]>
Commit | Line | Data |
---|---|---|
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) | |
13 | C | |
14 | C *** CASCADE OF K- *** | |
15 | C *** NVE 04-MAY-1988 CERN GENEVA *** | |
16 | C | |
17 | C ORIGIN : H.FESEFELDT (13-SEP-1987) | |
18 | C | |
19 | C K- 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),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/ | |
48 | C | |
49 | C --- INITIALIZATION INDICATED BY KGINIT(4) --- | |
50 | IF (KGINIT(4) .NE. 0) GO TO 10 | |
51 | KGINIT(4)=1 | |
52 | C | |
53 | C --- 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 | |
60 | C | |
61 | C** COMPUTE NORMALIZATION CONSTANTS | |
62 | C** FOR P AS TARGET | |
63 | C | |
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 | |
81 | C** 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 | |
108 | C** 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) | |
119 | C | |
120 | C** 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 | |
130 | C** 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 | |
137 | C** 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 | |
143 | C** 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 | |
152 | C** 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 | |
158 | C** 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 | |
163 | C** 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 | |
170 | C** 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 | |
175 | C** 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 | |
180 | C | |
181 | 22 ALEAB=LOG(EAB) | |
182 | C** 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. | |
186 | C** 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 | |
201 | C** P OR N AS TARGET | |
202 | CALL GRNDM(RNDM,1) | |
203 | RAN=RNDM(1) | |
204 | EXCS=0. | |
205 | GOTO (30,40),NFL | |
206 | C** 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 | |
234 | C** 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 | |
292 | C** 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 | |
326 | C** NUCLEAR EXCITATION | |
327 | 55 IF(NPRT(4)) | |
328 | *WRITE(NEWBCD,1001) | |
329 | GOTO 53 | |
330 | C** 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) | |
368 | C | |
369 | 1001 FORMAT('0*CASKM* CASCADE ENERGETICALLY NOT POSSIBLE', | |
370 | $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING') | |
371 | 1003 FORMAT(' *CASKM* KAON- -INDUCED CASCADE,', | |
372 | $ ' AVAIL. ENERGY',2X,F8.4, | |
373 | $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES') | |
374 | 1004 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) | |
378 | 2001 FORMAT('0*CASKM* TABLES FOR MULT. DATA KAON- INDUCED REACTION', | |
379 | $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING') | |
380 | 2002 FORMAT(' *CASKM* TARGET PARTICLE FLAG',2X,I5) | |
381 | 2003 FORMAT(1H ,10E12.4) | |
382 | 2004 FORMAT(' *CASKM* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4) | |
383 | 2005 FORMAT(' *CASKM* NO PARTICLES PRODUCED') | |
384 | C | |
385 | 9999 CONTINUE | |
386 | END |