[u/mrichter/AliRoot.git] / GEANT321 / gheisha / caskp.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:01  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.39  by  S.Giani
*-- Author :
      SUBROUTINE CASKP(K,INT,NFL)
C
C *** CASCADE OF K+ ***
C *** NVE 04-MAY-1988 CERN GENEVA ***
C
C ORIGIN : H.FESEFELDT (13-SEP-1987)
C
C K+  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
C
#include "geant321/mxgkgh.inc"
#include "geant321/s_curpar.inc"
#include "geant321/s_consts.inc"
#include "geant321/s_result.inc"
#include "geant321/s_prntfl.inc"
#include "geant321/s_kginit.inc"
#include "geant321/limits.inc"
C
      REAL N
      DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2)
      DIMENSION RNDM(1)
      SAVE PMUL,ANORM
      DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
      DATA CECH/0.33,0.27,0.29,0.31,0.27,0.18,0.13,0.10,0.09,0.07/
      DATA B/0.7,0.7/,C/1.25/
C
C --- INITIALIZATION INDICATED BY KGINIT(5) ---
      IF (KGINIT(5) .NE. 0) GO TO 10
      KGINIT(5)=1
C
C --- INITIALIZE PMUL AND ANORM ARRAYS ---
      DO 9000 J=1,1200
      DO 9001 I=1,2
      PMUL(I,J)=0.0
      IF (J .LE. 60) ANORM(I,J)=0.0
 9001 CONTINUE
 9000 CONTINUE
C
C** COMPUTE NORMALIZATION CONSTANTS
C** FOR P AS TARGET
C
      L=0
      DO 1 NP1=1,20
      NP=NP1-1
      NMM1=NP1-2
      IF(NMM1.LE.1) NMM1=1
      DO 1 NM1=NMM1,NP1
      NM=NM1-1
      DO 1 NZ1=1,20
      NZ=NZ1-1
      L=L+1
      IF(L.GT.1200) GOTO 1
      NT=NP+NM+NZ
      IF(NT.LE.0.OR.NT.GT.60) GOTO 1
      PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
      ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
    1 CONTINUE
C** FOR N AS TARGET
      L=0
      DO 2 NP1=1,20
      NP=NP1-1
      NMM1=NP1-1
      IF(NMM1.LE.1) NMM1=1
      NPP1=NP1+1
      DO 2 NM1=NMM1,NPP1
      NM=NM1-1
      DO 2 NZ1=1,20
      NZ=NZ1-1
      L=L+1
      IF(L.GT.1200) GOTO 2
      NT=NP+NM+NZ
      IF(NT.LE.0.OR.NT.GT.60) GOTO 2
      PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
      ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
    2 CONTINUE
      DO 3 I=1,60
      IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
      IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
    3 CONTINUE
      IF(.NOT.NPRT(10)) GOTO 10
      WRITE(NEWBCD,2001)
      DO 4 NFL=1,2
      WRITE(NEWBCD,2002) NFL
      WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
      WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
    4 CONTINUE
C**  CHOOSE PROTON OR NEUTRON AS TARGET
   10 NFL=2
      CALL GRNDM(RNDM,1)
      IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
      TARMAS=RMASS(14)
      IF (NFL .EQ. 2) TARMAS=RMASS(16)
      S=AMASQ+TARMAS**2+2.0*TARMAS*EN
      RS=SQRT(S)
      ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
      ENP(9)=SQRT(ENP(8))
      EAB=RS-TARMAS-RMASS(10)
C
C**  ELASTIC SCATTERING
      NP=0
      NM=0
      NZ=0
      N=0.
      IPA(1)=10
      IPA(2)=14
      IF(NFL.EQ.2) IPA(2)=16
      IF(INT.EQ.2) GOTO 20
C**  FOR K+ N REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION
C**  TO K+ N --> K0 P
      IF(NFL.EQ.1) GOTO 100
      IPLAB=IFIX(P   *5.)+1
      IF(IPLAB.GT.10) IPLAB=10
      CALL GRNDM(RNDM,1)
      IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
      IPA(1)=11
      IPA(2)=14
      GOTO 100
C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
  20  IF (EAB .LE. RMASS(7)) GOTO 55
C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
      IEAB=IFIX(EAB*5.)+1
      IF(IEAB.GT.10) GOTO 22
      CALL GRNDM(RNDM,1)
      IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
      N=1.
      GOTO (23,24),NFL
 23   CONTINUE
      TEST=-(1+B(1))**2/(2.0*C**2)
      IF (TEST .LT. EXPXL) TEST=EXPXL
      IF (TEST .GT. EXPXU) TEST=EXPXU
      W0=EXP(TEST)
      WP=EXP(TEST)
      WP=WP*2.0
      CALL GRNDM(RNDM,1)
      RAN=RNDM(1)
      NP=0
      NM=0
      NZ=1
      IF(RAN.LT.W0/(W0+WP)) GOTO 50
      NP=1
      NM=0
      NZ=0
      GOTO 50
 24   CONTINUE
      TEST=-(1+B(2))**2/(2.0*C**2)
      IF (TEST .LT. EXPXL) TEST=EXPXL
      IF (TEST .GT. EXPXU) TEST=EXPXU
      W0=EXP(TEST)
      WP=EXP(TEST)
      TEST=-(-1+B(2))**2/(2.0*C**2)
      IF (TEST .LT. EXPXL) TEST=EXPXL
      IF (TEST .GT. EXPXU) TEST=EXPXU
      WM=EXP(TEST)
      WT=W0+WP+WM
      WP=W0+WP
      CALL GRNDM(RNDM,1)
      RAN=RNDM(1)
      NP=0
      NM=0
      NZ=1
      IF(RAN.LT.W0/WT) GOTO 50
      NP=1
      NM=0
      NZ=0
      IF(RAN.LT.WP/WT) GOTO 50
      NP=0
      NM=1
      NZ=0
      GOTO 50
C
   22 ALEAB=LOG(EAB)
C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
      N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
     * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
      N=N-2.
C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
      ANPN=0.
      DO 21 NT=1,60
      TEST=-(PI/4.0)*(NT/N)**2
      IF (TEST .LT. EXPXL) TEST=EXPXL
      IF (TEST .GT. EXPXU) TEST=EXPXU
      DUM1=PI*NT/(2.0*N*N)
      DUM2=ABS(DUM1)
      DUM3=EXP(TEST)
      ADDNVE=0.0
      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
      ANPN=ANPN+ADDNVE
   21 CONTINUE
      ANPN=1./ANPN
C** P OR N AS TARGET
      CALL GRNDM(RNDM,1)
      RAN=RNDM(1)
      EXCS=0.
      GOTO (30,40),NFL
C** FOR P AS TARGET
   30 L=0
      DO 31 NP1=1,20
      NP=NP1-1
      NMM1=NP1-2
      IF(NMM1.LE.1) NMM1=1
      DO 31 NM1=NMM1,NP1
      NM=NM1-1
      DO 31 NZ1=1,20
      NZ=NZ1-1
      L=L+1
      IF(L.GT.1200) GOTO 31
      NT=NP+NM+NZ
      IF(NT.LE.0.OR.NT.GT.60) GOTO 31
      TEST=-(PI/4.0)*(NT/N)**2
      IF (TEST .LT. EXPXL) TEST=EXPXL
      IF (TEST .GT. EXPXU) TEST=EXPXU
      DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
      DUM2=ABS(DUM1)
      DUM3=EXP(TEST)
      ADDNVE=0.0
      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
      EXCS=EXCS+ADDNVE
      IF(RAN.LT.EXCS) GOTO 50
   31 CONTINUE
      GOTO 80
C** FOR N AS TARGET
   40 L=0
      DO 41 NP1=1,20
      NP=NP1-1
      NMM1=NP1-1
      IF(NMM1.LE.1) NMM1=1
      NPP1=NP1+1
      DO 41 NM1=NMM1,NPP1
      NM=NM1-1
      DO 41 NZ1=1,20
      NZ=NZ1-1
      L=L+1
      IF(L.GT.1200) GOTO 41
      NT=NP+NM+NZ
      IF(NT.LE.0.OR.NT.GT.60) GOTO 41
      TEST=-(PI/4.0)*(NT/N)**2
      IF (TEST .LT. EXPXL) TEST=EXPXL
      IF (TEST .GT. EXPXU) TEST=EXPXU
      DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
      DUM2=ABS(DUM1)
      DUM3=EXP(TEST)
      ADDNVE=0.0
      IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
      IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
      EXCS=EXCS+ADDNVE
      IF(RAN.LT.EXCS) GOTO 50
   41 CONTINUE
      GOTO 80
   50 GOTO (60,65),NFL
   60 IF(NP.EQ.1+NM) GOTO 61
      IF(NP.EQ.2+NM) GOTO 63
      IPA(1)=10
      IPA(2)=14
      GOTO 100
   61 CALL GRNDM(RNDM,1)
      IF(RNDM(1).LT.0.5) GOTO 62
      IPA(1)=10
      IPA(2)=16
      GOTO 100
   62 IPA(1)=11
      IPA(2)=14
      GOTO 100
   63 IPA(1)=11
      IPA(2)=16
      GOTO 100
   65 IF(NP.EQ.NM) GOTO 66
      IF(NP.EQ.1+NM) GOTO 68
      IPA(1)=10
      IPA(2)=14
      GOTO 100
   66 CALL GRNDM(RNDM,1)
      IF(RNDM(1).LT.0.25) GOTO 67
      IPA(1)=10
      IPA(2)=16
      GOTO 100
   67 IPA(1)=11
      IPA(2)=14
      GOTO 100
   68 IPA(1)=11
      IPA(2)=16
      GOTO 100
   70 IF(NPRT(4))
     *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
      CALL STPAIR
      IF(INT.EQ.1) CALL TWOB(10,NFL,N)
      IF(INT.EQ.2) CALL GENXPT(10,NFL,N)
      GO TO 9999
   55 IF(NPRT(4))
     *WRITE(NEWBCD,1001)
      GOTO 53
C** EXCLUSIVE REACTION NOT FOUND
   80 IF(NPRT(4))
     *WRITE(NEWBCD,1004) RS,N
   53 INT=1
      NP=0
      NM=0
      NZ=0
      N=0.
      IPA(1)=10
      IPA(2)=14
      IF(NFL.EQ.2) IPA(2)=16
  100 DO 101 I=3,60
  101 IPA(I)=0
      IF(INT.LE.0) GOTO 131
  120 NT=2
      IF(NP.EQ.0) GOTO 122
      DO 121 I=1,NP
      NT=NT+1
  121 IPA(NT)=7
  122 IF(NM.EQ.0) GOTO 124
      DO 123 I=1,NM
      NT=NT+1
  123 IPA(NT)=9
  124 IF(NZ.EQ.0) GOTO 130
      DO 125 I=1,NZ
      NT=NT+1
  125 IPA(NT)=8
  130 IF(NPRT(4))
     *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
      DO 132 I=1,NT
      IF(IPA(I).NE.11) GOTO 132
      CALL GRNDM(RNDM,1)
      IF(RNDM(1).LT.0.5) GOTO 132
      IPA(I)=12
  132 CONTINUE
      GOTO 70
  131 IF(NPRT(4))
     *WRITE(NEWBCD,2005)
C
1001  FORMAT('0*CASKP* CASCADE ENERGETICALLY NOT POSSIBLE',
     $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
1003  FORMAT(' *CASKP* KAON+ -INDUCED CASCADE,',
     $ ' AVAIL. ENERGY',2X,F8.4,
     $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
1004  FORMAT(' *CASKP* KAON+ -INDUCED CASCADE,',
     $ ' EXCLUSIVE REACTION NOT FOUND',
     $ 'TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,2X,
     $ '<NTOT>',2X,F8.4)
2001  FORMAT('0*CASKP* TABLES FOR MULT. DATA KAON+  INDUCED REACTION',
     $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
2002  FORMAT(' *CASKP* TARGET PARTICLE FLAG',2X,I5)
2003  FORMAT(1H ,10E12.4)
2004  FORMAT(' *CASKP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
2005  FORMAT(' *CASKP* NO PARTICLES PRODUCED')
C
 9999 CONTINUE
      END
Commit	Line	Data
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 CASKP(K,INT,NFL)
	13	C
	14	C * CASCADE OF K+ *
	15	C * NVE 04-MAY-1988 CERN GENEVA *
	16	C
	17	C ORIGIN : H.FESEFELDT (13-SEP-1987)
	18	C
	19	C K+ 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_curpar.inc"
	30	#include "geant321/s_consts.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),SUPP(10),CECH(10),B(2)
	38	DIMENSION RNDM(1)
	39	SAVE PMUL,ANORM
	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.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/
	43	C
	44	C --- INITIALIZATION INDICATED BY KGINIT(5) ---
	45	IF (KGINIT(5) .NE. 0) GO TO 10
	46	KGINIT(5)=1
	47	C
	48	C --- INITIALIZE PMUL AND ANORM ARRAYS ---
	49	DO 9000 J=1,1200
	50	DO 9001 I=1,2
	51	PMUL(I,J)=0.0
	52	IF (J .LE. 60) ANORM(I,J)=0.0
	53	9001 CONTINUE
	54	9000 CONTINUE
	55	C
	56	C** COMPUTE NORMALIZATION CONSTANTS
	57	C** FOR P AS TARGET
	58	C
	59	L=0
	60	DO 1 NP1=1,20
	61	NP=NP1-1
	62	NMM1=NP1-2
	63	IF(NMM1.LE.1) NMM1=1
	64	DO 1 NM1=NMM1,NP1
65	NM=NM1-1
66	DO 1 NZ1=1,20
67	NZ=NZ1-1
68	L=L+1
69	IF(L.GT.1200) GOTO 1
70	NT=NP+NM+NZ
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)
74	1 CONTINUE
75	C** FOR N AS TARGET
76	L=0
77	DO 2 NP1=1,20
78	NP=NP1-1
79	NMM1=NP1-1
80	IF(NMM1.LE.1) NMM1=1
81	NPP1=NP1+1
82	DO 2 NM1=NMM1,NPP1
83	NM=NM1-1
84	DO 2 NZ1=1,20
85	NZ=NZ1-1
86	L=L+1
87	IF(L.GT.1200) GOTO 2
88	NT=NP+NM+NZ
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)
92	2 CONTINUE
93	DO 3 I=1,60
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)
96	3 CONTINUE
97	IF(.NOT.NPRT(10)) GOTO 10
98	WRITE(NEWBCD,2001)
99	DO 4 NFL=1,2
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)
103	4 CONTINUE
104	C** CHOOSE PROTON OR NEUTRON AS TARGET
105	10 NFL=2
106	CALL GRNDM(RNDM,1)
107	IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
108	TARMAS=RMASS(14)
109	IF (NFL .EQ. 2) TARMAS=RMASS(16)
110	S=AMASQ+TARMAS*2+2.0TARMAS*EN
111	RS=SQRT(S)
112	ENP(8)=AMASQ+TARMAS*2+2.0TARMAS*ENP(6)
113	ENP(9)=SQRT(ENP(8))
114	EAB=RS-TARMAS-RMASS(10)
115	C
116	C** ELASTIC SCATTERING
117	NP=0
118	NM=0
119	NZ=0
120	N=0.
121	IPA(1)=10
122	IPA(2)=14
123	IF(NFL.EQ.2) IPA(2)=16
124	IF(INT.EQ.2) GOTO 20
125	C** FOR K+ N REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION
126	C** TO K+ N --> K0 P
127	IF(NFL.EQ.1) GOTO 100
128	IPLAB=IFIX(P *5.)+1
129	IF(IPLAB.GT.10) IPLAB=10
130	CALL GRNDM(RNDM,1)
131	IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
132	IPA(1)=11
133	IPA(2)=14
134	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
138	IEAB=IFIX(EAB*5.)+1
139	IF(IEAB.GT.10) GOTO 22
140	CALL GRNDM(RNDM,1)
141	IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
142	N=1.
143	GOTO (23,24),NFL
144	23 CONTINUE
145	TEST=-(1+B(1))*2/(2.0C**2)
146	IF (TEST .LT. EXPXL) TEST=EXPXL
147	IF (TEST .GT. EXPXU) TEST=EXPXU
148	W0=EXP(TEST)
149	WP=EXP(TEST)
150	WP=WP*2.0
151	CALL GRNDM(RNDM,1)
152	RAN=RNDM(1)
153	NP=0
154	NM=0
155	NZ=1
156	IF(RAN.LT.W0/(W0+WP)) GOTO 50
157	NP=1
158	NM=0
159	NZ=0
160	GOTO 50
161	24 CONTINUE
162	TEST=-(1+B(2))*2/(2.0C**2)
163	IF (TEST .LT. EXPXL) TEST=EXPXL
164	IF (TEST .GT. EXPXU) TEST=EXPXU
165	W0=EXP(TEST)
166	WP=EXP(TEST)
167	TEST=-(-1+B(2))*2/(2.0C**2)
168	IF (TEST .LT. EXPXL) TEST=EXPXL
169	IF (TEST .GT. EXPXU) TEST=EXPXU
170	WM=EXP(TEST)
171	WT=W0+WP+WM
172	WP=W0+WP
173	CALL GRNDM(RNDM,1)
174	RAN=RNDM(1)
175	NP=0
176	NM=0
177	NZ=1
178	IF(RAN.LT.W0/WT) GOTO 50
179	NP=1
180	NM=0
181	NZ=0
182	IF(RAN.LT.WP/WT) GOTO 50
183	NP=0
184	NM=1
185	NZ=0
186	GOTO 50
187	C
188	22 ALEAB=LOG(EAB)
189	C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
190	N=3.62567+0.665843ALEAB+0.336514ALEAB*ALEAB
191	* +0.117712ALEABALEABALEAB+0.0136912ALEABALEABALEAB*ALEAB
192	N=N-2.
193	C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION
194	ANPN=0.
195	DO 21 NT=1,60
196	TEST=-(PI/4.0)(NT/N)*2
197	IF (TEST .LT. EXPXL) TEST=EXPXL
198	IF (TEST .GT. EXPXU) TEST=EXPXU
199	DUM1=PINT/(2.0N*N)
200	DUM2=ABS(DUM1)
201	DUM3=EXP(TEST)
202	ADDNVE=0.0
203	IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
204	IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
205	ANPN=ANPN+ADDNVE
206	21 CONTINUE
207	ANPN=1./ANPN
208	C** P OR N AS TARGET
209	CALL GRNDM(RNDM,1)
210	RAN=RNDM(1)
211	EXCS=0.
212	GOTO (30,40),NFL
213	C** FOR P AS TARGET
214	30 L=0
215	DO 31 NP1=1,20
216	NP=NP1-1
217	NMM1=NP1-2
218	IF(NMM1.LE.1) NMM1=1
219	DO 31 NM1=NMM1,NP1
220	NM=NM1-1
221	DO 31 NZ1=1,20
222	NZ=NZ1-1
223	L=L+1
224	IF(L.GT.1200) GOTO 31
225	NT=NP+NM+NZ
226	IF(NT.LE.0.OR.NT.GT.60) GOTO 31
227	TEST=-(PI/4.0)(NT/N)*2
228	IF (TEST .LT. EXPXL) TEST=EXPXL
229	IF (TEST .GT. EXPXU) TEST=EXPXU
230	DUM1=ANPNPINTPMUL(1,L)ANORM(1,NT)/(2.0NN)
231	DUM2=ABS(DUM1)
232	DUM3=EXP(TEST)
233	ADDNVE=0.0
234	IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
235	IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
236	EXCS=EXCS+ADDNVE
237	IF(RAN.LT.EXCS) GOTO 50
238	31 CONTINUE
239	GOTO 80
240	C** FOR N AS TARGET
241	40 L=0
242	DO 41 NP1=1,20
243	NP=NP1-1
244	NMM1=NP1-1
245	IF(NMM1.LE.1) NMM1=1
246	NPP1=NP1+1
247	DO 41 NM1=NMM1,NPP1
248	NM=NM1-1
249	DO 41 NZ1=1,20
250	NZ=NZ1-1
251	L=L+1
252	IF(L.GT.1200) GOTO 41
253	NT=NP+NM+NZ
254	IF(NT.LE.0.OR.NT.GT.60) GOTO 41
255	TEST=-(PI/4.0)(NT/N)*2
256	IF (TEST .LT. EXPXL) TEST=EXPXL
257	IF (TEST .GT. EXPXU) TEST=EXPXU
258	DUM1=ANPNPINTPMUL(2,L)ANORM(2,NT)/(2.0NN)
259	DUM2=ABS(DUM1)
260	DUM3=EXP(TEST)
261	ADDNVE=0.0
262	IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
263	IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
264	EXCS=EXCS+ADDNVE
265	IF(RAN.LT.EXCS) GOTO 50
266	41 CONTINUE
267	GOTO 80
268	50 GOTO (60,65),NFL
269	60 IF(NP.EQ.1+NM) GOTO 61
270	IF(NP.EQ.2+NM) GOTO 63
271	IPA(1)=10
272	IPA(2)=14
273	GOTO 100
274	61 CALL GRNDM(RNDM,1)
275	IF(RNDM(1).LT.0.5) GOTO 62
276	IPA(1)=10
277	IPA(2)=16
278	GOTO 100
279	62 IPA(1)=11
280	IPA(2)=14
281	GOTO 100
282	63 IPA(1)=11
283	IPA(2)=16
284	GOTO 100
285	65 IF(NP.EQ.NM) GOTO 66
286	IF(NP.EQ.1+NM) GOTO 68
287	IPA(1)=10
288	IPA(2)=14
289	GOTO 100
290	66 CALL GRNDM(RNDM,1)
291	IF(RNDM(1).LT.0.25) GOTO 67
292	IPA(1)=10
293	IPA(2)=16
294	GOTO 100
295	67 IPA(1)=11
296	IPA(2)=14
297	GOTO 100
298	68 IPA(1)=11
299	IPA(2)=16
300	GOTO 100
301	70 IF(NPRT(4))
302	*WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
303	CALL STPAIR
304	IF(INT.EQ.1) CALL TWOB(10,NFL,N)
305	IF(INT.EQ.2) CALL GENXPT(10,NFL,N)
306	GO TO 9999
307	55 IF(NPRT(4))
308	*WRITE(NEWBCD,1001)
309	GOTO 53
310	C** EXCLUSIVE REACTION NOT FOUND
311	80 IF(NPRT(4))
312	*WRITE(NEWBCD,1004) RS,N
313	53 INT=1
314	NP=0
315	NM=0
316	NZ=0
317	N=0.
318	IPA(1)=10
319	IPA(2)=14
320	IF(NFL.EQ.2) IPA(2)=16
321	100 DO 101 I=3,60
322	101 IPA(I)=0
323	IF(INT.LE.0) GOTO 131
324	120 NT=2
325	IF(NP.EQ.0) GOTO 122
326	DO 121 I=1,NP
327	NT=NT+1
328	121 IPA(NT)=7
329	122 IF(NM.EQ.0) GOTO 124
330	DO 123 I=1,NM
331	NT=NT+1
332	123 IPA(NT)=9
333	124 IF(NZ.EQ.0) GOTO 130
334	DO 125 I=1,NZ
335	NT=NT+1
336	125 IPA(NT)=8
337	130 IF(NPRT(4))
338	*WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
339	DO 132 I=1,NT
340	IF(IPA(I).NE.11) GOTO 132
341	CALL GRNDM(RNDM,1)
342	IF(RNDM(1).LT.0.5) GOTO 132
343	IPA(I)=12
344	132 CONTINUE
345	GOTO 70
346	131 IF(NPRT(4))
347	*WRITE(NEWBCD,2005)
348	C
349	1001 FORMAT('0CASKP CASCADE ENERGETICALLY NOT POSSIBLE',
350	$ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
351	1003 FORMAT(' CASKP KAON+ -INDUCED CASCADE,',
352	$ ' AVAIL. ENERGY',2X,F8.4,
353	$ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
354	1004 FORMAT(' CASKP KAON+ -INDUCED CASCADE,',
355	$ ' EXCLUSIVE REACTION NOT FOUND',
356	$ 'TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X,
357	$ '<NTOT>',2X,F8.4)
358	2001 FORMAT('0CASKP TABLES FOR MULT. DATA KAON+ INDUCED REACTION',
359	$ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
360	2002 FORMAT(' CASKP TARGET PARTICLE FLAG',2X,I5)
361	2003 FORMAT(1H ,10E12.4)
362	2004 FORMAT(' CASKP ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
363	2005 FORMAT(' CASKP NO PARTICLES PRODUCED')
364	C
365	9999 CONTINUE
366	END