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