58 SUBROUTINE zbesy(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, CWRKR, CWRKI, IERR)
208 DOUBLE PRECISION cwrki, cwrkr, cyi, cyr, c1i, c1r, c2i, c2r, &
209 elim, exi, exr, ey, fnu, hcii, sti, str, tay, zi, zr, dexp
210 INTEGER i, ierr, k, kode, k1, k2, n, nz, nz1, nz2
211 dimension cyr(1), cyi(1), cwrkr(1), cwrki(1)
215 IF (zr.EQ.0.0d0 .AND. zi.EQ.0.0d0) ierr=1
216 IF (fnu.LT.0.0d0) ierr=1
217 IF (kode.LT.1 .OR. kode.GT.2) ierr=1
219 IF (ierr.NE.0)
RETURN 221 CALL zbesh(zr, zi, fnu, kode, 1, n, cyr, cyi, nz1, ierr)
222 IF (ierr.NE.0.AND.ierr.NE.3)
GO TO 170
223 CALL zbesh(zr, zi, fnu, kode, 2, n, cwrkr, cwrki, nz2, ierr)
224 IF (ierr.NE.0.AND.ierr.NE.3)
GO TO 170
226 IF (kode.EQ.2)
GO TO 60
228 str = cwrkr(i) - cyr(i)
229 sti = cwrki(i) - cyi(i)
237 k = min0(iabs(k1),iabs(k2))
241 elim = 2.303d0*(dble(float(k))*d1mach(5)-3.0d0)
246 IF (tay.LT.elim) ey = dexp(-tay)
247 IF (zi.LT.0.0d0)
GO TO 90
255 str = c1r*cyr(i) - c1i*cyi(i)
256 sti = c1r*cyi(i) + c1i*cyr(i)
257 str = -str + c2r*cwrkr(i) - c2i*cwrki(i)
258 sti = -sti + c2r*cwrki(i) + c2i*cwrkr(i)
261 IF (str.EQ.0.0d0 .AND. sti.EQ.0.0d0 .AND. ey.EQ.0.0d0) nz = nz + 1
276 SUBROUTINE zbesh(ZR, ZI, FNU, KODE, M, N, CYR, CYI, NZ, IERR)
436 DOUBLE PRECISION aa, alim, aln, arg, az, cyi, cyr, dig, elim, &
437 fmm, fn, fnu, fnul, hpi, rhpi, rl, r1m5,
sgn, str, tol, ufl, zi, &
438 zni, znr, zr, zti, bb
439 INTEGER i, ierr, inu, inuh, ir, k, kode, k1, k2, m, &
440 mm, mr, n, nn, nuf, nw, nz
441 dimension cyr(n), cyi(n)
443 DATA hpi /1.57079632679489662d0/
448 IF (zr.EQ.0.0d0 .AND. zi.EQ.0.0d0) ierr=1
449 IF (fnu.LT.0.0d0) ierr=1
450 IF (m.LT.1 .OR. m.GT.2) ierr=1
451 IF (kode.LT.1 .OR. kode.GT.2) ierr=1
453 IF (ierr.NE.0)
RETURN 466 tol = dmax1(d1mach(4),1.0d-18)
470 k = min0(iabs(k1),iabs(k2))
471 elim = 2.303d0*(dble(float(k))*r1m5-3.0d0)
473 aa = r1m5*dble(float(k1))
474 dig = dmin1(aa,18.0d0)
476 alim = elim + dmax1(-aa,-41.45d0)
477 fnul = 10.0d0 + 6.0d0*(dig-3.0d0)
478 rl = 1.2d0*dig + 3.0d0
479 fn = fnu + dble(float(nn-1))
481 fmm = dble(float(mm))
489 bb=dble(float(i1mach(9)))*0.5d0
491 IF (az.GT.aa)
GO TO 260
492 IF (fn.GT.aa)
GO TO 260
500 IF (az.LT.ufl)
GO TO 230
501 IF (fnu.GT.fnul)
GO TO 90
502 IF (fn.LE.1.0d0)
GO TO 70
503 IF (fn.GT.2.0d0)
GO TO 60
504 IF (az.GT.tol)
GO TO 70
507 IF (aln.GT.elim)
GO TO 230
510 CALL zuoik(znr, zni, fnu, kode, 2, nn, cyr, cyi, nuf, tol, elim, alim)
511 IF (nuf.LT.0)
GO TO 230
518 IF (nn.EQ.0)
GO TO 140
520 IF ((znr.LT.0.0d0) .OR. (znr.EQ.0.0d0 .AND. zni.LT.0.0d0 .AND. &
526 CALL zbknu(znr, zni, fnu, kode, nn, cyr, cyi, nz, tol, elim, alim)
533 CALL zacon(znr, zni, fnu, kode, mr, nn, cyr, cyi, nw, rl, fnul, &
535 IF (nw.LT.0)
GO TO 240
543 IF ((znr.GE.0.0d0) .AND. (znr.NE.0.0d0 .OR. zni.GE.0.0d0 .OR. &
546 IF (znr.NE.0.0d0 .OR. zni.GE.0.0d0)
GO TO 100
550 CALL zbunk(znr, zni, fnu, kode, mr, nn, cyr, cyi, nw, tol, elim, alim)
551 IF (nw.LT.0)
GO TO 240
559 sgn = dsign(hpi,-fmm)
567 arg = (fnu-dble(float(inu-ir)))*
sgn 570 znr = -rhpi*dsin(arg)
571 IF (mod(inuh,2).EQ.0)
GO TO 120
577 str = cyr(i)*znr - cyi(i)*zni
578 cyi(i) = cyr(i)*zni + cyi(i)*znr
586 IF (znr.LT.0.0d0)
GO TO 230
593 IF(nw.EQ.(-1))
GO TO 230
603 SUBROUTINE zuoik(ZR, ZI, FNU, KODE, IKFLG, N, YR, YI, NUF, TOL, ELIM, ALIM)
633 DOUBLE PRECISION aarg, aic, alim, aphi, argi, argr, asumi, asumr, &
634 ascle, ax, ay, bsumi, bsumr, cwrki, cwrkr, czi, czr, elim, fnn, &
635 fnu, gnn, gnu, phii, phir, rcz, str, sti, sumi, sumr, tol, yi, &
636 yr, zbi, zbr, zeroi, zeror, zeta1i, zeta1r, zeta2i, zeta2r, zi, &
637 zni, znr, zr, zri, zrr
638 INTEGER i, idum, iform, ikflg, init, kode, n, nn, nuf, nw
639 dimension yr(1), yi(1), cwrkr(16), cwrki(16)
640 DATA zeror,zeroi / 0.0d0, 0.0d0 /
641 DATA aic / 1.265512123484645396d+00 /
646 IF (zr.GE.0.0d0)
GO TO 10
652 ax = dabs(zr)*1.7321d0
655 IF (ay.GT.ax) iform = 2
656 gnu = dmax1(fnu,1.0d0)
657 IF (ikflg.EQ.1)
GO TO 20
658 fnn = dble(float(nn))
659 gnn = fnu + fnn - 1.0d0
667 IF (iform.EQ.2)
GO TO 30
669 CALL zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii, &
670 zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
671 czr = -zeta1r + zeta2r
672 czi = -zeta1i + zeta2i
677 IF (zi.GT.0.0d0)
GO TO 40
680 CALL zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r, &
681 zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
682 czr = -zeta1r + zeta2r
683 czi = -zeta1i + zeta2i
684 aarg = zabs(argr,argi)
686 IF (kode.EQ.1)
GO TO 60
690 IF (ikflg.EQ.1)
GO TO 70
694 aphi = zabs(phir,phii)
699 IF (rcz.GT.elim)
GO TO 210
700 IF (rcz.LT.alim)
GO TO 80
701 rcz = rcz + dlog(aphi)
702 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
703 IF (rcz.GT.elim)
GO TO 210
709 IF (rcz.LT.(-elim))
GO TO 90
710 IF (rcz.GT.(-alim))
GO TO 130
711 rcz = rcz + dlog(aphi)
712 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
713 IF (rcz.GT.(-elim))
GO TO 110
722 ascle = 1.0d+3*d1mach(1)/tol
723 CALL zlog(phir, phii, str, sti, idum)
726 IF (iform.EQ.1)
GO TO 120
727 CALL zlog(argr, argi, str, sti, idum)
728 czr = czr - 0.25d0*str - aic
729 czi = czi - 0.25d0*sti
735 CALL zuchk(czr, czi, nw, ascle, tol)
736 IF (nw.NE.0)
GO TO 90
738 IF (ikflg.EQ.2)
RETURN 744 gnu = fnu + dble(float(nn-1))
745 IF (iform.EQ.2)
GO TO 150
747 CALL zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii, &
748 zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
749 czr = -zeta1r + zeta2r
750 czi = -zeta1i + zeta2i
753 CALL zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r, &
754 zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
755 czr = -zeta1r + zeta2r
756 czi = -zeta1i + zeta2i
757 aarg = zabs(argr,argi)
759 IF (kode.EQ.1)
GO TO 170
763 aphi = zabs(phir,phii)
765 IF (rcz.LT.(-elim))
GO TO 180
766 IF (rcz.GT.(-alim))
RETURN 767 rcz = rcz + dlog(aphi)
768 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
769 IF (rcz.GT.(-elim))
GO TO 190
778 ascle = 1.0d+3*d1mach(1)/tol
779 CALL zlog(phir, phii, str, sti, idum)
782 IF (iform.EQ.1)
GO TO 200
783 CALL zlog(argr, argi, str, sti, idum)
784 czr = czr - 0.25d0*str - aic
785 czi = czi - 0.25d0*sti
791 CALL zuchk(czr, czi, nw, ascle, tol)
792 IF (nw.NE.0)
GO TO 180
799 SUBROUTINE zbknu(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM)
811 DOUBLE PRECISION aa, ak, alim, ascle, a1, a2, bb, bk, bry, caz, &
812 cbi, cbr, cc, cchi, cchr, cki, ckr, coefi, coefr, conei, coner, &
813 crscr, csclr, cshi, cshr, csi, csr, csrr, cssr, ctwoi, ctwor, &
814 czeroi, czeror, czi, czr, dnu, dnu2, dpi, elim, etest, fc, fhs, &
815 fi, fk, fks, fmui, fmur, fnu, fpi, fr, g1, g2, hpi, pi, pr, pti,&
816 ptr, p1i, p1r, p2i, p2m, p2r, qi, qr, rak, rcaz, rthpi, rzi, &
817 rzr, r1, s, smui, smur, spi, sti, str, s1i, s1r, s2i, s2r, tm, &
818 tol, tth, t1, t2, yi, yr, zi, zr, elm, celmr, zdr, zdi, &
819 as, alas, helim, cyr, cyi
820 INTEGER i, iflag, inu, k, kflag, kk, kmax, kode, koded, n, nz, &
821 idum, j, ic, inub, nw
822 dimension yr(n), yi(n), cc(8), cssr(3), csrr(3), bry(3), cyr(2),&
828 DATA czeror,czeroi,coner,conei,ctwor,ctwoi,r1/ &
829 0.0d0 , 0.0d0 , 1.0d0 , 0.0d0 , 2.0d0 , 0.0d0 , 2.0d0 /
830 DATA dpi, rthpi, spi ,hpi, fpi, tth / &
831 3.14159265358979324d0, 1.25331413731550025d0, &
832 1.90985931710274403d0, 1.57079632679489662d0, &
833 1.89769999331517738d0, 6.66666666666666666d-01/
834 DATA cc(1), cc(2), cc(3), cc(4), cc(5), cc(6), cc(7), cc(8)/ &
835 5.77215664901532861d-01, -4.20026350340952355d-02, &
836 -4.21977345555443367d-02, 7.21894324666309954d-03, &
837 -2.15241674114950973d-04, -2.01348547807882387d-05, &
838 1.13302723198169588d-06, 6.11609510448141582d-09/
849 bry(1) = 1.0d+3*d1mach(1)/tol
850 bry(2) = 1.0d0/bry(1)
860 inu = int(sngl(fnu+0.5d0))
861 dnu = fnu - dble(float(inu))
862 IF (dabs(dnu).EQ.0.5d0)
GO TO 110
864 IF (dabs(dnu).GT.tol) dnu2 = dnu*dnu
865 IF (caz.GT.r1)
GO TO 110
870 CALL zlog(rzr, rzi, smur, smui, idum)
873 CALL zshch(fmur, fmui, cshr, cshi, cchr, cchi)
874 IF (dnu.EQ.0.0d0)
GO TO 10
884 t2 = dexp(-dgamln(a2,idum))
886 IF (dabs(dnu).GT.0.1d0)
GO TO 40
896 IF (dabs(tm).LT.tol)
GO TO 30
901 g1 = (t1-t2)/(dnu+dnu)
904 fr = fc*(cchr*g1+smur*g2)
905 fi = fc*(cchi*g1+smui*g2)
906 CALL zexp(fmur, fmui, str, sti)
909 CALL zdiv(0.5d0, 0.0d0, str, sti, ptr, pti)
921 IF (inu.GT.0 .OR. n.GT.1)
GO TO 80
925 IF (caz.LT.tol)
GO TO 70
926 CALL zmlt(zr, zi, zr, zi, czr, czi)
931 fr = (fr*ak+pr+qr)/bk
932 fi = (fi*ak+pi+qi)/bk
939 str = ckr*czr - cki*czi
941 cki = (ckr*czi+cki*czr)*rak
943 s1r = ckr*fr - cki*fi + s1r
944 s1i = ckr*fi + cki*fr + s1i
946 bk = bk + ak + ak + 1.0d0
948 IF (a1.GT.tol)
GO TO 60
952 IF (koded.EQ.1)
RETURN 953 CALL zexp(zr, zi, str, sti)
954 CALL zmlt(s1r, s1i, str, sti, yr(1), yi(1))
960 IF (caz.LT.tol)
GO TO 100
961 CALL zmlt(zr, zi, zr, zi, czr, czi)
966 fr = (fr*ak+pr+qr)/bk
967 fi = (fi*ak+pi+qi)/bk
974 str = ckr*czr - cki*czi
976 cki = (ckr*czi+cki*czr)*rak
978 s1r = ckr*fr - cki*fi + s1r
979 s1i = ckr*fi + cki*fr + s1i
982 s2r = ckr*str - cki*sti + s2r
983 s2i = ckr*sti + cki*str + s2i
985 bk = bk + ak + ak + 1.0d0
987 IF (a1.GT.tol)
GO TO 90
992 IF (ak.GT.alim) kflag = 3
996 CALL zmlt(p2r, p2i, rzr, rzi, s2r, s2i)
999 IF (koded.EQ.1)
GO TO 210
1000 CALL zexp(zr, zi, fr, fi)
1001 CALL zmlt(s1r, s1i, fr, fi, s1r, s1i)
1002 CALL zmlt(s2r, s2i, fr, fi, s2r, s2i)
1011 CALL zsqrt(zr, zi, str, sti)
1012 CALL zdiv(rthpi, czeroi, str, sti, coefr, coefi)
1014 IF (koded.EQ.2)
GO TO 120
1015 IF (zr.GT.alim)
GO TO 290
1017 str = dexp(-zr)*cssr(kflag)
1020 CALL zmlt(coefr, coefi, str, sti, coefr, coefi)
1022 IF (dabs(dnu).EQ.0.5d0)
GO TO 300
1028 IF (ak.EQ.czeror)
GO TO 300
1029 fhs = dabs(0.25d0-dnu2)
1030 IF (fhs.EQ.czeror)
GO TO 300
1037 t1 = dble(float(i1mach(14)-1))
1038 t1 = t1*d1mach(5)*3.321928094d0
1039 t1 = dmax1(t1,12.0d0)
1040 t1 = dmin1(t1,60.0d0)
1042 IF (zr.NE.0.0d0)
GO TO 130
1049 IF (t2.GT.caz)
GO TO 170
1053 etest = ak/(dpi*caz*tol)
1055 IF (etest.LT.coner)
GO TO 180
1057 ckr = caz + caz + ctwor
1062 cbr = ckr/(fk+coner)
1064 p2r = cbr*p2r - p1r*ak
1067 fks = fks + fk + fk + ctwor
1071 IF (etest.LT.str)
GO TO 160
1075 fk = fk + spi*t1*dsqrt(t2/caz)
1076 fhs = dabs(0.25d0-dnu2)
1083 ak = fpi*ak/(tol*dsqrt(a2))
1084 aa = 3.0d0*t1/(1.0d0+caz)
1085 bb = 14.7d0*t1/(28.0d0+caz)
1086 ak = (dlog(ak)+caz*dcos(aa)/(1.0d0+0.008d0*caz))/dcos(bb)
1087 fk = 0.12125d0*ak*ak/caz + 1.5d0
1103 ak = (fks+fk)/(a1+fhs)
1104 rak = 2.0d0/(fk+coner)
1109 p2r = (ptr*cbr-pti*cbi-p1r)*ak
1110 p2i = (pti*cbr+ptr*cbi-p1i)*ak
1115 fks = a1 - fk + coner
1128 CALL zmlt(coefr, coefi, s1r, s1i, str, sti)
1129 CALL zmlt(str, sti, csr, csi, s1r, s1i)
1130 IF (inu.GT.0 .OR. n.GT.1)
GO TO 200
1133 IF(iflag.EQ.1)
GO TO 270
1145 CALL zmlt(p1r, p1i, p2r, p2i, ptr, pti)
1146 str = dnu + 0.5d0 - ptr
1148 CALL zdiv(str, sti, zr, zi, str, sti)
1150 CALL zmlt(str, sti, s1r, s1i, s2r, s2i)
1159 IF (n.EQ.1) inu = inu - 1
1160 IF (inu.GT.0)
GO TO 220
1161 IF (n.GT.1)
GO TO 215
1167 IF(iflag.EQ.1)
GO TO 270
1171 IF(iflag.EQ.1)
GO TO 261
1178 s2r = ckr*str - cki*sti + s1r
1179 s2i = ckr*sti + cki*str + s1i
1184 IF (kflag.GE.3)
GO TO 230
1189 p2m = dmax1(str,sti)
1190 IF (p2m.LE.ascle)
GO TO 230
1204 IF (n.NE.1)
GO TO 240
1224 s2r = ckr*p2r - cki*p2i + s1r
1225 s2i = cki*p2r + ckr*p2i + s1i
1234 IF (kflag.GE.3)
GO TO 260
1237 p2m = dmax1(str,sti)
1238 IF (p2m.LE.ascle)
GO TO 260
1268 s2r = str*ckr-sti*cki+s1r
1269 s2i = sti*ckr+str*cki+s1i
1277 IF(p2r.LT.(-elim))
GO TO 263
1278 CALL zlog(s2r,s2i,str,sti,idum)
1284 CALL zuchk(p1r,p1i,nw,ascle,tol)
1285 IF(nw.NE.0)
GO TO 263
1289 IF(ic.EQ.(i-1))
GO TO 264
1293 IF(alas.LT.helim)
GO TO 262
1300 IF(n.NE.1)
GO TO 270
1312 IF(inub.LE.inu)
GO TO 225
1313 IF(n.NE.1)
GO TO 240
1320 IF(n.EQ.1)
GO TO 280
1325 CALL zkscl(zdr,zdi,fnu,n,yr,yi,nz,rzr,rzi,ascle,tol,elim)
1327 IF (inu.LE.0)
RETURN 1331 yr(kk) = s1r*csrr(1)
1332 yi(kk) = s1i*csrr(1)
1333 IF (inu.EQ.1)
RETURN 1337 yr(kk) = s2r*csrr(1)
1338 yi(kk) = s2i*csrr(1)
1339 IF (inu.EQ.2)
RETURN 1340 t2 = fnu + dble(float(kk-1))
1368 SUBROUTINE zacon(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, FNUL, TOL, ELIM, ALIM)
1386 DOUBLE PRECISION alim, arg, ascle, as2, azn, bry, bscle, cki, &
1387 ckr, conei, coner, cpn, cscl, cscr, csgni, csgnr, cspni, cspnr, &
1388 csr, csrr, cssr, cyi, cyr, c1i, c1m, c1r, c2i, c2r, elim, fmr, &
1389 fn, fnu, fnul, pi, pti, ptr, razn, rl, rzi, rzr, sc1i, sc1r, &
1390 sc2i, sc2r,
sgn, spn, sti, str, s1i, s1r, s2i, s2r, tol, yi, yr, &
1391 yy, zeroi, zeror, zi, zni, znr, zr
1392 INTEGER i, inu, iuf, kflag, kode, mr, n, nn, nw, nz
1393 dimension yr(n), yi(n), cyr(2), cyi(2), cssr(3), csrr(3), bry(3)
1394 DATA pi / 3.14159265358979324d0 /
1395 DATA zeror,zeroi,coner,conei / 0.0d0,0.0d0,1.0d0,0.0d0 /
1400 CALL zbinu(znr, zni, fnu, kode, nn, yr, yi, nw, rl, fnul, tol, elim, alim)
1401 IF (nw.LT.0)
GO TO 90
1406 CALL zbknu(znr, zni, fnu, kode, nn, cyr, cyi, nw, tol, elim, alim)
1407 IF (nw.NE.0)
GO TO 90
1410 fmr = dble(float(mr))
1411 sgn = -dsign(pi,fmr)
1414 IF (kode.EQ.1)
GO TO 10
1418 CALL zmlt(csgnr, csgni, cpn, spn, csgnr, csgni)
1424 inu = int(sngl(fnu))
1425 arg = (fnu-dble(float(inu)))*
sgn 1430 IF (mod(inu,2).EQ.0)
GO TO 20
1439 ascle = 1.0d+3*d1mach(1)/tol
1440 IF (kode.EQ.1)
GO TO 30
1441 CALL zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf)
1446 CALL zmlt(cspnr, cspni, c1r, c1i, str, sti)
1447 CALL zmlt(csgnr, csgni, c2r, c2i, ptr, pti)
1459 IF (kode.EQ.1)
GO TO 40
1460 CALL zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf)
1465 CALL zmlt(cspnr, cspni, c1r, c1i, str, sti)
1466 CALL zmlt(csgnr, csgni, c2r, c2i, ptr, pti)
1476 rzr = (str+str)*razn
1477 rzi = (sti+sti)*razn
1493 bry(2) = 1.0d0/ascle
1497 IF (as2.GT.bry(1))
GO TO 50
1501 IF (as2.LT.bry(2))
GO TO 60
1505 s1r = s1r*cssr(kflag)
1506 s1i = s1i*cssr(kflag)
1507 s2r = s2r*cssr(kflag)
1508 s2i = s2i*cssr(kflag)
1513 s2r = ckr*str - cki*sti + s1r
1514 s2i = ckr*sti + cki*str + s1i
1523 IF (kode.EQ.1)
GO TO 70
1524 IF (iuf.LT.0)
GO TO 70
1525 CALL zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf)
1531 IF (iuf.NE.3)
GO TO 70
1533 s1r = sc1r*cssr(kflag)
1534 s1i = sc1i*cssr(kflag)
1535 s2r = sc2r*cssr(kflag)
1536 s2i = sc2i*cssr(kflag)
1540 ptr = cspnr*c1r - cspni*c1i
1541 pti = cspnr*c1i + cspni*c1r
1542 yr(i) = ptr + csgnr*c2r - csgni*c2i
1543 yi(i) = pti + csgnr*c2i + csgni*c2r
1548 IF (kflag.GE.3)
GO TO 80
1551 c1m = dmax1(ptr,pti)
1552 IF (c1m.LE.bscle)
GO TO 80
1559 s1r = s1r*cssr(kflag)
1560 s1i = s1i*cssr(kflag)
1561 s2r = s2r*cssr(kflag)
1562 s2i = s2i*cssr(kflag)
1568 IF(nw.EQ.(-2)) nz=-2
1572 SUBROUTINE zbunk(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM)
1583 DOUBLE PRECISION alim, ax, ay, elim, fnu, tol, yi, yr, zi, zr
1584 INTEGER kode, mr, n, nz
1585 dimension yr(1), yi(1)
1587 ax = dabs(zr)*1.7321d0
1589 IF (ay.GT.ax)
GO TO 10
1594 CALL zunk1(zr, zi, fnu, kode, mr, n, yr, yi, nz, tol, elim, alim)
1602 CALL zunk2(zr, zi, fnu, kode, mr, n, yr, yi, nz, tol, elim, alim)
1607 SUBROUTINE zunik(ZRR, ZRI, FNU, IKFLG, IPMTR, TOL, INIT, PHIR, &
1608 PHII, ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)
1632 DOUBLE PRECISION ac, c, con, conei, coner, crfni, crfnr, cwrki, &
1633 cwrkr, fnu, phii, phir, rfn, si, sr, sri, srr, sti, str, sumi, &
1634 sumr, test, ti, tol, tr, t2i, t2r, zeroi, zeror, zeta1i, zeta1r, &
1635 zeta2i, zeta2r, zni, znr, zri, zrr
1636 INTEGER i, idum, ikflg, init, ipmtr, j, k, l
1637 dimension c(120), cwrkr(16), cwrki(16), con(2)
1638 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
1639 DATA con(1), con(2) / &
1640 3.98942280401432678d-01, 1.25331413731550025d+00 /
1641 DATA c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10), &
1642 c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18), &
1643 c(19), c(20), c(21), c(22), c(23), c(24)/ &
1644 1.00000000000000000d+00, -2.08333333333333333d-01, &
1645 1.25000000000000000d-01, 3.34201388888888889d-01, &
1646 -4.01041666666666667d-01, 7.03125000000000000d-02, &
1647 -1.02581259645061728d+00, 1.84646267361111111d+00, &
1648 -8.91210937500000000d-01, 7.32421875000000000d-02, &
1649 4.66958442342624743d+00, -1.12070026162229938d+01, &
1650 8.78912353515625000d+00, -2.36408691406250000d+00, &
1651 1.12152099609375000d-01, -2.82120725582002449d+01, &
1652 8.46362176746007346d+01, -9.18182415432400174d+01, &
1653 4.25349987453884549d+01, -7.36879435947963170d+00, &
1654 2.27108001708984375d-01, 2.12570130039217123d+02, &
1655 -7.65252468141181642d+02, 1.05999045252799988d+03/
1656 DATA c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32), &
1657 c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40), &
1658 c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/ &
1659 -6.99579627376132541d+02, 2.18190511744211590d+02, &
1660 -2.64914304869515555d+01, 5.72501420974731445d-01, &
1661 -1.91945766231840700d+03, 8.06172218173730938d+03, &
1662 -1.35865500064341374d+04, 1.16553933368645332d+04, &
1663 -5.30564697861340311d+03, 1.20090291321635246d+03, &
1664 -1.08090919788394656d+02, 1.72772750258445740d+00, &
1665 2.02042913309661486d+04, -9.69805983886375135d+04, &
1666 1.92547001232531532d+05, -2.03400177280415534d+05, &
1667 1.22200464983017460d+05, -4.11926549688975513d+04, &
1668 7.10951430248936372d+03, -4.93915304773088012d+02, &
1669 6.07404200127348304d+00, -2.42919187900551333d+05, &
1670 1.31176361466297720d+06, -2.99801591853810675d+06/
1671 DATA c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56), &
1672 c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64), &
1673 c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/ &
1674 3.76327129765640400d+06, -2.81356322658653411d+06, &
1675 1.26836527332162478d+06, -3.31645172484563578d+05, &
1676 4.52187689813627263d+04, -2.49983048181120962d+03, &
1677 2.43805296995560639d+01, 3.28446985307203782d+06, &
1678 -1.97068191184322269d+07, 5.09526024926646422d+07, &
1679 -7.41051482115326577d+07, 6.63445122747290267d+07, &
1680 -3.75671766607633513d+07, 1.32887671664218183d+07, &
1681 -2.78561812808645469d+06, 3.08186404612662398d+05, &
1682 -1.38860897537170405d+04, 1.10017140269246738d+02, &
1683 -4.93292536645099620d+07, 3.25573074185765749d+08, &
1684 -9.39462359681578403d+08, 1.55359689957058006d+09, &
1685 -1.62108055210833708d+09, 1.10684281682301447d+09/
1686 DATA c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80), &
1687 c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88), &
1688 c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/ &
1689 -4.95889784275030309d+08, 1.42062907797533095d+08, &
1690 -2.44740627257387285d+07, 2.24376817792244943d+06, &
1691 -8.40054336030240853d+04, 5.51335896122020586d+02, &
1692 8.14789096118312115d+08, -5.86648149205184723d+09, &
1693 1.86882075092958249d+10, -3.46320433881587779d+10, &
1694 4.12801855797539740d+10, -3.30265997498007231d+10, &
1695 1.79542137311556001d+10, -6.56329379261928433d+09, &
1696 1.55927986487925751d+09, -2.25105661889415278d+08, &
1697 1.73951075539781645d+07, -5.49842327572288687d+05, &
1698 3.03809051092238427d+03, -1.46792612476956167d+10, &
1699 1.14498237732025810d+11, -3.99096175224466498d+11, &
1700 8.19218669548577329d+11, -1.09837515608122331d+12/
1701 DATA c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104), &
1702 c(105), c(106), c(107), c(108), c(109), c(110), c(111), &
1703 c(112), c(113), c(114), c(115), c(116), c(117), c(118)/ &
1704 1.00815810686538209d+12, -6.45364869245376503d+11, &
1705 2.87900649906150589d+11, -8.78670721780232657d+10, &
1706 1.76347306068349694d+10, -2.16716498322379509d+09, &
1707 1.43157876718888981d+08, -3.87183344257261262d+06, &
1708 1.82577554742931747d+04, 2.86464035717679043d+11, &
1709 -2.40629790002850396d+12, 9.10934118523989896d+12, &
1710 -2.05168994109344374d+13, 3.05651255199353206d+13, &
1711 -3.16670885847851584d+13, 2.33483640445818409d+13, &
1712 -1.23204913055982872d+13, 4.61272578084913197d+12, &
1713 -1.19655288019618160d+12, 2.05914503232410016d+11, &
1714 -2.18229277575292237d+10, 1.24700929351271032d+09/
1715 DATA c(119), c(120)/ &
1716 -2.91883881222208134d+07, 1.18838426256783253d+05/
1718 IF (init.NE.0)
GO TO 40
1725 sr = coner + (tr*tr-ti*ti)
1726 si = conei + (tr*ti+ti*tr)
1727 CALL zsqrt(sr, si, srr, sri)
1730 CALL zdiv(str, sti, tr, ti, znr, zni)
1731 CALL zlog(znr, zni, str, sti, idum)
1736 CALL zdiv(coner, conei, srr, sri, tr, ti)
1739 CALL zsqrt(srr, sri, cwrkr(16), cwrki(16))
1740 phir = cwrkr(16)*con(ikflg)
1741 phii = cwrki(16)*con(ikflg)
1742 IF (ipmtr.NE.0)
RETURN 1743 CALL zdiv(coner, conei, sr, si, t2r, t2i)
1755 str = sr*t2r - si*t2i + c(l)
1756 si = sr*t2i + si*t2r
1759 str = crfnr*srr - crfni*sri
1760 crfni = crfnr*sri + crfni*srr
1762 cwrkr(k) = crfnr*sr - crfni*si
1763 cwrki(k) = crfnr*si + crfni*sr
1765 test = dabs(cwrkr(k)) + dabs(cwrki(k))
1766 IF (ac.LT.tol .AND. test.LT.tol)
GO TO 30
1772 IF (ikflg.EQ.2)
GO TO 60
1784 phir = cwrkr(16)*con(1)
1785 phii = cwrki(16)*con(1)
1795 sr = sr + tr*cwrkr(i)
1796 si = si + tr*cwrki(i)
1801 phir = cwrkr(16)*con(2)
1802 phii = cwrki(16)*con(2)
1806 SUBROUTINE zunk1(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM)
1822 DOUBLE PRECISION alim, ang, aphi, asc, ascle, bry, cki, ckr, &
1823 conei, coner, crsc, cscl, csgni, cspni, cspnr, csr, csrr, cssr, &
1824 cwrki, cwrkr, cyi, cyr, c1i, c1r, c2i, c2m, c2r, elim, fmr, fn, &
1825 fnf, fnu, phidi, phidr, phii, phir, pi, rast, razr, rs1, rzi, &
1826 rzr,
sgn, sti, str, sumdi, sumdr, sumi, sumr, s1i, s1r, s2i, &
1827 s2r, tol, yi, yr, zeroi, zeror, zeta1i, zeta1r, zeta2i, zeta2r, &
1828 zet1di, zet1dr, zet2di, zet2dr, zi, zr, zri, zrr
1829 INTEGER i, ib, iflag, ifn, il, init, inu, iuf, k, kdflg, kflag, &
1830 kk, kode, mr, n, nw, nz, initd, ic, ipard, j, m
1831 dimension bry(3), init(2), yr(1), yi(1), sumr(2), sumi(2), &
1832 zeta1r(2), zeta1i(2), zeta2r(2), zeta2i(2), cyr(2), cyi(2), &
1833 cwrkr(16,3), cwrki(16,3), cssr(3), csrr(3), phir(2), phii(2)
1834 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
1835 DATA pi / 3.14159265358979324d0 /
1851 bry(1) = 1.0d+3*d1mach(1)/tol
1852 bry(2) = 1.0d0/bry(1)
1856 IF (zr.GE.0.0d0)
GO TO 10
1866 fn = fnu + dble(float(i-1))
1868 CALL zunik(zrr, zri, fn, 2, 0, tol, init(j), phir(j), phii(j), &
1869 zeta1r(j), zeta1i(j), zeta2r(j), zeta2i(j), sumr(j), sumi(j), &
1870 cwrkr(1,j), cwrki(1,j))
1871 IF (kode.EQ.1)
GO TO 20
1872 str = zrr + zeta2r(j)
1873 sti = zri + zeta2i(j)
1874 rast = fn/zabs(str,sti)
1876 sti = -sti*rast*rast
1877 s1r = zeta1r(j) - str
1878 s1i = zeta1i(j) - sti
1881 s1r = zeta1r(j) - zeta2r(j)
1882 s1i = zeta1i(j) - zeta2i(j)
1888 IF (dabs(rs1).GT.elim)
GO TO 60
1889 IF (kdflg.EQ.1) kflag = 2
1890 IF (dabs(rs1).LT.alim)
GO TO 40
1894 aphi = zabs(phir(j),phii(j))
1895 rs1 = rs1 + dlog(aphi)
1896 IF (dabs(rs1).GT.elim)
GO TO 60
1897 IF (kdflg.EQ.1) kflag = 1
1898 IF (rs1.LT.0.0d0)
GO TO 40
1899 IF (kdflg.EQ.1) kflag = 3
1905 s2r = phir(j)*sumr(j) - phii(j)*sumi(j)
1906 s2i = phir(j)*sumi(j) + phii(j)*sumr(j)
1907 str = dexp(s1r)*cssr(kflag)
1910 str = s2r*s1r - s2i*s1i
1911 s2i = s1r*s2i + s2r*s1i
1913 IF (kflag.NE.1)
GO TO 50
1914 CALL zuchk(s2r, s2i, nw, bry(1), tol)
1915 IF (nw.NE.0)
GO TO 60
1919 yr(i) = s2r*csrr(kflag)
1920 yi(i) = s2i*csrr(kflag)
1921 IF (kdflg.EQ.2)
GO TO 75
1925 IF (rs1.GT.0.0d0)
GO TO 300
1929 IF (zr.LT.0.0d0)
GO TO 300
1934 IF (i.EQ.1)
GO TO 70
1935 IF ((yr(i-1).EQ.zeror).AND.(yi(i-1).EQ.zeroi))
GO TO 70
1942 razr = 1.0d0/zabs(zrr,zri)
1945 rzr = (str+str)*razr
1946 rzi = (sti+sti)*razr
1950 IF (n.LT.ib)
GO TO 160
1955 fn = fnu + dble(float(n-1))
1957 IF (mr.NE.0) ipard = 0
1959 CALL zunik(zrr, zri, fn, 2, ipard, tol, initd, phidr, phidi, &
1960 zet1dr, zet1di, zet2dr, zet2di, sumdr, sumdi, cwrkr(1,3), &
1962 IF (kode.EQ.1)
GO TO 80
1965 rast = fn/zabs(str,sti)
1967 sti = -sti*rast*rast
1972 s1r = zet1dr - zet2dr
1973 s1i = zet1di - zet2di
1976 IF (dabs(rs1).GT.elim)
GO TO 95
1977 IF (dabs(rs1).LT.alim)
GO TO 100
1981 aphi = zabs(phidr,phidi)
1982 rs1 = rs1+dlog(aphi)
1983 IF (dabs(rs1).LT.elim)
GO TO 100
1985 IF (dabs(rs1).GT.0.0d0)
GO TO 300
1989 IF (zr.LT.0.0d0)
GO TO 300
2009 s2r = ckr*c2r - cki*c2i + s1r
2010 s2i = ckr*c2i + cki*c2r + s1i
2019 IF (kflag.GE.3)
GO TO 120
2022 c2m = dmax1(str,sti)
2023 IF (c2m.LE.ascle)
GO TO 120
2030 s1r = s1r*cssr(kflag)
2031 s1i = s1i*cssr(kflag)
2032 s2r = s2r*cssr(kflag)
2033 s2i = s2i*cssr(kflag)
2042 fmr = dble(float(mr))
2043 sgn = -dsign(pi,fmr)
2048 inu = int(sngl(fnu))
2049 fnf = fnu - dble(float(inu))
2054 IF (mod(ifn,2).EQ.0)
GO TO 170
2065 fn = fnu + dble(float(kk-1))
2071 IF (n.GT.2)
GO TO 175
2086 IF ((kk.EQ.n).AND.(ib.LT.n))
GO TO 180
2087 IF ((kk.EQ.ib).OR.(kk.EQ.ic))
GO TO 172
2090 CALL zunik(zrr, zri, fn, 1, 0, tol, initd, phidr, phidi, &
2091 zet1dr, zet1di, zet2dr, zet2di, sumdr, sumdi, &
2092 cwrkr(1,m), cwrki(1,m))
2093 IF (kode.EQ.1)
GO TO 200
2096 rast = fn/zabs(str,sti)
2098 sti = -sti*rast*rast
2103 s1r = -zet1dr + zet2dr
2104 s1i = -zet1di + zet2di
2110 IF (dabs(rs1).GT.elim)
GO TO 260
2111 IF (kdflg.EQ.1) iflag = 2
2112 IF (dabs(rs1).LT.alim)
GO TO 220
2116 aphi = zabs(phidr,phidi)
2117 rs1 = rs1 + dlog(aphi)
2118 IF (dabs(rs1).GT.elim)
GO TO 260
2119 IF (kdflg.EQ.1) iflag = 1
2120 IF (rs1.LT.0.0d0)
GO TO 220
2121 IF (kdflg.EQ.1) iflag = 3
2123 str = phidr*sumdr - phidi*sumdi
2124 sti = phidr*sumdi + phidi*sumdr
2127 str = dexp(s1r)*cssr(iflag)
2130 str = s2r*s1r - s2i*s1i
2131 s2i = s2r*s1i + s2i*s1r
2133 IF (iflag.NE.1)
GO TO 230
2134 CALL zuchk(s2r, s2i, nw, bry(1), tol)
2135 IF (nw.EQ.0)
GO TO 230
2143 s2r = s2r*csrr(iflag)
2144 s2i = s2i*csrr(iflag)
2150 IF (kode.EQ.1)
GO TO 250
2151 CALL zs1s2(zrr, zri, s1r, s1i, s2r, s2i, nw, asc, alim, iuf)
2154 yr(kk) = s1r*cspnr - s1i*cspni + s2r
2155 yi(kk) = cspnr*s1i + cspni*s1r + s2i
2159 IF (c2r.NE.0.0d0 .OR. c2i.NE.0.0d0)
GO TO 255
2163 IF (kdflg.EQ.2)
GO TO 275
2167 IF (rs1.GT.0.0d0)
GO TO 300
2187 fn = dble(float(inu+il))
2191 s2r = s1r + (fn+fnf)*(rzr*c2r-rzi*c2i)
2192 s2i = s1i + (fn+fnf)*(rzr*c2i+rzi*c2r)
2202 IF (kode.EQ.1)
GO TO 280
2203 CALL zs1s2(zrr, zri, c1r, c1i, c2r, c2i, nw, asc, alim, iuf)
2206 yr(kk) = c1r*cspnr - c1i*cspni + c2r
2207 yi(kk) = c1r*cspni + c1i*cspnr + c2i
2211 IF (iflag.GE.3)
GO TO 290
2214 c2m = dmax1(c2r,c2i)
2215 IF (c2m.LE.ascle)
GO TO 290
2222 s1r = s1r*cssr(iflag)
2223 s1i = s1i*cssr(iflag)
2224 s2r = s2r*cssr(iflag)
2225 s2i = s2i*cssr(iflag)
2234 SUBROUTINE zunk2(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, TOL, ELIM, ALIM)
2254 DOUBLE PRECISION aarg, aic, aii, air, alim, ang, aphi, argdi, &
2255 argdr, argi, argr, asc, ascle, asumdi, asumdr, asumi, asumr, &
2256 bry, bsumdi, bsumdr, bsumi, bsumr, car, cipi, cipr, cki, ckr, &
2257 conei, coner, crsc, cr1i, cr1r, cr2i, cr2r, cscl, csgni, csi, &
2258 cspni, cspnr, csr, csrr, cssr, cyi, cyr, c1i, c1r, c2i, c2m, &
2259 c2r, daii, dair, elim, fmr, fn, fnf, fnu, hpi, phidi, phidr, &
2260 phii, phir, pi, pti, ptr, rast, razr, rs1, rzi, rzr, sar,
sgn, &
2261 sti, str, s1i, s1r, s2i, s2r, tol, yi, yr, yy, zbi, zbr, zeroi, &
2262 zeror, zeta1i, zeta1r, zeta2i, zeta2r, zet1di, zet1dr, zet2di, &
2263 zet2dr, zi, zni, znr, zr, zri, zrr
2264 INTEGER i, ib, iflag, ifn, il, in, inu, iuf, k, kdflg, kflag, kk, &
2265 kode, mr, n, nai, ndai, nw, nz, idum, j, ipard, ic
2266 dimension bry(3), yr(1), yi(1), asumr(2), asumi(2), bsumr(2), &
2267 bsumi(2), phir(2), phii(2), argr(2), argi(2), zeta1r(2), &
2268 zeta1i(2), zeta2r(2), zeta2i(2), cyr(2), cyi(2), cipr(4), &
2269 cipi(4), cssr(3), csrr(3)
2270 DATA zeror,zeroi,coner,conei,cr1r,cr1i,cr2r,cr2i / &
2271 0.0d0, 0.0d0, 1.0d0, 0.0d0, &
2272 1.0d0,1.73205080756887729d0 , -0.5d0,-8.66025403784438647d-01 /
2273 DATA hpi, pi, aic / &
2274 1.57079632679489662d+00, 3.14159265358979324d+00, &
2275 1.26551212348464539d+00/
2276 DATA cipr(1),cipi(1),cipr(2),cipi(2),cipr(3),cipi(3),cipr(4), &
2278 1.0d0,0.0d0 , 0.0d0,-1.0d0 , -1.0d0,0.0d0 , 0.0d0,1.0d0 /
2294 bry(1) = 1.0d+3*d1mach(1)/tol
2295 bry(2) = 1.0d0/bry(1)
2299 IF (zr.GE.0.0d0)
GO TO 10
2308 inu = int(sngl(fnu))
2309 fnf = fnu - dble(float(inu))
2316 str = c2r*cipr(kk) - c2i*cipi(kk)
2317 sti = c2r*cipi(kk) + c2i*cipr(kk)
2318 csr = cr1r*str - cr1i*sti
2319 csi = cr1r*sti + cr1i*str
2320 IF (yy.GT.0.0d0)
GO TO 20
2335 fn = fnu + dble(float(i-1))
2336 CALL zunhj(znr, zni, fn, 0, tol, phir(j), phii(j), argr(j), &
2337 argi(j), zeta1r(j), zeta1i(j), zeta2r(j), zeta2i(j), asumr(j), &
2338 asumi(j), bsumr(j), bsumi(j))
2339 IF (kode.EQ.1)
GO TO 30
2340 str = zbr + zeta2r(j)
2341 sti = zbi + zeta2i(j)
2342 rast = fn/zabs(str,sti)
2344 sti = -sti*rast*rast
2345 s1r = zeta1r(j) - str
2346 s1i = zeta1i(j) - sti
2349 s1r = zeta1r(j) - zeta2r(j)
2350 s1i = zeta1i(j) - zeta2i(j)
2356 IF (dabs(rs1).GT.elim)
GO TO 70
2357 IF (kdflg.EQ.1) kflag = 2
2358 IF (dabs(rs1).LT.alim)
GO TO 50
2362 aphi = zabs(phir(j),phii(j))
2363 aarg = zabs(argr(j),argi(j))
2364 rs1 = rs1 + dlog(aphi) - 0.25d0*dlog(aarg) - aic
2365 IF (dabs(rs1).GT.elim)
GO TO 70
2366 IF (kdflg.EQ.1) kflag = 1
2367 IF (rs1.LT.0.0d0)
GO TO 50
2368 IF (kdflg.EQ.1) kflag = 3
2374 c2r = argr(j)*cr2r - argi(j)*cr2i
2375 c2i = argr(j)*cr2i + argi(j)*cr2r
2376 CALL zairy(c2r, c2i, 0, 2, air, aii, nai, idum)
2377 CALL zairy(c2r, c2i, 1, 2, dair, daii, ndai, idum)
2378 str = dair*bsumr(j) - daii*bsumi(j)
2379 sti = dair*bsumi(j) + daii*bsumr(j)
2380 ptr = str*cr2r - sti*cr2i
2381 pti = str*cr2i + sti*cr2r
2382 str = ptr + (air*asumr(j)-aii*asumi(j))
2383 sti = pti + (air*asumi(j)+aii*asumr(j))
2384 ptr = str*phir(j) - sti*phii(j)
2385 pti = str*phii(j) + sti*phir(j)
2386 s2r = ptr*csr - pti*csi
2387 s2i = ptr*csi + pti*csr
2388 str = dexp(s1r)*cssr(kflag)
2391 str = s2r*s1r - s2i*s1i
2392 s2i = s1r*s2i + s2r*s1i
2394 IF (kflag.NE.1)
GO TO 60
2395 CALL zuchk(s2r, s2i, nw, bry(1), tol)
2396 IF (nw.NE.0)
GO TO 70
2398 IF (yy.LE.0.0d0) s2i = -s2i
2401 yr(i) = s2r*csrr(kflag)
2402 yi(i) = s2i*csrr(kflag)
2406 IF (kdflg.EQ.2)
GO TO 85
2410 IF (rs1.GT.0.0d0)
GO TO 320
2414 IF (zr.LT.0.0d0)
GO TO 320
2422 IF (i.EQ.1)
GO TO 80
2423 IF ((yr(i-1).EQ.zeror).AND.(yi(i-1).EQ.zeroi))
GO TO 80
2430 razr = 1.0d0/zabs(zrr,zri)
2433 rzr = (str+str)*razr
2434 rzi = (sti+sti)*razr
2438 IF (n.LT.ib)
GO TO 180
2443 fn = fnu + dble(float(n-1))
2445 IF (mr.NE.0) ipard = 0
2446 CALL zunhj(znr, zni, fn, ipard, tol, phidr, phidi, argdr, argdi, &
2447 zet1dr, zet1di, zet2dr, zet2di, asumdr, asumdi, bsumdr, bsumdi)
2448 IF (kode.EQ.1)
GO TO 90
2451 rast = fn/zabs(str,sti)
2453 sti = -sti*rast*rast
2458 s1r = zet1dr - zet2dr
2459 s1i = zet1di - zet2di
2462 IF (dabs(rs1).GT.elim)
GO TO 105
2463 IF (dabs(rs1).LT.alim)
GO TO 120
2467 aphi = zabs(phidr,phidi)
2468 rs1 = rs1+dlog(aphi)
2469 IF (dabs(rs1).LT.elim)
GO TO 120
2471 IF (rs1.GT.0.0d0)
GO TO 320
2475 IF (zr.LT.0.0d0)
GO TO 320
2492 s2r = ckr*c2r - cki*c2i + s1r
2493 s2i = ckr*c2i + cki*c2r + s1i
2502 IF (kflag.GE.3)
GO TO 130
2505 c2m = dmax1(str,sti)
2506 IF (c2m.LE.ascle)
GO TO 130
2513 s1r = s1r*cssr(kflag)
2514 s1i = s1i*cssr(kflag)
2515 s2r = s2r*cssr(kflag)
2516 s2i = s2i*cssr(kflag)
2525 fmr = dble(float(mr))
2526 sgn = -dsign(pi,fmr)
2531 IF (yy.LE.0.0d0) csgni = -csgni
2536 IF (mod(ifn,2).EQ.0)
GO TO 190
2551 str = csr*c2r + csi*c2i
2552 csi = -csr*c2i + csi*c2r
2561 fn = fnu + dble(float(kk-1))
2566 IF (n.GT.2)
GO TO 175
2583 IF ((kk.EQ.n).AND.(ib.LT.n))
GO TO 210
2584 IF ((kk.EQ.ib).OR.(kk.EQ.ic))
GO TO 172
2585 CALL zunhj(znr, zni, fn, 0, tol, phidr, phidi, argdr, &
2586 argdi, zet1dr, zet1di, zet2dr, zet2di, asumdr, &
2587 asumdi, bsumdr, bsumdi)
2589 IF (kode.EQ.1)
GO TO 220
2592 rast = fn/zabs(str,sti)
2594 sti = -sti*rast*rast
2599 s1r = -zet1dr + zet2dr
2600 s1i = -zet1di + zet2di
2606 IF (dabs(rs1).GT.elim)
GO TO 280
2607 IF (kdflg.EQ.1) iflag = 2
2608 IF (dabs(rs1).LT.alim)
GO TO 240
2612 aphi = zabs(phidr,phidi)
2613 aarg = zabs(argdr,argdi)
2614 rs1 = rs1 + dlog(aphi) - 0.25d0*dlog(aarg) - aic
2615 IF (dabs(rs1).GT.elim)
GO TO 280
2616 IF (kdflg.EQ.1) iflag = 1
2617 IF (rs1.LT.0.0d0)
GO TO 240
2618 IF (kdflg.EQ.1) iflag = 3
2620 CALL zairy(argdr, argdi, 0, 2, air, aii, nai, idum)
2621 CALL zairy(argdr, argdi, 1, 2, dair, daii, ndai, idum)
2622 str = dair*bsumdr - daii*bsumdi
2623 sti = dair*bsumdi + daii*bsumdr
2624 str = str + (air*asumdr-aii*asumdi)
2625 sti = sti + (air*asumdi+aii*asumdr)
2626 ptr = str*phidr - sti*phidi
2627 pti = str*phidi + sti*phidr
2628 s2r = ptr*csr - pti*csi
2629 s2i = ptr*csi + pti*csr
2630 str = dexp(s1r)*cssr(iflag)
2633 str = s2r*s1r - s2i*s1i
2634 s2i = s2r*s1i + s2i*s1r
2636 IF (iflag.NE.1)
GO TO 250
2637 CALL zuchk(s2r, s2i, nw, bry(1), tol)
2638 IF (nw.EQ.0)
GO TO 250
2642 IF (yy.LE.0.0d0) s2i = -s2i
2647 s2r = s2r*csrr(iflag)
2648 s2i = s2i*csrr(iflag)
2654 IF (kode.EQ.1)
GO TO 270
2655 CALL zs1s2(zrr, zri, s1r, s1i, s2r, s2i, nw, asc, alim, iuf)
2658 yr(kk) = s1r*cspnr - s1i*cspni + s2r
2659 yi(kk) = s1r*cspni + s1i*cspnr + s2i
2666 IF (c2r.NE.0.0d0 .OR. c2i.NE.0.0d0)
GO TO 255
2670 IF (kdflg.EQ.2)
GO TO 295
2674 IF (rs1.GT.0.0d0)
GO TO 320
2694 fn = dble(float(inu+il))
2698 s2r = s1r + (fn+fnf)*(rzr*c2r-rzi*c2i)
2699 s2i = s1i + (fn+fnf)*(rzr*c2i+rzi*c2r)
2709 IF (kode.EQ.1)
GO TO 300
2710 CALL zs1s2(zrr, zri, c1r, c1i, c2r, c2i, nw, asc, alim, iuf)
2713 yr(kk) = c1r*cspnr - c1i*cspni + c2r
2714 yi(kk) = c1r*cspni + c1i*cspnr + c2i
2718 IF (iflag.GE.3)
GO TO 310
2721 c2m = dmax1(c2r,c2i)
2722 IF (c2m.LE.ascle)
GO TO 310
2729 s1r = s1r*cssr(iflag)
2730 s1i = s1i*cssr(iflag)
2731 s2r = s2r*cssr(iflag)
2732 s2i = s2i*cssr(iflag)
2741 SUBROUTINE zunhj(ZR, ZI, FNU, IPMTR, TOL, PHIR, PHII, ARGR, ARGI, &
2742 ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
2778 DOUBLE PRECISION alfa, ang, ap, ar, argi, argr, asumi, asumr, &
2779 atol, aw2, azth, beta, br, bsumi, bsumr, btol, c, conei, coner, &
2780 cri, crr, dri, drr, ex1, ex2, fnu, fn13, fn23, gama, gpi, hpi, &
2781 phii, phir, pi, pp, pr, przthi, przthr, ptfni, ptfnr, raw, raw2, &
2782 razth, rfnu, rfnu2, rfn13, rtzti, rtztr, rzthi, rzthr, sti, str, &
2783 sumai, sumar, sumbi, sumbr, test, tfni, tfnr, thpi, tol, tzai, &
2784 tzar, t2i, t2r, upi, upr, wi, wr, w2i, w2r, zai, zar, zbi, zbr, &
2785 zci, zcr, zeroi, zeror, zetai, zetar, zeta1i, zeta1r, zeta2i, &
2786 zeta2r, zi, zr, zthi, zthr
2787 INTEGER ias, ibs, ipmtr, is, j, jr, ju, k, kmax, kp1, ks, l, lr, &
2788 lrp1, l1, l2, m, idum
2789 dimension ar(14), br(14), c(105), alfa(180), beta(210), gama(30), &
2790 ap(30), pr(30), pi(30), upr(14), upi(14), crr(14), cri(14), &
2792 DATA ar(1), ar(2), ar(3), ar(4), ar(5), ar(6), ar(7), ar(8), &
2793 ar(9), ar(10), ar(11), ar(12), ar(13), ar(14)/ &
2794 1.00000000000000000d+00, 1.04166666666666667d-01, &
2795 8.35503472222222222d-02, 1.28226574556327160d-01, &
2796 2.91849026464140464d-01, 8.81627267443757652d-01, &
2797 3.32140828186276754d+00, 1.49957629868625547d+01, &
2798 7.89230130115865181d+01, 4.74451538868264323d+02, &
2799 3.20749009089066193d+03, 2.40865496408740049d+04, &
2800 1.98923119169509794d+05, 1.79190200777534383d+06/
2801 DATA br(1), br(2), br(3), br(4), br(5), br(6), br(7), br(8), &
2802 br(9), br(10), br(11), br(12), br(13), br(14)/ &
2803 1.00000000000000000d+00, -1.45833333333333333d-01, &
2804 -9.87413194444444444d-02, -1.43312053915895062d-01, &
2805 -3.17227202678413548d-01, -9.42429147957120249d-01, &
2806 -3.51120304082635426d+00, -1.57272636203680451d+01, &
2807 -8.22814390971859444d+01, -4.92355370523670524d+02, &
2808 -3.31621856854797251d+03, -2.48276742452085896d+04, &
2809 -2.04526587315129788d+05, -1.83844491706820990d+06/
2810 DATA c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10), &
2811 c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18), &
2812 c(19), c(20), c(21), c(22), c(23), c(24)/ &
2813 1.00000000000000000d+00, -2.08333333333333333d-01, &
2814 1.25000000000000000d-01, 3.34201388888888889d-01, &
2815 -4.01041666666666667d-01, 7.03125000000000000d-02, &
2816 -1.02581259645061728d+00, 1.84646267361111111d+00, &
2817 -8.91210937500000000d-01, 7.32421875000000000d-02, &
2818 4.66958442342624743d+00, -1.12070026162229938d+01, &
2819 8.78912353515625000d+00, -2.36408691406250000d+00, &
2820 1.12152099609375000d-01, -2.82120725582002449d+01, &
2821 8.46362176746007346d+01, -9.18182415432400174d+01, &
2822 4.25349987453884549d+01, -7.36879435947963170d+00, &
2823 2.27108001708984375d-01, 2.12570130039217123d+02, &
2824 -7.65252468141181642d+02, 1.05999045252799988d+03/
2825 DATA c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32), &
2826 c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40), &
2827 c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/ &
2828 -6.99579627376132541d+02, 2.18190511744211590d+02, &
2829 -2.64914304869515555d+01, 5.72501420974731445d-01, &
2830 -1.91945766231840700d+03, 8.06172218173730938d+03, &
2831 -1.35865500064341374d+04, 1.16553933368645332d+04, &
2832 -5.30564697861340311d+03, 1.20090291321635246d+03, &
2833 -1.08090919788394656d+02, 1.72772750258445740d+00, &
2834 2.02042913309661486d+04, -9.69805983886375135d+04, &
2835 1.92547001232531532d+05, -2.03400177280415534d+05, &
2836 1.22200464983017460d+05, -4.11926549688975513d+04, &
2837 7.10951430248936372d+03, -4.93915304773088012d+02, &
2838 6.07404200127348304d+00, -2.42919187900551333d+05, &
2839 1.31176361466297720d+06, -2.99801591853810675d+06/
2840 DATA c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56), &
2841 c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64), &
2842 c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/ &
2843 3.76327129765640400d+06, -2.81356322658653411d+06, &
2844 1.26836527332162478d+06, -3.31645172484563578d+05, &
2845 4.52187689813627263d+04, -2.49983048181120962d+03, &
2846 2.43805296995560639d+01, 3.28446985307203782d+06, &
2847 -1.97068191184322269d+07, 5.09526024926646422d+07, &
2848 -7.41051482115326577d+07, 6.63445122747290267d+07, &
2849 -3.75671766607633513d+07, 1.32887671664218183d+07, &
2850 -2.78561812808645469d+06, 3.08186404612662398d+05, &
2851 -1.38860897537170405d+04, 1.10017140269246738d+02, &
2852 -4.93292536645099620d+07, 3.25573074185765749d+08, &
2853 -9.39462359681578403d+08, 1.55359689957058006d+09, &
2854 -1.62108055210833708d+09, 1.10684281682301447d+09/
2855 DATA c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80), &
2856 c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88), &
2857 c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/ &
2858 -4.95889784275030309d+08, 1.42062907797533095d+08, &
2859 -2.44740627257387285d+07, 2.24376817792244943d+06, &
2860 -8.40054336030240853d+04, 5.51335896122020586d+02, &
2861 8.14789096118312115d+08, -5.86648149205184723d+09, &
2862 1.86882075092958249d+10, -3.46320433881587779d+10, &
2863 4.12801855797539740d+10, -3.30265997498007231d+10, &
2864 1.79542137311556001d+10, -6.56329379261928433d+09, &
2865 1.55927986487925751d+09, -2.25105661889415278d+08, &
2866 1.73951075539781645d+07, -5.49842327572288687d+05, &
2867 3.03809051092238427d+03, -1.46792612476956167d+10, &
2868 1.14498237732025810d+11, -3.99096175224466498d+11, &
2869 8.19218669548577329d+11, -1.09837515608122331d+12/
2870 DATA c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104), &
2872 1.00815810686538209d+12, -6.45364869245376503d+11, &
2873 2.87900649906150589d+11, -8.78670721780232657d+10, &
2874 1.76347306068349694d+10, -2.16716498322379509d+09, &
2875 1.43157876718888981d+08, -3.87183344257261262d+06, &
2876 1.82577554742931747d+04/
2877 DATA alfa(1), alfa(2), alfa(3), alfa(4), alfa(5), alfa(6), &
2878 alfa(7), alfa(8), alfa(9), alfa(10), alfa(11), alfa(12), &
2879 alfa(13), alfa(14), alfa(15), alfa(16), alfa(17), alfa(18), &
2880 alfa(19), alfa(20), alfa(21), alfa(22)/ &
2881 -4.44444444444444444d-03, -9.22077922077922078d-04, &
2882 -8.84892884892884893d-05, 1.65927687832449737d-04, &
2883 2.46691372741792910d-04, 2.65995589346254780d-04, &
2884 2.61824297061500945d-04, 2.48730437344655609d-04, &
2885 2.32721040083232098d-04, 2.16362485712365082d-04, &
2886 2.00738858762752355d-04, 1.86267636637545172d-04, &
2887 1.73060775917876493d-04, 1.61091705929015752d-04, &
2888 1.50274774160908134d-04, 1.40503497391269794d-04, &
2889 1.31668816545922806d-04, 1.23667445598253261d-04, &
2890 1.16405271474737902d-04, 1.09798298372713369d-04, &
2891 1.03772410422992823d-04, 9.82626078369363448d-05/
2892 DATA alfa(23), alfa(24), alfa(25), alfa(26), alfa(27), alfa(28), &
2893 alfa(29), alfa(30), alfa(31), alfa(32), alfa(33), alfa(34), &
2894 alfa(35), alfa(36), alfa(37), alfa(38), alfa(39), alfa(40), &
2895 alfa(41), alfa(42), alfa(43), alfa(44)/ &
2896 9.32120517249503256d-05, 8.85710852478711718d-05, &
2897 8.42963105715700223d-05, 8.03497548407791151d-05, &
2898 7.66981345359207388d-05, 7.33122157481777809d-05, &
2899 7.01662625163141333d-05, 6.72375633790160292d-05, &
2900 6.93735541354588974d-04, 2.32241745182921654d-04, &
2901 -1.41986273556691197d-05, -1.16444931672048640d-04, &
2902 -1.50803558053048762d-04, -1.55121924918096223d-04, &
2903 -1.46809756646465549d-04, -1.33815503867491367d-04, &
2904 -1.19744975684254051d-04, -1.06184319207974020d-04, &
2905 -9.37699549891194492d-05, -8.26923045588193274d-05, &
2906 -7.29374348155221211d-05, -6.44042357721016283d-05/
2907 DATA alfa(45), alfa(46), alfa(47), alfa(48), alfa(49), alfa(50), &
2908 alfa(51), alfa(52), alfa(53), alfa(54), alfa(55), alfa(56), &
2909 alfa(57), alfa(58), alfa(59), alfa(60), alfa(61), alfa(62), &
2910 alfa(63), alfa(64), alfa(65), alfa(66)/ &
2911 -5.69611566009369048d-05, -5.04731044303561628d-05, &
2912 -4.48134868008882786d-05, -3.98688727717598864d-05, &
2913 -3.55400532972042498d-05, -3.17414256609022480d-05, &
2914 -2.83996793904174811d-05, -2.54522720634870566d-05, &
2915 -2.28459297164724555d-05, -2.05352753106480604d-05, &
2916 -1.84816217627666085d-05, -1.66519330021393806d-05, &
2917 -1.50179412980119482d-05, -1.35554031379040526d-05, &
2918 -1.22434746473858131d-05, -1.10641884811308169d-05, &
2919 -3.54211971457743841d-04, -1.56161263945159416d-04, &
2920 3.04465503594936410d-05, 1.30198655773242693d-04, &
2921 1.67471106699712269d-04, 1.70222587683592569d-04/
2922 DATA alfa(67), alfa(68), alfa(69), alfa(70), alfa(71), alfa(72), &
2923 alfa(73), alfa(74), alfa(75), alfa(76), alfa(77), alfa(78), &
2924 alfa(79), alfa(80), alfa(81), alfa(82), alfa(83), alfa(84), &
2925 alfa(85), alfa(86), alfa(87), alfa(88)/ &
2926 1.56501427608594704d-04, 1.36339170977445120d-04, &
2927 1.14886692029825128d-04, 9.45869093034688111d-05, &
2928 7.64498419250898258d-05, 6.07570334965197354d-05, &
2929 4.74394299290508799d-05, 3.62757512005344297d-05, &
2930 2.69939714979224901d-05, 1.93210938247939253d-05, &
2931 1.30056674793963203d-05, 7.82620866744496661d-06, &
2932 3.59257485819351583d-06, 1.44040049814251817d-07, &
2933 -2.65396769697939116d-06, -4.91346867098485910d-06, &
2934 -6.72739296091248287d-06, -8.17269379678657923d-06, &
2935 -9.31304715093561232d-06, -1.02011418798016441d-05, &
2936 -1.08805962510592880d-05, -1.13875481509603555d-05/
2937 DATA alfa(89), alfa(90), alfa(91), alfa(92), alfa(93), alfa(94), &
2938 alfa(95), alfa(96), alfa(97), alfa(98), alfa(99), alfa(100), &
2939 alfa(101), alfa(102), alfa(103), alfa(104), alfa(105), &
2940 alfa(106), alfa(107), alfa(108), alfa(109), alfa(110)/ &
2941 -1.17519675674556414d-05, -1.19987364870944141d-05, &
2942 3.78194199201772914d-04, 2.02471952761816167d-04, &
2943 -6.37938506318862408d-05, -2.38598230603005903d-04, &
2944 -3.10916256027361568d-04, -3.13680115247576316d-04, &
2945 -2.78950273791323387d-04, -2.28564082619141374d-04, &
2946 -1.75245280340846749d-04, -1.25544063060690348d-04, &
2947 -8.22982872820208365d-05, -4.62860730588116458d-05, &
2948 -1.72334302366962267d-05, 5.60690482304602267d-06, &
2949 2.31395443148286800d-05, 3.62642745856793957d-05, &
2950 4.58006124490188752d-05, 5.24595294959114050d-05, &
2951 5.68396208545815266d-05, 5.94349820393104052d-05/
2952 DATA alfa(111), alfa(112), alfa(113), alfa(114), alfa(115), &
2953 alfa(116), alfa(117), alfa(118), alfa(119), alfa(120), &
2954 alfa(121), alfa(122), alfa(123), alfa(124), alfa(125), &
2955 alfa(126), alfa(127), alfa(128), alfa(129), alfa(130)/ &
2956 6.06478527578421742d-05, 6.08023907788436497d-05, &
2957 6.01577894539460388d-05, 5.89199657344698500d-05, &
2958 5.72515823777593053d-05, 5.52804375585852577d-05, &
2959 5.31063773802880170d-05, 5.08069302012325706d-05, &
2960 4.84418647620094842d-05, 4.60568581607475370d-05, &
2961 -6.91141397288294174d-04, -4.29976633058871912d-04, &
2962 1.83067735980039018d-04, 6.60088147542014144d-04, &
2963 8.75964969951185931d-04, 8.77335235958235514d-04, &
2964 7.49369585378990637d-04, 5.63832329756980918d-04, &
2965 3.68059319971443156d-04, 1.88464535514455599d-04/
2966 DATA alfa(131), alfa(132), alfa(133), alfa(134), alfa(135), &
2967 alfa(136), alfa(137), alfa(138), alfa(139), alfa(140), &
2968 alfa(141), alfa(142), alfa(143), alfa(144), alfa(145), &
2969 alfa(146), alfa(147), alfa(148), alfa(149), alfa(150)/ &
2970 3.70663057664904149d-05, -8.28520220232137023d-05, &
2971 -1.72751952869172998d-04, -2.36314873605872983d-04, &
2972 -2.77966150694906658d-04, -3.02079514155456919d-04, &
2973 -3.12594712643820127d-04, -3.12872558758067163d-04, &
2974 -3.05678038466324377d-04, -2.93226470614557331d-04, &
2975 -2.77255655582934777d-04, -2.59103928467031709d-04, &
2976 -2.39784014396480342d-04, -2.20048260045422848d-04, &
2977 -2.00443911094971498d-04, -1.81358692210970687d-04, &
2978 -1.63057674478657464d-04, -1.45712672175205844d-04, &
2979 -1.29425421983924587d-04, -1.14245691942445952d-04/
2980 DATA alfa(151), alfa(152), alfa(153), alfa(154), alfa(155), &
2981 alfa(156), alfa(157), alfa(158), alfa(159), alfa(160), &
2982 alfa(161), alfa(162), alfa(163), alfa(164), alfa(165), &
2983 alfa(166), alfa(167), alfa(168), alfa(169), alfa(170)/ &
2984 1.92821964248775885d-03, 1.35592576302022234d-03, &
2985 -7.17858090421302995d-04, -2.58084802575270346d-03, &
2986 -3.49271130826168475d-03, -3.46986299340960628d-03, &
2987 -2.82285233351310182d-03, -1.88103076404891354d-03, &
2988 -8.89531718383947600d-04, 3.87912102631035228d-06, &
2989 7.28688540119691412d-04, 1.26566373053457758d-03, &
2990 1.62518158372674427d-03, 1.83203153216373172d-03, &
2991 1.91588388990527909d-03, 1.90588846755546138d-03, &
2992 1.82798982421825727d-03, 1.70389506421121530d-03, &
2993 1.55097127171097686d-03, 1.38261421852276159d-03/
2994 DATA alfa(171), alfa(172), alfa(173), alfa(174), alfa(175), &
2995 alfa(176), alfa(177), alfa(178), alfa(179), alfa(180)/ &
2996 1.20881424230064774d-03, 1.03676532638344962d-03, &
2997 8.71437918068619115d-04, 7.16080155297701002d-04, &
2998 5.72637002558129372d-04, 4.42089819465802277d-04, &
2999 3.24724948503090564d-04, 2.20342042730246599d-04, &
3000 1.28412898401353882d-04, 4.82005924552095464d-05/
3001 DATA beta(1), beta(2), beta(3), beta(4), beta(5), beta(6), &
3002 beta(7), beta(8), beta(9), beta(10), beta(11), beta(12), &
3003 beta(13), beta(14), beta(15), beta(16), beta(17), beta(18), &
3004 beta(19), beta(20), beta(21), beta(22)/ &
3005 1.79988721413553309d-02, 5.59964911064388073d-03, &
3006 2.88501402231132779d-03, 1.80096606761053941d-03, &
3007 1.24753110589199202d-03, 9.22878876572938311d-04, &
3008 7.14430421727287357d-04, 5.71787281789704872d-04, &
3009 4.69431007606481533d-04, 3.93232835462916638d-04, &
3010 3.34818889318297664d-04, 2.88952148495751517d-04, &
3011 2.52211615549573284d-04, 2.22280580798883327d-04, &
3012 1.97541838033062524d-04, 1.76836855019718004d-04, &
3013 1.59316899661821081d-04, 1.44347930197333986d-04, &
3014 1.31448068119965379d-04, 1.20245444949302884d-04, &
3015 1.10449144504599392d-04, 1.01828770740567258d-04/
3016 DATA beta(23), beta(24), beta(25), beta(26), beta(27), beta(28), &
3017 beta(29), beta(30), beta(31), beta(32), beta(33), beta(34), &
3018 beta(35), beta(36), beta(37), beta(38), beta(39), beta(40), &
3019 beta(41), beta(42), beta(43), beta(44)/ &
3020 9.41998224204237509d-05, 8.74130545753834437d-05, &
3021 8.13466262162801467d-05, 7.59002269646219339d-05, &
3022 7.09906300634153481d-05, 6.65482874842468183d-05, &
3023 6.25146958969275078d-05, 5.88403394426251749d-05, &
3024 -1.49282953213429172d-03, -8.78204709546389328d-04, &
3025 -5.02916549572034614d-04, -2.94822138512746025d-04, &
3026 -1.75463996970782828d-04, -1.04008550460816434d-04, &
3027 -5.96141953046457895d-05, -3.12038929076098340d-05, &
3028 -1.26089735980230047d-05, -2.42892608575730389d-07, &
3029 8.05996165414273571d-06, 1.36507009262147391d-05, &
3030 1.73964125472926261d-05, 1.98672978842133780d-05/
3031 DATA beta(45), beta(46), beta(47), beta(48), beta(49), beta(50), &
3032 beta(51), beta(52), beta(53), beta(54), beta(55), beta(56), &
3033 beta(57), beta(58), beta(59), beta(60), beta(61), beta(62), &
3034 beta(63), beta(64), beta(65), beta(66)/ &
3035 2.14463263790822639d-05, 2.23954659232456514d-05, &
3036 2.28967783814712629d-05, 2.30785389811177817d-05, &
3037 2.30321976080909144d-05, 2.28236073720348722d-05, &
3038 2.25005881105292418d-05, 2.20981015361991429d-05, &
3039 2.16418427448103905d-05, 2.11507649256220843d-05, &
3040 2.06388749782170737d-05, 2.01165241997081666d-05, &
3041 1.95913450141179244d-05, 1.90689367910436740d-05, &
3042 1.85533719641636667d-05, 1.80475722259674218d-05, &
3043 5.52213076721292790d-04, 4.47932581552384646d-04, &
3044 2.79520653992020589d-04, 1.52468156198446602d-04, &
3045 6.93271105657043598d-05, 1.76258683069991397d-05/
3046 DATA beta(67), beta(68), beta(69), beta(70), beta(71), beta(72), &
3047 beta(73), beta(74), beta(75), beta(76), beta(77), beta(78), &
3048 beta(79), beta(80), beta(81), beta(82), beta(83), beta(84), &
3049 beta(85), beta(86), beta(87), beta(88)/ &
3050 -1.35744996343269136d-05, -3.17972413350427135d-05, &
3051 -4.18861861696693365d-05, -4.69004889379141029d-05, &
3052 -4.87665447413787352d-05, -4.87010031186735069d-05, &
3053 -4.74755620890086638d-05, -4.55813058138628452d-05, &
3054 -4.33309644511266036d-05, -4.09230193157750364d-05, &
3055 -3.84822638603221274d-05, -3.60857167535410501d-05, &
3056 -3.37793306123367417d-05, -3.15888560772109621d-05, &
3057 -2.95269561750807315d-05, -2.75978914828335759d-05, &
3058 -2.58006174666883713d-05, -2.41308356761280200d-05, &
3059 -2.25823509518346033d-05, -2.11479656768912971d-05, &
3060 -1.98200638885294927d-05, -1.85909870801065077d-05/
3061 DATA beta(89), beta(90), beta(91), beta(92), beta(93), beta(94), &
3062 beta(95), beta(96), beta(97), beta(98), beta(99), beta(100), &
3063 beta(101), beta(102), beta(103), beta(104), beta(105), &
3064 beta(106), beta(107), beta(108), beta(109), beta(110)/ &
3065 -1.74532699844210224d-05, -1.63997823854497997d-05, &
3066 -4.74617796559959808d-04, -4.77864567147321487d-04, &
3067 -3.20390228067037603d-04, -1.61105016119962282d-04, &
3068 -4.25778101285435204d-05, 3.44571294294967503d-05, &
3069 7.97092684075674924d-05, 1.03138236708272200d-04, &
3070 1.12466775262204158d-04, 1.13103642108481389d-04, &
3071 1.08651634848774268d-04, 1.01437951597661973d-04, &
3072 9.29298396593363896d-05, 8.40293133016089978d-05, &
3073 7.52727991349134062d-05, 6.69632521975730872d-05, &
3074 5.92564547323194704d-05, 5.22169308826975567d-05, &
3075 4.58539485165360646d-05, 4.01445513891486808d-05/
3076 DATA beta(111), beta(112), beta(113), beta(114), beta(115), &
3077 beta(116), beta(117), beta(118), beta(119), beta(120), &
3078 beta(121), beta(122), beta(123), beta(124), beta(125), &
3079 beta(126), beta(127), beta(128), beta(129), beta(130)/ &
3080 3.50481730031328081d-05, 3.05157995034346659d-05, &
3081 2.64956119950516039d-05, 2.29363633690998152d-05, &
3082 1.97893056664021636d-05, 1.70091984636412623d-05, &
3083 1.45547428261524004d-05, 1.23886640995878413d-05, &
3084 1.04775876076583236d-05, 8.79179954978479373d-06, &
3085 7.36465810572578444d-04, 8.72790805146193976d-04, &
3086 6.22614862573135066d-04, 2.85998154194304147d-04, &
3087 3.84737672879366102d-06, -1.87906003636971558d-04, &
3088 -2.97603646594554535d-04, -3.45998126832656348d-04, &
3089 -3.53382470916037712d-04, -3.35715635775048757d-04/
3090 DATA beta(131), beta(132), beta(133), beta(134), beta(135), &
3091 beta(136), beta(137), beta(138), beta(139), beta(140), &
3092 beta(141), beta(142), beta(143), beta(144), beta(145), &
3093 beta(146), beta(147), beta(148), beta(149), beta(150)/ &
3094 -3.04321124789039809d-04, -2.66722723047612821d-04, &
3095 -2.27654214122819527d-04, -1.89922611854562356d-04, &
3096 -1.55058918599093870d-04, -1.23778240761873630d-04, &
3097 -9.62926147717644187d-05, -7.25178327714425337d-05, &
3098 -5.22070028895633801d-05, -3.50347750511900522d-05, &
3099 -2.06489761035551757d-05, -8.70106096849767054d-06, &
3100 1.13698686675100290d-06, 9.16426474122778849d-06, &
3101 1.56477785428872620d-05, 2.08223629482466847d-05, &
3102 2.48923381004595156d-05, 2.80340509574146325d-05, &
3103 3.03987774629861915d-05, 3.21156731406700616d-05/
3104 DATA beta(151), beta(152), beta(153), beta(154), beta(155), &
3105 beta(156), beta(157), beta(158), beta(159), beta(160), &
3106 beta(161), beta(162), beta(163), beta(164), beta(165), &
3107 beta(166), beta(167), beta(168), beta(169), beta(170)/ &
3108 -1.80182191963885708d-03, -2.43402962938042533d-03, &
3109 -1.83422663549856802d-03, -7.62204596354009765d-04, &
3110 2.39079475256927218d-04, 9.49266117176881141d-04, &
3111 1.34467449701540359d-03, 1.48457495259449178d-03, &
3112 1.44732339830617591d-03, 1.30268261285657186d-03, &
3113 1.10351597375642682d-03, 8.86047440419791759d-04, &
3114 6.73073208165665473d-04, 4.77603872856582378d-04, &
3115 3.05991926358789362d-04, 1.60315694594721630d-04, &
3116 4.00749555270613286d-05, -5.66607461635251611d-05, &
3117 -1.32506186772982638d-04, -1.90296187989614057d-04/
3118 DATA beta(171), beta(172), beta(173), beta(174), beta(175), &
3119 beta(176), beta(177), beta(178), beta(179), beta(180), &
3120 beta(181), beta(182), beta(183), beta(184), beta(185), &
3121 beta(186), beta(187), beta(188), beta(189), beta(190)/ &
3122 -2.32811450376937408d-04, -2.62628811464668841d-04, &
3123 -2.82050469867598672d-04, -2.93081563192861167d-04, &
3124 -2.97435962176316616d-04, -2.96557334239348078d-04, &
3125 -2.91647363312090861d-04, -2.83696203837734166d-04, &
3126 -2.73512317095673346d-04, -2.61750155806768580d-04, &
3127 6.38585891212050914d-03, 9.62374215806377941d-03, &
3128 7.61878061207001043d-03, 2.83219055545628054d-03, &
3129 -2.09841352012720090d-03, -5.73826764216626498d-03, &
3130 -7.70804244495414620d-03, -8.21011692264844401d-03, &
3131 -7.65824520346905413d-03, -6.47209729391045177d-03/
3132 DATA beta(191), beta(192), beta(193), beta(194), beta(195), &
3133 beta(196), beta(197), beta(198), beta(199), beta(200), &
3134 beta(201), beta(202), beta(203), beta(204), beta(205), &
3135 beta(206), beta(207), beta(208), beta(209), beta(210)/ &
3136 -4.99132412004966473d-03, -3.45612289713133280d-03, &
3137 -2.01785580014170775d-03, -7.59430686781961401d-04, &
3138 2.84173631523859138d-04, 1.10891667586337403d-03, &
3139 1.72901493872728771d-03, 2.16812590802684701d-03, &
3140 2.45357710494539735d-03, 2.61281821058334862d-03, &
3141 2.67141039656276912d-03, 2.65203073395980430d-03, &
3142 2.57411652877287315d-03, 2.45389126236094427d-03, &
3143 2.30460058071795494d-03, 2.13684837686712662d-03, &
3144 1.95896528478870911d-03, 1.77737008679454412d-03, &
3145 1.59690280765839059d-03, 1.42111975664438546d-03/
3146 DATA gama(1), gama(2), gama(3), gama(4), gama(5), gama(6), &
3147 gama(7), gama(8), gama(9), gama(10), gama(11), gama(12), &
3148 gama(13), gama(14), gama(15), gama(16), gama(17), gama(18), &
3149 gama(19), gama(20), gama(21), gama(22)/ &
3150 6.29960524947436582d-01, 2.51984209978974633d-01, &
3151 1.54790300415655846d-01, 1.10713062416159013d-01, &
3152 8.57309395527394825d-02, 6.97161316958684292d-02, &
3153 5.86085671893713576d-02, 5.04698873536310685d-02, &
3154 4.42600580689154809d-02, 3.93720661543509966d-02, &
3155 3.54283195924455368d-02, 3.21818857502098231d-02, &
3156 2.94646240791157679d-02, 2.71581677112934479d-02, &
3157 2.51768272973861779d-02, 2.34570755306078891d-02, &
3158 2.19508390134907203d-02, 2.06210828235646240d-02, &
3159 1.94388240897880846d-02, 1.83810633800683158d-02, &
3160 1.74293213231963172d-02, 1.65685837786612353d-02/
3161 DATA gama(23), gama(24), gama(25), gama(26), gama(27), gama(28), &
3162 gama(29), gama(30)/ &
3163 1.57865285987918445d-02, 1.50729501494095594d-02, &
3164 1.44193250839954639d-02, 1.38184805735341786d-02, &
3165 1.32643378994276568d-02, 1.27517121970498651d-02, &
3166 1.22761545318762767d-02, 1.18338262398482403d-02/
3167 DATA ex1, ex2, hpi, gpi, thpi / &
3168 3.33333333333333333d-01, 6.66666666666666667d-01, &
3169 1.57079632679489662d+00, 3.14159265358979324d+00, &
3170 4.71238898038468986d+00/
3171 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
3183 w2r = coner - zbr*zbr + zbi*zbi
3184 w2i = conei - zbr*zbi - zbr*zbi
3186 IF (aw2.GT.0.25d0)
GO TO 130
3196 IF (aw2.LT.tol)
GO TO 20
3198 pr(k) = pr(k-1)*w2r - pi(k-1)*w2i
3199 pi(k) = pr(k-1)*w2i + pi(k-1)*w2r
3200 sumar = sumar + pr(k)*gama(k)
3201 sumai = sumai + pi(k)*gama(k)
3203 IF (ap(k).LT.tol)
GO TO 20
3208 zetar = w2r*sumar - w2i*sumai
3209 zetai = w2r*sumai + w2i*sumar
3212 CALL zsqrt(sumar, sumai, zar, zai)
3213 CALL zsqrt(w2r, w2i, str, sti)
3216 str = coner + ex2*(zetar*zar-zetai*zai)
3217 sti = conei + ex2*(zetar*zai+zetai*zar)
3218 zeta1r = str*zeta2r - sti*zeta2i
3219 zeta1i = str*zeta2i + sti*zeta2r
3222 CALL zsqrt(zar, zai, str, sti)
3225 IF (ipmtr.EQ.1)
GO TO 120
3232 sumbr = sumbr + pr(k)*beta(k)
3233 sumbi = sumbi + pi(k)*beta(k)
3241 btol = tol*(dabs(bsumr)+dabs(bsumi))
3246 IF (rfnu2.LT.tol)
GO TO 110
3250 IF (ias.EQ.1)
GO TO 60
3255 sumar = sumar + pr(k)*alfa(m)
3256 sumai = sumai + pi(k)*alfa(m)
3257 IF (ap(k).LT.atol)
GO TO 50
3260 asumr = asumr + sumar*pp
3261 asumi = asumi + sumai*pp
3262 IF (pp.LT.tol) ias = 1
3264 IF (ibs.EQ.1)
GO TO 90
3269 sumbr = sumbr + pr(k)*beta(m)
3270 sumbi = sumbi + pi(k)*beta(m)
3271 IF (ap(k).LT.atol)
GO TO 80
3274 bsumr = bsumr + sumbr*pp
3275 bsumi = bsumi + sumbi*pp
3276 IF (pp.LT.btol) ibs = 1
3278 IF (ias.EQ.1 .AND. ibs.EQ.1)
GO TO 110
3283 asumr = asumr + coner
3293 CALL zsqrt(w2r, w2i, wr, wi)
3294 IF (wr.LT.0.0d0) wr = 0.0d0
3295 IF (wi.LT.0.0d0) wi = 0.0d0
3298 CALL zdiv(str, sti, zbr, zbi, zar, zai)
3299 CALL zlog(zar, zai, zcr, zci, idum)
3300 IF (zci.LT.0.0d0) zci = 0.0d0
3301 IF (zci.GT.hpi) zci = hpi
3302 IF (zcr.LT.0.0d0) zcr = 0.0d0
3303 zthr = (zcr-wr)*1.5d0
3304 zthi = (zci-wi)*1.5d0
3309 azth = zabs(zthr,zthi)
3311 IF (zthr.GE.0.0d0 .AND. zthi.LT.0.0d0)
GO TO 140
3313 IF (zthr.EQ.0.0d0)
GO TO 140
3314 ang = datan(zthi/zthr)
3315 IF (zthr.LT.0.0d0) ang = ang + gpi
3319 zetar = pp*dcos(ang)
3320 zetai = pp*dsin(ang)
3321 IF (zetai.LT.0.0d0) zetai = 0.0d0
3324 CALL zdiv(zthr, zthi, zetar, zetai, rtztr, rtzti)
3325 CALL zdiv(rtztr, rtzti, wr, wi, zar, zai)
3328 CALL zsqrt(tzar, tzai, str, sti)
3331 IF (ipmtr.EQ.1)
GO TO 120
3332 raw = 1.0d0/dsqrt(aw2)
3340 rzthr = str*razth*rfnu
3341 rzthi = sti*razth*rfnu
3349 str = t2r*c(2) + c(3)
3351 upr(2) = str*tfnr - sti*tfni
3352 upi(2) = str*tfni + sti*tfnr
3353 bsumr = upr(2) + zcr
3354 bsumi = upi(2) + zci
3357 IF (rfnu.LT.tol)
GO TO 220
3365 btol = tol*(dabs(bsumr)+dabs(bsumi))
3385 str = zar*t2r - t2i*zai + c(l)
3386 zai = zar*t2i + zai*t2r
3389 str = ptfnr*tfnr - ptfni*tfni
3390 ptfni = ptfnr*tfni + ptfni*tfnr
3392 upr(kp1) = ptfnr*zar - ptfni*zai
3393 upi(kp1) = ptfni*zar + ptfnr*zai
3394 crr(ks) = przthr*br(ks+1)
3395 cri(ks) = przthi*br(ks+1)
3396 str = przthr*rzthr - przthi*rzthi
3397 przthi = przthr*rzthi + przthi*rzthr
3399 drr(ks) = przthr*ar(ks+2)
3400 dri(ks) = przthi*ar(ks+2)
3403 IF (ias.EQ.1)
GO TO 180
3409 sumar = sumar + crr(jr)*upr(ju) - cri(jr)*upi(ju)
3410 sumai = sumai + crr(jr)*upi(ju) + cri(jr)*upr(ju)
3412 asumr = asumr + sumar
3413 asumi = asumi + sumai
3414 test = dabs(sumar) + dabs(sumai)
3415 IF (pp.LT.tol .AND. test.LT.tol) ias = 1
3417 IF (ibs.EQ.1)
GO TO 200
3418 sumbr = upr(lr+2) + upr(lrp1)*zcr - upi(lrp1)*zci
3419 sumbi = upi(lr+2) + upr(lrp1)*zci + upi(lrp1)*zcr
3423 sumbr = sumbr + drr(jr)*upr(ju) - dri(jr)*upi(ju)
3424 sumbi = sumbi + drr(jr)*upi(ju) + dri(jr)*upr(ju)
3426 bsumr = bsumr + sumbr
3427 bsumi = bsumi + sumbi
3428 test = dabs(sumbr) + dabs(sumbi)
3429 IF (pp.LT.btol .AND. test.LT.btol) ibs = 1
3431 IF (ias.EQ.1 .AND. ibs.EQ.1)
GO TO 220
3434 asumr = asumr + coner
3437 CALL zdiv(str, sti, rtztr, rtzti, bsumr, bsumi)
3441 SUBROUTINE zuchk(YR, YI, NZ, ASCLE, TOL)
3457 DOUBLE PRECISION ascle, ss, st, tol, wr, wi, yr, yi
3463 IF (st.GT.ascle)
RETURN 3466 IF (ss.LT.st) nz = 1
3470 SUBROUTINE zbinu(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL, TOL, ELIM, ALIM)
3479 DOUBLE PRECISION alim, az, cwi, cwr, cyi, cyr, dfnu, elim, fnu, &
3480 fnul, rl, tol, zeroi, zeror, zi, zr
3481 INTEGER i, inw, kode, n, nlast, nn, nui, nw, nz
3482 dimension cyr(1), cyi(1), cwr(2), cwi(2)
3483 DATA zeror,zeroi / 0.0d0, 0.0d0 /
3488 dfnu = fnu + dble(float(n-1))
3489 IF (az.LE.2.0d0)
GO TO 10
3490 IF (az*az*0.25d0.GT.dfnu+1.0d0)
GO TO 20
3495 CALL zseri(zr, zi, fnu, kode, nn, cyr, cyi, nw, tol, elim, alim)
3500 IF (nw.GE.0)
GO TO 120
3501 dfnu = fnu + dble(float(nn-1))
3503 IF (az.LT.rl)
GO TO 40
3504 IF (dfnu.LE.1.0d0)
GO TO 30
3505 IF (az+az.LT.dfnu*dfnu)
GO TO 50
3510 CALL zasyi(zr, zi, fnu, kode, nn, cyr, cyi, nw, rl, tol, elim, alim)
3511 IF (nw.LT.0)
GO TO 130
3514 IF (dfnu.LE.1.0d0)
GO TO 70
3519 CALL zuoik(zr, zi, fnu, kode, 1, nn, cyr, cyi, nw, tol, elim, alim)
3520 IF (nw.LT.0)
GO TO 130
3524 dfnu = fnu+dble(float(nn-1))
3525 IF (dfnu.GT.fnul)
GO TO 110
3526 IF (az.GT.fnul)
GO TO 110
3528 IF (az.GT.rl)
GO TO 80
3533 CALL zmlri(zr, zi, fnu, kode, nn, cyr, cyi, nw, tol)
3534 IF(nw.LT.0)
GO TO 130
3543 CALL zuoik(zr, zi, fnu, kode, 2, 2, cwr, cwi, nw, tol, elim, alim)
3544 IF (nw.GE.0)
GO TO 100
3552 IF (nw.GT.0)
GO TO 130
3553 CALL zwrsk(zr, zi, fnu, kode, nn, cyr, cyi, nw, cwr, cwi, tol, elim, alim)
3554 IF (nw.LT.0)
GO TO 130
3560 nui = int(sngl(fnul-dfnu)) + 1
3562 CALL zbuni(zr, zi, fnu, kode, nn, cyr, cyi, nw, nui, nlast, fnul, &
3564 IF (nw.LT.0)
GO TO 130
3566 IF (nlast.EQ.0)
GO TO 120
3573 IF(nw.EQ.(-2)) nz=-2
3577 SUBROUTINE zshch(ZR, ZI, CSHR, CSHI, CCHR, CCHI)
3587 DOUBLE PRECISION cchi, cchr, ch, cn, cshi, cshr, sh, sn, zi, zr, dcosh, dsinh
3599 DOUBLE PRECISION FUNCTION dgamln(Z,IERR)
3638 DOUBLE PRECISION cf, con, fln, fz, gln, rln, s, tlg, trm, tst, &
3639 t1, wdtol, z, zdmy, zinc, zm, zmin, zp, zsq
3640 INTEGER i, ierr, i1m, k, mz, nz
3641 dimension cf(22), gln(100)
3643 DATA gln(1), gln(2), gln(3), gln(4), gln(5), gln(6), gln(7), &
3644 gln(8), gln(9), gln(10), gln(11), gln(12), gln(13), gln(14), &
3645 gln(15), gln(16), gln(17), gln(18), gln(19), gln(20), &
3647 0.00000000000000000d+00, 0.00000000000000000d+00, &
3648 6.93147180559945309d-01, 1.79175946922805500d+00, &
3649 3.17805383034794562d+00, 4.78749174278204599d+00, &
3650 6.57925121201010100d+00, 8.52516136106541430d+00, &
3651 1.06046029027452502d+01, 1.28018274800814696d+01, &
3652 1.51044125730755153d+01, 1.75023078458738858d+01, &
3653 1.99872144956618861d+01, 2.25521638531234229d+01, &
3654 2.51912211827386815d+01, 2.78992713838408916d+01, &
3655 3.06718601060806728d+01, 3.35050734501368889d+01, &
3656 3.63954452080330536d+01, 3.93398841871994940d+01, &
3657 4.23356164607534850d+01, 4.53801388984769080d+01/
3658 DATA gln(23), gln(24), gln(25), gln(26), gln(27), gln(28), &
3659 gln(29), gln(30), gln(31), gln(32), gln(33), gln(34), &
3660 gln(35), gln(36), gln(37), gln(38), gln(39), gln(40), &
3661 gln(41), gln(42), gln(43), gln(44)/ &
3662 4.84711813518352239d+01, 5.16066755677643736d+01, &
3663 5.47847293981123192d+01, 5.80036052229805199d+01, &
3664 6.12617017610020020d+01, 6.45575386270063311d+01, &
3665 6.78897431371815350d+01, 7.12570389671680090d+01, &
3666 7.46582363488301644d+01, 7.80922235533153106d+01, &
3667 8.15579594561150372d+01, 8.50544670175815174d+01, &
3668 8.85808275421976788d+01, 9.21361756036870925d+01, &
3669 9.57196945421432025d+01, 9.93306124547874269d+01, &
3670 1.02968198614513813d+02, 1.06631760260643459d+02, &
3671 1.10320639714757395d+02, 1.14034211781461703d+02, &
3672 1.17771881399745072d+02, 1.21533081515438634d+02/
3673 DATA gln(45), gln(46), gln(47), gln(48), gln(49), gln(50), &
3674 gln(51), gln(52), gln(53), gln(54), gln(55), gln(56), &
3675 gln(57), gln(58), gln(59), gln(60), gln(61), gln(62), &
3676 gln(63), gln(64), gln(65), gln(66)/ &
3677 1.25317271149356895d+02, 1.29123933639127215d+02, &
3678 1.32952575035616310d+02, 1.36802722637326368d+02, &
3679 1.40673923648234259d+02, 1.44565743946344886d+02, &
3680 1.48477766951773032d+02, 1.52409592584497358d+02, &
3681 1.56360836303078785d+02, 1.60331128216630907d+02, &
3682 1.64320112263195181d+02, 1.68327445448427652d+02, &
3683 1.72352797139162802d+02, 1.76395848406997352d+02, &
3684 1.80456291417543771d+02, 1.84533828861449491d+02, &
3685 1.88628173423671591d+02, 1.92739047287844902d+02, &
3686 1.96866181672889994d+02, 2.01009316399281527d+02, &
3687 2.05168199482641199d+02, 2.09342586752536836d+02/
3688 DATA gln(67), gln(68), gln(69), gln(70), gln(71), gln(72), &
3689 gln(73), gln(74), gln(75), gln(76), gln(77), gln(78), &
3690 gln(79), gln(80), gln(81), gln(82), gln(83), gln(84), &
3691 gln(85), gln(86), gln(87), gln(88)/ &
3692 2.13532241494563261d+02, 2.17736934113954227d+02, &
3693 2.21956441819130334d+02, 2.26190548323727593d+02, &
3694 2.30439043565776952d+02, 2.34701723442818268d+02, &
3695 2.38978389561834323d+02, 2.43268849002982714d+02, &
3696 2.47572914096186884d+02, 2.51890402209723194d+02, &
3697 2.56221135550009525d+02, 2.60564940971863209d+02, &
3698 2.64921649798552801d+02, 2.69291097651019823d+02, &
3699 2.73673124285693704d+02, 2.78067573440366143d+02, &
3700 2.82474292687630396d+02, 2.86893133295426994d+02, &
3701 2.91323950094270308d+02, 2.95766601350760624d+02, &
3702 3.00220948647014132d+02, 3.04686856765668715d+02/
3703 DATA gln(89), gln(90), gln(91), gln(92), gln(93), gln(94), &
3704 gln(95), gln(96), gln(97), gln(98), gln(99), gln(100)/ &
3705 3.09164193580146922d+02, 3.13652829949879062d+02, &
3706 3.18152639620209327d+02, 3.22663499126726177d+02, &
3707 3.27185287703775217d+02, 3.31717887196928473d+02, &
3708 3.36261181979198477d+02, 3.40815058870799018d+02, &
3709 3.45379407062266854d+02, 3.49954118040770237d+02, &
3710 3.54539085519440809d+02, 3.59134205369575399d+02/
3712 DATA cf(1), cf(2), cf(3), cf(4), cf(5), cf(6), cf(7), cf(8), &
3713 cf(9), cf(10), cf(11), cf(12), cf(13), cf(14), cf(15), &
3714 cf(16), cf(17), cf(18), cf(19), cf(20), cf(21), cf(22)/ &
3715 8.33333333333333333d-02, -2.77777777777777778d-03, &
3716 7.93650793650793651d-04, -5.95238095238095238d-04, &
3717 8.41750841750841751d-04, -1.91752691752691753d-03, &
3718 6.41025641025641026d-03, -2.95506535947712418d-02, &
3719 1.79644372368830573d-01, -1.39243221690590112d+00, &
3720 1.34028640441683920d+01, -1.56848284626002017d+02, &
3721 2.19310333333333333d+03, -3.61087712537249894d+04, &
3722 6.91472268851313067d+05, -1.52382215394074162d+07, &
3723 3.82900751391414141d+08, -1.08822660357843911d+10, &
3724 3.47320283765002252d+11, -1.23696021422692745d+13, &
3725 4.88788064793079335d+14, -2.13203339609193739d+16/
3728 DATA con / 1.83787706640934548d+00/
3732 IF (z.LE.0.0d0)
GO TO 70
3733 IF (z.GT.101.0d0)
GO TO 10
3736 IF (fz.GT.0.0d0)
GO TO 10
3737 IF (nz.GT.100)
GO TO 10
3742 wdtol = dmax1(wdtol,0.5d-18)
3744 rln = d1mach(5)*float(i1m)
3745 fln = dmin1(rln,20.0d0)
3746 fln = dmax1(fln,3.0d0)
3748 zm = 1.8000d0 + 0.3875d0*fln
3749 mz = int(sngl(zm)) + 1
3753 IF (z.GE.zmin)
GO TO 20
3754 zinc = zmin - float(nz)
3760 IF (zp.LT.wdtol)
GO TO 40
3766 IF (dabs(trm).LT.tst)
GO TO 40
3770 IF (zinc.NE.0.0d0)
GO TO 50
3772 dgamln = z*(tlg-1.0d0) + 0.5d0*(con-tlg) + s
3776 nz = int(sngl(zinc))
3778 zp = zp*(z+float(i-1))
3781 dgamln = zdmy*(tlg-1.0d0) - dlog(zp) + 0.5d0*(con-tlg) + s
3789 SUBROUTINE zkscl(ZRR,ZRI,FNU,N,YR,YI,NZ,RZR,RZI,ASCLE,TOL,ELIM)
3801 DOUBLE PRECISION acs, as, ascle, cki, ckr, csi, csr, cyi, &
3802 cyr, elim, fn, fnu, rzi, rzr, str, s1i, s1r, s2i, s2r, &
3803 tol, yi, yr, zeroi, zeror, zri, zrr, zdr, zdi, celmr, &
3805 INTEGER i, ic, idum, kk, n, nn, nw, nz
3806 dimension yr(1), yi(1), cyr(2), cyi(2)
3807 DATA zeror,zeroi / 0.0d0 , 0.0d0 /
3818 acs = -zrr + dlog(as)
3822 IF (acs.LT.(-elim))
GO TO 10
3823 CALL zlog(s1r, s1i, csr, csi, idum)
3829 CALL zuchk(csr, csi, nw, ascle, tol)
3830 IF (nw.NE.0)
GO TO 10
3837 IF (ic.GT.1)
GO TO 20
3864 s2r = ckr*csr - cki*csi + s1r
3865 s2i = cki*csr + ckr*csi + s1i
3876 IF (acs.LT.(-elim))
GO TO 25
3877 CALL zlog(s2r, s2i, csr, csi, idum)
3883 CALL zuchk(csr, csi, nw, ascle, tol)
3884 IF (nw.NE.0)
GO TO 25
3888 IF (ic.EQ.kk-1)
GO TO 40
3892 IF(alas.LT.helim)
GO TO 30
3912 SUBROUTINE zacai(ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, TOL, ELIM, ALIM)
3932 DOUBLE PRECISION alim, arg, ascle, az, csgnr, csgni, cspnr, &
3933 cspni, c1r, c1i, c2r, c2i, cyr, cyi, dfnu, elim, fmr, fnu, pi, &
3934 rl,
sgn, tol, yy, yr, yi, zr, zi, znr, zni
3935 INTEGER inu, iuf, kode, mr, n, nn, nw, nz
3936 dimension yr(1), yi(1), cyr(2), cyi(2)
3937 DATA pi / 3.14159265358979324d0 /
3943 dfnu = fnu + dble(float(n-1))
3944 IF (az.LE.2.0d0)
GO TO 10
3945 IF (az*az*0.25d0.GT.dfnu+1.0d0)
GO TO 20
3950 CALL zseri(znr, zni, fnu, kode, nn, yr, yi, nw, tol, elim, alim)
3953 IF (az.LT.rl)
GO TO 30
3957 CALL zasyi(znr, zni, fnu, kode, nn, yr, yi, nw, rl, tol, elim, alim)
3958 IF (nw.LT.0)
GO TO 80
3964 CALL zmlri(znr, zni, fnu, kode, nn, yr, yi, nw, tol)
3965 IF(nw.LT.0)
GO TO 80
3970 CALL zbknu(znr, zni, fnu, kode, 1, cyr, cyi, nw, tol, elim, alim)
3971 IF (nw.NE.0)
GO TO 80
3972 fmr = dble(float(mr))
3973 sgn = -dsign(pi,fmr)
3976 IF (kode.EQ.1)
GO TO 50
3978 csgnr = -csgni*dsin(yy)
3979 csgni = csgni*dcos(yy)
3985 inu = int(sngl(fnu))
3986 arg = (fnu-dble(float(inu)))*
sgn 3989 IF (mod(inu,2).EQ.0)
GO TO 60
3997 IF (kode.EQ.1)
GO TO 70
3999 ascle = 1.0d+3*d1mach(1)/tol
4000 CALL zs1s2(znr, zni, c1r, c1i, c2r, c2i, nw, ascle, alim, iuf)
4003 yr(1) = cspnr*c1r - cspni*c1i + csgnr*c2r - csgni*c2i
4004 yi(1) = cspnr*c1i + cspni*c1r + csgnr*c2i + csgni*c2r
4008 IF(nw.EQ.(-2)) nz=-2
4012 SUBROUTINE zs1s2(ZRR, ZRI, S1R, S1I, S2R, S2I, NZ, ASCLE, ALIM, IUF)
4028 DOUBLE PRECISION aa, alim, aln, ascle, as1, as2, c1i, c1r, s1di, &
4029 s1dr, s1i, s1r, s2i, s2r, zeroi, zeror, zri, zrr
4030 INTEGER iuf, idum, nz
4031 DATA zeror,zeroi / 0.0d0 , 0.0d0 /
4035 IF (s1r.EQ.0.0d0 .AND. s1i.EQ.0.0d0)
GO TO 10
4036 IF (as1.EQ.0.0d0)
GO TO 10
4037 aln = -zrr - zrr + dlog(as1)
4043 IF (aln.LT.(-alim))
GO TO 10
4044 CALL zlog(s1dr, s1di, c1r, c1i, idum)
4045 c1r = c1r - zrr - zrr
4046 c1i = c1i - zri - zri
4047 CALL zexp(c1r, c1i, s1r, s1i)
4052 IF (aa.GT.ascle)
RETURN 4062 SUBROUTINE zrati(ZR, ZI, FNU, N, CYR, CYI, TOL)
4077 DOUBLE PRECISION ak, amagz, ap1, ap2, arg, az, cdfnui, cdfnur, &
4078 conei, coner, cyi, cyr, czeroi, czeror, dfnu, fdnu, flam, fnu, &
4079 fnup, pti, ptr, p1i, p1r, p2i, p2r, rak, rap1, rho, rt2, rzi, &
4080 rzr, test, test1, tol, tti, ttr, t1i, t1r, zi, zr
4081 INTEGER i, id, idnu, inu, itime, k, kk, magz, n
4082 dimension cyr(1), cyi(1)
4083 DATA czeror,czeroi,coner,conei,rt2 &
4084 /0.0d0, 0.0d0, 1.0d0, 0.0d0, 1.41421356237309505d0/
4086 inu = int(sngl(fnu))
4088 magz = int(sngl(az))
4089 amagz = dble(float(magz+1))
4090 fdnu = dble(float(idnu))
4091 fnup = dmax1(amagz,fdnu)
4092 id = idnu - magz - 1
4096 rzr = ptr*(zr+zr)*ptr
4097 rzi = -ptr*(zi+zi)*ptr
4115 arg = (ap2+ap2)/(ap1*tol)
4129 p2r = p1r - (t1r*ptr-t1i*pti)
4130 p2i = p1i - (t1r*pti+t1i*ptr)
4136 IF (ap1.LE.test)
GO TO 10
4137 IF (itime.EQ.2)
GO TO 20
4138 ak = zabs(t1r,t1i)*0.5d0
4139 flam = ak + dsqrt(ak*ak-1.0d0)
4140 rho = dmin1(ap2/ap1,flam)
4141 test = test1*dsqrt(rho/(rho*rho-1.0d0))
4146 ak = dble(float(kk))
4149 dfnu = fnu + dble(float(n-1))
4160 p1r = (ptr*ttr-pti*tti) + p2r
4161 p1i = (ptr*tti+pti*ttr) + p2i
4166 IF (p1r.NE.czeror .OR. p1i.NE.czeroi)
GO TO 40
4170 CALL zdiv(p2r, p2i, p1r, p1i, cyr(n), cyi(n))
4179 ptr = cdfnur + (t1r*rzr-t1i*rzi) + cyr(k+1)
4180 pti = cdfnui + (t1r*rzi+t1i*rzr) + cyi(k+1)
4182 IF (ak.NE.czeror)
GO TO 50
4188 cyr(k) = rak*ptr*rak
4189 cyi(k) = -rak*pti*rak
4196 SUBROUTINE zairy(ZR, ZI, ID, KODE, AIR, AII, NZ, IERR)
4327 DOUBLE PRECISION aa, ad, aii, air, ak, alim, atrm, az, az3, bk, &
4328 cc, ck, coef, conei, coner, csqi, csqr, cyi, cyr, c1, c2, dig, &
4329 dk, d1, d2, elim, fid, fnu, ptr, rl, r1m5, sfac, sti, str, &
4330 s1i, s1r, s2i, s2r, tol, trm1i, trm1r, trm2i, trm2r, tth, zeroi, &
4331 zeror, zi, zr, ztai, ztar, z3i, z3r, alaz, bb
4332 INTEGER id, ierr, iflag, k, kode, k1, k2, mr, nn, nz
4333 dimension cyr(1), cyi(1)
4334 DATA tth, c1, c2, coef /6.66666666666666667d-01, &
4335 3.55028053887817240d-01,2.58819403792806799d-01, &
4336 1.83776298473930683d-01/
4337 DATA zeror, zeroi, coner, conei /0.0d0,0.0d0,1.0d0,0.0d0/
4341 IF (id.LT.0 .OR. id.GT.1) ierr=1
4342 IF (kode.LT.1 .OR. kode.GT.2) ierr=1
4343 IF (ierr.NE.0)
RETURN 4345 tol = dmax1(d1mach(4),1.0d-18)
4346 fid = dble(float(id))
4347 IF (az.GT.1.0d0)
GO TO 70
4355 IF (az.LT.tol)
GO TO 170
4357 IF (aa.LT.tol/az)
GO TO 40
4365 z3r = str*zr - sti*zi
4366 z3i = str*zi + sti*zr
4369 bk = 3.0d0 - fid - fid
4371 dk = 3.0d0 + fid + fid
4375 ak = 24.0d0 + 9.0d0*fid
4376 bk = 30.0d0 - 9.0d0*fid
4378 str = (trm1r*z3r-trm1i*z3i)/d1
4379 trm1i = (trm1r*z3i+trm1i*z3r)/d1
4383 str = (trm2r*z3r-trm2i*z3i)/d2
4384 trm2i = (trm2r*z3i+trm2i*z3r)/d2
4392 IF (atrm.LT.tol*ad)
GO TO 40
4397 IF (id.EQ.1)
GO TO 50
4398 air = s1r*c1 - c2*(zr*s2r-zi*s2i)
4399 aii = s1i*c1 - c2*(zr*s2i+zi*s2r)
4400 IF (kode.EQ.1)
RETURN 4401 CALL zsqrt(zr, zi, str, sti)
4402 ztar = tth*(zr*str-zi*sti)
4403 ztai = tth*(zr*sti+zi*str)
4404 CALL zexp(ztar, ztai, str, sti)
4405 ptr = air*str - aii*sti
4406 aii = air*sti + aii*str
4412 IF (az.LE.tol)
GO TO 60
4413 str = zr*s1r - zi*s1i
4414 sti = zr*s1i + zi*s1r
4416 air = air + cc*(str*zr-sti*zi)
4417 aii = aii + cc*(str*zi+sti*zr)
4419 IF (kode.EQ.1)
RETURN 4420 CALL zsqrt(zr, zi, str, sti)
4421 ztar = tth*(zr*str-zi*sti)
4422 ztai = tth*(zr*sti+zi*str)
4423 CALL zexp(ztar, ztai, str, sti)
4424 ptr = str*air - sti*aii
4425 aii = str*aii + sti*air
4432 fnu = (1.0d0+fid)/3.0d0
4446 k = min0(iabs(k1),iabs(k2))
4447 elim = 2.303d0*(dble(float(k))*r1m5-3.0d0)
4449 aa = r1m5*dble(float(k1))
4450 dig = dmin1(aa,18.0d0)
4452 alim = elim + dmax1(-aa,-41.45d0)
4453 rl = 1.2d0*dig + 3.0d0
4459 bb=dble(float(i1mach(9)))*0.5d0
4462 IF (az.GT.aa)
GO TO 260
4464 IF (az.GT.aa) ierr=3
4465 CALL zsqrt(zr, zi, csqr, csqi)
4466 ztar = tth*(zr*csqr-zi*csqi)
4467 ztai = tth*(zr*csqi+zi*csqr)
4474 IF (zr.GE.0.0d0)
GO TO 80
4480 IF (zi.NE.0.0d0)
GO TO 90
4481 IF (zr.GT.0.0d0)
GO TO 90
4486 IF (aa.GE.0.0d0 .AND. zr.GT.0.0d0)
GO TO 110
4487 IF (kode.EQ.2)
GO TO 100
4491 IF (aa.GT.(-alim))
GO TO 100
4492 aa = -aa + 0.25d0*alaz
4495 IF (aa.GT.elim)
GO TO 270
4501 IF (zi.LT.0.0d0) mr = -1
4502 CALL zacai(ztar, ztai, fnu, kode, mr, 1, cyr, cyi, nn, rl, tol, &
4504 IF (nn.LT.0)
GO TO 280
4508 IF (kode.EQ.2)
GO TO 120
4512 IF (aa.LT.alim)
GO TO 120
4513 aa = -aa - 0.25d0*alaz
4516 IF (aa.LT.(-elim))
GO TO 210
4518 CALL zbknu(ztar, ztai, fnu, kode, 1, cyr, cyi, nz, tol, elim, alim)
4522 IF (iflag.NE.0)
GO TO 150
4523 IF (id.EQ.1)
GO TO 140
4524 air = csqr*s1r - csqi*s1i
4525 aii = csqr*s1i + csqi*s1r
4528 air = -(zr*s1r-zi*s1i)
4529 aii = -(zr*s1i+zi*s1r)
4534 IF (id.EQ.1)
GO TO 160
4535 str = s1r*csqr - s1i*csqi
4536 s1i = s1r*csqi + s1i*csqr
4542 str = -(s1r*zr-s1i*zi)
4543 s1i = -(s1r*zi+s1i*zr)
4549 aa = 1.0d+3*d1mach(1)
4552 IF (id.EQ.1)
GO TO 190
4553 IF (az.LE.aa)
GO TO 180
4564 IF (az.LE.aa)
GO TO 200
4565 s1r = 0.5d0*(zr*zr-zi*zi)
4581 IF(nn.EQ.(-1))
GO TO 270
4591 SUBROUTINE zseri(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL, ELIM, ALIM)
4608 DOUBLE PRECISION aa, acz, ak, ak1i, ak1r, alim, arm, ascle, atol, &
4609 az, cki, ckr, coefi, coefr, conei, coner, crscr, czi, czr, dfnu, &
4610 elim, fnu, fnup, hzi, hzr, raz, rs, rtr1, rzi, rzr, s, ss, sti, &
4611 str, s1i, s1r, s2i, s2r, tol, yi, yr, wi, wr, zeroi, zeror, zi, &
4613 INTEGER i, ib, idum, iflag, il, k, kode, l, m, n, nn, nz, nw
4614 dimension yr(1), yi(1), wr(2), wi(2)
4615 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
4619 IF (az.EQ.0.0d0)
GO TO 160
4620 arm = 1.0d+3*d1mach(1)
4624 IF (az.LT.arm)
GO TO 150
4629 IF (az.LE.rtr1)
GO TO 10
4630 CALL zmlt(hzr, hzi, hzr, hzi, czr, czi)
4634 CALL zlog(hzr, hzi, ckr, cki, idum)
4636 dfnu = fnu + dble(float(nn-1))
4643 ak = dgamln(fnup,idum)
4645 IF (kode.EQ.2) ak1r = ak1r - zr
4646 IF (ak1r.GT.(-elim))
GO TO 40
4651 IF (acz.GT.dfnu)
GO TO 190
4656 IF (ak1r.GT.(-alim))
GO TO 50
4663 IF (iflag.EQ.1) aa = aa*ss
4664 coefr = aa*dcos(ak1i)
4665 coefi = aa*dsin(ak1i)
4669 dfnu = fnu + dble(float(nn-i))
4673 IF (acz.LT.tol*fnup)
GO TO 70
4681 str = ak1r*czr - ak1i*czi
4682 sti = ak1r*czi + ak1i*czr
4690 IF (aa.GT.atol)
GO TO 60
4692 s2r = s1r*coefr - s1i*coefi
4693 s2i = s1r*coefi + s1i*coefr
4696 IF (iflag.EQ.0)
GO TO 80
4697 CALL zuchk(s2r, s2i, nw, ascle, tol)
4698 IF (nw.NE.0)
GO TO 30
4703 IF (i.EQ.il)
GO TO 90
4704 CALL zdiv(coefr, coefi, hzr, hzi, str, sti)
4716 IF (iflag.EQ.1)
GO TO 120
4720 yr(k) = (ak+fnu)*(rzr*yr(k+1)-rzi*yi(k+1)) + yr(k+2)
4721 yi(k) = (ak+fnu)*(rzr*yi(k+1)+rzi*yr(k+1)) + yi(k+2)
4741 s2r = s1r + (ak+fnu)*(rzr*ckr-rzi*cki)
4742 s2i = s1i + (ak+fnu)*(rzr*cki+rzi*ckr)
4751 IF (zabs(ckr,cki).GT.ascle)
GO TO 140
4756 IF (ib.GT.nn)
RETURN 4760 IF (fnu.EQ.0.0d0) nz = nz - 1
4764 IF (fnu.NE.0.0d0)
GO TO 170
4783 SUBROUTINE zasyi(ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM)
4797 DOUBLE PRECISION aa, aez, ak, ak1i, ak1r, alim, arg, arm, atol, &
4798 az, bb, bk, cki, ckr, conei, coner, cs1i, cs1r, cs2i, cs2r, czi, &
4799 czr, dfnu, dki, dkr, dnu2, elim, ezi, ezr, fdn, fnu, pi, p1i, &
4800 p1r, raz, rl, rtpi, rtr1, rzi, rzr, s,
sgn, sqk, sti, str, s2i, &
4801 s2r, tol, tzi, tzr, yi, yr, zeroi, zeror, zi, zr
4802 INTEGER i, ib, il, inu, j, jl, k, kode, koded, m, n, nn, nz
4803 dimension yr(1), yi(1)
4804 DATA pi, rtpi /3.14159265358979324d0 , 0.159154943091895336d0 /
4805 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
4809 arm = 1.0d+3*d1mach(1)
4812 dfnu = fnu + dble(float(n-il))
4821 CALL zsqrt(ak1r, ak1i, ak1r, ak1i)
4824 IF (kode.NE.2)
GO TO 10
4828 IF (dabs(czr).GT.elim)
GO TO 100
4831 IF ((dabs(czr).GT.alim) .AND. (n.GT.2))
GO TO 20
4833 CALL zexp(czr, czi, str, sti)
4834 CALL zmlt(ak1r, ak1i, str, sti, ak1r, ak1i)
4837 IF (dnu2.GT.rtr1) fdn = dnu2*dnu2
4847 jl = int(sngl(rl+rl)) + 2
4850 IF (zi.EQ.0.0d0)
GO TO 30
4855 inu = int(sngl(fnu))
4856 arg = (fnu-dble(float(inu)))*pi
4860 IF (zi.LT.0.0d0) bk = -bk
4863 IF (mod(inu,2).EQ.0)
GO TO 30
4883 CALL zdiv(ckr, cki, dkr, dki, str, sti)
4889 cs1r = cs1r + ckr*
sgn 4890 cs1i = cs1i + cki*
sgn 4893 aa = aa*dabs(sqk)/bb
4897 IF (aa.LE.atol)
GO TO 50
4903 IF (zr+zr.GE.elim)
GO TO 60
4906 CALL zexp(-tzr, -tzi, str, sti)
4907 CALL zmlt(str, sti, p1r, p1i, str, sti)
4908 CALL zmlt(str, sti, cs2r, cs2i, str, sti)
4912 fdn = fdn + 8.0d0*dfnu + 4.0d0
4916 yr(m) = s2r*ak1r - s2i*ak1i
4917 yi(m) = s2r*ak1i + s2i*ak1r
4929 yr(k) = (ak+fnu)*(rzr*yr(k+1)-rzi*yi(k+1)) + yr(k+2)
4930 yi(k) = (ak+fnu)*(rzr*yi(k+1)+rzi*yr(k+1)) + yi(k+2)
4934 IF (koded.EQ.0)
RETURN 4935 CALL zexp(czr, czi, ckr, cki)
4937 str = yr(i)*ckr - yi(i)*cki
4938 yi(i) = yr(i)*cki + yi(i)*ckr
4950 SUBROUTINE zbuni(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NUI, NLAST, FNUL, TOL, ELIM, ALIM)
4965 DOUBLE PRECISION alim, ax, ay, csclr, cscrr, cyi, cyr, dfnu, &
4966 elim, fnu, fnui, fnul, gnu, raz, rzi, rzr, sti, str, s1i, s1r, &
4967 s2i, s2r, tol, yi, yr, zi, zr, ascle, bry, c1r, c1i, c1m
4968 INTEGER i, iflag, iform, k, kode, n, nl, nlast, nui, nw, nz
4969 dimension yr(1), yi(1), cyr(2), cyi(2), bry(3)
4971 ax = dabs(zr)*1.7321d0
4974 IF (ay.GT.ax) iform = 2
4975 IF (nui.EQ.0)
GO TO 60
4976 fnui = dble(float(nui))
4977 dfnu = fnu + dble(float(n-1))
4979 IF (iform.EQ.2)
GO TO 10
4984 CALL zuni1(zr, zi, gnu, kode, 2, cyr, cyi, nw, nlast, fnul, tol, elim, alim)
4992 CALL zuni2(zr, zi, gnu, kode, 2, cyr, cyi, nw, nlast, fnul, tol, elim, alim)
4994 IF (nw.LT.0)
GO TO 50
4995 IF (nw.NE.0)
GO TO 90
4996 str = zabs(cyr(1),cyi(1))
5000 bry(1)=1.0d+3*d1mach(1)/tol
5001 bry(2) = 1.0d0/bry(1)
5006 IF (str.GT.bry(1))
GO TO 21
5012 IF (str.LT.bry(2))
GO TO 25
5022 raz = 1.0d0/zabs(zr,zi)
5030 s2r = (dfnu+fnui)*(rzr*str-rzi*sti) + s1r
5031 s2i = (dfnu+fnui)*(rzr*sti+rzi*str) + s1i
5035 IF (iflag.GE.3)
GO TO 30
5040 c1m = dmax1(c1r,c1i)
5041 IF (c1m.LE.ascle)
GO TO 30
5059 fnui = dble(float(nl))
5064 s2r = (fnu+fnui)*(rzr*str-rzi*sti) + s1r
5065 s2i = (fnu+fnui)*(rzr*sti+rzi*str) + s1i
5074 IF (iflag.GE.3)
GO TO 40
5077 c1m = dmax1(c1r,c1i)
5078 IF (c1m.LE.ascle)
GO TO 40
5095 IF(nw.EQ.(-2)) nz=-2
5098 IF (iform.EQ.2)
GO TO 70
5103 CALL zuni1(zr, zi, fnu, kode, n, yr, yi, nw, nlast, fnul, tol, elim, alim)
5111 CALL zuni2(zr, zi, fnu, kode, n, yr, yi, nw, nlast, fnul, tol, elim, alim)
5113 IF (nw.LT.0)
GO TO 50
5121 SUBROUTINE zuni1(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL, TOL, ELIM, ALIM)
5140 DOUBLE PRECISION alim, aphi, ascle, bry, conei, coner, crsc, &
5141 cscl, csrr, cssr, cwrki, cwrkr, c1r, c2i, c2m, c2r, elim, fn, &
5142 fnu, fnul, phii, phir, rast, rs1, rzi, rzr, sti, str, sumi, &
5143 sumr, s1i, s1r, s2i, s2r, tol, yi, yr, zeroi, zeror, zeta1i, &
5144 zeta1r, zeta2i, zeta2r, zi, zr, cyr, cyi
5145 INTEGER i, iflag, init, k, kode, m, n, nd, nlast, nn, nuf, nw, nz
5146 dimension bry(3), yr(1), yi(1), cwrkr(16), cwrki(16), cssr(3), &
5147 csrr(3), cyr(2), cyi(2)
5148 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
5166 bry(1) = 1.0d+3*d1mach(1)/tol
5170 fn = dmax1(fnu,1.0d0)
5172 CALL zunik(zr, zi, fn, 1, 1, tol, init, phir, phii, zeta1r, &
5173 zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
5174 IF (kode.EQ.1)
GO TO 10
5177 rast = fn/zabs(str,sti)
5179 sti = -sti*rast*rast
5184 s1r = -zeta1r + zeta2r
5185 s1i = -zeta1i + zeta2i
5188 IF (dabs(rs1).GT.elim)
GO TO 130
5192 fn = fnu + dble(float(nd-i))
5194 CALL zunik(zr, zi, fn, 1, 0, tol, init, phir, phii, zeta1r, &
5195 zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
5196 IF (kode.EQ.1)
GO TO 40
5199 rast = fn/zabs(str,sti)
5201 sti = -sti*rast*rast
5203 s1i = -zeta1i + sti + zi
5206 s1r = -zeta1r + zeta2r
5207 s1i = -zeta1i + zeta2i
5213 IF (dabs(rs1).GT.elim)
GO TO 110
5214 IF (i.EQ.1) iflag = 2
5215 IF (dabs(rs1).LT.alim)
GO TO 60
5219 aphi = zabs(phir,phii)
5220 rs1 = rs1 + dlog(aphi)
5221 IF (dabs(rs1).GT.elim)
GO TO 110
5222 IF (i.EQ.1) iflag = 1
5223 IF (rs1.LT.0.0d0)
GO TO 60
5224 IF (i.EQ.1) iflag = 3
5229 s2r = phir*sumr - phii*sumi
5230 s2i = phir*sumi + phii*sumr
5231 str = dexp(s1r)*cssr(iflag)
5234 str = s2r*s1r - s2i*s1i
5235 s2i = s2r*s1i + s2i*s1r
5237 IF (iflag.NE.1)
GO TO 70
5238 CALL zuchk(s2r, s2i, nw, bry(1), tol)
5239 IF (nw.NE.0)
GO TO 110
5244 yr(m) = s2r*csrr(iflag)
5245 yi(m) = s2i*csrr(iflag)
5247 IF (nd.LE.2)
GO TO 100
5248 rast = 1.0d0/zabs(zr,zi)
5251 rzr = (str+str)*rast
5252 rzi = (sti+sti)*rast
5253 bry(2) = 1.0d0/bry(1)
5266 s2r = s1r + (fnu+fn)*(rzr*c2r-rzi*c2i)
5267 s2i = s1i + (fnu+fn)*(rzr*c2i+rzi*c2r)
5276 IF (iflag.GE.3)
GO TO 90
5279 c2m = dmax1(str,sti)
5280 IF (c2m.LE.ascle)
GO TO 90
5287 s1r = s1r*cssr(iflag)
5288 s1i = s1i*cssr(iflag)
5289 s2r = s2r*cssr(iflag)
5290 s2i = s2i*cssr(iflag)
5299 IF (rs1.GT.0.0d0)
GO TO 120
5304 IF (nd.EQ.0)
GO TO 100
5305 CALL zuoik(zr, zi, fnu, kode, 1, nd, yr, yi, nuf, tol, elim, alim)
5306 IF (nuf.LT.0)
GO TO 120
5309 IF (nd.EQ.0)
GO TO 100
5310 fn = fnu + dble(float(nd-1))
5311 IF (fn.GE.fnul)
GO TO 30
5318 IF (rs1.GT.0.0d0)
GO TO 120
5327 SUBROUTINE zuni2(ZR, ZI, FNU, KODE, N, YR, YI, NZ, NLAST, FNUL, TOL, ELIM, ALIM)
5347 DOUBLE PRECISION aarg, aic, aii, air, alim, ang, aphi, argi, &
5348 argr, ascle, asumi, asumr, bry, bsumi, bsumr, cidi, cipi, cipr, &
5349 conei, coner, crsc, cscl, csrr, cssr, c1r, c2i, c2m, c2r, daii, &
5350 dair, elim, fn, fnu, fnul, hpi, phii, phir, rast, raz, rs1, rzi, &
5351 rzr, sti, str, s1i, s1r, s2i, s2r, tol, yi, yr, zbi, zbr, zeroi, &
5352 zeror, zeta1i, zeta1r, zeta2i, zeta2r, zi, zni, znr, zr, cyr, cyi
5353 INTEGER i, iflag, in, inu, j, k, kode, n, nai, nd, ndai, nlast, &
5354 nn, nuf, nw, nz, idum
5355 dimension bry(3), yr(1), yi(1), cipr(4), cipi(4), cssr(3), &
5356 csrr(3), cyr(2), cyi(2)
5357 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
5358 DATA cipr(1),cipi(1),cipr(2),cipi(2),cipr(3),cipi(3),cipr(4), &
5359 cipi(4)/ 1.0d0,0.0d0, 0.0d0,1.0d0, -1.0d0,0.0d0, 0.0d0,-1.0d0/
5360 DATA hpi, aic /1.57079632679489662d+00, 1.265512123484645396d+00/
5378 bry(1) = 1.0d+3*d1mach(1)/tol
5387 inu = int(sngl(fnu))
5388 ang = hpi*(fnu-dble(float(inu)))
5393 str = c2r*cipr(in) - c2i*cipi(in)
5394 c2i = c2r*cipi(in) + c2i*cipr(in)
5396 IF (zi.GT.0.0d0)
GO TO 10
5405 fn = dmax1(fnu,1.0d0)
5406 CALL zunhj(znr, zni, fn, 1, tol, phir, phii, argr, argi, zeta1r, &
5407 zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
5408 IF (kode.EQ.1)
GO TO 20
5411 rast = fn/zabs(str,sti)
5413 sti = -sti*rast*rast
5418 s1r = -zeta1r + zeta2r
5419 s1i = -zeta1i + zeta2i
5422 IF (dabs(rs1).GT.elim)
GO TO 150
5426 fn = fnu + dble(float(nd-i))
5427 CALL zunhj(znr, zni, fn, 0, tol, phir, phii, argr, argi, &
5428 zeta1r, zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
5429 IF (kode.EQ.1)
GO TO 50
5432 rast = fn/zabs(str,sti)
5434 sti = -sti*rast*rast
5436 s1i = -zeta1i + sti + dabs(zi)
5439 s1r = -zeta1r + zeta2r
5440 s1i = -zeta1i + zeta2i
5446 IF (dabs(rs1).GT.elim)
GO TO 120
5447 IF (i.EQ.1) iflag = 2
5448 IF (dabs(rs1).LT.alim)
GO TO 70
5452 aphi = zabs(phir,phii)
5453 aarg = zabs(argr,argi)
5454 rs1 = rs1 + dlog(aphi) - 0.25d0*dlog(aarg) - aic
5455 IF (dabs(rs1).GT.elim)
GO TO 120
5456 IF (i.EQ.1) iflag = 1
5457 IF (rs1.LT.0.0d0)
GO TO 70
5458 IF (i.EQ.1) iflag = 3
5464 CALL zairy(argr, argi, 0, 2, air, aii, nai, idum)
5465 CALL zairy(argr, argi, 1, 2, dair, daii, ndai, idum)
5466 str = dair*bsumr - daii*bsumi
5467 sti = dair*bsumi + daii*bsumr
5468 str = str + (air*asumr-aii*asumi)
5469 sti = sti + (air*asumi+aii*asumr)
5470 s2r = phir*str - phii*sti
5471 s2i = phir*sti + phii*str
5472 str = dexp(s1r)*cssr(iflag)
5475 str = s2r*s1r - s2i*s1i
5476 s2i = s2r*s1i + s2i*s1r
5478 IF (iflag.NE.1)
GO TO 80
5479 CALL zuchk(s2r, s2i, nw, bry(1), tol)
5480 IF (nw.NE.0)
GO TO 120
5482 IF (zi.LE.0.0d0) s2i = -s2i
5483 str = s2r*c2r - s2i*c2i
5484 s2i = s2r*c2i + s2i*c2r
5489 yr(j) = s2r*csrr(iflag)
5490 yi(j) = s2i*csrr(iflag)
5495 IF (nd.LE.2)
GO TO 110
5496 raz = 1.0d0/zabs(zr,zi)
5501 bry(2) = 1.0d0/bry(1)
5514 s2r = s1r + (fnu+fn)*(rzr*c2r-rzi*c2i)
5515 s2i = s1i + (fnu+fn)*(rzr*c2i+rzi*c2r)
5524 IF (iflag.GE.3)
GO TO 100
5527 c2m = dmax1(str,sti)
5528 IF (c2m.LE.ascle)
GO TO 100
5535 s1r = s1r*cssr(iflag)
5536 s1i = s1i*cssr(iflag)
5537 s2r = s2r*cssr(iflag)
5538 s2i = s2i*cssr(iflag)
5544 IF (rs1.GT.0.0d0)
GO TO 140
5552 IF (nd.EQ.0)
GO TO 110
5553 CALL zuoik(zr, zi, fnu, kode, 1, nd, yr, yi, nuf, tol, elim, alim)
5554 IF (nuf.LT.0)
GO TO 140
5557 IF (nd.EQ.0)
GO TO 110
5558 fn = fnu + dble(float(nd-1))
5559 IF (fn.LT.fnul)
GO TO 130
5565 IF (fn.LT.0.0d0) s1i = -s1i
5566 str = c2r*s1r - c2i*s1i
5567 c2i = c2r*s1i + c2i*s1r
5577 IF (rs1.GT.0.0d0)
GO TO 140
5586 SUBROUTINE zwrsk(ZRR, ZRI, FNU, KODE, N, YR, YI, NZ, CWR, CWI, TOL, ELIM, ALIM)
5598 DOUBLE PRECISION act, acw, alim, ascle, cinui, cinur, csclr, cti, &
5599 ctr, cwi, cwr, c1i, c1r, c2i, c2r, elim, fnu, pti, ptr, ract, &
5600 sti, str, tol, yi, yr, zri, zrr
5601 INTEGER i, kode, n, nw, nz
5602 dimension yr(1), yi(1), cwr(2), cwi(2)
5609 CALL zbknu(zrr, zri, fnu, kode, 2, cwr, cwi, nw, tol, elim, alim)
5610 IF (nw.NE.0)
GO TO 50
5611 CALL zrati(zrr, zri, fnu, n, yr, yi, tol)
5618 IF (kode.EQ.1)
GO TO 10
5628 acw = zabs(cwr(2),cwi(2))
5629 ascle = 1.0d+3*d1mach(1)/tol
5631 IF (acw.GT.ascle)
GO TO 20
5636 IF (acw.LT.ascle)
GO TO 30
5649 ptr = str*c1r - sti*c1i
5650 pti = str*c1i + sti*c1r
5653 ctr = zrr*ptr - zri*pti
5654 cti = zrr*pti + zri*ptr
5661 cinur = ptr*ctr - pti*cti
5662 cinui = ptr*cti + pti*ctr
5667 ptr = str*cinur - sti*cinui
5668 cinui = str*cinui + sti*cinur
5678 IF(nw.EQ.(-2)) nz=-2
5682 SUBROUTINE zmlri(ZR, ZI, FNU, KODE, N, YR, YI, NZ, TOL)
5694 DOUBLE PRECISION ack, ak, ap, at, az, bk, cki, ckr, cnormi, &
5695 cnormr, conei, coner, fkap, fkk, flam, fnf, fnu, pti, ptr, p1i, &
5696 p1r, p2i, p2r, raz, rho, rho2, rzi, rzr, scle, sti, str, sumi, &
5697 sumr, tfnf, tol, tst, yi, yr, zeroi, zeror, zi, zr
5698 INTEGER i, iaz, idum, ifnu, inu, itime, k, kk, km, kode, m, n, nz
5699 dimension yr(1), yi(1)
5700 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
5701 scle = d1mach(1)/tol
5705 ifnu = int(sngl(fnu))
5707 at = dble(float(iaz)) + 1.0d0
5719 ack = (at+1.0d0)*raz
5720 rho = ack + dsqrt(ack*ack-1.0d0)
5722 tst = (rho2+rho2)/((rho2-1.0d0)*(rho-1.0d0))
5731 p2r = p1r - (ckr*ptr-cki*pti)
5732 p2i = p1i - (cki*ptr+ckr*pti)
5738 IF (ap.GT.tst*ak*ak)
GO TO 20
5745 IF (inu.LT.iaz)
GO TO 40
5753 at = dble(float(inu)) + 1.0d0
5759 tst = dsqrt(ack/tol)
5764 p2r = p1r - (ckr*ptr-cki*pti)
5765 p2i = p1i - (ckr*pti+cki*ptr)
5771 IF (ap.LT.tst)
GO TO 30
5772 IF (itime.EQ.2)
GO TO 40
5774 flam = ack + dsqrt(ack*ack-1.0d0)
5775 fkap = ap/zabs(p1r,p1i)
5776 rho = dmin1(flam,fkap)
5777 tst = tst*dsqrt(rho/(rho*rho-1.0d0))
5786 kk = max0(i+iaz,k+inu)
5787 fkk = dble(float(kk))
5795 fnf = fnu - dble(float(ifnu))
5797 bk = dgamln(fkk+tfnf+1.0d0,idum) - dgamln(fkk+1.0d0,idum) - &
5798 dgamln(tfnf+1.0d0,idum)
5806 p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti)
5807 p2i = p1i + (fkk+fnf)*(rzi*ptr+rzr*pti)
5810 ak = 1.0d0 - tfnf/(fkk+tfnf)
5812 sumr = sumr + (ack+bk)*p1r
5813 sumi = sumi + (ack+bk)*p1i
5819 IF (n.EQ.1)
GO TO 70
5823 p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti)
5824 p2i = p1i + (fkk+fnf)*(rzi*ptr+rzr*pti)
5827 ak = 1.0d0 - tfnf/(fkk+tfnf)
5829 sumr = sumr + (ack+bk)*p1r
5830 sumi = sumi + (ack+bk)*p1i
5838 IF (ifnu.LE.0)
GO TO 90
5842 p2r = p1r + (fkk+fnf)*(rzr*ptr-rzi*pti)
5843 p2i = p1i + (fkk+fnf)*(rzr*pti+rzi*ptr)
5846 ak = 1.0d0 - tfnf/(fkk+tfnf)
5848 sumr = sumr + (ack+bk)*p1r
5849 sumi = sumi + (ack+bk)*p1i
5856 IF (kode.EQ.2) ptr = zeror
5857 CALL zlog(rzr, rzi, str, sti, idum)
5858 p1r = -fnf*str + ptr
5859 p1i = -fnf*sti + pti
5860 ap = dgamln(1.0d0+fnf,idum)
5871 CALL zexp(ptr, pti, str, sti)
5876 CALL zmlt(ckr, cki, ptr, pti, cnormr, cnormi)
5878 str = yr(i)*cnormr - yi(i)*cnormi
5879 yi(i) = yr(i)*cnormi + yi(i)*cnormr