cbesi.f 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261
  1. *DECK CBESI
  2. SUBROUTINE CBESI (Z, FNU, KODE, N, CY, NZ, IERR)
  3. C***BEGIN PROLOGUE CBESI
  4. C***PURPOSE Compute a sequence of the Bessel functions I(a,z) for
  5. C complex argument z and real nonnegative orders a=b,b+1,
  6. C b+2,... where b>0. A scaling option is available to
  7. C help avoid overflow.
  8. C***LIBRARY SLATEC
  9. C***CATEGORY C10B4
  10. C***TYPE COMPLEX (CBESI-C, ZBESI-C)
  11. C***KEYWORDS BESSEL FUNCTIONS OF COMPLEX ARGUMENT, I BESSEL FUNCTIONS,
  12. C MODIFIED BESSEL FUNCTIONS
  13. C***AUTHOR Amos, D. E., (SNL)
  14. C***DESCRIPTION
  15. C
  16. C On KODE=1, CBESI computes an N-member sequence of complex
  17. C Bessel functions CY(L)=I(FNU+L-1,Z) for real nonnegative
  18. C orders FNU+L-1, L=1,...,N and complex Z in the cut plane
  19. C -pi<arg(Z)<=pi. On KODE=2, CBESI returns the scaled functions
  20. C
  21. C CY(L) = exp(-abs(X))*I(FNU+L-1,Z), L=1,...,N and X=Re(Z)
  22. C
  23. C which removes the exponential growth in both the left and
  24. C right half-planes as Z goes to infinity.
  25. C
  26. C Input
  27. C Z - Argument of type COMPLEX
  28. C FNU - Initial order of type REAL, FNU>=0
  29. C KODE - A parameter to indicate the scaling option
  30. C KODE=1 returns
  31. C CY(L)=I(FNU+L-1,Z), L=1,...,N
  32. C =2 returns
  33. C CY(L)=exp(-abs(X))*I(FNU+L-1,Z), L=1,...,N
  34. C where X=Re(Z)
  35. C N - Number of terms in the sequence, N>=1
  36. C
  37. C Output
  38. C CY - Result vector of type COMPLEX
  39. C NZ - Number of underflows set to zero
  40. C NZ=0 Normal return
  41. C NZ>0 CY(L)=0, L=N-NZ+1,...,N
  42. C IERR - Error flag
  43. C IERR=0 Normal return - COMPUTATION COMPLETED
  44. C IERR=1 Input error - NO COMPUTATION
  45. C IERR=2 Overflow - NO COMPUTATION
  46. C (Re(Z) too large on KODE=1)
  47. C IERR=3 Precision warning - COMPUTATION COMPLETED
  48. C (Result has half precision or less
  49. C because abs(Z) or FNU+N-1 is large)
  50. C IERR=4 Precision error - NO COMPUTATION
  51. C (Result has no precision because
  52. C abs(Z) or FNU+N-1 is too large)
  53. C IERR=5 Algorithmic error - NO COMPUTATION
  54. C (Termination condition not met)
  55. C
  56. C *Long Description:
  57. C
  58. C The computation of I(a,z) is carried out by the power series
  59. C for small abs(z), the asymptotic expansion for large abs(z),
  60. C the Miller algorithm normalized by the Wronskian and a
  61. C Neumann series for intermediate magnitudes of z, and the
  62. C uniform asymptotic expansions for I(a,z) and J(a,z) for
  63. C large orders a. Backward recurrence is used to generate
  64. C sequences or reduce orders when necessary.
  65. C
  66. C The calculations above are done in the right half plane and
  67. C continued into the left half plane by the formula
  68. C
  69. C I(a,z*exp(t)) = exp(t*a)*I(a,z), Re(z)>0
  70. C t = i*pi or -i*pi
  71. C
  72. C For negative orders, the formula
  73. C
  74. C I(-a,z) = I(a,z) + (2/pi)*sin(pi*a)*K(a,z)
  75. C
  76. C can be used. However, for large orders close to integers the
  77. C the function changes radically. When a is a large positive
  78. C integer, the magnitude of I(-a,z)=I(a,z) is a large
  79. C negative power of ten. But when a is not an integer,
  80. C K(a,z) dominates in magnitude with a large positive power of
  81. C ten and the most that the second term can be reduced is by
  82. C unit roundoff from the coefficient. Thus, wide changes can
  83. C occur within unit roundoff of a large integer for a. Here,
  84. C large means a>abs(z).
  85. C
  86. C In most complex variable computation, one must evaluate ele-
  87. C mentary functions. When the magnitude of Z or FNU+N-1 is
  88. C large, losses of significance by argument reduction occur.
  89. C Consequently, if either one exceeds U1=SQRT(0.5/UR), then
  90. C losses exceeding half precision are likely and an error flag
  91. C IERR=3 is triggered where UR=R1MACH(4)=UNIT ROUNDOFF. Also,
  92. C if either is larger than U2=0.5/UR, then all significance is
  93. C lost and IERR=4. In order to use the INT function, arguments
  94. C must be further restricted not to exceed the largest machine
  95. C integer, U3=I1MACH(9). Thus, the magnitude of Z and FNU+N-1
  96. C is restricted by MIN(U2,U3). In IEEE arithmetic, U1,U2, and
  97. C U3 approximate 2.0E+3, 4.2E+6, 2.1E+9 in single precision
  98. C and 4.7E+7, 2.3E+15 and 2.1E+9 in double precision. This
  99. C makes U2 limiting in single precision and U3 limiting in
  100. C double precision. This means that one can expect to retain,
  101. C in the worst cases on IEEE machines, no digits in single pre-
  102. C cision and only 6 digits in double precision. Similar con-
  103. C siderations hold for other machines.
  104. C
  105. C The approximate relative error in the magnitude of a complex
  106. C Bessel function can be expressed as P*10**S where P=MAX(UNIT
  107. C ROUNDOFF,1.0E-18) is the nominal precision and 10**S repre-
  108. C sents the increase in error due to argument reduction in the
  109. C elementary functions. Here, S=MAX(1,ABS(LOG10(ABS(Z))),
  110. C ABS(LOG10(FNU))) approximately (i.e., S=MAX(1,ABS(EXPONENT OF
  111. C ABS(Z),ABS(EXPONENT OF FNU)) ). However, the phase angle may
  112. C have only absolute accuracy. This is most likely to occur
  113. C when one component (in magnitude) is larger than the other by
  114. C several orders of magnitude. If one component is 10**K larger
  115. C than the other, then one can expect only MAX(ABS(LOG10(P))-K,
  116. C 0) significant digits; or, stated another way, when K exceeds
  117. C the exponent of P, no significant digits remain in the smaller
  118. C component. However, the phase angle retains absolute accuracy
  119. C because, in complex arithmetic with precision P, the smaller
  120. C component will not (as a rule) decrease below P times the
  121. C magnitude of the larger component. In these extreme cases,
  122. C the principal phase angle is on the order of +P, -P, PI/2-P,
  123. C or -PI/2+P.
  124. C
  125. C***REFERENCES 1. M. Abramowitz and I. A. Stegun, Handbook of Mathe-
  126. C matical Functions, National Bureau of Standards
  127. C Applied Mathematics Series 55, U. S. Department
  128. C of Commerce, Tenth Printing (1972) or later.
  129. C 2. D. E. Amos, Computation of Bessel Functions of
  130. C Complex Argument, Report SAND83-0086, Sandia National
  131. C Laboratories, Albuquerque, NM, May 1983.
  132. C 3. D. E. Amos, Computation of Bessel Functions of
  133. C Complex Argument and Large Order, Report SAND83-0643,
  134. C Sandia National Laboratories, Albuquerque, NM, May
  135. C 1983.
  136. C 4. D. E. Amos, A Subroutine Package for Bessel Functions
  137. C of a Complex Argument and Nonnegative Order, Report
  138. C SAND85-1018, Sandia National Laboratory, Albuquerque,
  139. C NM, May 1985.
  140. C 5. D. E. Amos, A portable package for Bessel functions
  141. C of a complex argument and nonnegative order, ACM
  142. C Transactions on Mathematical Software, 12 (September
  143. C 1986), pp. 265-273.
  144. C
  145. C***ROUTINES CALLED CBINU, I1MACH, R1MACH
  146. C***REVISION HISTORY (YYMMDD)
  147. C 830501 DATE WRITTEN
  148. C 890801 REVISION DATE from Version 3.2
  149. C 910415 Prologue converted to Version 4.0 format. (BAB)
  150. C 920128 Category corrected. (WRB)
  151. C 920811 Prologue revised. (DWL)
  152. C***END PROLOGUE CBESI
  153. COMPLEX CONE, CSGN, CY, Z, ZN
  154. REAL AA, ALIM, ARG, DIG, ELIM, FNU, FNUL, PI, RL, R1M5, S1, S2,
  155. * TOL, XX, YY, R1MACH, AZ, FN, BB, ASCLE, RTOL, ATOL
  156. INTEGER I, IERR, INU, K, KODE, K1, K2, N, NN, NZ, I1MACH
  157. DIMENSION CY(N)
  158. DATA PI /3.14159265358979324E0/
  159. DATA CONE / (1.0E0,0.0E0) /
  160. C
  161. C***FIRST EXECUTABLE STATEMENT CBESI
  162. IERR = 0
  163. NZ=0
  164. IF (FNU.LT.0.0E0) IERR=1
  165. IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
  166. IF (N.LT.1) IERR=1
  167. IF (IERR.NE.0) RETURN
  168. XX = REAL(Z)
  169. YY = AIMAG(Z)
  170. C-----------------------------------------------------------------------
  171. C SET PARAMETERS RELATED TO MACHINE CONSTANTS.
  172. C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0E-18.
  173. C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
  174. C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND
  175. C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR
  176. C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
  177. C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
  178. C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
  179. C FNUL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC SERIES FOR LARGE FNU.
  180. C-----------------------------------------------------------------------
  181. TOL = MAX(R1MACH(4),1.0E-18)
  182. K1 = I1MACH(12)
  183. K2 = I1MACH(13)
  184. R1M5 = R1MACH(5)
  185. K = MIN(ABS(K1),ABS(K2))
  186. ELIM = 2.303E0*(K*R1M5-3.0E0)
  187. K1 = I1MACH(11) - 1
  188. AA = R1M5*K1
  189. DIG = MIN(AA,18.0E0)
  190. AA = AA*2.303E0
  191. ALIM = ELIM + MAX(-AA,-41.45E0)
  192. RL = 1.2E0*DIG + 3.0E0
  193. FNUL = 10.0E0 + 6.0E0*(DIG-3.0E0)
  194. AZ = ABS(Z)
  195. C-----------------------------------------------------------------------
  196. C TEST FOR RANGE
  197. C-----------------------------------------------------------------------
  198. AA = 0.5E0/TOL
  199. BB=I1MACH(9)*0.5E0
  200. AA=MIN(AA,BB)
  201. IF(AZ.GT.AA) GO TO 140
  202. FN=FNU+(N-1)
  203. IF(FN.GT.AA) GO TO 140
  204. AA=SQRT(AA)
  205. IF(AZ.GT.AA) IERR=3
  206. IF(FN.GT.AA) IERR=3
  207. ZN = Z
  208. CSGN = CONE
  209. IF (XX.GE.0.0E0) GO TO 40
  210. ZN = -Z
  211. C-----------------------------------------------------------------------
  212. C CALCULATE CSGN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE
  213. C WHEN FNU IS LARGE
  214. C-----------------------------------------------------------------------
  215. INU = FNU
  216. ARG = (FNU-INU)*PI
  217. IF (YY.LT.0.0E0) ARG = -ARG
  218. S1 = COS(ARG)
  219. S2 = SIN(ARG)
  220. CSGN = CMPLX(S1,S2)
  221. IF (MOD(INU,2).EQ.1) CSGN = -CSGN
  222. 40 CONTINUE
  223. CALL CBINU(ZN, FNU, KODE, N, CY, NZ, RL, FNUL, TOL, ELIM, ALIM)
  224. IF (NZ.LT.0) GO TO 120
  225. IF (XX.GE.0.0E0) RETURN
  226. C-----------------------------------------------------------------------
  227. C ANALYTIC CONTINUATION TO THE LEFT HALF PLANE
  228. C-----------------------------------------------------------------------
  229. NN = N - NZ
  230. IF (NN.EQ.0) RETURN
  231. RTOL = 1.0E0/TOL
  232. ASCLE = R1MACH(1)*RTOL*1.0E+3
  233. DO 50 I=1,NN
  234. C CY(I) = CY(I)*CSGN
  235. ZN=CY(I)
  236. AA=REAL(ZN)
  237. BB=AIMAG(ZN)
  238. ATOL=1.0E0
  239. IF (MAX(ABS(AA),ABS(BB)).GT.ASCLE) GO TO 55
  240. ZN = ZN*CMPLX(RTOL,0.0E0)
  241. ATOL = TOL
  242. 55 CONTINUE
  243. ZN = ZN*CSGN
  244. CY(I) = ZN*CMPLX(ATOL,0.0E0)
  245. CSGN = -CSGN
  246. 50 CONTINUE
  247. RETURN
  248. 120 CONTINUE
  249. IF(NZ.EQ.(-2)) GO TO 130
  250. NZ = 0
  251. IERR=2
  252. RETURN
  253. 130 CONTINUE
  254. NZ=0
  255. IERR=5
  256. RETURN
  257. 140 CONTINUE
  258. NZ=0
  259. IERR=4
  260. RETURN
  261. END