]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 CASPB(K,INT,NFL) | |
13 | C | |
14 | C *** CASCADE OF ANTI PROTON *** | |
15 | C *** NVE 04-MAY-1988 CERN GENEVA *** | |
16 | C | |
17 | C ORIGIN : H.FESEFELDT (13-SEP-1987) | |
18 | C | |
19 | C PB 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 PMUL1(2,1200),PMUL2(2,400),ANORM1(2,60),ANORM2(2,60), | |
38 | $ SUPP(10),CECH(20),ANHL(29),B(2) | |
39 | DIMENSION RNDM(1) | |
40 | SAVE PMUL1,ANORM1,PMUL2,ANORM2 | |
41 | DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/ | |
42 | DATA CECH/0.14,0.17,0.18,0.18,0.18,0.17,0.17,0.16,0.155,0.145, | |
43 | * 0.11,0.082,0.065,0.050,0.041,0.035,0.028,0.024,0.010 | |
44 | * ,0.0/ | |
45 | DATA ANHL/1.00,1.00,1.00,1.00,1.0,1.00,1.0,1.00,1.00,0.90 | |
46 | * ,0.6,0.52,0.47,0.44,0.41,0.39,0.37,0.35,0.34,0.24 | |
47 | * ,0.19,0.15,0.12,0.10,0.09,0.07,0.06,0.05,0./ | |
48 | DATA B/0.7,0.7/,C/1.25/ | |
49 | C | |
50 | C --- INITIALIZATION INDICATED BY KGINIT(11) --- | |
51 | IF (KGINIT(11) .NE. 0) GO TO 10 | |
52 | KGINIT(11)=1 | |
53 | C | |
54 | C --- INITIALIZE PMUL AND ANORM ARRAYS --- | |
55 | DO 9000 J=1,1200 | |
56 | DO 9001 I=1,2 | |
57 | PMUL1(I,J)=0.0 | |
58 | IF (J .LE. 400) PMUL2(I,J)=0.0 | |
59 | IF (J .LE. 60) ANORM1(I,J)=0.0 | |
60 | IF (J .LE. 60) ANORM2(I,J)=0.0 | |
61 | 9001 CONTINUE | |
62 | 9000 CONTINUE | |
63 | C | |
64 | C** COMPUTE NORMALIZATION CONSTANTS | |
65 | C** FOR P AS TARGET | |
66 | C | |
67 | L=0 | |
68 | DO 1 NP1=1,20 | |
69 | NP=NP1-1 | |
70 | NMM1=NP1-1 | |
71 | IF(NMM1.LE.1) NMM1=1 | |
72 | NPP1=NP1+1 | |
73 | DO 1 NM1=NMM1,NPP1 | |
74 | NM=NM1-1 | |
75 | DO 1 NZ1=1,20 | |
76 | NZ=NZ1-1 | |
77 | L=L+1 | |
78 | IF(L.GT.1200) GOTO 1 | |
79 | NT=NP+NM+NZ | |
80 | IF(NT.LE.0.OR.NT.GT.60) GOTO 1 | |
81 | PMUL1(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C) | |
82 | ANORM1(1,NT)=ANORM1(1,NT)+PMUL1(1,L) | |
83 | 1 CONTINUE | |
84 | C** FOR N AS TARGET | |
85 | L=0 | |
86 | DO 2 NP1=1,20 | |
87 | NP=NP1-1 | |
88 | NPP1=NP1+2 | |
89 | DO 2 NM1=NP1,NPP1 | |
90 | NM=NM1-1 | |
91 | DO 2 NZ1=1,20 | |
92 | NZ=NZ1-1 | |
93 | L=L+1 | |
94 | IF(L.GT.1200) GOTO 2 | |
95 | NT=NP+NM+NZ | |
96 | IF(NT.LE.0.OR.NT.GT.60) GOTO 2 | |
97 | PMUL1(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C) | |
98 | ANORM1(2,NT)=ANORM1(2,NT)+PMUL1(2,L) | |
99 | 2 CONTINUE | |
100 | DO 3 I=1,60 | |
101 | IF(ANORM1(1,I).GT.0.) ANORM1(1,I)=1./ANORM1(1,I) | |
102 | IF(ANORM1(2,I).GT.0.) ANORM1(2,I)=1./ANORM1(2,I) | |
103 | 3 CONTINUE | |
104 | IF(.NOT.NPRT(10)) GOTO 9 | |
105 | WRITE(NEWBCD,2001) | |
106 | DO 4 NFL=1,2 | |
107 | WRITE(NEWBCD,2002) NFL | |
108 | WRITE(NEWBCD,2003) (ANORM1(NFL,I),I=1,60) | |
109 | WRITE(NEWBCD,2003) (PMUL1(NFL,I),I=1,1200) | |
110 | 4 CONTINUE | |
111 | C** DO THE SAME FOR ANNIHILATION CHANNELS | |
112 | C** FOR P AS TARGET | |
113 | C | |
114 | 9 L=0 | |
115 | DO 5 NP1=1,20 | |
116 | NP=NP1-1 | |
117 | NM=NP | |
118 | DO 5 NZ1=1,20 | |
119 | NZ=NZ1-1 | |
120 | L=L+1 | |
121 | IF(L.GT.400) GOTO 5 | |
122 | NT=NP+NM+NZ | |
123 | IF(NT.LE.1.OR.NT.GT.60) GOTO 5 | |
124 | PMUL2(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C) | |
125 | ANORM2(1,NT)=ANORM2(1,NT)+PMUL2(1,L) | |
126 | 5 CONTINUE | |
127 | C** FOR N AS TARGET | |
128 | L=0 | |
129 | DO 6 NP1=1,20 | |
130 | NP=NP1-1 | |
131 | NM=NP+1 | |
132 | DO 6 NZ1=1,20 | |
133 | NZ=NZ1-1 | |
134 | L=L+1 | |
135 | IF(L.GT.400) GOTO 6 | |
136 | NT=NP+NM+NZ | |
137 | IF(NT.LE.1.OR.NT.GT.60) GOTO 6 | |
138 | PMUL2(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C) | |
139 | ANORM2(2,NT)=ANORM2(2,NT)+PMUL2(2,L) | |
140 | 6 CONTINUE | |
141 | DO 7 I=1,60 | |
142 | IF(ANORM2(1,I).GT.0.) ANORM2(1,I)=1./ANORM2(1,I) | |
143 | IF(ANORM2(2,I).GT.0.) ANORM2(2,I)=1./ANORM2(2,I) | |
144 | 7 CONTINUE | |
145 | IF(.NOT.NPRT(10)) GOTO 10 | |
146 | WRITE(NEWBCD,3001) | |
147 | DO 8 NFL=1,2 | |
148 | WRITE(NEWBCD,3002) NFL | |
149 | WRITE(NEWBCD,3003) (ANORM2(NFL,I),I=1,60) | |
150 | WRITE(NEWBCD,3003) (PMUL2(NFL,I),I=1,400) | |
151 | 8 CONTINUE | |
152 | C** CHOOSE PROTON OR NEUTRON AS TARGET | |
153 | 10 NFL=2 | |
154 | CALL GRNDM(RNDM,1) | |
155 | IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1 | |
156 | TARMAS=RMASS(14) | |
157 | IF (NFL .EQ. 2) TARMAS=RMASS(16) | |
158 | S=AMASQ+TARMAS**2+2.0*TARMAS*EN | |
159 | RS=SQRT(S) | |
160 | ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6) | |
161 | ENP(9)=SQRT(ENP(8)) | |
162 | EAB=RS-TARMAS-ABS(RMASS(15)) | |
163 | C** ELASTIC SCATTERING | |
164 | NCECH=0 | |
165 | NP=0 | |
166 | NM=0 | |
167 | NZ=0 | |
168 | N=0. | |
169 | IF(INT.EQ.2) GOTO 20 | |
170 | C** INTRODUCE CHARGE EXCHANGE REACTION PB P --> NB N | |
171 | IF(NFL.EQ.2) GOTO 100 | |
172 | IPLAB=IFIX(P*10.)+1 | |
173 | IF(IPLAB.GT.10) IPLAB=IFIX(P)+10 | |
174 | IF(IPLAB.GT.20) IPLAB=20 | |
175 | CALL GRNDM(RNDM,1) | |
176 | IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.75) GOTO 100 | |
177 | NCECH=1 | |
178 | GOTO 100 | |
179 | C** ANNIHILATION CHANNELS | |
180 | 20 IPLAB=IFIX(P*10.)+1 | |
181 | IF(IPLAB.GT.10) IPLAB=IFIX(P)+10 | |
182 | IF(IPLAB.GT.19) IPLAB=IFIX(P/10.)+19 | |
183 | IF(IPLAB.GT.28) IPLAB=29 | |
184 | CALL GRNDM(RNDM,1) | |
185 | IF(RNDM(1).GT.ANHL(IPLAB)) GOTO 19 | |
186 | EAB=RS | |
187 | IF (EAB .LE. 2.0*RMASS(7)) GOTO 55 | |
188 | GOTO 222 | |
189 | C** CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT. | |
190 | 19 IF (EAB .LE. RMASS(7)) GOTO 55 | |
191 | C** SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM | |
192 | IEAB=IFIX(EAB*5.)+1 | |
193 | IF(IEAB.GT.10) GOTO 22 | |
194 | CALL GRNDM(RNDM,1) | |
195 | IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22 | |
196 | N=1. | |
197 | GOTO (24,23),NFL | |
198 | 23 CONTINUE | |
199 | TEST=-(1+B(1))**2/(2.0*C**2) | |
200 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
201 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
202 | W0=EXP(TEST) | |
203 | TEST=-(-1+B(1))**2/(2.0*C**2) | |
204 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
205 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
206 | WM=EXP(TEST) | |
207 | CALL GRNDM(RNDM,1) | |
208 | RAN=RNDM(1) | |
209 | NP=0 | |
210 | NM=0 | |
211 | NZ=1 | |
212 | IF(RAN.LT.W0/(W0+WM)) GOTO 100 | |
213 | NP=0 | |
214 | NM=1 | |
215 | NZ=0 | |
216 | GOTO 100 | |
217 | 24 CONTINUE | |
218 | TEST=-(1+B(2))**2/(2.0*C**2) | |
219 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
220 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
221 | W0=EXP(TEST) | |
222 | WP=EXP(TEST) | |
223 | TEST=-(-1+B(2))**2/(2.0*C**2) | |
224 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
225 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
226 | WM=EXP(TEST) | |
227 | WT=W0+WP+WM | |
228 | WP=W0+WP | |
229 | CALL GRNDM(RNDM,1) | |
230 | RAN=RNDM(1) | |
231 | NP=0 | |
232 | NM=0 | |
233 | NZ=1 | |
234 | IF(RAN.LT.W0/WT) GOTO 100 | |
235 | NP=1 | |
236 | NM=0 | |
237 | NZ=0 | |
238 | IF(RAN.LT.WP/WT) GOTO 100 | |
239 | NP=0 | |
240 | NM=1 | |
241 | NZ=0 | |
242 | GOTO 100 | |
243 | C | |
244 | 22 ALEAB=LOG(EAB) | |
245 | C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP | |
246 | N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB | |
247 | * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB | |
248 | N=N-2. | |
249 | C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION | |
250 | ANPN=0. | |
251 | DO 21 NT=1,60 | |
252 | TEST=-(PI/4.0)*(NT/N)**2 | |
253 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
254 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
255 | DUM1=PI*NT/(2.0*N*N) | |
256 | DUM2=ABS(DUM1) | |
257 | DUM3=EXP(TEST) | |
258 | ADDNVE=0.0 | |
259 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 | |
260 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3 | |
261 | ANPN=ANPN+ADDNVE | |
262 | 21 CONTINUE | |
263 | ANPN=1./ANPN | |
264 | C** P OR N AS TARGET | |
265 | CALL GRNDM(RNDM,1) | |
266 | RAN=RNDM(1) | |
267 | EXCS=0. | |
268 | GOTO (30,40),NFL | |
269 | C** FOR P AS TARGET | |
270 | 30 L=0 | |
271 | DO 31 NP1=1,20 | |
272 | NP=NP1-1 | |
273 | NMM1=NP1-1 | |
274 | IF(NMM1.LE.1) NMM1=1 | |
275 | NPP1=NP1+1 | |
276 | DO 31 NM1=NMM1,NPP1 | |
277 | NM=NM1-1 | |
278 | DO 31 NZ1=1,20 | |
279 | NZ=NZ1-1 | |
280 | L=L+1 | |
281 | IF(L.GT.1200) GOTO 31 | |
282 | NT=NP+NM+NZ | |
283 | IF(NT.LE.0.OR.NT.GT.60) GOTO 31 | |
284 | TEST=-(PI/4.0)*(NT/N)**2 | |
285 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
286 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
287 | DUM1=ANPN*PI*NT*PMUL1(1,L)*ANORM1(1,NT)/(2.0*N*N) | |
288 | DUM2=ABS(DUM1) | |
289 | DUM3=EXP(TEST) | |
290 | ADDNVE=0.0 | |
291 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 | |
292 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3 | |
293 | EXCS=EXCS+ADDNVE | |
294 | IF(RAN.LT.EXCS) GOTO 100 | |
295 | 31 CONTINUE | |
296 | GOTO 80 | |
297 | C** FOR N AS TARGET | |
298 | 40 L=0 | |
299 | DO 41 NP1=1,20 | |
300 | NP=NP1-1 | |
301 | NPP1=NP1+2 | |
302 | DO 41 NM1=NP1,NPP1 | |
303 | NM=NM1-1 | |
304 | DO 41 NZ1=1,20 | |
305 | NZ=NZ1-1 | |
306 | L=L+1 | |
307 | IF(L.GT.1200) GOTO 41 | |
308 | NT=NP+NM+NZ | |
309 | IF(NT.LE.0.OR.NT.GT.60) GOTO 41 | |
310 | TEST=-(PI/4.0)*(NT/N)**2 | |
311 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
312 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
313 | DUM1=ANPN*PI*NT*PMUL1(2,L)*ANORM1(2,NT)/(2.0*N*N) | |
314 | DUM2=ABS(DUM1) | |
315 | DUM3=EXP(TEST) | |
316 | ADDNVE=0.0 | |
317 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 | |
318 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3 | |
319 | EXCS=EXCS+ADDNVE | |
320 | IF(RAN.LT.EXCS) GOTO 100 | |
321 | 41 CONTINUE | |
322 | GOTO 80 | |
323 | C** ANNIHILATION CHANNELS | |
324 | 222 IPA(1)=0 | |
325 | IPA(2)=0 | |
326 | ALEAB=LOG(EAB) | |
327 | C** NO. OF TOTAL PARTICLES VS SQRT(S) | |
328 | N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB | |
329 | * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB | |
330 | N=N-2. | |
331 | C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION | |
332 | ANPN=0. | |
333 | DO 221 NT=2,60 | |
334 | TEST=-(PI/4.0)*(NT/N)**2 | |
335 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
336 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
337 | DUM1=PI*NT/(2.0*N*N) | |
338 | DUM2=ABS(DUM1) | |
339 | DUM3=EXP(TEST) | |
340 | ADDNVE=0.0 | |
341 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 | |
342 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3 | |
343 | ANPN=ANPN+ADDNVE | |
344 | 221 CONTINUE | |
345 | ANPN=1./ANPN | |
346 | C** P OR N AS TARGET | |
347 | CALL GRNDM(RNDM,1) | |
348 | RAN=RNDM(1) | |
349 | EXCS=0. | |
350 | GOTO (230,240),NFL | |
351 | C** FOR P AS TARGET | |
352 | 230 L=0 | |
353 | DO 231 NP1=1,20 | |
354 | NP=NP1-1 | |
355 | NM=NP | |
356 | DO 231 NZ1=1,20 | |
357 | NZ=NZ1-1 | |
358 | L=L+1 | |
359 | IF(L.GT.400) GOTO 231 | |
360 | NT=NP+NM+NZ | |
361 | IF(NT.LE.1.OR.NT.GT.60) GOTO 231 | |
362 | TEST=-(PI/4.0)*(NT/N)**2 | |
363 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
364 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
365 | DUM1=ANPN*PI*NT*PMUL2(1,L)*ANORM2(1,NT)/(2.0*N*N) | |
366 | DUM2=ABS(DUM1) | |
367 | DUM3=EXP(TEST) | |
368 | ADDNVE=0.0 | |
369 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 | |
370 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3 | |
371 | EXCS=EXCS+ADDNVE | |
372 | IF(RAN.LT.EXCS) GOTO 120 | |
373 | 231 CONTINUE | |
374 | GOTO 80 | |
375 | C** FOR N AS TARGET | |
376 | 240 L=0 | |
377 | DO 241 NP1=1,20 | |
378 | NP=NP1-1 | |
379 | NM=NP+1 | |
380 | DO 241 NZ1=1,20 | |
381 | NZ=NZ1-1 | |
382 | L=L+1 | |
383 | IF(L.GT.400) GOTO 241 | |
384 | NT=NP+NM+NZ | |
385 | IF(NT.LE.1.OR.NT.GT.60) GOTO 241 | |
386 | TEST=-(PI/4.0)*(NT/N)**2 | |
387 | IF (TEST .LT. EXPXL) TEST=EXPXL | |
388 | IF (TEST .GT. EXPXU) TEST=EXPXU | |
389 | DUM1=ANPN*PI*NT*PMUL2(2,L)*ANORM2(2,NT)/(2.0*N*N) | |
390 | DUM2=ABS(DUM1) | |
391 | DUM3=EXP(TEST) | |
392 | ADDNVE=0.0 | |
393 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 | |
394 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3 | |
395 | EXCS=EXCS+ADDNVE | |
396 | IF(RAN.LT.EXCS) GOTO 120 | |
397 | 241 CONTINUE | |
398 | GOTO 80 | |
399 | 50 IF(NPRT(4)) | |
400 | *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ | |
401 | CALL STPAIR | |
402 | IF(INT.EQ.1) CALL TWOB(15,NFL,N) | |
403 | IF(INT.EQ.2) CALL GENXPT(15,NFL,N) | |
404 | GO TO 9999 | |
405 | 55 IF(NPRT(4)) | |
406 | *WRITE(NEWBCD,1001) | |
407 | GOTO 53 | |
408 | C** EXCLUSIVE REACTION NOT FOUND,ASSUME ELASTIC SCATTERING | |
409 | 80 IF(NPRT(4)) | |
410 | *WRITE(NEWBCD,1004)EAB,N | |
411 | 53 INT=1 | |
412 | NP=0 | |
413 | NM=0 | |
414 | NZ=0 | |
415 | 100 DO 101 I=1,60 | |
416 | 101 IPA(I)=0 | |
417 | IF(INT.LE.0) GOTO 131 | |
418 | GOTO (112,102),NFL | |
419 | 102 GOTO (103,104),INT | |
420 | 103 IPA(1)=15 | |
421 | IPA(2)=16 | |
422 | NT=2 | |
423 | GOTO 130 | |
424 | 104 IF(NP.EQ.-1+NM) GOTO 105 | |
425 | IF(NP.EQ. NM) GOTO 106 | |
426 | IPA(1)=17 | |
427 | IPA(2)=14 | |
428 | GOTO 120 | |
429 | 105 IPA(1)=15 | |
430 | IPA(2)=14 | |
431 | CALL GRNDM(RNDM,1) | |
432 | IF(RNDM(1).LT.0.5) GOTO 120 | |
433 | IPA(1)=17 | |
434 | IPA(2)=16 | |
435 | GOTO 120 | |
436 | 106 IPA(1)=15 | |
437 | IPA(2)=16 | |
438 | GOTO 120 | |
439 | 112 GOTO (113,114),INT | |
440 | 113 IPA(1)=15 | |
441 | IPA(2)=14 | |
442 | NT=2 | |
443 | IF(NCECH.EQ.0) GOTO 130 | |
444 | IPA(1)=17 | |
445 | IPA(2)=16 | |
446 | GOTO 130 | |
447 | 114 IF(NP.EQ. NM) GOTO 115 | |
448 | IF(NP.EQ.1+NM) GOTO 116 | |
449 | IPA(1)=17 | |
450 | IPA(2)=14 | |
451 | GOTO 120 | |
452 | 115 IPA(1)=17 | |
453 | IPA(2)=16 | |
454 | CALL GRNDM(RNDM,1) | |
455 | IF(RNDM(1).LT.0.33) GOTO 120 | |
456 | IPA(1)=15 | |
457 | IPA(2)=14 | |
458 | GOTO 120 | |
459 | 116 IPA(1)=15 | |
460 | IPA(2)=16 | |
461 | 120 NT=2 | |
462 | IF(NP.EQ.0) GOTO 122 | |
463 | DO 121 I=1,NP | |
464 | NT=NT+1 | |
465 | 121 IPA(NT)=7 | |
466 | 122 IF(NM.EQ.0) GOTO 124 | |
467 | DO 123 I=1,NM | |
468 | NT=NT+1 | |
469 | 123 IPA(NT)=9 | |
470 | 124 IF(NZ.EQ.0) GOTO 130 | |
471 | DO 125 I=1,NZ | |
472 | NT=NT+1 | |
473 | 125 IPA(NT)=8 | |
474 | 130 IF(NPRT(4)) | |
475 | *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20) | |
476 | GOTO 50 | |
477 | 131 IF(NPRT(4)) | |
478 | *WRITE(NEWBCD,2005) | |
479 | C | |
480 | 1001 FORMAT('0*CASPB* CASCADE ENERGETICALLY NOT POSSIBLE', | |
481 | $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING') | |
482 | 1003 FORMAT(' *CASPB* ANTIPROTON-INDUCED CASCADE,', | |
483 | $ ' AVAIL. ENERGY',2X,F8.4, | |
484 | $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES') | |
485 | 1004 FORMAT(' *CASPB* ANTIPROTON-INDUCED CASCADE,', | |
486 | $ ' EXCLUSIVE REACTION', | |
487 | $ ' NOT FOUND TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X, | |
488 | $ ' <NTOT>',2X,F8.4) | |
489 | 2001 FORMAT('0*CASPB* TABLES FOR MULT. DATA ANTIPROTON INDUCED ', | |
490 | $ 'REACTION FOR DEFINITION OF NUMBERS SEE FORTRAN CODING') | |
491 | 2002 FORMAT(' *CASPB* TARGET PARTICLE FLAG',2X,I5) | |
492 | 2003 FORMAT(1H ,10E12.4) | |
493 | 2004 FORMAT(' *CASPB* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4) | |
494 | 2005 FORMAT(' *CASPB* NO PARTICLES PRODUCED') | |
495 | 3001 FORMAT('0*CASPB* TABLES FOR MULT. DATA ANTIPROTON INDUCED ', | |
496 | $ ' ANNIHILATION REACTION FOR DEFINITION OF NUMBERS SEE FORTRAN', | |
497 | $ ' CODING') | |
498 | 3002 FORMAT(' *CASPB* TARGET PARTICLE FLAG',2X,I5) | |
499 | 3003 FORMAT(1H ,10E12.4) | |
500 | C | |
501 | 9999 CONTINUE | |
502 | END |