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

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