]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gheisha/caspb.F
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gheisha / caspb.F
CommitLineData
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)
13C
14C *** CASCADE OF ANTI PROTON ***
15C *** NVE 04-MAY-1988 CERN GENEVA ***
16C
17C ORIGIN : H.FESEFELDT (13-SEP-1987)
18C
19C PB 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 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/
49C
50C --- INITIALIZATION INDICATED BY KGINIT(11) ---
51 IF (KGINIT(11) .NE. 0) GO TO 10
52 KGINIT(11)=1
53C
54C --- 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
63C
64C** COMPUTE NORMALIZATION CONSTANTS
65C** FOR P AS TARGET
66C
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
84C** 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
111C** DO THE SAME FOR ANNIHILATION CHANNELS
112C** FOR P AS TARGET
113C
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
127C** 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
152C** 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))
163C** ELASTIC SCATTERING
164 NCECH=0
165 NP=0
166 NM=0
167 NZ=0
168 N=0.
169 IF(INT.EQ.2) GOTO 20
170C** 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
179C** 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
189C** CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
190 19 IF (EAB .LE. RMASS(7)) GOTO 55
191C** 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
243C
244 22 ALEAB=LOG(EAB)
245C** 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.
249C** 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
264C** P OR N AS TARGET
265 CALL GRNDM(RNDM,1)
266 RAN=RNDM(1)
267 EXCS=0.
268 GOTO (30,40),NFL
269C** 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
297C** 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
323C** ANNIHILATION CHANNELS
324 222 IPA(1)=0
325 IPA(2)=0
326 ALEAB=LOG(EAB)
327C** 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.
331C** 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
346C** P OR N AS TARGET
347 CALL GRNDM(RNDM,1)
348 RAN=RNDM(1)
349 EXCS=0.
350 GOTO (230,240),NFL
351C** 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
375C** 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
408C** 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)
479C
4801001 FORMAT('0*CASPB* CASCADE ENERGETICALLY NOT POSSIBLE',
481 $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
4821003 FORMAT(' *CASPB* ANTIPROTON-INDUCED CASCADE,',
483 $ ' AVAIL. ENERGY',2X,F8.4,
484 $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
4851004 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)
4892001 FORMAT('0*CASPB* TABLES FOR MULT. DATA ANTIPROTON INDUCED ',
490 $ 'REACTION FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
4912002 FORMAT(' *CASPB* TARGET PARTICLE FLAG',2X,I5)
4922003 FORMAT(1H ,10E12.4)
4932004 FORMAT(' *CASPB* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
4942005 FORMAT(' *CASPB* NO PARTICLES PRODUCED')
4953001 FORMAT('0*CASPB* TABLES FOR MULT. DATA ANTIPROTON INDUCED ',
496 $ ' ANNIHILATION REACTION FOR DEFINITION OF NUMBERS SEE FORTRAN',
497 $ ' CODING')
4983002 FORMAT(' *CASPB* TARGET PARTICLE FLAG',2X,I5)
4993003 FORMAT(1H ,10E12.4)
500C
501 9999 CONTINUE
502 END