/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:55 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "dbmp0.h" #include #include void /*FUNCTION*/ dbmp0( double x, double *ampl, double *theta) { long int _l0; double z; static double eta; static double bm0cs[37]={.9211656246827742712573767730182e-1,-.1050590997271905102480716371755e-2, .1470159840768759754056392850952e-4,-.5058557606038554223347929327702e-6, .2787254538632444176630356137881e-7,-.2062363611780914802618841018973e-8, .1870214313138879675138172596261e-9,-.1969330971135636200241730777825e-10, .2325973793999275444012508818052e-11,-.3009520344938250272851224734482e-12, .4194521333850669181471206768646e-13,-.6219449312188445825973267429564e-14, .9718260411336068469601765885269e-15,-.1588478585701075207366635966937e-15, .2700072193671308890086217324458e-16,-.4750092365234008992477504786773e-17, .8615128162604370873191703746560e-18,-.1605608686956144815745602703359e-18, .3066513987314482975188539801599e-19,-.5987764223193956430696505617066e-20, .1192971253748248306489069841066e-20,-.2420969142044805489484682581333e-21, .4996751760510616453371002879999e-22,-.1047493639351158510095040511999e-22, .2227786843797468101048183466666e-23,-.4801813239398162862370542933333e-24, .1047962723470959956476996266666e-24,-.2313858165678615325101260800000e-25, .5164823088462674211635199999999e-26,-.1164691191850065389525401599999e-26, .2651788486043319282958336000000e-27,-.6092559503825728497691306666666e-28, .1411804686144259308038826666666e-28,-.3298094961231737245750613333333e-29, .7763931143074065031714133333333e-30,-.1841031343661458478421333333333e-30, .4395880138594310737100799999999e-31}; static double bth0cs[44]={-.24901780862128936717709793789967e0, .48550299609623749241048615535485e-3,-.54511837345017204950656273563505e-5, .13558673059405964054377445929903e-6,-.55691398902227626227583218414920e-8, .32609031824994335304004205719468e-9,-.24918807862461341125237903877993e-10, .23449377420882520554352413564891e-11,-.26096534444310387762177574766136e-12, .33353140420097395105869955014923e-13,-.47890000440572684646750770557409e-14, .75956178436192215972642568545248e-15,-.13131556016891440382773397487633e-15, .24483618345240857495426820738355e-16,-.48805729810618777683256761918331e-17, .10327285029786316149223756361204e-17,-.23057633815057217157004744527025e-18, .54044443001892693993017108483765e-19,-.13240695194366572724155032882385e-19, .33780795621371970203424792124722e-20,-.89457629157111779003026926292299e-21, .24519906889219317090899908651405e-21,-.69388422876866318680139933157657e-22, .20228278714890138392946303337791e-22,-.60628500002335483105794195371764e-23, .18649748964037635381823788396270e-23,-.58783732384849894560245036530867e-24, .18958591447999563485531179503513e-24,-.62481979372258858959291620728565e-25, .21017901684551024686638633529074e-25,-.72084300935209253690813933992446e-26, .25181363892474240867156405976746e-26,-.89518042258785778806143945953643e-27, .32357237479762298533256235868587e-27,-.11883010519855353657047144113796e-27, .44306286907358104820579231941731e-28,-.16761009648834829495792010135681e-28, .64292946921207466972532393966088e-29,-.24992261166978652421207213682763e-29, .98399794299521955672828260355318e-30,-.39220375242408016397989131626158e-30, .15818107030056522138590618845692e-30,-.64525506144890715944344098365426e-31, .26611111369199356137177018346367e-31}; static double bm02cs[40]={.9500415145228381369330861335560e-1, -.3801864682365670991748081566851e-3,.2258339301031481192951829927224e-5, -.3895725802372228764730621412605e-7,.1246886416512081697930990529725e-8, -.6065949022102503779803835058387e-10,.4008461651421746991015275971045e-11, -.3350998183398094218467298794574e-12,.3377119716517417367063264341996e-13, -.3964585901635012700569356295823e-14,.5286111503883857217387939744735e-15, -.7852519083450852313654640243493e-16,.1280300573386682201011634073449e-16, -.2263996296391429776287099244884e-17,.4300496929656790388646410290477e-18, -.8705749805132587079747535451455e-19,.1865862713962095141181442772050e-19, -.4210482486093065457345086972301e-20,.9956676964228400991581627417842e-21, -.2457357442805313359605921478547e-21,.6307692160762031568087353707059e-22, -.1678773691440740142693331172388e-22,.4620259064673904433770878136087e-23, -.1311782266860308732237693402496e-23,.3834087564116302827747922440276e-24, -.1151459324077741271072613293576e-24,.3547210007523338523076971345213e-25, -.1119218385815004646264355942176e-25,.3611879427629837831698404994257e-26, -.1190687765913333150092641762463e-26,.4005094059403968131802476449536e-27, -.1373169422452212390595193916017e-27,.4794199088742531585996491526437e-28, -.1702965627624109584006994476452e-28,.6149512428936330071503575161324e-29, -.2255766896581828349944300237242e-29,.8399707509294299486061658353200e-30, -.3172997595562602355567423936152e-30,.1215205298881298554583333026514e-30, -.4715852749754438693013210568045e-31}; static double bt02cs[39]={-.24548295213424597462050467249324e0, .12544121039084615780785331778299e-2,-.31253950414871522854973446709571e-4, .14709778249940831164453426969314e-5,-.99543488937950033643468850351158e-7, .85493166733203041247578711397751e-8,-.86989759526554334557985512179192e-9, .10052099533559791084540101082153e-9,-.12828230601708892903483623685544e-10, .17731700781805131705655750451023e-11,-.26174574569485577488636284180925e-12, .40828351389972059621966481221103e-13,-.66751668239742720054606749554261e-14, .11365761393071629448392469549951e-14,-.20051189620647160250559266412117e-15, .36497978794766269635720591464106e-16,-.68309637564582303169355843788800e-17, .13107583145670756620057104267946e-17,-.25723363101850607778757130649599e-18, .51521657441863959925267780949333e-19,-.10513017563758802637940741461333e-19, .21820381991194813847301084501333e-20,-.46004701210362160577225905493333e-21, .98407006925466818520953651199999e-22,-.21334038035728375844735986346666e-22, .46831036423973365296066286933333e-23,-.10400213691985747236513382399999e-23, .23349105677301510051777740800000e-24,-.52956825323318615788049749333333e-25, .12126341952959756829196287999999e-25,-.28018897082289428760275626666666e-26, .65292678987012873342593706666666e-27,-.15337980061873346427835733333333e-27, .36305884306364536682359466666666e-28,-.86560755713629122479172266666666e-29, .20779909972536284571238399999999e-29,-.50211170221417221674325333333333e-30, .12208360279441714184191999999999e-30,-.29860056267039913454250666666666e-31}; static double pi4 = 0.785398163397448309615660845819876e0; static long nbm0 = 0; static long nbt02 = 0; static long nbm02 = 0; static long nbth0 = 0; static double xmax = 0.e0; /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const Bm02cs = &bm02cs[0] - 1; double *const Bm0cs = &bm0cs[0] - 1; double *const Bt02cs = &bt02cs[0] - 1; double *const Bth0cs = &bth0cs[0] - 1; /* end of OFFSET VECTORS */ /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 2002-03-29 DBMP0 Krogh Very minor clean up of code. *>> 1996-04-27 DBMP0 Krogh Changes to use .C. and C%%. *>> 1996-03-30 DBMP0 Krogh Added external statement. *>> 1995-11-28 DBMP0 Krogh Changes to simplify conversion to C. *>> 1995-11-03 DBMP0 Krogh Removed blanks in numbers for C conversion. *>> 1994-11-11 DBMP0 Krogh Declared all vars. *>> 1994-10-20 DBMP0 Krogh Changes to use M77CON *>> 1991-01-14 DBMP0 CLL Changed to generic name SQRT *>> 1990-11-29 DBMP0 CLL Changed subroutine name to DBMP0 *>> 1985-12-03 D9B0MP Lawson Initial code. * JULY 1977 EDITION. W. FULLERTON, C3, LOS ALAMOS SCIENTIFIC LAB. * C.L.LAWSON & S.CHAN, JPL, 1984 FEB ADAPTED TO JPL MATH77 LIBRARY. * * EVALUATE THE MODULUS AND PHASE FOR THE BESSEL J0 AND Y0 FUNCTIONS. * (13-JAN-83) : UTAH: MISSING ARGUMENT 37 INSERTED FOLLOWING * 37H.. IN LAST CALL TO XERROR * ------------------------------------------------------------------ *--D replaces "?": ?BMP0, ?INITS, ?CSEVL, ?ERM1, ?ERV1 * ------------------------------------------------------------------ */ /* SERIES FOR BM0 ON THE INTERVAL 1.56250D-02 TO 6.25000D-02 * WITH WEIGHTED ERROR 4.40D-32 * LOG WEIGHTED ERROR 31.36 * SIGNIFICANT FIGURES REQUIRED 30.02 * DECIMAL PLACES REQUIRED 32.14 * *++ Save data by elements if ~.C. */ /* SERIES FOR BTH0 ON THE INTERVAL 0. TO 1.56250D-02 * WITH WEIGHTED ERROR 2.66D-32 * LOG WEIGHTED ERROR 31.57 * SIGNIFICANT FIGURES REQUIRED 30.67 * DECIMAL PLACES REQUIRED 32.40 * *++ Save data by elements if ~.C. */ /* SERIES FOR BM02 ON THE INTERVAL 0. TO 1.56250D-02 * WITH WEIGHTED ERROR 4.72D-32 * LOG WEIGHTED ERROR 31.33 * SIGNIFICANT FIGURES REQUIRED 30.00 * DECIMAL PLACES REQUIRED 32.13 * *++ Save data by elements if ~.C. */ /* SERIES FOR BT02 ON THE INTERVAL 1.56250D-02 TO 6.25000D-02 * WITH WEIGHTED ERROR 2.99D-32 * LOG WEIGHTED ERROR 31.52 * SIGNIFICANT FIGURES REQUIRED 30.61 * DECIMAL PLACES REQUIRED 32.32 * *++ Save data by elements if ~.C. */ /* ------------------------------------------------------------------ */ if (nbm0 == 0) { eta = 0.1e0*DBL_EPSILON/FLT_RADIX; dinits( bm0cs, 37, eta, &nbm0 ); dinits( bt02cs, 39, eta, &nbt02 ); dinits( bm02cs, 40, eta, &nbm02 ); dinits( bth0cs, 44, eta, &nbth0 ); xmax = 0.04e0/DBL_EPSILON; } if (x < 4.e0) { *ampl = 0.e0; *theta = 0.e0; derm1( "DBMP0", 1, 0, "X MUST BE .GE. 4", "X", x, '.' ); } if (x <= 8.e0) { z = (128.e0/(x*x) - 5.e0)/3.e0; *ampl = (.75e0 + dcsevl( z, bm0cs, nbm0 ))/sqrt( x ); *theta = x - pi4 + dcsevl( z, bt02cs, nbt02 )/x; return; } if (x > xmax) { *ampl = 0.e0; *theta = 0.e0; derm1( "DBMP0", 2, 0, "NO PRECISION BECAUSE X .GT. XMAX", "X", x, ',' ); derv1( "XMAX", xmax, '.' ); } z = 128.e0/(x*x) - 1.e0; *ampl = (.75e0 + dcsevl( z, bm02cs, nbm02 ))/sqrt( x ); *theta = x - pi4 + dcsevl( z, bth0cs, nbth0 )/x; return; } /* end of function */