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