/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:57 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "sbmp1.h" #include #include void /*FUNCTION*/ sbmp1( float x, float *ampl, float *theta) { long int _l0; float z; static float eta; static float 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 float 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 float 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 float 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 float pi4 = 0.785398163397448309615660845819876e0; static long nbm1 = 0; static long nbt12 = 0; static long nbm12 = 0; static long nbth1 = 0; static float xmax = 0.e0; /* OFFSET Vectors w/subscript range: 1 to dimension */ float *const Bm12cs = &bm12cs[0] - 1; float *const Bm1cs = &bm1cs[0] - 1; float *const Bt12cs = &bt12cs[0] - 1; float *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 SBMP1 Krogh Very minor clean up of code. *>> 1996-04-27 SBMP1 Krogh Changes to use .C. and C%%. *>> 1996-03-30 SBMP1 Krogh Added external statement. *>> 1995-11-28 SBMP1 Krogh Changes to simplify conversion to C. *>> 1995-11-03 SBMP1 Krogh Removed blanks in numbers for C conversion. *>> 1994-11-11 SBMP1 Krogh Declared all vars. *>> 1994-10-20 SBMP1 Krogh Changes to use M77CON *>> 1991-01-14 SBMP1 CLL Changed to use generic name SQRT *>> 1990-11-29 CLL Changed subroutine name to SBMP1 *>> 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. * * ------------------------------------------------------------------ *--S replaces "?": ?BMP1, ?INITS, ?CSEVL, ?ERM1, ?ERV1 * ------------------------------------------------------------------ */ /* SERIES FOR BM1 ON THE INTERVAL 1.56250E-02 TO 6.25000E-02 * WITH WEIGHTED ERROR 4.91E-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.56250E-02 TO 6.25000E-02 * WITH WEIGHTED ERROR 3.33E-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.56250E-02 * WITH WEIGHTED ERROR 5.01E-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.56250E-02 * WITH WEIGHTED ERROR 2.82E-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*FLT_EPSILON/FLT_RADIX; sinits( bm1cs, 37, eta, &nbm1 ); sinits( bt12cs, 39, eta, &nbt12 ); sinits( bm12cs, 40, eta, &nbm12 ); sinits( bth1cs, 44, eta, &nbth1 ); xmax = 0.04e0/FLT_EPSILON; } if (x < 4.e0) { *ampl = 0.e0; *theta = 0.e0; serm1( "SBMP1", 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 + scsevl( z, bm1cs, nbm1 ))/sqrtf( x ); *theta = x - 3*pi4 + scsevl( z, bt12cs, nbt12 )/x; return; } if (x > xmax) { *ampl = 0.e0; *theta = 0.e0; serm1( "SBMP1", 2, 0, "NO PRECISION BECAUSE X .GT. XMAX", "X", x, ',' ); serv1( "XMAX", xmax, '.' ); } z = 128.e0/(x*x) - 1.e0; *ampl = (0.75e0 + scsevl( z, bm12cs, nbm12 ))/sqrtf( x ); *theta = x - 3*pi4 + scsevl( z, bth1cs, nbth1 )/x; return; } /* end of function */