source: trunk/examples/extended/electromagnetic/TestEm3/geant3/src/uginit.F@ 1230

Last change on this file since 1230 was 807, checked in by garnier, 17 years ago

update

File size: 3.1 KB
Line 
1
2 SUBROUTINE UGINIT
3*
4* To initialise GEANT/USER program and read data cards
5*
6#include "calor.inc"
7#include "celoss.inc"
8#include "histo.inc"
9#include "geant321/gckine.inc"
10#include "geant321/gcbank.inc"
11*
12 CHARACTER*20 filnam
13*
14* *** Define the GEANT parameters
15 CALL GINIT
16*
17* *** default values for histo
18 do ih = 1,MaxHist
19 histo(ih) = .false.
20 enddo
21*
22* *** Calor definition
23 CALL FFKEY('CALOR',NbAbsor,4,'MIXED')
24 CALL FFKEY('MATE' ,materAbs(1),MaxAbs,'INTEGER')
25 CALL FFKEY('THICK',thickAbs(1),MaxAbs,'REAL')
26* *** production cuts (bcute, dcute and ppcutm) for each absorber
27 CALL FFKEY('CUTPR',prodcut(1) ,4*MaxAbs,'REAL')
28* *** histograms
29 CALL FFKEY('HISTO',idhist,5,'MIXED')
30* *** max allowed step size
31 CALL FFKEY('STEPMX',stepmax,1,'REAL')
32*
33* *** read data cards
34 PRINT *, 'G3 > gives the filename of the data cards to be read:'
35 READ (*,'(A)') filnam
36 IF (filnam.EQ.' ') filnam = 'run01.dat'
37 OPEN (unit=5,file=filnam,status='unknown',form='formatted')
38*
39* fileName for histograms, must be 1st data card !
40 fileName = 'testem3.paw'
41 READ(5,98)key,spaces,fileName
4298 FORMAT(A4,A2,A25)
43
44 CALL GFFGO
45*
46* *** check size of arrays
47 if (NbAbsor.gt.MaxAbs) then
48 write (6,51) NbAbsor, MaxAbs
49 NbAbsor = MaxAbs
50 endif
51 if (NbLayer.gt.MaxLay) then
52 write (6,52) NbLayer, MaxLay
53 NbLayer = MaxLay
54 endif
5551 FORMAT (/,5x,'warning (uginit): NbAbsor= ',I2,' truncated to ',I2)
5652 FORMAT (/,5x,'warning (uginit): NbLayer= ',I3,' truncated to ',I3)
57
58 write(6,99) fileName
5999 FORMAT(/,15x,'histogram file --> Name: ',A25)
60
61 CALL GZINIT
62 CALL GPART
63 CALL GPIONS
64*
65* *** overwrite ITRTYP for ion C12
66 JPA = LQ(JPART-67)
67 Q(JPA+6) = 8.0
68*
69 CALL GDINIT
70*
71* *** Geometry and materials description
72 CALL UGEOM
73*
74* *** Energy loss and cross-sections initialisations
75 CALL GPHYSI
76*
77 CALL GPRINT('MATE',0)
78 CALL GPRINT('TMED',0)
79 CALL GPRINT('VOLU',0)
80*
81* *** some initialisation
82 do k=1,MaxAbs
83 sumEdep(k) = 0.
84 sumTrck(k) = 0.
85 su2Edep(k) = 0.
86 su2Trck(k) = 0.
87 enddo
88*
89 do k=1,MaxPlanes
90 EnerFlow(k) = 0.
91 EleakLat(k) = 0.
92 enddo
93*
94 END
Note: See TracBrowser for help on using the repository browser.