Module Profile_Finger ! Here the functions provided in the original code by L. Finger have been ! implemented as subroutines as is the common practice in Fortran 90 when ! several dummy arguments have output intent attribute. ! The before using the main subroutine (called here Prof_Val) the user program ! should call Init_Prof_Val to set the arrays xp and wp as well as the global ! variable init_profval to true. ! The subroutine Prof_Val returns the value of the profile function at twoth of ! a peak of centre twoth0 as well as the derivatives wrt profile parameters. ! Asymmetry due to axial divergence using the method of Finger, Cox and Jephcoat, ! J. Appl. Cryst. 27, 892, 1992. ! This version based on code provided by Finger, Cox and Jephcoat as modified ! by J Hester with a new derivative calculation method (see J. Appl. Cryst. article ! accompanying this code) and then optimised, adapted to Fortran 90 and further ! improved by J. Rodriguez-Carvajal. ! implicit none !---- List of Public Subroutines ----! public :: init_prof_val, prof_val, lorentzian, gaussian, psvoigtian !---- List of Private Functions ----! private :: dfunc_int, extra_int integer, parameter :: sp = selected_real_kind(6,30) integer, parameter :: dp = selected_real_kind(14,150) integer, parameter :: cp = sp !switch to double precision by putting cp=dp real(kind=dp), parameter :: pi = 3.141592653589793238463_dp real(kind=dp), parameter :: to_DEG = 180.0_dp/pi real(kind=dp), parameter :: to_RAD = pi/180.0_dp logical :: init_profval=.false. integer, private,dimension(14) :: nterms =(/6,10,20,40,60,80,100,150,200,300,400,600,800,1000/) integer, private,dimension(14) :: fstterm=(/0, 3, 8,18,38,68,108,158,233,333,483,683,983,1383/) real(kind=cp),private,dimension(0:1883) :: wp real(kind=cp),private,dimension(0:1883) :: xp ! ! Variables to switch to new calculations of some variables that depend ! only on (twoth0,asym1,asym2) and not on the particular point of the profile. ! When the subroutine is invoked for the same reflection some variables ! are not calculated. ! ! real(kind=cp), private, save :: twoth0_prev = 0.0_cp real(kind=cp), private, save :: asym1_prev = 0.0_cp real(kind=cp), private, save :: asym2_prev = 0.0_cp ! Fixed constants real(kind=cp), private, parameter :: pi_over_two=0.5_cp*pi real(kind=cp), private, parameter :: eps=1.0e-6_cp integer, private, parameter :: ctrl_nsteps= 1000 Contains ! ! Subroutine Init_Prof_Val() ! ! Values for the abscissas and weights of the Gauss-Legendre ! N-point quadrature formula have been precomputed using routine ! Gauleg from "Numerical Recipes" (Press, Flannery, Teukolsky ! and Vetterling, 1986, Cambridge University Press, ! ISBN 0 521 30811 9), and are stored in the assignment statements ! for XP and WP below. ! Subroutine Init_Prof_Val() xp(0)=0.0 wp(0)=0.0 xp(1:40)=(/ & 0.2386192E+00,0.6612094E+00,0.9324695E+00,0.1488743E+00,0.4333954E+00, & 0.6794096E+00,0.8650634E+00,0.9739065E+00,0.7652652E-01,0.2277859E+00, & 0.3737061E+00,0.5108670E+00,0.6360537E+00,0.7463319E+00,0.8391170E+00, & 0.9122344E+00,0.9639719E+00,0.9931286E+00,0.3877242E-01,0.1160841E+00, & 0.1926976E+00,0.2681522E+00,0.3419941E+00,0.4137792E+00,0.4830758E+00, & 0.5494671E+00,0.6125539E+00,0.6719567E+00,0.7273183E+00,0.7783057E+00, & 0.8246122E+00,0.8659595E+00,0.9020988E+00,0.9328128E+00,0.9579168E+00, & 0.9772599E+00,0.9907262E+00,0.9982377E+00,0.2595977E-01,0.7780933E-01/) xp(41:80)=(/ & 0.1294491E+00,0.1807400E+00,0.2315436E+00,0.2817229E+00,0.3311428E+00, & 0.3796701E+00,0.4271737E+00,0.4735258E+00,0.5186014E+00,0.5622789E+00, & 0.6044406E+00,0.6449728E+00,0.6837663E+00,0.7207165E+00,0.7557238E+00, & 0.7886937E+00,0.8195375E+00,0.8481720E+00,0.8745199E+00,0.8985103E+00, & 0.9200785E+00,0.9391663E+00,0.9557223E+00,0.9697018E+00,0.9810672E+00, & 0.9897879E+00,0.9958405E+00,0.9992101E+00,0.1951138E-01,0.5850444E-01, & 0.9740840E-01,0.1361640E+00,0.1747123E+00,0.2129945E+00,0.2509524E+00, & 0.2885281E+00,0.3256644E+00,0.3623048E+00,0.3983934E+00,0.4338754E+00/) xp(81:120)=(/ & 0.4686966E+00,0.5028041E+00,0.5361459E+00,0.5686713E+00,0.6003306E+00, & 0.6310758E+00,0.6608599E+00,0.6896376E+00,0.7173652E+00,0.7440003E+00, & 0.7695024E+00,0.7938327E+00,0.8169541E+00,0.8388315E+00,0.8594314E+00, & 0.8787226E+00,0.8966756E+00,0.9132631E+00,0.9284599E+00,0.9422428E+00, & 0.9545908E+00,0.9654851E+00,0.9749091E+00,0.9828486E+00,0.9892913E+00, & 0.9942275E+00,0.9976499E+00,0.9995538E+00,0.1562898E-01,0.4687168E-01, & 0.7806858E-01,0.1091892E+00,0.1402031E+00,0.1710801E+00,0.2017899E+00, & 0.2323025E+00,0.2625881E+00,0.2926172E+00,0.3223603E+00,0.3517885E+00/) xp(121:160)=(/ & 0.3808730E+00,0.4095853E+00,0.4378974E+00,0.4657816E+00,0.4932108E+00, & 0.5201580E+00,0.5465970E+00,0.5725019E+00,0.5978475E+00,0.6226089E+00, & 0.6467619E+00,0.6702830E+00,0.6931492E+00,0.7153381E+00,0.7368281E+00, & 0.7575981E+00,0.7776279E+00,0.7968979E+00,0.8153892E+00,0.8330839E+00, & 0.8499645E+00,0.8660147E+00,0.8812187E+00,0.8955616E+00,0.9090296E+00, & 0.9216093E+00,0.9332885E+00,0.9440559E+00,0.9539008E+00,0.9628137E+00, & 0.9707858E+00,0.9778094E+00,0.9838775E+00,0.9889844E+00,0.9931249E+00, & 0.9962951E+00,0.9984920E+00,0.9997137E+00,0.1043694E-01,0.3130627E-01/) xp(161:200)=(/ & 0.5216195E-01,0.7299491E-01,0.9379607E-01,0.1145563E+00,0.1352667E+00, & 0.1559181E+00,0.1765016E+00,0.1970082E+00,0.2174290E+00,0.2377550E+00, & 0.2579774E+00,0.2780874E+00,0.2980762E+00,0.3179352E+00,0.3376556E+00, & 0.3572289E+00,0.3766466E+00,0.3959001E+00,0.4149811E+00,0.4338813E+00, & 0.4525925E+00,0.4711065E+00,0.4894151E+00,0.5075106E+00,0.5253849E+00, & 0.5430303E+00,0.5604390E+00,0.5776036E+00,0.5945165E+00,0.6111703E+00, & 0.6275579E+00,0.6436720E+00,0.6595056E+00,0.6750519E+00,0.6903041E+00, & 0.7052554E+00,0.7198995E+00,0.7342299E+00,0.7482404E+00,0.7619248E+00/) xp(201:240)=(/ & 0.7752773E+00,0.7882919E+00,0.8009631E+00,0.8132853E+00,0.8252531E+00, & 0.8368613E+00,0.8481049E+00,0.8589789E+00,0.8694787E+00,0.8795996E+00, & 0.8893372E+00,0.8986874E+00,0.9076460E+00,0.9162090E+00,0.9243729E+00, & 0.9321340E+00,0.9394890E+00,0.9464346E+00,0.9529678E+00,0.9590857E+00, & 0.9647858E+00,0.9700655E+00,0.9749225E+00,0.9793548E+00,0.9833603E+00, & 0.9869373E+00,0.9900843E+00,0.9927999E+00,0.9950829E+00,0.9969323E+00, & 0.9983473E+00,0.9993274E+00,0.9998723E+00,0.7834291E-02,0.2350095E-01, & 0.3916184E-01,0.5481311E-01,0.7045093E-01,0.8607145E-01,0.1016708E+00/) xp(241:280)=(/ & 0.1172453E+00,0.1327909E+00,0.1483040E+00,0.1637806E+00,0.1792170E+00, & 0.1946095E+00,0.2099541E+00,0.2252472E+00,0.2404850E+00,0.2556638E+00, & 0.2707798E+00,0.2858293E+00,0.3008086E+00,0.3157141E+00,0.3305421E+00, & 0.3452890E+00,0.3599510E+00,0.3745247E+00,0.3890065E+00,0.4033927E+00, & 0.4176799E+00,0.4318646E+00,0.4459432E+00,0.4599124E+00,0.4737686E+00, & 0.4875086E+00,0.5011288E+00,0.5146260E+00,0.5279969E+00,0.5412382E+00, & 0.5543465E+00,0.5673188E+00,0.5801518E+00,0.5928424E+00,0.6053874E+00, & 0.6177838E+00,0.6300285E+00,0.6421185E+00,0.6540509E+00,0.6658228E+00/) xp(281:320)=(/ & 0.6774311E+00,0.6888732E+00,0.7001461E+00,0.7112472E+00,0.7221736E+00, & 0.7329227E+00,0.7434919E+00,0.7538786E+00,0.7640801E+00,0.7740941E+00, & 0.7839181E+00,0.7935496E+00,0.8029862E+00,0.8122257E+00,0.8212659E+00, & 0.8301044E+00,0.8387391E+00,0.8471679E+00,0.8553887E+00,0.8633995E+00, & 0.8711983E+00,0.8787832E+00,0.8861524E+00,0.8933041E+00,0.9002364E+00, & 0.9069477E+00,0.9134364E+00,0.9197008E+00,0.9257394E+00,0.9315507E+00, & 0.9371333E+00,0.9424859E+00,0.9476071E+00,0.9524956E+00,0.9571503E+00, & 0.9615700E+00,0.9657536E+00,0.9697002E+00,0.9734086E+00,0.9768781E+00/) xp(321:360)=(/ & 0.9801078E+00,0.9830968E+00,0.9858445E+00,0.9883502E+00,0.9906132E+00, & 0.9926330E+00,0.9944091E+00,0.9959410E+00,0.9972285E+00,0.9982712E+00, & 0.9990687E+00,0.9996210E+00,0.9999281E+00,0.5227245E-02,0.1568116E-01, & 0.2613337E-01,0.3658271E-01,0.4702806E-01,0.5746827E-01,0.6790220E-01, & 0.7832871E-01,0.8874665E-01,0.9915490E-01,0.1095523E+00,0.1199377E+00, & 0.1303101E+00,0.1406682E+00,0.1510109E+00,0.1613371E+00,0.1716456E+00, & 0.1819354E+00,0.1922054E+00,0.2024543E+00,0.2126811E+00,0.2228846E+00, & 0.2330638E+00,0.2432175E+00,0.2533446E+00,0.2634441E+00,0.2735147E+00/) xp(361:400)=(/ & 0.2835555E+00,0.2935652E+00,0.3035429E+00,0.3134874E+00,0.3233976E+00, & 0.3332725E+00,0.3431110E+00,0.3529120E+00,0.3626744E+00,0.3723971E+00, & 0.3820792E+00,0.3917194E+00,0.4013169E+00,0.4108705E+00,0.4203792E+00, & 0.4298420E+00,0.4392578E+00,0.4486255E+00,0.4579443E+00,0.4672130E+00, & 0.4764306E+00,0.4855961E+00,0.4947086E+00,0.5037670E+00,0.5127704E+00, & 0.5217177E+00,0.5306079E+00,0.5394402E+00,0.5482135E+00,0.5569269E+00, & 0.5655795E+00,0.5741702E+00,0.5826982E+00,0.5911624E+00,0.5995621E+00, & 0.6078963E+00,0.6161639E+00,0.6243643E+00,0.6324964E+00,0.6405594E+00/) xp(401:440)=(/ & 0.6485524E+00,0.6564744E+00,0.6643248E+00,0.6721025E+00,0.6798068E+00, & 0.6874367E+00,0.6949916E+00,0.7024704E+00,0.7098725E+00,0.7171970E+00, & 0.7244432E+00,0.7316101E+00,0.7386971E+00,0.7457033E+00,0.7526281E+00, & 0.7594705E+00,0.7662300E+00,0.7729057E+00,0.7794970E+00,0.7860030E+00, & 0.7924232E+00,0.7987567E+00,0.8050030E+00,0.8111612E+00,0.8172308E+00, & 0.8232111E+00,0.8291014E+00,0.8349011E+00,0.8406095E+00,0.8462260E+00, & 0.8517501E+00,0.8571811E+00,0.8625184E+00,0.8677614E+00,0.8729095E+00, & 0.8779623E+00,0.8829191E+00,0.8877794E+00,0.8925427E+00,0.8972084E+00/) xp(441:480)=(/ & 0.9017761E+00,0.9062452E+00,0.9106152E+00,0.9148857E+00,0.9190563E+00, & 0.9231263E+00,0.9270955E+00,0.9309634E+00,0.9347295E+00,0.9383934E+00, & 0.9419548E+00,0.9454132E+00,0.9487683E+00,0.9520197E+00,0.9551671E+00, & 0.9582100E+00,0.9611482E+00,0.9639814E+00,0.9667092E+00,0.9693313E+00, & 0.9718476E+00,0.9742575E+00,0.9765610E+00,0.9787578E+00,0.9808476E+00, & 0.9828302E+00,0.9847054E+00,0.9864729E+00,0.9881326E+00,0.9896844E+00, & 0.9911279E+00,0.9924632E+00,0.9936899E+00,0.9948081E+00,0.9958175E+00, & 0.9967181E+00,0.9975097E+00,0.9981923E+00,0.9987659E+00,0.9992302E+00/) xp(481:520)=(/ & 0.9995854E+00,0.9998313E+00,0.9999680E+00,0.3922075E-02,0.1176598E-01, & 0.1960917E-01,0.2745115E-01,0.3529144E-01,0.4312955E-01,0.5096502E-01, & 0.5879735E-01,0.6662606E-01,0.7445067E-01,0.8227070E-01,0.9008566E-01, & 0.9789509E-01,0.1056985E+00,0.1134954E+00,0.1212853E+00,0.1290678E+00, & 0.1368423E+00,0.1446083E+00,0.1523655E+00,0.1601134E+00,0.1678513E+00, & 0.1755790E+00,0.1832958E+00,0.1910013E+00,0.1986951E+00,0.2063767E+00, & 0.2140456E+00,0.2217013E+00,0.2293434E+00,0.2369713E+00,0.2445847E+00, & 0.2521830E+00,0.2597658E+00,0.2673327E+00,0.2748830E+00,0.2824165E+00/) xp(521:560)=(/ & 0.2899326E+00,0.2974308E+00,0.3049108E+00,0.3123719E+00,0.3198139E+00, & 0.3272362E+00,0.3346383E+00,0.3420199E+00,0.3493804E+00,0.3567194E+00, & 0.3640365E+00,0.3713311E+00,0.3786029E+00,0.3858515E+00,0.3930762E+00, & 0.4002768E+00,0.4074528E+00,0.4146037E+00,0.4217291E+00,0.4288285E+00, & 0.4359016E+00,0.4429478E+00,0.4499667E+00,0.4569580E+00,0.4639212E+00, & 0.4708558E+00,0.4777615E+00,0.4846377E+00,0.4914841E+00,0.4983003E+00, & 0.5050859E+00,0.5118403E+00,0.5185633E+00,0.5252543E+00,0.5319131E+00, & 0.5385391E+00,0.5451319E+00,0.5516912E+00,0.5582166E+00,0.5647076E+00/) xp(561:600)=(/ & 0.5711639E+00,0.5775851E+00,0.5839707E+00,0.5903203E+00,0.5966337E+00, & 0.6029103E+00,0.6091498E+00,0.6153519E+00,0.6215161E+00,0.6276420E+00, & 0.6337293E+00,0.6397777E+00,0.6457866E+00,0.6517559E+00,0.6576850E+00, & 0.6635737E+00,0.6694215E+00,0.6752281E+00,0.6809932E+00,0.6867164E+00, & 0.6923974E+00,0.6980357E+00,0.7036311E+00,0.7091832E+00,0.7146916E+00, & 0.7201561E+00,0.7255763E+00,0.7309518E+00,0.7362823E+00,0.7415676E+00, & 0.7468072E+00,0.7520008E+00,0.7571482E+00,0.7622490E+00,0.7673029E+00, & 0.7723096E+00,0.7772688E+00,0.7821801E+00,0.7870433E+00,0.7918581E+00/) xp(601:640)=(/ & 0.7966241E+00,0.8013412E+00,0.8060089E+00,0.8106271E+00,0.8151953E+00, & 0.8197134E+00,0.8241811E+00,0.8285980E+00,0.8329640E+00,0.8372787E+00, & 0.8415419E+00,0.8457533E+00,0.8499127E+00,0.8540198E+00,0.8580743E+00, & 0.8620760E+00,0.8660247E+00,0.8699201E+00,0.8737620E+00,0.8775501E+00, & 0.8812842E+00,0.8849641E+00,0.8885896E+00,0.8921603E+00,0.8956762E+00, & 0.8991369E+00,0.9025424E+00,0.9058923E+00,0.9091864E+00,0.9124246E+00, & 0.9156067E+00,0.9187324E+00,0.9218016E+00,0.9248141E+00,0.9277697E+00, & 0.9306682E+00,0.9335094E+00,0.9362932E+00,0.9390194E+00,0.9416878E+00/) xp(641:680)=(/ & 0.9442982E+00,0.9468506E+00,0.9493447E+00,0.9517803E+00,0.9541574E+00, & 0.9564759E+00,0.9587354E+00,0.9609360E+00,0.9630774E+00,0.9651596E+00, & 0.9671823E+00,0.9691456E+00,0.9710493E+00,0.9728932E+00,0.9746772E+00, & 0.9764012E+00,0.9780652E+00,0.9796690E+00,0.9812125E+00,0.9826957E+00, & 0.9841183E+00,0.9854805E+00,0.9867820E+00,0.9880227E+00,0.9892027E+00, & 0.9903218E+00,0.9913800E+00,0.9923771E+00,0.9933133E+00,0.9941882E+00, & 0.9950021E+00,0.9957547E+00,0.9964460E+00,0.9970760E+00,0.9976447E+00, & 0.9981519E+00,0.9985978E+00,0.9989822E+00,0.9993052E+00,0.9995666E+00/) xp(681:720)=(/ & 0.9997666E+00,0.9999050E+00,0.9999820E+00,0.2615810E-02,0.7847359E-02, & 0.1307869E-01,0.1830967E-01,0.2354014E-01,0.2876997E-01,0.3399902E-01, & 0.3922713E-01,0.4445417E-01,0.4967999E-01,0.5490445E-01,0.6012741E-01, & 0.6534873E-01,0.7056825E-01,0.7578585E-01,0.8100137E-01,0.8621467E-01, & 0.9142561E-01,0.9663405E-01,0.1018398E+00,0.1070429E+00,0.1122429E+00, & 0.1174399E+00,0.1226337E+00,0.1278242E+00,0.1330111E+00,0.1381944E+00, & 0.1433739E+00,0.1485495E+00,0.1537210E+00,0.1588884E+00,0.1640513E+00, & 0.1692098E+00,0.1743636E+00,0.1795127E+00,0.1846569E+00,0.1897960E+00/) xp(721:760)=(/ & 0.1949299E+00,0.2000585E+00,0.2051816E+00,0.2102991E+00,0.2154108E+00, & 0.2205166E+00,0.2256164E+00,0.2307101E+00,0.2357974E+00,0.2408782E+00, & 0.2459525E+00,0.2510200E+00,0.2560807E+00,0.2611343E+00,0.2661808E+00, & 0.2712201E+00,0.2762519E+00,0.2812761E+00,0.2862926E+00,0.2913013E+00, & 0.2963021E+00,0.3012947E+00,0.3062790E+00,0.3112550E+00,0.3162225E+00, & 0.3211813E+00,0.3261313E+00,0.3310724E+00,0.3360045E+00,0.3409273E+00, & 0.3458408E+00,0.3507449E+00,0.3556393E+00,0.3605240E+00,0.3653989E+00, & 0.3702637E+00,0.3751184E+00,0.3799629E+00,0.3847969E+00,0.3896204E+00/) xp(761:800)=(/ & 0.3944333E+00,0.3992353E+00,0.4040264E+00,0.4088065E+00,0.4135754E+00, & 0.4183329E+00,0.4230790E+00,0.4278136E+00,0.4325364E+00,0.4372474E+00, & 0.4419464E+00,0.4466333E+00,0.4513080E+00,0.4559703E+00,0.4606202E+00, & 0.4652574E+00,0.4698819E+00,0.4744936E+00,0.4790923E+00,0.4836778E+00, & 0.4882502E+00,0.4928091E+00,0.4973546E+00,0.5018864E+00,0.5064046E+00, & 0.5109088E+00,0.5153991E+00,0.5198753E+00,0.5243372E+00,0.5287848E+00, & 0.5332179E+00,0.5376364E+00,0.5420402E+00,0.5464292E+00,0.5508032E+00, & 0.5551622E+00,0.5595059E+00,0.5638343E+00,0.5681473E+00,0.5724448E+00/) xp(801:840)=(/ & 0.5767266E+00,0.5809926E+00,0.5852427E+00,0.5894768E+00,0.5936947E+00, & 0.5978964E+00,0.6020817E+00,0.6062506E+00,0.6104028E+00,0.6145384E+00, & 0.6186571E+00,0.6227589E+00,0.6268437E+00,0.6309113E+00,0.6349616E+00, & 0.6389945E+00,0.6430100E+00,0.6470079E+00,0.6509880E+00,0.6549504E+00, & 0.6588948E+00,0.6628211E+00,0.6667294E+00,0.6706194E+00,0.6744910E+00, & 0.6783442E+00,0.6821788E+00,0.6859947E+00,0.6897919E+00,0.6935702E+00, & 0.6973295E+00,0.7010697E+00,0.7047907E+00,0.7084924E+00,0.7121748E+00, & 0.7158376E+00,0.7194809E+00,0.7231044E+00,0.7267082E+00,0.7302921E+00/) xp(841:880)=(/ & 0.7338560E+00,0.7373998E+00,0.7409234E+00,0.7444268E+00,0.7479097E+00, & 0.7513722E+00,0.7548142E+00,0.7582355E+00,0.7616360E+00,0.7650157E+00, & 0.7683744E+00,0.7717121E+00,0.7750287E+00,0.7783241E+00,0.7815982E+00, & 0.7848508E+00,0.7880821E+00,0.7912917E+00,0.7944797E+00,0.7976459E+00, & 0.8007903E+00,0.8039128E+00,0.8070132E+00,0.8100916E+00,0.8131479E+00, & 0.8161818E+00,0.8191934E+00,0.8221826E+00,0.8251493E+00,0.8280935E+00, & 0.8310149E+00,0.8339136E+00,0.8367895E+00,0.8396425E+00,0.8424725E+00, & 0.8452794E+00,0.8480632E+00,0.8508238E+00,0.8535611E+00,0.8562750E+00/) xp(881:920)=(/ & 0.8589656E+00,0.8616325E+00,0.8642760E+00,0.8668957E+00,0.8694918E+00, & 0.8720640E+00,0.8746124E+00,0.8771368E+00,0.8796372E+00,0.8821136E+00, & 0.8845658E+00,0.8869937E+00,0.8893975E+00,0.8917768E+00,0.8941318E+00, & 0.8964623E+00,0.8987683E+00,0.9010496E+00,0.9033063E+00,0.9055383E+00, & 0.9077455E+00,0.9099278E+00,0.9120852E+00,0.9142177E+00,0.9163252E+00, & 0.9184075E+00,0.9204648E+00,0.9224968E+00,0.9245036E+00,0.9264851E+00, & 0.9284412E+00,0.9303720E+00,0.9322772E+00,0.9341570E+00,0.9360111E+00, & 0.9378397E+00,0.9396426E+00,0.9414198E+00,0.9431712E+00,0.9448967E+00/) xp(921:960)=(/ & 0.9465965E+00,0.9482703E+00,0.9499181E+00,0.9515400E+00,0.9531358E+00, & 0.9547056E+00,0.9562492E+00,0.9577666E+00,0.9592578E+00,0.9607228E+00, & 0.9621615E+00,0.9635738E+00,0.9649597E+00,0.9663193E+00,0.9676524E+00, & 0.9689590E+00,0.9702391E+00,0.9714927E+00,0.9727196E+00,0.9739199E+00, & 0.9750936E+00,0.9762406E+00,0.9773609E+00,0.9784544E+00,0.9795211E+00, & 0.9805610E+00,0.9815741E+00,0.9825603E+00,0.9835197E+00,0.9844521E+00, & 0.9853575E+00,0.9862360E+00,0.9870876E+00,0.9879120E+00,0.9887095E+00, & 0.9894799E+00,0.9902232E+00,0.9909394E+00,0.9916285E+00,0.9922904E+00/) xp(961:1000)=(/ & 0.9929252E+00,0.9935328E+00,0.9941132E+00,0.9946664E+00,0.9951924E+00, & 0.9956911E+00,0.9961626E+00,0.9966068E+00,0.9970238E+00,0.9974135E+00, & 0.9977758E+00,0.9981109E+00,0.9984186E+00,0.9986990E+00,0.9989521E+00, & 0.9991778E+00,0.9993762E+00,0.9995472E+00,0.9996909E+00,0.9998072E+00, & 0.9998962E+00,0.9999577E+00,0.9999920E+00,0.1962267E-02,0.5886772E-02, & 0.9811186E-02,0.1373545E-01,0.1765950E-01,0.2158328E-01,0.2550673E-01, & 0.2942978E-01,0.3335238E-01,0.3727447E-01,0.4119598E-01,0.4511686E-01, & 0.4903704E-01,0.5295647E-01,0.5687508E-01,0.6079282E-01,0.6470962E-01/) xp(1001:1040)=(/ & 0.6862542E-01,0.7254017E-01,0.7645380E-01,0.8036625E-01,0.8427746E-01, & 0.8818738E-01,0.9209594E-01,0.9600308E-01,0.9990874E-01,0.1038129E+00, & 0.1077154E+00,0.1116162E+00,0.1155154E+00,0.1194128E+00,0.1233083E+00, & 0.1272019E+00,0.1310936E+00,0.1349832E+00,0.1388708E+00,0.1427562E+00, & 0.1466395E+00,0.1505204E+00,0.1543991E+00,0.1582754E+00,0.1621492E+00, & 0.1660205E+00,0.1698893E+00,0.1737555E+00,0.1776190E+00,0.1814798E+00, & 0.1853377E+00,0.1891928E+00,0.1930450E+00,0.1968942E+00,0.2007404E+00, & 0.2045835E+00,0.2084235E+00,0.2122602E+00,0.2160937E+00,0.2199238E+00/) xp(1041:1080)=(/ & 0.2237505E+00,0.2275738E+00,0.2313936E+00,0.2352099E+00,0.2390225E+00, & 0.2428314E+00,0.2466366E+00,0.2504380E+00,0.2542355E+00,0.2580292E+00, & 0.2618188E+00,0.2656044E+00,0.2693859E+00,0.2731633E+00,0.2769365E+00, & 0.2807054E+00,0.2844699E+00,0.2882301E+00,0.2919859E+00,0.2957372E+00, & 0.2994839E+00,0.3032259E+00,0.3069634E+00,0.3106961E+00,0.3144240E+00, & 0.3181470E+00,0.3218652E+00,0.3255784E+00,0.3292866E+00,0.3329897E+00, & 0.3366877E+00,0.3403805E+00,0.3440681E+00,0.3477503E+00,0.3514272E+00, & 0.3550987E+00,0.3587648E+00,0.3624253E+00,0.3660802E+00,0.3697295E+00/) xp(1081:1120)=(/ & 0.3733731E+00,0.3770109E+00,0.3806429E+00,0.3842691E+00,0.3878893E+00, & 0.3915036E+00,0.3951118E+00,0.3987140E+00,0.4023100E+00,0.4058998E+00, & 0.4094834E+00,0.4130607E+00,0.4166316E+00,0.4201960E+00,0.4237541E+00, & 0.4273055E+00,0.4308504E+00,0.4343887E+00,0.4379203E+00,0.4414451E+00, & 0.4449632E+00,0.4484743E+00,0.4519786E+00,0.4554759E+00,0.4589662E+00, & 0.4624494E+00,0.4659255E+00,0.4693945E+00,0.4728562E+00,0.4763106E+00, & 0.4797577E+00,0.4831973E+00,0.4866296E+00,0.4900543E+00,0.4934715E+00, & 0.4968812E+00,0.5002831E+00,0.5036774E+00,0.5070638E+00,0.5104425E+00/) xp(1121:1160)=(/ & 0.5138133E+00,0.5171762E+00,0.5205312E+00,0.5238781E+00,0.5272169E+00, & 0.5305477E+00,0.5338702E+00,0.5371846E+00,0.5404906E+00,0.5437884E+00, & 0.5470777E+00,0.5503587E+00,0.5536311E+00,0.5568951E+00,0.5601504E+00, & 0.5633972E+00,0.5666352E+00,0.5698645E+00,0.5730851E+00,0.5762968E+00, & 0.5794996E+00,0.5826936E+00,0.5858785E+00,0.5890544E+00,0.5922213E+00, & 0.5953790E+00,0.5985276E+00,0.6016669E+00,0.6047970E+00,0.6079177E+00, & 0.6110291E+00,0.6141311E+00,0.6172236E+00,0.6203066E+00,0.6233801E+00, & 0.6264440E+00,0.6294982E+00,0.6325427E+00,0.6355775E+00,0.6386024E+00/) xp(1161:1200)=(/ & 0.6416176E+00,0.6446229E+00,0.6476182E+00,0.6506036E+00,0.6535789E+00, & 0.6565442E+00,0.6594994E+00,0.6624444E+00,0.6653792E+00,0.6683037E+00, & 0.6712180E+00,0.6741219E+00,0.6770155E+00,0.6798986E+00,0.6827712E+00, & 0.6856333E+00,0.6884849E+00,0.6913259E+00,0.6941562E+00,0.6969758E+00, & 0.6997847E+00,0.7025828E+00,0.7053701E+00,0.7081465E+00,0.7109120E+00, & 0.7136666E+00,0.7164102E+00,0.7191427E+00,0.7218642E+00,0.7245746E+00, & 0.7272737E+00,0.7299617E+00,0.7326385E+00,0.7353039E+00,0.7379581E+00, & 0.7406008E+00,0.7432322E+00,0.7458521E+00,0.7484606E+00,0.7510575E+00/) xp(1201:1240)=(/ & 0.7536428E+00,0.7562165E+00,0.7587786E+00,0.7613290E+00,0.7638676E+00, & 0.7663945E+00,0.7689096E+00,0.7714129E+00,0.7739043E+00,0.7763837E+00, & 0.7788512E+00,0.7813067E+00,0.7837502E+00,0.7861816E+00,0.7886009E+00, & 0.7910080E+00,0.7934030E+00,0.7957857E+00,0.7981562E+00,0.8005144E+00, & 0.8028602E+00,0.8051937E+00,0.8075148E+00,0.8098234E+00,0.8121196E+00, & 0.8144033E+00,0.8166744E+00,0.8189330E+00,0.8211789E+00,0.8234122E+00, & 0.8256328E+00,0.8278407E+00,0.8300358E+00,0.8322182E+00,0.8343877E+00, & 0.8365444E+00,0.8386882E+00,0.8408191E+00,0.8429370E+00,0.8450420E+00/) xp(1241:1280)=(/ & 0.8471339E+00,0.8492128E+00,0.8512786E+00,0.8533313E+00,0.8553709E+00, & 0.8573972E+00,0.8594104E+00,0.8614104E+00,0.8633970E+00,0.8653704E+00, & 0.8673304E+00,0.8692771E+00,0.8712104E+00,0.8731303E+00,0.8750367E+00, & 0.8769297E+00,0.8788091E+00,0.8806750E+00,0.8825274E+00,0.8843662E+00, & 0.8861913E+00,0.8880028E+00,0.8898006E+00,0.8915847E+00,0.8933550E+00, & 0.8951117E+00,0.8968545E+00,0.8985835E+00,0.9002987E+00,0.9020000E+00, & 0.9036874E+00,0.9053609E+00,0.9070204E+00,0.9086660E+00,0.9102976E+00, & 0.9119152E+00,0.9135187E+00,0.9151081E+00,0.9166835E+00,0.9182447E+00/) xp(1281:1320)=(/ & 0.9197918E+00,0.9213247E+00,0.9228435E+00,0.9243480E+00,0.9258383E+00, & 0.9273143E+00,0.9287760E+00,0.9302235E+00,0.9316566E+00,0.9330754E+00, & 0.9344797E+00,0.9358697E+00,0.9372453E+00,0.9386065E+00,0.9399532E+00, & 0.9412854E+00,0.9426031E+00,0.9439063E+00,0.9451950E+00,0.9464691E+00, & 0.9477286E+00,0.9489735E+00,0.9502038E+00,0.9514195E+00,0.9526205E+00, & 0.9538069E+00,0.9549785E+00,0.9561355E+00,0.9572777E+00,0.9584052E+00, & 0.9595179E+00,0.9606159E+00,0.9616990E+00,0.9627673E+00,0.9638208E+00, & 0.9648595E+00,0.9658833E+00,0.9668922E+00,0.9678863E+00,0.9688654E+00/) xp(1321:1360)=(/ & 0.9698296E+00,0.9707788E+00,0.9717132E+00,0.9726325E+00,0.9735369E+00, & 0.9744262E+00,0.9753006E+00,0.9761600E+00,0.9770043E+00,0.9778335E+00, & 0.9786477E+00,0.9794468E+00,0.9802309E+00,0.9809998E+00,0.9817537E+00, & 0.9824924E+00,0.9832160E+00,0.9839244E+00,0.9846177E+00,0.9852958E+00, & 0.9859587E+00,0.9866065E+00,0.9872390E+00,0.9878564E+00,0.9884585E+00, & 0.9890455E+00,0.9896171E+00,0.9901736E+00,0.9907148E+00,0.9912407E+00, & 0.9917514E+00,0.9922468E+00,0.9927269E+00,0.9931917E+00,0.9936412E+00, & 0.9940754E+00,0.9944943E+00,0.9948979E+00,0.9952862E+00,0.9956591E+00/) xp(1361:1400)=(/ & 0.9960167E+00,0.9963590E+00,0.9966859E+00,0.9969974E+00,0.9972936E+00, & 0.9975745E+00,0.9978400E+00,0.9980901E+00,0.9983248E+00,0.9985442E+00, & 0.9987482E+00,0.9989368E+00,0.9991100E+00,0.9992678E+00,0.9994103E+00, & 0.9995373E+00,0.9996489E+00,0.9997452E+00,0.9998261E+00,0.9998915E+00, & 0.9999416E+00,0.9999762E+00,0.9999955E+00,0.1570010E-02,0.4710016E-02, & 0.7849975E-02,0.1098986E-01,0.1412963E-01,0.1726926E-01,0.2040873E-01, & 0.2354799E-01,0.2668702E-01,0.2982579E-01,0.3296426E-01,0.3610241E-01, & 0.3924020E-01,0.4237761E-01,0.4551459E-01,0.4865113E-01,0.5178719E-01/) xp(1401:1440)=(/ & 0.5492274E-01,0.5805775E-01,0.6119218E-01,0.6432601E-01,0.6745921E-01, & 0.7059174E-01,0.7372358E-01,0.7685468E-01,0.7998504E-01,0.8311460E-01, & 0.8624334E-01,0.8937123E-01,0.9249824E-01,0.9562434E-01,0.9874950E-01, & 0.1018737E+00,0.1049969E+00,0.1081190E+00,0.1112401E+00,0.1143601E+00, & 0.1174789E+00,0.1205966E+00,0.1237131E+00,0.1268284E+00,0.1299424E+00, & 0.1330552E+00,0.1361666E+00,0.1392767E+00,0.1423855E+00,0.1454928E+00, & 0.1485987E+00,0.1517031E+00,0.1548060E+00,0.1579074E+00,0.1610073E+00, & 0.1641055E+00,0.1672022E+00,0.1702971E+00,0.1733905E+00,0.1764821E+00/) xp(1441:1480)=(/ & 0.1795719E+00,0.1826600E+00,0.1857463E+00,0.1888308E+00,0.1919134E+00, & 0.1949941E+00,0.1980728E+00,0.2011497E+00,0.2042245E+00,0.2072973E+00, & 0.2103681E+00,0.2134368E+00,0.2165035E+00,0.2195679E+00,0.2226302E+00, & 0.2256904E+00,0.2287482E+00,0.2318039E+00,0.2348572E+00,0.2379083E+00, & 0.2409569E+00,0.2440033E+00,0.2470472E+00,0.2500886E+00,0.2531276E+00, & 0.2561641E+00,0.2591981E+00,0.2622295E+00,0.2652584E+00,0.2682846E+00, & 0.2713082E+00,0.2743291E+00,0.2773473E+00,0.2803628E+00,0.2833755E+00, & 0.2863854E+00,0.2893925E+00,0.2923967E+00,0.2953980E+00,0.2983965E+00/) xp(1481:1520)=(/ & 0.3013920E+00,0.3043845E+00,0.3073740E+00,0.3103605E+00,0.3133439E+00, & 0.3163243E+00,0.3193015E+00,0.3222756E+00,0.3252465E+00,0.3282141E+00, & 0.3311786E+00,0.3341398E+00,0.3370977E+00,0.3400522E+00,0.3430035E+00, & 0.3459513E+00,0.3488957E+00,0.3518367E+00,0.3547742E+00,0.3577082E+00, & 0.3606387E+00,0.3635657E+00,0.3664890E+00,0.3694087E+00,0.3723248E+00, & 0.3752373E+00,0.3781460E+00,0.3810510E+00,0.3839522E+00,0.3868497E+00, & 0.3897433E+00,0.3926331E+00,0.3955190E+00,0.3984010E+00,0.4012791E+00, & 0.4041533E+00,0.4070234E+00,0.4098896E+00,0.4127517E+00,0.4156097E+00/) xp(1521:1560)=(/ & 0.4184636E+00,0.4213134E+00,0.4241591E+00,0.4270006E+00,0.4298378E+00, & 0.4326708E+00,0.4354996E+00,0.4383241E+00,0.4411442E+00,0.4439600E+00, & 0.4467714E+00,0.4495784E+00,0.4523810E+00,0.4551791E+00,0.4579727E+00, & 0.4607618E+00,0.4635464E+00,0.4663264E+00,0.4691018E+00,0.4718726E+00, & 0.4746387E+00,0.4774001E+00,0.4801569E+00,0.4829089E+00,0.4856561E+00, & 0.4883986E+00,0.4911362E+00,0.4938690E+00,0.4965969E+00,0.4993199E+00, & 0.5020381E+00,0.5047512E+00,0.5074594E+00,0.5101626E+00,0.5128607E+00, & 0.5155538E+00,0.5182418E+00,0.5209247E+00,0.5236025E+00,0.5262750E+00/) xp(1561:1600)=(/ & 0.5289425E+00,0.5316046E+00,0.5342616E+00,0.5369133E+00,0.5395597E+00, & 0.5422007E+00,0.5448365E+00,0.5474668E+00,0.5500918E+00,0.5527113E+00, & 0.5553254E+00,0.5579340E+00,0.5605371E+00,0.5631347E+00,0.5657267E+00, & 0.5683131E+00,0.5708940E+00,0.5734692E+00,0.5760387E+00,0.5786026E+00, & 0.5811608E+00,0.5837132E+00,0.5862599E+00,0.5888008E+00,0.5913360E+00, & 0.5938652E+00,0.5963886E+00,0.5989062E+00,0.6014178E+00,0.6039235E+00, & 0.6064233E+00,0.6089170E+00,0.6114048E+00,0.6138865E+00,0.6163622E+00, & 0.6188318E+00,0.6212953E+00,0.6237527E+00,0.6262040E+00,0.6286490E+00/) xp(1601:1640)=(/ & 0.6310879E+00,0.6335205E+00,0.6359469E+00,0.6383670E+00,0.6407808E+00, & 0.6431883E+00,0.6455895E+00,0.6479843E+00,0.6503727E+00,0.6527547E+00, & 0.6551303E+00,0.6574994E+00,0.6598620E+00,0.6622181E+00,0.6645677E+00, & 0.6669107E+00,0.6692472E+00,0.6715770E+00,0.6739003E+00,0.6762169E+00, & 0.6785268E+00,0.6808300E+00,0.6831266E+00,0.6854163E+00,0.6876994E+00, & 0.6899756E+00,0.6922451E+00,0.6945077E+00,0.6967635E+00,0.6990124E+00, & 0.7012544E+00,0.7034895E+00,0.7057176E+00,0.7079388E+00,0.7101530E+00, & 0.7123603E+00,0.7145605E+00,0.7167536E+00,0.7189397E+00,0.7211187E+00/) xp(1641:1680)=(/ & 0.7232906E+00,0.7254553E+00,0.7276129E+00,0.7297634E+00,0.7319066E+00, & 0.7340426E+00,0.7361714E+00,0.7382929E+00,0.7404071E+00,0.7425141E+00, & 0.7446137E+00,0.7467060E+00,0.7487909E+00,0.7508684E+00,0.7529385E+00, & 0.7550013E+00,0.7570565E+00,0.7591043E+00,0.7611446E+00,0.7631774E+00, & 0.7652027E+00,0.7672204E+00,0.7692306E+00,0.7712332E+00,0.7732282E+00, & 0.7752155E+00,0.7771953E+00,0.7791673E+00,0.7811317E+00,0.7830884E+00, & 0.7850373E+00,0.7869785E+00,0.7889120E+00,0.7908376E+00,0.7927555E+00, & 0.7946656E+00,0.7965678E+00,0.7984622E+00,0.8003486E+00,0.8022273E+00/) xp(1681:1720)=(/ & 0.8040979E+00,0.8059607E+00,0.8078155E+00,0.8096624E+00,0.8115013E+00, & 0.8133321E+00,0.8151550E+00,0.8169698E+00,0.8187765E+00,0.8205752E+00, & 0.8223658E+00,0.8241483E+00,0.8259227E+00,0.8276889E+00,0.8294470E+00, & 0.8311968E+00,0.8329385E+00,0.8346720E+00,0.8363972E+00,0.8381142E+00, & 0.8398229E+00,0.8415234E+00,0.8432156E+00,0.8448994E+00,0.8465749E+00, & 0.8482421E+00,0.8499009E+00,0.8515513E+00,0.8531933E+00,0.8548269E+00, & 0.8564521E+00,0.8580688E+00,0.8596771E+00,0.8612769E+00,0.8628682E+00, & 0.8644510E+00,0.8660253E+00,0.8675910E+00,0.8691482E+00,0.8706968E+00/) xp(1721:1760)=(/ & 0.8722369E+00,0.8737683E+00,0.8752911E+00,0.8768053E+00,0.8783108E+00, & 0.8798077E+00,0.8812959E+00,0.8827754E+00,0.8842463E+00,0.8857083E+00, & 0.8871617E+00,0.8886063E+00,0.8900422E+00,0.8914692E+00,0.8928875E+00, & 0.8942970E+00,0.8956977E+00,0.8970895E+00,0.8984725E+00,0.8998466E+00, & 0.9012119E+00,0.9025683E+00,0.9039157E+00,0.9052543E+00,0.9065839E+00, & 0.9079046E+00,0.9092164E+00,0.9105192E+00,0.9118130E+00,0.9130978E+00, & 0.9143736E+00,0.9156404E+00,0.9168982E+00,0.9181469E+00,0.9193866E+00, & 0.9206172E+00,0.9218387E+00,0.9230511E+00,0.9242545E+00,0.9254487E+00/) xp(1761:1800)=(/ & 0.9266338E+00,0.9278098E+00,0.9289766E+00,0.9301343E+00,0.9312828E+00, & 0.9324221E+00,0.9335522E+00,0.9346731E+00,0.9357848E+00,0.9368872E+00, & 0.9379805E+00,0.9390645E+00,0.9401392E+00,0.9412046E+00,0.9422608E+00, & 0.9433077E+00,0.9443453E+00,0.9453735E+00,0.9463925E+00,0.9474021E+00, & 0.9484024E+00,0.9493933E+00,0.9503749E+00,0.9513471E+00,0.9523099E+00, & 0.9532633E+00,0.9542073E+00,0.9551420E+00,0.9560672E+00,0.9569829E+00, & 0.9578893E+00,0.9587862E+00,0.9596736E+00,0.9605516E+00,0.9614201E+00, & 0.9622791E+00,0.9631287E+00,0.9639687E+00,0.9647992E+00,0.9656203E+00/) xp(1801:1840)=(/ & 0.9664318E+00,0.9672338E+00,0.9680262E+00,0.9688091E+00,0.9695824E+00, & 0.9703462E+00,0.9711004E+00,0.9718451E+00,0.9725801E+00,0.9733056E+00, & 0.9740215E+00,0.9747278E+00,0.9754244E+00,0.9761115E+00,0.9767889E+00, & 0.9774567E+00,0.9781148E+00,0.9787633E+00,0.9794022E+00,0.9800314E+00, & 0.9806509E+00,0.9812608E+00,0.9818610E+00,0.9824515E+00,0.9830323E+00, & 0.9836035E+00,0.9841649E+00,0.9847166E+00,0.9852586E+00,0.9857909E+00, & 0.9863135E+00,0.9868264E+00,0.9873295E+00,0.9878229E+00,0.9883066E+00, & 0.9887805E+00,0.9892447E+00,0.9896991E+00,0.9901437E+00,0.9905786E+00/) xp(1841:1883)=(/ & 0.9910037E+00,0.9914191E+00,0.9918247E+00,0.9922205E+00,0.9926065E+00, & 0.9929827E+00,0.9933492E+00,0.9937058E+00,0.9940527E+00,0.9943897E+00, & 0.9947169E+00,0.9950344E+00,0.9953420E+00,0.9956398E+00,0.9959278E+00, & 0.9962060E+00,0.9964743E+00,0.9967328E+00,0.9969815E+00,0.9972204E+00, & 0.9974494E+00,0.9976686E+00,0.9978780E+00,0.9980775E+00,0.9982672E+00, & 0.9984471E+00,0.9986171E+00,0.9987772E+00,0.9989275E+00,0.9990680E+00, & 0.9991986E+00,0.9993193E+00,0.9994302E+00,0.9995313E+00,0.9996225E+00, & 0.9997038E+00,0.9997753E+00,0.9998369E+00,0.9998886E+00,0.9999306E+00, & 0.9999626E+00,0.9999848E+00,0.9999971E+00/) wp(1:40)=(/ & 0.4679139E+00,0.3607616E+00,0.1713245E+00,0.2955242E+00,0.2692667E+00, & 0.2190864E+00,0.1494513E+00,0.6667134E-01,0.1527534E+00,0.1491730E+00, & 0.1420961E+00,0.1316886E+00,0.1181945E+00,0.1019301E+00,0.8327674E-01, & 0.6267205E-01,0.4060143E-01,0.1761401E-01,0.7750595E-01,0.7703982E-01, & 0.7611036E-01,0.7472317E-01,0.7288658E-01,0.7061165E-01,0.6791205E-01, & 0.6480401E-01,0.6130624E-01,0.5743977E-01,0.5322785E-01,0.4869581E-01, & 0.4387091E-01,0.3878217E-01,0.3346020E-01,0.2793701E-01,0.2224585E-01, & 0.1642106E-01,0.1049828E-01,0.4521277E-02,0.5190788E-01,0.5176794E-01/) wp(41:80)=(/ & 0.5148845E-01,0.5107016E-01,0.5051418E-01,0.4982204E-01,0.4899558E-01, & 0.4803703E-01,0.4694899E-01,0.4573438E-01,0.4439648E-01,0.4293889E-01, & 0.4136555E-01,0.3968070E-01,0.3788887E-01,0.3599490E-01,0.3400389E-01, & 0.3192122E-01,0.2975249E-01,0.2750356E-01,0.2518048E-01,0.2278952E-01, & 0.2033712E-01,0.1782990E-01,0.1527462E-01,0.1267817E-01,0.1004756E-01, & 0.7389931E-02,0.4712730E-02,0.2026812E-02,0.3901781E-01,0.3895840E-01, & 0.3883965E-01,0.3866176E-01,0.3842499E-01,0.3812971E-01,0.3777636E-01, & 0.3736549E-01,0.3689771E-01,0.3637375E-01,0.3579439E-01,0.3516053E-01/) wp(81:120)=(/ & 0.3447312E-01,0.3373321E-01,0.3294194E-01,0.3210050E-01,0.3121017E-01, & 0.3027232E-01,0.2928837E-01,0.2825982E-01,0.2718823E-01,0.2607524E-01, & 0.2492254E-01,0.2373188E-01,0.2250509E-01,0.2124403E-01,0.1995061E-01, & 0.1862681E-01,0.1727465E-01,0.1589618E-01,0.1449351E-01,0.1306876E-01, & 0.1162411E-01,0.1016177E-01,0.8683945E-02,0.7192905E-02,0.5690922E-02, & 0.4180313E-02,0.2663534E-02,0.1144950E-02,0.3125542E-01,0.3122488E-01, & 0.3116384E-01,0.3107234E-01,0.3095048E-01,0.3079838E-01,0.3061619E-01, & 0.3040408E-01,0.3016227E-01,0.2989098E-01,0.2959049E-01,0.2926108E-01/) wp(121:160)=(/ & 0.2890309E-01,0.2851685E-01,0.2810276E-01,0.2766120E-01,0.2719261E-01, & 0.2669746E-01,0.2617622E-01,0.2562940E-01,0.2505754E-01,0.2446120E-01, & 0.2384096E-01,0.2319742E-01,0.2253122E-01,0.2184300E-01,0.2113344E-01, & 0.2040323E-01,0.1965309E-01,0.1888374E-01,0.1809594E-01,0.1729046E-01, & 0.1646809E-01,0.1562962E-01,0.1477588E-01,0.1390771E-01,0.1302595E-01, & 0.1213146E-01,0.1122511E-01,0.1030780E-01,0.9380420E-02,0.8443871E-02, & 0.7499073E-02,0.6546948E-02,0.5588428E-02,0.4624450E-02,0.3655961E-02, & 0.2683925E-02,0.1709393E-02,0.7346345E-03,0.2087312E-01,0.2086402E-01/) wp(161:200)=(/ & 0.2084584E-01,0.2081857E-01,0.2078223E-01,0.2073683E-01,0.2068240E-01, & 0.2061896E-01,0.2054653E-01,0.2046515E-01,0.2037486E-01,0.2027568E-01, & 0.2016767E-01,0.2005088E-01,0.1992534E-01,0.1979113E-01,0.1964829E-01, & 0.1949689E-01,0.1933700E-01,0.1916867E-01,0.1899200E-01,0.1880705E-01, & 0.1861391E-01,0.1841266E-01,0.1820338E-01,0.1798617E-01,0.1776113E-01, & 0.1752835E-01,0.1728792E-01,0.1703997E-01,0.1678459E-01,0.1652190E-01, & 0.1625201E-01,0.1597504E-01,0.1569110E-01,0.1540033E-01,0.1510285E-01, & 0.1479879E-01,0.1448828E-01,0.1417146E-01,0.1384846E-01,0.1351943E-01/) wp(201:240)=(/ & 0.1318451E-01,0.1284384E-01,0.1249758E-01,0.1214587E-01,0.1178887E-01, & 0.1142673E-01,0.1105962E-01,0.1068768E-01,0.1031109E-01,0.9930004E-02, & 0.9544593E-02,0.9155022E-02,0.8761463E-02,0.8364086E-02,0.7963064E-02, & 0.7558573E-02,0.7150788E-02,0.6739888E-02,0.6326051E-02,0.5909457E-02, & 0.5490289E-02,0.5068728E-02,0.4644959E-02,0.4219166E-02,0.3791535E-02, & 0.3362252E-02,0.2931504E-02,0.2499479E-02,0.2066366E-02,0.1632357E-02, & 0.1197647E-02,0.7624721E-03,0.3276087E-03,0.1566826E-01,0.1566442E-01, & 0.1565672E-01,0.1564519E-01,0.1562981E-01,0.1561059E-01,0.1558755E-01/) wp(241:280)=(/ & 0.1556067E-01,0.1552998E-01,0.1549547E-01,0.1545716E-01,0.1541506E-01, & 0.1536917E-01,0.1531950E-01,0.1526608E-01,0.1520891E-01,0.1514800E-01, & 0.1508338E-01,0.1501505E-01,0.1494303E-01,0.1486735E-01,0.1478802E-01, & 0.1470505E-01,0.1461848E-01,0.1452832E-01,0.1443459E-01,0.1433731E-01, & 0.1423652E-01,0.1413223E-01,0.1402447E-01,0.1391327E-01,0.1379866E-01, & 0.1368065E-01,0.1355929E-01,0.1343460E-01,0.1330661E-01,0.1317535E-01, & 0.1304086E-01,0.1290316E-01,0.1276230E-01,0.1261831E-01,0.1247122E-01, & 0.1232106E-01,0.1216788E-01,0.1201172E-01,0.1185260E-01,0.1169058E-01/) wp(281:320)=(/ & 0.1152568E-01,0.1135796E-01,0.1118744E-01,0.1101418E-01,0.1083822E-01, & 0.1065959E-01,0.1047835E-01,0.1029454E-01,0.1010820E-01,0.9919373E-02, & 0.9728115E-02,0.9534468E-02,0.9338480E-02,0.9140200E-02,0.8939676E-02, & 0.8736957E-02,0.8532093E-02,0.8325134E-02,0.8116132E-02,0.7905137E-02, & 0.7692201E-02,0.7477377E-02,0.7260717E-02,0.7042274E-02,0.6822103E-02, & 0.6600256E-02,0.6376790E-02,0.6151757E-02,0.5925215E-02,0.5697218E-02, & 0.5467822E-02,0.5237083E-02,0.5005059E-02,0.4771806E-02,0.4537382E-02, & 0.4301844E-02,0.4065249E-02,0.3827657E-02,0.3589125E-02,0.3349711E-02/) wp(321:360)=(/ & 0.3109476E-02,0.2868477E-02,0.2626773E-02,0.2384425E-02,0.2141492E-02, & 0.1898033E-02,0.1654108E-02,0.1409777E-02,0.1165101E-02,0.9201405E-03, & 0.6749606E-03,0.4296466E-03,0.1845901E-03,0.1045439E-01,0.1045325E-01, & 0.1045097E-01,0.1044754E-01,0.1044297E-01,0.1043726E-01,0.1043041E-01, & 0.1042242E-01,0.1041329E-01,0.1040302E-01,0.1039161E-01,0.1037907E-01, & 0.1036539E-01,0.1035058E-01,0.1033464E-01,0.1031758E-01,0.1029938E-01, & 0.1028006E-01,0.1025961E-01,0.1023804E-01,0.1021535E-01,0.1019155E-01, & 0.1016663E-01,0.1014060E-01,0.1011347E-01,0.1008523E-01,0.1005588E-01/) wp(361:400)=(/ & 0.1002544E-01,0.9993899E-02,0.9961267E-02,0.9927547E-02,0.9892741E-02, & 0.9856855E-02,0.9819891E-02,0.9781854E-02,0.9742747E-02,0.9702576E-02, & 0.9661345E-02,0.9619057E-02,0.9575718E-02,0.9531333E-02,0.9485905E-02, & 0.9439441E-02,0.9391946E-02,0.9343424E-02,0.9293880E-02,0.9243321E-02, & 0.9191751E-02,0.9139177E-02,0.9085604E-02,0.9031038E-02,0.8975485E-02, & 0.8918951E-02,0.8861442E-02,0.8802965E-02,0.8743525E-02,0.8683130E-02, & 0.8621786E-02,0.8559499E-02,0.8496277E-02,0.8432127E-02,0.8367054E-02, & 0.8301068E-02,0.8234174E-02,0.8166380E-02,0.8097693E-02,0.8028121E-02/) wp(401:440)=(/ & 0.7957672E-02,0.7886353E-02,0.7814173E-02,0.7741138E-02,0.7667257E-02, & 0.7592538E-02,0.7516989E-02,0.7440619E-02,0.7363435E-02,0.7285447E-02, & 0.7206662E-02,0.7127090E-02,0.7046739E-02,0.6965617E-02,0.6883734E-02, & 0.6801099E-02,0.6717721E-02,0.6633608E-02,0.6548770E-02,0.6463217E-02, & 0.6376957E-02,0.6290000E-02,0.6202356E-02,0.6114033E-02,0.6025043E-02, & 0.5935394E-02,0.5845096E-02,0.5754159E-02,0.5662594E-02,0.5570409E-02, & 0.5477616E-02,0.5384224E-02,0.5290244E-02,0.5195685E-02,0.5100559E-02, & 0.5004875E-02,0.4908644E-02,0.4811876E-02,0.4714583E-02,0.4616774E-02/) wp(441:480)=(/ & 0.4518461E-02,0.4419654E-02,0.4320364E-02,0.4220601E-02,0.4120378E-02, & 0.4019704E-02,0.3918590E-02,0.3817049E-02,0.3715090E-02,0.3612725E-02, & 0.3509965E-02,0.3406822E-02,0.3303306E-02,0.3199429E-02,0.3095203E-02, & 0.2990638E-02,0.2885746E-02,0.2780539E-02,0.2675029E-02,0.2569225E-02, & 0.2463141E-02,0.2356788E-02,0.2250177E-02,0.2143320E-02,0.2036229E-02, & 0.1928915E-02,0.1821391E-02,0.1713667E-02,0.1605756E-02,0.1497670E-02, & 0.1389420E-02,0.1281018E-02,0.1172476E-02,0.1063806E-02,0.9550200E-03, & 0.8461294E-03,0.7371464E-03,0.6280830E-03,0.5189512E-03,0.4097636E-03/) wp(481:520)=(/ & 0.3005340E-03,0.1912855E-03,0.8217779E-04,0.7844110E-02,0.7843627E-02, & 0.7842662E-02,0.7841214E-02,0.7839284E-02,0.7836871E-02,0.7833976E-02, & 0.7830599E-02,0.7826741E-02,0.7822400E-02,0.7817579E-02,0.7812276E-02, & 0.7806493E-02,0.7800229E-02,0.7793485E-02,0.7786262E-02,0.7778560E-02, & 0.7770379E-02,0.7761720E-02,0.7752583E-02,0.7742970E-02,0.7732880E-02, & 0.7722314E-02,0.7711273E-02,0.7699757E-02,0.7687768E-02,0.7675306E-02, & 0.7662371E-02,0.7648965E-02,0.7635088E-02,0.7620742E-02,0.7605926E-02, & 0.7590643E-02,0.7574892E-02,0.7558676E-02,0.7541994E-02,0.7524848E-02/) wp(521:560)=(/ & 0.7507240E-02,0.7489169E-02,0.7470638E-02,0.7451646E-02,0.7432197E-02, & 0.7412290E-02,0.7391927E-02,0.7371109E-02,0.7349838E-02,0.7328114E-02, & 0.7305939E-02,0.7283315E-02,0.7260243E-02,0.7236724E-02,0.7212760E-02, & 0.7188352E-02,0.7163501E-02,0.7138210E-02,0.7112480E-02,0.7086312E-02, & 0.7059708E-02,0.7032669E-02,0.7005198E-02,0.6977296E-02,0.6948964E-02, & 0.6920205E-02,0.6891020E-02,0.6861412E-02,0.6831380E-02,0.6800929E-02, & 0.6770059E-02,0.6738773E-02,0.6707072E-02,0.6674958E-02,0.6642433E-02, & 0.6609500E-02,0.6576160E-02,0.6542416E-02,0.6508269E-02,0.6473721E-02/) wp(561:600)=(/ & 0.6438775E-02,0.6403433E-02,0.6367697E-02,0.6331569E-02,0.6295052E-02, & 0.6258147E-02,0.6220857E-02,0.6183184E-02,0.6145131E-02,0.6106700E-02, & 0.6067893E-02,0.6028713E-02,0.5989161E-02,0.5949241E-02,0.5908956E-02, & 0.5868306E-02,0.5827296E-02,0.5785926E-02,0.5744201E-02,0.5702123E-02, & 0.5659693E-02,0.5616916E-02,0.5573792E-02,0.5530326E-02,0.5486520E-02, & 0.5442376E-02,0.5397897E-02,0.5353085E-02,0.5307945E-02,0.5262478E-02, & 0.5216687E-02,0.5170575E-02,0.5124145E-02,0.5077400E-02,0.5030342E-02, & 0.4982975E-02,0.4935301E-02,0.4887323E-02,0.4839045E-02,0.4790469E-02/) wp(601:640)=(/ & 0.4741598E-02,0.4692436E-02,0.4642984E-02,0.4593247E-02,0.4543228E-02, & 0.4492929E-02,0.4442353E-02,0.4391504E-02,0.4340385E-02,0.4288999E-02, & 0.4237349E-02,0.4185438E-02,0.4133270E-02,0.4080847E-02,0.4028173E-02, & 0.3975251E-02,0.3922085E-02,0.3868678E-02,0.3815032E-02,0.3761152E-02, & 0.3707040E-02,0.3652700E-02,0.3598135E-02,0.3543349E-02,0.3488345E-02, & 0.3433126E-02,0.3377697E-02,0.3322059E-02,0.3266217E-02,0.3210173E-02, & 0.3153933E-02,0.3097498E-02,0.3040873E-02,0.2984060E-02,0.2927064E-02, & 0.2869888E-02,0.2812535E-02,0.2755009E-02,0.2697314E-02,0.2639453E-02/) wp(641:680)=(/ & 0.2581429E-02,0.2523247E-02,0.2464909E-02,0.2406419E-02,0.2347782E-02, & 0.2289000E-02,0.2230077E-02,0.2171017E-02,0.2111823E-02,0.2052500E-02, & 0.1993050E-02,0.1933477E-02,0.1873786E-02,0.1813979E-02,0.1754061E-02, & 0.1694034E-02,0.1633904E-02,0.1573673E-02,0.1513345E-02,0.1452924E-02, & 0.1392413E-02,0.1331817E-02,0.1271139E-02,0.1210383E-02,0.1149552E-02, & 0.1088651E-02,0.1027682E-02,0.9666507E-03,0.9055595E-03,0.8444126E-03, & 0.7832138E-03,0.7219667E-03,0.6606753E-03,0.5993432E-03,0.5379742E-03, & 0.4765722E-03,0.4151409E-03,0.3536841E-03,0.2922057E-03,0.2307099E-03/) wp(681:720)=(/ & 0.1692014E-03,0.1076904E-03,0.4626372E-04,0.5231608E-02,0.5231465E-02, & 0.5231179E-02,0.5230749E-02,0.5230177E-02,0.5229461E-02,0.5228602E-02, & 0.5227600E-02,0.5226454E-02,0.5225166E-02,0.5223735E-02,0.5222161E-02, & 0.5220444E-02,0.5218584E-02,0.5216581E-02,0.5214435E-02,0.5212147E-02, & 0.5209716E-02,0.5207142E-02,0.5204426E-02,0.5201567E-02,0.5198567E-02, & 0.5195423E-02,0.5192138E-02,0.5188710E-02,0.5185141E-02,0.5181429E-02, & 0.5177576E-02,0.5173581E-02,0.5169445E-02,0.5165167E-02,0.5160747E-02, & 0.5156186E-02,0.5151485E-02,0.5146642E-02,0.5141658E-02,0.5136534E-02/) wp(721:760)=(/ & 0.5131269E-02,0.5125863E-02,0.5120318E-02,0.5114632E-02,0.5108806E-02, & 0.5102840E-02,0.5096735E-02,0.5090490E-02,0.5084106E-02,0.5077583E-02, & 0.5070920E-02,0.5064119E-02,0.5057180E-02,0.5050102E-02,0.5042885E-02, & 0.5035531E-02,0.5028039E-02,0.5020409E-02,0.5012642E-02,0.5004738E-02, & 0.4996696E-02,0.4988518E-02,0.4980203E-02,0.4971752E-02,0.4963165E-02, & 0.4954443E-02,0.4945584E-02,0.4936590E-02,0.4927461E-02,0.4918197E-02, & 0.4908799E-02,0.4899266E-02,0.4889599E-02,0.4879799E-02,0.4869864E-02, & 0.4859797E-02,0.4849596E-02,0.4839263E-02,0.4828797E-02,0.4818199E-02/) wp(761:800)=(/ & 0.4807470E-02,0.4796608E-02,0.4785616E-02,0.4774492E-02,0.4763238E-02, & 0.4751853E-02,0.4740338E-02,0.4728694E-02,0.4716920E-02,0.4705017E-02, & 0.4692985E-02,0.4680825E-02,0.4668537E-02,0.4656121E-02,0.4643577E-02, & 0.4630907E-02,0.4618109E-02,0.4605185E-02,0.4592136E-02,0.4578960E-02, & 0.4565659E-02,0.4552233E-02,0.4538683E-02,0.4525008E-02,0.4511210E-02, & 0.4497288E-02,0.4483243E-02,0.4469075E-02,0.4454785E-02,0.4440373E-02, & 0.4425840E-02,0.4411185E-02,0.4396410E-02,0.4381514E-02,0.4366498E-02, & 0.4351363E-02,0.4336109E-02,0.4320736E-02,0.4305245E-02,0.4289636E-02/) wp(801:840)=(/ & 0.4273910E-02,0.4258066E-02,0.4242106E-02,0.4226030E-02,0.4209839E-02, & 0.4193532E-02,0.4177110E-02,0.4160574E-02,0.4143924E-02,0.4127161E-02, & 0.4110284E-02,0.4093296E-02,0.4076195E-02,0.4058982E-02,0.4041659E-02, & 0.4024225E-02,0.4006681E-02,0.3989027E-02,0.3971264E-02,0.3953392E-02, & 0.3935412E-02,0.3917324E-02,0.3899129E-02,0.3880828E-02,0.3862420E-02, & 0.3843906E-02,0.3825288E-02,0.3806564E-02,0.3787737E-02,0.3768805E-02, & 0.3749771E-02,0.3730634E-02,0.3711395E-02,0.3692054E-02,0.3672612E-02, & 0.3653070E-02,0.3633427E-02,0.3613685E-02,0.3593845E-02,0.3573906E-02/) wp(841:880)=(/ & 0.3553869E-02,0.3533735E-02,0.3513504E-02,0.3493177E-02,0.3472754E-02, & 0.3452237E-02,0.3431624E-02,0.3410918E-02,0.3390119E-02,0.3369227E-02, & 0.3348242E-02,0.3327166E-02,0.3305999E-02,0.3284741E-02,0.3263394E-02, & 0.3241957E-02,0.3220431E-02,0.3198818E-02,0.3177116E-02,0.3155328E-02, & 0.3133454E-02,0.3111493E-02,0.3089448E-02,0.3067318E-02,0.3045104E-02, & 0.3022806E-02,0.3000426E-02,0.2977964E-02,0.2955420E-02,0.2932796E-02, & 0.2910091E-02,0.2887306E-02,0.2864443E-02,0.2841501E-02,0.2818481E-02, & 0.2795384E-02,0.2772211E-02,0.2748961E-02,0.2725637E-02,0.2702238E-02/) wp(881:920)=(/ & 0.2678765E-02,0.2655218E-02,0.2631599E-02,0.2607908E-02,0.2584146E-02, & 0.2560312E-02,0.2536409E-02,0.2512437E-02,0.2488395E-02,0.2464286E-02, & 0.2440109E-02,0.2415865E-02,0.2391555E-02,0.2367179E-02,0.2342739E-02, & 0.2318235E-02,0.2293667E-02,0.2269037E-02,0.2244344E-02,0.2219590E-02, & 0.2194775E-02,0.2169901E-02,0.2144966E-02,0.2119973E-02,0.2094922E-02, & 0.2069814E-02,0.2044649E-02,0.2019428E-02,0.1994152E-02,0.1968821E-02, & 0.1943437E-02,0.1917999E-02,0.1892508E-02,0.1866966E-02,0.1841373E-02, & 0.1815729E-02,0.1790036E-02,0.1764294E-02,0.1738503E-02,0.1712665E-02/) wp(921:960)=(/ & 0.1686780E-02,0.1660848E-02,0.1634872E-02,0.1608850E-02,0.1582785E-02, & 0.1556676E-02,0.1530525E-02,0.1504331E-02,0.1478097E-02,0.1451822E-02, & 0.1425507E-02,0.1399154E-02,0.1372762E-02,0.1346332E-02,0.1319866E-02, & 0.1293363E-02,0.1266825E-02,0.1240253E-02,0.1213646E-02,0.1187006E-02, & 0.1160334E-02,0.1133630E-02,0.1106895E-02,0.1080130E-02,0.1053335E-02, & 0.1026511E-02,0.9996593E-03,0.9727801E-03,0.9458743E-03,0.9189426E-03, & 0.8919858E-03,0.8650045E-03,0.8379996E-03,0.8109717E-03,0.7839217E-03, & 0.7568502E-03,0.7297579E-03,0.7026457E-03,0.6755143E-03,0.6483644E-03/) wp(961:1000)=(/ & 0.6211967E-03,0.5940120E-03,0.5668111E-03,0.5395947E-03,0.5123635E-03, & 0.4851182E-03,0.4578597E-03,0.4305887E-03,0.4033058E-03,0.3760120E-03, & 0.3487078E-03,0.3213941E-03,0.2940716E-03,0.2667411E-03,0.2394033E-03, & 0.2120589E-03,0.1847087E-03,0.1573535E-03,0.1299941E-03,0.1026314E-03, & 0.7526651E-04,0.4790311E-04,0.2057885E-04,0.3924530E-02,0.3924469E-02, & 0.3924348E-02,0.3924167E-02,0.3923925E-02,0.3923623E-02,0.3923260E-02, & 0.3922837E-02,0.3922354E-02,0.3921810E-02,0.3921206E-02,0.3920541E-02, & 0.3919816E-02,0.3919030E-02,0.3918185E-02,0.3917278E-02,0.3916312E-02/) wp(1001:1040)=(/ & 0.3915285E-02,0.3914198E-02,0.3913051E-02,0.3911843E-02,0.3910575E-02, & 0.3909247E-02,0.3907858E-02,0.3906410E-02,0.3904901E-02,0.3903332E-02, & 0.3901703E-02,0.3900014E-02,0.3898265E-02,0.3896456E-02,0.3894587E-02, & 0.3892658E-02,0.3890668E-02,0.3888619E-02,0.3886510E-02,0.3884342E-02, & 0.3882113E-02,0.3879825E-02,0.3877476E-02,0.3875068E-02,0.3872601E-02, & 0.3870074E-02,0.3867487E-02,0.3864840E-02,0.3862134E-02,0.3859369E-02, & 0.3856544E-02,0.3853660E-02,0.3850716E-02,0.3847713E-02,0.3844651E-02, & 0.3841530E-02,0.3838349E-02,0.3835109E-02,0.3831811E-02,0.3828453E-02/) wp(1041:1080)=(/ & 0.3825036E-02,0.3821561E-02,0.3818026E-02,0.3814433E-02,0.3810781E-02, & 0.3807070E-02,0.3803300E-02,0.3799473E-02,0.3795586E-02,0.3791641E-02, & 0.3787638E-02,0.3783576E-02,0.3779456E-02,0.3775278E-02,0.3771042E-02, & 0.3766747E-02,0.3762395E-02,0.3757984E-02,0.3753516E-02,0.3748990E-02, & 0.3744406E-02,0.3739765E-02,0.3735066E-02,0.3730309E-02,0.3725495E-02, & 0.3720624E-02,0.3715695E-02,0.3710709E-02,0.3705666E-02,0.3700566E-02, & 0.3695408E-02,0.3690194E-02,0.3684923E-02,0.3679596E-02,0.3674211E-02, & 0.3668770E-02,0.3663273E-02,0.3657719E-02,0.3652109E-02,0.3646442E-02/) wp(1081:1120)=(/ & 0.3640720E-02,0.3634941E-02,0.3629106E-02,0.3623216E-02,0.3617269E-02, & 0.3611267E-02,0.3605209E-02,0.3599096E-02,0.3592927E-02,0.3586703E-02, & 0.3580424E-02,0.3574090E-02,0.3567700E-02,0.3561256E-02,0.3554757E-02, & 0.3548203E-02,0.3541594E-02,0.3534931E-02,0.3528213E-02,0.3521441E-02, & 0.3514615E-02,0.3507734E-02,0.3500800E-02,0.3493812E-02,0.3486770E-02, & 0.3479674E-02,0.3472524E-02,0.3465321E-02,0.3458065E-02,0.3450756E-02, & 0.3443393E-02,0.3435977E-02,0.3428508E-02,0.3420987E-02,0.3413413E-02, & 0.3405786E-02,0.3398107E-02,0.3390375E-02,0.3382592E-02,0.3374756E-02/) wp(1121:1160)=(/ & 0.3366868E-02,0.3358928E-02,0.3350937E-02,0.3342894E-02,0.3334800E-02, & 0.3326654E-02,0.3318457E-02,0.3310208E-02,0.3301909E-02,0.3293559E-02, & 0.3285158E-02,0.3276707E-02,0.3268205E-02,0.3259653E-02,0.3251051E-02, & 0.3242398E-02,0.3233696E-02,0.3224944E-02,0.3216142E-02,0.3207290E-02, & 0.3198390E-02,0.3189440E-02,0.3180440E-02,0.3171392E-02,0.3162295E-02, & 0.3153149E-02,0.3143955E-02,0.3134712E-02,0.3125421E-02,0.3116082E-02, & 0.3106695E-02,0.3097260E-02,0.3087778E-02,0.3078247E-02,0.3068670E-02, & 0.3059045E-02,0.3049373E-02,0.3039654E-02,0.3029888E-02,0.3020075E-02/) wp(1161:1200)=(/ & 0.3010217E-02,0.3000311E-02,0.2990360E-02,0.2980362E-02,0.2970318E-02, & 0.2960229E-02,0.2950094E-02,0.2939914E-02,0.2929688E-02,0.2919418E-02, & 0.2909102E-02,0.2898742E-02,0.2888336E-02,0.2877887E-02,0.2867393E-02, & 0.2856855E-02,0.2846273E-02,0.2835647E-02,0.2824977E-02,0.2814264E-02, & 0.2803508E-02,0.2792708E-02,0.2781865E-02,0.2770980E-02,0.2760052E-02, & 0.2749081E-02,0.2738068E-02,0.2727013E-02,0.2715915E-02,0.2704776E-02, & 0.2693596E-02,0.2682374E-02,0.2671110E-02,0.2659805E-02,0.2648460E-02, & 0.2637073E-02,0.2625646E-02,0.2614179E-02,0.2602671E-02,0.2591123E-02/) wp(1201:1240)=(/ & 0.2579536E-02,0.2567908E-02,0.2556241E-02,0.2544535E-02,0.2532789E-02, & 0.2521005E-02,0.2509181E-02,0.2497319E-02,0.2485419E-02,0.2473480E-02, & 0.2461503E-02,0.2449488E-02,0.2437436E-02,0.2425346E-02,0.2413218E-02, & 0.2401054E-02,0.2388852E-02,0.2376614E-02,0.2364339E-02,0.2352028E-02, & 0.2339680E-02,0.2327296E-02,0.2314877E-02,0.2302422E-02,0.2289931E-02, & 0.2277405E-02,0.2264844E-02,0.2252249E-02,0.2239618E-02,0.2226953E-02, & 0.2214254E-02,0.2201520E-02,0.2188753E-02,0.2175952E-02,0.2163117E-02, & 0.2150249E-02,0.2137349E-02,0.2124415E-02,0.2111448E-02,0.2098449E-02/) wp(1241:1280)=(/ & 0.2085417E-02,0.2072354E-02,0.2059258E-02,0.2046131E-02,0.2032972E-02, & 0.2019782E-02,0.2006561E-02,0.1993309E-02,0.1980026E-02,0.1966713E-02, & 0.1953370E-02,0.1939996E-02,0.1926592E-02,0.1913159E-02,0.1899697E-02, & 0.1886205E-02,0.1872684E-02,0.1859134E-02,0.1845555E-02,0.1831949E-02, & 0.1818314E-02,0.1804650E-02,0.1790960E-02,0.1777241E-02,0.1763495E-02, & 0.1749722E-02,0.1735922E-02,0.1722096E-02,0.1708242E-02,0.1694363E-02, & 0.1680457E-02,0.1666526E-02,0.1652569E-02,0.1638586E-02,0.1624578E-02, & 0.1610545E-02,0.1596488E-02,0.1582405E-02,0.1568299E-02,0.1554168E-02/) wp(1281:1320)=(/ & 0.1540013E-02,0.1525835E-02,0.1511633E-02,0.1497407E-02,0.1483159E-02, & 0.1468888E-02,0.1454594E-02,0.1440278E-02,0.1425940E-02,0.1411579E-02, & 0.1397197E-02,0.1382794E-02,0.1368369E-02,0.1353923E-02,0.1339456E-02, & 0.1324969E-02,0.1310461E-02,0.1295933E-02,0.1281385E-02,0.1266817E-02, & 0.1252230E-02,0.1237623E-02,0.1222998E-02,0.1208353E-02,0.1193690E-02, & 0.1179009E-02,0.1164309E-02,0.1149592E-02,0.1134857E-02,0.1120104E-02, & 0.1105334E-02,0.1090547E-02,0.1075743E-02,0.1060923E-02,0.1046086E-02, & 0.1031234E-02,0.1016365E-02,0.1001481E-02,0.9865808E-03,0.9716658E-03/) wp(1321:1360)=(/ & 0.9567359E-03,0.9417913E-03,0.9268321E-03,0.9118587E-03,0.8968712E-03, & 0.8818700E-03,0.8668551E-03,0.8518269E-03,0.8367855E-03,0.8217313E-03, & 0.8066644E-03,0.7915851E-03,0.7764936E-03,0.7613902E-03,0.7462750E-03, & 0.7311483E-03,0.7160104E-03,0.7008614E-03,0.6857017E-03,0.6705313E-03, & 0.6553507E-03,0.6401600E-03,0.6249593E-03,0.6097491E-03,0.5945295E-03, & 0.5793007E-03,0.5640630E-03,0.5488166E-03,0.5335618E-03,0.5182987E-03, & 0.5030277E-03,0.4877489E-03,0.4724626E-03,0.4571690E-03,0.4418684E-03, & 0.4265610E-03,0.4112470E-03,0.3959267E-03,0.3806003E-03,0.3652680E-03/) wp(1361:1400)=(/ & 0.3499301E-03,0.3345867E-03,0.3192383E-03,0.3038849E-03,0.2885269E-03, & 0.2731644E-03,0.2577977E-03,0.2424270E-03,0.2270526E-03,0.2116747E-03, & 0.1962935E-03,0.1809093E-03,0.1655224E-03,0.1501328E-03,0.1347410E-03, & 0.1193471E-03,0.1039514E-03,0.8855408E-04,0.7315545E-04,0.5775582E-04, & 0.4235569E-04,0.2695689E-04,0.1158044E-04,0.3140018E-02,0.3139987E-02, & 0.3139926E-02,0.3139833E-02,0.3139709E-02,0.3139554E-02,0.3139368E-02, & 0.3139152E-02,0.3138904E-02,0.3138625E-02,0.3138316E-02,0.3137975E-02, & 0.3137604E-02,0.3137201E-02,0.3136768E-02,0.3136304E-02,0.3135809E-02/) wp(1401:1440)=(/ & 0.3135283E-02,0.3134726E-02,0.3134138E-02,0.3133519E-02,0.3132869E-02, & 0.3132189E-02,0.3131477E-02,0.3130735E-02,0.3129962E-02,0.3129158E-02, & 0.3128323E-02,0.3127457E-02,0.3126560E-02,0.3125633E-02,0.3124675E-02, & 0.3123686E-02,0.3122666E-02,0.3121615E-02,0.3120534E-02,0.3119422E-02, & 0.3118279E-02,0.3117105E-02,0.3115901E-02,0.3114666E-02,0.3113400E-02, & 0.3112103E-02,0.3110776E-02,0.3109418E-02,0.3108029E-02,0.3106610E-02, & 0.3105160E-02,0.3103680E-02,0.3102169E-02,0.3100627E-02,0.3099055E-02, & 0.3097452E-02,0.3095819E-02,0.3094155E-02,0.3092461E-02,0.3090736E-02/) wp(1441:1480)=(/ & 0.3088981E-02,0.3087195E-02,0.3085379E-02,0.3083532E-02,0.3081655E-02, & 0.3079748E-02,0.3077810E-02,0.3075842E-02,0.3073843E-02,0.3071815E-02, & 0.3069756E-02,0.3067666E-02,0.3065547E-02,0.3063397E-02,0.3061217E-02, & 0.3059007E-02,0.3056766E-02,0.3054496E-02,0.3052195E-02,0.3049865E-02, & 0.3047504E-02,0.3045113E-02,0.3042692E-02,0.3040242E-02,0.3037761E-02, & 0.3035250E-02,0.3032709E-02,0.3030139E-02,0.3027538E-02,0.3024908E-02, & 0.3022248E-02,0.3019558E-02,0.3016838E-02,0.3014089E-02,0.3011310E-02, & 0.3008501E-02,0.3005662E-02,0.3002794E-02,0.2999896E-02,0.2996969E-02/) wp(1481:1520)=(/ & 0.2994012E-02,0.2991026E-02,0.2988010E-02,0.2984965E-02,0.2981890E-02, & 0.2978786E-02,0.2975652E-02,0.2972489E-02,0.2969297E-02,0.2966075E-02, & 0.2962825E-02,0.2959545E-02,0.2956236E-02,0.2952897E-02,0.2949530E-02, & 0.2946134E-02,0.2942708E-02,0.2939254E-02,0.2935770E-02,0.2932258E-02, & 0.2928716E-02,0.2925146E-02,0.2921547E-02,0.2917919E-02,0.2914262E-02, & 0.2910577E-02,0.2906863E-02,0.2903120E-02,0.2899349E-02,0.2895549E-02, & 0.2891720E-02,0.2887863E-02,0.2883978E-02,0.2880064E-02,0.2876122E-02, & 0.2872151E-02,0.2868152E-02,0.2864125E-02,0.2860069E-02,0.2855985E-02/) wp(1521:1560)=(/ & 0.2851873E-02,0.2847734E-02,0.2843565E-02,0.2839369E-02,0.2835145E-02, & 0.2830893E-02,0.2826613E-02,0.2822305E-02,0.2817970E-02,0.2813606E-02, & 0.2809215E-02,0.2804796E-02,0.2800350E-02,0.2795875E-02,0.2791374E-02, & 0.2786844E-02,0.2782288E-02,0.2777704E-02,0.2773092E-02,0.2768453E-02, & 0.2763787E-02,0.2759094E-02,0.2754373E-02,0.2749625E-02,0.2744850E-02, & 0.2740048E-02,0.2735219E-02,0.2730363E-02,0.2725480E-02,0.2720571E-02, & 0.2715634E-02,0.2710671E-02,0.2705681E-02,0.2700664E-02,0.2695621E-02, & 0.2690551E-02,0.2685454E-02,0.2680331E-02,0.2675182E-02,0.2670006E-02/) wp(1561:1600)=(/ & 0.2664804E-02,0.2659576E-02,0.2654321E-02,0.2649040E-02,0.2643733E-02, & 0.2638400E-02,0.2633041E-02,0.2627657E-02,0.2622246E-02,0.2616809E-02, & 0.2611347E-02,0.2605858E-02,0.2600344E-02,0.2594805E-02,0.2589240E-02, & 0.2583649E-02,0.2578033E-02,0.2572391E-02,0.2566724E-02,0.2561032E-02, & 0.2555315E-02,0.2549572E-02,0.2543804E-02,0.2538011E-02,0.2532193E-02, & 0.2526350E-02,0.2520483E-02,0.2514590E-02,0.2508672E-02,0.2502730E-02, & 0.2496763E-02,0.2490772E-02,0.2484756E-02,0.2478715E-02,0.2472650E-02, & 0.2466561E-02,0.2460447E-02,0.2454309E-02,0.2448147E-02,0.2441961E-02/) wp(1601:1640)=(/ & 0.2435751E-02,0.2429516E-02,0.2423258E-02,0.2416976E-02,0.2410670E-02, & 0.2404340E-02,0.2397986E-02,0.2391609E-02,0.2385209E-02,0.2378784E-02, & 0.2372337E-02,0.2365866E-02,0.2359371E-02,0.2352853E-02,0.2346312E-02, & 0.2339748E-02,0.2333161E-02,0.2326551E-02,0.2319918E-02,0.2313262E-02, & 0.2306584E-02,0.2299882E-02,0.2293158E-02,0.2286411E-02,0.2279642E-02, & 0.2272850E-02,0.2266036E-02,0.2259200E-02,0.2252341E-02,0.2245460E-02, & 0.2238557E-02,0.2231631E-02,0.2224684E-02,0.2217715E-02,0.2210724E-02, & 0.2203711E-02,0.2196677E-02,0.2189620E-02,0.2182543E-02,0.2175443E-02/) wp(1641:1680)=(/ & 0.2168323E-02,0.2161180E-02,0.2154017E-02,0.2146832E-02,0.2139626E-02, & 0.2132400E-02,0.2125152E-02,0.2117883E-02,0.2110593E-02,0.2103282E-02, & 0.2095951E-02,0.2088599E-02,0.2081226E-02,0.2073833E-02,0.2066420E-02, & 0.2058986E-02,0.2051531E-02,0.2044057E-02,0.2036562E-02,0.2029047E-02, & 0.2021513E-02,0.2013958E-02,0.2006384E-02,0.1998789E-02,0.1991175E-02, & 0.1983542E-02,0.1975888E-02,0.1968216E-02,0.1960524E-02,0.1952812E-02, & 0.1945082E-02,0.1937332E-02,0.1929563E-02,0.1921775E-02,0.1913968E-02, & 0.1906142E-02,0.1898298E-02,0.1890434E-02,0.1882552E-02,0.1874652E-02/) wp(1681:1720)=(/ & 0.1866733E-02,0.1858795E-02,0.1850840E-02,0.1842866E-02,0.1834874E-02, & 0.1826863E-02,0.1818835E-02,0.1810789E-02,0.1802725E-02,0.1794643E-02, & 0.1786544E-02,0.1778427E-02,0.1770292E-02,0.1762140E-02,0.1753970E-02, & 0.1745784E-02,0.1737580E-02,0.1729359E-02,0.1721120E-02,0.1712865E-02, & 0.1704593E-02,0.1696304E-02,0.1687999E-02,0.1679677E-02,0.1671338E-02, & 0.1662983E-02,0.1654611E-02,0.1646223E-02,0.1637819E-02,0.1629399E-02, & 0.1620962E-02,0.1612510E-02,0.1604042E-02,0.1595557E-02,0.1587058E-02, & 0.1578542E-02,0.1570011E-02,0.1561465E-02,0.1552903E-02,0.1544325E-02/) wp(1721:1760)=(/ & 0.1535733E-02,0.1527125E-02,0.1518503E-02,0.1509865E-02,0.1501213E-02, & 0.1492545E-02,0.1483863E-02,0.1475167E-02,0.1466456E-02,0.1457730E-02, & 0.1448990E-02,0.1440236E-02,0.1431467E-02,0.1422684E-02,0.1413888E-02, & 0.1405077E-02,0.1396253E-02,0.1387414E-02,0.1378563E-02,0.1369697E-02, & 0.1360818E-02,0.1351926E-02,0.1343020E-02,0.1334101E-02,0.1325169E-02, & 0.1316224E-02,0.1307265E-02,0.1298294E-02,0.1289310E-02,0.1280314E-02, & 0.1271305E-02,0.1262283E-02,0.1253249E-02,0.1244202E-02,0.1235143E-02, & 0.1226072E-02,0.1216989E-02,0.1207894E-02,0.1198787E-02,0.1189668E-02/) wp(1761:1800)=(/ & 0.1180538E-02,0.1171396E-02,0.1162242E-02,0.1153077E-02,0.1143900E-02, & 0.1134712E-02,0.1125513E-02,0.1116303E-02,0.1107082E-02,0.1097850E-02, & 0.1088607E-02,0.1079354E-02,0.1070089E-02,0.1060815E-02,0.1051529E-02, & 0.1042234E-02,0.1032928E-02,0.1023612E-02,0.1014286E-02,0.1004950E-02, & 0.9956034E-03,0.9862475E-03,0.9768819E-03,0.9675067E-03,0.9581219E-03, & 0.9487276E-03,0.9393240E-03,0.9299112E-03,0.9204892E-03,0.9110581E-03, & 0.9016180E-03,0.8921690E-03,0.8827112E-03,0.8732448E-03,0.8637697E-03, & 0.8542861E-03,0.8447941E-03,0.8352937E-03,0.8257851E-03,0.8162684E-03/) wp(1801:1840)=(/ & 0.8067436E-03,0.7972109E-03,0.7876703E-03,0.7781220E-03,0.7685659E-03, & 0.7590023E-03,0.7494312E-03,0.7398528E-03,0.7302670E-03,0.7206740E-03, & 0.7110739E-03,0.7014668E-03,0.6918528E-03,0.6822320E-03,0.6726045E-03, & 0.6629703E-03,0.6533295E-03,0.6436824E-03,0.6340289E-03,0.6243691E-03, & 0.6147032E-03,0.6050312E-03,0.5953533E-03,0.5856694E-03,0.5759799E-03, & 0.5662846E-03,0.5565837E-03,0.5468774E-03,0.5371657E-03,0.5274486E-03, & 0.5177264E-03,0.5079991E-03,0.4982667E-03,0.4885295E-03,0.4787874E-03, & 0.4690406E-03,0.4592892E-03,0.4495332E-03,0.4397729E-03,0.4300082E-03/) wp(1841:1883)=(/ & 0.4202392E-03,0.4104661E-03,0.4006890E-03,0.3909079E-03,0.3811229E-03, & 0.3713342E-03,0.3615418E-03,0.3517459E-03,0.3419465E-03,0.3321437E-03, & 0.3223377E-03,0.3125285E-03,0.3027162E-03,0.2929009E-03,0.2830827E-03, & 0.2732617E-03,0.2634380E-03,0.2536118E-03,0.2437830E-03,0.2339519E-03, & 0.2241184E-03,0.2142827E-03,0.2044449E-03,0.1946051E-03,0.1847634E-03, & 0.1749198E-03,0.1650745E-03,0.1552276E-03,0.1453792E-03,0.1355293E-03, & 0.1256781E-03,0.1158257E-03,0.1059721E-03,0.9611747E-04,0.8626190E-04, & 0.7640548E-04,0.6654832E-04,0.5669051E-04,0.4683217E-04,0.3697344E-04, & 0.2711461E-04,0.1725677E-04,0.7413338E-05/) init_profval=.true. return End Subroutine Init_Prof_Val Subroutine Gaussian(Pos , Pos0 , Gamma , Dgdt , Dgdg, Gauss ) !---- Arguments ----! real(kind=cp), intent(in) :: pos real(kind=cp), intent(in) :: pos0 real(kind=cp), intent(in) :: gamma real(kind=cp), intent(out) :: dgdt !derivative of Gauss wrt Pos0 real(kind=cp), intent(out) :: dgdg !derivative of Gauss wrt Gamma real(kind=cp), intent(out) :: gauss !---- Local Variables ----! real(kind=cp),parameter :: c= 1.6651092223154_cp ! 2*sqrt(ln2) real(kind=cp),parameter :: cg= 0.93943727869965_cp ! 2*sqrt(ln2/pi) real(kind=cp) :: delp , ex delp = pos - pos0 if (abs(delp)/gamma > 6.0 ) then Gauss = 0.0 dgdt = 0.0 dgdg = 0.0 else ex=(delp * c /gamma)**2 Gauss = cg * exp(-ex)/gamma dgdg = Gauss * ( -1.0 + 2.0 * ex) / gamma dgdt = 2.0 * c*c * delp * Gauss/(gamma*gamma) end if return End Subroutine Gaussian Subroutine Lorentzian(Pos , Pos0 , Gamma , Dldt , Dldg, Lorentz ) !---- Arguments ----! real(kind=cp), intent(in) :: pos real(kind=cp), intent(in) :: pos0 real(kind=cp), intent(in) :: gamma real(kind=cp), intent(out):: dldt !derivative of Lorentz wrt Pos0 real(kind=cp), intent(out):: dldg !derivative of Lorentz wrt Gamma real(kind=cp), intent(out):: lorentz !---- Local Variables ----! real(kind=cp), parameter :: cl=2.0_cp/pi real(kind=cp) :: delp , denom, denom2, delp2, gamma2 delp = pos - pos0 delp2=delp*delp gamma2=gamma*gamma denom = 4.0 * delp2 + gamma2 denom2=denom*denom lorentz = cl * gamma / denom dldt = 8.0 * cl * gamma * delp / denom2 dldg = cl * (4.0 * delp2 - gamma2) / denom2 return End Subroutine Lorentzian Subroutine PsVoigtian(Twoth , Twoth0 , Eta , Gamma, Dprdt , Dprdg , Dprde, PsVoigt ) !---- Arguments ----! real(kind=cp), intent(in) :: twoth ! point at which to evaluate the profile real(kind=cp), intent(in) :: twoth0 ! two theta value for peak real(kind=cp), intent(in) :: eta ! mixing coefficient between Gaussian and Lorentzian real(kind=cp), intent(in) :: gamma ! FWHM real(kind=cp), intent(out) :: dprdt ! derivative of profile wrt TwoTH0 real(kind=cp), intent(out) :: dprdg ! derivative of profile wrt Gamma real(kind=cp), intent(out) :: dprde ! derivative of profile wrt Eta real(kind=cp), intent(out) :: psvoigt !---- Local Variables ----! real(kind=cp) :: Gauss ! Gaussian part real(kind=cp) :: Lorentz ! Lorentzian part real(kind=cp) :: dgdt , dgdg , dldt , dldg call Gaussian(twoth , twoth0 , gamma , dgdt , dgdg ,Gauss) call Lorentzian(twoth , twoth0 , gamma , dldt , dldg, Lorentz) psvoigt = eta * Lorentz + (1.0 - eta) * Gauss dprdt = eta * dldt + (1.0 - eta) * dgdt dprdg = eta * dldg + (1.0 - eta) * dgdg dprde = Lorentz - Gauss return End Subroutine PsVoigtian Subroutine Prof_Val( eta, gamma, asym1, asym2, twoth, twoth0, dprdt, dprdg, & dprde , dprds , dprdd , profval, use_asym, use_hps) real(kind=cp), Intent(In) :: eta ! mixing coefficient between Gaussian and Lorentzian real(kind=cp), Intent(In) :: gamma ! FWHM real(kind=cp), Intent(In) :: asym1 ! s_l source width/detector distance or D_L+S_L if use_hps is true real(kind=cp), Intent(In) :: asym2 ! d_l detector width/detector distance or D_L-S_L if use_hps is true real(kind=cp), Intent(In) :: twoth ! point at which to evaluate the profile real(kind=cp), Intent(In) :: twoth0 ! two_theta value for peak real(kind=cp), Intent(Out) :: dprdt ! derivative of profile wrt TwoTH0 real(kind=cp), Intent(Out) :: dprdg ! derivative of profile wrt Gamma real(kind=cp), Intent(Out) :: dprde ! derivative of profile wrt Eta real(kind=cp), Intent(Out) :: dprds ! derivative of profile wrt asym1 real(kind=cp), Intent(Out) :: dprdd ! derivative of profile wrt asym2 real(kind=cp), Intent(Out) :: profval ! Value of the profile at point twoth Logical, Intent(In) :: use_asym ! true if asymmetry to be used Logical, Intent(In) :: use_hps ! true if asym1=D_L+S_L and asym2=D_L-S_L ! false if asym1=D_L ans asym2=S_L !The variables below have the "save" attribute in order to save calculation !time when the subroutine is invoked for different points of the same peak real(kind=cp),save :: s_l , d_l, half_over_dl real(kind=cp),save :: df_dh_factor, df_ds_factor real(kind=cp),save :: dfi_emin, dfi_einfl real(kind=cp),save :: normv_analytic real(kind=cp),save :: einfl ! 2phi value for inflection point real(kind=cp),save :: emin ! 2phi value for minimum real(kind=cp),save :: cstwoth ! cos(twoth) real(kind=cp),save :: coseinfl ! cos(Einfl) real(kind=cp),save :: apb ! (S + H)/L real(kind=cp),save :: amb ! (S - H)/L real(kind=cp),save :: apb2 ! (ApB) **2 Integer,save :: arraynum, ngt, ngt2, it Logical,save :: s_eq_d ! Variables not conserving their value between calls Integer :: side, k real(kind=cp) :: tmp , tmp1 , tmp2 ! intermediate values real(kind=cp) :: delta ! Angle of integration for comvolution real(kind=cp) :: sindelta ! sine of DELTA real(kind=cp) :: cosdelta ! cosine of DELTA real(kind=cp) :: rcosdelta ! 1/cos(DELTA) real(kind=cp) :: f,g, einflr,eminr,twoth0r real(kind=cp) :: sumwg, sumwrg, sumwrdgda ,sumwdgdb , sumwrdgdb real(kind=cp) :: sumwgdrdg, sumwgdrde, sumwgdrd2t real(kind=cp) :: sumwx logical :: re_calculate ! First simple calculation of Pseudo-Voigt if asymmetry is not used if(.not. use_asym) then call Psvoigtian(twoth,twoth0,eta,gamma,dprdt,dprdg,dprde,tmp) profval = tmp dprds = 0.0 dprdd = 0.0 return end if !From here to the end of the procedure asymmetry is used. !Make the calculations of some variables only if twoth0,asym1,asym2 !are different from previous values. This saves calculation time if the !different points of a peak are calculated sequentially for the same values !of twotheta and asymmetry parameters. re_calculate= abs(twoth0_prev-twoth0) > eps .or. & abs(asym1_prev-asym1) > eps .or. & abs(asym2_prev-asym2) > eps if(re_calculate) then twoth0_prev=twoth0 asym1_prev=asym1 asym2_prev=asym2 twoth0r=twoth0*to_rad cstwoth = Cos(twoth0r) If (use_hps) Then s_l = 0.5*(asym1 - asym2) ! 1/2(s_l+d_l - (d_l-s_l)) d_l = 0.5*(asym1 + asym2) ! 1/2(s_l+d_l + (d_l-s_l)) Else s_l = asym1 d_l = asym2 End If apb = s_l + d_l amb = s_l - d_l ! Catch special case of S_L = D_L If (Abs(amb) < 0.00001) Then s_eq_d = .TRUE. Else s_eq_d = .FALSE. End If apb2 = apb*apb tmp = Sqrt(1.0 + amb*amb)*cstwoth If ((Abs(tmp) > 1.0) .or. (Abs(tmp) <= Abs(cstwoth))) Then einfl = twoth0 einflr=einfl*to_rad dfi_einfl = pi_over_two Else einflr = Acos(tmp) einfl=einflr*to_deg dfi_einfl = dfunc_int(einflr,twoth0r) End If coseinfl = Cos(einflr) tmp2 = 1.0 + apb2 tmp = Sqrt(tmp2) * cstwoth ! If S_L or D_L are zero, set Einfl = 2theta ! If S_L equals D_L, set Einfl = 2theta If ((s_l == 0.0) .OR. (d_l == 0.0) .OR. s_eq_d) then einfl = twoth0 einflr=einfl*to_rad End if If (Abs(tmp) <= 1.0) Then eminr = Acos(tmp) emin = eminr * to_deg tmp1 = tmp2 * (1.0 - tmp2 * cstwoth*cstwoth) Else tmp1 = 0.0 If (tmp > 0.0) Then emin = 0.0 eminr= 0.0 Else emin = 180.0 eminr= pi End If End If dfi_emin = dfunc_int(eminr,twoth0r) ! ! Simplifications if S_L equals D_L ! half_over_dl=0.5_cp/d_l If (s_eq_d) Then dfi_einfl = pi_over_two normv_analytic = (dfi_einfl - dfi_emin) - & half_over_dl*(extra_int(einflr)-extra_int(eminr)) df_dh_factor = half_over_dl * (pi_over_two - dfi_emin) df_ds_factor = half_over_dl * (pi_over_two - dfi_emin) df_dh_factor = df_dh_factor - 2.0_cp*half_over_dl * normv_analytic Else dfi_einfl = dfunc_int(einflr,twoth0r) normv_analytic = Min(s_l,d_l)/d_l*(pi_over_two - dfi_einfl) normv_analytic = normv_analytic + apb*half_over_dl*(dfi_einfl-dfi_emin) & -2.0_cp*half_over_dl*(extra_int(einflr)-extra_int(eminr)) tmp= half_over_dl*(pi - dfi_einfl - dfi_emin) tmp1=half_over_dl*(dfi_einfl - dfi_emin) If(d_l < s_l) Then df_dh_factor = tmp df_ds_factor = tmp1 Else df_dh_factor = tmp1 df_ds_factor = tmp End If df_dh_factor = df_dh_factor - 2.0_cp*half_over_dl * normv_analytic End If arraynum = 1 k = ctrl_nsteps * (twoth0 - emin) ! Calculate the number of terms needed Do if ( .not. ( arraynum < 14 .And. k > nterms(arraynum) ) ) exit arraynum = arraynum + 1 End Do ngt = nterms(arraynum) ! Save the number of terms ngt2 = ngt / 2 it = fstterm(arraynum)-ngt2 End if !re_calculate ! Clear terms needed for summations sumwg = 0.0 sumwrg = 0.0 sumwrdgda = 0.0 sumwdgdb = 0.0 sumwrdgdb = 0.0 sumwgdrd2t = 0.0 sumwgdrdg = 0.0 sumwgdrde = 0.0 sumwx = 0.0 ! Compute the convolution integral Do k = ngt2 , ngt Do side = 1,2 If (side == 1) Then delta = (twoth0 + emin)/2 + (twoth0 - emin) * xp(k + it)/2 sumwx = sumwx + wp(k+it) Else delta = (twoth0 + emin)/2 - (twoth0 - emin) * xp(k + it)/2 sumwx = sumwx + wp(k+it) End If sindelta = Sin(delta*to_rad) cosdelta = Cos(delta*to_rad) If (Abs(cosdelta) < 1.0E-15) cosdelta = 1.0E-15 rcosdelta = Abs(1.0 / cosdelta) tmp = cosdelta*cosdelta - cstwoth*cstwoth If (tmp > 0.0) Then tmp1 = Sqrt(tmp) f = Abs(cstwoth) / tmp1 !h-function in FCJ Else f = 0.0 End If ! calculate G(Delta,2theta) , FCJ eq. 7a and 7b If ( Abs(delta - emin) > Abs(einfl - emin)) Then If (s_l > d_l) Then g = 2.0 * d_l * f * rcosdelta Else g = 2.0 * s_l * f * rcosdelta End If Else g = (-1.0 + apb * f) * rcosdelta End If call Psvoigtian(twoth-delta+twoth0,twoth0,eta,gamma,dprdt,dprdg,dprde,tmp) sumwg = sumwg + wp(k+it) * g sumwrg = sumwrg + wp(k+it) * g * tmp If ( Abs(cosdelta) > Abs(coseinfl)) Then sumwrdgda = sumwrdgda + wp(k+it) * f * rcosdelta * tmp sumwrdgdb = sumwrdgdb + wp(k+it) * f * rcosdelta * tmp Else If (s_l < d_l) Then sumwrdgdb = sumwrdgdb + 2.0*wp(k+it)*f* rcosdelta*tmp Else sumwrdgda = sumwrdgda + 2.0*wp(k+it)*f* rcosdelta*tmp End If End If sumwgdrd2t = sumwgdrd2t + wp(k+it) * g * dprdt sumwgdrdg = sumwgdrdg + wp(k+it) * g * dprdg sumwgdrde = sumwgdrde + wp(k+it) * g * dprde End Do ! loop over left, right side of quadrature End Do If (sumwg == 0.0) sumwg = 1.0_cp profval = sumwrg / sumwg dprdt = sumwgdrd2t/ sumwg dprdg = sumwgdrdg / sumwg dprde = sumwgdrde / sumwg ! If(normv_analytic <= 0.0) normv_analytic=1.0_cp dprdd = sumwrdgda / sumwg - df_dh_factor*profval/normv_analytic - profval/d_l dprds = sumwrdgdb / sumwg - df_ds_factor*profval/normv_analytic If (use_hps) Then dprds = 0.5_cp*(dprdd + dprds) !S is really D+S dprdd = 0.5_cp*(dprdd - dprds) !D is really D-S End If Return End Subroutine Prof_Val ! Function to give the analytical value of the normalisation constant Function dfunc_int(twopsi, twoth0) result(dfunc) Real(kind=cp), Intent(In) :: twopsi Real(kind=cp), Intent(In) :: twoth0 Real(kind=cp) :: dfunc !--- Local variables Real(kind=cp) :: sintp !Sin twopsi Real(kind=cp) :: sin2t,sin2t2,csp,csm,ssp,ssm,a,b ! sin2Theta, (sin2Theta)^2 If(Abs(twopsi-twoth0) < 1.0E-5) Then dfunc=pi_over_two Else sin2t=Sin(twoth0) sin2t2=sin2t*sin2t sintp = Sin(twopsi) csp=sintp+sin2t2 csm=sintp-sin2t2 ssp=Abs((sintp+1.0_cp)*sin2t) ssm=Abs((sintp-1.0_cp)*sin2t) a=csm/ssm; b=-csp/ssp If(a > 1.0_cp) a=1.0_cp If(b <-1.0_cp) b=-1.0_cp dfunc=0.5_cp*(Asin(a)-Asin(b)) End If End Function dfunc_int ! Function to calculate 1/4(log(|sin(x)+1|)-log(|sin(x)-1|)) Function extra_int(x) result(extra) Real(kind=cp), Intent(In) :: x Real(kind=cp) :: extra !--- Local variables Real(kind=cp) :: sinx sinx = Sin(x) extra = 0.25_cp*(Log(Abs(sinx+1.0_cp))-Log(Abs(sinx-1.0_cp))) End Function extra_int End Module Profile_Finger Program Test_Profile ! ! Routine to test Profval ! use Profile_Finger implicit none real:: Profval, Eta , Gamma , S_L , D_L , TwoTH , TwoTH0 , dPRdT, dPRdG, dPRdE , dPRdS , dPRdD real:: dprdsnum, dprddnum, dprdgnum logical :: Use_Asym, use_hps integer :: i, j real:: SVProf,SVProfA,SVdPRdT,SVdPRdG,SVdPRdE, tini, tfin real:: SVprofdel, actNormval, Normval, delta ! open(unit=10,file="for_new.out",status="Unknown") Eta = 0.5 Gamma = 0.06 S_L = 0.045 !0.015 as distributed D_L = 0.0000 !0.04 as distributed ! S_L = 0.055 !0.015 as distributed ! D_L = 0.04 !0.04 as distributed ! S_L = 0.015 !0.015 as distributed ! D_L = 0.050 !0.04 as distributed ! D_L = 0.000 ! S_L = 0.125 TwoTH0 = 4.0 call Init_Prof_Val() Use_HPS = .true. write(10,*) '# Output of modified profile.for program.' write(10,*) '# This version with revised derivative calculation' write(10,*) '# Columns headed "num" are numerical equivalents' write(10,*) '# of the previous column obtained by calculating' write(10,*) '# (F(x+h)-F(x-h))/2h, h = 0.1,0.01,0.001,0.0001' if(use_hps) then write(10,*) '# Eta=',Eta,'Gamma=',gamma,'D+S=',S_L,'D-S=',D_L, 'two theta=',twoth0 else write(10,*) '# Eta=',Eta,'Gamma=',gamma,'S=',S_L,'D=',D_L,'two theta=',twoth0 end if write(10,'(a)')'# TwoTH Profile Prof-a dPR/dT ' & //' dPR/dG dPR/dE dPR/dTa dPR/dGa dPR/dEa ' & //'dPR/dSa num dPR/dDa num ' call cpu_time(tini) do i = 1,200 TwoTH = (i-100)*0.01 + TwoTH0 Use_Asym = .false. call Prof_val( Eta , Gamma , S_L , D_L , TwoTH ,TwoTH0 , dPRdT, dPRdG, & dPRdE , dPRdS , dPRdD , SVProf, Use_Asym, Use_HPS) SVdPRdT = dPRdT SVdPRdG = dPRdG SVdPRdE = dPRdE delta = 0.001 !for numerical derivatives do j=1,3 Use_Asym = .true. call Prof_val( Eta , Gamma , S_L+delta , D_L , TwoTH , TwoTH0 , dPRdT, dPRdG, dPRdE , & dPRdS , dPRdD , SVProfA, Use_Asym, Use_HPS ) call Prof_val( Eta, Gamma, S_L-delta,D_L, TwoTH, TwoTH0, dPRdT, dPRdG, dPRdE , & dPRdS , dPRdD , SVProfdel, Use_Asym , Use_HPS) dprdsnum = (SVProfA - SVProfdel)/(2.0*delta) call Prof_val( Eta , Gamma , S_L , D_L+delta , TwoTH , TwoTH0 , dPRdT, dPRdG, dPRdE ,& dPRdS , dPRdD , SVProfA,Use_Asym,Use_HPS ) call Prof_val( Eta, Gamma, S_L,D_L-delta, TwoTH, TwoTH0, dPRdT, dPRdG, dPRdE , & dPRdS , dPRdD , SVProfdel,Use_Asym, Use_HPS ) dprddnum = (SVProfA - SVProfdel)/(2.0*delta) call Prof_val( Eta , Gamma , S_L , D_L , TwoTH ,TwoTH0 , dPRdT, dPRdG, dPRdE , & dPRdS , dPRdD , SVProfA, Use_Asym, Use_HPS) write(10,'(13f10.4,f8.5,f10.4)')TwoTH,SVProf,SVProfA,SVdPRdT, SVdPRdG,SVdPRdE,dPRdT,dPRdG, dPRdE,dPRdS, & dprdsnum,dPRdD,dprddnum,delta delta = delta * 0.1 end do write(10,*) write(10,'(a)')'# TwoTH Profile Prof-a dPR/dT dPR/dG dPR/dE dPR/dTa dPR/dGa ' & //'dPR/dEa dPR/dSa num dPR/dDa num delta' end do call cpu_time(tfin) write(*,"(a,f9.6,a)") " => CPU-time: ",tfin-tini," seconds" stop End Program Test_Profile