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