1 SUBROUTINE zairy(ZR, ZI, ID, KODE, AIR, AII, NZ, IERR)
130 DOUBLE PRECISION AA, AD, AII, AIR, AK, ALIM, ATRM, AZ, AZ3, BK,
131 * cc, ck, coef, conei, coner, csqi, csqr, cyi, cyr, c1, c2, dig,
132 * dk, d1, d2, elim, fid, fnu, ptr, rl, r1m5, sfac, sti,
str,
133 * s1i, s1r, s2i, s2r, tol, trm1i, trm1r, trm2i, trm2r, tth, zeroi,
134 * zeror, zi, zr, ztai, ztar, z3i, z3r,
d1mach, xzabs, alaz, bb
135 INTEGER ID, IERR, IFLAG, K, KODE, K1, K2, MR, NN, NZ, I1MACH
137 DATA tth, c1, c2, coef /6.66666666666666667
d-01,
138 * 3.55028053887817240
d-01,2.58819403792806799
d-01,
139 * 1.83776298473930683
d-01/
140 DATA zeror, zeroi, coner, conei /0.0d0,0.0d0,1.0d0,0.0d0/
144 IF (id.LT.0 .OR. id.GT.1) ierr=1
145 IF (kode.LT.1 .OR. kode.GT.2) ierr=1
146 IF (ierr.NE.0)
RETURN
149 fid = dble(float(id))
150 IF (az.GT.1.0d0) go to 70
158 IF (az.LT.tol) go to 170
160 IF (aa.LT.tol/az) go to 40
168 z3r =
str*zr - sti*zi
169 z3i =
str*zi + sti*zr
172 bk = 3.0d0 - fid - fid
174 dk = 3.0d0 + fid + fid
178 ak = 24.0d0 + 9.0d0*fid
179 bk = 30.0d0 - 9.0d0*fid
181 str = (trm1r*z3r-trm1i*z3i)/d1
182 trm1i = (trm1r*z3i+trm1i*z3r)/d1
186 str = (trm2r*z3r-trm2i*z3i)/d2
187 trm2i = (trm2r*z3i+trm2i*z3r)/d2
195 IF (atrm.LT.tol*ad) go to 40
200 IF (id.EQ.1) go to 50
201 air = s1r*c1 - c2*(zr*s2r-zi*s2i)
202 aii = s1i*c1 - c2*(zr*s2i+zi*s2r)
203 IF (kode.EQ.1)
RETURN
205 ztar = tth*(zr*
str-zi*sti)
206 ztai = tth*(zr*sti+zi*
str)
208 ptr = air*
str - aii*sti
209 aii = air*sti + aii*
str
215 IF (az.LE.tol) go to 60
216 str = zr*s1r - zi*s1i
217 sti = zr*s1i + zi*s1r
219 air = air + cc*(
str*zr-sti*zi)
220 aii = aii + cc*(
str*zi+sti*zr)
222 IF (kode.EQ.1)
RETURN
224 ztar = tth*(zr*
str-zi*sti)
225 ztai = tth*(zr*sti+zi*
str)
227 ptr =
str*air - sti*aii
228 aii =
str*aii + sti*air
235 fnu = (1.0d0+fid)/3.0d0
249 k = min0(iabs(k1),iabs(k2))
250 elim = 2.303d0*(dble(float(k))*r1m5-3.0d0)
252 aa = r1m5*dble(float(k1))
253 dig = dmin1(aa,18.0d0)
255 alim = elim + dmax1(-aa,-41.45d0)
256 rl = 1.2d0*dig + 3.0d0
262 bb=dble(float(i1mach(9)))*0.5d0
265 IF (az.GT.aa) go to 260
268 CALL
xzsqrt(zr, zi, csqr, csqi)
269 ztar = tth*(zr*csqr-zi*csqi)
270 ztai = tth*(zr*csqi+zi*csqr)
277 IF (zr.GE.0.0d0) go to 80
283 IF (zi.NE.0.0d0) go to 90
284 IF (zr.GT.0.0d0) go to 90
289 IF (aa.GE.0.0d0 .AND. zr.GT.0.0d0) go to 110
290 IF (kode.EQ.2) go to 100
294 IF (aa.GT.(-alim)) go to 100
295 aa = -aa + 0.25d0*alaz
298 IF (aa.GT.elim) go to 270
304 IF (zi.LT.0.0d0) mr = -1
305 CALL
zacai(ztar, ztai, fnu, kode, mr, 1, cyr, cyi, nn, rl, tol,
307 IF (nn.LT.0) go to 280
311 IF (kode.EQ.2) go to 120
315 IF (aa.LT.alim) go to 120
316 aa = -aa - 0.25d0*alaz
319 IF (aa.LT.(-elim)) go to 210
321 CALL
zbknu(ztar, ztai, fnu, kode, 1, cyr, cyi, nz, tol, elim,
326 IF (iflag.NE.0) go to 150
327 IF (id.EQ.1) go to 140
328 air = csqr*s1r - csqi*s1i
329 aii = csqr*s1i + csqi*s1r
332 air = -(zr*s1r-zi*s1i)
333 aii = -(zr*s1i+zi*s1r)
338 IF (id.EQ.1) go to 160
339 str = s1r*csqr - s1i*csqi
340 s1i = s1r*csqi + s1i*csqr
346 str = -(s1r*zr-s1i*zi)
347 s1i = -(s1r*zi+s1i*zr)
356 IF (id.EQ.1) go to 190
357 IF (az.LE.aa) go to 180
368 IF (az.LE.aa) go to 200
369 s1r = 0.5d0*(zr*zr-zi*zi)
385 IF(nn.EQ.(-1)) go to 270
std::string str(char sep= 'x') const
subroutine zacai(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, TOL, ELIM, ALIM)
subroutine xzexp(AR, AI, BR, BI)
subroutine zairy(ZR, ZI, ID, KODE, AIR, AII, NZ, IERR)
std::string dimension(void) const
double precision function d1mach(i)
F77_RET_T const double const double double * d
subroutine xzsqrt(AR, AI, BR, BI)
subroutine zbknu(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM)