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