/*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 "dei.h" #include #include double /*FUNCTION*/ dei( double xin) { double dei_v; /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1996-04-27 DEI Krogh Changes to use .C. and C%%. *>> 1996-03-30 DEI Krogh Added external statements. *>> 1995-11-28 DEI Krogh GO TO's => blodk IF's, removed multiple entry. *>> 1995-11-14 DEI Krogh Changes to simplify conversion to C. *>> 1995-11-03 DEI Krogh Removed blanks in numbers for C conversion. *>> 1994-10-20 DEI Krogh Changes to use M77CON *>> 1994-04-20 DEI CLL Edited type stmts to make DP & SP files similar. *>> 1992-03-13 DEI FTK Removed implicit statements. *>> 1991-01-14 CLL DE1 Changed to generic name ABS *>> 1990-11-29 CLL *>> 1985-08-02 DEI Lawson Initial code. * * JULY 1977 EDITION. W. FULLERTON, C3, * LOS ALAMOS SCIENTIFIC LAB. * * REORGANIZATION OF FULLERTON'S DEI & DE1, * C.L. LAWSON & S.CHAN, JUNE 1983, JPL. * * ---------------------------------------------------------------- * MACHINE DEPENDENT VALUES ARE SET ON THE FIRST ENTRY * TO THIS CODE. EXAMPLES OF THESE VALUES FOLLOW: * * SYSTEM NTAE10 NTAE11 NTAE12 NTAE13 NTAE14 * ------ ------ ------ ------ ------ ------ * UNIVAC S.P. ** 16 14 13 12 * UNIVAC D.P. 21 34 24 29 32 * * SYSTEM NTE11 NTE12 XMAX XMIN DELTA * ------ ----- ----- ---- ---- ----- * UNIVAC S.P. 13 10 84.8 -92.41 4.48 * UNIVAC D.P. 19 17 703.2 -714.9 6.56 * * SYSTEM EARG1 EARG2 * ------ ----- ----- * UNIVAC S.P. 89.42 88.03 * UNIVAC D.P. 710.5 709.1 * * ---------------------------------------------------------------- *--D replaces "?": ?E1, ?EI, ?INITS, ?CSEVL, ?ERM1, ?ERV1 * Also uses ERMSG * ------------------------------------------------------------------ */ dei_v = -de1( -xin ); return( dei_v ); } /* end of function */ #include double /*FUNCTION*/ de1( double xin) { long int _l0; double bignum, de1_v, eta, x; static double delta, earg1, earg2, xmin; static long ntae10 = 0; static long ntae11 = 0; static long ntae12 = 0; static long nte11 = 0; static long nte12 = 0; static long ntae13 = 0; static long ntae14 = 0; static double xmax = 0.e0; static double zero = 0.e0; static double fac = 0.999e0; static char msg1[34] = "|X| SO LARGE DE1 or DEI OVERFLOWS"; static char msg2[39] = "X = ZERO, DE1(0) or DEI(0) not defined"; static char msg3[35] = "|X| SO LARGE DE1 or DEI UNDERFLOWS"; static char name[11] = "DE1 or DEI"; static double ae10cs[50]={.3284394579616699087873844201881e-1, -.1669920452031362851476184343387e-1,.2845284724361346807424899853252e-3, -.7563944358516206489487866938533e-5,.2798971289450859157504843180879e-6, -.1357901828534531069525563926255e-7,.8343596202040469255856102904906e-9, -.6370971727640248438275242988532e-10,.6007247608811861235760831561584e-11, -.7022876174679773590750626150088e-12,.1018302673703687693096652346883e-12, -.1761812903430880040406309966422e-13,.3250828614235360694244030353877e-14, -.5071770025505818678824872259044e-15,.1665177387043294298172486084156e-16, .3166753890797514400677003536555e-16,-.1588403763664141515133118343538e-16, .4175513256138018833003034618484e-17,-.2892347749707141906710714478852e-18, -.2800625903396608103506340589669e-18,.1322938639539270903707580023781e-18, -.1804447444177301627283887833557e-19,-.7905384086522616076291644817604e-20, .4435711366369570103946235838027e-20,-.4264103994978120868865309206555e-21, -.3920101766937117541553713162048e-21,.1527378051343994266343752326971e-21, .1024849527049372339310308783117e-22,-.2134907874771433576262711405882e-22, .3239139475160028267061694700366e-23,.2142183762299889954762643168296e-23, -.8234609419601018414700348082312e-24,-.1524652829645809479613694401140e-24, .1378208282460639134668480364325e-24,.2131311202833947879523224999253e-26, -.2012649651526484121817466763127e-25,.1995535662263358016106311782673e-26, .2798995808984003464948686520319e-26,-.5534511845389626637640819277823e-27, -.3884995396159968861682544026146e-27,.1121304434507359382850680354679e-27, .5566568152423740948256563833514e-28,-.2045482929810499700448533938176e-28, -.8453813992712336233411457493674e-29,.3565758433431291562816111116287e-29, .1383653872125634705539949098871e-29,-.6062167864451372436584533764778e-30, -.2447198043989313267437655119189e-30,.1006850640933998348011548180480e-30, .4623685555014869015664341461674e-31}; static double ae11cs[60]={.20263150647078889499401236517381e0, -.73655140991203130439536898728034e-1,.63909349118361915862753283840020e-2, -.60797252705247911780653153363999e-3,-.73706498620176629330681411493484e-4, .48732857449450183453464992488076e-4,-.23837064840448290766588489460235e-5, -.30518612628561521027027332246121e-5,.17050331572564559009688032992907e-6, .23834204527487747258601598136403e-6,.10781772556163166562596872364020e-7, -.17955692847399102653642691446599e-7,-.41284072341950457727912394640436e-8, .68622148588631968618346844526664e-9,.53130183120506356147602009675961e-9, .78796880261490694831305022893515e-10,-.26261762329356522290341675271232e-10, -.15483687636308261963125756294100e-10,-.25818962377261390492802405122591e-11, .59542879191591072658903529959352e-12,.46451400387681525833784919321405e-12, .11557855023255861496288006203731e-12,-.10475236870835799012317547189670e-14, -.11896653502709004368104489260929e-13,-.47749077490261778752643019349950e-14, -.81077649615772777976249734754135e-15,.13435569250031554199376987998178e-15, .14134530022913106260248873881287e-15,.49451592573953173115520663232883e-16, .79884048480080665648858587399367e-17,-.14008632188089809829248711935393e-17, -.14814246958417372107722804001680e-17,-.55826173646025601904010693937113e-18, -.11442074542191647264783072544598e-18,.25371823879566853500524018479923e-20, .13205328154805359813278863389097e-19,.62930261081586809166287426789485e-20, .17688270424882713734999261332548e-20,.23266187985146045209674296887432e-21, -.67803060811125233043773831844113e-22,-.59440876959676373802874150531891e-22, -.23618214531184415968532592503466e-22,-.60214499724601478214168478744576e-23, -.65517906474348299071370444144639e-24,.29388755297497724587042038699349e-24, .22601606200642115173215728758510e-24,.89534369245958628745091206873087e-25, .24015923471098457555772067457706e-25,.34118376888907172955666423043413e-26, -.71617071694630342052355013345279e-27,-.75620390659281725157928651980799e-27, -.33774612157467324637952920780800e-27,-.10479325703300941711526430332245e-27, -.21654550252170342240854880201386e-28,-.75297125745288269994689298432000e-30, .19103179392798935768638084000426e-29,.11492104966530338547790728833706e-29, .43896970582661751514410359193600e-30,.12320883239205686471647157725866e-30, .22220174457553175317538581162666e-31}; static double ae12cs[41]={.63629589796747038767129887806803e0, -.13081168675067634385812671121135e0,-.84367410213053930014487662129752e-2, .26568491531006685413029428068906e-2,.32822721781658133778792170142517e-3, -.23783447771430248269579807851050e-4,-.11439804308100055514447076797047e-4, -.14405943433238338455239717699323e-5,.52415956651148829963772818061664e-8, .38407306407844323480979203059716e-7,.85880244860267195879660515759344e-8, .10219226625855003286339969553911e-8,.21749132323289724542821339805992e-10, -.22090238142623144809523503811741e-10,-.63457533544928753294383622208801e-11, -.10837746566857661115340539732919e-11,-.11909822872222586730262200440277e-12, -.28438682389265590299508766008661e-14,.25080327026686769668587195487546e-14, .78729641528559842431597726421265e-15,.15475066347785217148484334637329e-15, .22575322831665075055272608197290e-16,.22233352867266608760281380836693e-17, .16967819563544153513464194662399e-19,-.57608316255947682105310087304533e-19, -.17591235774646878055625369408853e-19,-.36286056375103174394755328682666e-20, -.59235569797328991652558143488000e-21,-.76030380926310191114429136895999e-22, -.62547843521711763842641428479999e-23,.25483360759307648606037606400000e-24, .25598615731739857020168874666666e-24,.71376239357899318800207052800000e-25, .14703759939567568181578956800000e-25,.25105524765386733555198634666666e-26, .35886666387790890886583637333333e-27,.39886035156771301763317759999999e-28, .21763676947356220478805333333333e-29,-.46146998487618942367607466666666e-30, -.20713517877481987707153066666666e-30,-.51890378563534371596970666666666e-31}; static double e11cs[29]={-.16113461655571494025720663927566180e2, .77940727787426802769272245891741497e1,-.19554058188631419507127283812814491e1, .37337293866277945611517190865690209e0,-.56925031910929019385263892220051166e-1, .72110777696600918537847724812635813e-2,-.78104901449841593997715184089064148e-3, .73880933562621681878974881366177858e-4,-.62028618758082045134358133607909712e-5, .46816002303176735524405823868362657e-6,-.32092888533298649524072553027228719e-7, .20151997487404533394826262213019548e-8,-.11673686816697793105356271695015419e-9, .62762706672039943397788748379615573e-11,-.31481541672275441045246781802393600e-12, .14799041744493474210894472251733333e-13,-.65457091583979673774263401588053333e-15, .27336872223137291142508012748799999e-16,-.10813524349754406876721727624533333e-17, .40628328040434303295300348586666666e-19,-.14535539358960455858914372266666666e-20, .49632746181648636830198442666666666e-22,-.16208612696636044604866560000000000e-23, .50721448038607422226431999999999999e-25,-.15235811133372207813973333333333333e-26, .44001511256103618696533333333333333e-28,-.12236141945416231594666666666666666e-29, .32809216661066001066666666666666666e-31,-.84933452268306432000000000000000000e-33}; static double e12cs[25]={-.3739021479220279511668698204827e-1, .4272398606220957726049179176528e-1,-.130318207984970054415392055219726e0, .144191240246988907341095893982137e-1,-.134617078051068022116121527983553e-2, .107310292530637799976115850970073e-3,-.742999951611943649610283062223163e-5, .453773256907537139386383211511827e-6,-.247641721139060131846547423802912e-7, .122076581374590953700228167846102e-8,-.548514148064092393821357398028261e-10, .226362142130078799293688162377002e-11,-.863589727169800979404172916282240e-13, .306291553669332997581032894881279e-14,-.101485718855944147557128906734933e-15, .315482174034069877546855328426666e-17,-.923604240769240954484015923200000e-19, .255504267970814002440435029333333e-20,-.669912805684566847217882453333333e-22, .166925405435387319431987199999999e-23,-.396254925184379641856000000000000e-25, .898135896598511332010666666666666e-27,-.194763366993016433322666666666666e-28, .404836019024630033066666666666666e-30,-.807981567699845120000000000000000e-32}; static double ae13cs[50]={-.60577324664060345999319382737747e0, -.11253524348366090030649768852718e0,.13432266247902779492487859329414e-1, -.19268451873811457249246838991303e-2,.30911833772060318335586737475368e-3, -.53564132129618418776393559795147e-4,.98278128802474923952491882717237e-5, -.18853689849165182826902891938910e-5,.37494319356894735406964042190531e-6, -.76823455870552639273733465680556e-7,.16143270567198777552956300060868e-7, -.34668022114907354566309060226027e-8,.75875420919036277572889747054114e-9, -.16886433329881412573514526636703e-9,.38145706749552265682804250927272e-10, -.87330266324446292706851718272334e-11,.20236728645867960961794311064330e-11, -.47413283039555834655210340820160e-12,.11221172048389864324731799928920e-12, -.26804225434840309912826809093395e-13,.64578514417716530343580369067212e-14, -.15682760501666478830305702849194e-14,.38367865399315404861821516441408e-15, -.94517173027579130478871048932556e-16,.23434812288949573293896666439133e-16, -.58458661580214714576123194419882e-17,.14666229867947778605873617419195e-17, -.36993923476444472706592538274474e-18,.93790159936721242136014291817813e-19, -.23893673221937873136308224087381e-19,.61150624629497608051934223837866e-20, -.15718585327554025507719853288106e-20,.40572387285585397769519294491306e-21, -.10514026554738034990566367122773e-21,.27349664930638667785806003131733e-22, -.71401604080205796099355574271999e-23,.18705552432235079986756924211199e-23, -.49167468166870480520478020949333e-24,.12964988119684031730916087125333e-24, -.34292515688362864461623940437333e-25,.90972241643887034329104820906666e-26, -.24202112314316856489934847999999e-26,.64563612934639510757670475093333e-27, -.17269132735340541122315987626666e-27,.46308611659151500715194231466666e-28, -.12448703637214131241755170133333e-28,.33544574090520678532907007999999e-29, -.90598868521070774437543935999999e-30,.24524147051474238587273216000000e-30, -.66528178733552062817107967999999e-31}; static double ae14cs[64]={-.1892918000753016825495679942820e0, -.8648117855259871489968817056824e-1,.7224101543746594747021514839184e-2, -.8097559457557386197159655610181e-3,.1099913443266138867179251157002e-3, -.1717332998937767371495358814487e-4,.2985627514479283322825342495003e-5, -.5659649145771930056560167267155e-6,.1152680839714140019226583501663e-6, -.2495030440269338228842128765065e-7,.5692324201833754367039370368140e-8, -.1359957664805600338490030939176e-8,.3384662888760884590184512925859e-9, -.8737853904474681952350849316580e-10,.2331588663222659718612613400470e-10, -.6411481049213785969753165196326e-11,.1812246980204816433384359484682e-11, -.5253831761558460688819403840466e-12,.1559218272591925698855028609825e-12, -.4729168297080398718476429369466e-13,.1463761864393243502076199493808e-13, -.4617388988712924102232173623604e-14,.1482710348289369323789239660371e-14, -.4841672496239229146973165734417e-15,.1606215575700290408116571966188e-15, -.5408917538957170947895023784252e-16,.1847470159346897881370231402310e-16, -.6395830792759094470500610425050e-17,.2242780721699759457250233276170e-17, -.7961369173983947552744555308646e-18,.2859308111540197459808619929272e-18, -.1038450244701137145900697137446e-18,.3812040607097975780866841008319e-19, -.1413795417717200768717562723696e-19,.5295367865182740958305442594815e-20, -.2002264245026825902137211131439e-20,.7640262751275196014736848610918e-21, -.2941119006868787883311263523362e-21,.1141823539078927193037691483586e-21, -.4469308475955298425247020718489e-22,.1763262410571750770630491408520e-22, -.7009968187925902356351518262340e-23,.2807573556558378922287757507515e-23, -.1132560944981086432141888891562e-23,.4600574684375017946156764233727e-24, -.1881448598976133459864609148108e-24,.7744916111507730845444328478037e-25, -.3208512760585368926702703826261e-25,.1337445542910839760619930421384e-25, -.5608671881802217048894771735210e-26,.2365839716528537483710069473279e-26, -.1003656195025305334065834526856e-26,.4281490878094161131286642556927e-27, -.1836345261815318199691326958250e-27,.7917798231349540000097468678144e-28, -.3431542358742220361025015775231e-28,.1494705493897103237475066008917e-28, -.6542620279865705439739042420053e-29,.2877581395199171114340487353685e-29, -.1271557211796024711027981200042e-29,.5644615555648722522388044622506e-30, -.2516994994284095106080616830293e-30,.1127259818927510206370368804181e-30, -.5069814875800460855562584719360e-31}; /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const Ae10cs = &ae10cs[0] - 1; double *const Ae11cs = &ae11cs[0] - 1; double *const Ae12cs = &ae12cs[0] - 1; double *const Ae13cs = &ae13cs[0] - 1; double *const Ae14cs = &ae14cs[0] - 1; double *const E11cs = &e11cs[0] - 1; double *const E12cs = &e12cs[0] - 1; /* end of OFFSET VECTORS */ /* SERIES FOR AE10 ON THE INTERVAL -3.12500D-02 TO 0. * WITH WEIGHTED ERROR 4.62D-32 * LOG WEIGHTED ERROR 31.34 * SIGNIFICANT FIGURES REQUIRED 29.70 * DECIMAL PLACES REQUIRED 32.18 * *++ Save data by elements if ~.C. */ /* SERIES FOR AE11 ON THE INTERVAL -1.25000D-01 TO -3.12500D-02 * WITH WEIGHTED ERROR 2.22D-32 * LOG WEIGHTED ERROR 31.65 * SIGNIFICANT FIGURES REQUIRED 30.75 * DECIMAL PLACES REQUIRED 32.54 * *++ Save data by elements if ~.C. */ /* SERIES FOR AE12 ON THE INTERVAL -2.50000D-01 TO -1.25000D-01 * WITH WEIGHTED ERROR 5.19D-32 * LOG WEIGHTED ERROR 31.28 * SIGNIFICANT FIGURES REQUIRED 30.82 * DECIMAL PLACES REQUIRED 32.09 * *++ Save data by elements if ~.C. */ /* SERIES FOR E11 ON THE INTERVAL -4.00000D+00 TO -1.00000D+00 * WITH WEIGHTED ERROR 8.49D-34 * LOG WEIGHTED ERROR 33.07 * SIGNIFICANT FIGURES REQUIRED 34.13 * DECIMAL PLACES REQUIRED 33.80 * *++ Save data by elements if ~.C. */ /* SERIES FOR E12 ON THE INTERVAL -1.00000D+00 TO 1.00000D+00 * WITH WEIGHTED ERROR 8.08D-33 * LOG WEIGHTED ERROR 32.09 * APPROX SIGNIFICANT FIGURES REQUIRED 30.4 * DECIMAL PLACES REQUIRED 32.79 * *++ Save data by elements if ~.C. */ /* SERIES FOR AE13 ON THE INTERVAL 2.50000D-01 TO 1.00000D+00 * WITH WEIGHTED ERROR 6.65D-32 * LOG WEIGHTED ERROR 31.18 * SIGNIFICANT FIGURES REQUIRED 30.69 * DECIMAL PLACES REQUIRED 32.03 * *++ Save data by elements if ~.C. */ /* SERIES FOR AE14 ON THE INTERVAL 0. TO 2.50000D-01 * WITH WEIGHTED ERROR 5.07D-32 * LOG WEIGHTED ERROR 31.30 * SIGNIFICANT FIGURES REQUIRED 30.40 * DECIMAL PLACES REQUIRED 32.20 * *++ Save data by elements if ~.C. */ /* ------------------------------------------------------------------ * */ x = xin; if (ntae10 == 0) { bignum = DBL_MAX; eta = 0.1e0*DBL_EPSILON/FLT_RADIX; dinits( ae10cs, 50, eta, &ntae10 ); dinits( ae11cs, 60, eta, &ntae11 ); dinits( ae12cs, 41, eta, &ntae12 ); dinits( e11cs, 29, eta, &nte11 ); dinits( e12cs, 25, eta, &nte12 ); dinits( ae13cs, 50, eta, &ntae13 ); dinits( ae14cs, 64, eta, &ntae14 ); /* SETTING XMAX TO AVOID UNDERFLOW. * */ earg1 = -log( DBL_MIN ); xmax = (earg1 - log( earg1 ))*fac; /* SETTING XMIN TO AVOID OVERFLOW. * */ earg2 = log( bignum ); delta = log( earg2 ); xmin = -(earg2 + delta)*fac; } if (x <= (-1.e0)) { if (x <= (-32.e0)) { if (x < xmin) { derm1( name, 1, 0, msg1, "X", xin, ',' ); derv1( "Limit |X|", xmin, '.' ); de1_v = -bignum; } else { de1_v = exp( -x - delta )*(earg2/x)*(1.e0 + dcsevl( 64.e0/ x + 1.e0, ae10cs, ntae10 )); } } else if (x <= (-8.e0)) { de1_v = exp( -x )/x*(1.e0 + dcsevl( (64.e0/x + 5.e0)/3.e0, ae11cs, ntae11 )); } else if (x <= (-4.e0)) { de1_v = exp( -x )/x*(1.e0 + dcsevl( 16.e0/x + 3.e0, ae12cs, ntae12 )); } else { de1_v = -log( -x ) + dcsevl( (2.e0*x + 5.e0)/3.e0, e11cs, nte11 ); } } else if (x <= 1.0e0) { if (x == zero) { ermsg( name, 2, 0, msg2, '.' ); de1_v = bignum; } else { de1_v = (-log( fabs( x ) ) - 0.6875e0 + x) + dcsevl( x, e12cs, nte12 ); } } else if (x <= 4.0e0) { de1_v = exp( -x )/x*(1.e0 + dcsevl( (8.e0/x - 5.e0)/3.e0, ae13cs, ntae13 )); } else if (x <= xmax) { de1_v = exp( -x )/x*(1.e0 + dcsevl( 8.e0/x - 1.e0, ae14cs, ntae14 )); } else { derm1( name, 3, 0, msg3, "X", xin, ',' ); derv1( "Limit |X|", xmax, '.' ); de1_v = zero; } return( de1_v ); } /* end of function */