1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
|
*DECK ZAIRY
SUBROUTINE ZAIRY (ZR, ZI, ID, KODE, AIR, AII, NZ, IERR)
C***BEGIN PROLOGUE ZAIRY
C***PURPOSE Compute the Airy function Ai(z) or its derivative dAi/dz
C for complex argument z. A scaling option is available
C to help avoid underflow and overflow.
C***LIBRARY SLATEC
C***CATEGORY C10D
C***TYPE COMPLEX (CAIRY-C, ZAIRY-C)
C***KEYWORDS AIRY FUNCTION, BESSEL FUNCTION OF ORDER ONE THIRD,
C BESSEL FUNCTION OF ORDER TWO THIRDS
C***AUTHOR Amos, D. E., (SNL)
C***DESCRIPTION
C
C ***A DOUBLE PRECISION ROUTINE***
C On KODE=1, ZAIRY computes the complex Airy function Ai(z)
C or its derivative dAi/dz on ID=0 or ID=1 respectively. On
C KODE=2, a scaling option exp(zeta)*Ai(z) or exp(zeta)*dAi/dz
C is provided to remove the exponential decay in -pi/3<arg(z)
C <pi/3 and the exponential growth in pi/3<abs(arg(z))<pi where
C zeta=(2/3)*z**(3/2).
C
C While the Airy functions Ai(z) and dAi/dz are analytic in
C the whole z-plane, the corresponding scaled functions defined
C for KODE=2 have a cut along the negative real axis.
C
C Input
C ZR - DOUBLE PRECISION real part of argument Z
C ZI - DOUBLE PRECISION imag part of argument Z
C ID - Order of derivative, ID=0 or ID=1
C KODE - A parameter to indicate the scaling option
C KODE=1 returns
C AI=Ai(z) on ID=0
C AI=dAi/dz on ID=1
C at z=Z
C =2 returns
C AI=exp(zeta)*Ai(z) on ID=0
C AI=exp(zeta)*dAi/dz on ID=1
C at z=Z where zeta=(2/3)*z**(3/2)
C
C Output
C AIR - DOUBLE PRECISION real part of result
C AII - DOUBLE PRECISION imag part of result
C NZ - Underflow indicator
C NZ=0 Normal return
C NZ=1 AI=0 due to underflow in
C -pi/3<arg(Z)<pi/3 on KODE=1
C IERR - Error flag
C IERR=0 Normal return - COMPUTATION COMPLETED
C IERR=1 Input error - NO COMPUTATION
C IERR=2 Overflow - NO COMPUTATION
C (Re(Z) too large with KODE=1)
C IERR=3 Precision warning - COMPUTATION COMPLETED
C (Result has less than half precision)
C IERR=4 Precision error - NO COMPUTATION
C (Result has no precision)
C IERR=5 Algorithmic error - NO COMPUTATION
C (Termination condition not met)
C
C *Long Description:
C
C Ai(z) and dAi/dz are computed from K Bessel functions by
C
C Ai(z) = c*sqrt(z)*K(1/3,zeta)
C dAi/dz = -c* z *K(2/3,zeta)
C c = 1/(pi*sqrt(3))
C zeta = (2/3)*z**(3/2)
C
C when abs(z)>1 and from power series when abs(z)<=1.
C
C In most complex variable computation, one must evaluate ele-
C mentary functions. When the magnitude of Z is large, losses
C of significance by argument reduction occur. Consequently, if
C the magnitude of ZETA=(2/3)*Z**(3/2) exceeds U1=SQRT(0.5/UR),
C then losses exceeding half precision are likely and an error
C flag IERR=3 is triggered where UR=MAX(D1MACH(4),1.0D-18) is
C double precision unit roundoff limited to 18 digits precision.
C Also, if the magnitude of ZETA is larger than U2=0.5/UR, then
C all significance is lost and IERR=4. In order to use the INT
C function, ZETA must be further restricted not to exceed
C U3=I1MACH(9)=LARGEST INTEGER. Thus, the magnitude of ZETA
C must be restricted by MIN(U2,U3). In IEEE arithmetic, U1,U2,
C and U3 are approximately 2.0E+3, 4.2E+6, 2.1E+9 in single
C precision and 4.7E+7, 2.3E+15, 2.1E+9 in double precision.
C This makes U2 limiting is single precision and U3 limiting
C in double precision. This means that the magnitude of Z
C cannot exceed approximately 3.4E+4 in single precision and
C 2.1E+6 in double precision. This also means that one can
C expect to retain, in the worst cases on 32-bit machines,
C no digits in single precision and only 6 digits in double
C precision.
C
C The approximate relative error in the magnitude of a complex
C Bessel function can be expressed as P*10**S where P=MAX(UNIT
C ROUNDOFF,1.0E-18) is the nominal precision and 10**S repre-
C sents the increase in error due to argument reduction in the
C elementary functions. Here, S=MAX(1,ABS(LOG10(ABS(Z))),
C ABS(LOG10(FNU))) approximately (i.e., S=MAX(1,ABS(EXPONENT OF
C ABS(Z),ABS(EXPONENT OF FNU)) ). However, the phase angle may
C have only absolute accuracy. This is most likely to occur
C when one component (in magnitude) is larger than the other by
C several orders of magnitude. If one component is 10**K larger
C than the other, then one can expect only MAX(ABS(LOG10(P))-K,
C 0) significant digits; or, stated another way, when K exceeds
C the exponent of P, no significant digits remain in the smaller
C component. However, the phase angle retains absolute accuracy
C because, in complex arithmetic with precision P, the smaller
C component will not (as a rule) decrease below P times the
C magnitude of the larger component. In these extreme cases,
C the principal phase angle is on the order of +P, -P, PI/2-P,
C or -PI/2+P.
C
C***REFERENCES 1. M. Abramowitz and I. A. Stegun, Handbook of Mathe-
C matical Functions, National Bureau of Standards
C Applied Mathematics Series 55, U. S. Department
C of Commerce, Tenth Printing (1972) or later.
C 2. D. E. Amos, Computation of Bessel Functions of
C Complex Argument and Large Order, Report SAND83-0643,
C Sandia National Laboratories, Albuquerque, NM, May
C 1983.
C 3. D. E. Amos, A Subroutine Package for Bessel Functions
C of a Complex Argument and Nonnegative Order, Report
C SAND85-1018, Sandia National Laboratory, Albuquerque,
C NM, May 1985.
C 4. D. E. Amos, A portable package for Bessel functions
C of a complex argument and nonnegative order, ACM
C Transactions on Mathematical Software, 12 (September
C 1986), pp. 265-273.
C
C***ROUTINES CALLED D1MACH, I1MACH, ZABS, ZACAI, ZBKNU, ZEXP, ZSQRT
C***REVISION HISTORY (YYMMDD)
C 830501 DATE WRITTEN
C 890801 REVISION DATE from Version 3.2
C 910415 Prologue converted to Version 4.0 format. (BAB)
C 920128 Category corrected. (WRB)
C 920811 Prologue revised. (DWL)
C 930122 Added ZEXP and ZSQRT to EXTERNAL statement. (RWC)
C***END PROLOGUE ZAIRY
C COMPLEX AI,CONE,CSQ,CY,S1,S2,TRM1,TRM2,Z,ZTA,Z3
DOUBLE PRECISION AA, AD, AII, AIR, AK, ALIM, ATRM, AZ, AZ3, BK,
* CC, CK, COEF, CONEI, CONER, CSQI, CSQR, CYI, CYR, C1, C2, DIG,
* DK, D1, D2, ELIM, FID, FNU, PTR, RL, R1M5, SFAC, STI, STR,
* S1I, S1R, S2I, S2R, TOL, TRM1I, TRM1R, TRM2I, TRM2R, TTH, ZEROI,
* ZEROR, ZI, ZR, ZTAI, ZTAR, Z3I, Z3R, D1MACH, ZABS, ALAZ, BB
INTEGER ID, IERR, IFLAG, K, KODE, K1, K2, MR, NN, NZ, I1MACH
DIMENSION CYR(1), CYI(1)
EXTERNAL ZABS, ZEXP, ZSQRT
DATA TTH, C1, C2, COEF /6.66666666666666667D-01,
* 3.55028053887817240D-01,2.58819403792806799D-01,
* 1.83776298473930683D-01/
DATA ZEROR, ZEROI, CONER, CONEI /0.0D0,0.0D0,1.0D0,0.0D0/
C***FIRST EXECUTABLE STATEMENT ZAIRY
IERR = 0
NZ=0
IF (ID.LT.0 .OR. ID.GT.1) IERR=1
IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
IF (IERR.NE.0) RETURN
AZ = ZABS(ZR,ZI)
TOL = MAX(D1MACH(4),1.0D-18)
FID = ID
IF (AZ.GT.1.0D0) GO TO 70
C-----------------------------------------------------------------------
C POWER SERIES FOR ABS(Z).LE.1.
C-----------------------------------------------------------------------
S1R = CONER
S1I = CONEI
S2R = CONER
S2I = CONEI
IF (AZ.LT.TOL) GO TO 170
AA = AZ*AZ
IF (AA.LT.TOL/AZ) GO TO 40
TRM1R = CONER
TRM1I = CONEI
TRM2R = CONER
TRM2I = CONEI
ATRM = 1.0D0
STR = ZR*ZR - ZI*ZI
STI = ZR*ZI + ZI*ZR
Z3R = STR*ZR - STI*ZI
Z3I = STR*ZI + STI*ZR
AZ3 = AZ*AA
AK = 2.0D0 + FID
BK = 3.0D0 - FID - FID
CK = 4.0D0 - FID
DK = 3.0D0 + FID + FID
D1 = AK*DK
D2 = BK*CK
AD = MIN(D1,D2)
AK = 24.0D0 + 9.0D0*FID
BK = 30.0D0 - 9.0D0*FID
DO 30 K=1,25
STR = (TRM1R*Z3R-TRM1I*Z3I)/D1
TRM1I = (TRM1R*Z3I+TRM1I*Z3R)/D1
TRM1R = STR
S1R = S1R + TRM1R
S1I = S1I + TRM1I
STR = (TRM2R*Z3R-TRM2I*Z3I)/D2
TRM2I = (TRM2R*Z3I+TRM2I*Z3R)/D2
TRM2R = STR
S2R = S2R + TRM2R
S2I = S2I + TRM2I
ATRM = ATRM*AZ3/AD
D1 = D1 + AK
D2 = D2 + BK
AD = MIN(D1,D2)
IF (ATRM.LT.TOL*AD) GO TO 40
AK = AK + 18.0D0
BK = BK + 18.0D0
30 CONTINUE
40 CONTINUE
IF (ID.EQ.1) GO TO 50
AIR = S1R*C1 - C2*(ZR*S2R-ZI*S2I)
AII = S1I*C1 - C2*(ZR*S2I+ZI*S2R)
IF (KODE.EQ.1) RETURN
CALL ZSQRT(ZR, ZI, STR, STI)
ZTAR = TTH*(ZR*STR-ZI*STI)
ZTAI = TTH*(ZR*STI+ZI*STR)
CALL ZEXP(ZTAR, ZTAI, STR, STI)
PTR = AIR*STR - AII*STI
AII = AIR*STI + AII*STR
AIR = PTR
RETURN
50 CONTINUE
AIR = -S2R*C2
AII = -S2I*C2
IF (AZ.LE.TOL) GO TO 60
STR = ZR*S1R - ZI*S1I
STI = ZR*S1I + ZI*S1R
CC = C1/(1.0D0+FID)
AIR = AIR + CC*(STR*ZR-STI*ZI)
AII = AII + CC*(STR*ZI+STI*ZR)
60 CONTINUE
IF (KODE.EQ.1) RETURN
CALL ZSQRT(ZR, ZI, STR, STI)
ZTAR = TTH*(ZR*STR-ZI*STI)
ZTAI = TTH*(ZR*STI+ZI*STR)
CALL ZEXP(ZTAR, ZTAI, STR, STI)
PTR = STR*AIR - STI*AII
AII = STR*AII + STI*AIR
AIR = PTR
RETURN
C-----------------------------------------------------------------------
C CASE FOR ABS(Z).GT.1.0
C-----------------------------------------------------------------------
70 CONTINUE
FNU = (1.0D0+FID)/3.0D0
C-----------------------------------------------------------------------
C SET PARAMETERS RELATED TO MACHINE CONSTANTS.
C TOL IS THE APPROXIMATE UNIT ROUNDOFF LIMITED TO 1.0D-18.
C ELIM IS THE APPROXIMATE EXPONENTIAL OVER- AND UNDERFLOW LIMIT.
C EXP(-ELIM).LT.EXP(-ALIM)=EXP(-ELIM)/TOL AND
C EXP(ELIM).GT.EXP(ALIM)=EXP(ELIM)*TOL ARE INTERVALS NEAR
C UNDERFLOW AND OVERFLOW LIMITS WHERE SCALED ARITHMETIC IS DONE.
C RL IS THE LOWER BOUNDARY OF THE ASYMPTOTIC EXPANSION FOR LARGE Z.
C DIG = NUMBER OF BASE 10 DIGITS IN TOL = 10**(-DIG).
C-----------------------------------------------------------------------
K1 = I1MACH(15)
K2 = I1MACH(16)
R1M5 = D1MACH(5)
K = MIN(ABS(K1),ABS(K2))
ELIM = 2.303D0*(K*R1M5-3.0D0)
K1 = I1MACH(14) - 1
AA = R1M5*K1
DIG = MIN(AA,18.0D0)
AA = AA*2.303D0
ALIM = ELIM + MAX(-AA,-41.45D0)
RL = 1.2D0*DIG + 3.0D0
ALAZ = LOG(AZ)
C-----------------------------------------------------------------------
C TEST FOR PROPER RANGE
C-----------------------------------------------------------------------
AA=0.5D0/TOL
BB=I1MACH(9)*0.5D0
AA=MIN(AA,BB)
AA=AA**TTH
IF (AZ.GT.AA) GO TO 260
AA=SQRT(AA)
IF (AZ.GT.AA) IERR=3
CALL ZSQRT(ZR, ZI, CSQR, CSQI)
ZTAR = TTH*(ZR*CSQR-ZI*CSQI)
ZTAI = TTH*(ZR*CSQI+ZI*CSQR)
C-----------------------------------------------------------------------
C RE(ZTA).LE.0 WHEN RE(Z).LT.0, ESPECIALLY WHEN IM(Z) IS SMALL
C-----------------------------------------------------------------------
IFLAG = 0
SFAC = 1.0D0
AK = ZTAI
IF (ZR.GE.0.0D0) GO TO 80
BK = ZTAR
CK = -ABS(BK)
ZTAR = CK
ZTAI = AK
80 CONTINUE
IF (ZI.NE.0.0D0) GO TO 90
IF (ZR.GT.0.0D0) GO TO 90
ZTAR = 0.0D0
ZTAI = AK
90 CONTINUE
AA = ZTAR
IF (AA.GE.0.0D0 .AND. ZR.GT.0.0D0) GO TO 110
IF (KODE.EQ.2) GO TO 100
C-----------------------------------------------------------------------
C OVERFLOW TEST
C-----------------------------------------------------------------------
IF (AA.GT.(-ALIM)) GO TO 100
AA = -AA + 0.25D0*ALAZ
IFLAG = 1
SFAC = TOL
IF (AA.GT.ELIM) GO TO 270
100 CONTINUE
C-----------------------------------------------------------------------
C CBKNU AND CACON RETURN EXP(ZTA)*K(FNU,ZTA) ON KODE=2
C-----------------------------------------------------------------------
MR = 1
IF (ZI.LT.0.0D0) MR = -1
CALL ZACAI(ZTAR, ZTAI, FNU, KODE, MR, 1, CYR, CYI, NN, RL, TOL,
* ELIM, ALIM)
IF (NN.LT.0) GO TO 280
NZ = NZ + NN
GO TO 130
110 CONTINUE
IF (KODE.EQ.2) GO TO 120
C-----------------------------------------------------------------------
C UNDERFLOW TEST
C-----------------------------------------------------------------------
IF (AA.LT.ALIM) GO TO 120
AA = -AA - 0.25D0*ALAZ
IFLAG = 2
SFAC = 1.0D0/TOL
IF (AA.LT.(-ELIM)) GO TO 210
120 CONTINUE
CALL ZBKNU(ZTAR, ZTAI, FNU, KODE, 1, CYR, CYI, NZ, TOL, ELIM,
* ALIM)
130 CONTINUE
S1R = CYR(1)*COEF
S1I = CYI(1)*COEF
IF (IFLAG.NE.0) GO TO 150
IF (ID.EQ.1) GO TO 140
AIR = CSQR*S1R - CSQI*S1I
AII = CSQR*S1I + CSQI*S1R
RETURN
140 CONTINUE
AIR = -(ZR*S1R-ZI*S1I)
AII = -(ZR*S1I+ZI*S1R)
RETURN
150 CONTINUE
S1R = S1R*SFAC
S1I = S1I*SFAC
IF (ID.EQ.1) GO TO 160
STR = S1R*CSQR - S1I*CSQI
S1I = S1R*CSQI + S1I*CSQR
S1R = STR
AIR = S1R/SFAC
AII = S1I/SFAC
RETURN
160 CONTINUE
STR = -(S1R*ZR-S1I*ZI)
S1I = -(S1R*ZI+S1I*ZR)
S1R = STR
AIR = S1R/SFAC
AII = S1I/SFAC
RETURN
170 CONTINUE
AA = 1.0D+3*D1MACH(1)
S1R = ZEROR
S1I = ZEROI
IF (ID.EQ.1) GO TO 190
IF (AZ.LE.AA) GO TO 180
S1R = C2*ZR
S1I = C2*ZI
180 CONTINUE
AIR = C1 - S1R
AII = -S1I
RETURN
190 CONTINUE
AIR = -C2
AII = 0.0D0
AA = SQRT(AA)
IF (AZ.LE.AA) GO TO 200
S1R = 0.5D0*(ZR*ZR-ZI*ZI)
S1I = ZR*ZI
200 CONTINUE
AIR = AIR + C1*S1R
AII = AII + C1*S1I
RETURN
210 CONTINUE
NZ = 1
AIR = ZEROR
AII = ZEROI
RETURN
270 CONTINUE
NZ = 0
IERR=2
RETURN
280 CONTINUE
IF(NN.EQ.(-1)) GO TO 270
NZ=0
IERR=5
RETURN
260 CONTINUE
IERR=4
NZ=0
RETURN
END
|
