GEANT321/fluka/nizl.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:04  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.44  by  S.Giani
  11 *-- Author :
  12 *$ CREATE NIZL.FOR
  13 *COPY NIZL
  14 *                                                                      *
  15 *=== nizl =============================================================*
  16 *                                                                      *
  17       SUBROUTINE NIZL ( IT, AAA, EKE, PO, SI, ZL )
  18
  19 #include "geant321/dblprc.inc"
  20 #include "geant321/dimpar.inc"
  21 #include "geant321/iounit.inc"
  22 *=====================================================================*
  23 *
  24 *     Revision september 90 by       A. Ferrari
  25 *                                    Milan
  26 *     last change 12 Febr. 1991      by Alfredo Ferrari
  27 *                                    INFN-Milan
  28 *
  29 C********************************************************************
  30 C     VERSION SEPTEMBER 90 BY        A. FERRARI
  31 C                                    INFN, MILAN
  32 C     LAST CHANGE ON 09 JUNE -92 BY  ALFREDO FERRARI
  33 C
  34 C
  35 C     SEE: H.J. MOEHRING, HADRON-NUCLEUS INELASTIC CROSS-SECTIONS FOR
  36 C     USE IN HADRON-CASCADE CALCULATIONS AT HIGH ENERGIES,
  37 C     TIS DIVISION REPORT 14. OCTOBER 1983, TIS-RP/116, CERN GENEVA
  38 C
  39 C
  40 C     THIS IS A SUBROUTINE OF FLUKA82 TO CALCULATE THE INELASTIC
  41 C     SCATTERING LENGTH OF THE MATERIAL IN G/CM**2.
  42 C
  43 C     INPUT VARIABLES:
  44 C        IT     = TYPE OF THE PARTICLE
  45 C        AA     = ATOMIC WEIGHT OF THE NUCLEUS
  46 C        PO     = PARTICLE MOMENTUM IN GEV/C
  47 C
  48 C     OUTPUT VARIABLES:
  49 C        SI     = INTERPOLATED CROSS SECTION IN MILLIBARNS
  50 C        ZL     = INTERPOLATED ABSORPTION LENGTH IN G/CM**2
  51 C
  52 C
  53 C     OTHER INPORTANT VARIABLES:
  54 C        SIG    = PROTON/NUCLEI CROSS SECTIONS
  55 C        SEG    = PION-/NUCLEI CROSS SECTIONS ABOVE 0.3 GEV/C
  56 C        SEGP   = PION+/NUCLEI CROSS SECTIONS ABOVE 0.3 GEV/C
  57 C        SIGKM  = K+ AND K0/NUCLEI CROSS SECTIONS ABOVE 3.0 GEV/C
  58 C        SIGKP  = K+ AND K0 BAR/NUCLEI CROSS SECTIONS ABOVE 3.0 GEV/C
  59 C        SIGAP  = ANTINUCLEON/NUCLEI CROSS SECTIONS ABOVE 3.0 GEV/C
  60 C        SEEG   = PION/NUCLEI CROSS SECTIONS BELOW 0.3 GEV/C
  61 C        P      = MOMENTUMS FOR WHICH THE CROSS SECTIONS ARE GIVEN IN
  62 C                 SIG, SEG, SEGP, SIGKM, SIGKP AND SIGAP
  63 C        PEE    = MOMENTUMS FOR WHICH THE CROSS SECTIONS ARE GIVEN IN
  64 C                 SEEG
  65 C        A      = NUCLEI FOR WHICH THE CROSS SECTIONS ARE GIVEN IN
  66 C                 SIG, SEG, SEGP, SIGKM, SIGKP, SIGAP AND SEEG
  67 C        PLAB   = MOMENTUMS FOR WHICH THE TOTAL CROSS SECTIONS ARE
  68 C                 GIVEN IN TOTCRS
  69 C        TOTCRS = TOTAL CROSS SECTIONS AS A FUNCTION OF MOMENTUM
  70 C                 TOTCRS(K,I) WHERE K=MOMENTUM INDEX,I=REACTION TYPE
  71 C                 I=1:NEGATIVE KAON-PROTON  = KAON ZERO BAR-NEUTRON
  72 C                 I=2:NEGATIVE KAON-NEUTRON = KAON ZERO BAR-PROTON
  73 C                 I=3:POSITIVE KAON-PROTON  = KAON ZERO NEUTRON
  74 C                 I=4:POSITIVE KAON-NEUTRON = KAON ZERO-PROTON
  75 C                 I=5:ANTI NUCLEON-NUCLEON
  76 C
  77 C
  78 C     NOTE1: PRESENTLY CROSS SECTIONS ARE ASSUMED TO BE CONSTANT
  79 C     ABOVE 10000.0 GEV/C FOR ALL PARTICLES AND
  80 C     BELOW 0.13 GEV/C FOR PIONS AND BELOW 0.3 GEV/C FOR OTHERS
  81 C
  82 C     NOTE2: SEE TABLE ITT TO FIND OUT HOW DIFFERENT HADRONS
  83 C     ARE TREATED. ALL PARTICLES WITH PARTICLE NUMBER BIGGER THAN
  84 C     25 ARE TREATED AS PROTONS.
  85 C
  86 C     NOTE3: FOR LEPTONS AND PHOTONS PRACTICALLY ZERO CROSS SECTION
  87 C     IS RETURNED.
  88 C********************************************************************
  89 C
  90 #include "geant321/paprop.inc"
  91 C
  92       PARAMETER ( AVOGMB = 1.0D+27 / AVOGAD )
  93       PARAMETER ( AMPROT = 0.93827231D+00 )
  94       PARAMETER ( AMNEUT = 0.93956563D+00 )
  95       PARAMETER ( AMNTM2 = AMPROT + AMNEUT )
  96       PARAMETER ( AMNCSQ = 0.25D+00 * AMNTM2 * AMNTM2 )
  97 C
  98 C     DIMENSION SIG1(20,5),SEG1(20,5),SEGP1(20,5),SIG2(20,4),
  99 C    *SEG2(20,4),SEGP2(20,4)
 100 C     EQUIVALENCE (SIG(1),SIG1(1)),(SIG(101),SIG2(1)),
 101 C    *(SEG(1),SEG1(1)),(SEG(101),SEG2(1)),
 102 C    *(SEGP(1),SEGP1(1)),(SEGP(101),SEGP2(1))
 103       DIMENSION SEEG(4,9),PEE(4),SIGKP(20,9),SIGKM(20,9),SIGAP(20,9)
 104       DIMENSION SEG(20,9),SIG(20,9),SEGP(20,9),P(20),A(9),ITT(39)
 105       DIMENSION BET(4),ALPH(4)
 106       DIMENSION TOTCRS(19,5)
 107       DIMENSION PLAB(19)
 108       REAL RNDM(1)
 109       SAVE ALPH, BET, A, P, SEEG, PEE, SIG, SEG, SEGP, PLAB, TOTCRS,
 110      &     SIGKP, SIGKM, SIGAP, RND, ITT, IROU1, IROU2
 111       DATA ALPH/.748D0,.803D0,.63D0,.63D0/
 112       DATA BET/1.27D0,1.22D0,.9D0,.9D0/
 113       DATA A/1.D0,9.D0,12.D0,27.D0,55.9D0,63.5D0,112.4D0,
 114      *207.2D0,238.1D0/
 115       DATA P/0.3D0,0.4D0,0.5D0,0.6D0,0.8D0,1.D0,1.5D0,
 116      *2.D0,3.D0,4.D0,5.D0,6.D0,10.D0,
 117      *20.D0,50.D0,100.D0,200.D0,400.D0,1000.D0,10000.D0/
 118       DATA SEEG/0.1D0,16.D0,35.D0,42.D0,360.D0,370.D0,310.D0,290.D0,
 119      * 430.D0,435.D0,380.D0,350.D0,
 120      * 670.D0,650.D0,630.D0,610.D0,
 121      * 1130.D0,1040.D0,1000.D0,1000.D0,
 122      * 1240.D0,1140.D0,1100.D0,1090.D0,
 123      * 1880.D0,1750.D0,1645.D0,1630.D0,
 124      * 2930.D0,2750.D0,2540.D0,2500.D0,
 125      * 3240.D0,3050.D0,2800.D0,2750.D0/
 126       DATA PEE /0.13D0,0.19D0,0.25D0,0.30D0/
 127
 128       DATA ((SIG  (I,J),I= 1,20),J= 1, 3) /
 129      & 1.0000D-04,1.0000D-04,1.0000D-04,1.0000D-01,1.0000D+00,
 130      & 4.0000D+00,2.4500D+01,2.5000D+01,2.7200D+01,2.7800D+01,
 131      & 2.8500D+01,2.9200D+01,2.9700D+01,3.0500D+01,3.1500D+01,
 132      & 3.1700D+01,3.2100D+01,3.2900D+01,3.4500D+01,4.1200D+01,
 133      & 2.0200D+02,1.9400D+02,1.8700D+02,1.7500D+02,1.5800D+02,
 134      & 1.5300D+02,2.1700D+02,2.2000D+02,2.1200D+02,2.0700D+02,
 135      & 2.0300D+02,2.0100D+02,1.9900D+02,1.9600D+02,1.9400D+02,
 136      & 1.9500D+02,1.9600D+02,1.9900D+02,2.0400D+02,2.2600D+02,
 137      & 2.5000D+02,2.4000D+02,2.3000D+02,2.1600D+02,1.9600D+02,
 138      & 1.9000D+02,2.5000D+02,2.6000D+02,2.5900D+02,2.5400D+02,
 139      & 2.4900D+02,2.4700D+02,2.4400D+02,2.4100D+02,2.3900D+02,
 140      & 2.4000D+02,2.4100D+02,2.4400D+02,2.5100D+02,2.7600D+02 /
 141
 142       DATA ((SEG  (I,J),I= 1,20),J= 1, 3) /
 143      & 4.2000D+01,1.9000D+01,1.6100D+01,1.7000D+01,2.2700D+01,
 144      & 3.2500D+01,2.4600D+01,2.6200D+01,2.5000D+01,2.3700D+01,
 145      & 2.3000D+01,2.2500D+01,2.2000D+01,2.1200D+01,2.0800D+01,
 146      & 2.0700D+01,2.1000D+01,2.1900D+01,2.3800D+01,2.8400D+01,
 147      & 2.9000D+02,2.6400D+02,2.1200D+02,1.9000D+02,1.8900D+02,
 148      & 1.9700D+02,1.9000D+02,1.8500D+02,1.8000D+02,1.7500D+02,
 149      & 1.7000D+02,1.6800D+02,1.6400D+02,1.5500D+02,1.4500D+02,
 150      & 1.4500D+02,1.4800D+02,1.5000D+02,1.5500D+02,1.7200D+02,
 151      & 3.5000D+02,3.0000D+02,2.5000D+02,2.4000D+02,2.4500D+02,
 152      & 2.6000D+02,2.4500D+02,2.3000D+02,2.1500D+02,2.1000D+02,
 153      & 2.0900D+02,2.0800D+02,2.0500D+02,1.8500D+02,1.7500D+02,
 154      & 1.7000D+02,1.7000D+02,1.7300D+02,1.8100D+02,2.0500D+02 /
 155
 156       DATA ((SEGP (I,J),I= 1,20),J= 1, 3) /
 157      & 1.0000D-01,1.0000D-01,1.0000D-01,1.0000D-01,6.1000D+00,
 158      & 1.2000D+01,1.7700D+01,1.9500D+01,2.0500D+01,2.0700D+01,
 159      & 2.0600D+01,2.0600D+01,2.0200D+01,1.9800D+01,1.9700D+01,
 160      & 1.9900D+01,2.0500D+01,2.1500D+01,2.3500D+01,3.2200D+01,
 161      & 2.9000D+02,2.6400D+02,2.1200D+02,1.9000D+02,1.8900D+02,
 162      & 1.9700D+02,1.9000D+02,1.8500D+02,1.8000D+02,1.7500D+02,
 163      & 1.7000D+02,1.6800D+02,1.6400D+02,1.5500D+02,1.4500D+02,
 164      & 1.4500D+02,1.4800D+02,1.5000D+02,1.5500D+02,1.7200D+02,
 165      & 3.5000D+02,3.0000D+02,2.5000D+02,2.4000D+02,2.4500D+02,
 166      & 2.6000D+02,2.4500D+02,2.3000D+02,2.1500D+02,2.1000D+02,
 167      & 2.0900D+02,2.0800D+02,2.0500D+02,1.8500D+02,1.7500D+02,
 168      & 1.7000D+02,1.7000D+02,1.7300D+02,1.8100D+02,2.0500D+02 /
 169
 170       DATA ((SIGKP(I,J),I= 1,20),J= 1, 3) /
 171      & 1.0000D-03,1.0000D-03,1.0000D-03,1.0000D-03,2.0000D-01,
 172      & 4.5000D+00,8.9000D+00,1.1600D+01,1.2200D+01,1.3400D+01,
 173      & 1.3600D+01,1.3700D+01,1.3700D+01,1.4900D+01,1.5900D+01,
 174      & 1.6500D+01,1.7400D+01,1.8600D+01,2.0900D+01,2.8800D+01,
 175      & 1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,
 176      & 1.7440D+02,1.7440D+02,1.2960D+02,1.2460D+02,1.2610D+02,
 177      & 1.2460D+02,1.2290D+02,1.1900D+02,1.1700D+02,1.1900D+02,
 178      & 1.2900D+02,1.3100D+02,1.3600D+02,1.4400D+02,1.7400D+02,
 179      & 2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,
 180      & 2.1630D+02,2.1630D+02,1.6330D+02,1.5700D+02,1.5880D+02,
 181      & 1.5700D+02,1.5480D+02,1.5000D+02,1.4800D+02,1.5000D+02,
 182      & 1.6100D+02,1.6400D+02,1.6900D+02,1.7900D+02,2.1900D+02 /
 183
 184       DATA ((SIGKM(I,J),I= 1,20),J= 1, 3) /
 185      & 3.8000D+01,4.3000D+01,2.3000D+01,1.8500D+01,2.0000D+01,
 186      & 2.9000D+01,2.5000D+01,2.3000D+01,2.2500D+01,2.1000D+01,
 187      & 2.0500D+01,2.0000D+01,1.9200D+01,1.8500D+01,1.7800D+01,
 188      & 1.7800D+01,1.8300D+01,1.9200D+01,2.1200D+01,2.8900D+01,
 189      & 1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,
 190      & 1.7440D+02,1.7440D+02,1.7440D+02,1.6160D+02,1.4900D+02,
 191      & 1.4800D+02,1.5000D+02,1.4600D+02,1.3100D+02,1.2900D+02,
 192      & 1.2900D+02,1.3100D+02,1.3600D+02,1.4400D+02,1.7400D+02,
 193      & 2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,
 194      & 2.1630D+02,2.1630D+02,2.1630D+02,2.0040D+02,1.8700D+02,
 195      & 1.8540D+02,1.8700D+02,1.8200D+02,1.6500D+02,1.6100D+02,
 196      & 1.6100D+02,1.6400D+02,1.6900D+02,1.7900D+02,2.1900D+02 /
 197
 198       DATA ((SIGAP(I,J),I= 1,20),J= 1, 3) /
 199      & 1.6400D+02,1.2600D+02,1.1400D+02,9.8000D+01,8.6000D+01,
 200      & 7.2400D+01,5.9000D+01,5.7000D+01,5.3000D+01,5.2000D+01,
 201      & 4.8000D+01,4.5500D+01,4.3500D+01,4.0400D+01,3.6500D+01,
 202      & 3.5200D+01,3.4500D+01,3.4500D+01,3.5400D+01,4.1500D+01,
 203      & 3.2400D+02,3.2400D+02,3.2400D+02,3.2400D+02,3.2400D+02,
 204      & 3.2400D+02,3.2400D+02,3.2400D+02,3.0100D+02,2.9200D+02,
 205      & 2.8400D+02,2.7600D+02,2.7200D+02,2.4500D+02,2.0200D+02,
 206      & 1.9800D+02,1.9600D+02,1.9600D+02,1.9900D+02,2.1900D+02,
 207      & 3.8800D+02,3.8800D+02,3.8800D+02,3.8800D+02,3.8800D+02,
 208      & 3.8800D+02,3.8800D+02,3.8800D+02,3.6000D+02,3.5000D+02,
 209      & 3.4000D+02,3.3000D+02,3.2500D+02,2.9600D+02,2.4600D+02,
 210      & 2.4200D+02,2.4000D+02,2.4000D+02,2.4400D+02,2.6600D+02 /
 211
 212       DATA ((SIG  (I,J),I= 1,20),J= 4, 6) /
 213      & 4.5600D+02,4.3400D+02,4.1600D+02,3.9000D+02,3.6100D+02,
 214      & 3.5200D+02,4.6700D+02,4.7100D+02,4.5800D+02,4.5300D+02,
 215      & 4.5000D+02,4.5500D+02,4.6000D+02,4.4500D+02,4.3500D+02,
 216      & 4.3000D+02,4.3200D+02,4.3700D+02,4.4600D+02,4.8100D+02,
 217      & 7.8200D+02,7.3800D+02,7.0600D+02,6.6100D+02,6.2600D+02,
 218      & 6.1100D+02,7.7600D+02,7.8000D+02,7.6400D+02,7.6000D+02,
 219      & 7.5000D+02,7.6000D+02,7.5500D+02,7.4000D+02,7.3000D+02,
 220      & 7.2600D+02,7.2900D+02,7.3600D+02,7.4800D+02,7.9200D+02,
 221      & 8.6000D+02,8.1000D+02,7.7500D+02,7.2500D+02,6.9000D+02,
 222      & 6.8000D+02,8.4700D+02,8.5300D+02,8.5000D+02,8.4500D+02,
 223      & 8.4000D+02,8.3500D+02,8.2500D+02,8.0500D+02,7.9500D+02,
 224      & 7.9600D+02,7.9900D+02,8.0600D+02,8.1900D+02,8.6400D+02 /
 225
 226       DATA ((SEG  (I,J),I= 1,20),J= 4, 6) /
 227      & 6.1000D+02,5.4000D+02,4.9000D+02,4.6000D+02,4.3500D+02,
 228      & 4.5000D+02,4.4000D+02,4.1500D+02,4.1000D+02,3.9800D+02,
 229      & 3.9200D+02,3.8700D+02,3.7000D+02,3.5000D+02,3.3300D+02,
 230      & 3.3300D+02,3.3500D+02,3.3800D+02,3.4800D+02,3.8300D+02,
 231      & 1.0000D+03,9.1000D+02,8.6000D+02,8.0000D+02,7.8000D+02,
 232      & 7.7500D+02,7.6000D+02,7.1000D+02,6.8300D+02,6.7000D+02,
 233      & 6.6300D+02,6.5400D+02,6.3400D+02,5.9800D+02,5.7000D+02,
 234      & 5.7000D+02,5.7500D+02,5.8000D+02,6.0000D+02,6.5300D+02,
 235      & 1.0900D+03,1.0000D+03,9.6000D+02,9.5000D+02,8.8000D+02,
 236      & 8.5000D+02,8.3500D+02,7.8000D+02,7.5000D+02,7.4000D+02,
 237      & 7.3000D+02,7.2000D+02,7.0000D+02,6.6000D+02,6.3000D+02,
 238      & 6.3000D+02,6.3500D+02,6.4000D+02,6.6000D+02,7.2000D+02 /
 239
 240       DATA ((SEGP (I,J),I= 1,20),J= 4, 6) /
 241      & 6.1000D+02,5.4000D+02,4.9000D+02,4.6000D+02,4.3500D+02,
 242      & 4.5000D+02,4.4000D+02,4.1500D+02,4.1000D+02,3.9800D+02,
 243      & 3.9200D+02,3.8700D+02,3.7000D+02,3.5000D+02,3.3300D+02,
 244      & 3.3300D+02,3.3500D+02,3.3800D+02,3.4800D+02,3.8300D+02,
 245      & 1.0000D+03,9.1000D+02,8.6000D+02,8.0000D+02,7.8000D+02,
 246      & 7.7500D+02,7.6000D+02,7.1000D+02,6.8300D+02,6.7000D+02,
 247      & 6.6300D+02,6.5400D+02,6.3400D+02,5.9800D+02,5.7000D+02,
 248      & 5.7000D+02,5.7500D+02,5.8000D+02,6.0000D+02,6.5300D+02,
 249      & 1.0900D+03,1.0000D+03,9.6000D+02,9.5000D+02,8.8000D+02,
 250      & 8.5000D+02,8.3500D+02,7.8000D+02,7.5000D+02,7.4000D+02,
 251      & 7.3000D+02,7.2000D+02,7.0000D+02,6.6000D+02,6.3000D+02,
 252      & 6.3000D+02,6.3500D+02,6.4000D+02,6.6000D+02,7.2000D+02 /
 253
 254       DATA ((SIGKP(I,J),I= 1,20),J= 4, 6) /
 255      & 3.1750D+02,3.1750D+02,3.1750D+02,3.1750D+02,3.1750D+02,
 256      & 3.1750D+02,3.1750D+02,3.1320D+02,3.0110D+02,3.0460D+02,
 257      & 3.0110D+02,2.9680D+02,2.8700D+02,2.8400D+02,2.8600D+02,
 258      & 2.9900D+02,3.0200D+02,3.1100D+02,3.2800D+02,3.8600D+02,
 259      & 6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,
 260      & 6.8380D+02,6.8380D+02,5.6180D+02,5.4020D+02,5.4640D+02,
 261      & 5.4020D+02,5.3250D+02,5.1500D+02,5.1000D+02,5.1000D+02,
 262      & 5.2200D+02,5.2600D+02,5.3900D+02,5.6700D+02,6.5400D+02,
 263      & 7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,
 264      & 7.5220D+02,7.5220D+02,6.2240D+02,5.9840D+02,6.0530D+02,
 265      & 5.9840D+02,5.8990D+02,5.7000D+02,5.6500D+02,5.6500D+02,
 266      & 5.7500D+02,5.7900D+02,5.9400D+02,6.2400D+02,7.1800D+02 /
 267
 268       DATA ((SIGKM(I,J),I= 1,20),J= 4, 6) /
 269      & 3.9680D+02,3.9680D+02,3.9680D+02,3.9680D+02,3.9680D+02,
 270      & 3.9680D+02,3.9680D+02,3.9680D+02,3.6760D+02,3.5300D+02,
 271      & 3.5000D+02,3.5000D+02,3.4100D+02,3.1700D+02,3.0300D+02,
 272      & 2.9900D+02,3.0200D+02,3.1100D+02,3.2800D+02,3.8600D+02,
 273      & 6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,
 274      & 6.8380D+02,6.8380D+02,6.8380D+02,6.3360D+02,6.2400D+02,
 275      & 6.2000D+02,6.1600D+02,5.9800D+02,5.6900D+02,5.3400D+02,
 276      & 5.2200D+02,5.2600D+02,5.3900D+02,5.6700D+02,6.5400D+02,
 277      & 7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,
 278      & 7.5220D+02,7.5220D+02,7.5220D+02,6.9700D+02,6.9000D+02,
 279      & 6.8500D+02,6.8000D+02,6.6000D+02,6.3000D+02,5.9000D+02,
 280      & 5.7500D+02,5.7900D+02,5.9400D+02,6.2400D+02,7.1800D+02 /
 281
 282       DATA ((SIGAP(I,J),I= 1,20),J= 4, 6) /
 283      & 6.4800D+02,6.4800D+02,6.4800D+02,6.4800D+02,6.4800D+02,
 284      & 6.4800D+02,6.4800D+02,6.4800D+02,5.9800D+02,5.8100D+02,
 285      & 5.6400D+02,5.4800D+02,5.4000D+02,5.0000D+02,4.3400D+02,
 286      & 4.2900D+02,4.2700D+02,4.2700D+02,4.3200D+02,4.6400D+02,
 287      & 1.0240D+03,1.0240D+03,1.0240D+03,1.0240D+03,1.0240D+03,
 288      & 1.0240D+03,1.0240D+03,1.0240D+03,9.4100D+02,9.1500D+02,
 289      & 8.8800D+02,8.6200D+02,8.4900D+02,8.0100D+02,7.2000D+02,
 290      & 7.1600D+02,7.1500D+02,7.1500D+02,7.2200D+02,7.6300D+02,
 291      & 1.1100D+03,1.1100D+03,1.1100D+03,1.1100D+03,1.1100D+03,
 292      & 1.1100D+03,1.1100D+03,1.1100D+03,1.0200D+03,9.9200D+02,
 293      & 9.6300D+02,9.3500D+02,9.2100D+02,8.7000D+02,7.8800D+02,
 294      & 7.8400D+02,7.8400D+02,7.8400D+02,7.9200D+02,8.3400D+02 /
 295
 296       DATA ((SIG  (I,J),I= 1,20),J= 7, 9) /
 297      & 1.2360D+03,1.1780D+03,1.1400D+03,1.0800D+03,1.0250D+03,
 298      & 1.0370D+03,1.2610D+03,1.2670D+03,1.2500D+03,1.2500D+03,
 299      & 1.2240D+03,1.2200D+03,1.2130D+03,1.2100D+03,1.2000D+03,
 300      & 1.2000D+03,1.2100D+03,1.2130D+03,1.2300D+03,1.2800D+03,
 301      & 1.8200D+03,1.7600D+03,1.7200D+03,1.6500D+03,1.5700D+03,
 302      & 1.6490D+03,1.9300D+03,1.9350D+03,1.9200D+03,1.9000D+03,
 303      & 1.8930D+03,1.8880D+03,1.8800D+03,1.8700D+03,1.8600D+03,
 304      & 1.8650D+03,1.8700D+03,1.8800D+03,1.9000D+03,1.9450D+03,
 305      & 1.9900D+03,1.9300D+03,1.8900D+03,1.8200D+03,1.7300D+03,
 306      & 1.8320D+03,2.1270D+03,2.1310D+03,2.1200D+03,2.1330D+03,
 307      & 2.0900D+03,2.0850D+03,2.0800D+03,2.0700D+03,2.0600D+03,
 308      & 2.0600D+03,2.0700D+03,2.0770D+03,2.0950D+03,2.1400D+03 /
 309
 310       DATA ((SEG  (I,J),I= 1,20),J= 7, 9) /
 311      & 1.6300D+03,1.4800D+03,1.3100D+03,1.2600D+03,1.2400D+03,
 312      & 1.2200D+03,1.2000D+03,1.1500D+03,1.1150D+03,1.1050D+03,
 313      & 1.0950D+03,1.0800D+03,1.0620D+03,1.0000D+03,9.6000D+02,
 314      & 9.6000D+02,9.6500D+02,9.7100D+02,1.0000D+03,1.0850D+03,
 315      & 2.5000D+03,2.2500D+03,1.9600D+03,1.8500D+03,1.8200D+03,
 316      & 1.8000D+03,1.7800D+03,1.7000D+03,1.6900D+03,1.6850D+03,
 317      & 1.6800D+03,1.6750D+03,1.6600D+03,1.5800D+03,1.5000D+03,
 318      & 1.4800D+03,1.4800D+03,1.4950D+03,1.5300D+03,1.6500D+03,
 319      & 2.7500D+03,2.4750D+03,2.2000D+03,2.1000D+03,2.1000D+03,
 320      & 2.1000D+03,2.0700D+03,1.9600D+03,1.8800D+03,1.8700D+03,
 321      & 1.8400D+03,1.8200D+03,1.8000D+03,1.7400D+03,1.6650D+03,
 322      & 1.6650D+03,1.6780D+03,1.6920D+03,1.7440D+03,1.8780D+03 /
 323
 324       DATA ((SEGP (I,J),I= 1,20),J= 7, 9) /
 325      & 1.6300D+03,1.4800D+03,1.3100D+03,1.2600D+03,1.2400D+03,
 326      & 1.2200D+03,1.2000D+03,1.1500D+03,1.1150D+03,1.1050D+03,
 327      & 1.0950D+03,1.0800D+03,1.0620D+03,1.0000D+03,9.6000D+02,
 328      & 9.6000D+02,9.6500D+02,9.7100D+02,1.0000D+03,1.0850D+03,
 329      & 2.5000D+03,2.2500D+03,1.9600D+03,1.8500D+03,1.8200D+03,
 330      & 1.8000D+03,1.7800D+03,1.7000D+03,1.6900D+03,1.6850D+03,
 331      & 1.6800D+03,1.6750D+03,1.6600D+03,1.5800D+03,1.5000D+03,
 332      & 1.4800D+03,1.4800D+03,1.4950D+03,1.5300D+03,1.6500D+03,
 333      & 2.7500D+03,2.4750D+03,2.2000D+03,2.1000D+03,2.1000D+03,
 334      & 2.1000D+03,2.0700D+03,1.9600D+03,1.8800D+03,1.8700D+03,
 335      & 1.8400D+03,1.8200D+03,1.8000D+03,1.7400D+03,1.6650D+03,
 336      & 1.6650D+03,1.6780D+03,1.6920D+03,1.7440D+03,1.8780D+03 /
 337
 338       DATA ((SIGKP(I,J),I= 1,20),J= 7, 9) /
 339      & 1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,
 340      & 1.1530D+03,1.1530D+03,9.8450D+02,9.4660D+02,9.5740D+02,
 341      & 9.4660D+02,9.3310D+02,9.0000D+02,8.8600D+02,8.8000D+02,
 342      & 8.8600D+02,8.9300D+02,9.1500D+02,9.5600D+02,1.0850D+03,
 343      & 1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,
 344      & 1.8219D+03,1.8219D+03,1.6088D+03,1.5469D+03,1.5646D+03,
 345      & 1.5469D+03,1.5248D+03,1.4660D+03,1.4330D+03,1.4070D+03,
 346      & 1.4070D+03,1.4210D+03,1.4520D+03,1.5130D+03,1.6890D+03,
 347      & 2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,
 348      & 2.0215D+03,2.0215D+03,1.7987D+03,1.7296D+03,1.7493D+03,
 349      & 1.7296D+03,1.7049D+03,1.6400D+03,1.6000D+03,1.5700D+03,
 350      & 1.5630D+03,1.5800D+03,1.6130D+03,1.6790D+03,1.8680D+03 /
 351
 352       DATA ((SIGKM(I,J),I= 1,20),J= 7, 9) /
 353      & 1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,
 354      & 1.1530D+03,1.1530D+03,1.1530D+03,1.0683D+03,1.0590D+03,
 355      & 1.0530D+03,1.0460D+03,1.0180D+03,9.3700D+02,8.9800D+02,
 356      & 8.8600D+02,8.9300D+02,9.1500D+02,9.5600D+02,1.0850D+03,
 357      & 1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,
 358      & 1.8219D+03,1.8219D+03,1.8219D+03,1.6881D+03,1.6750D+03,
 359      & 1.6700D+03,1.6600D+03,1.6200D+03,1.4330D+03,1.4070D+03,
 360      & 1.4070D+03,1.4210D+03,1.4520D+03,1.5130D+03,1.6890D+03,
 361      & 2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,
 362      & 2.0215D+03,2.0215D+03,2.0215D+03,1.8731D+03,1.8590D+03,
 363      & 1.8540D+03,1.8440D+03,1.8000D+03,1.6200D+03,1.5800D+03,
 364      & 1.5630D+03,1.5800D+03,1.6130D+03,1.6790D+03,1.8680D+03 /
 365
 366       DATA ((SIGAP(I,J),I= 1,20),J= 7, 9) /
 367      & 1.5900D+03,1.5900D+03,1.5900D+03,1.5900D+03,1.5900D+03,
 368      & 1.5900D+03,1.5900D+03,1.5900D+03,1.4570D+03,1.4170D+03,
 369      & 1.3760D+03,1.3360D+03,1.3160D+03,1.2600D+03,1.1750D+03,
 370      & 1.1720D+03,1.1760D+03,1.1760D+03,1.1850D+03,1.2330D+03,
 371      & 2.3380D+03,2.3380D+03,2.3380D+03,2.3380D+03,2.3380D+03,
 372      & 2.3380D+03,2.3380D+03,2.3380D+03,2.1360D+03,2.0760D+03,
 373      & 2.0170D+03,1.9580D+03,1.9280D+03,1.8730D+03,1.8000D+03,
 374      & 1.8040D+03,1.8160D+03,1.8160D+03,1.8260D+03,1.8740D+03,
 375      & 2.5520D+03,2.5520D+03,2.5520D+03,2.5520D+03,2.5520D+03,
 376      & 2.5520D+03,2.5520D+03,2.5520D+03,2.3300D+03,2.2650D+03,
 377      & 2.2000D+03,2.1360D+03,2.1030D+03,2.0500D+03,1.9840D+03,
 378      & 1.9900D+03,2.0040D+03,2.0040D+03,2.0150D+03,2.0610D+03 /
 379
 380       DATA ((TOTCRS(I,J),I= 1,19),J= 1, 3) /
 381      & 7.9400D+01,7.6200D+01,4.4700D+01,3.6500D+01,3.3100D+01,
 382      & 4.0200D+01,4.3400D+01,5.1700D+01,4.3600D+01,3.6900D+01,
 383      & 3.1200D+01,3.1600D+01,3.3500D+01,3.0400D+01,2.7400D+01,
 384      & 2.5400D+01,2.4500D+01,2.4000D+01,2.2500D+01,
 385      & 5.4200D+01,5.1000D+01,3.6000D+01,2.6000D+01,2.9100D+01,
 386      & 3.0000D+01,3.0000D+01,3.6600D+01,3.3000D+01,2.9600D+01,
 387      & 2.8300D+01,2.7000D+01,2.6400D+01,2.2700D+01,2.1800D+01,
 388      & 2.0500D+01,2.1000D+01,2.1900D+01,2.0600D+01,
 389      & 1.2000D+01,1.3700D+01,1.3000D+01,1.2500D+01,1.1200D+01,
 390      & 1.2000D+01,1.4300D+01,1.6000D+01,1.7200D+01,1.8100D+01,
 391      & 1.7900D+01,1.8300D+01,1.7900D+01,1.7600D+01,1.7200D+01,
 392      & 1.7600D+01,1.7200D+01,1.7000D+01,1.7300D+01 /
 393
 394       DATA ((TOTCRS(I,J),I= 1,19),J= 4, 5) /
 395      & 1.3000D+01,1.4500D+01,1.4000D+01,1.3000D+01,1.4500D+01,
 396      & 1.5800D+01,1.6900D+01,1.8500D+01,2.0600D+01,2.0900D+01,
 397      & 2.0000D+01,1.9400D+01,1.9000D+01,1.8800D+01,1.7800D+01,
 398      & 1.7800D+01,1.7800D+01,1.7500D+01,1.7500D+01,
 399      & 2.8000D+02,1.9970D+02,1.7110D+02,1.5430D+02,1.4000D+02,
 400      & 1.3000D+02,1.1680D+02,1.1740D+02,1.1160D+02,1.0900D+02,
 401      & 1.0650D+02,1.0280D+02,1.0000D+02,9.0200D+01,7.6700D+01,
 402      & 6.8000D+01,6.2800D+01,6.0700D+01,5.6000D+01 /
 403
 404 C  PLAB - LAB MOMENTUM SCALE FOR TOTCRS
 405       DATA PLAB/.3D0,.4D0,.5D0,.6D0,.7D0,.8D0,.9D0,1.D0,1.1D0,
 406      *1.2D0,1.3D0,
 407      &1.4D0,1.5D0,2.D0,3.D0,4.D0,
 408      *5.D0,6.D0,10.D0/
 409 * Original correspondence
 410 *                p    ap   e-   e+   nu  anu gamma  n    an  mu+  mu-
 411 *     DATA ITT/   1,   7,   0,   0,   0,   0,   0,   2,   8,   0,   0,
 412 *              Klong pi+  pi-   K+   K- Lam  Alam Kshrt Sig- Sig+ Sig0
 413 *    &           10,   3,   4,   6,   5,   1,   2,  10,   1,   1,   1,
 414 *               pi0   K0  AK0
 415 *    &            3,  10,   9/
 416 *                p    ap   e-   e+   nu  anu gamma  n    an  mu+  mu-
 417       DATA ITT/   1,   7,   0,   0,   0,   0,   0,   2,   8,   0,   0,
 418 *              Klong pi+  pi-   K+   K- Lam  Alam Kshrt Sig- Sig+ Sig0
 419      &           10,   3,   4,   6,   5,   2,   8,  10,   2,   1,   2,
 420 *               pi0   K0  AK0  pi0  res. res. res. res. Asi- Asi0 Asi+
 421      &            3,  10,   9,   3,   0,   0,   0,   0,   8,   8,   7,
 422 *                X0  Ax0   X-  AX-  Om- Aom+
 423      &            2,   8,   2,   8,   2,   8 /
 424 *
 425 *
 426 *     Modified by A. Ferrari to use RNDM2
 427 *
 428 *
 429 *     Comment the next 1 card for Rndm2, activate for Rndm
 430 *
 431 *     DATA ROU1/-2.D0/
 432 *
 433 *     Comment the next 1 card on Rndm, activate for Rndm2
 434 *
 435       DATA IROU1, IROU2 /2*0/
 436       AA=AAA
 437       SI=AZRZRZ
 438       ZL=AINFNT
 439       IF ( AA .LT. 1.5D+00 ) THEN
 440          IF ( IT .EQ. 13 .AND. PO .LE. 0.270436311984990D+00 ) THEN
 441             SI = 0.D+00
 442             ZL = AINFNT
 443             RETURN
 444          ELSE IF ( IT .EQ. 1 .AND. PO .LE. 0.776527236216833D+00 ) THEN
 445             SI = 0.D+00
 446             ZL = AINFNT
 447             RETURN
 448          ELSE IF ( IT .EQ. 8 .AND. PO .LE. 0.777284775476990D+00 ) THEN
 449             SI = 0.D+00
 450             ZL = AINFNT
 451             RETURN
 452          END IF
 453       END IF
 454 *  Check the kinetic energy: no interaction below 50 MeV at present
 455 *     IF ( IT .LE. 30 ) THEN
 456          IF ( EKE .LT. 0.0499D+00 ) RETURN
 457 *     ELSE
 458 *        IF ( EKE .LT. 2.5D+00 ) RETURN
 459 *     END IF
 460       IF(AA.LT.0.99D0)RETURN
 461 C
 462 C     CALCULATE THE NEW PARTICLE NUMBER IIT:   1=P,2=N,3=PI+,4=PI-,
 463 C     5=K-,6=K+,7=P BAR,8=N BAR,9=K ZERO BAR,10=K ZERO
 464 C
 465       IIT=ITT(IT)
 466       IF(IIT.EQ.0)RETURN
 467 C
 468 C     RNDM IS CALLED ONLY ONCE EVEN IF 'CALL NIZL' IS IN A DO-LOOP
 469 C     (I.E. CURRENT MATERIAL IS A COMPOUND).
 470 C
 471       IF(IT.EQ.19.OR.IT.EQ.12) THEN
 472         CALL GRNDMQ(JROU1,JROU2,0,'G')
 473         IF(IROU1.NE.JROU1.AND.IROU2.NE.JROU2) THEN
 474            CALL GRNDM(RNDM,1)
 475            RND=RNDM(1)
 476         ENDIF
 477         IF(RND.GT.0.5D0) IIT=9
 478         CALL GRNDMQ(IROU1,IROU2,0,'G')
 479       END IF
 480       IF(AA.LT.2.D0) GOTO 9
 481       IF(IIT.GE.5.AND.PO.LE.2.D0) GOTO 102
 482 C
 483 C********************************************************************
 484 C     P, N , PI+, PI-  OR ANY HIGH ENERGY (> 2 GEV/C) HADRON
 485 C********************************************************************
 486 C
 487 C     CALCULATE THE MOMENTUM INDEX K
 488 C
 489  9    CONTINUE
 490       DO 22 K=1,20
 491          IF(PO.LE.P(K)) GO TO 23
 492    22 CONTINUE
 493       K=20
 494    23 CONTINUE
 495 C
 496 C     CALCULATE THE MASS INDEX J
 497 C
 498       IF(AA.GE.2.D0) GOTO 8
 499       AA=1.D+00
 500       J=1
 501       JJ=1
 502       GOTO 7
 503  8    CONTINUE
 504       DO 5 I=2,8
 505          IF(AA.LE.A(I)) GO TO 6
 506          GO TO 5
 507     6    CONTINUE
 508          J=I-1
 509          JJ=J+1
 510          GO TO 7
 511     5 CONTINUE
 512       J=8
 513       JJ=J+1
 514     7 CONTINUE
 515       GO TO (101,101,114,113,116,115,1002,1002,116,115)    ,IIT
 516 C
 517 C     NUCLEONS
 518 C
 519  101  CONTINUE
 520       SI1=SIG(K,J)*(AA/A(J))**(LOG(SIG(K,JJ)/SIG(K,J))/LOG(A(J+1)/A(J
 521      *)))
 522       IF (K.EQ.1) THEN
 523          SI=SI1
 524          GO TO 121
 525       END IF
 526       KK=K-1
 527       SI2=SIG(KK,J)*(AA/A(J))**(LOG(SIG(KK,JJ)/SIG(KK,J))/LOG(A(J+1)/
 528      *A(J)))
 529       IF (PO.GE.10000.D0) THEN
 530          AMITSQ=AM(IT)*AM(IT)
 531          S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
 532          S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
 533          SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
 534          ALS2SQ=LOG(S2SQ)
 535          BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
 536          ACOEF=SI2-BCOEF*ALS2SQ
 537          SI=ACOEF+BCOEF*LOG(SSSQ)
 538          GO TO 121
 539       ELSE
 540          GO TO 120
 541       END IF
 542 C
 543 C     PI -
 544 C
 545   113 CONTINUE
 546       IF(K.EQ.1) GOTO 1113
 547       SI1=SEG(K,J)*(AA/A(J))**(LOG(SEG(K,JJ)/SEG(K,J))/LOG(A(J+1)/A(J
 548      *)))
 549       KK=K-1
 550       SI2=SEG(KK,J)*(AA/A(J))**(LOG(SEG(KK,JJ)/SEG(KK,J))/LOG(A(J+1)/
 551      *A(J)))
 552       IF (PO.GE.10000.D0) THEN
 553          AMITSQ=AM(IT)*AM(IT)
 554          S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
 555          S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
 556          SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
 557          ALS2SQ=LOG(S2SQ)
 558          BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
 559          ACOEF=SI2-BCOEF*ALS2SQ
 560          SI=ACOEF+BCOEF*LOG(SSSQ)
 561          GO TO 121
 562       ELSE
 563          GO TO 120
 564       END IF
 565 C
 566 C     PI +
 567 C
 568   114 CONTINUE
 569       IF(K.EQ.1) GOTO 1113
 570       SI1=SEGP(K,J)*(AA/A(J))**(LOG(SEGP(K,JJ)/SEGP(K,J))/LOG(A(J+1)/
 571      *A(J)))
 572       KK=K-1
 573       SI2=SEGP(KK,J)*(AA/A(J))**(LOG(SEGP(KK,JJ)/SEGP(KK,J))/LOG(A(J+
 574      *1)/A(J)))
 575       IF (PO.GE.10000.D0) THEN
 576          AMITSQ=AM(IT)*AM(IT)
 577          S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
 578          S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
 579          SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
 580          ALS2SQ=LOG(S2SQ)
 581          BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
 582          ACOEF=SI2-BCOEF*ALS2SQ
 583          SI=ACOEF+BCOEF*LOG(SSSQ)
 584          GO TO 121
 585       ELSE
 586          GO TO 120
 587       END IF
 588 C
 589 C     K -  AND K0 BAR
 590 C
 591   116 CONTINUE
 592 C     IF(K.EQ.1) GOTO 1113
 593       SI1=SIGKM(K,J)*(AA/A(J))**(LOG(SIGKM(K,JJ)/SIGKM(K,J))/LOG(A(J+
 594      *1)/A(J)))
 595       IF (K.EQ.1) THEN
 596          SI=SI1
 597          GO TO 121
 598       END IF
 599       KK=K-1
 600       SI2=SIGKM(KK,J)*(AA/A(J))**(LOG(SIGKM(KK,JJ)/SIGKM(KK,J))/LOG(A
 601      *(J+1)/A(J)))
 602       IF (PO.GE.10000.D0) THEN
 603          AMITSQ=AM(IT)*AM(IT)
 604          S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
 605          S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
 606          SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
 607          ALS2SQ=LOG(S2SQ)
 608          BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
 609          ACOEF=SI2-BCOEF*ALS2SQ
 610          SI=ACOEF+BCOEF*LOG(SSSQ)
 611          GO TO 121
 612       ELSE
 613          GO TO 120
 614       END IF
 615 C
 616 C     K +  AND K0
 617 C
 618   115 CONTINUE
 619       SI1=SIGKP(K,J)*(AA/A(J))**(LOG(SIGKP(K,JJ)/SIGKP(K,J))/LOG(A(J+
 620      *1)/A(J)))
 621       IF (K.EQ.1) THEN
 622          SI=SI1
 623          GO TO 121
 624       END IF
 625       KK=K-1
 626       SI2=SIGKP(KK,J)*(AA/A(J))**(LOG(SIGKP(KK,JJ)/SIGKP(KK,J))/LOG(A
 627      *(J+1)/A(J)))
 628       IF (PO.GE.10000.D0) THEN
 629          AMITSQ=AM(IT)*AM(IT)
 630          S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
 631          S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
 632          SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
 633          ALS2SQ=LOG(S2SQ)
 634          BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
 635          ACOEF=SI2-BCOEF*ALS2SQ
 636          SI=ACOEF+BCOEF*LOG(SSSQ)
 637          GO TO 121
 638       ELSE
 639          GO TO 120
 640       END IF
 641 C
 642 C     ANTI-NUCLEONS
 643 C
 644  1002 CONTINUE
 645       SI1=SIGAP(K,J)*(AA/A(J))**(LOG(SIGAP(K,JJ)/SIGAP(K,J))/LOG(A(J+
 646      *1)/A(J)))
 647       IF (K.EQ.1) THEN
 648          SI=SI1
 649          GO TO 121
 650       END IF
 651       KK=K-1
 652       SI2=SIGAP(KK,J)*(AA/A(J))**(LOG(SIGAP(KK,JJ)/SIGAP(KK,J))/LOG(A
 653      *(J+1)/A(J)))
 654       IF (PO.GE.10000.D0) THEN
 655          AMITSQ=AM(IT)*AM(IT)
 656          S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
 657          S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
 658          SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
 659          ALS2SQ=LOG(S2SQ)
 660          BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
 661          ACOEF=SI2-BCOEF*ALS2SQ
 662          SI=ACOEF+BCOEF*LOG(SSSQ)
 663          GO TO 121
 664       END IF
 665 C
 666 C     INTERPOLATE LINEARLY WITH RESPECT TO MOMENTUM
 667 C
 668   120 CONTINUE
 669       SI=SI1+(PO-P(K))*(SI2-SI1)/(P(KK)-P(K))
 670       GO TO 121
 671 C
 672 C********************************************************************
 673 C     LOW ENERGY  (<2.0 GEV/C) K-, K+, PBAR, NBAR, K ZERO BAR, K ZERO
 674 C********************************************************************
 675 C
 676   102 CONTINUE
 677       IF(IIT.GE.9) IIT=IIT-4
 678 C
 679 C     CALCULATE MOMENTUM INDEX K AND INTERACTION INDICES I1 AND I2
 680 C
 681       DO 33 K=1,19
 682       IF(PO.LE.PLAB(K)) GO TO 34
 683    33 CONTINUE
 684       K=19
 685    34 KK=K-1
 686       PO1=PO-PLAB(K)
 687       IIT=IIT-4
 688       I2=2*IIT
 689       I1=I2-1
 690       IF(I1.LT.5) GO TO 41
 691       I1=5
 692       I2=5
 693  41   CONTINUE
 694 C
 695 C     TAKE THE AVERAGE OVER -/NEUTRON AND -/PROTON CROSS SECTIONS
 696 C     AND INTERPOLATE LINEARLY WITH RESPECT TO MOMENTUM
 697 C
 698       SI=(TOTCRS(K,I1)+TOTCRS(K,I2))*0.5D0
 699       IF(K.EQ.1) GOTO 2008
 700       DS=(TOTCRS(KK,I1)+TOTCRS(KK,I2)-TOTCRS(K,I1)-TOTCRS(K,I2))*0.5D0
 701       SI=SI+PO1*DS/(PLAB(KK)-PLAB(K))
 702  2008 CONTINUE
 703       SI=BET(IIT)*SI*AA**ALPH(IIT)
 704       IF(IT.NE.16.OR.PO.GE.1.41D0) GOTO 121
 705 C
 706 C     SPECIAL TREATMENT FOR LOW ENERGY K-
 707 C
 708       SI=SI*0.5D0*(1.D0+SQRT(PO**2+0.244D0)-0.494D0)
 709       GO TO 121
 710 C
 711 C********************************************************************
 712 C        LOW ENERGY PIONS (<0.3GEV/C)
 713 C********************************************************************
 714 C
 715  1113 CONTINUE
 716       SI=0.01D0
 717       IF(IT.EQ.13.AND.J.EQ.1) THEN
 718         SI = ANGLGB
 719         GOTO 121
 720       END IF
 721       DO 1122 K=1,4
 722          IF(PO.LE.PEE(K)) GOTO 1123
 723  1122 CONTINUE
 724       K=4
 725  1123 CONTINUE
 726       SI1=SEEG(K,J)*(AA/A(J))**(LOG(SEEG(K,JJ)/SEEG(K,J))
 727      * /LOG(A(J+1)/A(J)))
 728       SI=SI1
 729       IF(K.EQ.1)GO TO 121
 730       KK=K-1
 731       SI2=SEEG(KK,J)*(AA/A(J))**(LOG(SEEG(KK,JJ)
 732      * /SEEG(KK,J))/LOG(A(J+1)/A(J)))
 733 C
 734 C     INTERPOLATE LINEARLY WITH RESPECT TO MOMENTUM
 735 C
 736       SI=SI1 + (PO-PEE(K))*(SI2-SI1)/(PEE(KK)-PEE(K))
 737 C
 738 C********************************************************************
 739 C     CALCULATE THE INTERACTION LENGTH
 740 C********************************************************************
 741 C
 742  121  CONTINUE
 743 * A. Ferrari: commented out, no 1.07 factor is applied now to neutrons
 744 *     IF(J.EQ.1.AND.IIT.EQ.2) SI=SI*1.07D+00
 745 C     ZL=10000.D0*AA/(6.022D0*SI)
 746       ZL=AVOGMB*AA/SI
 747       RETURN
 748       END