This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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