1 | SUBROUTINE CGHINI
|
---|
2 |
|
---|
3 | C-----------------------------------------------------------------------
|
---|
4 | C C(ORSIKA) GH(EISHA) INI(TIALISATION)
|
---|
5 | C INITIALIZATION OF RELEVANT GHEISHA VARIABLES
|
---|
6 | C THIS SUBROUTINE IS CALLED FROM START
|
---|
7 | C
|
---|
8 | C ORIGIN : GHEISHA ROUTINE "GHEINI", F.CARMINATI
|
---|
9 | C REDESIGN: P. GABRIEL IK1 FZK KARLSRUHE
|
---|
10 | C-----------------------------------------------------------------------
|
---|
11 |
|
---|
12 | *KEEP,AIR.
|
---|
13 | COMMON /AIR/ COMPOS,PROBTA,AVERAW,AVOGAD
|
---|
14 | DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
|
---|
15 | *KEEP,CGCOMP.
|
---|
16 | PARAMETER (KK=3)
|
---|
17 | COMMON/CGCOMP/ ACOMP,ZCOMP,WCOMP
|
---|
18 | REAL ACOMP(KK),ZCOMP(KK),WCOMP(KK)
|
---|
19 | *KEEP,PAM.
|
---|
20 | COMMON /PAM/ PAMA,SIGNUM
|
---|
21 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
---|
22 | *KEEP,RUNPAR.
|
---|
23 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
---|
24 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
---|
25 | * MONIOU,MDEBUG,NUCNUC,
|
---|
26 | * CETAPE,
|
---|
27 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
---|
28 | * N1STTR,MDBASE,
|
---|
29 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
---|
30 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
---|
31 | * ,GHEISH,GHESIG
|
---|
32 | COMMON /RUNPAC/ DSN,HOST,USER
|
---|
33 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
---|
34 | REAL STEPFC
|
---|
35 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
---|
36 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
---|
37 | * N1STTR,MDBASE
|
---|
38 | INTEGER CETAPE
|
---|
39 | CHARACTER*79 DSN
|
---|
40 | CHARACTER*20 HOST,USER
|
---|
41 |
|
---|
42 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
---|
43 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
---|
44 | * ,GHEISH,GHESIG
|
---|
45 | *KEND.
|
---|
46 |
|
---|
47 | COMMON/GSECTI/ AIEL(20),AIIN(20),AIFI(20),AICA(20),ALAM,K0FLAG
|
---|
48 | INTEGER K0FLAG
|
---|
49 | REAL AIEL,AIIN,AIFI,AICA,ALAM
|
---|
50 |
|
---|
51 | C --- GHEISHA COMMONS ---
|
---|
52 | C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES ---
|
---|
53 | COMMON /KGINIT/ KGINIT(50)
|
---|
54 |
|
---|
55 | COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI,
|
---|
56 | $ SMU,CT,CTKCH,CTK0,
|
---|
57 | $ ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM,
|
---|
58 | $ RMASS(35),RCHARG(35)
|
---|
59 |
|
---|
60 | REAL MP,MPI,MMU,MEL,MKCH,MK0,
|
---|
61 | * ML0,MSP,MS0,MSM,MX0,MXM
|
---|
62 |
|
---|
63 | PARAMETER (MXGKGH=100)
|
---|
64 | PARAMETER (MXEVEN=12*MXGKGH)
|
---|
65 | COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN)
|
---|
66 |
|
---|
67 | COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10)
|
---|
68 | LOGICAL LPRT,NPRT
|
---|
69 |
|
---|
70 | PARAMETER (MXGKPV=MXGKGH)
|
---|
71 | COMMON /VECUTY/ PV(10,MXGKPV)
|
---|
72 |
|
---|
73 | C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
|
---|
74 | C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
|
---|
75 | COMMON /LIMITS/ EXPXL,EXPXU
|
---|
76 |
|
---|
77 |
|
---|
78 | C --- "NEVENT" CHANGED TO "KEVENT" IN COMMON /CURPAR/ DUE TO CLASH ---
|
---|
79 | C --- WITH VARIABLE "NEVENT" IN GEANT COMMON ---
|
---|
80 |
|
---|
81 | PARAMETER (MXGKCU=MXGKGH)
|
---|
82 | COMMON /CURPAR/ WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,KEVENT,SHFLAG,
|
---|
83 | $ ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
|
---|
84 | $ RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
|
---|
85 | $ ATNO2,ZNO2
|
---|
86 |
|
---|
87 | DATA CLIGHT /2.99792458E10/
|
---|
88 | C-----------------------------------------------------------------------
|
---|
89 |
|
---|
90 | IF ( DEBUG ) WRITE(MDEBUG,*) 'CGHINI:'
|
---|
91 |
|
---|
92 | C --- INITIALZE COMPOSITION OF AIR
|
---|
93 | WCOMP(1) = COMPOS(1)
|
---|
94 | WCOMP(2) = COMPOS(2)
|
---|
95 | WCOMP(3) = COMPOS(3)
|
---|
96 | ACOMP(1) = 14.
|
---|
97 | ACOMP(2) = 16.
|
---|
98 | ACOMP(3) = 40.
|
---|
99 | ZCOMP(1) = 7.
|
---|
100 | ZCOMP(2) = 8.
|
---|
101 | ZCOMP(3) = 18.
|
---|
102 |
|
---|
103 | C --- SET GHEISHA I/O UNITS TO THE SAME AS FOR CORSIKA --
|
---|
104 | INBCD=MONIIN
|
---|
105 | NEWBCD=MONIOU
|
---|
106 | IF ( DEBUG ) NEWBCD=MDEBUG
|
---|
107 |
|
---|
108 | C --- INITIALISE ALL GHEISHA PRINT FLAGS AS FALSE ---
|
---|
109 | C --- ACTIVATION IS DONE BY "DEBUG" STEERING CARD ---
|
---|
110 | DO 11 J=1,10
|
---|
111 | NPRT(J)=.FALSE.
|
---|
112 | 11 CONTINUE
|
---|
113 | IF ( DEBUG ) THEN
|
---|
114 | NPRT(4)=.TRUE.
|
---|
115 | NPRT(9)=.TRUE.
|
---|
116 | ENDIF
|
---|
117 | LPRT=.FALSE.
|
---|
118 | DO 12 I=1,MXGKPV
|
---|
119 | DO 12 J=1,10
|
---|
120 | PV(J,I)=0.
|
---|
121 | 12 CONTINUE
|
---|
122 |
|
---|
123 | C --- INITIALISE KGINIT ARRAY ---
|
---|
124 | DO 20 J=1,50
|
---|
125 | KGINIT(J)=0
|
---|
126 | 20 CONTINUE
|
---|
127 |
|
---|
128 | C --- INITIALIZE SOME CUT-OFF PARAMETERS WITH GEANT VALUES ---
|
---|
129 | TOFCUT=1.0E+20
|
---|
130 | NSIZE=MXEVEN
|
---|
131 | K0FLAG=0
|
---|
132 | CENG(3)=0.
|
---|
133 | CENG(4)=0.
|
---|
134 |
|
---|
135 | C --- INITIALIZE PI, 2*PI, PI/2 AND PARTICLE PARAMETERS ---
|
---|
136 | PI=ACOS(-1.0)
|
---|
137 | TWPI=2.0*PI
|
---|
138 | PIBTW=PI/2.0
|
---|
139 | C *** GAMMA ***
|
---|
140 | RMASS(1)=PAMA(1)
|
---|
141 | RCHARG(1)=0.0
|
---|
142 | C *** NEUTRINO ***
|
---|
143 | RMASS(2)=PAMA(4)
|
---|
144 | RCHARG(2)=0.0
|
---|
145 | C *** E+ ***
|
---|
146 | RMASS(3)=PAMA(2)
|
---|
147 | RCHARG(3)=1.0
|
---|
148 | C *** E- ***
|
---|
149 | RMASS(4)=PAMA(3)
|
---|
150 | RCHARG(4)=-1.0
|
---|
151 | C *** MU+ ***
|
---|
152 | RMASS(5)=PAMA(5)
|
---|
153 | RCHARG(5)=1.0
|
---|
154 | C *** MU- ***
|
---|
155 | RMASS(6)=PAMA(6)
|
---|
156 | RCHARG(6)=-1.0
|
---|
157 | C *** PI+ ***
|
---|
158 | RMASS(7)=PAMA(8)
|
---|
159 | RCHARG(7)=1.0
|
---|
160 | CT=780.4
|
---|
161 | C *** PI0 ***
|
---|
162 | RMASS(8)=PAMA(7)
|
---|
163 | RCHARG(8)=0.0
|
---|
164 | C *** PI- ***
|
---|
165 | RMASS(9)=PAMA(9)
|
---|
166 | RCHARG(9)=-1.0
|
---|
167 | C *** K+ ***
|
---|
168 | RMASS(10)=PAMA(11)
|
---|
169 | RCHARG(10)=1.0
|
---|
170 | CTKCH=370.9
|
---|
171 | C *** K0 SHORT (==> K0) ***
|
---|
172 | RMASS(11)=PAMA(16)
|
---|
173 | RCHARG(11)=0.0
|
---|
174 | CTK0=2.675
|
---|
175 | C *** K0 LONG (==> K0 BAR) ***
|
---|
176 | RMASS(12)=-PAMA(10)
|
---|
177 | RCHARG(12)=0.0
|
---|
178 | C *** K- ***
|
---|
179 | RMASS(13)=PAMA(12)
|
---|
180 | RCHARG(13)=-1.0
|
---|
181 | C *** P ***
|
---|
182 | RMASS(14)=PAMA(14)
|
---|
183 | RCHARG(14)=1.0
|
---|
184 | C *** P BAR ***
|
---|
185 | RMASS(15)=-PAMA(15)
|
---|
186 | RCHARG(15)=-1.0
|
---|
187 | C *** N ***
|
---|
188 | RMASS(16)=PAMA(13)
|
---|
189 | RCHARG(16)=0.0
|
---|
190 | C *** N BAR ***
|
---|
191 | RMASS(17)=-PAMA(25)
|
---|
192 | RCHARG(17)=0.0
|
---|
193 | C *** L0 ***
|
---|
194 | RMASS(18)=PAMA(18)
|
---|
195 | RCHARG(18)=0.0
|
---|
196 | CTL0=7.89
|
---|
197 | C *** L0 BAR ***
|
---|
198 | RMASS(19)=-PAMA(26)
|
---|
199 | RCHARG(19)=0.0
|
---|
200 | C *** S+ ***
|
---|
201 | RMASS(20)=PAMA(19)
|
---|
202 | RCHARG(20)=1.0
|
---|
203 | CTSP=2.40
|
---|
204 | C *** S0 ***
|
---|
205 | RMASS(21)=PAMA(20)
|
---|
206 | RCHARG(21)=0.0
|
---|
207 | C *** S- ***
|
---|
208 | RMASS(22)=PAMA(21)
|
---|
209 | RCHARG(22)=-1.0
|
---|
210 | CTSM=4.44
|
---|
211 | C *** S+ BAR ***
|
---|
212 | RMASS(23)=-PAMA(27)
|
---|
213 | RCHARG(23)=-1.0
|
---|
214 | C *** S0 BAR ***
|
---|
215 | RMASS(24)=-PAMA(28)
|
---|
216 | RCHARG(24)=0.0
|
---|
217 | C *** S- BAR ***
|
---|
218 | RMASS(25)=-PAMA(29)
|
---|
219 | RCHARG(25)=1.0
|
---|
220 | C *** XI0 ***
|
---|
221 | RMASS(26)=PAMA(22)
|
---|
222 | RCHARG(26)=0.0
|
---|
223 | CTX0=8.69
|
---|
224 | C *** XI- ***
|
---|
225 | RMASS(27)=PAMA(23)
|
---|
226 | RCHARG(27)=-1.0
|
---|
227 | CTXM=4.92
|
---|
228 | C *** XI0 BAR ***
|
---|
229 | RMASS(28)=-PAMA(30)
|
---|
230 | RCHARG(28)=0.0
|
---|
231 | CTX0=8.69
|
---|
232 | C *** XI- BAR ***
|
---|
233 | RMASS(29)=-PAMA(31)
|
---|
234 | RCHARG(29)=1.0
|
---|
235 | C *** DEUTERON ***
|
---|
236 | RMASS(30)=PAMA(45)
|
---|
237 | RCHARG(30)=1.0
|
---|
238 | C *** TRITON ***
|
---|
239 | RMASS(31)=PAMA(46)
|
---|
240 | RCHARG(31)=1.0
|
---|
241 | C *** ALPHA ***
|
---|
242 | RMASS(32)=PAMA(47)
|
---|
243 | RCHARG(32)=2.0
|
---|
244 | C *** OMEGA- ***
|
---|
245 | RMASS(33)=PAMA(24)
|
---|
246 | RCHARG(33)=-1.0
|
---|
247 | C *** OMEGA- BAR ***
|
---|
248 | RMASS(34)=-PAMA(32)
|
---|
249 | RCHARG(34)=1.0
|
---|
250 | C *** NEW PARTICLE (GEANTINO) ***
|
---|
251 | RMASS(35)=0.0
|
---|
252 | RCHARG(35)=0.0
|
---|
253 |
|
---|
254 | IF (NPRT(9))
|
---|
255 | $ WRITE(MDEBUG,1000) (I,RMASS(I),RCHARG(I),I=1,33),
|
---|
256 | $ CT,CTKCH,CTK0,CTL0,CTSP,CTSM,CTX0,CTXM
|
---|
257 | 1000 FORMAT(' *CGHINI* === GHEISHA PARTICLE PROPERTIES ==='/
|
---|
258 | $ '0INDEX',5X,'MASS (GEV)',5X,'CHARGE'/1H /
|
---|
259 | $ 33(1H ,1X,I3,5X,F11.6,6X,F5.2/),
|
---|
260 | $ '0PI +- CT = ',G12.5,' K +- CT = ',G12.5/
|
---|
261 | $ ' K0 CT = ',G12.5,' L0 CT = ',G12.5/
|
---|
262 | $ ' S+ CT = ',G12.5,' S- CT = ',G12.5/
|
---|
263 | $ ' X0 CT = ',G12.5,' X- CT = ',G12.5)
|
---|
264 |
|
---|
265 | MP=RMASS(14)
|
---|
266 | MPI=RMASS(7)
|
---|
267 | MMU=RMASS(5)
|
---|
268 | MEL=RMASS(3)
|
---|
269 | MKCH=RMASS(10)
|
---|
270 | MK0=RMASS(11)
|
---|
271 | SMP=MP**2
|
---|
272 | SMPI=MPI**2
|
---|
273 | SMU=MMU**2
|
---|
274 | ML0=RMASS(18)
|
---|
275 | MSP=RMASS(20)
|
---|
276 | MS0=RMASS(21)
|
---|
277 | MSM=RMASS(22)
|
---|
278 | MX0=RMASS(26)
|
---|
279 | MXM=RMASS(27)
|
---|
280 |
|
---|
281 | C --- LOAD LIMITS FOR INTRINSIC FUNCTION ARGUMENTS ---
|
---|
282 | EXPXL = - 82.0
|
---|
283 | EXPXU = 82.0
|
---|
284 |
|
---|
285 | IF (NPRT(9)) WRITE(MDEBUG,1001) EXPXL,EXPXU
|
---|
286 | 1001 FORMAT(' *GHEINI* === INTRINSIC FUNCTION BOUNDARIES ==='/
|
---|
287 | $ ' EXPXL,EXPXU = ',2(G12.5,1X))
|
---|
288 |
|
---|
289 | RETURN
|
---|
290 | END
|
---|