55 SUBROUTINE zbesj(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, IERR)
204 DOUBLE PRECISION aa, alim, arg, cii, csgni, csgnr, cyi, cyr, dig, &
205 elim, fnu, fnul, hpi, rl, r1m5, str, tol, zi, zni, znr, zr, &
207 INTEGER i, ierr, inu, inuh, ir, k, kode, k1, k2, n, nl, nz
208 dimension cyr(1), cyi(1)
209 DATA hpi /1.57079632679489662d0/
214 IF (fnu.LT.0.0d0) ierr=1
215 IF (kode.LT.1 .OR. kode.GT.2) ierr=1
217 IF (ierr.NE.0)
RETURN 229 tol = dmax1(d1mach(4),1.0d-18)
233 k = min0(iabs(k1),iabs(k2))
234 elim = 2.303d0*(dble(float(k))*r1m5-3.0d0)
236 aa = r1m5*dble(float(k1))
237 dig = dmin1(aa,18.0d0)
239 alim = elim + dmax1(-aa,-41.45d0)
240 rl = 1.2d0*dig + 3.0d0
241 fnul = 10.0d0 + 6.0d0*(dig-3.0d0)
246 fn = fnu+dble(float(n-1))
248 bb=dble(float(i1mach(9)))*0.5d0
250 IF (az.GT.aa)
GO TO 260
251 IF (fn.GT.aa)
GO TO 260
263 arg = (fnu-dble(float(inu-ir)))*hpi
266 IF (mod(inuh,2).EQ.0)
GO TO 40
275 IF (zi.GE.0.0d0)
GO TO 50
281 CALL zbinu(znr, zni, fnu, kode, n, cyr, cyi, nz, rl, fnul, tol, &
283 IF (nz.LT.0)
GO TO 130
287 str = cyr(i)*csgnr - cyi(i)*csgni
288 cyi(i) = cyr(i)*csgni + cyi(i)*csgnr
296 IF(nz.EQ.(-2))
GO TO 140
312 SUBROUTINE zuchk(YR, YI, NZ, ASCLE, TOL)
328 DOUBLE PRECISION ascle, ss, st, tol, wr, wi, yr, yi
334 IF (st.GT.ascle)
RETURN 341 SUBROUTINE zbinu(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL, TOL, ELIM, ALIM)
350 DOUBLE PRECISION alim, az, cwi, cwr, cyi, cyr, dfnu, elim, fnu, &
351 fnul, rl, tol, zeroi, zeror, zi, zr
352 INTEGER i, inw, kode, n, nlast, nn, nui, nw, nz
353 dimension cyr(1), cyi(1), cwr(2), cwi(2)
354 DATA zeror,zeroi / 0.0d0, 0.0d0 /
359 dfnu = fnu + dble(float(n-1))
360 IF (az.LE.2.0d0)
GO TO 10
361 IF (az*az*0.25d0.GT.dfnu+1.0d0)
GO TO 20
366 CALL zseri(zr, zi, fnu, kode, nn, cyr, cyi, nw, tol, elim, alim)
371 IF (nw.GE.0)
GO TO 120
372 dfnu = fnu + dble(float(nn-1))
374 IF (az.LT.rl)
GO TO 40
375 IF (dfnu.LE.1.0d0)
GO TO 30
376 IF (az+az.LT.dfnu*dfnu)
GO TO 50
381 CALL zasyi(zr, zi, fnu, kode, nn, cyr, cyi, nw, rl, tol, elim, alim)
382 IF (nw.LT.0)
GO TO 130
385 IF (dfnu.LE.1.0d0)
GO TO 70
390 CALL zuoik(zr, zi, fnu, kode, 1, nn, cyr, cyi, nw, tol, elim, alim)
391 IF (nw.LT.0)
GO TO 130
395 dfnu = fnu+dble(float(nn-1))
396 IF (dfnu.GT.fnul)
GO TO 110
397 IF (az.GT.fnul)
GO TO 110
399 IF (az.GT.rl)
GO TO 80
404 CALL zmlri(zr, zi, fnu, kode, nn, cyr, cyi, nw, tol)
405 IF(nw.LT.0)
GO TO 130
414 CALL zuoik(zr, zi, fnu, kode, 2, 2, cwr, cwi, nw, tol, elim, alim)
415 IF (nw.GE.0)
GO TO 100
423 IF (nw.GT.0)
GO TO 130
424 CALL zwrsk(zr, zi, fnu, kode, nn, cyr, cyi, nw, cwr, cwi, tol, elim, alim)
425 IF (nw.LT.0)
GO TO 130
431 nui = int(sngl(fnul-dfnu)) + 1
433 CALL zbuni(zr, zi, fnu, kode, nn, cyr, cyi, nw, nui, nlast, fnul, &
435 IF (nw.LT.0)
GO TO 130
437 IF (nlast.EQ.0)
GO TO 120
448 SUBROUTINE zseri(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM)
465 DOUBLE PRECISION aa, acz, ak, ak1i, ak1r, alim, arm, ascle, atol, &
466 az, cki, ckr, coefi, coefr, conei, coner, crscr, czi, czr, dfnu, &
467 elim, fnu, fnup, hzi, hzr, raz, rs, rtr1, rzi, rzr, s, ss, sti, &
468 str, s1i, s1r, s2i, s2r, tol, yi, yr, wi, wr, zeroi, zeror, zi, &
470 INTEGER i, ib, idum, iflag, il, k, kode, l, m, n, nn, nz, nw
471 dimension yr(1), yi(1), wr(2), wi(2)
472 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
476 IF (az.EQ.0.0d0)
GO TO 160
477 arm = 1.0d+3*d1mach(1)
481 IF (az.LT.arm)
GO TO 150
486 IF (az.LE.rtr1)
GO TO 10
487 CALL zmlt(hzr, hzi, hzr, hzi, czr, czi)
491 CALL zlog(hzr, hzi, ckr, cki, idum)
493 dfnu = fnu + dble(float(nn-1))
500 ak = dgamln(fnup,idum)
502 IF (kode.EQ.2) ak1r = ak1r - zr
503 IF (ak1r.GT.(-elim))
GO TO 40
508 IF (acz.GT.dfnu)
GO TO 190
513 IF (ak1r.GT.(-alim))
GO TO 50
520 IF (iflag.EQ.1) aa = aa*ss
521 coefr = aa*dcos(ak1i)
522 coefi = aa*dsin(ak1i)
526 dfnu = fnu + dble(float(nn-i))
530 IF (acz.LT.tol*fnup)
GO TO 70
538 str = ak1r*czr - ak1i*czi
539 sti = ak1r*czi + ak1i*czr
547 IF (aa.GT.atol)
GO TO 60
549 s2r = s1r*coefr - s1i*coefi
550 s2i = s1r*coefi + s1i*coefr
553 IF (iflag.EQ.0)
GO TO 80
554 CALL zuchk(s2r, s2i, nw, ascle, tol)
555 IF (nw.NE.0)
GO TO 30
560 IF (i.EQ.il)
GO TO 90
561 CALL zdiv(coefr, coefi, hzr, hzi, str, sti)
573 IF (iflag.EQ.1)
GO TO 120
577 yr(k) = (ak+fnu)*(rzr*yr(k+1)-rzi*yi(k+1)) + yr(k+2)
578 yi(k) = (ak+fnu)*(rzr*yi(k+1)+rzi*yr(k+1)) + yi(k+2)
598 s2r = s1r + (ak+fnu)*(rzr*ckr-rzi*cki)
599 s2i = s1i + (ak+fnu)*(rzr*cki+rzi*ckr)
608 IF (zabs(ckr,cki).GT.ascle)
GO TO 140
617 IF (fnu.EQ.0.0d0) nz = nz - 1
621 IF (fnu.NE.0.0d0)
GO TO 170
640 SUBROUTINE zasyi(ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM)
654 DOUBLE PRECISION aa, aez, ak, ak1i, ak1r, alim, arg, arm, atol, &
655 az, bb, bk, cki, ckr, conei, coner, cs1i, cs1r, cs2i, cs2r, czi, &
656 czr, dfnu, dki, dkr, dnu2, elim, ezi, ezr, fdn, fnu, pi, p1i, &
657 p1r, raz, rl, rtpi, rtr1, rzi, rzr, s,
sgn, sqk, sti, str, s2i, &
658 s2r, tol, tzi, tzr, yi, yr, zeroi, zeror, zi, zr
659 INTEGER i, ib, il, inu, j, jl, k, kode, koded, m, n, nn, nz
660 dimension yr(1), yi(1)
661 DATA pi, rtpi /3.14159265358979324d0 , 0.159154943091895336d0 /
662 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
666 arm = 1.0d+3*d1mach(1)
669 dfnu = fnu + dble(float(n-il))
678 CALL zsqrt(ak1r, ak1i, ak1r, ak1i)
681 IF (kode.NE.2)
GO TO 10
685 IF (dabs(czr).GT.elim)
GO TO 100
688 IF ((dabs(czr).GT.alim) .AND. (n.GT.2))
GO TO 20
690 CALL zexp(czr, czi, str, sti)
691 CALL zmlt(ak1r, ak1i, str, sti, ak1r, ak1i)
694 IF (dnu2.GT.rtr1) fdn = dnu2*dnu2
704 jl = int(sngl(rl+rl)) + 2
707 IF (zi.EQ.0.0d0)
GO TO 30
713 arg = (fnu-dble(float(inu)))*pi
717 IF (zi.LT.0.0d0) bk = -bk
720 IF (mod(inu,2).EQ.0)
GO TO 30
740 CALL zdiv(ckr, cki, dkr, dki, str, sti)
746 cs1r = cs1r + ckr*
sgn 747 cs1i = cs1i + cki*
sgn 754 IF (aa.LE.atol)
GO TO 50
760 IF (zr+zr.GE.elim)
GO TO 60
763 CALL zexp(-tzr, -tzi, str, sti)
764 CALL zmlt(str, sti, p1r, p1i, str, sti)
765 CALL zmlt(str, sti, cs2r, cs2i, str, sti)
769 fdn = fdn + 8.0d0*dfnu + 4.0d0
773 yr(m) = s2r*ak1r - s2i*ak1i
774 yi(m) = s2r*ak1i + s2i*ak1r
786 yr(k) = (ak+fnu)*(rzr*yr(k+1)-rzi*yi(k+1)) + yr(k+2)
787 yi(k) = (ak+fnu)*(rzr*yi(k+1)+rzi*yr(k+1)) + yi(k+2)
791 IF (koded.EQ.0)
RETURN 792 CALL zexp(czr, czi, ckr, cki)
794 str = yr(i)*ckr - yi(i)*cki
795 yi(i) = yr(i)*cki + yi(i)*ckr
807 SUBROUTINE zuoik(ZR, ZI, FNU, KODE, IKFLG, N, YR, YI, NUF, TOL, ELIM, ALIM)
837 DOUBLE PRECISION aarg, aic, alim, aphi, argi, argr, asumi, asumr, &
838 ascle, ax, ay, bsumi, bsumr, cwrki, cwrkr, czi, czr, elim, fnn, &
839 fnu, gnn, gnu, phii, phir, rcz, str, sti, sumi, sumr, tol, yi, &
840 yr, zbi, zbr, zeroi, zeror, zeta1i, zeta1r, zeta2i, zeta2r, zi, &
841 zni, znr, zr, zri, zrr
842 INTEGER i, idum, iform, ikflg, init, kode, n, nn, nuf, nw
843 dimension yr(1), yi(1), cwrkr(16), cwrki(16)
844 DATA zeror,zeroi / 0.0d0, 0.0d0 /
845 DATA aic / 1.265512123484645396d+00 /
850 IF (zr.GE.0.0d0)
GO TO 10
856 ax = dabs(zr)*1.7321d0
859 IF (ay.GT.ax) iform = 2
860 gnu = dmax1(fnu,1.0d0)
861 IF (ikflg.EQ.1)
GO TO 20
862 fnn = dble(float(nn))
863 gnn = fnu + fnn - 1.0d0
871 IF (iform.EQ.2)
GO TO 30
873 CALL zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii, &
874 zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
875 czr = -zeta1r + zeta2r
876 czi = -zeta1i + zeta2i
881 IF (zi.GT.0.0d0)
GO TO 40
884 CALL zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r, &
885 zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
886 czr = -zeta1r + zeta2r
887 czi = -zeta1i + zeta2i
888 aarg = zabs(argr,argi)
890 IF (kode.EQ.1)
GO TO 60
894 IF (ikflg.EQ.1)
GO TO 70
898 aphi = zabs(phir,phii)
903 IF (rcz.GT.elim)
GO TO 210
904 IF (rcz.LT.alim)
GO TO 80
905 rcz = rcz + dlog(aphi)
906 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
907 IF (rcz.GT.elim)
GO TO 210
913 IF (rcz.LT.(-elim))
GO TO 90
914 IF (rcz.GT.(-alim))
GO TO 130
915 rcz = rcz + dlog(aphi)
916 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
917 IF (rcz.GT.(-elim))
GO TO 110
926 ascle = 1.0d+3*d1mach(1)/tol
927 CALL zlog(phir, phii, str, sti, idum)
930 IF (iform.EQ.1)
GO TO 120
931 CALL zlog(argr, argi, str, sti, idum)
932 czr = czr - 0.25d0*str - aic
933 czi = czi - 0.25d0*sti
939 CALL zuchk(czr, czi, nw, ascle, tol)
940 IF (nw.NE.0)
GO TO 90
942 IF (ikflg.EQ.2)
RETURN 948 gnu = fnu + dble(float(nn-1))
949 IF (iform.EQ.2)
GO TO 150
951 CALL zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii, &
952 zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
953 czr = -zeta1r + zeta2r
954 czi = -zeta1i + zeta2i
957 CALL zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r, &
958 zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
959 czr = -zeta1r + zeta2r
960 czi = -zeta1i + zeta2i
961 aarg = zabs(argr,argi)
963 IF (kode.EQ.1)
GO TO 170
967 aphi = zabs(phir,phii)
969 IF (rcz.LT.(-elim))
GO TO 180
970 IF (rcz.GT.(-alim))
RETURN 971 rcz = rcz + dlog(aphi)
972 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
973 IF (rcz.GT.(-elim))
GO TO 190
982 ascle = 1.0d+3*d1mach(1)/tol
983 CALL zlog(phir, phii, str, sti, idum)
986 IF (iform.EQ.1)
GO TO 200
987 CALL zlog(argr, argi, str, sti, idum)
988 czr = czr - 0.25d0*str - aic
989 czi = czi - 0.25d0*sti
995 CALL zuchk(czr, czi, nw, ascle, tol)
996 IF (nw.NE.0)
GO TO 180
1003 SUBROUTINE zbuni(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NUI, NLAST, FNUL, TOL, ELIM, ALIM)
1018 DOUBLE PRECISION alim, ax, ay, csclr, cscrr, cyi, cyr, dfnu, &
1019 elim, fnu, fnui, fnul, gnu, raz, rzi, rzr, sti, str, s1i, s1r, &
1020 s2i, s2r, tol, yi, yr, zi, zr, ascle, bry, c1r, c1i, c1m
1021 INTEGER i, iflag, iform, k, kode, n, nl, nlast, nui, nw, nz
1022 dimension yr(1), yi(1), cyr(2), cyi(2), bry(3)
1024 ax = dabs(zr)*1.7321d0
1027 IF (ay.GT.ax) iform = 2
1028 IF (nui.EQ.0)
GO TO 60
1029 fnui = dble(float(nui))
1030 dfnu = fnu + dble(float(n-1))
1032 IF (iform.EQ.2)
GO TO 10
1037 CALL zuni1(zr, zi, gnu, kode, 2, cyr, cyi, nw, nlast, fnul, tol, elim, alim)
1045 CALL zuni2(zr, zi, gnu, kode, 2, cyr, cyi, nw, nlast, fnul, tol, elim, alim)
1047 IF (nw.LT.0)
GO TO 50
1048 IF (nw.NE.0)
GO TO 90
1049 str = zabs(cyr(1),cyi(1))
1053 bry(1)=1.0d+3*d1mach(1)/tol
1054 bry(2) = 1.0d0/bry(1)
1059 IF (str.GT.bry(1))
GO TO 21
1065 IF (str.LT.bry(2))
GO TO 25
1075 raz = 1.0d0/zabs(zr,zi)
1083 s2r = (dfnu+fnui)*(rzr*str-rzi*sti) + s1r
1084 s2i = (dfnu+fnui)*(rzr*sti+rzi*str) + s1i
1088 IF (iflag.GE.3)
GO TO 30
1093 c1m = dmax1(c1r,c1i)
1094 IF (c1m.LE.ascle)
GO TO 30
1112 fnui = dble(float(nl))
1117 s2r = (fnu+fnui)*(rzr*str-rzi*sti) + s1r
1118 s2i = (fnu+fnui)*(rzr*sti+rzi*str) + s1i
1127 IF (iflag.GE.3)
GO TO 40
1130 c1m = dmax1(c1r,c1i)
1131 IF (c1m.LE.ascle)
GO TO 40
1148 IF(nw.EQ.(-2)) nz=-2
1151 IF (iform.EQ.2)
GO TO 70
1156 CALL zuni1(zr, zi, fnu, kode, n, yr, yi, nw, nlast, fnul, tol, elim, alim)
1164 CALL zuni2(zr, zi, fnu, kode, n, yr, yi, nw, nlast, fnul, tol, elim, alim)
1166 IF (nw.LT.0)
GO TO 50
1174 SUBROUTINE zuni1(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL, TOL, ELIM, ALIM)
1193 DOUBLE PRECISION alim, aphi, ascle, bry, conei, coner, crsc, &
1194 cscl, csrr, cssr, cwrki, cwrkr, c1r, c2i, c2m, c2r, elim, fn, &
1195 fnu, fnul, phii, phir, rast, rs1, rzi, rzr, sti, str, sumi, &
1196 sumr, s1i, s1r, s2i, s2r, tol, yi, yr, zeroi, zeror, zeta1i, &
1197 zeta1r, zeta2i, zeta2r, zi, zr, cyr, cyi
1198 INTEGER i, iflag, init, k, kode, m, n, nd, nlast, nn, nuf, nw, nz
1199 dimension bry(3), yr(1), yi(1), cwrkr(16), cwrki(16), cssr(3), &
1200 csrr(3), cyr(2), cyi(2)
1201 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
1219 bry(1) = 1.0d+3*d1mach(1)/tol
1223 fn = dmax1(fnu,1.0d0)
1225 CALL zunik(zr, zi, fn, 1, 1, tol, init, phir, phii, zeta1r, &
1226 zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
1227 IF (kode.EQ.1)
GO TO 10
1230 rast = fn/zabs(str,sti)
1232 sti = -sti*rast*rast
1237 s1r = -zeta1r + zeta2r
1238 s1i = -zeta1i + zeta2i
1241 IF (dabs(rs1).GT.elim)
GO TO 130
1245 fn = fnu + dble(float(nd-i))
1247 CALL zunik(zr, zi, fn, 1, 0, tol, init, phir, phii, zeta1r, &
1248 zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
1249 IF (kode.EQ.1)
GO TO 40
1252 rast = fn/zabs(str,sti)
1254 sti = -sti*rast*rast
1256 s1i = -zeta1i + sti + zi
1259 s1r = -zeta1r + zeta2r
1260 s1i = -zeta1i + zeta2i
1266 IF (dabs(rs1).GT.elim)
GO TO 110
1267 IF (i.EQ.1) iflag = 2
1268 IF (dabs(rs1).LT.alim)
GO TO 60
1272 aphi = zabs(phir,phii)
1273 rs1 = rs1 + dlog(aphi)
1274 IF (dabs(rs1).GT.elim)
GO TO 110
1275 IF (i.EQ.1) iflag = 1
1276 IF (rs1.LT.0.0d0)
GO TO 60
1277 IF (i.EQ.1) iflag = 3
1282 s2r = phir*sumr - phii*sumi
1283 s2i = phir*sumi + phii*sumr
1284 str = dexp(s1r)*cssr(iflag)
1287 str = s2r*s1r - s2i*s1i
1288 s2i = s2r*s1i + s2i*s1r
1290 IF (iflag.NE.1)
GO TO 70
1291 CALL zuchk(s2r, s2i, nw, bry(1), tol)
1292 IF (nw.NE.0)
GO TO 110
1297 yr(m) = s2r*csrr(iflag)
1298 yi(m) = s2i*csrr(iflag)
1300 IF (nd.LE.2)
GO TO 100
1301 rast = 1.0d0/zabs(zr,zi)
1304 rzr = (str+str)*rast
1305 rzi = (sti+sti)*rast
1306 bry(2) = 1.0d0/bry(1)
1319 s2r = s1r + (fnu+fn)*(rzr*c2r-rzi*c2i)
1320 s2i = s1i + (fnu+fn)*(rzr*c2i+rzi*c2r)
1329 IF (iflag.GE.3)
GO TO 90
1332 c2m = dmax1(str,sti)
1333 IF (c2m.LE.ascle)
GO TO 90
1340 s1r = s1r*cssr(iflag)
1341 s1i = s1i*cssr(iflag)
1342 s2r = s2r*cssr(iflag)
1343 s2i = s2i*cssr(iflag)
1352 IF (rs1.GT.0.0d0)
GO TO 120
1357 IF (nd.EQ.0)
GO TO 100
1358 CALL zuoik(zr, zi, fnu, kode, 1, nd, yr, yi, nuf, tol, elim, alim)
1359 IF (nuf.LT.0)
GO TO 120
1362 IF (nd.EQ.0)
GO TO 100
1363 fn = fnu + dble(float(nd-1))
1364 IF (fn.GE.fnul)
GO TO 30
1371 IF (rs1.GT.0.0d0)
GO TO 120
1380 SUBROUTINE zuni2(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL, TOL, ELIM, ALIM)
1400 DOUBLE PRECISION aarg, aic, aii, air, alim, ang, aphi, argi, &
1401 argr, ascle, asumi, asumr, bry, bsumi, bsumr, cidi, cipi, cipr, &
1402 conei, coner, crsc, cscl, csrr, cssr, c1r, c2i, c2m, c2r, daii, &
1403 dair, elim, fn, fnu, fnul, hpi, phii, phir, rast, raz, rs1, rzi, &
1404 rzr, sti, str, s1i, s1r, s2i, s2r, tol, yi, yr, zbi, zbr, zeroi, &
1405 zeror, zeta1i, zeta1r, zeta2i, zeta2r, zi, zni, znr, zr, cyr, cyi
1406 INTEGER i, iflag, in, inu, j, k, kode, n, nai, nd, ndai, nlast, &
1407 nn, nuf, nw, nz, idum
1408 dimension bry(3), yr(1), yi(1), cipr(4), cipi(4), cssr(3), &
1409 csrr(3), cyr(2), cyi(2)
1410 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
1411 DATA cipr(1),cipi(1),cipr(2),cipi(2),cipr(3),cipi(3),cipr(4), &
1412 cipi(4)/ 1.0d0,0.0d0, 0.0d0,1.0d0, -1.0d0,0.0d0, 0.0d0,-1.0d0/
1413 DATA hpi, aic /1.57079632679489662d+00, 1.265512123484645396d+00/
1431 bry(1) = 1.0d+3*d1mach(1)/tol
1440 inu = int(sngl(fnu))
1441 ang = hpi*(fnu-dble(float(inu)))
1446 str = c2r*cipr(in) - c2i*cipi(in)
1447 c2i = c2r*cipi(in) + c2i*cipr(in)
1449 IF (zi.GT.0.0d0)
GO TO 10
1458 fn = dmax1(fnu,1.0d0)
1459 CALL zunhj(znr, zni, fn, 1, tol, phir, phii, argr, argi, zeta1r, &
1460 zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
1461 IF (kode.EQ.1)
GO TO 20
1464 rast = fn/zabs(str,sti)
1466 sti = -sti*rast*rast
1471 s1r = -zeta1r + zeta2r
1472 s1i = -zeta1i + zeta2i
1475 IF (dabs(rs1).GT.elim)
GO TO 150
1479 fn = fnu + dble(float(nd-i))
1480 CALL zunhj(znr, zni, fn, 0, tol, phir, phii, argr, argi, &
1481 zeta1r, zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
1482 IF (kode.EQ.1)
GO TO 50
1485 rast = fn/zabs(str,sti)
1487 sti = -sti*rast*rast
1489 s1i = -zeta1i + sti + dabs(zi)
1492 s1r = -zeta1r + zeta2r
1493 s1i = -zeta1i + zeta2i
1499 IF (dabs(rs1).GT.elim)
GO TO 120
1500 IF (i.EQ.1) iflag = 2
1501 IF (dabs(rs1).LT.alim)
GO TO 70
1505 aphi = zabs(phir,phii)
1506 aarg = zabs(argr,argi)
1507 rs1 = rs1 + dlog(aphi) - 0.25d0*dlog(aarg) - aic
1508 IF (dabs(rs1).GT.elim)
GO TO 120
1509 IF (i.EQ.1) iflag = 1
1510 IF (rs1.LT.0.0d0)
GO TO 70
1511 IF (i.EQ.1) iflag = 3
1517 CALL zairy(argr, argi, 0, 2, air, aii, nai, idum)
1518 CALL zairy(argr, argi, 1, 2, dair, daii, ndai, idum)
1519 str = dair*bsumr - daii*bsumi
1520 sti = dair*bsumi + daii*bsumr
1521 str = str + (air*asumr-aii*asumi)
1522 sti = sti + (air*asumi+aii*asumr)
1523 s2r = phir*str - phii*sti
1524 s2i = phir*sti + phii*str
1525 str = dexp(s1r)*cssr(iflag)
1528 str = s2r*s1r - s2i*s1i
1529 s2i = s2r*s1i + s2i*s1r
1531 IF (iflag.NE.1)
GO TO 80
1532 CALL zuchk(s2r, s2i, nw, bry(1), tol)
1533 IF (nw.NE.0)
GO TO 120
1535 IF (zi.LE.0.0d0) s2i = -s2i
1536 str = s2r*c2r - s2i*c2i
1537 s2i = s2r*c2i + s2i*c2r
1542 yr(j) = s2r*csrr(iflag)
1543 yi(j) = s2i*csrr(iflag)
1548 IF (nd.LE.2)
GO TO 110
1549 raz = 1.0d0/zabs(zr,zi)
1554 bry(2) = 1.0d0/bry(1)
1567 s2r = s1r + (fnu+fn)*(rzr*c2r-rzi*c2i)
1568 s2i = s1i + (fnu+fn)*(rzr*c2i+rzi*c2r)
1577 IF (iflag.GE.3)
GO TO 100
1580 c2m = dmax1(str,sti)
1581 IF (c2m.LE.ascle)
GO TO 100
1588 s1r = s1r*cssr(iflag)
1589 s1i = s1i*cssr(iflag)
1590 s2r = s2r*cssr(iflag)
1591 s2i = s2i*cssr(iflag)
1597 IF (rs1.GT.0.0d0)
GO TO 140
1605 IF (nd.EQ.0)
GO TO 110
1606 CALL zuoik(zr, zi, fnu, kode, 1, nd, yr, yi, nuf, tol, elim, alim)
1607 IF (nuf.LT.0)
GO TO 140
1610 IF (nd.EQ.0)
GO TO 110
1611 fn = fnu + dble(float(nd-1))
1612 IF (fn.LT.fnul)
GO TO 130
1618 IF (fn.LT.0.0d0) s1i = -s1i
1619 str = c2r*s1r - c2i*s1i
1620 c2i = c2r*s1i + c2i*s1r
1630 IF (rs1.GT.0.0d0)
GO TO 140
1639 SUBROUTINE zwrsk(ZRR, ZRI, FNU, KODE, N, YR, YI, NZ, CWR, CWI, TOL, ELIM, ALIM)
1651 DOUBLE PRECISION act, acw, alim, ascle, cinui, cinur, csclr, cti, &
1652 ctr, cwi, cwr, c1i, c1r, c2i, c2r, elim, fnu, pti, ptr, ract, &
1653 sti, str, tol, yi, yr, zri, zrr
1654 INTEGER i, kode, n, nw, nz
1655 dimension yr(1), yi(1), cwr(2), cwi(2)
1662 CALL zbknu(zrr, zri, fnu, kode, 2, cwr, cwi, nw, tol, elim, alim)
1663 IF (nw.NE.0)
GO TO 50
1664 CALL zrati(zrr, zri, fnu, n, yr, yi, tol)
1671 IF (kode.EQ.1)
GO TO 10
1681 acw = zabs(cwr(2),cwi(2))
1682 ascle = 1.0d+3*d1mach(1)/tol
1684 IF (acw.GT.ascle)
GO TO 20
1689 IF (acw.LT.ascle)
GO TO 30
1702 ptr = str*c1r - sti*c1i
1703 pti = str*c1i + sti*c1r
1706 ctr = zrr*ptr - zri*pti
1707 cti = zrr*pti + zri*ptr
1714 cinur = ptr*ctr - pti*cti
1715 cinui = ptr*cti + pti*ctr
1720 ptr = str*cinur - sti*cinui
1721 cinui = str*cinui + sti*cinur
1731 IF(nw.EQ.(-2)) nz=-2
1735 SUBROUTINE zbknu(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM)
1747 DOUBLE PRECISION aa, ak, alim, ascle, a1, a2, bb, bk, bry, caz, &
1748 cbi, cbr, cc, cchi, cchr, cki, ckr, coefi, coefr, conei, coner, &
1749 crscr, csclr, cshi, cshr, csi, csr, csrr, cssr, ctwoi, ctwor, &
1750 czeroi, czeror, czi, czr, dnu, dnu2, dpi, elim, etest, fc, fhs, &
1751 fi, fk, fks, fmui, fmur, fnu, fpi, fr, g1, g2, hpi, pi, pr, pti,&
1752 ptr, p1i, p1r, p2i, p2m, p2r, qi, qr, rak, rcaz, rthpi, rzi, &
1753 rzr, r1, s, smui, smur, spi, sti, str, s1i, s1r, s2i, s2r, tm, &
1754 tol, tth, t1, t2, yi, yr, zi, zr, elm, celmr, zdr, zdi, &
1755 as, alas, helim, cyr, cyi
1756 INTEGER i, iflag, inu, k, kflag, kk, kmax, kode, koded, n, nz, &
1757 idum, j, ic, inub, nw
1758 dimension yr(n), yi(n), cc(8), cssr(3), csrr(3), bry(3), cyr(2),&
1764 DATA czeror,czeroi,coner,conei,ctwor,ctwoi,r1/ &
1765 0.0d0 , 0.0d0 , 1.0d0 , 0.0d0 , 2.0d0 , 0.0d0 , 2.0d0 /
1766 DATA dpi, rthpi, spi ,hpi, fpi, tth / &
1767 3.14159265358979324d0, 1.25331413731550025d0, &
1768 1.90985931710274403d0, 1.57079632679489662d0, &
1769 1.89769999331517738d0, 6.66666666666666666d-01/
1770 DATA cc(1), cc(2), cc(3), cc(4), cc(5), cc(6), cc(7), cc(8)/ &
1771 5.77215664901532861d-01, -4.20026350340952355d-02, &
1772 -4.21977345555443367d-02, 7.21894324666309954d-03, &
1773 -2.15241674114950973d-04, -2.01348547807882387d-05, &
1774 1.13302723198169588d-06, 6.11609510448141582d-09/
1785 bry(1) = 1.0d+3*d1mach(1)/tol
1786 bry(2) = 1.0d0/bry(1)
1794 rzr = (str+str)*rcaz
1795 rzi = (sti+sti)*rcaz
1796 inu = int(sngl(fnu+0.5d0))
1797 dnu = fnu - dble(float(inu))
1798 IF (dabs(dnu).EQ.0.5d0)
GO TO 110
1800 IF (dabs(dnu).GT.tol) dnu2 = dnu*dnu
1801 IF (caz.GT.r1)
GO TO 110
1806 CALL zlog(rzr, rzi, smur, smui, idum)
1809 CALL zshch(fmur, fmui, cshr, cshi, cchr, cchi)
1810 IF (dnu.EQ.0.0d0)
GO TO 10
1820 t2 = dexp(-dgamln(a2,idum))
1822 IF (dabs(dnu).GT.0.1d0)
GO TO 40
1832 IF (dabs(tm).LT.tol)
GO TO 30
1837 g1 = (t1-t2)/(dnu+dnu)
1840 fr = fc*(cchr*g1+smur*g2)
1841 fi = fc*(cchi*g1+smui*g2)
1842 CALL zexp(fmur, fmui, str, sti)
1845 CALL zdiv(0.5d0, 0.0d0, str, sti, ptr, pti)
1857 IF (inu.GT.0 .OR. n.GT.1)
GO TO 80
1861 IF (caz.LT.tol)
GO TO 70
1862 CALL zmlt(zr, zi, zr, zi, czr, czi)
1867 fr = (fr*ak+pr+qr)/bk
1868 fi = (fi*ak+pi+qi)/bk
1869 str = 1.0d0/(ak-dnu)
1872 str = 1.0d0/(ak+dnu)
1875 str = ckr*czr - cki*czi
1877 cki = (ckr*czi+cki*czr)*rak
1879 s1r = ckr*fr - cki*fi + s1r
1880 s1i = ckr*fi + cki*fr + s1i
1882 bk = bk + ak + ak + 1.0d0
1884 IF (a1.GT.tol)
GO TO 60
1888 IF (koded.EQ.1)
RETURN 1889 CALL zexp(zr, zi, str, sti)
1890 CALL zmlt(s1r, s1i, str, sti, yr(1), yi(1))
1896 IF (caz.LT.tol)
GO TO 100
1897 CALL zmlt(zr, zi, zr, zi, czr, czi)
1902 fr = (fr*ak+pr+qr)/bk
1903 fi = (fi*ak+pi+qi)/bk
1904 str = 1.0d0/(ak-dnu)
1907 str = 1.0d0/(ak+dnu)
1910 str = ckr*czr - cki*czi
1912 cki = (ckr*czi+cki*czr)*rak
1914 s1r = ckr*fr - cki*fi + s1r
1915 s1i = ckr*fi + cki*fr + s1i
1918 s2r = ckr*str - cki*sti + s2r
1919 s2i = ckr*sti + cki*str + s2i
1921 bk = bk + ak + ak + 1.0d0
1923 IF (a1.GT.tol)
GO TO 90
1928 IF (ak.GT.alim) kflag = 3
1932 CALL zmlt(p2r, p2i, rzr, rzi, s2r, s2i)
1935 IF (koded.EQ.1)
GO TO 210
1936 CALL zexp(zr, zi, fr, fi)
1937 CALL zmlt(s1r, s1i, fr, fi, s1r, s1i)
1938 CALL zmlt(s2r, s2i, fr, fi, s2r, s2i)
1947 CALL zsqrt(zr, zi, str, sti)
1948 CALL zdiv(rthpi, czeroi, str, sti, coefr, coefi)
1950 IF (koded.EQ.2)
GO TO 120
1951 IF (zr.GT.alim)
GO TO 290
1953 str = dexp(-zr)*cssr(kflag)
1956 CALL zmlt(coefr, coefi, str, sti, coefr, coefi)
1958 IF (dabs(dnu).EQ.0.5d0)
GO TO 300
1964 IF (ak.EQ.czeror)
GO TO 300
1965 fhs = dabs(0.25d0-dnu2)
1966 IF (fhs.EQ.czeror)
GO TO 300
1973 t1 = dble(float(i1mach(14)-1))
1974 t1 = t1*d1mach(5)*3.321928094d0
1975 t1 = dmax1(t1,12.0d0)
1976 t1 = dmin1(t1,60.0d0)
1978 IF (zr.NE.0.0d0)
GO TO 130
1985 IF (t2.GT.caz)
GO TO 170
1989 etest = ak/(dpi*caz*tol)
1991 IF (etest.LT.coner)
GO TO 180
1993 ckr = caz + caz + ctwor
1998 cbr = ckr/(fk+coner)
2000 p2r = cbr*p2r - p1r*ak
2003 fks = fks + fk + fk + ctwor
2007 IF (etest.LT.str)
GO TO 160
2011 fk = fk + spi*t1*dsqrt(t2/caz)
2012 fhs = dabs(0.25d0-dnu2)
2019 ak = fpi*ak/(tol*dsqrt(a2))
2020 aa = 3.0d0*t1/(1.0d0+caz)
2021 bb = 14.7d0*t1/(28.0d0+caz)
2022 ak = (dlog(ak)+caz*dcos(aa)/(1.0d0+0.008d0*caz))/dcos(bb)
2023 fk = 0.12125d0*ak*ak/caz + 1.5d0
2039 ak = (fks+fk)/(a1+fhs)
2040 rak = 2.0d0/(fk+coner)
2045 p2r = (ptr*cbr-pti*cbi-p1r)*ak
2046 p2i = (pti*cbr+ptr*cbi-p1i)*ak
2051 fks = a1 - fk + coner
2064 CALL zmlt(coefr, coefi, s1r, s1i, str, sti)
2065 CALL zmlt(str, sti, csr, csi, s1r, s1i)
2066 IF (inu.GT.0 .OR. n.GT.1)
GO TO 200
2069 IF(iflag.EQ.1)
GO TO 270
2081 CALL zmlt(p1r, p1i, p2r, p2i, ptr, pti)
2082 str = dnu + 0.5d0 - ptr
2084 CALL zdiv(str, sti, zr, zi, str, sti)
2086 CALL zmlt(str, sti, s1r, s1i, s2r, s2i)
2095 IF (n.EQ.1) inu = inu - 1
2096 IF (inu.GT.0)
GO TO 220
2097 IF (n.GT.1)
GO TO 215
2103 IF(iflag.EQ.1)
GO TO 270
2107 IF(iflag.EQ.1)
GO TO 261
2114 s2r = ckr*str - cki*sti + s1r
2115 s2i = ckr*sti + cki*str + s1i
2120 IF (kflag.GE.3)
GO TO 230
2125 p2m = dmax1(str,sti)
2126 IF (p2m.LE.ascle)
GO TO 230
2140 IF (n.NE.1)
GO TO 240
2160 s2r = ckr*p2r - cki*p2i + s1r
2161 s2i = cki*p2r + ckr*p2i + s1i
2170 IF (kflag.GE.3)
GO TO 260
2173 p2m = dmax1(str,sti)
2174 IF (p2m.LE.ascle)
GO TO 260
2204 s2r = str*ckr-sti*cki+s1r
2205 s2i = sti*ckr+str*cki+s1i
2213 IF(p2r.LT.(-elim))
GO TO 263
2214 CALL zlog(s2r,s2i,str,sti,idum)
2220 CALL zuchk(p1r,p1i,nw,ascle,tol)
2221 IF(nw.NE.0)
GO TO 263
2225 IF(ic.EQ.(i-1))
GO TO 264
2229 IF(alas.LT.helim)
GO TO 262
2236 IF(n.NE.1)
GO TO 270
2248 IF(inub.LE.inu)
GO TO 225
2249 IF(n.NE.1)
GO TO 240
2256 IF(n.EQ.1)
GO TO 280
2261 CALL zkscl(zdr,zdi,fnu,n,yr,yi,nz,rzr,rzi,ascle,tol,elim)
2263 IF (inu.LE.0)
RETURN 2267 yr(kk) = s1r*csrr(1)
2268 yi(kk) = s1i*csrr(1)
2269 IF (inu.EQ.1)
RETURN 2273 yr(kk) = s2r*csrr(1)
2274 yi(kk) = s2i*csrr(1)
2275 IF (inu.EQ.2)
RETURN 2276 t2 = fnu + dble(float(kk-1))
2304 SUBROUTINE zkscl(ZRR,ZRI,FNU,N,YR,YI,NZ,RZR,RZI,ASCLE,TOL,ELIM)
2316 DOUBLE PRECISION acs, as, ascle, cki, ckr, csi, csr, cyi, &
2317 cyr, elim, fn, fnu, rzi, rzr, str, s1i, s1r, s2i, s2r, &
2318 tol, yi, yr, zeroi, zeror, zri, zrr, zdr, zdi, celmr, &
2320 INTEGER i, ic, idum, kk, n, nn, nw, nz
2321 dimension yr(1), yi(1), cyr(2), cyi(2)
2322 DATA zeror,zeroi / 0.0d0 , 0.0d0 /
2333 acs = -zrr + dlog(as)
2337 IF (acs.LT.(-elim))
GO TO 10
2338 CALL zlog(s1r, s1i, csr, csi, idum)
2344 CALL zuchk(csr, csi, nw, ascle, tol)
2345 IF (nw.NE.0)
GO TO 10
2352 IF (ic.GT.1)
GO TO 20
2379 s2r = ckr*csr - cki*csi + s1r
2380 s2i = cki*csr + ckr*csi + s1i
2391 IF (acs.LT.(-elim))
GO TO 25
2392 CALL zlog(s2r, s2i, csr, csi, idum)
2398 CALL zuchk(csr, csi, nw, ascle, tol)
2399 IF (nw.NE.0)
GO TO 25
2403 IF (ic.EQ.kk-1)
GO TO 40
2407 IF(alas.LT.helim)
GO TO 30
2427 SUBROUTINE zshch(ZR, ZI, CSHR, CSHI, CCHR, CCHI)
2437 DOUBLE PRECISION cchi, cchr, ch, cn, cshi, cshr, sh, sn, zi, zr, dcosh, dsinh
2449 SUBROUTINE zmlri(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL)
2461 DOUBLE PRECISION ack, ak, ap, at, az, bk, cki, ckr, cnormi, &
2462 cnormr, conei, coner, fkap, fkk, flam, fnf, fnu, pti, ptr, p1i, &
2463 p1r, p2i, p2r, raz, rho, rho2, rzi, rzr, scle, sti, str, sumi, &
2464 sumr, tfnf, tol, tst, yi, yr, zeroi, zeror, zi, zr
2465 INTEGER i, iaz, idum, ifnu, inu, itime, k, kk, km, kode, m, n, nz
2466 dimension yr(1), yi(1)
2467 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
2468 scle = d1mach(1)/tol
2472 ifnu = int(sngl(fnu))
2474 at = dble(float(iaz)) + 1.0d0
2486 ack = (at+1.0d0)*raz
2487 rho = ack + dsqrt(ack*ack-1.0d0)
2489 tst = (rho2+rho2)/((rho2-1.0d0)*(rho-1.0d0))
2498 p2r = p1r - (ckr*ptr-cki*pti)
2499 p2i = p1i - (cki*ptr+ckr*pti)
2505 IF (ap.GT.tst*ak*ak)
GO TO 20
2512 IF (inu.LT.iaz)
GO TO 40
2520 at = dble(float(inu)) + 1.0d0
2526 tst = dsqrt(ack/tol)
2531 p2r = p1r - (ckr*ptr-cki*pti)
2532 p2i = p1i - (ckr*pti+cki*ptr)
2538 IF (ap.LT.tst)
GO TO 30
2539 IF (itime.EQ.2)
GO TO 40
2541 flam = ack + dsqrt(ack*ack-1.0d0)
2542 fkap = ap/zabs(p1r,p1i)
2543 rho = dmin1(flam,fkap)
2544 tst = tst*dsqrt(rho/(rho*rho-1.0d0))
2553 kk = max0(i+iaz,k+inu)
2554 fkk = dble(float(kk))
2562 fnf = fnu - dble(float(ifnu))
2564 bk = dgamln(fkk+tfnf+1.0d0,idum) - dgamln(fkk+1.0d0,idum) - &
2565 dgamln(tfnf+1.0d0,idum)
2573 p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti)
2574 p2i = p1i + (fkk+fnf)*(rzi*ptr+rzr*pti)
2577 ak = 1.0d0 - tfnf/(fkk+tfnf)
2579 sumr = sumr + (ack+bk)*p1r
2580 sumi = sumi + (ack+bk)*p1i
2586 IF (n.EQ.1)
GO TO 70
2590 p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti)
2591 p2i = p1i + (fkk+fnf)*(rzi*ptr+rzr*pti)
2594 ak = 1.0d0 - tfnf/(fkk+tfnf)
2596 sumr = sumr + (ack+bk)*p1r
2597 sumi = sumi + (ack+bk)*p1i
2605 IF (ifnu.LE.0)
GO TO 90
2609 p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti)
2610 p2i = p1i + (fkk+fnf)*(rzr*pti+rzi*ptr)
2613 ak = 1.0d0 - tfnf/(fkk+tfnf)
2615 sumr = sumr + (ack+bk)*p1r
2616 sumi = sumi + (ack+bk)*p1i
2623 IF (kode.EQ.2) ptr = zeror
2624 CALL zlog(rzr, rzi, str, sti, idum)
2625 p1r = -fnf*str + ptr
2626 p1i = -fnf*sti + pti
2627 ap = dgamln(1.0d0+fnf,idum)
2638 CALL zexp(ptr, pti, str, sti)
2643 CALL zmlt(ckr, cki, ptr, pti, cnormr, cnormi)
2645 str = yr(i)*cnormr - yi(i)*cnormi
2646 yi(i) = yr(i)*cnormi + yi(i)*cnormr
2655 DOUBLE PRECISION FUNCTION dgamln(Z,IERR)
2694 DOUBLE PRECISION cf, con, fln, fz, gln, rln, s, tlg, trm, tst, &
2695 t1, wdtol, z, zdmy, zinc, zm, zmin, zp, zsq
2696 INTEGER i, ierr, i1m, k, mz, nz
2697 dimension cf(22), gln(100)
2699 DATA gln(1), gln(2), gln(3), gln(4), gln(5), gln(6), gln(7), &
2700 gln(8), gln(9), gln(10), gln(11), gln(12), gln(13), gln(14), &
2701 gln(15), gln(16), gln(17), gln(18), gln(19), gln(20), &
2703 0.00000000000000000d+00, 0.00000000000000000d+00, &
2704 6.93147180559945309d-01, 1.79175946922805500d+00, &
2705 3.17805383034794562d+00, 4.78749174278204599d+00, &
2706 6.57925121201010100d+00, 8.52516136106541430d+00, &
2707 1.06046029027452502d+01, 1.28018274800814696d+01, &
2708 1.51044125730755153d+01, 1.75023078458738858d+01, &
2709 1.99872144956618861d+01, 2.25521638531234229d+01, &
2710 2.51912211827386815d+01, 2.78992713838408916d+01, &
2711 3.06718601060806728d+01, 3.35050734501368889d+01, &
2712 3.63954452080330536d+01, 3.93398841871994940d+01, &
2713 4.23356164607534850d+01, 4.53801388984769080d+01/
2714 DATA gln(23), gln(24), gln(25), gln(26), gln(27), gln(28), &
2715 gln(29), gln(30), gln(31), gln(32), gln(33), gln(34), &
2716 gln(35), gln(36), gln(37), gln(38), gln(39), gln(40), &
2717 gln(41), gln(42), gln(43), gln(44)/ &
2718 4.84711813518352239d+01, 5.16066755677643736d+01, &
2719 5.47847293981123192d+01, 5.80036052229805199d+01, &
2720 6.12617017610020020d+01, 6.45575386270063311d+01, &
2721 6.78897431371815350d+01, 7.12570389671680090d+01, &
2722 7.46582363488301644d+01, 7.80922235533153106d+01, &
2723 8.15579594561150372d+01, 8.50544670175815174d+01, &
2724 8.85808275421976788d+01, 9.21361756036870925d+01, &
2725 9.57196945421432025d+01, 9.93306124547874269d+01, &
2726 1.02968198614513813d+02, 1.06631760260643459d+02, &
2727 1.10320639714757395d+02, 1.14034211781461703d+02, &
2728 1.17771881399745072d+02, 1.21533081515438634d+02/
2729 DATA gln(45), gln(46), gln(47), gln(48), gln(49), gln(50), &
2730 gln(51), gln(52), gln(53), gln(54), gln(55), gln(56), &
2731 gln(57), gln(58), gln(59), gln(60), gln(61), gln(62), &
2732 gln(63), gln(64), gln(65), gln(66)/ &
2733 1.25317271149356895d+02, 1.29123933639127215d+02, &
2734 1.32952575035616310d+02, 1.36802722637326368d+02, &
2735 1.40673923648234259d+02, 1.44565743946344886d+02, &
2736 1.48477766951773032d+02, 1.52409592584497358d+02, &
2737 1.56360836303078785d+02, 1.60331128216630907d+02, &
2738 1.64320112263195181d+02, 1.68327445448427652d+02, &
2739 1.72352797139162802d+02, 1.76395848406997352d+02, &
2740 1.80456291417543771d+02, 1.84533828861449491d+02, &
2741 1.88628173423671591d+02, 1.92739047287844902d+02, &
2742 1.96866181672889994d+02, 2.01009316399281527d+02, &
2743 2.05168199482641199d+02, 2.09342586752536836d+02/
2744 DATA gln(67), gln(68), gln(69), gln(70), gln(71), gln(72), &
2745 gln(73), gln(74), gln(75), gln(76), gln(77), gln(78), &
2746 gln(79), gln(80), gln(81), gln(82), gln(83), gln(84), &
2747 gln(85), gln(86), gln(87), gln(88)/ &
2748 2.13532241494563261d+02, 2.17736934113954227d+02, &
2749 2.21956441819130334d+02, 2.26190548323727593d+02, &
2750 2.30439043565776952d+02, 2.34701723442818268d+02, &
2751 2.38978389561834323d+02, 2.43268849002982714d+02, &
2752 2.47572914096186884d+02, 2.51890402209723194d+02, &
2753 2.56221135550009525d+02, 2.60564940971863209d+02, &
2754 2.64921649798552801d+02, 2.69291097651019823d+02, &
2755 2.73673124285693704d+02, 2.78067573440366143d+02, &
2756 2.82474292687630396d+02, 2.86893133295426994d+02, &
2757 2.91323950094270308d+02, 2.95766601350760624d+02, &
2758 3.00220948647014132d+02, 3.04686856765668715d+02/
2759 DATA gln(89), gln(90), gln(91), gln(92), gln(93), gln(94), &
2760 gln(95), gln(96), gln(97), gln(98), gln(99), gln(100)/ &
2761 3.09164193580146922d+02, 3.13652829949879062d+02, &
2762 3.18152639620209327d+02, 3.22663499126726177d+02, &
2763 3.27185287703775217d+02, 3.31717887196928473d+02, &
2764 3.36261181979198477d+02, 3.40815058870799018d+02, &
2765 3.45379407062266854d+02, 3.49954118040770237d+02, &
2766 3.54539085519440809d+02, 3.59134205369575399d+02/
2768 DATA cf(1), cf(2), cf(3), cf(4), cf(5), cf(6), cf(7), cf(8), &
2769 cf(9), cf(10), cf(11), cf(12), cf(13), cf(14), cf(15), &
2770 cf(16), cf(17), cf(18), cf(19), cf(20), cf(21), cf(22)/ &
2771 8.33333333333333333d-02, -2.77777777777777778d-03, &
2772 7.93650793650793651d-04, -5.95238095238095238d-04, &
2773 8.41750841750841751d-04, -1.91752691752691753d-03, &
2774 6.41025641025641026d-03, -2.95506535947712418d-02, &
2775 1.79644372368830573d-01, -1.39243221690590112d+00, &
2776 1.34028640441683920d+01, -1.56848284626002017d+02, &
2777 2.19310333333333333d+03, -3.61087712537249894d+04, &
2778 6.91472268851313067d+05, -1.52382215394074162d+07, &
2779 3.82900751391414141d+08, -1.08822660357843911d+10, &
2780 3.47320283765002252d+11, -1.23696021422692745d+13, &
2781 4.88788064793079335d+14, -2.13203339609193739d+16/
2784 DATA con / 1.83787706640934548d+00/
2788 IF (z.LE.0.0d0)
GO TO 70
2789 IF (z.GT.101.0d0)
GO TO 10
2792 IF (fz.GT.0.0d0)
GO TO 10
2793 IF (nz.GT.100)
GO TO 10
2798 wdtol = dmax1(wdtol,0.5d-18)
2800 rln = d1mach(5)*float(i1m)
2801 fln = dmin1(rln,20.0d0)
2802 fln = dmax1(fln,3.0d0)
2804 zm = 1.8000d0 + 0.3875d0*fln
2805 mz = int(sngl(zm)) + 1
2809 IF (z.GE.zmin)
GO TO 20
2810 zinc = zmin - float(nz)
2816 IF (zp.LT.wdtol)
GO TO 40
2822 IF (dabs(trm).LT.tst)
GO TO 40
2826 IF (zinc.NE.0.0d0)
GO TO 50
2828 dgamln = z*(tlg-1.0d0) + 0.5d0*(con-tlg) + s
2832 nz = int(sngl(zinc))
2834 zp = zp*(z+float(i-1))
2837 dgamln = zdmy*(tlg-1.0d0) - dlog(zp) + 0.5d0*(con-tlg) + s
2845 SUBROUTINE zunik(ZRR, ZRI, FNU, IKFLG, IPMTR, TOL, INIT, PHIR, &
2846 PHII, ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)
2870 DOUBLE PRECISION ac, c, con, conei, coner, crfni, crfnr, cwrki, &
2871 cwrkr, fnu, phii, phir, rfn, si, sr, sri, srr, sti, str, sumi, &
2872 sumr, test, ti, tol, tr, t2i, t2r, zeroi, zeror, zeta1i, zeta1r, &
2873 zeta2i, zeta2r, zni, znr, zri, zrr
2874 INTEGER i, idum, ikflg, init, ipmtr, j, k, l
2875 dimension c(120), cwrkr(16), cwrki(16), con(2)
2876 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
2877 DATA con(1), con(2) / &
2878 3.98942280401432678d-01, 1.25331413731550025d+00 /
2879 DATA c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10), &
2880 c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18), &
2881 c(19), c(20), c(21), c(22), c(23), c(24)/ &
2882 1.00000000000000000d+00, -2.08333333333333333d-01, &
2883 1.25000000000000000d-01, 3.34201388888888889d-01, &
2884 -4.01041666666666667d-01, 7.03125000000000000d-02, &
2885 -1.02581259645061728d+00, 1.84646267361111111d+00, &
2886 -8.91210937500000000d-01, 7.32421875000000000d-02, &
2887 4.66958442342624743d+00, -1.12070026162229938d+01, &
2888 8.78912353515625000d+00, -2.36408691406250000d+00, &
2889 1.12152099609375000d-01, -2.82120725582002449d+01, &
2890 8.46362176746007346d+01, -9.18182415432400174d+01, &
2891 4.25349987453884549d+01, -7.36879435947963170d+00, &
2892 2.27108001708984375d-01, 2.12570130039217123d+02, &
2893 -7.65252468141181642d+02, 1.05999045252799988d+03/
2894 DATA c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32), &
2895 c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40), &
2896 c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/ &
2897 -6.99579627376132541d+02, 2.18190511744211590d+02, &
2898 -2.64914304869515555d+01, 5.72501420974731445d-01, &
2899 -1.91945766231840700d+03, 8.06172218173730938d+03, &
2900 -1.35865500064341374d+04, 1.16553933368645332d+04, &
2901 -5.30564697861340311d+03, 1.20090291321635246d+03, &
2902 -1.08090919788394656d+02, 1.72772750258445740d+00, &
2903 2.02042913309661486d+04, -9.69805983886375135d+04, &
2904 1.92547001232531532d+05, -2.03400177280415534d+05, &
2905 1.22200464983017460d+05, -4.11926549688975513d+04, &
2906 7.10951430248936372d+03, -4.93915304773088012d+02, &
2907 6.07404200127348304d+00, -2.42919187900551333d+05, &
2908 1.31176361466297720d+06, -2.99801591853810675d+06/
2909 DATA c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56), &
2910 c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64), &
2911 c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/ &
2912 3.76327129765640400d+06, -2.81356322658653411d+06, &
2913 1.26836527332162478d+06, -3.31645172484563578d+05, &
2914 4.52187689813627263d+04, -2.49983048181120962d+03, &
2915 2.43805296995560639d+01, 3.28446985307203782d+06, &
2916 -1.97068191184322269d+07, 5.09526024926646422d+07, &
2917 -7.41051482115326577d+07, 6.63445122747290267d+07, &
2918 -3.75671766607633513d+07, 1.32887671664218183d+07, &
2919 -2.78561812808645469d+06, 3.08186404612662398d+05, &
2920 -1.38860897537170405d+04, 1.10017140269246738d+02, &
2921 -4.93292536645099620d+07, 3.25573074185765749d+08, &
2922 -9.39462359681578403d+08, 1.55359689957058006d+09, &
2923 -1.62108055210833708d+09, 1.10684281682301447d+09/
2924 DATA c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80), &
2925 c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88), &
2926 c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/ &
2927 -4.95889784275030309d+08, 1.42062907797533095d+08, &
2928 -2.44740627257387285d+07, 2.24376817792244943d+06, &
2929 -8.40054336030240853d+04, 5.51335896122020586d+02, &
2930 8.14789096118312115d+08, -5.86648149205184723d+09, &
2931 1.86882075092958249d+10, -3.46320433881587779d+10, &
2932 4.12801855797539740d+10, -3.30265997498007231d+10, &
2933 1.79542137311556001d+10, -6.56329379261928433d+09, &
2934 1.55927986487925751d+09, -2.25105661889415278d+08, &
2935 1.73951075539781645d+07, -5.49842327572288687d+05, &
2936 3.03809051092238427d+03, -1.46792612476956167d+10, &
2937 1.14498237732025810d+11, -3.99096175224466498d+11, &
2938 8.19218669548577329d+11, -1.09837515608122331d+12/
2939 DATA c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104), &
2940 c(105), c(106), c(107), c(108), c(109), c(110), c(111), &
2941 c(112), c(113), c(114), c(115), c(116), c(117), c(118)/ &
2942 1.00815810686538209d+12, -6.45364869245376503d+11, &
2943 2.87900649906150589d+11, -8.78670721780232657d+10, &
2944 1.76347306068349694d+10, -2.16716498322379509d+09, &
2945 1.43157876718888981d+08, -3.87183344257261262d+06, &
2946 1.82577554742931747d+04, 2.86464035717679043d+11, &
2947 -2.40629790002850396d+12, 9.10934118523989896d+12, &
2948 -2.05168994109344374d+13, 3.05651255199353206d+13, &
2949 -3.16670885847851584d+13, 2.33483640445818409d+13, &
2950 -1.23204913055982872d+13, 4.61272578084913197d+12, &
2951 -1.19655288019618160d+12, 2.05914503232410016d+11, &
2952 -2.18229277575292237d+10, 1.24700929351271032d+09/
2953 DATA c(119), c(120)/ &
2954 -2.91883881222208134d+07, 1.18838426256783253d+05/
2956 IF (init.NE.0)
GO TO 40
2963 sr = coner + (tr*tr-ti*ti)
2964 si = conei + (tr*ti+ti*tr)
2965 CALL zsqrt(sr, si, srr, sri)
2968 CALL zdiv(str, sti, tr, ti, znr, zni)
2969 CALL zlog(znr, zni, str, sti, idum)
2974 CALL zdiv(coner, conei, srr, sri, tr, ti)
2977 CALL zsqrt(srr, sri, cwrkr(16), cwrki(16))
2978 phir = cwrkr(16)*con(ikflg)
2979 phii = cwrki(16)*con(ikflg)
2980 IF (ipmtr.NE.0)
RETURN 2981 CALL zdiv(coner, conei, sr, si, t2r, t2i)
2993 str = sr*t2r - si*t2i + c(l)
2994 si = sr*t2i + si*t2r
2997 str = crfnr*srr - crfni*sri
2998 crfni = crfnr*sri + crfni*srr
3000 cwrkr(k) = crfnr*sr - crfni*si
3001 cwrki(k) = crfnr*si + crfni*sr
3003 test = dabs(cwrkr(k)) + dabs(cwrki(k))
3004 IF (ac.LT.tol .AND. test.LT.tol)
GO TO 30
3010 IF (ikflg.EQ.2)
GO TO 60
3022 phir = cwrkr(16)*con(1)
3023 phii = cwrki(16)*con(1)
3033 sr = sr + tr*cwrkr(i)
3034 si = si + tr*cwrki(i)
3039 phir = cwrkr(16)*con(2)
3040 phii = cwrki(16)*con(2)
3044 SUBROUTINE zunhj(ZR, ZI, FNU, IPMTR, TOL, PHIR, PHII, ARGR, ARGI, &
3045 ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
3081 DOUBLE PRECISION alfa, ang, ap, ar, argi, argr, asumi, asumr, &
3082 atol, aw2, azth, beta, br, bsumi, bsumr, btol, c, conei, coner, &
3083 cri, crr, dri, drr, ex1, ex2, fnu, fn13, fn23, gama, gpi, hpi, &
3084 phii, phir, pi, pp, pr, przthi, przthr, ptfni, ptfnr, raw, raw2, &
3085 razth, rfnu, rfnu2, rfn13, rtzti, rtztr, rzthi, rzthr, sti, str, &
3086 sumai, sumar, sumbi, sumbr, test, tfni, tfnr, thpi, tol, tzai, &
3087 tzar, t2i, t2r, upi, upr, wi, wr, w2i, w2r, zai, zar, zbi, zbr, &
3088 zci, zcr, zeroi, zeror, zetai, zetar, zeta1i, zeta1r, zeta2i, &
3089 zeta2r, zi, zr, zthi, zthr
3090 INTEGER ias, ibs, ipmtr, is, j, jr, ju, k, kmax, kp1, ks, l, lr, &
3091 lrp1, l1, l2, m, idum
3092 dimension ar(14), br(14), c(105), alfa(180), beta(210), gama(30), &
3093 ap(30), pr(30), pi(30), upr(14), upi(14), crr(14), cri(14), &
3095 DATA ar(1), ar(2), ar(3), ar(4), ar(5), ar(6), ar(7), ar(8), &
3096 ar(9), ar(10), ar(11), ar(12), ar(13), ar(14)/ &
3097 1.00000000000000000d+00, 1.04166666666666667d-01, &
3098 8.35503472222222222d-02, 1.28226574556327160d-01, &
3099 2.91849026464140464d-01, 8.81627267443757652d-01, &
3100 3.32140828186276754d+00, 1.49957629868625547d+01, &
3101 7.89230130115865181d+01, 4.74451538868264323d+02, &
3102 3.20749009089066193d+03, 2.40865496408740049d+04, &
3103 1.98923119169509794d+05, 1.79190200777534383d+06/
3104 DATA br(1), br(2), br(3), br(4), br(5), br(6), br(7), br(8), &
3105 br(9), br(10), br(11), br(12), br(13), br(14)/ &
3106 1.00000000000000000d+00, -1.45833333333333333d-01, &
3107 -9.87413194444444444d-02, -1.43312053915895062d-01, &
3108 -3.17227202678413548d-01, -9.42429147957120249d-01, &
3109 -3.51120304082635426d+00, -1.57272636203680451d+01, &
3110 -8.22814390971859444d+01, -4.92355370523670524d+02, &
3111 -3.31621856854797251d+03, -2.48276742452085896d+04, &
3112 -2.04526587315129788d+05, -1.83844491706820990d+06/
3113 DATA c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10), &
3114 c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18), &
3115 c(19), c(20), c(21), c(22), c(23), c(24)/ &
3116 1.00000000000000000d+00, -2.08333333333333333d-01, &
3117 1.25000000000000000d-01, 3.34201388888888889d-01, &
3118 -4.01041666666666667d-01, 7.03125000000000000d-02, &
3119 -1.02581259645061728d+00, 1.84646267361111111d+00, &
3120 -8.91210937500000000d-01, 7.32421875000000000d-02, &
3121 4.66958442342624743d+00, -1.12070026162229938d+01, &
3122 8.78912353515625000d+00, -2.36408691406250000d+00, &
3123 1.12152099609375000d-01, -2.82120725582002449d+01, &
3124 8.46362176746007346d+01, -9.18182415432400174d+01, &
3125 4.25349987453884549d+01, -7.36879435947963170d+00, &
3126 2.27108001708984375d-01, 2.12570130039217123d+02, &
3127 -7.65252468141181642d+02, 1.05999045252799988d+03/
3128 DATA c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32), &
3129 c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40), &
3130 c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/ &
3131 -6.99579627376132541d+02, 2.18190511744211590d+02, &
3132 -2.64914304869515555d+01, 5.72501420974731445d-01, &
3133 -1.91945766231840700d+03, 8.06172218173730938d+03, &
3134 -1.35865500064341374d+04, 1.16553933368645332d+04, &
3135 -5.30564697861340311d+03, 1.20090291321635246d+03, &
3136 -1.08090919788394656d+02, 1.72772750258445740d+00, &
3137 2.02042913309661486d+04, -9.69805983886375135d+04, &
3138 1.92547001232531532d+05, -2.03400177280415534d+05, &
3139 1.22200464983017460d+05, -4.11926549688975513d+04, &
3140 7.10951430248936372d+03, -4.93915304773088012d+02, &
3141 6.07404200127348304d+00, -2.42919187900551333d+05, &
3142 1.31176361466297720d+06, -2.99801591853810675d+06/
3143 DATA c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56), &
3144 c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64), &
3145 c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/ &
3146 3.76327129765640400d+06, -2.81356322658653411d+06, &
3147 1.26836527332162478d+06, -3.31645172484563578d+05, &
3148 4.52187689813627263d+04, -2.49983048181120962d+03, &
3149 2.43805296995560639d+01, 3.28446985307203782d+06, &
3150 -1.97068191184322269d+07, 5.09526024926646422d+07, &
3151 -7.41051482115326577d+07, 6.63445122747290267d+07, &
3152 -3.75671766607633513d+07, 1.32887671664218183d+07, &
3153 -2.78561812808645469d+06, 3.08186404612662398d+05, &
3154 -1.38860897537170405d+04, 1.10017140269246738d+02, &
3155 -4.93292536645099620d+07, 3.25573074185765749d+08, &
3156 -9.39462359681578403d+08, 1.55359689957058006d+09, &
3157 -1.62108055210833708d+09, 1.10684281682301447d+09/
3158 DATA c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80), &
3159 c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88), &
3160 c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/ &
3161 -4.95889784275030309d+08, 1.42062907797533095d+08, &
3162 -2.44740627257387285d+07, 2.24376817792244943d+06, &
3163 -8.40054336030240853d+04, 5.51335896122020586d+02, &
3164 8.14789096118312115d+08, -5.86648149205184723d+09, &
3165 1.86882075092958249d+10, -3.46320433881587779d+10, &
3166 4.12801855797539740d+10, -3.30265997498007231d+10, &
3167 1.79542137311556001d+10, -6.56329379261928433d+09, &
3168 1.55927986487925751d+09, -2.25105661889415278d+08, &
3169 1.73951075539781645d+07, -5.49842327572288687d+05, &
3170 3.03809051092238427d+03, -1.46792612476956167d+10, &
3171 1.14498237732025810d+11, -3.99096175224466498d+11, &
3172 8.19218669548577329d+11, -1.09837515608122331d+12/
3173 DATA c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104), &
3175 1.00815810686538209d+12, -6.45364869245376503d+11, &
3176 2.87900649906150589d+11, -8.78670721780232657d+10, &
3177 1.76347306068349694d+10, -2.16716498322379509d+09, &
3178 1.43157876718888981d+08, -3.87183344257261262d+06, &
3179 1.82577554742931747d+04/
3180 DATA alfa(1), alfa(2), alfa(3), alfa(4), alfa(5), alfa(6), &
3181 alfa(7), alfa(8), alfa(9), alfa(10), alfa(11), alfa(12), &
3182 alfa(13), alfa(14), alfa(15), alfa(16), alfa(17), alfa(18), &
3183 alfa(19), alfa(20), alfa(21), alfa(22)/ &
3184 -4.44444444444444444d-03, -9.22077922077922078d-04, &
3185 -8.84892884892884893d-05, 1.65927687832449737d-04, &
3186 2.46691372741792910d-04, 2.65995589346254780d-04, &
3187 2.61824297061500945d-04, 2.48730437344655609d-04, &
3188 2.32721040083232098d-04, 2.16362485712365082d-04, &
3189 2.00738858762752355d-04, 1.86267636637545172d-04, &
3190 1.73060775917876493d-04, 1.61091705929015752d-04, &
3191 1.50274774160908134d-04, 1.40503497391269794d-04, &
3192 1.31668816545922806d-04, 1.23667445598253261d-04, &
3193 1.16405271474737902d-04, 1.09798298372713369d-04, &
3194 1.03772410422992823d-04, 9.82626078369363448d-05/
3195 DATA alfa(23), alfa(24), alfa(25), alfa(26), alfa(27), alfa(28), &
3196 alfa(29), alfa(30), alfa(31), alfa(32), alfa(33), alfa(34), &
3197 alfa(35), alfa(36), alfa(37), alfa(38), alfa(39), alfa(40), &
3198 alfa(41), alfa(42), alfa(43), alfa(44)/ &
3199 9.32120517249503256d-05, 8.85710852478711718d-05, &
3200 8.42963105715700223d-05, 8.03497548407791151d-05, &
3201 7.66981345359207388d-05, 7.33122157481777809d-05, &
3202 7.01662625163141333d-05, 6.72375633790160292d-05, &
3203 6.93735541354588974d-04, 2.32241745182921654d-04, &
3204 -1.41986273556691197d-05, -1.16444931672048640d-04, &
3205 -1.50803558053048762d-04, -1.55121924918096223d-04, &
3206 -1.46809756646465549d-04, -1.33815503867491367d-04, &
3207 -1.19744975684254051d-04, -1.06184319207974020d-04, &
3208 -9.37699549891194492d-05, -8.26923045588193274d-05, &
3209 -7.29374348155221211d-05, -6.44042357721016283d-05/
3210 DATA alfa(45), alfa(46), alfa(47), alfa(48), alfa(49), alfa(50), &
3211 alfa(51), alfa(52), alfa(53), alfa(54), alfa(55), alfa(56), &
3212 alfa(57), alfa(58), alfa(59), alfa(60), alfa(61), alfa(62), &
3213 alfa(63), alfa(64), alfa(65), alfa(66)/ &
3214 -5.69611566009369048d-05, -5.04731044303561628d-05, &
3215 -4.48134868008882786d-05, -3.98688727717598864d-05, &
3216 -3.55400532972042498d-05, -3.17414256609022480d-05, &
3217 -2.83996793904174811d-05, -2.54522720634870566d-05, &
3218 -2.28459297164724555d-05, -2.05352753106480604d-05, &
3219 -1.84816217627666085d-05, -1.66519330021393806d-05, &
3220 -1.50179412980119482d-05, -1.35554031379040526d-05, &
3221 -1.22434746473858131d-05, -1.10641884811308169d-05, &
3222 -3.54211971457743841d-04, -1.56161263945159416d-04, &
3223 3.04465503594936410d-05, 1.30198655773242693d-04, &
3224 1.67471106699712269d-04, 1.70222587683592569d-04/
3225 DATA alfa(67), alfa(68), alfa(69), alfa(70), alfa(71), alfa(72), &
3226 alfa(73), alfa(74), alfa(75), alfa(76), alfa(77), alfa(78), &
3227 alfa(79), alfa(80), alfa(81), alfa(82), alfa(83), alfa(84), &
3228 alfa(85), alfa(86), alfa(87), alfa(88)/ &
3229 1.56501427608594704d-04, 1.36339170977445120d-04, &
3230 1.14886692029825128d-04, 9.45869093034688111d-05, &
3231 7.64498419250898258d-05, 6.07570334965197354d-05, &
3232 4.74394299290508799d-05, 3.62757512005344297d-05, &
3233 2.69939714979224901d-05, 1.93210938247939253d-05, &
3234 1.30056674793963203d-05, 7.82620866744496661d-06, &
3235 3.59257485819351583d-06, 1.44040049814251817d-07, &
3236 -2.65396769697939116d-06, -4.91346867098485910d-06, &
3237 -6.72739296091248287d-06, -8.17269379678657923d-06, &
3238 -9.31304715093561232d-06, -1.02011418798016441d-05, &
3239 -1.08805962510592880d-05, -1.13875481509603555d-05/
3240 DATA alfa(89), alfa(90), alfa(91), alfa(92), alfa(93), alfa(94), &
3241 alfa(95), alfa(96), alfa(97), alfa(98), alfa(99), alfa(100), &
3242 alfa(101), alfa(102), alfa(103), alfa(104), alfa(105), &
3243 alfa(106), alfa(107), alfa(108), alfa(109), alfa(110)/ &
3244 -1.17519675674556414d-05, -1.19987364870944141d-05, &
3245 3.78194199201772914d-04, 2.02471952761816167d-04, &
3246 -6.37938506318862408d-05, -2.38598230603005903d-04, &
3247 -3.10916256027361568d-04, -3.13680115247576316d-04, &
3248 -2.78950273791323387d-04, -2.28564082619141374d-04, &
3249 -1.75245280340846749d-04, -1.25544063060690348d-04, &
3250 -8.22982872820208365d-05, -4.62860730588116458d-05, &
3251 -1.72334302366962267d-05, 5.60690482304602267d-06, &
3252 2.31395443148286800d-05, 3.62642745856793957d-05, &
3253 4.58006124490188752d-05, 5.24595294959114050d-05, &
3254 5.68396208545815266d-05, 5.94349820393104052d-05/
3255 DATA alfa(111), alfa(112), alfa(113), alfa(114), alfa(115), &
3256 alfa(116), alfa(117), alfa(118), alfa(119), alfa(120), &
3257 alfa(121), alfa(122), alfa(123), alfa(124), alfa(125), &
3258 alfa(126), alfa(127), alfa(128), alfa(129), alfa(130)/ &
3259 6.06478527578421742d-05, 6.08023907788436497d-05, &
3260 6.01577894539460388d-05, 5.89199657344698500d-05, &
3261 5.72515823777593053d-05, 5.52804375585852577d-05, &
3262 5.31063773802880170d-05, 5.08069302012325706d-05, &
3263 4.84418647620094842d-05, 4.60568581607475370d-05, &
3264 -6.91141397288294174d-04, -4.29976633058871912d-04, &
3265 1.83067735980039018d-04, 6.60088147542014144d-04, &
3266 8.75964969951185931d-04, 8.77335235958235514d-04, &
3267 7.49369585378990637d-04, 5.63832329756980918d-04, &
3268 3.68059319971443156d-04, 1.88464535514455599d-04/
3269 DATA alfa(131), alfa(132), alfa(133), alfa(134), alfa(135), &
3270 alfa(136), alfa(137), alfa(138), alfa(139), alfa(140), &
3271 alfa(141), alfa(142), alfa(143), alfa(144), alfa(145), &
3272 alfa(146), alfa(147), alfa(148), alfa(149), alfa(150)/ &
3273 3.70663057664904149d-05, -8.28520220232137023d-05, &
3274 -1.72751952869172998d-04, -2.36314873605872983d-04, &
3275 -2.77966150694906658d-04, -3.02079514155456919d-04, &
3276 -3.12594712643820127d-04, -3.12872558758067163d-04, &
3277 -3.05678038466324377d-04, -2.93226470614557331d-04, &
3278 -2.77255655582934777d-04, -2.59103928467031709d-04, &
3279 -2.39784014396480342d-04, -2.20048260045422848d-04, &
3280 -2.00443911094971498d-04, -1.81358692210970687d-04, &
3281 -1.63057674478657464d-04, -1.45712672175205844d-04, &
3282 -1.29425421983924587d-04, -1.14245691942445952d-04/
3283 DATA alfa(151), alfa(152), alfa(153), alfa(154), alfa(155), &
3284 alfa(156), alfa(157), alfa(158), alfa(159), alfa(160), &
3285 alfa(161), alfa(162), alfa(163), alfa(164), alfa(165), &
3286 alfa(166), alfa(167), alfa(168), alfa(169), alfa(170)/ &
3287 1.92821964248775885d-03, 1.35592576302022234d-03, &
3288 -7.17858090421302995d-04, -2.58084802575270346d-03, &
3289 -3.49271130826168475d-03, -3.46986299340960628d-03, &
3290 -2.82285233351310182d-03, -1.88103076404891354d-03, &
3291 -8.89531718383947600d-04, 3.87912102631035228d-06, &
3292 7.28688540119691412d-04, 1.26566373053457758d-03, &
3293 1.62518158372674427d-03, 1.83203153216373172d-03, &
3294 1.91588388990527909d-03, 1.90588846755546138d-03, &
3295 1.82798982421825727d-03, 1.70389506421121530d-03, &
3296 1.55097127171097686d-03, 1.38261421852276159d-03/
3297 DATA alfa(171), alfa(172), alfa(173), alfa(174), alfa(175), &
3298 alfa(176), alfa(177), alfa(178), alfa(179), alfa(180)/ &
3299 1.20881424230064774d-03, 1.03676532638344962d-03, &
3300 8.71437918068619115d-04, 7.16080155297701002d-04, &
3301 5.72637002558129372d-04, 4.42089819465802277d-04, &
3302 3.24724948503090564d-04, 2.20342042730246599d-04, &
3303 1.28412898401353882d-04, 4.82005924552095464d-05/
3304 DATA beta(1), beta(2), beta(3), beta(4), beta(5), beta(6), &
3305 beta(7), beta(8), beta(9), beta(10), beta(11), beta(12), &
3306 beta(13), beta(14), beta(15), beta(16), beta(17), beta(18), &
3307 beta(19), beta(20), beta(21), beta(22)/ &
3308 1.79988721413553309d-02, 5.59964911064388073d-03, &
3309 2.88501402231132779d-03, 1.80096606761053941d-03, &
3310 1.24753110589199202d-03, 9.22878876572938311d-04, &
3311 7.14430421727287357d-04, 5.71787281789704872d-04, &
3312 4.69431007606481533d-04, 3.93232835462916638d-04, &
3313 3.34818889318297664d-04, 2.88952148495751517d-04, &
3314 2.52211615549573284d-04, 2.22280580798883327d-04, &
3315 1.97541838033062524d-04, 1.76836855019718004d-04, &
3316 1.59316899661821081d-04, 1.44347930197333986d-04, &
3317 1.31448068119965379d-04, 1.20245444949302884d-04, &
3318 1.10449144504599392d-04, 1.01828770740567258d-04/
3319 DATA beta(23), beta(24), beta(25), beta(26), beta(27), beta(28), &
3320 beta(29), beta(30), beta(31), beta(32), beta(33), beta(34), &
3321 beta(35), beta(36), beta(37), beta(38), beta(39), beta(40), &
3322 beta(41), beta(42), beta(43), beta(44)/ &
3323 9.41998224204237509d-05, 8.74130545753834437d-05, &
3324 8.13466262162801467d-05, 7.59002269646219339d-05, &
3325 7.09906300634153481d-05, 6.65482874842468183d-05, &
3326 6.25146958969275078d-05, 5.88403394426251749d-05, &
3327 -1.49282953213429172d-03, -8.78204709546389328d-04, &
3328 -5.02916549572034614d-04, -2.94822138512746025d-04, &
3329 -1.75463996970782828d-04, -1.04008550460816434d-04, &
3330 -5.96141953046457895d-05, -3.12038929076098340d-05, &
3331 -1.26089735980230047d-05, -2.42892608575730389d-07, &
3332 8.05996165414273571d-06, 1.36507009262147391d-05, &
3333 1.73964125472926261d-05, 1.98672978842133780d-05/
3334 DATA beta(45), beta(46), beta(47), beta(48), beta(49), beta(50), &
3335 beta(51), beta(52), beta(53), beta(54), beta(55), beta(56), &
3336 beta(57), beta(58), beta(59), beta(60), beta(61), beta(62), &
3337 beta(63), beta(64), beta(65), beta(66)/ &
3338 2.14463263790822639d-05, 2.23954659232456514d-05, &
3339 2.28967783814712629d-05, 2.30785389811177817d-05, &
3340 2.30321976080909144d-05, 2.28236073720348722d-05, &
3341 2.25005881105292418d-05, 2.20981015361991429d-05, &
3342 2.16418427448103905d-05, 2.11507649256220843d-05, &
3343 2.06388749782170737d-05, 2.01165241997081666d-05, &
3344 1.95913450141179244d-05, 1.90689367910436740d-05, &
3345 1.85533719641636667d-05, 1.80475722259674218d-05, &
3346 5.52213076721292790d-04, 4.47932581552384646d-04, &
3347 2.79520653992020589d-04, 1.52468156198446602d-04, &
3348 6.93271105657043598d-05, 1.76258683069991397d-05/
3349 DATA beta(67), beta(68), beta(69), beta(70), beta(71), beta(72), &
3350 beta(73), beta(74), beta(75), beta(76), beta(77), beta(78), &
3351 beta(79), beta(80), beta(81), beta(82), beta(83), beta(84), &
3352 beta(85), beta(86), beta(87), beta(88)/ &
3353 -1.35744996343269136d-05, -3.17972413350427135d-05, &
3354 -4.18861861696693365d-05, -4.69004889379141029d-05, &
3355 -4.87665447413787352d-05, -4.87010031186735069d-05, &
3356 -4.74755620890086638d-05, -4.55813058138628452d-05, &
3357 -4.33309644511266036d-05, -4.09230193157750364d-05, &
3358 -3.84822638603221274d-05, -3.60857167535410501d-05, &
3359 -3.37793306123367417d-05, -3.15888560772109621d-05, &
3360 -2.95269561750807315d-05, -2.75978914828335759d-05, &
3361 -2.58006174666883713d-05, -2.41308356761280200d-05, &
3362 -2.25823509518346033d-05, -2.11479656768912971d-05, &
3363 -1.98200638885294927d-05, -1.85909870801065077d-05/
3364 DATA beta(89), beta(90), beta(91), beta(92), beta(93), beta(94), &
3365 beta(95), beta(96), beta(97), beta(98), beta(99), beta(100), &
3366 beta(101), beta(102), beta(103), beta(104), beta(105), &
3367 beta(106), beta(107), beta(108), beta(109), beta(110)/ &
3368 -1.74532699844210224d-05, -1.63997823854497997d-05, &
3369 -4.74617796559959808d-04, -4.77864567147321487d-04, &
3370 -3.20390228067037603d-04, -1.61105016119962282d-04, &
3371 -4.25778101285435204d-05, 3.44571294294967503d-05, &
3372 7.97092684075674924d-05, 1.03138236708272200d-04, &
3373 1.12466775262204158d-04, 1.13103642108481389d-04, &
3374 1.08651634848774268d-04, 1.01437951597661973d-04, &
3375 9.29298396593363896d-05, 8.40293133016089978d-05, &
3376 7.52727991349134062d-05, 6.69632521975730872d-05, &
3377 5.92564547323194704d-05, 5.22169308826975567d-05, &
3378 4.58539485165360646d-05, 4.01445513891486808d-05/
3379 DATA beta(111), beta(112), beta(113), beta(114), beta(115), &
3380 beta(116), beta(117), beta(118), beta(119), beta(120), &
3381 beta(121), beta(122), beta(123), beta(124), beta(125), &
3382 beta(126), beta(127), beta(128), beta(129), beta(130)/ &
3383 3.50481730031328081d-05, 3.05157995034346659d-05, &
3384 2.64956119950516039d-05, 2.29363633690998152d-05, &
3385 1.97893056664021636d-05, 1.70091984636412623d-05, &
3386 1.45547428261524004d-05, 1.23886640995878413d-05, &
3387 1.04775876076583236d-05, 8.79179954978479373d-06, &
3388 7.36465810572578444d-04, 8.72790805146193976d-04, &
3389 6.22614862573135066d-04, 2.85998154194304147d-04, &
3390 3.84737672879366102d-06, -1.87906003636971558d-04, &
3391 -2.97603646594554535d-04, -3.45998126832656348d-04, &
3392 -3.53382470916037712d-04, -3.35715635775048757d-04/
3393 DATA beta(131), beta(132), beta(133), beta(134), beta(135), &
3394 beta(136), beta(137), beta(138), beta(139), beta(140), &
3395 beta(141), beta(142), beta(143), beta(144), beta(145), &
3396 beta(146), beta(147), beta(148), beta(149), beta(150)/ &
3397 -3.04321124789039809d-04, -2.66722723047612821d-04, &
3398 -2.27654214122819527d-04, -1.89922611854562356d-04, &
3399 -1.55058918599093870d-04, -1.23778240761873630d-04, &
3400 -9.62926147717644187d-05, -7.25178327714425337d-05, &
3401 -5.22070028895633801d-05, -3.50347750511900522d-05, &
3402 -2.06489761035551757d-05, -8.70106096849767054d-06, &
3403 1.13698686675100290d-06, 9.16426474122778849d-06, &
3404 1.56477785428872620d-05, 2.08223629482466847d-05, &
3405 2.48923381004595156d-05, 2.80340509574146325d-05, &
3406 3.03987774629861915d-05, 3.21156731406700616d-05/
3407 DATA beta(151), beta(152), beta(153), beta(154), beta(155), &
3408 beta(156), beta(157), beta(158), beta(159), beta(160), &
3409 beta(161), beta(162), beta(163), beta(164), beta(165), &
3410 beta(166), beta(167), beta(168), beta(169), beta(170)/ &
3411 -1.80182191963885708d-03, -2.43402962938042533d-03, &
3412 -1.83422663549856802d-03, -7.62204596354009765d-04, &
3413 2.39079475256927218d-04, 9.49266117176881141d-04, &
3414 1.34467449701540359d-03, 1.48457495259449178d-03, &
3415 1.44732339830617591d-03, 1.30268261285657186d-03, &
3416 1.10351597375642682d-03, 8.86047440419791759d-04, &
3417 6.73073208165665473d-04, 4.77603872856582378d-04, &
3418 3.05991926358789362d-04, 1.60315694594721630d-04, &
3419 4.00749555270613286d-05, -5.66607461635251611d-05, &
3420 -1.32506186772982638d-04, -1.90296187989614057d-04/
3421 DATA beta(171), beta(172), beta(173), beta(174), beta(175), &
3422 beta(176), beta(177), beta(178), beta(179), beta(180), &
3423 beta(181), beta(182), beta(183), beta(184), beta(185), &
3424 beta(186), beta(187), beta(188), beta(189), beta(190)/ &
3425 -2.32811450376937408d-04, -2.62628811464668841d-04, &
3426 -2.82050469867598672d-04, -2.93081563192861167d-04, &
3427 -2.97435962176316616d-04, -2.96557334239348078d-04, &
3428 -2.91647363312090861d-04, -2.83696203837734166d-04, &
3429 -2.73512317095673346d-04, -2.61750155806768580d-04, &
3430 6.38585891212050914d-03, 9.62374215806377941d-03, &
3431 7.61878061207001043d-03, 2.83219055545628054d-03, &
3432 -2.09841352012720090d-03, -5.73826764216626498d-03, &
3433 -7.70804244495414620d-03, -8.21011692264844401d-03, &
3434 -7.65824520346905413d-03, -6.47209729391045177d-03/
3435 DATA beta(191), beta(192), beta(193), beta(194), beta(195), &
3436 beta(196), beta(197), beta(198), beta(199), beta(200), &
3437 beta(201), beta(202), beta(203), beta(204), beta(205), &
3438 beta(206), beta(207), beta(208), beta(209), beta(210)/ &
3439 -4.99132412004966473d-03, -3.45612289713133280d-03, &
3440 -2.01785580014170775d-03, -7.59430686781961401d-04, &
3441 2.84173631523859138d-04, 1.10891667586337403d-03, &
3442 1.72901493872728771d-03, 2.16812590802684701d-03, &
3443 2.45357710494539735d-03, 2.61281821058334862d-03, &
3444 2.67141039656276912d-03, 2.65203073395980430d-03, &
3445 2.57411652877287315d-03, 2.45389126236094427d-03, &
3446 2.30460058071795494d-03, 2.13684837686712662d-03, &
3447 1.95896528478870911d-03, 1.77737008679454412d-03, &
3448 1.59690280765839059d-03, 1.42111975664438546d-03/
3449 DATA gama(1), gama(2), gama(3), gama(4), gama(5), gama(6), &
3450 gama(7), gama(8), gama(9), gama(10), gama(11), gama(12), &
3451 gama(13), gama(14), gama(15), gama(16), gama(17), gama(18), &
3452 gama(19), gama(20), gama(21), gama(22)/ &
3453 6.29960524947436582d-01, 2.51984209978974633d-01, &
3454 1.54790300415655846d-01, 1.10713062416159013d-01, &
3455 8.57309395527394825d-02, 6.97161316958684292d-02, &
3456 5.86085671893713576d-02, 5.04698873536310685d-02, &
3457 4.42600580689154809d-02, 3.93720661543509966d-02, &
3458 3.54283195924455368d-02, 3.21818857502098231d-02, &
3459 2.94646240791157679d-02, 2.71581677112934479d-02, &
3460 2.51768272973861779d-02, 2.34570755306078891d-02, &
3461 2.19508390134907203d-02, 2.06210828235646240d-02, &
3462 1.94388240897880846d-02, 1.83810633800683158d-02, &
3463 1.74293213231963172d-02, 1.65685837786612353d-02/
3464 DATA gama(23), gama(24), gama(25), gama(26), gama(27), gama(28), &
3465 gama(29), gama(30)/ &
3466 1.57865285987918445d-02, 1.50729501494095594d-02, &
3467 1.44193250839954639d-02, 1.38184805735341786d-02, &
3468 1.32643378994276568d-02, 1.27517121970498651d-02, &
3469 1.22761545318762767d-02, 1.18338262398482403d-02/
3470 DATA ex1, ex2, hpi, gpi, thpi / &
3471 3.33333333333333333d-01, 6.66666666666666667d-01, &
3472 1.57079632679489662d+00, 3.14159265358979324d+00, &
3473 4.71238898038468986d+00/
3474 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
3486 w2r = coner - zbr*zbr + zbi*zbi
3487 w2i = conei - zbr*zbi - zbr*zbi
3489 IF (aw2.GT.0.25d0)
GO TO 130
3499 IF (aw2.LT.tol)
GO TO 20
3501 pr(k) = pr(k-1)*w2r - pi(k-1)*w2i
3502 pi(k) = pr(k-1)*w2i + pi(k-1)*w2r
3503 sumar = sumar + pr(k)*gama(k)
3504 sumai = sumai + pi(k)*gama(k)
3506 IF (ap(k).LT.tol)
GO TO 20
3511 zetar = w2r*sumar - w2i*sumai
3512 zetai = w2r*sumai + w2i*sumar
3515 CALL zsqrt(sumar, sumai, zar, zai)
3516 CALL zsqrt(w2r, w2i, str, sti)
3519 str = coner + ex2*(zetar*zar-zetai*zai)
3520 sti = conei + ex2*(zetar*zai+zetai*zar)
3521 zeta1r = str*zeta2r - sti*zeta2i
3522 zeta1i = str*zeta2i + sti*zeta2r
3525 CALL zsqrt(zar, zai, str, sti)
3528 IF (ipmtr.EQ.1)
GO TO 120
3535 sumbr = sumbr + pr(k)*beta(k)
3536 sumbi = sumbi + pi(k)*beta(k)
3544 btol = tol*(dabs(bsumr)+dabs(bsumi))
3549 IF (rfnu2.LT.tol)
GO TO 110
3553 IF (ias.EQ.1)
GO TO 60
3558 sumar = sumar + pr(k)*alfa(m)
3559 sumai = sumai + pi(k)*alfa(m)
3560 IF (ap(k).LT.atol)
GO TO 50
3563 asumr = asumr + sumar*pp
3564 asumi = asumi + sumai*pp
3565 IF (pp.LT.tol) ias = 1
3567 IF (ibs.EQ.1)
GO TO 90
3572 sumbr = sumbr + pr(k)*beta(m)
3573 sumbi = sumbi + pi(k)*beta(m)
3574 IF (ap(k).LT.atol)
GO TO 80
3577 bsumr = bsumr + sumbr*pp
3578 bsumi = bsumi + sumbi*pp
3579 IF (pp.LT.btol) ibs = 1
3581 IF (ias.EQ.1 .AND. ibs.EQ.1)
GO TO 110
3586 asumr = asumr + coner
3596 CALL zsqrt(w2r, w2i, wr, wi)
3597 IF (wr.LT.0.0d0) wr = 0.0d0
3598 IF (wi.LT.0.0d0) wi = 0.0d0
3601 CALL zdiv(str, sti, zbr, zbi, zar, zai)
3602 CALL zlog(zar, zai, zcr, zci, idum)
3603 IF (zci.LT.0.0d0) zci = 0.0d0
3604 IF (zci.GT.hpi) zci = hpi
3605 IF (zcr.LT.0.0d0) zcr = 0.0d0
3606 zthr = (zcr-wr)*1.5d0
3607 zthi = (zci-wi)*1.5d0
3612 azth = zabs(zthr,zthi)
3614 IF (zthr.GE.0.0d0 .AND. zthi.LT.0.0d0)
GO TO 140
3616 IF (zthr.EQ.0.0d0)
GO TO 140
3617 ang = datan(zthi/zthr)
3618 IF (zthr.LT.0.0d0) ang = ang + gpi
3622 zetar = pp*dcos(ang)
3623 zetai = pp*dsin(ang)
3624 IF (zetai.LT.0.0d0) zetai = 0.0d0
3627 CALL zdiv(zthr, zthi, zetar, zetai, rtztr, rtzti)
3628 CALL zdiv(rtztr, rtzti, wr, wi, zar, zai)
3631 CALL zsqrt(tzar, tzai, str, sti)
3634 IF (ipmtr.EQ.1)
GO TO 120
3635 raw = 1.0d0/dsqrt(aw2)
3643 rzthr = str*razth*rfnu
3644 rzthi = sti*razth*rfnu
3652 str = t2r*c(2) + c(3)
3654 upr(2) = str*tfnr - sti*tfni
3655 upi(2) = str*tfni + sti*tfnr
3656 bsumr = upr(2) + zcr
3657 bsumi = upi(2) + zci
3660 IF (rfnu.LT.tol)
GO TO 220
3668 btol = tol*(dabs(bsumr)+dabs(bsumi))
3688 str = zar*t2r - t2i*zai + c(l)
3689 zai = zar*t2i + zai*t2r
3692 str = ptfnr*tfnr - ptfni*tfni
3693 ptfni = ptfnr*tfni + ptfni*tfnr
3695 upr(kp1) = ptfnr*zar - ptfni*zai
3696 upi(kp1) = ptfni*zar + ptfnr*zai
3697 crr(ks) = przthr*br(ks+1)
3698 cri(ks) = przthi*br(ks+1)
3699 str = przthr*rzthr - przthi*rzthi
3700 przthi = przthr*rzthi + przthi*rzthr
3702 drr(ks) = przthr*ar(ks+2)
3703 dri(ks) = przthi*ar(ks+2)
3706 IF (ias.EQ.1)
GO TO 180
3712 sumar = sumar + crr(jr)*upr(ju) - cri(jr)*upi(ju)
3713 sumai = sumai + crr(jr)*upi(ju) + cri(jr)*upr(ju)
3715 asumr = asumr + sumar
3716 asumi = asumi + sumai
3717 test = dabs(sumar) + dabs(sumai)
3718 IF (pp.LT.tol .AND. test.LT.tol) ias = 1
3720 IF (ibs.EQ.1)
GO TO 200
3721 sumbr = upr(lr+2) + upr(lrp1)*zcr - upi(lrp1)*zci
3722 sumbi = upi(lr+2) + upr(lrp1)*zci + upi(lrp1)*zcr
3726 sumbr = sumbr + drr(jr)*upr(ju) - dri(jr)*upi(ju)
3727 sumbi = sumbi + drr(jr)*upi(ju) + dri(jr)*upr(ju)
3729 bsumr = bsumr + sumbr
3730 bsumi = bsumi + sumbi
3731 test = dabs(sumbr) + dabs(sumbi)
3732 IF (pp.LT.btol .AND. test.LT.btol) ibs = 1
3734 IF (ias.EQ.1 .AND. ibs.EQ.1)
GO TO 220
3737 asumr = asumr + coner
3740 CALL zdiv(str, sti, rtztr, rtzti, bsumr, bsumi)
3744 SUBROUTINE zrati(ZR, ZI, FNU, N, CYR, CYI, TOL)
3759 DOUBLE PRECISION ak, amagz, ap1, ap2, arg, az, cdfnui, cdfnur, &
3760 conei, coner, cyi, cyr, czeroi, czeror, dfnu, fdnu, flam, fnu, &
3761 fnup, pti, ptr, p1i, p1r, p2i, p2r, rak, rap1, rho, rt2, rzi, &
3762 rzr, test, test1, tol, tti, ttr, t1i, t1r, zi, zr
3763 INTEGER i, id, idnu, inu, itime, k, kk, magz, n
3764 dimension cyr(1), cyi(1)
3765 DATA czeror,czeroi,coner,conei,rt2 &
3766 /0.0d0, 0.0d0, 1.0d0, 0.0d0, 1.41421356237309505d0/
3768 inu = int(sngl(fnu))
3770 magz = int(sngl(az))
3771 amagz = dble(float(magz+1))
3772 fdnu = dble(float(idnu))
3773 fnup = dmax1(amagz,fdnu)
3774 id = idnu - magz - 1
3778 rzr = ptr*(zr+zr)*ptr
3779 rzi = -ptr*(zi+zi)*ptr
3797 arg = (ap2+ap2)/(ap1*tol)
3811 p2r = p1r - (t1r*ptr-t1i*pti)
3812 p2i = p1i - (t1r*pti+t1i*ptr)
3818 IF (ap1.LE.test)
GO TO 10
3819 IF (itime.EQ.2)
GO TO 20
3820 ak = zabs(t1r,t1i)*0.5d0
3821 flam = ak + dsqrt(ak*ak-1.0d0)
3822 rho = dmin1(ap2/ap1,flam)
3823 test = test1*dsqrt(rho/(rho*rho-1.0d0))
3828 ak = dble(float(kk))
3831 dfnu = fnu + dble(float(n-1))
3842 p1r = (ptr*ttr-pti*tti) + p2r
3843 p1i = (ptr*tti+pti*ttr) + p2i
3848 IF (p1r.NE.czeror .OR. p1i.NE.czeroi)
GO TO 40
3852 CALL zdiv(p2r, p2i, p1r, p1i, cyr(n), cyi(n))
3861 ptr = cdfnur + (t1r*rzr-t1i*rzi) + cyr(k+1)
3862 pti = cdfnui + (t1r*rzi+t1i*rzr) + cyi(k+1)
3864 IF (ak.NE.czeror)
GO TO 50
3870 cyr(k) = rak*ptr*rak
3871 cyi(k) = -rak*pti*rak
3878 SUBROUTINE zairy(ZR, ZI, ID, KODE, AIR, AII, NZ, IERR)
4009 DOUBLE PRECISION aa, ad, aii, air, ak, alim, atrm, az, az3, bk, &
4010 cc, ck, coef, conei, coner, csqi, csqr, cyi, cyr, c1, c2, dig, &
4011 dk, d1, d2, elim, fid, fnu, ptr, rl, r1m5, sfac, sti, str, &
4012 s1i, s1r, s2i, s2r, tol, trm1i, trm1r, trm2i, trm2r, tth, zeroi, &
4013 zeror, zi, zr, ztai, ztar, z3i, z3r, alaz, bb
4014 INTEGER id, ierr, iflag, k, kode, k1, k2, mr, nn, nz
4015 dimension cyr(1), cyi(1)
4016 DATA tth, c1, c2, coef /6.66666666666666667d-01, &
4017 3.55028053887817240d-01,2.58819403792806799d-01, &
4018 1.83776298473930683d-01/
4019 DATA zeror, zeroi, coner, conei /0.0d0,0.0d0,1.0d0,0.0d0/
4023 IF (id.LT.0 .OR. id.GT.1) ierr=1
4024 IF (kode.LT.1 .OR. kode.GT.2) ierr=1
4025 IF (ierr.NE.0)
RETURN 4027 tol = dmax1(d1mach(4),1.0d-18)
4028 fid = dble(float(id))
4029 IF (az.GT.1.0d0)
GO TO 70
4037 IF (az.LT.tol)
GO TO 170
4039 IF (aa.LT.tol/az)
GO TO 40
4047 z3r = str*zr - sti*zi
4048 z3i = str*zi + sti*zr
4051 bk = 3.0d0 - fid - fid
4053 dk = 3.0d0 + fid + fid
4057 ak = 24.0d0 + 9.0d0*fid
4058 bk = 30.0d0 - 9.0d0*fid
4060 str = (trm1r*z3r-trm1i*z3i)/d1
4061 trm1i = (trm1r*z3i+trm1i*z3r)/d1
4065 str = (trm2r*z3r-trm2i*z3i)/d2
4066 trm2i = (trm2r*z3i+trm2i*z3r)/d2
4074 IF (atrm.LT.tol*ad)
GO TO 40
4079 IF (id.EQ.1)
GO TO 50
4080 air = s1r*c1 - c2*(zr*s2r-zi*s2i)
4081 aii = s1i*c1 - c2*(zr*s2i+zi*s2r)
4082 IF (kode.EQ.1)
RETURN 4083 CALL zsqrt(zr, zi, str, sti)
4084 ztar = tth*(zr*str-zi*sti)
4085 ztai = tth*(zr*sti+zi*str)
4086 CALL zexp(ztar, ztai, str, sti)
4087 ptr = air*str - aii*sti
4088 aii = air*sti + aii*str
4094 IF (az.LE.tol)
GO TO 60
4095 str = zr*s1r - zi*s1i
4096 sti = zr*s1i + zi*s1r
4098 air = air + cc*(str*zr-sti*zi)
4099 aii = aii + cc*(str*zi+sti*zr)
4101 IF (kode.EQ.1)
RETURN 4102 CALL zsqrt(zr, zi, str, sti)
4103 ztar = tth*(zr*str-zi*sti)
4104 ztai = tth*(zr*sti+zi*str)
4105 CALL zexp(ztar, ztai, str, sti)
4106 ptr = str*air - sti*aii
4107 aii = str*aii + sti*air
4114 fnu = (1.0d0+fid)/3.0d0
4128 k = min0(iabs(k1),iabs(k2))
4129 elim = 2.303d0*(dble(float(k))*r1m5-3.0d0)
4131 aa = r1m5*dble(float(k1))
4132 dig = dmin1(aa,18.0d0)
4134 alim = elim + dmax1(-aa,-41.45d0)
4135 rl = 1.2d0*dig + 3.0d0
4141 bb=dble(float(i1mach(9)))*0.5d0
4144 IF (az.GT.aa)
GO TO 260
4146 IF (az.GT.aa) ierr=3
4147 CALL zsqrt(zr, zi, csqr, csqi)
4148 ztar = tth*(zr*csqr-zi*csqi)
4149 ztai = tth*(zr*csqi+zi*csqr)
4156 IF (zr.GE.0.0d0)
GO TO 80
4162 IF (zi.NE.0.0d0)
GO TO 90
4163 IF (zr.GT.0.0d0)
GO TO 90
4168 IF (aa.GE.0.0d0 .AND. zr.GT.0.0d0)
GO TO 110
4169 IF (kode.EQ.2)
GO TO 100
4173 IF (aa.GT.(-alim))
GO TO 100
4174 aa = -aa + 0.25d0*alaz
4177 IF (aa.GT.elim)
GO TO 270
4183 IF (zi.LT.0.0d0) mr = -1
4184 CALL zacai(ztar, ztai, fnu, kode, mr, 1, cyr, cyi, nn, rl, tol, &
4186 IF (nn.LT.0)
GO TO 280
4190 IF (kode.EQ.2)
GO TO 120
4194 IF (aa.LT.alim)
GO TO 120
4195 aa = -aa - 0.25d0*alaz
4198 IF (aa.LT.(-elim))
GO TO 210
4200 CALL zbknu(ztar, ztai, fnu, kode, 1, cyr, cyi, nz, tol, elim, alim)
4204 IF (iflag.NE.0)
GO TO 150
4205 IF (id.EQ.1)
GO TO 140
4206 air = csqr*s1r - csqi*s1i
4207 aii = csqr*s1i + csqi*s1r
4210 air = -(zr*s1r-zi*s1i)
4211 aii = -(zr*s1i+zi*s1r)
4216 IF (id.EQ.1)
GO TO 160
4217 str = s1r*csqr - s1i*csqi
4218 s1i = s1r*csqi + s1i*csqr
4224 str = -(s1r*zr-s1i*zi)
4225 s1i = -(s1r*zi+s1i*zr)
4231 aa = 1.0d+3*d1mach(1)
4234 IF (id.EQ.1)
GO TO 190
4235 IF (az.LE.aa)
GO TO 180
4246 IF (az.LE.aa)
GO TO 200
4247 s1r = 0.5d0*(zr*zr-zi*zi)
4263 IF(nn.EQ.(-1))
GO TO 270
4273 SUBROUTINE zacai(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, TOL, ELIM, ALIM)
4293 DOUBLE PRECISION alim, arg, ascle, az, csgnr, csgni, cspnr, &
4294 cspni, c1r, c1i, c2r, c2i, cyr, cyi, dfnu, elim, fmr, fnu, pi, &
4295 rl,
sgn, tol, yy, yr, yi, zr, zi, znr, zni
4296 INTEGER inu, iuf, kode, mr, n, nn, nw, nz
4297 dimension yr(1), yi(1), cyr(2), cyi(2)
4298 DATA pi / 3.14159265358979324d0 /
4304 dfnu = fnu + dble(float(n-1))
4305 IF (az.LE.2.0d0)
GO TO 10
4306 IF (az*az*0.25d0.GT.dfnu+1.0d0)
GO TO 20
4311 CALL zseri(znr, zni, fnu, kode, nn, yr, yi, nw, tol, elim, alim)
4314 IF (az.LT.rl)
GO TO 30
4318 CALL zasyi(znr, zni, fnu, kode, nn, yr, yi, nw, rl, tol, elim, alim)
4319 IF (nw.LT.0)
GO TO 80
4325 CALL zmlri(znr, zni, fnu, kode, nn, yr, yi, nw, tol)
4326 IF(nw.LT.0)
GO TO 80
4331 CALL zbknu(znr, zni, fnu, kode, 1, cyr, cyi, nw, tol, elim, alim)
4332 IF (nw.NE.0)
GO TO 80
4333 fmr = dble(float(mr))
4334 sgn = -dsign(pi,fmr)
4337 IF (kode.EQ.1)
GO TO 50
4339 csgnr = -csgni*dsin(yy)
4340 csgni = csgni*dcos(yy)
4346 inu = int(sngl(fnu))
4347 arg = (fnu-dble(float(inu)))*
sgn 4350 IF (mod(inu,2).EQ.0)
GO TO 60
4358 IF (kode.EQ.1)
GO TO 70
4360 ascle = 1.0d+3*d1mach(1)/tol
4361 CALL zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf)
4364 yr(1) = cspnr*c1r - cspni*c1i + csgnr*c2r - csgni*c2i
4365 yi(1) = cspnr*c1i + cspni*c1r + csgnr*c2i + csgni*c2r
4369 IF(nw.EQ.(-2)) nz=-2
4373 SUBROUTINE zs1s2(ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM, IUF)
4389 DOUBLE PRECISION aa, alim, aln, ascle, as1, as2, c1i, c1r, s1di, &
4390 s1dr, s1i, s1r, s2i, s2r, zeroi, zeror, zri, zrr
4391 INTEGER iuf, idum, nz
4392 DATA zeror,zeroi / 0.0d0 , 0.0d0 /
4396 IF (s1r.EQ.0.0d0 .AND. s1i.EQ.0.0d0)
GO TO 10
4397 IF (as1.EQ.0.0d0)
GO TO 10
4398 aln = -zrr - zrr + dlog(as1)
4404 IF (aln.LT.(-alim))
GO TO 10
4405 CALL zlog(s1dr, s1di, c1r, c1i, idum)
4406 c1r = c1r - zrr - zrr
4407 c1i = c1i - zri - zri
4408 CALL zexp(c1r, c1i, s1r, s1i)
4413 IF (aa.GT.ascle)
RETURN