]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gheisha/caskm.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gheisha / caskm.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:21:00 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.39 by S.Giani
11*-- Author :
12 SUBROUTINE CASKM(K,INT,NFL)
13C
14C *** CASCADE OF K- ***
15C *** NVE 04-MAY-1988 CERN GENEVA ***
16C
17C ORIGIN : H.FESEFELDT (13-SEP-1987)
18C
19C K- UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
20C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
21C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
22C IS DEGRADED IN ENERGY. NO OTHER PARTICLES PRODUCED.
23C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
24C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
25C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
26C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
27C
28#include "geant321/mxgkgh.inc"
29#include "geant321/s_consts.inc"
30#include "geant321/s_curpar.inc"
31#include "geant321/s_result.inc"
32#include "geant321/s_prntfl.inc"
33#include "geant321/s_kginit.inc"
34#include "geant321/limits.inc"
35C
36 REAL N
37 DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),CNK0(20),PIY1(4),
38 $ PIY2(3),IPIY1(2,4),IPIY2(2,3),IPIY3(2,3),B(2)
39 DIMENSION RNDM(1)
40 SAVE PMUL,ANORM
41 DATA CECH/1.,1.,1.,0.70,0.60,0.55,0.35,0.25,0.18,0.15/
42 DATA CNK0/0.17,0.18,0.17,0.24,0.26,0.20,0.22,0.21,0.34,0.45
43 $ ,0.58,0.55,0.36,0.29,0.29,0.32,0.32,0.33,0.33,0.33/
44 DATA PIY1/0.67,0.78,0.89,1.00/,PIY2/0.68,0.84,1.00/
45 DATA IPIY1/8,18,9,20,8,21,7,22/
46 DATA IPIY2/9,18,9,21,8,22/,IPIY3/7,18,8,20,7,21/
47 DATA B/0.7,0.7/,C/1.25/
48C
49C --- INITIALIZATION INDICATED BY KGINIT(4) ---
50 IF (KGINIT(4) .NE. 0) GO TO 10
51 KGINIT(4)=1
52C
53C --- INITIALIZE PMUL AND ANORM ARRAYS ---
54 DO 9000 J=1,1200
55 DO 9001 I=1,2
56 PMUL(I,J)=0.0
57 IF (J .LE. 60) ANORM(I,J)=0.0
58 9001 CONTINUE
59 9000 CONTINUE
60C
61C** COMPUTE NORMALIZATION CONSTANTS
62C** FOR P AS TARGET
63C
64 L=0
65 DO 1 NP1=1,20
66 NP=NP1-1
67 NMM1=NP1-1
68 IF(NMM1.LE.1) NMM1=1
69 NPP1=NP1+1
70 DO 1 NM1=NMM1,NPP1
71 NM=NM1-1
72 DO 1 NZ1=1,20
73 NZ=NZ1-1
74 L=L+1
75 IF(L.GT.1200) GOTO 1
76 NT=NP+NM+NZ
77 IF(NT.LE.0.OR.NT.GT.60) GOTO 1
78 PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
79 ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
80 1 CONTINUE
81C** FOR N AS TARGET
82 L=0
83 DO 2 NP1=1,20
84 NP=NP1-1
85 NPP1=NP1+2
86 DO 2 NM1=NP1,NPP1
87 NM=NM1-1
88 DO 2 NZ1=1,20
89 NZ=NZ1-1
90 L=L+1
91 IF(L.GT.1200) GOTO 2
92 NT=NP+NM+NZ
93 IF(NT.LE.0.OR.NT.GT.60) GOTO 2
94 PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
95 ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
96 2 CONTINUE
97 DO 3 I=1,60
98 IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
99 IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
100 3 CONTINUE
101 IF(.NOT.NPRT(10)) GOTO 10
102 WRITE(NEWBCD,2001)
103 DO 4 NFL=1,2
104 WRITE(NEWBCD,2002) NFL
105 WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
106 WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
107 4 CONTINUE
108C** CHOOSE PROTON OR NEUTRON AS TARGET
109 10 NFL=2
110 CALL GRNDM(RNDM,1)
111 IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
112 TARMAS=RMASS(14)
113 IF (NFL .EQ. 2) TARMAS=RMASS(16)
114 S=AMASQ+TARMAS**2+2.0*TARMAS*EN
115 RS=SQRT(S)
116 ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
117 ENP(9)=SQRT(ENP(8))
118 EAB=RS-TARMAS-RMASS(13)
119C
120C** ELASTIC SCATTERING
121 NP=0
122 NM=0
123 NZ=0
124 N=0.
125 IPA(1)=13
126 IPA(2)=14
127 IF(NFL.EQ.2) IPA(2)=16
128 IF(INT.EQ.2) GOTO 20
129 GOTO 100
130C** CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
131 20 IPLAB=IFIX(P*5.)+1
132 IF(IPLAB.GT.10) GOTO 22
133 CALL GRNDM(RNDM,1)
134 IF(RNDM(1).LT.CECH(IPLAB)) GOTO 19
135 IF (EAB .LT. RMASS(7)) GOTO 55
136 GOTO 22
137C** CHARGE EXCHANGE REACTION (IS INCLUDED IN INELASTIC CROSS SECTION)
138 19 IPLAB=IFIX(P*10.)+1
139 IF(IPLAB.GT.20) IPLAB=20
140 CALL GRNDM(RNDM,1)
141 IF(RNDM(1).GT.CNK0(IPLAB)) GOTO 24
142 IF(NFL.EQ.1) GOTO 23
143C** FOR K- N REACTION NO K N STRANGENESS EXCHANGE POSSIBLE
144 INT=1
145 IPA(1)=13
146 IPA(2)=16
147 GOTO 100
148 23 INT=1
149 IPA(1)=12
150 IPA(2)=16
151 GOTO 100
152C** P L, P S REACTIONS
153 24 CALL GRNDM(RNDM,1)
154 RAN=RNDM(1)
155 IF(RAN.LT.0.25) GOTO 25
156 IF(RAN.LT.0.50) GOTO 26
157 IF(RAN.LT.0.75) GOTO 27
158C** K- P --> PI0 L OR K- N --> PI- L
159 IPA(1)=8
160 IF(NFL.EQ.2) IPA(1)=9
161 IPA(2)=18
162 GOTO 100
163C** K- P --> PI- S+
164 25 IPA(1)=9
165 IPA(2)=20
166 IF(NFL.EQ.1) GOTO 100
167 IPA(1)=13
168 IPA(2)=16
169 GOTO 100
170C** K- P --> PI0 S0 OR K- N --> PI- S0
171 26 IPA(1)=8
172 IF(NFL.EQ.2) IPA(1)=9
173 IPA(2)=21
174 GOTO 100
175C** K- P --> PI+ S- OR K- N --> PI0 S-
176 27 IPA(1)=7
177 IF(NFL.EQ.2) IPA(1)=8
178 IPA(2)=22
179 GOTO 100
180C
181 22 ALEAB=LOG(EAB)
182C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
183 N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
184 * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
185 N=N-2.
186C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION
187 ANPN=0.
188 DO 21 NT=1,60
189 TEST=-(PI/4.0)*(NT/N)**2
190 IF (TEST .LT. EXPXL) TEST=EXPXL
191 IF (TEST .GT. EXPXU) TEST=EXPXU
192 DUM1=PI*NT/(2.0*N*N)
193 DUM2=ABS(DUM1)
194 DUM3=EXP(TEST)
195 ADDNVE=0.0
196 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
197 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
198 ANPN=ANPN+ADDNVE
199 21 CONTINUE
200 ANPN=1./ANPN
201C** P OR N AS TARGET
202 CALL GRNDM(RNDM,1)
203 RAN=RNDM(1)
204 EXCS=0.
205 GOTO (30,40),NFL
206C** FOR P AS TARGET
207 30 L=0
208 DO 31 NP1=1,20
209 NP=NP1-1
210 NMM1=NP1-1
211 IF(NMM1.LE.1) NMM1=1
212 NPP1=NP1+1
213 DO 31 NM1=NMM1,NPP1
214 NM=NM1-1
215 DO 31 NZ1=1,20
216 NZ=NZ1-1
217 L=L+1
218 IF(L.GT.1200) GOTO 31
219 NT=NP+NM+NZ
220 IF(NT.LE.0.OR.NT.GT.60) GOTO 31
221 TEST=-(PI/4.0)*(NT/N)**2
222 IF (TEST .LT. EXPXL) TEST=EXPXL
223 IF (TEST .GT. EXPXU) TEST=EXPXU
224 DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
225 DUM2=ABS(DUM1)
226 DUM3=EXP(TEST)
227 ADDNVE=0.0
228 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
229 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
230 EXCS=EXCS+ADDNVE
231 IF(RAN.LT.EXCS) GOTO 50
232 31 CONTINUE
233 GOTO 80
234C** FOR N AS TARGET
235 40 L=0
236 DO 41 NP1=1,20
237 NP=NP1-1
238 NPP1=NP1+2
239 DO 41 NM1=NP1,NPP1
240 NM=NM1-1
241 DO 41 NZ1=1,20
242 NZ=NZ1-1
243 L=L+1
244 IF(L.GT.1200) GOTO 41
245 NT=NP+NM+NZ
246 IF(NT.LE.0.OR.NT.GT.60) GOTO 41
247 TEST=-(PI/4.0)*(NT/N)**2
248 IF (TEST .LT. EXPXL) TEST=EXPXL
249 IF (TEST .GT. EXPXU) TEST=EXPXU
250 DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
251 DUM2=ABS(DUM1)
252 DUM3=EXP(TEST)
253 ADDNVE=0.0
254 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
255 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
256 EXCS=EXCS+ADDNVE
257 IF(RAN.LT.EXCS) GOTO 50
258 41 CONTINUE
259 GOTO 80
260 50 GOTO (60,65),NFL
261 60 IF(NP.EQ.NM) GOTO 61
262 IF(NP.EQ.1+NM) GOTO 63
263 IPA(1)=12
264 IPA(2)=14
265 GOTO 90
266 61 CALL GRNDM(RNDM,1)
267 IF(RNDM(1).LT.0.75) GOTO 62
268 IPA(1)=12
269 IPA(2)=16
270 GOTO 90
271 62 IPA(1)=13
272 IPA(2)=14
273 GOTO 90
274 63 IPA(1)=13
275 IPA(2)=16
276 GOTO 90
277 65 IF(NP.EQ.-1+NM) GOTO 66
278 IF(NP.EQ.NM) GOTO 68
279 IPA(1)=12
280 IPA(2)=16
281 GOTO 90
282 66 CALL GRNDM(RNDM,1)
283 IF(RNDM(1).LT.0.50) GOTO 67
284 IPA(1)=12
285 IPA(2)=16
286 GOTO 90
287 67 IPA(1)=13
288 IPA(2)=14
289 GOTO 90
290 68 IPA(1)=13
291 IPA(2)=16
292C** PI Y PRODUCTION INSTEAD OF K N
293 90 CALL GRNDM(RNDM,1)
294 IF(RNDM(1).LT.0.5) GOTO 100
295 IF(IPA(1).EQ.13.AND.IPA(2).EQ.16) GOTO 95
296 IF(IPA(1).EQ.11.AND.IPA(2).EQ.14) GOTO 95
297 IF(IPA(1).EQ.12.AND.IPA(2).EQ.14) GOTO 95
298 CALL GRNDM(RNDM,1)
299 RAN=RNDM(1)
300 DO 91 I=1,4
301 IF(RAN.LT.PIY1(I)) GOTO 92
302 91 CONTINUE
303 GOTO 100
304 92 IPA(1)=IPIY1(1,I)
305 IPA(2)=IPIY1(2,I)
306 GOTO 100
307 95 CALL GRNDM(RNDM,1)
308 RAN=RNDM(1)
309 DO 96 I=1,3
310 IF(RAN.LT.PIY2(I)) GOTO 97
311 96 CONTINUE
312 GOTO 100
313 97 IF(IPA(2).EQ.14) GOTO 98
314 IPA(1)=IPIY2(1,I)
315 IPA(2)=IPIY2(2,I)
316 GOTO 100
317 98 IPA(1)=IPIY3(1,I)
318 IPA(2)=IPIY3(2,I)
319 GOTO 100
320 70 IF(NPRT(4))
321 *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
322 CALL STPAIR
323 IF(INT.EQ.1) CALL TWOB(13,NFL,N)
324 IF(INT.EQ.2) CALL GENXPT(13,NFL,N)
325 GO TO 9999
326C** NUCLEAR EXCITATION
327 55 IF(NPRT(4))
328 *WRITE(NEWBCD,1001)
329 GOTO 53
330C** EXCLUSIVE REACTION NOT FOUND
331 80 IF(NPRT(4))
332 *WRITE(NEWBCD,1004) RS,N
333 53 INT=1
334 NP=0
335 NM=0
336 NZ=0
337 N=0.
338 IPA(1)=13
339 IPA(2)=14
340 IF(NFL.EQ.2) IPA(2)=16
341 100 DO 101 I=3,60
342 101 IPA(I)=0
343 IF(INT.LE.0) GOTO 131
344 120 NT=2
345 IF(NP.EQ.0) GOTO 122
346 DO 121 I=1,NP
347 NT=NT+1
348 121 IPA(NT)=7
349 122 IF(NM.EQ.0) GOTO 124
350 DO 123 I=1,NM
351 NT=NT+1
352 123 IPA(NT)=9
353 124 IF(NZ.EQ.0) GOTO 130
354 DO 125 I=1,NZ
355 NT=NT+1
356 125 IPA(NT)=8
357 130 IF(NPRT(4))
358 *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
359 DO 132 I=1,NT
360 IF(IPA(I).NE.12) GOTO 132
361 CALL GRNDM(RNDM,1)
362 IF(RNDM(1).LT.0.5) GOTO 132
363 IPA(I)=11
364 132 CONTINUE
365 GOTO 70
366 131 IF(NPRT(4))
367 *WRITE(NEWBCD,2005)
368C
3691001 FORMAT('0*CASKM* CASCADE ENERGETICALLY NOT POSSIBLE',
370 $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
3711003 FORMAT(' *CASKM* KAON- -INDUCED CASCADE,',
372 $ ' AVAIL. ENERGY',2X,F8.4,
373 $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
3741004 FORMAT(' *CASKM* KAON- -INDUCED CASCADE,',
375 $ ' EXCLUSIVE REACTION NOT FOUND',
376 $ ' TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X,
377 $ '<NTOT>',2X,F8.4)
3782001 FORMAT('0*CASKM* TABLES FOR MULT. DATA KAON- INDUCED REACTION',
379 $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
3802002 FORMAT(' *CASKM* TARGET PARTICLE FLAG',2X,I5)
3812003 FORMAT(1H ,10E12.4)
3822004 FORMAT(' *CASKM* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
3832005 FORMAT(' *CASKM* NO PARTICLES PRODUCED')
384C
385 9999 CONTINUE
386 END