/*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 "dbmp1.h" #include #include void /*FUNCTION*/ dbmp1( double x, double *ampl, double *theta) { long int _l0; double z; static double eta; static double bm1cs[37]={.1069845452618063014969985308538e0,.3274915039715964900729055143445e-2, -.2987783266831698592030445777938e-4,.8331237177991974531393222669023e-6, -.4112665690302007304896381725498e-7,.2855344228789215220719757663161e-8, -.2485408305415623878060026596055e-9,.2543393338072582442742484397174e-10, -.2941045772822967523489750827909e-11,.3743392025493903309265056153626e-12, -.5149118293821167218720548243527e-13,.7552535949865143908034040764199e-14, -.1169409706828846444166290622464e-14,.1896562449434791571721824605060e-15, -.3201955368693286420664775316394e-16,.5599548399316204114484169905493e-17, -.1010215894730432443119390444544e-17,.1873844985727562983302042719573e-18, -.3563537470328580219274301439999e-19,.6931283819971238330422763519999e-20, -.1376059453406500152251408930133e-20,.2783430784107080220599779327999e-21, -.5727595364320561689348669439999e-22,.1197361445918892672535756799999e-22, -.2539928509891871976641440426666e-23,.5461378289657295973069619199999e-24, -.1189211341773320288986289493333e-24,.2620150977340081594957824000000e-25, -.5836810774255685901920938666666e-26,.1313743500080595773423615999999e-26, -.2985814622510380355332778666666e-27,.6848390471334604937625599999999e-28, -.1584401568222476721192960000000e-28,.3695641006570938054301013333333e-29, -.8687115921144668243012266666666e-30,.2057080846158763462929066666666e-30, -.4905225761116225518523733333333e-31}; static double bt12cs[39]={.73823860128742974662620839792764e0, -.33361113174483906384470147681189e-2,.61463454888046964698514899420186e-4, -.24024585161602374264977635469568e-5,.14663555577509746153210591997204e-6, -.11841917305589180567005147504983e-7,.11574198963919197052125466303055e-8, -.13001161129439187449366007794571e-9,.16245391141361731937742166273667e-10, -.22089636821403188752155441770128e-11,.32180304258553177090474358653778e-12, -.49653147932768480785552021135381e-13,.80438900432847825985558882639317e-14, -.13589121310161291384694712682282e-14,.23810504397147214869676529605973e-15, -.43081466363849106724471241420799e-16,.80202544032771002434993512550400e-17, -.15316310642462311864230027468799e-17,.29928606352715568924073040554666e-18, -.59709964658085443393815636650666e-19,.12140289669415185024160852650666e-19, -.25115114696612948901006977706666e-20,.52790567170328744850738380799999e-21, -.11260509227550498324361161386666e-21,.24348277359576326659663462400000e-22, -.53317261236931800130038442666666e-23,.11813615059707121039205990399999e-23, -.26465368283353523514856789333333e-24,.59903394041361503945577813333333e-25, -.13690854630829503109136383999999e-25,.31576790154380228326413653333333e-26, -.73457915082084356491400533333333e-27,.17228081480722747930705920000000e-27, -.40716907961286507941068800000000e-28,.96934745136779622700373333333333e-29, -.23237636337765716765354666666666e-29,.56074510673522029406890666666666e-30, -.13616465391539005860522666666666e-30,.33263109233894654388906666666666e-31}; static double bm12cs[40]={.9807979156233050027272093546937e-1, .1150961189504685306175483484602e-2,-.4312482164338205409889358097732e-5, .5951839610088816307813029801832e-7,-.1704844019826909857400701586478e-8, .7798265413611109508658173827401e-10,-.4958986126766415809491754951865e-11, .4038432416421141516838202265144e-12,-.3993046163725175445765483846645e-13, .4619886183118966494313342432775e-14,-.6089208019095383301345472619333e-15, .8960930916433876482157048041249e-16,-.1449629423942023122916518918925e-16, .2546463158537776056165149648068e-17,-.4809472874647836444259263718620e-18, .9687684668292599049087275839124e-19,-.2067213372277966023245038117551e-19, .4646651559150384731802767809590e-20,-.1094966128848334138241351328339e-20, .2693892797288682860905707612785e-21,-.6894992910930374477818970026857e-22, .1830268262752062909890668554740e-22,-.5025064246351916428156113553224e-23, .1423545194454806039631693634194e-23,-.4152191203616450388068886769801e-24, .1244609201503979325882330076547e-24,-.3827336370569304299431918661286e-25, .1205591357815617535374723981835e-25,-.3884536246376488076431859361124e-26, .1278689528720409721904895283461e-26,-.4295146689447946272061936915912e-27, .1470689117829070886456802707983e-27,-.5128315665106073128180374017796e-28, .1819509585471169385481437373286e-28,-.6563031314841980867618635050373e-29, .2404898976919960653198914875834e-29,-.8945966744690612473234958242979e-30, .3376085160657231026637148978240e-30,-.1291791454620656360913099916966e-30, .5008634462958810520684951501254e-31}; static double bth1cs[44]={.74749957203587276055443483969695e0, -.12400777144651711252545777541384e-2,.99252442404424527376641497689592e-5, -.20303690737159711052419375375608e-6,.75359617705690885712184017583629e-8, -.41661612715343550107630023856228e-9,.30701618070834890481245102091216e-10, -.28178499637605213992324008883924e-11,.30790696739040295476028146821647e-12, -.38803300262803434112787347554781e-13,.55096039608630904934561726208562e-14, -.86590060768383779940103398953994e-15,.14856049141536749003423689060683e-15, -.27519529815904085805371212125009e-16,.54550796090481089625036223640923e-17, -.11486534501983642749543631027177e-17,.25535213377973900223199052533522e-18, -.59621490197413450395768287907849e-19,.14556622902372718620288302005833e-19, -.37022185422450538201579776019593e-20,.97763074125345357664168434517924e-21, -.26726821639668488468723775393052e-21,.75453300384983271794038190655764e-22, -.21947899919802744897892383371647e-22,.65648394623955262178906999817493e-23, -.20155604298370207570784076869519e-23,.63417768556776143492144667185670e-24, -.20419277885337895634813769955591e-24,.67191464220720567486658980018551e-25, -.22569079110207573595709003687336e-25,.77297719892989706370926959871929e-26, -.26967444512294640913211424080920e-26,.95749344518502698072295521933627e-27, -.34569168448890113000175680827627e-27,.12681234817398436504211986238374e-27, -.47232536630722639860464993713445e-28,.17850008478186376177858619796417e-28, -.68404361004510395406215223566746e-29,.26566028671720419358293422672212e-29, -.10450402527914452917714161484670e-29,.41618290825377144306861917197064e-30, -.16771639203643714856501347882887e-30,.68361997776664389173535928028528e-31, -.28172247861233641166739574622810e-31}; static double pi4 = 0.785398163397448309615660845819876e0; static long nbm1 = 0; static long nbt12 = 0; static long nbm12 = 0; static long nbth1 = 0; static double xmax = 0.e0; /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const Bm12cs = &bm12cs[0] - 1; double *const Bm1cs = &bm1cs[0] - 1; double *const Bt12cs = &bt12cs[0] - 1; double *const Bth1cs = &bth1cs[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 DBMP1 Krogh Very minor clean up of code. *>> 1996-04-27 DBMP1 Krogh Changes to use .C. and C%%. *>> 1996-03-30 DBMP1 Krogh Added external statement. *>> 1995-11-28 DBMP1 Krogh Changes to simplify conversion to C. *>> 1995-11-03 DBMP1 Krogh Removed blanks in numbers for C conversion. *>> 1994-11-11 DBMP1 Krogh Declared all vars. *>> 1994-10-20 DBMP1 Krogh Changes to use M77CON *>> 1991-01-14 DBMP1 CLL Changed to use generic name SQRT *>> 1990-11-29 CLL Changed subroutine name to DBMP1 *>> 1985-08-02 D9B1MP 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 J1 AND Y1 FUNCTIONS. * * ------------------------------------------------------------------ *--D replaces "?": ?BMP1, ?INITS, ?CSEVL, ?ERM1, ?ERV1 * ------------------------------------------------------------------ */ /* SERIES FOR BM1 ON THE INTERVAL 1.56250D-02 TO 6.25000D-02 * WITH WEIGHTED ERROR 4.91D-32 * LOG WEIGHTED ERROR 31.31 * SIGNIFICANT FIGURES REQUIRED 30.04 * DECIMAL PLACES REQUIRED 32.09 * *++ Save data by elements if ~.C. */ /* SERIES FOR BT12 ON THE INTERVAL 1.56250D-02 TO 6.25000D-02 * WITH WEIGHTED ERROR 3.33D-32 * LOG WEIGHTED ERROR 31.48 * SIGNIFICANT FIGURES REQUIRED 31.05 * DECIMAL PLACES REQUIRED 32.27 * *++ Save data by elements if ~.C. */ /* SERIES FOR BM12 ON THE INTERVAL 0. TO 1.56250D-02 * WITH WEIGHTED ERROR 5.01D-32 * LOG WEIGHTED ERROR 31.30 * SIGNIFICANT FIGURES REQUIRED 29.99 * DECIMAL PLACES REQUIRED 32.10 * *++ Save data by elements if ~.C. */ /* SERIES FOR BTH1 ON THE INTERVAL 0. TO 1.56250D-02 * WITH WEIGHTED ERROR 2.82D-32 * LOG WEIGHTED ERROR 31.55 * SIGNIFICANT FIGURES REQUIRED 31.12 * DECIMAL PLACES REQUIRED 32.37 * *++ Save data by elements if ~.C. */ /* ------------------------------------------------------------------ */ if (nbm1 == 0) { eta = 0.1e0*DBL_EPSILON/FLT_RADIX; dinits( bm1cs, 37, eta, &nbm1 ); dinits( bt12cs, 39, eta, &nbt12 ); dinits( bm12cs, 40, eta, &nbm12 ); dinits( bth1cs, 44, eta, &nbth1 ); xmax = 0.04e0/DBL_EPSILON; } if (x < 4.e0) { *ampl = 0.e0; *theta = 0.e0; derm1( "DBMP1", 1, 0, "X MUST BE .GE. 4", "X", x, '.' ); } if (x <= 8.e0) { z = (128.e0/(x*x) - 5.e0)/3.e0; *ampl = (0.75e0 + dcsevl( z, bm1cs, nbm1 ))/sqrt( x ); *theta = x - 3*pi4 + dcsevl( z, bt12cs, nbt12 )/x; return; } if (x > xmax) { *ampl = 0.e0; *theta = 0.e0; derm1( "DBMP1", 2, 0, "NO PRECISION BECAUSE X .GT. XMAX", "X", x, ',' ); derv1( "XMAX", xmax, '.' ); } z = 128.e0/(x*x) - 1.e0; *ampl = (0.75e0 + dcsevl( z, bm12cs, nbm12 ))/sqrt( x ); *theta = x - 3*pi4 + dcsevl( z, bth1cs, nbth1 )/x; return; } /* end of function */