1 SUBROUTINE zasyi(ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM,
14 DOUBLE PRECISION AA, AEZ, AK, AK1I, AK1R, ALIM, ARG, ARM, ATOL,
15 * az, bb, bk, cki, ckr, conei, coner, cs1i, cs1r, cs2i, cs2r, czi,
16 * czr, dfnu, dki, dkr, dnu2, elim, ezi, ezr, fdn, fnu, pi, p1i,
17 * p1r, raz, rl, rtpi, rtr1, rzi, rzr, s, sgn, sqk, sti,
str, s2i,
18 * s2r, tol, tzi, tzr, yi, yr, zeroi, zeror, zi, zr,
d1mach, xzabs
19 INTEGER I, IB, IL, INU, J, JL, K, KODE, KODED, M, N, NN, NZ
21 DATA pi, rtpi /3.14159265358979324d0 , 0.159154943091895336d0 /
22 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
29 dfnu = fnu + dble(float(n-il))
38 CALL
xzsqrt(ak1r, ak1i, ak1r, ak1i)
41 IF (kode.NE.2) go to 10
45 IF (dabs(czr).GT.elim) go to 100
48 IF ((dabs(czr).GT.alim) .AND. (n.GT.2)) go to 20
51 CALL
zmlt(ak1r, ak1i,
str, sti, ak1r, ak1i)
54 IF (dnu2.GT.rtr1) fdn = dnu2*dnu2
64 jl = int(sngl(rl+rl)) + 2
67 IF (zi.EQ.0.0d0) go to 30
73 arg = (fnu-dble(float(inu)))*pi
77 IF (zi.LT.0.0d0) bk = -bk
80 IF (
mod(inu,2).EQ.0) go to 30
100 CALL
zdiv(ckr, cki, dkr, dki,
str, sti)
106 cs1r = cs1r + ckr*sgn
107 cs1i = cs1i + cki*sgn
114 IF (aa.LE.atol) go to 50
120 IF (zr+zr.GE.elim) go to 60
129 fdn = fdn + 8.0d0*dfnu + 4.0d0
133 yr(m) = s2r*ak1r - s2i*ak1i
134 yi(m) = s2r*ak1i + s2i*ak1r
146 yr(k) = (ak+fnu)*(rzr*yr(k+1)-rzi*yi(k+1)) + yr(k+2)
147 yi(k) = (ak+fnu)*(rzr*yi(k+1)+rzi*yr(k+1)) + yi(k+2)
151 IF (koded.EQ.0)
RETURN
152 CALL
xzexp(czr, czi, ckr, cki)
154 str = yr(i)*ckr - yi(i)*cki
155 yi(i) = yr(i)*cki + yi(i)*ckr
std::string str(char sep= 'x') const
subroutine xzexp(AR, AI, BR, BI)
std::string dimension(void) const
octave_int< T > mod(const octave_int< T > &x, const octave_int< T > &y)
double precision function d1mach(i)
F77_RET_T const double const double double * d
subroutine zdiv(AR, AI, BR, BI, CR, CI)
subroutine zasyi(ZR, ZI, FNU, KODE, N, YR, YI, NZ, RL, TOL, ELIM, ALIM)
subroutine xzsqrt(AR, AI, BR, BI)
subroutine zmlt(AR, AI, BR, BI, CR, CI)