+OPTION,MAPASM. +ASM,23. +USE,GCDES,TestEm1,T=EXE. * +EXE,CRA*. * +PAM,11,T=CARD,T=ATTACH. /cern/pro/src/car/geant321.car +PATCH,TestEm1. +DECK,BLANKDEK. * * TestEm1 1.00 /01 980918 13.00 GEANT EXAMPLES * * TEST PROGRAM FOR GEANT TEST * * Author M.Maire ********* * * * History * ------- * * +KEEP,CALOR. COMMON/CALOR/Imat,BoxSize,Field * * Imat = GEANT material number. (data card CALOR) * BoxSize = total size of the box (cm) (data card CALOR) * Field = magnetic field (tesla) (data card CALOR) * +KEEP,CELOSS. COMMON/CELOSS/ ETOT,NTRAK0,NTRAK1,NSTEP0,NSTEP1,NBCALL(12), + NSTRK0,NSTRK1 +DECK,main,if=batch. PROGRAM main * * PARAMETER (NGBANK=100000, NHBOOK=10000) COMMON/GCBANK/Q(NGBANK) COMMON/PAWC /H(NHBOOK) * CALL GZEBRA( NGBANK) CALL HLIMIT(-NHBOOK) * * *** initialize HIGZ CALL HPLINT(0) * * *** GEANT initialisation CALL UGINIT * * *** Start events processing CALL GRUN * * *** End of RUN CALL UGLAST * STOP END +DECK,main,IF=-batch. PROGRAM main * * GEANT main program. To link with the MOTIF user interface * the routine GPAWPP(NWGEAN,NWPAW) should be called, whereas * the routine GPAW(NWGEAN,NWPAW) gives access to the basic * graphics version. * PARAMETER (NWGEAN=3000000, NWPAW=1000000) COMMON/GCBANK/GEANT(NWGEAN) COMMON/PAWC /PAW (NWPAW) * * CALL GPAW (NWGEAN,NWPAW) * END * SUBROUTINE qnext END * SUBROUTINE czopen END * SUBROUTINE cztcp END * SUBROUTINE czclos END * SUBROUTINE czputa END +DECK,UGINIT SUBROUTINE UGINIT * * To initialise GEANT/USER program and read data cards * +SEQ,CALOR,CELOSS. * CHARACTER*20 filnam * * *** Define the GEANT parameters CALL GINIT * *** read data cards PRINT *, 'G3 > gives the filename of the data cards to be read:' READ (*,'(A)') filnam IF (filnam.EQ.' ') filnam = 'testem1.dat' OPEN (unit=5,file=filnam,status='unknown',form='formatted') * * *** Calor definition CALL FFKEY('CALOR',Imat,3,'MIXED') * * *** read data cards CALL GFFGO * CALL GZINIT CALL GPART * CALL GDINIT * * *** Geometry and materials description CALL UGEOM * * *** Energy loss and cross-sections initialisations CALL GPHYSI * CALL GPRINT('MATE',0) CALL GPRINT('TMED',0) CALL GPRINT('VOLU',0) * * *** Define user histograms CALL UHINIT * * *** some initialisation NTRAK0 = 0 NTRAK1 = 0 NSTEP0 = 0 NSTEP1 = 0 CALL VZERO (NBCALL,12) * END +DECK,UGEOM. SUBROUTINE UGEOM * * *** Define user geometry set up * * +SEQ,CALOR. * DIMENSION PAR(3) DIMENSION Aair(2),Zair(2),Wair(2) DIMENSION AH2O(2),ZH2O(2),WH2O(2) * * *** Air compound parameters DATA Aair/14.01, 16.00/ DATA Zair/ 7. , 8. / DATA Wair/ 0.7 , 0.3 / * * *** Air compound parameters DATA AH2O/ 1.01, 16.00/ DATA ZH2O/ 1. , 8. / DATA WH2O/ 2. , 1. / * * *** Defines USER perticular materials CALL GSMIXT( 1,'Air' , Aair ,Zair, 1.29E-3, 2 , Wair) CALL GSMATE( 2,'H2 Liquid', 1.01, 1., 0.0708 , 865., 790., 0,0) CALL GSMIXT( 3,'Water' , AH2O ,ZH2O, 1.0 ,-2 , WH2O) CALL GSMATE( 4,'Liquid Ar', 39.95, 18., 1.39 , 14.0, 84.0, 0,0) CALL GSMATE( 5,'Aluminium', 26.98, 13., 2.7 , 8.9, 37.2, 0,0) CALL GSMATE( 6,'Iron ', 55.85, 26., 7.87 , 1.76, 17.1, 0,0) CALL GSMATE( 7,'Lead ',207.19, 82., 11.35 , 0.56, 18.5, 0,0) CALL GSMATE( 8,'Uranium ',238.03, 92., 18.95 , 0.32, 12. , 0,0) * * * *** Defines USER tracking media parameters IFIELD = 0 IF (Field.GT.0.) IFIELD = 3 FIELDM = 10*Field TMAXFD = 10.0 STEMAX = 1000. DEEMAX = 0.20 EPSIL = 0.001 STMIN = 0.010 * CALL GSTMED( 1,'Container',Imat, 0 ,IFIELD,FIELDM,TMAXFD, * STEMAX,DEEMAX,EPSIL,STMIN, 0 , 0 ) * * * *** Geometry PAR(1) = BoxSize/2. PAR(2) = BoxSize/2. PAR(3) = BoxSize/2. CALL GSVOLU('aBox','BOX ',1,PAR,3,IVOL) * * *** Close geometry banks. (obligatory system routine) CALL GGCLOS * * * *** dessin CALL GSATT ('*','SEEN',1) * DO IX = 1,3 CALL GDOPEN (IX) SCALE = 18./BoxSize PAXIS = 0. SAXIS = 1. CALL GDRAWC ('aBox',IX,0.,10.,9.3,SCALE,SCALE) CALL GDAXIS (PAXIS,PAXIS,PAXIS,SAXIS) CALL GDSCAL (10. , 0.3) CALL GDCLOS END DO * END +DECK,UHINIT. SUBROUTINE UHINIT * * To book the user's histograms * CALL HBOOK1(1,'track length (mm) of a charged particle', + 100,0.,500.,0.) CALL HBOOK1(2,'Nb of steps per track (charged particle)', + 100,0.,100.,0.) CALL HBOOK1(3,'step length (mm) charged particle', + 100,0.,10. ,0.) * END +DECK,GUKINE SUBROUTINE GUKINE * * Generates Kinematics for primary track * * Data card Kine : Itype Ekine * +SEQ,GCBANK,GCFLAG,GCKINE. * DIMENSION VERTEX(3),PLAB(3) * DATA VERTEX/3*0./ DATA PLAB /3*0./ * * CALL GSVERT(VERTEX,0,0,0,0,NVERT) * * JPA = LQ(JPART-IKINE) XMASS = Q(JPA+7) PLAB(1) = SQRT(PKINE(1)*(PKINE(1)+2*XMASS)) * CALL GSKINE(PLAB,IKINE,NVERT,0,0,NT) * * *** Kinematics debug IF (IEVENT.EQ.1.OR.IDEBUG.NE.0) CALL GPRINT('KINE',0) * END +DECK,GUTREV SUBROUTINE GUTREV * * User routine to control tracking of one event * Called by GRUN * +SEQ,CELOSS * ETOT = 0. * CALL GTREVE * END +DECK,GUTRAK SUBROUTINE GUTRAK * * User routine to control tracking of one track * Called by GTREVE * +SEQ,GCKINE. +SEQ,GCTRAK. +SEQ,CELOSS. * * * *** initialisation track per track NSTRK0 = 0 NSTRK1 = 0 * CALL GTRACK * * *** count nb of tracks IF (CHARGE.NE.0.) THEN NTRAK1 = NTRAK1 + 1 CALL HFILL (1,SLENG*10,0.,1.) CALL HFILL (2,REAL(NSTRK1),0.,1.) ELSE NTRAK0 = NTRAK0 + 1 ENDIF * END +DECK,GUSTEP SUBROUTINE GUSTEP * * User routine called at the end of each tracking step * +SEQ,GCFLAG. +SEQ,GCKINE,GCKING,GCTRAK. +SEQ,CELOSS. * * * *** Debug event and store tracks for drawing IF (IDEBUG.NE.0) CALL GPCXYZ IF ((ISWIT(1).EQ.1).AND.(CHARGE.NE.0.)) CALL GSXYZ IF (ISWIT(1).EQ.2) CALL GSXYZ * * *** Something generated ? IF(NGKINE.GT.0) CALL GSKING(0) * * *** Energy deposited ETOT = ETOT + DESTEP * * *** count number of steps IF (CHARGE.NE.0.) THEN NSTEP1 = NSTEP1 + 1 NSTRK1 = NSTRK1 + 1 CALL HFILL (3,STEP*10,0.,1.) ELSE NSTEP0 = NSTEP0 + 1 NSTRK0 = NSTRK0 + 1 ENDIF * * *** count nb of invoked processes IF (NMEC.GT.0) THEN DO IM = 1,NMEC IPROC = LMEC(IM) IF (IPROC.EQ.21) IPROC = 12 IF (IPROC.LE.12) NBCALL(IPROC) = NBCALL(IPROC)+1 ENDDO ENDIF END +DECK,GUOUT SUBROUTINE GUOUT * * User routine called at the end of each event * +SEQ,GCFLAG. +SEQ,CELOSS. * CHARACTER*4 unit * * *** drawing * +self,if=-batch. IF (ISWIT(1).NE.0) THEN CALL GDHEAD (110110,'TestEm1',0.) CALL GDSHOW (3) CALL GDXYZ (0) END IF +self. * * energy deposited * CALL GEVKEV (ETOT,ETunit,unit) IF (ISWIT(1).NE.0) PRINT 750,ETunit,unit * 750 FORMAT(1X,'Energy deposit: ',F8.3,A4) * END +DECK,UGLAST SUBROUTINE UGLAST * * Termination routine to print histograms and statistics * +SEQ,GCFLAG. +SEQ,GCTRAK. +SEQ,CELOSS. * * *** nb of steps and tracks per event TOTEVT = IEVENT FNTRK0 = NTRAK0/TOTEVT FNTRK1 = NTRAK1/TOTEVT FNSTP0 = NSTEP0/TOTEVT FNSTP1 = NSTEP1/TOTEVT PRINT 750, FNTRK0,FNTRK1,FNSTP0,FNSTP1 * * *** frequency of processes call CALL UCTOH('MUNU',NAMEC(12),4,4) PRINT 760,(NAMEC(I),I=1,12) PRINT 761,(NBCALL(I)/TOTEVT,I=1,12) * * *** geant termination CALL GLAST * * *** print selected histo * * *** close HIGZ file CALL HPLEND * * *** Save selected histograms IF (ISWIT(2).EQ.1) THEN CALL HRPUT(0,'testem1.histo','N') ENDIF * * *** formats 750 FORMAT(//,1X,'nb tracks/event neutral: ',F9.2,' charged: ',F9.2, + /,1X,'nb steps/event neutral: ',F9.2,' charged: ',F9.2) 760 FORMAT(//,1X,'nb of process calls per event: ', + /,3X,12A9) 761 FORMAT( 3X,12F9.2,//) * END +DECK,ffread,T=data. LIST CALOR 5 (Imat) 2000. (size) 0. (field) TRIG 100 KINE 3 (Itype) 0.100 (Ekine) DEBUG 10 5 1000 SWIT 0 (draw) 0 (save) CUTS 10.e-6 (cutgam) 10.e-6 (cutele) 3*10.e-3 (cutneu/had/muo) 2*10.e-6 (bcute/m) 2*10.e-6 (dcute/m) 10.e-3 (ppcutm) ABAN 0 LOSS 1 TIME 2=1. +QUIT.