dai.f 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100
  1. *DECK DAI
  2. DOUBLE PRECISION FUNCTION DAI (X)
  3. C***BEGIN PROLOGUE DAI
  4. C***PURPOSE Evaluate the Airy function.
  5. C***LIBRARY SLATEC (FNLIB)
  6. C***CATEGORY C10D
  7. C***TYPE DOUBLE PRECISION (AI-S, DAI-D)
  8. C***KEYWORDS AIRY FUNCTION, FNLIB, SPECIAL FUNCTIONS
  9. C***AUTHOR Fullerton, W., (LANL)
  10. C***DESCRIPTION
  11. C
  12. C DAI(X) calculates the double precision Airy function for double
  13. C precision argument X.
  14. C
  15. C Series for AIF on the interval -1.00000E+00 to 1.00000E+00
  16. C with weighted error 8.37E-33
  17. C log weighted error 32.08
  18. C significant figures required 30.87
  19. C decimal places required 32.63
  20. C
  21. C Series for AIG on the interval -1.00000E+00 to 1.00000E+00
  22. C with weighted error 7.47E-34
  23. C log weighted error 33.13
  24. C significant figures required 31.50
  25. C decimal places required 33.68
  26. C
  27. C***REFERENCES (NONE)
  28. C***ROUTINES CALLED D1MACH, D9AIMP, DAIE, DCSEVL, INITDS, XERMSG
  29. C***REVISION HISTORY (YYMMDD)
  30. C 770701 DATE WRITTEN
  31. C 890531 Changed all specific intrinsics to generic. (WRB)
  32. C 890531 REVISION DATE from Version 3.2
  33. C 891214 Prologue converted to Version 4.0 format. (BAB)
  34. C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
  35. C 920618 Removed space from variable names. (RWC, WRB)
  36. C***END PROLOGUE DAI
  37. DOUBLE PRECISION X, AIFCS(13), AIGCS(13), THETA, XM, XMAX, X3SML,
  38. 1 Z, D1MACH, DCSEVL, DAIE, XMAXT
  39. LOGICAL FIRST
  40. SAVE AIFCS, AIGCS, NAIF, NAIG, X3SML, XMAX, FIRST
  41. DATA AIFCS( 1) / -.3797135849 6669997496 1970894694 14 D-1 /
  42. DATA AIFCS( 2) / +.5919188853 7263638574 3197280137 77 D-1 /
  43. DATA AIFCS( 3) / +.9862928057 7279975365 6038910440 60 D-3 /
  44. DATA AIFCS( 4) / +.6848843819 0765667554 8548301824 12 D-5 /
  45. DATA AIFCS( 5) / +.2594202596 2194713019 4892790814 03 D-7 /
  46. DATA AIFCS( 6) / +.6176612774 0813750329 4457496972 36 D-10 /
  47. DATA AIFCS( 7) / +.1009245417 2466117901 4295562246 01 D-12 /
  48. DATA AIFCS( 8) / +.1201479251 1179938141 2880332253 33 D-15 /
  49. DATA AIFCS( 9) / +.1088294558 8716991878 5252954666 66 D-18 /
  50. DATA AIFCS( 10) / +.7751377219 6684887039 2384000000 00 D-22 /
  51. DATA AIFCS( 11) / +.4454811203 7175638391 4666666666 66 D-25 /
  52. DATA AIFCS( 12) / +.2109284523 1692343466 6666666666 66 D-28 /
  53. DATA AIFCS( 13) / +.8370173591 0741333333 3333333333 33 D-32 /
  54. DATA AIGCS( 1) / +.1815236558 1161273011 5562099578 64 D-1 /
  55. DATA AIGCS( 2) / +.2157256316 6010755534 0306388199 68 D-1 /
  56. DATA AIGCS( 3) / +.2567835698 7483249659 0524280901 33 D-3 /
  57. DATA AIGCS( 4) / +.1426521411 9792403898 8294969217 21 D-5 /
  58. DATA AIGCS( 5) / +.4572114920 0180426070 4340975581 91 D-8 /
  59. DATA AIGCS( 6) / +.9525170843 5647098607 3922788405 92 D-11 /
  60. DATA AIGCS( 7) / +.1392563460 5771399051 1504206861 90 D-13 /
  61. DATA AIGCS( 8) / +.1507099914 2762379592 3069911386 66 D-16 /
  62. DATA AIGCS( 9) / +.1255914831 2567778822 7032053333 33 D-19 /
  63. DATA AIGCS( 10) / +.8306307377 0821340343 8293333333 33 D-23 /
  64. DATA AIGCS( 11) / +.4465753849 3718567445 3333333333 33 D-26 /
  65. DATA AIGCS( 12) / +.1990085503 4518869333 3333333333 33 D-29 /
  66. DATA AIGCS( 13) / +.7470288525 6533333333 3333333333 33 D-33 /
  67. DATA FIRST /.TRUE./
  68. C***FIRST EXECUTABLE STATEMENT DAI
  69. IF (FIRST) THEN
  70. NAIF = INITDS (AIFCS, 13, 0.1*REAL(D1MACH(3)))
  71. NAIG = INITDS (AIGCS, 13, 0.1*REAL(D1MACH(3)))
  72. C
  73. X3SML = D1MACH(3)**0.3334D0
  74. XMAXT = (-1.5D0*LOG(D1MACH(1)))**0.6667D0
  75. XMAX = XMAXT - XMAXT*LOG(XMAXT)/(4.0D0*SQRT(XMAXT)+1.0D0)
  76. * - 0.01D0
  77. ENDIF
  78. FIRST = .FALSE.
  79. C
  80. IF (X.GE.(-1.D0)) GO TO 20
  81. CALL D9AIMP (X, XM, THETA)
  82. DAI = XM * COS(THETA)
  83. RETURN
  84. C
  85. 20 IF (X.GT.1.0D0) GO TO 30
  86. Z = 0.0D0
  87. IF (ABS(X).GT.X3SML) Z = X**3
  88. DAI = 0.375D0 + (DCSEVL (Z, AIFCS, NAIF) - X*(0.25D0 +
  89. 1 DCSEVL (Z, AIGCS, NAIG)) )
  90. RETURN
  91. C
  92. 30 IF (X.GT.XMAX) GO TO 40
  93. DAI = DAIE(X) * EXP(-2.0D0*X*SQRT(X)/3.0D0)
  94. RETURN
  95. C
  96. 40 DAI = 0.0D0
  97. CALL XERMSG ('SLATEC', 'DAI', 'X SO BIG AI UNDERFLOWS', 1, 1)
  98. RETURN
  99. C
  100. END