--- /dev/null
+*
+* $Id$
+*
+* $Log$
+* Revision 1.1.1.1 1995/10/24 10:21:33 cernlib
+* Geant
+*
+*
+#include "geant321/pilot.h"
+*CMZ : 3.21/02 29/03/94 15.41.23 by S.Giani
+*-- Author :
+ SUBROUTINE GRAYLI
+C.
+C. ******************************************************************
+C. * *
+C. * Calculates cross-section of current material for RAYLEIGH *
+C. * EFFECT using polinomial fits of tables in log-log scale. *
+C. * One fit (4 coefficients) for each element is used. *
+C. * Atomic form factors are calculated as a function of momentum *
+C. * transfer using polinomial fits of data tables in log-log scale*
+C. * One or two fits are used according with the value of NFIT. *
+C. * Evaluates the integral of atomic form factors which will be *
+C. * used in the SUBROUTINE GRAYL to sample scattering angles *
+C. * NOTE: *
+C. * (1) Above 10 MeV a cut is imposed as the contribution of *
+C. * Rayleigh effect is negligible *
+C. * *
+C. * ==>Called by : GPHYSI *
+C. * Author G.Tromba (*), P.Bregant (**) *
+C. * *
+C. * (*) now at: Sincrotrone Trieste, Padriciano 99, Trieste (I) *
+C. * (**)U.S.L. n.1 Triestina *
+C. * Servizio di Fisica Sanitaria, v.Pieta' 19, 34129 Trieste *
+C * *
+C. ******************************************************************
+C.
+#include "geant321/gcbank.inc"
+#include "geant321/gctrak.inc"
+#include "geant321/gconsp.inc"
+#include "geant321/gcmate.inc"
+#include "geant321/gcjloc.inc"
+#include "geant321/gcmulo.inc"
+ DIMENSION COHER(4,100),CFORM(8,100),ELIM(100)
+*
+ DATA((COHER(I,J),I=1,4),J=1,20)/-12.646,-1.9734,.13417,.23998E-01
+ +,-10.303,-1.9553,0.15913,0.29927E-01
+ +,-9.1274,-2.0474,0.87874E-01,0.23572E-01
+ +,-8.3066,-2.0615,0.46623E-01,0.18455E-01
+ +,-7.6967,-2.0684,0.24280E-01,0.15622E-01
+ +,-7.2088,-2.0633,0.15713E-01,0.14402E-01
+ +,-6.8026,-2.0574,0.16437E-01,0.14518E-01
+ +,-6.4403,-2.0449,0.18975E-01,0.14716E-01
+ +,-6.1099,-2.0390,0.21207E-01,0.15081E-01
+ +,-5.7930,-2.0384,0.19210E-01,0.14989E-01
+ +,-5.5410,-2.0430,0.20118E-01,0.15698E-01
+ +,-5.3138,-2.0399,0.21325E-01,0.16074E-01
+ +,-5.0993,-2.0395,0.19494E-01,0.16046E-01
+ +,-4.9005,-2.0397,0.17404E-01,0.15937E-01
+ +,-4.7149,-2.0394,0.15412E-01,0.15788E-01
+ +,-4.5420,-2.0393,0.13945E-01,0.15704E-01
+ +,-4.3846,-2.0372,0.14551E-01,0.15848E-01
+ +,-4.2381,-2.0316,0.16322E-01,0.16051E-01
+ +,-4.1023,-2.0249,0.17752E-01,0.16300E-01
+ +,-3.9704,-2.0187,0.17285E-01,0.16217E-01/
+ DATA ((COHER(I,J),I=1,4),J=21,40)/-3.8342,-2.0137,.014534,.015744
+ +,-3.7014,-2.0118,0.10973E-01,0.15228E-01
+ +,-3.5759,-2.0127,0.80253E-02,0.14884E-01
+ +,-3.4584,-2.0121,0.70340E-02,0.14731E-01
+ +,-3.3494,-2.0101,0.66838E-02,0.14731E-01
+ +,-3.2392,-2.0074,0.57007E-02,0.14562E-01
+ +,-3.1309,-2.0050,0.41822E-02,0.14312E-01
+ +,-3.0235,-2.0049,0.19877E-02,0.14052E-01
+ +,-2.9211,-2.0071,0.85036E-03,0.13970E-01
+ +,-2.8192,-2.0069,-0.14296E-02,0.13732E-01
+ +,-2.7265,-2.0088,-0.26683E-02,0.13717E-01
+ +,-2.6378,-2.0095,-0.34226E-02,0.13727E-01
+ +,-2.5496,-2.0094,-0.62157E-02,0.13425E-01
+ +,-2.4704,-2.0092,-0.43550E-02,0.13753E-01
+ +,-2.3900,-2.0083,-0.48368E-02,0.13730E-01
+ +,-2.3111,-2.0072,-0.55407E-02,0.13668E-01
+ +,-2.2355,-2.0065,-0.61290E-02,0.13697E-01
+ +,-2.1614,-2.0064,-0.70329E-02,0.13672E-01
+ +,-2.0899,-2.0060,-0.78982E-02,0.13612E-01
+ +,-2.0203,-2.0057,-0.85764E-02,0.13570E-01/
+ DATA((COHER(I,J),I=1,4),J=41,60)/-1.9519,-2.0049,-.0091079,.013506
+ +,-1.8851,-2.0036,-0.94870E-02,0.13472E-01
+ +,-1.8210,-2.0019,-0.10066E-01,0.13410E-01
+ +,-1.7554,-2.0007,-0.11089E-01,0.13247E-01
+ +,-1.6914,-1.9990,-0.11844E-01,0.13139E-01
+ +,-1.6279,-1.9984,-0.12922E-01,0.12987E-01
+ +,-1.5659,-1.9980,-0.13635E-01,0.12948E-01
+ +,-1.5073,-1.9977,-0.14136E-01,0.12937E-01
+ +,-1.4501,-1.9959,-0.14206E-01,0.12957E-01
+ +,-1.3942,-1.9943,-0.14863E-01,0.12876E-01
+ +,-1.3378,-1.9916,-0.15680E-01,0.12738E-01
+ +,-1.2820,-1.9881,-0.16880E-01,0.12511E-01
+ +,-1.2231,-1.9861,-0.18942E-01,0.12204E-01
+ +,-1.1658,-1.9850,-0.21146E-01,0.11896E-01
+ +,-1.1112,-1.9864,-0.22968E-01,0.11769E-01
+ +,-1.0594,-1.9877,-0.24247E-01,0.11707E-01
+ +,-1.0104,-1.9895,-0.24993E-01,0.11718E-01
+ +,-0.96289,-1.9905,-0.25026E-01,0.11788E-01
+ +,-0.91458,-1.9909,-0.25128E-01,0.11807E-01
+ +,-0.86838,-1.9909,-0.25111E-01,0.11847E-01/
+ DATA ((COHER(I,J),I=1,4),J=61,80)/-.82136,-1.9903,-.025340,.011835
+ +,-0.77441,-1.9864,-0.26074E-01,0.11635E-01
+ +,-0.72869,-1.9885,-0.26020E-01,0.11761E-01
+ +,-0.68337,-1.9878,-0.26532E-01,0.11712E-01
+ +,-0.63683,-1.9871,-0.26966E-01,0.11650E-01
+ +,-0.59154,-1.9867,-0.27440E-01,0.11604E-01
+ +,-0.54758,-1.9862,-0.27986E-01,0.11561E-01
+ +,-0.50282,-1.9861,-0.28229E-01,0.11547E-01
+ +,-0.45943,-1.9858,-0.28501E-01,0.11535E-01
+ +,-0.41677,-1.9856,-0.28696E-01,0.11540E-01
+ +,-0.37528,-1.9853,-0.29045E-01,0.11529E-01
+ +,-0.33450,-1.9843,-0.29095E-01,0.11545E-01
+ +,-0.29346,-1.9834,-0.29469E-01,0.11511E-01
+ +,-0.25286,-1.9823,-0.29847E-01,0.11469E-01
+ +,-0.21251,-1.9810,-0.30285E-01,0.11412E-01
+ +,-0.17200,-1.9801,-0.30821E-01,0.11368E-01
+ +,-0.13190,-1.9789,-0.31515E-01,0.11257E-01
+ +,-0.92060E-01,-1.9781,-0.32135E-01,0.11179E-01
+ +,-0.52955E-01,-1.9775,-0.32687E-01,0.11125E-01
+ +,-0.14708E-01,-1.9770,-0.33185E-01,0.11092E-01/
+ DATA((COHER(I,J),I=1,4),J=81,100)/.022864,-1.9751,-.033545,.011037
+ +,0.60152E-01,-1.9764,-0.33897E-01,0.11092E-01
+ +,0.96158E-01,-1.9760,-0.34169E-01,0.11099E-01
+ +,0.13251,-1.9753,-0.34520E-01,0.11085E-01
+ +,0.16833,-1.9747,-0.34818E-01,0.11081E-01
+ +,0.20362,-1.9740,-0.35032E-01,0.11086E-01
+ +,0.23778,-1.9734,-0.34984E-01,0.11155E-01
+ +,0.27280,-1.9725,-0.35314E-01,0.11153E-01
+ +,0.30673,-1.9718,-0.35308E-01,0.11229E-01
+ +,0.34031,-1.9706,-0.35518E-01,0.11187E-01
+ +,0.37415,-1.9695,-0.35653E-01,0.11175E-01
+ +,0.40755,-1.9670,-0.34285E-01,0.11389E-01
+ +,0.44086,-1.9671,-0.35957E-01,0.11154E-01
+ +,0.47375,-1.9661,-0.36059E-01,0.11145E-01
+ +,0.50582,-1.9648,-0.36048E-01,0.11154E-01
+ +,0.53772,-1.9635,-0.36237E-01,0.11140E-01
+ +,0.56929,-1.9622,-0.36256E-01,0.11141E-01
+ +,0.60044,-1.9608,-0.36340E-01,0.11134E-01
+ +,0.63122,-1.9596,-0.36313E-01,0.11138E-01
+ +,0.66162,-1.9582,-0.36298E-01,0.11141E-01/
+*
+ DATA ELIM/3*0.,3*0.13569E-04,3*0.14408E-04,3*0.15299E-04
+ +,3*0.21928E-04,3*0.27876E-04,3*0.35437E-04,3*0.45049E-04
+ +,3*0.50793E-04,3*0.53934E-04,3*0.57269E-04,3*0.60810E-04
+ +,3*0.68563E-04,3*0.77305E-04,3*0.87161E-04,3*0.98274E-04
+ +,3* 0.11080E-03,3*0.11765E-03,3*0.12493E-03,3*0.13266E-03
+ +,3*0.14086E-03,3*0.15882E-03,3* 0.16864E-03,3*0.19014E-03
+ +,3*0.21438E-03,3*0.22764E-03,2*0.24171E-03,3*0.27253E-03
+ +,4*0.28938E-03,3*0.3072E-03,10*0./
+*
+ DATA((CFORM(I,J),I=1,8),J=1,10)/-22.516,-5.1310,-.90555,-.055778
+ +,0.11875,0.36659E-01,0.39279E-02,0.14494E-03
+ +,-19.260,-4.6034,-0.60480,-0.86935E-01
+ +,0.75207E-01,0.29358E-01,0.35640E-02,0.14448E-03
+ +,-16.745,-2.9900,-0.34216E-01,-0.22543
+ +,-0.29032E-01,0.11312E-01,0.24065E-02,0.12420E-03
+ +,-17.780,-7.8538,-1.1320,-0.56378E-01
+ +,-16.730,-4.1304,0.18327,0.63285E-01
+ +,-5.7128,-1.8620,-0.14825,-0.39071E-02
+ +,-15.923,-4.1463,0.24609,0.83958E-01
+ +,6.1359,4.3284,0.91725,0.55486E-01
+ +,-15.224,-4.1486,0.28574,0.99104E-01
+ +,7.9239,5.4239,1.1417,0.69696E-01
+ +,-14.548,-4.1850,0.26729,0.10343
+ +,5.6813,4.4241,1.0125,0.64574E-01
+ +,-13.948,-4.2241,0.23705,0.10507
+ +,-0.73602,1.2353,0.51040,0.38876E-01
+ +,-13.380,-4.3238,0.15807,0.98704E-01
+ +,-4.5122,-0.69749,0.20317,0.23107E-01
+ +,-12.880,-4.3645,0.11149,0.96212E-01/
+ DATA((CFORM(I,J),I=1,8),J=11,20)/-12.894,-5.1262,-0.54343,-.017585
+ +,-12.442,-4.4181,0.64564E-01,0.93785E-01
+ +,-18.182,-7.9979,-1.0369,-0.44947E-01
+ +,-11.961,-4.4932,-0.23538E-01,0.83167E-01
+ +,-7.7002,-2.7396,-0.16988,0.17141E-02
+ +,-11.655,-4.3468,0.67545E-01,0.10218
+ +,-11.458,-4.8625,-0.54640,-0.19752E-01
+ +,-11.288,-4.3645,0.31952E-01,0.10016
+ +,-13.733,-6.1918,-0.78628,-0.33620E-01
+ +,-10.866,-4.4125,-0.54747E-01,0.87723E-01
+ +,-6.9281,-2.5933,-0.16486,0.11230E-02
+ +,-10.716,-4.2771,0.63949E-01,0.11331
+ +,-9.1472,-3.9093,-0.40549,-0.12939E-01
+ +,-10.308,-4.3105,-0.26699E-01,0.98791E-01
+ +,-10.558,-4.7765,-0.56625,-0.22421E-01
+ +,-9.9972,-4.3437,-0.82898E-01,0.92124E-01
+ +,-6.0983,-2.3464,-0.13404,0.24166E-02
+ +,-10.027,-4.2552,0.73490E-01,0.13009
+ +,-7.9984,-3.5151,-0.35363,-0.10654E-01
+ +,-9.6508,-4.2506,-0.65510E-02,0.11484/
+ DATA((CFORM(I,J),I=1,8),J=21,30)/-9.2121,-4.2776,-0.49730,-.019235
+ +,-9.4905,-4.2588,0.32597E-02,0.12279
+ +,-3.9128,-1.2033,0.75797E-01,0.14897E-01
+ +,-9.3296,-4.1979,0.42817E-01,0.13360
+ +,-5.1579,-1.9987,-0.76380E-01,0.56926E-02
+ +,-9.0348,-4.1729,-0.43368E-02,0.12460
+ +,-6.1115,-2.6115,-0.19286,-0.13208E-02
+ +,-8.7478,-4.1599,-0.57064E-01,0.11511
+ +,-4.5827,-1.7167,-0.21089E-01,0.91965E-02
+ +,-8.6469,-4.1430,-0.21725E-01,0.12790
+ +,-5.4795,-2.3056,-0.13495,0.22647E-02
+ +,-8.4099,-4.1228,-0.55178E-01,0.12251
+ +,-6.1802,-2.7722,-0.22505,-0.32066E-02
+ +,-8.2279,-4.0934,-0.62350E-01,0.12269
+ +,-5.8290,-2.5908,-0.19000,-0.10226E-02
+ +,-8.0551,-4.0478,-0.60875E-01,0.12369
+ +,-6.2227,-2.8633,-0.24196,-0.41418E-02
+ +,-7.8068,-4.0203,-0.10682,0.11396
+ +,-6.6260,-3.1507,-0.29866,-0.76188E-02
+ +,-7.5763,-3.9966,-0.14839,0.10560/
+ DATA((CFORM(I,J),I=1,8),J=31,40)/-5.8965,-2.7383,-.22009,-.0028149
+ +,-7.5281,-3.9941,-0.10906,0.12081
+ +,-6.2790,-3.0188,-0.27697,-0.63842E-02
+ +,-7.3337,-3.9547,-0.13178,0.11541
+ +,-6.5270,-3.2157,-0.31779,-0.89844E-02
+ +,-7.1437,-3.9160,-0.15503,0.10982
+ +,-6.6564,-3.3380,-0.34420,-0.10706E-01
+ +,-6.9226,-3.8688,-0.19301,0.99252E-01
+ +,-6.6676,-3.3866,-0.35637,-0.11562E-01
+ +,-6.7647,-3.8417,-0.20928,0.96358E-01
+ +,-6.5973,-3.3839,-0.35856,-0.11806E-01
+ +,-6.5615,-3.7910,-0.24140,0.86548E-01
+ +,-5.5223,-2.7503,-0.23696,-0.43562E-02
+ +,-6.6156,-3.8232,-0.17222,0.11431
+ +,-5.7577,-2.9413,-0.27766,-0.69923E-02
+ +,-6.4351,-3.7636,-0.19273,0.10630
+ +,-5.8988,-3.0704,-0.30602,-0.88735E-02
+ +,-6.2520,-3.7107,-0.21873,0.97517E-01
+ +,-5.1690,-2.6301,-0.21923,-0.34573E-02
+ +,-6.2183,-3.7177,-0.18979,0.11175/
+ DATA((CFORM(I,J),I=1,8),J=41,50)/-5.3652,-2.7941,-.25462,-.0057986
+ +,-6.0669,-3.6847,-0.20939,0.10725
+ +,-5.5028,-2.9182,-0.28166,-0.75863E-02
+ +,-5.9625,-3.6681,-0.21256,0.10888
+ +,-4.4716,-2.2542,-0.14575,0.11394E-02
+ +,-5.9717,-3.7006,-0.17526,0.12848
+ +,-4.6959,-2.4391,-0.18590,-0.15318E-02
+ +,-5.8101,-3.6454,-0.19615,0.12040
+ +,-4.8697,-2.5886,-0.21853,-0.36987E-02
+ +,-5.6609,-3.6010,-0.21568,0.11417
+ +,-4.3929,-2.2914,-0.15753,0.22346E-03
+ +,-5.6585,-3.6429,-0.19093,0.13204
+ +,-4.5695,-2.4433,-0.19070,-0.19681E-02
+ +,-5.5414,-3.6051,-0.19872,0.12936
+ +,-4.7029,-2.5655,-0.21777,-0.37707E-02
+ +,-5.4029,-3.5513,-0.21291,0.12265
+ +,-4.2616,-2.2896,-0.16092,-0.80603E-04
+ +,-5.3622,-3.5694,-0.20212,0.13395
+ +,-4.4165,-2.4282,-0.19184,-0.21565E-02
+ +,-5.2567,-3.5409,-0.20978,0.13282/
+ DATA((CFORM(I,J),I=1,8),J=51,60)/-4.5344,-2.5405,-.21724,-.0038729
+ +,-5.1491,-3.5054,-0.21718,0.13045
+ +,-3.6372,-1.9343,-0.88690E-01,0.46020E-02
+ +,-5.0258,-3.4548,-0.22839,0.12463
+ +,-3.8210,-2.0961,-0.12529,0.21101E-02
+ +,-4.8945,-3.3989,-0.24271,0.11716
+ +,-3.9712,-2.2334,-0.15661,-0.34134E-04
+ +,-4.7735,-3.3522,-0.25562,0.11148
+ +,-3.1689,-1.6776,-0.36233E-01,0.80485E-02
+ +,-4.8172,-3.4334,-0.22782,0.13781
+ +,-3.3490,-1.8398,-0.73631E-01,0.54743E-02
+ +,-4.6932,-3.3773,-0.24060,0.13057
+ +,-3.5038,-1.9826,-0.10676,0.31787E-02
+ +,-4.5891,-3.3400,-0.25016,0.12742
+ +,-3.6192,-2.0937,-0.13237,0.14104E-02
+ +,-4.5112,-3.3248,-0.25437,0.12929
+ +,-3.6974,-2.1750,-0.15093,0.13588E-03
+ +,-4.4412,-3.3123,-0.25609,0.13194
+ +,-3.7627,-2.2475,-0.16786,-0.10371E-02
+ +,-4.3611,-3.2863,-0.25915,0.13169/
+ DATA((CFORM(I,J),I=1,8),J=61,70)/-3.2202,-1.8724,-.086015,.0044765
+ +,-4.3280,-3.3034,-0.25324,0.14193
+ +,-3.3101,-1.9643,-0.10751,0.29785E-02
+ +,-4.2204,-3.2500,-0.26236,0.13536
+ +,-3.3804,-2.0408,-0.12547,0.17255E-02
+ +,-4.1144,-3.1979,-0.27167,0.12901
+ +,-2.9387,-1.7293,-0.56192E-01,0.64683E-02
+ +,-4.1523,-3.3027,-0.26089,0.15874
+ +,-3.0175,-1.8125,-0.75694E-01,0.51021E-02
+ +,-4.0626,-3.2616,-0.26653,0.15504
+ +,-3.0862,-1.8882,-0.93679E-01,0.38370E-02
+ +,-3.9705,-3.2160,-0.27238,0.15031
+ +,-3.1456,-1.9572,-0.11034,0.26582E-02
+ +,-3.8761,-3.1664,-0.27856,0.14462
+ +,-3.1764,-2.0014,-0.12079,0.19291E-02
+ +,-3.7797,-3.1138,-0.28517,0.13823
+ +,-3.2001,-2.0409,-0.13038,0.12518E-02
+ +,-3.6830,-3.0606,-0.29220,0.13166
+ +,-2.3527,-1.3953,0.18353E-01,0.11661E-01
+ +,-3.7196,-3.1764,-0.28985,0.16452/
+ DATA((CFORM(I,J),I=1,8),J=71,80)/-2.4343,-1.4853,-.0039059,.010053
+ +,-3.6407,-3.1393,-0.29399,0.16168
+ +,-2.5051,-1.5660,-0.23942E-01,0.86019E-02
+ +,-3.5604,-3.0986,-0.29802,0.15798
+ +,-1.8482,-1.0335,0.10459,0.17905E-01
+ +,-3.5085,-3.1017,-0.30378,0.16493
+ +,-1.9235,-1.1237,0.81217E-01,0.16159E-01
+ +,-3.4387,-3.0742,-0.30789,0.16440
+ +,-1.9968,-1.2113,0.58623E-01,0.14477E-01
+ +,-3.3686,-3.0445,-0.31168,0.16331
+ +,-1.5319,-0.79915,0.16481,0.22511E-01
+ +,-3.2798,-2.9781,-0.31121,0.15278
+ +,-1.5451,-0.83937,0.15298,0.21567E-01
+ +,-3.2138,-2.9536,-0.31574,0.15312
+ +,-1.5881,-0.90618,0.13445,0.20123E-01
+ +,-3.1480,-2.9280,-0.31999,0.15319
+ +,-1.6449,-0.98427,0.11327,0.18495E-01
+ +,-3.0827,-2.9016,-0.32395,0.15299
+ +,-1.7060,-1.0648,0.91680E-01,0.16851E-01
+ +,-3.0177,-2.8739,-0.32760,0.15248/
+ DATA((CFORM(I,J),I=1,8),J=81,90)/-1.4063,-0.78702,.16611,.02263
+ +,-2.9358,-2.8086,-0.32466,0.14168
+ +,-1.3849,-0.79373,0.16298,0.22357E-01
+ +,-2.8720,-2.7814,-0.32852,0.14138
+ +,-1.4038,-0.84050,0.14911,0.21248E-01
+ +,-2.8081,-2.7526,-0.33199,0.14064
+ +,-1.3918,-0.84924,0.14659,0.21073E-01
+ +,-2.7440,-2.7219,-0.33502,0.13940
+ +,-1.3620,-0.84008,0.14882,0.21263E-01
+ +,-2.6798,-2.6896,-0.33763,0.13770
+ +,-1.3138,-0.81488,0.15492,0.21729E-01
+ +,-2.6153,-2.6552,-0.33976,0.13541
+ +,-1.2903,-0.81842,0.15271,0.21530E-01
+ +,-2.5504,-2.6186,-0.34144,0.13254
+ +,-1.2999,-0.85623,0.14107,0.20590E-01
+ +,-2.5124,-2.6461,-0.35864,0.14864
+ +,-1.3280,-0.91171,0.12477,0.19289E-01
+ +,-2.4543,-2.6213,-0.36244,0.14915
+ +,-1.3618,-0.97145,0.10751,0.17921E-01
+ +,-2.3971,-2.5968,-0.36603,0.14969/
+ DATA((CFORM(I,J),I=1,8),J=91,100)/-2.1137,-2.5390,-0.89964,-.12482
+ +, 0.77611E-01,0.30619E-01,0.38767E-02,0.16722E-03
+ +,-2.0552,-2.4989,-0.89176,-0.12773
+ +, 0.76385E-01,0.30504E-01,0.38795E-02,0.16780E-03
+ +,-2.0034,-2.4634,-0.88113,-0.12883
+ +, 0.75109E-01,0.30234E-01,0.38560E-02,0.16706E-03
+ +,-1.9472,-2.4095,-0.85679,-0.12888
+ +,0.72058E-01,0.29358E-01,0.37583E-02,0.16315E-03
+ +,-1.8812,-2.3376,-0.82622,-0.13040
+ +,0.67863E-01,0.28260E-01,0.36427E-02,0.15873E-03
+ +,-1.8109,-2.2711,-0.80769,-0.13494
+ +,0.64860E-01,0.27749E-01,0.36090E-02,0.15806E-03
+ +,-1.7501,-2.2381,-0.81389,-0.14124
+ +,0.65086E-01,0.28325E-01,0.37071E-02,0.16301E-03
+ +,-1.7117,-2.2507,-0.84168,-0.14592
+ +,0.68718E-01,0.29785E-01,0.38979E-02,0.17149E-03
+ +,-1.6921,-2.2819,-0.86677,-0.14607
+ +,0.72800E-01,0.31032E-01,0.40423E-02,0.17744E-03
+ +,-1.3289,-1.3553,-0.20094,-0.91459E-01
+ +,-0.17322E-01,-0.97804E-03,0.,0./
+*
+C. ------------------------------------------------------------------
+C
+ SIG = 0.
+ IF(JRAYL.LE.0) GO TO 99
+ ELOW2 = ELOW(IEKBIN)
+ IF (Z.LT.1.0.OR.ELOW2.GT.0.001) GO TO 20
+ ALOGQ2 = LOG(ELOW2*1000.)
+ IF(IEKBIN.GT.1) THEN
+ ELOW1 = ELOW(IEKBIN-1)
+ ALOGQ1 = LOG(ELOW1*1000.)
+ ELSE
+ ELOW1 = 0.
+ ALOGQ1 = 0.
+ ENDIF
+ IF(JMIXT.EQ.0)THEN
+C
+C simple material (element)
+C
+ IZ=INT(Z)
+ JRAYL=LQ(JMA-13)
+ SIG=EXP(((COHER(4,IZ) *ALOGQ2+
+ + COHER(3,IZ))*ALOGQ2+
+ + COHER(2,IZ))*ALOGQ2+
+ + COHER(1,IZ))*AVO*DENS/A
+ IF(IEKBIN.NE.1) THEN
+C
+C* Use one or two functions to fit form factors
+ IF (ELIM(IZ).EQ.0.) THEN
+ FUN1 = (EXP(((((((CFORM(8,IZ)*ALOGQ1+
+ + CFORM(7,IZ))*ALOGQ1+
+ + CFORM(6,IZ))*ALOGQ1+
+ + CFORM(5,IZ))*ALOGQ1+
+ + CFORM(4,IZ))*ALOGQ1+
+ + CFORM(3,IZ))*ALOGQ1+
+ + CFORM(2,IZ))*ALOGQ1+
+ + CFORM(1,IZ))**2)*2.*ELOW1
+ FUN2=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))*ALOGQ2+
+ + CFORM(4,IZ))*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ IF (ELOW1.LE.ELIM(IZ)) THEN
+ FUN1=(EXP(((CFORM(4,IZ)*ALOGQ1+
+ + CFORM(3,IZ))*ALOGQ1+
+ + CFORM(2,IZ))*ALOGQ1+
+ + CFORM(1,IZ))**2)*2.*ELOW1
+ ELSE
+ FUN1=(EXP(((CFORM(8,IZ)*ALOGQ1+
+ + CFORM(7,IZ))*ALOGQ1+
+ + CFORM(6,IZ))*ALOGQ1+
+ + CFORM(5,IZ))**2)*2.*ELOW1
+ ENDIF
+ IF (ELOW2.LE.ELIM(IZ)) THEN
+ FUN2=(EXP(((CFORM(4,IZ)*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ FUN2=(EXP(((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))**2)*2.*ELOW2
+ ENDIF
+ ENDIF
+
+ Q(JRAYL+NEK1+IEKBIN)=Q(JRAYL+NEK1+IEKBIN-1)+
+ + 0.5*(FUN2+FUN1)*(ELOW2-ELOW1)
+ ELSE
+ IF (ELIM(IZ).EQ.0.) THEN
+ FUN1=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))*ALOGQ2+
+ + CFORM(4,IZ))*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ IF (ELOW2.LE.ELIM(IZ)) THEN
+ FUN1=(EXP(((CFORM(4,IZ)*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ FUN1=(EXP(((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))**2)*2.*ELOW2
+ ENDIF
+ Q(JRAYL+NEK1+1)=Q(JRAYL+NEK1+1)+0.5*FUN1*ELOW2
+ ENDIF
+ ENDIF
+ ELSE
+C
+C compound/mixture
+C
+ NLMAT=Q(JMA+11)
+ NLM=IABS(NLMAT)
+ SIG=0.
+ IF(IEKBIN.NE.1) THEN
+ HINT=0.
+ ELSE
+ Q(JRAYL+NEK1+1)=0.
+ ENDIF
+ DO 10 I=1,NLM
+ J=JMIXT+I
+ AA=Q(J)
+ ZZ=Q(J+NLM)
+ IZ=INT(ZZ)
+ WMAT=Q(J+2*NLM)
+ S=EXP(((COHER(4,IZ) *ALOGQ2+
+ + COHER(3,IZ))*ALOGQ2+
+ + COHER(2,IZ))*ALOGQ2+
+ + COHER(1,IZ))
+ S=S*WMAT/AA
+ SIG=SIG+AVO*DENS*S
+ IF(IEKBIN.NE.1) THEN
+C
+C* Use one or two functions to fit form factors
+ IF (ELIM(IZ).EQ.0.) THEN
+ FUN1=(EXP(((((((CFORM(8,IZ)*ALOGQ1+
+ + CFORM(7,IZ))*ALOGQ1+
+ + CFORM(6,IZ))*ALOGQ1+
+ + CFORM(5,IZ))*ALOGQ1+
+ + CFORM(4,IZ))*ALOGQ1+
+ + CFORM(3,IZ))*ALOGQ1+
+ + CFORM(2,IZ))*ALOGQ1+
+ + CFORM(1,IZ))**2)*2.*ELOW1
+ FUN2=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))*ALOGQ2+
+ + CFORM(4,IZ))*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ IF (ELOW1.LE.ELIM(IZ)) THEN
+ FUN1=(EXP(((CFORM(4,IZ)*ALOGQ1+
+ + CFORM(3,IZ))*ALOGQ1+
+ + CFORM(2,IZ))*ALOGQ1+
+ + CFORM(1,IZ))**2)*2.*ELOW1
+ ELSE
+ FUN1=(EXP(((CFORM(8,IZ)*ALOGQ1+
+ + CFORM(7,IZ))*ALOGQ1+
+ + CFORM(6,IZ))*ALOGQ1+
+ + CFORM(5,IZ))**2)*2.*ELOW1
+ ENDIF
+ IF (ELOW2.LE.ELIM(IZ)) THEN
+ FUN2=(EXP(((CFORM(4,IZ)*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ FUN2=(EXP(((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))**2)*2*ELOW2
+ ENDIF
+ ENDIF
+ HINT=HINT+WMAT*0.5*(FUN2+FUN1)*(ELOW2-ELOW1)
+*
+ ELSE
+ IF (ELIM(IZ).EQ.0.) THEN
+ FUN1=(EXP(((((((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))*ALOGQ2+
+ + CFORM(4,IZ))*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ IF (ELOW2.LE.ELIM(IZ)) THEN
+ FUN1=(EXP(((CFORM(4,IZ)*ALOGQ2+
+ + CFORM(3,IZ))*ALOGQ2+
+ + CFORM(2,IZ))*ALOGQ2+
+ + CFORM(1,IZ))**2)*2.*ELOW2
+ ELSE
+ FUN1=(EXP(((CFORM(8,IZ)*ALOGQ2+
+ + CFORM(7,IZ))*ALOGQ2+
+ + CFORM(6,IZ))*ALOGQ2+
+ + CFORM(5,IZ))**2)*2.*ELOW2
+ ENDIF
+ ENDIF
+ Q(JRAYL+NEK1+1)=Q(JRAYL+NEK1+1)+WMAT*0.5*FUN1*ELOW2
+ ENDIF
+ 10 CONTINUE
+ IF(IEKBIN.NE.1)
+ + Q(JRAYL+NEK1+IEKBIN)=Q(JRAYL+NEK1+IEKBIN-1)+HINT
+ ENDIF
+C
+ 20 IF(SIG.GT.0.)THEN
+ Q(JRAYL+IEKBIN)=1./SIG
+ ELSE
+ Q(JRAYL+IEKBIN)=BIG
+ Q(JRAYL+NEK1+IEKBIN)=0.
+ ENDIF
+C
+ 99 END
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff