5 * Revision 1.1.1.1 1995/10/24 10:21:00 cernlib
9 #include "geant321/pilot.h"
10 *CMZ : 3.21/02 29/03/94 15.41.38 by S.Giani
12 SUBROUTINE CASPIP(K,INT,NFL)
14 C *** CASCADE OF PI+ ***
15 C *** NVE 04-MAY-1988 CERN GENEVA ***
17 C ORIGIN : H.FESEFELDT (18-SEP-1987)
19 C PI+ 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.
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/limits.inc"
34 #include "geant321/s_kginit.inc"
37 DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
40 DATA SUPP/0.,0.2,0.45,0.55,0.65,0.75,0.85,0.90,0.94,0.98/
41 DATA CECH/0.33,0.27,0.29,0.31,0.27,0.18,0.13,0.10,0.09,0.07/
42 DATA B/0.7,0.7/,C/1.25/
44 C --- INITIALIZATION INDICATED BY KGINIT(18) ---
45 IF (KGINIT(18) .NE. 0) GO TO 10
48 C --- INITIALIZE PMUL AND ANORM ARRAYS ---
52 IF (J .LE. 60) ANORM(I,J)=0.0
56 C** COMPUTE NORMALIZATION CONSTANTS
71 IF(NT.LE.0.OR.NT.GT.60) GOTO 1
72 PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
73 ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
89 IF(NT.LE.0.OR.NT.GT.60) GOTO 2
90 PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
91 ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
94 IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
95 IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
97 IF(.NOT.NPRT(10)) GOTO 10
100 WRITE(NEWBCD,2002) NFL
101 WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
102 WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
104 C** CHOOSE PROTON OR NEUTRON AS TARGET
107 IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
109 IF (NFL .EQ. 2) TARMAS=RMASS(16)
110 S=AMASQ+TARMAS**2+2.0*TARMAS*EN
112 ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
114 EAB=RS-TARMAS-RMASS(7)
116 C** ELASTIC SCATTERING
123 IF(NFL.EQ.2) IPA(2)=16
125 C** FOR PI+ N REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION
126 C** TO PI+ N --> PI0 P
127 IF(NFL.EQ.1) GOTO 100
129 IF(IPLAB.GT.10) IPLAB=10
131 IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
135 C** CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
136 20 IF (EAB .LE. RMASS(7)) GOTO 55
137 C** SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
139 IF(IEAB.GT.10) GOTO 22
141 IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
145 TEST=-(1+B(1))**2/(2.0*C**2)
146 IF (TEST .LE. EXPXL) TEST=EXPXL
147 IF (TEST .GE. EXPXU) TEST=EXPXU
155 IF(RAN.LT.W0/(W0+WP)) GOTO 50
161 TEST=-(1+B(2))**2/(2.0*C**2)
162 IF (TEST .LE. EXPXL) TEST=EXPXL
163 IF (TEST .GE. EXPXU) TEST=EXPXU
166 TEST=-(-1+B(2))**2/(2.0*C**2)
167 IF (TEST .LE. EXPXL) TEST=EXPXL
168 IF (TEST .GE. EXPXU) TEST=EXPXU
177 IF(RAN.LT.W0/WT) GOTO 50
181 IF(RAN.LT.WP/WT) GOTO 50
188 C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
189 N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
190 * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
192 C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION
195 TEST=-(PI/4.0)*(NT/N)**2
196 IF (TEST .LE. EXPXL) TEST=EXPXL
197 IF (TEST .GE. EXPXU) TEST=EXPXU
202 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
203 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
223 IF(L.GT.1200) GOTO 31
225 IF(NT.LE.0.OR.NT.GT.60) GOTO 31
226 TEST=-(PI/4.0)*(NT/N)**2
227 IF (TEST .LE. EXPXL) TEST=EXPXL
228 IF (TEST .GE. EXPXU) TEST=EXPXU
229 DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
233 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
234 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
236 IF(RAN.LT.EXCS) GOTO 50
251 IF(L.GT.1200) GOTO 41
253 IF(NT.LE.0.OR.NT.GT.60) GOTO 41
254 TEST=-(PI/4.0)*(NT/N)**2
255 IF (TEST .LE. EXPXL) TEST=EXPXL
256 IF (TEST .GE. EXPXU) TEST=EXPXU
257 DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
261 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
262 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3
264 IF(RAN.LT.EXCS) GOTO 50
268 60 IF(NP.EQ.1+NM) GOTO 61
269 IF(NP.EQ.2+NM) GOTO 63
273 61 CALL GRNDM(RNDM,1)
274 IF(RNDM(1).LT.0.5) GOTO 62
284 65 IF(NP.EQ.NM) GOTO 66
285 IF(NP.EQ.1+NM) GOTO 68
289 66 CALL GRNDM(RNDM,1)
290 IF(RNDM(1).LT.0.25) GOTO 67
301 *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
303 IF(INT.EQ.1) CALL TWOB(7,NFL,N)
304 IF(INT.EQ.2) CALL GENXPT(7,NFL,N)
309 C** EXCLUSIVE REACTION NOT FOUND
311 *WRITE(NEWBCD,1004) RS,N
319 IF(NFL.EQ.2) IPA(2)=16
322 IF(INT.LE.0) GOTO 131
328 122 IF(NM.EQ.0) GOTO 124
332 124 IF(NZ.EQ.0) GOTO 130
337 *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
338 IF(IPA(1).EQ.7) NP=NP+1
339 IF(IPA(1).EQ.8) NZ=NZ+1
340 IF(IPA(1).EQ.9) NM=NM+1
345 1001 FORMAT('0*CASPIP* CASCADE ENERGETICALLY NOT POSSIBLE',
346 $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
347 1003 FORMAT(' *CASPIP* PION+ -INDUCED CASCADE,',
348 $ ' AVAIL. ENERGY',2X,F8.4,
349 $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
350 1004 FORMAT(' *CASPIP* PION+ -INDUCED CASCADE,',
351 $ ' EXCLUSIVE REACTION NOT FOUND',
352 $ ' TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X,
354 2001 FORMAT('0*CASPIP* TABLES FOR MULT. DATA PION+ INDUCED REACTION',
355 $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
356 2002 FORMAT(' *CASPIP* TARGET PARTICLE FLAG',2X,I5)
357 2003 FORMAT(1H ,10E12.4)
358 2004 FORMAT(' *CASPIP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
359 2005 FORMAT(' *CASPIP* NO PARTICLES PRODUCED')