1 SUBROUTINE zuoik(ZR, ZI, FNU, KODE, IKFLG, N, YR, YI, NUF, TOL,
30 DOUBLE PRECISION AARG, AIC, ALIM, APHI, ARGI, ARGR, ASUMI, ASUMR,
31 * ascle, ax, ay, bsumi, bsumr, cwrki, cwrkr, czi, czr, elim, fnn,
32 * fnu, gnn, gnu, phii, phir, rcz, str, sti, sumi, sumr, tol, yi,
33 * yr, zbi, zbr, zeroi, zeror, zeta1i, zeta1r, zeta2i, zeta2r, zi,
34 * zni, znr, zr, zri, zrr,
d1mach, xzabs
35 INTEGER I, IDUM, IFORM, IKFLG, INIT, KODE, N, NN, NUF, NW
36 dimension yr(n), yi(n), cwrkr(16), cwrki(16)
37 DATA zeror,zeroi / 0.0d0, 0.0d0 /
38 DATA aic / 1.265512123484645396d+00 /
43 IF (zr.GE.0.0d0)
GO TO 10
49 ax = dabs(zr)*1.7321d0
52 IF (ay.GT.ax) iform = 2
53 gnu = dmax1(fnu,1.0d0)
54 IF (ikflg.EQ.1)
GO TO 20
56 gnn = fnu + fnn - 1.0d0
64 IF (iform.EQ.2)
GO TO 30
66 CALL zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii,
67 * zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
68 czr = -zeta1r + zeta2r
69 czi = -zeta1i + zeta2i
74 IF (zi.GT.0.0d0)
GO TO 40
77 CALL zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r,
78 * zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
79 czr = -zeta1r + zeta2r
80 czi = -zeta1i + zeta2i
81 aarg = xzabs(argr,argi)
83 IF (kode.EQ.1)
GO TO 60
87 IF (ikflg.EQ.1)
GO TO 70
91 aphi = xzabs(phir,phii)
96 IF (rcz.GT.elim)
GO TO 210
97 IF (rcz.LT.alim)
GO TO 80
98 rcz = rcz + dlog(aphi)
99 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
100 IF (rcz.GT.elim)
GO TO 210
106 IF (rcz.LT.(-elim))
GO TO 90
107 IF (rcz.GT.(-alim))
GO TO 130
108 rcz = rcz + dlog(aphi)
109 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
110 IF (rcz.GT.(-elim))
GO TO 110
119 ascle = 1.0d+3*
d1mach(1)/tol
120 CALL xzlog(phir, phii, str, sti, idum)
123 IF (iform.EQ.1)
GO TO 120
124 CALL xzlog(argr, argi, str, sti, idum)
125 czr = czr - 0.25d0*str - aic
126 czi = czi - 0.25d0*sti
132 CALL zuchk(czr, czi, nw, ascle, tol)
133 IF (nw.NE.0)
GO TO 90
135 IF (ikflg.EQ.2)
RETURN 141 gnu = fnu + dble(float(nn-1))
142 IF (iform.EQ.2)
GO TO 150
144 CALL zunik(zrr, zri, gnu, ikflg, 1, tol, init, phir, phii,
145 * zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
146 czr = -zeta1r + zeta2r
147 czi = -zeta1i + zeta2i
150 CALL zunhj(znr, zni, gnu, 1, tol, phir, phii, argr, argi, zeta1r,
151 * zeta1i, zeta2r, zeta2i, asumr, asumi, bsumr, bsumi)
152 czr = -zeta1r + zeta2r
153 czi = -zeta1i + zeta2i
154 aarg = xzabs(argr,argi)
156 IF (kode.EQ.1)
GO TO 170
160 aphi = xzabs(phir,phii)
162 IF (rcz.LT.(-elim))
GO TO 180
163 IF (rcz.GT.(-alim))
RETURN 164 rcz = rcz + dlog(aphi)
165 IF (iform.EQ.2) rcz = rcz - 0.25d0*dlog(aarg) - aic
166 IF (rcz.GT.(-elim))
GO TO 190
175 ascle = 1.0d+3*
d1mach(1)/tol
176 CALL xzlog(phir, phii, str, sti, idum)
179 IF (iform.EQ.1)
GO TO 200
180 CALL xzlog(argr, argi, str, sti, idum)
181 czr = czr - 0.25d0*str - aic
182 czi = czi - 0.25d0*sti
188 CALL zuchk(czr, czi, nw, ascle, tol)
189 IF (nw.NE.0)
GO TO 180
double precision function d1mach(i)
OCTAVE_EXPORT octave_value_list etc The functions then dimension(columns)