Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gheisha / cassm.F
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 CASSM(K,INT,NFL)
13 C
14 C *** CASCADE OF SIGMA- ***
15 C *** NVE 04-MAY-1988 CERN GENEVA ***
16 C
17 C ORIGIN : H.FESEFELDT (13-SEP-1987)
18 C
19 C S-  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),IIPA(10,2),B(2)
38       DIMENSION RNDM(2)
39       SAVE PMUL,ANORM
40       DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
41       DATA IIPA/21,18,14,16,16,16,16,16,16,16,
42      *          16,16,22,21,18,22,22,22,22,22/
43       DATA B/0.7,0.7/,C/1.25/
44 C
45 C --- INITIALIZATION INDICATED BY KGINIT(12) ---
46       IF (KGINIT(12) .NE. 0) GO TO 10
47       KGINIT(12)=1
48 C
49 C --- INITIALIZE PMUL AND ANORM ARRAYS ---
50       DO 9000 J=1,1200
51       DO 9001 I=1,2
52       PMUL(I,J)=0.0
53       IF (J .LE. 60) ANORM(I,J)=0.0
54  9001 CONTINUE
55  9000 CONTINUE
56 C
57 C** COMPUTE NORMALIZATION CONSTANTS
58 C** FOR P AS TARGET
59 C
60       L=0
61       DO 1 NP1=1,20
62       NP=NP1-1
63       NMM1=NP1-1
64       IF(NMM1.LE.0) NMM1=1
65       NPP1=NP1+1
66       DO 1 NM1=NMM1,NPP1
67       NM=NM1-1
68       DO 1 NZ1=1,20
69       NZ=NZ1-1
70       L=L+1
71       IF(L.GT.1200) GOTO 1
72       NT=NP+NM+NZ
73       IF(NT.LE.0.OR.NT.GT.60) GOTO 1
74       PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
75       ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
76     1 CONTINUE
77 C** FOR N AS TARGET
78       L=0
79       DO 2 NP1=1,20
80       NP=NP1-1
81       NMM1=NP1
82       NPP1=NP1+2
83       DO 2 NM1=NMM1,NPP1
84       NM=NM1-1
85       DO 2 NZ1=1,20
86       NZ=NZ1-1
87       L=L+1
88       IF(L.GT.1200) GOTO 2
89       NT=NP+NM+NZ
90       IF(NT.LE.0.OR.NT.GT.60) GOTO 2
91       PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
92       ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
93     2 CONTINUE
94       DO 3 I=1,60
95       IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
96       IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
97     3 CONTINUE
98       IF(.NOT.NPRT(10)) GOTO 10
99       WRITE(NEWBCD,2001)
100       DO 4 NFL=1,2
101       WRITE(NEWBCD,2002) NFL
102       WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
103       WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
104     4 CONTINUE
105 C**  CHOOSE PROTON OR NEUTRON AS TARGET
106    10 NFL=2
107       CALL GRNDM(RNDM,1)
108       IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
109       TARMAS=RMASS(14)
110       IF (NFL .EQ. 2) TARMAS=RMASS(16)
111       S=AMASQ+TARMAS**2+2.0*TARMAS*EN
112       RS=SQRT(S)
113       ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
114       ENP(9)=SQRT(ENP(8))
115       EAB=RS-TARMAS-RMASS(22)
116 C**  ELASTIC SCATTERING
117       NP=0
118       NM=0
119       NZ=0
120       N=0.
121       IPA(1)=22
122       IPA(2)=14
123       IF(NFL.EQ.2) IPA(2)=16
124       IF(INT.EQ.2) GOTO 20
125 C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS
126 C** S-P --> S0N, S-P --> L N  ,
127 C** S-P --> PS-, S-P --> N S0 , S-P --> N L
128 C** S-N --> NS-,
129       IPLAB=IFIX(P*2.5)+1
130       IF(IPLAB.GT.10) IPLAB=10
131       CALL GRNDM(RNDM,1)
132       IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
133       CALL GRNDM(RNDM,1)
134       RAN=RNDM(1)
135       IRN=IFIX(RAN/0.2)+1
136       IF(IRN.GT.5) IRN=5
137       IRN=IRN+(NFL-1)*5
138       IPA(1)=IIPA(IRN,1)
139       IPA(2)=IIPA(IRN,2)
140       GOTO 120
141 C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
142   20  IF (EAB .LE. RMASS(7)) GOTO 55
143       ALEAB=LOG(EAB)
144 C** NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM
145       N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
146      * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
147       N=N-2.
148 C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
149       ANPN=0.
150       DO 21 NT=1,60
151       TEST=-(PI/4.0)*(NT/N)**2
152       IF (TEST .LT. EXPXL) TEST=EXPXL
153       IF (TEST .GT. EXPXU) TEST=EXPXU
154       DUM1=PI*NT/(2.0*N*N)
155       DUM2=ABS(DUM1)
156       DUM3=EXP(TEST)
157       ADDNVE=0.0
158       IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
159       IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
160       ANPN=ANPN+ADDNVE
161    21 CONTINUE
162       ANPN=1./ANPN
163 C** P OR N AS TARGET
164       CALL GRNDM(RNDM,1)
165       RAN=RNDM(1)
166       EXCS=0.
167       GOTO (30,40),NFL
168 C** FOR P AS TARGET
169    30 L=0
170       DO 31 NP1=1,20
171       NP=NP1-1
172       NMM1=NP1-1
173       IF(NMM1.LE.0) NMM1=1
174       NPP1=NP1+1
175       DO 31 NM1=NMM1,NPP1
176       NM=NM1-1
177       DO 31 NZ1=1,20
178       NZ=NZ1-1
179       L=L+1
180       IF(L.GT.1200) GOTO 31
181       NT=NP+NM+NZ
182       IF(NT.LE.0.OR.NT.GT.60) GOTO 31
183       TEST=-(PI/4.0)*(NT/N)**2
184       IF (TEST .LT. EXPXL) TEST=EXPXL
185       IF (TEST .GT. EXPXU) TEST=EXPXU
186       DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
187       DUM2=ABS(DUM1)
188       DUM3=EXP(TEST)
189       ADDNVE=0.0
190       IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
191       IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
192       EXCS=EXCS+ADDNVE
193       IF(RAN.LT.EXCS) GOTO 100
194    31 CONTINUE
195       GOTO 80
196 C** FOR N AS TARGET
197    40 L=0
198       DO 41 NP1=1,20
199       NP=NP1-1
200       NMM1=NP1
201       NPP1=NP1+2
202       DO 41 NM1=NMM1,NPP1
203       NM=NM1-1
204       DO 41 NZ1=1,20
205       NZ=NZ1-1
206       L=L+1
207       IF(L.GT.1200) GOTO 41
208       NT=NP+NM+NZ
209       IF(NT.LE.0.OR.NT.GT.60) GOTO 41
210       TEST=-(PI/4.0)*(NT/N)**2
211       IF (TEST .LT. EXPXL) TEST=EXPXL
212       IF (TEST .GT. EXPXU) TEST=EXPXU
213       DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,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       EXCS=EXCS+ADDNVE
220       IF(RAN.LT.EXCS) GOTO 100
221    41 CONTINUE
222       GOTO 80
223    50 IF(NPRT(4))
224      *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
225       IF(INT.EQ.1) CALL TWOB(22,NFL,N)
226       IF(INT.EQ.2) CALL GENXPT(22,NFL,N)
227       GO TO 9999
228    55 IF(NPRT(4))
229      *WRITE(NEWBCD,1001)
230       GOTO 53
231 C** EXCLUSIVE REACTION NOT FOUND
232    80 IF(NPRT(4))
233      *WRITE(NEWBCD,1004) RS,N
234    53 INT=1
235       NP=0
236       NM=0
237       NZ=0
238       IPA(1)=22
239       IPA(2)=14
240       IF(NFL.EQ.2) IPA(2)=16
241       GOTO 120
242   100 DO 101 I=1,60
243   101 IPA(I)=0
244       IF(INT.LE.0) GOTO 131
245       GOTO (102,112),NFL
246   102 NCHT=NP-NM
247       NCHT=NCHT+2
248       IF(NCHT.LE.0) NCHT=1
249       IF(NCHT.GT.3) NCHT=3
250       GOTO (103,104,105),NCHT
251   103 IPA(1)=21
252       CALL GRNDM(RNDM,1)
253       IF(RNDM(1).LT.0.5) IPA(1)=18
254       IPA(2)=14
255       GOTO 120
256   104 IPA(1)=22
257       IPA(2)=14
258       CALL GRNDM(RNDM,2)
259       IF(RNDM(1).LT.0.5) GOTO 120
260       IPA(1)=21
261       IF(RNDM(2).LT.0.5) IPA(1)=18
262       IPA(2)=16
263       GOTO 120
264   105 IPA(1)=22
265       IPA(2)=16
266       GOTO 120
267   112 NCHT=NP-NM
268       NCHT=NCHT+3
269       IF(NCHT.LE.0) NCHT=1
270       IF(NCHT.GT.3) NCHT=3
271       GOTO (113,114,115),NCHT
272   113 IPA(1)=21
273       CALL GRNDM(RNDM,1)
274       IF(RNDM(1).LT.0.5) IPA(1)=18
275       IPA(2)=14
276       GOTO 120
277   114 IPA(1)=21
278       CALL GRNDM(RNDM,2)
279       IF(RNDM(1).LT.0.5) IPA(1)=18
280       IPA(2)=16
281       IF(RNDM(2).LT.0.5) GOTO 120
282       IPA(1)=22
283       IPA(2)=14
284       GOTO 120
285   115 IPA(1)=22
286       IPA(2)=16
287   120 NT=2
288       IF(NP.EQ.0) GOTO 122
289       DO 121 I=1,NP
290       NT=NT+1
291   121 IPA(NT)=7
292   122 IF(NM.EQ.0) GOTO 124
293       DO 123 I=1,NM
294       NT=NT+1
295   123 IPA(NT)=9
296   124 IF(NZ.EQ.0) GOTO 130
297       DO 125 I=1,NZ
298       NT=NT+1
299   125 IPA(NT)=8
300   130 IF(NPRT(4))
301      *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
302       GOTO 50
303   131 IF(NPRT(4))
304      *WRITE(NEWBCD,2005)
305 C
306 1001  FORMAT('0*CASSM* CASCADE ENERGETICALLY NOT POSSIBLE',
307      $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
308 1003  FORMAT(' *CASSM* SIGMA- -INDUCED CASCADE,',
309      $ ' AVAIL. ENERGY',2X,F8.4,
310      $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
311 1004  FORMAT(' *CASSM* SIGMA- -INDUCED CASCADE,',
312      $ ' EXCLUSIVE REACTION NOT FOUND',
313      $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,2X,
314      $ '<NTOT>',2X,F8.4)
315 2001  FORMAT('0*CASSM* TABLES FOR MULT. DATA SIGMA- INDUCED REACTION',
316      $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
317 2002  FORMAT(' *CASSM* TARGET PARTICLE FLAG',2X,I5)
318 2003  FORMAT(1H ,10E12.4)
319 2004  FORMAT(' *CASSM* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
320 2005  FORMAT(' *CASSM* NO PARTICLES PRODUCED')
321 C
322  9999 CONTINUE
323       END