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 CASN(K,INT,NFL)
14 C *** CASCADE OF NEUTRON ***
15 C *** NVE 04-MAY-1988 CERN GENEVA ***
17 C ORIGIN : H.FESEFELDT (13-SEP-1987)
19 C N 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.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
41 DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
42 DATA B/0.35,0.0/,C/1.25/
44 C --- INITIALIZATION INDICATED BY KGINIT(17) ---
45 IF (KGINIT(17) .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
72 IF(NT.LE.0.OR.NT.GT.60) GOTO 1
73 PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
76 PMUL(1,L)=PMUL(1,L)/(NPROTF*NNEUTF)
77 ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
95 IF(NT.LE.0.OR.NT.GT.60) GOTO 2
96 PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
99 PMUL(2,L)=PMUL(2,L)/(NPROTF*NNEUTF)
100 ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
103 IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
104 IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
106 IF(.NOT.NPRT(10)) GOTO 10
109 WRITE(NEWBCD,2002) NFL
110 WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
111 WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
113 C** CHOOSE PROTON OR NEUTRON AS TARGET
116 IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
118 IF (NFL .EQ. 2) TARMAS=RMASS(16)
119 S=AMASQ+TARMAS**2+2.0*TARMAS*EN
121 ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
123 EAB=RS-TARMAS-RMASS(16)
124 C** ELASTIC SCATTERING
131 C** INTRODUCE CHARGE EXCHANGE REACTION PN --> NP
132 IF(NFL.EQ.2) GOTO 100
134 IF(IPLAB.GT.10) IPLAB=10
136 IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
139 C** CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
140 20 IF (EAB .LE. RMASS(7)) GOTO 55
141 C** SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
143 IF(IEAB.GT.10) GOTO 22
145 IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
149 TEST=-(1+B(2))**2/(2.0*C**2)
150 IF (TEST .GT. EXPXU) TEST=EXPXU
151 IF (TEST .LT. EXPXL) TEST=EXPXL
159 IF(RAN.LT.W0/(W0+WM)) GOTO 100
165 TEST=-(1+B(1))**2/(2.0*C**2)
166 IF (TEST .GT. EXPXU) TEST=EXPXU
167 IF (TEST .LT. EXPXL) TEST=EXPXL
170 TEST=-(-1+B(1))**2/(2.0*C**2)
171 IF (TEST .GT. EXPXU) TEST=EXPXU
172 IF (TEST .LT. EXPXL) TEST=EXPXL
181 IF(RAN.LT.W0/WT) GOTO 100
185 IF(RAN.LT.WP/WT) GOTO 100
192 C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
193 N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
194 * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
196 C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION
199 TEST=-(PI/4.0)*(NT/N)**2
200 IF (TEST .GT. EXPXU) TEST=EXPXU
201 IF (TEST .LT. EXPXL) TEST=EXPXL
202 ANPN=ANPN+PI*NT*EXP(TEST)/(2.0*N*N)
220 IF(L.GT.1200) GOTO 31
222 IF(NT.LE.0.OR.NT.GT.60) GOTO 31
223 TEST=-(PI/4.0)*(NT/N)**2
224 IF (TEST .GT. EXPXU) TEST=EXPXU
225 IF (TEST .LT. EXPXL) TEST=EXPXL
226 DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
230 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
231 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
233 IF(RAN.LT.EXCS) GOTO 100
248 IF(L.GT.1200) GOTO 41
250 IF(NT.LE.0.OR.NT.GT.60) GOTO 41
251 TEST=-(PI/4.0)*(NT/N)**2
252 IF (TEST .GT. EXPXU) TEST=EXPXU
253 IF (TEST .LT. EXPXL) TEST=EXPXL
254 DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
258 IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
259 IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
261 IF(RAN.LT.EXCS) GOTO 100
265 *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
267 IF(INT.EQ.1) CALL TWOB(16,NFL,N)
268 IF(INT.EQ.2) CALL GENXPT(16,NFL,N)
273 C** EXCLUSIVE REACTION NOT FOUND
275 *WRITE(NEWBCD,1004) RS,N
282 IF(INT.LE.0) GOTO 131
283 NPROT=1-NP+NM+(1-NFL)
286 102 GOTO (103,104),INT
291 104 IF(NNEUT.EQ.1) GOTO 105
292 IF(NNEUT.EQ.2) GOTO 106
299 IF(RNDM(1).LT.0.5) GOTO 120
306 112 GOTO (113,114),INT
310 IF(NCECH.EQ.0) GOTO 130
314 114 IF(NNEUT.EQ.1) GOTO 115
315 IF(NNEUT.EQ.2) GOTO 116
322 IF(RNDM(1).LT.0.33) GOTO 120
333 122 IF(NM.EQ.0) GOTO 124
337 124 IF(NZ.EQ.0) GOTO 130
342 *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
347 1001 FORMAT('0*CASN* CASCADE ENERGETICALLY NOT POSSIBLE NUCLEAR',
348 * ' EXCITATION',2X,F8.4,2X,'INCIDENT ENERGY LOST')
349 1003 FORMAT(' *CASN* NEUTRON-INDUCED CASCADE,',
350 $ ' AVAIL. ENERGY',2X,F8.4,
351 $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
352 1004 FORMAT(' *CASN* NEUTRON-INDUCED CASCADE,',
353 $ ' EXCLUSIVE REACTION NOT FOUND',
354 $ ' TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X,
356 2001 FORMAT('0*CASN* TABLES FOR MULT. DATA NEUTRON INDUCED REACTION',
357 $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
358 2002 FORMAT(' *CASN* TARGET PARTICLE FLAG',2X,I5)
359 2003 FORMAT(1H ,10E12.4)
360 2004 FORMAT(' *CASN* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
361 2005 FORMAT(' *CASN* NO PARTICLES PRODUCED')