lars/geant4
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
103bda00c8680bda1a926bc1a7b4fd8ebc9b2d72
geant4/examples/extended/electromagnetic/TestEm1/geant3/testem1.cra
T
Gabriele Cosmo ca1c8cb059 Import Geant4 1.0.0 source tree
2016-06-08 15:28:20 +02:00

424 lines
20 KiB
Plaintext
Raw Blame History

+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.
Reference in New Issue View Git Blame Copy Permalink