GEANT321/fluka/sihael.F

   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, 6*0.D0, 0.175D0, 4*0.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(PO2**2+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)=SLOW*TEMP1**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=SLOW*TEMP1**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