* * $Id: grayli.F,v 1.1.1.1 1995/10/24 10:21:33 cernlib Exp $ * * $Log: grayli.F,v $ * 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