Import Geant4 8.1.0 source tree
This commit is contained in:
Gabriele Cosmo
@@ -0,0 +1,11 @@
|
||||
|
||||
SUBROUTINE FFUSER(ikey)
|
||||
*
|
||||
* The routine is called when a *key card is read
|
||||
*
|
||||
CHARACTER*4 keyw
|
||||
*
|
||||
call UHTOC(ikey,4,keyw,4)
|
||||
if (keyw.eq.'HIST') call uhinit
|
||||
*
|
||||
END
|
||||
@@ -0,0 +1,267 @@
|
||||
|
||||
SUBROUTINE GTGAMA
|
||||
C.
|
||||
C. ******************************************************************
|
||||
C. * *
|
||||
C. * Photon track. Computes step size and propagates particle *
|
||||
C. * through step. *
|
||||
C. * *
|
||||
C. * ==>Called by : GTRACK *
|
||||
C. * Authors R.Brun, F.Bruyant L.Urban ******** *
|
||||
C. * *
|
||||
C. ******************************************************************
|
||||
C.
|
||||
#include "geant321/gcbank.inc"
|
||||
#include "geant321/gccuts.inc"
|
||||
#include "geant321/gcjloc.inc"
|
||||
#include "geant321/gconsp.inc"
|
||||
#include "geant321/gcphys.inc"
|
||||
#include "geant321/gcstak.inc"
|
||||
#include "geant321/gctmed.inc"
|
||||
#include "geant321/gcmulo.inc"
|
||||
#include "geant321/gctrak.inc"
|
||||
#include "geant321/gcunit.inc"
|
||||
|
||||
PARAMETER (EPSMAC=1.E-6)
|
||||
DOUBLE PRECISION ONE,XCOEF1,XCOEF2,XCOEF3,ZERO
|
||||
|
||||
PARAMETER (ONE=1,ZERO=0)
|
||||
PARAMETER (EPCUT=1.022E-3)
|
||||
C.
|
||||
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
||||
IABAN = NINT(DPHYS1)
|
||||
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
||||
C. ------------------------------------------------------------------
|
||||
*
|
||||
* *** Particle below energy threshold ? Short circuit
|
||||
*
|
||||
*
|
||||
IF (GEKIN.LE.CUTGAM) GOTO 998
|
||||
*
|
||||
* *** Update local pointers if medium has changed
|
||||
*
|
||||
IF(IUPD.EQ.0)THEN
|
||||
IUPD = 1
|
||||
JPHOT = LQ(JMA-6)
|
||||
JCOMP = LQ(JMA-8)
|
||||
JPAIR = LQ(JMA-10)
|
||||
JPFIS = LQ(JMA-12)
|
||||
JRAYL = LQ(JMA-13)
|
||||
ENDIF
|
||||
*
|
||||
* *** Compute current step size
|
||||
*
|
||||
IPROC = 103
|
||||
STEP = STEMAX
|
||||
GEKRT1 = 1 .-GEKRAT
|
||||
*
|
||||
* ** Step limitation due to pair production ?
|
||||
*
|
||||
IF (GETOT.GT.EPCUT) THEN
|
||||
IF (IPAIR.GT.0) THEN
|
||||
STEPPA = GEKRT1*Q(JPAIR+IEKBIN) +GEKRAT*Q(JPAIR+IEKBIN+1)
|
||||
SPAIR = STEPPA*ZINTPA
|
||||
IF (SPAIR.LT.STEP) THEN
|
||||
STEP = SPAIR
|
||||
IPROC = 6
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
*
|
||||
* ** Step limitation due to Compton scattering ?
|
||||
*
|
||||
IF (ICOMP.GT.0) THEN
|
||||
STEPCO = GEKRT1*Q(JCOMP+IEKBIN) +GEKRAT*Q(JCOMP+IEKBIN+1)
|
||||
SCOMP = STEPCO*ZINTCO
|
||||
IF (SCOMP.LT.STEP) THEN
|
||||
STEP = SCOMP
|
||||
IPROC = 7
|
||||
ENDIF
|
||||
ENDIF
|
||||
*
|
||||
* ** Step limitation due to photo-electric effect ?
|
||||
*
|
||||
IF (GEKIN.LT.0.4) THEN
|
||||
IF (IPHOT.GT.0) THEN
|
||||
STEPPH = GEKRT1*Q(JPHOT+IEKBIN) +GEKRAT*Q(JPHOT+IEKBIN+1)
|
||||
SPHOT = STEPPH*ZINTPH
|
||||
IF (SPHOT.LT.STEP) THEN
|
||||
STEP = SPHOT
|
||||
IPROC = 8
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
*
|
||||
* ** Step limitation due to photo-fission ?
|
||||
*
|
||||
IF (JPFIS.GT.0) THEN
|
||||
STEPPF = GEKRT1*Q(JPFIS+IEKBIN) +GEKRAT*Q(JPFIS+IEKBIN+1)
|
||||
SPFIS = STEPPF*ZINTPF
|
||||
IF (SPFIS.LT.STEP) THEN
|
||||
STEP = SPFIS
|
||||
IPROC = 23
|
||||
ENDIF
|
||||
ENDIF
|
||||
*
|
||||
* ** Step limitation due to Rayleigh scattering ?
|
||||
*
|
||||
IF (IRAYL.GT.0) THEN
|
||||
IF (GEKIN.LT.0.01) THEN
|
||||
STEPRA = GEKRT1*Q(JRAYL+IEKBIN) +GEKRAT*Q(JRAYL+IEKBIN+1)
|
||||
SRAYL = STEPRA*ZINTRA
|
||||
IF (SRAYL.LT.STEP) THEN
|
||||
STEP = SRAYL
|
||||
IPROC = 25
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
*
|
||||
IF (STEP.LT.0.) STEP = 0.
|
||||
*
|
||||
* ** Step limitation due to geometry ?
|
||||
*
|
||||
IF (STEP.GE.SAFETY) THEN
|
||||
CALL GTNEXT
|
||||
IF (IGNEXT.NE.0) THEN
|
||||
STEP = SNEXT + PREC
|
||||
INWVOL= 2
|
||||
IPROC = 0
|
||||
NMEC = 1
|
||||
LMEC(1)=1
|
||||
ENDIF
|
||||
*
|
||||
* Update SAFETY in stack companions, if any
|
||||
IF (IQ(JSTAK+3).NE.0) THEN
|
||||
DO 10 IST = IQ(JSTAK+3),IQ(JSTAK+1)
|
||||
JST = JSTAK +3 +(IST-1)*NWSTAK
|
||||
Q(JST+11) = SAFETY
|
||||
10 CONTINUE
|
||||
IQ(JSTAK+3) = 0
|
||||
ENDIF
|
||||
*
|
||||
ELSE
|
||||
IQ(JSTAK+3) = 0
|
||||
ENDIF
|
||||
*
|
||||
* *** Linear transport
|
||||
*
|
||||
IF (INWVOL.EQ.2) THEN
|
||||
DO 20 I = 1,3
|
||||
VECTMP = VECT(I) +STEP*VECT(I+3)
|
||||
IF(VECTMP.EQ.VECT(I)) THEN
|
||||
*
|
||||
* *** Correct for machine precision
|
||||
*
|
||||
IF(VECT(I+3).NE.0.) THEN
|
||||
VECTMP = VECT(I)+ABS(VECT(I))*SIGN(1.,VECT(I+3))*
|
||||
+ EPSMAC
|
||||
IF(NMEC.GT.0) THEN
|
||||
IF(LMEC(NMEC).EQ.104) NMEC=NMEC-1
|
||||
ENDIF
|
||||
NMEC=NMEC+1
|
||||
LMEC(NMEC)=104
|
||||
#ifdef G3DEBUG
|
||||
WRITE(CHMAIL, 10000)
|
||||
CALL GMAIL(0,0)
|
||||
WRITE(CHMAIL, 10100) GEKIN, NUMED, STEP, SNEXT
|
||||
CALL GMAIL(0,0)
|
||||
10000 FORMAT(' Boundary correction in GTGAMA: ',
|
||||
+ ' GEKIN NUMED STEP SNEXT')
|
||||
10100 FORMAT(31X,E10.3,1X,I10,1X,E10.3,1X,E10.3,1X)
|
||||
#endif
|
||||
ENDIF
|
||||
ENDIF
|
||||
VECT(I) = VECTMP
|
||||
20 CONTINUE
|
||||
ELSE
|
||||
DO 30 I = 1,3
|
||||
VECT(I) = VECT(I) +STEP*VECT(I+3)
|
||||
30 CONTINUE
|
||||
ENDIF
|
||||
*
|
||||
SLENG = SLENG +STEP
|
||||
*
|
||||
* *** Update time of flight
|
||||
*
|
||||
TOFG = TOFG +STEP/CLIGHT
|
||||
*
|
||||
* *** Update interaction probabilities
|
||||
*
|
||||
IF (GETOT.GT.EPCUT) THEN
|
||||
IF (IPAIR.GT.0) ZINTPA = ZINTPA -STEP/STEPPA
|
||||
ENDIF
|
||||
IF (ICOMP.GT.0) ZINTCO = ZINTCO -STEP/STEPCO
|
||||
IF (GEKIN.LT.0.4) THEN
|
||||
IF (IPHOT.GT.0) ZINTPH = ZINTPH -STEP/STEPPH
|
||||
ENDIF
|
||||
IF (JPFIS.GT.0) ZINTPF = ZINTPF -STEP/STEPPF
|
||||
IF (IRAYL.GT.0) THEN
|
||||
IF (GEKIN.LT.0.01) ZINTRA = ZINTRA -STEP/STEPRA
|
||||
ENDIF
|
||||
*
|
||||
IF (IPROC.EQ.0) GO TO 999
|
||||
NMEC = 1
|
||||
LMEC(1) = IPROC
|
||||
*
|
||||
* ** Pair production ?
|
||||
*
|
||||
IF (IPROC.EQ.6) THEN
|
||||
CALL GPAIRG
|
||||
*
|
||||
* ** Compton scattering ?
|
||||
*
|
||||
ELSE IF (IPROC.EQ.7) THEN
|
||||
CALL GCOMP
|
||||
*
|
||||
* ** Photo-electric effect ?
|
||||
*
|
||||
ELSE IF (IPROC.EQ.8) THEN
|
||||
*
|
||||
IF ((IABAN.NE.0).AND.(GEKIN.LE.0.001)) THEN
|
||||
* Calculate range of the photoelectron ( with kin. energy Ephot)
|
||||
JCOEF = LQ(JMA-17)
|
||||
IF(GEKRAT.LT.0.7) THEN
|
||||
I1 = MAX(IEKBIN-1,1)
|
||||
ELSE
|
||||
I1 = MIN(IEKBIN,NEKBIN-1)
|
||||
ENDIF
|
||||
I1 = 3*(I1-1)+1
|
||||
XCOEF1 = Q(JCOEF+I1)
|
||||
XCOEF2 = Q(JCOEF+I1+1)
|
||||
XCOEF3 = Q(JCOEF+I1+2)
|
||||
IF(XCOEF1.NE.0.) THEN
|
||||
STOPMX = -XCOEF2+SIGN(ONE,XCOEF1)*SQRT(XCOEF2**2 - (XCOEF3-
|
||||
+ GEKIN/XCOEF1))
|
||||
ELSE
|
||||
STOPMX = - (XCOEF3-GEKIN)/XCOEF2
|
||||
ENDIF
|
||||
*
|
||||
* DO NOT call GPHOT if this (overestimated) range is smaller
|
||||
* than SAFETY
|
||||
*
|
||||
IF (STOPMX.LE.SAFETY) GOTO 998
|
||||
ENDIF
|
||||
|
||||
CALL GPHOT
|
||||
*
|
||||
* ** Rayleigh effect ?
|
||||
*
|
||||
ELSE IF (IPROC.EQ.25) THEN
|
||||
CALL GRAYL
|
||||
*
|
||||
* ** Photo-fission ?
|
||||
*
|
||||
ELSE IF (IPROC.EQ.23) THEN
|
||||
CALL GPFIS
|
||||
*
|
||||
ENDIF
|
||||
*
|
||||
GOTO 999
|
||||
998 DESTEP = GEKIN
|
||||
GEKIN = 0.
|
||||
GETOT = 0.
|
||||
VECT(7)= 0.
|
||||
ISTOP = 2
|
||||
NMEC = 1
|
||||
LMEC(1)= 30
|
||||
999 END
|
||||
@@ -0,0 +1,40 @@
|
||||
|
||||
SUBROUTINE GUKINE
|
||||
*
|
||||
* Generates Kinematics for primary track
|
||||
*
|
||||
* Data card Kine : Itype Ekine
|
||||
*
|
||||
#include "geant321/gcbank.inc"
|
||||
#include "geant321/gcflag.inc"
|
||||
#include "geant321/gckine.inc"
|
||||
*
|
||||
#include "detector.inc"
|
||||
*
|
||||
DIMENSION vertex(3),Plab(3)
|
||||
dimension rndm(2)
|
||||
*
|
||||
DATA vertex/3*0./
|
||||
DATA Plab /3*0./
|
||||
*
|
||||
vertex(1) = -0.5*BoxSize
|
||||
*
|
||||
* random in YZ
|
||||
beam = 0.4*BoxSize
|
||||
call GRNDM (rndm,2)
|
||||
*
|
||||
vertex(2) = (2*rndm(1)-1.)*beam
|
||||
vertex(3) = (2*rndm(2)-1.)*beam
|
||||
*
|
||||
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
|
||||
@@ -0,0 +1,18 @@
|
||||
|
||||
SUBROUTINE GUOUT
|
||||
*
|
||||
* User routine called at the end of each event
|
||||
*
|
||||
#include "geant321/gcflag.inc"
|
||||
*
|
||||
* *** drawing
|
||||
*
|
||||
#ifndef batch
|
||||
IF (ISWIT(1).NE.0) THEN
|
||||
CALL GDHEAD (110110,'TestEm14',0.)
|
||||
CALL GDSHOW (3)
|
||||
CALL GDXYZ (0)
|
||||
END IF
|
||||
#endif
|
||||
*
|
||||
END
|
||||
@@ -0,0 +1,68 @@
|
||||
|
||||
SUBROUTINE GUSTEP
|
||||
*
|
||||
* User routine called at the end of each tracking step
|
||||
*
|
||||
#include "geant321/gcflag.inc"
|
||||
#include "geant321/gckine.inc"
|
||||
#include "geant321/gcking.inc"
|
||||
#include "geant321/gctrak.inc"
|
||||
*
|
||||
#include "process.inc"
|
||||
#include "histo.inc"
|
||||
*
|
||||
character*20 cdum
|
||||
*
|
||||
* *** Debug event and store tracks for drawing
|
||||
IF (IDEBUG.NE.0) CALL GPCXYZ
|
||||
IF (IDEBUG.NE.0) CALL GPGKIN
|
||||
IF ((ISWIT(1).EQ.1).AND.(CHARGE.NE.0.)) CALL GSXYZ
|
||||
IF (ISWIT(1).EQ.2) CALL GSXYZ
|
||||
*
|
||||
* *** if no process: return
|
||||
IF (NMEC.EQ.0) return
|
||||
*
|
||||
* *** count nb of invoked processes
|
||||
DO IM = 1,NMEC
|
||||
IPROC = LMEC(IM)
|
||||
IF (IPROC.EQ.21) IPROC = 12
|
||||
IF (IPROC.LE.12) NBCALL(IPROC) = NBCALL(IPROC)+1
|
||||
ENDDO
|
||||
*
|
||||
* *** sum track length for discrete processes
|
||||
if ((iproc.gt.5)) then
|
||||
nbTot = nbTot + 1
|
||||
sumTrak = sumTrak + sleng
|
||||
sumTrak2 = sumTrak2 + sleng*sleng
|
||||
endif
|
||||
*
|
||||
* *** plot final state
|
||||
*
|
||||
* scattered primary particle (if still alive)
|
||||
if (istop.eq.0) then
|
||||
id = 1
|
||||
if (histo(id)) call hfill (id,gekin/histUnit(id),0.,1.)
|
||||
id = 2
|
||||
if (histo(id)) call hfill (id,vect(4),0.,1.)
|
||||
endif
|
||||
*
|
||||
* *** secondaries
|
||||
if (ngkine.gt.0) then
|
||||
do lp = 1,ngkine
|
||||
ipar = gkin(5,lp) + 0.1
|
||||
call gfpart(ipar,cdum,ndum,gmass,gcharg,dum,dum,ndum)
|
||||
ekin = gkin(4,lp) - gmass
|
||||
pc = sqrt(gkin(1,lp)**2 + gkin(2,lp)**2 + gkin(3,lp)**2)
|
||||
cost = gkin(1,lp)/pc
|
||||
if (gcharg.ne.0.) id = 3
|
||||
if (gcharg.eq.0.) id = 5
|
||||
if (histo(id)) call hfill (id,ekin/histUnit(id),0.,1.)
|
||||
id = id + 1
|
||||
if (histo(id)) call hfill (id,cost,0.,1.)
|
||||
enddo
|
||||
endif
|
||||
*
|
||||
* *** stop the tracking
|
||||
istop = 1
|
||||
*
|
||||
END
|
||||
@@ -0,0 +1,61 @@
|
||||
#ifdef 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
|
||||
|
||||
#else
|
||||
|
||||
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
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,74 @@
|
||||
|
||||
SUBROUTINE UGEOM
|
||||
*
|
||||
* *** Define user geometry set up
|
||||
*
|
||||
*
|
||||
#include "detector.inc"
|
||||
*
|
||||
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,'Tungsten' ,183.85, 74., 19.30 , 0.35, 18.5, 0,0)
|
||||
CALL GSMATE( 8,'Lead' ,207.19, 82., 11.35 , 0.56, 18.5, 0,0)
|
||||
CALL GSMATE( 9,'Uranium' ,238.03, 92., 18.95 , 0.32, 12. , 0,0)
|
||||
CALL GSMATE(10,'Germanium', 72.61, 32., 5.323 , 2.30, 16.6, 0,0)
|
||||
*
|
||||
* *** Defines USER tracking media parameters
|
||||
IFIELD = 0
|
||||
FIELDM = 0.
|
||||
TMAXFD = 10.0
|
||||
STEMAX = 1000.
|
||||
DEEMAX = 1.
|
||||
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 = 0.1*BoxSize
|
||||
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
|
||||
@@ -0,0 +1,67 @@
|
||||
|
||||
SUBROUTINE UGINIT
|
||||
*
|
||||
* To initialise GEANT/USER program and read data cards
|
||||
*
|
||||
#include "detector.inc"
|
||||
#include "process.inc"
|
||||
#include "histo.inc"
|
||||
*
|
||||
CHARACTER*20 filnam
|
||||
CHARACTER*4 key
|
||||
CHARACTER*2 spaces
|
||||
*
|
||||
* *** Define the GEANT parameters
|
||||
CALL GINIT
|
||||
*
|
||||
* histograms
|
||||
do ih = 1,MaxHist
|
||||
histo(ih) = .false.
|
||||
enddo
|
||||
*
|
||||
* *** Detector definition
|
||||
CALL FFKEY('DETECTOR',Imat,2,'MIXED')
|
||||
*
|
||||
* histograms
|
||||
CALL FFKEY('HISTO',idhist,5,'MIXED')
|
||||
*
|
||||
* *** read data cards
|
||||
PRINT *, 'G3 > gives the filename of the data cards to be read:'
|
||||
READ (*,'(A)') filnam
|
||||
IF (filnam.EQ.' ') filnam = 'allprocesses.dat'
|
||||
OPEN (unit=5,file=filnam,status='unknown',form='formatted')
|
||||
*
|
||||
* filename should be 1st data card !
|
||||
fileName = 'photonprocesses.paw'
|
||||
READ(5,98)key,spaces,fileName
|
||||
98 FORMAT(A4,A2,A25)
|
||||
*
|
||||
* *** read data cards
|
||||
CALL GFFGO
|
||||
*
|
||||
write(6,99) fileName
|
||||
99 FORMAT(/,15x,'histogram file --> Name: ',A25)
|
||||
*
|
||||
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)
|
||||
*
|
||||
* *** initialisation of /process/
|
||||
|
||||
CALL VZERO (nbCall,12)
|
||||
nbTot = 0
|
||||
sumTrak = 0.
|
||||
sumTrak2 = 0.
|
||||
*
|
||||
END
|
||||
@@ -0,0 +1,62 @@
|
||||
|
||||
SUBROUTINE UGLAST
|
||||
*
|
||||
* Termination routine to print histograms and statistics
|
||||
*
|
||||
#include "geant321/gcflag.inc"
|
||||
#include "geant321/gckine.inc"
|
||||
#include "geant321/gctrak.inc"
|
||||
*
|
||||
#include "detector.inc"
|
||||
#include "process.inc"
|
||||
#include "histo.inc"
|
||||
*
|
||||
character*20 material, particle
|
||||
character*4 unit
|
||||
real massMFP, massAC
|
||||
*
|
||||
* *** run conditions
|
||||
call gfmate(Imat,material,dum,dum,density,dum,dum,dum,ndum)
|
||||
call gfpart(Ikine,particle,ndum,dum,dum,dum,dum,ndum)
|
||||
call gevkev(pkine(1),energy,unit)
|
||||
PRINT 750, ievent,particle,energy,unit,boxSize,material,density
|
||||
*
|
||||
* *** frequency of processes call
|
||||
CALL UCTOH('MUNU',NAMEC(12),4,4)
|
||||
PRINT 760,(NAMEC(I),I=1,12)
|
||||
PRINT 761,(NBCALL(I),I=1,12)
|
||||
*
|
||||
* *** compute mean free path and related quantities
|
||||
avTrak = sumTrak /nbTot
|
||||
avTrak2 = sumTrak2/nbTot
|
||||
rms = sqrt(abs(avTrak2 - avTrak*avTrak))
|
||||
AtteCoef = 1./avTrak
|
||||
*
|
||||
massMFP = avTrak*density
|
||||
massAC = 1./massMFP
|
||||
print 770, avTrak,rms,massMFP,AtteCoef,massAC
|
||||
*
|
||||
* *** geant termination
|
||||
CALL GLAST
|
||||
*
|
||||
* *** close HIGZ file
|
||||
CALL HPLEND
|
||||
*
|
||||
* *** histograms
|
||||
CALL HRPUT(0,fileName,'N')
|
||||
*
|
||||
* *** formats
|
||||
*
|
||||
750 FORMAT(/,1X,'The run consists of ',I7,1X,A8,' of ',F7.2,A4,
|
||||
+ ' throught',F10.2,' cm of ',A8,' (density: ',F7.3,' g/cm3)')
|
||||
|
||||
760 FORMAT(/,1X,'Frequency of process calls: ',
|
||||
+ /,1X,12A8)
|
||||
761 FORMAT( 1X,12I8,/)
|
||||
|
||||
770 FORMAT(/,1X,'MeanFreePath:',F12.5,' cm +- ',F12.5,' cm',
|
||||
+ 5X,'massic:',F12.5,' g/cm2',
|
||||
+ /,1X,'CrossSection:',F12.5,' cm^-1 ',15X,
|
||||
+ 5X,'massic:',F12.5,' cm2/g',/)
|
||||
*
|
||||
END
|
||||
@@ -0,0 +1,28 @@
|
||||
|
||||
SUBROUTINE UHINIT
|
||||
*
|
||||
*
|
||||
#include "histo.inc"
|
||||
*
|
||||
CHARACTER*50 title(6)
|
||||
*
|
||||
data title /
|
||||
1 'scattered primary particle: energy spectrum',
|
||||
2 'scattered primary particle: costheta distribution',
|
||||
3 'charged secondaries: energy spectrum',
|
||||
4 'charged secondaries: costheta distribution',
|
||||
5 'neutral secondaries: energy spectrum',
|
||||
6 'neutral secondaries: costheta distribution' /
|
||||
*
|
||||
if (histo(idhist)) call hdelet(idhist)
|
||||
*
|
||||
vmin = valmin
|
||||
vmax = valmax
|
||||
call hbook1(idhist,title(idhist),nbBins,vmin,vmax,0.)
|
||||
*
|
||||
histo (idhist) = .true.
|
||||
binWidth(idhist) = (valmax-valmin)/nbBins
|
||||
if (valunit.le.0.) valunit = 1.
|
||||
histUnit(idhist) = valunit
|
||||
*
|
||||
END
|
||||
Reference in New Issue
Block a user