*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:04  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.44  by  S.Giani
*-- Author :
*$ CREATE NIZL.FOR
*COPY NIZL
*                                                                      *
*=== nizl =============================================================*
*                                                                      *
      SUBROUTINE NIZL ( IT, AAA, EKE, PO, SI, ZL )
 
#include "geant321/dblprc.inc"
#include "geant321/dimpar.inc"
#include "geant321/iounit.inc"
*=====================================================================*
*
*     Revision september 90 by       A. Ferrari
*                                    Milan
*     last change 12 Febr. 1991      by Alfredo Ferrari
*                                    INFN-Milan
*
C********************************************************************
C     VERSION SEPTEMBER 90 BY        A. FERRARI
C                                    INFN, MILAN
C     LAST CHANGE ON 09 JUNE -92 BY  ALFREDO FERRARI
C
C
C     SEE: H.J. MOEHRING, HADRON-NUCLEUS INELASTIC CROSS-SECTIONS FOR
C     USE IN HADRON-CASCADE CALCULATIONS AT HIGH ENERGIES,
C     TIS DIVISION REPORT 14. OCTOBER 1983, TIS-RP/116, CERN GENEVA
C
C
C     THIS IS A SUBROUTINE OF FLUKA82 TO CALCULATE THE INELASTIC
C     SCATTERING LENGTH OF THE MATERIAL IN G/CM**2.
C
C     INPUT VARIABLES:
C        IT     = TYPE OF THE PARTICLE
C        AA     = ATOMIC WEIGHT OF THE NUCLEUS
C        PO     = PARTICLE MOMENTUM IN GEV/C
C
C     OUTPUT VARIABLES:
C        SI     = INTERPOLATED CROSS SECTION IN MILLIBARNS
C        ZL     = INTERPOLATED ABSORPTION LENGTH IN G/CM**2
C
C
C     OTHER INPORTANT VARIABLES:
C        SIG    = PROTON/NUCLEI CROSS SECTIONS
C        SEG    = PION-/NUCLEI CROSS SECTIONS ABOVE 0.3 GEV/C
C        SEGP   = PION+/NUCLEI CROSS SECTIONS ABOVE 0.3 GEV/C
C        SIGKM  = K+ AND K0/NUCLEI CROSS SECTIONS ABOVE 3.0 GEV/C
C        SIGKP  = K+ AND K0 BAR/NUCLEI CROSS SECTIONS ABOVE 3.0 GEV/C
C        SIGAP  = ANTINUCLEON/NUCLEI CROSS SECTIONS ABOVE 3.0 GEV/C
C        SEEG   = PION/NUCLEI CROSS SECTIONS BELOW 0.3 GEV/C
C        P      = MOMENTUMS FOR WHICH THE CROSS SECTIONS ARE GIVEN IN
C                 SIG, SEG, SEGP, SIGKM, SIGKP AND SIGAP
C        PEE    = MOMENTUMS FOR WHICH THE CROSS SECTIONS ARE GIVEN IN
C                 SEEG
C        A      = NUCLEI FOR WHICH THE CROSS SECTIONS ARE GIVEN IN
C                 SIG, SEG, SEGP, SIGKM, SIGKP, SIGAP AND SEEG
C        PLAB   = MOMENTUMS FOR WHICH THE TOTAL CROSS SECTIONS ARE
C                 GIVEN IN TOTCRS
C        TOTCRS = TOTAL CROSS SECTIONS AS A FUNCTION OF MOMENTUM
C                 TOTCRS(K,I) WHERE K=MOMENTUM INDEX,I=REACTION TYPE
C                 I=1:NEGATIVE KAON-PROTON  = KAON ZERO BAR-NEUTRON
C                 I=2:NEGATIVE KAON-NEUTRON = KAON ZERO BAR-PROTON
C                 I=3:POSITIVE KAON-PROTON  = KAON ZERO NEUTRON
C                 I=4:POSITIVE KAON-NEUTRON = KAON ZERO-PROTON
C                 I=5:ANTI NUCLEON-NUCLEON
C
C
C     NOTE1: PRESENTLY CROSS SECTIONS ARE ASSUMED TO BE CONSTANT
C     ABOVE 10000.0 GEV/C FOR ALL PARTICLES AND
C     BELOW 0.13 GEV/C FOR PIONS AND BELOW 0.3 GEV/C FOR OTHERS
C
C     NOTE2: SEE TABLE ITT TO FIND OUT HOW DIFFERENT HADRONS
C     ARE TREATED. ALL PARTICLES WITH PARTICLE NUMBER BIGGER THAN
C     25 ARE TREATED AS PROTONS.
C
C     NOTE3: FOR LEPTONS AND PHOTONS PRACTICALLY ZERO CROSS SECTION
C     IS RETURNED.
C********************************************************************
C
#include "geant321/paprop.inc"
C
      PARAMETER ( AVOGMB = 1.0D+27 / AVOGAD )
      PARAMETER ( AMPROT = 0.93827231D+00 )
      PARAMETER ( AMNEUT = 0.93956563D+00 )
      PARAMETER ( AMNTM2 = AMPROT + AMNEUT )
      PARAMETER ( AMNCSQ = 0.25D+00 * AMNTM2 * AMNTM2 )
C
C     DIMENSION SIG1(20,5),SEG1(20,5),SEGP1(20,5),SIG2(20,4),
C    *SEG2(20,4),SEGP2(20,4)
C     EQUIVALENCE (SIG(1),SIG1(1)),(SIG(101),SIG2(1)),
C    *(SEG(1),SEG1(1)),(SEG(101),SEG2(1)),
C    *(SEGP(1),SEGP1(1)),(SEGP(101),SEGP2(1))
      DIMENSION SEEG(4,9),PEE(4),SIGKP(20,9),SIGKM(20,9),SIGAP(20,9)
      DIMENSION SEG(20,9),SIG(20,9),SEGP(20,9),P(20),A(9),ITT(39)
      DIMENSION BET(4),ALPH(4)
      DIMENSION TOTCRS(19,5)
      DIMENSION PLAB(19)
      REAL RNDM(1)
      SAVE ALPH, BET, A, P, SEEG, PEE, SIG, SEG, SEGP, PLAB, TOTCRS,
     &     SIGKP, SIGKM, SIGAP, RND, ITT, IROU1, IROU2
      DATA ALPH/.748D0,.803D0,.63D0,.63D0/
      DATA BET/1.27D0,1.22D0,.9D0,.9D0/
      DATA A/1.D0,9.D0,12.D0,27.D0,55.9D0,63.5D0,112.4D0,
     *207.2D0,238.1D0/
      DATA P/0.3D0,0.4D0,0.5D0,0.6D0,0.8D0,1.D0,1.5D0,
     *2.D0,3.D0,4.D0,5.D0,6.D0,10.D0,
     *20.D0,50.D0,100.D0,200.D0,400.D0,1000.D0,10000.D0/
      DATA SEEG/0.1D0,16.D0,35.D0,42.D0,360.D0,370.D0,310.D0,290.D0,
     * 430.D0,435.D0,380.D0,350.D0,
     * 670.D0,650.D0,630.D0,610.D0,
     * 1130.D0,1040.D0,1000.D0,1000.D0,
     * 1240.D0,1140.D0,1100.D0,1090.D0,
     * 1880.D0,1750.D0,1645.D0,1630.D0,
     * 2930.D0,2750.D0,2540.D0,2500.D0,
     * 3240.D0,3050.D0,2800.D0,2750.D0/
      DATA PEE /0.13D0,0.19D0,0.25D0,0.30D0/
 
      DATA ((SIG  (I,J),I= 1,20),J= 1, 3) /
     & 1.0000D-04,1.0000D-04,1.0000D-04,1.0000D-01,1.0000D+00,
     & 4.0000D+00,2.4500D+01,2.5000D+01,2.7200D+01,2.7800D+01,
     & 2.8500D+01,2.9200D+01,2.9700D+01,3.0500D+01,3.1500D+01,
     & 3.1700D+01,3.2100D+01,3.2900D+01,3.4500D+01,4.1200D+01,
     & 2.0200D+02,1.9400D+02,1.8700D+02,1.7500D+02,1.5800D+02,
     & 1.5300D+02,2.1700D+02,2.2000D+02,2.1200D+02,2.0700D+02,
     & 2.0300D+02,2.0100D+02,1.9900D+02,1.9600D+02,1.9400D+02,
     & 1.9500D+02,1.9600D+02,1.9900D+02,2.0400D+02,2.2600D+02,
     & 2.5000D+02,2.4000D+02,2.3000D+02,2.1600D+02,1.9600D+02,
     & 1.9000D+02,2.5000D+02,2.6000D+02,2.5900D+02,2.5400D+02,
     & 2.4900D+02,2.4700D+02,2.4400D+02,2.4100D+02,2.3900D+02,
     & 2.4000D+02,2.4100D+02,2.4400D+02,2.5100D+02,2.7600D+02 /
 
      DATA ((SEG  (I,J),I= 1,20),J= 1, 3) /
     & 4.2000D+01,1.9000D+01,1.6100D+01,1.7000D+01,2.2700D+01,
     & 3.2500D+01,2.4600D+01,2.6200D+01,2.5000D+01,2.3700D+01,
     & 2.3000D+01,2.2500D+01,2.2000D+01,2.1200D+01,2.0800D+01,
     & 2.0700D+01,2.1000D+01,2.1900D+01,2.3800D+01,2.8400D+01,
     & 2.9000D+02,2.6400D+02,2.1200D+02,1.9000D+02,1.8900D+02,
     & 1.9700D+02,1.9000D+02,1.8500D+02,1.8000D+02,1.7500D+02,
     & 1.7000D+02,1.6800D+02,1.6400D+02,1.5500D+02,1.4500D+02,
     & 1.4500D+02,1.4800D+02,1.5000D+02,1.5500D+02,1.7200D+02,
     & 3.5000D+02,3.0000D+02,2.5000D+02,2.4000D+02,2.4500D+02,
     & 2.6000D+02,2.4500D+02,2.3000D+02,2.1500D+02,2.1000D+02,
     & 2.0900D+02,2.0800D+02,2.0500D+02,1.8500D+02,1.7500D+02,
     & 1.7000D+02,1.7000D+02,1.7300D+02,1.8100D+02,2.0500D+02 /
 
      DATA ((SEGP (I,J),I= 1,20),J= 1, 3) /
     & 1.0000D-01,1.0000D-01,1.0000D-01,1.0000D-01,6.1000D+00,
     & 1.2000D+01,1.7700D+01,1.9500D+01,2.0500D+01,2.0700D+01,
     & 2.0600D+01,2.0600D+01,2.0200D+01,1.9800D+01,1.9700D+01,
     & 1.9900D+01,2.0500D+01,2.1500D+01,2.3500D+01,3.2200D+01,
     & 2.9000D+02,2.6400D+02,2.1200D+02,1.9000D+02,1.8900D+02,
     & 1.9700D+02,1.9000D+02,1.8500D+02,1.8000D+02,1.7500D+02,
     & 1.7000D+02,1.6800D+02,1.6400D+02,1.5500D+02,1.4500D+02,
     & 1.4500D+02,1.4800D+02,1.5000D+02,1.5500D+02,1.7200D+02,
     & 3.5000D+02,3.0000D+02,2.5000D+02,2.4000D+02,2.4500D+02,
     & 2.6000D+02,2.4500D+02,2.3000D+02,2.1500D+02,2.1000D+02,
     & 2.0900D+02,2.0800D+02,2.0500D+02,1.8500D+02,1.7500D+02,
     & 1.7000D+02,1.7000D+02,1.7300D+02,1.8100D+02,2.0500D+02 /
 
      DATA ((SIGKP(I,J),I= 1,20),J= 1, 3) /
     & 1.0000D-03,1.0000D-03,1.0000D-03,1.0000D-03,2.0000D-01,
     & 4.5000D+00,8.9000D+00,1.1600D+01,1.2200D+01,1.3400D+01,
     & 1.3600D+01,1.3700D+01,1.3700D+01,1.4900D+01,1.5900D+01,
     & 1.6500D+01,1.7400D+01,1.8600D+01,2.0900D+01,2.8800D+01,
     & 1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,
     & 1.7440D+02,1.7440D+02,1.2960D+02,1.2460D+02,1.2610D+02,
     & 1.2460D+02,1.2290D+02,1.1900D+02,1.1700D+02,1.1900D+02,
     & 1.2900D+02,1.3100D+02,1.3600D+02,1.4400D+02,1.7400D+02,
     & 2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,
     & 2.1630D+02,2.1630D+02,1.6330D+02,1.5700D+02,1.5880D+02,
     & 1.5700D+02,1.5480D+02,1.5000D+02,1.4800D+02,1.5000D+02,
     & 1.6100D+02,1.6400D+02,1.6900D+02,1.7900D+02,2.1900D+02 /
 
      DATA ((SIGKM(I,J),I= 1,20),J= 1, 3) /
     & 3.8000D+01,4.3000D+01,2.3000D+01,1.8500D+01,2.0000D+01,
     & 2.9000D+01,2.5000D+01,2.3000D+01,2.2500D+01,2.1000D+01,
     & 2.0500D+01,2.0000D+01,1.9200D+01,1.8500D+01,1.7800D+01,
     & 1.7800D+01,1.8300D+01,1.9200D+01,2.1200D+01,2.8900D+01,
     & 1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,1.7440D+02,
     & 1.7440D+02,1.7440D+02,1.7440D+02,1.6160D+02,1.4900D+02,
     & 1.4800D+02,1.5000D+02,1.4600D+02,1.3100D+02,1.2900D+02,
     & 1.2900D+02,1.3100D+02,1.3600D+02,1.4400D+02,1.7400D+02,
     & 2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,2.1630D+02,
     & 2.1630D+02,2.1630D+02,2.1630D+02,2.0040D+02,1.8700D+02,
     & 1.8540D+02,1.8700D+02,1.8200D+02,1.6500D+02,1.6100D+02,
     & 1.6100D+02,1.6400D+02,1.6900D+02,1.7900D+02,2.1900D+02 /
 
      DATA ((SIGAP(I,J),I= 1,20),J= 1, 3) /
     & 1.6400D+02,1.2600D+02,1.1400D+02,9.8000D+01,8.6000D+01,
     & 7.2400D+01,5.9000D+01,5.7000D+01,5.3000D+01,5.2000D+01,
     & 4.8000D+01,4.5500D+01,4.3500D+01,4.0400D+01,3.6500D+01,
     & 3.5200D+01,3.4500D+01,3.4500D+01,3.5400D+01,4.1500D+01,
     & 3.2400D+02,3.2400D+02,3.2400D+02,3.2400D+02,3.2400D+02,
     & 3.2400D+02,3.2400D+02,3.2400D+02,3.0100D+02,2.9200D+02,
     & 2.8400D+02,2.7600D+02,2.7200D+02,2.4500D+02,2.0200D+02,
     & 1.9800D+02,1.9600D+02,1.9600D+02,1.9900D+02,2.1900D+02,
     & 3.8800D+02,3.8800D+02,3.8800D+02,3.8800D+02,3.8800D+02,
     & 3.8800D+02,3.8800D+02,3.8800D+02,3.6000D+02,3.5000D+02,
     & 3.4000D+02,3.3000D+02,3.2500D+02,2.9600D+02,2.4600D+02,
     & 2.4200D+02,2.4000D+02,2.4000D+02,2.4400D+02,2.6600D+02 /
 
      DATA ((SIG  (I,J),I= 1,20),J= 4, 6) /
     & 4.5600D+02,4.3400D+02,4.1600D+02,3.9000D+02,3.6100D+02,
     & 3.5200D+02,4.6700D+02,4.7100D+02,4.5800D+02,4.5300D+02,
     & 4.5000D+02,4.5500D+02,4.6000D+02,4.4500D+02,4.3500D+02,
     & 4.3000D+02,4.3200D+02,4.3700D+02,4.4600D+02,4.8100D+02,
     & 7.8200D+02,7.3800D+02,7.0600D+02,6.6100D+02,6.2600D+02,
     & 6.1100D+02,7.7600D+02,7.8000D+02,7.6400D+02,7.6000D+02,
     & 7.5000D+02,7.6000D+02,7.5500D+02,7.4000D+02,7.3000D+02,
     & 7.2600D+02,7.2900D+02,7.3600D+02,7.4800D+02,7.9200D+02,
     & 8.6000D+02,8.1000D+02,7.7500D+02,7.2500D+02,6.9000D+02,
     & 6.8000D+02,8.4700D+02,8.5300D+02,8.5000D+02,8.4500D+02,
     & 8.4000D+02,8.3500D+02,8.2500D+02,8.0500D+02,7.9500D+02,
     & 7.9600D+02,7.9900D+02,8.0600D+02,8.1900D+02,8.6400D+02 /
 
      DATA ((SEG  (I,J),I= 1,20),J= 4, 6) /
     & 6.1000D+02,5.4000D+02,4.9000D+02,4.6000D+02,4.3500D+02,
     & 4.5000D+02,4.4000D+02,4.1500D+02,4.1000D+02,3.9800D+02,
     & 3.9200D+02,3.8700D+02,3.7000D+02,3.5000D+02,3.3300D+02,
     & 3.3300D+02,3.3500D+02,3.3800D+02,3.4800D+02,3.8300D+02,
     & 1.0000D+03,9.1000D+02,8.6000D+02,8.0000D+02,7.8000D+02,
     & 7.7500D+02,7.6000D+02,7.1000D+02,6.8300D+02,6.7000D+02,
     & 6.6300D+02,6.5400D+02,6.3400D+02,5.9800D+02,5.7000D+02,
     & 5.7000D+02,5.7500D+02,5.8000D+02,6.0000D+02,6.5300D+02,
     & 1.0900D+03,1.0000D+03,9.6000D+02,9.5000D+02,8.8000D+02,
     & 8.5000D+02,8.3500D+02,7.8000D+02,7.5000D+02,7.4000D+02,
     & 7.3000D+02,7.2000D+02,7.0000D+02,6.6000D+02,6.3000D+02,
     & 6.3000D+02,6.3500D+02,6.4000D+02,6.6000D+02,7.2000D+02 /
 
      DATA ((SEGP (I,J),I= 1,20),J= 4, 6) /
     & 6.1000D+02,5.4000D+02,4.9000D+02,4.6000D+02,4.3500D+02,
     & 4.5000D+02,4.4000D+02,4.1500D+02,4.1000D+02,3.9800D+02,
     & 3.9200D+02,3.8700D+02,3.7000D+02,3.5000D+02,3.3300D+02,
     & 3.3300D+02,3.3500D+02,3.3800D+02,3.4800D+02,3.8300D+02,
     & 1.0000D+03,9.1000D+02,8.6000D+02,8.0000D+02,7.8000D+02,
     & 7.7500D+02,7.6000D+02,7.1000D+02,6.8300D+02,6.7000D+02,
     & 6.6300D+02,6.5400D+02,6.3400D+02,5.9800D+02,5.7000D+02,
     & 5.7000D+02,5.7500D+02,5.8000D+02,6.0000D+02,6.5300D+02,
     & 1.0900D+03,1.0000D+03,9.6000D+02,9.5000D+02,8.8000D+02,
     & 8.5000D+02,8.3500D+02,7.8000D+02,7.5000D+02,7.4000D+02,
     & 7.3000D+02,7.2000D+02,7.0000D+02,6.6000D+02,6.3000D+02,
     & 6.3000D+02,6.3500D+02,6.4000D+02,6.6000D+02,7.2000D+02 /
 
      DATA ((SIGKP(I,J),I= 1,20),J= 4, 6) /
     & 3.1750D+02,3.1750D+02,3.1750D+02,3.1750D+02,3.1750D+02,
     & 3.1750D+02,3.1750D+02,3.1320D+02,3.0110D+02,3.0460D+02,
     & 3.0110D+02,2.9680D+02,2.8700D+02,2.8400D+02,2.8600D+02,
     & 2.9900D+02,3.0200D+02,3.1100D+02,3.2800D+02,3.8600D+02,
     & 6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,
     & 6.8380D+02,6.8380D+02,5.6180D+02,5.4020D+02,5.4640D+02,
     & 5.4020D+02,5.3250D+02,5.1500D+02,5.1000D+02,5.1000D+02,
     & 5.2200D+02,5.2600D+02,5.3900D+02,5.6700D+02,6.5400D+02,
     & 7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,
     & 7.5220D+02,7.5220D+02,6.2240D+02,5.9840D+02,6.0530D+02,
     & 5.9840D+02,5.8990D+02,5.7000D+02,5.6500D+02,5.6500D+02,
     & 5.7500D+02,5.7900D+02,5.9400D+02,6.2400D+02,7.1800D+02 /
 
      DATA ((SIGKM(I,J),I= 1,20),J= 4, 6) /
     & 3.9680D+02,3.9680D+02,3.9680D+02,3.9680D+02,3.9680D+02,
     & 3.9680D+02,3.9680D+02,3.9680D+02,3.6760D+02,3.5300D+02,
     & 3.5000D+02,3.5000D+02,3.4100D+02,3.1700D+02,3.0300D+02,
     & 2.9900D+02,3.0200D+02,3.1100D+02,3.2800D+02,3.8600D+02,
     & 6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,6.8380D+02,
     & 6.8380D+02,6.8380D+02,6.8380D+02,6.3360D+02,6.2400D+02,
     & 6.2000D+02,6.1600D+02,5.9800D+02,5.6900D+02,5.3400D+02,
     & 5.2200D+02,5.2600D+02,5.3900D+02,5.6700D+02,6.5400D+02,
     & 7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,7.5220D+02,
     & 7.5220D+02,7.5220D+02,7.5220D+02,6.9700D+02,6.9000D+02,
     & 6.8500D+02,6.8000D+02,6.6000D+02,6.3000D+02,5.9000D+02,
     & 5.7500D+02,5.7900D+02,5.9400D+02,6.2400D+02,7.1800D+02 /
 
      DATA ((SIGAP(I,J),I= 1,20),J= 4, 6) /
     & 6.4800D+02,6.4800D+02,6.4800D+02,6.4800D+02,6.4800D+02,
     & 6.4800D+02,6.4800D+02,6.4800D+02,5.9800D+02,5.8100D+02,
     & 5.6400D+02,5.4800D+02,5.4000D+02,5.0000D+02,4.3400D+02,
     & 4.2900D+02,4.2700D+02,4.2700D+02,4.3200D+02,4.6400D+02,
     & 1.0240D+03,1.0240D+03,1.0240D+03,1.0240D+03,1.0240D+03,
     & 1.0240D+03,1.0240D+03,1.0240D+03,9.4100D+02,9.1500D+02,
     & 8.8800D+02,8.6200D+02,8.4900D+02,8.0100D+02,7.2000D+02,
     & 7.1600D+02,7.1500D+02,7.1500D+02,7.2200D+02,7.6300D+02,
     & 1.1100D+03,1.1100D+03,1.1100D+03,1.1100D+03,1.1100D+03,
     & 1.1100D+03,1.1100D+03,1.1100D+03,1.0200D+03,9.9200D+02,
     & 9.6300D+02,9.3500D+02,9.2100D+02,8.7000D+02,7.8800D+02,
     & 7.8400D+02,7.8400D+02,7.8400D+02,7.9200D+02,8.3400D+02 /
 
      DATA ((SIG  (I,J),I= 1,20),J= 7, 9) /
     & 1.2360D+03,1.1780D+03,1.1400D+03,1.0800D+03,1.0250D+03,
     & 1.0370D+03,1.2610D+03,1.2670D+03,1.2500D+03,1.2500D+03,
     & 1.2240D+03,1.2200D+03,1.2130D+03,1.2100D+03,1.2000D+03,
     & 1.2000D+03,1.2100D+03,1.2130D+03,1.2300D+03,1.2800D+03,
     & 1.8200D+03,1.7600D+03,1.7200D+03,1.6500D+03,1.5700D+03,
     & 1.6490D+03,1.9300D+03,1.9350D+03,1.9200D+03,1.9000D+03,
     & 1.8930D+03,1.8880D+03,1.8800D+03,1.8700D+03,1.8600D+03,
     & 1.8650D+03,1.8700D+03,1.8800D+03,1.9000D+03,1.9450D+03,
     & 1.9900D+03,1.9300D+03,1.8900D+03,1.8200D+03,1.7300D+03,
     & 1.8320D+03,2.1270D+03,2.1310D+03,2.1200D+03,2.1330D+03,
     & 2.0900D+03,2.0850D+03,2.0800D+03,2.0700D+03,2.0600D+03,
     & 2.0600D+03,2.0700D+03,2.0770D+03,2.0950D+03,2.1400D+03 /
 
      DATA ((SEG  (I,J),I= 1,20),J= 7, 9) /
     & 1.6300D+03,1.4800D+03,1.3100D+03,1.2600D+03,1.2400D+03,
     & 1.2200D+03,1.2000D+03,1.1500D+03,1.1150D+03,1.1050D+03,
     & 1.0950D+03,1.0800D+03,1.0620D+03,1.0000D+03,9.6000D+02,
     & 9.6000D+02,9.6500D+02,9.7100D+02,1.0000D+03,1.0850D+03,
     & 2.5000D+03,2.2500D+03,1.9600D+03,1.8500D+03,1.8200D+03,
     & 1.8000D+03,1.7800D+03,1.7000D+03,1.6900D+03,1.6850D+03,
     & 1.6800D+03,1.6750D+03,1.6600D+03,1.5800D+03,1.5000D+03,
     & 1.4800D+03,1.4800D+03,1.4950D+03,1.5300D+03,1.6500D+03,
     & 2.7500D+03,2.4750D+03,2.2000D+03,2.1000D+03,2.1000D+03,
     & 2.1000D+03,2.0700D+03,1.9600D+03,1.8800D+03,1.8700D+03,
     & 1.8400D+03,1.8200D+03,1.8000D+03,1.7400D+03,1.6650D+03,
     & 1.6650D+03,1.6780D+03,1.6920D+03,1.7440D+03,1.8780D+03 /
 
      DATA ((SEGP (I,J),I= 1,20),J= 7, 9) /
     & 1.6300D+03,1.4800D+03,1.3100D+03,1.2600D+03,1.2400D+03,
     & 1.2200D+03,1.2000D+03,1.1500D+03,1.1150D+03,1.1050D+03,
     & 1.0950D+03,1.0800D+03,1.0620D+03,1.0000D+03,9.6000D+02,
     & 9.6000D+02,9.6500D+02,9.7100D+02,1.0000D+03,1.0850D+03,
     & 2.5000D+03,2.2500D+03,1.9600D+03,1.8500D+03,1.8200D+03,
     & 1.8000D+03,1.7800D+03,1.7000D+03,1.6900D+03,1.6850D+03,
     & 1.6800D+03,1.6750D+03,1.6600D+03,1.5800D+03,1.5000D+03,
     & 1.4800D+03,1.4800D+03,1.4950D+03,1.5300D+03,1.6500D+03,
     & 2.7500D+03,2.4750D+03,2.2000D+03,2.1000D+03,2.1000D+03,
     & 2.1000D+03,2.0700D+03,1.9600D+03,1.8800D+03,1.8700D+03,
     & 1.8400D+03,1.8200D+03,1.8000D+03,1.7400D+03,1.6650D+03,
     & 1.6650D+03,1.6780D+03,1.6920D+03,1.7440D+03,1.8780D+03 /
 
      DATA ((SIGKP(I,J),I= 1,20),J= 7, 9) /
     & 1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,
     & 1.1530D+03,1.1530D+03,9.8450D+02,9.4660D+02,9.5740D+02,
     & 9.4660D+02,9.3310D+02,9.0000D+02,8.8600D+02,8.8000D+02,
     & 8.8600D+02,8.9300D+02,9.1500D+02,9.5600D+02,1.0850D+03,
     & 1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,
     & 1.8219D+03,1.8219D+03,1.6088D+03,1.5469D+03,1.5646D+03,
     & 1.5469D+03,1.5248D+03,1.4660D+03,1.4330D+03,1.4070D+03,
     & 1.4070D+03,1.4210D+03,1.4520D+03,1.5130D+03,1.6890D+03,
     & 2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,
     & 2.0215D+03,2.0215D+03,1.7987D+03,1.7296D+03,1.7493D+03,
     & 1.7296D+03,1.7049D+03,1.6400D+03,1.6000D+03,1.5700D+03,
     & 1.5630D+03,1.5800D+03,1.6130D+03,1.6790D+03,1.8680D+03 /
 
      DATA ((SIGKM(I,J),I= 1,20),J= 7, 9) /
     & 1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,1.1530D+03,
     & 1.1530D+03,1.1530D+03,1.1530D+03,1.0683D+03,1.0590D+03,
     & 1.0530D+03,1.0460D+03,1.0180D+03,9.3700D+02,8.9800D+02,
     & 8.8600D+02,8.9300D+02,9.1500D+02,9.5600D+02,1.0850D+03,
     & 1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,1.8219D+03,
     & 1.8219D+03,1.8219D+03,1.8219D+03,1.6881D+03,1.6750D+03,
     & 1.6700D+03,1.6600D+03,1.6200D+03,1.4330D+03,1.4070D+03,
     & 1.4070D+03,1.4210D+03,1.4520D+03,1.5130D+03,1.6890D+03,
     & 2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,2.0215D+03,
     & 2.0215D+03,2.0215D+03,2.0215D+03,1.8731D+03,1.8590D+03,
     & 1.8540D+03,1.8440D+03,1.8000D+03,1.6200D+03,1.5800D+03,
     & 1.5630D+03,1.5800D+03,1.6130D+03,1.6790D+03,1.8680D+03 /
 
      DATA ((SIGAP(I,J),I= 1,20),J= 7, 9) /
     & 1.5900D+03,1.5900D+03,1.5900D+03,1.5900D+03,1.5900D+03,
     & 1.5900D+03,1.5900D+03,1.5900D+03,1.4570D+03,1.4170D+03,
     & 1.3760D+03,1.3360D+03,1.3160D+03,1.2600D+03,1.1750D+03,
     & 1.1720D+03,1.1760D+03,1.1760D+03,1.1850D+03,1.2330D+03,
     & 2.3380D+03,2.3380D+03,2.3380D+03,2.3380D+03,2.3380D+03,
     & 2.3380D+03,2.3380D+03,2.3380D+03,2.1360D+03,2.0760D+03,
     & 2.0170D+03,1.9580D+03,1.9280D+03,1.8730D+03,1.8000D+03,
     & 1.8040D+03,1.8160D+03,1.8160D+03,1.8260D+03,1.8740D+03,
     & 2.5520D+03,2.5520D+03,2.5520D+03,2.5520D+03,2.5520D+03,
     & 2.5520D+03,2.5520D+03,2.5520D+03,2.3300D+03,2.2650D+03,
     & 2.2000D+03,2.1360D+03,2.1030D+03,2.0500D+03,1.9840D+03,
     & 1.9900D+03,2.0040D+03,2.0040D+03,2.0150D+03,2.0610D+03 /
 
      DATA ((TOTCRS(I,J),I= 1,19),J= 1, 3) /
     & 7.9400D+01,7.6200D+01,4.4700D+01,3.6500D+01,3.3100D+01,
     & 4.0200D+01,4.3400D+01,5.1700D+01,4.3600D+01,3.6900D+01,
     & 3.1200D+01,3.1600D+01,3.3500D+01,3.0400D+01,2.7400D+01,
     & 2.5400D+01,2.4500D+01,2.4000D+01,2.2500D+01,
     & 5.4200D+01,5.1000D+01,3.6000D+01,2.6000D+01,2.9100D+01,
     & 3.0000D+01,3.0000D+01,3.6600D+01,3.3000D+01,2.9600D+01,
     & 2.8300D+01,2.7000D+01,2.6400D+01,2.2700D+01,2.1800D+01,
     & 2.0500D+01,2.1000D+01,2.1900D+01,2.0600D+01,
     & 1.2000D+01,1.3700D+01,1.3000D+01,1.2500D+01,1.1200D+01,
     & 1.2000D+01,1.4300D+01,1.6000D+01,1.7200D+01,1.8100D+01,
     & 1.7900D+01,1.8300D+01,1.7900D+01,1.7600D+01,1.7200D+01,
     & 1.7600D+01,1.7200D+01,1.7000D+01,1.7300D+01 /
 
      DATA ((TOTCRS(I,J),I= 1,19),J= 4, 5) /
     & 1.3000D+01,1.4500D+01,1.4000D+01,1.3000D+01,1.4500D+01,
     & 1.5800D+01,1.6900D+01,1.8500D+01,2.0600D+01,2.0900D+01,
     & 2.0000D+01,1.9400D+01,1.9000D+01,1.8800D+01,1.7800D+01,
     & 1.7800D+01,1.7800D+01,1.7500D+01,1.7500D+01,
     & 2.8000D+02,1.9970D+02,1.7110D+02,1.5430D+02,1.4000D+02,
     & 1.3000D+02,1.1680D+02,1.1740D+02,1.1160D+02,1.0900D+02,
     & 1.0650D+02,1.0280D+02,1.0000D+02,9.0200D+01,7.6700D+01,
     & 6.8000D+01,6.2800D+01,6.0700D+01,5.6000D+01 /
 
C  PLAB - LAB MOMENTUM SCALE FOR TOTCRS
      DATA PLAB/.3D0,.4D0,.5D0,.6D0,.7D0,.8D0,.9D0,1.D0,1.1D0,
     *1.2D0,1.3D0,
     &1.4D0,1.5D0,2.D0,3.D0,4.D0,
     *5.D0,6.D0,10.D0/
* Original correspondence
*                p    ap   e-   e+   nu  anu gamma  n    an  mu+  mu-
*     DATA ITT/   1,   7,   0,   0,   0,   0,   0,   2,   8,   0,   0,
*              Klong pi+  pi-   K+   K- Lam  Alam Kshrt Sig- Sig+ Sig0
*    &           10,   3,   4,   6,   5,   1,   2,  10,   1,   1,   1,
*               pi0   K0  AK0
*    &            3,  10,   9/
*                p    ap   e-   e+   nu  anu gamma  n    an  mu+  mu-
      DATA ITT/   1,   7,   0,   0,   0,   0,   0,   2,   8,   0,   0,
*              Klong pi+  pi-   K+   K- Lam  Alam Kshrt Sig- Sig+ Sig0
     &           10,   3,   4,   6,   5,   2,   8,  10,   2,   1,   2,
*               pi0   K0  AK0  pi0  res. res. res. res. Asi- Asi0 Asi+
     &            3,  10,   9,   3,   0,   0,   0,   0,   8,   8,   7,
*                X0  Ax0   X-  AX-  Om- Aom+
     &            2,   8,   2,   8,   2,   8 /
*
*
*     Modified by A. Ferrari to use RNDM2
*
*
*     Comment the next 1 card for Rndm2, activate for Rndm
*
*     DATA ROU1/-2.D0/
*
*     Comment the next 1 card on Rndm, activate for Rndm2
*
      DATA IROU1, IROU2 /2*0/
      AA=AAA
      SI=AZRZRZ
      ZL=AINFNT
      IF ( AA .LT. 1.5D+00 ) THEN
         IF ( IT .EQ. 13 .AND. PO .LE. 0.270436311984990D+00 ) THEN
            SI = 0.D+00
            ZL = AINFNT
            RETURN
         ELSE IF ( IT .EQ. 1 .AND. PO .LE. 0.776527236216833D+00 ) THEN
            SI = 0.D+00
            ZL = AINFNT
            RETURN
         ELSE IF ( IT .EQ. 8 .AND. PO .LE. 0.777284775476990D+00 ) THEN
            SI = 0.D+00
            ZL = AINFNT
            RETURN
         END IF
      END IF
*  Check the kinetic energy: no interaction below 50 MeV at present
*     IF ( IT .LE. 30 ) THEN
         IF ( EKE .LT. 0.0499D+00 ) RETURN
*     ELSE
*        IF ( EKE .LT. 2.5D+00 ) RETURN
*     END IF
      IF(AA.LT.0.99D0)RETURN
C
C     CALCULATE THE NEW PARTICLE NUMBER IIT:   1=P,2=N,3=PI+,4=PI-,
C     5=K-,6=K+,7=P BAR,8=N BAR,9=K ZERO BAR,10=K ZERO
C
      IIT=ITT(IT)
      IF(IIT.EQ.0)RETURN
C
C     RNDM IS CALLED ONLY ONCE EVEN IF 'CALL NIZL' IS IN A DO-LOOP
C     (I.E. CURRENT MATERIAL IS A COMPOUND).
C
      IF(IT.EQ.19.OR.IT.EQ.12) THEN
        CALL GRNDMQ(JROU1,JROU2,0,'G')
        IF(IROU1.NE.JROU1.AND.IROU2.NE.JROU2) THEN
           CALL GRNDM(RNDM,1)
           RND=RNDM(1)
        ENDIF
        IF(RND.GT.0.5D0) IIT=9
        CALL GRNDMQ(IROU1,IROU2,0,'G')
      END IF
      IF(AA.LT.2.D0) GOTO 9
      IF(IIT.GE.5.AND.PO.LE.2.D0) GOTO 102
C
C********************************************************************
C     P, N , PI+, PI-  OR ANY HIGH ENERGY (> 2 GEV/C) HADRON
C********************************************************************
C
C     CALCULATE THE MOMENTUM INDEX K
C
 9    CONTINUE
      DO 22 K=1,20
         IF(PO.LE.P(K)) GO TO 23
   22 CONTINUE
      K=20
   23 CONTINUE
C
C     CALCULATE THE MASS INDEX J
C
      IF(AA.GE.2.D0) GOTO 8
      AA=1.D+00
      J=1
      JJ=1
      GOTO 7
 8    CONTINUE
      DO 5 I=2,8
         IF(AA.LE.A(I)) GO TO 6
         GO TO 5
    6    CONTINUE
         J=I-1
         JJ=J+1
         GO TO 7
    5 CONTINUE
      J=8
      JJ=J+1
    7 CONTINUE
      GO TO (101,101,114,113,116,115,1002,1002,116,115)    ,IIT
C
C     NUCLEONS
C
 101  CONTINUE
      SI1=SIG(K,J)*(AA/A(J))**(LOG(SIG(K,JJ)/SIG(K,J))/LOG(A(J+1)/A(J
     *)))
      IF (K.EQ.1) THEN
         SI=SI1
         GO TO 121
      END IF
      KK=K-1
      SI2=SIG(KK,J)*(AA/A(J))**(LOG(SIG(KK,JJ)/SIG(KK,J))/LOG(A(J+1)/
     *A(J)))
      IF (PO.GE.10000.D0) THEN
         AMITSQ=AM(IT)*AM(IT)
         S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
         S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
         SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
         ALS2SQ=LOG(S2SQ)
         BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
         ACOEF=SI2-BCOEF*ALS2SQ
         SI=ACOEF+BCOEF*LOG(SSSQ)
         GO TO 121
      ELSE
         GO TO 120
      END IF
C
C     PI -
C
  113 CONTINUE
      IF(K.EQ.1) GOTO 1113
      SI1=SEG(K,J)*(AA/A(J))**(LOG(SEG(K,JJ)/SEG(K,J))/LOG(A(J+1)/A(J
     *)))
      KK=K-1
      SI2=SEG(KK,J)*(AA/A(J))**(LOG(SEG(KK,JJ)/SEG(KK,J))/LOG(A(J+1)/
     *A(J)))
      IF (PO.GE.10000.D0) THEN
         AMITSQ=AM(IT)*AM(IT)
         S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
         S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
         SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
         ALS2SQ=LOG(S2SQ)
         BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
         ACOEF=SI2-BCOEF*ALS2SQ
         SI=ACOEF+BCOEF*LOG(SSSQ)
         GO TO 121
      ELSE
         GO TO 120
      END IF
C
C     PI +
C
  114 CONTINUE
      IF(K.EQ.1) GOTO 1113
      SI1=SEGP(K,J)*(AA/A(J))**(LOG(SEGP(K,JJ)/SEGP(K,J))/LOG(A(J+1)/
     *A(J)))
      KK=K-1
      SI2=SEGP(KK,J)*(AA/A(J))**(LOG(SEGP(KK,JJ)/SEGP(KK,J))/LOG(A(J+
     *1)/A(J)))
      IF (PO.GE.10000.D0) THEN
         AMITSQ=AM(IT)*AM(IT)
         S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
         S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
         SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
         ALS2SQ=LOG(S2SQ)
         BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
         ACOEF=SI2-BCOEF*ALS2SQ
         SI=ACOEF+BCOEF*LOG(SSSQ)
         GO TO 121
      ELSE
         GO TO 120
      END IF
C
C     K -  AND K0 BAR
C
  116 CONTINUE
C     IF(K.EQ.1) GOTO 1113
      SI1=SIGKM(K,J)*(AA/A(J))**(LOG(SIGKM(K,JJ)/SIGKM(K,J))/LOG(A(J+
     *1)/A(J)))
      IF (K.EQ.1) THEN
         SI=SI1
         GO TO 121
      END IF
      KK=K-1
      SI2=SIGKM(KK,J)*(AA/A(J))**(LOG(SIGKM(KK,JJ)/SIGKM(KK,J))/LOG(A
     *(J+1)/A(J)))
      IF (PO.GE.10000.D0) THEN
         AMITSQ=AM(IT)*AM(IT)
         S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
         S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
         SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
         ALS2SQ=LOG(S2SQ)
         BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
         ACOEF=SI2-BCOEF*ALS2SQ
         SI=ACOEF+BCOEF*LOG(SSSQ)
         GO TO 121
      ELSE
         GO TO 120
      END IF
C
C     K +  AND K0
C
  115 CONTINUE
      SI1=SIGKP(K,J)*(AA/A(J))**(LOG(SIGKP(K,JJ)/SIGKP(K,J))/LOG(A(J+
     *1)/A(J)))
      IF (K.EQ.1) THEN
         SI=SI1
         GO TO 121
      END IF
      KK=K-1
      SI2=SIGKP(KK,J)*(AA/A(J))**(LOG(SIGKP(KK,JJ)/SIGKP(KK,J))/LOG(A
     *(J+1)/A(J)))
      IF (PO.GE.10000.D0) THEN
         AMITSQ=AM(IT)*AM(IT)
         S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
         S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
         SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
         ALS2SQ=LOG(S2SQ)
         BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
         ACOEF=SI2-BCOEF*ALS2SQ
         SI=ACOEF+BCOEF*LOG(SSSQ)
         GO TO 121
      ELSE
         GO TO 120
      END IF
C
C     ANTI-NUCLEONS
C
 1002 CONTINUE
      SI1=SIGAP(K,J)*(AA/A(J))**(LOG(SIGAP(K,JJ)/SIGAP(K,J))/LOG(A(J+
     *1)/A(J)))
      IF (K.EQ.1) THEN
         SI=SI1
         GO TO 121
      END IF
      KK=K-1
      SI2=SIGAP(KK,J)*(AA/A(J))**(LOG(SIGAP(KK,JJ)/SIGAP(KK,J))/LOG(A
     *(J+1)/A(J)))
      IF (PO.GE.10000.D0) THEN
         AMITSQ=AM(IT)*AM(IT)
         S1SQ=AMITSQ+AMNCSQ+AMNTM2*(P(K)+0.5D+00*AMITSQ/P(K))
         S2SQ=AMITSQ+AMNCSQ+AMNTM2*(P(KK)+0.5D+00*AMITSQ/P(KK))
         SSSQ=AMITSQ+AMNCSQ+AMNTM2*(PO+0.5D+00*AMITSQ/PO)
         ALS2SQ=LOG(S2SQ)
         BCOEF=(SI2-SI1)/(ALS2SQ-LOG(S1SQ))
         ACOEF=SI2-BCOEF*ALS2SQ
         SI=ACOEF+BCOEF*LOG(SSSQ)
         GO TO 121
      END IF
C
C     INTERPOLATE LINEARLY WITH RESPECT TO MOMENTUM
C
  120 CONTINUE
      SI=SI1+(PO-P(K))*(SI2-SI1)/(P(KK)-P(K))
      GO TO 121
C
C********************************************************************
C     LOW ENERGY  (<2.0 GEV/C) K-, K+, PBAR, NBAR, K ZERO BAR, K ZERO
C********************************************************************
C
  102 CONTINUE
      IF(IIT.GE.9) IIT=IIT-4
C
C     CALCULATE MOMENTUM INDEX K AND INTERACTION INDICES I1 AND I2
C
      DO 33 K=1,19
      IF(PO.LE.PLAB(K)) GO TO 34
   33 CONTINUE
      K=19
   34 KK=K-1
      PO1=PO-PLAB(K)
      IIT=IIT-4
      I2=2*IIT
      I1=I2-1
      IF(I1.LT.5) GO TO 41
      I1=5
      I2=5
 41   CONTINUE
C
C     TAKE THE AVERAGE OVER -/NEUTRON AND -/PROTON CROSS SECTIONS
C     AND INTERPOLATE LINEARLY WITH RESPECT TO MOMENTUM
C
      SI=(TOTCRS(K,I1)+TOTCRS(K,I2))*0.5D0
      IF(K.EQ.1) GOTO 2008
      DS=(TOTCRS(KK,I1)+TOTCRS(KK,I2)-TOTCRS(K,I1)-TOTCRS(K,I2))*0.5D0
      SI=SI+PO1*DS/(PLAB(KK)-PLAB(K))
 2008 CONTINUE
      SI=BET(IIT)*SI*AA**ALPH(IIT)
      IF(IT.NE.16.OR.PO.GE.1.41D0) GOTO 121
C
C     SPECIAL TREATMENT FOR LOW ENERGY K-
C
      SI=SI*0.5D0*(1.D0+SQRT(PO**2+0.244D0)-0.494D0)
      GO TO 121
C
C********************************************************************
C        LOW ENERGY PIONS (<0.3GEV/C)
C********************************************************************
C
 1113 CONTINUE
      SI=0.01D0
      IF(IT.EQ.13.AND.J.EQ.1) THEN
        SI = ANGLGB
        GOTO 121
      END IF
      DO 1122 K=1,4
         IF(PO.LE.PEE(K)) GOTO 1123
 1122 CONTINUE
      K=4
 1123 CONTINUE
      SI1=SEEG(K,J)*(AA/A(J))**(LOG(SEEG(K,JJ)/SEEG(K,J))
     * /LOG(A(J+1)/A(J)))
      SI=SI1
      IF(K.EQ.1)GO TO 121
      KK=K-1
      SI2=SEEG(KK,J)*(AA/A(J))**(LOG(SEEG(KK,JJ)
     * /SEEG(KK,J))/LOG(A(J+1)/A(J)))
C
C     INTERPOLATE LINEARLY WITH RESPECT TO MOMENTUM
C
      SI=SI1 + (PO-PEE(K))*(SI2-SI1)/(PEE(KK)-PEE(K))
C
C********************************************************************
C     CALCULATE THE INTERACTION LENGTH
C********************************************************************
C
 121  CONTINUE
* A. Ferrari: commented out, no 1.07 factor is applied now to neutrons
*     IF(J.EQ.1.AND.IIT.EQ.2) SI=SI*1.07D+00
C     ZL=10000.D0*AA/(6.022D0*SI)
      ZL=AVOGMB*AA/SI
      RETURN
      END