1 SUBROUTINE cuoik(Z, FNU, KODE, IKFLG, N, Y, NUF, TOL, ELIM, ALIM)
27 COMPLEX ARG, ASUM, BSUM, CWRK, CZ, CZERO, PHI, SUM, Y, Z, ZB,
28 * zeta1, zeta2, zn, zr
29 REAL AARG, AIC, ALIM, APHI, ASCLE, AX, AY, ELIM, FNN, FNU, GNN,
30 * gnu, rcz, tol, x, yy
31 INTEGER I, IFORM, IKFLG, INIT, KODE, N, NN, NUF, NW
33 DATA czero / (0.0e0,0.0e0) /
34 DATA aic / 1.265512123484645396
e+00 /
39 IF (x.LT.0.0e0) zr = -z
45 IF (ay.GT.ax) iform = 2
46 gnu = amax1(fnu,1.0e0)
47 IF (ikflg.EQ.1) go
to 10
49 gnn = fnu + fnn - 1.0e0
57 IF (iform.EQ.2) go
to 20
59 CALL
cunik(zr, gnu, ikflg, 1, tol, init, phi, zeta1, zeta2, sum,
64 zn = -zr*
cmplx(0.0e0,1.0e0)
65 IF (yy.GT.0.0e0) go
to 30
68 CALL
cunhj(zn, gnu, 1, tol, phi, arg, zeta1, zeta2, asum, bsum)
72 IF (kode.EQ.2) cz = cz - zb
73 IF (ikflg.EQ.2) cz = -cz
79 IF (rcz.GT.elim) go
to 170
80 IF (rcz.LT.alim) go
to 50
81 rcz = rcz + alog(aphi)
82 IF (iform.EQ.2) rcz = rcz - 0.25e0*alog(aarg) - aic
83 IF (rcz.GT.elim) go
to 170
89 IF (rcz.LT.(-elim)) go
to 60
90 IF (rcz.GT.(-alim)) go
to 100
91 rcz = rcz + alog(aphi)
92 IF (iform.EQ.2) rcz = rcz - 0.25e0*alog(aarg) - aic
93 IF (rcz.GT.(-elim)) go
to 80
101 ascle = 1.0
e+3*r1mach(1)/tol
103 IF (iform.EQ.1) go
to 90
104 cz = cz -
cmplx(0.25e0,0.0e0)*clog(arg) -
cmplx(aic,0.0e0)
109 CALL
cuchk(cz, nw, ascle, tol)
110 IF (nw.EQ.1) go
to 60
112 IF (ikflg.EQ.2)
RETURN
118 gnu = fnu + float(nn-1)
119 IF (iform.EQ.2) go
to 120
121 CALL
cunik(zr, gnu, ikflg, 1, tol, init, phi, zeta1, zeta2, sum,
126 CALL
cunhj(zn, gnu, 1, tol, phi, arg, zeta1, zeta2, asum, bsum)
130 IF (kode.EQ.2) cz = cz - zb
133 IF (rcz.LT.(-elim)) go
to 140
134 IF (rcz.GT.(-alim))
RETURN
135 rcz = rcz + alog(aphi)
136 IF (iform.EQ.2) rcz = rcz - 0.25e0*alog(aarg) - aic
137 IF (rcz.GT.(-elim)) go
to 150
145 ascle = 1.0
e+3*r1mach(1)/tol
147 IF (iform.EQ.1) go
to 160
148 cz = cz -
cmplx(0.25e0,0.0e0)*clog(arg) -
cmplx(aic,0.0e0)
153 CALL
cuchk(cz, nw, ascle, tol)
154 IF (nw.EQ.1) go
to 140
subroutine cuchk(Y, NZ, ASCLE, TOL)
octave_value sin(void) const
may be zero for pure relative error test tem the relative tolerance must be greater than or equal to
OCTAVE_EXPORT octave_value_list etc The functions then dimension(columns)
subroutine cunik(ZR, FNU, IKFLG, IPMTR, TOL, INIT, PHI, ZETA1, ZETA2, SUM, CWRK)
subroutine cuoik(Z, FNU, KODE, IKFLG, N, Y, NUF, TOL, ELIM, ALIM)
subroutine cunhj(Z, FNU, IPMTR, TOL, PHI, ARG, ZETA1, ZETA2, ASUM, BSUM)
octave_value cos(void) const
OCTAVE_EXPORT octave_value_list return the value of the option it must match the dimension of the state and the relative tolerance must also be a vector of the same length tem it must match the dimension of the state and the absolute tolerance must also be a vector of the same length The local error test applied at each integration step is xample roup abs(local error in x(i))<