geant3/src/uginit.F

0001
0002       SUBROUTINE UGINIT
0003 *
0004 *     To initialise GEANT/USER  program and read data cards
0005 *
0006 #include "calor.inc"
0007 #include "celoss.inc"
0008 #include "histo.inc"
0009 #include "geant321/gckine.inc"
0010 #include "geant321/gcbank.inc"
0011 *
0012       CHARACTER*20 filnam
0013 *
0014 * *** Define the GEANT parameters
0015       CALL GINIT
0016 *
0017 * *** default values for histo
0018       do ih = 1,MaxHist
0019         histo(ih) = .false.
0020       enddo
0021 *
0022 * *** Calor definition
0023       CALL FFKEY('CALOR',NbAbsor,4,'MIXED')
0024       CALL FFKEY('MATE' ,materAbs(1),MaxAbs,'INTEGER')
0025       CALL FFKEY('THICK',thickAbs(1),MaxAbs,'REAL')
0026 * *** production cuts (bcute, dcute and ppcutm) for each absorber
0027       CALL FFKEY('CUTPR',prodcut(1) ,4*MaxAbs,'REAL')
0028 * *** histograms
0029       CALL FFKEY('HISTO',idhist,5,'MIXED')
0030 * *** max allowed step size
0031       CALL FFKEY('STEPMX',stepmax,1,'REAL')
0032 *
0033 * *** read data cards
0034       PRINT *, 'G3 > gives the filename of the data cards to be read:'
0035       READ (*,'(A)') filnam
0036       IF (filnam.EQ.' ') filnam = 'run01.dat'
0037       OPEN (unit=5,file=filnam,status='unknown',form='formatted')
0038 *
0039 *     fileName for histograms, must be 1st data card !
0040       fileName = 'testem3.paw'
0041       READ(5,98)key,spaces,fileName
0042 98    FORMAT(A4,A2,A25)
0043
0044       CALL GFFGO
0045 *
0046 * *** check size of arrays
0047       if (NbAbsor.gt.MaxAbs) then
0048         write (6,51) NbAbsor, MaxAbs
0049         NbAbsor = MaxAbs
0050       endif
0051       if (NbLayer.gt.MaxLay) then
0052         write (6,52) NbLayer, MaxLay
0053         NbLayer = MaxLay
0054       endif
0055 51    FORMAT (/,5x,'warning (uginit): NbAbsor= ',I2,' truncated to ',I2)
0056 52    FORMAT (/,5x,'warning (uginit): NbLayer= ',I3,' truncated to ',I3)
0057
0058       write(6,99) fileName
0059 99    FORMAT(/,15x,'histogram file --> Name: ',A25)
0060
0061       CALL GZINIT
0062       CALL GPART
0063       CALL GPIONS
0064 *
0065 * *** overwrite ITRTYP for ion C12
0066       JPA = LQ(JPART-67)
0067       Q(JPA+6) = 8.0
0068 *
0069       CALL GDINIT
0070 *
0071 * *** Geometry and materials description
0072       CALL UGEOM
0073 *
0074 * *** Energy loss and cross-sections initialisations
0075       CALL GPHYSI
0076 *
0077       CALL GPRINT('MATE',0)
0078       CALL GPRINT('TMED',0)
0079       CALL GPRINT('VOLU',0)
0080 *
0081 * *** some initialisation
0082       do k=1,MaxAbs
0083         sumEdep(k) = 0.
0084         sumTrck(k) = 0.
0085         su2Edep(k) = 0.
0086         su2Trck(k) = 0.
0087       enddo
0088 *
0089       do k=1,MaxPlanes
0090         EnerFlow(k) = 0.
0091         EleakLat(k) = 0.
0092       enddo
0093 *
0094       END