source: trunk/MagicSoft/Simulation/Corsika/Mmcs/cghini.f@ 19094

Last change on this file since 19094 was 286, checked in by harald, 25 years ago
This is the start point for further developments of the Magic Monte Carlo Simulation written by Jose Carlos Gonzales. Now it is under control of one CVS repository for the whole collaboration. Everyone should use this CVS repository for further developments.
File size: 7.7 KB
Line 
1 SUBROUTINE CGHINI
2
3C-----------------------------------------------------------------------
4C C(ORSIKA) GH(EISHA) INI(TIALISATION)
5C INITIALIZATION OF RELEVANT GHEISHA VARIABLES
6C THIS SUBROUTINE IS CALLED FROM START
7C
8C ORIGIN : GHEISHA ROUTINE "GHEINI", F.CARMINATI
9C REDESIGN: P. GABRIEL IK1 FZK KARLSRUHE
10C-----------------------------------------------------------------------
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
51C --- GHEISHA COMMONS ---
52C --- 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
73C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS ---
74C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND ---
75 COMMON /LIMITS/ EXPXL,EXPXU
76
77
78C --- "NEVENT" CHANGED TO "KEVENT" IN COMMON /CURPAR/ DUE TO CLASH ---
79C --- 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/
88C-----------------------------------------------------------------------
89
90 IF ( DEBUG ) WRITE(MDEBUG,*) 'CGHINI:'
91
92C --- 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
103C --- SET GHEISHA I/O UNITS TO THE SAME AS FOR CORSIKA --
104 INBCD=MONIIN
105 NEWBCD=MONIOU
106 IF ( DEBUG ) NEWBCD=MDEBUG
107
108C --- INITIALISE ALL GHEISHA PRINT FLAGS AS FALSE ---
109C --- 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
123C --- INITIALISE KGINIT ARRAY ---
124 DO 20 J=1,50
125 KGINIT(J)=0
126 20 CONTINUE
127
128C --- 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
135C --- INITIALIZE PI, 2*PI, PI/2 AND PARTICLE PARAMETERS ---
136 PI=ACOS(-1.0)
137 TWPI=2.0*PI
138 PIBTW=PI/2.0
139C *** GAMMA ***
140 RMASS(1)=PAMA(1)
141 RCHARG(1)=0.0
142C *** NEUTRINO ***
143 RMASS(2)=PAMA(4)
144 RCHARG(2)=0.0
145C *** E+ ***
146 RMASS(3)=PAMA(2)
147 RCHARG(3)=1.0
148C *** E- ***
149 RMASS(4)=PAMA(3)
150 RCHARG(4)=-1.0
151C *** MU+ ***
152 RMASS(5)=PAMA(5)
153 RCHARG(5)=1.0
154C *** MU- ***
155 RMASS(6)=PAMA(6)
156 RCHARG(6)=-1.0
157C *** PI+ ***
158 RMASS(7)=PAMA(8)
159 RCHARG(7)=1.0
160 CT=780.4
161C *** PI0 ***
162 RMASS(8)=PAMA(7)
163 RCHARG(8)=0.0
164C *** PI- ***
165 RMASS(9)=PAMA(9)
166 RCHARG(9)=-1.0
167C *** K+ ***
168 RMASS(10)=PAMA(11)
169 RCHARG(10)=1.0
170 CTKCH=370.9
171C *** K0 SHORT (==> K0) ***
172 RMASS(11)=PAMA(16)
173 RCHARG(11)=0.0
174 CTK0=2.675
175C *** K0 LONG (==> K0 BAR) ***
176 RMASS(12)=-PAMA(10)
177 RCHARG(12)=0.0
178C *** K- ***
179 RMASS(13)=PAMA(12)
180 RCHARG(13)=-1.0
181C *** P ***
182 RMASS(14)=PAMA(14)
183 RCHARG(14)=1.0
184C *** P BAR ***
185 RMASS(15)=-PAMA(15)
186 RCHARG(15)=-1.0
187C *** N ***
188 RMASS(16)=PAMA(13)
189 RCHARG(16)=0.0
190C *** N BAR ***
191 RMASS(17)=-PAMA(25)
192 RCHARG(17)=0.0
193C *** L0 ***
194 RMASS(18)=PAMA(18)
195 RCHARG(18)=0.0
196 CTL0=7.89
197C *** L0 BAR ***
198 RMASS(19)=-PAMA(26)
199 RCHARG(19)=0.0
200C *** S+ ***
201 RMASS(20)=PAMA(19)
202 RCHARG(20)=1.0
203 CTSP=2.40
204C *** S0 ***
205 RMASS(21)=PAMA(20)
206 RCHARG(21)=0.0
207C *** S- ***
208 RMASS(22)=PAMA(21)
209 RCHARG(22)=-1.0
210 CTSM=4.44
211C *** S+ BAR ***
212 RMASS(23)=-PAMA(27)
213 RCHARG(23)=-1.0
214C *** S0 BAR ***
215 RMASS(24)=-PAMA(28)
216 RCHARG(24)=0.0
217C *** S- BAR ***
218 RMASS(25)=-PAMA(29)
219 RCHARG(25)=1.0
220C *** XI0 ***
221 RMASS(26)=PAMA(22)
222 RCHARG(26)=0.0
223 CTX0=8.69
224C *** XI- ***
225 RMASS(27)=PAMA(23)
226 RCHARG(27)=-1.0
227 CTXM=4.92
228C *** XI0 BAR ***
229 RMASS(28)=-PAMA(30)
230 RCHARG(28)=0.0
231 CTX0=8.69
232C *** XI- BAR ***
233 RMASS(29)=-PAMA(31)
234 RCHARG(29)=1.0
235C *** DEUTERON ***
236 RMASS(30)=PAMA(45)
237 RCHARG(30)=1.0
238C *** TRITON ***
239 RMASS(31)=PAMA(46)
240 RCHARG(31)=1.0
241C *** ALPHA ***
242 RMASS(32)=PAMA(47)
243 RCHARG(32)=2.0
244C *** OMEGA- ***
245 RMASS(33)=PAMA(24)
246 RCHARG(33)=-1.0
247C *** OMEGA- BAR ***
248 RMASS(34)=-PAMA(32)
249 RCHARG(34)=1.0
250C *** 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
281C --- 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
Note: See TracBrowser for help on using the repository browser.