This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / neutron / colisn.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:56  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
11 *-- Author :
12       SUBROUTINE COLISN(D,LD,IGAMS,LGAM,INABS,LNAB,ITHRMS,LTHRM,
13      + IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,Q,NSEI,NAEI,NMT2,NMT4,
14      + NMT16,NMT17,NMT18,NMT22,NMT23,NMT24,NMT28,NMT51,NMT91,
15      + NMT102,NMT103,NMT104,NMT105,NMT106,NMT107,NMT108,NMT109,
16      + NMT111,NMT112,NMT113,NMT114,IGCBS2,LGCB2,KZ,LR,QLR,
17      + IIN,IIM)
18 C        THIS ROUTINE IS CALLED AT EACH COLLISION TO
19 C        DETERMINE THE POST COLLISION PARAMETERS
20 #include "geant321/minput.inc"
21 #include "geant321/mconst.inc"
22 #include "geant321/mnutrn.inc"
23 #include "geant321/mapoll.inc"
24 #include "geant321/mcross.inc"
25 #include "geant321/mmass.inc"
26 #include "geant321/mupsca.inc"
27 #include "geant321/mpstor.inc"
28 #include "geant321/mmicab.inc"
29       DIMENSION D(*),LD(*),IGAMS(*),LGAM(*),INABS(*),LNAB(*),
30      + ITHRMS(*),LTHRM(*),IDICTS(NNR,NNUC),LDICT(NNR,NNUC),NTX(*),
31      + NTS(*),IGCBS(NGR,NNUC),LGCB(NGR,NNUC),AWR(*),Q(NQ,NNUC),
32      + NSEI(*),NAEI(*),NMT2(*),NMT4(*),NMT16(1),NMT17(*),NMT18(*),
33      + NMT22(*),NMT23(*),NMT24(*),NMT28(*),NMT51(*),NMT91(*),
34      + NMT102(*),NMT103(*),NMT104(*),NMT105(*),NMT106(*),NMT107(*),
35      + NMT108(*),NMT109(*),NMT111(*),NMT112(*),NMT113(*),NMT114(*),
36      + IGCBS2(NGR,NNUC),LGCB2(NGR,NNUC),KZ(*),LR(NQ,NNUC),QLR(NQ,NNUC),
37      + FM(MAXNEU)
38 C
39       CHARACTER*80 COMM
40 C
41       DATA QBE8/-7.3686E+06/
42       SAVE
43       CALL GTMED(NMED,MED)
44 C       INITIALIZE THE COUNTERS AND FLAGS
45 C       ITRY ALLOWS FOR MULTIPLE ATTEMPTS IF THE ENDF/B PARTIAL
46 C       CROSS SECTIONS DO NOT EXACTLY SUM TO THE TOTAL
47    10 ISTOP=0
48       ITRY=0
49       NCOL=NCOL+1
50       SIGREC=0.0
51       SUMREC=0.0
52       FSUMS = 1.0
53       FSUMIS = 1.0
54       FSUMA = 1.0
55    20 ID=0
56       MT=0
57       QI=0.0
58       LRI=0
59       QLRI=0.0
60       DO 30 I=1,MAXNEU
61          FM(I)=1.0
62    30 CONTINUE
63       DO 40 I=1,MAXNEU
64          ENE(I)=0.0
65    40 CONTINUE
66       INEU = 0
67       U1=0.0
68       V1=0.0
69       W1=0.0
70       ERFGM=0.0
71       IFLG=0
72       LIFLAG=0
73       AWRI=AWR(IIN)
74       KZI=KZ(IIM)
75 #if defined(CERNLIB_MDEBUG)
76       PRINT *,' COLISN: A=',AWRI,' K=',KZI
77 #endif
78 C       INITIALIZE THE CROSS SECTION VARIABLES
79       SIGT=0.0
80       SIGTNS=0.0
81       SIGTNA=0.0
82       SIGNES=0.0
83       SIGNIS=0.0
84       SGNISD=0.0
85       SGNISC=0.0
86       SIGN2N=0.0
87       SIGN3N=0.0
88       SIGNNA=0.0
89       SGNN3A=0.0
90       SGN2NA=0.0
91       SIGNNP=0.0
92       SIGNF=0.0
93       SIGNG=0.0
94       SIGNP=0.0
95       SIGND=0.0
96       SIGNT=0.0
97       SGN3HE=0.0
98       SIGNA=0.0
99       SIGN2A=0.0
100       SIGN3A=0.0
101       SIGN2P=0.0
102       SIGNPA=0.0
103       SGNT2A=0.0
104       SGND2A=0.0
105       SUMIS=0.0
106       SUMS=0.0
107       SUMA=0.0
108 C       DETERMINE THE TOTAL CROSS SECTION (MT-1)
109       L1=LDICT(1,IIN)
110       IF(L1.EQ.0)GO TO 50
111       LS1=IDICTS(1,IIN) + LMOX2
112       LEN=L1/2
113       CALL TBSPLT(D(LS1),E,LEN,SIGT)
114       GO TO 60
115    50 CONTINUE
116       COMM=' COLISN: TOTAL CROSS SECTION LENGTH IS ZERO'
117       SIGREC = 0.0
118       SUMREC = 0.0
119       GOTO 980
120    60 CONTINUE
121 C       DETERMINE THE TOTAL NEUTRON DISAPPEARANCE (MT-102 TO MT-114
122 C       AND MT-18)
123       L1=LNAB(IIN)
124       IF(L1.EQ.0)GO TO 70
125       LS1=INABS(IIN)+LMOX2
126       LEN=L1/2
127       CALL TBSPLT(D(LS1),E,LEN,SIGTNA)
128       GO TO 80
129    70 SIGTNA=0.0
130    80 CONTINUE
131 C       DETERMINE THE NON-ABSORPTION PROBABILITY
132       PNAB=1.0-SIGTNA/SIGT
133 C       DETERMINE THE COLLISION TYPE (ABSORPTION OR SCATTERING)
134       R=FLTRNF(0)
135       IF(R.GT.PNAB)GO TO 570
136 C       THE REACTION TYPE IS A SCATTER
137       NSEI(IIN)=NSEI(IIN)+1
138       SIGTNS=SIGT-SIGTNA
139       R=FLTRNF(0)
140 C       DETERMINE (N,N) CROSS SECTION (MT-2)
141       ID=2
142       L1=LDICT(ID,IIN)
143       IF(L1.EQ.0)GO TO 110
144       LS1=IDICTS(ID,IIN)+LMOX2
145       LEN=L1/2
146       CALL TBSPLT(D(LS1),E,LEN,SIGNES)
147       SUMS=SIGNES/SIGTNS*FSUMS
148       IF(R.GT.SUMS)GO TO 120
149 C       REACTION TYPE IS (N,N)
150       NMT2(MED)=NMT2(MED)+1
151 C       DETERMINE IF SCATTERING OCCURS IN THE THERMAL ENERGY RANGE
152       ETHERM = 500.*8.617E-5*TEMP/AWRI
153       IF(E.LE.ETHERM) THEN
154 C Reaction is a thermal scatter
155          CALL THRMSC(D,D,ITHRMS,LTHRM,E,U,V,W,TEMP,FM,AWR,IIN,
156      +               IFLG,IOUT)
157          QI=Q(ID,IIN)
158          CALL CMLABE(D,D,AWRI,KZI,ID,FM,QI,IFLG)
159          EP = E
160          VP = V
161          UP = U
162          WP = W
163          AGEP = AGE
164          MTP = 2
165          CALL STOPAR(IDNEU,NNEU)
166          RETURN
167       ENDIF
168 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
169 C       CENTER OF MASS COORDINATE SYSTEM
170       L1=LDICT(67,IIN)
171       IF(L1.EQ.0)GO TO 90
172       LS1=IDICTS(67,IIN)+LMOX2
173       LEN=L1
174       CALL CANGLE(D(LS1),D(LS1),E,FM(1),LEN)
175       GO TO 100
176 C       ASSUME ISOTROPIC IN THE CENTER OF MASS COORDINATE SYSTEM
177    90 R=FLTRNF(0)
178       FM(1)=2.0*R-1.0
179 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
180 C       COORDINATE SYSTEM
181   100 CONTINUE
182       QI=Q(ID,IIN)
183       CALL CMLABE(D,D,AWRI,KZI,ID,FM(1),QI,IFLG)
184       EP = E
185       VP = V
186       UP = U
187       WP = W
188       AGEP = AGE
189       MTP = 2
190       CALL STOPAR(IDNEU,NNEU)
191       RETURN
192   110 SIGNES=0.0
193   120 CONTINUE
194 C       DETERMINE (N,N") CROSS SECTION (MT-4)
195       ID=3
196       L1=LDICT(ID,IIN)
197       IF(L1.EQ.0)GO TO 240
198       LS1=IDICTS(ID,IIN)+LMOX2
199       LEN=L1/2
200       CALL TBSPLT(D(LS1),E,LEN,SIGNIS)
201       SUMS=SUMS+SIGNIS/SIGTNS*FSUMS
202       IF(R.GT.SUMS)GO TO 250
203 C       REACTION TYPE IS (N,N")
204       NMT4(MED)=NMT4(MED)+1
205 C       DETERMINE (N,N"-DISCRETE) CROSS SECTION (MT-51 TO MT-90)
206       R=FLTRNF(0)
207       DO 130 I=14,53
208          L1=LDICT(I,IIN)
209          IF(L1.EQ.0)GO TO 170
210          LS1=IDICTS(I,IIN)+LMOX2
211          LEN=L1/2
212          CALL XSECNU(D,LEN,E,SGNISD,LS1,L1)
213          SUMIS=SUMIS+SGNISD/SIGNIS*FSUMIS
214          IF(R.LE.SUMIS)GO TO 140
215   130 CONTINUE
216       GO TO 180
217   140 CONTINUE
218 C       REACTION TYPE IS (N,N") DISCRETE
219       NMT51(MED)=NMT51(MED)+1
220       I=I+68
221 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
222 C       CENTER OF MASS COORDINATE SYSTEM
223       L1=LDICT(I,IIN)
224       IF(L1.EQ.0)GO TO 150
225       LS1=IDICTS(I,IIN)+LMOX2
226       LEN=L1
227       CALL CANGLE(D(LS1),D(LS1),E,FM(1),LEN)
228       GO TO 160
229 C       ASSUME ISOTROPIC IN THE CENTER OF MASS COORDINATE SYSTEM
230   150 R=FLTRNF(0)
231       FM(1)=2.0*R-1.0
232 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
233 C       COORDINATE SYSTEM
234   160 ID=I-68
235       QI=Q(ID,IIN)
236       LRI=LR(ID,IIN)
237       QLRI=QLR(ID,IIN)
238       CALL CMLABI(D,D,AWRI,KZI,ID,FM(1),QI,IFLG,LIFLAG,LRI)
239 C Re-sample if no energy determined in CMLABI
240       IF(IFLG.EQ.-1) GOTO 10
241       EP = E
242       VP = V
243       UP = U
244       WP = W
245       AGEP = AGE
246       MTP = 51
247       CALL STOPAR(IDNEU,NNEU)
248       IF(LRI.EQ.22)GO TO 520
249       IF(LRI.EQ.23)GO TO 530
250       IF(LRI.EQ.28)GO TO 540
251       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
252      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SGNISD)
253       RETURN
254   170 SGNISD=0.0
255   180 CONTINUE
256 C       DISCRETE INELASTIC SCATTERING LEVEL WAS NOT CHOSEN
257 C       DETERMINE (N,N"-CONTINUUM) CROSS SECTION (MT-91)
258       ID=54
259       L1=LDICT(ID,IIN)
260       IF(L1.EQ.0)GO TO 210
261       LS1=IDICTS(ID,IIN)+LMOX2
262       LEN=L1/2
263       CALL TBSPLT(D(LS1),E,LEN,SGNISC)
264       SUMIS=SUMIS+SGNISC/SIGNIS*FSUMIS
265       IF(R.GT.SUMIS)GO TO 220
266 C       REACTION TYPE IS (N,N") CONTINUUM
267       NMT91(MED)=NMT91(MED)+1
268 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
269 C       LABORATORY COORDINATE SYSTEM
270       L1=LDICT(122,IIN)
271       IF(L1.EQ.0)GO TO 190
272       LS1=IDICTS(122,IIN)+LMOX2
273       LEN=L1
274       CALL CANGLE(D(LS1),D(LS1),E,FM(1),LEN)
275       GO TO 200
276 C       ASSUME ISOTROPIC IN THE LABORATORY COORDINATE SYSTEM
277   190 CALL GTISO(U1,V1,W1)
278       U=U1
279       V=V1
280       W=W1
281       LIFLAG=1
282 C       DETERMINE THE EXIT NEUTRON ENERGY IN THE LABORATORY
283 C       COORDINATE SYSTEM
284   200 L1=LDICT(133,IIN)
285       IF(L1.EQ.0)GO TO 230
286       LS1=IDICTS(133,IIN)+LMOX2
287       CALL SECEGY(EX,D(LS1),E,D(LS1))
288       E=EX
289       IFLG=1
290 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
291 C       COORDINATE SYSTEM
292       QI=Q(ID,IIN)
293       LRI=LR(ID,IIN)
294       QLRI=QLR(ID,IIN)
295       CALL CMLABI(D,D,AWRI,KZI,ID,FM(1),QI,IFLG,LIFLAG,LRI)
296 C Re-sample if no energy determined in CMLABI
297       IF(IFLG.EQ.-1) GOTO 10
298       EP = E
299       VP = V
300       UP = U
301       WP = W
302       AGEP = AGE
303       MTP = 91
304       CALL STOPAR(IDNEU,NNEU)
305       IF(LRI.EQ.22)GO TO 520
306       IF(LRI.EQ.23)GO TO 530
307       IF(LRI.EQ.28)GO TO 540
308       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
309      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SGNISC)
310       RETURN
311   210 SGNISC=0.0
312   220 CONTINUE
313       COMM= ' COLISN: INELASTIC SCATTERING CROSS SECTION WAS NOT CHOSEN'
314       NMT4(MED)=NMT4(MED)-1
315       FSUMIS = 1./SUMIS
316       GO TO 550
317   230 CONTINUE
318       COMM=' COLISN: NO SECONDARY ENERGY DISTRIBUTION WAS FOUND MT-91'
319       ISTOP=1
320       GO TO 560
321   240 SIGNIS=0.0
322   250 CONTINUE
323 C       DETERMINE (N,2N) CROSS SECTION (MT-16)
324       ID=8
325       L1=LDICT(ID,IIN)
326       IF(L1.EQ.0)GO TO 290
327       LS1=IDICTS(ID,IIN)+LMOX2
328       LEN=L1/2
329       CALL TBSPLT(D(LS1),E,LEN,SIGN2N)
330       SUMS=SUMS+SIGN2N/SIGTNS*FSUMS
331       IF(R.GT.SUMS)GO TO 300
332 C       REACTION TYPE IS (N,2N)
333       NMT16(MED)=NMT16(MED)+1
334 C       USE THE ONE NEUTRON EMISSION MODEL AND MULTIPLY THE
335 C       WEIGHT BY TWO
336 C changed to 2 neutron production CZ July 30, 1992
337 CZ      WATE=2.0*WATE
338 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
339 C       LABORATORY COORDINATE SYSTEM
340       L1=LDICT(72,IIN)
341       IF(L1.EQ.0)GO TO 260
342       LS1=IDICTS(72,IIN)+LMOX2
343       LEN=L1
344 C get scattering angle for 1. neutron
345       CALL CANGLE(D(LS1),D(LS1),E,FM(1),LEN)
346 C get scattering angle for 2. neutron
347       CALL CANGLE(D(LS1),D(LS1),E,FM(2),LEN)
348       GO TO 270
349 C       ASSUME ISOTROPIC IN THE LABORATORY COORDINATE SYSTEM
350   260 CONTINUE
351       IFLG=1
352 C       DETERMINE THE EXIT NEUTRON ENERGY IN THE LABORATORY
353 C       COORDINATE SYSTEM
354   270 INEU = 2
355       L1=LDICT(123,IIN)
356       IF(L1.EQ.0)GO TO 280
357       LS1=IDICTS(123,IIN)+LMOX2
358       CALL GETENE(E,D(LS1),D(LS1),INEU)
359 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
360 C       COORDINATE SYSTEM
361       QI=Q(ID,IIN)
362       CALL N2NN3N(D,D,AWRI,KZI,ID,FM,QI,IFLG)
363       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
364      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGN2N)
365       RETURN
366   280 CONTINUE
367       COMM=' COLISN: NO SECONDARY ENERGY DISTRIBUTION WAS FOUND MT-16'
368       ISTOP=1
369       GO TO 560
370   290 SIGN2N=0.0
371   300 CONTINUE
372 C       DETERMINE (N,3N) CROSS SECTION (MT-17)
373       ID=9
374       L1=LDICT(ID,IIN)
375       IF(L1.EQ.0)GO TO 350
376       LS1=IDICTS(ID,IIN)+LMOX2
377       LEN=L1/2
378       CALL TBSPLT(D(LS1),E,LEN,SIGN3N)
379       SUMS=SUMS+SIGN3N/SIGTNS*FSUMS
380       IF(R.GT.SUMS)GO TO 360
381 C       REACTION TYPE IS (N,3N)
382       NMT17(MED)=NMT17(MED)+1
383 C       USE THE ONE NEUTRON EMISSION MODEL AND MULTIPLY THE
384 C       WEIGHT BY THREE
385 C changed to 3 neutron production CZ July 30,1992
386 CZ      WATE=3.0*WATE
387 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
388 C       LABORATORY COORDINATE SYSTEM
389       L1=LDICT(73,IIN)
390       IF(L1.EQ.0)GO TO 320
391       LS1=IDICTS(73,IIN)+LMOX2
392       LEN=L1
393       DO 310 KN=1,3
394          CALL CANGLE(D(LS1),D(LS1),E,FM(KN),LEN)
395   310 CONTINUE
396       GO TO 330
397 C       ASSUME ISOTROPIC IN THE LABORATORY COORDINATE SYSTEM
398   320 CONTINUE
399       IFLG=1
400 C       DETERMINE THE EXIT NEUTRON ENERGY IN THE LABORATORY
401 C       COORDINATE SYSTEM
402   330 L1=LDICT(124,IIN)
403       IF(L1.EQ.0)GO TO 340
404       LS1=IDICTS(124,IIN)+LMOX2
405       INEU = 3
406       CALL GETENE(E,D(LS1),D(LS1),INEU)
407 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
408 C       COORDINATE SYSTEM
409       QI=Q(ID,IIN)
410       CALL N2NN3N(D,D,AWRI,KZI,ID,FM,QI,IFLG)
411       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
412      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGN3N)
413       RETURN
414   340 CONTINUE
415       COMM= ' COLISN; NO SECONDARY ENERGY DISTRIBUTION WAS FOUND MT-17'
416       ISTOP=1
417       GO TO 560
418   350 SIGN3N=0.0
419   360 CONTINUE
420 C       DETERMINE (N,N"A) CROSS SECTION (MT-22)
421       ID=11
422       L1=LDICT(ID,IIN)
423       IF(L1.EQ.0)GO TO 400
424       LS1=IDICTS(ID,IIN)+LMOX2
425       LEN=L1/2
426       CALL TBSPLT(D(LS1),E,LEN,SIGNNA)
427       SUMS=SUMS+SIGNNA/SIGTNS*FSUMS
428       IF(R.GT.SUMS)GO TO 410
429 C       REACTION TYPE IS (N,N"A)
430       NMT22(MED)=NMT22(MED)+1
431 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
432 C       LABORATORY COORDINATE SYSTEM
433       L1=LDICT(75,IIN)
434       IF(L1.EQ.0)GO TO 370
435       LS1=IDICTS(75,IIN)+LMOX2
436       LEN=L1
437       CALL CANGLE(D(LS1),D(LS1),E,FM(1),LEN)
438       GO TO 380
439 C       ASSUME ISOTROPIC IN THE LABORATORY COORDINATE SYSTEM
440   370 CALL GTISO(U1,V1,W1)
441       U=U1
442       V=V1
443       W=W1
444       LIFLAG=1
445 C       DETERMINE THE EXIT NEUTRON ENERGY IN THE LABORATORY
446 C       COORDINATE SYSTEM
447   380 L1=LDICT(126,IIN)
448       IF(L1.EQ.0)GO TO 390
449       LS1=IDICTS(126,IIN)+LMOX2
450       CALL SECEGY(EX,D(LS1),E,D(LS1))
451       E=EX
452       IFLG=1
453 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
454 C       COORDINATE SYSTEM
455       QI=Q(ID,IIN)
456       LRI=22
457       CALL CMLABI(D,D,AWRI,KZI,ID,FM(1),QI,IFLG,LIFLAG,LRI)
458 C Re-sample if no energy determined in CMLABI
459       IF(IFLG.EQ.-1) GOTO 10
460       UP = U
461       VP = V
462       WP = W
463       EP = E
464       AGEP = AGE
465       MTP = 22
466       CALL STOPAR(IDNEU,NNEU)
467       KZ1=2
468       KZ2=KZI-KZ1
469       ATAR=AWRI*AN
470       A1=AA
471       A2=ATAR-AA
472       Z1=ZA
473       Z2=A2*9.31075E+08
474       MT=22
475       CALL NN2BOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
476       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
477      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNNA)
478       RETURN
479   390 CONTINUE
480       COMM=' COLISN; NO SECONDARY ENERGY DISTRIBUTION WAS FOUND MT-22'
481       ISTOP=1
482       GO TO 560
483   400 SIGNNA=0.0
484   410 CONTINUE
485 C       DETERMINE (N,2NA) CROSS SECTION (MT-24)
486       ID=12
487       L1=LDICT(ID,IIN)
488       IF(L1.EQ.0)GO TO 450
489       LS1=IDICTS(ID,IIN)+LMOX2
490       LEN=L1/2
491       CALL TBSPLT(D(LS1),E,LEN,SGN2NA)
492       SUMS=SUMS+SGN2NA/SIGTNS*FSUMS
493       IF(R.GT.SUMS)GO TO 460
494 C       REACTION TYPE IS (N,2NA)
495       NMT24(MED)=NMT24(MED)+1
496 C       USE THE ONE NEUTRON EMISSION MODEL AND MULTIPLY THE
497 C       WEIGHT BY TWO
498 C changed to 2 neutron production CZ July 30,1992
499 CZ      WATE=2.0*WATE
500 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
501 C       LABORATORY COORDINATE SYSTEM
502       L1=LDICT(76,IIN)
503       IF(L1.EQ.0)GO TO 420
504       LS1=IDICTS(76,IIN)+LMOX2
505       LEN=L1
506       CALL CANGLE(D(LS1),D(LS1),E,FM(1),LEN)
507       CALL CANGLE(D(LS1),D(LS1),E,FM(2),LEN)
508       GO TO 430
509 C       ASSUME ISOTROPIC IN THE LABORATORY COORDINATE SYSTEM
510   420 CONTINUE
511       IFLG=1
512 C       DETERMINE THE EXIT NEUTRON ENERGY IN THE LABORATORY
513 C       COORDINATE SYSTEM
514   430 L1=LDICT(127,IIN)
515       IF(L1.EQ.0)GO TO 440
516       LS1=IDICTS(127,IIN)+LMOX2
517       INEU=2
518       CALL GETENE(E,D(LS1),D(LS1),INEU)
519 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
520 C       COORDINATE SYSTEM
521       QI=Q(ID,IIN)
522       CALL N2NN3N(D,D,AWRI,KZI,ID,FM,QI,IFLG)
523       KZ1=2
524       KZ2=KZI-KZ1
525       ATAR=AWRI*AN
526       A1=AA
527       A2=ATAR-AN-AA
528       Z1=ZA
529       Z2=A2*9.31075E+08
530       MT=24
531       CALL NN2BOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
532       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
533      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SGN2NA)
534       RETURN
535   440 CONTINUE
536       COMM=' COLISN; NO SECONDARY ENERGY DISTRIBUTION WAS FOUND MT-24'
537       ISTOP=1
538       GO TO 560
539   450 SGN2NA=0.0
540   460 CONTINUE
541 C       DETERMINE (N,N"P) CROSS SECTION (MT-28)
542       ID=13
543       L1=LDICT(ID,IIN)
544       IF(L1.EQ.0)GO TO 500
545       LS1=IDICTS(ID,IIN)+LMOX2
546       LEN=L1/2
547       CALL TBSPLT(D(LS1),E,LEN,SIGNNP)
548       SUMS=SUMS+SIGNNP/SIGTNS*FSUMS
549       IF(R.GT.SUMS)GO TO 510
550 C       REACTION TYPE IS (N,N"P)
551       NMT28(MED)=NMT28(MED)+1
552 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
553 C       LABORATORY COORDINATE SYSTEM
554       L1=LDICT(77,IIN)
555       IF(L1.EQ.0)GO TO 470
556       LS1=IDICTS(77,IIN)+LMOX2
557       LEN=L1
558       CALL CANGLE(D(LS1),D(LS1),E,FM(1),LEN)
559       GO TO 480
560 C       ASSUME ISOTROPIC IN THE LABORATORY COORDINATE SYSTEM
561   470 CALL GTISO(U1,V1,W1)
562       U=U1
563       V=V1
564       W=W1
565       LIFLAG=1
566 C       DETERMINE THE EXIT NEUTRON ENERGY IN THE LABORATORY
567 C       COORDINATE SYSTEM
568   480 L1=LDICT(128,IIN)
569       IF(L1.EQ.0)GO TO 490
570       LS1=IDICTS(128,IIN)+LMOX2
571       CALL SECEGY(EX,D(LS1),E,D(LS1))
572       E=EX
573       IFLG=1
574 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
575 C       COORDINATE SYSTEM
576       QI=Q(ID,IIN)
577       LRI=28
578       CALL CMLABI(D,D,AWRI,KZI,ID,FM(1),QI,IFLG,LIFLAG,LRI)
579 C Re-sample if no energy determined in CMLABI
580       IF(IFLG.EQ.-1) GOTO 10
581       EP = E
582       UP = U
583       VP = V
584       WP = W
585       AGEP = AGE
586       MTP = 28
587       CALL STOPAR(IDNEU,NNEU)
588       KZ1=1
589       KZ2=KZI-KZ1
590       ATAR=AWRI*AN
591       A1=AP
592       A2=ATAR-AP
593       Z1=ZP
594       Z2=A2*9.31075E+08
595       MT=28
596       CALL NN2BOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
597       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
598      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNNP)
599       RETURN
600   490 CONTINUE
601       COMM=' COLISN; NO SECONDARY ENERGY DISTRIBUTION FOUND FOR MT-28'
602       SIGREC=SIGTNS
603       SUMREC=SUMS
604       ISTOP=1
605       GO TO 560
606   500 SIGNNP=0.0
607   510 CONTINUE
608       FSUMS = 1./SUMS
609       GO TO 550
610   520 CONTINUE
611 C       REACTION TYPE IS (N,N"A) USING LR FLAG
612       NMT22(MED)=NMT22(MED)+1
613       SIGNNA=SGNISD
614       IF(ID.EQ.54)SIGNNA=SGNISC
615       KZ1=2
616       KZ2=KZI-KZ1
617       ATAR=AWRI*AN
618       A1=AA
619       A2=ATAR-AA
620       Z1=ZA
621       Z2=A2*9.31075E+08
622       MT=22
623       CALL LR2BOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,QLRI,ID,MT)
624       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
625      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNNA)
626       RETURN
627   530 CONTINUE
628 C       REACTION TYPE IS (N,N"3A) USING LR FLAG
629 C       CARBON-12 IS CURRENTLY THE ONLY ELEMENT CONTAINING MT-23
630       NMT23(MED)=NMT23(MED)+1
631       SGNN3A=SGNISD
632       IF(ID.EQ.54)SGNN3A=SGNISC
633       KZ1=2
634       KZ2=KZI-KZ1
635       ATAR=AWRI*AN
636       A1=AA
637       A2=ATAR-AA
638       Z1=ZA
639       Z2=A2*9.31075E+08
640 C       QBE8 IS THE MASS DIFFERENCE FOR A CARBON-ALPHA EMISSION
641       MT=23
642       CALL LR2BOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,QBE8,ID,MT)
643       KZ1=2
644       KZ2=KZ2-KZ1
645       ATAR=AWRI*AN
646       A1=AA
647       A2=A2-AA
648       Z1=ZA
649       Z2=A2*9.31075E+08
650       MT=23
651       CALL LR2BOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QBE8,QLRI,ID,MT)
652       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
653      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SGNN3A)
654       RETURN
655   540 CONTINUE
656 C       REACTION TYPE IS (N,N"P) USING LR FLAG
657       NMT28(MED)=NMT28(MED)+1
658       SIGNNP=SGNISD
659       IF(ID.EQ.54)SIGNNP=SGNISC
660       KZ1=1
661       KZ2=KZI-KZ1
662       ATAR=AWRI*AN
663       A1=AP
664       A2=ATAR-AP
665       Z1=ZP
666       Z2=A2*9.31075E+08
667       MT=28
668       CALL LR2BOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,QLRI,ID,MT)
669       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
670      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNNP)
671       RETURN
672   550 ITRY=ITRY+1
673       NSEI(IIN)=NSEI(IIN)-1
674       ISTOP = 1
675       IF((FSUMS.GT.0.1.AND.FSUMS.LE.10.0).AND.
676      +   (FSUMIS.GT.0.1.AND.FSUMIS.LE.10.0)) ISTOP = 0
677       IF(ISTOP.EQ.0.AND.ITRY.LE.5) GOTO 20
678 C       A SCATTERING REACTION WAS NOT CHOSEN
679       COMM=' COLISN: A SCATTERING REACTION TYPE WAS NOT CHOSEN '
680       SIGREC=SIGTNS
681       SUMREC=SUMS
682       GOTO 980
683   560 CONTINUE
684       IF(ISTOP.EQ.1)GO TO 980
685       ITRY=0
686       GO TO 20
687 C       THE REACTION TYPE IS AN ABSORPTION
688   570 NAEI(IIN)=NAEI(IIN)+1
689       R=FLTRNF(0)
690 C       DETERMINE THE FISSION CROSS SECTION (MT-18)
691 C       THE TREATMENT OF THE FISSION REACTION ASSUMES THE FISSION
692 C       CROSS SECTION IS STORED AS NUBAR*SIGF
693       ID=10
694       L1=LDICT(ID,IIN)
695       IF(L1.EQ.0)GO TO 640
696       LS1=IDICTS(ID,IIN)+LMOX2
697       LEN=L1/2
698       CALL TBSPLT(D(LS1),E,LEN,SIGNF)
699 C       DETERMINE THE AVERAGE NUMBER OF NEUTRONS EMITTED PER FISSION
700 C       EVENT (NUBAR)
701       L1=LDICT(134,IIN)
702       IF(L1.EQ.0)GO TO 630
703       LS1=IDICTS(134,IIN)+LMOX2
704       LEN=L1
705       CALL GETNU(D(LS1),D(LS1),EOLD,LEN,XNU)
706 C       EXTRACT THE FISSION CROSS SECTION FROM THE NUBAR*SIGF CROSS
707 C       SECTION STORED IN POSITION 10 OF THE DICTIONARY
708       SIGNF=SIGNF/XNU
709       SUMA=SIGNF/SIGTNA*FSUMA
710       IF(R.GT.SUMA)GO TO 650
711 C       THE REACTION TYPE IS (N,F)
712       NMT18(MED)=NMT18(MED)+1
713       WATE = 0.0
714 C       DETERMINE THE COSINE OF THE NEUTRON SCATTERING ANGLE IN THE
715 C       LABORATORY COORDINATE SYSTEM
716 C changed in order to get N fission neutron CZ July 30,1992
717 C INEU is poisson distributed with mean XNU
718   580 CALL GPOISS(XNU,INEU,1)
719       IF(INEU.GT.INT(4.*XNU)) GOTO 580
720 C check for maximum number of neutrons emitted
721       IF(INEU.GT.INT(AWRI)-KZ(MED)) INEU = INT(AWRI) - KZ(MED)
722       IF(INEU.GT.MAXNEU) INEU = MAXNEU
723       L1=LDICT(74,IIN)
724       IF(L1.EQ.0)GO TO 600
725       LS1=IDICTS(74,IIN)+LMOX2
726       LEN=L1
727       DO 590 KN=1,INEU
728          CALL CANGLE(D(LS1),D(LS1),E,FM(KN),LEN)
729   590 CONTINUE
730       GO TO 610
731 C       ASSUME ISOTROPIC IN THE LABORATORY COORDINATE SYSTEM
732   600 CONTINUE
733       LIFLAG=1
734 C       DETERMINE THE EXIT NEUTRON ENERGY IN THE LABORATORY
735 C       COORDINATE SYSTEM
736   610 L1=LDICT(125,IIN)
737       IF(L1.EQ.0)GO TO 620
738       LS1=IDICTS(125,IIN)+LMOX2
739       IF(INEU.GT.0) CALL GETENE(E,D(LS1),D(LS1),INEU)
740 C       DETERMINE THE EXIT NEUTRON WEIGHT FROM THE AVERAGE NUMBER
741 C       OF NEUTRONS EMITTED PER FISSION REACTION (NU)
742 C changed CZ July 30,1992
743 CZ      WATE=WATE*XNU
744 C       DETERMINE THE EXIT COLLISION PARAMETERS IN THE LABORATORY
745 C       COORDINATE SYSTEM
746       QI=Q(ID,IIN)
747       IF(INEU.GT.0) CALL LABNF(D,D,FM,AWRI,KZI,QI,LIFLAG)
748       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
749      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNF)
750       NPSCL(3)=NPSCL(3)+1
751       CALL BANKR(D,D,3)
752       RETURN
753   620 CONTINUE
754       COMM=' COLISN: NO SECONDARY ENERGY DISTRIBUTION FOUND FOR MT-18'
755       SIGREC=SIGNF
756       SUMREC=SUMA
757       ISTOP=1
758       GO TO 970
759   630 CONTINUE
760       COMM=' COLISN: NO NUMBER OF FISSION NEUTRON FOUND FOR MT-18'
761       SIGREC=SIGNF
762       SUMREC=SUMA
763       ISTOP=1
764       GO TO 970
765   640 SIGNF=0.0
766   650 CONTINUE
767 C       DETERMINE (N,G) CROSS SECTION (MT-102)
768       ID=55
769       L1=LDICT(ID,IIN)
770       IF(L1.EQ.0)GO TO 660
771       LS1=IDICTS(ID,IIN)+LMOX2
772       LEN=L1/2
773       CALL TBSPLT(D(LS1),E,LEN,SIGNG)
774       SUMA=SUMA+SIGNG/SIGTNA*FSUMA
775       IF(R.GT.SUMA)GO TO 670
776 C       THE REACTION TYPE IS (N,G)
777       NMT102(MED)=NMT102(MED)+1
778       QI=Q(ID,IIN)
779       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
780      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNG)
781       MT=102
782       CALL NGHEVY(D,D,KZI,AWRI,QI,MT)
783       WATE=0.0
784       RETURN
785   660 SIGNG=0.0
786   670 CONTINUE
787 C       DETERMINE (N,P) CROSS SECTION (MT-103)
788       ID=56
789       L1=LDICT(ID,IIN)
790       IF(L1.EQ.0)GO TO 690
791       LS1=IDICTS(ID,IIN)+LMOX2
792       LEN=L1/2
793       CALL TBSPLT(D(LS1),E,LEN,SIGNP)
794       SUMA=SUMA+SIGNP/SIGTNA*FSUMA
795       IF(R.GT.SUMA)GO TO 700
796 C       THE REACTION TYPE IS (N,P)
797       NMT103(MED)=NMT103(MED)+1
798       QI=Q(ID,IIN)
799       KZ1=1
800       KZ2=KZI-KZ1
801       ATAR=AWRI*AN
802       A1=AP
803       A2=ATAR+AN-AP
804       Z1=ZP
805       Z2=A2*9.31075E+08
806       MT=103
807       IF(KZI.EQ.6)GO TO 680
808       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
809       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
810      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNP)
811       WATE=0.0
812       RETURN
813   680 CALL GRNDST(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
814       WATE=0.0
815       RETURN
816   690 SIGNP=0.0
817   700 CONTINUE
818 C       DETERMINE (N,D) CROSS SECTION (MT-104)
819       ID=57
820       L1=LDICT(ID,IIN)
821       IF(L1.EQ.0)GO TO 720
822       LS1=IDICTS(ID,IIN)+LMOX2
823       LEN=L1/2
824       CALL TBSPLT(D(LS1),E,LEN,SIGND)
825       SUMA=SUMA+SIGND/SIGTNA*FSUMA
826       IF(R.GT.SUMA)GO TO 730
827 C       THE REACTION TYPE IS (N,D)
828       NMT104(MED)=NMT104(MED)+1
829       QI=Q(ID,IIN)
830       KZ1=1
831       KZ2=KZI-KZ1
832       ATAR=AWRI*AN
833       A1=AD
834       A2=ATAR+AN-AD
835       Z1=ZD
836       Z2=A2*9.31075E+08
837       MT=104
838       IF((KZI.EQ.5).OR.(KZI.EQ.6))GO TO 710
839       IF((KZI.EQ.8).OR.(KZI.EQ.13))GO TO 710
840       IF((KZI.EQ.14).OR.(KZI.EQ.20))GO TO 710
841       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
842       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
843      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGND)
844       WATE=0.0
845       RETURN
846   710 CALL GRNDST(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
847       WATE=0.0
848       RETURN
849   720 SIGND=0.0
850   730 CONTINUE
851 C       DETERMINE (N,T) CROSS SECTION (MT-105)
852       ID=58
853       L1=LDICT(ID,IIN)
854       IF(L1.EQ.0)GO TO 750
855       LS1=IDICTS(ID,IIN)+LMOX2
856       LEN=L1/2
857       CALL TBSPLT(D(LS1),E,LEN,SIGNT)
858       SUMA=SUMA+SIGNT/SIGTNA*FSUMA
859       IF(R.GT.SUMA)GO TO 760
860 C       THE REACTION TYPE IS (N,T)
861       NMT105(MED)=NMT105(MED)+1
862       QI=Q(ID,IIN)
863       KZ1=1
864       KZ2=KZI-KZ1
865       ATAR=AWRI*AN
866       A1=AT
867       A2=ATAR+AN-AT
868       Z1=ZT
869       Z2=A2*9.31075E+08
870       MT=105
871       IF((KZI.EQ.5).OR.(KZI.EQ.13))GO TO 740
872       IF(KZI.EQ.20)GO TO 740
873       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
874       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
875      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNT)
876       WATE=0.0
877       RETURN
878   740 CALL GRNDST(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
879       WATE=0.0
880       RETURN
881   750 SIGNT=0.0
882   760 CONTINUE
883 C       DETERMINE (N,3HE) CROSS SECTION (MT-106)
884       ID=59
885       L1=LDICT(ID,IIN)
886       IF(L1.EQ.0)GO TO 780
887       LS1=IDICTS(ID,IIN)+LMOX2
888       LEN=L1/2
889       CALL TBSPLT(D(LS1),E,LEN,SGN3HE)
890       SUMA=SUMA+SGN3HE/SIGTNA*FSUMA
891       IF(R.GT.SUMA)GO TO 790
892 C       THE REACTION TYPE IS (N,3HE)
893       NMT106(MED)=NMT106(MED)+1
894       QI=Q(ID,IIN)
895       KZ1=2
896       KZ2=KZI-KZ1
897       ATAR=AWRI*AN
898       A1=AHE3
899       A2=ATAR+AN-AHE3
900       Z1=ZHE3
901       Z2=A2*9.31075E+08
902       MT=106
903       IF(KZI.EQ.20)GO TO 770
904       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
905       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
906      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SGN3HE)
907       WATE=0.0
908       RETURN
909   770 CALL GRNDST(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
910       WATE=0.0
911       RETURN
912   780 SGN3HE=0.0
913   790 CONTINUE
914 C       DETERMINE (N,A) CROSS SECTION (MT-107)
915       ID=60
916       L1=LDICT(ID,IIN)
917       IF(L1.EQ.0)GO TO 810
918       LS1=IDICTS(ID,IIN)+LMOX2
919       LEN=L1/2
920       CALL TBSPLT(D(LS1),E,LEN,SIGNA)
921       SUMA=SUMA+SIGNA/SIGTNA*FSUMA
922       IF(R.GT.SUMA)GO TO 820
923 C       THE REACTION TYPE IS (N,A)
924       NMT107(MED)=NMT107(MED)+1
925       QI=Q(ID,IIN)
926       KZ1=2
927       KZ2=KZI-KZ1
928       ATAR=AWRI*AN
929       A1=AA
930       A2=ATAR+AN-AA
931       Z1=ZA
932       Z2=A2*9.31075E+08
933       MT=107
934       IF((KZI.EQ.6).OR.(KZI.EQ.13))GO TO 800
935       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
936       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
937      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNA)
938       WATE=0.0
939       RETURN
940   800 CALL GRNDST(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
941       WATE=0.0
942       RETURN
943   810 SIGNA=0.0
944   820 CONTINUE
945 C       DETERMINE (N,2A) CROSS SECTION (MT-108)
946       ID=61
947       L1=LDICT(ID,IIN)
948       IF(L1.EQ.0)GO TO 840
949       LS1=IDICTS(ID,IIN)+LMOX2
950       LEN=L1/2
951       CALL TBSPLT(D(LS1),E,LEN,SIGN2A)
952       SUMA=SUMA+SIGN2A/SIGTNA*FSUMA
953       IF(R.GT.SUMA)GO TO 850
954 C       THE REACTION TYPE IS (N,2A)
955       NMT108(MED)=NMT108(MED)+1
956       QI=Q(ID,IIN)
957       KZ1=2
958       KZ2=KZI-2*KZ1
959       ATAR=AWRI*AN
960       A1=AA
961       A2=ATAR+AN-AA
962       Z1=ZA
963       Z2=A2*9.31075E+08
964       MT=108
965 C       USE THE ONE PARTICLE EMISSION MODEL AND MULTIPLY THE
966 C       WEIGHT BY TWO
967       IF((KZI.EQ.7).OR.(KZI.EQ.20))GO TO 830
968       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
969       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
970      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGN2A)
971       WATE=0.0
972       RETURN
973   830 CALL GRNDST(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
974       WATE=0.0
975       RETURN
976   840 SIGN2A=0.0
977   850 CONTINUE
978 C       DETERMINE (N,3A) CROSS SECTION (MT-109)
979       ID=62
980       L1=LDICT(ID,IIN)
981       IF(L1.EQ.0)GO TO 860
982       LS1=IDICTS(ID,IIN)+LMOX2
983       LEN=L1/2
984       CALL TBSPLT(D(LS1),E,LEN,SIGN3A)
985       SUMA=SUMA+SIGN3A/SIGTNA*FSUMA
986       IF(R.GT.SUMA)GO TO 870
987 C       THE REACTION TYPE IS (N,3A)
988       NMT109(MED)=NMT109(MED)+1
989       QI=Q(ID,IIN)
990       KZ1=2
991       KZ2=KZI-3*KZ1
992       ATAR=AWRI*AN
993       A1=AA
994       A2=ATAR+AN-AA
995       Z1=ZA
996       Z2=A2*9.31075E+08
997       MT=109
998 C       USE THE ONE PARTICLE EMISSION MODEL AND MULTIPLY THE
999 C       WEIGHT BY THREE
1000       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
1001       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
1002      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGN3A)
1003       WATE=0.0
1004       RETURN
1005   860 SIGN3A=0.0
1006   870 CONTINUE
1007 C       DETERMINE (N,2P) CROSS SECTION (MT-111)
1008       ID=63
1009       L1=LDICT(ID,IIN)
1010       IF(L1.EQ.0)GO TO 890
1011       LS1=IDICTS(ID,IIN)+LMOX2
1012       LEN=L1/2
1013       CALL TBSPLT(D(LS1),E,LEN,SIGN2P)
1014       SUMA=SUMA+SIGN2P/SIGTNA*FSUMA
1015       IF(R.GT.SUMA)GO TO 900
1016 C       THE REACTION TYPE IS (N,2P)
1017       NMT111(MED)=NMT111(MED)+1
1018       QI=Q(ID,IIN)
1019       KZ1=1
1020       KZ2=KZI-2*KZ1
1021       ATAR=AWRI*AN
1022       A1=AP
1023       A2=ATAR+AN-AP
1024       Z1=ZP
1025       Z2=A2*9.31075E+08
1026       MT=111
1027 C       USE THE ONE PARTICLE EMISSION MODEL AND MULTIPLY THE
1028 C       WEIGHT BY TWO
1029       IF(KZI.EQ.20)GO TO 880
1030       CALL TWOBOD(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
1031       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
1032      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGN2P)
1033       WATE=0.0
1034       RETURN
1035   880 CALL GRNDST(D,D,KZ1,KZ2,A1,A2,Z1,Z2,ATAR,QI,MT)
1036       WATE=0.0
1037       RETURN
1038   890 SIGN2P=0.0
1039   900 CONTINUE
1040 C       DETERMINE (N,PA) CROSS SECTION (MT-112)
1041       ID=64
1042       L1=LDICT(ID,IIN)
1043       IF(L1.EQ.0)GO TO 910
1044       LS1=IDICTS(ID,IIN)+LMOX2
1045       LEN=L1/2
1046       CALL TBSPLT(D(LS1),E,LEN,SIGNPA)
1047       SUMA=SUMA+SIGNPA/SIGTNA*FSUMA
1048       IF(R.GT.SUMA)GO TO 920
1049 C       THE REACTION TYPE IS (N,PA)
1050       NMT112(MED)=NMT112(MED)+1
1051       QI=Q(ID,IIN)
1052       KZ1=1
1053       KZ2=2
1054       KZ3=KZI-KZ1-KZ2
1055       ATAR=AWRI*AN
1056       A1=AP
1057       A2=AA
1058       A3=ATAR+AN-A1
1059       Z1=ZP
1060       Z2=ZA
1061       Z3=A3*9.31075E+08
1062       MT=112
1063 CZ July 30,1992 Three-Body process added ----
1064       CALL TREBOD(D,D,KZ1,KZ2,KZ3,A1,A2,A3,Z1,Z2,Z3,ATAR,QI,MT)
1065       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
1066      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SIGNPA)
1067       WATE=0.0
1068       RETURN
1069   910 SIGNPA=0.0
1070   920 CONTINUE
1071 C       DETERMINE (N,T2A) CROSS SECTION (MT-113)
1072       ID=65
1073       L1=LDICT(ID,IIN)
1074       IF(L1.EQ.0)GO TO 930
1075       LS1=IDICTS(ID,IIN)+LMOX2
1076       LEN=L1/2
1077       CALL TBSPLT(D(LS1),E,LEN,SGNT2A)
1078       SUMA=SUMA+SGNT2A/SIGTNA*FSUMA
1079       IF(R.GT.SUMA)GO TO 940
1080 C       THE REACTION TYPE IS (N,T2A)
1081       NMT113(MED)=NMT113(MED)+1
1082       QI=Q(ID,IIN)
1083       KZ1=1
1084       KZ2=2
1085       KZ3=KZI-KZ1-2*KZ2
1086       ATAR=AWRI*AN
1087       A1=AT
1088       A2=AA
1089       A3=ATAR+AN-A1
1090       Z1=ZT
1091       Z2=ZA
1092       Z3=A3*9.31075E+08
1093       MT=113
1094 CZ July 30,1992 Three-Body process added ----
1095       CALL TREBOD(D,D,KZ1,KZ2,KZ3,A1,A2,A3,Z1,Z2,Z3,ATAR,QI,MT)
1096       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
1097      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SGNT2A)
1098       WATE=0.0
1099       RETURN
1100   930 SGNT2A=0.0
1101   940 CONTINUE
1102 C       DETERMINE (N,D2A) CROSS SECTION (MT-114)
1103       ID=66
1104       L1=LDICT(ID,IIN)
1105       IF(L1.EQ.0)GO TO 950
1106       LS1=IDICTS(ID,IIN)+LMOX2
1107       LEN=L1/2
1108       CALL TBSPLT(D(LS1),E,LEN,SGND2A)
1109       SUMA=SUMA+SGND2A/SIGTNA*FSUMA
1110       IF(R.GT.SUMA)GO TO 960
1111 C       THE REACTION TYPE IS (N,D2A)
1112       NMT114(MED)=NMT114(MED)+1
1113       QI=Q(ID,IIN)
1114       KZ1=1
1115       KZ2=2
1116       KZ3=KZI-KZ1-2*KZ2
1117       ATAR=AWRI*AN
1118       A1=AD
1119       A2=AA
1120       A3=ATAR+AN-A1
1121       Z1=ZD
1122       Z2=ZA
1123       Z3=A3*9.31075E+08
1124       MT=114
1125 CZ July 30,1992 Three-Body process added ----
1126       CALL TREBOD(D,D,KZ1,KZ2,KZ3,A1,A2,A3,Z1,Z2,Z3,ATAR,QI,MT)
1127       CALL PHOTON(D,D,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,
1128      +IGCBS2,LGCB2,LR,IGAMS,LGAM,QI,ID,IIN,LRI,SGND2A)
1129       WATE=0.0
1130       RETURN
1131   950 SGND2A=0.0
1132   960 CONTINUE
1133       FSUMA = 1./SUMA
1134       ITRY=ITRY+1
1135       ISTOP=1
1136       IF(FSUMA.GT.0.1.AND.FSUMA.LE.10.0) ISTOP=0
1137       NAEI(IIN)=NAEI(IIN)-1
1138       IF(ISTOP.EQ.0.AND.ITRY.LE.5)GO TO 20
1139 C       AN ABSORPTION REACTION WAS NOT CHOSEN
1140       COMM=' COLISN:AN ABSORPTION REACTION TYPE WAS NOT CHOSEN '
1141       SIGREC = SIGTNA
1142       SUMREC = SUMA
1143       GOTO 980
1144   970 CONTINUE
1145       IF(ISTOP.EQ.1)GO TO 980
1146       ITRY=0
1147       GO TO 20
1148   980 CONTINUE
1149       WRITE(IOUT,'(A80,/,I5,F7.1,I4,/,G18.7,I5,3G10.4)') COMM,
1150      +      NMED,AWR(IIN),KZ(IIM),
1151      +      E,MT,
1152      +      SIGT,SIGREC,SUMREC
1153       RETURN
1154       END