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
subroutine xzexp(AR, AI, BR, BI)
octave_int< T > mod(const octave_int< T > &x, const octave_int< T > &y)
double precision function d1mach(i)
F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T const F77_REAL const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T const F77_DBLE F77_DBLE &F77_RET_T const F77_REAL F77_REAL &F77_RET_T F77_REAL F77_REAL &F77_RET_T F77_DBLE F77_DBLE &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE * 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)
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 zmlt(AR, AI, BR, BI, CR, CI)