[u/mrichter/AliRoot.git] / GEANT321 / fluka / sihael.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:05  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.45  by  S.Giani
*-- Author :
*$ CREATE SIHAEL.FOR
*COPY SIHAEL
*                                                                      *
*=== sihael ===========================================================*
*                                                                      *
      SUBROUTINE SIHAEL(KPROJ,EKIN,PLAB,ANUC,SIGELA)
 
#include "geant321/dblprc.inc"
#include "geant321/dimpar.inc"
#include "geant321/iounit.inc"
C***
C        HJM 22/10/88
C
C        CROSS SECTIONS FOR ELASTIC SCATTERING
C
C        INCLUDING - PION/NUCLEON PROTON DATA FROM BERTINI (HETKFA2)
C
C                  - ...  HIGH-ENERGY APPROXIMATION:
C                                       SIGEL/SIGTOT = CONST
C
C                  - NUCLEON-NUCLEUS DATA FROM HETKFA2
C***
      PARAMETER (NEN=106)
      PARAMETER (NEA=23)
      PARAMETER (NNAA=10)
      DIMENSION EKIHN(NEN),EKIHA(NEA),AMASS(NNAA)
      DIMENSION SEPIMP(NEN),SEPIPP(NEN),SEPP(NEN),SENP(NEN)
      DIMENSION SENA(NEA,NNAA),SEPA(NEA,NNAA)
      DIMENSION TSIG(2)
      DIMENSION RELTO(14)
C
#include "geant321/paprop.inc"
C***
C   KINETIC ENERGIES FOR TABLE LOOK-UP
 
      DATA EKIHN /
     &   0.00D0, 0.02D0, 0.04D0, 0.06D0, 0.08D0, 0.10D0, 0.12D0, 0.14D0,
     &   0.16D0, 0.18D0, 0.20D0, 0.22D0, 0.24D0, 0.26D0, 0.28D0, 0.30D0,
     &   0.32D0, 0.34D0, 0.36D0, 0.38D0, 0.40D0, 0.42D0, 0.44D0, 0.46D0,
     &   0.48D0, 0.50D0, 0.52D0, 0.54D0, 0.56D0, 0.58D0, 0.60D0, 0.62D0,
     &   0.64D0, 0.66D0, 0.68D0, 0.70D0, 0.72D0, 0.74D0, 0.76D0, 0.78D0,
     &   0.80D0, 0.82D0, 0.84D0, 0.86D0, 0.88D0, 0.90D0, 0.92D0, 0.94D0,
     &   0.96D0, 0.98D0, 1.00D0, 1.02D0, 1.04D0, 1.06D0, 1.08D0, 1.10D0,
     &   1.12D0, 1.14D0, 1.16D0, 1.18D0, 1.20D0, 1.22D0, 1.24D0, 1.26D0,
     &   1.28D0, 1.30D0, 1.32D0, 1.34D0, 1.36D0, 1.38D0, 1.40D0, 1.42D0,
     &   1.44D0, 1.46D0, 1.48D0, 1.50D0, 1.52D0, 1.54D0, 1.56D0, 1.58D0,
     &   1.60D0, 1.62D0, 1.64D0, 1.66D0, 1.68D0, 1.70D0, 1.72D0, 1.74D0,
     &   1.76D0, 1.78D0, 1.80D0, 1.82D0, 1.84D0, 1.86D0, 1.88D0, 1.90D0,
     &   1.92D0, 1.94D0, 1.96D0, 1.98D0, 2.00D0, 2.5D0,  3.0D0,  3.5D0,
     &   5.0D0, 10.0D0/
      DATA EKIHA /
     &   0.015D0, 0.02D0, 0.025D0, 0.03D0,  0.04D0, 0.05D0, 0.06D0,
     &   0.08D0,  0.10D0, 0.125D0, 0.15D0, 0.175D0, 0.20D0, 0.225D0,
     &   0.25D0,  0.3D0,  0.4D0,   0.6D0,  1.0D0,   2.0D0,  5.0D0,
     &   10.0D0,  22.5D0/
      DATA AMASS /
     &   4.D0, 9.D0, 12.D0, 27.D0, 47.9D0, 55.9D0, 63.5D0, 112.4D0,
     &   207.2D0, 238.1D0/
C-------------------------------------------------------------------
C
C***     PI(-)-P ELASTIC CROSS SECTION DATA
      DATA (SEPIMP(IE),IE=1,50) /
     *     1.250D+00,  1.500D+00,  1.750D+00,  2.450D+00,  3.800D+00,
     *     6.000D+00,  9.700D+00,  1.500D+01,  2.140D+01,  2.310D+01,
     *     2.295D+01,  2.070D+01,  1.795D+01,  1.550D+01,  1.360D+01,
     *     1.230D+01,  1.130D+01,  1.070D+01,  1.050D+01,  1.070D+01,
     *     1.120D+01,  1.175D+01,  1.235D+01,  1.300D+01,  1.400D+01,
     *     1.500D+01,  1.600D+01,  1.700D+01,  1.835D+01,  1.970D+01,
     *     2.050D+01,  1.915D+01,  1.770D+01,  1.650D+01,  1.570D+01,
     *     1.520D+01,  1.510D+01,  1.525D+01,  1.550D+01,  1.600D+01,
     *     1.685D+01,  1.800D+01,  2.000D+01,  2.230D+01,  2.475D+01,
     *     2.635D+01,  2.510D+01,  2.300D+01,  2.140D+01,  2.000D+01/
      DATA (SEPIMP(IE),IE=51,106) /
     *     1.870D+01,  1.750D+01,  1.670D+01,  1.585D+01,  1.505D+01,
     *     1.440D+01,  1.395D+01,  1.340D+01,  1.299D+01,  1.260D+01,
     *     1.215D+01,  1.175D+01,  1.140D+01,  1.099D+01,  1.060D+01,
     *     1.040D+01,  1.010D+01,  9.990D+00,  9.900D+00,  9.750D+00,
     *     9.600D+00,  9.550D+00,  9.450D+00,  9.350D+00,  9.250D+00,
     *     9.250D+00,  9.350D+00,  9.650D+00,  9.850D+00,  1.000D+01,
     *     1.015D+01,  1.030D+01,  1.060D+01,  1.080D+01,  1.095D+01,
     *     1.100D+01,  1.095D+01,  1.090D+01,  1.070D+01,  1.035D+01,
     *     1.000D+01,  9.600D+00,  9.050D+00,  8.550D+00,  8.200D+00,
     *     8.000D+00,  7.850D+00,  7.800D+00,  7.750D+00,  7.700D+00,
     *     7.650D+00,
     *     7.600D+00,  7.240D+00,  6.770D+00,  5.840D+00,  4.570D+00/
* *** The previous 5 points have been substituted to the erroneous
* *** ones from H.J. Mohring by A. Ferrari
C---------------------------------------------------------------------
C
C***     PI(+)-P ELASTIC CROSS SECTION DATA
      DATA (SEPIPP(IE),IE=1,50) /
     *     1.800D+00,  4.000D+00,  9.900D+00,  2.170D+01,  4.000D+01,
     *     6.580D+01,  9.680D+01,  1.392D+02,  1.800D+02,  2.000D+02,
     *     1.655D+02,  1.420D+02,  1.225D+02,  1.032D+02,  8.400D+01,
     *     6.725D+01,  5.510D+01,  4.725D+01,  4.130D+01,  3.690D+01,
     *     3.230D+01,  2.885D+01,  2.600D+01,  2.300D+01,  2.090D+01,
     *     1.875D+01,  1.675D+01,  1.500D+01,  1.340D+01,  1.200D+01,
     *     1.100D+01,  9.980D+00,  9.200D+00,  8.600D+00,  8.200D+00,
     *     8.100D+00,  8.100D+00,  8.250D+00,  8.500D+00,  8.750D+00,
     *     9.000D+00,  9.400D+00,  9.750D+00,  1.000D+01,  1.030D+01,
     *     1.075D+01,  1.130D+01,  1.200D+01,  1.275D+01,  1.330D+01/
      DATA (SEPIPP(IE),IE=51,106) /
     *     1.350D+01,  1.335D+01,  1.330D+01,  1.330D+01,  1.345D+01,
     *     1.355D+01,  1.380D+01,  1.400D+01,  1.460D+01,  1.500D+01,
     *     1.555D+01,  1.625D+01,  1.700D+01,  1.800D+01,  1.875D+01,
     *     1.920D+01,  1.925D+01,  1.890D+01,  1.830D+01,  1.790D+01,
     *     1.725D+01,  1.690D+01,  1.640D+01,  1.600D+01,  1.550D+01,
     *     1.505D+01,  1.475D+01,  1.430D+01,  1.400D+01,  1.365D+01,
     *     1.335D+01,  1.300D+01,  1.280D+01,  1.250D+01,  1.225D+01,
     *     1.205D+01,  1.195D+01,  1.175D+01,  1.150D+01,  1.135D+01,
     *     1.105D+01,  1.095D+01,  1.080D+01,  1.060D+01,  1.030D+01,
     *     1.020D+01,  1.005D+01,  9.900D+00,  9.800D+00,  9.700D+00,
     *     9.600D+00,
     *     7.350D+00,  7.200D+00,  7.000D+00,  5.800D+00,  4.800D+00/
C---------------------------------------------------------------------
C
C***     P-P ELASTIC CROSS SECTION DATA
      DATA (SEPP(IE),IE=1,50) /
     *     6.750D+02,  1.550D+02,  6.750D+01,  4.420D+01,  3.230D+01,
     *     2.800D+01,  2.520D+01,  2.370D+01,  2.300D+01,  2.275D+01,
     *     2.260D+01,  2.260D+01,  2.260D+01,  2.260D+01,  2.270D+01,
     *     2.280D+01,  2.295D+01,  2.300D+01,  2.310D+01,  2.330D+01,
     *     2.350D+01,  2.380D+01,  2.395D+01,  2.420D+01,  2.460D+01,
     *     2.485D+01,  2.500D+01,  2.530D+01,  2.565D+01,  2.600D+01,
     *     2.620D+01,  2.640D+01,  2.660D+01,  2.675D+01,  2.690D+01,
     *     2.700D+01,  2.705D+01,  2.710D+01,  2.715D+01,  2.720D+01,
     *     2.725D+01,  2.725D+01,  2.720D+01,  2.715D+01,  2.710D+01,
     *     2.700D+01,  2.695D+01,  2.680D+01,  2.670D+01,  2.660D+01/
      DATA (SEPP(IE),IE=51,106) /
     *     2.640D+01,  2.625D+01,  2.605D+01,  2.590D+01,  2.570D+01,
     *     2.545D+01,  2.525D+01,  2.500D+01,  2.480D+01,  2.470D+01,
     *     2.450D+01,  2.430D+01,  2.410D+01,  2.395D+01,  2.370D+01,
     *     2.360D+01,  2.340D+01,  2.325D+01,  2.305D+01,  2.290D+01,
     *     2.275D+01,  2.270D+01,  2.260D+01,  2.250D+01,  2.230D+01,
     *     2.225D+01,  2.210D+01,  2.200D+01,  2.195D+01,  2.190D+01,
     *     2.175D+01,  2.165D+01,  2.150D+01,  2.140D+01,  2.125D+01,
     *     2.120D+01,  2.105D+01,  2.100D+01,  2.090D+01,  2.075D+01,
     *     2.065D+01,  2.055D+01,  2.045D+01,  2.030D+01,  2.020D+01,
     *     2.005D+01,  2.000D+01,  1.995D+01,  1.980D+01,  1.975D+01,
     *     1.965D+01,
     *     17.15D+00,  14.45D+00,  13.00D+00,  11.50D+00,  10.50D+00/
C--------------------------------------------------------------------
C
C***     N-P ELASTIC CROSS SECTION DATA
      DATA (SENP(IE),IE=1,50) /
     *     1.965D+03,  4.750D+02,  2.200D+02,  1.300D+02,  9.180D+01,
     *     7.300D+01,  6.030D+01,  5.180D+01,  4.680D+01,  4.320D+01,
     *     4.080D+01,  3.910D+01,  3.760D+01,  3.650D+01,  3.550D+01,
     *     3.480D+01,  3.415D+01,  3.370D+01,  3.325D+01,  3.290D+01,
     *     3.275D+01,  3.250D+01,  3.255D+01,  3.275D+01,  3.285D+01,
     *     3.275D+01,  3.220D+01,  3.150D+01,  3.075D+01,  2.990D+01,
     *     2.875D+01,  2.775D+01,  2.695D+01,  2.630D+01,  2.590D+01,
     *     2.565D+01,  2.560D+01,  2.560D+01,  2.560D+01,  2.565D+01,
     *     2.570D+01,  2.575D+01,  2.578D+01,  2.580D+01,  2.585D+01,
     *     2.580D+01,  2.575D+01,  2.560D+01,  2.540D+01,  2.505D+01/
      DATA (SENP(IE),IE=51,106) /
     *     2.470D+01,  2.425D+01,  2.375D+01,  2.315D+01,  2.275D+01,
     *     2.230D+01,  2.200D+01,  2.175D+01,  2.155D+01,  2.145D+01,
     *     2.130D+01,  2.125D+01,  2.115D+01,  2.105D+01,  2.100D+01,
     *     2.095D+01,  2.090D+01,  2.080D+01,  2.070D+01,  2.060D+01,
     *     2.050D+01,  2.045D+01,  2.040D+01,  2.030D+01,  2.025D+01,
     *     2.020D+01,  2.015D+01,  2.010D+01,  2.005D+01,  2.002D+01,
     *     2.000D+01,  1.999D+01,  1.990D+01,  1.985D+01,  1.975D+01,
     *     1.970D+01,  1.965D+01,  1.960D+01,  1.950D+01,  1.945D+01,
     *     1.940D+01,  1.925D+01,  1.920D+01,  1.915D+01,  1.910D+01,
     *     1.900D+01,  1.898D+01,  1.895D+01,  1.890D+01,  1.880D+01,
     *     1.875D+01,
     *     17.00D+00,  14.40D+00,  12.00D+00,  11.00D+00,  10.00D+00/
C---------------------------------------------------------------------
C
C***     N-A ELASTIC CROSS SECTION DATA
      DATA (SENA(IE,1),IE=1,NEA) /
C*                  NEUTRON - HELIUM
     *     5.103D-01,  5.157D-01,  5.103D-01,  4.777D-01,  4.072D-01,
     *     3.420D-01,  2.714D-01,  1.683D-01,  6.700D-02,  6.100D-02,
     *     5.800D-02,  4.900D-02,  3.800D-02,  3.300D-02,  3.000D-02,
     *     2.400D-02,  2.300D-02,  2.900D-02,  3.600D-02,  4.100D-02,
     *     4.000D-02,  3.700D-02,  3.400D-02/
C
C*                  NEUTRON - BERYLLIUM
      DATA (SENA(IE,2),IE=1,NEA) /
     *     8.762D-01,  8.856D-01,  8.762D-01,  8.203D-01,  6.991D-01,
     *     5.873D-01,  4.661D-01,  2.890D-01,  1.401D-01,  1.305D-01,
     *     1.238D-01,  1.069D-01,  8.495D-02,  7.480D-02,  6.750D-02,
     *     5.565D-02,  5.230D-02,  6.470D-02,  7.765D-02,  8.722D-02,
     *     8.440D-02,  7.821D-02,  7.259D-02/
C
C*                  NEUTRON - CARBON
      DATA (SENA(IE,3),IE=1,NEA) /
     *     9.200D-01,  9.500D-01,  9.400D-01,  8.800D-01,  7.500D-01,
     *     6.100D-01,  5.000D-01,  3.700D-01,  1.820D-01,  1.710D-01,
     *     1.620D-01,  1.410D-01,  1.130D-01,  1.000D-01,  9.000D-02,
     *     7.500D-02,  7.000D-02,  8.600D-02,  1.020D-01,  1.140D-01,
     *     1.100D-01,  1.020D-01,  9.500D-02/
C
C*                  NEUTRON - ALUMINUM
      DATA (SENA(IE,4),IE=1,NEA) /
     *     1.090D+00,  1.180D+00,  1.240D+00,  1.280D+00,  1.260D+00,
     *     1.160D+00,  9.300D-01,  6.300D-01,  3.580D-01,  3.450D-01,
     *     3.350D-01,  2.990D-01,  2.480D-01,  2.220D-01,  2.020D-01,
     *     1.730D-01,  1.610D-01,  1.920D-01,  2.200D-01,  2.420D-01,
     *     2.370D-01,  2.220D-01,  2.060D-01/
C
C*                  NEUTRON - TITANIUM
      DATA (SENA(IE,5),IE=1,NEA) /
     *     1.029D+00,  9.469D-01,  1.091D+00,  1.284D+00,  1.591D+00,
     *     1.691D+00,  1.258D+00,  9.241D-01,  5.620D-01,  5.493D-01,
     *     5.375D-01,  4.907D-01,  4.182D-01,  3.800D-01,  3.484D-01,
     *     3.038D-01,  2.823D-01,  3.307D-01,  3.720D-01,  4.040D-01,
     *     3.959D-01,  3.743D-01,  3.517D-01/
C
C*                  NEUTRON - IRON
      DATA (SENA(IE,6),IE=1,NEA) /
     *     1.178D+00,  9.793D-01,  1.090D+00,  1.271D+00,  1.650D+00,
     *     1.799D+00,  1.339D+00,  1.009D+00,  6.223D-01,  6.132D-01,
     *     6.042D-01,  5.572D-01,  4.812D-01,  4.402D-01,  4.053D-01,
     *     3.554D-01,  3.304D-01,  3.814D-01,  4.244D-01,  4.603D-01,
     *     4.523D-01,  4.293D-01,  4.053D-01/
C
C*                  NEUTRON - COPPER
      DATA (SENA(IE,7),IE=1,NEA) /
     *     1.386D+00,  1.050D+00,  1.134D+00,  1.302D+00,  1.722D+00,
     *     1.922D+00,  1.449D+00,  1.103D+00,  6.762D-01,  6.686D-01,
     *     6.602D-01,  6.131D-01,  5.344D-01,  4.912D-01,  4.541D-01,
     *     4.004D-01,  3.728D-01,  4.273D-01,  4.725D-01,  5.103D-01,
     *     5.022D-01,  4.781D-01,  4.524D-01/
C
C*                  NEUTRON - CADMIUM
      DATA (SENA(IE,8),IE=1,NEA) /
     *     2.029D+00,  1.537D+00,  1.660D+00,  1.906D+00,  2.520D+00,
     *     2.812D+00,  2.121D+00,  1.614D+00,  1.014D+00,  1.012D+00,
     *     1.006D+00,  9.557D-01,  8.607D-01,  8.038D-01,  7.541D-01,
     *     6.775D-01,  6.334D-01,  7.080D-01,  7.669D-01,  8.156D-01,
     *     8.074D-01,  7.769D-01,  7.404D-01/
C
C*                  NEUTRON - LEAD
      DATA (SENA(IE,9),IE=1,NEA) /
     *     3.050D+00,  2.310D+00,  2.495D+00,  2.865D+00,  3.789D+00,
     *     4.228D+00,  3.188D+00,  2.426D+00,  1.536D+00,  1.538D+00,
     *     1.536D+00,  1.488D+00,  1.384D+00,  1.317D+00,  1.256D+00,
     *     1.153D+00,  1.089D+00,  1.185D+00,  1.255D+00,  1.315D+00,
     *     1.307D+00,  1.269D+00,  1.224D+00/
C
C*                  NEUTRON - URANIUM
      DATA (SENA(IE,10),IE=1,NEA) /
     *     3.346D+00,  2.535D+00,  2.738D+00,  3.143D+00,  4.157D+00,
     *     4.639D+00,  3.498D+00,  2.662D+00,  1.685D+00,  1.687D+00,
     *     1.685D+00,  1.632D+00,  1.518D+00,  1.445D+00,  1.378D+00,
     *     1.265D+00,  1.194D+00,  1.300D+00,  1.377D+00,  1.443D+00,
     *     1.434D+00,  1.392D+00,  1.343D+00/
C---  ----------------------------------------------------------------
C
C***     P-A ELASTIC CROSS SECTION DATA
      DATA (SEPA(IE,1),IE=1,NEA) /
C*                  PROTON - HELIUM
     *   8*0.000D+00,                          6.700D-02,  6.100D-02,
     *     5.800D-02,  4.900D-02,  3.800D-02,  3.300D-02,  3.000D-02,
     *     2.400D-02,  2.300D-02,  2.900D-02,  3.600D-02,  4.100D-02,
     *     4.000D-02,  3.700D-02,  3.400D-02/
C
C*                  PROTON - BERYLLIUM
      DATA (SEPA(IE,2),IE=1,NEA) /
     *   8*0.000D+00,                          1.401D-01,  1.305D-01,
     *     1.238D-01,  1.069D-01,  8.495D-02,  7.480D-02,  6.750D-02,
     *     5.565D-02,  5.230D-02,  6.470D-02,  7.765D-02,  8.722D-02,
     *     8.440D-02,  7.821D-02,  7.259D-02/
C
C*                  PROTON - CARBON
      DATA (SEPA(IE,3),IE=1,NEA) /
     *   8*0.000D+00,                          1.820D-01,  1.710D-01,
     *     1.620D-01,  1.410D-01,  1.130D-01,  1.000D-01,  9.000D-02,
     *     7.500D-02,  7.000D-02,  8.600D-02,  1.020D-01,  1.140D-01,
     *     1.100D-01,  1.020D-01,  9.500D-02/
C
C*                  PROTON - ALUMINUM
      DATA (SEPA(IE,4),IE=1,NEA) /
     *   8*0.000D+00,                          3.650D-01,  3.540D-01,
     *     3.420D-01,  3.060D-01,  2.530D-01,  2.260D-01,  2.040D-01,
     *     1.750D-01,  1.610D-01,  1.900D-01,  2.200D-01,  2.430D-01,
     *     2.370D-01,  2.220D-01,  2.070D-01/
C
C*                  PROTON - TITANIUM
      DATA (SEPA(IE,5),IE=1,NEA) /
     *   8*0.000D+00,                          5.828D-01,  5.726D-01,
     *     5.594D-01,  5.100D-01,  4.310D-01,  3.897D-01,  3.561D-01,
     *     3.084D-01,  2.829D-01,  3.262D-01,  3.714D-01,  4.066D-01,
     *     3.985D-01,  3.764D-01,  3.517D-01/
C
C*                  NEUTRON - IRON
      DATA (SEPA(IE,6),IE=1,NEA) /
     *   8*0.000D+00,                          6.383D-01,  6.313D-01,
     *     6.212D-01,  5.732D-01,  4.913D-01,  4.483D-01,  4.113D-01,
     *     3.594D-01,  3.304D-01,  3.764D-01,  4.243D-01,  4.623D-01,
     *     4.543D-01,  4.313D-01,  4.053D-01/
C
C*                  NEUTRON - COPPER
      DATA (SEPA(IE,7),IE=1,NEA) /
     *   8*0.000D+00,                          6.950D-01,  6.895D-01,
     *     6.803D-01,  6.322D-01,  5.471D-01,  5.014D-01,  4.619D-01,
     *     4.048D-01,  3.728D-01,  4.211D-01,  4.722D-01,  5.135D-01,
     *     5.051D-01,  4.804D-01,  4.527D-01/
C
C*                  NEUTRON - CADMIUM
      DATA (SEPA(IE,8),IE=1,NEA) /
     *   8*0.000D+00,                          1.045D+00,  1.043D+00,
     *     1.036D+00,  9.718D-01,  8.822D-01,  8.211D-01,  7.679D-01,
     *     6.828D-01,  6.325D-01,  6.951D-01,  7.647D-01,  8.232D-01,
     *     8.138D-01,  7.935D-01,  7.415D-01/
C
C*                  NEUTRON - LEAD
      DATA (SEPA(IE,9),IE=1,NEA) /
     *   8*0.000D+00,                          1.589D+00,  1.584D+00,
     *     1.577D+00,  1.528D+00,  1.417D+00,  1.345D+00,  1.277D+00,
     *     1.159D+00,  1.086D+00,  1.159D+00,  1.252D+00,  1.331D+00,
     *     1.320D+00,  1.278D+00,  1.256D+00/
C
C*                  NEUTRON - URANIUM
      DATA (SEPA(IE,10),IE=1,NEA) /
     *   8*0.000D+00,                          1.743D+00,  1.738D+00,
     *     1.730D+00,  1.676D+00,  1.554D+00,  1.475D+00,  1.401D+00,
     *     1.271D+00,  1.191D+00,  1.271D+00,  1.373D+00,  1.460D+00,
     *     1.448D+00,  1.402D+00,  1.378D+00/
C
      DATA RELTO / 0.175D0, 6*0.D0, 0.175D0, 4*0.D0, 0.14D0, 0.14D0/
C
C--------------------------------------------------------------------
C
      IF(ANUC.LT.1.5D0) THEN
C                               HADRON-PROTON ELASTIC CROSS SECTIONS
         IPOL=0
         EK1=EKIN
         IF(EKIN.GT.20.D0) THEN
            SIGELA=RELTO(KPROJ)*SHPTOT(KPROJ,PLAB)
            RETURN
         ELSEIF(EKIN.GT.10.D0) THEN
            IPOL=1
            PO2=20.D0
            EK2=SQRT(PO2**2+AM(KPROJ)**2) - AM(KPROJ)
            SEL2=RELTO(KPROJ)*SHPTOT(KPROJ,PO2)
            EK1=10.D0
         ENDIF
C
         DO 101 IE=1,NEN
            IF(EK1.LT.EKIHN(IE)) THEN
               JE1=IE-1
               JE2=IE
               DDEE=EKIHN(JE2) - EKIHN(JE1)
               GOTO 102
            ENDIF
 101     CONTINUE
         JE1=NEN
         JE2=NEN
         DDEE=1.D0
 102     CONTINUE
C****
C                                  PROTON-PROTON
         IF(KPROJ.EQ.1) THEN
            S1=SEPP(JE1)
            S2=SEPP(JE2)
C                                  NEUTRON-PROTON
         ELSEIF(KPROJ.EQ.8) THEN
            S1=SENP(JE1)
            S2=SENP(JE2)
C                                  PI(+)-PROTON
         ELSEIF(KPROJ.EQ.13) THEN
            S1=SEPIPP(JE1)
            S2=SEPIPP(JE2)
C                                  PI(-)-PROTON
         ELSEIF(KPROJ.EQ.14) THEN
            S1=SEPIMP(JE1)
            S2=SEPIMP(JE2)
C                                  UNDEFINED ENTRY CONDITIONS
         ELSE
            SIGELA=0.D0
            RETURN
         ENDIF
C
         SIGELA=S1 + (S2-S1)*(EK1-EKIHN(JE1))/DDEE
C
C                                  INTERPOLATION BETWEEN 10/20 GEV
         IF(IPOL.EQ.1) THEN
            SEL1=SIGELA
            SIGELA=SEL1 + (SEL2-SEL1)*(EKIN-EK1)/(EK2-EK1)
         ENDIF
C
         RETURN
C
      ENDIF
C***************************************
C                               HADRON-NUCLEUS ELASTIC CROSS SECTIONS
      DO 201 IE=1,NEA
         IF(EKIN.LT.EKIHA(IE)) THEN
            JE=IE - 1
            GOTO 202
         ENDIF
 201  CONTINUE
      IF(EKIN.EQ.EKIHA(NEA)) THEN
         JE=NEA - 1
      ELSE
         JE=-1
      ENDIF
 202  CONTINUE
C
      DO 203 IA=1,NNAA
         IF(ANUC.LT.AMASS(IA)) THEN
            JA=IA - 1
            GOTO 204
         ENDIF
 203  CONTINUE
      IF(ANUC.EQ.AMASS(NNAA)) THEN
         JA=NNAA - 1
      ELSE
         JA=-1
      ENDIF
 204  CONTINUE
C
      IF (JA) 230,220,210
  210 IF (JE) 240,250,211
  211 TEMP1=ANUC/AMASS(JA)
      TEMP2=LOG(AMASS(JA+1)/AMASS(JA))
      KE=JE
      DO 212 I=1,2
         IF(KPROJ.EQ.8) THEN
            SLOW=SENA(KE,JA)
            POWER=LOG(SENA(KE,JA+1)/SLOW)/TEMP2
         ELSE
            SLOW=SEPA(KE,JA)
            POWER=LOG(SEPA(KE,JA+1)/SLOW)/TEMP2
         ENDIF
         TSIG(I)=SLOW*TEMP1**POWER
      KE=KE+1
  212 CONTINUE
C
  213 SIGELA=TSIG(1)
     *       + (EKIN-EKIHA(JE))*(TSIG(2)-TSIG(1))
     *         /(EKIHA(JE+1)-EKIHA(JE))
      SIGELA=SIGELA * 1E3
      RETURN
C*
C                                          A IS LESS THAN A MIN
  220 JA=1
      TEMP1= (ANUC/AMASS(JA)) **0.6666666666666667D0
  221 IF (JE) 260,270,222
  222 IF(KPROJ.EQ.8) THEN
         TSIG(1) = SENA(JE,JA) * TEMP1
         TSIG(2) = SENA(JE+1,JA) *TEMP1
      ELSE
         TSIG(1) = SEPA(JE,JA) * TEMP1
         TSIG(2) = SEPA(JE+1,JA) *TEMP1
      ENDIF
      GO TO 213
C*
C                                         A IS GREATER THAN A MAX
  230 JA=NNAA
      TEMP1= (ANUC/AMASS(JA))**0.6666666666666667D0
      GO TO 221
C*
C                                         EKIN  LT.  EMIN
  250 JE=1
  251 TEMP1=ANUC/AMASS(JA)
      TEMP2=LOG(AMASS(JA+1)/AMASS(JA))
      IF(KPROJ.EQ.8) THEN
         SLOW=SENA(JE,JA)
         POWER=LOG(SENA(JE,JA+1)/SLOW)/TEMP2
      ELSE
         SLOW=SEPA(JE,JA)
         POWER=LOG(SEPA(JE,JA+1)/SLOW)/TEMP2
      ENDIF
      SIGELA=SLOW*TEMP1**POWER
      SIGELA=SIGELA * 1.D+03
      RETURN
C
  270 JE=1
  271 IF(KPROJ.EQ.8) THEN
         SIGELA=SENA(JE,JA)*TEMP1
      ELSE
         SIGELA=SEPA(JE,JA)*TEMP1
      ENDIF
      SIGELA=SIGELA * 1.D+03
      RETURN
C*
C                                         EKIN  GT.  EMAX
  240 JE=NEA
      GO TO 251
  260 JE=NEA
      GO TO 271
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:05 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.45 by S.Giani
	11	*-- Author :
	12	*$ CREATE SIHAEL.FOR
	13	*COPY SIHAEL
	14	* *
	15	=== sihael ===========================================================
	16	* *
	17	SUBROUTINE SIHAEL(KPROJ,EKIN,PLAB,ANUC,SIGELA)
	18
	19	#include "geant321/dblprc.inc"
	20	#include "geant321/dimpar.inc"
	21	#include "geant321/iounit.inc"
	22	C***
	23	C HJM 22/10/88
	24	C
	25	C CROSS SECTIONS FOR ELASTIC SCATTERING
	26	C
	27	C INCLUDING - PION/NUCLEON PROTON DATA FROM BERTINI (HETKFA2)
	28	C
	29	C - ... HIGH-ENERGY APPROXIMATION:
	30	C SIGEL/SIGTOT = CONST
	31	C
	32	C - NUCLEON-NUCLEUS DATA FROM HETKFA2
	33	C***
	34	PARAMETER (NEN=106)
	35	PARAMETER (NEA=23)
	36	PARAMETER (NNAA=10)
	37	DIMENSION EKIHN(NEN),EKIHA(NEA),AMASS(NNAA)
	38	DIMENSION SEPIMP(NEN),SEPIPP(NEN),SEPP(NEN),SENP(NEN)
	39	DIMENSION SENA(NEA,NNAA),SEPA(NEA,NNAA)
	40	DIMENSION TSIG(2)
	41	DIMENSION RELTO(14)
	42	C
	43	#include "geant321/paprop.inc"
	44	C***
	45	C KINETIC ENERGIES FOR TABLE LOOK-UP
	46
	47	DATA EKIHN /
	48	& 0.00D0, 0.02D0, 0.04D0, 0.06D0, 0.08D0, 0.10D0, 0.12D0, 0.14D0,
	49	& 0.16D0, 0.18D0, 0.20D0, 0.22D0, 0.24D0, 0.26D0, 0.28D0, 0.30D0,
	50	& 0.32D0, 0.34D0, 0.36D0, 0.38D0, 0.40D0, 0.42D0, 0.44D0, 0.46D0,
	51	& 0.48D0, 0.50D0, 0.52D0, 0.54D0, 0.56D0, 0.58D0, 0.60D0, 0.62D0,
	52	& 0.64D0, 0.66D0, 0.68D0, 0.70D0, 0.72D0, 0.74D0, 0.76D0, 0.78D0,
	53	& 0.80D0, 0.82D0, 0.84D0, 0.86D0, 0.88D0, 0.90D0, 0.92D0, 0.94D0,
	54	& 0.96D0, 0.98D0, 1.00D0, 1.02D0, 1.04D0, 1.06D0, 1.08D0, 1.10D0,
	55	& 1.12D0, 1.14D0, 1.16D0, 1.18D0, 1.20D0, 1.22D0, 1.24D0, 1.26D0,
	56	& 1.28D0, 1.30D0, 1.32D0, 1.34D0, 1.36D0, 1.38D0, 1.40D0, 1.42D0,
	57	& 1.44D0, 1.46D0, 1.48D0, 1.50D0, 1.52D0, 1.54D0, 1.56D0, 1.58D0,
	58	& 1.60D0, 1.62D0, 1.64D0, 1.66D0, 1.68D0, 1.70D0, 1.72D0, 1.74D0,
	59	& 1.76D0, 1.78D0, 1.80D0, 1.82D0, 1.84D0, 1.86D0, 1.88D0, 1.90D0,
	60	& 1.92D0, 1.94D0, 1.96D0, 1.98D0, 2.00D0, 2.5D0, 3.0D0, 3.5D0,
	61	& 5.0D0, 10.0D0/
	62	DATA EKIHA /
	63	& 0.015D0, 0.02D0, 0.025D0, 0.03D0, 0.04D0, 0.05D0, 0.06D0,
	64	& 0.08D0, 0.10D0, 0.125D0, 0.15D0, 0.175D0, 0.20D0, 0.225D0,
65	& 0.25D0, 0.3D0, 0.4D0, 0.6D0, 1.0D0, 2.0D0, 5.0D0,
66	& 10.0D0, 22.5D0/
67	DATA AMASS /
68	& 4.D0, 9.D0, 12.D0, 27.D0, 47.9D0, 55.9D0, 63.5D0, 112.4D0,
69	& 207.2D0, 238.1D0/
70	C-------------------------------------------------------------------
71	C
72	C*** PI(-)-P ELASTIC CROSS SECTION DATA
73	DATA (SEPIMP(IE),IE=1,50) /
74	* 1.250D+00, 1.500D+00, 1.750D+00, 2.450D+00, 3.800D+00,
75	* 6.000D+00, 9.700D+00, 1.500D+01, 2.140D+01, 2.310D+01,
76	* 2.295D+01, 2.070D+01, 1.795D+01, 1.550D+01, 1.360D+01,
77	* 1.230D+01, 1.130D+01, 1.070D+01, 1.050D+01, 1.070D+01,
78	* 1.120D+01, 1.175D+01, 1.235D+01, 1.300D+01, 1.400D+01,
79	* 1.500D+01, 1.600D+01, 1.700D+01, 1.835D+01, 1.970D+01,
80	* 2.050D+01, 1.915D+01, 1.770D+01, 1.650D+01, 1.570D+01,
81	* 1.520D+01, 1.510D+01, 1.525D+01, 1.550D+01, 1.600D+01,
82	* 1.685D+01, 1.800D+01, 2.000D+01, 2.230D+01, 2.475D+01,
83	* 2.635D+01, 2.510D+01, 2.300D+01, 2.140D+01, 2.000D+01/
84	DATA (SEPIMP(IE),IE=51,106) /
85	* 1.870D+01, 1.750D+01, 1.670D+01, 1.585D+01, 1.505D+01,
86	* 1.440D+01, 1.395D+01, 1.340D+01, 1.299D+01, 1.260D+01,
87	* 1.215D+01, 1.175D+01, 1.140D+01, 1.099D+01, 1.060D+01,
88	* 1.040D+01, 1.010D+01, 9.990D+00, 9.900D+00, 9.750D+00,
89	* 9.600D+00, 9.550D+00, 9.450D+00, 9.350D+00, 9.250D+00,
90	* 9.250D+00, 9.350D+00, 9.650D+00, 9.850D+00, 1.000D+01,
91	* 1.015D+01, 1.030D+01, 1.060D+01, 1.080D+01, 1.095D+01,
92	* 1.100D+01, 1.095D+01, 1.090D+01, 1.070D+01, 1.035D+01,
93	* 1.000D+01, 9.600D+00, 9.050D+00, 8.550D+00, 8.200D+00,
94	* 8.000D+00, 7.850D+00, 7.800D+00, 7.750D+00, 7.700D+00,
95	* 7.650D+00,
96	* 7.600D+00, 7.240D+00, 6.770D+00, 5.840D+00, 4.570D+00/
97	* *** The previous 5 points have been substituted to the erroneous
98	* *** ones from H.J. Mohring by A. Ferrari
99	C---------------------------------------------------------------------
100	C
101	C*** PI(+)-P ELASTIC CROSS SECTION DATA
102	DATA (SEPIPP(IE),IE=1,50) /
103	* 1.800D+00, 4.000D+00, 9.900D+00, 2.170D+01, 4.000D+01,
104	* 6.580D+01, 9.680D+01, 1.392D+02, 1.800D+02, 2.000D+02,
105	* 1.655D+02, 1.420D+02, 1.225D+02, 1.032D+02, 8.400D+01,
106	* 6.725D+01, 5.510D+01, 4.725D+01, 4.130D+01, 3.690D+01,
107	* 3.230D+01, 2.885D+01, 2.600D+01, 2.300D+01, 2.090D+01,
108	* 1.875D+01, 1.675D+01, 1.500D+01, 1.340D+01, 1.200D+01,
109	* 1.100D+01, 9.980D+00, 9.200D+00, 8.600D+00, 8.200D+00,
110	* 8.100D+00, 8.100D+00, 8.250D+00, 8.500D+00, 8.750D+00,
111	* 9.000D+00, 9.400D+00, 9.750D+00, 1.000D+01, 1.030D+01,
112	* 1.075D+01, 1.130D+01, 1.200D+01, 1.275D+01, 1.330D+01/
113	DATA (SEPIPP(IE),IE=51,106) /
114	* 1.350D+01, 1.335D+01, 1.330D+01, 1.330D+01, 1.345D+01,
115	* 1.355D+01, 1.380D+01, 1.400D+01, 1.460D+01, 1.500D+01,
116	* 1.555D+01, 1.625D+01, 1.700D+01, 1.800D+01, 1.875D+01,
117	* 1.920D+01, 1.925D+01, 1.890D+01, 1.830D+01, 1.790D+01,
118	* 1.725D+01, 1.690D+01, 1.640D+01, 1.600D+01, 1.550D+01,
119	* 1.505D+01, 1.475D+01, 1.430D+01, 1.400D+01, 1.365D+01,
120	* 1.335D+01, 1.300D+01, 1.280D+01, 1.250D+01, 1.225D+01,
121	* 1.205D+01, 1.195D+01, 1.175D+01, 1.150D+01, 1.135D+01,
122	* 1.105D+01, 1.095D+01, 1.080D+01, 1.060D+01, 1.030D+01,
123	* 1.020D+01, 1.005D+01, 9.900D+00, 9.800D+00, 9.700D+00,
124	* 9.600D+00,
125	* 7.350D+00, 7.200D+00, 7.000D+00, 5.800D+00, 4.800D+00/
126	C---------------------------------------------------------------------
127	C
128	C*** P-P ELASTIC CROSS SECTION DATA
129	DATA (SEPP(IE),IE=1,50) /
130	* 6.750D+02, 1.550D+02, 6.750D+01, 4.420D+01, 3.230D+01,
131	* 2.800D+01, 2.520D+01, 2.370D+01, 2.300D+01, 2.275D+01,
132	* 2.260D+01, 2.260D+01, 2.260D+01, 2.260D+01, 2.270D+01,
133	* 2.280D+01, 2.295D+01, 2.300D+01, 2.310D+01, 2.330D+01,
134	* 2.350D+01, 2.380D+01, 2.395D+01, 2.420D+01, 2.460D+01,
135	* 2.485D+01, 2.500D+01, 2.530D+01, 2.565D+01, 2.600D+01,
136	* 2.620D+01, 2.640D+01, 2.660D+01, 2.675D+01, 2.690D+01,
137	* 2.700D+01, 2.705D+01, 2.710D+01, 2.715D+01, 2.720D+01,
138	* 2.725D+01, 2.725D+01, 2.720D+01, 2.715D+01, 2.710D+01,
139	* 2.700D+01, 2.695D+01, 2.680D+01, 2.670D+01, 2.660D+01/
140	DATA (SEPP(IE),IE=51,106) /
141	* 2.640D+01, 2.625D+01, 2.605D+01, 2.590D+01, 2.570D+01,
142	* 2.545D+01, 2.525D+01, 2.500D+01, 2.480D+01, 2.470D+01,
143	* 2.450D+01, 2.430D+01, 2.410D+01, 2.395D+01, 2.370D+01,
144	* 2.360D+01, 2.340D+01, 2.325D+01, 2.305D+01, 2.290D+01,
145	* 2.275D+01, 2.270D+01, 2.260D+01, 2.250D+01, 2.230D+01,
146	* 2.225D+01, 2.210D+01, 2.200D+01, 2.195D+01, 2.190D+01,
147	* 2.175D+01, 2.165D+01, 2.150D+01, 2.140D+01, 2.125D+01,
148	* 2.120D+01, 2.105D+01, 2.100D+01, 2.090D+01, 2.075D+01,
149	* 2.065D+01, 2.055D+01, 2.045D+01, 2.030D+01, 2.020D+01,
150	* 2.005D+01, 2.000D+01, 1.995D+01, 1.980D+01, 1.975D+01,
151	* 1.965D+01,
152	* 17.15D+00, 14.45D+00, 13.00D+00, 11.50D+00, 10.50D+00/
153	C--------------------------------------------------------------------
154	C
155	C*** N-P ELASTIC CROSS SECTION DATA
156	DATA (SENP(IE),IE=1,50) /
157	* 1.965D+03, 4.750D+02, 2.200D+02, 1.300D+02, 9.180D+01,
158	* 7.300D+01, 6.030D+01, 5.180D+01, 4.680D+01, 4.320D+01,
159	* 4.080D+01, 3.910D+01, 3.760D+01, 3.650D+01, 3.550D+01,
160	* 3.480D+01, 3.415D+01, 3.370D+01, 3.325D+01, 3.290D+01,
161	* 3.275D+01, 3.250D+01, 3.255D+01, 3.275D+01, 3.285D+01,
162	* 3.275D+01, 3.220D+01, 3.150D+01, 3.075D+01, 2.990D+01,
163	* 2.875D+01, 2.775D+01, 2.695D+01, 2.630D+01, 2.590D+01,
164	* 2.565D+01, 2.560D+01, 2.560D+01, 2.560D+01, 2.565D+01,
165	* 2.570D+01, 2.575D+01, 2.578D+01, 2.580D+01, 2.585D+01,
166	* 2.580D+01, 2.575D+01, 2.560D+01, 2.540D+01, 2.505D+01/
167	DATA (SENP(IE),IE=51,106) /
168	* 2.470D+01, 2.425D+01, 2.375D+01, 2.315D+01, 2.275D+01,
169	* 2.230D+01, 2.200D+01, 2.175D+01, 2.155D+01, 2.145D+01,
170	* 2.130D+01, 2.125D+01, 2.115D+01, 2.105D+01, 2.100D+01,
171	* 2.095D+01, 2.090D+01, 2.080D+01, 2.070D+01, 2.060D+01,
172	* 2.050D+01, 2.045D+01, 2.040D+01, 2.030D+01, 2.025D+01,
173	* 2.020D+01, 2.015D+01, 2.010D+01, 2.005D+01, 2.002D+01,
174	* 2.000D+01, 1.999D+01, 1.990D+01, 1.985D+01, 1.975D+01,
175	* 1.970D+01, 1.965D+01, 1.960D+01, 1.950D+01, 1.945D+01,
176	* 1.940D+01, 1.925D+01, 1.920D+01, 1.915D+01, 1.910D+01,
177	* 1.900D+01, 1.898D+01, 1.895D+01, 1.890D+01, 1.880D+01,
178	* 1.875D+01,
179	* 17.00D+00, 14.40D+00, 12.00D+00, 11.00D+00, 10.00D+00/
180	C---------------------------------------------------------------------
181	C
182	C*** N-A ELASTIC CROSS SECTION DATA
183	DATA (SENA(IE,1),IE=1,NEA) /
184	C* NEUTRON - HELIUM
185	* 5.103D-01, 5.157D-01, 5.103D-01, 4.777D-01, 4.072D-01,
186	* 3.420D-01, 2.714D-01, 1.683D-01, 6.700D-02, 6.100D-02,
187	* 5.800D-02, 4.900D-02, 3.800D-02, 3.300D-02, 3.000D-02,
188	* 2.400D-02, 2.300D-02, 2.900D-02, 3.600D-02, 4.100D-02,
189	* 4.000D-02, 3.700D-02, 3.400D-02/
190	C
191	C* NEUTRON - BERYLLIUM
192	DATA (SENA(IE,2),IE=1,NEA) /
193	* 8.762D-01, 8.856D-01, 8.762D-01, 8.203D-01, 6.991D-01,
194	* 5.873D-01, 4.661D-01, 2.890D-01, 1.401D-01, 1.305D-01,
195	* 1.238D-01, 1.069D-01, 8.495D-02, 7.480D-02, 6.750D-02,
196	* 5.565D-02, 5.230D-02, 6.470D-02, 7.765D-02, 8.722D-02,
197	* 8.440D-02, 7.821D-02, 7.259D-02/
198	C
199	C* NEUTRON - CARBON
200	DATA (SENA(IE,3),IE=1,NEA) /
201	* 9.200D-01, 9.500D-01, 9.400D-01, 8.800D-01, 7.500D-01,
202	* 6.100D-01, 5.000D-01, 3.700D-01, 1.820D-01, 1.710D-01,
203	* 1.620D-01, 1.410D-01, 1.130D-01, 1.000D-01, 9.000D-02,
204	* 7.500D-02, 7.000D-02, 8.600D-02, 1.020D-01, 1.140D-01,
205	* 1.100D-01, 1.020D-01, 9.500D-02/
206	C
207	C* NEUTRON - ALUMINUM
208	DATA (SENA(IE,4),IE=1,NEA) /
209	* 1.090D+00, 1.180D+00, 1.240D+00, 1.280D+00, 1.260D+00,
210	* 1.160D+00, 9.300D-01, 6.300D-01, 3.580D-01, 3.450D-01,
211	* 3.350D-01, 2.990D-01, 2.480D-01, 2.220D-01, 2.020D-01,
212	* 1.730D-01, 1.610D-01, 1.920D-01, 2.200D-01, 2.420D-01,
213	* 2.370D-01, 2.220D-01, 2.060D-01/
214	C
215	C* NEUTRON - TITANIUM
216	DATA (SENA(IE,5),IE=1,NEA) /
217	* 1.029D+00, 9.469D-01, 1.091D+00, 1.284D+00, 1.591D+00,
218	* 1.691D+00, 1.258D+00, 9.241D-01, 5.620D-01, 5.493D-01,
219	* 5.375D-01, 4.907D-01, 4.182D-01, 3.800D-01, 3.484D-01,
220	* 3.038D-01, 2.823D-01, 3.307D-01, 3.720D-01, 4.040D-01,
221	* 3.959D-01, 3.743D-01, 3.517D-01/
222	C
223	C* NEUTRON - IRON
224	DATA (SENA(IE,6),IE=1,NEA) /
225	* 1.178D+00, 9.793D-01, 1.090D+00, 1.271D+00, 1.650D+00,
226	* 1.799D+00, 1.339D+00, 1.009D+00, 6.223D-01, 6.132D-01,
227	* 6.042D-01, 5.572D-01, 4.812D-01, 4.402D-01, 4.053D-01,
228	* 3.554D-01, 3.304D-01, 3.814D-01, 4.244D-01, 4.603D-01,
229	* 4.523D-01, 4.293D-01, 4.053D-01/
230	C
231	C* NEUTRON - COPPER
232	DATA (SENA(IE,7),IE=1,NEA) /
233	* 1.386D+00, 1.050D+00, 1.134D+00, 1.302D+00, 1.722D+00,
234	* 1.922D+00, 1.449D+00, 1.103D+00, 6.762D-01, 6.686D-01,
235	* 6.602D-01, 6.131D-01, 5.344D-01, 4.912D-01, 4.541D-01,
236	* 4.004D-01, 3.728D-01, 4.273D-01, 4.725D-01, 5.103D-01,
237	* 5.022D-01, 4.781D-01, 4.524D-01/
238	C
239	C* NEUTRON - CADMIUM
240	DATA (SENA(IE,8),IE=1,NEA) /
241	* 2.029D+00, 1.537D+00, 1.660D+00, 1.906D+00, 2.520D+00,
242	* 2.812D+00, 2.121D+00, 1.614D+00, 1.014D+00, 1.012D+00,
243	* 1.006D+00, 9.557D-01, 8.607D-01, 8.038D-01, 7.541D-01,
244	* 6.775D-01, 6.334D-01, 7.080D-01, 7.669D-01, 8.156D-01,
245	* 8.074D-01, 7.769D-01, 7.404D-01/
246	C
247	C* NEUTRON - LEAD
248	DATA (SENA(IE,9),IE=1,NEA) /
249	* 3.050D+00, 2.310D+00, 2.495D+00, 2.865D+00, 3.789D+00,
250	* 4.228D+00, 3.188D+00, 2.426D+00, 1.536D+00, 1.538D+00,
251	* 1.536D+00, 1.488D+00, 1.384D+00, 1.317D+00, 1.256D+00,
252	* 1.153D+00, 1.089D+00, 1.185D+00, 1.255D+00, 1.315D+00,
253	* 1.307D+00, 1.269D+00, 1.224D+00/
254	C
255	C* NEUTRON - URANIUM
256	DATA (SENA(IE,10),IE=1,NEA) /
257	* 3.346D+00, 2.535D+00, 2.738D+00, 3.143D+00, 4.157D+00,
258	* 4.639D+00, 3.498D+00, 2.662D+00, 1.685D+00, 1.687D+00,
259	* 1.685D+00, 1.632D+00, 1.518D+00, 1.445D+00, 1.378D+00,
260	* 1.265D+00, 1.194D+00, 1.300D+00, 1.377D+00, 1.443D+00,
261	* 1.434D+00, 1.392D+00, 1.343D+00/
262	C--- ----------------------------------------------------------------
263	C
264	C*** P-A ELASTIC CROSS SECTION DATA
265	DATA (SEPA(IE,1),IE=1,NEA) /
266	C* PROTON - HELIUM
267	* 8*0.000D+00, 6.700D-02, 6.100D-02,
268	* 5.800D-02, 4.900D-02, 3.800D-02, 3.300D-02, 3.000D-02,
269	* 2.400D-02, 2.300D-02, 2.900D-02, 3.600D-02, 4.100D-02,
270	* 4.000D-02, 3.700D-02, 3.400D-02/
271	C
272	C* PROTON - BERYLLIUM
273	DATA (SEPA(IE,2),IE=1,NEA) /
274	* 8*0.000D+00, 1.401D-01, 1.305D-01,
275	* 1.238D-01, 1.069D-01, 8.495D-02, 7.480D-02, 6.750D-02,
276	* 5.565D-02, 5.230D-02, 6.470D-02, 7.765D-02, 8.722D-02,
277	* 8.440D-02, 7.821D-02, 7.259D-02/
278	C
279	C* PROTON - CARBON
280	DATA (SEPA(IE,3),IE=1,NEA) /
281	* 8*0.000D+00, 1.820D-01, 1.710D-01,
282	* 1.620D-01, 1.410D-01, 1.130D-01, 1.000D-01, 9.000D-02,
283	* 7.500D-02, 7.000D-02, 8.600D-02, 1.020D-01, 1.140D-01,
284	* 1.100D-01, 1.020D-01, 9.500D-02/
285	C
286	C* PROTON - ALUMINUM
287	DATA (SEPA(IE,4),IE=1,NEA) /
288	* 8*0.000D+00, 3.650D-01, 3.540D-01,
289	* 3.420D-01, 3.060D-01, 2.530D-01, 2.260D-01, 2.040D-01,
290	* 1.750D-01, 1.610D-01, 1.900D-01, 2.200D-01, 2.430D-01,
291	* 2.370D-01, 2.220D-01, 2.070D-01/
292	C
293	C* PROTON - TITANIUM
294	DATA (SEPA(IE,5),IE=1,NEA) /
295	* 8*0.000D+00, 5.828D-01, 5.726D-01,
296	* 5.594D-01, 5.100D-01, 4.310D-01, 3.897D-01, 3.561D-01,
297	* 3.084D-01, 2.829D-01, 3.262D-01, 3.714D-01, 4.066D-01,
298	* 3.985D-01, 3.764D-01, 3.517D-01/
299	C
300	C* NEUTRON - IRON
301	DATA (SEPA(IE,6),IE=1,NEA) /
302	* 8*0.000D+00, 6.383D-01, 6.313D-01,
303	* 6.212D-01, 5.732D-01, 4.913D-01, 4.483D-01, 4.113D-01,
304	* 3.594D-01, 3.304D-01, 3.764D-01, 4.243D-01, 4.623D-01,
305	* 4.543D-01, 4.313D-01, 4.053D-01/
306	C
307	C* NEUTRON - COPPER
308	DATA (SEPA(IE,7),IE=1,NEA) /
309	* 8*0.000D+00, 6.950D-01, 6.895D-01,
310	* 6.803D-01, 6.322D-01, 5.471D-01, 5.014D-01, 4.619D-01,
311	* 4.048D-01, 3.728D-01, 4.211D-01, 4.722D-01, 5.135D-01,
312	* 5.051D-01, 4.804D-01, 4.527D-01/
313	C
314	C* NEUTRON - CADMIUM
315	DATA (SEPA(IE,8),IE=1,NEA) /
316	* 8*0.000D+00, 1.045D+00, 1.043D+00,
317	* 1.036D+00, 9.718D-01, 8.822D-01, 8.211D-01, 7.679D-01,
318	* 6.828D-01, 6.325D-01, 6.951D-01, 7.647D-01, 8.232D-01,
319	* 8.138D-01, 7.935D-01, 7.415D-01/
320	C
321	C* NEUTRON - LEAD
322	DATA (SEPA(IE,9),IE=1,NEA) /
323	* 8*0.000D+00, 1.589D+00, 1.584D+00,
324	* 1.577D+00, 1.528D+00, 1.417D+00, 1.345D+00, 1.277D+00,
325	* 1.159D+00, 1.086D+00, 1.159D+00, 1.252D+00, 1.331D+00,
326	* 1.320D+00, 1.278D+00, 1.256D+00/
327	C
328	C* NEUTRON - URANIUM
329	DATA (SEPA(IE,10),IE=1,NEA) /
330	* 8*0.000D+00, 1.743D+00, 1.738D+00,
331	* 1.730D+00, 1.676D+00, 1.554D+00, 1.475D+00, 1.401D+00,
332	* 1.271D+00, 1.191D+00, 1.271D+00, 1.373D+00, 1.460D+00,
333	* 1.448D+00, 1.402D+00, 1.378D+00/
334	C
335	DATA RELTO / 0.175D0, 60.D0, 0.175D0, 40.D0, 0.14D0, 0.14D0/
336	C
337	C--------------------------------------------------------------------
338	C
339	IF(ANUC.LT.1.5D0) THEN
340	C HADRON-PROTON ELASTIC CROSS SECTIONS
341	IPOL=0
342	EK1=EKIN
343	IF(EKIN.GT.20.D0) THEN
344	SIGELA=RELTO(KPROJ)*SHPTOT(KPROJ,PLAB)
345	RETURN
346	ELSEIF(EKIN.GT.10.D0) THEN
347	IPOL=1
348	PO2=20.D0
349	EK2=SQRT(PO22+AM(KPROJ)2) - AM(KPROJ)
350	SEL2=RELTO(KPROJ)*SHPTOT(KPROJ,PO2)
351	EK1=10.D0
352	ENDIF
353	C
354	DO 101 IE=1,NEN
355	IF(EK1.LT.EKIHN(IE)) THEN
356	JE1=IE-1
357	JE2=IE
358	DDEE=EKIHN(JE2) - EKIHN(JE1)
359	GOTO 102
360	ENDIF
361	101 CONTINUE
362	JE1=NEN
363	JE2=NEN
364	DDEE=1.D0
365	102 CONTINUE
366	C****
367	C PROTON-PROTON
368	IF(KPROJ.EQ.1) THEN
369	S1=SEPP(JE1)
370	S2=SEPP(JE2)
371	C NEUTRON-PROTON
372	ELSEIF(KPROJ.EQ.8) THEN
373	S1=SENP(JE1)
374	S2=SENP(JE2)
375	C PI(+)-PROTON
376	ELSEIF(KPROJ.EQ.13) THEN
377	S1=SEPIPP(JE1)
378	S2=SEPIPP(JE2)
379	C PI(-)-PROTON
380	ELSEIF(KPROJ.EQ.14) THEN
381	S1=SEPIMP(JE1)
382	S2=SEPIMP(JE2)
383	C UNDEFINED ENTRY CONDITIONS
384	ELSE
385	SIGELA=0.D0
386	RETURN
387	ENDIF
388	C
389	SIGELA=S1 + (S2-S1)*(EK1-EKIHN(JE1))/DDEE
390	C
391	C INTERPOLATION BETWEEN 10/20 GEV
392	IF(IPOL.EQ.1) THEN
393	SEL1=SIGELA
394	SIGELA=SEL1 + (SEL2-SEL1)*(EKIN-EK1)/(EK2-EK1)
395	ENDIF
396	C
397	RETURN
398	C
399	ENDIF
400	C***************************************
401	C HADRON-NUCLEUS ELASTIC CROSS SECTIONS
402	DO 201 IE=1,NEA
403	IF(EKIN.LT.EKIHA(IE)) THEN
404	JE=IE - 1
405	GOTO 202
406	ENDIF
407	201 CONTINUE
408	IF(EKIN.EQ.EKIHA(NEA)) THEN
409	JE=NEA - 1
410	ELSE
411	JE=-1
412	ENDIF
413	202 CONTINUE
414	C
415	DO 203 IA=1,NNAA
416	IF(ANUC.LT.AMASS(IA)) THEN
417	JA=IA - 1
418	GOTO 204
419	ENDIF
420	203 CONTINUE
421	IF(ANUC.EQ.AMASS(NNAA)) THEN
422	JA=NNAA - 1
423	ELSE
424	JA=-1
425	ENDIF
426	204 CONTINUE
427	C
428	IF (JA) 230,220,210
429	210 IF (JE) 240,250,211
430	211 TEMP1=ANUC/AMASS(JA)
431	TEMP2=LOG(AMASS(JA+1)/AMASS(JA))
432	KE=JE
433	DO 212 I=1,2
434	IF(KPROJ.EQ.8) THEN
435	SLOW=SENA(KE,JA)
436	POWER=LOG(SENA(KE,JA+1)/SLOW)/TEMP2
437	ELSE
438	SLOW=SEPA(KE,JA)
439	POWER=LOG(SEPA(KE,JA+1)/SLOW)/TEMP2
440	ENDIF
441	TSIG(I)=SLOWTEMP1*POWER
442	KE=KE+1
443	212 CONTINUE
444	C
445	213 SIGELA=TSIG(1)
446	* + (EKIN-EKIHA(JE))*(TSIG(2)-TSIG(1))
447	* /(EKIHA(JE+1)-EKIHA(JE))
448	SIGELA=SIGELA * 1E3
449	RETURN
450	C*
451	C A IS LESS THAN A MIN
452	220 JA=1
453	TEMP1= (ANUC/AMASS(JA)) **0.6666666666666667D0
454	221 IF (JE) 260,270,222
455	222 IF(KPROJ.EQ.8) THEN
456	TSIG(1) = SENA(JE,JA) * TEMP1
457	TSIG(2) = SENA(JE+1,JA) *TEMP1
458	ELSE
459	TSIG(1) = SEPA(JE,JA) * TEMP1
460	TSIG(2) = SEPA(JE+1,JA) *TEMP1
461	ENDIF
462	GO TO 213
463	C*
464	C A IS GREATER THAN A MAX
465	230 JA=NNAA
466	TEMP1= (ANUC/AMASS(JA))**0.6666666666666667D0
467	GO TO 221
468	C*
469	C EKIN LT. EMIN
470	250 JE=1
471	251 TEMP1=ANUC/AMASS(JA)
472	TEMP2=LOG(AMASS(JA+1)/AMASS(JA))
473	IF(KPROJ.EQ.8) THEN
474	SLOW=SENA(JE,JA)
475	POWER=LOG(SENA(JE,JA+1)/SLOW)/TEMP2
476	ELSE
477	SLOW=SEPA(JE,JA)
478	POWER=LOG(SEPA(JE,JA+1)/SLOW)/TEMP2
479	ENDIF
480	SIGELA=SLOWTEMP1*POWER
481	SIGELA=SIGELA * 1.D+03
482	RETURN
483	C
484	270 JE=1
485	271 IF(KPROJ.EQ.8) THEN
486	SIGELA=SENA(JE,JA)*TEMP1
487	ELSE
488	SIGELA=SEPA(JE,JA)*TEMP1
489	ENDIF
490	SIGELA=SIGELA * 1.D+03
491	RETURN
492	C*
493	C EKIN GT. EMAX
494	240 JE=NEA
495	GO TO 251
496	260 JE=NEA
497	GO TO 271
498	END