Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gphys / grayli.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:33  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
11 *-- Author :
12       SUBROUTINE GRAYLI
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *  Calculates cross-section of current material for RAYLEIGH     *
17 C.    *  EFFECT using  polinomial fits of tables in log-log scale.     *
18 C.    *  One fit (4 coefficients) for each element is used.            *
19 C.    *  Atomic form factors are calculated as a function of momentum  *
20 C.    *  transfer using polinomial fits of data tables in log-log scale*
21 C.    *  One or two fits are used according with the value of NFIT.    *
22 C.    *  Evaluates the integral of atomic form factors which will be   *
23 C.    *  used in the SUBROUTINE GRAYL to sample scattering angles      *
24 C.    *  NOTE:                                                         *
25 C.    *  (1) Above 10 MeV a cut is imposed as the contribution of      *
26 C.    *  Rayleigh effect is negligible                                 *
27 C.    *                                                                *
28 C.    *    ==>Called by : GPHYSI                                       *
29 C.    *       Author    G.Tromba (*), P.Bregant (**)                   *
30 C.    *                                                                *
31 C.    *  (*) now at: Sincrotrone Trieste, Padriciano 99, Trieste (I)   *
32 C.    *  (**)U.S.L. n.1 Triestina                                      *
33 C.    *      Servizio di Fisica Sanitaria, v.Pieta' 19, 34129 Trieste  *
34 C     *                                                                *
35 C.    ******************************************************************
36 C.
37 #include "geant321/gcbank.inc"
38 #include "geant321/gctrak.inc"
39 #include "geant321/gconsp.inc"
40 #include "geant321/gcmate.inc"
41 #include "geant321/gcjloc.inc"
42 #include "geant321/gcmulo.inc"
43       DIMENSION COHER(4,100),CFORM(8,100),ELIM(100)
44 *
45       DATA((COHER(I,J),I=1,4),J=1,20)/-12.646,-1.9734,.13417,.23998E-01
46      +,-10.303,-1.9553,0.15913,0.29927E-01
47      +,-9.1274,-2.0474,0.87874E-01,0.23572E-01
48      +,-8.3066,-2.0615,0.46623E-01,0.18455E-01
49      +,-7.6967,-2.0684,0.24280E-01,0.15622E-01
50      +,-7.2088,-2.0633,0.15713E-01,0.14402E-01
51      +,-6.8026,-2.0574,0.16437E-01,0.14518E-01
52      +,-6.4403,-2.0449,0.18975E-01,0.14716E-01
53      +,-6.1099,-2.0390,0.21207E-01,0.15081E-01
54      +,-5.7930,-2.0384,0.19210E-01,0.14989E-01
55      +,-5.5410,-2.0430,0.20118E-01,0.15698E-01
56      +,-5.3138,-2.0399,0.21325E-01,0.16074E-01
57      +,-5.0993,-2.0395,0.19494E-01,0.16046E-01
58      +,-4.9005,-2.0397,0.17404E-01,0.15937E-01
59      +,-4.7149,-2.0394,0.15412E-01,0.15788E-01
60      +,-4.5420,-2.0393,0.13945E-01,0.15704E-01
61      +,-4.3846,-2.0372,0.14551E-01,0.15848E-01
62      +,-4.2381,-2.0316,0.16322E-01,0.16051E-01
63      +,-4.1023,-2.0249,0.17752E-01,0.16300E-01
64      +,-3.9704,-2.0187,0.17285E-01,0.16217E-01/
65       DATA ((COHER(I,J),I=1,4),J=21,40)/-3.8342,-2.0137,.014534,.015744
66      +,-3.7014,-2.0118,0.10973E-01,0.15228E-01
67      +,-3.5759,-2.0127,0.80253E-02,0.14884E-01
68      +,-3.4584,-2.0121,0.70340E-02,0.14731E-01
69      +,-3.3494,-2.0101,0.66838E-02,0.14731E-01
70      +,-3.2392,-2.0074,0.57007E-02,0.14562E-01
71      +,-3.1309,-2.0050,0.41822E-02,0.14312E-01
72      +,-3.0235,-2.0049,0.19877E-02,0.14052E-01
73      +,-2.9211,-2.0071,0.85036E-03,0.13970E-01
74      +,-2.8192,-2.0069,-0.14296E-02,0.13732E-01
75      +,-2.7265,-2.0088,-0.26683E-02,0.13717E-01
76      +,-2.6378,-2.0095,-0.34226E-02,0.13727E-01
77      +,-2.5496,-2.0094,-0.62157E-02,0.13425E-01
78      +,-2.4704,-2.0092,-0.43550E-02,0.13753E-01
79      +,-2.3900,-2.0083,-0.48368E-02,0.13730E-01
80      +,-2.3111,-2.0072,-0.55407E-02,0.13668E-01
81      +,-2.2355,-2.0065,-0.61290E-02,0.13697E-01
82      +,-2.1614,-2.0064,-0.70329E-02,0.13672E-01
83      +,-2.0899,-2.0060,-0.78982E-02,0.13612E-01
84      +,-2.0203,-2.0057,-0.85764E-02,0.13570E-01/
85       DATA((COHER(I,J),I=1,4),J=41,60)/-1.9519,-2.0049,-.0091079,.013506
86      +,-1.8851,-2.0036,-0.94870E-02,0.13472E-01
87      +,-1.8210,-2.0019,-0.10066E-01,0.13410E-01
88      +,-1.7554,-2.0007,-0.11089E-01,0.13247E-01
89      +,-1.6914,-1.9990,-0.11844E-01,0.13139E-01
90      +,-1.6279,-1.9984,-0.12922E-01,0.12987E-01
91      +,-1.5659,-1.9980,-0.13635E-01,0.12948E-01
92      +,-1.5073,-1.9977,-0.14136E-01,0.12937E-01
93      +,-1.4501,-1.9959,-0.14206E-01,0.12957E-01
94      +,-1.3942,-1.9943,-0.14863E-01,0.12876E-01
95      +,-1.3378,-1.9916,-0.15680E-01,0.12738E-01
96      +,-1.2820,-1.9881,-0.16880E-01,0.12511E-01
97      +,-1.2231,-1.9861,-0.18942E-01,0.12204E-01
98      +,-1.1658,-1.9850,-0.21146E-01,0.11896E-01
99      +,-1.1112,-1.9864,-0.22968E-01,0.11769E-01
100      +,-1.0594,-1.9877,-0.24247E-01,0.11707E-01
101      +,-1.0104,-1.9895,-0.24993E-01,0.11718E-01
102      +,-0.96289,-1.9905,-0.25026E-01,0.11788E-01
103      +,-0.91458,-1.9909,-0.25128E-01,0.11807E-01
104      +,-0.86838,-1.9909,-0.25111E-01,0.11847E-01/
105       DATA ((COHER(I,J),I=1,4),J=61,80)/-.82136,-1.9903,-.025340,.011835
106      +,-0.77441,-1.9864,-0.26074E-01,0.11635E-01
107      +,-0.72869,-1.9885,-0.26020E-01,0.11761E-01
108      +,-0.68337,-1.9878,-0.26532E-01,0.11712E-01
109      +,-0.63683,-1.9871,-0.26966E-01,0.11650E-01
110      +,-0.59154,-1.9867,-0.27440E-01,0.11604E-01
111      +,-0.54758,-1.9862,-0.27986E-01,0.11561E-01
112      +,-0.50282,-1.9861,-0.28229E-01,0.11547E-01
113      +,-0.45943,-1.9858,-0.28501E-01,0.11535E-01
114      +,-0.41677,-1.9856,-0.28696E-01,0.11540E-01
115      +,-0.37528,-1.9853,-0.29045E-01,0.11529E-01
116      +,-0.33450,-1.9843,-0.29095E-01,0.11545E-01
117      +,-0.29346,-1.9834,-0.29469E-01,0.11511E-01
118      +,-0.25286,-1.9823,-0.29847E-01,0.11469E-01
119      +,-0.21251,-1.9810,-0.30285E-01,0.11412E-01
120      +,-0.17200,-1.9801,-0.30821E-01,0.11368E-01
121      +,-0.13190,-1.9789,-0.31515E-01,0.11257E-01
122      +,-0.92060E-01,-1.9781,-0.32135E-01,0.11179E-01
123      +,-0.52955E-01,-1.9775,-0.32687E-01,0.11125E-01
124      +,-0.14708E-01,-1.9770,-0.33185E-01,0.11092E-01/
125       DATA((COHER(I,J),I=1,4),J=81,100)/.022864,-1.9751,-.033545,.011037
126      +,0.60152E-01,-1.9764,-0.33897E-01,0.11092E-01
127      +,0.96158E-01,-1.9760,-0.34169E-01,0.11099E-01
128      +,0.13251,-1.9753,-0.34520E-01,0.11085E-01
129      +,0.16833,-1.9747,-0.34818E-01,0.11081E-01
130      +,0.20362,-1.9740,-0.35032E-01,0.11086E-01
131      +,0.23778,-1.9734,-0.34984E-01,0.11155E-01
132      +,0.27280,-1.9725,-0.35314E-01,0.11153E-01
133      +,0.30673,-1.9718,-0.35308E-01,0.11229E-01
134      +,0.34031,-1.9706,-0.35518E-01,0.11187E-01
135      +,0.37415,-1.9695,-0.35653E-01,0.11175E-01
136      +,0.40755,-1.9670,-0.34285E-01,0.11389E-01
137      +,0.44086,-1.9671,-0.35957E-01,0.11154E-01
138      +,0.47375,-1.9661,-0.36059E-01,0.11145E-01
139      +,0.50582,-1.9648,-0.36048E-01,0.11154E-01
140      +,0.53772,-1.9635,-0.36237E-01,0.11140E-01
141      +,0.56929,-1.9622,-0.36256E-01,0.11141E-01
142      +,0.60044,-1.9608,-0.36340E-01,0.11134E-01
143      +,0.63122,-1.9596,-0.36313E-01,0.11138E-01
144      +,0.66162,-1.9582,-0.36298E-01,0.11141E-01/
145 *
146       DATA ELIM/3*0.,3*0.13569E-04,3*0.14408E-04,3*0.15299E-04
147      +,3*0.21928E-04,3*0.27876E-04,3*0.35437E-04,3*0.45049E-04
148      +,3*0.50793E-04,3*0.53934E-04,3*0.57269E-04,3*0.60810E-04
149      +,3*0.68563E-04,3*0.77305E-04,3*0.87161E-04,3*0.98274E-04
150      +,3* 0.11080E-03,3*0.11765E-03,3*0.12493E-03,3*0.13266E-03
151      +,3*0.14086E-03,3*0.15882E-03,3* 0.16864E-03,3*0.19014E-03
152      +,3*0.21438E-03,3*0.22764E-03,2*0.24171E-03,3*0.27253E-03
153      +,4*0.28938E-03,3*0.3072E-03,10*0./
154 *
155       DATA((CFORM(I,J),I=1,8),J=1,10)/-22.516,-5.1310,-.90555,-.055778
156      +,0.11875,0.36659E-01,0.39279E-02,0.14494E-03
157      +,-19.260,-4.6034,-0.60480,-0.86935E-01
158      +,0.75207E-01,0.29358E-01,0.35640E-02,0.14448E-03
159      +,-16.745,-2.9900,-0.34216E-01,-0.22543
160      +,-0.29032E-01,0.11312E-01,0.24065E-02,0.12420E-03
161      +,-17.780,-7.8538,-1.1320,-0.56378E-01
162      +,-16.730,-4.1304,0.18327,0.63285E-01
163      +,-5.7128,-1.8620,-0.14825,-0.39071E-02
164      +,-15.923,-4.1463,0.24609,0.83958E-01
165      +,6.1359,4.3284,0.91725,0.55486E-01
166      +,-15.224,-4.1486,0.28574,0.99104E-01
167      +,7.9239,5.4239,1.1417,0.69696E-01
168      +,-14.548,-4.1850,0.26729,0.10343
169      +,5.6813,4.4241,1.0125,0.64574E-01
170      +,-13.948,-4.2241,0.23705,0.10507
171      +,-0.73602,1.2353,0.51040,0.38876E-01
172      +,-13.380,-4.3238,0.15807,0.98704E-01
173      +,-4.5122,-0.69749,0.20317,0.23107E-01
174      +,-12.880,-4.3645,0.11149,0.96212E-01/
175       DATA((CFORM(I,J),I=1,8),J=11,20)/-12.894,-5.1262,-0.54343,-.017585
176      +,-12.442,-4.4181,0.64564E-01,0.93785E-01
177      +,-18.182,-7.9979,-1.0369,-0.44947E-01
178      +,-11.961,-4.4932,-0.23538E-01,0.83167E-01
179      +,-7.7002,-2.7396,-0.16988,0.17141E-02
180      +,-11.655,-4.3468,0.67545E-01,0.10218
181      +,-11.458,-4.8625,-0.54640,-0.19752E-01
182      +,-11.288,-4.3645,0.31952E-01,0.10016
183      +,-13.733,-6.1918,-0.78628,-0.33620E-01
184      +,-10.866,-4.4125,-0.54747E-01,0.87723E-01
185      +,-6.9281,-2.5933,-0.16486,0.11230E-02
186      +,-10.716,-4.2771,0.63949E-01,0.11331
187      +,-9.1472,-3.9093,-0.40549,-0.12939E-01
188      +,-10.308,-4.3105,-0.26699E-01,0.98791E-01
189      +,-10.558,-4.7765,-0.56625,-0.22421E-01
190      +,-9.9972,-4.3437,-0.82898E-01,0.92124E-01
191      +,-6.0983,-2.3464,-0.13404,0.24166E-02
192      +,-10.027,-4.2552,0.73490E-01,0.13009
193      +,-7.9984,-3.5151,-0.35363,-0.10654E-01
194      +,-9.6508,-4.2506,-0.65510E-02,0.11484/
195       DATA((CFORM(I,J),I=1,8),J=21,30)/-9.2121,-4.2776,-0.49730,-.019235
196      +,-9.4905,-4.2588,0.32597E-02,0.12279
197      +,-3.9128,-1.2033,0.75797E-01,0.14897E-01
198      +,-9.3296,-4.1979,0.42817E-01,0.13360
199      +,-5.1579,-1.9987,-0.76380E-01,0.56926E-02
200      +,-9.0348,-4.1729,-0.43368E-02,0.12460
201      +,-6.1115,-2.6115,-0.19286,-0.13208E-02
202      +,-8.7478,-4.1599,-0.57064E-01,0.11511
203      +,-4.5827,-1.7167,-0.21089E-01,0.91965E-02
204      +,-8.6469,-4.1430,-0.21725E-01,0.12790
205      +,-5.4795,-2.3056,-0.13495,0.22647E-02
206      +,-8.4099,-4.1228,-0.55178E-01,0.12251
207      +,-6.1802,-2.7722,-0.22505,-0.32066E-02
208      +,-8.2279,-4.0934,-0.62350E-01,0.12269
209      +,-5.8290,-2.5908,-0.19000,-0.10226E-02
210      +,-8.0551,-4.0478,-0.60875E-01,0.12369
211      +,-6.2227,-2.8633,-0.24196,-0.41418E-02
212      +,-7.8068,-4.0203,-0.10682,0.11396
213      +,-6.6260,-3.1507,-0.29866,-0.76188E-02
214      +,-7.5763,-3.9966,-0.14839,0.10560/
215       DATA((CFORM(I,J),I=1,8),J=31,40)/-5.8965,-2.7383,-.22009,-.0028149
216      +,-7.5281,-3.9941,-0.10906,0.12081
217      +,-6.2790,-3.0188,-0.27697,-0.63842E-02
218      +,-7.3337,-3.9547,-0.13178,0.11541
219      +,-6.5270,-3.2157,-0.31779,-0.89844E-02
220      +,-7.1437,-3.9160,-0.15503,0.10982
221      +,-6.6564,-3.3380,-0.34420,-0.10706E-01
222      +,-6.9226,-3.8688,-0.19301,0.99252E-01
223      +,-6.6676,-3.3866,-0.35637,-0.11562E-01
224      +,-6.7647,-3.8417,-0.20928,0.96358E-01
225      +,-6.5973,-3.3839,-0.35856,-0.11806E-01
226      +,-6.5615,-3.7910,-0.24140,0.86548E-01
227      +,-5.5223,-2.7503,-0.23696,-0.43562E-02
228      +,-6.6156,-3.8232,-0.17222,0.11431
229      +,-5.7577,-2.9413,-0.27766,-0.69923E-02
230      +,-6.4351,-3.7636,-0.19273,0.10630
231      +,-5.8988,-3.0704,-0.30602,-0.88735E-02
232      +,-6.2520,-3.7107,-0.21873,0.97517E-01
233      +,-5.1690,-2.6301,-0.21923,-0.34573E-02
234      +,-6.2183,-3.7177,-0.18979,0.11175/
235       DATA((CFORM(I,J),I=1,8),J=41,50)/-5.3652,-2.7941,-.25462,-.0057986
236      +,-6.0669,-3.6847,-0.20939,0.10725
237      +,-5.5028,-2.9182,-0.28166,-0.75863E-02
238      +,-5.9625,-3.6681,-0.21256,0.10888
239      +,-4.4716,-2.2542,-0.14575,0.11394E-02
240      +,-5.9717,-3.7006,-0.17526,0.12848
241      +,-4.6959,-2.4391,-0.18590,-0.15318E-02
242      +,-5.8101,-3.6454,-0.19615,0.12040
243      +,-4.8697,-2.5886,-0.21853,-0.36987E-02
244      +,-5.6609,-3.6010,-0.21568,0.11417
245      +,-4.3929,-2.2914,-0.15753,0.22346E-03
246      +,-5.6585,-3.6429,-0.19093,0.13204
247      +,-4.5695,-2.4433,-0.19070,-0.19681E-02
248      +,-5.5414,-3.6051,-0.19872,0.12936
249      +,-4.7029,-2.5655,-0.21777,-0.37707E-02
250      +,-5.4029,-3.5513,-0.21291,0.12265
251      +,-4.2616,-2.2896,-0.16092,-0.80603E-04
252      +,-5.3622,-3.5694,-0.20212,0.13395
253      +,-4.4165,-2.4282,-0.19184,-0.21565E-02
254      +,-5.2567,-3.5409,-0.20978,0.13282/
255       DATA((CFORM(I,J),I=1,8),J=51,60)/-4.5344,-2.5405,-.21724,-.0038729
256      +,-5.1491,-3.5054,-0.21718,0.13045
257      +,-3.6372,-1.9343,-0.88690E-01,0.46020E-02
258      +,-5.0258,-3.4548,-0.22839,0.12463
259      +,-3.8210,-2.0961,-0.12529,0.21101E-02
260      +,-4.8945,-3.3989,-0.24271,0.11716
261      +,-3.9712,-2.2334,-0.15661,-0.34134E-04
262      +,-4.7735,-3.3522,-0.25562,0.11148
263      +,-3.1689,-1.6776,-0.36233E-01,0.80485E-02
264      +,-4.8172,-3.4334,-0.22782,0.13781
265      +,-3.3490,-1.8398,-0.73631E-01,0.54743E-02
266      +,-4.6932,-3.3773,-0.24060,0.13057
267      +,-3.5038,-1.9826,-0.10676,0.31787E-02
268      +,-4.5891,-3.3400,-0.25016,0.12742
269      +,-3.6192,-2.0937,-0.13237,0.14104E-02
270      +,-4.5112,-3.3248,-0.25437,0.12929
271      +,-3.6974,-2.1750,-0.15093,0.13588E-03
272      +,-4.4412,-3.3123,-0.25609,0.13194
273      +,-3.7627,-2.2475,-0.16786,-0.10371E-02
274      +,-4.3611,-3.2863,-0.25915,0.13169/
275       DATA((CFORM(I,J),I=1,8),J=61,70)/-3.2202,-1.8724,-.086015,.0044765
276      +,-4.3280,-3.3034,-0.25324,0.14193
277      +,-3.3101,-1.9643,-0.10751,0.29785E-02
278      +,-4.2204,-3.2500,-0.26236,0.13536
279      +,-3.3804,-2.0408,-0.12547,0.17255E-02
280      +,-4.1144,-3.1979,-0.27167,0.12901
281      +,-2.9387,-1.7293,-0.56192E-01,0.64683E-02
282      +,-4.1523,-3.3027,-0.26089,0.15874
283      +,-3.0175,-1.8125,-0.75694E-01,0.51021E-02
284      +,-4.0626,-3.2616,-0.26653,0.15504
285      +,-3.0862,-1.8882,-0.93679E-01,0.38370E-02
286      +,-3.9705,-3.2160,-0.27238,0.15031
287      +,-3.1456,-1.9572,-0.11034,0.26582E-02
288      +,-3.8761,-3.1664,-0.27856,0.14462
289      +,-3.1764,-2.0014,-0.12079,0.19291E-02
290      +,-3.7797,-3.1138,-0.28517,0.13823
291      +,-3.2001,-2.0409,-0.13038,0.12518E-02
292      +,-3.6830,-3.0606,-0.29220,0.13166
293      +,-2.3527,-1.3953,0.18353E-01,0.11661E-01
294      +,-3.7196,-3.1764,-0.28985,0.16452/
295       DATA((CFORM(I,J),I=1,8),J=71,80)/-2.4343,-1.4853,-.0039059,.010053
296      +,-3.6407,-3.1393,-0.29399,0.16168
297      +,-2.5051,-1.5660,-0.23942E-01,0.86019E-02
298      +,-3.5604,-3.0986,-0.29802,0.15798
299      +,-1.8482,-1.0335,0.10459,0.17905E-01
300      +,-3.5085,-3.1017,-0.30378,0.16493
301      +,-1.9235,-1.1237,0.81217E-01,0.16159E-01
302      +,-3.4387,-3.0742,-0.30789,0.16440
303      +,-1.9968,-1.2113,0.58623E-01,0.14477E-01
304      +,-3.3686,-3.0445,-0.31168,0.16331
305      +,-1.5319,-0.79915,0.16481,0.22511E-01
306      +,-3.2798,-2.9781,-0.31121,0.15278
307      +,-1.5451,-0.83937,0.15298,0.21567E-01
308      +,-3.2138,-2.9536,-0.31574,0.15312
309      +,-1.5881,-0.90618,0.13445,0.20123E-01
310      +,-3.1480,-2.9280,-0.31999,0.15319
311      +,-1.6449,-0.98427,0.11327,0.18495E-01
312      +,-3.0827,-2.9016,-0.32395,0.15299
313      +,-1.7060,-1.0648,0.91680E-01,0.16851E-01
314      +,-3.0177,-2.8739,-0.32760,0.15248/
315       DATA((CFORM(I,J),I=1,8),J=81,90)/-1.4063,-0.78702,.16611,.02263
316      +,-2.9358,-2.8086,-0.32466,0.14168
317      +,-1.3849,-0.79373,0.16298,0.22357E-01
318      +,-2.8720,-2.7814,-0.32852,0.14138
319      +,-1.4038,-0.84050,0.14911,0.21248E-01
320      +,-2.8081,-2.7526,-0.33199,0.14064
321      +,-1.3918,-0.84924,0.14659,0.21073E-01
322      +,-2.7440,-2.7219,-0.33502,0.13940
323      +,-1.3620,-0.84008,0.14882,0.21263E-01
324      +,-2.6798,-2.6896,-0.33763,0.13770
325      +,-1.3138,-0.81488,0.15492,0.21729E-01
326      +,-2.6153,-2.6552,-0.33976,0.13541
327      +,-1.2903,-0.81842,0.15271,0.21530E-01
328      +,-2.5504,-2.6186,-0.34144,0.13254
329      +,-1.2999,-0.85623,0.14107,0.20590E-01
330      +,-2.5124,-2.6461,-0.35864,0.14864
331      +,-1.3280,-0.91171,0.12477,0.19289E-01
332      +,-2.4543,-2.6213,-0.36244,0.14915
333      +,-1.3618,-0.97145,0.10751,0.17921E-01
334      +,-2.3971,-2.5968,-0.36603,0.14969/
335       DATA((CFORM(I,J),I=1,8),J=91,100)/-2.1137,-2.5390,-0.89964,-.12482
336      +, 0.77611E-01,0.30619E-01,0.38767E-02,0.16722E-03
337      +,-2.0552,-2.4989,-0.89176,-0.12773
338      +, 0.76385E-01,0.30504E-01,0.38795E-02,0.16780E-03
339      +,-2.0034,-2.4634,-0.88113,-0.12883
340      +, 0.75109E-01,0.30234E-01,0.38560E-02,0.16706E-03
341      +,-1.9472,-2.4095,-0.85679,-0.12888
342      +,0.72058E-01,0.29358E-01,0.37583E-02,0.16315E-03
343      +,-1.8812,-2.3376,-0.82622,-0.13040
344      +,0.67863E-01,0.28260E-01,0.36427E-02,0.15873E-03
345      +,-1.8109,-2.2711,-0.80769,-0.13494
346      +,0.64860E-01,0.27749E-01,0.36090E-02,0.15806E-03
347      +,-1.7501,-2.2381,-0.81389,-0.14124
348      +,0.65086E-01,0.28325E-01,0.37071E-02,0.16301E-03
349      +,-1.7117,-2.2507,-0.84168,-0.14592
350      +,0.68718E-01,0.29785E-01,0.38979E-02,0.17149E-03
351      +,-1.6921,-2.2819,-0.86677,-0.14607
352      +,0.72800E-01,0.31032E-01,0.40423E-02,0.17744E-03
353      +,-1.3289,-1.3553,-0.20094,-0.91459E-01
354      +,-0.17322E-01,-0.97804E-03,0.,0./
355 *
356 C.    ------------------------------------------------------------------
357 C
358       SIG = 0.
359       IF(JRAYL.LE.0) GO TO 99
360       ELOW2 = ELOW(IEKBIN)
361       IF (Z.LT.1.0.OR.ELOW2.GT.0.001) GO TO 20
362       ALOGQ2 = LOG(ELOW2*1000.)
363       IF(IEKBIN.GT.1) THEN
364         ELOW1 = ELOW(IEKBIN-1)
365         ALOGQ1 = LOG(ELOW1*1000.)
366       ELSE
367         ELOW1 = 0.
368         ALOGQ1 = 0.
369       ENDIF
370       IF(JMIXT.EQ.0)THEN
371 C
372 C             simple material (element)
373 C
374          IZ=INT(Z)
375          JRAYL=LQ(JMA-13)
376          SIG=EXP(((COHER(4,IZ) *ALOGQ2+
377      +             COHER(3,IZ))*ALOGQ2+
378      +             COHER(2,IZ))*ALOGQ2+
379      +             COHER(1,IZ))*AVO*DENS/A
380          IF(IEKBIN.NE.1) THEN
381 C
382 C*    Use one or two functions to fit form factors
383             IF (ELIM(IZ).EQ.0.) THEN
384                FUN1 = (EXP(((((((CFORM(8,IZ)*ALOGQ1+
385      +                    CFORM(7,IZ))*ALOGQ1+
386      +                    CFORM(6,IZ))*ALOGQ1+
387      +                    CFORM(5,IZ))*ALOGQ1+
388      +                    CFORM(4,IZ))*ALOGQ1+
389      +                    CFORM(3,IZ))*ALOGQ1+
390      +                    CFORM(2,IZ))*ALOGQ1+
391      +                    CFORM(1,IZ))**2)*2.*ELOW1
392                 FUN2=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
393      +                    CFORM(7,IZ))*ALOGQ2+
394      +                    CFORM(6,IZ))*ALOGQ2+
395      +                    CFORM(5,IZ))*ALOGQ2+
396      +                    CFORM(4,IZ))*ALOGQ2+
397      +                    CFORM(3,IZ))*ALOGQ2+
398      +                    CFORM(2,IZ))*ALOGQ2+
399      +                    CFORM(1,IZ))**2)*2.*ELOW2
400             ELSE
401                 IF (ELOW1.LE.ELIM(IZ)) THEN
402                     FUN1=(EXP(((CFORM(4,IZ)*ALOGQ1+
403      +                    CFORM(3,IZ))*ALOGQ1+
404      +                    CFORM(2,IZ))*ALOGQ1+
405      +                    CFORM(1,IZ))**2)*2.*ELOW1
406                 ELSE
407                     FUN1=(EXP(((CFORM(8,IZ)*ALOGQ1+
408      +                    CFORM(7,IZ))*ALOGQ1+
409      +                    CFORM(6,IZ))*ALOGQ1+
410      +                    CFORM(5,IZ))**2)*2.*ELOW1
411                 ENDIF
412                IF (ELOW2.LE.ELIM(IZ)) THEN
413                     FUN2=(EXP(((CFORM(4,IZ)*ALOGQ2+
414      +                    CFORM(3,IZ))*ALOGQ2+
415      +                    CFORM(2,IZ))*ALOGQ2+
416      +                    CFORM(1,IZ))**2)*2.*ELOW2
417                 ELSE
418                     FUN2=(EXP(((CFORM(8,IZ)*ALOGQ2+
419      +                    CFORM(7,IZ))*ALOGQ2+
420      +                    CFORM(6,IZ))*ALOGQ2+
421      +                    CFORM(5,IZ))**2)*2.*ELOW2
422                 ENDIF
423             ENDIF
424  
425             Q(JRAYL+NEK1+IEKBIN)=Q(JRAYL+NEK1+IEKBIN-1)+
426      +      0.5*(FUN2+FUN1)*(ELOW2-ELOW1)
427          ELSE
428             IF (ELIM(IZ).EQ.0.) THEN
429                  FUN1=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
430      +                    CFORM(7,IZ))*ALOGQ2+
431      +                    CFORM(6,IZ))*ALOGQ2+
432      +                    CFORM(5,IZ))*ALOGQ2+
433      +                    CFORM(4,IZ))*ALOGQ2+
434      +                    CFORM(3,IZ))*ALOGQ2+
435      +                    CFORM(2,IZ))*ALOGQ2+
436      +                    CFORM(1,IZ))**2)*2.*ELOW2
437             ELSE
438                IF (ELOW2.LE.ELIM(IZ)) THEN
439                     FUN1=(EXP(((CFORM(4,IZ)*ALOGQ2+
440      +                    CFORM(3,IZ))*ALOGQ2+
441      +                    CFORM(2,IZ))*ALOGQ2+
442      +                    CFORM(1,IZ))**2)*2.*ELOW2
443                 ELSE
444                     FUN1=(EXP(((CFORM(8,IZ)*ALOGQ2+
445      +                    CFORM(7,IZ))*ALOGQ2+
446      +                    CFORM(6,IZ))*ALOGQ2+
447      +                    CFORM(5,IZ))**2)*2.*ELOW2
448                 ENDIF
449                 Q(JRAYL+NEK1+1)=Q(JRAYL+NEK1+1)+0.5*FUN1*ELOW2
450             ENDIF
451          ENDIF
452       ELSE
453 C
454 C             compound/mixture
455 C
456          NLMAT=Q(JMA+11)
457          NLM=IABS(NLMAT)
458          SIG=0.
459          IF(IEKBIN.NE.1) THEN
460             HINT=0.
461          ELSE
462             Q(JRAYL+NEK1+1)=0.
463          ENDIF
464          DO 10 I=1,NLM
465             J=JMIXT+I
466             AA=Q(J)
467             ZZ=Q(J+NLM)
468             IZ=INT(ZZ)
469             WMAT=Q(J+2*NLM)
470             S=EXP(((COHER(4,IZ) *ALOGQ2+
471      +                   COHER(3,IZ))*ALOGQ2+
472      +                   COHER(2,IZ))*ALOGQ2+
473      +                   COHER(1,IZ))
474             S=S*WMAT/AA
475             SIG=SIG+AVO*DENS*S
476             IF(IEKBIN.NE.1) THEN
477 C
478 C*    Use one or two functions to fit form factors
479             IF (ELIM(IZ).EQ.0.) THEN
480                 FUN1=(EXP(((((((CFORM(8,IZ)*ALOGQ1+
481      +                    CFORM(7,IZ))*ALOGQ1+
482      +                    CFORM(6,IZ))*ALOGQ1+
483      +                    CFORM(5,IZ))*ALOGQ1+
484      +                    CFORM(4,IZ))*ALOGQ1+
485      +                    CFORM(3,IZ))*ALOGQ1+
486      +                    CFORM(2,IZ))*ALOGQ1+
487      +                    CFORM(1,IZ))**2)*2.*ELOW1
488                 FUN2=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
489      +                    CFORM(7,IZ))*ALOGQ2+
490      +                    CFORM(6,IZ))*ALOGQ2+
491      +                    CFORM(5,IZ))*ALOGQ2+
492      +                    CFORM(4,IZ))*ALOGQ2+
493      +                    CFORM(3,IZ))*ALOGQ2+
494      +                    CFORM(2,IZ))*ALOGQ2+
495      +                    CFORM(1,IZ))**2)*2.*ELOW2
496             ELSE
497                 IF (ELOW1.LE.ELIM(IZ)) THEN
498                     FUN1=(EXP(((CFORM(4,IZ)*ALOGQ1+
499      +                    CFORM(3,IZ))*ALOGQ1+
500      +                    CFORM(2,IZ))*ALOGQ1+
501      +                    CFORM(1,IZ))**2)*2.*ELOW1
502                 ELSE
503                     FUN1=(EXP(((CFORM(8,IZ)*ALOGQ1+
504      +                    CFORM(7,IZ))*ALOGQ1+
505      +                    CFORM(6,IZ))*ALOGQ1+
506      +                    CFORM(5,IZ))**2)*2.*ELOW1
507                 ENDIF
508                IF (ELOW2.LE.ELIM(IZ)) THEN
509                     FUN2=(EXP(((CFORM(4,IZ)*ALOGQ2+
510      +                    CFORM(3,IZ))*ALOGQ2+
511      +                    CFORM(2,IZ))*ALOGQ2+
512      +                    CFORM(1,IZ))**2)*2.*ELOW2
513                 ELSE
514                     FUN2=(EXP(((CFORM(8,IZ)*ALOGQ2+
515      +                    CFORM(7,IZ))*ALOGQ2+
516      +                    CFORM(6,IZ))*ALOGQ2+
517      +                    CFORM(5,IZ))**2)*2*ELOW2
518                 ENDIF
519             ENDIF
520                HINT=HINT+WMAT*0.5*(FUN2+FUN1)*(ELOW2-ELOW1)
521 *
522             ELSE
523                IF (ELIM(IZ).EQ.0.) THEN
524                    FUN1=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
525      +                    CFORM(7,IZ))*ALOGQ2+
526      +                    CFORM(6,IZ))*ALOGQ2+
527      +                    CFORM(5,IZ))*ALOGQ2+
528      +                    CFORM(4,IZ))*ALOGQ2+
529      +                    CFORM(3,IZ))*ALOGQ2+
530      +                    CFORM(2,IZ))*ALOGQ2+
531      +                    CFORM(1,IZ))**2)*2.*ELOW2
532                ELSE
533                   IF (ELOW2.LE.ELIM(IZ)) THEN
534                       FUN1=(EXP(((CFORM(4,IZ)*ALOGQ2+
535      +                    CFORM(3,IZ))*ALOGQ2+
536      +                    CFORM(2,IZ))*ALOGQ2+
537      +                    CFORM(1,IZ))**2)*2.*ELOW2
538                   ELSE
539                       FUN1=(EXP(((CFORM(8,IZ)*ALOGQ2+
540      +                    CFORM(7,IZ))*ALOGQ2+
541      +                    CFORM(6,IZ))*ALOGQ2+
542      +                    CFORM(5,IZ))**2)*2.*ELOW2
543                   ENDIF
544                ENDIF
545                Q(JRAYL+NEK1+1)=Q(JRAYL+NEK1+1)+WMAT*0.5*FUN1*ELOW2
546             ENDIF
547    10    CONTINUE
548          IF(IEKBIN.NE.1)
549      +   Q(JRAYL+NEK1+IEKBIN)=Q(JRAYL+NEK1+IEKBIN-1)+HINT
550       ENDIF
551 C
552    20 IF(SIG.GT.0.)THEN
553          Q(JRAYL+IEKBIN)=1./SIG
554       ELSE
555          Q(JRAYL+IEKBIN)=BIG
556          Q(JRAYL+NEK1+IEKBIN)=0.
557       ENDIF
558 C
559   99  END