+TITLE. C GEANT 3.15/09 920408 13.02 CERN PROGRAM LIBRARY GEANT = W5013 C GEANT3 GENERAL, PHYSICS AND KINEMATICS PACKAGES +PATCH,$VERSION. +DECK,V3_15. *CMZ : 3.15/09 08/04/92 13.02.08 by Federico Carminati *-- Author : Federico Carminati 16/03/92 * *::> VERSION 3.15/09 920408 13.02 * * * ************************************************************ * * * * * * * * G E A N T Version 3.15 * * * * * * O F F I C I A L R E L E A S E * * * * * * CERN, Geneva, April 7, 1992 * * * * * * * * * * * ************************************************************ * * *::> VERSION 3.15/08 920401 8.41 * * *::> VERSION 3.15/07 920331 9.42 * * *::> VERSION 3.15/06 920331 8.01 * * *::> VERSION 3.15/05 920329 15.41 * * *::> VERSION 3.15/04 920329 13.45 * * *::> VERSION 3.15/03 920327 18.49 * * *::> VERSION 3.15/02 920316 12.53 * * *::> VERSION 3.15/01 920316 10.18 * * Prerelease stamping of 3.15 * +DECK,V3_14. *CMZ : 07/01/92 15.44.59 by Federico Carminati *-- Author : * *::> VERSION 3.14/16 901107 15.23 * * See PATCH,HISTORY for the description of version 3.14 * +DECK,V3_13. *CMZ : 07/01/92 15.44.59 by Federico Carminati *-- Author : * *::> VERSION 3.13/05 890628 15.01 * * See PATCH,HISTORY for the description of version 3.14 * +PATCH,HISTORY +DECK,BLANKDEK. *CMZ : 3.15/01 07/01/92 15.30.56 by Federico Carminati *-- Author : Federico Carminati * * * ************************************************ * * * * * G E A N T version 3.15/01 * * * * * * P R E R E L E A S E * * * ============================== * * * * * ************************************************ * +DECK,V_315 *CMZ : 3.15/09 03/04/92 13.49.11 by Federico Carminati *-- Author : Federico Carminati * * * Maintenance and support for the GEANT MonteCarlo system * are performed by the Simulation Section of the CERN * Computing and Networks division. For any problem please * contact: * * Federico Carminati * CERN-CN * 1211 Geneva 23 * Tel: +41 22 767.4959 * Telefax: +41 22 767.7155 * E-mail: * BITnet/EARN: FCA@CERNVM * DECnet : VXCERN::FCA (Node 22.190) * Internet : fca@cernvm.cern.ch * * An electronic GEANT discussion list has been set up on CERNVM. * To be included in the mailing list it is enough to send the * following message: * * TELL LISTSERV AT CERNVM SUBSCRIBE LGEANT Firstname Lastname Inst * * People who do not dispose of a TELL (or equivalent) bitnet * command should send a mail to LISTSERV@CERNVM containing the * only line: * * SUBSCRIBE LGEANT Firstname Lastname Inst * *================================= History * *===> 20/NOV/1990 * * Current plans set the release of GEANT 3.15 around the third * quarter of 1991. * *===> 27/NOV/1990 * * Correction in GTRACK to set correctly the value of PREC * to match machine precision. Thanks to Stephan Egli and * M.Maire. * Introduced in the 314 correction cradle. * *===> 28/NOV/1990 * * Correction in GNTUBE to avoid square root of a negative * number. Thanks to M.Maire * Introduced in the 314 correction cradle. * * Eliminate TOFG=0 from GINIT, already done in GTRIGI * Thanks to F.Carminati * Introduced in the 314 correction cradle. * *===> 29/NOV/1990 * * UNIX and BSLASH flags correctly set inside *GEANT. * Thanks to A.Nathaniel * GPMATE now prints also the components in case of * mixtures. If NUMB is <0 then materials from 1 to * -NUMB are printed. Thanks to Stephan Egli. * * Corrections in GRGET (obsolete), GGET, GRIN to reset * correctly the number in GCNUM. Thanks to Stephan Egli * Introduced in the 314 correction cradle. * *===> 30/NOV/1990 * * New version of GNOELT and GNELTU, thanks to Yoshihisa Iga * and R.Nierhaus * Introduced in the 314 correction cradle. * * Correction in GTRAK, all mechanisms turned off in the * vacuum. Thanks to S.Egli * Introduced in the 314 correction cradle. * * *===> 03/DEC/1990 * * New routine GXPICK for the interactive version (Command * DRAWING/PICK) to pick a point in a detector and return * volume/material characteristics. Thanks to S.Egli. * *===> 04/DEC/1990 * * MAXNOD from 2000 to 8000 in GDTR0. Suggestion by S.Egli. * Introduced in the 314 correction cradle. * * Bug corrected in GGCLOS, do not touch ISEARC in case * of user search (ISEARC.GT.0). Thanks to D.Ward. * Introduced in the 314 correction cradle. * *===> 05/DEC/1990 * * Correction in TWOB, get correctly Tmin and Tmax and * their distribution. Thanks to Marko Mikuz. * Introduced in the 314 correction cradle. * *===> 06/DEC/1990 * * Correction in TWOCLU and GENXPT to improve energy * conservation. Thanks to S.Egli. * Introduced in the 314 correction cradle. * *===> 11/DEC/1990 * * Generic function LOG introduced in GHFRAK. Generic * functions MAX and MIN introduced in several routines * in GGEOM (HYPE) and CGPACK. Generic SIN, COS, ATAN and * SQRT introduced in CGPACK. Thanks to Federico Carminati. * Introduced in the 314 correction cradle. * *===> 13/DEC/1990 * * GTAU routine to be obsoleted. * * Supporting link for the LSCAN data structure mispelled * in several places. Corrected now. Thanks to Isabel Josa. * Introduced in the 314 correction cradle. * * Unused variable IPOT eliminated from GHFFER. * * Changes in the interactive part for ATC GKS which does * not use FORTRAN unit for metafiles. (routines GXINT and * GXGCON). Thanks to W.Koellner * *===> 14/DEC/1990 * * REAL*8 changed to DOUBLE PRECISION in CGPACK. * Life of the D+/- mesons was 100 times too short. * Thanks to Cheng He Sheng. * Introduced in the 314 correction cradle. * *===> 19/DEC/1990 * * Modification in GDRAW and GDSPEC to correct a bug. * Modifications in GLVOLU not to print a warning message * caused by drawing. * Introduced in the 314 correction cradle. * *===> 20/DEC/1990 * * Correction in GRAYLI affecting Rayleigh effect in * mixtures. * Introduced in the 314 correction cradle. * * Recode of GRAYLI and GHESIG to be safer with respect * to compiler optimization. * Thanks to Rafi Yaari. * *===> 8/JAN/1991 * * Corrections in GRGET, GGET, GRIN to set correctly * NPART, NTMED, NMATE, NVOLUM. Thanks to Lee Roberts. * Introduced in the 314 correction cradle. * * New meaning for ISVOL. If <0 the material is not a * a detector but the tracking parameters are the same * as in the case ISVOL>0 (sensitive medium). * Thanks to Michel Maire. * Introduced in the 314 correction cradle. * *===> 9/JAN/1991 * * TMAXFD not recomputed with IGAUTO=1 if the value given * by the user >= 0. Default value reset to 20. instead of * 60. degrees. Thanks to W.Mueller and M.Maire * Introduced in the 314 correction cradle. * *===> 10/JAN/1991 * * Corrections in GPFIS, GPFISI and GPHYSI for the fotofission * and fotoabsorbtion (Giant resonance) of photons on Uranium * and plutonium. Thanks to Harm Fesefeld. * Introduced in the 314 correction cradle. * * Correction in GPHYSI in case ILOSS=2 and more than one * tracking medium with the same material number then a * spurious error message was printed. Thanks to Kevin Sparks * Introduced in the 314 correction cradle. * * Corrections in GENXPT, TWOCLU, TWOB, CINEMA and EXNU. * Thanks to Harm Fesefeldt. * Introduced in the 314 correction cradle. * *===> 11/JAN/1991 * * Correction in GPPART in case of user words. Thanks to Walter * Mueller. * Introduced in the 314 correction cradle. * * Correction in GSTMED to protect for EPSIL <=0. Thanks to * Michel Lefebvre. * Introduced in the 314 correction cradle. * *===> 14/JAN/1991 * * Correction in GRGET to read the banks in the correct * division. Thanks to M.Maire. * Introduced in the 314 correction cradle. * * Improvement of GRIN, GROUT. New global keywords KINE and * TRIG can now be used. Thanks to Federico Carminati * Introduced in the 314 correction cradle. * *===> 17/JAN/1991 * * Correction in GSVOLU, GSDVN, GSDVN2, GSDVT, GSDVT2 not to * use uninitialized LINATT, set by GDINIT. This should take * care of the problem of empty drawings. Thanks to Simone Giani. * Introduced in the 314 correction cradle. * * Correction in GPKINE to print correctly user words and vertex * information. Thanks to Kevin Sparks. * Introduced in the 314 correction cradle. * * Correction in GPVERT to print correctly user words and vertex * information. Thanks to Soren G. Frederiksen. * Introduced in the 314 correction cradle. * *===> 18/JAN/1991 * * Max. GCKING stack size parametrized. The actual value of the * stack is not changed (100), but can be redefined in the * sequence GCKMAX. Important for LHC studies. * Thanks to Harm Fesefeldt. * * Correction in GPRINT to call correctly GPDIGI and GPSETS. * Thanks to Michel Maire. * Introduced in the 314 correction cradle. * *===> 22/JAN/1991 * * New facilities of DZDOC introduced in the interactive menu. * Patchy flag (DZDOC) to assure backward compatibility. * Thanks to O.Schaile * *===> 31/JAN/1991 * * New facility using the JUMPT package to call user routines. * Patchy flag (USRJMP) to assure bacward compatibility. * Thanks to F.Carminati * *===> 05/FEB/1991 * * Correction in GINIT to print the level of the correction * cradle applied. Thanks to F.Carminati. * Introduced in the 314 correction cradle. * * Correction Cradle 3.14/06 stamped and released. * *===> 06/FEB/1991 * * Introduction of the AIX370 flag in GEANX and GEANT. * Thanks to Roger Howard. * *===> 13/FEB/1991 * * Protection in GTRACK, GFTRAC and GLTRAC, do not update * pointers to cross section banks in the vacuum. * Thanks to C.Fuglesang, S.Banerjee, M.Maire. * Introduced in the 314 correction cradle. * *???> Backward incompatibility * * GFDETH returns NAMESH as a character*4 array and * GFDETD returns NAMESD as a character*4 array. * Thanks to M.Maire. * * *===> 14/FEB/1991 * * Mods in GPMATE, GPPART, GPTMED, GSDK, GSMATE, GSMIXT, GSPART, * GSTMED, GSROTM, GPROTM * to warn against replacement of existing objects. Thanks to * Steve O'Neale. * Introduced in the 314 correction cradle. * * Force load of user routines in GINIT. * Introduced in the 314 correction cradle. * *===> 15/FEB/1991 * * GSDVN to notify correctly when mother volume does not exists. * Thanks to Victor Perevoztchikov. * Introduced in the 314 correction cradle. * *===> 20/FEB/1991 * * Correction in GHEINI for the exponent range to be compatible * with IEEE machines. Original limits were for IBM/370. * Routine LIMDAT eliminated. Thanks to Hans-Jochen Trost. * Introduced in the 314 correction cradle. * *???> Backward incompatibility * * Parameter NAMATE returned from GFMATE now a CHARACTER*20 * variable. Thanks to Michel Maire. * * Monitoring introduced, flag MONITOR. Thanks to F.Carminati. * Mods in GXINT, GINIT, GLAST. Routine GEAMON introduced. * Introduced in the 314 correction cradle. * *===> 22/FEB/1991 * * GWORK in GINIT was (DUMMY) called without arguments. * GUDTIM was (dummy) called as a routine and it is a * function. Thanks to F.Carminati. * Introduced in the 314 correction cradle. * * GUVIEW to specify 3rd argument as a character. Thanks to * Federico Carminati. * Introduced in the 314 correction cradle. * * Call NUCRIN with the right number of arguments (the last * was not used anyway). Thanks to Federico Carminati. * Introduced in the 314 correction cradle. * *===> 04/MAR/1991 * * Correction in GMUSIG to avoid division by zero. Thanks to * M.Verzocchi. * Introduced in the 314 correction cradle. * * *===> 20/MAR/1991 * * Corrections in GPRELM, muon e+e- soft radiation. Correction in * GDRELM for the ionization energy loss for muons. Thanks to * A.Nathaniel. Introduced in the 314 correction cradle. * *===> 21/MAR/1991 * * Correction in GPHYSI to initialise the JMULOF bank even in * the case of vacuum. Electron tracking in vacuum was not taking * into account the TMAXFD parameter. Correction in GRANGI to set * the range to BIG in case of 0 energy loss tabulated in JLOSS. * Correction in GPHYSI to switch off all the mechanisms in the * vacuum but decay. The corresponding code in GTRACK has been * removed. The previous corrections for IUPD in GLTRAC, GFTRAC * and GTRACK have been removed as well. Thanks to D.Ward, R.Brun, * F.Carminati * Introduced in the 314 correction cradle. * * Corrections in GRANGI and in GTHADR to cure small steps in * tracking. Thanks to M.Maire. * Introduced in the 314 correction cradle. * *===> 25/MAR/1991 * *???> Backward incompatibility * * GFPART returns NAPART as a CHARACTER*20 array. Thanks to R.Rui * Introduced in the 314 correction cradle. * *===> 26/MAR/1991 * * GFTMAT will return the correct values for the vacuum, except * for hadrons. Thanks to P.Gumplinger. * Introduced in the 314 correction cradle. * * Correction in GPCXYZ when the number of mechanisms is greater * than 6. Thanks to Y.Iga. * Introduced in the 314 correction cradle. * * *===> 27/MAR/1991 * * GDXYZ corrected to use HIGZ generic line types. Thanks to * M.Maire. * Introduced in the 314 correction cradle. * * Correction in the CDF for RZ/IN and RZ/OUT. Thanks to * F.Carminati. * Introduced in the 314 correction cradle. * *===> 04/APR/1991 * * For reasons of speed GKS-type lines are used now in * GDCXYZ, GDXYZ. Thanks to F.Carminati. * Introduced in the 314 correction cradle. * *===> 18/APR/1991 * * Correction of the logic for TMAXFD. Now is: * * AUTO 1: 0 accepted * TMAXFD>20 --> set to 20 * TMAXFD<=0 --> set to 20 * * AUTO 0: TMAXFD>0 --> accepted * TMAXFD<=0 --> set to 20 * * Thanks to Gerry Lynch. * Introduced in the 314 correction cradle. * * Correction in GMULOF. STMIN=BIG for the vacuum. Thanks * to F.Carminati. * Introduced in the 314 correction cradle. * * Correction in GRFILE, GRIN called with IDVERS=0 and not * 999. Thanks to F.Carminati. * Introduced in the 314 correction cradle. * *===> 22/APR/1991 * * Corrections in GPRELA, GMULOF, GPHYSI and GTNEXT. Now * STMIN is set to 0. for vacuum independly of the AUTO * flag. Thanks to M.Maire. * Introduced in the 314 correction cradle. * * Format correction in GSDVN. Thanks to Federico Carminati. * Introduced in the 314 correction cradle. * *===> 23/APR/1991 * * Correction in GINIT to initialize LIN via IQTTIN if * different from 0. Thanks to F.Carminati * Introduced in the 314 correction cradle. * *===> 24/APR/1991 * * New routines GPLMAT, GPRMAT, GPGKIN from Michel Maire. * *===> 25/APR/1991 * * geant.metafile is not opened any more by default. * The METAFILE command now accepts the metafile name * for packages like ATC-GKS which do not use FORTRAN. * Thanks to W.Koellner. * *===> 01/MAY/1991 * * Problem corrected in GHEISH for neutron cascade. A neutron * undergoing an hadronic reaction could generate two recoil * protons. Thanks to Henk den Bok. * Introduced in the 314 correction cradle. * * Correction in GNEXT/GTNEXT. STMIN not used anymore for * MANY volumes. Thanks to M.Maire. * Introduced in the 314 correction cradle. * *===> 02/MAY/1991 * * Call to NVETIM routine removed from GHEISHA. Thanks to * F.Carminati. * *===> 07/MAY/1991 * * RNDM interactive command added to set the random number * generator seeds. Thanks to F.Carminati. * *===> 08/MAY/1991 * * New routine GDTRAK introduced to draw a track and delete * it from the JXYZ buffer optionally. Thanks to R.Brun, * F.Carminati. * * Important correction in GTGAMA, GTNEUT to avoid problems * due to machine precision. When a push is made to cross a * volume boundary the condition that the change in coordinate * be not negligible is imposed. Thanks to F.Carminati, R.Brun. * Introduced in the 314 correction cradle. * *===> 09/MAY/1991 * * Correction in GMGAUS due to G.Lynch. The sigma of the multiple * scattering in the gaussian approssimation was too small. * Introduced in the 314 correction cradle. * *===> 14/MAY/1991 * * Corrections in GTELEC, GTHADR and GTMUON to introduce the * same boundary correction than in GTNEUT, GTGAMA. Thanks to * P.Gumplinger. * Introduced in the 314 correction cradle. * * New menu in GXINT to handle FZ files. Thanks to F.Carminati * *===> 17/MAY/1991 * * Correction in GHFHDN to reset to 0. TOFD. Thanks to * R.Rui. * Introduced in the 314 correction cradle. * *===> 31/MAY/1991 * * Correction in GTRACK to allow PREC to decrease and avoid * problems when changing particle and position but not medium. * Thanks to R.Spiwoks. * Introduced in the 314 correction cradle. * *===> 4/JUN/1991 * * New version of the hidden line removal, thanks to S.Giani. * New menu CVOL introduced to cut volumes and new SHIFT * command to shift volumes for drawing. * * Correction in GHEISH. The ENP parameters are reset to 0. * at the beginning of every event. Thanks to Henk den Bok. * Introduced in the 314 correction cradle. * *===> 5/JUN/1991 * * Correction introduced in GPHYSI. JTM recalculated after * bank push. Thanks to K.Sparks. * Introduced in the 314 correction cradle. * *===> 11/JUN/1991 * * Correction introduced in GTELEC, GTMUON, GTHADR. When the * energy loss is below machine precision, it is recalculated * via the De/Dx table. Thanks to H.Fesefeld and Ralf Spiwoks. * Introduced in the 314 correction cradle. * * Booking of the bank IMAT-4 delayed till GPHYSI. Will save some * words in case of materials which are not inserted in a tracking * medium. Thanks to F.Carminati. * *???> Backward incompatibility * * The argument DMAXMS in the calling sequence of GSTMED, unused * in 314, will be called STEMAX and will assume the meaning of * maximum step allowed for a particle in the given material. * This will only affect people running with AUTO 0. In case of * automatic computation of the tracking media parameters, this * number will be set to BIG (=1.E10). * Thanks to F.Carminati, M.Maire. * *===> 12/JUN/1991 * * Corrections in GMUNU to allow the usage of a variable number of * energy bins. Corrections in PHASP and GMUSIG for very high * energies. Thanks to Hans-Jochen Trost. * Introduced in the 314 correction cradle. * * Correction in GFLTHE to avoid division by 0. Thanks to * Roy Bossingham. * Introduced in the 314 correction cradle. * *===> 13/JUN/1991 * * Correction in GINPGO and GINPCO to check correctly the PHI * limits. Thanks to R.Bossingham. * Introduced in the 314 correction cradle. * *===> 19/JUN/1991 * * Correction in GMUNU to calculate correctly the angle of the * incoming muon. Thanks to H-J.Trost. * Introduced in the 314 correction cradle. * *===> 20/JUN/1991 * * Corrections in GLANDZ for high energy to avoid numerical * problems. Thanks to H-J.Trost. * Introduced in the 314 correction cradle. * *===> 26/JUN/1991 * * All the routines and the commons of the HADRIN/NUCRIN * package have been renamed. All routines begin now with * GHF and all commons with GCF. This to avoid interactions * with the interface with FLUKA. Thanks to F.Carminati * *===> 28/JUN/1991 * * New algorithm for pushing a view bank. Now push of the * max between MORGS and the 25% of the size of the view * bank. Thanks to S.Giani. * *===> 17/JUL/1991 * * Common HIATT of HIGZ removed from GXCONT and workstation type * retrieved in GXDZ from Workstation ID. Thanks to O.Couet. * * Modification in GMUSIG to protect against possible division * by zero. Thanks to M.Sarris. * * Correction in GDSHOW to recalculate COSPSI and SINPSI. Thanks * to M.Verzocchi. * Introduced in the 314 correction cradle. * *===> 18/JUL/1991 * * Correction in GINVOL. When tracking in magnetic * field they could return the wrong volume. Thanks to D.Greiner. * Introduced in the 314 correction cradle. * *===> 24/JUL/1991 * * Corrections in GRIN to allow tracking after reading a data * structure. Thanks to R.Brun. * Introduced in the 314 correction cradle. * * Modifications in GXINT to allow running with the MOTIF * user interface. Thanks to R.Brun. * *===> 31/JUL/1991 * * INT=0 suppressed in GHEISH after nuclear fission. * Thanks to Kati Lassila. * *===> 01/AUG/1991 * * Protection introduced in GMUSIG. Thanks to Jochen Trost. * Introduced in the 314 correction cradle. * *===> 02/AUG/1991 * * Correction in GHSTOP to fix the calculation of the time of * flight for stopping particles. Thanks to L.Roberts. * Introduced in the 314 correction cradle. * * Correction in GNPGON not to calculate safety for the inner * radius when this is 0. Thanks to Andrei Nomerotsky. * Introduced in the 314 correction cradle. * * Correction in GNOTRP to return the correct SNXT. Thanks to * V.Innocente. * Introduced in the 314 correction cradle. * * Correction in GHSTOP not to discard hadrons at rest, they * may decay. Thanks to H.Fesefeld. * Introduced in the 314 correction cradle. * * Modifications in GHSTOP and GHEISH to handle user defined * particles. Thanks to P.Gumplinger. * Introduced in the 314 correction cradle. * *===> 12/AUG/1991 * * Call to GUINTI added in GINTRI to define user commands. Thanks * to V.Vercesi. * Introduced in the 314 correction cradle. * *===> 21/AUG/1991 * * Modification in GTMED to print a warning when FIELDM .EQ. 0 * and IFIELD .NE. 0. Thanks to Federico Carminati * * Modification in GTHADR to set CFLD = BIG in case FIELDM=0. * Thanks to V.Vercesi. * Introduced in the 314 correction cradle. * *===> 27/AUG/1991 * * Call to C dummy routine to initialise X11 introduced in * GXINT for IBM/VM. Thanks to M.Marquina. * *===> 19/SEP/1991 * * Rayleigh effect now the default. IRAYL is set to 1 by default * in GINIT. Thanks to M.Maire * * Changes in the multiple scattering routines. GMOLI1 and GMOLI2 * suppressed and GMOLIO used instead. Corresponding changes in * GMULTS and GMULOF. The code of GMOLS has been put in line inside * GMOLIE and GMOLS is obsolete. GPOISS and GMCOUL modified for * performance reasons. * Gaussian scattering is now generated according to the Rossi * gaussian formula and there is no logarithmic term in the * sigma of the gaussian. This gives a distribution where the * tails are underestimated, but which is consistent over many * steps. * Moliere and single Coulomb scattering are chosen according to * the value of Omega in the Moliere formula. * The new meaning of IMULS is the following: * * IMULS = 0 No multiple scattering * IMULS = 1,2 Moliere or single Coulomb scattering * IMULS = 3 Gaussian scattering with Rossi formula * * Thanks to G.Lynch. * *===> 14/OCT/1991 * * New algorithm for calculation of energy loss. The stopping * range is now calculated with a parabolical interpolation * instead than with a linear one. This gives a dE/dx curve * which is a piecewise linear function and not a step function. * Thanks to F.Carminati. * * Modification of GNOPG1 taking care of the case of a particle * which is very near to the surface and it may appear inside due * to machine precision. This could cause the volume to be skipped. * Thanks to R.Nierhaus. * * Routine GNPGON rewritten for the calculation of SNXT. The * previous routine was returning wrong results. Thanks to * R.Nierhaus. * *===> 28/OCT/1991 * * Modifications in the routines GFLPHI and GFCOOR. The ordering * for TUBS in phi was wrong. Volumes could become invisible. * Thanks to F.Carminati. * * New routine GFVERT introduced. Retrieves the parameters of a * vertex. Thanks to F.Carminati. * *===> 29/OCT/1991 * * Modification in NUCREC to zero the whole of the PV array * to prevent the use of uninitiated variables. Thanks to * F.Ranjard. Introduced in the 3.14 correction cradel. * *===> 1/NOV/1991 * * Useless code commented out in GTRAIN. Thanks to F.Carminati. * * GNCONE gone to double precision. Thanks to J.Toth. * *===> 5/NOV/1991 * * Variable USERW undefined in the RESULT common now set to * UPWGHT from GCTRAK common. Thanks to F.Ranjard. * * Type declarations for GCSTAK completed. Thanks to M.Battle. * *===> 5/DEC/1991 * * New calculation of the range table. Simpson integration rule * used. Modifications in GRANGI, GCOEFF. * *===> 10/DEC/1991 * * Protection introduced against the reading of a pre-315 data * structure. The value of STEMAX is set to BIG in this case. * Modification in GPHYSI. * * Better handling of version numbers in I/O operations. * Modifications in GPHYSI and GRIN. * *===> 08/JAN/1992 * * Correction in GLANDZ to avoid gaussian distribution for * very thin layers. The version of GEANT 3.13 has been * used for this. Thanks to F.Carminati and M.Maire. * * Corrections in GTNEXT, GINVOL and GTMEDI to protect against * wrong values of INGOTO when using MANY volumes. Thanks to * R.Brun. * *===> 15/JAN/1992 * *???> Backward incompatibility * * The random numbers seeds are stored at the end of every event * in the JRUNG bank at locations 19 and 20. If the JRUNG data * structure is read in and the data card RNDM or the interactive * command RNDM has not been issued (NRNDM(1), NRNDM(2) <> 0), * and if the words 19/20 are not 0, then the random number * generator is restarted with these seeds. Thanks to F.Carminati * * The RNDM command now reads the values of the seeds into * NRNDM(1) and NRNDM(2) in common GCFLAG. The values 0 0 * can be used for the random seeds. These values will not * alter the current status of the random number generator, * but zeroing the variables NRNDM(1) and NRNDM(2) will * allow them to be reinitialised with the values stored * in a data structure read from disk. Thanks to F.Carminati * * Routine GREND now needs an integer as input. This is to be * consistent with GRFILE. * *===> 27/JAN/1992 * * The following changes made to the names of FLUKA routines * to avoid clashes with ISAJET. Thanks to L.Roberts. * * Type Original name New name * Routine DECAY FKDECA * Routine FLAVOR FKFLAV * Routine SIGINT FKSIGI * *===> 31/JAN/1992 * * Corrections in GMEDIA in case of many volumes to avoid * program crash. Thanks to R.Jones. * * Change of logics in GRUN. Now if NEVENT is <= 0, no event * is processed. Thanks to B.Lockman. * * Common GCFLAX put in the GCFLAG sequence with the BATCH and * NOLOG variable from GXINT. Thanks to B.Cole. * * Problem corrected in GDECAY. The mass of the particle was * altered. If the next particle was the same, the mass was * not reset to its correct value. Thanks to S.Tonse. * * TIMINT is now really the time left after initiatlization * as is specified in the documentation and not the time * USED for initialization as it was till now. * Thanks to V.Ivanov. * * Corrections in GNPGON. Improvement of code safety under * optimization in GNOGO1, GNPGON, GNPCON. Thanks to Y.Iga. * *===> 4/FEB/1992 * * Corrections in GMULOF and GTHADR. SFIELD takes precedence * on STMIN in case IFIELD=1 to make sure that the Runge-Kutta * approssimation still works. Thanks to R.Hawkings. * *===> 10/FEB/1992 * * Correction in GDRAY to improve the precision in the calculation * of the angle. Thanks to F.Carminati & P.Lubrano. * * Change in GFKINE. The variable TOFG is not updated any more. * Thanks to F.Carminati * * New GMEDIA, GTMEDI, GINVOL to take care of the problems with * MANY volumes. Thanks to R.Jones. * *===> 14/FEB/1992 * * Bug corrected in GNPGON when the particle was exactly on the * wall of the last Z section. Thanks to V.Palichik. * *===> 17/FEB/1992 * * Updated routines GLUND, GLUNDI and new sequences LUDAT1, LUDAT3, * LUJETS. The data cards MSTE, KTYP, PMAS, PWID, IDB have been * removed because either obsolete or not aplicable. The new code * runs with JETSET 7.3 upward. Thanks to F.Carminati, T.Sjostrand. * * Update of GLUDKY to work with 7.3. Thanks to F.Carminati. * *===> 23/FEB/1992 * * New subroutine GFIN to handle sequential input. Routine GGET * has been maintained for backward compatibility. * Thanks to F.Carminati. * *===> 01/MAR/1992 * * New Runge-Kutta integration routine for the tracking in * magnetic field. If the result of the stepping is not accurate, * the step is divided in 2 parts and the integration repeated * and so on. Thanks to V.Perevotchikov. * *===> 05/MAR/1992 * * Correction in GLTRAC. When the particle fetched has an entry * in JKINE the correct vertex number is calculated. Thanks to * Y.Foka. * *===> 06/MAR/1992 * * Correction in GTELEC. The calculated range may be slightly * larger than the maximum allowed range due to precision * problems and this was leading to very small negative steps. * Thanks to R.Brun. * *===> 08/MAR/1992 * * New GRKUTA, GHELIX, GHELX3 from V.Perevotchikov. * *===> 16/MAR/1992 * * ENERGY renamed to FKENER in FLUKA. Thanks to F.Carminati * *===> 17/MAR/1992 * * VERTEX->FKVERT, ZEROIN->FKZERO, ERROR->FKERRO in FLUKA. * Thanks to F.Carminati * * Corrections in PBANH. Thanks to M.Sasaki. * *===> 19/MAR/1992 * * Corrections in GFIN, GFOUT and GRIN, version 0 is now allowed * for a data structure in I/O. Thanks to B.Cole. * * Modification in GBREME to improve precision for small angles. * Thanks to F.Carminati. * * Inlining of rotation routines in GFTRAC, GINVOL, GTMEDI, * GTNEXT, GMEPOS, GMEDIA. Thanks to D.Kryn, F.Carminati. * * New routines GDLENS, GDPLST and GDPRTR in the drawing package. * New version of GDTREE. Thanks to S.Giani. * * Streamlining of GDTOM, GINROT, GITRAN, GMTOD, GRMTD, GRMUL, * GROT, GTRMUL and GTRNSF. Thanks to F.Carminati. * *===> 23/MAR/1992 * *???> Backward incompatibility * Tracking medium name in GFTMED changed in CHARACTER variable. * Thanks to V.Perevotchikov. * * IMPULS renamed to FKIMPU * DRES renamed to FKDRES * ERUP renamed to FKERUP in FLUKA. Thanks to F.Carminati. * *===> 24/MAR/1992 * * COSI entry point renamed to FKCOSI * POLI renamed to FKPOLI in FLUKA. Thanks to F.Carminati * * Changes in GCOMP to increase the precision of the rotation * of the scattered photons and electrons in the reference * frame of the incoming particle. Thanks to F.Carminati * * New version of the routines GNOPG1 and GNPGO1. Speed up of * a factor two or more achieved. Thanks to F.Carminati, * M.Roethlisberger. * *===> 29/MAR/1992 * * Improvement of the routines GMEDIA, GTMEDI and GINVOL. A better * use is made of the variable INGOTO. Thanks to R.Jones, F.Carminati. * *===> 01/APR/1992 * * Modification in GTRACK. If a particle tries for more than 5 times * consecutively to exit a volume, the precision used for tracking is * multiplied by 5 and so on every fifth attempt. Thanks to * F.Carminati. * * Modification in FLUFIN to normalise in double precision the * direction cosines given to FLUKA. Thanks to A.Ferrari * * Modification in GLANDZ to avoid peaks in energy loss for very * light materials. Thanks to F.Carminati * * New routine GETVER to crack the title sequence and to return * the correct version number. Thanks to F.Carminati and M.Maire. * +DECK,V_314. *CMZ : 3.15/01 07/01/92 15.30.57 by Federico Carminati *-- Author : C C C ************************************************ C * * C * G E A N T version 3.14.16 * C * * C * Official R e l e a s e * C * ============================== * C * * C ************************************************ C C C * The version 3.14 of GEANT is being released. Apart from a few * features, reported below, the new version is compatible with the * previous version 3.13. Substantial developments have taken place, * in particular in the physics and tracking areas. * * In addition to the GEANT team * (R.Brun:CERN/CN-AS, F.Bruyant:CERN/ECP-PI and M.Maire:LAPP), * many people have contributed to the new version, especially * - a large number of users of the previous version who reported * their experience, found bugs and suggested several improvements, * - the guinea-pigs of 3.14 who gave us essential comments during * our attempt to automatize computation of the tracking parameters. * ** A.Givernaud (UA1), F.Nessi, V.Vercesi(UA2/LHC) * ** The LHC proto collaborations * - H.Fesefelt(Aachen) has provided a new version of the GHEISHA * package with help from N.Van Eijndhoven (CERN/CN-AS) * - H.J Trost from ANL has reported problems in the muon-nuclear * interactions routines and provided the relevant corrections. * - P.Pedroni (Pavia) has implemented a new interface called * by GHEISHA for low-energy hadronic processes (See NUCRIN below). * - the contributors to the geometry package: * for the introduction of new shapes * ELTU by A.Solano (ZEUS) * HYPE by M.Corden (ALEPH and SSC) * CTUB by A.McPherson (CEBAF) * for systematic investigation of problems with the old shapes * R.Nierhaus (CERN/CN-AS) * - S.Egli (H1) has proposed an automatic optimisation for the * geometry at initialisation time. * - G.Lynch from Berkeley has investigated the multiple-scattering * various strategies and proposed a new algorithm. * - A.Rotondi and P.Montagna have proposed a new technique for the * fast generation of Vavilov distribution. * K.S.Koelbig (CERN/CN-AS) has implemented a new routine GVAVIV * based on their work. * - J.Salt (CERN/CN-AS) has implemented the graphics interface to the * CG package from Serpukhov with the help of E.Chernaev. * - The IBM team (C.Guerin, M.Roelisberger) have investigated how * to speed-up the program. Their work has been coordinated * by F.Carminati (CERN/CN-AS). * * GEANT3.14 documentation * ======================= * The printing of a new manual describing the new version is * scheduled for the end of this year. The CERN Program Library * will not distribute anymore the old document (version 3.11). * * * Important notice to GEANT users * =============================== * * Following the reorganisation of the CERN research divisions * in July 90, R.Brun is now in charge of the Application Software * group (AS) in the CN division and F.Bruyant is in charge of the * Production support and computers Infrastructure group (PI) in the * ECP division. They will nevertheless continue, with M.Maire, to be * actively involved in the development of GEANT. Federico Carminati * is the coordinator of a simulation software unit in the CN-AS group. * Users are strongly recommended to address their questions,etc * directly to him (email: FCA@CERNVM.CERN.CH on BITNET). In particular, * feedback from users making comparisons with real data will be most * appreciated. * * The simulation team is preparing the ground for the next version * of GEANT. In view of the proposed new accelerators, the following * items are considered with high priority: * - Parametrization techniques. A survey of the various methods * used in current experiments has been done and the implementation * of a new algorithm based on the GSCAN geometry + GFLASH (H1) * is in progress. * - Improvements in the geometry package. General shape definition, * surface based algorithms. * - Detector data structure and data base. Interface with CAD systems. * - Parallelism (at event level and below). * * *...................................................................... * * *** Compatibility with version 3.13 * =============================== * - If COMMON blocks GCMULO or/and GCJLOC were included in the * user code, the new GEANT sequences GCMULO and GCJLOC must be * inserted and the code recompiled. * - Initialisation data structures saved with the previous versions * cannot be read by the new version, because the binning for * the cross-sections and energy loss tables has been changed. * - The GCPHYS variables SOLOSS,STLOSS,SOMULS,STMULS are no more * defined (see comments below) * - The GCTRAK variable IDECAD is replaced by IGAUTO * * * *** MAIN CHANGES IN THE TRACKING PROCEDURES * ======================================= * * The tracking control routines GTGAMA,GTELEC,GTHADR,GTNEUT,GTMUON * have been largely rewritten to reflect the changes to the energy-loss * and multiple scattering processes. * * * *** The ENERGY RANGE of the cross section and energy loss tables can * be fixed by the user with the new data card : * 'ERANG' EKMIN EKMAX NKBIN * which defines nkbin bins from Ekmin to Ekmax in a logarithmic scale. * The default is, as before, 90 bins from 10 Kev to 10 Tev but in * logarithmic scale. NKBIN must be 50 3) inelastic * interactions from a few MeV/c up to about 4.5 GeV/c laboratory * momentum of the incoming particle. * NUCRIN is automatically called by the GHEISHA routine GHEISH * when the flag IHADR=3 (set by data card HADR). * It is assumed that these reactions are the superimposition of three * basic processes: * * (a) inelastic collision of the projectile hadron (allowed particles are : * p,pbar,n,nbar,pi0,pi+,pi-,k+,k-,k0,k0bar,lamda0,lamda0bar,sigma+, * sigma-,sigma0) with a target nucleon in the nucleus. * This interaction is simulated,taking into account of the nucleon * Fermi momentum, using HADRIN (see ref.2) program. * The corresponding physical model is based on the experimental evidence * that, in the selected momentum range,the inelastic cross section shows * the typical threshold and resonance behaviour of meson production: * the primary hadron-nucleon system is excited to an isobaric state * which then decays into hadrons or other resonances. * * If the interacting nucleus is hydrogen,HADRIN can also be used * in a separate way to simulate hadron-proton reaction. * * (b) induced intranuclear cascade with resulting proton and neutron * emission; * * (c) nuclear evaporation and deexcitation from residual nucleus. At the * output the total energy available for these processes is given as * "excitation energy". * * The mean excitation and cascade energies and the average multiplicities * of cascade particles are parametrized, according to experimental * distributions. * In each event their value are sampled from gaussian distribution: * if they fall in the permitted kinematical region, energy and types of * cascade nucleons are calculated and the remaining energy is assigned to * the incoming particle. * For hadron-nucleon interactions all relevant kinematic variables are * Lorentz-trasformed into the target nucleon rest system. If interaction * kinetic energy is greater than the total available collision energy * a new Fermi momentun is sampled, otherwise an event is generated with * HADRIN,in which decays modes of 107 particle and resonances into about * 450 different channels are tabulated and outgoing particle directions * and momenta are chosen to reproduced experimental momentum transfer * distributions. * Final state particles kinematical variables are transformed back into * laboratory system; reaction and sampled event energies are again compared: * if their difference is negative, energy is not conserved and generation * has to be started once more with a new Fermi momentum sampling or if it * is,on the contrary positive, particle momenta and energies are corrected * to reach conservation. * The sampled events conserve the energy, the momentum, the electric and * baryonic charge and the strangeness. * NUCRIN and HADRIN are initialised, by default, before event generation, * with a call to subroutines HADDEN and CHANWX which estabilish internal * weight tables and decay channels. * * ----------------------------------------------------------------------- * (1) K. Hanssgen, J. Ranft , Comp. Phys. Comm. 39, 53 (1986) * (2) K. Hanssgen, J. Ranft , Comp. Phys. Comm. 39, 37 (1986) * * * *** GEOMETRY PACKAGE: New shapes and many improvements * ================================================== * * Automatic optimisation of the geometry structure: * A new data card OPTI has been introduced (S.Egli H1). * OPTI -1 : disable optimisation * OPTI 0 : only volumes GSORDered are optimised (as in 3.13) * OPTI 1 : volumes GSORDered are optimised along the axis * specified. All the other volumes are automatically * optimised along the best axis (1 to 7). * OPTI 2 : All volumes are optimised along the best axis. * Volumes for which GSORD was called are also optimised. * The default value for OPTI is 0. * In case OPTI >0, the result of the optimisation is printed. * The automatic optimisation is done at initialisation time by * a new routine GGORDQ called by GGCLOS. * * * Most of the geometry routines have been revisited and consolidated. * The following new shapes are available. * * 'ELTU' is a cylinder with an elliptical section. * It has three parameters: the ellipse semi-axis in X, * the ellipse semi-axis in Y and the half length in Z. * Given the equation of the conical curve: * X**2/A**2 + Y**2/B**2 = 1, * describing the volume,then: PAR(1) = A * PAR(2) = B * PAR(3) = DZ * ELTU is not divisible. * * 'HYPE' is a hyperbolic tube, ie the inner and outer surfaces * are hyperboloids, as would be formed by a system of * cylindrical wires which were then rotated * tangentially about their centres. The 4 parameters * are the inner and outer radii, the half length in z, * and the "stereo angle" theta in degrees, such that * the hyperbolic surfaces are given by * r**2 = (z*tan(theta))**2 + (r at z=0)**2 * * 'CTUB' (for cut tube) is a TUBS whose end planes are not * perpendicular to the z axis. It has 11 parameters : * the 5 of the TUBS shape plus the components of the normal * to the end plane at the lower z (LXL,LYL,LZL) and * those at the higher z (LXH,LYH,LZH). * DZ means the half length in z for x = y = 0 * * * Bugs have been fixed in the routines GNPCON, GNPGON and GNOPGO. * * The new version of GNOTRP requires an extended parameter array. * In addition to the 11 specified parameters (of which 4 are * modified in subroutine GSVOLU or GSPOSP), the coefficients of * the implicit normalized plane equation for the 6 surfaces * of the hexahedron are stored. * * IMPORTANT NOTE concerning the TRAP shape * ======================================== * The Geant documentation describes the Geant shape TRAP as follows: * * TRAP is a general trapezoid, i.e. one for which the * faces perpendicular to z are trapezia and their * centres are not at the same x, y. It has 11 * parameters: Dz the half length in z, Th & Phi the * polar angles from the centre of the face at z=-Dz * to that at z=+Dz, H1 the half length in y at * z=-Dz, LB1 the half length in x at z=-Dz and y=low * edge, LH1 the half length in x at z=-Dz and y= * high edge, Th1 the angle w.r.t. the y axis from * the centre of the low y edge to the centre of the * high y edge, and H2, LB2, LH2, Th2 the * corresponding quantities to the 1s but at z=+Dz. * * This seems to describe a general hexahedron with 3 constraints: * 2 constraints follow from the fact that two faces are "trapezia". * (twice 2 edges parallel). * The 3rd constaint is that two faces are parallel, namely the "trapezia" * faces are both perpendicular to the Z-axis. * We will assume that shape TRAP is a hexahedron with 3 * constraints and direct our attention to the degrees of freedom * of such a shape. * The shape has 8 vertices and therefore 24 coordinates. * If we first consider a volume with 8 vertices and 6 surfaces, * but do not make the assumption that the surfaces are plane, * we see that this shape has 18 degrees of freedom. * We loose 3 coordinates because of the translational invariance * of the shape and 3 coordinates because of its rotational * invariance. * If we now assume that the shape is a hexahedron, that is * bounded by plane surfaces, we have 6 constraints, one for each * surface, and our hexahedron has 12 degrees of freedom. * Considering the 3 constraints mentioned in the beginning, * we conclude that our shape trapezohedron has 9 degrees of freedom. * It is however described by 11 parameters. * Therefore we must either drop our assumption that shape TRAP is * a hexahedron, that is bounded by parallel surfaces, or we must * request that the user specifies the 11 parameters with certain * constraints. * * To check that the user respected the constraints, we check the * coplanarity of the faces during the specification phase of shape TRAP. * We know the vertex coordinates, and we have the indices to the * vertices for each face. * Assuming that a face is tetrahedron, we compute its volume. * We divide by the surface of the base triangle, and get a measure * for the coplanarity of the face, which is actually a distance. * A warning message is printed in case of no-coplanar faces. * * GSORD problem * ============= * A bug has been found in GTNEXT (and alike) which is induced by a bug of * logic in GSORD/GGORD. User calls to GSORD, with ordering axis 4 (Rxy) * or 5 (Rxyz), may cause problems when the ordered contents are such that * one can jump from a given content to another one without crossing a * content which, along the given axis, occupies a position in between the * start and the end contents : e.g. coaxial TUBES with different Z-lengths * should not in general be ordered by GSORD along the axis IAX=4 (Rxy). * However, part of the information provided by such calls can still be * used, in the static context of GTMEDI for instance. Therefore, the * following convention has been introduced: If the user is sure that the * contents are positioned in such a way that the anomaly mentioned above * cannot occur, the call to GSORD can be modified by using IAX=14 (instead * of 4), or 15 (instead of 5), in which case the ordering techniques will * also be used in the dynamic context of GTNEXT. In case of doubt, the * user has better to keep the old code, with IAX=4 or 5. * * *** DRAWING PACKAGE: Interface to the CG package * ============================================ * * An interface to the CG (Combinatorial Geometry) package written * at Serpukhov by E.Cernaev et al is now available. The new package * is automatically called if the option 'HIDE' is selected. eg. * * CALL GDOPT('HIDE','ON') in a Fortran program * DOPT HIDE ON/OFF in the interactive version * * This new facility includes a hidden line and surface algorithm * which permits nice 3-D views of a detector. * In the frequent case of hermetic 4 PI detectors, a facility * to remove a box (The Cutting BOX) is also implemented. The Cutting BOX * specifies a region of the detector which must be Cut to see inside. * A new interactive command CBOX is available to specify the box limits. * * The CG system is part of the GEANG file (See Patches CGCDES,CGPACK) * To activate the CG package, +USE,CG,*GEANG. * * * *** The SCAN geometry * ================= * A new Patch,GSCAN has been introduced on a provisional basis in the GEANG * file. See discussion about SCAN below. * * *** GUPARA: Parametrization interface * ================================= * A new FFREAD data cards PCUT can be used to set parametrization cuts. * The first argument of the PCUT card is a integer flag which turns or * on off the parametrization mechanism. If the parametrization is turned on * and a particle falls below one of the 5 cuts specified by the PCUT card * (similar in kind to the cuts specified by the card CUTS), then the * routine GUPARA is called and tracking of the particle is abandoned. This * mechanism is provided for applying parametrization schemes which * replace a particle by a parametrized shower when it falls below * a certain threshold. * *............................................................................. * * * *** GXINT: Interactive version * ========================== * * New menu FORTRAN: CALL,FILE,CLOSE,FORTRAN * New menu HISTOGRAM: FILE,LIST,PLOT,DELETE,LEGO,HRIN,HROUT,PUT,GET * ZONE,SET,OPTION,NULL * New menu PICTURE: FILE,LIST,DELETE,SCRATCH,PLOT,RENAME,IZOUT,IZIN,IGSET * New menu SCAN: PHI,THETA,SLIST,VERTEX,SFACTORS,LSCAN,HSCAN * New menu PHYSICS: ANNI,BREM,COMP,DCAY,DRAY,HADR,LOSS,MULS,MUNU,PAIR, * PFIS,PHOT,RAYL,CUTS,PHYSI * * The menus FORTRAN,HISTOGRAM and PICTURE are subsets of the similar * menus in the PAW system. * * The menu PHYSICS gives the possibility to modify the run conditions. * In case physics conditions are changed (LOSS,DRAY,MULS,CUTS) it is * mandatory to call the command PHYSI (which calls GPHYSI) to recompute * the cross-section and/or energy loss tables. * * The menu FORTRAN is similar to the FORTRAN menu of PAW. It contains * in addition a new very important command FORTRAN which gives the * possibility to describe the geometry (UGEOM) in a Fortran routine * that can be edited interactively with the local editor and also * executed interactively under the control of the Fortran interpreter * COMIS. * * *** GEANT >FORTRAN FNAME * * The routines in the file FNAME will be compiled by COMIS. * If routines with names: UGEOM,GUKINE,GUOUT,UGLAST are found, * then they will be automatically called by GXINT instead of * the routines with the same names compiled with the standard * Fortran compiler and linked with the application. * The user callable routines from the GEANT library as well as * routines from PACKLIB (HBOOK,HPLOT,HIGZ,ZEBRA) may be called * from these user routines. All GEANT common blocks may be * referenced. * In case where the routine UGEOM is called several times, * it is important to DROP all the initialisation data structures * JVOLUM,JMATE,JTMED,etc already in memory by using the routine GIDROP. * * Example of an interactive session where the routine UGEOM is modified: * * GEANT > Edit ugeom.for * GEANT > Fortran ugeom.for * GEANT > Call GIDROP * GEANT > Call UGEOM * GEANT > Dtree * GEANT > Edit ugeom.for * GEANT > Fortran ugeom.for * GEANT > Call GIDROP * GEANT > Call UGEOM * GEANT > Dtree * * If FNAME='-', calls to user routines is reset and standard * routines called instead. * * *** Interface to CG * The command DOPT has a new option HIDE (DOPT HIDE ON/OFF) * Type DOPT without parameters to get the list of all currently * available options. * When this option is ON, the subsequent graphics commands DCUT/DRAW * will invoke the CG system for hidden line/surface removal. * This algorithm requires a lot of memory and time. It is recommended * to set the visibility attributes (SATT SEEN 0) for many of the * volumes in case the command aborts for lake of memory or time. * This option can also be used with the view banks mechanism (DOPEN) * * New command CBOX to specify the boundaries of the cutting box. * * *** PLMAT * * The existing command PLMAT offers the new possibility to plot * various physics parameters (cross-sections, energy-loss tables,etc) * in graphics format (via HPLOT) if MECAN=ALLG * The Keywords 'STEP' or 'RANG' may also be specified to produce * an alphanumeric output of the step-size and energy-range tables. * * PLMAT IMATE IPART MECAN [ IDM ] * * IMATE I 'Material number' * IPART I 'Particle number' * MECAN C 'Mechanism' * IDM I 'ID mode option' D=0 * * * *** New menu SCAN. The SCAN geometry * ================================ * * This new menu contains various commands for an interactive interface * to the SCAN geometry * The SCAN geometry algorithm has been designed as a tool to improve * the tracking speed. This new facility still requires substantial * developments in view of the new parametrisation algorithms which * are developed in collaboration between the CN/AS group and the * LEP/HERA/LHC/SSC and other interested groups. * The SCAN facility is being introduced in the version 3.14 on a trial * basis to familiarise potential users with the concept. * The SCAN geometry data structure JSCAN is automatically generated * either by calling the GSCAN routine in the PATCH,GSCAN of GEANG * or interactively by using the commands in the new menu SCAN. * Starting from the normal geometry data structure created by GSVOLU, * GSPOS,GSDVN,etc, the detector may be divided into a simpler geometry * structure (theta,phi) or (eta,phi). * Geantinos are tracked starting from a VERTEX position through * the NPHI,NTETA divisions. For each division, the SCAN procedure * will insert into the JSCAN data structure the following information * for every main detector component specified in the SLIST command * in the spherical R direction: * Total number of radiation lengths up to entry in each R * Total number of absorption lenghts * Detector identifier * When the interactive command TRIGGER is entered, the number of * Geantinos specified as parameter will be tracked. In case the * data structure JSCAN is not empty, the program will automatically * start with the first PHI,TETA division not yet filled. As the * number of Geantinos to be tracked can be very large (depending * on the granularity) this gives the possibility to fill the JSCAN * data structures in several passes. * * * New menu SCAN: PHI,TETA,SLIST,VERTEX,SFACTORS,LSCAN,HSCAN * * ==> /SCAN/PHI NPHI [ PHIMIN PHIMAX ] * * NPHI I 'Number of PHI divisions' D=90 * PHIMIN R 'Minimum PHI in degrees' D=0 * PHIMAX R 'Maximum PHI in degrees' D=360 * * To specify number of divisions along PHI. * * * ==> /SCAN/TETA NTETA TETMIN TETMAX [ DIVTYP ] * * NTETA I 'Number of TETA divisions' D=90 * TETMIN R 'Minimum value of TETA' D=0 * TETMAX R 'Maximum value of TETA' D=180 * DIVTYP I 'Type of TETA division' D=1 R=1:2 * * To specify number of divisions along TETA. * If DIVTYP=1 divisions in degrees following the THETA angle. * If DIVTYP=2 divisions in pseudo-rapidity ETA. * * * ==> /SCAN/SLIST LIST * * LIST C 'List of master volumes' * * Only boundary crossings of volumes given in LIST * will be seen in the SCAN geometry. * * * ==> /SCAN/VERTEX VX VY VZ * * VX R 'Scan vertex origin' D=0 * VY R 'Scan vertex origin' D=0 * VZ R 'Scan vertex origin' D=0 * * All Geantinos tracked will start from position VX,VY,VZ. * * * ==> /SCAN/SFACTORS FACTX0 FACTL FACTR * * FACTX0 R 'Scale factor for SX0' D=100 * FACTL R 'Scale factor for SL' D=1000 * FACTR R 'Scale factor for R' D=100 * * Set scale factors for SX0,SL and R. The given scale factors must be * such that: * * SX0*FACTX0 < 2**15-1 (32767) * SL*FACTL < 2**10-1 (1023) * SR*FACTR < 2**17-1 (131071) * * * ==> /SCAN/LSCAN ID [ VOLUME CHOPT ] * * ID I 'Lego plot identifier' D=2000 * VOLUME C 'Volume name' D='XXXX' * CHOPT C 'List of options' D='OPX' R=' ,O,P,I,X,L' * * Generates and plot a table of physics quantities such as * the total number of radiation lengths or interaction lengths * in function of the SCAN parameters TETA,PHI. * * CHOPT='O' table is generated at Exit of VOLUME. * CHOPT='I' table is generated at Entry of VOLUME. * CHOPT='X' radiation lengths * CHOPT='L' Interaction lengths * CHOPT='P' Plot the table * * If VOLUME='XXXX' Mother volume is used. * * * ==> /SCAN/HSCAN IDPHI [ VOLUME CHOPT ] * * IDPHI I 'Histogram/phi identifier' D=1000 * VOLUME C 'Volume name' D='XXXX' * CHOPT C 'List of options' D='OPX' R=' ,O,P,I,X,L' * * Generates and plot an histogram of physics quantities such as * the total number of radiation lengths or interaction lengths * in function of the SCAN parameter TETA for a given value of PHI. * * CHOPT='O' histogram is generated at Exit of VOLUME. * CHOPT='I' histogram is generated at Entry of VOLUME. * CHOPT='X' radiation lengths * CHOPT='L' Interaction lengths * CHOPT='P' Plot the histogram * * If VOLUME='XXXX' Mother volume is used. * The histogram identifier IDPHI is used to also identify which * PHI division to plot. IPHI=MOD(IDPHI,1000). * If IPHI=0, then all PHI divisions are generated (not plotted) * with histogram identifiers IDPHI+PHI division number. * * * * * * * *** New commands FILE,REND,MDIR,CDIR,IN,OUT in the RZ menu. * ======================================================= * * * ==> RZ/FILE LUN FNAME [ CHOPT ] * * LUN I 'Logical unit number' * FNAME C 'File name' * CHOPT C 'Options' D=' ' R=' ,U,N,I,O' * * Open a GEANT/RZ file. Call GRFILE (See below). * * CHOPT=' ' readonly mode * CHOPT='U' update mode * CHOPT='N' create new file * CHOPT='I' Read all structures from existing file * CHOPT='O' Write all structures on file * * * ==> RZ/OUT OBJECT [ IDVERS ] * * OBJECT C 'Structure name' * IDVERS I 'Version number' D=1 * * Write data structure identified by OBJECT,IDVERS to RZ file. * Call GROUT (See below) * * MATE write JMATE structure * TMED write JTMED structure * VOLU write JVOLUM structure * ROTM write JROTM structure * SETS write JSET structure * PART write JPART structure * SCAN write JSCAN structure * * write all structures * * ==> RZ/IN OBJECT [ IDVERS ] * * OBJECT C 'Structure name' * IDVERS I 'Version number' D=1 * * Read data structure identified by OBJECT,IDVERS into memory. * Call GRIN (See below) * * MATE read JMATE structure * TMED read JTMED structure * VOLU read JVOLUM structure * ROTM read JROTM structure * SETS read JSET structure * PART read JPART structure * SCAN read JSCAN structure * * read all structures * * * * * *** New routines for direct access I/O in the GIOPA package * ======================================================= * * ==> SUBROUTINE GRFILE(LUN,CHFILE,CHOPT) *. *. Routine to open a GEANT/RZ data base. *. *. LUN logical unit number associated to the file *. *. CHFILE RZ file name *. *. CHOPT is a character string which may be *. 'N' To create a new file *. 'U' to open an existing file for update *. ' ' to open an existing file for read only *. 'Q' The initial allocation (default 1000 records) *. is given in IQUEST(10) *. 'I' Read all data structures from file to memory *. 'O' Write all data structures from memory to file *. *. Note: *. If options 'I' or 'O' all data structures are read or *. written from/to file and the file is closed. *. See routine GRMDIR to create subdirectories *. See routines GROUT,GRIN to write,read objects *. *. *. *. ==> SUBROUTINE GROUT(CHOBJ,IDVERS,CHOPT) *. *. Routine to write GEANT object(s) in the RZ file *. at the Current Working Directory (See RZCDIR) *. Input is taken from the data structures in memory *. (VOLU,ROTM,TMED,MATE,SETS,PART,SCAN) *. *. CHOBJ The type of object to be written: *. MATE write JMATE structure *. TMED write JTMED structure *. VOLU write JVOLUM structure *. ROTM write JROTM structure *. SETS write JSET structure *. PART write JPART structure *. SCAN write LSCAN structure *. INIT write all initialisation structures *. *. IDVERS is a positive integer which specifies the version *. number of the object(s). *. *. CHOPT List of options (none for the time being) *. *. Note that if the cross-sections and energy loss tables *. are available in the data structure JMATE, then they are *. saved on the data base. *. *. *. The data structures saved by this routine can be retrieved *. with the routine GRIN. *. *. Before calling this routine a RZ data base must have been *. created using GRFILE. *. The data base must be closed with RZEND. *. Ex: if LUN=1 CALL RZEND('LUN1') *. *. The RZ data base can be transported between different *. machines in using the ZEBRA RZ utility RZTOFZ. *. *. The interactive version of GEANT provides facilities *. to interactively update, create and display objects. *. *. Example. *. *. CALL GRFILE(1,'Geometry.dat','N') *. CALL GROUT('VOLU',1,' ') *. CALL GROUT('MATE',1,' ') *. CALL GROUT('TMED',1,' ') *. CALL GROUT('ROTM',1,' ') *. CALL GROUT('PART',1,' ') *. CALL GROUT('SCAN',1,' ') *. CALL GROUT('SETS',1,' ') *. *. The same result can be achieved by: *. CALL GRFILE(1,'Geometry.dat','NO') *. *. *. *. ==> SUBROUTINE GRIN(CHOBJ,IDVERS,CHOPT) *. *. Routine to read GEANT object(s) fromin the RZ file *. at the Current Working Directory (See RZCDIR) *. The data structures from disk are read in memory *. (VOLU,ROTM,TMED,MATE,SETS,PART,SCAN) *. *. CHOBJ The type of object to be read: *. MATE read JMATE structure *. TMED read JTMED structure *. VOLU read JVOLUM structure *. ROTM read JROTM structure *. SETS read JSET structure *. PART read JPART structure *. SCAN read LSCAN structure *. INIT read all initialisation structures *. *. IDVERS is a positive integer which specifies the version *. number of the object(s). *. *. CHOPT List of options (none for the time being) *. *. *. The RZ data base has been created via GRFILE/GROUT *. *. *. Example. *. *. CALL GRFILE(1,'Geometry.dat',' ') *. CALL GRIN ('VOLU',1,' ') *. CALL GRIN ('MATE',1,' ') *. CALL GRIN ('TMED',1,' ') *. CALL GRIN ('ROTM',1,' ') *. CALL GRIN ('PART',1,' ') *. CALL GRIN ('SCAN',1,' ') *. CALL GRIN ('SETS',1,' ') *. *. The same result can be achieved by: *. CALL GRFILE(1,'Geometry.dat','I') *. *. *. * ==> SUBROUTINE GRMDIR(CHDIR,CHOPT) *. *. *. Routine to create a subdirectory *. *. CHDIR Subdirectory name *. *. CHOPT is a character string which may be *. ' ' To create a subdirectory *. 'S' To create a subdirectory and set the new *. Current Directory to this directory. *. *. +DECK,V_313. *CMZ : 3.15/01 20/11/90 19.41.24 by Federico Carminati *-- Author : * *::> VERSION 3.13/05 890628 15.01 * * Changes in GTELEC,GTHADR and GTMUON for overstopping tracks. * STEP and SLENG correction optimized * In COMMON/GCDRAW/ variable IGVIEW changed to IDVIEW * Routine GTRMUL recoded * DOUBLE precision in GINTCO and protection added. * Changes in GNOPG6. * Changes in GINME (for spheres,tubes and cones DPP.LE.0) * GDINIT called by GXINT * Particle data table updated in GPART * Tests on boundary conditions for IEKBIN modified in GTGAMA * A new user callable routine GBIRK introduced in GPHYS. * GBIRK may be called from GUSTEP to compute the Birk * correction factors for anorganic scintillators. * *::> VERSION 3.13/04 890623 12.34 * * New version of GLANDZ and GPOISS by L.Urban * GRNDM calling sequence changed * Sequence numbers (1-->215) can be initialized * with data card RNDM * Ex: * RNDM 9876 1234534 initializes sequence 1 * RNDM 45 initilizes sequence 45 with the starting * seed of sequence 45 * New routine GRANOR (copy of RANNOR for GRNDM) * *::> VERSION 3.13/03 890425 12.09 * * Update of inline documentation DOCGBASE,DOCGKINE,DOCGTRAK * Deck GGCLOS modified and moved from GGEOM to GBASE * New deck GHCLOS (called by GGCLOS) in GBASE * Deck GEVKEV moved from GTRAK to GCONS * New decks GFNDIG,GFNHIT,GRHITS in GHITS * Minor bug corrected in GTELEC * Control of debug and removal of SNXT=BIG in GTNEXT * Call to GUSTEP removed from GUVIEW * *::> VERSION 3.13/02 890311 10.45 * * Bug corrected in GPAIRM (COMMON/GCMATE/ overwritten * Bug corrected in outines GDRELM and GDRELP * (error in AVO changed to AVOGAD) * Minor corrections in physics routines * SAVE statements added * Protection in GHANGL * Default changed to GHEISHA instead of TATINA * in routines GUPHAD and GUHADR * Bug corrected in GHTATI (NAMEC(12) instead of NAMEC(10) * +PATCH,*GEANT +DECK,BLANKDEK. *CMZ : 3.15/09 04/04/92 17.14.14 by Federico Carminati *-- Author : +USE,GCDES. +USE,GBASE. +USE,GCONS. +USE,GHITS. +USE,GIOPA. +USE,GKINE. +USE,GPHYS. +USE,GTRAK. +USE,GUSER. +USE, SINGLE, IF=CDC, CRAY. +USE, UNIX, IF=SUN, SGI, DECS, CONVEX, IBMRT, AIX370. +USE, UNIX, IF=HPUX, APOLLO, IPSC +USE, IBMALL, IF=IBM, IBMMVS, AIX370. +USE, DOUBLE, IF=APOLLO, IBMALL, VAX. +USE, DOUBLE, IF=UNIX, IF=-SINGLE. +USE, BSLASH, IF=SUN, SGI, DECS, IBMRT, IPSC. +PATCH,*GEANTOP +DECK,BLANKDEK. *CMZ : 3.15/01 19/09/91 17.31.57 by Federico Carminati *-- Author : +USE,P=GCDES +USE,P=GHCDES +USE,P=GBASE,D=GRUN. +USE,P=GBASE,D=GTRIG. +USE,P=GPHYS,D=GDECAY. +USE,P=GTRAK,D=GFTRAC. +USE,P=GTRAK,D=GLTRAC. +USE,P=GTRAK,D=GSSTAK. +USE,P=GTRAK,D=GHELIX. +USE,P=GTRAK,D=GSKING. +USE,P=GTRAK,D=GRKUTA. +USE,P=GTRAK,D=GTGAMA. +USE,P=GTRAK,D=GTELEC. +USE,P=GTRAK,D=GTHADR. +USE,P=GTRAK,D=GTNEUT. +USE,P=GTRAK,D=GTMUON. +USE,P=GTRAK,D=GTNINO. +USE,P=GTRAK,D=GTRACK. +USE,P=GTRAK,D=GTREVE. +USE,P=GTRAK,D=GTVOL. +USE,P=GTRAK,D=GINVOL. +USE,P=GTRAK,D=GTMEDI. +USE,P=GTRAK,D=GTNEXT. +USE,P=GUSER,D=GUSWIM. +USE,P=GUSER,D=GUTRAK. +USE,P=GUSER,D=GUTREV. +USE,P=GPHYS,D=GDECAY. +USE,P=GGEOM,D=GMEDIA. +USE,P=GIFACE,D=GHEISH. +USE,P=GIFACE,D=GHSTOP. +USE,P=GIFACE,D=GPFIS. +USE,P=GIFACE,D=GMUNU. +USE,SINGLE,IF=CDC,CRAY. +PATCH,GCDES. +DECK,BLANKDEK. *CMZ : 3.15/09 07/04/92 14.40.14 by Federico Carminati *-- Author : +KEEP,GTLINK INTEGER JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT C +KEEP,GCLINK +SEQ, GTLINK, IF=TYPE. COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT C +KEEP,GTBANK INTEGER IQ,LQ,NZEBRA,IXSTOR,IXDIV,IXCONS,LMAIN,LR1,JCG INTEGER KWBANK,KWWORK,IWS REAL GVERSN,ZVERSN,FENDQ,WS,Q C +KEEP,GCBANK +SEQ,GTBANK,IF=TYPE. PARAMETER (KWBANK=69000,KWWORK=5200) COMMON/GCBANK/NZEBRA,GVERSN,ZVERSN,IXSTOR,IXDIV,IXCONS,FENDQ(16) + ,LMAIN,LR1,WS(KWBANK) DIMENSION IQ(2),Q(2),LQ(8000),IWS(2) EQUIVALENCE (Q(1),IQ(1),LQ(9)),(LQ(1),LMAIN),(IWS(1),WS(1)) EQUIVALENCE (JCG,JGSTAT) +SEQ,GCLINK +KEEP,GTCURS INTEGER INTFLA REAL SIZD2,FACHV,HALF,SAVPLX,SAVPLY,YPLT,XPLT * +KEEP,GCCURS +SEQ,GTCURS,IF=TYPE COMMON/GCCURS/INTFLA,SIZD2,FACHV,HALF,SAVPLX,SAVPLY,YPLT,XPLT * +KEEP,GTCUTS REAL CUTGAM,CUTELE,CUTNEU,CUTHAD,CUTMUO,BCUTE,BCUTM + ,DCUTE ,DCUTM ,PPCUTM,TOFMAX,GCUTS C +KEEP,GCCUTS COMMON/GCCUTS/CUTGAM,CUTELE,CUTNEU,CUTHAD,CUTMUO,BCUTE,BCUTM + ,DCUTE ,DCUTM ,PPCUTM,TOFMAX,GCUTS(5) C +SEQ,GTCUTS,IF=TYPE. +KEEP,GTURSB INTEGER NUMNDS,IADDI,NUMND2,NNPAR,IISELT * +KEEP,GCURSB COMMON/GCURSB/NUMNDS,IADDI,NUMND2,NNPAR,IISELT COMMON/GCURSC/MOMO CHARACTER*4 MOMO * +SEQ,GTURSB,IF=TYPE +KEEP,GTFLAG. INTEGER IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN + ,IEOTRI,IEVENT,ISWIT,IFINIT,NEVENT,NRNDM C +KEEP,GCFLAG COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) COMMON/GCFLAX/BATCH, NOLOG LOGICAL BATCH, NOLOG C +SEQ,GTFLAG,IF=TYPE. +KEEP,GTOPTI INTEGER IOPTIM +KEEP,GCOPTI COMMON/GCOPTI/ IOPTIM C +SEQ, GTOPTI, IF=TYPE +KEEP,GCJLOC COMMON/GCJLOC/NJLOC(2),JTM,JMA,JLOSS,JPROB,JMIXT,JPHOT,JANNI + ,JCOMP,JBREM,JPAIR,JDRAY,JPFIS,JMUNU,JRAYL + ,JMULOF,JCOEF,JRANG C INTEGER NJLOC ,JTM,JMA,JLOSS,JPROB,JMIXT,JPHOT,JANNI + ,JCOMP,JBREM,JPAIR,JDRAY,JPFIS,JMUNU,JRAYL + ,JMULOF,JCOEF,JRANG C +KEEP,GTKINE. INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT C +KEEP,GCKINE COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD C +SEQ,GTKINE,IF=TYPE. +KEEP,GCKMAX INTEGER MXGKIN PARAMETER (MXGKIN=100) +KEEP,GCKING +SEQ, GCKMAX COMMON/GCKING/KCASE,NGKINE,GKIN(5,MXGKIN), + TOFD(MXGKIN),IFLGK(MXGKIN) INTEGER KCASE,NGKINE ,IFLGK REAL GKIN,TOFD C +KEEP,GTLIST. INTEGER NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT + ,NSTAT,LHSTA,LGET ,LSAVE,LSETS,LPRIN,LGEOM,LVIEW,LPLOT,LSTAT C +KEEP,GCLIST COMMON/GCLIST/NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT + ,NSTAT,LHSTA(20),LGET (20),LSAVE(20),LSETS(20),LPRIN(20) + ,LGEOM(20),LVIEW(20),LPLOT(20),LSTAT(20) C +SEQ,GTLIST,IF=TYPE. +KEEP,GCMATE COMMON/GCMATE/NMAT,NAMATE(5),A,Z,DENS,RADL,ABSL C INTEGER NMAT,NAMATE REAL A,Z,DENS,RADL,ABSL C +KEEP,GCMULO COMMON/GCMULO/SINMUL(101),COSMUL(101),SQRMUL(101),OMCMOL,CHCMOL + ,EKMIN,EKMAX,NEKBIN,NEK1,EKINV,GEKA,GEKB,EKBIN(200),ELOW(200) C REAL SINMUL,COSMUL,SQRMUL,OMCMOL,CHCMOL,EKMIN,EKMAX,ELOW,EKINV REAL GEKA,GEKB,EKBIN INTEGER NEKBIN,NEK1 C +KEEP,GCMZFO COMMON/GCMZFO/IOMATE,IOPART,IOTMED,IOSEJD,IOSJDD,IOSJDH,IOSTAK + ,IOMZFO(13) C INTEGER IOMATE,IOPART,IOTMED,IOSEJD,IOSJDD,IOSJDH,IOSTAK + ,IOMZFO C +KEEP,GTNUM. INTEGER NMATE ,NVOLUM,NROTM,NTMED,NTMULT,NTRACK,NPART + ,NSTMAX,NVERTX,NHEAD,NBIT ,NALIVE,NTMSTO C +KEEP,GCNUM COMMON/GCNUM/NMATE ,NVOLUM,NROTM,NTMED,NTMULT,NTRACK,NPART + ,NSTMAX,NVERTX,NHEAD,NBIT COMMON /GCNUMX/ NALIVE,NTMSTO C +SEQ,GTNUM,IF=TYPE. +KEEP,GTCONS REAL PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS REAL EMMU,PMASS,AVO C +KEEP,GTCONP,IF=SINGLE. REAL PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS REAL EMMU,PMASS,AVO C +KEEP,GTCONP,IF=-SINGLE. DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS DOUBLE PRECISION EMMU,PMASS,AVO C +KEEP,GCONSP +SEQ,GTCONP PARAMETER (PI=3.14159265358979324) PARAMETER (TWOPI=6.28318530717958648) PARAMETER (PIBY2=1.57079632679489662) PARAMETER (DEGRAD=0.0174532925199432958) PARAMETER (RADDEG=57.2957795130823209) PARAMETER (CLIGHT=29979245800.) PARAMETER (BIG=10000000000.) PARAMETER (EMASS=0.0005109990615) PARAMETER (EMMU=0.105658387) PARAMETER (PMASS=0.9382723128) PARAMETER (AVO=0.60221367) +KEEP,GCONST. +SEQ, GTCONS, IF=TYPE. COMMON/GCONST/PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS COMMON/GCONSX/EMMU,PMASS,AVO C +KEEP,GTPHYS. INTEGER IPAIR,ICOMP,IPHOT,IPFIS,IDRAY,IANNI,IBREM,IHADR,IMUNU + ,IDCAY,ILOSS,IMULS,IRAYL REAL SPAIR,SLPAIR,ZINTPA,STEPPA,SCOMP,SLCOMP,ZINTCO,STEPCO + ,SPHOT,SLPHOT,ZINTPH,STEPPH,SPFIS,SLPFIS,ZINTPF,STEPPF + ,SDRAY,SLDRAY,ZINTDR,STEPDR,SANNI,SLANNI,ZINTAN,STEPAN + ,SBREM,SLBREM,ZINTBR,STEPBR,SHADR,SLHADR,ZINTHA,STEPHA + ,SMUNU,SLMUNU,ZINTMU,STEPMU,SDCAY,SLIFE ,SUMLIF,DPHYS1 + ,SLOSS,SOLOSS,STLOSS,DPHYS2,SMULS,SOMULS,STMULS,DPHYS3 + ,SRAYL,SLRAYL,ZINTRA,STEPRA C +KEEP,GCPHYS COMMON/GCPHYS/IPAIR,SPAIR,SLPAIR,ZINTPA,STEPPA + ,ICOMP,SCOMP,SLCOMP,ZINTCO,STEPCO + ,IPHOT,SPHOT,SLPHOT,ZINTPH,STEPPH + ,IPFIS,SPFIS,SLPFIS,ZINTPF,STEPPF + ,IDRAY,SDRAY,SLDRAY,ZINTDR,STEPDR + ,IANNI,SANNI,SLANNI,ZINTAN,STEPAN + ,IBREM,SBREM,SLBREM,ZINTBR,STEPBR + ,IHADR,SHADR,SLHADR,ZINTHA,STEPHA + ,IMUNU,SMUNU,SLMUNU,ZINTMU,STEPMU + ,IDCAY,SDCAY,SLIFE ,SUMLIF,DPHYS1 + ,ILOSS,SLOSS,SOLOSS,STLOSS,DPHYS2 + ,IMULS,SMULS,SOMULS,STMULS,DPHYS3 + ,IRAYL,SRAYL,SLRAYL,ZINTRA,STEPRA * +SEQ,GTPHYS,IF=TYPE. +KEEP,GTPARM. INTEGER IPARAM,MPSTAK,NSPARA,NPGENE REAL PCUTGA,PCUTEL,PCUTNE,PCUTHA,PCUTMU +KEEP,GCPARM. COMMON/GCPARM/IPARAM,PCUTGA,PCUTEL,PCUTNE,PCUTHA,PCUTMU + ,NSPARA,MPSTAK,NPGENE REAL PACUTS(5) EQUIVALENCE (PACUTS(1),PCUTGA) +SEQ,GTPARM,IF=TYPE. C +KEEP,GCPOLY COMMON/GCPOLY/IZSEC,IPSEC INTEGER IZSEC,IPSEC C +KEEP,GCPUSH COMMON/GCPUSH/NCVERT,NCKINE,NCJXYZ,NPVERT,NPKINE,NPJXYZ INTEGER NCVERT,NCKINE,NCJXYZ,NPVERT,NPKINE,NPJXYZ C +KEEP,GCRZ COMMON/GCRZ1/NRECRZ,NRGET,NRSAVE,LRGET(20),LRSAVE(20) INTEGER NRECRZ,NRGET,NRSAVE,LRGET ,LRSAVE COMMON/GCRZ2/RZTAGS CHARACTER*8 RZTAGS(4) C +KEEP,GTSETS. INTEGER IHSET,IHDET,ISET,IDET,IDTYPE,NVNAME,NUMBV C +KEEP,GCSETS. COMMON/GCSETS/IHSET,IHDET,ISET,IDET,IDTYPE,NVNAME,NUMBV(20) C +SEQ,GTSETS,IF=TYPE. +KEEP,GTSTAK. INTEGER NJTMAX,NJTMIN,NTSTKP,NTSTKS,NDBOOK,NDPUSH,NJFREE,NJGARB, + NJINVO,LINSAV,LMXSAV,NWSTAK,NWINT,NWREAL,NWTRAC +KEEP,GCSHNO. PARAMETER ( NSBOX=1, NSTRD1=2, NSTRD2=3, NSTRAP=4, NSTUBE=5, + NSTUBS=6, NSCONE=7, NSCONS=8, NSSPHE=9, NSPARA=10,NSPGON=11, + NSPCON=12,NSELTU=13,NSHYPE=14,NSGTRA=28, NSCTUB=29 ) +KEEP,GCSTAK. +SEQ,GTSTAK,IF=TYPE. PARAMETER (NWSTAK=12,NWINT=11,NWREAL=12,NWTRAC=NWINT+NWREAL+5) COMMON /GCSTAK/ NJTMAX, NJTMIN, NTSTKP, NTSTKS, NDBOOK, NDPUSH, + NJFREE, NJGARB, NJINVO, LINSAV(15), LMXSAV(15) C +KEEP,GCTATI COMMON/GCTATI/NSEC,KIND(30),EN(30),PL(30),PT(30),THETA(30),PHI(30) INTEGER NSEC,KIND REAL EN,PL,PT,THETA,PHI C +KEEP,GCTIME COMMON/GCTIME/TIMINT,TIMEND,ITIME,IGDATE,IGTIME INTEGER ITIME,IGDATE,IGTIME REAL TIMINT,TIMEND C +KEEP,GTHIL2. INTEGER LARETT,JTICK,JMYLL,JFIMOT,JFISCA,JFINAM, + JAASS1,JAASS2,JAASS3,JAASS4, + JTICKS,JMYLLS,JMYMOT +KEEP,GCHIL2. +SEQ, GTHIL2, IF=TYPE COMMON/GCHIL2/LARETT(2),JTICK,JMYLL,JFIMOT,JFISCA,JFINAM, + JAASS1,JAASS2, + JAASS3,JAASS4,JTICKS,JMYLLS,JMYMOT * +KEEP,GTTMED. INTEGER NUMED,NATMED,ISVOL,IFIELD,IUPD,ISTPAR,NUMOLD REAL FIELDM,TMAXFD,STEMAX,DEEMAX,EPSIL,STMIN,CFIELD,PREC C +KEEP,GCTMED COMMON/GCTMED/NUMED,NATMED(5),ISVOL,IFIELD,FIELDM,TMAXFD,STEMAX + ,DEEMAX,EPSIL,STMIN,CFIELD,PREC,IUPD,ISTPAR,NUMOLD C +SEQ,GTTMED,IF=TYPE. +KEEP,GTTRAK. INTEGER NMEC,LMEC,NAMEC,NSTEP ,MAXNST,IGNEXT,INWVOL,ISTOP,MAXMEC + ,IGAUTO,IEKBIN,ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN,NLVSAV,ISTORY REAL VECT,GETOT,GEKIN,VOUT,DESTEP,DESTEL,SAFETY,SLENG ,STEP + ,SNEXT,SFIELD,TOFG ,GEKRAT,UPWGHT +KEEP,GCTRAK +SEQ,GTTRAK,IF=TYPE. PARAMETER (MAXMEC=30) COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(MAXMEC) + ,NAMEC(MAXMEC),NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG + ,STEP ,SNEXT ,SFIELD,TOFG ,GEKRAT,UPWGHT,IGNEXT,INWVOL + ,ISTOP ,IGAUTO,IEKBIN, ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN + ,NLVSAV,ISTORY C +KEEP,GCUNIT COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5) INTEGER LIN,LOUT,NUNITS,LUNITS COMMON/GCMAIL/CHMAIL CHARACTER*132 CHMAIL C +KEEP,GTVOLU. INTEGER NLEVEL,NAMES,NUMBER,LVOLUM,LINDEX,INFROM,NLEVMX, + NLDEV,LINMX REAL GTRAN,GRMAT,GONLY,GLX +KEEP,GCVOLU COMMON/GCVOLU/NLEVEL,NAMES(15),NUMBER(15), +LVOLUM(15),LINDEX(15),INFROM,NLEVMX,NLDEV(15),LINMX(15), +GTRAN(3,15),GRMAT(10,15),GONLY(15),GLX(3) C +SEQ,GTVOLU,IF=TYPE. +KEEP,GCVOL2 COMMON/GCVOL2/NLEVE2,NAMES2(15),NUMB2(15), +LVOL2(15),LIND2(15),INFRO2,NLDEV2(15),LINMX2(15), +GTRAN2(3,15),GRMAT2(10,15),GONLY2(15),GLX2(15) INTEGER NLEVE2,NAMES2,NUMB2,LVOL2,LIND2,INFRO2,NLDEV2,LINMX2 REAL GTRAN2,GRMAT2,GONLY2,GLX2 C +KEEP,GTDRAW. INTEGER NUMNOD,MAXNOD,NUMND1,LEVVER,LEVHOR,MAXV,IPICK, + MLEVV,MLEVH,NWCUT,JNAM,JMOT,JXON,JBRO,JDUP,JSCA,JDVM,JPSM, + JNAM1,JMOT1,JXON1,JBRO1,JDUP1,JSCA1,JULEV,JVLEV, + LOOKTB,IDRNUM,NGVIEW,ICUTFL,ICUT,NSURF,ISURF,LINATT,LINATP, + ITXATT,ITHRZ,IPRJ,ITR3D,IPKHIT,IOBJ,LINBUF, + MAXGU,MORGU,MAXGS,MORGS,MAXTU,MORTU,MAXTS,MORTS, + IGU,IGS,ITU,ITS,NKVIEW,IDVIEW, + NOPEN,IGMR,IPIONS,ITRKOP,IHIDEN REAL GRMAT0,GTRAN0,GSIN,GCOS,SINPSI,COSPSI,GTHETA,GPHI,GPSI, + GU0,GV0,GSCU,GSCV,CTHETA,CPHI,DCUT,GZUA,GZVA,GZUB,GZVB,GZUC, + GZVC,PLTRNX,PLTRNY,DPERS,DDUMMY +KEEP,GCDRAW COMMON/GCDRAW/NUMNOD,MAXNOD,NUMND1,LEVVER,LEVHOR,MAXV,IPICK, + MLEVV,MLEVH,NWCUT,JNAM,JMOT,JXON,JBRO,JDUP,JSCA,JDVM,JPSM, + JNAM1,JMOT1,JXON1,JBRO1,JDUP1,JSCA1,JULEV,JVLEV, + LOOKTB(16), + GRMAT0(10),GTRAN0(3),IDRNUM,GSIN(41),GCOS(41),SINPSI,COSPSI, + GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV,NGVIEW, + ICUTFL,ICUT,CTHETA,CPHI,DCUT,NSURF,ISURF, + GZUA,GZVA,GZUB,GZVB,GZUC,GZVC,PLTRNX,PLTRNY, + LINATT,LINATP,ITXATT,ITHRZ,IPRJ,DPERS,ITR3D,IPKHIT,IOBJ,LINBUF, + MAXGU,MORGU,MAXGS,MORGS,MAXTU,MORTU,MAXTS,MORTS, + IGU,IGS,ITU,ITS,NKVIEW,IDVIEW, + NOPEN,IGMR,IPIONS,ITRKOP,IHIDEN, + DDUMMY(18) C +SEQ,GTDRAW,IF=TYPE. +KEEP,GSECTI COMMON/GSECTI/ AIEL(20),AIIN(20),AIFI(20),AICA(20),ALAM,K0FLAG INTEGER K0FLAG REAL AIEL,AIIN,AIFI,AICA,ALAM C +KEEP,GCGOBJ PARAMETER (NTRCG=1) PARAMETER (NWB=207,NWREV=100,NWS=1500) PARAMETER (C2TOC1=7.7, C3TOC1=2.,TVLIM=1296.) COMMON /GCGOBJ/IST,IFCG,ILCG,NTCUR,NFILT,NTNEX,KCGST + ,NCGVOL,IVFUN,IVCLOS,IFACST,NCLAS1,NCLAS2,NCLAS3 COMMON /CGBLIM/IHOLE,CGXMIN,CGXMAX,CGYMIN,CGYMAX,CGZMIN,CGZMAX C +KEEP,GTSCAN INTEGER MSLIST,NPHI,IPHIMI,IPHIMA,IPHI1,IPHIL,NTETA,MODTET,NSLMAX, + MAXMDT,NSLIST,ISLIST,IPHI,ITETA,ISCUR REAL PHIMIN,PHIMAX,TETMIN,TETMAX,VSCAN,FACTX0,FACTL, + FACTR,SX0,SABS,TETMID,TETMAD + ,SX0S,SX0T,SABSS,SABST,FACTSF + ,DLTPHI,DLTETA,DPHIM1,DTETM1 + ,FCX0M1,FCLLM1,FCRRM1 +KEEP,GCSCAN +SEQ,GTSCAN, IF=TYPE PARAMETER (MSLIST=32,MAXMDT=3) COMMON/GCSCAN/SCANFL,NPHI,PHIMIN,PHIMAX,NTETA,TETMIN,TETMAX, + MODTET,IPHIMI,IPHIMA,IPHI1,IPHIL,NSLMAX, + NSLIST,ISLIST(MSLIST),VSCAN(3),FACTX0,FACTL, + FACTR,IPHI,ITETA,ISCUR,SX0,SABS,TETMID(MAXMDT), + TETMAD(MAXMDT) + ,SX0S,SX0T,SABSS,SABST,FACTSF + ,DLTPHI,DLTETA,DPHIM1,DTETM1 + ,FCX0M1,FCLLM1,FCRRM1 LOGICAL SCANFL COMMON/GCSCAC/SFIN,SFOUT CHARACTER*80 SFIN,SFOUT * +KEEP,GTSCAL. INTEGER MXSLNK, ISLINK, LSLAST, LSCAN, LSTEMP, LSPARA, LSERAY * +KEEP,GCSCAL. +SEQ,GTSCAL, IF=TYPE PARAMETER(MXSLNK=100) COMMON/GCSCAL/ ISLINK(MXSLNK) EQUIVALENCE (LSLAST,ISLINK(MXSLNK)) EQUIVALENCE (LSCAN ,ISLINK(1)),(LSTEMP,ISLINK(2)) EQUIVALENCE (LSPARA,ISLINK(3)),(LSERAY,ISLINK(4)) * +KEEP,GTPARA. INTEGER BITPHI, BITTET, BITPOT LOGICAL SYMPHI, SYMTEU, SYMTED +KEEP,GCPARA. +SEQ,GTPARA. PARAMETER (LSTACK = 5000) C BITPOT is for Phi.Or.Tet C C --------------------------------------------------------- COMMON /GCPARA/ + EPSIX0 (LSTACK) , + IDRPHI (LSTACK ) , IDRTET (LSTACK ), + IDROUT (LSTACK ) , JPLOST (LSTACK ), + IPHTMP (LSTACK ) , + BITPHI (LSTACK ) , BITTET (LSTACK ), + BITPOT (LSTACK ) , JJLOST, JJFILL, + JENTRY, JEMPTY, + EPSMAX, + JJTEMP, JJWORK , JJSTK1, + J1TEMP, J1STK1, + IFOUNP, IFOUNT , IFNPOT, + SYMPHI, + SYMTEU, SYMTED C +KEEP,GTJUMP INTEGER JUDCAY, JUDIGI, JUDTIM, JUFLD , JUHADR, JUIGET, + JUINME, JUINTI, JUKINE, JUNEAR, JUOUT , JUPHAD, + JUSKIP, JUSTEP, JUSWIM, JUTRAK, JUTREV, JUVIEW, + JUPARA INTEGER JMPADR, MAXJMP * +KEEP,GCJUMP +SEQ ,GTJUMP, IF=TYPE PARAMETER (MAXJMP=30) COMMON/GCJUMP/JUDCAY, JUDIGI, JUDTIM, JUFLD , JUHADR, JUIGET, + JUINME, JUINTI, JUKINE, JUNEAR, JUOUT , JUPHAD, + JUSKIP, JUSTEP, JUSWIM, JUTRAK, JUTREV, JUVIEW, + JUPARA DIMENSION JMPADR(MAXJMP) EQUIVALENCE (JMPADR(1), JUDCAY) * +KEEP,GCOMIS COMMON/GCOMIS/ICOMIS,JUINIT,JUGEOM,JUKINE,JUSTEP,JUOUT,JULAST * +KEEP,GCXLUN COMMON/GCXLUN/LUNIT(128) * +KEEP,GTMUTR * INTEGER NCVOLS,NSHIFT,KSHIFT,ICUBE,NAIN,JJJ,NIET,IVOOLD, + IWPOIN,IHPOIN,IVECVO,IOLDSU,ICGP,IPORNT REAL GXMIN,GXMAX,GYMIN,GYMAX,GZMIN,GZMAX,GXXXX,GYYYY,GZZZZ REAL CLIPMI,CLIPMA,ABCD,BMIN,BMAX,CGB,CGB1,GBOOM REAL PORGX,PORGY,PORGZ,POX,POY,POZ,PORMIR,PORMAR +KEEP,GCMUTR +SEQ, GTMUTR, IF=TYPE * PARAMETER (MULTRA=50) CHARACTER*4 GNASH, GNNVV, GNVNV COMMON/GCMUTR/NCVOLS,KSHIFT,NSHIFT,ICUBE,NAIN,JJJ, + NIET,IOLDSU,IVOOLD,IWPOIN,IHPOIN,IVECVO(100), + PORGX,PORGY,PORGZ,POX(15),POY(15),POZ(15),GBOOM, + PORMIR(18),PORMAR(18),IPORNT, + ICGP,CLIPMI(6),CLIPMA(6), + ABCD(4),BMIN(6),BMAX(6),CGB(16000),CGB1(16000), + GXMIN(MULTRA),GXMAX(MULTRA),GYMIN(MULTRA), + GYMAX(MULTRA),GZMIN(MULTRA),GZMAX(MULTRA), + GXXXX(MULTRA),GYYYY(MULTRA),GZZZZ(MULTRA) * COMMON/GCMUTC/ GNASH(MULTRA),GNNVV(MULTRA),GNVNV(MULTRA) * +KEEP,GTHILN. INTEGER LARECG,JCGOBJ,JCGCOL,JCOUNT,JCLIPS,IMPOIN,IMCOUN, + JSIX,JSIY,JSIZ,JPXC,JPYC,JPZC,ICLIP1,ICLIP2 +KEEP,GCHILN. +SEQ, GTHILN, IF=TYPE COMMON/GCHILN/LARECG(2), JCGOBJ, JCGCOL, JCOUNT, JCLIPS, + IMPOIN, IMCOUN, JSIX, JSIY, JSIZ, + JPXC, JPYC, JPZC, ICLIP1, ICLIP2 * +KEEP,GTSPEE * REAL S1,S2,S3,SS1,SS2,SS3,SRAGMX,SRAGMN, + RAINT1,RAINT2,RMIN1,RMIN2,RMAX1,RMAX2 INTEGER ISCOP,NTIM,NTFLAG,IOLDCU,ITSTCU,ISUBLI,IPORLI INTEGER LPASS,JPORJJ,LEP,JSC * +KEEP,GCSPEE. +SEQ, GTSPEE, IF=TYPE COMMON/GCSPEE/S1,S2,S3,SS1,SS2,SS3,LEP,IPORLI,ISUBLI, + SRAGMX,SRAGMN,RAINT1,RAINT2,RMIN1,RMIN2, + RMAX1,RMAX2,JPORJJ,ITSTCU,IOLDCU,ISCOP, + NTIM,NTFLAG,LPASS,JSC * +KEEP, LUJETS COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) INTEGER N,K REAL P,V SAVE /LUJETS/ * +KEEP, LUDAT1 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) INTEGER MSTU,MSTJ REAL PARU,PARJ SAVE /LUDAT1/ * +KEEP, LUDAT3 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) INTEGER MDCY,MDME,KFDP REAL BRAT SAVE /LUDAT3/ * +KEEP,GCLUND COMMON/GCLUND/IFLUND,ECLUND INTEGER IFLUND REAL ECLUND C +KEEP,PAWCT INTEGER NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKUIP,IFENCE,LLMAIN,IQQ,LQQ REAL WWS,QQ +KEEP,PAWC +SEQ,PAWCT,IF=TYPE. COMMON /PAWC/ NWPAW,IXPAWC,IHBOOK,IXHIGZ,IXKUIP,IFENCE(5), + LLMAIN, WWS(9989) DIMENSION IQQ(2),QQ(2),LQQ(8000) EQUIVALENCE (QQ(1),IQQ(1),LQQ(9)),(LQQ(1),LLMAIN) C +PATCH,GBASE +DECK,DOCGBASE,IF=DOC *CMZ : 3.15/09 08/04/92 12.25.09 by Federico Carminati *-- Author : Federico Carminati * ************************************************************************ * * * * * Introduction to GEANT3 * * ---------------------- * * * * * * GEANT3 APPLICATIONS * * * * The principal applications of GEANT3 are: * * * * - The tracking of particles through an experimental setup for * * acceptance studies or simulation of detector response, and * * - the graphical representation of the setup and of the particle * * trajectories. * * * * It is of course desirable and very instructive to combine the two * * interactively since the observation of what happens to a particle * * during the tracking may underline the weaknesses of the setup and * * makes the debugging easier. In view of these applications, the * * GEANT3 system allows: * * * * - to describe an experimental setup in a rather efficient and * * simple way. The setup is represented by a structure of * * geometrical VOLUMEs. Each volume is given a 'MEDIUM' number by * * the user. Different volumes may have the same medium number * * [GEOM]. A medium is defined by a set of parameters, the * * so-called TRACKING MEDIUM parameters, which include reference to * * the MATERIAL filling the volume [CONS]. * * - to generate simulated events from standard Monte Carlo * * generators [KINE]. * * - to control the transport of particles through the various * * regions of the setup, taking into account the geometrical volume * * boundaries and all physical effects due to the nature of the * * particles themselves, to their interactions with the matter and * * to the magnetic field [TRAK, PHYS]. * * - to record the elements of the particle trajectories and the * * response from the sensitive detectors [HITS], * * - to visualize either interactively or in batch the detectors and * * the particle trajectories [DRAW, XINT]. * * * * Part of the subroutines available in GEANT3 are integrated into * * program segments which perform these tasks. * * The program segments may contain 'dummy' and 'default' user * * subroutines called whenever application dependent actions are * * expected. * * Other subroutines provide tools either to perform simple * * functions (control print, debug, I/O, etc.) or to implement the * * operations required for most of the applications (description of * * the geometrical setup, handling of detector responses,etc.). * * It is the responsibility of the user to assemble the appropriate * * program segments and tools into an executable program, to code the * * relevant user subroutines, to provide the data describing the * * experimental environment and to submit the appropriate data cards * * which control the execution of the program. The section BASE of * * the User's Guide gives the information necessary to understand how * * to do this job. * * * * Note: as a general convention the names of the dummy or default * * user subroutines have GU or UG as first two letters and are * * printed in bold characters. * * * * EVENT SIMULATION FRAMEWORK * * * * The framework for event simulation is described in the following * * paragraphs to familiarize the reader with the areas where user * * interventions are expected. * * At the same time, the GEANT3 data structures are introduced. * * This last point is important as the coding to be provided by the * * user often consists of filling data structures, or extracting * * information from them, or saving them on output, making use of * * standard routines available in the system. * * A main program has to be provided by the user [BASE 100]. It * * allocates the dynamic memory for ZEBRA and HBOOK and gives control * * to the three phases of the run: * * * * - Initialisation * * - Event processing * * - Termination. * * * * INITIALISATION * * * * The initialisation phase is under the control of the user [BASE * * 100]. It consists of the following steps, most of them performed * * via calls to standard GEANT3 subroutines: * * * * - GINIT, to initialize the GEANT3 common blocks with default * * values which the user should be aware of [BASE 030, 110]. * * - GFFGO to read 'free format' data cards which can override some * * of the values defined in GINIT the default options [BASE 040, * * 110]. * * - GZINIT to initialize the dynamic core divisions, the link areas * * and the data structure JRUNG [BASE 110]. * * - GDINIT to initialize the drawing package [DRAW]. * * - GPART and auxiliaries, to generate the data structure JPART * * describing the standard particle properties [CONS]. * * - GMATE and auxiliaries, to generate the data structure JMATE * * describing the characteristics of the most commonly used * * MATERIALs [CONS]. * * - to define the geometry of the different components of the * * experimental setup [GEOM] and the tracking medium parameters * * [CONS,TRAK], and to generate the corresponding data structures * * JROTM, JVOLUM and JTMED. * * - to specify which elements of the geometrical setup should * * be considered as 'sensitive detectors', giving a 'response' when * * hit by a particle [HITS]. * * - GGCLOS to close the Geometry package (mandatory). * * - GBHSTA to book standard GEANT3 histograms as required by the * * user with the data card HSTA [BASE 040, 110]. * * - GPHYSI to compute energy loss and cross section tables and to * * store them in the data structure JMATE [CONS,PHYS]. * * * * EVENT PROCESSING * * * * The processing phase is triggered by a call to the subroutine GRUN * * which, for each event to be processed, gives control to the * * subroutines: * * * * - GTRIGI, to initialize the event processing and to create the * * Header bank JHEAD. * * - GTRIG to process the event. * * - GTRIGC to clean up the event division * * * * and checks that enough time is left for the next event [BASE 200]. * * The main steps of GTRIG consist of calls to the following user * * routines: * * * * - GUKINE generates the data structures JVERTX and JKINE describing * * the kinematics of the current event on input [KINE], or reads * * them [IOPA]. * * - GUTREV (calls GTREVE) controls the tracking for the whole event * * [TRAK]. Each particle is tracked in turn and when a sensitive * * detector is hit, the user may store any useful information in * * the data structure JHITS [HITS]. Before tracking the next * * particle, any secondary products generated by the current one, * * and stored by the user in the temporary data structure JSTAK, * * are processed in the same way. * * Simultaneously, the data structure JXYZ, containing the * * coordinates of space points along the tracks for the whole * * event, can be filled by the user [TRAK]. * * - GUDIGI simulates the detector responses for the whole event, * * making use of the information previously recorded in the data * * structure JHITS, and stores the results in the data structure * * JDIGI [HITS]. * * - GUOUT outputs the relevant data structures for the current event * * [IOPA]. * * * * Other user routines called during the tracking phase triggered by * * GTREVE should be mentioned for completeness: * * * * - The hadronic processes activated by default for the tracking of * * hadrons in GEANT3 are described by the program GHEISHA (file * * GEANH). In the subroutines GUPHAD and GUHADR [TRAK] the user * * may select, instead of GHEISHA, the program FLUKA (file GEANF). * * - After each tracking step of a given track in a given medium, * * control is given to the subroutine GUSTEP. From the information * * available in common blocks the user is able to take the * * appropriate action, such as storing a hit or transferring a * * secondary product either in the stack JSTAK or in the events * * structure JVERTX/JKINE. * * - The subroutine GUSWIM is called by various tracking routines to * * select the appropriate code for transport of the particle over * * the given tracking step. A default version is provided in the * * library for this routine which in normal cases need not to be * * provided by the user. * * - The magnetic field, unless constant with no X- or Y-component, * * has to be returned by the user subroutine GUFLD. * * * * TERMINATION * * * * The termination phase is under the control of the user [BASE * * 300]. For trivial applications it may simply consist of a call to * * the subroutine GLAST which computes and prints some statistical * * information (time per event, use of dynamic memory, etc.). * * * * * ************************************************************************ * * * * * Simplified Program Flow Chart * * ----------------------------- * * * * MAIN(user) * * | * * |-GZEBRA initialisation of ZEBRA system, dynamic core * * | allocation * * |-UGINIT (user) * * || * * ||- GINIT initialisation of GEANT3 variables * * ||- GFFGO interpretation of data cards * * ||- GZINIT initialisation of ZEBRA core divisions and link * * || areas * * ||- GPART creation of the 'particle' data structure JPART * * ||- GMATE creation of the 'material' data structure JMATE * * ||- description of the geometrical setup, of the * * || sensitive detectors and creation of data structures * * || JVOLUM, JTMED, JROTM, JSETS * * ||- GGCLOS close Geometry package * * ||- GPHYSI preparation of cross-sections and energy loss tables * * | for all used materials * * | * * |-GRUN (loop over events) * * || * * ||- GTRIGI initialisation for event processing * * ||- GTRIG event processing * * || | * * || |- GUKINE (user) generation (or input) of event initial * * || | kinematics * * || |- GUTREV (user) * * || | |- GTREVE (simplified flow for sequential tracking) * * || | |- GSSTAK store primary tracks in stack * * || | |- Loop over tracks * * || | |- GLTRAC prepare commons for tracking * * || | |- GMEDIA find current volume /tracking medium * * || | |- GUTRAK (user) * * || | |- GTRACK * * || | |- GTGAMA/GTELEC/... tracking of particle * * || | according to type * * || | |- compute physical step size * * || | |- GTNEXT compute geometrical step size * * || | |- propagate (GUSWIM..) * * || | |- test change of volume (GINVOL) * * || | |- GUSTEP (user) recording of hits in data * * || | structure JHITS and of space points * * || | in structure JXYZ * * || |- GUDIGI computation of digitisations and recording in * * || | structure JDIGI * * || |- GUOUT output of current event * * || * * ||- GTRIGC clearing of memory for next event * * | * * |-UGLAST (user) * * || * * ||- GLAST standard GEANT3 termination. * * | * * | * * STOP * * * * * ************************************************************************ ************************************************************************ * * * Overview of COMMON Blocks * * ------------------------- * * * * * * INTRODUCTION * * * * The communication between program segments of the GEANT3 system is * * ensured by data structures and by 'long range' variables in common * * blocks. In addition,within the program segments, the subroutines * * communicate with each other via explicit arguments and via the * * common block variables. * * The data structures are described in separate sections. Here, the * * main features of the common blocks used in GEANT3 are summarized, * * with special mention of the variables initialized in GINIT and of * * the possibility to override them via data cards [BASE040]. * * The labelled common blocks are accessible via Patchy/CMZ * * sequences identified by the name of the COMMON. They are defined * * in the Patch GCDES. * * * * Note: Unless otherwise specified the long range variables are * * initialized in GINIT. When not zero, default values are * * quoted between brackets. If the value may be modified via a * * standard data card the card keyword is also given between * * brackets. * * * * DYNAMIC CORE * * * * The GEANT3 data structures are stored in the common /GCBANK/ * * accessible via the following Patchy sequence. * * * *+KEEP,GCBANK * * PARAMETER (KWBANK=69000,KWWORK=5200) * * COMMON/GCBANK/NZEBRA,GVERSN,ZVERSN,IXSTOR,IXDIV,IXCONS,FENDQ(16) * * + ,LMAIN,LR1,WS(KWBANK) * * DIMENSION IQ(2),Q(2),LQ(8000),IWS(2) * * EQUIVALENCE (Q(1),IQ(1),LQ(9)),(LQ(1),LMAIN),(IWS(1),WS(1)) * * EQUIVALENCE (JCG,JGSTAT) * * COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART * * + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX * * + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT * * * * The /GCLINK/ variables are pointers to the GEANT3 data structures. * * They belong to a permanent area declared in GZINIT. The common * * /GCLINK/ alone may be accessed through the sequence GCLINK. * * * * OTHER LABELLED COMMON BLOCKS * * * * COMMON/GCCUTS/CUTGAM,CUTELE,CUTNEU,CUTHAD,CUTMUO,BCUTE,BCUTM) * * + ,DCUTE ,DCUTM ,PPCUTM,TOFMAX,GCUTS(5) * * C * * CUTGAM Kinetic energy cut for gammas (0.001, CUTS) * * CUTELE Kinetic energy cut for electrons (0.001, CUTS) * * CUTHAD Kinetic energy cut for hadrons (0.01, CUTS) * * CUTNEU Kinetic energy cut for neutral hadrons (0.01, CUTS) * * CUTMUO Kinetic energy cut for muons (0.01, CUTS) * * BCUTE Kinetic energy cut for electron Brems. (CUTGAM, CUTS) * * BCUTM Kinetic energy cut for muon Brems. (CUTGAM, CUTS) * * DCUTE Kinetic energy cut for electron delta-rays (CUTELE, CUTS) * * DCUTM Kinetic energy cut for muon delta-rays (CUTELE, CUTS) * * PPCUTM Kinetic energy cut for e+e- pair production by muons * * (.01, CUTS) * * TOFMAX Tracking cut on time of flight integrated from primary * * interaction time (1.E+10, CUTS) * * GCUTS For user applications (CUTS) * * * * Note: The cuts BCUTE, BCUTM and DCUTE, DCUTM are given, in GPHYSI, * * the respective default values CUTGAM and CUTELE. Only * * experienced users should make use of the facility offered by * * the data card CUTS to change BCUTE, DCUTE, BCUTM and DCUTM. * * * * COMMON /GCDRAW/ ..... * * see GEANG Pam file * * * * COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN * * + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) * * COMMON/GCFLAX/BATCH, NOLOG * * LOGICAL BATCH, NOLOG * * C * * IDEBUG Flag set equal to 1 to activate debug if IEVENT (below) * * IDEMIN is greater or equal to IDEMIN * * IDEMAX and less or equal to IDEMAX (DEBU) * * ITEST Flag to request printing of IEVENT, IDEVT and NRNDM * * (below) every ITEST events (DEBU) * * IDRUN Current user run number (1, RUN) * * IDEVT Current user event number (RUN) * * IEORUN Flag to terminate current run if non zero * * IEOTRI Flag to abort current event if non zero * * IEVENT Current event sequence number (1) * * ISWIT Flags reserved for user in relation to debug (SWIT) * * IFINIT System flags to check initialisation of GEANT routines * * NEVENT Number of events to be processed (10000000,TRIG) * * NRNDM Initial value of random number seeds NRNDM(1), * * NRNDM(2). If NRNDM(2) is 0, the independent sequence * * NRNDM(1) is used. If NRNDM(1) is 0, the default sequence * * is used. (9876, 54321, RNDM) * * BATCH Flag set to .TRUE. if the program is running in * * batch. * * NOLOG Flag set to .TRUE. if the no logon file has been * * requested. * * * * COMMON/GCJLOC/NJLOC(2),JTM,JMA,JLOSS,JPROB,JMIXT,JPHOT,JANNI * * + ,JCOMP,JBREM,JPAIR,JDRAY,JPFIS,JMUNU,JRAYL * * + ,JMULOF,JCOEF,JRANG * * C * * For relocation of local pointers. Self-explanatory [CONS 199]. * * * * COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP * * + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD * * C * * IKINE User flag(0, KINE) * * PKINE User array(1E10, KINE) * * ITRA Current track number * * ISTAK Current stack-track number * * IVERT Current vertex number * * IPART Current particle number * * ITRTYP Tracking type of current particle * * NAPART Name of current particle * * AMASS Mass of current particle * * CHARGE Charge of current particle * * TLIFE Life-time of current particle * * VERT Coordinates of origin vertex for current track * * PVERT Track kinematics at origin vertex (PVERT(4) no longer * * used) * * IPAOLD Particle number of the previous track. * * * * INTEGER MXGKIN * * PARAMETER (MXGKIN=100) * * COMMON/GCKING/KCASE,NGKINE,GKIN(5,MXGKIN), * * + TOFD(MXGKIN),IFLGK(MXGKIN) * * KCASE Mechanism having generated the secondary particles * * NGKINE Number of generated secondaries * * GKIN(1,I) Px of I-th secondary * * GKIN(2,I) Py " " * * GKIN(3,I) Pz " " * * GKIN(4,I) E " " * * GKIN(5,I) Particle number " " * * TOFD(I) Time delay introduced by the interaction. * * * * COMMON/GCLIST/NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT * * + ,NSTAT,LHSTA(20),LGET (20),LSAVE(20),LSETS(20),LPRIN(20) * * + ,LGEOM(20),LVIEW(20),LPLOT(20),LSTAT(20) * *C * * NHSTA Number of histograms declared on data card HSTA * * NGET Number of data structures declared on data card GET * * NSAVE Number of data structures declared on data card SAVE * * NSETS Number of items described on data card SETS * * NPRIN Number of items described on data card PRIN * * NGEOM Number of items described on data card GEOM * * NVIEW Number of items described on data card VIEW * * NPLOT Number of items described on data card PLOT * * NSTAT Number of items described on data card STAT * * LHSTA,...,LSTAT Corresponding user lists of items (HSTA,...,STAT) * * * * See examples of utilisation of the user lists in GEANT3 examples * * in GEANX file. LSTAT(1) is reserved by the system for volume * * statistics. * * * * COMMON/GCMATE/NMAT,NAMATE(5),A,Z,DENS,RADL,ABSL * * C * * NMAT Current material number * * NAMATE Name of current material * * A Atomic weight of current material * * Z Atomic number of current material * * DENS Density of current material * * RADL Radiation length of current material * * ABSL Absorption length of current material * * * * COMMON/GCMULO/SINMUL(101),COSMUL(101),SQRMUL(101),OMCMOL,CHCMOL * * + ,EKMIN,EKMAX,NEKBIN,NEK1,EKINV,GEKA,GEKB,EKBIN(200),ELOW(200) * * * * Pre-computed quantities for multiple scattering and energy * * binning [CONS 199] * * SINMUL Not used * * COSMUL Not used * * SQRMUL Not used * * OMCMOL Constant Omega for Moliere scattering * * CHCMOL Constant for Moliere scattering * * EKMIN Lower edge for the energy range (1E-5, ERAN) * * EKMAX Upper edge for the energy range (1E+4, ERAN) * * NEKBIN Number of energy bins to be used (90, ERAN) * * NEK1 Number of energy bins to be used + 1 * * EKINV \ * * GEKA >Constants for the energy binning * * GEKB / * * EKBIN Lower edges of energy bins * * ELOW Lower edges of logarithm of energy bins * * * * COMMON/GCNUM/NMATE ,NVOLUM,NROTM,NTMED,NTMULT,NTRACK,NPART * * + ,NSTMAX,NVERTX,NHEAD,NBIT * * COMMON /GCNUMX/ NALIVE,NTMSTO * * C * * NMATE Number of Materials * * NVOLUM Number of Volumes * * NROTM Number of Rotation matrices * * NTMED Number of Tracking media * * NTMULT Number of tracks processed in current event (including * * secondaries), reset to 0 for each event * * NTRACK Number of tracks in JKINE banks for current event * * NPART Number of Particle banks * * NSTMAX Maximum number of tracks in stack JSTAK for current * * event, reset to 0 for each event * * NVERTX Number of Vertices in JVERTX banks for current event * * NHEAD Number of data words in the JHEAD bank (10) * * NBIT Number of bits per word (initialized in GINIT via FFINIT * * NALIVE Internal counter used for parallel tracking * * NTMSTO Internal counter used for parallel tracking * * * **KEEP,GCONSP * * DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS * * DOUBLE PRECISION EMMU,PMASS,AVO * *C * * PARAMETER (PI=3.14159265358979324) * * PARAMETER (TWOPI=6.28318530717958648) * * PARAMETER (PIBY2=1.57079632679489662) * * PARAMETER (DEGRAD=0.0174532925199432958) * * PARAMETER (RADDEG=57.2957795130823209) * * PARAMETER (CLIGHT=29979245800.) * * PARAMETER (BIG=10000000000.) * * PARAMETER (EMASS=0.0005109990615) * * PARAMETER (EMMU=0.105658387) * * PARAMETER (PMASS=0.9382723128) * * PARAMETER (AVO=0.60221367) * * * * PI Number PI * * TWOPI (2.*PI) * * PIBY2 (PI/2.) * * DEGRAD Degree to radian conversion factor (PI/180.) * * RADDEG Radian to degree conversion factor (180./PI) * * CLIGHT Light velocity * * BIG Arbitrary large number * * EMASS Electron mass * * EMMU Muon mass * * PMASS Proton mass * * AVO Avogadro Number * 1E-24 * * * * Control of Geometry optimisation * * COMMON/GCOPTI/IOPTIM * * IOPTIM -1 = No optimisation at all. GSORD calls disabled * * 0 = No optimisation. Only user calls to GSORD kept * * 1 = All non-ordered volumes are ordered along the best axis* * 2 = All volumes are ordered along the best axis * * * * Control of physics processes. * * COMMON/GCPHYS/IPAIR,SPAIR,SLPAIR,ZINTPA,STEPPA * * + ,ICOMP,SCOMP,SLCOMP,ZINTCO,STEPCO * * + ,IPHOT,SPHOT,SLPHOT,ZINTPH,STEPPH * * + ,IPFIS,SPFIS,SLPFIS,ZINTPF,STEPPF * * + ,IDRAY,SDRAY,SLDRAY,ZINTDR,STEPDR * * + ,IANNI,SANNI,SLANNI,ZINTAN,STEPAN * * + ,IBREM,SBREM,SLBREM,ZINTBR,STEPBR * * + ,IHADR,SHADR,SLHADR,ZINTHA,STEPHA * * + ,IMUNU,SMUNU,SLMUNU,ZINTMU,STEPMU * * + ,IDCAY,SDCAY,SLIFE ,SUMLIF,DPHYS1 * * + ,ILOSS,SLOSS,SOLOSS,STLOSS,DPHYS2 * * + ,IMULS,SMULS,SOMULS,STMULS,DPHYS3 * * + ,IRAYL,SRAYL,SLRAYL,ZINTRA,STEPRA * * * * * IPAIR Controls pair production process (1,PAIR) * * 0 = no pair production * * 1 = pair production with generation of secondaries * * 2 = same without generation of secondaries * * ICOMP Controls Compton scattering process (1,COMP) * * 0 = no Compton scattering * * 1 = Compton scattering with generation of secondaries * * 2 = same without generation of secondaries * * IPHOT Controls photo-electric effect process (1,PHOT) * * 0 = no photo-electric effect * * 1 = photo-electric effect with generation of secondaries * * 2 = same without generation of secondaries * * IPFIS Controls photofission process (0,PFIS) * * 0 = no photofission * * 1 = photofission with generation of secondaries * * 2 = same without generation of secondaries * * IDRAY Controls delta rays process (1,DRAY) * * 0 = no delta rays effect * * 1 = delta rays with generation of secondaries * * 2 = same without generation of secondaries * * IANNI Controls positron annihilation process (1,ANNI) * * 0 = no positron annihilation effect * * 1 = positron annihilation with generation of secondaries * * 2 = same without generation of secondaries * * IBREM Controls Bremsstrahlung process (1,BREM) * * 0 = no Bremsstrahlung effect * * 1 = Bremsstrahlung with generation of secondaries * * 2 = same without generation of secondaries * * IHADR Controls hadron interactions process (1,HADR) * * 0 = no hadron interactions effect * * 1 = hadron interactions with generation of secondaries * * 2 = same without generation of secondaries * * 3 = in case GHEISHA is used, the NUCRIN/HADRIN package is * * called for hadrons below 5 GeV * * IMUNU Controls muon nuclear interaction process (0,MUNU) * * 0 = no muon nuclear interaction effect * * 1 = muon nuclear interaction with generation of secondaries* * 2 = same without generation of secondaries * * IDCAY Controls decay process (1,DCAY) * * 0 = no decay effect * * 1 = decay with generation of secondaries * * 2 = same without generation of secondaries * * ILOSS Controls energy loss process (2,LOSS) * * 0 = no energy loss effect * * 1 = delta ray and reduced Landau fluctuations * * 2 = full Landau fluctuations and no delta rays * * 3 = same as 1 * * 4 = average Energy loss and no fluctuations * * IMULS Controls multiple scattering (1,MULS) * * 1 = Moliere or Coulomb scattering * * 2 = Moliere or Coulomb scattering * * 3 = Gaussian scattering * * IRAYL 0 = No Rayleigh scattering * * 1 = Rayleigh scattering * * * * COMMON/GCPOLY/IZSEC,IPSEC * * C * * Internal flags for polygon and polycone shapes. See GEANG file. * * * * COMMON/GCPUSH/NCVERT,NCKINE,NCJXYZ,NPVERT,NPKINE,NPJXYZ * * C * * NCVERT Initial size of mother bank JVERTX (5) * * NCKINE Initial size of mother bank JKINE (50) * * NCJXYZ Initial size of mother bank JXYZ (50) * * NPVERT Increment for size of mother bank JVERTX (5) * * NPKINE Increment for size of mother bank JKINE (10) * * NPJXYZ Increment for size of mother bank JXYZ (10) * * * * COMMON/GCSETS/IHSET,IHDET,ISET,IDET,IDTYPE,NVNAME,NUMBV(20) * * C * * IHSET Set identifier * * IHDET Detector identifier * * ISET Position of set in bank JSET * * IDET Position of detector in bank JS=IB(JSET-IDET) * * IDTYPE User defined detector type * * NVNAME Number of elements in NUMBV * * NUMBV List of volume numbers to identify the detector * * * * PARAMETER (NWSTAK=12,NWINT=11,NWREAL=12,NWTRAC=NWINT+NWREAL+5) * * COMMON /GCSTAK/ NJTMAX, NJTMIN, NTSTKP, NTSTKS, NDBOOK, NDPUSH, * * + NJFREE, NJGARB, NJINVO, LINSAV(15), LMXSAV(15) * *C * * NTKSTP Primary allocation for stack JSTAK * * NTKSTS Secondary allocation for stack JSTAK * * NDBOOK local variable for control of stack size * * NDPUSH local variable for control of stack size * * (other variables used in parallel tracking only) * * * * COMMON/GCTIME/TIMINT,TIMEND,ITIME,IGDATE,IGTIME * * INTEGER ITIME,IGDATE,IGTIME * * REAL TIMINT,TIMEND * * C * * TIMINT Total time left after initialization (System, TIME) * * TIMEND Time required for program termination phase (1., TIME) * * ITIME Test on time left done every ITIME events (1, ITIME) * * IGDATE Date of the day YYMMDD integer (e.g. 920407) * * IGTIME Time of the day HHMM integer (e.g. 1425) * * * * COMMON/GCTMED/NUMED,NATMED(5),ISVOL,IFIELD,FIELDM,TMAXFD,STEMAX * * + ,DEEMAX,EPSIL,STMIN,CFIELD,PREC,IUPD,ISTPAR,NUMOLD * * NUMED Current tracking medium number * * NATMED Name of current tracking medium * * ISVOL Sensitive volume flag (if non zero) * * IFIELD Field map type (0 if no field) * * FIELDM Maximum field * * TMAXFD Maximum field turning angle in one step * * STEMAX Maximum step allowed * * DEEMAX Maximum energy loss gradient in one step * * EPSIL Boundary crossing accuracy * * STMIN Minimum step size by energy loss, multiple scattering * * or field * * CFIELD Constant for field step evaluation * * PREC Initial step for boundary crossing (0.1*EPSIL) * * IUDP 0 If medium change, (1 otherwise) * * ISTPAR 0 If standard tracking parameters * * NUMOLD Numed of the last medium. * * * * PARAMETER (MAXMEC=30) * * COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(MAXMEC) * * + ,NAMEC(MAXMEC),NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG * * + ,STEP ,SNEXT ,SFIELD,TOFG ,GEKRAT,UPWGHT,IGNEXT,INWVOL * * + ,ISTOP ,IGAUTO,IEKBIN, ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN * * + ,NLVSAV,ISTORY * * VECT Current track parameters (X,Y,Z,Px/P,Py/P,Pz/P,P) * * GETOT Current track total energy * * GEKIN Current track kinetic energy * * VOUT Local use * * NMEC Number of mechanisms for current step * * LMEC List of mechanism indices for current step * * NAMEC Mechanism names (See below) * * NSTEP Number of steps so far * * MAXNST Maximum number of steps allowed (default = 10000) * * DESTEP Total energy lost in current step * * DESTEL Continuous energy loss in current step * * SAFETY Overestimated distance to closest medium boundary * * SLENG Track length at current point * * STEP Size of current tracking step * * SNEXT Straight distance to next current medium boundary * * SFIELD Field turning angle step size evaluation * * TOFG Time of flight * * GEKRAT Interpolation factor in table ELOW * * UPWGHT User particle weight * * IGNEXT Flag set to 1 when SNEXT has been recomputed * * INWVOL Flag set to 1 when entering a new volume, * * 2 when leaving a volume and * * 3 when leaving the experimental setup. * * 0 otherwise 0 * * ISTOP Flag set to 1 when track looses its identity * * 2 when energy below cut * * IGAUTO Automatic computation of DEEMAX,STMIN,TMAXFD,STEMAX * * IEKBIN Current kinetic energy bin in table ELOW * * ILOSL Local value of ILOSS for current tracking medium * * IMULL Local value of IMULS for current tracking medium * * INGOTO Content number of limiting content when computing SNEXT * * NLDOWN Lowest level reached down the tree (parallel tracking only)* * NLEVIN Number of levels currently filled and valid in /GCVOLU/ * * NLVSAV Current level (parallel tracking only) * * ISTORY User flag for current track history (reset to 0 in GLTRAC) * * -------- * * NAMEC List of possible mechanisms for step size limitation * * filled in GINIT : * * DATA MEC/'NEXT','MULS','LOSS','FIEL','DCAY','PAIR','COMP','PHOT' * * + ,'BREM','DRAY','ANNI','HADR','ECOH','EVAP','FISS','ABSO' * * + ,'ANNH','CAPT','EINC','INHE','MUNU','TOFM','PFIS','SCUT' * * + ,'RAYL','PARA','PRED','LOOP','NULL','STOP'/ * * * * * * * COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5) * * INTEGER LIN,LOUT,NUNITS,LUNITS * * COMMON/GCMAIL/CHMAIL * * CHARACTER*132 CHMAIL * * C * * LIN Input unit to read data cards * * LOUT Line printer output unit * * NUNITS Number of additional units * * LUNITS List of additional units. * * CHMAIL Internal string used for error messages * * LIN and LOUT are defined in GINIT through calls to the routine * * FFGET from the standard FFREAD package. NUNITS and LUNITS are * * reserved for user applications. * * * * COMMON /GCVOLU/ ...... * * see GEANG Pam file * * * * * * * ************************************************************************ * * * Summary of Data Cards * * --------------------- * * * * * * INTRODUCTION * * * * GEANT3 uses the standard FFREAD package to read 'free format' data * * cards in the routine GFFGO. The cards currently interpreted by * * GFFGO can be classified into four categories: * * * * - General control of the run. * * - Control of the physics processes. * * - Debug and I/O operations. * * - User applications. * * * * The data cards are listed below by category with the following * * information: * * * * - KEY, card keyword, any number of characters truncated to the * * first 4 * * - N, maximum expected number of variables NVAR, * * - T, TYPE of these variables (I=INTEGER, R=REAL or M=MIXED) * * * * for each variable in turn: * * * * - VAR.., FORTRAN name * * - Short description (more detail in BASE 030) * * - COMMON where it is stored, and * * - Default value from GINIT. * * * * When a card is decoded, the values entered by the user without * * explicit assignment are assigned to the variables in order. The * * number of values can be less than NVAR. In case of a MIXED type * * the values entered have to be in agreement with the default of the * * corresponding FORTRAN variable names. * * * * Example of data card: RUN 5 201 * * * * to preset the current run and event number to 5 and 201 * * respectively. * * In batch jobs there is no need for any special termination card * * and none of the cards mentioned below is mandatory. * * * * USER DEFINED DATA CARDS * * * * Before calling GFFGO the user may define private data cards * * through calls to FFKEY as follows: * * CALL FFKEY('KEY',VAR(1),NVAR,'TYPE') * * They will be interpreted by GFFGO in the same way as the standard * * cards. * * * * SUMMARY OF THE MOST IMPORTANT GEANT3 DATA CARDS * * * * KEY N T VAR.. Short description COMMON GINIT * * General control of the run: * * HSTA 20 M LHSTA Names of required histograms GCLIST 0 * * PATR 4 I NJTMAX Max number of tracks in parallel GCSTAK 0 * * tracking stack * * NJTMIN Number of tracks above which " 0 * * parallel tracking can be * * reactivated when frozen earlier * * NTSTKP Primary allocation for stack JSTAK " 500 * * NTSTKS Secondary ... (when parallel " 100 * * tracking used) * * RNDM 2 I NRNDM Initial random number seeds * * NRNDM(1) GCFLAG 9876 * * NRNDM(2) GCFLAG 54321 * * RNDM 2 I NRNDM Initial random number seeds GCFLAG 0 * * RUNG 2 I IDRUN User run number GCFLAG 1 * * IDEVT User event number GCFLAG 1 * * TIME 3 M TIMINT Time left after initialisation GCTIME System * * TIMEND Time required for termination GCTIME 1. * * ITIME Test every ITIME events GCTIME 1 * * TRIG 1 I NEVENT Number of events to process GCFLAG 1E7 * * Geometry optimization: * * OPTI 1 I IOPTIM Optimization level GCOPTI 1 * * SCAN process control: * * SCAN 8 M SCAN granularity and mode * * SCANFL Scan processing flag (Logical) GCSCAN FALSE * * NPHI Number of divisions in PHI GCSCAN 90 * * PHIMIN Minimum value of PHI GCSCAN 0. * * PHIMAX Maximum value of PHI GCSCAN 360. * * NTETA Number of divisions in TETA GCSCAN 90 * * TETMIN Minimum value of TETA GCSCAN 0. * * TETMAX Maximum value of TETA GCSCAN 180. * * MODTET Type of TETA division GCSCAN 1 * * SCAL 32 M SLIST List of scanned volumes GCSCAN 'XXXX' * * SCAP 6 R SCAN parameters * * VX SCAN vertex X coordinate GCSCAN 0.0 * * VY SCAN vertex Y coordinate GCSCAN 0.0 * * VZ SCAN vertex Z coordinate GCSCAN 0.0 * * FACTX0 Scale factor for SX0 GCSCAN 100. * * FACTL Scale factor for SL GCSCAN 1000. * * FACTR Scale factor for R GCSCAN 100. * * Control of physics processes: * * AUTO 1 I IGAUTO Automatic computation of STMIN GCTRAK 1 * * STEMAX,DEEMAX,TMAXFD * * 0 = Tracking media parameters * * taken from the argument list * * of GSTMED * * 1 = Tracking media parameters * * calculated by GEANT * * ANNI 1 I IANNI Annihilation flag GCPHYS 1 * * BREM 1 I IBREM Bremsstrahlung flag GCPHYS 1 * * COMP 1 I ICOMP Compton scattering flag GCPHYS 1 * * CUTS 15 R Kinetic energy cuts : * * CUTGAM " " for gammas GCCUTS 0.001 * * CUTELE " " for electrons GCCUTS 0.001 * * CUTHAD " " for charged hadrons GCCUTS 0.01 * * CUTNEU " " for neutral hadrons GCCUTS 0.01 * * CUTMUO " " for muons GCCUTS 0.01 * * BCUTE " " for electron brems. GCCUTS CUTGAM * * BCUTM " " for muon Brems. GCCUTS CUTGAM * * DCUTE " " for electron delta-rays GCCUTS CUTELE * * DCUTM " " for muon delta-rays CCUTS CUTELE * * PPCUTM " " for e+e- pairs by muons CCUTS 10 MeV * * TOFMAX Time of flight cut GCCUTS 1.E+10 * * GCUTS 5 user words GCCUTS 0. * * DCAY 1 I IDCAY Decay flag GCPHYS 1 * * DRAY 1 I IDRAY delta-rays flag GCPHYS 1 * * ERAN 3 M Cross section tables * * R EKMIN Minimum energy for the tables GCMULO 1E-5 * * R EKMAX Maximum energy for the tables GCMULO 1E+4 * * I NEKBIN Number of bins in the table GCMULO 90 * * HADR 1 I IHADR Hadronic process flag GCPHYS 1 * * LOSS 1 I ILOSS Energy loss flag CGPHYS 2 * * MULS 1 I IMULS Multiple scattering flag GCPHYS 1 * * MUNU 1 I IMUNU Muon nuclear interactions flag GCPHYS 0 * * PAIR 1 I IPAIR Pair production flag GCPHYS 1 * * PFIS 1 I IPFIS Photofission flag GCPHYS 0 * * PHOT 1 I IPHOT Photo-electric effect flag GCPHYS 1 * * RAYL 1 I IRAYL Rayleigh scattering flag GCPHYS 0 * * * * Debug and I/O operations: * * DEBU 3 M IDEMIN First event to debug GCFLAG 0 * * IDEMAX Last event to debug GCFLAG 0 * * ITEST Print control frequency GCFLAG 0 * * GET 20 M LGET Names of data structure to get GCLIST ' ' * * PRIN 20 M LPRIN User keywords to print data GCLIST ' ' * * structures * * SAVE 20 M LSAVE Names of data struct. to save GCLIST ' ' * * SWIT 10 I ISWIT User flags for debug or else GCFLAG 0 * * User applications: * * KINE 11 M IKINE User flag GCKINE 0 * * PKINE 10 user words GCKINE 1.E+10 * * SETS 20 M LSETS User words for detector sets GCLIST ' ' * * STAT 20 M LSTAT 1 system + 19 user words GCLIST ' ' * * PLOT 20 M LPLOT User words to control plots GCLIST ' ' * * GEOM 20 M LGEOM User words to control geometry GCLIST ' ' * * VIEW 20 M LVIEW User words to control View banks GCLIST ' ' * * * * * * * * * * * * * ************************************************************************ * * * The Reference Systems and dimensional Units * * ------------------------------------------- * * * * * * THE MASTER REFERENCE SYSTEM (MARS) * * * * The Master Reference System (MARS) is determined by the way the * * user represents the kinematical quantities. If the axes are * * labelled (X,Y,Z), then the point P(A,B,C) is represented by * * * * Y | * * | * P(A,B,C) * * | * X A on axis X * * | * B on axis Y * * | * C on axis Z * * | * * * | * * * | * * * | * * * | * * * | * * | * * ............................> * * Z * * The tracking is performed in the MAster Reference System. This * * implies that the arguments of the user magnetic field routine, * * space point coordinates and field components, are given in this * * system. * * * * THE LOCAL REFERENCE SYSTEMS (MRS AND DRS) * * * * As explained in GEOM 001, the experimental set-up is described by * * the definition of an 'initial MOTHER' volume inside which * * 'DAUGHTER' volumes are positioned. Other daughter volumes can be * * positioned inside these volumes which are promoted as mother * * volumes and so on, as russian dolls. * * This requires the definition of local reference systems, the * * Mother Reference Systems (MRS, Origin O.) and the Daughter * * Reference Systems (DRS, Origin O.). * * The local reference system of the 'initial mother' volume * * coincides with the MAster Reference System. * * The full description of a given detector is usually given in the * * local reference system of the associated volume. * * The transformation of a point from the MRS (V.) to the DRS (V.), * * at any level, requires the knowledge of a rotation matrix R and a * * translation vector T defined through the relation : * * ( V. ) = [ R ] ( V. - T ) * * The components of T are the projections of the vector O.O. onto * * the MRS axes. * * The rotation matrices are computed from the spherical angles of * * each of the axes of the daughter reference system (I, II, III) * * with respect to the mother reference system (1,2,3). * * The spherical angles THETA and PHI of a direction D are defined * * as follows : * * * * THETA is the angle formed by the axis 3 and D (range : 0 to 180 * * degrees) * * PHI is the angle formed by the axis 1 and the projection of D * * onto the plane defined by the axes 1 and 2 (range : 0 to * * 360 degrees) * * Examples are given in GEOM 200. * * The various rotation matrices required for a given set-up must be * * defined during the initialisation stage, usually in the user * * routine UGEOM. * * A serial number is assigned to each matrix [GEOM 200]. * * The translation parameters and the serial number of the rotation * * matrix are specified by the user when the volumes are positioned * * inside the set-up [GEOM 110]. * * * * THE DIMENSIONAL UNITS * * * * Unless otherwise specified, the following units are used * * throughout the program : * * * * - CENTIMETER, SECOND, KILOGAUSS, GEV, GEV/C, DEGREE * * * ************************************************************************ * * * Examples of MAIN Program and User Initialisation * * ------------------------------------------------ * * * * PROGRAM MAIN * * C * * PARAMETER (NG=100000,NH=10000) * * COMMON/PAWC/H(NH) * * COMMON/GCBANK/Q(NG) * * C * * C Allocate memory for ZEBRA and HBOOK * * CALL GZEBRA(NG) * * CALL HLIMIT(-NH) * * C * * C Initialize Graphics package * * CALL IGINIT(0) * * C Open metafile and define workstation type * * C (computer dependent) * * .... * * C * * C Initialisation phase * * CALL UGINIT * * C * * C Processing phase * * CALL GRUN * * C * * C Termination phase * * CALL UGLAST * * C * * END * * SUBROUTINE UGINIT * * C * * +SEQ,GCLIST * * C * * C Initialize GEANT variables * * CALL GINIT * * C * * C Read data cards * * CALL GFFGO * * C * * C Initialize data structures * * CALL GZINIT * * C * * C Initialize drawing package * * CALL GDINIT * * C * * C Open I/O buffers * * IF(NGET .GT.0)CALL GOPEN(1,'I',0,IER) * * IF(NSAVE.GT.0)CALL GOPEN(2,'O',0,IER) * * C * * C Fetch permanent data structures (if any) * * CALL GFIN(1,'INIT',1,IDENT,' ',IER) * * IF(IER.LT.0) THEN * * C * * C Define standard Particle and Material data * * CALL GPART * * CALL GMATE * * C * * C Define the geometrical set-up * * CALL 'user code' * * CALL GGCLOS * * C * * C Compute cross-section and energy loss tables * * CALL GPHYSI * * ENDIF * * C * * C Initialize standard histograms * * CALL GBHSTA * * C * * END * * * * * * * ************************************************************************ * * * The System Initialisation routines * * ---------------------------------- * * * * Presets COMMON block variables to default values. Preprocessing * * of various COMMON block variables. See 'Overview of COMMON * * blocks' [BASE 030]. Reads a set of data cards with the FFREAD * * package. See 'Summary of data cards' [BASE 040] GFFGO should be * * called after GINIT. Allocates the dynamic core divisions. * * Initialize the link areas and the data structure JRUNG [BASE 299]. * * Initialize exotic bank formats. GZINIT should be called after * * GFFGO. To be called before the user geometry routine if the user * * wants to open VIEW banks there. Initializes any standard * * histogram required by the user with the data record HSTA. * * The following histogram keywords may be used : * * TIME Time per event * * SIZE Size of division LXDIV per event * * MULT Total number of tracks per event * * NTRA Number of 'long life' tracks per event * * STAK Maximum stack size per event * * * * GBHSTA should be called after GFFGO. * * * * Steering routines for Event Processing * * -------------------------------------- * * * * The following flow chart is only valid for the 'batch' execution * * mode. For interactive applications, see section XINT. Main * * routine to control a run of events * * ......... * * ...>| TIMEX| * * | ......... * * | Get time left (TIMINT) after * * initialisation * * | * * ............................. * * | ........... | * * ... >| GTRIGI | | * * | ........... | * * | ........... | * * ........ . |.. >| GTRIG | ......... . * * | | | ......... . |loop on | * * | GRUN |... | | | | * * ........ . | ......... . | events | * * |.. >| GTRIGC | ......... . * * | ......... . . * * | ................... | * * ... >| check time left | | * * | ................... | * * ............................. * * * * Resets to 0 the flag IEOTRI in /GCFLAG/ and the counters NTRACK * * and NVERTX in /GCNUM/. Sets the debug flag IDEBUG in /GCFLAG/ to * * the value required for the current event. * * Creates the Header bank for current event. * * Prints the sequence number, the event number and the number * * random generators, under control of the flag ITEST (data card * * DEBU). * * Steering routine to process one event (trigger) * * * * .......................... * * | Generates kinematics, | * * ... >| or read event GUKINE | * * | .......................... * * | ................ * * | | Tracking/hits| * * ........ . |.. >| GUTREV | * * | GTRIG |.. >| .............. . * * ........ . | .............. . * * |.. >| * * Digitisations | * * | | GUDIGI | * * | ................ * * | ................ * * | | Output event | * * ... >| GUOUT | * * ................ * * The partition initialized in GTRIGI is cleared. The space used * * by the current event may be used by the next one. * * * * The banks JRUNG and JHEAD * * ------------------------- * * * * Run bank JRUNG: 1 user link, 30 data words * * LQ(JRUNG-1) user link * * IQ(JRUNG+1) IDRUN Run number * * "" +2/10) Reserved for user applications * * +11) creation date for 'INIT' data structures * * +12) creation time for 'INIT' data structures * * +13) creation data for 'KINE' * * +14) creation time for 'KINE' * * +15) creation data for 'HITS' * * +16) creation time for 'HITS' * * +17) creation data for 'DIGI' * * +18) creation time for 'DIGI' * * +19) Random number seed 1 * * +20) Random number seed 2 * * +21) GEANT version number when 'INIT' created * * +22) ZEBRA version number when 'INIT' created * * +23) GEANT version number when 'KINE' created * * +24) ZEBRA version number when 'KINE' created * * +25) GEANT version number when 'HITS' created * * +26) ZEBRA version number when 'HITS' created * * +27) GEANT version number when 'DIGI' created * * +28) ZEBRA version number when 'DIGI' created * * Header bank JHEAD: 1 user link, NHEAD(=10) data words * * IQ(JHEAD+1) IDRUN Run number * * "" +2) IDEVT Event number * * "" +3) NRNDM(1) Random number seed 1 at beginning of event * * "" +4) NRNDM(2) " " * * "" +5/10) Reserved for user applications * * * ************************************************************************ * * * * * Example of User Termination and related routines * * ------------------------------------------------ * * * * SUBROUTINE UGLAST * * C * * +SEQ,GCLIST * * C * * C Call standard GEANT termination routine * * CALL GLAST * * C * * C Close HIGZ files * * CALL IGEND * * C * * C Close I/O buffers * * IF(NGET.EQ.0.AND.NSAVE.EQ.0) GO TO 5 * * CALL GCLOSE(0,IER) * * C * * C Print histograms * * 5 CALL HISTDO * * C * * END * * * * * ************************************************************************ +DECK,GBHSTA *CMZ : 3.12/27 06/09/88 14.32.58 by Rene Brun *-- Author : SUBROUTINE GBHSTA C. C. ****************************************************************** C. * * C. * Books histograms statistics * C. * * C. * ==>Called by : , GUOUT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCLIST C. C. ------------------------------------------------------------------ C. IF(NHSTA.LE.0)GO TO 99 CALL GLOOK('TIME',LHSTA,NHSTA,ID) IF(ID.NE.0) + CALL HBOOK1(-ID,'TIME PER EVENT$',100,0.,0.,0.) C CALL GLOOK('SIZE',LHSTA,NHSTA,ID) IF(ID.NE.0) + CALL HBOOK1(-ID,'SPACE USED IN IXDIV PER EVENT$',100,0.,0.,0.) C CALL GLOOK('MULT',LHSTA,NHSTA,ID) IF(ID.NE.0) + CALL HBOOK1(-ID,'TOTAL NUMBER OF TRACKS PER EVENT$',100,0.,0.,0.) C CALL GLOOK('NTRA',LHSTA,NHSTA,ID) IF(ID.NE.0) + CALL HBOOK1(-ID,'LONG LIFE TRACKS PER EVENT$',100,0.,0.,0.) C CALL GLOOK('STAK',LHSTA,NHSTA,ID) IF(ID.NE.0) + CALL HBOOK1(-ID,'MAXIMUM STACK SIZE PER EVENT$',100,0.,0.,0.) C 99 RETURN END +DECK,GEAMON,IF=MONITOR. *CMZ : 3.15/01 14/02/92 08.28.21 by Federico Carminati *-- Author : Federico Carminati 20/02/91 SUBROUTINE GEAMON(ICASE,CHINFO) C. C. ****************************************************************** C. * * C. * Routine for GEANT monitoring * C. * * C. * ==>Called by : , GUOUT * C. * Author R.Brun, F.Carminati ******** * C. * * C. ****************************************************************** C. +SEQ, GCUNIT C. C. ------------------------------------------------------------------ C. COMMON/CWK/IWK CHARACTER*5 ENTRY, EXIT, BATINT LOGICAL FIRST, INTRAC CHARACTER*(*) CHINFO SAVE IWK1,IM1,TIM1,FIRST,ENTRY,EXIT,BATINT DATA ENTRY /'GINIT'/ DATA EXIT /'GLAST'/ DATA BATINT /'BATCH'/ DATA FIRST /.TRUE./ * *________________________________________________________ * IF(ICASE.LE.1)THEN IF(FIRST) THEN CALL TIMEL(TIM1) IWK1=IWK CALL DATIME(IDAT1,ITIM1) IH1=ITIM1/100 IM1=ITIM1-100*IH1+IH1*60 IF(INTRAC()) BATINT='INTER' FIRST=.FALSE. ENDIF ENDIF IF(ICASE.EQ.0) THEN ENTRY='GXINT' EXIT ='GXINT' ELSE IF(ICASE.EQ.1) THEN WRITE(CHMAIL,10000)IWK1,CHINFO,ENTRY,BATINT ELSEIF(ICASE.EQ.2) THEN IF(ENTRY.EQ.'GXINT'.AND.CHINFO.EQ.'GLAST') THEN EXIT='GLAST' GOTO 999 ENDIF CALL TIMEL(TIM2) CPTIME=TIM1-TIM2 CALL DATIME(IDAT2,ITIM2) IH2=ITIM2/100 IM2=ITIM2-100*IH2+IH2*60 IMD=IM2-IM1 IF(IMD.LT.0) IMD=IMD+24*60 IRTIME=MIN(999 ,MAX(IMD,1)) CPTIME=MIN(999.,CPTIME) WRITE(CHMAIL,10100)IWK1,IRTIME,CPTIME,EXIT ENDIF * CALL UMLOG('GEANTMON',CHMAIL(1:LNBLNK(CHMAIL))) * ENDIF * 10000 FORMAT('LOG111 WTYP=',I6,1X,A,2(1X,A5)) 10100 FORMAT('LOGOUT WTYP=',I6,' RT=',I3,' min CP=',F7.3,' sec ',A5) * 999 END +DECK,GETNUM *CMZ : 3.13/03 25/04/89 11.36.41 by Rene Brun *-- Author : SUBROUTINE GETNUM(LIST,N) C. C. ****************************************************************** C. * * C. * Routine to count the number of non blank elements * C. * in the array LIST before the first blank one * C. * * C. * ==>Called by : GFFGO * C. * ==>Author R.Brun ********* * C. * * C. ****************************************************************** C. DIMENSION LIST(*) SAVE IFIRST,IDFLT DATA IFIRST/0/ C. ------------------------------------------------------------------ C. IF(IFIRST.EQ.0)THEN IFIRST=1 CALL UCTOH(' ',IDFLT,4,4) ENDIF C N = 0 DO 10 I=1,20 IF(LIST(I).EQ.IDFLT) GO TO 99 N=N+1 10 CONTINUE C 99 RETURN END +DECK,GFFGO *CMZ : 3.15/01 13/01/92 20.43.19 by Federico Carminati *-- Author : SUBROUTINE GFFGO C. C. ****************************************************************** C. * * C. * Routine to define and read GEANT/FFREAD data cards * C. * If user data cards have been defined via FFKEY * C. * they will be read as well * C. * * C. * ==>Called by : , UGINIT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCPHYS +SEQ,GCCUTS +SEQ,GCFLAG +SEQ,GCKINE +SEQ,GCLIST +SEQ,GCPARM +SEQ,GCSTAK +SEQ,GCTIME +SEQ,GCTRAK +SEQ,GCMULO +SEQ,GCSCAN +SEQ,GCUNIT +SEQ,GCOPTI +SEQ,GCRZ C. C. ------------------------------------------------------------------ C. CALL FFKEY ('ANNI',IANNI , 1,'INTEGER') CALL FFKEY ('BREM',IBREM , 1,'INTEGER') CALL FFKEY ('COMP',ICOMP , 1,'INTEGER') CALL FFKEY ('CUTS',CUTGAM,16,'REAL') CALL FFKEY ('DEBU',IDEMIN, 3,'INTEGER') CALL FFKEY ('DCAY',IDCAY , 1,'INTEGER') CALL FFKEY ('DRAY',IDRAY , 1,'INTEGER') CALL FFKEY ('GEOM',LGEOM ,20,'MIXED') CALL FFKEY ('GET ',LGET ,20,'MIXED') CALL FFKEY ('HADR',IHADR , 1,'INTEGER') CALL FFKEY ('HSTA',LHSTA ,20,'MIXED') CALL FFKEY ('KINE',IKINE ,11,'MIXED') CALL FFKEY ('LOSS',ILOSS , 1,'INTEGER') CALL FFKEY ('MULS',IMULS , 1,'INTEGER') CALL FFKEY ('MUNU',IMUNU , 1,'INTEGER') CALL FFKEY ('PAIR',IPAIR , 1,'INTEGER') CALL FFKEY ('PATR',NJTMAX, 4,'INTEGER') CALL FFKEY ('PFIS',IPFIS , 1,'INTEGER') CALL FFKEY ('PHOT',IPHOT , 1,'INTEGER') CALL FFKEY ('PLOT',LPLOT ,20,'MIXED') CALL FFKEY ('PRIN',LPRIN ,20,'MIXED') CALL FFKEY ('RAYL',IRAYL , 1,'INTEGER') CALL FFKEY ('RGET',LRGET ,20,'MIXED') CALL FFKEY ('RSAV',LRSAVE,20,'MIXED') CALL FFKEY ('RNDM',NRNDM , 2,'INTEGER') CALL FFKEY ('RUNG',IDRUN , 2,'INTEGER') CALL FFKEY ('SAVE',LSAVE ,20,'MIXED') CALL FFKEY ('SETS',LSETS ,20,'MIXED') CALL FFKEY ('STAT',LSTAT ,20,'MIXED') CALL FFKEY ('SWIT',ISWIT ,10,'INTEGER') CALL FFKEY ('TIME',TIMINT, 3,'MIXED') CALL FFKEY ('TRIG',NEVENT, 1,'INTEGER') CALL FFKEY ('VIEW',LVIEW ,20,'MIXED') CALL FFKEY ('ERAN',EKMIN , 3,'MIXED') CALL FFKEY ('AUTO',IGAUTO, 1,'INTEGER') CALL FFKEY ('OPTI',IOPTIM, 1,'INTEGER') *--------------- SCAN/Parametrize cards CALL FFKEY ('SCAN',SCANFL, 8,'MIXED') CALL FFKEY ('SCAL',ISLIST,MSLIST,'MIXED') CALL FFKEY ('SCAP',VSCAN , 6,'REAL') CALL FFKEY ('PCUT',IPARAM, 6,'MIXED') CALL FFKEY ('PNUM',MPSTAK, 2,'MIXED') C C Now read data cards C CALL FFGO C C Get some parameters from the data cards C CALL GETNUM (LHSTA ,NHSTA) CALL GETNUM (LGET ,NGET) CALL GETNUM (LSAVE ,NSAVE) CALL GETNUM (LRGET ,NRGET) CALL GETNUM (LRSAVE,NRSAVE) CALL GETNUM (LSETS ,NSETS) CALL GETNUM (LPRIN ,NPRIN) CALL GETNUM (LGEOM ,NGEOM) CALL GETNUM (LVIEW ,NVIEW) CALL GETNUM (LPLOT ,NPLOT) CALL GETNUM (LSTAT ,NSTAT) CALL GETNUM (ISLIST,NSLIST) IF(MODTET.LT.1.OR.MODTET.GT.MAXMDT) THEN WRITE(LOUT,10000) MODTET 10000 FORMAT(' MODTET = ',I2,' out of range - 1 assumed') MODTET=1 ENDIF TETMIN = TETMID(MODTET) TETMAX = TETMAD(MODTET) IF(IDEVT.GT.0)IDEVT=IDEVT-1 C C Set IDEBUG flag for initialisation phase C IF(IDEMIN.LT.0.AND.IDEMAX.GE.0)THEN IDEMIN=-IDEMIN IDEBUG=1 ENDIF C C Initialise the random number generator C IF(NRNDM(2).NE.0)THEN CALL GRNDMQ(NRNDM(1),NRNDM(2),1,'S') ELSEIF(NRNDM(1).GT.0)THEN ISEQ=NRNDM(1) CALL GRNDMQ(NRNDM(1),NRNDM(2),ISEQ,'Q') CALL GRNDMQ(NRNDM(1),NRNDM(2),ISEQ,'S') ENDIF C 999 END +DECK,GFHSTA *CMZ : 3.12/27 06/09/88 14.32.58 by Rene Brun *-- Author : SUBROUTINE GFHSTA C. C. ****************************************************************** C. * * C. * Fills histograms statistics * C. * * C. * ==>Called by : , GUOUT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM +SEQ,GCLIST COMMON/QUEST/IQUEST(100) C. C. ------------------------------------------------------------------ C. IF(NHSTA.LE.0)GO TO 99 CALL GLOOK('TIME',LHSTA,NHSTA,ID) IF(ID.NE.0)THEN CALL TIMED(TEVENT) CALL HFILL(-ID,TEVENT,0.,1.) ENDIF C CALL GLOOK('SIZE',LHSTA,NHSTA,ID) IF(ID.NE.0)THEN NL=NZLEFT(IXDIV,' ') SIZE=IQUEST(11) CALL HFILL(-ID,SIZE,0.,1.) ENDIF C CALL GLOOK('MULT',LHSTA,NHSTA,ID) IF(ID.NE.0)THEN CALL HFILL(-ID,FLOAT(NTMULT)+0.1,0.,1.) ENDIF C CALL GLOOK('NTRA',LHSTA,NHSTA,ID) IF(ID.NE.0)THEN CALL HFILL(-ID,FLOAT(NTRACK)+0.1,0.,1.) ENDIF C CALL GLOOK('STAK',LHSTA,NHSTA,ID) IF(ID.NE.0)THEN CALL HFILL(-ID,FLOAT(NSTMAX)+0.1,0.,1.) ENDIF C 99 RETURN END +DECK,GGCLOS. *CMZ : 3.15/01 05/12/90 16.28.55 by Federico Carminati *-- Author : SUBROUTINE GGCLOS C. C. ****************************************************************** C. * * C. * Closes off the geometry setting. * C. * Initializes the search list for the contents of each * C. * volume following the order they have been positioned, and * C. * inserting the content '0' when a call to GSNEXT (-1) has * C. * been required by the user. * C. * Performs the development of the JVOLUM structure for all * C. * volumes with variable parameters, by calling GGDVLP. * C. * Interprets the user calls to GSORD, through GGORD. * C. * Computes and stores in a bank (next to JVOLUM mother bank) * C. * the number of levels in the geometrical tree and the * C. * maximum number of contents per level, by calling GGNLEV. * C. * Sets status bit for CONCAVE volumes, through GGCAVE. * C. * Completes the JSET structure with the list of volume names * C. * which identify uniquely a given physical detector, the * C. * list of bit numbers to pack the corresponding volume copy * C. * numbers, and the generic path(s) in the JVOLUM tree, * C. * through the routine GHCLOS. * C. * * C. * Called by : * C. * Authors : R.Brun, F.Bruyant ********* * C. * * C. * Modified by S.Egli at 15.9.90: automatic sorting of volumes * C * done by calling GGORDQ for each volume * C. ****************************************************************** C. +CDE, GCBANK. +CDE, GCFLAG. +CDE, GCLIST. +CDE, GCNUM. +CDE, GCUNIT. +CDE, GCOPTI. C. ------------------------------------------------------------------ CHARACTER*4 NAME * * *** Stop the run in case of serious anomaly during initialization * IF (IEORUN.NE.0) THEN WRITE (CHMAIL, 1001) CALL GMAIL (0, 0) STOP ENDIF * IF (NVOLUM.LE.0) THEN WRITE (CHMAIL, 1002) NVOLUM CALL GMAIL (0, 0) GO TO 999 ENDIF * NPUSH = NVOLUM -IQ(JVOLUM-2) CALL MZPUSH (IXCONS, JVOLUM, NPUSH, NPUSH,'I') * * *** Loop over volumes, create default JNear banks as relevant, * and release unused bank space * IDO = 0 DO 80 IVO = 1,NVOLUM JVO = LQ(JVOLUM-IVO) * * *** Check if Tracking medium has been defined * NMED=Q(JVO+4) IF(NMED.LE.0.OR.NMED.GT.IQ(JTMED-2))THEN WRITE(CHMAIL,1003)IQ(JVOLUM+IVO) CALL GMAIL (0, 0) ELSE IF(LQ(JTMED-NMED).EQ.0)THEN WRITE(CHMAIL,1003)IQ(JVOLUM+IVO) CALL GMAIL (0, 0) ENDIF ENDIF IF (JBIT(IQ(JVO),1).NE.0) GO TO 80 IDO = 1 CALL SBIT1 (IQ(JVO),1) NINL = IQ(JVO-2) NIN = Q(JVO+3) NUSED = IABS(NIN) IF (NIN.GT.0) THEN * reserve enough additional space for sorted volumes IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN NUSED=NUSED+1 ELSE NUSED=NUSED+2 ENDIF ENDIF * NPUSH = NUSED -NINL CALL MZPUSH (IXCONS, JVO, NPUSH, 0, 'I') IF (NIN.LE.0) GO TO 80 * IZERO = JBIT(IQ(JVO),4) NEL = NIN +IZERO CALL MZBOOK (IXCONS,JN,JVO,-NIN-1,'VONE',0,0,NEL+1,2,0) IQ(JN-5) = IVO IQ(JN+1) = NEL JN = JN +1 DO 29 I = 1,NIN IQ(JN+IZERO+I) = I 29 CONTINUE IF (IZERO.NE.0) IQ(JN+1) = 0 * 80 CONTINUE * IF (IDO.NE.0) THEN * * *** Perform development of JVOLUM structure where necessary * CALL GGDVLP * * *** Fill GSORD ordering banks if required * * Modified by S.Egli to allow GGORDQ to find the optimum sorting for * all volumes * IF(IOPTIM.GE.1)THEN WRITE(6,'(A)')' GGCLOS: Start automatic volume ordering:' ENDIF DO 91 IVO = 1,NVOLUM JVO = LQ(JVOLUM-IVO) NIN = Q(JVO+3) ISEARC=Q(JVO+1) IF(ISEARC.GT.0) GO TO 91 * check if sorting not possible or not wanted IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN Q(JVO+1)=0. IF(NIN.GT.500.AND.IOPTIM.GE.1)THEN CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4) WRITE (CHMAIL,1004) NAME,NIN CALL GMAIL (0, 0) ENDIF ELSEIF(IOPTIM.EQ.0)THEN IF(ISEARC.LT.0)CALL GGORD (IVO) ELSEIF(IOPTIM.EQ.1)THEN IF(ISEARC.EQ.0) THEN CALL GGORDQ(IVO) ELSE CALL GGORD (IVO) END IF ELSE CALL GGORDQ(IVO) ENDIF 91 CONTINUE * * *** Set status bit for concave volumes * CALL GGCAVE * * *** Compute maximum number of levels and of contents per level * CALL GGNLEV * ENDIF * * *** Scan the volume structure to retrieve the path through * the physical tree for all sensitive detectors * CALL GHCLOS * * *** Books STAT banks if data card STAT is submitted * IF (NSTAT.GT.0) CALL GBSTAT * CALL MZGARB (IXCONS, 0) * 1001 FORMAT (' Severe diagnostic in initialization phase. STOP') 1002 FORMAT (' GGCLOS : NVOLUM =',I5,' *****') 1003 FORMAT (' Illegal tracking medium number in volume : ',A4) 1004 FORMAT (' GGORDQ : Volume ',A4,' has more than 500 (', + I3,') daughters ; volume sorting not possible !') * END GGCLOS 999 END +DECK, GHCLOS. *CMZ : 3.13/03 25/04/89 12.06.24 by F.Bruyant *-- Author : SUBROUTINE GHCLOS C. C. ****************************************************************** C. * * C. * SUBR. GHCLOS * C. * * C. * For every sensitive detector, calls GGDETV in order to * C. * complete the JD bank with the list of volume names which * C. * permit to identify uniquely a given physical detector, the * C. * list of bit numbers to pack the corresponding volume copy * C. * numbers, and the generic path(s) through the JVOLUM tree. * C. * * C. * Called by : GGCLOS, * C. * Author : F.Bruyant * C. * * C. ****************************************************************** C. +CDE, GCBANK. C. C. ------------------------------------------------------------------ * IF (JSET.NE.0) THEN * * *** Scan the volume structure to retrieve the path through * the physical tree for all sensitive detectors * NSET = IQ(JSET-1) DO 20 ISET=1,NSET JS = LQ(JSET-ISET) NDET = IQ(JS-1) DO 10 IDET=1,NDET CALL GGDETV (ISET, IDET) 10 CONTINUE 20 CONTINUE ENDIF * END GHCLOS END +DECK,GINIT *CMZ : 3.15/09 08/04/92 11.51.13 by Federico Carminati *-- Author : SUBROUTINE GINIT C. C. ****************************************************************** C. * * C. * GEANT initialisation routine * C. * * C. * IFINIT(1)=1 free * C. * (2)=1 if GZINIT " " * C. * (3)=1 if GLUND or GLUNDI have been called * C. * (4)=1 if GHEINI or GPGHEI have been called * C. * (5)=1 if GHCASC has been called * C. * (6)=1 if GLUDKY has been called * C. * (7)=1 if GTAU " " * C. * (8)=1 if GPRELA * C. * (9)=1 if GPCXYZ * C. * (10)=1 if GDRAW * C. * (11)=1 if INIT_GMR * C. * (12)=1 if GET_GEANT_STRUCTURE * C. * (13)=1 if GPIONS * C. * (14)=1 if GDINIT * C. * (15)=1 if GHFHDN (HADRIN/NUCRIN) * C. * * C. * ==>Called by : , UGINIT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCLIST +SEQ,GCSETS +SEQ,GCONSP +SEQ,GCPUSH +SEQ,GCTIME +SEQ,GCPHYS +SEQ,GCPARM +SEQ,GCCUTS +SEQ,GCFLAG +SEQ,GCKINE +SEQ,GCKING +SEQ,GCMULO +SEQ,GCSCAN +SEQ,GCOPTI +SEQ,GCNUM +SEQ,GCSTAK +SEQ,GCTRAK +SEQ,GCUNIT +SEQ,GCVOLU +SEQ,GCTMED +SEQ,GCRZ +SEQ,GCJUMP, IF=USRJMP * COMMON/GCONST/PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS * COMMON/GCONSX/EMMU,PMASS,AVO COMMON/GCONST/CONS1(8) COMMON/GCONSX/CONS2(3) +SELF, IF=USRJMP EXTERNAL GUDCAY, GUDIGI, GUDTIM, GUFLD , GUHADR, GUIGET, + GUINME, GUINTI, GUKINE, GUNEAR, GUOUT , GUPHAD, + GUSKIP, GUSTEP, GUSWIM, GUTRAK, GUTREV, GUVIEW, + GUPARA +SELF C C ZEBRA system common blocks C COMMON /ZHEADP/IQHEAD(20),IQDATE,IQTIME,IQPAGE,NQPAGE(4) COMMON /ZMACH/ NQBITW,NQBITC,NQCHAW,NQLNOR,NQLMAX,NQLPTH,NQRMAX +, IQLPCT,IQNIL COMMON /ZSTATE/QVERSN,NQPHAS,IQDBUG,NQDCUT,NQWCUT,NQERR +, NQLOGD,NQLOGM,NQLOCK,NQDEVZ,NQAUGM(6) COMMON /ZUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE C CHARACTER*4 MEC(MAXMEC),DFLT(2) CHARACTER*8 CHVERS +SELF, IF=MONITOR CHARACTER*32 CHINFO +SELF SAVE LOAD DATA LOAD/0/ DATA DFLT /' ','XXXX'/ DATA MEC/'NEXT','MULS','LOSS','FIEL','DCAY','PAIR','COMP','PHOT' + ,'BREM','DRAY','ANNI','HADR','ECOH','EVAP','FISS','ABSO' + ,'ANNH','CAPT','EINC','INHE','MUNU','TOFM','PFIS','SCUT' + ,'RAYL','PARA','PRED','LOOP','NULL','STOP'/ * * This line would introduce a backward incompatibility because * it would presume a GCTRAK 16 bytes longer. The related code * is commented in the routines GT... C + ,'RAYL','PARA','PRED','LOOP','NULL','STOP','SMAX','SCOR'/ C. C. ------------------------------------------------------------------ C. C +SEQ,DATEQQ +SEQ,TIMEQQ CALL GETVER(CHVERS,GVERSN) ZVERSN = QVERSN IGDATE = IQDATE IGTIME = IQTIME LIN = IQREAD IF(IQTTIN.NE.0) LIN=IQTTIN LOUT = IQPRNT C WRITE (CHMAIL,10100)GVERSN CALL GMAIL(0,0) * GVERSC = 0.0 +SEQ, GVERSC, T=PASS. IF (GVERSC.NE.0.0) THEN WRITE (CHMAIL,10200) GVERSC CALL GMAIL(0,0) ENDIF +SELF, IF=MONITOR * WRITE(CHINFO,10000) GVERSN, GVERSC 10000 FORMAT(' Version/Cradle: ',F7.4,'/',F7.4) CALL GEAMON(1,CHINFO) +SELF. WRITE(CHMAIL,10300)IDATQQ,ITIMQQ CALL GMAIL(0,1) C +SELF, IF=USRJMP JUDCAY = JUMPAD(GUDCAY) JUDIGI = JUMPAD(GUDIGI) * GUDTIM is a function JUFLD = JUMPAD(GUFLD) JUHADR = JUMPAD(GUHADR) JUIGET = JUMPAD(GUIGET) JUINME = JUMPAD(GUINME) JUINTI = JUMPAD(GUINTI) JUKINE = JUMPAD(GUKINE) JUNEAR = JUMPAD(GUNEAR) JUOUT = JUMPAD(GUOUT) JUPHAD = JUMPAD(GUPHAD) JUSKIP = JUMPAD(GUSKIP) JUSTEP = JUMPAD(GUSTEP) JUSWIM = JUMPAD(GUSWIM) JUTRAK = JUMPAD(GUTRAK) JUTREV = JUMPAD(GUTREV) JUVIEW = JUMPAD(GUVIEW) JUPARA = JUMPAD(GUPARA) +SELF C CALL FFINIT(0) NBIT = NQBITW CALL UCTOH(DFLT,IDFLT,4,4) CONS1( 1) = PI CONS1( 2) = TWOPI CONS1( 3) = PIBY2 CONS1( 4) = DEGRAD CONS1( 5) = RADDEG CONS1( 6) = CLIGHT CONS1( 7) = BIG CONS1( 8) = EMASS CONS2( 1) = EMMU CONS2( 2) = PMASS CONS2( 3) = AVO DO 10 J=1,MXGKIN TOFD(J) = 0. IFLGK(J) = 0 10 CONTINUE C IGAUTO= 1 IPAIR = 1 ICOMP = 1 IPHOT = 1 IRAYL = 0 IBREM = 1 IHADR = 1 IANNI = 1 IDRAY = 1 IMUNU = 1 IPFIS = 0 IDCAY = 1 ILOSS = 2 IMULS = 1 C CUTGAM = 0.001 CUTELE = 0.001 CUTHAD = 0.01 CUTNEU = 0.01 CUTMUO = 0.01 TOFMAX = BIG DO 20 J=1,5 GCUTS(J) = 0. 20 CONTINUE C C The following cuts can be changed by data card CUTS C If they are now changed, then the routine GPHYSI C will change them respectively to C BCUTE=CUTGAM,BCUTM=CUTGAM, DCUTE=CUTELE, DCUTM=CUTELE C and PPCUTM=4.*EMASS C DCUTE = BIG DCUTM = BIG BCUTE = BIG BCUTM = BIG PPCUTM= BIG ISTPAR= 1 IOPTIM= 0 C NCVERT = 5 NCKINE = 50 NCJXYZ = 100 NPVERT = 5 NPKINE = 10 NPJXYZ = 200 C IKINE = 0 DO 30 J=1,10 PKINE(J) = BIG 30 CONTINUE CALL VZERO (IHSET,26) CALL VZERO (NHSTA,9) CALL VFILL (LHSTA, 180, IDFLT) CALL VFILL (LRGET, 40, IDFLT) CALL VZERO (NUNITS,6) CALL VZERO (IDEBUG,42) CALL VZERO (NMATE,9) CALL VZERO (NLEVEL,306) NALIVE = 0 NTMSTO = 0 NJTMAX = 0 NJTMIN = 0 NTSTKP = 500 NTSTKS = 100 * *-------- Scan parameters defaults SCANFL = .FALSE. NPHI = 90 PHIMIN = 0. PHIMAX = 360. IPHI1 = 1 IPHIL = NPHI NTETA = 90 TETMID(1) = -10. TETMID(2) = 0. TETMID(3) = -1. TETMAD(1) = 10. TETMAD(2) = 180. TETMAD(3) = 1. MODTET = 1 CALL VFILL (ISLIST,MSLIST,IDFLT) CALL UCTOH(DFLT(2),ISLIST(1),4,4) NSLIST = 1 VSCAN(1) = 0. VSCAN(2) = 0. VSCAN(3) = 0. FACTX0 = 100. FACTL = 10. FACTSF = 100. FACTR = 100. *--- Parametrization cut=0 means no parametrization IPARAM = 0 DO 40 J=1,5 PACUTS(J) = 0. 40 CONTINUE *--- Size for the primary parametrization stak MPSTAK = 1000 *--- Number of particles generated for every shower NPGENE = 20 *-------- Scan parameters defaults C RZTAGS(1)='STRUCTUR' RZTAGS(2)='TRIG-NR ' RZTAGS(3)='RUNG-NRT ' RZTAGS(4)='USER-ID ' NRGET = 0 NRSAVE = 0 NRECRZ = 1000 C IPAOLD =-1 NUMOLD = 0 C IEVENT = 0 IDRUN = 1 NHEAD = 10 NTMED = 100 NMATE = 100 NROTM = 100 NPART = 100 NEVENT = 10000000 C TIMINT = 0. TIMEND = 1. ITIME = 1 C CALL UCTOH(MEC,NAMEC,4,MAXMEC*4) MAXNST=10000 C C Constants for energy loss and physics processes C UPWGHT=1. NEKBIN=90 NEK1=NEKBIN+1 EKMIN=1.E-5 EKMAX=1.E+4 C C Initialize Random number generator C NRNDM(1) = 0 NRNDM(2) = 0 CALL GRNDMQ(0,0,1,' ') C C Constants for multiple scattering (GMUL) C DXM=TWOPI/100. XM=-0.5*DXM SQ=-0.0099999 DO 50 I=1,101 SQ=SQ+0.01 IF(I.LT.101)SQRMUL(I)=SQRT(-2.*LOG(SQ)) XM=XM+DXM SINMUL(I)=SIN(XM) 50 COSMUL(I)=COS(XM) SQRMUL(101)=0.01 C C This piece of code to force loading of default C routines from the GEANG file on some machines C like VAX. C IF(LOAD.NE.0)THEN CALL GWORK (IP1) +SELF, IF=-USRJMP CALL GUDCAY CALL GUDIGI P1 = GUDTIM( P2, P3,IP4, P4) CALL GUFLD ( P1, P2) CALL GUHADR CALL GUIGET(IP1,IP2,IP3) CALL GUINME( P1, P2, P3,IP4) CALL GUINTI CALL GUKINE CALL GUNEAR(IP1,IP2, P3,IP4) CALL GUOUT CALL GUPHAD CALL GUSKIP(IP1) CALL GUSTEP CALL GUSWIM( P1, P2, P3, P4) CALL GUTRAK CALL GUTREV CALL GUVIEW(IP1,IP2,IP3,IP4) CALL GUPARA +SELF ENDIF C 10100 FORMAT('1***** GEANT Version',F7.4, * +' Pre-release version *****') +' Released on Tuesday 07 April 1992 *****') 10200 FORMAT('0***** Correction Cradle Version ',F7.4) 10300 FORMAT(' ***** Library compiled on ',I6,' at ',I4,' *****') END +DECK,GLAST *CMZ : 3.15/01 03/02/92 19.31.18 by Federico Carminati *-- Author : SUBROUTINE GLAST C. C. ****************************************************************** C. * * C. * TERMINATION ROUTINE * C. * * C. * ==>Called by : , UGLAST * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCFLAG +SEQ,GCUNIT +SEQ,GCTIME C. C. ------------------------------------------------------------------ C. WRITE (CHMAIL,1000) IEVENT CALL GMAIL(0,0) C CALL GRNDMQ(NRNDM(1),NRNDM(2),0,'G') C WRITE (CHMAIL,3000) NRNDM CALL GMAIL(0,0) C C COMPUTE ONE EVENT PROCESSING TIME C IF(IEVENT.GT.0)THEN CALL TIMEL(TIMLFT) XMEAN = (TIMINT - TIMLFT)/IEVENT WRITE(CHMAIL,4000)XMEAN CALL GMAIL(0,2) ENDIF C C Print ZEBRA statistics C CALL MZEND C C Print statistics C IF(JGSTAT.NE.0)CALL GPSTAT +SELF, IF=MONITOR C C Call monitoring routine C CALL GEAMON(2,'GLAST') +SELF. C 1000 FORMAT('1',9X,'**** NUMBER OF EVENTS PROCESSED =',I6) 3000 FORMAT(10X,'**** RANDOM NUMBER GENERATOR AFTER' +,' LAST COMPLETE EVENT ',2I12) 4000 FORMAT(10X,'**** TIME TO PROCESS ONE EVENT IS =',F10.4, + ' SECONDS') END +DECK,GLOOK *CMZ : 3.13/02 30/01/89 10.41.23 by Rene Brun *-- Author : SUBROUTINE GLOOK(NAME,IVECT,N,ILOOK) C. C. ****************************************************************** C. * * C. * Search position ILOOK of element NAME in array IVECT * C. * of length N * C. * * C. * ==>Called by : many GEANT and GEANG routines * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. DIMENSION IVECT(1) CHARACTER*(*) NAME C. C. ------------------------------------------------------------------ C. CALL UCTOH(NAME,NAMEH,4,4) ILOOK=IUCOMP(NAMEH,IVECT,N) C END +DECK,GMAIL *CMZ : 3.12/27 06/09/88 14.32.59 by Rene Brun *-- Author : SUBROUTINE GMAIL(LINBEF,LINAFT) C. C. ****************************************************************** C. * * C. * Send a mail on the output device (usually unit LOUT) * C. * The mail is in character array CHMAIL of /GCMAIL/ * C. * Max length is 132 chars and trailing blanks are stripped * C. * LINBEF lines are skipped before mail and LINAFT after * C. * * C. * ==>Called by : many routines * C. * Authors : R.Brun, P.Zanarini ********* * C. * * C. ****************************************************************** C. +SEQ,GCUNIT C. C. ------------------------------------------------------------------ C. DO 10 I=1,LINBEF WRITE (LOUT,1000) 10 CONTINUE DO 20 NCH=132,1,-1 IF (CHMAIL(NCH:NCH).NE.' ') GO TO 30 20 CONTINUE NCH=1 30 CONTINUE WRITE (LOUT,2000) CHMAIL(1:NCH) DO 40 I=1,LINAFT WRITE (LOUT,1000) 40 CONTINUE 1000 FORMAT (1X) 2000 FORMAT (A) END +DECK,GPRINT *CMZ : 3.15/01 31/01/91 16.48.11 by Federico Carminati *-- Author : SUBROUTINE GPRINT(CHNAME,NUMB) C. C. ****************************************************************** C. * * C. * Routine to print data structures * C. * * C. * CHNAME name of a data structure * C. * NUMB data structure number * C. * * C. * ==>Called by : , UGINIT , GINC4 * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. CHARACTER*4 KNAMES(11),NAME DIMENSION NHAMES(11) CHARACTER*(*) CHNAME SAVE IFIRST,KNAMES,NHAMES DATA IFIRST/0/ DATA KNAMES/'DIGI','JXYZ','HITS','KINE','MATE','VOLU' + ,'ROTM','SETS','TMED','PART','VERT'/ C. C. ------------------------------------------------------------------ C. NAME=CHNAME IF(IFIRST.EQ.0)THEN IFIRST=1 CALL UCTOH(KNAMES,NHAMES,4,44) ENDIF C CALL GLOOK(NAME,NHAMES,11,JUMP) C IF(JUMP.EQ. 1) CALL GPDIGI ('*','*') IF(JUMP.EQ. 2) CALL GPJXYZ (NUMB) IF(JUMP.EQ. 3) CALL GPHITS ('*','*') IF(JUMP.EQ. 4) CALL GPKINE (NUMB) IF(JUMP.EQ. 5) CALL GPMATE (NUMB) IF(JUMP.EQ. 6) CALL GPVOLU (NUMB) IF(JUMP.EQ. 7) CALL GPROTM (NUMB) IF(JUMP.EQ. 8) CALL GPSETS ('*','*') IF(JUMP.EQ. 9) CALL GPTMED (NUMB) IF(JUMP.EQ.10) CALL GPPART (NUMB) IF(JUMP.EQ.11) CALL GPVERT (NUMB) C END +DECK,GRUN,IF=-INLIB *CMZ : 3.15/01 03/02/92 19.29.07 by Federico Carminati *-- Author : SUBROUTINE GRUN *. *. ****************************************************************** *. * * *. * Steering routine to process all the events * *. * * *. * ==>Called by : , main program * *. * Author R.Brun ********* * *. * * *. ****************************************************************** *. +SEQ,GCBANK +SEQ,GCFLAG +SEQ,GCUNIT +SEQ,GCTIME SAVE IFIRST DATA IFIRST/0/ *. *. ------------------------------------------------------------------ *. * Keep starting time * IF(IFIRST.EQ.0)THEN IFIRST=1 CALL TIMEL(TIMINT) ENDIF * 10 IF(IEVENT.LT.NEVENT) THEN IEVENT=IEVENT+1 * * Initialises event partition * CALL GTRIGI * * Process one event (trigger) * CALL GTRIG * * Clear event partition * CALL GTRIGC * IF(IEORUN.EQ.0) THEN * * Check time left * IF(ITIME.LE.0)GO TO 10 IF(MOD(IEVENT,ITIME).NE.0)GO TO 10 CALL TIMEL(TIMNOW) IF(TIMNOW.GT.TIMEND)GO TO 10 WRITE(CHMAIL,10000)TIMEND CALL GMAIL(0,2) IEORUN = 1 ENDIF ENDIF * 10000 FORMAT(5X,'***** THE JOB STOPS NOW BECAUSE THE TIME LEFT IS LESS', +' THAN ',F8.3,' SECONDS *****') END +DECK,GTRIG,IF=-INLIB *CMZ : 3.15/01 20/02/91 22.56.09 by Federico Carminati *-- Author : SUBROUTINE GTRIG C. C. ****************************************************************** C. * * C. * Steering routine to process one event * C. * ==>Called by : GRUN , GINC4 * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCFLAG +SEQ,GCJUMP, IF=USRJMP C. C. ------------------------------------------------------------------ C. C. Kinematics C. +SELF, IF=-USRJMP CALL GUKINE +SELF, IF=USRJMP CALL JUMPT0(JUKINE) +SELF IF (IEOTRI.NE.0) GO TO 99 C. C. Tracking C. +SELF, IF=-USRJMP CALL GUTREV +SELF, IF=USRJMP CALL JUMPT0(JUTREV) +SELF IF (IEOTRI.NE.0) GO TO 99 C. C. Digitisation C. +SELF, IF=-USRJMP CALL GUDIGI +SELF, IF=USRJMP CALL JUMPT0(JUDIGI) +SELF IF (IEOTRI.NE.0) GO TO 99 C. C. User end of event control routine C. +SELF, IF=-USRJMP CALL GUOUT +SELF, IF=USRJMP CALL JUMPT0(JUOUT) +SELF C 99 RETURN END +DECK,GTRIGC *CMZ : 3.15/01 15/01/92 09.27.48 by Federico Carminati *-- Author : SUBROUTINE GTRIGC C. C. ****************************************************************** C. * * C. * Clear event partition * C. * * C. * ==>Called by : GRUN , GINC4 * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCSTAK. +SEQ,GCFLAG. C. C. ------------------------------------------------------------------ C. * IF (NJTMAX.LT.0) NJTMAX = -NJTMAX * CALL GRNDMQ(IQ(JRUNG+19),IQ(JRUNG+20),0,'G') * IF (JSTAK.NE.0) THEN IQ(JSTAK+1) = 0 IQ(JSTAK+3) = 0 ENDIF * CALL MZWIPE (IXDIV) * END GTRIGC END +DECK,GTRIGI *CMZ : 3.15/01 28/10/91 13.35.29 by Federico Carminati *-- Author : SUBROUTINE GTRIGI C. C. ****************************************************************** C. * * C. * Initialises event partition * C. * ==>Called by : GRUN , GINC4 * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM +SEQ,GCFLAG +SEQ,GCUNIT +SEQ,GCTRAK C. C. ------------------------------------------------------------------ C. IEOTRI=0 NTRACK=0 NVERTX=0 IDEBUG=0 TOFG =0. C C Print event number and random number generator C CALL GRNDMQ(NRNDM(1),NRNDM(2),0,'G') C C Create event header bank C CALL MZBOOK(IXDIV,JHEAD,JHEAD,1,'HEAD', 1, 1,NHEAD,2,0) IDEVT=IDEVT+1 IQ(JHEAD+1)=IDRUN IQ(JHEAD+2)=IDEVT IQ(JHEAD+3)=NRNDM(1) IQ(JHEAD+4)=NRNDM(2) C IF(ITEST.GT.0)THEN IF(MOD(IEVENT,ITEST).EQ.0)THEN WRITE (CHMAIL,1000) IEVENT,IDEVT,(NRNDM(I),I = 1,2) CALL GMAIL(0,0) ENDIF ENDIF C IF(IEVENT.GE.IDEMIN.AND.IEVENT.LE.IDEMAX)IDEBUG=1 C 1000 FORMAT(' **** GTRIGI: IEVENT=',I7,' IDEVT=',I7, +' Random Seeds = ',I10,2X,I10) 99 RETURN END +DECK,GWORK *CMZ : 3.12/27 06/09/88 14.33.00 by Rene Brun *-- Author : SUBROUTINE GWORK(NWORK) C. C. ****************************************************************** C. * * C. * Make sure that at least NWORK words of working space * C. * are available in the blank common WS(1.....,NWORK) * C. * * C. * If the current work space is bigger GWORK does nothing * C. * In the other case it calls ZWORK * C. * * C. * ==>Called by : USER,GDRAWC,GDRAWX * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK C. C. ------------------------------------------------------------------ C. CALL MZWORK(IXSTOR,WS,WS(NWORK),0) END +DECK,GZEBRA *CMZ : 3.12/27 06/09/88 14.33.00 by Rene Brun *-- Author : SUBROUTINE GZEBRA(NZEB) C. C. ****************************************************************** C. * * C. * Routine to initialise ZEBRA store (//) * C. * * C. * ==>Called by : * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK C. C. ------------------------------------------------------------------ C. NZEBRA=NZEB CALL MZEBRA(-1) CALL MZSTOR(IXSTOR,'/GCBANK/',' ',FENDQ,LQ,LR1,WS,LQ(KWWORK+100) + ,LQ(NZEBRA-30)) CALL MZLOGL(IXSTOR,0) C RETURN END +DECK,GZINIT *CMZ : 3.14/16 24/10/90 13.47.40 by Rene Brun *-- Author : SUBROUTINE GZINIT C. C. ****************************************************************** C. * * C. * Routine to initialise GEANT/ZEBRA data structures * C. * * C. * ==>Called by : , UGINIT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCFLAG +SEQ,GCJLOC +SEQ,GCTIME +SEQ,GCMZFO +SEQ,GCSCAL COMMON/GCLOCA/NLOCAL(2),LOCAL(20) C. C. ------------------------------------------------------------------ C. IF(IFINIT(2).NE.0)RETURN IFINIT(2)=1 C C Create one long range division (reverse) C to store all constants C The event structures are created in division 2 C of the store C MINCON=2000 MAXCON=8*NZEBRA/10 CALL MZDIV(IXSTOR,IXCONS,'Constants',MINCON,MAXCON,'LRC') IXDIV=IXSTOR+2 C C IXDIV and IXCONS are two self contained divisions. C To gain time we specify that to ZEBRA C CALL MZXREF(IXCONS,IXDIV,'C') CALL MZXREF(IXDIV,IXCONS,'C') C C Define a default work space of KWWORK words C CALL MZWORK(IXSTOR,WS,WS(KWWORK),0) C C Create a permanent link area for master pointers C CALL MZLINK(IXSTOR,'/GCLINK/',JDIGI,JSKLT,JDIGI) C C Create a permanent link area for param. pointers C CALL MZLINK(IXSTOR,'/GCSLNK/',LSCAN,LSLAST,LSCAN) C C Create temporary link areas C CALL MZLINT(IXSTOR,'/GCLOCA/',NLOCAL,LOCAL(1),LOCAL(20)) CALL MZLINT(IXSTOR,'/GCJLOC/',NJLOC ,JTM,JRANG) C C Define IO descriptors of GEANT banks C CALL MZFORM('MATE','5H -F' ,IOMATE) CALL MZFORM('PART','5H -F' ,IOPART) CALL MZFORM('TMED','5H -F' ,IOTMED) CALL MZFORM('SEJD','10I / 1H 1I',IOSEJD) CALL MZFORM('SJDD','/ 1H 1I' ,IOSJDD) CALL MZFORM('SJDH','/ 1H 1I 2F' ,IOSJDH) CALL MZFORM ('STAK', '3I / 3I 9F', IOSTAK) CALL MZFORM('RUNG','20I -F' ,IORUNG) C C Create RUN header bank C CALL MZBOOK(IXCONS,JRUNG,JRUNG,1,'RUNG',1,1,30,IORUNG,0) IQ(JRUNG-5)=1 IQ(JRUNG+1)=IDRUN C C Fill header with default date,time,Geant and Zebra C version numbers for the 4 main GEANT data structures C INIT,KINE,HITS,DIGI C DO 10 I=1,4 IQ(JRUNG+2*I+ 9)=IGDATE IQ(JRUNG+2*I+10)=IGTIME Q(JRUNG+2*I+19)=GVERSN Q(JRUNG+2*I+20)=ZVERSN 10 CONTINUE C 99 RETURN END +DECK,GETVER. *CMZ : 3.15/09 03/04/92 12.46.36 by Federico Carminati *-- Author : Federico Carminati 03/04/92 SUBROUTINE GETVER(CHVER,HVERS) C. C. ****************************************************************** C. * * C. * Routine to get the current version number from a pam * C. * file. This routine is cracking the title given in * C. * HOLLERITH format, because CMZ and old versions of PATCHY * C. * do not support the character title sequence QFTITLCH * C. * * C. * ==>Called by : GINIT * C. * Author F.Carminati ********* * C. * * C. ****************************************************************** C. CHARACTER*60 CHTIT CHARACTER*6 CHFOR CHARACTER*8 CHVER * CHVER = ' ' HVERS = 0. * WRITE(CHTIT,'( +SEQ,QFTITLE,N=60. +)') DO 10 JSLASH=1,60 IF(CHTIT(JSLASH:JSLASH).EQ.'/') THEN JSL=JSLASH GOTO 20 ENDIF 10 CONTINUE GOTO 999 * 20 CONTINUE DO 30 JBLA=JSL,1,-1 IF(CHTIT(JBLA-1:JBLA-1).EQ.' ') THEN JBEG=JBLA GOTO 40 ENDIF 30 CONTINUE GOTO 999 * 40 CONTINUE DO 50 JBLA=JSL,60 IF(CHTIT(JBLA+1:JBLA+1).EQ.' ') THEN JEND=JBLA GOTO 60 ENDIF 50 CONTINUE GOTO 999 * 60 WRITE(CHFOR,'(''(F'',I1,''.2)'')') JSL-JBEG READ(CHTIT(JBEG:JSL-1),CHFOR) HMAIN READ(CHTIT(JSL+1:JEND),'(I2)') ISUBV HVERS=HMAIN+ISUBV*.001 NCHA=JEND-JBEG+1 CHVER=' ' IF(NCHA.EQ.8) THEN CHVER=CHTIT(JBEG:JEND) ELSE CHVER=' '//CHTIT(JBEG:JEND) ENDIF * 999 END +PATCH,GCONS +DECK,DOCGCONS,IF=DOC *CMZ : 3.15/09 07/04/92 16.45.30 by Federico Carminati *-- Author : Federico Carminati ************************************************************************ * * * Introduction to the section CONS * * -------------------------------- * * * * THE SECTION CONS * * * * The experimental setup is represented by a structure of * * geometrical volumes. Each volume is given a medium number by the * * user. Different volumes may have the same medium number [GEOM]. * * A medium is defined by a set of parameters, the so>-called * * 'tracking medium' parameters, which include reference to the * * material filling the volume. * * The tracking of particles through an experimental setup [TRAK] * * requires access to the data which describe * * - the geometrical setup, * * - the characteristics of the materials used, * * - the tracking medium parameters, and * * - the particle properties. * * The section CONS contains all routines related to the storage and * * retrieval of information for the materials, the tracking media and * * the particles. * * * * MATERIALS * * * * The material constants are stored in the data structure JMATE * * through the routine GMATE which defines the standard table of * * materials. They can be accessed with the routine GFMATE and * * printed with the routine GPMATE. * * GMATE calls the routine GSMATE for each material in turn. The * * user may directly use GSMATE instead of, or in addition to, or to * * partly override, GMATE. * * MIXTUREs of basic materials, or COMPOUNDs, molecules with atoms * * from different basic materials, may also be defined and their * * characteristics can be stored in the structure JMATE, through * * calls to the routine GSMIXT. Mixtures of compounds are also * * accepted. * * In addition, some quantities computed during the initialisation * * of the physics processes are stored in the structure JMATE , such * * as energy loss and cross>-section tables [PHYS]. * * * * TRACKING MEDIUM PARAMETERS * * * * For each medium in turn, the tracking medium parameters are * * stored in the data structure JTMED through the routine GSTMED. * * Details about these parameters are given in [TRAK]. They can be * * accessed with the routine GFTMED and printed with the routine * * GPTMED. * * The correct setting of the tracking media parameters is crucial * * for the correctness of the results of the simulation. In GEANT * * some of these parameters are calculated automatically by the * * program by default. This can be disabled by the data record AUTO * * 0, but only experienced users should use this option. * * The tracking cuts, the physics cuts and the flags which control * * the physics processes, defined in GINIT and possibly modified via * * the relevant data cards, are also stored in the structure JTMED. * * Any of these additional parameters can be modified through the * * routine GSTPAR. * * * * PARTICLES * * * * The particle constants are stored in the data structure JPART * * through the routine GPART which defines the standard table of * * particles and, if relevant, the branching ratios and decay modes. * * The standard particle constants can be accessed with the routine * * GFPART and printed with the routine GPPART. * * GPART calls the routine GSPART (and GSDK for the decays) for each * * particle in turn. The user may call directly GSPART and GSDK * * instead of, or in addition to, or to partly override, GPART. * * * ************************************************************************ +DECK,GEVKEV *CMZ : 3.15/09 03/04/92 15.13.32 by Federico Carminati *-- Author : SUBROUTINE GEVKEV(EGEV,ENERU,KUNIT) C. C. ****************************************************************** C. * * C. * Convert energy from GeV to more appropriate units * C. * * C. * ==>Called by : GPLMAT,GPRMAT,GPHYSI,GPCXYZ * C. * Author M.Maire ********* * C. * * C. ****************************************************************** C. CHARACTER*4 KUNIT * IF(EGEV.LT.0.0009999) THEN ENERU = EGEV*1.E+6 KUNIT = ' keV' ELSEIF(EGEV.LT.0.9999) THEN ENERU = EGEV*1.E+3 KUNIT = ' MeV' ELSEIF(EGEV.LT.999.9) THEN ENERU = EGEV KUNIT = ' GeV' ELSE ENERU = EGEV*1.E-3 KUNIT = ' TeV' ENDIF * END +DECK,GFCOUL *CMZ : 3.12/27 06/09/88 14.33.00 by Rene Brun *-- Author : FUNCTION GFCOUL(Z) C. C. ****************************************************************** C. * * C. * Compute Coulomb correction for pair production and Brem * C. * REFERENCE : EGS MANUAL SLAC 210 - UC32 - JUNE 78 * C. * FORMULA 2.7.17 * C. * * C. * ==>Called by : GSMIXT * C. * Author M.Maire ********* * C. * * C. ****************************************************************** C. DATA ALPHA / 7.29927E-03 / AZ2 = (ALPHA*Z)**2 AZ4 = AZ2 * AZ2 FP = ( 0.0083*AZ4 + 0.20206 + 1./(1.+AZ2) ) * AZ2 FM = ( 0.0020*AZ4 + 0.0369 ) * AZ4 GFCOUL = FP - FM END +DECK,GFMATE *CMZ : 3.15/01 20/02/91 19.32.20 by Federico Carminati *-- Author : SUBROUTINE GFMATE(IMAT,NAMATE,A,Z,DENS,RADL,ABSL,UBUF,NWBUF) C. C. ****************************************************************** C. * * C. * Return parameters for material IMAT * C. * * C. * ==>Called by : , GTRACK * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM CHARACTER NAMATE*(*) DIMENSION UBUF(1) C. C. ------------------------------------------------------------------ C. A=-1. IF (JMATE.LE.0)GO TO 99 IF (IMAT.LE.0)GO TO 99 IF (IMAT.GT.NMATE)GO TO 99 C JMA = LQ(JMATE- IMAT) IF (JMA.LE.0)GO TO 99 CALL UHTOC(IQ(JMA+1),4,NAMATE,20) A = Q(JMA + 6) Z = Q(JMA + 7) DENS = Q(JMA + 8) RADL = Q(JMA + 9) ABSL = Q(JMA + 10) NWBUF = IQ(JMA-1) - 11 IF(NWBUF.GT.0) CALL UCOPY(Q(JMA+12),UBUF,NWBUF) C 99 RETURN END +DECK,GFPART *CMZ : 3.15/01 11/04/91 09.29.41 by Federico Carminati *-- Author : SUBROUTINE GFPART(IPART,NAPART,ITRTYP,AMASS,CHARGE,TLIFE + ,UBUF,NWBUF) C. C. ****************************************************************** C. * * C. * Return parameters for particle of type IPART * C. * * C. * ==>Called by : , GTREVE * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM CHARACTER*20 NAPART DIMENSION UBUF(10) C. C. ------------------------------------------------------------------ C. ITRTYP=0 IF (JPART.LE.0)GO TO 99 IF (IPART.LE.0)GO TO 99 IF (IPART.GT.NPART)GO TO 99 JPA = LQ(JPART- IPART) IF (JPA.LE.0)GO TO 99 C CALL UHTOC(IQ(JPA+1),4,NAPART,20) ITRTYP = Q(JPA + 6) AMASS = Q(JPA + 7) CHARGE = Q(JPA + 8) TLIFE = Q(JPA + 9) NWBUF = IQ(JPA-1) - 9 IF(NWBUF.LE.0) GO TO 99 DO 20 I=1,NWBUF 20 UBUF(I)=Q(JPA+9+I) C 99 RETURN END +DECK,GFTITL *CMZ : 3.12/27 26/01/89 16.13.31 by Unknown *-- Author : SUBROUTINE GFTITL(IBUF,ITITLE) C. C. ****************************************************************** C. * * C. * Get title ITITLE (up to 20 characters) stored in * C. * 5 words of IBUF * C. * * C. * ==>Called by : GPMATE,GPPART,GPTMED,GPKINE,GPJXYZ * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. DIMENSION ITITLE(20),IBUF(5) C. C. ------------------------------------------------------------------ C. DO 10 I = 1,5 J = 4 * I - 3 10 CALL UBLOW (IBUF(I),ITITLE(J),4) C CALL GLOOK('$ ',ITITLE,20,ILAST) IF (ILAST.EQ.0)GO TO 99 C CALL VBLANK (ITITLE(ILAST),20-ILAST+1) C 99 RETURN END +DECK,GFTMAT *CMZ : 3.15/01 24/02/92 12.42.08 by Federico Carminati *-- Author : SUBROUTINE GFTMAT(IMATE,IPART,MECA,KDIM,TKIN,VALUE,PCUT,IXST) C. C. ****************************************************************** C. * * C. * FETCH and INTERPOLATE the DE/DX and Cross sections * C. * tabulated in JMATE banks coresponding to : * C. * material IMATE, particle IPART, mecanism name MECA, * C. * kinetic energies TKIN * C. * * C. * The MECAnism name can be : * C. * 'LOSS' 'PHOT' 'ANNI' 'COMP' 'MUNU' 'BREM' * C. * 'PAIR' 'DRAY' 'PFIS' 'HADT' 'HADG' 'RAYL' * C. * 'RANG' 'STEP' * C. * * C. * For Hadronic particles it also computes the total * C. * hadronic cross section from TATINA ( 'HADT' ) or * C. * GHEISHA ( 'HADG' ) programs * C. * * C. * Input parameters * C. * IMATE Geant material number * C. * IPART Geant particle number * C. * MECA mechanism name of the bank to be fetched * C. * KDIM dimension of the arrays TKIN , VALUE * C. * TKIN array of kinetic energy of incident particle (in Gev) * C. * * C. * Output parameters * C. * VALUE array of energy loss (in Mev/cm) , * C. * or stopping range (cm) ,or continuous step (cm) * C. * or macroscopic cross section (in 1/cm) * C. * PCUT(5) array of the physical cuts in material IMATE (Gev) * C. * IXST flag = 1 if the array VALUE is filled , =0 otherwise * C. * * C. * ==>Called by : GPLMAT GRPMAT * C. * Authors R.Brun, M.Maire ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCNUM. +SEQ,GCONSP. +SEQ,GCUNIT. +SEQ,GCMULO +SEQ,GSECTI. * CHARACTER*4 MECA DIMENSION TKIN(KDIM), VALUE(KDIM), PCUT(5) * * ------------------------------------------------------------------ * IXST = 0 IF(KDIM.LE.0) GO TO 999 CALL VZERO(VALUE,KDIM) CALL VZERO( PCUT,5) * IF(JMATE.LE.0) GO TO 999 IF(IMATE.LE.0) GO TO 999 IF(IMATE.GT.NMATE) GO TO 990 JMA = LQ(JMATE-IMATE) IF(JMA.LE.0) GO TO 990 A = Q(JMA+6) Z = Q(JMA+7) DENS = Q(JMA+8) RADL = Q(JMA+9) NLM = Q(JMA+11) JPROB = LQ(JMA-4) AZRO = Q(JPROB+8) AHEFF = A IF(NLM .GT.1) THEN JMIXT = LQ(JMA-5) JMI1 = LQ(JMIXT-1) AHEFF = Q(JMI1+1) ENDIF * IF(JTMED.LE.0) GO TO 999 IF(NTMED.LE.0) GO TO 999 JBANK = JTMED DO 15 ITM = 1,NTMED JTM = LQ(JTMED-ITM) IF(JTM.LE.0) GO TO 15 JTMN = 0 IMAT = Q(JTM+6) IF(IMAT.EQ.IMATE) THEN JTMN = LQ(JTM) IF(JTMN.NE.0) JBANK = JTMN GO TO 16 ENDIF 15 CONTINUE 16 CALL UCOPY( Q(JBANK+6),PCUT(1),5) CUTHAD = Q(JBANK+ 4) ILOSS = Q(JBANK+21) IMULS = Q(JBANK+22) IFIELD = Q(JTM + 8) FIELDM = Q(JTM + 9) TMAXFD = Q(JTM + 10) STEMAX = Q(JTM + 11) DEEMAX = Q(JTM + 12) STMIN = Q(JTM + 14) * IF(JPART.LE.0) GO TO 999 IF(IPART.LE.0) GO TO 999 IF(IPART.GT.NPART) GO TO 990 JPA = LQ(JPART-IPART) IF(JPA.LE.0) GO TO 990 ITYPE = Q(JPA+6) AMASS = Q(JPA+7) CHARGE = Q(JPA+8) * * *** Find the correct pointer * JBANK = 0 ISHIF = 0 RMASS = 1. * * *** Photons * IF (ITYPE.EQ.1) THEN IF (MECA.EQ.'PHOT') JBANK = LQ(JMA- 6) IF (MECA.EQ.'COMP') JBANK = LQ(JMA- 8) IF (MECA.EQ.'PAIR') JBANK = LQ(JMA-10) IF (MECA.EQ.'PFIS') JBANK = LQ(JMA-12) IF (MECA.EQ.'RAYL') JBANK = LQ(JMA-13) * * *** Electrons / positons * ELSE IF (ITYPE.EQ.2) THEN IF (MECA.EQ.'LOSS') THEN JBANK = LQ(JMA- 1) IF (CHARGE.GT.0.) ISHIF = NEK1 ELSE IF (MECA.EQ.'RANG') THEN JBANK = LQ(JMA- 15) IF (CHARGE.GT.0.) ISHIF = NEK1 ELSE IF (MECA.EQ.'STEP') THEN JBANK = LQ(JTM- 1) ELSE IF ((MECA.EQ.'ANNI').AND.(CHARGE.GT.0.)) THEN JBANK = LQ(JMA- 7) ELSE IF (MECA.EQ.'BREM') THEN JBANK = LQ(JMA- 9) ELSE IF (MECA.EQ.'DRAY') THEN JBANK = LQ(JMA-11) IF (CHARGE.GT.0.) ISHIF = NEK1 ENDIF * * *** Neutral hadrons * ELSE IF (ITYPE.EQ.3) THEN IF(Z.LT.1.) GO TO 999 IF (MECA.EQ.'HADG') THEN JBANK = -3 CALL GHEINI K0OLD = K0FLAG ELSE IF (MECA.EQ.'HADT') THEN JBANK = -4 ENDIF * * *** Charged hadrons * ELSE IF (ITYPE.EQ.4) THEN IF(Z.LT.1.) GO TO 999 RMASS = PMASS/AMASS IF (MECA.EQ.'LOSS') THEN JBANK = LQ(JMA- 3) ELSE IF (MECA.EQ.'RANG') THEN JBANK = LQ(JMA- 16) + NEK1 ELSE IF (MECA.EQ.'STEP') THEN JBANK = -1 JRANG = LQ(JMA -16) + NEK1 CUTPRO = CUTHAD*RMASS CUTPRO = MAX(ELOW(1), MIN( CUTPRO, ELOW(NEK1)*0.99)) IKCUT = GEKA*LOG10(CUTPRO) + GEKB GKC = (CUTPRO - ELOW(IKCUT))/(ELOW(IKCUT+1) - ELOW(IKCUT)) STOPC = (1.-GKC)*Q(JRANG+IKCUT) + GKC*Q(JRANG+IKCUT+1) ELSE IF (MECA.EQ.'DRAY') THEN JBANK = -2 JPROB = LQ(JMA-4) AZRO = Q(JPROB+17) DCUTM = PCUT(4) ELSE IF (MECA.EQ.'HADG') THEN JBANK = -3 CALL GHEINI K0OLD = K0FLAG ELSE IF (MECA.EQ.'HADT') THEN JBANK = -4 ENDIF * * *** Muons * ELSE IF (ITYPE.EQ.5) THEN IF (MECA.EQ.'LOSS') THEN JBANK = LQ(JMA- 2) ELSE IF (MECA.EQ.'RANG') THEN JBANK = LQ(JMA- 16) ELSE IF (MECA.EQ.'STEP') THEN JBANK = LQ(JTM- 2) ELSE IF (MECA.EQ.'MUNU') THEN JBANK = LQ(JMA- 6) ELSE IF (MECA.EQ.'BREM') THEN JBANK = LQ(JMA- 9) ISHIF = NEK1 ELSE IF (MECA.EQ.'PAIR') THEN JBANK = LQ(JMA- 10) ISHIF = NEK1 ELSE IF (MECA.EQ.'DRAY') THEN JBANK = LQ(JMA-11) ISHIF = 2*NEK1 ENDIF * ENDIF IF(JBANK.EQ.0) GO TO 999 IXST = 1 * * JBANK = JBANK + ISHIF DO 101 IKB = 1,KDIM * Find bin number in table JMATE EKP = TKIN(IKB)*RMASS EKP = MAX(ELOW(1), MIN( EKP, ELOW(NEK1)*0.99)) IKP=GEKA*LOG10(EKP)+GEKB +0.001 GKRA=(EKP-ELOW(IKP))/(ELOW(IKP+1)-ELOW(IKP)) * IF(JBANK.GT.0) THEN * Retieve value from bank JMATE VALUE(IKB) = (1.-GKRA)*Q(JBANK+IKP) + GKRA*Q(JBANK+IKP+1) IF ((MECA.EQ.'PHOT').AND.(EKP.GE.0.05 )) VALUE(IKB) = BIG IF ((MECA.EQ.'MUNU').AND.(EKP.LT.0.05 )) VALUE(IKB) = BIG IF ( MECA.EQ.'LOSS') THEN VALUE(IKB) = VALUE(IKB)*CHARGE*CHARGE*1.E+3 ELSE IF (MECA.EQ.'RANG') THEN VALUE(IKB) = VALUE(IKB)/(RMASS*CHARGE*CHARGE) ELSE IF (MECA.NE.'STEP') THEN IF (VALUE(IKB).GT.0.) THEN VALUE(IKB) = 1./VALUE(IKB) ELSE VALUE(IKB) = 1./BIG ENDIF ENDIF * ELSEIF (JBANK.EQ.-1) THEN * Compute step due to muls + loss + field GEKIN=TKIN(IKB) GETOT=GEKIN+AMASS PMOM =SQRT(GEKIN*(GETOT+AMASS)) SFIELD = BIG SMULS = BIG SLOSS = BIG STOPMX = BIG IF (IFIELD*FIELDM.NE.0.) + SFIELD = 3333.*DEGRAD*TMAXFD*PMOM/ABS(FIELDM*CHARGE) IF (IMULS.GT.0.) + SMULS = MIN (2232.*RADL*((PMOM**2)/(GETOT*CHARGE))**2 , + 10.*RADL ) IF (ILOSS*DEEMAX.GT.0.) THEN STOPP = (1.-GKRA)*Q(JRANG+IKP) + GKRA*Q(JRANG+IKP+1) STOPMX = (STOPP - STOPC)/(RMASS*CHARGE*CHARGE) IF (STOPMX.LT.0.) STOPMX = 0. EKF = MAX ( ELOW(1) , (1.-DEEMAX)*EKP ) IKF = GEKA*LOG10(EKF) + GEKB GKF = (EKF-ELOW(IKF))/(ELOW(IKF+1)-ELOW(IKF)) SLOSP= STOPP - (1.-GKF)*Q(JRANG+IKF) - GKF*Q(JRANG+IKF+1) SLOSS = SLOSP/(RMASS*CHARGE*CHARGE) ENDIF * IF (STOPMX.LE.STMIN) THEN VALUE(IKB) = STOPMX ELSE VALUE(IKB) = MAX(STMIN, MIN(SLOSS,SFIELD,SMULS,STEMAX) ) ENDIF * ELSEIF (JBANK.EQ.-2) THEN * Compute delta ray cross section for hadrons GEKIN=TKIN(IKB) GETOT=GEKIN+AMASS GAMASS=GETOT+AMASS BET2=GEKIN*GAMASS/(GETOT*GETOT) TMAX=EMASS*GEKIN*GAMASS/(0.5*AMASS*AMASS+EMASS*GETOT) IF(TMAX.GT.DCUTM)THEN Y=DCUTM/TMAX SIG=(1.-Y+BET2*Y*LOG(Y))/DCUTM IF(AMASS.GT.0.9)SIG=SIG+0.5*(TMAX-DCUTM)/(GETOT*GETOT) VALUE(IKB)=SIG*AZRO*CHARGE*CHARGE*EMASS/BET2 ELSE VALUE(IKB)=1./BIG ENDIF * ELSEIF (JBANK.EQ.-3) THEN * compute hadronic cross section from GHEISHA code GEKIN=TKIN(IKB) PMOM = SQRT(GEKIN*(GEKIN+2*AMASS)) K0FLAG = 1 GHCOR1 = 0. IF(JTMN.GT.0) GHCOR1=Q(JTMN+26) IF(NLM.GT.1) THEN VALUE(IKB)=GHESIG(PMOM,GEKIN,A,Q(JMIXT+1), * Q(JMIXT+NLM+1),Q(JMIXT+2*NLM+1),NLM,DENS,GHCOR1,IPART) ELSE VALUE(IKB)=GHESIG(PMOM,GEKIN,A,A,Z,1.,1,DENS,GHCOR1,IPART) ENDIF IF(VALUE(IKB).LE.0.) VALUE(IKB) = 1./BIG K0FLAG = K0OLD * ELSEIF (JBANK.EQ.-4) THEN * compute hadronic cross section from TATINA code GEKIN=TKIN(IKB) PMOM = SQRT(GEKIN*(GEKIN+2*AMASS)) VALUE(IKB) = GHSIGM(PMOM,IPART,AHEFF)/AZRO IF(VALUE(IKB).LE.0.) VALUE(IKB) = 1./BIG ENDIF 101 CONTINUE * GO TO 999 990 WRITE(CHMAIL,1000) IMATE ,IPART CALL GMAIL(0,0) * 1000 FORMAT(' ***** GFTMAT error : material',I4, * ' or particle',I4,' not defined' ) 999 END +DECK,GFTMED *CMZ : 3.15/03 23/03/92 13.55.16 by Federico Carminati *-- Author : SUBROUTINE GFTMED(NUMED,NATMED,NMAT,ISVOL,IFIELD,FIELDM, + TMAXFD,STEMAX,DEEMAX,EPSIL,STMIN,UBUF,NWBUF) C. C. ****************************************************************** C. * * C. * Return parameters for tracking medium NUMED * C. * * C. * ==>Called by : , GTRACK * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM CHARACTER*20 NATMED DIMENSION UBUF(1) C. C. ------------------------------------------------------------------ C. NMAT=0 IF (JTMED.LE.0)GO TO 99 IF (NUMED.LE.0)GO TO 99 IF (NUMED.GT.NTMED)GO TO 99 JTM = LQ(JTMED- NUMED) IF (JTM.LE.0)GO TO 99 C CALL UHTOC(IQ(JTM+1),4,NATMED,20) NMAT = Q(JTM + 6) ISVOL = Q(JTM + 7) IFIELD = Q(JTM + 8) FIELDM = Q(JTM + 9) TMAXFD = Q(JTM + 10) STEMAX = Q(JTM + 11) DEEMAX = Q(JTM + 12) EPSIL = Q(JTM + 13) STMIN = Q(JTM + 14) NWBUF = IQ(JTM-1) - 14 IF(NWBUF.LE.0) GO TO 99 DO 20 I=1,NWBUF 20 UBUF(I)=Q(JTM+14+I) C 99 RETURN END +DECK,GHMIX *CMZ : 3.12/27 06/09/88 14.33.01 by Rene Brun *-- Author : SUBROUTINE GHMIX(A, W, N, AEFF) C C ****************************************************************** C * * C * Works out an effective atomic weight AEFF for a material * C * with N elements of atomic weight A(I) in proportion W(I) by * C * weight. The criterion is that the hadronic interaction * C * length of a 5 GeV/c pion is correct. Errors on the calculated * C * hadronic interaction length for other momenta and other * C * particles in GEANT version 3.04 are less than 1% in most cases.* C * For details see Memorandum OPAL/0037N/JA/md, ref. Hadron * C * Milestone 84/003, Calculation of Hadronic Interaction Lengths * C * for Mixtures. * C. * * C. * ==>Called by : GSMIXT * C. * Author J.Allison ********* * C * * C ****************************************************************** C +SEQ,GCUNIT DIMENSION A(N), W(N) C. C. ------------------------------------------------------------------ C. C Work out PINT which is proportional to the interaction C probability. Also work out the mean atomic weight, i.e. that C weighted by proportion by numbers, as starting value for C iterative method of finding AEFF. C PINT = 0. AINV = 0. WTOT = 0. DO 10 I = 1, N PINT = PINT + W(I) * GHSIGM(5., 8, A(I)) / A(I) AINV = AINV + W(I) / A(I) WTOT = WTOT + W(I) 10 CONTINUE C IF ( ABS ( WTOT - 1. ) .GT. 0.01 ) GO TO 98 C C Work out AEFF which gives PINT for 5 GeV/c pion. C (This is a short Newton's method loop.) C AEFF = 1. / AINV PNEW = GHSIGM ( 5., 8, AEFF ) / AEFF DA = 1. ITER = 0 20 CONTINUE ITER = ITER + 1 AEFF = AEFF + DA POLD = PNEW DAOLD = DA PNEW = GHSIGM ( 5., 8, AEFF ) / AEFF DP = PNEW - POLD DA = (PINT - PNEW ) * DAOLD / DP IF ( ( ITER .GT. 1 ) .AND. ( ABS ( DA ) .GT. ABS ( DAOLD ) ) ) + GO TO 97 IF ( ABS ( DA ) .GT. 0.01 ) GO TO 20 C RETURN C C Error conditions. C 97 CONTINUE WRITE (CHMAIL,197) CALL GMAIL(0,0) 197 FORMAT ( ' ***** GHMIX : ', +'HADRONIC INTERACTION MIXTURE ROUTINE NOT CONVERGING') RETURN C 98 CONTINUE WRITE (CHMAIL,198) WTOT CALL GMAIL(0,0) 198 FORMAT ( ' ***** GHMIX : ', +'FRACTIONS BY WEIGHT OF MIXTURES DO NOT ADD UP TO 1',F10.4) END +DECK,GMATE *CMZ : 3.15/01 16/03/92 09.16.29 by Federico Carminati *-- Author : SUBROUTINE GMATE C. C. ****************************************************************** C. * * C. * Define standard GEANT materials * C. * * C. * All data EXCEPT for nuclear absorption lengths taken from : * C. * M. Aguilar-Benitez et al, * C. * Rev. of Particle Properties, * C. * Rev. Mod. Phys. 56(1984) * C. * * C. * ==>Called by : , UGINIT * C. * Author G.Patrick ********* * C. * * C. ****************************************************************** C. DIMENSION UBUF(1) DATA UBUF/0./ C CALL GSMATE( 1,'HYDROGEN$ ', 1.01, 1.,0.0708,865.,790.,UBUF,0) CALL GSMATE( 2,'DEUTERIUM$', 2.01, 1.,0.162 ,757.,342.,UBUF,0) CALL GSMATE( 3,'HELIUM$ ', 4. , 2.,0.125 ,755.,478.,UBUF,0) CALL GSMATE( 4,'LITHIUM$ ', 6.94, 3.,0.534 ,155.,120.6,UBUF,0) CALL GSMATE( 5,'BERILLIUM$', 9.01, 4.,1.848 ,35.3,36.7,UBUF,0) CALL GSMATE( 6,'CARBON$ ', 12.01, 6.,2.265 ,18.8,49.9,UBUF,0) CALL GSMATE( 7,'NITROGEN$ ', 14.01, 7.,0.808 ,44.5,99.4,UBUF,0) CALL GSMATE( 8,'NEON$ ', 20.18,10.,1.207 , 24.,74.9,UBUF,0) CALL GSMATE( 9,'ALUMINIUM$', 26.98,13.,2.7 , 8.9,37.2,UBUF,0) CALL GSMATE(10,'IRON$ ', 55.85,26.,7.87 ,1.76,17.1,UBUF,0) CALL GSMATE(11,'COPPER$ ', 63.54,29.,8.96 ,1.43,14.8,UBUF,0) CALL GSMATE(12,'TUNGSTEN$ ',183.85,74.,19.3 ,0.35,10.3,UBUF,0) CALL GSMATE(13,'LEAD$ ',207.19,82.,11.35 ,0.56,18.5,UBUF,0) CALL GSMATE(14,'URANIUM$ ',238.03,92.,18.95 ,0.32,12. ,UBUF,0) CALL GSMATE(15,'AIR$ ',14.61,7.3,0.001205,30423.24,67500. + ,UBUF,0) CALL GSMATE(16,'VACUUM$ ',1.E-16,1.E-16,1.E-16,1.E+16,1.E+16 + ,UBUF,0) C END +DECK,GPART *CMZ : 3.15/01 16/03/92 09.17.04 by Federico Carminati *-- Author : SUBROUTINE GPART C. C. ******************************************************************* C. * * C. * Define standard GEANT particles plus selected decay modes * C. * and branching ratios. * C. * * C. * All data taken from : M. AGUILAR-BENITEZ et al, * C. * Review of Particle Properties, * C. * Rev. Mod. Phys. 56(1984). * C. * * C. * In the case of W and Z, the lifetimes are calculated from * C. * quoted upper limits on widths. * C. * * C. * NPAR Number of parent particles defined for decay. * C. * IPAR List of parent partilces allowed to decay. * C. * Currently set up for pi0,pi+,pi-,K0long,K+,K-, * C. * K0short,eta,lambda,sigma+,sigma0,sigma-,xi0, * C. * xi-,omega-,antilambda,antisigma -,antisigma 0, * C. * antisigma +,antixi 0,antixi +,antiomega + * C. * decays. * C. * MODE(I,J) I'th decay mode of J'th particle defined in * C. * IPAR. * C. * BRATIO(I,J) Branching ratio for I'th decay mode of J'th * C. * particle in IPAR. * C. * * C. * ==>Called by : , UGINIT * C. * Author G.Patrick ********* * C. * * C. ******************************************************************* C. +SEQ,GCBANK +SEQ,GCPHYS +SEQ,GCONSP C DIMENSION BRATIO(6,24),BRTIO1(6,20),BRTIO2(6,4) DIMENSION IPAR(24) DIMENSION MODE(6,24),MODE1(6,20),MODE2(6,4) DIMENSION UBUF(1) C EQUIVALENCE(BRTIO1(1,1),BRATIO(1,1)),(BRTIO2(1,1),BRATIO(1,21)) EQUIVALENCE(MODE1(1,1),MODE(1,1)),(MODE2(1,1),MODE(1,21)) C DATA IPAR/ 7, 8, 9,10,11,12,16,17,18,19,20,21,22,23,24,26,27, * 28,29,30,31,32,5,6/ DATA BRTIO1/ 98.802, 1.198, 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 21.50, 19.35, 19.35, 13.55, 13.55, 12.39, * 63.50, 21.16, 5.59, 4.82, 3.20, 1.73, * 63.50, 21.16, 5.59, 4.82, 3.20, 1.73, * 68.61, 31.39, 0., 0., 0., 0., * 39.10, 31.80, 23.7, 4.91, 0.5, 0., * 64.20, 35.80, 0., 0., 0., 0., * 51.64, 48.36, 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 68.60, 23.40, 8.00, 0., 0., 0., * 64.20, 35.80, 0., 0., 0., 0., * 51.64, 48.36, 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0./ DATA BRTIO2/100.00, 0., 0., 0., 0., 0., * 68.60, 23.40, 8.00, 0., 0., 0., * 100.00, 0., 0., 0., 0., 0., * 100.00, 0., 0., 0., 0., 0./ DATA MODE1/ 101,30201, 0, 0, 0, 0, * 405, 0, 0, 0, 0, 0, * 406, 0, 0, 0, 0, 0, * 70707,40308,40209,40608,40509,70908, * 405, 708,90808,70402,70405,70708, * 406, 709,80909,70403,70406,70709, * 908, 707, 0, 0, 0, 0, * 101,70707,70908,10908,10302, 0, * 914, 713, 0, 0, 0, 0, * 714, 813, 0, 0, 0, 0, * 118, 0, 0, 0, 0, 0, * 913, 0, 0, 0, 0, 0, * 718, 0, 0, 0, 0, 0, * 918, 0, 0, 0, 0, 0, * 1218, 922, 723, 0, 0, 0, * 815, 725, 0, 0, 0, 0, * 715, 925, 0, 0, 0, 0, * 126, 0, 0, 0, 0, 0, * 825, 0, 0, 0, 0, 0, * 726, 0, 0, 0, 0, 0/ DATA MODE2/ 826, 0, 0, 0, 0, 0, * 1126, 830, 731, 0, 0, 0, * 40402, 0, 0, 0, 0, 0, * 40403, 0, 0, 0, 0, 0/ DATA NPAR/24/ DATA UBUF/0./ C. C. ------------------------------------------------------------------- C. REMASS=EMASS REMMU =EMMU RPMASS=PMASS CALL GSPART( 1,'GAMMA$ ',1,0. , 0.,1.000000E+15,UBUF,0) CALL GSPART( 2,'POSITRON$ ',2,REMASS , 1.,1.000000E+15,UBUF,0) CALL GSPART( 3,'ELECTRON$ ',2,REMASS ,-1.,1.000000E+15,UBUF,0) CALL GSPART( 4,'NEUTRINO$ ',3,0. , 0.,1.000000E+15,UBUF,0) CALL GSPART( 5,'MUON +$ ',5,REMMU , 1.,2.197030E-06,UBUF,0) CALL GSPART( 6,'MUON -$ ',5,REMMU ,-1.,2.197030E-06,UBUF,0) CALL GSPART( 7,'PION 0$ ',3,0.134973, 0.,0.840000E-16,UBUF,0) CALL GSPART( 8,'PION +$ ',4,0.139567, 1.,2.603000E-08,UBUF,0) CALL GSPART( 9,'PION -$ ',4,0.139567,-1.,2.603000E-08,UBUF,0) CALL GSPART(10,'KAON 0 LONG$ ',3,0.49767 , 0.,5.183000E-08,UBUF,0) CALL GSPART(11,'KAON +$ ',4,0.493646, 1.,1.237100E-08,UBUF,0) CALL GSPART(12,'KAON -$ ',4,0.493646,-1.,1.237100E-08,UBUF,0) CALL GSPART(13,'NEUTRON$ ',3,0.939566, 0.,8.960000E+02,UBUF,0) CALL GSPART(14,'PROTON$ ',4,RPMASS , 1.,1.000000E+15,UBUF,0) CALL GSPART(15,'ANTIPROTON$ ',4,RPMASS ,-1.,1.000000E+15,UBUF,0) CALL GSPART(16,'KAON 0 SHORT$',3,0.49767 , 0.,8.922000E-11,UBUF,0) CALL GSPART(17,'ETA$ ',3,0.5488 , 0.,7.479742E-19,UBUF,0) CALL GSPART(18,'LAMBDA$ ',3,1.11563 , 0.,2.631000E-10,UBUF,0) CALL GSPART(19,'SIGMA +$ ',4,1.18937 , 1.,0.800000E-10,UBUF,0) CALL GSPART(20,'SIGMA 0$ ',3,1.19255 , 0.,7.400000E-20,UBUF,0) CALL GSPART(21,'SIGMA -$ ',4,1.19743 ,-1.,1.479000E-10,UBUF,0) CALL GSPART(22,'XI 0$ ',3,1.3149 , 0.,2.900000E-10,UBUF,0) CALL GSPART(23,'XI -$ ',4,1.32132 ,-1.,1.639000E-10,UBUF,0) CALL GSPART(24,'OMEGA -$ ',4,1.67243 ,-1.,0.822000E-10,UBUF,0) CALL GSPART(25,'ANTINEUTRON$ ',3,0.939566, 0.,8.960000E+02,UBUF,0) CALL GSPART(26,'ANTILAMBDA$ ',3,1.11563 , 0.,2.631000E-10,UBUF,0) CALL GSPART(27,'ANTISIGMA -$ ',4,1.18937 ,-1.,0.800000E-10,UBUF,0) CALL GSPART(28,'ANTISIGMA 0$ ',3,1.19255 , 0.,7.400000E-20,UBUF,0) CALL GSPART(29,'ANTISIGMA +$ ',4,1.19743 , 1.,1.479000E-10,UBUF,0) CALL GSPART(30,'ANTIXI 0$ ',3,1.3149 , 0.,2.900000E-10,UBUF,0) CALL GSPART(31,'ANTIXI +$ ',4,1.32132 , 1.,1.639000E-10,UBUF,0) CALL GSPART(32,'ANTIOMEGA +$ ',4,1.67243 , 1.,0.822000E-10,UBUF,0) CALL GSPART(33,'TAU +$ ',4,1.7841 , 1.,3.040000E-13,UBUF,0) CALL GSPART(34,'TAU -$ ',4,1.7841 ,-1.,3.040000E-13,UBUF,0) CALL GSPART(35,'D +$ ',4,1.8693 , 1.,1.062000E-12,UBUF,0) CALL GSPART(36,'D -$ ',4,1.8693 ,-1.,1.062000E-12,UBUF,0) CALL GSPART(37,'D 0$ ',3,1.8645 , 0.,4.280000E-13,UBUF,0) CALL GSPART(38,'ANTI D 0$ ',3,1.8645 , 0.,4.280000E-13,UBUF,0) CALL GSPART(39,'DS+$ ',4,1.9693 , 1.,4.360000E-13,UBUF,0) CALL GSPART(40,'DS-$ ',4,1.9693 ,-1.,4.360000E-13,UBUF,0) CALL GSPART(41,'LAMBDA C +$ ',4,2.2849 , 1.,1.790000E-13,UBUF,0) CALL GSPART(42,'W +$ ',4,81.000 , 1.,9.400000E-26,UBUF,0) CALL GSPART(43,'W -$ ',4,81.000 ,-1.,9.400000E-26,UBUF,0) CALL GSPART(44,'Z 0$ ',3,92.400 , 0.,7.740000E-26,UBUF,0) CALL GSPART(45,'DEUTERON$ ',4,1.875613,+1.,1.000000E+15,UBUF,0) CALL GSPART(46,'TRITON$ ',4,2.81448 ,+1.,1.000000E+15,UBUF,0) CALL GSPART(47,'ALPHA$ ',4,3.727417,+2.,1.000000E+15,UBUF,0) CALL GSPART(48,'GEANTINO$ ',6,0. , 0.,1.000000E+15,UBUF,0) CALL GSPART(49,'HE3$ ',4,2.81448 ,+2.,1.000000E+15,UBUF,0) C C Define decay modes. C IF (IDCAY.LE.0) GO TO 99 DO 10 I=1,NPAR CALL GSDK(IPAR(I),BRATIO(1,I),MODE(1,I)) 10 CONTINUE C 99 RETURN END +DECK,GPIONS. *CMZ : 3.15/01 16/03/92 09.16.07 by Federico Carminati *-- Author : M.Maire 10/07/90 SUBROUTINE GPIONS C. C. ******************************************************************* C. * * C. * Define a subset of the 'stable' most common elements * C. * in the Nature * C. * * C. * ==>Called by : , UGINIT * C. * Author B.Grosdidier (Strasbourg) ***** * C. * * C. ******************************************************************* C. DIMENSION UBUF(1) DATA UBUF/0./ * * The Geant particle identification begin to IPART = 61 CALL GSPART( 61,'LI6 ',4, 5.60305, 3., 1000., UBUF,0) CALL GSPART( 62,'LI7 ',4, 6.53536, 3., 1000., UBUF,0) CALL GSPART( 63,'BE7 ',4, 6.53622, 4., 1000., UBUF,0) CALL GSPART( 64,'BE9 ',4, 8.39479, 4., 1000., UBUF,0) CALL GSPART( 65,'B10 ',4, 9.32699, 5., 1000., UBUF,0) CALL GSPART( 66,'B11 ',4, 10.25510, 5., 1000., UBUF,0) CALL GSPART( 67,'C12 ',4, 11.17793, 6., 1000., UBUF,0) CALL GSPART( 68,'N14 ',4, 13.04378, 7., 1000., UBUF,0) CALL GSPART( 69,'O16 ',4, 14.89917, 8., 1000., UBUF,0) CALL GSPART( 70,'F19 ',4, 17.69690, 9., 1000., UBUF,0) CALL GSPART( 71,'NE20 ',4, 18.62284, 10., 1000., UBUF,0) CALL GSPART( 72,'NA23 ',4, 21.41483, 11., 1000., UBUF,0) CALL GSPART( 73,'MG24 ',4, 22.34193, 12., 1000., UBUF,0) CALL GSPART( 74,'AL27 ',4, 25.13314, 13., 1000., UBUF,0) CALL GSPART( 75,'SI28 ',4, 26.06034, 14., 1000., UBUF,0) CALL GSPART( 76,'P31 ',4, 28.85188, 15., 1000., UBUF,0) CALL GSPART( 77,'S32 ',4, 29.78180, 16., 1000., UBUF,0) CALL GSPART( 78,'CL35 ',4, 32.57328, 17., 1000., UBUF,0) CALL GSPART( 79,'AR36 ',4, 33.50356, 18., 1000., UBUF,0) CALL GSPART( 80,'K39 ',4, 36.29447, 19., 1000., UBUF,0) CALL GSPART( 81,'CA40 ',4, 37.22492, 20., 1000., UBUF,0) CALL GSPART( 82,'SC45 ',4, 41.87617, 21., 1000., UBUF,0) CALL GSPART( 83,'TI48 ',4, 44.66324, 22., 1000., UBUF,0) CALL GSPART( 84,'V51 ',4, 47.45401, 23., 1000., UBUF,0) CALL GSPART( 85,'CR52 ',4, 48.38228, 24., 1000., UBUF,0) CALL GSPART( 86,'MN55 ',4, 51.17447, 25., 1000., UBUF,0) CALL GSPART( 87,'FE56 ',4, 52.10307, 26., 1000., UBUF,0) CALL GSPART( 88,'CO59 ',4, 54.89593, 27., 1000., UBUF,0) CALL GSPART( 89,'NI58 ',4, 53.96644, 28., 1000., UBUF,0) CALL GSPART( 90,'CU63 ',4, 58.61856, 29., 1000., UBUF,0) CALL GSPART( 91,'ZN64 ',4, 59.54963, 30., 1000., UBUF,0) CALL GSPART( 92,'GE74 ',4, 68.85715, 32., 1000., UBUF,0) CALL GSPART( 93,'SE80 ',4, 74.44178, 34., 1000., UBUF,0) CALL GSPART( 94,'KR84 ',4, 78.16309, 36., 1000., UBUF,0) CALL GSPART( 95,'SR88 ',4, 81.88358, 38., 1000., UBUF,0) CALL GSPART( 96,'ZR90 ',4, 83.74571, 40., 1000., UBUF,0) CALL GSPART( 97,'MO98 ',4, 91.19832, 42., 1000., UBUF,0) CALL GSPART( 98,'PD106',4, 98.64997, 46., 1000., UBUF,0) CALL GSPART( 99,'CD114',4, 106.10997, 48., 1000., UBUF,0) CALL GSPART(100,'SN120',4, 111.68821, 50., 1000., UBUF,0) CALL GSPART(101,'XE132',4, 122.86796, 54., 1000., UBUF,0) CALL GSPART(102,'BA138',4, 128.45793, 56., 1000., UBUF,0) CALL GSPART(103,'CE140',4, 130.32111, 58., 1000., UBUF,0) CALL GSPART(104,'SM152',4, 141.51236, 62., 1000., UBUF,0) CALL GSPART(105,'DY164',4, 152.69909, 66., 1000., UBUF,0) CALL GSPART(106,'YB174',4, 162.02245, 70., 1000., UBUF,0) CALL GSPART(107,'W184 ',4, 171.34924, 74., 1000., UBUF,0) CALL GSPART(108,'PT194',4, 180.67513, 78., 1000., UBUF,0) CALL GSPART(109,'AU197',4, 183.47324, 79., 1000., UBUF,0) CALL GSPART(110,'HG202',4, 188.13451, 80., 1000., UBUF,0) CALL GSPART(111,'PB208',4, 193.72907, 82., 1000., UBUF,0) CALL GSPART(112,'U238 ',4, 221.74295, 92., 1000., UBUF,0) * END +DECK,GPLMAT. *CMZ : 3.15/01 24/02/92 12.52.17 by Federico Carminati *-- Author : Federico Carminati 23/04/91 SUBROUTINE GPLMAT(IMATE,IPART,MECAN,KDIN,TKIN,IDM) C. C. ****************************************************************** C. * * C. * INTERPOLATE and PLOT the DE/DX and Cross sections * C. * tabulated in JMATE banks corresponding to : * C. * material IMATE, particle IPART, mecanism name MECAN , * C. * kinetic energies TKIN * C. * * C. * The MECAnism name can be : * C. * 'LOSS' 'RANG' 'STEP' 'PHOT' 'ANNI' 'COMP' * C. * 'MUNU' 'BREM' 'PAIR' 'DRAY' 'PFIS' 'RAYL' * C. * 'HADG' * C. * * C. * For Hadronic particles it compute the total hadronic * C. * cross section from Gheisha ('HADG') * C. * * C. * Input parameters * C. * IMATE Geant material number * C. * IPART Geant particle number * C. * MECAN mechanism name of the bank(s) to be ploted. * C. * if mecan = 'ALL' all the relevant banks for * C. * particle IPART will be ploted , plus the total * C. * cross section and total mean free path. * C. * KDIN dimension of the array TKIN (maximum 100) * C. * TKIN array of kinetic energy of incident particle (in Gev) * C. * IDM convention for histogramming mode : * C. * IDM.gt.0 fill , print , keep histogram(s) * C. * IDM.eq.0 fill , print , delete histogram(s) * C. * IDM.lt.0 fill , noprint , keep histogram(s) * C. * The histogram IDentificator will be : * C. * 10000*imate + 100*ipart + imeca * C. * where IMECA is the link number in stucture JMATE * C. * (see Geant3 writeup CONS 199) * C. * for 'HADG' imeca = 17 * C. * * C. * ==>Called by : * C. * Authors R.Brun, M.Maire ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCNUM. +SEQ,GCONSP. +SEQ,GCUNIT. PARAMETER (MMX= 100,NMECA= 13,NCOL= 5) CHARACTER*(*) MECAN CHARACTER*4 LMECA(NMECA) , MECA , KU(NCOL) CHARACTER NAPART*12 , NAMATE*16 , CHTITL*68 DIMENSION LMECHA(NMECA) , KMECA(NMECA) DIMENSION TKIN(KDIN),VALUE(MMX),SIGT(MMX),PCUT(5) DIMENSION KI(NCOL),EK(NCOL) * DATA LMECA / 'LOSS' , 'PHOT' , 'ANNI' , 'COMP' , 'MUNU' , * 'BREM' , 'PAIR' , 'DRAY' , 'PFIS' , 'RAYL' , * 'RANG' , 'STEP' , 'HADG' / DATA KMECA / 1,6,7,8,6,9,10,11,12,13,15,16,17/ * * ------------------------------------------------------------------ * KDIM = MIN(KDIN,MMX) IF (KDIM.LE.0) GO TO 999 * IF (JMATE.LE.0) GO TO 999 IF (IMATE.LE.0) GO TO 999 IF (IMATE.GT.NMATE) GO TO 990 JMA = LQ(JMATE-IMATE) IF (JMA.LE.0) GO TO 990 CALL UHTOC(IQ(JMA+1),4,NAMATE,16) * IF (JPART.LE.0) GO TO 999 IF (IPART.LE.0) GO TO 999 IF (IPART.GT.NPART) GO TO 990 JPA = LQ(JPART-IPART) IF (JPA.LE.0) GO TO 990 CALL UHTOC(IQ(JPA+1),4,NAPART,12) * * *** Print bin meaning IF (IDM.GE.0) THEN CHMAIL='1' CALL GMAIL(0,0) CHMAIL=' ' CHMAIL(31:)='Kinetic energy bin meaning' CALL GMAIL(0,0) CHMAIL(31:)='--------------------------' CALL GMAIL(0,1) NROW = (KDIM-1)/NCOL + 1 DO 106 IR=1,NROW DO 105 IC=1,NCOL IKB = IR + (IC-1)*NROW IF (IKB.GT.KDIM) IKB=KDIM KI(IC) = IKB CALL GEVKEV(TKIN(IKB),EK(IC),KU(IC)) 105 CONTINUE WRITE(CHMAIL,7985) (KI(IC),EK(IC),KU(IC),IC=1,NCOL) CALL GMAIL(0,0) 106 CONTINUE ENDIF * BIGINV= 1000./BIG CALL UCTOH(LMECA,LMECHA,4,4*NMECA) CALL VZERO(SIGT,MMX) N2 = 1 IF (MECAN.EQ.'ALL') N2 = NMECA DO 510 IMEC = 1,N2 MECA = MECAN IF(MECAN.EQ.'ALL') MECA = LMECA(IMEC) CALL GFTMAT(IMATE,IPART,MECA,KDIM,TKIN,VALUE,PCUT,IXST) IF(IXST.EQ.0) GO TO 510 * * *** Book histogram ISIG = 0 IF (MECA.EQ.'LOSS') THEN CHTITL = NAPART//' in '//NAMATE//' DE/DX (mev/cm)' ELSEIF (MECA.EQ.'RANG') THEN CHTITL = NAPART//' in '//NAMATE//' Stopping range (cm)' ELSEIF (MECA.EQ.'STEP') THEN CHTITL = NAPART//' in '//NAMATE//' continuous step (cm)' ELSE CHTITL = NAPART//' in '//NAMATE//' '//MECA// + ' cross section (1/cm)' ISIG = 1 ENDIF * CALL GLOOK(MECA,LMECHA,NMECA,ILOOK) IMECA = KMECA(ILOOK) ID = 10000*IMATE + 100*IPART + IMECA CALL HBOOKB(ID,CHTITL,KDIM-1,TKIN,0.) * * *** Fill histogram * VALMI = MAX (BIGINV,VMAX(VALUE,KDIM)*1.E-6) DO 101 IKB = 1,KDIM IF (VALUE(IKB).GE.VALMI) CALL HFILL(ID,TKIN(IKB),0.,VALUE(IKB)) IF (ISIG.EQ.1) SIGT(IKB) = SIGT(IKB) + VALUE(IKB) 101 CONTINUE CALL HIDOPT(ID,'LOGY') IF(IDM.GE.0) CALL HPHIST(ID,' ',0) IF(IDM.EQ.0) CALL HDELET(ID) 510 CONTINUE * * *** plot total cross section and mean free path IF (MECAN.EQ.'ALL') THEN CHTITL= NAPART//' in '//NAMATE//' total cross section (1/cm)' ID = 10000*IMATE + 100*IPART + 21 CALL HBOOKB(ID,CHTITL,KDIM-1,TKIN,0.) * CHTITL= NAPART//' in '//NAMATE//' total mean free path (cm)' II = ID + 1 CALL HBOOKB(II,CHTITL,KDIM-1,TKIN,0.) * VALMI = MAX (BIGINV,VMAX( SIGT,KDIM)*1.E-6) DO 201 IKB = 1,KDIM IF (SIGT(IKB).GE.VALMI) THEN CALL HFILL(ID,TKIN(IKB),0., SIGT(IKB)) CALL HFILL(II,TKIN(IKB),0.,1./SIGT(IKB)) ENDIF 201 CONTINUE CALL HIDOPT(ID,'LOGY') IF(IDM.GE.0) CALL HPHIST(ID,' ',0) IF(IDM.EQ.0) CALL HDELET(ID) * CALL HIDOPT(II,'LOGY') IF(IDM.GE.0) CALL HPHIST(II,' ',0) IF(IDM.EQ.0) CALL HDELET(II) ENDIF * GO TO 999 * 990 WRITE(CHMAIL,1000) IMATE ,IPART CALL GMAIL(0,0) 1000 FORMAT(' ***** GPLMAT error : material',I4, * ' or particle',I4,' not defined' ) 7102 FORMAT(6X,'BCUTE =',F6.2,A4,3X,'BCUTM =',F6.2,A4,3X, * 'DCUTE =',F6.2,A4,3X,'DCUTM =',F6.2,A4,3X, * 'PPCUTM =',F6.2,A4 ) 7985 FORMAT(1X,5(' bin ',I3,' =',F7.2,A4)) 999 END +DECK,GPMATE *CMZ : 3.15/01 02/05/91 08.56.29 by Federico Carminati *-- Author : SUBROUTINE GPMATE (NUMB) C. C. ****************************************************************** C. * * C. * Routine to print material data structures JMATE * C. * NUMB Material number * C. * * C. * Changed by S.Egli at 8.5.90: also show mixture contents * C. * * C. * ==>Called by : , GPRINT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT +SEQ,GCNUM CHARACTER CHMIXT*17 C. C. ------------------------------------------------------------------ C. IF (JMATE.LE.0) GO TO 999 IF (NUMB .EQ.0) THEN WRITE (CHMAIL,10000) CALL GMAIL(0,0) N1 = 1 N2 = NMATE ELSE N1 = ABS(NUMB) N2 = ABS(NUMB) ENDIF IF(NUMB.GE.0) THEN WRITE (CHMAIL,10100) CALL GMAIL(0,1) ENDIF C DO 20 I=N1,N2 JMA = LQ(JMATE-I) IF (JMA.LE.0) GO TO 20 C NMIXT=Q(JMA+11) CHMIXT=' ' IF(NMIXT.GT.1) CHMIXT=' A Z W' WRITE (CHMAIL,10200) I,(Q(JMA + J),J = 1,10),NMIXT,CHMIXT CALL GMAIL(0,0) IF(NMIXT.GT.1)THEN JMX=LQ(JMA-5) DO 10 J=1,NMIXT WRITE(CHMAIL,10300)Q(JMX+J),Q(JMX+NMIXT+J), + Q(JMX+2*NMIXT+J) CALL GMAIL(0,0) 10 CONTINUE ENDIF 20 CONTINUE C 10000 FORMAT ('0',51('='),5X,'MATERIALS',6X,50('=')) 10100 FORMAT ('0','MATERIAL',27X,'A',9X,'Z',5X,'DENSITY' +,2X,'RADIAT L',2X,'ABSORP L',' NMIXT') 10200 FORMAT (' ',I8,1X,5A4,3F10.3,2E10.3,I4,2X,A17) 10300 FORMAT (' ',85X,2F7.2,F7.3) 999 END +DECK,GPPART *CMZ : 3.15/01 14/02/91 10.55.37 by Federico Carminati *-- Author : SUBROUTINE GPPART (NUMB ) C. C. ****************************************************************** C. * * C. * Routine to print particle definition JPART * C. * NUMB Particle number * C. * * C. * ==>Called by : , GPRINT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT DIMENSION ITITLE(5) C. C. ------------------------------------------------------------------ C. IF (JPART.LE.0) GO TO 99 C IF (NUMB .EQ.0)THEN WRITE (CHMAIL,1000) CALL GMAIL(0,0) N1 = 1 N2 = IQ(JPART-2) ELSE N1 = ABS(NUMB) N2 = ABS(NUMB) ENDIF C IF(NUMB.GE.0) THEN WRITE (CHMAIL,1001) CALL GMAIL(0,1) ENDIF C DO 10 I=N1,N2 JP = LQ(JPART-I) IF (JP.NE.0)THEN IOPT = Q(JP+6) NL = IQ(JP-1) CALL UCOPY(IQ(JP+1),ITITLE,5) NW=MIN(NL,13) WRITE (CHMAIL,1002) I,ITITLE,IOPT, + (Q(JP + J),J = 7,NW) 5 CALL GMAIL(0,0) IF(NL-NW.GT.0) THEN NS=NW+1 NW=MIN(NL,NW+5) WRITE(CHMAIL,1003) (Q(JP + J),J = NS,NW) GO TO 5 END IF ENDIF 10 CONTINUE C 1000 FORMAT ('0',51('='),3X,'Particle Types',3X,50('=')) 1001 FORMAT ('0','Part',25X,'Options',8X,'Mass',4X,'Charge' +,' Life time User words') 1002 FORMAT (' ',I4,1X,5A4,I8,6X,E11.4,F7.0,3X,5(E12.5,2X)) 1003 FORMAT (61X,5(E12.5,2X)) 99 RETURN END +DECK,GPRMAT. *CMZ : 3.15/01 23/04/91 18.14.41 by Federico Carminati *-- Author : Federico Carminati 23/04/91 SUBROUTINE GPRMAT(IMATE,IPART,MECAN,KDIN,TKIN) C. C. ****************************************************************** C. * * C. * INTERPOLATE and PRINT the DE/DX ,stopping range and * C. * Cross sections tabulated in JMATE banks corresponding to * C. * material IMATE, particle IPART, mecanism name MECAN , * C. * kinetic energies TKIN. * C. * * C. * The MECAnism name can be : * C. * 'LOSS' 'RANG' 'STEP' 'PHOT' 'ANNI' 'COMP' * C. * 'MUNU' 'BREM' 'PAIR' 'DRAY' 'PFIS' 'RAYL' * C. * 'HADG' * C. * * C. * For Hadronic particles it computes the total hadronic * C. * cross section from Gheisha ('HADG') * C. * * C. * Input parameters * C. * IMATE Geant material number * C. * IPART Geant particle number * C. * MECAN mechanism name of the bank(s) to be printed. * C. * if mecan = 'ALL' all the relevant banks for * C. * particle IPART will be printed , plus the total * C. * cross section. * C. * KDIN dimension of the array TKIN (maximum 100) * C. * TKIN array of kinetic energy of incident particle (in Gev) * C. * * C. * ==>Called by : * C. * Authors R.Brun, M.Maire ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCNUM. +SEQ,GCUNIT. PARAMETER (MMX=100,NMECA= 13) CHARACTER*(*) MECAN CHARACTER*4 LMECA(NMECA), MECA CHARACTER*4 KU1 , KU2 , KU3 , KU(5) DIMENSION TKIN(KDIN),VALUE(MMX),SIGT(MMX),PCUT(5),CU(5) * DATA LMECA / 'LOSS' , 'RANG' , 'STEP' , 'PHOT' , 'ANNI' , * 'COMP' , 'MUNU' , 'BREM' , 'PAIR' , 'DRAY' , * 'PFIS' , 'RAYL' , 'HADG' / * * ------------------------------------------------------------------ * KDIM = MIN(KDIN,MMX) IF (KDIM.LE.0) GO TO 999 * IF (JMATE.LE.0) GO TO 999 IF (IMATE.LE.0) GO TO 999 IF (IMATE.GT.NMATE) GO TO 990 JMA = LQ(JMATE-IMATE) IF (JMA.LE.0) GO TO 990 * IF (JPART.LE.0) GO TO 999 IF (IPART.LE.0) GO TO 999 IF (IPART.GT.NPART) GO TO 990 JPA = LQ(JPART-IPART) IF (JPA.LE.0) GO TO 990 * CALL VZERO (SIGT,MMX) N2 = 1 IF (MECAN.EQ.'ALL') N2 = NMECA DO 510 IMEC = 1,N2 MECA = MECAN IF (MECAN.EQ.'ALL') MECA = LMECA(IMEC) CALL GFTMAT(IMATE,IPART,MECA,KDIM,TKIN,VALUE,PCUT,IXST) IF(IXST.EQ.0) GO TO 510 CHMAIL='1' CALL GMAIL(0,0) WRITE(CHMAIL,7101)(IQ(JMA+I),I=1,5),MECA,(IQ(JPA+J),J=1,5) CALL GMAIL(0,0) CHMAIL(31:)='-----------------------------------------' CALL GMAIL(0,1) CHMAIL=' ' DO 107 K=1,5 107 CALL GEVKEV(PCUT(K),CU(K),KU(K)) WRITE(CHMAIL,7102) (CU(K),KU(K),K=1,5) CALL GMAIL(0,1) * IF (MECA.EQ.'LOSS'.OR.MECA.EQ.'RANG'.OR.MECA.EQ.'STEP') THEN IF (MECA.EQ.'LOSS') WRITE(CHMAIL,7980) IF (MECA.EQ.'RANG') WRITE(CHMAIL,7981) IF (MECA.EQ.'STEP') WRITE(CHMAIL,7982) CALL GMAIL(0,1) NROW = (KDIM-1)/3 + 1 DO 101 IKB=1,NROW IK = IKB DE1 = VALUE(IK) CALL GEVKEV(TKIN(IK),EK1,KU1) * IK = IKB + NROW IF (IK.GT.KDIM) IK=KDIM DE2 = VALUE(IK) CALL GEVKEV(TKIN(IK),EK2,KU2) * IK = IKB + 2*NROW IF (IK.GT.KDIM) IK=KDIM DE3 = VALUE(IK) CALL GEVKEV(TKIN(IK),EK3,KU3) * WRITE(CHMAIL,7985) EK1,KU1,DE1,EK2,KU2,DE2,EK3,KU3,DE3 CALL GMAIL(0,0) 101 CONTINUE ELSE WRITE(CHMAIL,7990) CALL GMAIL(0,1) NROW = (KDIM-1)/2 + 1 DO 108 IKB=1,NROW IK = IKB SIG1 = VALUE(IK) AL1 = 1./SIG1 SIGT(IK) = SIGT(IK) + SIG1 CALL GEVKEV(TKIN(IK),EK1,KU1) * IK = IKB + NROW IF (IK.GT.KDIM) IK=KDIM SIG2 = VALUE(IK) AL2 = 1./SIG2 SIGT(IK) = SIGT(IK) + SIG2 CALL GEVKEV(TKIN(IK),EK2,KU2) * WRITE(CHMAIL,7995) EK1,KU1,SIG1,AL1,EK2,KU2,SIG2,AL2 CALL GMAIL(0,0) 108 CONTINUE ENDIF 510 CONTINUE * * *** print total cross section IF (MECAN.EQ.'ALL') THEN MECA = 'SIGT' CHMAIL='1' CALL GMAIL(0,0) WRITE(CHMAIL,7101)(IQ(JMA+I),I=1,5),MECA,(IQ(JPA+J),J=1,5) CALL GMAIL(0,0) CHMAIL(31:)='-----------------------------------------' CALL GMAIL(0,1) CHMAIL=' ' DO 207 K=1,5 207 CALL GEVKEV(PCUT(K),CU(K),KU(K)) WRITE(CHMAIL,7102) (CU(K),KU(K),K=1,5) CALL GMAIL(0,1) WRITE(CHMAIL,7991) CALL GMAIL(0,1) NROW = (KDIM-1)/2 + 1 DO 208 IKB=1,NROW IK = IKB SIG1 = SIGT(IK) AL1 = 1./SIG1 CALL GEVKEV(TKIN(IK),EK1,KU1) * IK = IKB + NROW IF (IK.GT.KDIM) IK=KDIM SIG2 = SIGT(IK) AL2 = 1./SIG2 CALL GEVKEV(TKIN(IK),EK2,KU2) * WRITE(CHMAIL,7995) EK1,KU1,SIG1,AL1,EK2,KU2,SIG2,AL2 CALL GMAIL(0,0) 208 CONTINUE ENDIF * GO TO 999 * 990 WRITE(CHMAIL,1000) IMATE ,IPART CALL GMAIL(0,0) * 1000 FORMAT(' ***** GPRMAT error : material',I4, * ' or particle',I4,' not defined' ) 7101 FORMAT(30X,5A4,A4, ' for ',5A4) 7102 FORMAT( 6X,'BCUTE =',F6.2,A4,3X,'BCUTM =',F6.2,A4,3X, * 'DCUTE =',F6.2,A4,3X,'DCUTM =',F6.2,A4,3X, * 'PPCUTM =',F6.2,A4 ) 7980 FORMAT( 6X,'kinetic energy DE/DX(mev/cm)', * 6X,'kinetic energy DE/DX(mev/cm)', * 6X,'kinetic energy DE/DX(mev/cm)') 7981 FORMAT( 6X,'kinetic energy Stop range cm', * 6X,'kinetic energy Stop ramge cm', * 6X,'kinetic energy Stop range cm') 7982 FORMAT( 6X,'kinetic energy Mulof step cm', * 6X,'kinetic energy Mulof step cm', * 6X,'kinetic energy Mulof step cm') 7985 FORMAT( 3(F16.2,A4,E15.4)) 7990 FORMAT( 6X,'kinetic energy Sigma (1/cm) Lambda (cm)', * 6X,'kinetic energy Sigma (1/cm) Lambda (cm)') 7991 FORMAT( 6X,'kinetic energy Sigto (1/cm) Lambda (cm)', * 6X,'kinetic energy Sigto (1/cm) Lambda (cm)') 7995 FORMAT( 2(F16.2,A4,2(E15.4))) 999 END +DECK,GPTMED *CMZ : 3.15/01 28/10/91 21.51.30 by Federico Carminati *-- Author : SUBROUTINE GPTMED (NUMB ) C. C. ****************************************************************** C. * * C. * Routine to print tracking media data structure JTMED * C. * NUMB medium number * C. * * C. * ==>Called by : , GPRINT * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT +SEQ,GCNUM DIMENSION ITITLE(5) C. C. ------------------------------------------------------------------ C. IF (JTMED.LE.0) GO TO 99 C IF (NUMB .EQ.0)THEN WRITE (CHMAIL,1000) CALL GMAIL(0,0) N1 = 1 N2 = NTMED ELSE N1 = ABS(NUMB) N2 = ABS(NUMB) ENDIF IF(NUMB.GE.0) THEN WRITE (CHMAIL,1001) CALL GMAIL(0,1) ENDIF C DO 10 I=N1,N2 JTM = LQ(JTMED-I) IF (JTM.NE.0)THEN IMAT = Q(JTM+6) ISVOL = Q(JTM+7) IFIELD = Q(JTM+8) CALL UCOPY(IQ(JTM+1),ITITLE,5) WRITE(CHMAIL,1002)I,ITITLE,IMAT,ISVOL,IFIELD, + (Q(JTM+J),J=9,14) CALL GMAIL(0,0) ENDIF 10 CONTINUE C 1000 FORMAT ('0',51('='),3X,'TRACKING MEDIA',3X,50('=')) 1001 FORMAT ('0','TMED',26X,'MATERIAL ','ISVOL',' IFIELD FIELDM' +, ' TMAXFD',' STEMAX',' DEEMAX',' EPSIL',' STMIN') 1002 FORMAT (' ',I6,1X,5A4,I8,I8,I6,4X,F6.2,2X,F6.2,G10.3,3F8.3) 99 RETURN END +DECK,GSDK *CMZ : 3.15/01 14/02/91 10.55.37 by Federico Carminati *-- Author : SUBROUTINE GSDK(IPART,BRATIO,MODE) C. C. ****************************************************************** C. * * C. * Defines branching ratios and decay modes for standard * C. * GEANT particles. * C. * * C. * ==>Called by : , GPART * C. * Author G.Patrick ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCPHYS +SEQ,GCNUM +SEQ,GCUNIT DIMENSION BRATIO(6) DIMENSION MODE(6) C. C. ------------------------------------------------------------------ C. IF (IDCAY.LE.0) GO TO 99 IF (IPART.LE.0) GO TO 99 IF (IPART.GT.NPART) GO TO 99 C C Particle pointer. C JPA = LQ(JPART-IPART) IF (JPA.LE.0) GO TO 99 C C Book decay links and data banks. C JDK1=LQ(JPA-1) JDK2=LQ(JPA-2) IF(JDK1+JDK2.NE.0) THEN WRITE(CHMAIL, 10000) CALL GMAIL(1,0) CALL GPPART(IPART) CALL MZDROP(IXCONS,LQ(JPA-1),' ') CALL MZDROP(IXCONS,LQ(JPA-2),' ') ENDIF CALL MZBOOK(IXCONS,JDK1,JPA,-1,'PABR',0,0,6,3,0) JPA=LQ(JPART-IPART) CALL MZBOOK(IXCONS,JDK2,JPA,-2,'PAMO',0,0,6,2,0) JPA=LQ(JPART-IPART) JDK1=LQ(JPA-1) IQ(JDK1-5)=IPART IQ(JDK2-5)=IPART C C Store branching ratios & decay modes. C DO 20 I=1,6 Q(JDK1+I) = BRATIO(I) IQ(JDK2+I) = MODE(I) 20 CONTINUE C 99 RETURN 10000 FORMAT(' *** GSDK ***: Warning, redefinition of decay ', + 'for particle:') END +DECK,GSMATE *CMZ : 3.15/01 24/07/91 12.12.15 by Federico Carminati *-- Author : SUBROUTINE GSMATE(IMAT,NAMATE,A,Z,DENS,RADL,ABSL,UBUF,NWBUF) C. C. ****************************************************************** C. * * C. * * C. * Store material parameters * C. * * C. * * C. * The Material data structure JMATE * C. * --------------------------------- * C. * * C. * | JMATE * C. * NMATE IMATE v * C. * ...................................... * C. * | | | | | * C. * ...................................... * C. * | * C. * | JMA * C. * v * C. * ..................... * C. * | 1 | | * C. * ..... | * C. * | 2 | Material | * C. * |...| | * C. * | 3 | Name | * C. * |...| | * C. * | 4 | | * C. * |...| | * C. * | 5 | | * C. * ..................... * C. * | 6 | A | * C. * |...|...............| * C. * | 7 | Z | * C. * |...|...............| * C. * | 8 | Density | * C. * |...|...............| * C. * | 9 | RADL | * C. * |...|...............| * C. * | 10| ABSL | * C. * |...|...............| * C. * | 11| NMIXT | * C. * |...|...............| * C. * | | | * C. * ..................... * C. * * C. * JMA = LQ(JMATE-IMATE) pointer to material IMATE * C. * * C. * When the subroutine GPHYSI is called at initialisation * C. * time the following banks are created for each material * C. * (tabulation of energy loss and cross-section). * C. * | JMATE * C. * NMATE IMATE v * C. * ................................................ * C. * | | | | | * C. * ................................................ * C. * | JMA = LQ(JMATE-IMATE) * C. * v 11 * C. * ............................................................ * C. * | 13 12 11 10 9 8 7 6 5 4 3 2 1 | | Material parameters | * C. * ............................................................ * C. * | | | | | | | | | | | | | * C. * | | | | | | | | | | | | v JMAEL = LQ(JMA-1) * C. * | | | | | | | | | | | | 270 * C. * | | | | | | | | | | | |................................ * C. * | | | | | | | | | | | ||Energy loss for electron/positro* C. * | | | | | | | | | | | |............................ * C. * | | | | | | | | | | | v JMAMU = LQ(JMA-2) 90 * C. * | | | | | | | | | | |.............................. * C. * | | | | | | | | | | ||Energy loss for muons | * C. * | | | | | | | | | | |.............................. * C. * | | | | | | | | | | v JMAAL = LQ(JMA-3) 90 * C. * | | | | | | | | | |................................ * C. * | | | | | | | | | ||Energy loss for other particles| * C. * | | | | | | | | | |................................ * C. * | | | | | | | | | v JPROB = LQ(JMA-4) 30 * C. * | | | | | | | | |.................................. * C. * | | | | | | | | ||Some material constants | * C. * | | | | | | | | |.................................. * C. * | | | | | | | | v JMIXT = LQ(JMA-5) 11 * C. * | | | | | | | |.................................... * C. * | | | | | | | ||Mixture or compound parameters | * C. * | | | | | | | |.................................... * C. * | | | | | | | v JPHOT = LQ(JMA-6) and JMUNU 90 * C. * | | | | | | |...................................... * C. * | | | | | | ||Photo-effect cross-section | * C. * | | | | | | |...................................... * C. * | | | | | | v JANNI = LQ(JMA-7) 90 * C. * | | | | | |........................................ * C. * | | | | | ||Positron annihilation cross-section | * C. * | | | | | |........................................ * C. * | | | | | V JCOMP = LQ(JMA-8) 90 * C. * | | | | |.......................................... * C. * | | | | ||Compton scattering cross-section | * C. * | | | | |.......................................... * C. * | | | | V JBREM = LQ(JMA-9) 90 * C. * | | | | ............................................ * C. * | | | | |Bremsstrahlung cross-section | * C. * | | | | ............................................ * C. * | | | V JPAIR = LQ(JMA-10) 90 * C. * | | | ............................................... * C. * | | | |Pair production cross-section | * C. * | | | ............................................... * C. * | | V JDRAY = LQ(JMA-11) 210 * C. * | | .................................................. * C. * | | |Moller and Bhabha cross-sections | * C. * | | .................................................. * C. * | V JPFIS = LQ(JMA-12) 90 * C. * | ..................................................... * C. * | |Photo fission cross section | * C. * | ..................................................... * C. * V JRAYL = LQ(JMA-13) 62 * C. * ........................................................ * C. * |Rayleigh scattering cross section and atomic form fact| * C. * ........................................................ * C. * V JMUNU = LQ(JMA-14) 90 * C. * ........................................................ * C. * V JRANG = LQ(JMA-15) 180 * C. * V........................................................ * C. * |Stopping range for electrons/positrons | * C. * ........................................................ * C. * V JRANG = LQ(JMA-16) 180 * C. * V........................................................ * C. * |Stopping range for muons / other particles | * C. * ........................................................ * C. * * C. * ==>Called by : , UGEOM , GINC3 * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM +SEQ,GCMZFO +SEQ,GCUNIT DIMENSION UBUF(1) CHARACTER*(*) NAMATE CHARACTER*20 NAME C. C. ------------------------------------------------------------------ C. IF(IMAT.LE.0)GO TO 99 IF(JMATE.LE.0)THEN CALL MZBOOK(IXCONS,JMATE,JMATE,1,'MATE',NMATE,NMATE,0,3,0) IQ(JMATE-5)=0 ENDIF IF(IMAT.GT.NMATE)THEN CALL MZPUSH(IXCONS,JMATE,IMAT-NMATE,0,'I') NMATE=IMAT JMA1=0 ELSE JMA1=LQ(JMATE-IMAT) IF(JMA1.GT.0) THEN WRITE(CHMAIL,10000) CALL GMAIL(1,0) CALL GPMATE(IMAT) CALL MZDROP(IXCONS,LQ(JMATE-IMAT),' ') ENDIF ENDIF CALL MZBOOK(IXCONS,JMA,JMATE,-IMAT,'MATE',20,20,NWBUF+11,IOMATE,0) C NAME=NAMATE NCH=LNBLNK(NAME) IF(NCH.GT.0)THEN IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' ' ENDIF CALL UCTOH(NAME,IQ(JMA+1),4,20) C Q(JMA + 6) = A Q(JMA + 7) = Z Q(JMA + 8) = DENS Q(JMA + 9) = RADL Q(JMA + 10) = ABSL Q(JMA + 11) = 1. IF(NWBUF.GT.0)CALL UCOPY(UBUF,Q(JMA+12),NWBUF) C IF(JMA1.GT.0) THEN CALL GPMATE(-IMAT) ENDIF C 10000 FORMAT(' *** GSMATE ***: Warning, material redefinition:') 99 END +DECK,GSMIXT *CMZ : 3.15/01 16/12/91 20.55.28 by Federico Carminati *-- Author : SUBROUTINE GSMIXT(IMAT,NAMATE,A,Z,DENS,NLMAT,WMAT) C. C. ****************************************************************** C. * * C. * Defines mixture OR COMPOUND IMAT as composed by * C. * THE BASIC NLMAT materials defined by arrays A,Z and WMAT * C. * * C. * If NLMAT.GT.0 then WMAT contains the PROPORTION BY * C. * WEIGTHS OF EACH BASIC MATERIAL IN THE MIXTURE. * C. * * C. * If NLMAT.LT.0 then WMAT contains the number of atoms * C. * of a given kind into the molecule of the COMPOUND * C. * In this case, WMAT in output is changed to relative * C. * weigths. * C. * * C. * nb : the radiation length is computed according * C. * the EGS manual slac-210 uc-32 June-78 * C. * formula 2-6-8 (37) * C. * * C. * ==>Called by : , UGEOM * C. * Authors R.Brun, M.Maire ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM +SEQ,GCUNIT +SEQ,GCMZFO DIMENSION WMAT(1),A(1),Z(1) CHARACTER*(*) NAMATE CHARACTER*20 NAME DATA ALR2AV , AL183 / 1.39621E-03 , 5.20948 / C. C. ------------------------------------------------------------------ C. IF (IMAT.LE.0)GO TO 99 IF(JMATE.LE.0)THEN CALL MZBOOK(IXCONS,JMATE,JMATE,1,'MATE',NMATE,NMATE,0,3,0) IQ(JMATE-5)=0 ENDIF IF(IMAT.GT.NMATE)THEN CALL MZPUSH(IXCONS,JMATE,IMAT-NMATE,0,'I') NMATE=IMAT JMA1=0 ELSE JMA1=LQ(JMATE-IMAT) IF(JMA1.GT.0) THEN WRITE(CHMAIL,10000) CALL GMAIL(1,0) CALL GPMATE(IMAT) CALL MZDROP(IXCONS,LQ(JMATE-IMAT),' ') ENDIF ENDIF CALL MZBOOK(IXCONS,JMA,JMATE,-IMAT,'MATE',20,20,11,IOMATE,0) C NAME=NAMATE NCH=LNBLNK(NAME) IF(NCH.GT.0)THEN IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' ' ENDIF CALL UCTOH(NAME,IQ(JMA+1),4,20) C C Store mixture parameters C and parameter for Pair/Brems and C Photoelectric routines C NLM = IABS(NLMAT) IF (NLM.LE.0)GO TO 90 CALL MZBOOK(IXCONS,JMIXT,JMA,-5,'MAMI',2,2,4*NLM,3,0) CALL MZBOOK(IXCONS,JMI1,JMIXT,-1,'MAM1',0,0,10,3,0) JMA = LQ(JMATE- IMAT) IQ(JMIXT-5)=IMAT IQ(JMI1-5)=IMAT C C Compute proportion by weigths in the compound C IF(NLMAT.LT.0) THEN AMOL = 0. ZMOL = 0. DO 10 I= 1,NLM AMOL = AMOL + WMAT(I)*A(I) ZMOL = ZMOL + WMAT(I)*Z(I) 10 CONTINUE DO 20 I= 1,NLM WMAT(I)= WMAT(I)*A(I) / AMOL 20 CONTINUE ENDIF C C Compute effective mixture parameters C AEFF = 0. ZEFF = 0. RADINV = 0. DO 40 I = 1,NLM AEFF = AEFF + WMAT(I)*A(I) ZEFF = ZEFF + WMAT(I)*Z(I) ZC = Z(I) ALZ = LOG(ZC)/3. XINV = ZC*(ZC+GXSI(ZC))*(AL183-ALZ-GFCOUL(ZC))/A(I) RADINV = RADINV + WMAT(I)*XINV Q(JMIXT+3*NLM+I)=XINV Q(JMIXT + 2* NLM + I) = WMAT(I) Q(JMIXT + NLM + I) = Z(I) Q(JMIXT + I) = A(I) 40 CONTINUE RADINV = ALR2AV * DENS * RADINV RADEFF = 1. / RADINV CALL GHMIX(A,WMAT,NLM,AHEFF) ABSEFF=10000.*AHEFF/(6.022*DENS*GHSIGM(5.,8,AHEFF)) C Q(JMA + 6) = AEFF Q(JMA + 7) = ZEFF Q(JMA + 8) = DENS Q(JMA + 9) = RADEFF Q(JMA + 10) = ABSEFF Q(JMA + 11) = NLM Q(JMI1 + 1) = AHEFF IF(NLMAT.GT.0)THEN Q(JMI1 + 2) = AEFF Q(JMI1 + 3) = ZEFF ELSE Q(JMI1 + 2) = AMOL Q(JMI1 + 3) = ZMOL ENDIF C IF(JMA1.GT.0) THEN CALL GPMATE(-IMAT) ENDIF C GO TO 99 C 90 CHMAIL=' ***** GSMIXT ERROR. MIXTURE WITH NO COMPONENTS' CALL GMAIL(0,0) C 99 RETURN 10000 FORMAT(' *** GSMIXT ***: Warning, material redefinition:') END +DECK,GSPART *CMZ : 3.15/01 24/07/91 12.12.15 by Federico Carminati *-- Author : SUBROUTINE GSPART(IPART,NAPART,ITRTYP,AMASS,CHARGE,TLIFE, + UBUF,NWBUF) C. C. ****************************************************************** C. * * C. * Store particle parameters * C. * * C. * ==>Called by : , GPART * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCNUM +SEQ,GCMZFO +SEQ,GCUNIT DIMENSION UBUF(1) CHARACTER*(*) NAPART CHARACTER*20 NAME C. C. ------------------------------------------------------------------ C. IF(IPART.LE.0)GO TO 99 IF(JPART.LE.0)THEN CALL MZBOOK(IXCONS,JPART,JPART,1,'PART',NPART,NPART,0,3,0) IQ(JPART-5)=0 ENDIF IF(IPART.GT.NPART)THEN CALL MZPUSH(IXCONS,JPART,IPART-NPART,0,'I') NPART=IPART JPA1=0 ELSE JPA1=LQ(JPART-IPART) IF(JPA1.GT.0) THEN WRITE(CHMAIL,10000) CALL GMAIL(1,0) CALL GPPART(IPART) CALL MZDROP(IXCONS,LQ(JPART-IPART),' ') ENDIF ENDIF CALL MZBOOK(IXCONS,JPA,JPART,-IPART,'PART',2,2,NWBUF+9,IOPART,0) C NAME=NAPART NCH=LNBLNK(NAME) IF(NCH.GT.0)THEN IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' ' ENDIF CALL UCTOH(NAME,IQ(JPA+1),4,20) C Q(JPA + 6) = ITRTYP Q(JPA + 7) = AMASS Q(JPA + 8) = CHARGE Q(JPA + 9) = TLIFE IF(NWBUF.GT.0)CALL UCOPY(UBUF,Q(JPA+10),NWBUF) C IF(JPA1.GT.0) THEN CALL GPPART(-IPART) ENDIF C 99 RETURN 10000 FORMAT(' *** GSPART ***: Warning, particle redefinition:') END +DECK,GSTMED *CMZ : 3.15/01 24/02/92 12.42.08 by Federico Carminati *-- Author : SUBROUTINE GSTMED(KTMED,NATMED,NMAT,ISVOL,IFIELD,FIELDM,TMAXFD, + STEMAX,DEEMAX,EPSIL,STMIN,UBUF,NWBUF) * *********************************************************************** * * * * * Store tracking media parameters * * * * Stores the parameters of the tracking medium ITMED in the data* * structure JTMED. * * ITMED tracking medium number 0Called by : , UGEOM , GINC3 * * Author R.Brun ********* * * * *********************************************************************** * +SEQ,GCBANK +SEQ,GCCUTS +SEQ,GCPHYS +SEQ,GCONSP +SEQ,GCUNIT +SEQ,GCNUM +SEQ,GCMZFO +SEQ,GCTRAK. DIMENSION MECA(5,13) EQUIVALENCE (MECA(1,1),IPAIR) DIMENSION UBUF(1),CUTVEC(10) EQUIVALENCE (CUTVEC,CUTGAM) CHARACTER*(*) NATMED CHARACTER*20 NAME C. C. ------------------------------------------------------------------ C. ITMED=ABS(KTMED) IF(JTMED.LE.0)THEN CALL MZBOOK(IXCONS,JTMED,JTMED,1,'TMED',NTMED,NTMED,25,3,0) CALL UCOPY(CUTVEC,Q(JTMED+1),10) IQ(JTMED-5)=0 DO 10 I=1,13 Q(JTMED+10+I)=MECA(1,I) 10 CONTINUE ENDIF IF(ITMED.GT.NTMED)THEN CALL MZPUSH(IXCONS,JTMED,ITMED-NTMED,0,'I') NTMED=ITMED JTM1=0 ELSE JTM1=LQ(JTMED-ITMED) IF(JTM1.GT.0) THEN WRITE(CHMAIL,10100) CALL GMAIL(1,0) CALL GPTMED(ITMED) CALL MZDROP(IXCONS,LQ(JTMED-ITMED),' ') ENDIF ENDIF NW=NWBUF+14 CALL MZBOOK(IXCONS,JTM,JTMED,-ITMED,'TMED',10,10,NW,IOTMED,0) C NAME=NATMED NCH=LNBLNK(NAME) IF(NCH.GT.0)THEN IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' ' ENDIF CALL UCTOH(NAME,IQ(JTM+1),4,20) C EPS=EPSIL IF(EPSIL.LE.0.0) THEN WRITE(CHMAIL,10000) ITMED, EPSIL CALL GMAIL(0,0) EPS=1.E-4 END IF IF(IFIELD.NE.0.AND.FIELDM.EQ.0.0) THEN WRITE(CHMAIL,10200) ITMED, IFIELD CALL GMAIL(0,0) END IF IF(IGAUTO.NE.0.AND.ITMED.GT.0)THEN DE=-1. ST=-1. SM=-1. ELSE DE=DEEMAX ST=STMIN SM=STEMAX ENDIF Q(JTM + 6) = NMAT Q(JTM + 7) = ISVOL Q(JTM + 8) = IFIELD Q(JTM + 9) = FIELDM Q(JTM + 10) = TMAXFD Q(JTM + 11) = SM Q(JTM + 12) = DE Q(JTM + 13) = EPS Q(JTM + 14) = ST IF(NWBUF.GT.0)CALL UCOPY(UBUF,Q(JTM+15),NWBUF) C IF(JTM1.GT.0) THEN CALL GPTMED(-ITMED) ENDIF C 10000 FORMAT('0*** GSTMED *** Warning, medium = ',I5, + ', value of EPSIL=',E10.3,' reset to 1 micron') 10100 FORMAT(' *** GSTMED *** Warning, tracking medium redefinition:') 10200 FORMAT('0*** GSTMED *** Warning, medium = ',I5, + ', IFIELD = ',I3,' and FIELDM = 0.0 is illegal') 999 END +DECK,GSTPAR *CMZ : 3.15/01 14/01/92 10.19.22 by Federico Carminati *-- Author : SUBROUTINE GSTPAR(ITMED,CHPAR,PARVAL) * ************************************************************************ * * * To change the value of cut or mechanism "CHPAR" * * to a new value PARVAL for tracking medium ITMED * * The data structure JTMED contains the standard tracking * * parameters (CUTS and flags to control the physics processes) which * * are used by default for all tracking media. It is possible to * * redefine individually with GSTPAR any of these parameters for a * * given tracking medium. * * ITMED tracking medium number * * CHPAR is a character string (variable name) * * PARVAL must be given as a floating point. * * For example to change CUTGAM to 0.0001 * * * * ==>Called by : * * Author R.Brun ********* * * * ************************************************************************ * +SEQ,GCBANK +SEQ,GCPHYS +SEQ,GCCUTS +SEQ,GCUNIT +SEQ,GCNUM DIMENSION CUTS(10),MECA(5,13) EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR) CHARACTER*(*) CHPAR C. C. ------------------------------------------------------------------ C. IF(ITMED.LE.0)GO TO 90 IF(ITMED.GT.NTMED)GO TO 90 JTM=LQ(JTMED-ITMED) IF(JTM.LE.0)GO TO 90 JTMN=LQ(JTM) IF(JTMN.EQ.0)THEN CALL MZBOOK(IXCONS,JTMN,JTM,0,'TCUT',0,0,30,3,0) IQ(JTMN-5)=ITMED DO 10 I=1,10 Q(JTMN+I)=CUTS(I) 10 CONTINUE DO 20 I=1,13 Q(JTMN+10+I)=MECA(1,I) 20 CONTINUE ENDIF C ITPAR=0 IF(CHPAR.EQ.'CUTGAM')ITPAR=1 IF(CHPAR.EQ.'CUTELE')ITPAR=2 IF(CHPAR.EQ.'CUTNEU')ITPAR=3 IF(CHPAR.EQ.'CUTHAD')ITPAR=4 IF(CHPAR.EQ.'CUTMUO')ITPAR=5 IF(CHPAR.EQ.'BCUTE' )ITPAR=6 IF(CHPAR.EQ.'BCUTM' )ITPAR=7 IF(CHPAR.EQ.'DCUTE' )ITPAR=8 IF(CHPAR.EQ.'DCUTM' )ITPAR=9 IF(CHPAR.EQ.'PPCUTM')ITPAR=10 IF(CHPAR.EQ.'PAIR' )ITPAR=11 IF(CHPAR.EQ.'COMP' )ITPAR=12 IF(CHPAR.EQ.'PHOT' )ITPAR=13 IF(CHPAR.EQ.'PFIS' )ITPAR=14 IF(CHPAR.EQ.'DRAY' )ITPAR=15 IF(CHPAR.EQ.'ANNI' )ITPAR=16 IF(CHPAR.EQ.'BREM' )ITPAR=17 IF(CHPAR.EQ.'HADR' )ITPAR=18 IF(CHPAR.EQ.'MUNU' )ITPAR=19 IF(CHPAR.EQ.'DCAY' )ITPAR=20 IF(CHPAR.EQ.'LOSS' )ITPAR=21 IF(CHPAR.EQ.'MULS' )ITPAR=22 IF(CHPAR.EQ.'RAYL' )ITPAR=23 IF(CHPAR.EQ.'GHCOR1')ITPAR=26 IF(CHPAR.EQ.'GHCOR2')ITPAR=27 IF(CHPAR.EQ.'GHCOR3')ITPAR=28 IF(CHPAR.EQ.'GHCOR4')ITPAR=29 IF(CHPAR.EQ.'BIRK1' )ITPAR=27 IF(CHPAR.EQ.'BIRK2' )ITPAR=28 IF(CHPAR.EQ.'BIRK3' )ITPAR=29 IF(ITPAR.NE.0)THEN Q(JTMN+ITPAR)=PARVAL IF(ITPAR.EQ.21)THEN KLOSS=PARVAL+0.001 IF(KLOSS.EQ.3.OR.KLOSS.EQ.1)Q(JTMN+15)=1. ENDIF ELSE WRITE(CHMAIL,1000)ITMED,CHPAR CALL GMAIL(0,0) ENDIF GO TO 99 C 90 WRITE(CHMAIL,2000)ITMED CALL GMAIL(0,0) C 1000 FORMAT(' ***** GSTPAR error for tracking medium ', + I3,' Tracking parameter ',A,' not defined ***** ') 2000 FORMAT(' ***** GSTPAR error. Tracking medium NR ', + I3,' not defined ***** ') 99 END +DECK,GXSI *CMZ : 3.13/05 22/05/89 16.58.35 by Rene Brun *-- Author : FUNCTION GXSI (Z) C. C. ****************************************************************** C. * * C. * COMPUTE SCREENING FACTOR FOR PAIR PRODUCTION AND BREM * C. * REFERENCE : EGS MANUAL SLAC 210 - UC32 - JUNE 78 * C. * FORMULA 2.7.22 * C. * * C. * ==>Called by : GSMIXT * C. * Author M.Maire ********* * C. * * C. ****************************************************************** C. DATA AL183 , AL1440 / 5.20948 , 7.27239 / ALZ = LOG(Z)/3. GXSI = (AL1440 - 2*ALZ) / (AL183 - ALZ - GFCOUL(Z)) END +PATCH,GHITS +DECK,DOCGHITS,IF=DOC *CMZ : 3.15/09 07/04/92 17.05.37 by Federico Carminati *-- Author : Federico Carminati * ************************************************************************ * * * Introduction to the Detector Response package * * --------------------------------------------- * * * * * * THE DETECTOR RESPONSE PACKAGE * * * * In the context of GEANT3: * * * * - a hit is the user defined 'quantum of information' recorded at * * tracking time to keep track of the interaction between one * * particle and a given sensitive detector, and regarded as * * necessary to compute the digitisations later. * * * * - a digitisation is the user defined 'quantum of information' * * simulating the response of a given detector element, after * * tracking of a complete event. * * * * The detector response package consists of tools to store in, and * * retrieve or print from, the data structures JSET, JHITS and JDIGI * * the information relevant to the hits and digitisations. A few * * subroutines which may help the user to solve some of the usual * * problems of digitisation in simple detectors have been added to * * the package, e.g. the intersection of a track with a plane or a * * cylinder and the digitisation of conventional drift and MWP * * chambers. * * For complex set-ups with different types of detectors the user * * has normally to define several types of hits and digitisations. * * In addition to the hits generated by all particles of the current * * event, computing the digitisations requires usually some * * information about the intrinsic characteristics and performance of * * the detectors. * * The information to be recorded for the hits and digitisations is * * highly experiment dependent, therefore only a framework can be * * proposed to store it. The solution adopted here should be * * satisfactory for most of the applications. Feedback from the * * users is needed and will be welcome. * * Two remarks can be made: * * * * - the stability of the information to be stored is usually reached * * much earlier for the hits than for the digitisations. Therefore * * the user may save computing time by designing an intermediate * * event output at the hits level. * * - the scheme proposed for storing the digitisations should in any * * case be considered as an intermediate stage, a reshuffling of * * the data being necessary if the user wants to simulate more * * closely the specific format of the real data acquisition system. * * * * SETS AND DETECTORS * * * * The reader is assumed to be familiar with the way the geometrical * * setup is described [GEOM 001], in particular with the concepts of * * logical volume structure and of physical path through the volume * * tree. * * The user is required to classify into sets all sensitive * * detectors for which storing the hits in the data structure JHITS * * is wanted. * * The 4-character names which identify the sets are user defined, * * and the list of sets which the user wants to activate for a given * * run can be entered through the data card SETS. The user is * * entirely free to group together, in one or in several sets, * * detectors of the same type or of different types. For * * convenience, it is recommended to have at least one set for each * * main component of the setup, e.g. hadron calorimeters, * * electromagnetic calorimeters, vertex chamber, etc. * * A detector can be declared as sensitive through the tracking * * medium parameter ISVOL, and allocated to a set through the * * subroutine GSDET. Currently, the active sets and detectors have * * to be redefined for every run. Tools will be provided later to * * read in part or the whole of the information from a previous run * * and to update the relevant structures according to the user * * requirements. * * Each (logical) detector is identified by the 4-character name of * * the corresponding volume. As a given volume may describe several * * similar detectors of the physical setup, some additional * * information is needed for associating correctly the hits with the * * physical detectors. The user has to enter the (shortest) list of * * volume names, the vector NAMESV, which permits identification of * * the path through the physical tree, even in the presence of * * multiple copies at the volume level or at any lower level in the * * tree. The identification will be achieved when needed, by * * specifying a list of volume numbers, the vector NUMBV, in one to * * one correspondence with the above list of volume names. This * * list, after packing, will constitute the identifier of the * * physical detector. * * * * THE BASIC USER TOOLS * * * * The data structure JSET is built through calls to the routine * * GSDET which allocates detectors to sets and defines their * * parameters, and to the auxiliary routines GSDETH, GSDETD and * * GSDETU which store respectively in the structure JSET, for each * * logical detector separately: * * * * - the parameters required for the storage of the hit elements in * * the data structure JHITS, such as the packing and scaling * * conventions. * * * * - the parameters required for the storage of the digitisations in * * the structure JDIGI, such as the packing conventions. the user * * parameters, which may consist, for instance, of the intrinsic * * detector characteristics needed for computing the digitisations. * * * * To permit storage of more than one type of hit for a given * * sensitive detector, detector 'aliases' can be defined through * * calls to the routine GSDETA. They are entered in the JSET * * structure as additional detectors, with the same geometrical * * characteristics as the original one. Then, the user has the * * possibility to call the appropriate routines GSDETH, GSDETD and * * GSDETU. * * During the tracking, for each step inside the sensitive * * detectors, under control of the subroutine GUSTEP, the hits can be * * stored in the data structure JHITS with the subroutine GSAHIT (or * * GSCHIT, more appropriate for calorimetry). For each hit the * * information consists of: * * * * - the reference to the track in the structure JKINE, * * - the packed identifier of the physical detector, and * * - the packed data for the different elements of the hit. * * * * When the tracking has been completed for the whole event the * * digitisations can be computed in the user subroutine GUDIGI which * * may extract the hits with the subroutine GFHITS and store the * * digitisations in the data structure JDIGI, with the subroutine * * GSDIGI. For each digitisation the information should at least * * consist of: * * * * - the reference to the track(s), * * - the packed identifier of the physical detector, and * * - the packed data for the digitisation itself. * * * * RETRIEVAL OF GEOMETRICAL INFORMATION * * * * The packed identifier of as physical detector stored a part of * * the hit (or digitisation) information, is returned (unpacked) by * * the routines GFHITS or GFDIGI which extract the information from * * the JHITS or JDIGI structures, and may be used to retrieve the * * identity and geometrical characteristics of the given detector. * * At the moment this is automatized through the use of the * * routines GFPATH (which assumes that the sensitive detectors have * * been declared through the routine GSDETV, not GSDET) and GLVOLU * * which fills the common /GCVOLU/. * * GFPATH prepares the lists LNAM and LNUM required by the routine * * GLVOLU [GEOM 001]. * * Worth is in progress in this area and might lead to a more * * transparent approach. Therefore, the routines GSDETV, GGDETV and * * GFPATH and their action on the structure JSETS will not be * * documented in more detail now. * * * ************************************************************************ +DECK,GCDERR *CMZ : 3.13/05 30/05/89 08.49.53 by Rene Brun *-- Author : SUBROUTINE GCDERR (ICD,ERP,ERS) C. C. ****************************************************************** C. * * C. * ROUTINE TO CALCULATE THE ERROR ON THE CURRENT DIVISION * C. * INFORMATION AS OBTAINED BY "GCDRIF" * C. * * C. * INPUT: ICD = DIGITIZED CURRENT DIVISION INFORMATION * C. * ( 0 ... 1000 ) * C. * ERP = VARIANCE OF GAUSSIAN DISTRIBUTED PEDESTAL * C. * ERRORS ON THE MEASURED PULSE HEIGHTS * C. * RELATIVE TO THE SUM OF THE PULSE HEIGHTS * C. * ERS = VARIANCE OF GAUSSIAN DISTRIBUTED SLOPE * C. * ERRORS ON THE MEASURED PULSE HEIGHTS * C. * RELATIVE TO EACH PULSE HEIGHT * C. * OUTPUT: ICD = VALUE UPDATED ACCORDING TO RANDOM ERRORS * C. * * C. * ==>Called by : , GUDIGI * C. * Author D.Mitaroff ********* * C. * * C. ****************************************************************** C. COMMON /GCYDR/ ZL DIMENSION RNDM(4) C Z = ICD C C---- CALCULATE PEDESTAL ERRORS FOR VARIANCE BEING 1. CALL GRNDM(RNDM,4) * call rannor(eps1,eps2) RY=RNDM(1) RZ=RNDM(2) RX=6.283185*RZ A1=SQRT(-2.*LOG(RY)) EPS1=A1*SIN(RX) EPS2=A1*COS(RX) DZP = - EPS1 * Z + EPS2 * (ZL - Z) C C---- CALCULATE SLOPE ERRORS FOR VARIANCE BEING 1. * call rannor(eps1,eps2) RY=RNDM(3) RZ=RNDM(4) RX=6.283185*RZ A1=SQRT(-2.*LOG(RY)) EPS1=A1*SIN(RX) EPS2=A1*COS(RX) DZS = (EPS2 - EPS1) * Z * (ZL - Z) / ZL C C---- CALCULATE NEW VALUE OF ICD FOR VARIANCES ERP, ERS. Z = Z + ERP * DZP + ERS * DZS IF (Z .LT. 0.) Z = 0. IF (Z .GT. ZL) Z = ZL C ICD = Z C END +DECK,GCDRIF *CMZ : 3.15/01 24/02/92 12.42.08 by Federico Carminati *-- Author : SUBROUTINE GCDRIF (RADD,ZMIN,ZMAX,DETREP,HITREP,IOUT) C. C. ************************************************************************** C. * * C. * Digitisation of Drift- Chambers * C. * -------------------------------- * C. * * C. * Digitisation routine for a cylindrical drift chamber. * C. * RADD radius of cylinder in cm * C. * ZMIN z of lower end of cylinder * C. * ZMAX z of upper end of " * C. * DETREP(1) number of wires * C. * DETREP(2) wire spacing in PHI (radians) * C. * DETREP(3) cosine of wire angle * C. * DETREP(4) sine of wire angle (signed like dphi/dz) * C. * DETREP(5) dphi/dz along wire * C. * DETREP(6) phi of point with z=0 on wire 1 * C. * DETREP(7) drift velocity (cm/nsec) * C. * DETREP(8) quantity describing the drift angle * C. * if.ne.0 ==> user routine GUDTIM * C. * HITREP(1) phi coordinate of intersection * C. * HITREP(2) z coordinate * C. * HITREP(3) dphi/dr * C. * HITREP(4) dz/dr * C. * IOUT(1) wire number (1..NWI with increasing phi) (-1 for * C. * bad DETREP parameters) * C. * IOUT(2) drift time (nsec) (+/- for phi(hit)>/< phi(wire) * C. * IOUT(3) digitised current division information (rel. pos. * C. * along wire of charge) (per mille) * C. * IOUT(4) amount of charge deposited to wire * C. * Coordinate systems along wire * C. * I. Charge I. * C. * . | . * C. * | . | * C. * ========================================= SENSE WIRE * C. * ...................................................> Z (cm) * C. * Z Z. Z. * C. * L * C. * ...............................................> X (arbitrary scale) * C. * 0 X. L * C. * X. (L-X.) * C. * The scaling used is such that L . 1000. * C. * Knowing the position Z. of the deposit of charge, * C. * Z.-ZL * C. * X. = L * C. * . ..... * C. * Z.-ZL * C. * This information is stored into IOUT(3). * C. * Routine to calculate the error on the current division * C. * information as obtained by "GCDRIFT". * C. * ICD digitized current division information * C. * (0 ... 1000) * C. * ERP variance of Gaussian distributed pedestral errors * C. * on the measured pulse heights relative to the sum * C. * of the pulse heights * C. * ERS variance of Gaussian distributed slope errors on * C. * the measured pulse heights relative to the each * C. * pulse heights * C. * Here we assume that X. has been determined by measuring * C. * the pulse heights I., I. with some statistical errors. * C. * X. is then given by the formula * C. * X. = L . I./I. with I. . I.+I. * C. * and its error is determined by * C. * .X. = -(X./I.) .I. + (L-X./I.) .I. * C. * with the errors on measuring the pulse heights * C. * .I. = .. + ...I. * C. * .I. = .. + ...I. * C. * .., .. are of dimension (I) and represent the "pedestral" * C. * errors; * C. * .., .. are the "slope" errors. * C. * All are assumed to be distributed independently (no * C. * correlations), randomly and Gaussian around zero. This gives * C. * the final result * C. * .. .. X.(L-X.) * C. * .X. = - .. X. + .. (L-X.) + (..-..) ........ * C. * I. I. L * C. * .................. ................. * C. * "pedestal" "slope" * C. * In GCDERR, the X. derived from GCDRIF is set to * C. * X. = X. + .X. (but 0 . X. . L) * C. * using ERP ..... variance for ./I. , ../I. distributions * C. * ERS ..... variance for .., .. distributions. * C. * * C. * ==>Called by : , GUDIGI * C. * Author D.Mitaroff ********* * C. * * C. ************************************************************************** C. DIMENSION DETREP(8), HITREP(4), IOUT(4) +SEQ,GCONSP C. C. ----------------------------------------------------------------- C. ZREL = 1000. IOUT(1) = -1 NWI = DETREP(1) WSP = DETREP(2) DVL = DETREP(7) IF (WSP .EQ. 0.) GOTO 99 IF (DVL .EQ. 0.) GOTO 99 C C---- CALCULATE WIRE NUMBER. FI = HITREP(1) ZZ = HITREP(2) FI0 = DETREP(6) + ZZ * DETREP(5) DFI = FI - FI0 10 IF (DFI .GE. 0.) GOTO 11 DFI = DFI + TWOPI GOTO 10 11 IF (DFI .LT. TWOPI) GOTO 12 DFI = DFI - TWOPI GOTO 11 12 IW = DFI / WSP + 0.5 DIS = DFI - IW * WSP IF (IW .EQ. NWI) IW = 0 IOUT(1) = IW + 1 C C---- CALCULATE DRIFT TIME. DIS = DIS * RADD * DETREP(3) IF ( DETREP(8) .NE. 0. ) GOTO 2 IOUT(2) = DIS / DVL GOTO 3 C C---- DRIFT TIME BY USER ROUTINE. 2 IOUT(2) = GUDTIM (DETREP,HITREP,IW+1,DIS) C C---- CALCULATE CURRENT DIVISION INFORMATION. 3 Z0 = ZZ + DIS * DETREP(4) IF (Z0 .LT. ZMIN) Z0 = ZMIN IF (Z0 .GT. ZMAX) Z0 = ZMAX IOUT(3) = ZREL * (Z0 - ZMIN) / (ZMAX - ZMIN) IOUT(4) = 0 C. 99 RETURN END +DECK,GCMWPC *CMZ : 3.15/01 24/02/92 12.42.08 by Federico Carminati *-- Author : SUBROUTINE GCMWPC (DETREP,HITREP,IOUT) C. C. ****************************************************************** C. * * C. * Routine to compute one or two digitisations produced by a * C. * hit on a cylindrical MWPC. * C. * DETREP(1) number of wires * C. * DETREP(2) wire spacing (radians) * C. * DETREP(3) dtheta/dz along the wires * C. * DETREP(4) theta of a point on wire 1 * C. * DETREP(5) z of a point on wire 1 * C. * DETREP(6) gap width * C. * HITREP(1) theta coordinate of intersection * C. * HITREP(2) z coordinate * C. * HITREP(3) dtheta/dr * C. * HITREP(4) dz/dr * C. * IOUT(1) wire number (-1-missing) * C. * IOUT(2) cluster size * C. * IOUT(3) wire number of second cluster if any * C. * IOUT(4) cluster size * C. * * C. * ==>Called by : , GUDIGI * C. * Author M.Hansroul ********* * C. * * C. ****************************************************************** C. +SEQ,GCONSP DIMENSION HITREP(4), DETREP(6), IOUT(4) +SELF,IF=-SINGLE DOUBLE PRECISION ONE +SELF PARAMETER (ONE=1) C. C. ------------------------------------------------------------------ C. IOUT(1) = - 1 IOUT(3) = - 1 ZS = DETREP(2) IF (ZS.EQ.0.) GO TO 99 C. C. COMPUTE WIRE NUMBER C. HG = .5 * DETREP(6) DT = HG * HITREP(3) DZ = HG * HITREP(4) T1 = HITREP(1) - DT T2 = HITREP(1) + DT Z1 = HITREP(2) - DZ Z2 = HITREP(2) + DZ C Z0 = DETREP(5) DT = DETREP(3) DZ = Z1 - Z0 T1 = T1 - DZ * DT DZ = Z2 - Z0 T2 = T2 - DZ * DT T0 = DETREP(4) C T1 = MOD (ONE*T1,TWOPI) T2 = MOD (ONE*T2,TWOPI) T0 = MOD (ONE*T0,TWOPI) IF (T1.LT.0.) T1 = T1 + TWOPI IF (T2.LT.0.) T2 = T2 + TWOPI IF (T0.LT.0.) T0 = T0 + TWOPI C NN = 0 W1 = (T1 - T0) / ZS IF (W1.LE.0.)THEN NN = NN + 1 W1 = W1 + TWOPI / ZS ENDIF C W2 = (T2 - T0) / ZS IF (W2.LE.0.)THEN NN = NN + 1 W2 = W2 + TWOPI / ZS ENDIF C W1 = W1 + 1.5 W2 = W2 + 1.5 IW1 = W1 IW2 = W2 NWIR = DETREP(1) IF (NN.NE.1)THEN C. C. 1 CLUSTER C. IWMIN = MIN (IW1,IW2) IWMAX = MAX (IW1,IW2) IF (IWMIN.GT.NWIR) GO TO 99 C IWMAX = MIN (NWIR,IWMAX) C IOUT(1) = IWMIN IOUT(2) = IWMAX - IWMIN + 1 ELSE C. C. SPECIAL CASE: SIGNAL ON WIRE 1 C. AND ON WIRE 'NWIRES' --> 2 CLUSTERS C. IW = MIN (IW1,IW2) IW = MIN (IW,NWIR) IOUT(1) = 1 IOUT(2) = IW IW = MAX (IW1,IW2) IF (IW.GT.NWIR) GO TO 99 IOUT(3) = IW IOUT(4) = NWIR - IW + 1 ENDIF C 99 RETURN END +DECK,GCUBS *CMZ : 3.12/27 06/09/88 14.33.06 by Rene Brun *-- Author : SUBROUTINE GCUBS(X,Y,D1,D2,A) C. C. C. ****************************************************************** C. * * C. * Calculates a cubic through P1,(-X,Y1),(X,Y2),P2 * C. * where Y2=-Y1 * C. * Y=A(1)+A(2)*X+A(3)*X**2+A(4)*X**3 * C. * The coordinate system is assumed to be the cms system * C. * of P1,P2. * C. * * C. * ==>Called by : GIPLAN,GICYL * C. * Author H.Boerner ********* * C. * * C. ****************************************************************** C. REAL X,Y,D1,D2,A(4) C. C. C. ------------------------------------------------------------------ C. C. IF (X.EQ.0.) GO TO 10 C C FACT = (D1 - D2) * 0.25 A(1) = - 1. * FACT * X A(3) = FACT / X A(2) = (6. * Y - (D1 + D2) * X) / (4. * X) A(4) = ((D1 + D2)*X - 2.*Y) / (4.*X**3) RETURN C 10 A(1) = 0. A(2) = 1. A(3) = 0. A(4) = 0. END +DECK,GFDET *CMZ : 3.14/14 11/06/90 10.13.20 by Rene Brun *-- Author : SUBROUTINE GFDET(IUSET,IUDET,NV,NAMESV,NBITSV,IDTYPE + ,NWHI,NWDI,ISET,IDET) C. C. ****************************************************************** C. * * C. * returns volume parameters for detector IUDET of set IUSET* C. * * C. * Input parameters * C. * IUSET set identifier (4 characters), user defined * C. * IUDET detector identifier (4 characters), name of an * C. * existing volume * C. * * C. * Output parameters * C. * NV number of volume descriptors * C. * NAMESV vector of NV volume descriptors (4 characters) * C. * NBITSV vector of NV bit numbers for packing the volume * C. * numbers * C. * IDTYPE detector type, user defined * C. * NWHI number of words for the primary allocation of HITS * C. * banks * C. * NWDI number of words for the primary allocation of DIGI * C. * banks when first allocation not sufficient * C. * ISET position of set in bank JSET * C. * IDET position of detector in bank JS=IB(JSET-ISET) * C. * If ISET=0 or IDET=0 error * C. * Remarks: * C. * - The vector NAMESV (length NV) contains the list of volume * C. * names which permit the identification of every physical * C. * detector with detector name IUDET. [See example in HITS * C. * 110]. * C. * - Each element of the vector NBITSV (length NV) is the * C. * number of bits used for packing the number of the * C. * corresponding volume, when building the packed identifier * C. * of a given physical detector. * C. * - Vectors NAMESV and NBITSV must be dimensionned at least * C. * to NV in the calling routine. * C. * * C. * ==>Called by : * C. * Author R.Brun , M.Maire ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT DIMENSION NBITSV(1) CHARACTER*4 NAMESV(1),IUSET,IUDET C. C. ------------------------------------------------------------------ C. ISET=0 IDET=0 C C Check if detector IUDET has been defined C IF (JSET.LE.0) GO TO 90 NSET = IQ(JSET-1) IF (NSET.LE.0) GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF (ISET.EQ.0) GO TO 90 JS = LQ(JSET-ISET) NDET = IQ(JS-1) IF (NDET.LE.0) GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF (IDET.EQ.0) GO TO 95 JD=LQ(JS-IDET) NV=IQ(JD+2) NWHI=IQ(JD+7) NWDI=IQ(JD+8) C IF(NV.GT.0)THEN DO 10 I=1,NV CALL UHTOC(IQ(JD+2*I+ 9),4,NAMESV(I),4) NBITSV(I)=IQ(JD+2*I+10) 10 CONTINUE ENDIF C CALL GFATT(IUDET,'DTYP',IDTYPE) GO TO 99 C 90 WRITE (CHMAIL, 1000) IUSET CALL GMAIL(0,0) 1000 FORMAT (' ***** GFDET ERROR SET ',A4,' NOT FOUND') GO TO 99 95 WRITE (CHMAIL, 2000) IUSET,IUDET CALL GMAIL(0,0) 2000 FORMAT (' ***** GFDET ERROR FOR SET ',A4, + ' DETECTOR ',A4,' NOT FOUND') C 99 RETURN END +DECK,GFDETA *CMZ : 3.12/27 06/09/88 14.33.06 by Rene Brun *-- Author : SUBROUTINE GFDETA (IUSET,IUALI,IALI) C. C. ****************************************************************** C. * * C. * Returns the position IALI of the detector alias IUALI * C. * * C. * ==>Called by : , * C. * Author F.Bruyant ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT CHARACTER*4 IUSET,IUALI C C. ------------------------------------------------------------------ C. IF (JSET.LE.0) GO TO 90 NSET = IQ(JSET-1) IF (NSET.LE.0) GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF (ISET.EQ.0) GO TO 90 JS = LQ(JSET-ISET) NDET = IQ(JS-1) IF (NDET.LE.0) GO TO 90 CALL GLOOK(IUALI,IQ(JS+1),NDET,IALI) IF (IALI.EQ.0) GO TO 95 GO TO 99 C 90 WRITE (CHMAIL, 1000) IUSET CALL GMAIL(0,0) 1000 FORMAT (' ***** GFDETA ERROR FOR SET ',A4) GO TO 99 95 WRITE (CHMAIL, 2000) IUSET,IUALI CALL GMAIL(0,0) 2000 FORMAT (' ***** GFDETA ERROR FOR SET ',A4,' ALIAS ',A4, + ' NOT FOUND') C 99 RETURN END +DECK,GFDETD *CMZ : 3.15/01 13/02/91 21.24.50 by Federico Carminati *-- Author : SUBROUTINE GFDETD(IUSET,IUDET,ND,NAMESD,NBITSD) C. C. ****************************************************************** C. * * C. * Returns digitisation parameters for detector IUDET of set * C. * IUSET. * C. * * C. * Input parameters * C. * IUSET user set identifier * C. * IUDET user detector identifier * C. * * C. * Output parameters * C. * ND number of elements per digitisation * C. * NAMESD the ND variable names for the digitisation * C. * elements * C. * NBITSD the ND bit numbers for packing the variable * C. * values. * C. * * C. * ==>Called by : * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT DIMENSION NBITSD(1) CHARACTER*4 IUSET,IUDET,NAMESD(1) C. C. ------------------------------------------------------------------ C. IF(JSET.LE.0)GO TO 90 NSET=IQ(JSET-1) IF(NSET.LE.0)GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 90 JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.LE.0)GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.LE.0)GO TO 95 JD=LQ(JS-IDET) JDD=LQ(JD-2) ND=IQ(JD+6) C IF(ND.GT.0)THEN DO 10 I=1,ND CALL UHTOC(IQ(JDD+2*I-1),4,NAMESD(I),4) NBITSD(I)=IQ(JDD+2*I ) 10 CONTINUE ENDIF GO TO 99 C C Error C 90 WRITE (CHMAIL, 1000) IUSET CALL GMAIL(0,0) 1000 FORMAT (' ***** GFDETD ERROR SET ',A4,' NOT FOUND') GO TO 99 95 WRITE (CHMAIL, 2000) IUSET,IUDET CALL GMAIL(0,0) 2000 FORMAT (' ***** GFDETD ERROR FOR SET ',A4, + ' DETECTOR ',A4,' NOT FOUND') C 99 RETURN END +DECK,GFDETH *CMZ : 3.15/01 13/02/91 21.24.50 by Federico Carminati *-- Author : SUBROUTINE GFDETH(IUSET,IUDET,NH,NAMESH,NBITSH,ORIG,FACT) C. C. ****************************************************************** C. * * C. * Returns hit parameters for detector IUDET of set IUSET. * C. * * C. * Input parameters * C. * IUSET user set identifier * C. * IUDET user detector identifier * C. * * C. * Output parameters * C. * NH number of elements per hit * C. * NAMESH the NH variable names for the hit elements * C. * NBITSH the NH bit numbers for packing the variable values * C. * ORIG The quantity packed in the structure JHITS for the * C. * Ith variable is a positive integer with NBITSH(I) * C. * bits and such that * C. * FACT IVAR(I) = (VAR(I)+ORIG(I))*FACT(I) * C. * * C. * ==>Called by : * C. * Author R.Brun ,M.Maire ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT DIMENSION NBITSH(1),ORIG(1),FACT(1) CHARACTER*4 IUSET,IUDET,NAMESH(1) C. C. ------------------------------------------------------------------ C. IF(JSET.LE.0)GO TO 90 NSET=IQ(JSET-1) IF(NSET.LE.0)GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 90 JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.LE.0)GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.LE.0)GO TO 95 JD=LQ(JS-IDET) JDH=LQ(JD-1) NH=IQ(JD+4) C IF(NH.GT.0)THEN DO 10 I=1,NH CALL UHTOC(IQ(JDH+4*I-3),4,NAMESH(I),4) NBITSH(I)=IQ(JDH+4*I-2) ORIG(I) = Q(JDH+4*I-1) FACT(I) = Q(JDH+4*I ) 10 CONTINUE ENDIF GO TO 99 C C Error C 90 WRITE (CHMAIL, 1000) IUSET CALL GMAIL(0,0) 1000 FORMAT (' ***** GFDETH ERROR SET ',A4,' NOT FOUND') GO TO 99 95 WRITE (CHMAIL, 2000) IUSET,IUDET CALL GMAIL(0,0) 2000 FORMAT (' ***** GFDETH ERROR FOR SET ',A4, + ' DETECTOR ',A4,' NOT FOUND') C 99 RETURN END +DECK,GFDETU *CMZ : 3.12/27 06/09/88 14.33.07 by Rene Brun *-- Author : SUBROUTINE GFDETU(IUSET,IUDET,NUPAR,NW,UPAR) C. C. ******************************************************************* C. * * C. * Return in UPAR the first NUPAR user parameters of detector * C. * IUDET. NW is the total number of parameters(output), or zero * C. * if an error occured. * C. * * C. * ==>Called by : * C. * Author W.Gebel ********* * C. * * C. ******************************************************************* C. +SEQ,GCBANK +SEQ,GCUNIT DIMENSION UPAR(1) CHARACTER*4 IUSET,IUDET C. C. ------------------------------------------------------------------ C. NW=0 NSET=IQ(JSET-1) IF(NSET.LE.0) GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,IS) IF(IS.LE.0) GO TO 90 JS=LQ(JSET-IS) ND=IQ(JS-1) IF(ND.LE.0) GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),ND,ID) IF(ID.LE.0) GO TO 95 JD=LQ(JS-ID) JU=LQ(JD-3) IF(JU.NE.0)THEN NW=IQ(JU-1) IF(NUPAR.GT.0) CALL UCOPY(Q(JU+1),UPAR(1),NUPAR) ENDIF GO TO 99 C C Error C 90 WRITE (CHMAIL, 1000) IUSET CALL GMAIL(0,0) 1000 FORMAT (' ***** GFDETU ERROR SET ',A4,' NOT FOUND') GO TO 99 95 WRITE (CHMAIL, 2000) IUSET,IUDET CALL GMAIL(0,0) 2000 FORMAT (' ***** GFDETU ERROR FOR SET ',A4, + ' DETECTOR ',A4,' NOT FOUND') C 99 RETURN END +DECK,GFDIGI *CMZ : 3.14/14 20/06/90 17.37.03 by Rene Brun *-- Author : SUBROUTINE GFDIGI(IUSET,IUDET,NTDIM,NVDIM,NDDIM,NDMAX,NUMVS +, LTRA,NTRA,NUMBV,KDIGI,NDIGS) C. C. ****************************************************************** C. * * C. * * C. * Returns the digitisations for the physical volume * C. * specified by the list NUMVS with generic volume name IUDET * C. * belonging to set IUSET. * C. * IUSET user set identifier * C. * IUDET user detector identifier (name of the * C. * corresponding sensitive volume) * C. * NTDIM 1st dimension of LTRA (max. number of tracks * C. * contributing) * C. * NVDIM 1st dimension of NUMVS, NUMBV (usually =NV, the * C. * number of volume descriptors which permit to iden- * C. * tify a given detector, possibly smaller than NV) * C. * NDDIM 1st dimension of KDIGI (argument ND of GSDETD) * C. * NDMAX is the maximum number of digitisations to be * C. * returned * C. * NUMVS is a 1-Dim array that must contain on input the * C. * geometric path of the detector volume to be * C. * selected. * C. * All 0 interpreted as 'all physical volumes with * C. * generic name IUDET' * C. * LTRA is a 2-Dim array that will contain on output for * C. * each digitisation the numbers of the tracks which * C. * have produced it * C. * NTRA is a 1-Dim array that will contain on output for * C. * each digitisation the total number of tracks * C. * contributing. * C. * In case this number is greater than NTDIM, only * C. * the first NTDIM corresponding tracks can be * C. * returned on LTRA * C. * NUMBV is a 2-Dim array that will contain on output for * C. * each digitisation the list of volume numbers which * C. * identify each physical volume * C. * KDIGI is a 2-Dim array that will contain the NDIGI * C. * digitisations * C. * NDIGI is the total number of digitisations in this * C. * detector. * C. * In case the total number of digitisations is * C. * greater than NDMAX, NDIGI is set to NDMAX+1 and * C. * only NDMAX digitisations are returned * C. * - KDIGI(1,I) = digitisation type 1 for digitisation * C. * number I * C. * - NUMBV(1,I) = volume number 1 for digitisation number I * C. * - LTRA (1,I) = first track number contributing to * C. * digitisation number I * C. * In the calling routine, the arrays LTRA, NTRA, NUMVS, * C. * NUMBV, KDIGI must be dimensioned to: * C. * LTRA (NTDIM,NDMAX) * C. * NTRA (NDMAX) * C. * NUMVS(NVDIM) * C. * NUMBV(NVDIM,NDMAX) * C. * KDIGI(NDDIM,NDMAX) * C. * * C. * ==>Called by : * C. * Author W.Gebel ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK PARAMETER (NVMAX=20) DIMENSION NUMVT(NVMAX),NUMVS(NVDIM),NUMBV(NVDIM,1) DIMENSION LTRA(NTDIM,1),NTRA(1),KDIGI(NDDIM,1) EQUIVALENCE (WS(1),NUMVT(1)) CHARACTER*4 IUSET,IUDET C. C. -------------------------------------------------------------------------- C. C Find if selected set, detector exists C NDIGS=0 IF(JDIGI.LE.0)GO TO 999 NSET=IQ(JSET-1) CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 999 C JS=LQ(JSET-ISET) JDI=LQ(JDIGI-ISET) IF(JS.LE.0)GO TO 999 IF(JDI.LE.0)GO TO 999 NDET=IQ(JS-1) CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.EQ.0)GO TO 999 C JD=LQ(JS-IDET) JDID=LQ(JDI-IDET) IF(JDID.LE.0)GO TO 999 JDDI=LQ(JD-2) C ILAST=IQ(JDI+IDET) IF(ILAST.EQ.0)GO TO 999 NV=IQ(JD+2) ND=IQ(JD+6) C C C Loop on all digits C C IDIG=0 I=0 NWDI=0 C 10 CONTINUE I=I+NWDI IF(I.GE.ILAST)GO TO 110 NWDI=IQ(JDID+I+1) NK=2 C NTRM1= JBYT(IQ(JDID+I+NK),1,16) NTRT = NTRM1+1 NWTR = NTRT/2+1 NK = NK+NWTR C C Find the selected volume C (if NO volumes exist take ALL digits) C IF(NV.GT.0)THEN K=1 DO 40 IV=1,NV NB=IQ(JD+2*IV+10) IF(NB.LE.0)THEN IF(K.GT.1)THEN K=1 NK=NK+1 ENDIF IF(IV.LE.NVMAX)NUMVT(IV)=IQ(JDID+I+NK) IF(IV.NE.NV)NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF IF(IV.LE.NVMAX)NUMVT(IV)=JBYT(IQ(JDID+I+NK),K,NB) K=K+NB ENDIF IF(IV.LE.NVDIM)THEN IF(NUMVS(IV).NE.0)THEN IF(NUMVS(IV).NE.NUMVT(IV))GO TO 10 ENDIF ENDIF 40 CONTINUE NK=NK+1 ENDIF C C C C ========> Now store number of tracks and volume numbers, C and fetch track numbers and digits C IDIG=IDIG+1 IF(IDIG.GT.NDMAX)GO TO 110 C NTRA(IDIG)=NTRT NVMIN=MIN(NV,NVDIM) CALL VZERO (NUMBV(1,IDIG),NVDIM) CALL UCOPY (NUMVT(1),NUMBV(1,IDIG),NVMIN) C C Get track numbers C MK=NK NK=2 IF(NTRT.GT.0)THEN IF(NTRM1.GE.1)THEN DO 54 ITR=1,NTRM1,2 IF(ITR.LE.NTDIM)THEN LTRA(ITR ,IDIG)=JBYT(IQ(JDID+I+NK),17,16) ENDIF NK=NK+1 IF(ITR.LT.NTDIM)THEN LTRA(ITR+1,IDIG)=JBYT(IQ(JDID+I+NK), 1,16) ENDIF 54 CONTINUE ENDIF IF(NTRT.LE.NTDIM)THEN IF(MOD(NTRT,2).EQ.1)LTRA(NTRT,IDIG)=JBYT(IQ(JDID+I+NK),17,16) ENDIF ENDIF NK=MK C C Get unpacked digits C IF(ND.LE.0)GO TO 10 K=1 DO 90 ID=1,ND NB=IQ(JDDI+2*ID) IF(NB.LE.0)THEN IF(K.GT.1)THEN K=1 NK=NK+1 ENDIF IF(ID.LE.NDDIM)KDIGI(ID,IDIG)=IQ(JDID+I+NK) IF(ID.NE.ND)NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF IF(ID.LE.NDDIM)KDIGI(ID,IDIG)=JBYT(IQ(JDID+I+NK),K,NB) K=K+NB ENDIF 90 CONTINUE C GO TO 10 C 110 NDIGS=IDIG C 999 RETURN END +DECK,GFHITS *CMZ : 3.14/14 20/06/90 17.37.14 by Rene Brun *-- Author : SUBROUTINE GFHITS(IUSET,IUDET,NVDIM,NHDIM,NHMAX,ITRS,NUMVS +, ITRA,NUMBV,HITS,NHITS) C. C. ****************************************************************** C. * * C. * * C. * Returns the hits produced by track ITRS (if 0, by all * C. * tracks) in the physical volume specified by the list NUMVS * C. * with generic volume name IUDET belonging to set IUSET. * C. * IUSET user set identifier * C. * IUDET user detector identifier (name of the * C. * corresponding sensitive volume) * C. * NVDIM 1st dimension of NUMBV and NUMVS (usually =NV, the * C. * number of volume descriptors which permit to identify* C. * a given detector, eventually smaller than NV) * C. * NHDIM 1st dimension of array HITS (argument NH of * C. * GSDETH) * C. * NHMAX maximum number of hits to be returned * C. * ITRS number of the selected track. If ITRS=0, all * C. * tracks are taken * C. * NUMVS is a 1-Dim array that must contain on input the * C. * geometric path of the detector volume to be * C. * selected. All 0 interpreted as 'all physical * C. * volumes with generic names IUDET' * C. * ITRA is a 1-Dim array that will contain on output for * C. * each hit the number of the track which has * C. * produced it * C. * NUMBV 2-Dim array that will contain on output for each * C. * hit the list of volume numbers which identify each * C. * physical volume. Zeroed when no more volumes are * C. * stored * C. * HITS 2-Dim array that will contain the NHITS hits * C. * NHITS returns the number of selected hits. In case the * C. * total number of hits is greater than NHMAX, NHITS * C. * is set to NHMAX+1 and only NHMAX hits are returned * C. * - HITS(1,I) is the element 1 for hit number I * C. * - NUMBV(1,I) is the volume number 1 for hit number I * C. * - ITRA(I) is the track number corresponding to hit * C. * number I * C. * In the calling routine the arrays NUMVS, NUMBV, HITS and * C. * ITRA must be dimensioned to: * C. * NUMVS(NVDIM) * C. * NUMBV(NVDIM,NHMAX) * C. * HITS(NHDIM,NHMAX) * C. * ITRA(NHMAX) * C. * * C. * ==>Called by : , GUDIGI * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK PARAMETER (NVMAX=20) DIMENSION NUMVT(NVMAX),NUMVS(NVDIM),NUMBV(NVDIM,1),ITRA(1) DIMENSION HITS(NHDIM,1) EQUIVALENCE (WS(1),NUMVT(1)) CHARACTER*4 IUSET,IUDET C. C. ------------------------------------------------------------------ C. C Find if selected set, detector exists C NHITS=0 IF(JHITS.LE.0)GO TO 999 NSET=IQ(JSET-1) CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 999 C JS=LQ(JSET-ISET) JH=LQ(JHITS-ISET) IF(JS.LE.0)GO TO 999 IF(JH.LE.0)GO TO 999 NDET=IQ(JS-1) CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.EQ.0)GO TO 999 C JD=LQ(JS-IDET) JHD=LQ(JH-IDET) IF(JHD.LE.0)GO TO 999 JDH=LQ(JD-1) C ILAST=IQ(JH+IDET) IF(ILAST.EQ.0)GO TO 999 NV=IQ(JD+2) NH=IQ(JD+4) NW=IQ(JD+1)+IQ(JD+3)+1 C C C Loop on all hits C C IHIT=0 DO 100 I=1,ILAST,NW C C Find the selected track C ITRT=IQ(JHD+I) IF(ITRS.NE.0 .AND. ITRS.NE.ITRT)GO TO 100 C C Find the selected volume C (if NO volumes exist take ALL hits) C NK=1 IF(NV.GT.0)THEN K=1 DO 40 IV=1,NV NB=IQ(JD+2*IV+10) IF(NB.LE.0)THEN IF(K.GT.1)THEN K=1 NK=NK+1 ENDIF IF(IV.LE.NVMAX)NUMVT(IV)=IQ(JHD+I+NK) IF(IV.NE.NV)NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF IF(IV.LE.NVMAX)NUMVT(IV)=JBYT(IQ(JHD+I+NK),K,NB) K=K+NB ENDIF IF(IV.LE.NVDIM)THEN IF(NUMVS(IV).NE.0)THEN IF(NUMVS(IV).NE.NUMVT(IV))GO TO 100 ENDIF ENDIF 40 CONTINUE NK=NK+1 ENDIF C C C C ========> Now store track number and volume numbers and fetch hits C IHIT=IHIT+1 IF(IHIT.GT.NHMAX)GO TO 110 C ITRA(IHIT)=ITRT NVMIN=MIN(NV,NVDIM) DO 55 J=1,NVDIM 55 NUMBV(J,IHIT)=0 DO 57 J=1,NVMIN 57 NUMBV(J,IHIT)=NUMVT(J) C C Get unpacked hits C Hits origin is shifted . Division by scale factor C IF(NH.GT.0)THEN K=1 DO 90 IH=1,NH NB=IQ(JDH+4*IH-2) IF(NB.LE.0)THEN IF(K.GT.1)THEN K=1 NK=NK+1 ENDIF KHIT=IQ(JHD+I+NK) NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF KHIT=JBYT(IQ(JHD+I+NK),K,NB) K=K+NB ENDIF IF(IH.LE.NHDIM)THEN HITS(IH,IHIT)=FLOAT(KHIT)/Q(JDH+4*IH) - Q(JDH+4*IH-1) ENDIF 90 CONTINUE ENDIF 100 CONTINUE C 110 NHITS=IHIT C 999 RETURN END +DECK, GFNDIG. *CMZ : 3.14/14 22/02/90 16.00.12 by Rene Brun *-- Author : SUBROUTINE GFNDIG (IUSET, IUDET, NDIGI) C. C. ****************************************************************** C. * * C. * SUBR. GFNDIG (IUSET, IUDET, NDIGI*) * C. * * C. * Returns the number of digits belonging to the detector IUDET * C. * of set IUSET * C. * * C. * IUSET User set identifier * C. * IUDET User detector identifier (name of the corresponding * C. * sensivitive volume) * C. * NDIGI returns the total number of digits * C. * * C. * Called by : * C. * Author : S.Banerjee * C. * * C. ****************************************************************** C. +CDE, GCBANK. CHARACTER*4 IUSET, IUDET C. C. ------------------------------------------------------------------ * * *** Find if selected set, detector exists * NDIGI = 0 IF (JDIGI.LE.0) GO TO 999 NSET = IQ(JSET-1) CALL GLOOK (IUSET, IQ(JSET+1), NSET, ISET) IF (ISET.LE.0) GO TO 999 * JS = LQ(JSET-ISET) JDI = LQ(JDIGI-ISET) IF (JS.LE.0) GO TO 999 IF (JDI.LE.0) GO TO 999 NDET = IQ(JS-1) CALL GLOOK (IUDET, IQ(JS+1), NDET, IDET) IF (IDET.LE.0) GO TO 999 * JDID = LQ(JDI-IDET) IF (JDID.LE.0) GO TO 999 ILAST = IQ(JDI+IDET) * IF (ILAST.NE.0) NDIGI = IQ(JDID+ILAST) * END GFNDIG 999 END +DECK, GFNHIT. *CMZ : 3.13/03 25/04/89 12.07.56 by F.Bruyant *-- Author : SUBROUTINE GFNHIT (IUSET, IUDET, NHITS) C. C. ****************************************************************** C. * * C. * SUBR. GFNHIT (IUSET, IUDET, NHITS*) * C. * * C. * Returns the number of hits belonging to the detector IUDET * C. * of set IUSET * C. * * C. * IUSET User set identifier * C. * IUDET User detector identifier (name of the corresponding * C. * sensivitive volume) * C. * NHITS returns the total number of hits * C. * * C. * Called by : * C. * Author : S.Banerjee * C. * * C. ****************************************************************** C. +CDE, GCBANK. CHARACTER*4 IUSET, IUDET C. C. ------------------------------------------------------------------ * * *** Find if selected set, detector exists * NHITS = 0 IF (JHITS.LE.0) GO TO 999 NSET = IQ(JSET-1) CALL GLOOK (IUSET, IQ(JSET+1), NSET, ISET) IF (ISET.LE.0) GO TO 999 * JS = LQ(JSET-ISET) JH = LQ(JHITS-ISET) IF (JS.LE.0) GO TO 999 IF (JH.LE.0) GO TO 999 NDET = IQ(JS-1) CALL GLOOK (IUDET, IQ(JS+1), NDET, IDET) IF (IDET.LE.0) GO TO 999 * JD = LQ(JS-IDET) JHD = LQ(JH-IDET) IF (JHD.LE.0) GO TO 999 NFIX = IQ(JD+1) + IQ(JD+3) + 1 ILAST = IQ(JH+IDET) * IF (ILAST.GT.0) NHITS = ILAST / NFIX * END GFNHIT 999 END +DECK,GFPATH *CMZ : 3.12/27 06/09/88 14.33.07 by Rene Brun *-- Author : SUBROUTINE GFPATH (ISET, IDET, NUMBV, NLEV, LNAM, LNUM) C. C. ****************************************************************** C. * * C. * Return the lists of NLEV volume names (LNAM) and numbers * C. * (LNUM) which identify the path through the JVOLUM data * C. * structure for the volume corresponding to the detector * C. * at position IDET in set at position ISET identified by * C. * the list of node identifiers given in NUMBV. * C. * * C. * NLEV is expected to be greater than 1 * C. * and no checks are performed on the validity of ISET/IDET * C. * In case of user error NLEV returns with the value 0. * C. * * C. * ==> Called by : * C. * Author F.Bruyant ********** * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCUNIT. INTEGER LNAM(*), LNUM(*), NUMBV(*) C. C. ----------------------------------------------------------------- C. JS = LQ(JSET-ISET) JD = LQ(JS-IDET) NV = IQ(JD+2) IPJD = JD +10 +2*NV LNAM(1) = IQ(IPJD+1) LNUM(1) = 1 NLEV = IQ(IPJD+2) C NSOL = IQ(JD+9) IF (NSOL.EQ.1) THEN C C Usual case C I = 0 DO 10 N = 2,NLEV IPJD = IPJD +2 LNAM(N) = IQ(IPJD+1) LNUM(N) = 1 IF (IQ(IPJD+2).LE.1) GO TO 10 I = I +1 LNUM(N) = NUMBV(I) 10 CONTINUE C ELSE IF (NSOL.GT.1) THEN C C Case with multiple path C IPSTO = IPJD DO 90 IS = 1,NSOL IPJDD = JD +8 DO 30 I = 1,NV IPJDD = IPJDD +2 IF (NUMBV(I).EQ.0) GO TO 30 IPJD = IPSTO DO 20 N = 2,NLEV IPJD = IPJD +2 IF (IQ(IPJD+1).EQ.IQ(IPJDD+1)) GO TO 30 20 CONTINUE GO TO 81 30 CONTINUE C C Fill LNAM,LNUM C IPJD = IPSTO DO 40 N = 2,NLEV IPJD = IPJD +2 LNAM(N) = IQ(IPJD+1) LNUM(N) = 1 40 CONTINUE IPJDD = JD +8 DO 60 I = 1,NV IPJDD = IPJDD +2 IF (NUMBV(I).EQ.0) GO TO 60 IPJD = IPSTO DO 50 N = 2,NLEV IPJD = IPJD +2 IF (IQ(IPJD+1).NE.IQ(IPJDD+1)) GO TO 50 IF (NUMBV(I).GT.IQ(IPJD+2)) GO TO 991 LNUM(N) = NUMBV(I) GO TO 60 50 CONTINUE 60 CONTINUE GO TO 999 C 81 IF (IS.EQ.NSOL) GO TO 991 IPSTO = IPSTO +2*NLEV NLEV = IQ(IPSTO+2) C 90 CONTINUE C ELSE C C User error C GO TO 991 C ENDIF GO TO 999 C 991 NLEV = 0 WRITE (CHMAIL, 1000) IQ(JD+9) CALL GMAIL(0,0) C 1000 FORMAT (' ***** GFPATH USER ERROR, IQ(JD+9)=',I2) C 999 RETURN END +DECK,GGDETV. *CMZ : 3.13/05 22/05/89 17.11.07 by Rene Brun *-- Author : SUBROUTINE GGDETV (ISET, IDET) C. C. ****************************************************************** C. * * C. * Routine - to compute and store the list of volumes which * C. * permit to identify uniquely any detector volume specified * C. * by the set number ISET, the detector number IDET and the * C. * corresponding list of volume copy numbers * C. * - to compute and store the physical path(s) through * C. * the JVOLUM data structure down to the given detector volume * C. * * C. * ==>Called by : GHCLOS * C. * Author F.Bruyant ********* * C. * * C. ****************************************************************** C. +SEQ, GCBANK. +SEQ, GCFLAG. +SEQ, GCNUM. +SEQ, GCUNIT. C. PARAMETER (NLVMAX=15,NSKMAX=20,NVMAX=20) INTEGER IVOSK(NSKMAX,NLVMAX-1), LIMUL(NLVMAX), LINAM(NLVMAX) +, LIST(2), NSK(NLVMAX-1) EQUIVALENCE (LINAM(1),WS(1)), (LIMUL(1),WS(NLVMAX+1)), (IVOSK(1,1) +, WS(2*NLVMAX+1)), (NSK(1),WS((NSKMAX+2)*(NLVMAX-1)+3)) +, (LIST(1),WS((NSKMAX+3)*(NLVMAX-1)+3)) C. C. ------------------------------------------------------------- C. JS = LQ(JSET-ISET) JD = LQ(JS-IDET) C C Check that JD bank has been created by GSDETV (not GSDET) C or has not been already processed. C IF (IQ(JD+9).NE.-1) GO TO 999 IQ(JD+9) = -2 IHDET = IQ(JS+IDET) IF (IDEBUG.NE.0) THEN WRITE (CHMAIL, 1001) IHDET CALL GMAIL (0,0) 1001 FORMAT (' GGDETV : Detector ',A4) ENDIF C C Check that current detector is not an alias C IALI = IQ(JD+10) IF (IALI.NE.0) GO TO 200 NSOL = 0 NV = 0 NLIST = 0 CALL VZERO (NSK, NLVMAX-1) NLEV = 1 LINAM(1) = IHDET MULT1 = 1 10 IVOS = IUCOMP (LINAM(NLEV), IQ(JVOLUM+1), NVOLUM) C C Search for detector parents up to top of tree C 20 IF (IVOS.EQ.1) GO TO 60 C DO 40 IVO=1,NVOLUM IF (IVO.EQ.IVOS) GO TO 40 JVO = LQ(JVOLUM-IVO) NIN = Q(JVO+3) IF (NIN.EQ.0) GO TO 40 IF (NSOL.GT.0) THEN C Skip mother banks already found IF (IUCOMP (IVO, IVOSK(1,NLEV), NSK(NLEV)) .NE. 0) GO TO 40 ENDIF C IF (NIN.LT.0) THEN C Division case JDIV = LQ(JVO-1) IF (IFIX(Q(JDIV+2)).NE.IVOS) GO TO 40 MULTI = ABS(Q(JDIV+3)) IF (MULTI.EQ.0) MULTI = 255 ELSE C Position case MULTI = 0 DO 30 IN=1,NIN JIN = LQ(JVO-IN) IF (IFIX(Q(JIN+2)).NE.IVOS) GO TO 30 MULTI = MAX(MULTI, IFIX(Q(JIN+3))) 30 CONTINUE IF (MULTI.EQ.0) GO TO 40 ENDIF C C New level found C LIMUL(NLEV) = MULTI IF (NLEV.EQ.NLVMAX) GO TO 920 IF (NSK(NLEV).EQ.NSKMAX) GO TO 930 NSK(NLEV) = NSK(NLEV) +1 IVOSK(NSK(NLEV),NLEV) = IVO NLEV = NLEV +1 LINAM(NLEV) = IQ(JVOLUM+IVO) IVOS = IVO GO TO 20 C 40 CONTINUE C C No more path found at current level C IF (NSK(NLEV).EQ.0) GO TO 910 IF (NSK(NLEV).GT.1.OR.LIMUL(NLEV+1).GT.1) THEN DO 50 N = 1,NSK(NLEV) IVO = IVOSK(N,NLEV) NANEW = IQ(JVOLUM+IVO) IPJD = JD +10 IF (NV.GT.0) THEN DO 49 I = 1,NV IF (NANEW.EQ.IQ(IPJD+1)) GO TO 50 IPJD = IPJD +2 49 CONTINUE ENDIF IF (NV.EQ.NVMAX) GO TO 940 NV = NV +1 IQ(IPJD+1) = NANEW 50 CONTINUE ENDIF GO TO 90 C C Store current solution C 60 NSOL = NSOL +1 LIMUL(NLEV) = 0 IF (LIMUL(1).GT.MULT1) MULT1 = LIMUL(1) +SELF, IF=DEBUGG. IF (IDEBUG.NE.0) THEN WRITE (CHMAIL, 1002) NSOL, NLEV CALL GMAIL (0,0) WRITE (CHMAIL, 1012) (LINAM(I),LIMUL(I),I=1,NLEV) CALL GMAIL (0,0) 1002 FORMAT (' GGDETV DEBUG : NSOL,NLEV ',2I3) 1012 FORMAT (15(1X,A4,I3)) ENDIF +SELF. C DO 80 N = NLEV,1,-1 LIST(NLIST+1) = LINAM(N) LIST(NLIST+2) = LIMUL(N) IF (N.EQ.NLEV) LIST(NLIST+2) = NLEV NLIST = NLIST +2 80 CONTINUE IF (NLEV.LT.3) GO TO 100 NLEV = NLEV -1 C 90 NSK(NLEV) = 0 NLEV = NLEV -1 IF (NLEV.GT.0) GO TO 10 C 100 IF (MULT1.GT.1) THEN NV = NV +1 IQ(JD+9+2*NV) = LINAM(1) ENDIF C C Perform final operations on JD bank C NW = 0 IF (NV.EQ.0) GO TO 150 C C Compute maximum multiplicities C DO 120 N = 1,NLIST,2 IPJD = JD +10 DO 110 I = 1,NV IF (IQ(IPJD+1).EQ.LIST(N)) + IQ(IPJD+2)=MAX(IQ(IPJD+2),LIST(N+1)) IPJD = IPJD +2 110 CONTINUE 120 CONTINUE C IF (IDEBUG.NE.0) THEN I2 = 0 125 I1 = I2 + 1 I2 = I1 + 14 IF (I2.GT.NV) I2 = NV WRITE (CHMAIL, 1003) (IQ(JD+10+I),I=2*I1-1,2*I2) CALL GMAIL (0, 0) IF (I2.LT.NV) GO TO 125 1003 FORMAT (10X,15(1X,A4,I3)) ENDIF C C Compute corresponding bit numbers for packing C IPJD = JD +10 K = 32 DO 140 N = 1,NV NBITS = 0 130 NBITS = NBITS +1 IF (IQ(IPJD+2).GT.2**NBITS-1) GO TO 130 IF (NBITS.GE.32) NBITS = 0 IQ(IPJD+2) = NBITS IPJD = IPJD +2 IF (NBITS.EQ.0) THEN K = 32 NW = NW +1 ELSE K = K +NBITS IF (K.LE.32) GO TO 140 K = NBITS NW = NW +1 ENDIF 140 CONTINUE C 150 IQ(JD+1) = NW IQ(JD+2) = NV IQ(JD+9) = NSOL C NDATA = 10 +2*NV +NLIST ND = IQ(JD-1) CALL MZPUSH (IXCONS, JD, 0, NDATA-ND, 'I') CALL UCOPY (LIST, IQ(JD+2*NV+11), NLIST) +SELF, IF=DEBUGG. IF (IDEBUG.NE.0) THEN ND1=MIN(10,NDATA) WRITE (CHMAIL, 1004) NDATA,(IQ(JD+I),I=1,ND1) CALL GMAIL (0,0) DO 160 II=ND1+1,NDATA,10 ND2=MIN(II+9,NDATA) WRITE (CHMAIL, 1005) (IQ(JD+I),I=II,ND2) CALL GMAIL (0,0) 160 CONTINUE 1004 FORMAT (' GGDETV DEBUG : NDATA ',I3,' JD --> ',10I4) 1005 FORMAT (10(1X,A4,I4)) ENDIF +SELF. GO TO 999 C C Current detector IDET is an alias C 200 CONTINUE IF (IDEBUG.NE.0) THEN IHALI = IQ(JS+IALI) WRITE (CHMAIL, 1006) IHALI CALL GMAIL (0,0) 1006 FORMAT (' Alias of detector ',A4) ENDIF C IDM = IQ(JD+10) JDM = LQ(JS-IDM) NDM = IQ(JDM-1) ND = IQ(JD-1) CALL MZPUSH (IXCONS, JD, 0, NDM-ND, 'I') NWHI = IQ(JD+7) NWDI = IQ(JD+8) JS = LQ(JSET-ISET) JDM = LQ(JS-IDM) CALL UCOPY (IQ(JDM+1), IQ(JD+1), NDM) IQ(JD+7) = NWHI IQ(JD+8) = NWDI IQ(JD+10) = IDM GO TO 999 C C Errors C 910 WRITE (CHMAIL, 1000) LINAM(NLEV) CALL GMAIL (0,0) 1000 FORMAT (' GGDETV : Hanging volume ',A4) GO TO 990 920 CHMAIL=' GGDETV : Parameter NLVMAX too small' CALL GMAIL (0,0) GO TO 990 930 CHMAIL=' GGDETV : Parameter NSKMAX too small' CALL GMAIL (0,0) GO TO 990 940 CHMAIL=' GGDETV : NVMAX (= size of NUMBV) too small' CALL GMAIL (0,0) 990 IEOTRI = 1 C 999 RETURN END +DECK,GICYL *CMZ : 3.12/27 06/09/88 14.33.08 by Rene Brun *-- Author : SUBROUTINE GICYL(R,X1,X2,S1,S2,IC,XINT,SINT,PZINT,IFLAG) C. C. ****************************************************************** C. * * C. * Intersection of a Track with a Cylinder or a Plane * C. * -------------------------------------------------- * C. * * C. * Calculates intersection of track (x1,x2) with cylindrical * C. * detector of radius R. The track is approximated by a cubic * C. * in the track length. To improve stability, the coordinate * C. * system is shifted. * C. * R radius of cylinder in cm * C. * X1 x,y,z,xp,yp,zp of 1st point * C. * X2 x,y,z,xp,yp,zp of 2nd point * C. * S1(2) S at 1st (2nd) point * C. * IC =1 straight line defined by x+xp * C. * IC =2 straight line defined by x1+x2 * C. * IC =3 cubic model * C. * XINT x,y,z,xp,yp,zp at intersection point * C. * SINT S at intersection point * C. * PZINT phi,z,dphi/dr,dz/dr * C. * IFLAG =1 if track intersects cylinder, =0 if not * C. * Calculates intersection of track (x1,x2) with plane * C. * parallel to (X-Z). The track is approximated by a cubic in * C. * the track length. To improve stability, the coordinate * C. * system is shifted. * C. * YC Y coordinate of plane * C. * X1,... as for GICYL * C. * IFLAG =1 if track intersects plane, * C. * =0 if not * C. * Warning: the default accuracy is 10 microns. The value of * C. * EPSI (internal variable) must be changed for a * C. * better precision. * C. * * C. * ==>Called by : , GUDIGI * C. * * C. * AUTHORS:R.BRUN/JJ.DUMONT FROM AN ORIGINAL ROUTINE BY * C. * H. BOERNER KEK OCTOBER 1982 * C. * * C. * * C. ****************************************************************** C. DIMENSION X1(6),X2(6),XINT(6),PZINT(4),A(4),B(4),C(4) C DATA MAXHIT/100/ DATA EPSI2/0.000001/ C. C. C. ------------------------------------------------------------------ C. C. IFLAG = 1 R12 = X1(1) * X1(1) + X1(2) * X1(2) R22 = X2(1) * X2(1) + X2(2) * X2(2) R2 = R * R DR2 = R22-R2 C C TRACK CROSSING THE CYLINDER FROM INSIDE OR OUTSIDE ? C IF (R22.LT.R12) GO TO 5 IF (R2.LT.R12) GO TO 90 IF (R2.GT.R22) GO TO 90 DRCTN = 1. IF (IC.EQ.3) GO TO 7 C IF(IC.EQ.2) GOTO 30 S=S1 DXDS=X1(4) DYDS=X1(5) DZDS=X1(6) BX=X1(1)-DXDS*S BY=X1(2)-DYDS*S BZ=X1(3)-DZDS*S GO TO 40 C 5 IF (R2.LT.R22) GO TO 90 IF (R2.GT.R12) GO TO 90 DRCTN = - 1. C IF(IC.EQ.3) GOTO 7 IF(IC.EQ.2) GOTO 30 S=S2 DXDS=X2(4) DYDS=X2(5) DZDS=X2(6) BX=X2(1)-DXDS*S BY=X2(2)-DYDS*S BZ=X2(3)-DZDS*S GOTO 40 C 30 DX=X2(1)-X1(1) DY=X2(2)-X1(2) DZ=X2(3)-X1(3) DS=SQRT(DX*DX+DY*DY+DZ*DZ) S=S1 DXDS=DX/DS DYDS=DY/DS DZDS=DZ/DS BX=X1(1)-DXDS*S BY=X1(2)-DYDS*S BZ=X1(3)-DZDS*S C 40 AE=DYDS*DYDS+DXDS*DXDS IF(AE.EQ.0.) GO TO 30 BE=DXDS*BX+DYDS*BY CE=BY*BY+BX*BX-R2 SG=SIGN(1.,DR2) XX=BE*BE-AE*CE IF(XX.LE.0.) GOTO 30 TRLEN=(SG*SQRT(ABS(XX))-BE)/AE XINT(1)=DXDS*TRLEN+BX XINT(2)=DYDS*TRLEN+BY XINT(3)=DZDS*TRLEN+BZ SINT=TRLEN XINT(4)=DXDS XINT(5)=DYDS XINT(6)=DZDS GO TO 200 C C SHIFT COORDINATE SYSTEM SUCH THAT CENTER OF GRAVITY=0 C 7 IF(R.LE.0.) GO TO 90 SHIFTX = (X1(1) + X2(1)) * 0.5 SHIFTY = (X1(2) + X2(2)) * 0.5 SHIFTZ = (X1(3) + X2(3)) * 0.5 SHIFTS = (S1 + S2) * 0.5 C C ONLY ONE VALUE NECESSARY SINCE X1= -X2 ETC. C XSHFT = X1(1) - SHIFTX YSHFT = X1(2) - SHIFTY ZSHFT = X1(3) - SHIFTZ SSHFT = S1 - SHIFTS C PABS1 = SQRT(X1(4)**2 + X1(5)**2 + X1(6)**2) PABS2 = SQRT(X2(4)**2 + X2(5)**2 + X2(6)**2) IF (PABS1.EQ.0..OR.PABS2.EQ.0.) GO TO 90 C C PARAMETRIZE THE TRACK BY A CUBIC THROUGH X1,X2 C CALL GCUBS(SSHFT,XSHFT,X1(4)/PABS1,X2(4)/PABS2,A) CALL GCUBS(SSHFT,YSHFT,X1(5)/PABS1,X2(5)/PABS2,B) CALL GCUBS(SSHFT,ZSHFT,X1(6)/PABS1,X2(6)/PABS2,C) C C ITERATE TO FIND THE TRACK LENGTH CORRESPONDING TO C THE INTERSECTION OF TRACK AND CYLINDER. C START AT S=0. MIDDLE OF THE SHIFTED INTERVAL. C DINTER = ABS(S2 - S1) * 0.5 S = 0. C DO 10 I = 1,MAXHIT X = SHIFTX + A(1) + S * (A(2) + S * (A(3) + S * A(4))) Y = SHIFTY + B(1) + S * (B(2) + S * (B(3) + S * B(4))) RN2 = X * X + Y * Y DR2 = (R2 - RN2) * DRCTN IF (ABS(DR2).LT.EPSI2) GO TO 20 DINTER = DINTER * 0.5 IF (DR2.LT.0.)S = S - DINTER IF (DR2.GE.0.)S = S + DINTER 10 CONTINUE C C COMPUTE INTERSECTION IN ORIGINAL COORDINATES C 20 CONTINUE XINT(1) = SHIFTX + A(1) + S * (A(2) + S * (A(3) + S * A(4))) XINT(2) = SHIFTY + B(1) + S * (B(2) + S * (B(3) + S * B(4))) XINT(3) = SHIFTZ + C(1) + S * (C(2) + S * (C(3) + S * C(4))) XINT(4) = A(2) + S * (2. * A(3) + 3. * S * A(4)) XINT(5) = B(2) + S * (2. * B(3) + 3. * S * B(4)) XINT(6) = C(2) + S * (2. * C(3) + 3. * S * C(4)) C C COMPUTE PHIHIT,ZHIT AND CORRESPONDING DERIVATIVES C SINT = S + SHIFTS 200 TERM = 1. / (XINT(4) * XINT(1) + XINT(5) * XINT(2)) PZINT(1) = ATAN2(XINT(2),XINT(1)) PZINT(2) = XINT(3) PZINT(3) = (XINT(1) * XINT(5) - XINT(2) * XINT(4)) * TERM / R PZINT(4) = TERM * XINT(6) * R RETURN C 90 IFLAG = 0 END +DECK,GIPLAN *CMZ : 3.12/27 06/09/88 14.33.08 by Rene Brun *-- Author : SUBROUTINE GIPLAN(YC,X1,X2,S1,S2,IC,XINT,SINT,PZINT,IFLAG) C. C. C. ****************************************************************** C. * * C. * Calculates intersection of track (X1,X2) * C. * with plane parallel to (X-Z) * C. * The track is approximated by a cubic in the * C. * track length. * C. * To improve stability, the coordinate system * C. * is shifted. * C. * input parameters * C. * YC = Y COORDINATE OF PLANE * C. * X1 = X,Y,Z,XP,YP,ZP OF 1ST POINT * C. * X2 = 2ND * C. * S1(2) = S AT 1ST(2ND) POINT * C. * IC = 1 STRAIGHT LINE DEFINED BY X+XP * C. * IC = 2 STRAIGHT LINE DEFINED BY X1+X2 * C. * IC = 3 CUBIC MODEL * C. * * C. * output parameters * C. * XINT = X,Y,Z,XP,YP,ZP AT INTERSECTION POINT * C. * SINT = S AT INTERSECTION POINT * C. * PZINT = PHI,Z,DPHI/DR,DZ/DR * C. * IFLAG = 1 IF TRACK INTERSECTS PLANE * C. * = 0 IF NOT * C. * * C. * Warning : the default accuracy is 10 microns. The value * C. * of EPSI must be changed for a better precision * C. * * C. * ==>Called by : , GUDIGI * C. * * C. * Authors: R.BRUN/JJ.DUMONT from an original routine by * C. * H. BOERNER KEK OCTOBER 1982 * C. * * C. * * C. ****************************************************************** C. DIMENSION X1(6),X2(6),XINT(6),PZINT(4),A(4),B(4),C(4) C DATA MAXHIT/100/ DATA EPSI/0.001/ C. C. C. ------------------------------------------------------------------ C. C. IFLAG = 1 DRCTN = 1. C C Track crossing the plane from above or below ? C IF (X2(2).LT.X1(2)) GO TO 5 IF (YC.LT.X1(2)) GO TO 90 IF (YC.GT.X2(2)) GO TO 90 IF (IC.EQ.2) GO TO 30 IF (IC.EQ.3) GO TO 7 C S=S1 DXDS=X1(4) DYDS=X1(5) DZDS=X1(6) BX=X1(1)-DXDS*(X1(2)-YC)/DYDS BZ=X1(3)-DZDS*(X1(2)-YC)/DYDS TRL2=(BX-X1(1))**2+(X1(2)-YC)**2+(BZ-X1(3))**2 GO TO 40 C 5 IF (YC.LT.X2(2)) GO TO 90 IF (YC.GT.X1(2)) GO TO 90 IF(IC.EQ.2) GO TO 30 DRCTN = - 1. C IF(IC.EQ.3) GOTO 7 S=S2 DXDS=X2(4) DYDS=X2(5) DZDS=X2(6) BX=X2(1)-DXDS*(X2(2)-YC)/DYDS BZ=X2(3)-DZDS*(X2(2)-YC)/DYDS TRL2=(BX-X2(1))**2+(X2(2)-YC)**2+(BZ-X2(3))**2 GOTO 40 C 30 DX=X2(1)-X1(1) DY=X2(2)-X1(2) DZ=X2(3)-X1(3) DS=SQRT(DX*DX+DY*DY+DZ*DZ) S=S1 DXDS=DX/DS DYDS=DY/DS DZDS=DZ/DS BX=X1(1)-DX*(X1(2)-YC)/DY BZ=X1(3)-DZ*(X1(2)-YC)/DY TRL2=(BX-X1(1))**2+(X1(2)-YC)**2+(BZ-X1(3))**2 C 40 TRLEN=SQRT(TRL2)*DRCTN+S XINT(1)=BX XINT(2)=YC XINT(3)=BZ SINT=TRLEN XINT(4)=DXDS XINT(5)=DYDS XINT(6)=DZDS GO TO 200 C C Shift coordinate system such that center of gravity=0 C 7 IF(YC.LE.0.) GO TO 90 SHIFTX = (X1(1) + X2(1)) * 0.5 SHIFTY = (X1(2) + X2(2)) * 0.5 SHIFTZ = (X1(3) + X2(3)) * 0.5 SHIFTS = (S1 + S2) * 0.5 C C Only one value necessary since X1= -X2 etc... C XSHFT = X1(1) - SHIFTX YSHFT = X1(2) - SHIFTY ZSHFT = X1(3) - SHIFTZ SSHFT = S1 - SHIFTS C PABS1 = SQRT(X1(4)**2 + X1(5)**2 + X1(6)**2) PABS2 = SQRT(X2(4)**2 + X2(5)**2 + X2(6)**2) IF (PABS1.EQ.0..OR.PABS2.EQ.0.) GO TO 90 C C Parametrize the track by a cubic through X1, X2 C CALL GCUBS(SSHFT,XSHFT,X1(4)/PABS1,X2(4)/PABS2,A) CALL GCUBS(SSHFT,YSHFT,X1(5)/PABS1,X2(5)/PABS2,B) CALL GCUBS(SSHFT,ZSHFT,X1(6)/PABS1,X2(6)/PABS2,C) C C Iterate to find the track length corresponding to C the intersection of track and plane. C Start at S=0. middle of the shifted interval. C DINTER = ABS(S2 - S1) * 0.5 S = 0. C DO 10 I = 1,MAXHIT Y = SHIFTY + B(1) + S * (B(2) + S * (B(3) + S * B(4))) DR=(YC-Y)*DRCTN IF (ABS(DR).LT.EPSI) GO TO 20 DINTER = DINTER * 0.5 IF (DR.LT.0.)S = S - DINTER IF (DR.GE.0.)S = S + DINTER 10 CONTINUE C C Compute intersection in original coordinates C 20 CONTINUE XINT(1) = SHIFTX + A(1) + S * (A(2) + S * (A(3) + S * A(4))) XINT(2)=YC XINT(3) = SHIFTZ + C(1) + S * (C(2) + S * (C(3) + S * C(4))) XINT(4) = A(2) + S * (2. * A(3) + 3. * S * A(4)) XINT(5) = B(2) + S * (2. * B(3) + 3. * S * B(4)) XINT(6) = C(2) + S * (2. * C(3) + 3. * S * C(4)) C C Compute PHIHIT,ZHIT and corresponding derivatives C SINT = S + SHIFTS 200 TERM = 1. / (XINT(4) * XINT(1) + XINT(5) * XINT(2)) PZINT(1) = ATAN2(XINT(2),XINT(1)) PZINT(2) = XINT(3) PZINT(3) = (XINT(1) * XINT(5) - XINT(2) * XINT(4)) * TERM / YC PZINT(4) = TERM * XINT(6) * YC RETURN C 90 IFLAG = 0 END +DECK,GPDIGI *CMZ : 3.13/05 22/05/89 17.11.40 by Rene Brun *-- Author : SUBROUTINE GPDIGI(IUSET,IUDET) C. C. ************************************************************************** C. * * C. * Print DIGIts in detector IUDET of set IUSET * C. * (in case IUSET/IUDET = *, take all sets/detectors) * C. * * C. * JDI=LQ(JDIGI-ISET) * C. * JDID=LQ(JDI-IDET) * C. * IQ(JDI+IDET)= pointer to LAST USED word in JDID * C. * * C. * Each digit is packed in JDID in the following format * C. * -- Track numbers packed * C. * -- Volume numbers packed * C. * -- Digits packed * C. * * C. * ==>Called by : , GPRINT * C. * Author W.Gebel ********* * C. * * C. ************************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT PARAMETER (NDEMX=100,NVMAX=20) DIMENSION KDIGI(NDEMX),NUMBV(NVMAX),KWS(130),LTR(3) EQUIVALENCE (WS(1),NUMBV(1)),(WS(101),KDIGI(1)) CHARACTER*4 IUSET,IUDET C. ------------------------------------------------------------------ C. IF(JDIGI.LE.0)GO TO 999 NSET=IQ(JSET-1) NS1=1 NS2=NSET IF(IUSET(1:1).NE.'*')THEN CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 999 NS1=ISET NS2=ISET ENDIF C C Loop on all selected sets C DO 230 ISET=NS1,NS2 JS=LQ(JSET-ISET) JDI=LQ(JDIGI-ISET) IF(JDI.LE.0)GO TO 230 NDET=IQ(JS-1) ND1=1 ND2=NDET IF(IUDET(1:1).NE.'*')THEN CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.EQ.0)GO TO 230 ND1=IDET ND2=IDET ENDIF C C Loop on selected detectors for this set C DO 220 IDET=ND1,ND2 JD=LQ(JS-IDET) JDID=LQ(JDI-IDET) IF(JDID.LE.0)GO TO 220 JDDI=LQ(JD-2) C WRITE(CHMAIL,1000)IQ(JS+IDET),IQ(JSET+ISET) CALL GMAIL(0,0) C C Get volumes / digitisings names and print header line C ILAST=IQ(JDI+IDET) IF(ILAST.EQ.0)GO TO 220 NV=IQ(JD+2) ND=IQ(JD+6) C CALL VBLANK(KWS,130) K=3 IF(NV.GT.0)THEN C Number of printed elements limited to 15 NVM=MIN(NV,15) DO 22 I=1,NVM CALL UBLOW(IQ(JD+2*I+9),KWS(K),4) 22 K=K+5 K=K+5 ENDIF IF(ND.GT.0)THEN DO 26 I=1,ND IF(K.LE.101) CALL UBLOW(IQ(JDDI+2*I-1),KWS(K),4) K=K+8 26 CONTINUE IF(K.GT.104)K=104 ENDIF WRITE(CHMAIL,2000)(KWS(I),I=1,K) CALL GMAIL(0,1) C C Now loop on all digits C to get track numbers, volume numbers and digits C IDIG=0 I=0 NWDI=0 C 30 CONTINUE I=I+NWDI IF(I.GE.ILAST)GO TO 220 NK=2 IDIG=IDIG+1 CALL VZERO (LTR(1),3) C C Get unpacked (first 3) tracks producing this digit C (2 tracks packed in 1 word; 1st half of 1st word: NTRA-1) C NWDI=IQ(JDID+I+1) NTRM1=JBYT(IQ(JDID+I+NK), 1,16) NTRA=NTRM1+1 IF(NTRA.GE.1)LTR(1)=JBYT(IQ(JDID+I+NK),17,16) NK=NK+1 IF(NTRA.GE.2)LTR(2)=JBYT(IQ(JDID+I+NK), 1,16) IF(NTRA.GE.3)LTR(3)=JBYT(IQ(JDID+I+NK),17,16) NWTR=NTRA/2+1 NK=NWTR+2 C C Get unpacked volume numbers C IF(NV.GT.0)THEN K=1 DO 50 IV=1,NV NB=IQ(JD+2*IV+10) IF(NB.LE.0)THEN IF(K.GT.1)THEN NK=NK+1 ENDIF NUMBV(IV)=IQ(JDID+I+NK) K=1 NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF NUMBV(IV)=JBYT(IQ(JDID+I+NK),K,NB) K=K+NB ENDIF 50 CONTINUE IF(K.NE.1)NK=NK+1 ENDIF C C Get unpacked digits C IF(ND.GT.0)THEN K=1 DO 90 ID=1,ND NB=IQ(JDDI+2*ID) IF(NB.LE.0)THEN IF(K.GT.1)THEN NK=NK+1 ENDIF IF(ID.LE.NDEMX) KDIGI(ID)=IQ(JDID+I+NK) K=1 NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF IF(ID.LE.NDEMX) KDIGI(ID)=JBYT(IQ(JDID+I+NK),K,NB) K=K+NB ENDIF 90 CONTINUE ENDIF C C Do the printout C (fitting in 1 line of 128 characters per each digit) C IF(NV.EQ.0)GO TO 119 IF(NV.GT.15)NV=15 GO TO (101,102,103,104,105,106,107,108,109,110 +, 111,112,113,114,115), NV C 101 NDP=MIN(ND,12) WRITE(CHMAIL,3001)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 102 NDP=MIN(ND,11) WRITE(CHMAIL,3002)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 103 NDP=MIN(ND,10) WRITE(CHMAIL,3003)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 104 NDP=MIN(ND,10) WRITE(CHMAIL,3004)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 105 NDP=MIN(ND, 9) WRITE(CHMAIL,3005)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 106 NDP=MIN(ND, 8) WRITE(CHMAIL,3006)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 107 NDP=MIN(ND, 8) WRITE(CHMAIL,3007)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 108 NDP=MIN(ND, 7) WRITE(CHMAIL,3008)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 109 NDP=MIN(ND, 7) WRITE(CHMAIL,3009)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 110 NDP=MIN(ND, 6) WRITE(CHMAIL,3010)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 111 NDP=MIN(ND, 5) WRITE(CHMAIL,3011)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 112 NDP=MIN(ND, 5) WRITE(CHMAIL,3012)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 113 NDP=MIN(ND, 4) WRITE(CHMAIL,3013)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 114 NDP=MIN(ND, 4) WRITE(CHMAIL,3014)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 115 NDP=MIN(ND, 3) WRITE(CHMAIL,3015)IDIG,(LTR(J),J=1,3),(NUMBV(L),L=1,NV) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 119 NDP=MIN(ND,12) WRITE(CHMAIL,3000)IDIG,(LTR(J),J=1,3) +, (KDIGI(L),L=1,NDP) CALL GMAIL(0,0) GO TO 30 C 220 CONTINUE 230 CONTINUE C C 1000 FORMAT(' =====>DIGITS OF DETECTOR ** ',A4, +' ** OF SET ** ',A4,' **') 2000 FORMAT(' DIGIT TR1 TR2 TR3 ',104A1) 3000 FORMAT(1X,I5,2X,3I5,3X, 12(1X,I7)) 3001 FORMAT(1X,I5,2X,3I5,3X, 1(1X,I4),2X,12(1X,I7)) 3002 FORMAT(1X,I5,2X,3I5,3X, 2(1X,I4),2X,11(1X,I7)) 3003 FORMAT(1X,I5,2X,3I5,3X, 3(1X,I4),2X,10(1X,I7)) 3004 FORMAT(1X,I5,2X,3I5,3X, 4(1X,I4),2X,10(1X,I7)) 3005 FORMAT(1X,I5,2X,3I5,3X, 5(1X,I4),2X, 9(1X,I7)) 3006 FORMAT(1X,I5,2X,3I5,3X, 6(1X,I4),2X, 8(1X,I7)) 3007 FORMAT(1X,I5,2X,3I5,3X, 7(1X,I4),2X, 8(1X,I7)) 3008 FORMAT(1X,I5,2X,3I5,3X, 8(1X,I4),2X, 7(1X,I7)) 3009 FORMAT(1X,I5,2X,3I5,3X, 9(1X,I4),2X, 7(1X,I7)) 3010 FORMAT(1X,I5,2X,3I5,3X,10(1X,I4),2X, 6(1X,I7)) 3011 FORMAT(1X,I5,2X,3I5,3X,11(1X,I4),2X, 5(1X,I7)) 3012 FORMAT(1X,I5,2X,3I5,3X,12(1X,I4),2X, 5(1X,I7)) 3013 FORMAT(1X,I5,2X,3I5,3X,13(1X,I4),2X, 4(1X,I7)) 3014 FORMAT(1X,I5,2X,3I5,2X,14(1X,I4),2X, 4(1X,I7)) 3015 FORMAT(1X,I5,2X,3I5,3X,15(1X,I4),2X, 3(1X,I7)) 999 RETURN END +DECK,GPDRIF *CMZ : 3.12/27 06/09/88 14.33.09 by Rene Brun *-- Author : SUBROUTINE GPDRIF (DETREP,HITREP,IOUT) C. C. ****************************************************************** C. * * C * DETREP(1)=NUMBER OF WIRES * C * (2)=WIRE SPACING * C * (3)=SIN (ALPHA) (ALPHA=ANGLE OF THE NORMAL * C * TO THE WIRE WITH RESPECT TO * C * AXIS I) * C * (4)=COS (ALPHA) * C * (5)=DISTANCE OF WIRE 1 FROM THE ORIGIN * C * (6)=DRIFT VELOCITY (CM/NSEC) * C * * C * HITREP(1)=X COORDINATE OF INTERSECTION * C * (2)=Y COORDINATE * C * * C * IOUT(1)=WIRE NUMBER * C * (2)=DRIFT TIME (SIGNED TO AVOID RIGHT/LEFT AMBIGUITY) * C. * * C. * ==>Called by : , GUDIGI * C. * Authors F.Carena, M.Hansroul ********* * C. * * C. ****************************************************************** C. DIMENSION HITREP(2), DETREP(6), IOUT(2) C. C. ------------------------------------------------------------------ C. IOUT(1) = - 1 SP = DETREP(2) DV = DETREP(6) IF (SP.EQ.0.) GO TO 99 IF (DV.EQ.0.) GO TO 99 C X = HITREP(1) Y = HITREP(2) SA = DETREP(3) CA = DETREP(4) U = X * CA + Y * SA OR = DETREP(5) W = (U - OR) / SP + 1.5 C IW = W NWIR = DETREP(1) IF (IW.GT.NWIR) GO TO 99 IF (IW.LE.0) GO TO 99 C DIST = U - OR - (IW - 1) * SP TDRIF = DIST / DV C IOUT(1) = IW IOUT(2) = TDRIF C 99 RETURN END +DECK,GPHITS *CMZ : 3.13/05 22/05/89 17.11.40 by Rene Brun *-- Author : SUBROUTINE GPHITS(IUSET,IUDET) C. C. ****************************************************************** C. * * C. * Prints HITS into detector IUDET of set IUSET * C. * * C. * If IPKHIT in /CGDRAW/ is greater than zero, * C. * only hit nr. IPKHIT is printed. * C. * * C. * JH=LQ(JHITS-ISET) * C. * JHD=LQ(JH-IDET) * C. * IQ(JH+IDET)= pointer to first free word in JHD * C. * Each hit is packed into JHD in the following format * C. * --Track number ITRA not packed * C. * --Volume numbers packed * C. * --Hits transformed and packed * C. * * C. * ==>Called by : , GPRINT ,, GINC4, GKHITS * C. * Authors : R.Brun ********** * C. * P.Zanarini * * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT +SEQ,GCDRAW PARAMETER (NHEMX=100,NVMAX=20) DIMENSION HITS(NHEMX),KWS(120),NUMBV(NVMAX) EQUIVALENCE (WS(1),NUMBV(1)),(WS(101),HITS(1)),(WS(201),KWS(1)) CHARACTER*4 IUSET,IUDET C. C. ------------------------------------------------------------------ C. IF(JHITS.LE.0)GO TO 999 NSET=IQ(JSET-1) NS1=1 NS2=NSET IF(IUSET(1:1).NE.'*')THEN CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 999 NS1=ISET NS2=ISET ENDIF C C loop on all selected sets C DO 130 ISET=NS1,NS2 JS=LQ(JSET-ISET) JH=LQ(JHITS-ISET) IF(JS.LE.0)GO TO 130 IF(JH.LE.0)GO TO 130 NDET=IQ(JS-1) ND1=1 ND2=NDET IF(IUDET(1:1).NE.'*')THEN CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.EQ.0)GO TO 130 ND1=IDET ND2=IDET ENDIF C C loop on selected detectors for this set C DO 120 IDET=ND1,ND2 JD=LQ(JS-IDET) JHD=LQ(JH-IDET) IF(JHD.LE.0)GO TO 120 JDH=LQ(JD-1) C WRITE(CHMAIL,1000)IQ(JS+IDET),IQ(JSET+ISET) CALL GMAIL(1,1) C ILAST=IQ(JH+IDET) IF(ILAST.EQ.0)GO TO 120 NV=IQ(JD+2) NH=IQ(JD+4) NW=IQ(JD+1)+IQ(JD+3)+1 C CALL VBLANK(KWS,120) K=0 IF(NV.GT.0) THEN C Number of printed elements limited to 9 NVM=MIN(NV,NVMAX) DO 22 I=1,NVM CALL UBLOW(IQ(JD+2*I+9),KWS(K+1),4) K=K+5 22 CONTINUE ENDIF IF(NH.GT.0)THEN K=K+5 IP0 = K NHM=MIN(NH,NHEMX) DO 26 I=1,NHM IF(K.GT.110)GO TO 26 NH1=I CALL UBLOW(IQ(JDH+4*I-3),KWS(K+1),4) K=K+10 26 CONTINUE ENDIF WRITE(CHMAIL,2000)(KWS(I),I=1,K) CALL GMAIL(0,0) C IF(NH.GT.0)THEN IF(NH1.LT.NHM)THEN CALL VBLANK(KWS,IP0) DO 40 NHP1=NH1+1,NHM,NH1 NHP2=NHP1+NH1-1 NHP2=MIN(NHP2,NHM) K=IP0 DO 30 I=NHP1,NHP2 CALL UBLOW(IQ(JDH+4*I-3),KWS(K+1),4) K=K+10 30 CONTINUE WRITE(CHMAIL,2100)(KWS(I),I=1,K) CALL GMAIL(0,0) 40 CONTINUE ENDIF ENDIF C C Now loop on all hits to get volume numbers and hits C IHIT=0 DO 110 I=1,ILAST,NW IHIT=IHIT+1 C C IPKHIT in /CGDRAW/ is used to print just that hit C IF (IPKHIT.GT.0.AND.IHIT.NE.IPKHIT) GO TO 110 C ITRA=IQ(JHD+I) C C Get unpacked volume numbers C NK=1 IF(NV.GT.0)THEN K=1 DO 50 IV=1,NVM NB=IQ(JD+2*IV+10) IF(NB.LE.0)THEN IF(K.GT.1)THEN K=1 NK=NK+1 ENDIF NUMBV(IV)=IQ(JHD+I+NK) IF(IV.NE.NV)NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF NUMBV(IV)=JBYT(IQ(JHD+I+NK),K,NB) K=K+NB ENDIF 50 CONTINUE NK=NK+1 ENDIF C C Get unpacked hits C Hits origin is shifted . Division by scale factor C IF(NH.GT.0)THEN K=1 DO 90 IH=1,NHM NB=IQ(JDH+4*IH-2) IF(NB.LE.0)THEN IF(K.GT.1)THEN NK=NK+1 ENDIF KHIT=IQ(JHD+I+NK) K=1 NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF KHIT=JBYT(IQ(JHD+I+NK),K,NB) K=K+NB ENDIF HITS(IH)=FLOAT(KHIT)/Q(JDH+4*IH) - Q(JDH+4*IH-1) 90 CONTINUE ENDIF C WRITE(CHMAIL,3000)IHIT,ITRA,(NUMBV(L),L=1,NV) IF(NH.GT.0)THEN IP0=NV*5+15 DO 100 NHP1=1,NHM,NH1 NHP2=NHP1+NH1-1 NHP2=MIN(NHP2,NHM) WRITE(CHMAIL(IP0+1:),4000)(HITS(L),L=NHP1,NHP2) CALL GMAIL(0,0) CHMAIL(1:IP0)=' ' 100 CONTINUE ENDIF C IF(IHIT.EQ.IPKHIT)GO TO 999 C 110 CONTINUE 120 CONTINUE 130 CONTINUE C 1000 FORMAT(' =====>HITS IN DETECTOR ** ',A4, +' ** OF SET ** ',A4,' **') 2000 FORMAT(' HIT TRACK ',120A1) 2100 FORMAT(12X,120A1) 3000 FORMAT(1X,I4,I6,20I5) 4000 FORMAT(12(G10.3)) 999 RETURN END +DECK,GPMWPC *CMZ : 3.13/05 22/05/89 17.11.07 by Rene Brun *-- Author : SUBROUTINE GPMWPC (DETREP,HITREP,IOUT) C. C. ****************************************************************** C. * * C * DETREP(1)=NUMBER OF WIRES * C * (2)=WIRE SPACING * C * (3)=SIN (ALPHA) (ALPHA=ANGLE OF THE NORMAL * C * TO THE WIRE WITH RESPECT TO * C * AXIS I) * C * (4)=COS (ALPHA) * C * (5)=DISTANCE OF WIRE 1 FROM THE ORIGIN * C * (6)=GAP WIDTH * C * * C * HITREP(1)=X COORDINATE OF INTERSECTION * C * (2)=Y COORDINATE * C * (3)=DX/DZ * C * (4)=DY/DZ * C * * C * IOUT(1)=WIRE NUMBER * C * (2)=CLUSTER SIZE * C. * * C. * ==>Called by : , GUDIGI * C. * Authors F.Carena, M.Hansroul ********* * C. * * C. ****************************************************************** C. DIMENSION HITREP(4), DETREP(6), IOUT(2) C. C. ------------------------------------------------------------------ C. IOUT(1) = - 1 SP = DETREP(2) IF (SP.EQ.0.) GO TO 99 C HG = .5 * DETREP(6) DX = HG * HITREP(3) DY = HG * HITREP(4) X1 = HITREP(1) - DX X2 = HITREP(1) + DX Y1 = HITREP(2) - DY Y2 = HITREP(2) + DY SA = DETREP(3) CA = DETREP(4) U1 = X1 * CA + Y1 * SA U2 = X2 * CA + Y2 * SA OR = DETREP(5) W1 = (U1 - OR) / SP + 1.5 W2 = (U2 - OR) / SP + 1.5 C IW1 = W1 IW2 = W2 IWMIN = MIN (IW1,IW2) IWMAX = MAX (IW1,IW2) NWIR = DETREP(1) IF (IWMIN.GT.NWIR) GO TO 99 IF (IWMAX.LE.0) GO TO 99 C IWMIN = MAX (1,IWMIN) IWMAX = MIN (NWIR,IWMAX) C IOUT(1) = IWMIN IOUT(2) = IWMAX - IWMIN + 1 C 99 RETURN END +DECK,GPSETS *CMZ : 3.13/02 23/02/89 08.54.35 by Rene Brun *-- Author : SUBROUTINE GPSETS(IUSET,IUDET) C. C. ****************************************************************** C. * * C. * Prints set and detector parameters * C. * * C. * IUSET user set identifier * C. * If * prints all detectors of all sets * C. * IUDET user detector identifier * C. * If * prints all detectors of set IUSET * C. * * C. * ==>Called by : , GPRINT , GINC4 * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT CHARACTER*4 IUSET,IUDET C. C. ------------------------------------------------------------------ C. IF(IUSET(1:1).EQ.'*')THEN WRITE(CHMAIL,1000) CALL GMAIL(0,0) ENDIF IF(JSET.LE.0)GO TO 999 NSET=IQ(JSET-1) NS1=1 NS2=NSET IF(IUSET(1:1).NE.'*')THEN CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 999 NS1=ISET NS2=ISET ENDIF C C loop on all selected sets C DO 130 ISET=NS1,NS2 JS=LQ(JSET-ISET) IF(JS.LE.0)GO TO 130 NDET=IQ(JS-1) ND1=1 ND2=NDET IF(IUDET(1:1).NE.'*')THEN CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.EQ.0)GO TO 130 ND1=IDET ND2=IDET ENDIF C C loop on selected detectors for this set C DO 120 IDET=ND1,ND2 JD=LQ(JS-IDET) IF(JD.LE.0)GO TO 120 NV=IQ(JD+2) NWHI=IQ(JD+7) NWDI=IQ(JD+8) C WRITE(CHMAIL,2000)IQ(JSET+ISET),IQ(JS+IDET),NWHI,NWDI CALL GMAIL(0,0) C IF(NV.NE.0)THEN DO 10 I=1,NV WRITE(CHMAIL,3000)IQ(JD+2*I+9),IQ(JD+2*I+10) CALL GMAIL(0,0) 10 CONTINUE ENDIF C JDH=LQ(JD-1) IF(JDH.GT.0)THEN NH=IQ(JD+4) IF(NH.GT.0)THEN DO 30 I=1,NH WRITE(CHMAIL,4000)IQ(JDH+4*I-3),IQ(JDH+4*I-2), + Q(JDH+4*I-1),Q(JDH+4*I) CALL GMAIL(0,0) 30 CONTINUE ENDIF ENDIF C JDD=LQ(JD-2) IF(JDD.GT.0)THEN ND=IQ(JD+6) IF(ND.GT.0)THEN DO 50 I=1,ND WRITE(CHMAIL,5000)IQ(JDD+2*I-1),IQ(JDD+2*I) CALL GMAIL(0,0) 50 CONTINUE ENDIF ENDIF C JDU=LQ(JD-3) IF(JDU.GT.0)THEN NU=IQ(JDU-1) IF(NU.GT.0)THEN WRITE(CHMAIL,6000) CALL GMAIL(0,0) DO 60 I=1,NU,10 L2=I+9 IF(L2.GT.NU)L2=NU WRITE(CHMAIL,7000)(Q(JDU+L),L=I,L2) CALL GMAIL(0,0) 60 CONTINUE ENDIF ENDIF C 120 CONTINUE 130 CONTINUE C 1000 FORMAT('0',51('='),3X,'SETS AND DETECTORS',3X,50('=')) 2000 FORMAT(' SET ',A4,' DETECTOR ',A4,' NWHI=',I6,' NWDI=',I6) 3000 FORMAT(10X,'VOLUME ',A4,' NBITSD=',I4) 4000 FORMAT(10X,'HIT ELEMENT =',A4,' NBITSH=',I4, +' ORIG =',E12.4,' FACT =',E12.4) 5000 FORMAT(10X,'DIGIT ELEMENT =',A4,' NBITSD=',I4) 6000 FORMAT(10X,'USER PARAMETERS') 7000 FORMAT(5X,10E12.4) 999 RETURN END +DECK, GRHITS. *CMZ : 3.15/01 24/02/92 13.11.08 by Federico Carminati *-- Author : SUBROUTINE GRHITS (IUSET, IUDET, NTRA, ITRA) C. C. ****************************************************************** C. * * C. * SUBR. GRHITS (IUSET, IUDET, NTRA, ITRA) * C. * * C. * Removes the hits produced by the tracks ITRA(1...NTRA) in * C. * the generic volume name IUDET belonging to the set IUSET. * C. * * C. * IUSET User set identifier * C. * IUDET User detector identifier (name of the corresponding * C. * sensivitive volume) * C. * NTRA Number of tracks whose hits are to be removed * C. * ITRA Track indices whose hits are to be removed * C. * * C. * Called by : * C. * Author : S.Banerjee * C. * * C. ****************************************************************** C. +CDE, GCBANK. COMMON /GC1HIT/ LOC(2), JD, JDH, JH, JHD, JHDN, JS DIMENSION ITRA(*) CHARACTER*(*) IUSET, IUDET SAVE JHDNN DATA JHDNN/0/ * * ------------------------------------------------------------------ * IF (NTRA.LE.0) GO TO 999 IF (JSET.LE.0) GO TO 999 IF (JHITS.LE.0) GO TO 999 * * *** Find the selected set(s) * NSET = IQ(JSET-1) IF (IUSET(1:1).EQ.'*') THEN NS1 = 1 NS2 = NSET ELSE CALL GLOOK (IUSET, IQ(JSET+1), NSET, ISET) IF (ISET.LE.0) GO TO 999 NS1 = ISET NS2 = ISET ENDIF CALL MZLINT (IXSTOR, '/GC1HIT/', LOC, JD, JS) * * *** Loop over selected sets * DO 30 ISET = NS1, NS2 JS = LQ(JSET-ISET) JH = LQ(JHITS-ISET) IF (JS.LE.0.OR.JH.LE.0) GO TO 30 NDET = IQ(JS-1) * * ** Find the selected detector(s) * IF (IUDET(1:1).EQ.'*') THEN ND1 = 1 ND2 = NDET ELSE CALL GLOOK (IUDET, IQ(JS+1), NDET, IDET) IF (IDET.EQ.0) GO TO 30 ND1 = IDET ND2 = IDET ENDIF * * ** Loop over selected detectors * DO 20 IDET = ND1, ND2 JD = LQ(JS-IDET) JHD = LQ(JH-IDET) IF (JD.LE.0) GO TO 20 IF (JHD.LE.0) GO TO 20 JDH = LQ(JD-1) IF (JDH.LE.0) GO TO 20 ILAST = IQ(JH+IDET) IF (ILAST.EQ.0) GO TO 20 NW = IQ(JD+1) + IQ(JD+3) + 1 * * ** Shunt the original bank and lift a new SJDH bank * CALL ZSHUNT (IXDIV, JHD, JHDNN, 2, 0) CALL MZBOOK (IXDIV, JHDN, JH, -IDET, 'SJHD', 0, 0, ILAST, + 1, -1) IQ(JHDN-5) = IQ(JHD-5) * * ** Copy the relevant part * LAST = 0 DO 10 I = 1, ILAST, NW II = IUCOMP (IQ(JHD+I), ITRA, NTRA) IF (II.LE.0) THEN CALL UCOPY (IQ(JHD+I), IQ(JHDN+LAST+1), NW) LAST = LAST + NW ENDIF 10 CONTINUE * * ** Drop the old bank * IF (LAST.LT.ILAST) THEN CALL VZERO (IQ(JHDN+LAST+1), ILAST-LAST) ENDIF IQ(JH+IDET) = LAST CALL MZDROP (IXDIV, JHD, ' ') 20 CONTINUE 30 CONTINUE * 100 LOC(1) = 0 * END GRHITS 999 END +DECK,GSAHIT *CMZ : 3.14/14 20/06/90 17.37.24 by Rene Brun *-- Author : SUBROUTINE GSAHIT(ISET,IDET,ITRA,NUMBV,HITS,IHIT) C. C. ****************************************************************** C. * * C. * Routines to Communicate with the JHITS data structure * C. * --------------------------------------------------------- * C. * * C. * Stores element values for current hit into the data * C. * structure JHITS. * C. * ISET set number (can be obtained from /GCSETS/ filled * C. * by GFINDS) * C. * IDET detector number " " " * C. * " * C. * ITRA track number producing this hit * C. * NUMBV array of volume numbers corresponding to list * C. * NAMESV of GSDET * C. * HITS array of values for current hit elements * C. * IHIT on return, current hit number. If =0, hit has not * C. * been stored. * C. * * C. * JH=LQ(JHITS-ISET) * C. * JHD=LQ(JH-IDET) * C. * IQ(JH+IDET)= pointer to LAST USED word in JHD * C. * Each hit is packed into JHD in the following format * C. * --Track number ITRA not packed * C. * --Volume numbers packed * C. * --Hits transformed and packed * C. * * C. * The Hit data structure JHITS * C. * ---------------------------- * C. * * C. * | JHITS * C. * NSET ISET v * C. * .......................................... * C. * | | | | | * C. * .......................................... * C. * | * C. * | JH * C. * NDET IDET v NDET * C. * ..................................... * C. * | | | | | | * C. * ..................................... * C. * | * C. * | JHD * C. * v * C. * ......................................... * C. * | | 1st hit | 2nd hit, etc. | * C. * ......................................... * C. * Bank layout * C. * JH = LQ(JHITS-ISET,) pointer to hits for set * C. * number ISET * C. * JHD = LQ(JH-IDET), pointer to hits of detector * C. * IDET * C. * of set ISET * C. * IQ(JH+IDET) number of words used so far for storing the * C. * hits * C. * of detector IDET * C. * IQ(JHD+1) 1st word of 1st hit * C. * IQ(JHD+NWH+1) 1st word of 2nd hit * C. * JS=LQ(JSET-ISET) * C. * JD=LQ(JS-IDET) * C. * NWH=IQ(JD+3) * C. * The JHITS structure is filled with the routines GSAHIT and * C. * GSCHIT. The routine GFHITS can be used to get the hits for * C. * a detector IDET and set ISET. * C. * * C. * ==>Called by : , GUSTEP * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT COMMON/GCLOCA/NLOCAL(2),JS,JD,JDH,JH,JHD,LOCAL(15) DIMENSION NUMBV(1),HITS(1) SAVE NMESS DATA NMESS/0/ C. C. ------------------------------------------------------------------ C. IHIT=0 IF(JSET.LE.0)GO TO 99 NSET=IQ(JSET-1) IF(NSET.LE.0)GO TO 99 IF(ISET.LE.0)GO TO 99 IF(ISET.GT.NSET)GO TO 99 JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.LE.0)GO TO 99 IF(IDET.LE.0)GO TO 99 IF(IDET.GT.NDET)GO TO 99 JD=LQ(JS-IDET) JDH=LQ(JD-1) IF(JDH.LE.0)GO TO 99 NW=IQ(JD+1)+IQ(JD+3)+1 NH=IQ(JD+4) NV=IQ(JD+2) C C Create HITS master bank C IF(JHITS.EQ.0)THEN CALL MZBOOK(IXDIV,JHITS,JHITS,1,'HITS',NSET,NSET,0,2,0) IQ(JHITS-5)=0 ENDIF JH=LQ(JHITS-ISET) IF(JH.EQ.0)THEN CALL MZBOOK(IXDIV,JH,JHITS,-ISET,'HITS',NDET,NDET,NDET,2,0) ENDIF C JHD=LQ(JH-IDET) IF(JHD.EQ.0)THEN C C Create Hits bank C NWHI=IQ(JD+7) CALL MZBOOK(IXDIV,JHD,JH,-IDET,'SJHD',0,0,NWHI,1,0) IQ(JHD-5)=1000*ISET+IDET ILAST=0 ELSE C C Check if enough space. If not increase bank size C NHD=IQ(JHD-1) ILAST=IQ(JH+IDET) NFREE=NHD-ILAST IF(NFREE.LE.NW)THEN NWHI2=MAX(100,NW,IQ(JD+7)/2) CALL MZPUSH(IXDIV,JHD,0,NWHI2,'I') JS = LQ(JSET-ISET) JD = LQ(JS-IDET) JDH = LQ(JD-1) JH = LQ(JHITS-ISET) ENDIF ENDIF C IQ(JH+IDET)=ILAST+NW IHIT=IQ(JH+IDET)/NW C C ========> Store track number,volumes numbers and hits C IQ(JHD+ILAST+1)=ITRA C C C Store packed volume numbers C NK=ILAST+2 IF(NV.GT.0)THEN K=1 C DO 50 I=1,NV NB=IQ(JD+2*I+10) IF(NB.LE.0)THEN IF(K.GT.1)THEN NK=NK+1 ENDIF IQ(JHD+NK)=NUMBV(I) K=1 IF(I.NE.NV)NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF CALL SBYT(NUMBV(I),IQ(JHD+NK),K,NB) K=K+NB ENDIF 50 CONTINUE NK=NK+1 ENDIF C C Store packed hits C Before packing, hits are changed to integers C Origin is shifted to have only positive integers C Result is multiplied by a constant to get resolution C IF(NH.GT.0)THEN K=1 DO 90 I=1,NH NB=IQ(JDH+4*I-2) XHIT=(HITS(I)+Q(JDH+4*I-1))*Q(JDH+4*I) IF(NB.EQ.0)THEN VALMX=2.147483E+9 ELSE VALMX=2.**NB-1. ENDIF IFLAG=0 IF(XHIT.LT.0.)THEN XHIT=0. IFLAG=1 ELSE IF(XHIT.GT.VALMX)THEN XHIT=VALMX IFLAG=1 ENDIF IF(IFLAG.NE.0)THEN NMESS=NMESS+1 IF(NMESS.LT.10)THEN WRITE(CHMAIL,1000)IQ(JSET+ISET),IQ(JS+IDET),I,HITS(I) + ,Q(JDH+4*I-1),Q(JDH+4*I) CALL GMAIL(0,0) ENDIF ENDIF C KHIT=XHIT+0.5 IF(NB.LE.0)THEN IF(K.GT.1)THEN NK=NK+1 ENDIF IQ(JHD+NK)=KHIT NK=NK+1 K=1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF CALL SBYT(KHIT,IQ(JHD+NK),K,NB) K=K+NB ENDIF 90 CONTINUE ENDIF C 1000 FORMAT(' ***** GSAHIT OVERFLOW WHEN IUSET= ',A4,' IUDET= ', +A4,' HITS(',I2,')=',E14.7,' ORIG= ',E14.7,' FACT= ',E14.7) 99 RETURN END +DECK,GSCHIT *CMZ : 3.13/02 30/01/89 12.47.43 by Rene Brun *-- Author : SUBROUTINE GSCHIT(ISET,IDET,ITRA,NUMBV,HITS,NHSUM,IHIT) C. C. ****************************************************************** C. * * C. * Store HITS values into detector IUDET of set IUSET * C. * * C. * NUMBV volume numbers * C. * HITS array of values for the elements of current hit * C. * ITRA track number associated to this hit * C. * IHIT output parameter containing the hit number * C. * If IHIT=0 hit has not been stored * C. * * C. * Same action as GSAHIT but in case the physical volume * C. * specified by NUMBV contains already some hit for the * C. * same track, then the routine will sum up the last NHSUM * C. * elements of the hit. * C. * In order to use that routine , no packing must be * C. * specified for these NHSUM last hits. * C. * If NHSUM.LE.0 then GSCHIT is the same as GSAHIT. * C. * * C. * ==>Called by : , GUSTEP * C. * Authors R.Brun, M.Maire ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT COMMON/GCLOCA/NLOCAL(2),JS,JD,JDH,JH,JHD,LOCAL(15) DIMENSION NUMBV(1),HITS(1) SAVE NMESS DATA NMESS/0/ C. C. ------------------------------------------------------------------ C. CALL GSAHIT(ISET,IDET,ITRA,NUMBV,HITS,IHIT) IF(IHIT.LE.1)GO TO 99 IF(NHSUM.LE.0)GO TO 99 C NV=IQ(JD+1) NH=IQ(JD+3) NW=NV+NH+1 IH1=IHIT-1 INDMAX=IH1*NW C DO 30 I=IH1,1,-1 IND=(I-1)*NW C C Check if track number is ITRA C IF(ITRA.NE.IQ(JHD+IND+1))GO TO 99 C C Check if volume numbers are the same C DO 10 J=1,NV IF(IQ(JHD+IND+J+1).NE.IQ(JHD+INDMAX+J+1))GO TO 30 10 CONTINUE C C Volumes are the same. Now sum the last NHSUM hits C DO 20 K=1,NHSUM SUM=FLOAT(IQ(JHD+IND+NW-K+1))+FLOAT(IQ(JHD+INDMAX+NW-K+1)) IF(SUM.GT.2.147483E+9)THEN SUM=2.147483E+9 NMESS=NMESS+1 IF(NMESS.LT.10)THEN WRITE(CHMAIL,1000)IQ(JSET+ISET),IQ(JS+IDET) CALL GMAIL(0,0) ENDIF ENDIF IQ(JHD+IND+NW-K+1)=SUM 20 CONTINUE C C Remove temporarily stored hit C IHIT=IHIT-1 IQ(JH+IDET)=IQ(JH+IDET)-NW GO TO 99 30 CONTINUE C 1000 FORMAT(' ***** GSCHIT OVERFLOW WHEN IUSET= ',A4,' IUDET= ',A4) 99 RETURN END +DECK,GSDET *CMZ : 3.15/01 16/12/91 10.38.49 by Federico Carminati *-- Author : SUBROUTINE GSDET(IUSET,IUDET,NV,NAMESV,NBITSV,IDTYPE + ,NWHI,NWDI,ISET,IDET) C. C. ****************************************************************** C. * * C. * Defines volume parameters for detector IUDET of set IUSET* C. * * C. * Input parameters * C. * IUSET set identifier (4 characters), user defined * C. * IUDET detector identifier (4 characters), name of an * C. * existing volume * C. * NV number of volume descriptors * C. * NAMESV vector of NV volume descriptors (4 characters) * C. * NBITSV vector of NV bit numbers for packing the volume * C. * numbers * C. * IDTYPE detector type, user defined * C. * NWHI number of words for the primary allocation of HITS * C. * banks * C. * NWDI number of words for the primary allocation of DIGI * C. * banks when first allocation not sufficient * C. * * C. * Output parameters * C. * ISET position of set in bank JSET * C. * IDET position of detector in bank JS=IB(JSET-ISET) * C. * If ISET=0 or IDET=0 error * C. * Remarks: * C. * - The vector NAMESV (length NV) contains the list of volume * C. * names which permit the identification of every physical * C. * detector with detector name IUDET. [See example in HITS * C. * 110]. * C. * - Each element of the vector NBITSV (length NV) is the * C. * number of bits used for packing the number of the * C. * corresponding volume, when building the packed identifier * C. * of a given physical detector. * C. * - For more details see the example given in GSDETH. * C. * - The detector type IDTYPE is not used internally by GEANT * C. * and can be defined by the user to distinguish quickly * C. * between various kinds of detectors, in the routine GUSTEP * C. * for example. * C. * * C. * IQ(JSET+ISET) = IUSET * C. * JS = LQ(JSET-ISET) + pointer to set parameters * C. * IQ(JS+IDET)=IUDET * C. * JD= LQ(JS-1) = pointer to detector IDET * C. * IQ(JD+1)=Total number of words to store packed volumes * C. * IQ(JD+2)=NV * C. * IQ(JD+3)=Number of words required per hit * C. * IQ(JD+4)=Number of different hits types * C. * IQ(JD+5)=Number of words required per digit * C. * IQ(JD+6)=Number of different digit types * C. * IQ(JD+7)=NWHI * C. * IQ(JD+8)=NWDI * C. * IQ(JD+9)=Number of paths through the JVOLUM tree * C. * IQ(JD+10)= For an alias only, IDET of main detector * C. * IQ(JD+2*I+9) = name of volume i = NAMESV(I) * C. * IQ(JD+2*I+10)= number of bits/volume = NBITSV(I) * C. * * C. * The Detector Set data structure JSET * C. * ------------------------------------ * C. * * C. * | JSET * C. * NSET ISET v NSET * C. * ................................................ * C. * | | | | | Set names| * C. * ................................................ * C. * | JS * C. * | * C. * NDET IDET v NDET * C. * ........................................ * C. * | | | | | Detector names | * C. * ........................................ * C. * | JD * C. * -3 -2 -1 v * C. * ................................................ * C. * | | | | | Parameters of GSDET | * C. * ................................................ * C. * | | | * C. * | | | JDH * C. * | | | * C. * | | | ............................. * C. * | | ............| Parameters of GSDETH | * C. * | | ............................. * C. * | | * C. * | | JDD * C. * | | * C. * | | ............................. * C. * | ...............| Parameters of GSDETD | * C. * | ............................. * C. * | * C. * | JDU * C. * | ............................. * C. * ..................| Parameters of GSDETU | * C. * ............................. * C. * JS = LQ(JSET-ISET) pointer to detector set number ISET * C. * The JSET data structure is filled by GSDET, GSDETH, GSDETD, * C. * GSDETU and eventually by GSDETA. * C. * * C. * ==>Called by : , UGEOM * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT +SEQ,GCMZFO PARAMETER (NVMAX=20) DIMENSION NBITSV(1),NAV(NVMAX) CHARACTER*4 NAMESV(1),IUSET(1),IUDET(1) EQUIVALENCE (WS(1),NAV(1)) C. C. ------------------------------------------------------------------ C. ISET=0 IDET=0 IF(NV.GT.15)GO TO 94 C C Check if volume IUDET has been defined C IF(JVOLUM.LE.0)GO TO 90 NVOLUM=IQ(JVOLUM-1) CALL GLOOK(IUDET,IQ(JVOLUM+1),NVOLUM,IVOL) IF(IVOL.EQ.0)GO TO 90 C IF(JSET.EQ.0)THEN C C Create mother JSET bank C CALL MZBOOK(IXCONS,JSET,JSET,1,'SETS',0,0,0,5,0) IQ(JSET-5)=0 NSET=0 ELSE NSET=IQ(JSET-1) CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF (ISET.NE.0) GO TO 30 ENDIF C C Create JS bank C CALL MZPUSH(IXCONS,JSET,1,1,'I') NSET=NSET+1 C ISET=NSET CALL UCTOH(IUSET,IQ(JSET+ISET),4,4) CALL MZBOOK(IXCONS,JS,JSET,-ISET,'SETS',0,0,0,5,0) C C Check if detector has already been defined C 30 JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.NE.0)THEN CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.NE.0) GO TO 92 ENDIF C C If not, create detector bank C CALL MZPUSH(IXCONS,JS,1,1,'I') NDET=NDET+1 IDET=NDET CALL UCTOH(IUDET,IQ(JS+IDET),4,4) CALL MZBOOK(IXCONS,JD,JS,-IDET,'SEJD',4,4,10+2*NV,IOSEJD,0) IQ(JD-5)=10*ISET+IDET C NW=0 IF(NV.GT.0)THEN CALL UCTOH(NAMESV,NAV,4,4*NV) K=32 DO 70 I=1,NV NB=NBITSV(I) IF(NB.LT.0)NB=0 IF(NB.GE.32)NB=0 IQ(JD+2*I+ 9)=NAV(I) IQ(JD+2*I+10)=NB IF(NB.LE.0)THEN NW=NW+1 K=32 ELSE K=K+NB IF(K.GT.32)THEN K=NB NW=NW+1 ENDIF ENDIF 70 CONTINUE ENDIF 80 IQ(JD+1)=NW IQ(JD+2)=NV IQ(JD+7)=NWHI IQ(JD+8)=NWDI IQ(JD+10)=0 C C Now enter set,det into JVOLUM data structure C CALL GSATT(IUDET,'SET ',ISET) CALL GSATT(IUDET,'DET ',IDET) CALL GSATT(IUDET,'DTYP',IDTYPE) GO TO 99 C C Errors C 90 WRITE(CHMAIL,1000)IUDET CALL GMAIL(0,0) 1000 FORMAT(' ***** GSDET ERROR, VOLUME ',A4,' NOT DEFINED') GO TO 99 C 92 WRITE(CHMAIL,2000)IUSET,IUDET CALL GMAIL(0,0) 2000 FORMAT(' ***** GSDET ERROR ,SET ',A4, ' DETECTOR ',A4, + ' ALREADY DEFINED') GO TO 99 C 94 WRITE(CHMAIL,3000)NV CALL GMAIL(0,0) 3000 FORMAT(' ***** GSDET ERROR ,SET ',A4, ' DETECTOR ',A4, + ' Too many descriptors:',I5) C 99 RETURN END +DECK,GSDETA *CMZ : 3.14/14 20/06/90 17.37.42 by Rene Brun *-- Author : SUBROUTINE GSDETA (IUSET, IUDET, IUALI, NWHI, NWDI, IALI) C. C. ****************************************************************** C. * * C. * Handling Detector Aliases * C. * -------------------------- * C. * * C. * Detector 'aliases' can be specified for any sensitive * C. * detector for which the user needs to store more than one * C. * type of hit. * C. * Defines an alias IUALI for detector IUDET of set IUSET. * C. * Enters it in the JSET structure as an additional detector in * C. * the corresponding set, at the position IALI. Copies to the * C. * link position IALI the GSDET parameter bank from the * C. * original detector IUDET, with empty links to the GSDETH, * C. * GSDETD and GSDETU parameter banks. The user can therefore * C. * call these three routines again with the arguments * C. * appropriate to the detector IUALI. Several aliases can be * C. * defined for the same detector through as many calls to * C. * GSDETA. * C. * * C. * ==>Called by : , UGEOM * C. * Author F.Bruyant ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCUNIT. +SEQ,GCMZFO CHARACTER*4 IUSET,IUDET,IUALI C. C. ------------------------------------------------------------------ C. IF (JSET.LE.0) GO TO 90 NSET = IQ(JSET-1) IF (NSET.LE.0) GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF (ISET.LE.0) GO TO 90 JS = LQ(JSET-ISET) NDET = IQ(JS-1) IF (NDET.LE.0) GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF (IDET.LE.0) GO TO 90 CALL GLOOK(IUALI,IQ(JS+1),NDET,IALI) IF (IALI.NE.0) GO TO 95 JD = LQ(JS-IDET) NDATA = IQ(JD-1) C CALL MZPUSH(IXCONS, JS, 1, 1,'I') NDET = NDET +1 IALI = NDET CALL UCTOH(IUALI,IQ(JS+IALI),4,4) C CALL MZBOOK(IXCONS,JD2,JS,-IALI, 'SEJD',4,4, NDATA,IOSEJD,0) IQ(JD2-5)=10*ISET+IALI JD = LQ(JS-IDET) CALL UCOPY (IQ(JD+1), IQ(JD2+1), NDATA) IQ(JD2+7) = NWHI IQ(JD2+8) = NWDI IQ(JD2+10) = IDET GO TO 99 C 90 WRITE (CHMAIL, 1000) IUSET, IUDET CALL GMAIL(0,0) 1000 FORMAT (' ***** GSDETA ERROR FOR SET ',A4,' OR DETECTOR ',A4) GO TO 99 95 WRITE (CHMAIL, 2000) IUSET, IUALI CALL GMAIL(0,0) 2000 FORMAT (' ***** GSDETA ERROR FOR SET ', A4, ' ALIAS NAME ' +, A4, ' ALREADY USED') C 99 RETURN END +DECK,GSDETD *CMZ : 3.14/14 20/06/90 17.37.51 by Rene Brun *-- Author : SUBROUTINE GSDETD(IUSET,IUDET,ND,NAMESD,NBITSD) C. C. ****************************************************************** C. * * C. * Handling sensitive DETector Digitisation parameters * C. * --------------------------------------------------- * C. * * C. * Defines digitisation parameters for detector IUDET of set * C. * IUSET. * C. * IUSET user set identifier * C. * IUDET user detector identifier * C. * ND number of elements per digitisation * C. * NAMESD the ND variable names for the digitisation * C. * elements * C. * NBITSD the ND bit numbers for packing the variable * C. * values. * C. * The routine is used at initialisation time once the * C. * geometrical volumes have been defined to describe the * C. * digitisation elements and the way to do packing in memory * C. * and on tape. Let us use the same example as in GSDETH. The * C. * non geometrical information we want to store for each * C. * digitisation is for example: * C. * - ADC pulse height in a lead glass block. * C. * Example of one digitisation in that scheme: * C. * EPHI 12 * C. * EZRI 41 * C. * BLOC 3 * C. * ADC 789 * C. * The FORTRAN coding to define the digitisation information * C. * could be: * C. * DATA NAMESD/'ADC '/ * C. * DATA NBITSD/16/ * C. * CALL GSDETD('ECAL','BLOC',1,NAMESD,NBITSD) * C. * Returns the digitisation parameters for detector IUDET of * C. * set IUSET. All arguments as explained in GSDETD. * C.. * * C. * JS = LQ(JSET-ISET) * C. * JD = LQ(JS-IDET) * C. * JDD= LQ(JD-2) * C. * IQ(JDD+2*I-1)=NAMESD(I) * C. * IQ(JDD+2*I) =NBITSD(I) * C. * * C. * ==>Called by : , UGEOM * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT +SEQ,GCMZFO PARAMETER (NDEMX=100) DIMENSION NBITSD(1),NAMD(NDEMX) CHARACTER*4 NAMESD(1),IUSET,IUDET EQUIVALENCE (WS(1),NAMD(1)) C. C. ------------------------------------------------------------------ C. IF(JSET.LE.0)GO TO 90 NSET=IQ(JSET-1) IF(NSET.LE.0)GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 90 JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.LE.0)GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.LE.0)GO TO 90 JD=LQ(JS-IDET) C CALL MZBOOK(IXCONS,JDD,JD,-2,'SJDD',0,0,2*ND,IOSJDD,0) C NW=0 IF(ND.GT.0)THEN CALL UCTOH(NAMESD,NAMD,4,4*ND) K=32 DO 30 I=1,ND NB=NBITSD(I) IF(NB.LT.0)NB=0 IF(NB.GE.32)NB=0 IQ(JDD+2*I-1)=NAMD(I) IQ(JDD+2*I )=NB IF(NB.LE.0)THEN NW=NW+1 K=32 ELSE K=K+NB IF(K.GT.32)THEN K=NB NW=NW+1 ENDIF ENDIF 30 CONTINUE ENDIF IQ(JD+5)=NW IQ(JD+6)=ND GO TO 99 C C Error C 90 WRITE(CHMAIL,1000)IUSET,IUDET CALL GMAIL(0,0) 1000 FORMAT(' ***** GSDETD ERROR FOR SET ',A4,' OR DETECTOR ',A4) C 99 RETURN END +DECK,GSDETH *CMZ : 3.14/14 20/06/90 17.38.04 by Rene Brun *-- Author : SUBROUTINE GSDETH(IUSET,IUDET,NH,NAMESH,NBITSH,ORIG,FACT) C. C. ****************************************************************** C. * * C. * Handling sensitive DETector Hit parameters * C. * ------------------------------------------ * C. * * C. * Defines hit parameters for detector IUDET of set IUSET. * C. * IUSET user set identifier * C. * IUDET user detector identifier * C. * NH number of elements per hit * C. * NAMESH the NH variable names for the hit elements * C. * NBITSH the NH bit numbers for packing the variable values * C. * ORIG The quantity packed in the structure JHITS for the * C. * Ith variable is a positive integer with NBITSH(I) * C. * bits and such that * C. * FACT IVAR(I) = (VAR(I)+ORIG(I))*FACT(I) * C. * The routine is used at initialisation time once the * C. * geometrical volumes have been defined to describe the hit * C. * elements and the way to do packing in memory and on tape. * C. * EXAMPLE * C. * Assume an electromagnetic calorimeter ECAL divided into 40 * C. * PHI sections called EPHI. Each EPHI division is again * C. * divided along the Z axis in 60 objects called EZRI. Each * C. * EZRI is finally divided into 4 lead glass blocks called * C. * BLOC. * C. * The geometrical information to describe one hit will then * C. * be: * C. * - The EPHI section number (between 1 and 40) * C. * - The EZRI division number (between 1 and 60) * C. * - The BLOC number (1 to 4) * C. * The variables we want to store for each hit are for example: * C. * - X x position of the hit in the lead glass block * C. * - Y y * C. * - Z z * C. * - E energy of the particle at this point * C. * - ELOS the energy deposited into this block * C. * Example of one hit in that scheme: * C. * EPHI 12 * C. * EZRI 41 * C. * BLOC 3 * C. * X 7.89 cm * C. * Y -345.6 cm * C. * Z 1234.8 cm * C. * E 12 Gev * C. * ELOS 11.85 Gev * C. * The FORTRAN coding to define the set/det/hits information * C. * could be: * C. * DIMENSION NAMESV(3),NBITSV(3) * C. * DIMENSION NAMESH(5),NBITSH(5),ORIG(5),FACT(5) * C. * DATA NAMESV/'EPHI','EZRI','BLOC'/ * C. * DATA NBITSV/6,6,3/ * C. * DATA NAMESH/'X ','Y ','Z ','E ','ELOS'/ * C. * DATA NBITSH/5*16/ * C. * DATA ORIG/3*1000.,0.,0./ * C. * DATA FACT/3*10.,2*100./ * C. * CALL GSDET ('ECAL','BLOC',3,NAMESV,NBITSV,2,100,100, * C. * + ISET,IDET) * C. * CALL GSDETH('ECAL','BLOC',5,NAMESH,NBITSH,ORIG,FACT) * C. * Returns the hit parameters for detector IUDET of set * C. * IUSET. All arguments are explained above. * C.. * * C. * * C. * JS = LQ(JSET-ISET) * C. * JD = LQ(JS-IDET) * C. * JDH= LQ(JD-1) * C. * IQ(JDH+4*I-3)= NAMESH(I) * C. * IQ(JDH+4*I-2)= NBITSH(I) * C. * Q(JDH+4*I-1)= ORIG(I) * C. * Q(JDH+4*I) = FACT(I) * C. * * C. * ==>Called by : , UGEOM * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT +SEQ,GCMZFO PARAMETER (NHEMX=100) DIMENSION NBITSH(1),ORIG(1),FACT(1),NAMH(NHEMX) CHARACTER*4 NAMESH(1),IUSET,IUDET EQUIVALENCE (WS(1),NAMH(1)) C. C. ------------------------------------------------------------------ C. IF(JSET.LE.0)GO TO 90 NSET=IQ(JSET-1) IF(NSET.LE.0)GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 90 JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.LE.0)GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.LE.0)GO TO 90 JD=LQ(JS-IDET) C CALL MZBOOK(IXCONS,JDH,JD,-1,'SJDH',0,0,4*NH,IOSJDH,0) C NW=0 IF(NH.GT.0)THEN CALL UCTOH(NAMESH,NAMH,4,4*NH) K=32 DO 30 I=1,NH NB=NBITSH(I) IF(NB.LT.0)NB=0 IF(NB.GE.32)NB=0 IQ(JDH+4*I-3)=NAMH(I) IQ(JDH+4*I-2)=NB Q(JDH+4*I-1)=ORIG(I) Q(JDH+4*I )=FACT(I) IF(FACT(I).LE.0.)Q(JDH+4*I)=1. IF(NB.LE.0)THEN NW=NW+1 K=32 ELSE K=K+NB IF(K.GT.32)THEN K=NB NW=NW+1 ENDIF ENDIF 30 CONTINUE ENDIF IQ(JD+3)=NW IQ(JD+4)=NH GO TO 99 C C Error C 90 WRITE(CHMAIL,1000)IUSET,IUDET CALL GMAIL(0,0) 1000 FORMAT(' ***** GSDETH ERROR FOR SET ',A4,' OR DETECTOR ',A4) C 99 RETURN END +DECK,GSDETU *CMZ : 3.14/14 20/06/90 17.38.13 by Rene Brun *-- Author : SUBROUTINE GSDETU(IUSET,IUDET,NUPAR,UPAR) C. C. ****************************************************************** C. * * C. * Storing and Retrieving User Detector parameters * C. * ----------------------------------------------- * C. * * C. * Stores user parameters for detector IUDET of set IUSET. * C. * IUSET user set identifier * C. * IUDET user detector identifier * C. * NUPAR number of user parameters * C. * UPAR array of NUPAR user floating point parameters. * C. * The routine is used at initialisation time once the * C. * geometrical volumes have been defined. * C. * * C. * * C. * JS = LQ(JSET-ISET) * C. * JD = LQ(JS-IDET) * C. * JDU= LQ(JD-1) * C. * Q(JDU+1) = UPAR(1) 1st user parameter,etc * C. * * C. * ==>Called by : , UGEOM * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK +SEQ,GCUNIT DIMENSION UPAR(1) CHARACTER*4 IUSET,IUDET C. C. ------------------------------------------------------------------ C. IF(JSET.LE.0)GO TO 90 NSET=IQ(JSET-1) IF(NSET.LE.0)GO TO 90 CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET) IF(ISET.LE.0)GO TO 90 JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.LE.0)GO TO 90 CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET) IF(IDET.LE.0)GO TO 90 JD=LQ(JS-IDET) C IF(NUPAR.LE.0)GO TO 90 CALL MZBOOK(IXCONS,JDU,JD,-3,'SJDU',0,0,NUPAR,3,0) C CALL UCOPY(UPAR,Q(JDU+1),NUPAR) GO TO 99 C C Error C 90 WRITE(CHMAIL,1000)IUSET,IUDET CALL GMAIL(0,0) 1000 FORMAT(' ***** GSDETU ERROR FOR SET ',A4,' OR DETECTOR ',A4) C 99 RETURN END +DECK,GSDETV *CMZ : 3.14/14 20/06/90 17.38.22 by Rene Brun *-- Author : SUBROUTINE GSDETV (IUSET, IUDET, IDTYPE, NWHI, NWDI, ISET, IDET) C. C. ****************************************************************** C. * * C. * Defines detector IUDET as a member of set IUSET * C. * and prepares the DETector structure * C. * * C. * Input parameters * C. * IUSET set identifier (4 characters), user defined * C. * IUDET detector identifier (4 characters), name of an * C. * existing volume * C. * IDTYPE detector type, user defined * C. * NWHI number of words for primary allocation of HITS banks * C. * NWDI number of words for primary allocation of DIGI banks * C. * * C. * Output parameters * C. * ISET position of set in bank JSET * C. * IDET position of detector in bank JS=IB(JSET-ISET) * C. * If ISET=0 or IDET=0 error * C. * Remarks: * C. * - The path through the volume tree will be automatically set * C. * in GGDETV,called by GGCLOS, after all volumes have been * C. * positionned. * C. * - The detector type IDTYPE is not used internally by GEANT * C. * and can be defined by the user to distinguish quickly * C. * between various kinds of detectors, in the routine GUSTEP * C. * for example. * C. * * C. * IQ(JSET+ISET) = IUSET * C. * JS = LQ(JSET-ISET) = pointer to set IUSET * C. * IQ(JS+IDET)=IUDET * C. * JD= LQ(JS-1) = pointer to detector IUDET * C. * IQ(JD+1)=Number of words to store packed volume numbers * C. * IQ(JD+2)=Number of volume descriptors * C. * IQ(JD+3)=Number of words per hit * C. * IQ(JD+4)=Number of elements per hit * C. * IQ(JD+5)=Number of words per digitisation * C. * IQ(JD+6)=Number of elements per digitisation * C. * IQ(JD+7)=NWHI, primary size of hit bank * C. * IQ(JD+8)=NWDI, primary size of digitisation bank * C. * IQ(JD+9)=Number of paths through the JVOLUM tree * C. * IQ(JD+10)=For aliases only, IDET of mother detector * C. * IQ(JD+11)=Name of first volume descriptor * C. * IQ(JD+12)=Number of bits for packing its number * C. * ... * C. * IQ(JD+9+2*NV)=Name of last volume descriptor * C. * IQ(JD+10+2*NV)=Number of bits for packing its number * C. * then for each possible path * C. * list of names and numbers for all levels * C. * (The number of levels is entered as number attached to * C. * the first name which is the top of the JVOLUM tree) * C. * * C. * The Detector Set data structure JSET * C. * ------------------------------------ * C. * * C. * | JSET * C. * NSET ISET v NSET * C. * ................................................ * C. * | | | | | Set names| * C. * ................................................ * C. * | JS * C. * | * C. * NDET IDET v NDET * C. * ........................................ * C. * | | | | | Detector names | * C. * ........................................ * C. * | JD * C. * -3 -2 -1 v * C. * ................................................ * C. * | | | | | Volume parameters, in GGDETV | * C. * ................................................ * C. * JDH * C. * JDD * C. * JDU * C. * * C. * The JSET structure is filled by GSDETV + GGDETV, and by * C. * GSDETH, GSDETD and GSDETU, eventually by GSDETA. * C. * * C. * ==>Called by : , UGEOM * C. * Authors R.Brun, F.Bruyant ********** * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCUNIT. +SEQ,GCMZFO CHARACTER*4 IUSET,IUDET C. C. ------------------------------------------------------------------ C. ISET = 0 IDET = 0 C C Check if volume IUDET has been defined C IF (JVOLUM.LE.0) GO TO 920 NVOLUM = IQ(JVOLUM-1) CALL GLOOK (IUDET, IQ(JVOLUM+1), NVOLUM, IVOL) IF (IVOL.EQ.0) GO TO 920 C C Check that volume IVOL is a sensitive medium C JVO = LQ(JVOLUM-IVOL) ITM = Q(JVO+4) JTM = LQ(JTMED-ITM) IF (Q(JTM+7).EQ.0.)THEN WRITE (CHMAIL,1000) IUDET CALL GMAIL(0,0) ENDIF C IF (JSET.EQ.0)THEN C C Create mother JSET bank C CALL MZBOOK (IXCONS, JSET, JSET, 1, 'SETS', 0,0,0, 5, 0) IQ(JSET-5)=0 NSET = 0 ELSE C NSET = IQ(JSET-1) CALL GLOOK (IUSET, IQ(JSET+1), NSET, ISET) IF (ISET.NE.0) GO TO 30 ENDIF C C Create JSET bank C CALL MZPUSH (IXCONS, JSET, 1, 1, 'I') NSET = NSET +1 C ISET = NSET CALL UCTOH (IUSET, IQ(JSET+ISET), 4, 4) CALL MZBOOK (IXCONS, JS, JSET, -ISET, 'SETS', 0,0,0, 5, 0) IQ(JS-5) = ISET C C Check if detector has already been defined C 30 JS = LQ(JSET-ISET) NDET = IQ(JS-1) IF (NDET.NE.0)THEN CALL GLOOK (IUDET, IQ(JS+1), NDET, IDET) IF (IDET.NE.0) GO TO 930 ENDIF C C If not, create detector bank C CALL MZPUSH (IXCONS, JS, 1, 1, 'I') NDET = NDET +1 IDET = NDET CALL UCTOH (IUDET, IQ(JS+IDET), 4, 4) CALL MZBOOK (IXCONS, JD, JS, -IDET, 'SEJD', 4,4,100, IOSEJD, 0) IQ(JD-5) = IDET C IQ(JD+7) = NWHI IQ(JD+8) = NWDI IQ(JD+9) = -1 C C Now enter Set/Det into JVOLUM data structure C CALL GSATT (IUDET, 'SET ', ISET) CALL GSATT (IUDET, 'DET ', IDET) CALL GSATT (IUDET, 'DTYP', IDTYPE) GO TO 999 C C Errors C 920 WRITE (CHMAIL,2000) IUDET CALL GMAIL(0,0) GO TO 999 C 930 WRITE (CHMAIL,3000) IUSET, IUDET CALL GMAIL(0,0) C 1000 FORMAT (' ***** GSDETV - ISVOL=0 FOR DETECTOR',A4,' - WARNING!') 2000 FORMAT (' ***** GSDETV ERROR, VOLUME ',A4,' NOT DEFINED') 3000 FORMAT (' ***** GSDETV ERROR ,SET ',A4, ' DETECTOR ',A4, + ' ALREADY DEFINED') C 999 RETURN END +DECK,GSDIGI *CMZ : 3.14/14 20/06/90 17.38.30 by Rene Brun *-- Author : SUBROUTINE GSDIGI(ISET,IDET,LTRA,NTRA,NUMBV,KDIGI,IDIG) C. C. ****************************************************************** C. * * C. * Routines to Communicate with the data structure JDIGI * C. * --------------------------------------------------------- * C. * * C. * Stores element values for current digitisation into the * C. * data structure JDIGI. * C. * ISET set number * C. * IDET detector number * C. * LTRA list of NTRA track numbers producing this * C. * digitisation * C. * NUMBV volume numbers corresponding to list NAMESV of * C. * GSDET * C. * KDIGI integer array of values for current digisation * C. * elements * C. * IDIG on return, current digitisation number. * C. * If =0 digitisation has not been stored. * C. * * C. * The Digitisation data structure JDIGI * C. * ------------------------------------- * C. * * C. * | JDIGI * C. * NSET ISET v * C. * .......................................... * C. * | | | | | * C. * .......................................... * C. * | * C. * | JDIG * C. * NDET IDET v NDET * C. * ..................................... * C. * | | | | | | * C. * ..................................... * C. * | * C. * | JDD * C. * v * C. * ........................................... * C. * | | 1st digitisation | 2nd digitisation, etc. * C. * ........................................... * C. * Bank layout * C. * JDIG = LQ(JDIGI-ISET), pointer to digitisations * C. * for set ISET * C. * JDD = LQ(JDIG-IDET), pointer to digitisations of * C. * detector IDET of set ISET * C. * IQ(JDIG+IDET) pointer to last word of last digitisation for * C. * this detector * C. * IQ(JDD+1) 1st word of first digitisation * C. * IQ(JDD+NWD+1) 1st word of second digitisation * C. * JS=LQ(JSET-ISET) * C. * JD=LQ(JS-IDET) * C. * NWD=IQ(JD+5) * C. * The JDIGI structure is filled with the routine GSDIGI. * C. * The routine GFDIGI can be used to get the digitisations for * C. * a detector IDET and set ISET. * C. * * C. * ==>Called by : , GUDIGI * C. * Authors R.Brun, W.Gebel ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK COMMON/GCLOCA/NLOCAL(2),JS,JD,JDDI,JDI,JDID,LOCAL(15) DIMENSION NUMBV(1),KDIGI(1),LTRA(1) C. C. ------------------------------------------------------------------ C. C Find if selected set, detector exists C IDIG=0 C IF(JSET.LE.0)GO TO 99 NSET=IQ(JSET-1) IF(NSET.LE.0)GO TO 99 IF(ISET.LE.0)GO TO 99 IF(ISET.GT.NSET)GO TO 99 C JS=LQ(JSET-ISET) NDET=IQ(JS-1) IF(NDET.LE.0)GO TO 99 IF(IDET.LE.0)GO TO 99 IF(IDET.GT.NDET)GO TO 99 C JD=LQ(JS-IDET) JDDI=LQ(JD-2) IF(JDDI.LE.0)GO TO 99 NW=IQ(JD+1)+IQ(JD+5)+2 ND=IQ(JD+6) NV=IQ(JD+2) NWTR=NTRA/2+1 NWD=NW+NWTR C C Create DIGItisation master bank C IF(JDIGI.EQ.0)THEN CALL MZBOOK(IXDIV,JDIGI,JDIGI,1,'DIGI',NSET,NSET,0,2,0) IQ(JDIGI-5)=0 ENDIF JDI=LQ(JDIGI-ISET) IF(JDI.EQ.0)THEN CALL MZBOOK(IXDIV,JDI,JDIGI,-ISET,'DIGI',NDET,NDET,NDET,2,0) ENDIF C JDID=LQ(JDI-IDET) IF(JDID.EQ.0)THEN C C Create DIGItisation bank C NWDI=IQ(JD+8) CALL MZBOOK(IXDIV,JDID,JDI,-IDET,'SJDI',0,0,NWDI,1,0) IQ(JDI+IDET)=0 ENDIF C C Check if enough space. If not increase bank size C 10 NDID=IQ(JDID-1) ILAST=IQ(JDI+IDET) NFREE=NDID-ILAST IF(NFREE.LE.NWD)THEN NWDI2=MAX(100,NWD,IQ(JD+8)/2) CALL MZPUSH(IXDIV,JDID,0,NWDI2,'I') GO TO 10 ENDIF C IQ(JDI+IDET)=ILAST+NWD IF(ILAST.NE.0)IDIG=IQ(JDID+ILAST) IDIG=IDIG+1 C C C C C ========> Store tracks numbers, volumes numbers and digits C IQ(JDID+ILAST+1)=NWD IQ(JDID+ILAST+NWD)=IDIG NK=ILAST+2 C C Store packed track numbers C Every 2 consecutive numbers into 1 word C 1st half of 1st word: NTRA-1 C IQ(JDID+NK)=0 IF(NTRA.GT.0)THEN NTRM1=NTRA-1 CALL SBYT(NTRM1,IQ(JDID+NK),1,16) IF(NTRM1.GE.1)THEN DO 23 ITR=1,NTRM1,2 CALL SBYT(LTRA(ITR) ,IQ(JDID+NK),17,16) NK=NK+1 CALL SBYT(LTRA(ITR+1),IQ(JDID+NK), 1,16) 23 CONTINUE ENDIF IF(MOD(NTRA,2).EQ.1)CALL SBYT(LTRA(NTRA),IQ(JDID+NK),17,16) ENDIF NK=NK+1 C C Store packed volume numbers C IF(NV.GT.0)THEN K=1 C DO 50 I=1,NV NB=IQ(JD+2*I+10) IF(NB.LE.0)THEN IF(K.GT.1)THEN NK=NK+1 ENDIF IQ(JDID+NK)=NUMBV(I) K=1 IF(I.NE.NV)NK=NK+1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF CALL SBYT(NUMBV(I),IQ(JDID+NK),K,NB) K=K+NB ENDIF 50 CONTINUE NK=NK+1 ENDIF C C Store packed digits C IF(ND.GT.0)THEN K=1 DO 90 I=1,ND NB=IQ(JDDI+2*I) IF(NB.LE.0)THEN IF(K.GT.1)THEN NK=NK+1 ENDIF IQ(JDID+NK)=KDIGI(I) NK=NK+1 K=1 ELSE IF(K+NB.GT.33)THEN K=1 NK=NK+1 ENDIF CALL SBYT(KDIGI(I),IQ(JDID+NK),K,NB) K=K+NB ENDIF 90 CONTINUE ENDIF C 99 RETURN END +PATCH,GIOPA +DECK,DOCGIOPA,IF=DOC *CMZ : 3.15/09 08/04/92 12.27.06 by Federico Carminati *-- Author : Federico Carminati * ************************************************************************ * * * The I/O service routines * * ------------------------ * * * * The I/O routines permit to read and write, the GEANT3 data * * structures. The possibility exists to write and read data * * structures to/from direct access files, in machine dependent or * * independent format and to/from direct access files. All I/O is * * done via the ZEBRA I/O routines both for direct access files (FZ * * package) and for direct access files (RZ package). * * Data can be generated on one type of machine, for example full * * detector simulation, and the data produced can be analyzed on a * * different machine. * * The data structures written to tape or disk can be read either in * * whole or in part. * * * * * * Routines to perform I/O * * ----------------------- * * * * CALL GCLOSE(LUN, IER) * * * * LUN Logical unit number * * IER Error flag * * * * Close sequential FZ file open with logical unit LUN. If LUN=0 * * close all FZ files. IER=1 if the file is no FZ file open with * * logical unit LUN is found, 0 otherwise. * * * * CALL GFIN(LUN,CHOBJ,NKEYS,IDVERS,CHOPT,IER) * * * * LUN Logical unit number * * CHOBJ CHARACTER*4 array containing the data structures to be * * read (DIGI,DRAW,HEAD,HITS,KINE,MATE,PART,ROTM,RUNG, * * SETS,STAK,STAT,TMED,VERT,VOLU,JXYZ,SCAN). In addition * * the following keywords are defined: * * INIT = DRAW,MATE,PART,ROTM,RUNG,SETS,TMED,VOLU,SCAN * * KINE = KINE,VERT * * TRIG = DIGI,HEAD,HITS,KINE,VERT,JXYZ * * NKEYS Number of valid elements in the array CHOBJ * * IDVERS Version to be retrieved. If IDVERS=0 the first version * * found will be retrieved. * * CHOPT Character option. * * IER Error flag. -1 if nothing has been read in. >0 in not * * all the requested data structures have been read in. * * * * * * * * Routine to read GEANT object(s) from a FZ file The data * * structures from disk are read in memory. * * * * CALL GFOUT(LUN,CHOBJ,NKEYS,IDVERS,CHOPT,IER) * * * * See above for the parameters. Routine to write GEANT object(s) * * into a FZ file The data structures are written from memory to * * disk. * * * * CALL GOPEN(LUN,LUNTYP,LEN,IER) * * * * LUN Logical unit * * LUNTYP CHARACTER variable specifying the format of the FZ * * file. Possible options are I,O,A,X. See the FZ manual * * for more information. * * LEN Logical record length of the FZ file. * * IER Error flag. 0 if file has been open correctly. * * * * Routine to open a FZ file for input or output. * * * * CALL GREND (LUN) * * * * LUN Logical unit * * * * Routine to close the RZ direct access file opened with logical * * unit LUN. * * * * CALL GRFILE(LUN,CHFILE,CHOPTT) * * * * LUN Logical unit number * * CHFILE Name of the file to be open * * CHOPTT Character option * * * * Routine to open an RZ file for input or output. If option I is * * given, then the INIT data structures will be read from the file * * and if the option O is given they will be written to the file. * * * * CALL GRIN(CHOBJT,IDVERS,CHOPT) * * * * CHOBJT CHARACTER*4 variable with the name of the data * * structure to be retrieved. See GFIN for more details. * * IDVERS Version of the data structure to be retrieved. If 0 * * the first found data structure will be retrieved. * * CHOPT Option variable * * * * Routine to read from a RZ direct access file GEANT data * * structures. * * * * CALL GRLEAS(JBANK) * * * * JBANK Pointer to a data structure * * * * Routine to release unused space in the data structure pointed to * * by JBANK. * * * * CALL GRMDIR(CHDIR,CHOPT) * * * * CHDIR Name of the directory * * CHOPT Character option * * * * Routine to create a GEANT subdirectory in an RZ file. * * * * CALL GROUT(CHOBJT,IDVERS,CHOPT) * * * * Routine to write to a RZ direct access file GEANT data * * structures. See GRIN for explanations on the parameters. * * * ************************************************************************ +DECK,GCLOSE *CMZ : 3.15/09 07/04/92 17.53.18 by Federico Carminati *-- Author : SUBROUTINE GCLOSE (LUN,IER) C. C. ****************************************************************** C. * * C. * Routine to close I/O units * C. * * C. * LUN Logical unit number * C. * IER error flag * C. * * C. * ==>Called by : , UGLAST * C. * Authors R.Brun, F.Carena ********* * C. * * C. ****************************************************************** C. +SEQ,GCUNIT C. C. ------------------------------------------------------------------ C. IER=0 IF(LUN.EQ.0)THEN CALL FZENDO(LUN,'T') CALL FZENDI(LUN,'T') ELSE DO 10 I=1,NUNITS IF(LUN.EQ.ABS(LUNITS(I)))THEN IF(LUNITS(I).LT.0)THEN CALL FZENDI(LUN,'T') ELSE CALL FZENDO(LUN,'T') ENDIF LUNITS(I)=0 GOTO 999 ENDIF 10 CONTINUE IER=1 ENDIF 999 END +DECK,GFIN. *CMZ : 3.15/09 08/04/92 12.17.45 by Federico Carminati *-- Author : SUBROUTINE GFIN(LUN,CHOBJ,NKEYS,IDVERS,CHOPT,IER) C. C. ****************************************************************** C. * * C. * Routine to read GEANT object(s) fromin the FZ file * C. * The data structures from disk are read in memory * C. * (VOLU,ROTM,TMED,MATE,SETS,PART,SCAN) * C. * * C. * CHOBJ The type of object to be read: * C. * MATE read JMATE structure * C. * TMED read JTMED structure * C. * VOLU read JVOLUM structure * C. * ROTM read JROTM structure * C. * SETS read JSET structure * C. * PART read JPART structure * C. * SCAN read LSCAN structure * C. * INIT read all initialisation structures * C. * * C. * IDVERS version to be read in * C. * * C. * CHOPT List of options (none for the time being) * C. * * C. * IER error flag. -1 if no structure read in * C. * >0 if only IER structures read in * C. * * C. * The FZ data base has been created via GOPEN/GFOUT * C. * * C. * * C. * Example. * C. * * C. * CALL GOPEN(1,'I',1024,IER) * C. * CALL GFIN ('VOLU',1,' ',IER) * C. * CALL GFIN ('MATE',1,' ',IER) * C. * CALL GFIN ('TMED',1,' ',IER) * C. * CALL GFIN ('ROTM',1,' ',IER) * C. * CALL GFIN ('PART',1,' ',IER) * C. * CALL GFIN ('SCAN',1,' ',IER) * C. * CALL GFIN ('SETS',1,' ',IER) * C. * * C. * ==>Called by : ,GOPEN * C. * Author F.Carminati ******* * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCFLAG. +SEQ,GCONSP. +SEQ,GCNUM. +SEQ,GCCUTS. +SEQ,GCSCAL. +SEQ,GCDRAW. +SEQ,GCVOLU. +SEQ,GCUNIT +SEQ,GCTIME * COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART * + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX * + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT COMMON/QUEST/IQUEST(100) PARAMETER (NLINIT=9,NLKINE=2,NLTRIG=6,NMKEY=22) DIMENSION JNAMES(20),LINIT(NLINIT),LKINE(NLKINE) DIMENSION LTRIG(NLTRIG),IXD(NMKEY) DIMENSION LINK(NMKEY),IVERSI(NMKEY),LDIV(2),IRESUL(NMKEY) DIMENSION IDOLD(8), IDNEW(8), VEROLD(8), VERNEW(8) DIMENSION IUHEAD(2),ITRAN(23) EQUIVALENCE (JNAMES(1),JDIGI) CHARACTER*4 KNAMES(NMKEY),CHOBJ(*) CHARACTER*(*) CHOPT DATA KNAMES/'DIGI','DRAW','HEAD','HITS','KINE','MATE','PART', + 'ROTM','RUNG','SETS','STAK','STAT','TMED','NULL','VERT', + 'VOLU','JXYZ','NULL','NULL','NULL','SCAN','NULL'/ DATA ITRAN/7,6,13,16,8,10,2,9,8*0,3,5,5,17,4,1,23/ DATA IXD/2,1,2,2,2,8*1,2,2,1,2,3*0,1,0/ DATA LINIT/2,6,7,8,9,10,13,16,21/ DATA LKINE/5,15/ DATA LTRIG/1,3,4,5,15,17/ DATA IDNEW / 8*0 / DATA VERNEW / 8*0. / C. C. ------------------------------------------------------------------ C. IQUEST(1)=0 LDIV(1) =IXCONS LDIV(2) =IXDIV KVOL=JVOLUM IER=0 * IOPTI=INDEX(CHOPT,'i')+INDEX(CHOPT,'I') IOPTT=INDEX(CHOPT,'t')+INDEX(CHOPT,'T') IOPTK=INDEX(CHOPT,'k')+INDEX(CHOPT,'K') * * Save old JRUNG dates and versions IF(JRUNG.GT.0) THEN DO 10 J=1,8 IDOLD(J) = IQ(JRUNG+10+J) VEROLD(J) = Q(JRUNG+20+J) 10 CONTINUE ENDIF * NLINK=0 DO 100 JKEY=1,NKEYS IF(CHOBJ(JKEY).EQ.'INIT') THEN IF(IOPTI+IOPTT+IOPTK.LE.0) IOPTI=1 DO 30 J=1, NLINIT DO 20 MLINK=1,NLINK IF(LINK(MLINK).EQ.LINIT(J)) GO TO 30 20 CONTINUE NLINK=NLINK+1 LINK(NLINK)=LINIT(J) 30 CONTINUE ELSEIF(CHOBJ(JKEY).EQ.'TRIG') THEN IF(IOPTI+IOPTT+IOPTK.LE.0) IOPTT=1 DO 50 J=1, NLTRIG DO 40 MLINK=1,NLINK IF(LINK(MLINK).EQ.LTRIG(J)) GO TO 50 40 CONTINUE NLINK=NLINK+1 LINK(NLINK)=LTRIG(J) 50 CONTINUE ELSEIF(CHOBJ(JKEY).EQ.'KINE') THEN IF(IOPTI+IOPTT+IOPTK.LE.0) IOPTK=1 DO 70 J=1, NLKINE DO 60 MLINK=1,NLINK IF(LINK(MLINK).EQ.LKINE(J)) GO TO 70 60 CONTINUE NLINK=NLINK+1 LINK(NLINK)=LKINE(J) 70 CONTINUE ELSE DO 90 J=1,NMKEY IF(CHOBJ(JKEY).EQ.KNAMES(J)) THEN DO 80 MLINK=1,NLINK IF(LINK(MLINK).EQ.J) GO TO 100 80 CONTINUE NLINK=NLINK+1 LINK(NLINK)=J GO TO 100 ENDIF 90 CONTINUE WRITE(CHMAIL,10300) CHOBJ(JKEY) CALL GMAIL(0,0) ENDIF 100 CONTINUE * IF(IOPTI.GT.0) THEN DO 120 J=1, NLINK DO 110 K=1, NLINIT IF(LINK(J).EQ.LINIT(K)) GO TO 120 110 CONTINUE WRITE(CHMAIL,10000) KNAMES(LINK(J)) CALL GMAIL(0,0) LINK(J)=0 120 CONTINUE ELSEIF(IOPTK.GT.0) THEN DO 140 J=1, NLINK DO 130 K=1, NLKINE IF(LINK(J).EQ.LKINE(K)) GO TO 140 130 CONTINUE WRITE(CHMAIL,10100) KNAMES(LINK(J)) CALL GMAIL(0,0) LINK(J)=0 140 CONTINUE ELSEIF(IOPTT.GT.0) THEN DO 160 J=1, NLINK DO 150 K=1, NLTRIG IF(LINK(J).EQ.LTRIG(K)) GO TO 160 150 CONTINUE WRITE(CHMAIL,10200) KNAMES(LINK(J)) CALL GMAIL(0,0) LINK(J)=0 160 CONTINUE ENDIF IOFF=0 DO 170 J=1, NLINK LINK(J+IOFF)=LINK(J) IF(LINK(J).EQ.0) IOFF=IOFF-1 170 CONTINUE NLINK=NLINK+IOFF * IF(NLINK.LE.0) THEN WRITE(CHMAIL,10400) CALL GMAIL(0,0) IER=-1 GOTO 999 ENDIF * DO 180 J=1, NLINK IVERSI(J)=0 IRESUL(J)=0 180 CONTINUE * * Go for next start of event data structure 190 IF(IOPTI.NE.0) THEN IF(JRUNG.NE.0)CALL MZDROP(IXCONS,JRUNG,' ') NUH=2 CALL FZIN(LUN,IXCONS,JRUNG,1,'E',NUH,IUHEAD) IF(IQUEST(1).GT.2)GO TO 240 IVERSI(5)=IUHEAD(1) IRESUL(5)=1 ELSEIF(IOPTT+IOPTK.NE.0) THEN IF(JHEAD.NE.0)CALL MZDROP(IXDIV,JHEAD,' ') NUH=2 CALL FZIN(LUN,IXDIV,JHEAD,1,'E',NUH,IUHEAD) IF(IQUEST(1).GT.2)GO TO 240 IF(IOPTT.NE.0) THEN IVERSI(2)=IUHEAD(1) IRESUL(2)=1 ENDIF ENDIF * IVERIN = IUHEAD(1) IF(IDVERS.NE.0.AND.IDVERS.NE.IVERIN) THEN DO 200 I=1,NLINK LINK(I)=-ABS(LINK(I)) 200 CONTINUE GOTO 190 ELSE DO 210 I=1,NLINK LINK(I)= ABS(LINK(I)) 210 CONTINUE ENDIF NK = IUHEAD(2) IF(NK.LE.0.OR.NK.GT.10) THEN IER=-1 GO TO 999 ENDIF DO 230 IK=1,NK C C Read next header C NUH=2 CALL FZIN(LUN,0,0,0,'S',NUH,IUHEAD) IF(IQUEST(1).GT.2)GO TO 320 IKEY=ITRAN(IUHEAD(1)) DO 220 I=1,NLINK NKEY=LINK(I) IF(IKEY.EQ.NKEY)THEN IDIV=LDIV(IXD(NKEY)) IF(NKEY.LE.20)THEN IF(JNAMES(NKEY).NE.0)THEN CALL MZDROP(IDIV,JNAMES(NKEY),'L') JNAMES(NKEY)=0 ENDIF CALL FZIN(LUN,IDIV,JNAMES(NKEY),1,'A',NUH,IUHEAD) ELSE NKL=NKEY-20 IF(ISLINK(NKL).NE.0)THEN CALL MZDROP(IDIV,ISLINK(NKL),'L') ISLINK(NKL)=0 ENDIF CALL FZIN(LUN,IDIV,ISLINK(NKL),1,'A',NUH,IUHEAD) ENDIF IF(IQUEST(1).LE.2.AND.IQUEST(1).GE.0) THEN IVERSI(I)=IVERIN IRESUL(I)=1 GOTO 230 ELSE GOTO 320 ENDIF ENDIF 220 CONTINUE 230 CONTINUE * 240 NIN=0 DO 250 I=1,NLINK IF(IRESUL(I).EQ.1) THEN WRITE(CHMAIL,10500) KNAMES(LINK(I)), IVERSI(I) CALL GMAIL(0,0) NIN=NIN+1 ELSEIF(LINK(I).GT.0) THEN WRITE(CHMAIL,10600) KNAMES(LINK(I)) CALL GMAIL(0,0) ELSEIF(LINK(I).LT.0) THEN WRITE(CHMAIL,10700) KNAMES(-LINK(I)), IDVERS CALL GMAIL(0,0) ENDIF 250 CONTINUE * IF(NIN.EQ.0) THEN WRITE(CHMAIL,10800) CALL GMAIL(0,0) IER=-1 GOTO 999 ELSEIF(NIN.LT.NLINK) THEN IER=NIN ENDIF * IF(KVOL.NE.JVOLUM)THEN NVOLUM=IQ(JVOLUM-1) CALL MZGARB(IXCONS,0) CALL GGDVLP CALL GGNLEV ENDIF * IF(JVOLUM.GT.0) THEN NLEVEL=0 NVOLUM=0 DO 260 J=1, IQ(JVOLUM-2) IF(LQ(JVOLUM-J).EQ.0) GOTO 270 NVOLUM=NVOLUM+1 260 CONTINUE 270 CONTINUE ENDIF * IF(JTMED.NE.0 )THEN CALL UCOPY(Q(JTMED+1),CUTGAM,10) NTMED=IQ(JTMED-2) ENDIF * IF(JPART.NE.0 ) NPART = IQ(JPART-2) IF(JVERTX.NE.0) NVERTX = IQ(JVERTX-2) IF(JMATE.NE.0 ) NMATE = IQ(JMATE-2) IF(JDRAW.GT.0 ) THEN NKVIEW = IQ(JDRAW-2) ELSE NKVIEW = 0 C C Book JDRAW structure for view banks C CALL MZBOOK(IXCONS,JDRAW,JDRAW,1,'DRAW',0,0,0,3,0) ENDIF C IF(JHEAD.GT.0)THEN IDRUN=IQ(JHEAD+1) IDEVT=IQ(JHEAD+2) ENDIF IF(JRUNG.GT.0) THEN * * Here we deal with version numbers If JRUNG has been read in, * then save the version numbers of the new JRUNG and restore * the current version number for KINE, HITS and DIGI DO 300 J=1, NLINK IF(IVERSI(J).GT.0) THEN NKEY = ABS(LINK(J)) IF(KNAMES(NKEY).EQ.'RUNG') THEN DO 280 I=1,8 IDNEW(I) = IQ(JRUNG+10+I) VERNEW(I) = Q(JRUNG+20+I) 280 CONTINUE * * And we put back the old version numbers because, * in principle, KINE, HITS and DIGI have not be read in DO 290 I=3,8 IQ(JRUNG+10+I) = IDOLD(I) Q(JRUNG+20+I) = VEROLD(I) 290 CONTINUE ENDIF ENDIF 300 CONTINUE * * And here we do it again for KINE, HITS and DIGI DO 310 J=1, NLINK IF(IVERSI(J).GT.0) THEN NKEY = ABS(LINK(J)) IF(KNAMES(NKEY).EQ.'KINE') THEN IF(IDNEW(3).GT.0) THEN IQ(JRUNG+13) = IDNEW(3) IQ(JRUNG+14) = IDNEW(4) Q(JRUNG+23) = VERNEW(3) Q(JRUNG+24) = VERNEW(4) ENDIF ELSEIF(KNAMES(NKEY).EQ.'HITS') THEN IF(IDNEW(5).GT.0) THEN IQ(JRUNG+15) = IDNEW(5) IQ(JRUNG+16) = IDNEW(6) Q(JRUNG+25) = VERNEW(5) Q(JRUNG+26) = VERNEW(6) ENDIF ELSEIF(KNAMES(NKEY).EQ.'DIGI') THEN IF(IDNEW(7).GT.0) THEN IQ(JRUNG+17) = IDNEW(7) IQ(JRUNG+18) = IDNEW(8) Q(JRUNG+27) = VERNEW(7) Q(JRUNG+28) = VERNEW(8) ENDIF ELSEIF(KNAMES(NKEY).EQ.'MATE'.OR. KNAMES(NKEY) .EQ.'TMED' + ) THEN IF(VERNEW(1).NE.0) THEN * We know which version number we are reading IF(VERNEW(1).LT.GVERSN) THEN WRITE(CHMAIL,10900) KNAMES(NKEY),VERNEW(1), + GVERSN CALL GMAIL(0,0) WRITE(CHMAIL,11000) CALL GMAIL(0,0) ENDIF ENDIF ENDIF ENDIF 310 CONTINUE ENDIF 320 CONTINUE * 10000 FORMAT(' *** GFIN *** Key ',A4,' ignored for initialization') 10100 FORMAT(' *** GFIN *** Key ',A4,' ignored for kinematics') 10200 FORMAT(' *** GFIN *** Key ',A4,' ignored for trigger') 10300 FORMAT(' *** GFIN *** Unknown key ',A4) 10400 FORMAT(' *** GFIN *** No valid key given') 10500 FORMAT(' *** GFIN *** Data structure ',A4,' version ',I10, + ' successfully read in ') 10600 FORMAT(' *** GFIN *** Data structure ',A4,' was not found') 10700 FORMAT(' *** GFIN *** Data structure ',A4,' version ',I10, + ' was not found') 10800 FORMAT(' *** GFIN *** Nothing found to read !') 10900 FORMAT(' *** GFIN *** ',A4,' data structure ', + 'version ',F6.4,' current version is ',F6.4) 11000 FORMAT(' Please call subroutine GPHYSI before ', + 'tracking') 999 END +DECK,GFOUT. *CMZ : 3.15/09 08/04/92 12.23.28 by Federico Carminati *-- Author : SUBROUTINE GFOUT(LUN,CHOBJ,NKEYS,IDVERS,CHOPT,IER) C. C. ****************************************************************** C. * * C. * Routine to write GEANT object(s) to a FZ file * C. * The data structures in memory are written to disk * C. * (VOLU,ROTM,TMED,MATE,SETS,PART,SCAN) * C. * * C. * CHOBJ The type of object to be read: * C. * MATE read JMATE structure * C. * TMED read JTMED structure * C. * VOLU read JVOLUM structure * C. * ROTM read JROTM structure * C. * SETS read JSET structure * C. * PART read JPART structure * C. * SCAN read LSCAN structure * C. * INIT read all initialisation structures * C. * * C. * IDVERS version to be read in * C. * * C. * IER error flag -1 if no data structure written out * C. * >0 if only IER structures written out * C. * * C. * CHOPT List of options (none for the time being) * C. * * C. * The FZ data base has been created via GOPEN/GFOUT * C. * * C. * Example. * C. * * C. * CALL GOPEN(1,'I',1024,IER) * C. * CALL GFOUT ('VOLU',1,' ',IER) * C. * CALL GFOUT ('MATE',1,' ',IER) * C. * CALL GFOUT ('TMED',1,' ',IER) * C. * CALL GFOUT ('ROTM',1,' ',IER) * C. * CALL GFOUT ('PART',1,' ',IER) * C. * CALL GFOUT ('SCAN',1,' ',IER) * C. * CALL GFOUT ('SETS',1,' ',IER) * C. * * C. * ==>Called by : * C. * Author R.Brun ********* * C. * * C. ****************************************************************** C. +SEQ,GCBANK. +SEQ,GCFLAG. +SEQ,GCONSP. +SEQ,GCNUM. +SEQ,GCCUTS. +SEQ,GCSCAL. +SEQ,GCDRAW. +SEQ,GCVOLU. +SEQ,GCUNIT. +SEQ,GCTIME * COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART * + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX * + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT COMMON/QUEST/IQUEST(100) PARAMETER (NLINIT=9,NLKINE=2,NLTRIG=6,NMKEY=22) DIMENSION JNAMES(20),LINIT(NLINIT),LKINE(NLKINE) DIMENSION LTRIG(NLTRIG),IXD(NMKEY) DIMENSION LINK(NMKEY),IVERSI(NMKEY),LDIV(2),IRESUL(NMKEY) DIMENSION IUHEAD(2),ITRAN(23),JTRAN(23) EQUIVALENCE (JNAMES(1),JDIGI) CHARACTER*4 KNAMES(NMKEY),CHOBJ(*) CHARACTER*(*) CHOPT DATA KNAMES/'DIGI','DRAW','HEAD','HITS','KINE','MATE','PART', + 'ROTM','RUNG','SETS','STAK','STAT','TMED','NULL','VERT', + 'VOLU','JXYZ','NULL','NULL','NULL','SCAN','NULL'/ DATA ITRAN/7,6,13,16,8,10,2,9,8*0,3,5,5,17,4,1,21/ DATA JTRAN/22,7,17,21,18,2,1,5,8,6,2*0,3,0,18,4,20,3*0,23,2*0/ DATA IXD/2,1,2,2,2,8*1,2,2,1,2,3*0,1,0/ DATA LINIT/2,6,7,8,9,10,13,16,21/ DATA LKINE/5,15/ DATA LTRIG/1,3,4,5,15,17/ C. C. ------------------------------------------------------------------ C. IQUEST(1)=0 IER=0 LDIV(1) =IXCONS LDIV(2) =IXDIV * IOPTI=INDEX(CHOPT,'i')+INDEX(CHOPT,'I') IOPTT=INDEX(CHOPT,'t')+INDEX(CHOPT,'T') IOPTK=INDEX(CHOPT,'k')+INDEX(CHOPT,'K') * NLINK=0 DO 90 JKEY=1,NKEYS IF(CHOBJ(JKEY).EQ.'INIT') THEN IF(IOPTI+IOPTT+IOPTK.LE.0) IOPTI=1 DO 20 J=1, NLINIT DO 10 MLINK=1,NLINK IF(LINK(MLINK).EQ.LINIT(J)) GO TO 20 10 CONTINUE NLINK=NLINK+1 LINK(NLINK)=LINIT(J) 20 CONTINUE ELSEIF(CHOBJ(JKEY).EQ.'TRIG') THEN IF(IOPTI+IOPTT+IOPTK.LE.0) IOPTT=1 DO 40 J=1, NLTRIG DO 30 MLINK=1,NLINK IF(LINK(MLINK).EQ.LTRIG(J)) GO TO 40 30 CONTINUE NLINK=NLINK+1 LINK(NLINK)=LTRIG(J) 40 CONTINUE ELSEIF(CHOBJ(JKEY).EQ.'KINE') THEN IF(IOPTI+IOPTT+IOPTK.LE.0) IOPTK=1 DO 60 J=1, NLKINE DO 50 MLINK=1,NLINK IF(LINK(MLINK).EQ.LKINE(J)) GO TO 60 50 CONTINUE NLINK=NLINK+1 LINK(NLINK)=LKINE(J) 60 CONTINUE ELSE DO 80 J=1,NMKEY IF(CHOBJ(JKEY).EQ.KNAMES(J)) THEN DO 70 MLINK=1,NLINK IF(LINK(MLINK).EQ.J) GO TO 90 70 CONTINUE NLINK=NLINK+1 LINK(NLINK)=J GO TO 90 ENDIF 80 CONTINUE WRITE(CHMAIL,10300) CHOBJ(JKEY) CALL GMAIL(0,0) ENDIF 90 CONTINUE * IF(IOPTI.GT.0) THEN DO 110 J=1, NLINK DO 100 K=1, NLINIT IF(LINK(J).EQ.LINIT(K)) GO TO 110 100 CONTINUE WRITE(CHMAIL,10000) KNAMES(LINK(J)) CALL GMAIL(0,0) LINK(J)=0 110 CONTINUE ELSEIF(IOPTK.GT.0) THEN DO 130 J=1, NLINK DO 120 K=1, NLKINE