besi0e.f 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129
  1. *DECK BESI0E
  2. FUNCTION BESI0E (X)
  3. C***BEGIN PROLOGUE BESI0E
  4. C***PURPOSE Compute the exponentially scaled modified (hyperbolic)
  5. C Bessel function of the first kind of order zero.
  6. C***LIBRARY SLATEC (FNLIB)
  7. C***CATEGORY C10B1
  8. C***TYPE SINGLE PRECISION (BESI0E-S, DBSI0E-D)
  9. C***KEYWORDS EXPONENTIALLY SCALED, FIRST KIND, FNLIB,
  10. C HYPERBOLIC BESSEL FUNCTION, MODIFIED BESSEL FUNCTION,
  11. C ORDER ZERO, SPECIAL FUNCTIONS
  12. C***AUTHOR Fullerton, W., (LANL)
  13. C***DESCRIPTION
  14. C
  15. C BESI0E(X) calculates the exponentially scaled modified (hyperbolic)
  16. C Bessel function of the first kind of order zero for real argument X;
  17. C i.e., EXP(-ABS(X))*I0(X).
  18. C
  19. C
  20. C Series for BI0 on the interval 0. to 9.00000D+00
  21. C with weighted error 2.46E-18
  22. C log weighted error 17.61
  23. C significant figures required 17.90
  24. C decimal places required 18.15
  25. C
  26. C
  27. C Series for AI0 on the interval 1.25000D-01 to 3.33333D-01
  28. C with weighted error 7.87E-17
  29. C log weighted error 16.10
  30. C significant figures required 14.69
  31. C decimal places required 16.76
  32. C
  33. C
  34. C Series for AI02 on the interval 0. to 1.25000D-01
  35. C with weighted error 3.79E-17
  36. C log weighted error 16.42
  37. C significant figures required 14.86
  38. C decimal places required 17.09
  39. C
  40. C***REFERENCES (NONE)
  41. C***ROUTINES CALLED CSEVL, INITS, R1MACH
  42. C***REVISION HISTORY (YYMMDD)
  43. C 770701 DATE WRITTEN
  44. C 890313 REVISION DATE from Version 3.2
  45. C 891214 Prologue converted to Version 4.0 format. (BAB)
  46. C***END PROLOGUE BESI0E
  47. DIMENSION BI0CS(12), AI0CS(21), AI02CS(22)
  48. LOGICAL FIRST
  49. SAVE BI0CS, AI0CS, AI02CS, NTI0, NTAI0, NTAI02, XSML, FIRST
  50. DATA BI0CS( 1) / -.0766054725 2839144951E0 /
  51. DATA BI0CS( 2) / 1.9273379539 93808270E0 /
  52. DATA BI0CS( 3) / .2282644586 920301339E0 /
  53. DATA BI0CS( 4) / .0130489146 6707290428E0 /
  54. DATA BI0CS( 5) / .0004344270 9008164874E0 /
  55. DATA BI0CS( 6) / .0000094226 5768600193E0 /
  56. DATA BI0CS( 7) / .0000001434 0062895106E0 /
  57. DATA BI0CS( 8) / .0000000016 1384906966E0 /
  58. DATA BI0CS( 9) / .0000000000 1396650044E0 /
  59. DATA BI0CS(10) / .0000000000 0009579451E0 /
  60. DATA BI0CS(11) / .0000000000 0000053339E0 /
  61. DATA BI0CS(12) / .0000000000 0000000245E0 /
  62. DATA AI0CS( 1) / .0757599449 4023796E0 /
  63. DATA AI0CS( 2) / .0075913808 1082334E0 /
  64. DATA AI0CS( 3) / .0004153131 3389237E0 /
  65. DATA AI0CS( 4) / .0000107007 6463439E0 /
  66. DATA AI0CS( 5) / -.0000079011 7997921E0 /
  67. DATA AI0CS( 6) / -.0000007826 1435014E0 /
  68. DATA AI0CS( 7) / .0000002783 8499429E0 /
  69. DATA AI0CS( 8) / .0000000082 5247260E0 /
  70. DATA AI0CS( 9) / -.0000000120 4463945E0 /
  71. DATA AI0CS(10) / .0000000015 5964859E0 /
  72. DATA AI0CS(11) / .0000000002 2925563E0 /
  73. DATA AI0CS(12) / -.0000000001 1916228E0 /
  74. DATA AI0CS(13) / .0000000000 1757854E0 /
  75. DATA AI0CS(14) / .0000000000 0112822E0 /
  76. DATA AI0CS(15) / -.0000000000 0114684E0 /
  77. DATA AI0CS(16) / .0000000000 0027155E0 /
  78. DATA AI0CS(17) / -.0000000000 0002415E0 /
  79. DATA AI0CS(18) / -.0000000000 0000608E0 /
  80. DATA AI0CS(19) / .0000000000 0000314E0 /
  81. DATA AI0CS(20) / -.0000000000 0000071E0 /
  82. DATA AI0CS(21) / .0000000000 0000007E0 /
  83. DATA AI02CS( 1) / .0544904110 1410882E0 /
  84. DATA AI02CS( 2) / .0033691164 7825569E0 /
  85. DATA AI02CS( 3) / .0000688975 8346918E0 /
  86. DATA AI02CS( 4) / .0000028913 7052082E0 /
  87. DATA AI02CS( 5) / .0000002048 9185893E0 /
  88. DATA AI02CS( 6) / .0000000226 6668991E0 /
  89. DATA AI02CS( 7) / .0000000033 9623203E0 /
  90. DATA AI02CS( 8) / .0000000004 9406022E0 /
  91. DATA AI02CS( 9) / .0000000000 1188914E0 /
  92. DATA AI02CS(10) / -.0000000000 3149915E0 /
  93. DATA AI02CS(11) / -.0000000000 1321580E0 /
  94. DATA AI02CS(12) / -.0000000000 0179419E0 /
  95. DATA AI02CS(13) / .0000000000 0071801E0 /
  96. DATA AI02CS(14) / .0000000000 0038529E0 /
  97. DATA AI02CS(15) / .0000000000 0001539E0 /
  98. DATA AI02CS(16) / -.0000000000 0004151E0 /
  99. DATA AI02CS(17) / -.0000000000 0000954E0 /
  100. DATA AI02CS(18) / .0000000000 0000382E0 /
  101. DATA AI02CS(19) / .0000000000 0000176E0 /
  102. DATA AI02CS(20) / -.0000000000 0000034E0 /
  103. DATA AI02CS(21) / -.0000000000 0000027E0 /
  104. DATA AI02CS(22) / .0000000000 0000003E0 /
  105. DATA FIRST /.TRUE./
  106. C***FIRST EXECUTABLE STATEMENT BESI0E
  107. IF (FIRST) THEN
  108. NTI0 = INITS (BI0CS, 12, 0.1*R1MACH(3))
  109. NTAI0 = INITS (AI0CS, 21, 0.1*R1MACH(3))
  110. NTAI02 = INITS (AI02CS, 22, 0.1*R1MACH(3))
  111. XSML = SQRT (4.5*R1MACH(3))
  112. ENDIF
  113. FIRST = .FALSE.
  114. C
  115. Y = ABS(X)
  116. IF (Y.GT.3.0) GO TO 20
  117. C
  118. BESI0E = 1.0 - X
  119. IF (Y.GT.XSML) BESI0E = EXP(-Y) * ( 2.75 +
  120. 1 CSEVL (Y*Y/4.5-1.0, BI0CS, NTI0) )
  121. RETURN
  122. C
  123. 20 IF (Y.LE.8.) BESI0E = (.375 + CSEVL ((48./Y-11.)/5., AI0CS, NTAI0)
  124. 1 ) / SQRT(Y)
  125. IF (Y.GT.8.) BESI0E = (.375 + CSEVL (16./Y-1., AI02CS, NTAI02))
  126. 1 / SQRT(Y)
  127. C
  128. RETURN
  129. END