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