OpenLibm/slatec/daie.f
Viral B. Shah c977aa998f Add Makefile.extras to build libopenlibm-extras.
Replace amos with slatec
2012-12-31 16:37:05 -05:00

220 lines
12 KiB
Fortran

*DECK DAIE
DOUBLE PRECISION FUNCTION DAIE (X)
C***BEGIN PROLOGUE DAIE
C***PURPOSE Calculate the Airy function for a negative argument and an
C exponentially scaled Airy function for a non-negative
C argument.
C***LIBRARY SLATEC (FNLIB)
C***CATEGORY C10D
C***TYPE DOUBLE PRECISION (AIE-S, DAIE-D)
C***KEYWORDS EXPONENTIALLY SCALED AIRY FUNCTION, FNLIB,
C SPECIAL FUNCTIONS
C***AUTHOR Fullerton, W., (LANL)
C***DESCRIPTION
C
C DAIE(X) calculates the Airy function or the exponentially scaled
C Airy function depending on the value of the argument. The function
C and argument are both double precision.
C
C Evaluate AI(X) for X .LE. 0.0 and AI(X)*EXP(ZETA) where
C ZETA = 2/3 * X**(3/2) for X .GE. 0.0
C
C Series for AIF on the interval -1.00000E+00 to 1.00000E+00
C with weighted error 8.37E-33
C log weighted error 32.08
C significant figures required 30.87
C decimal places required 32.63
C
C Series for AIG on the interval -1.00000E+00 to 1.00000E+00
C with weighted error 7.47E-34
C log weighted error 33.13
C significant figures required 31.50
C decimal places required 33.68
C
C Series for AIP1 on the interval 1.25000E-01 to 1.00000E+00
C with weighted error 3.69E-32
C log weighted error 31.43
C significant figures required 29.55
C decimal places required 32.31
C
C Series for AIP2 on the interval 0. to 1.25000E-01
C with weighted error 3.48E-32
C log weighted error 31.46
C significant figures required 28.74
C decimal places required 32.24
C
C***REFERENCES (NONE)
C***ROUTINES CALLED D1MACH, D9AIMP, DCSEVL, INITDS
C***REVISION HISTORY (YYMMDD)
C 770701 DATE WRITTEN
C 890531 Changed all specific intrinsics to generic. (WRB)
C 890531 REVISION DATE from Version 3.2
C 891214 Prologue converted to Version 4.0 format. (BAB)
C 920618 Removed space from variable names. (RWC, WRB)
C***END PROLOGUE DAIE
DOUBLE PRECISION X, AIFCS(13), AIGCS(13), AIP1CS(57), AIP2CS(37),
1 SQRTX, THETA, XBIG, XM, X3SML, X32SML, Z, D1MACH, DCSEVL
LOGICAL FIRST
SAVE AIFCS, AIGCS, AIP1CS, AIP2CS, NAIF, NAIG, NAIP1,
1 NAIP2, X3SML, X32SML, XBIG, FIRST
DATA AIFCS( 1) / -.3797135849 6669997496 1970894694 14 D-1 /
DATA AIFCS( 2) / +.5919188853 7263638574 3197280137 77 D-1 /
DATA AIFCS( 3) / +.9862928057 7279975365 6038910440 60 D-3 /
DATA AIFCS( 4) / +.6848843819 0765667554 8548301824 12 D-5 /
DATA AIFCS( 5) / +.2594202596 2194713019 4892790814 03 D-7 /
DATA AIFCS( 6) / +.6176612774 0813750329 4457496972 36 D-10 /
DATA AIFCS( 7) / +.1009245417 2466117901 4295562246 01 D-12 /
DATA AIFCS( 8) / +.1201479251 1179938141 2880332253 33 D-15 /
DATA AIFCS( 9) / +.1088294558 8716991878 5252954666 66 D-18 /
DATA AIFCS( 10) / +.7751377219 6684887039 2384000000 00 D-22 /
DATA AIFCS( 11) / +.4454811203 7175638391 4666666666 66 D-25 /
DATA AIFCS( 12) / +.2109284523 1692343466 6666666666 66 D-28 /
DATA AIFCS( 13) / +.8370173591 0741333333 3333333333 33 D-32 /
DATA AIGCS( 1) / +.1815236558 1161273011 5562099578 64 D-1 /
DATA AIGCS( 2) / +.2157256316 6010755534 0306388199 68 D-1 /
DATA AIGCS( 3) / +.2567835698 7483249659 0524280901 33 D-3 /
DATA AIGCS( 4) / +.1426521411 9792403898 8294969217 21 D-5 /
DATA AIGCS( 5) / +.4572114920 0180426070 4340975581 91 D-8 /
DATA AIGCS( 6) / +.9525170843 5647098607 3922788405 92 D-11 /
DATA AIGCS( 7) / +.1392563460 5771399051 1504206861 90 D-13 /
DATA AIGCS( 8) / +.1507099914 2762379592 3069911386 66 D-16 /
DATA AIGCS( 9) / +.1255914831 2567778822 7032053333 33 D-19 /
DATA AIGCS( 10) / +.8306307377 0821340343 8293333333 33 D-23 /
DATA AIGCS( 11) / +.4465753849 3718567445 3333333333 33 D-26 /
DATA AIGCS( 12) / +.1990085503 4518869333 3333333333 33 D-29 /
DATA AIGCS( 13) / +.7470288525 6533333333 3333333333 33 D-33 /
DATA AIP1CS( 1) / -.2146951858 9105384554 6086346777 8 D-1 /
DATA AIP1CS( 2) / -.7535382535 0433011662 1972086556 5 D-2 /
DATA AIP1CS( 3) / +.5971527949 0263808520 3538888199 4 D-3 /
DATA AIP1CS( 4) / -.7283251254 2076106485 0236829154 8 D-4 /
DATA AIP1CS( 5) / +.1110297130 7392996665 1738182114 0 D-4 /
DATA AIP1CS( 6) / -.1950386152 2844057103 4693031403 3 D-5 /
DATA AIP1CS( 7) / +.3786973885 1595151938 8531967005 7 D-6 /
DATA AIP1CS( 8) / -.7929675297 3509782790 3907287915 4 D-7 /
DATA AIP1CS( 9) / +.1762247638 6742560755 6842012220 2 D-7 /
DATA AIP1CS( 10) / -.4110767539 6671950450 2989659389 3 D-8 /
DATA AIP1CS( 11) / +.9984770057 8578922471 8341410754 4 D-9 /
DATA AIP1CS( 12) / -.2510093251 3871222113 4986773003 4 D-9 /
DATA AIP1CS( 13) / +.6500501929 8606954092 7203860172 5 D-10 /
DATA AIP1CS( 14) / -.1727818405 3936165154 7887710736 6 D-10 /
DATA AIP1CS( 15) / +.4699378842 8245125783 6229287230 7 D-11 /
DATA AIP1CS( 16) / -.1304675656 2977439144 9124124627 2 D-11 /
DATA AIP1CS( 17) / +.3689698478 4626788104 7394838228 2 D-12 /
DATA AIP1CS( 18) / -.1061087206 6468061736 5035967903 5 D-12 /
DATA AIP1CS( 19) / +.3098414384 8781874386 6021007011 0 D-13 /
DATA AIP1CS( 20) / -.9174908079 8241393078 3342354785 1 D-14 /
DATA AIP1CS( 21) / +.2752049140 3472108956 9357906227 1 D-14 /
DATA AIP1CS( 22) / -.8353750115 9220465580 9139330188 0 D-15 /
DATA AIP1CS( 23) / +.2563931129 3579349475 6863616861 2 D-15 /
DATA AIP1CS( 24) / -.7950633762 5988549832 7374728982 2 D-16 /
DATA AIP1CS( 25) / +.2489283634 6030699774 3728117564 4 D-16 /
DATA AIP1CS( 26) / -.7864326933 9287355696 6462622129 6 D-17 /
DATA AIP1CS( 27) / +.2505687311 4399756723 2447064501 9 D-17 /
DATA AIP1CS( 28) / -.8047420364 1639095245 3795868224 1 D-18 /
DATA AIP1CS( 29) / +.2604097118 9520539644 4340110439 2 D-18 /
DATA AIP1CS( 30) / -.8486954164 0564122594 8248883418 4 D-19 /
DATA AIP1CS( 31) / +.2784706882 1423378433 5942918602 7 D-19 /
DATA AIP1CS( 32) / -.9195858953 4986129136 8722415135 4 D-20 /
DATA AIP1CS( 33) / +.3055304318 3742387422 4766822558 3 D-20 /
DATA AIP1CS( 34) / -.1021035455 4794778759 0217704843 9 D-20 /
DATA AIP1CS( 35) / +.3431118190 7437578440 0055568083 6 D-21 /
DATA AIP1CS( 36) / -.1159129341 7977495133 7692246310 9 D-21 /
DATA AIP1CS( 37) / +.3935772844 2002556108 3626822915 4 D-22 /
DATA AIP1CS( 38) / -.1342880980 2967176119 5671898903 8 D-22 /
DATA AIP1CS( 39) / +.4603287883 5200027416 5919030531 4 D-23 /
DATA AIP1CS( 40) / -.1585043927 0040642278 1077249938 7 D-23 /
DATA AIP1CS( 41) / +.5481275667 7296759089 2552375500 8 D-24 /
DATA AIP1CS( 42) / -.1903349371 8550472590 6401794894 5 D-24 /
DATA AIP1CS( 43) / +.6635682302 3740087167 7761211596 8 D-25 /
DATA AIP1CS( 44) / -.2322311650 0263143079 7520098645 3 D-25 /
DATA AIP1CS( 45) / +.8157640113 4291793131 4274369535 9 D-26 /
DATA AIP1CS( 46) / -.2875824240 6329004900 5748992955 7 D-26 /
DATA AIP1CS( 47) / +.1017329450 9429014350 7971431901 8 D-26 /
DATA AIP1CS( 48) / -.3610879108 7422164465 7570349055 9 D-27 /
DATA AIP1CS( 49) / +.1285788540 3639934212 5664034269 8 D-27 /
DATA AIP1CS( 50) / -.4592901037 3785474251 6069302271 9 D-28 /
DATA AIP1CS( 51) / +.1645597033 8207137258 1210248533 3 D-28 /
DATA AIP1CS( 52) / -.5913421299 8435018420 8792027136 0 D-29 /
DATA AIP1CS( 53) / +.2131057006 6049933034 7936950954 6 D-29 /
DATA AIP1CS( 54) / -.7701158157 7875982169 8276174506 6 D-30 /
DATA AIP1CS( 55) / +.2790533307 9689304175 8178377728 0 D-30 /
DATA AIP1CS( 56) / -.1013807715 1112840064 5224136703 9 D-30 /
DATA AIP1CS( 57) / +.3692580158 7196240936 5828621653 3 D-31 /
DATA AIP2CS( 1) / -.1743144969 2937551339 0355844011 D-2 /
DATA AIP2CS( 2) / -.1678938543 2554167163 2190613480 D-2 /
DATA AIP2CS( 3) / +.3596534033 5216603588 5983858114 D-4 /
DATA AIP2CS( 4) / -.1380818602 7392283545 7399383100 D-5 /
DATA AIP2CS( 5) / +.7411228077 3150529884 8699095233 D-7 /
DATA AIP2CS( 6) / -.5002382039 0013301313 0422866325 D-8 /
DATA AIP2CS( 7) / +.4006939174 1718424067 5446866355 D-9 /
DATA AIP2CS( 8) / -.3673312427 9590504419 9318496207 D-10 /
DATA AIP2CS( 9) / +.3760344395 9237385243 9592002918 D-11 /
DATA AIP2CS( 10) / -.4223213327 1874753802 6564938968 D-12 /
DATA AIP2CS( 11) / +.5135094540 3365707091 9618754120 D-13 /
DATA AIP2CS( 12) / -.6690958503 9047759565 1681356676 D-14 /
DATA AIP2CS( 13) / +.9266675456 4129064823 9550724382 D-15 /
DATA AIP2CS( 14) / -.1355143824 1607057633 3397356591 D-15 /
DATA AIP2CS( 15) / +.2081154963 1283099529 9006549335 D-16 /
DATA AIP2CS( 16) / -.3341164991 5917685687 1277570256 D-17 /
DATA AIP2CS( 17) / +.5585785845 8592431686 8032946585 D-18 /
DATA AIP2CS( 18) / -.9692190401 5236524751 8658209109 D-19 /
DATA AIP2CS( 19) / +.1740457001 2889320646 5696557738 D-19 /
DATA AIP2CS( 20) / -.3226409797 3113040024 7846333098 D-20 /
DATA AIP2CS( 21) / +.6160744711 0662525853 3259618986 D-21 /
DATA AIP2CS( 22) / -.1209363479 8249005907 6420676266 D-21 /
DATA AIP2CS( 23) / +.2436327633 1013810826 1570095786 D-22 /
DATA AIP2CS( 24) / -.5029142214 9745746894 3403144533 D-23 /
DATA AIP2CS( 25) / +.1062241755 4363568949 5470626133 D-23 /
DATA AIP2CS( 26) / -.2292842848 9598924150 9856324266 D-24 /
DATA AIP2CS( 27) / +.5051817339 2950374498 6884778666 D-25 /
DATA AIP2CS( 28) / -.1134981237 1441240497 9793920000 D-25 /
DATA AIP2CS( 29) / +.2597655659 8560698069 8374144000 D-26 /
DATA AIP2CS( 30) / -.6051246215 4293950617 2231679999 D-27 /
DATA AIP2CS( 31) / +.1433597779 6677280072 0295253333 D-27 /
DATA AIP2CS( 32) / -.3451477570 6089998628 0721066666 D-28 /
DATA AIP2CS( 33) / +.8438751902 1364674042 7025066666 D-29 /
DATA AIP2CS( 34) / -.2093961422 9818816943 4453333333 D-29 /
DATA AIP2CS( 35) / +.5270088734 7894550318 2848000000 D-30 /
DATA AIP2CS( 36) / -.1344574330 1455338578 9030399999 D-30 /
DATA AIP2CS( 37) / +.3475709645 2660114734 0117333333 D-31 /
DATA FIRST /.TRUE./
C***FIRST EXECUTABLE STATEMENT DAIE
IF (FIRST) THEN
ETA = 0.1*REAL(D1MACH(3))
NAIF = INITDS (AIFCS, 13, ETA)
NAIG = INITDS (AIGCS, 13, ETA)
NAIP1 = INITDS (AIP1CS, 57, ETA)
NAIP2 = INITDS (AIP2CS, 37, ETA)
C
X3SML = ETA**0.3333E0
X32SML = 1.3104D0*X3SML**2
XBIG = D1MACH(2)**0.6666D0
ENDIF
FIRST = .FALSE.
C
IF (X.GE.(-1.0D0)) GO TO 20
CALL D9AIMP (X, XM, THETA)
DAIE = XM * COS(THETA)
RETURN
C
20 IF (X.GT.1.0D0) GO TO 30
Z = 0.0D0
IF (ABS(X).GT.X3SML) Z = X**3
DAIE = 0.375D0 + (DCSEVL (Z, AIFCS, NAIF) - X*(0.25D0 +
1 DCSEVL (Z, AIGCS, NAIG)) )
IF (X.GT.X32SML) DAIE = DAIE * EXP (2.0D0*X*SQRT(X)/3.0D0)
RETURN
C
30 IF (X.GT.4.0D0) GO TO 40
SQRTX = SQRT(X)
Z = (16.D0/(X*SQRTX) - 9.D0)/7.D0
DAIE = (0.28125D0 + DCSEVL (Z, AIP1CS, NAIP1))/SQRT(SQRTX)
RETURN
C
40 SQRTX = SQRT(X)
Z = -1.0D0
IF (X.LT.XBIG) Z = 16.0D0/(X*SQRTX) - 1.0D0
DAIE = (0.28125D0 + DCSEVL (Z, AIP2CS, NAIP2))/SQRT(SQRTX)
RETURN
C
END