1 SUBROUTINE zunik(ZRR, ZRI, FNU, IKFLG, IPMTR, TOL, INIT, PHIR,
2 * phii, zeta1r, zeta1i, zeta2r, zeta2i, sumr, sumi, cwrkr, cwrki)
25 DOUBLE PRECISION AC, C, CON, CONEI, CONER, CRFNI, CRFNR, CWRKI,
26 * cwrkr, fnu, phii, phir, rfn, si, sr, sri, srr, sti,
str, sumi,
27 * sumr, test, ti, tol, tr, t2i, t2r, zeroi, zeror, zeta1i, zeta1r,
28 * zeta2i, zeta2r, zni, znr, zri, zrr,
d1mach
29 INTEGER I, IDUM, IKFLG, INIT, IPMTR, J, K, L
30 dimension c(120), cwrkr(16), cwrki(16), con(2)
31 DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
33 1 3.98942280401432678
d-01, 1.25331413731550025
d+00 /
34 DATA c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10),
35 1 c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18),
36 2 c(19), c(20), c(21), c(22), c(23), c(24)/
37 3 1.00000000000000000
d+00, -2.08333333333333333
d-01,
38 4 1.25000000000000000
d-01, 3.34201388888888889
d-01,
39 5 -4.01041666666666667
d-01, 7.03125000000000000
d-02,
40 6 -1.02581259645061728
d+00, 1.84646267361111111
d+00,
41 7 -8.91210937500000000
d-01, 7.32421875000000000
d-02,
42 8 4.66958442342624743
d+00, -1.12070026162229938
d+01,
43 9 8.78912353515625000
d+00, -2.36408691406250000
d+00,
44 a 1.12152099609375000
d-01, -2.82120725582002449
d+01,
45 b 8.46362176746007346
d+01, -9.18182415432400174
d+01,
46 c 4.25349987453884549
d+01, -7.36879435947963170
d+00,
47 d 2.27108001708984375
d-01, 2.12570130039217123
d+02,
48 e -7.65252468141181642
d+02, 1.05999045252799988
d+03/
49 DATA c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32),
50 1 c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40),
51 2 c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/
52 3 -6.99579627376132541
d+02, 2.18190511744211590
d+02,
53 4 -2.64914304869515555
d+01, 5.72501420974731445
d-01,
54 5 -1.91945766231840700
d+03, 8.06172218173730938
d+03,
55 6 -1.35865500064341374
d+04, 1.16553933368645332
d+04,
56 7 -5.30564697861340311
d+03, 1.20090291321635246
d+03,
57 8 -1.08090919788394656
d+02, 1.72772750258445740
d+00,
58 9 2.02042913309661486
d+04, -9.69805983886375135
d+04,
59 a 1.92547001232531532
d+05, -2.03400177280415534
d+05,
60 b 1.22200464983017460
d+05, -4.11926549688975513
d+04,
61 c 7.10951430248936372
d+03, -4.93915304773088012
d+02,
62 d 6.07404200127348304
d+00, -2.42919187900551333
d+05,
63 e 1.31176361466297720
d+06, -2.99801591853810675
d+06/
64 DATA c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56),
65 1 c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64),
66 2 c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/
67 3 3.76327129765640400
d+06, -2.81356322658653411
d+06,
68 4 1.26836527332162478
d+06, -3.31645172484563578
d+05,
69 5 4.52187689813627263
d+04, -2.49983048181120962
d+03,
70 6 2.43805296995560639
d+01, 3.28446985307203782
d+06,
71 7 -1.97068191184322269
d+07, 5.09526024926646422
d+07,
72 8 -7.41051482115326577
d+07, 6.63445122747290267
d+07,
73 9 -3.75671766607633513
d+07, 1.32887671664218183
d+07,
74 a -2.78561812808645469
d+06, 3.08186404612662398
d+05,
75 b -1.38860897537170405
d+04, 1.10017140269246738
d+02,
76 c -4.93292536645099620
d+07, 3.25573074185765749
d+08,
77 d -9.39462359681578403
d+08, 1.55359689957058006
d+09,
78 e -1.62108055210833708
d+09, 1.10684281682301447
d+09/
79 DATA c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80),
80 1 c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88),
81 2 c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/
82 3 -4.95889784275030309
d+08, 1.42062907797533095
d+08,
83 4 -2.44740627257387285
d+07, 2.24376817792244943
d+06,
84 5 -8.40054336030240853
d+04, 5.51335896122020586
d+02,
85 6 8.14789096118312115
d+08, -5.86648149205184723
d+09,
86 7 1.86882075092958249
d+10, -3.46320433881587779
d+10,
87 8 4.12801855797539740
d+10, -3.30265997498007231
d+10,
88 9 1.79542137311556001
d+10, -6.56329379261928433
d+09,
89 a 1.55927986487925751
d+09, -2.25105661889415278
d+08,
90 b 1.73951075539781645
d+07, -5.49842327572288687
d+05,
91 c 3.03809051092238427
d+03, -1.46792612476956167
d+10,
92 d 1.14498237732025810
d+11, -3.99096175224466498
d+11,
93 e 8.19218669548577329
d+11, -1.09837515608122331
d+12/
94 DATA c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104),
95 1 c(105), c(106), c(107), c(108), c(109), c(110), c(111),
96 2 c(112), c(113), c(114), c(115), c(116), c(117), c(118)/
97 3 1.00815810686538209
d+12, -6.45364869245376503
d+11,
98 4 2.87900649906150589
d+11, -8.78670721780232657
d+10,
99 5 1.76347306068349694
d+10, -2.16716498322379509
d+09,
100 6 1.43157876718888981
d+08, -3.87183344257261262
d+06,
101 7 1.82577554742931747
d+04, 2.86464035717679043
d+11,
102 8 -2.40629790002850396
d+12, 9.10934118523989896
d+12,
103 9 -2.05168994109344374
d+13, 3.05651255199353206
d+13,
104 a -3.16670885847851584
d+13, 2.33483640445818409
d+13,
105 b -1.23204913055982872
d+13, 4.61272578084913197
d+12,
106 c -1.19655288019618160
d+12, 2.05914503232410016
d+11,
107 d -2.18229277575292237
d+10, 1.24700929351271032
d+09/
109 1 -2.91883881222208134
d+07, 1.18838426256783253
d+05/
111 IF (init.NE.0) go
to 40
121 IF (dabs(zrr).GT.ac .OR. dabs(zri).GT.ac) go
to 15
122 zeta1r = 2.0d0*dabs(dlog(test))+fnu
132 sr = coner + (tr*tr-ti*ti)
133 si = conei + (tr*ti+ti*tr)
134 CALL
xzsqrt(sr, si, srr, sri)
137 CALL
zdiv(
str, sti, tr, ti, znr, zni)
138 CALL
xzlog(znr, zni,
str, sti, idum)
143 CALL
zdiv(coner, conei, srr, sri, tr, ti)
146 CALL
xzsqrt(srr, sri, cwrkr(16), cwrki(16))
147 phir = cwrkr(16)*con(ikflg)
148 phii = cwrki(16)*con(ikflg)
149 IF (ipmtr.NE.0)
RETURN
150 CALL
zdiv(coner, conei, sr, si, t2r, t2i)
162 str = sr*t2r - si*t2i + c(l)
166 str = crfnr*srr - crfni*sri
167 crfni = crfnr*sri + crfni*srr
169 cwrkr(k) = crfnr*sr - crfni*si
170 cwrki(k) = crfnr*si + crfni*sr
172 test = dabs(cwrkr(k)) + dabs(cwrki(k))
173 IF (ac.LT.tol .AND. test.LT.tol) go
to 30
179 IF (ikflg.EQ.2) go
to 60
191 phir = cwrkr(16)*con(1)
192 phii = cwrki(16)*con(1)
202 sr = sr + tr*cwrkr(i)
203 si = si + tr*cwrki(i)
208 phir = cwrkr(16)*con(2)
209 phii = cwrki(16)*con(2)
subroutine xzlog(AR, AI, BR, BI, IERR)
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
calling an anonymous function involves an overhead quite comparable to the overhead of an m file function Passing a handle to a built in function is because the interpreter is not involved in the internal loop For a
subroutine zdiv(AR, AI, BR, BI, CR, CI)
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 zunik(ZRR, ZRI, FNU, IKFLG, IPMTR, TOL, INIT, PHIR, PHII, ZETA1R, ZETA1I, ZETA2R, ZETA2I, SUMR, SUMI, CWRKR, CWRKI)