1*DECK ZUNHJ 2 SUBROUTINE ZUNHJ (ZR, ZI, FNU, IPMTR, TOL, PHIR, PHII, ARGR, ARGI, 3 + ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI) 4C***BEGIN PROLOGUE ZUNHJ 5C***SUBSIDIARY 6C***PURPOSE Subsidiary to ZBESI and ZBESK 7C***LIBRARY SLATEC 8C***TYPE ALL (CUNHJ-A, ZUNHJ-A) 9C***AUTHOR Amos, D. E., (SNL) 10C***DESCRIPTION 11C 12C REFERENCES 13C HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A. 14C STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9. 15C 16C ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC 17C PRESS, N.Y., 1974, PAGE 420 18C 19C ABSTRACT 20C ZUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) = 21C J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU 22C BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION 23C 24C C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) ) 25C 26C FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS 27C AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE. 28C 29C (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2, 30C 31C ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING 32C PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY. 33C 34C MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND 35C MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR= 36C 1 COMPUTES ALL EXCEPT ASUM AND BSUM. 37C 38C***SEE ALSO ZBESI, ZBESK 39C***ROUTINES CALLED D1MACH, ZABS, ZDIV, ZLOG, ZSQRT 40C***REVISION HISTORY (YYMMDD) 41C 830501 DATE WRITTEN 42C 910415 Prologue converted to Version 4.0 format. (BAB) 43C 930122 Added ZLOG and ZSQRT to EXTERNAL statement. (RWC) 44C***END PROLOGUE ZUNHJ 45C COMPLEX ARG,ASUM,BSUM,CFNU,CONE,CR,CZERO,DR,P,PHI,PRZTH,PTFN, 46C *RFN13,RTZTA,RZTH,SUMA,SUMB,TFN,T2,UP,W,W2,Z,ZA,ZB,ZC,ZETA,ZETA1, 47C *ZETA2,ZTH 48 DOUBLE PRECISION ALFA, ANG, AP, AR, ARGI, ARGR, ASUMI, ASUMR, 49 * ATOL, AW2, AZTH, BETA, BR, BSUMI, BSUMR, BTOL, C, CONEI, CONER, 50 * CRI, CRR, DRI, DRR, EX1, EX2, FNU, FN13, FN23, GAMA, GPI, HPI, 51 * PHII, PHIR, PI, PP, PR, PRZTHI, PRZTHR, PTFNI, PTFNR, RAW, RAW2, 52 * RAZTH, RFNU, RFNU2, RFN13, RTZTI, RTZTR, RZTHI, RZTHR, STI, STR, 53 * SUMAI, SUMAR, SUMBI, SUMBR, TEST, TFNI, TFNR, THPI, TOL, TZAI, 54 * TZAR, T2I, T2R, UPI, UPR, WI, WR, W2I, W2R, ZAI, ZAR, ZBI, ZBR, 55 * ZCI, ZCR, ZEROI, ZEROR, ZETAI, ZETAR, ZETA1I, ZETA1R, ZETA2I, 56 * ZETA2R, ZI, ZR, ZTHI, ZTHR, ZABS, AC, D1MACH 57 INTEGER IAS, IBS, IPMTR, IS, J, JR, JU, K, KMAX, KP1, KS, L, LR, 58 * LRP1, L1, L2, M, IDUM 59 DIMENSION AR(14), BR(14), C(105), ALFA(180), BETA(210), GAMA(30), 60 * AP(30), PR(30), PI(30), UPR(14), UPI(14), CRR(14), CRI(14), 61 * DRR(14), DRI(14) 62 EXTERNAL ZABS, ZLOG, ZSQRT 63 DATA AR(1), AR(2), AR(3), AR(4), AR(5), AR(6), AR(7), AR(8), 64 1 AR(9), AR(10), AR(11), AR(12), AR(13), AR(14)/ 65 2 1.00000000000000000D+00, 1.04166666666666667D-01, 66 3 8.35503472222222222D-02, 1.28226574556327160D-01, 67 4 2.91849026464140464D-01, 8.81627267443757652D-01, 68 5 3.32140828186276754D+00, 1.49957629868625547D+01, 69 6 7.89230130115865181D+01, 4.74451538868264323D+02, 70 7 3.20749009089066193D+03, 2.40865496408740049D+04, 71 8 1.98923119169509794D+05, 1.79190200777534383D+06/ 72 DATA BR(1), BR(2), BR(3), BR(4), BR(5), BR(6), BR(7), BR(8), 73 1 BR(9), BR(10), BR(11), BR(12), BR(13), BR(14)/ 74 2 1.00000000000000000D+00, -1.45833333333333333D-01, 75 3 -9.87413194444444444D-02, -1.43312053915895062D-01, 76 4 -3.17227202678413548D-01, -9.42429147957120249D-01, 77 5 -3.51120304082635426D+00, -1.57272636203680451D+01, 78 6 -8.22814390971859444D+01, -4.92355370523670524D+02, 79 7 -3.31621856854797251D+03, -2.48276742452085896D+04, 80 8 -2.04526587315129788D+05, -1.83844491706820990D+06/ 81 DATA C(1), C(2), C(3), C(4), C(5), C(6), C(7), C(8), C(9), C(10), 82 1 C(11), C(12), C(13), C(14), C(15), C(16), C(17), C(18), 83 2 C(19), C(20), C(21), C(22), C(23), C(24)/ 84 3 1.00000000000000000D+00, -2.08333333333333333D-01, 85 4 1.25000000000000000D-01, 3.34201388888888889D-01, 86 5 -4.01041666666666667D-01, 7.03125000000000000D-02, 87 6 -1.02581259645061728D+00, 1.84646267361111111D+00, 88 7 -8.91210937500000000D-01, 7.32421875000000000D-02, 89 8 4.66958442342624743D+00, -1.12070026162229938D+01, 90 9 8.78912353515625000D+00, -2.36408691406250000D+00, 91 A 1.12152099609375000D-01, -2.82120725582002449D+01, 92 B 8.46362176746007346D+01, -9.18182415432400174D+01, 93 C 4.25349987453884549D+01, -7.36879435947963170D+00, 94 D 2.27108001708984375D-01, 2.12570130039217123D+02, 95 E -7.65252468141181642D+02, 1.05999045252799988D+03/ 96 DATA C(25), C(26), C(27), C(28), C(29), C(30), C(31), C(32), 97 1 C(33), C(34), C(35), C(36), C(37), C(38), C(39), C(40), 98 2 C(41), C(42), C(43), C(44), C(45), C(46), C(47), C(48)/ 99 3 -6.99579627376132541D+02, 2.18190511744211590D+02, 100 4 -2.64914304869515555D+01, 5.72501420974731445D-01, 101 5 -1.91945766231840700D+03, 8.06172218173730938D+03, 102 6 -1.35865500064341374D+04, 1.16553933368645332D+04, 103 7 -5.30564697861340311D+03, 1.20090291321635246D+03, 104 8 -1.08090919788394656D+02, 1.72772750258445740D+00, 105 9 2.02042913309661486D+04, -9.69805983886375135D+04, 106 A 1.92547001232531532D+05, -2.03400177280415534D+05, 107 B 1.22200464983017460D+05, -4.11926549688975513D+04, 108 C 7.10951430248936372D+03, -4.93915304773088012D+02, 109 D 6.07404200127348304D+00, -2.42919187900551333D+05, 110 E 1.31176361466297720D+06, -2.99801591853810675D+06/ 111 DATA C(49), C(50), C(51), C(52), C(53), C(54), C(55), C(56), 112 1 C(57), C(58), C(59), C(60), C(61), C(62), C(63), C(64), 113 2 C(65), C(66), C(67), C(68), C(69), C(70), C(71), C(72)/ 114 3 3.76327129765640400D+06, -2.81356322658653411D+06, 115 4 1.26836527332162478D+06, -3.31645172484563578D+05, 116 5 4.52187689813627263D+04, -2.49983048181120962D+03, 117 6 2.43805296995560639D+01, 3.28446985307203782D+06, 118 7 -1.97068191184322269D+07, 5.09526024926646422D+07, 119 8 -7.41051482115326577D+07, 6.63445122747290267D+07, 120 9 -3.75671766607633513D+07, 1.32887671664218183D+07, 121 A -2.78561812808645469D+06, 3.08186404612662398D+05, 122 B -1.38860897537170405D+04, 1.10017140269246738D+02, 123 C -4.93292536645099620D+07, 3.25573074185765749D+08, 124 D -9.39462359681578403D+08, 1.55359689957058006D+09, 125 E -1.62108055210833708D+09, 1.10684281682301447D+09/ 126 DATA C(73), C(74), C(75), C(76), C(77), C(78), C(79), C(80), 127 1 C(81), C(82), C(83), C(84), C(85), C(86), C(87), C(88), 128 2 C(89), C(90), C(91), C(92), C(93), C(94), C(95), C(96)/ 129 3 -4.95889784275030309D+08, 1.42062907797533095D+08, 130 4 -2.44740627257387285D+07, 2.24376817792244943D+06, 131 5 -8.40054336030240853D+04, 5.51335896122020586D+02, 132 6 8.14789096118312115D+08, -5.86648149205184723D+09, 133 7 1.86882075092958249D+10, -3.46320433881587779D+10, 134 8 4.12801855797539740D+10, -3.30265997498007231D+10, 135 9 1.79542137311556001D+10, -6.56329379261928433D+09, 136 A 1.55927986487925751D+09, -2.25105661889415278D+08, 137 B 1.73951075539781645D+07, -5.49842327572288687D+05, 138 C 3.03809051092238427D+03, -1.46792612476956167D+10, 139 D 1.14498237732025810D+11, -3.99096175224466498D+11, 140 E 8.19218669548577329D+11, -1.09837515608122331D+12/ 141 DATA C(97), C(98), C(99), C(100), C(101), C(102), C(103), C(104), 142 1 C(105)/ 143 2 1.00815810686538209D+12, -6.45364869245376503D+11, 144 3 2.87900649906150589D+11, -8.78670721780232657D+10, 145 4 1.76347306068349694D+10, -2.16716498322379509D+09, 146 5 1.43157876718888981D+08, -3.87183344257261262D+06, 147 6 1.82577554742931747D+04/ 148 DATA ALFA(1), ALFA(2), ALFA(3), ALFA(4), ALFA(5), ALFA(6), 149 1 ALFA(7), ALFA(8), ALFA(9), ALFA(10), ALFA(11), ALFA(12), 150 2 ALFA(13), ALFA(14), ALFA(15), ALFA(16), ALFA(17), ALFA(18), 151 3 ALFA(19), ALFA(20), ALFA(21), ALFA(22)/ 152 4 -4.44444444444444444D-03, -9.22077922077922078D-04, 153 5 -8.84892884892884893D-05, 1.65927687832449737D-04, 154 6 2.46691372741792910D-04, 2.65995589346254780D-04, 155 7 2.61824297061500945D-04, 2.48730437344655609D-04, 156 8 2.32721040083232098D-04, 2.16362485712365082D-04, 157 9 2.00738858762752355D-04, 1.86267636637545172D-04, 158 A 1.73060775917876493D-04, 1.61091705929015752D-04, 159 B 1.50274774160908134D-04, 1.40503497391269794D-04, 160 C 1.31668816545922806D-04, 1.23667445598253261D-04, 161 D 1.16405271474737902D-04, 1.09798298372713369D-04, 162 E 1.03772410422992823D-04, 9.82626078369363448D-05/ 163 DATA ALFA(23), ALFA(24), ALFA(25), ALFA(26), ALFA(27), ALFA(28), 164 1 ALFA(29), ALFA(30), ALFA(31), ALFA(32), ALFA(33), ALFA(34), 165 2 ALFA(35), ALFA(36), ALFA(37), ALFA(38), ALFA(39), ALFA(40), 166 3 ALFA(41), ALFA(42), ALFA(43), ALFA(44)/ 167 4 9.32120517249503256D-05, 8.85710852478711718D-05, 168 5 8.42963105715700223D-05, 8.03497548407791151D-05, 169 6 7.66981345359207388D-05, 7.33122157481777809D-05, 170 7 7.01662625163141333D-05, 6.72375633790160292D-05, 171 8 6.93735541354588974D-04, 2.32241745182921654D-04, 172 9 -1.41986273556691197D-05, -1.16444931672048640D-04, 173 A -1.50803558053048762D-04, -1.55121924918096223D-04, 174 B -1.46809756646465549D-04, -1.33815503867491367D-04, 175 C -1.19744975684254051D-04, -1.06184319207974020D-04, 176 D -9.37699549891194492D-05, -8.26923045588193274D-05, 177 E -7.29374348155221211D-05, -6.44042357721016283D-05/ 178 DATA ALFA(45), ALFA(46), ALFA(47), ALFA(48), ALFA(49), ALFA(50), 179 1 ALFA(51), ALFA(52), ALFA(53), ALFA(54), ALFA(55), ALFA(56), 180 2 ALFA(57), ALFA(58), ALFA(59), ALFA(60), ALFA(61), ALFA(62), 181 3 ALFA(63), ALFA(64), ALFA(65), ALFA(66)/ 182 4 -5.69611566009369048D-05, -5.04731044303561628D-05, 183 5 -4.48134868008882786D-05, -3.98688727717598864D-05, 184 6 -3.55400532972042498D-05, -3.17414256609022480D-05, 185 7 -2.83996793904174811D-05, -2.54522720634870566D-05, 186 8 -2.28459297164724555D-05, -2.05352753106480604D-05, 187 9 -1.84816217627666085D-05, -1.66519330021393806D-05, 188 A -1.50179412980119482D-05, -1.35554031379040526D-05, 189 B -1.22434746473858131D-05, -1.10641884811308169D-05, 190 C -3.54211971457743841D-04, -1.56161263945159416D-04, 191 D 3.04465503594936410D-05, 1.30198655773242693D-04, 192 E 1.67471106699712269D-04, 1.70222587683592569D-04/ 193 DATA ALFA(67), ALFA(68), ALFA(69), ALFA(70), ALFA(71), ALFA(72), 194 1 ALFA(73), ALFA(74), ALFA(75), ALFA(76), ALFA(77), ALFA(78), 195 2 ALFA(79), ALFA(80), ALFA(81), ALFA(82), ALFA(83), ALFA(84), 196 3 ALFA(85), ALFA(86), ALFA(87), ALFA(88)/ 197 4 1.56501427608594704D-04, 1.36339170977445120D-04, 198 5 1.14886692029825128D-04, 9.45869093034688111D-05, 199 6 7.64498419250898258D-05, 6.07570334965197354D-05, 200 7 4.74394299290508799D-05, 3.62757512005344297D-05, 201 8 2.69939714979224901D-05, 1.93210938247939253D-05, 202 9 1.30056674793963203D-05, 7.82620866744496661D-06, 203 A 3.59257485819351583D-06, 1.44040049814251817D-07, 204 B -2.65396769697939116D-06, -4.91346867098485910D-06, 205 C -6.72739296091248287D-06, -8.17269379678657923D-06, 206 D -9.31304715093561232D-06, -1.02011418798016441D-05, 207 E -1.08805962510592880D-05, -1.13875481509603555D-05/ 208 DATA ALFA(89), ALFA(90), ALFA(91), ALFA(92), ALFA(93), ALFA(94), 209 1 ALFA(95), ALFA(96), ALFA(97), ALFA(98), ALFA(99), ALFA(100), 210 2 ALFA(101), ALFA(102), ALFA(103), ALFA(104), ALFA(105), 211 3 ALFA(106), ALFA(107), ALFA(108), ALFA(109), ALFA(110)/ 212 4 -1.17519675674556414D-05, -1.19987364870944141D-05, 213 5 3.78194199201772914D-04, 2.02471952761816167D-04, 214 6 -6.37938506318862408D-05, -2.38598230603005903D-04, 215 7 -3.10916256027361568D-04, -3.13680115247576316D-04, 216 8 -2.78950273791323387D-04, -2.28564082619141374D-04, 217 9 -1.75245280340846749D-04, -1.25544063060690348D-04, 218 A -8.22982872820208365D-05, -4.62860730588116458D-05, 219 B -1.72334302366962267D-05, 5.60690482304602267D-06, 220 C 2.31395443148286800D-05, 3.62642745856793957D-05, 221 D 4.58006124490188752D-05, 5.24595294959114050D-05, 222 E 5.68396208545815266D-05, 5.94349820393104052D-05/ 223 DATA ALFA(111), ALFA(112), ALFA(113), ALFA(114), ALFA(115), 224 1 ALFA(116), ALFA(117), ALFA(118), ALFA(119), ALFA(120), 225 2 ALFA(121), ALFA(122), ALFA(123), ALFA(124), ALFA(125), 226 3 ALFA(126), ALFA(127), ALFA(128), ALFA(129), ALFA(130)/ 227 4 6.06478527578421742D-05, 6.08023907788436497D-05, 228 5 6.01577894539460388D-05, 5.89199657344698500D-05, 229 6 5.72515823777593053D-05, 5.52804375585852577D-05, 230 7 5.31063773802880170D-05, 5.08069302012325706D-05, 231 8 4.84418647620094842D-05, 4.60568581607475370D-05, 232 9 -6.91141397288294174D-04, -4.29976633058871912D-04, 233 A 1.83067735980039018D-04, 6.60088147542014144D-04, 234 B 8.75964969951185931D-04, 8.77335235958235514D-04, 235 C 7.49369585378990637D-04, 5.63832329756980918D-04, 236 D 3.68059319971443156D-04, 1.88464535514455599D-04/ 237 DATA ALFA(131), ALFA(132), ALFA(133), ALFA(134), ALFA(135), 238 1 ALFA(136), ALFA(137), ALFA(138), ALFA(139), ALFA(140), 239 2 ALFA(141), ALFA(142), ALFA(143), ALFA(144), ALFA(145), 240 3 ALFA(146), ALFA(147), ALFA(148), ALFA(149), ALFA(150)/ 241 4 3.70663057664904149D-05, -8.28520220232137023D-05, 242 5 -1.72751952869172998D-04, -2.36314873605872983D-04, 243 6 -2.77966150694906658D-04, -3.02079514155456919D-04, 244 7 -3.12594712643820127D-04, -3.12872558758067163D-04, 245 8 -3.05678038466324377D-04, -2.93226470614557331D-04, 246 9 -2.77255655582934777D-04, -2.59103928467031709D-04, 247 A -2.39784014396480342D-04, -2.20048260045422848D-04, 248 B -2.00443911094971498D-04, -1.81358692210970687D-04, 249 C -1.63057674478657464D-04, -1.45712672175205844D-04, 250 D -1.29425421983924587D-04, -1.14245691942445952D-04/ 251 DATA ALFA(151), ALFA(152), ALFA(153), ALFA(154), ALFA(155), 252 1 ALFA(156), ALFA(157), ALFA(158), ALFA(159), ALFA(160), 253 2 ALFA(161), ALFA(162), ALFA(163), ALFA(164), ALFA(165), 254 3 ALFA(166), ALFA(167), ALFA(168), ALFA(169), ALFA(170)/ 255 4 1.92821964248775885D-03, 1.35592576302022234D-03, 256 5 -7.17858090421302995D-04, -2.58084802575270346D-03, 257 6 -3.49271130826168475D-03, -3.46986299340960628D-03, 258 7 -2.82285233351310182D-03, -1.88103076404891354D-03, 259 8 -8.89531718383947600D-04, 3.87912102631035228D-06, 260 9 7.28688540119691412D-04, 1.26566373053457758D-03, 261 A 1.62518158372674427D-03, 1.83203153216373172D-03, 262 B 1.91588388990527909D-03, 1.90588846755546138D-03, 263 C 1.82798982421825727D-03, 1.70389506421121530D-03, 264 D 1.55097127171097686D-03, 1.38261421852276159D-03/ 265 DATA ALFA(171), ALFA(172), ALFA(173), ALFA(174), ALFA(175), 266 1 ALFA(176), ALFA(177), ALFA(178), ALFA(179), ALFA(180)/ 267 2 1.20881424230064774D-03, 1.03676532638344962D-03, 268 3 8.71437918068619115D-04, 7.16080155297701002D-04, 269 4 5.72637002558129372D-04, 4.42089819465802277D-04, 270 5 3.24724948503090564D-04, 2.20342042730246599D-04, 271 6 1.28412898401353882D-04, 4.82005924552095464D-05/ 272 DATA BETA(1), BETA(2), BETA(3), BETA(4), BETA(5), BETA(6), 273 1 BETA(7), BETA(8), BETA(9), BETA(10), BETA(11), BETA(12), 274 2 BETA(13), BETA(14), BETA(15), BETA(16), BETA(17), BETA(18), 275 3 BETA(19), BETA(20), BETA(21), BETA(22)/ 276 4 1.79988721413553309D-02, 5.59964911064388073D-03, 277 5 2.88501402231132779D-03, 1.80096606761053941D-03, 278 6 1.24753110589199202D-03, 9.22878876572938311D-04, 279 7 7.14430421727287357D-04, 5.71787281789704872D-04, 280 8 4.69431007606481533D-04, 3.93232835462916638D-04, 281 9 3.34818889318297664D-04, 2.88952148495751517D-04, 282 A 2.52211615549573284D-04, 2.22280580798883327D-04, 283 B 1.97541838033062524D-04, 1.76836855019718004D-04, 284 C 1.59316899661821081D-04, 1.44347930197333986D-04, 285 D 1.31448068119965379D-04, 1.20245444949302884D-04, 286 E 1.10449144504599392D-04, 1.01828770740567258D-04/ 287 DATA BETA(23), BETA(24), BETA(25), BETA(26), BETA(27), BETA(28), 288 1 BETA(29), BETA(30), BETA(31), BETA(32), BETA(33), BETA(34), 289 2 BETA(35), BETA(36), BETA(37), BETA(38), BETA(39), BETA(40), 290 3 BETA(41), BETA(42), BETA(43), BETA(44)/ 291 4 9.41998224204237509D-05, 8.74130545753834437D-05, 292 5 8.13466262162801467D-05, 7.59002269646219339D-05, 293 6 7.09906300634153481D-05, 6.65482874842468183D-05, 294 7 6.25146958969275078D-05, 5.88403394426251749D-05, 295 8 -1.49282953213429172D-03, -8.78204709546389328D-04, 296 9 -5.02916549572034614D-04, -2.94822138512746025D-04, 297 A -1.75463996970782828D-04, -1.04008550460816434D-04, 298 B -5.96141953046457895D-05, -3.12038929076098340D-05, 299 C -1.26089735980230047D-05, -2.42892608575730389D-07, 300 D 8.05996165414273571D-06, 1.36507009262147391D-05, 301 E 1.73964125472926261D-05, 1.98672978842133780D-05/ 302 DATA BETA(45), BETA(46), BETA(47), BETA(48), BETA(49), BETA(50), 303 1 BETA(51), BETA(52), BETA(53), BETA(54), BETA(55), BETA(56), 304 2 BETA(57), BETA(58), BETA(59), BETA(60), BETA(61), BETA(62), 305 3 BETA(63), BETA(64), BETA(65), BETA(66)/ 306 4 2.14463263790822639D-05, 2.23954659232456514D-05, 307 5 2.28967783814712629D-05, 2.30785389811177817D-05, 308 6 2.30321976080909144D-05, 2.28236073720348722D-05, 309 7 2.25005881105292418D-05, 2.20981015361991429D-05, 310 8 2.16418427448103905D-05, 2.11507649256220843D-05, 311 9 2.06388749782170737D-05, 2.01165241997081666D-05, 312 A 1.95913450141179244D-05, 1.90689367910436740D-05, 313 B 1.85533719641636667D-05, 1.80475722259674218D-05, 314 C 5.52213076721292790D-04, 4.47932581552384646D-04, 315 D 2.79520653992020589D-04, 1.52468156198446602D-04, 316 E 6.93271105657043598D-05, 1.76258683069991397D-05/ 317 DATA BETA(67), BETA(68), BETA(69), BETA(70), BETA(71), BETA(72), 318 1 BETA(73), BETA(74), BETA(75), BETA(76), BETA(77), BETA(78), 319 2 BETA(79), BETA(80), BETA(81), BETA(82), BETA(83), BETA(84), 320 3 BETA(85), BETA(86), BETA(87), BETA(88)/ 321 4 -1.35744996343269136D-05, -3.17972413350427135D-05, 322 5 -4.18861861696693365D-05, -4.69004889379141029D-05, 323 6 -4.87665447413787352D-05, -4.87010031186735069D-05, 324 7 -4.74755620890086638D-05, -4.55813058138628452D-05, 325 8 -4.33309644511266036D-05, -4.09230193157750364D-05, 326 9 -3.84822638603221274D-05, -3.60857167535410501D-05, 327 A -3.37793306123367417D-05, -3.15888560772109621D-05, 328 B -2.95269561750807315D-05, -2.75978914828335759D-05, 329 C -2.58006174666883713D-05, -2.41308356761280200D-05, 330 D -2.25823509518346033D-05, -2.11479656768912971D-05, 331 E -1.98200638885294927D-05, -1.85909870801065077D-05/ 332 DATA BETA(89), BETA(90), BETA(91), BETA(92), BETA(93), BETA(94), 333 1 BETA(95), BETA(96), BETA(97), BETA(98), BETA(99), BETA(100), 334 2 BETA(101), BETA(102), BETA(103), BETA(104), BETA(105), 335 3 BETA(106), BETA(107), BETA(108), BETA(109), BETA(110)/ 336 4 -1.74532699844210224D-05, -1.63997823854497997D-05, 337 5 -4.74617796559959808D-04, -4.77864567147321487D-04, 338 6 -3.20390228067037603D-04, -1.61105016119962282D-04, 339 7 -4.25778101285435204D-05, 3.44571294294967503D-05, 340 8 7.97092684075674924D-05, 1.03138236708272200D-04, 341 9 1.12466775262204158D-04, 1.13103642108481389D-04, 342 A 1.08651634848774268D-04, 1.01437951597661973D-04, 343 B 9.29298396593363896D-05, 8.40293133016089978D-05, 344 C 7.52727991349134062D-05, 6.69632521975730872D-05, 345 D 5.92564547323194704D-05, 5.22169308826975567D-05, 346 E 4.58539485165360646D-05, 4.01445513891486808D-05/ 347 DATA BETA(111), BETA(112), BETA(113), BETA(114), BETA(115), 348 1 BETA(116), BETA(117), BETA(118), BETA(119), BETA(120), 349 2 BETA(121), BETA(122), BETA(123), BETA(124), BETA(125), 350 3 BETA(126), BETA(127), BETA(128), BETA(129), BETA(130)/ 351 4 3.50481730031328081D-05, 3.05157995034346659D-05, 352 5 2.64956119950516039D-05, 2.29363633690998152D-05, 353 6 1.97893056664021636D-05, 1.70091984636412623D-05, 354 7 1.45547428261524004D-05, 1.23886640995878413D-05, 355 8 1.04775876076583236D-05, 8.79179954978479373D-06, 356 9 7.36465810572578444D-04, 8.72790805146193976D-04, 357 A 6.22614862573135066D-04, 2.85998154194304147D-04, 358 B 3.84737672879366102D-06, -1.87906003636971558D-04, 359 C -2.97603646594554535D-04, -3.45998126832656348D-04, 360 D -3.53382470916037712D-04, -3.35715635775048757D-04/ 361 DATA BETA(131), BETA(132), BETA(133), BETA(134), BETA(135), 362 1 BETA(136), BETA(137), BETA(138), BETA(139), BETA(140), 363 2 BETA(141), BETA(142), BETA(143), BETA(144), BETA(145), 364 3 BETA(146), BETA(147), BETA(148), BETA(149), BETA(150)/ 365 4 -3.04321124789039809D-04, -2.66722723047612821D-04, 366 5 -2.27654214122819527D-04, -1.89922611854562356D-04, 367 6 -1.55058918599093870D-04, -1.23778240761873630D-04, 368 7 -9.62926147717644187D-05, -7.25178327714425337D-05, 369 8 -5.22070028895633801D-05, -3.50347750511900522D-05, 370 9 -2.06489761035551757D-05, -8.70106096849767054D-06, 371 A 1.13698686675100290D-06, 9.16426474122778849D-06, 372 B 1.56477785428872620D-05, 2.08223629482466847D-05, 373 C 2.48923381004595156D-05, 2.80340509574146325D-05, 374 D 3.03987774629861915D-05, 3.21156731406700616D-05/ 375 DATA BETA(151), BETA(152), BETA(153), BETA(154), BETA(155), 376 1 BETA(156), BETA(157), BETA(158), BETA(159), BETA(160), 377 2 BETA(161), BETA(162), BETA(163), BETA(164), BETA(165), 378 3 BETA(166), BETA(167), BETA(168), BETA(169), BETA(170)/ 379 4 -1.80182191963885708D-03, -2.43402962938042533D-03, 380 5 -1.83422663549856802D-03, -7.62204596354009765D-04, 381 6 2.39079475256927218D-04, 9.49266117176881141D-04, 382 7 1.34467449701540359D-03, 1.48457495259449178D-03, 383 8 1.44732339830617591D-03, 1.30268261285657186D-03, 384 9 1.10351597375642682D-03, 8.86047440419791759D-04, 385 A 6.73073208165665473D-04, 4.77603872856582378D-04, 386 B 3.05991926358789362D-04, 1.60315694594721630D-04, 387 C 4.00749555270613286D-05, -5.66607461635251611D-05, 388 D -1.32506186772982638D-04, -1.90296187989614057D-04/ 389 DATA BETA(171), BETA(172), BETA(173), BETA(174), BETA(175), 390 1 BETA(176), BETA(177), BETA(178), BETA(179), BETA(180), 391 2 BETA(181), BETA(182), BETA(183), BETA(184), BETA(185), 392 3 BETA(186), BETA(187), BETA(188), BETA(189), BETA(190)/ 393 4 -2.32811450376937408D-04, -2.62628811464668841D-04, 394 5 -2.82050469867598672D-04, -2.93081563192861167D-04, 395 6 -2.97435962176316616D-04, -2.96557334239348078D-04, 396 7 -2.91647363312090861D-04, -2.83696203837734166D-04, 397 8 -2.73512317095673346D-04, -2.61750155806768580D-04, 398 9 6.38585891212050914D-03, 9.62374215806377941D-03, 399 A 7.61878061207001043D-03, 2.83219055545628054D-03, 400 B -2.09841352012720090D-03, -5.73826764216626498D-03, 401 C -7.70804244495414620D-03, -8.21011692264844401D-03, 402 D -7.65824520346905413D-03, -6.47209729391045177D-03/ 403 DATA BETA(191), BETA(192), BETA(193), BETA(194), BETA(195), 404 1 BETA(196), BETA(197), BETA(198), BETA(199), BETA(200), 405 2 BETA(201), BETA(202), BETA(203), BETA(204), BETA(205), 406 3 BETA(206), BETA(207), BETA(208), BETA(209), BETA(210)/ 407 4 -4.99132412004966473D-03, -3.45612289713133280D-03, 408 5 -2.01785580014170775D-03, -7.59430686781961401D-04, 409 6 2.84173631523859138D-04, 1.10891667586337403D-03, 410 7 1.72901493872728771D-03, 2.16812590802684701D-03, 411 8 2.45357710494539735D-03, 2.61281821058334862D-03, 412 9 2.67141039656276912D-03, 2.65203073395980430D-03, 413 A 2.57411652877287315D-03, 2.45389126236094427D-03, 414 B 2.30460058071795494D-03, 2.13684837686712662D-03, 415 C 1.95896528478870911D-03, 1.77737008679454412D-03, 416 D 1.59690280765839059D-03, 1.42111975664438546D-03/ 417 DATA GAMA(1), GAMA(2), GAMA(3), GAMA(4), GAMA(5), GAMA(6), 418 1 GAMA(7), GAMA(8), GAMA(9), GAMA(10), GAMA(11), GAMA(12), 419 2 GAMA(13), GAMA(14), GAMA(15), GAMA(16), GAMA(17), GAMA(18), 420 3 GAMA(19), GAMA(20), GAMA(21), GAMA(22)/ 421 4 6.29960524947436582D-01, 2.51984209978974633D-01, 422 5 1.54790300415655846D-01, 1.10713062416159013D-01, 423 6 8.57309395527394825D-02, 6.97161316958684292D-02, 424 7 5.86085671893713576D-02, 5.04698873536310685D-02, 425 8 4.42600580689154809D-02, 3.93720661543509966D-02, 426 9 3.54283195924455368D-02, 3.21818857502098231D-02, 427 A 2.94646240791157679D-02, 2.71581677112934479D-02, 428 B 2.51768272973861779D-02, 2.34570755306078891D-02, 429 C 2.19508390134907203D-02, 2.06210828235646240D-02, 430 D 1.94388240897880846D-02, 1.83810633800683158D-02, 431 E 1.74293213231963172D-02, 1.65685837786612353D-02/ 432 DATA GAMA(23), GAMA(24), GAMA(25), GAMA(26), GAMA(27), GAMA(28), 433 1 GAMA(29), GAMA(30)/ 434 2 1.57865285987918445D-02, 1.50729501494095594D-02, 435 3 1.44193250839954639D-02, 1.38184805735341786D-02, 436 4 1.32643378994276568D-02, 1.27517121970498651D-02, 437 5 1.22761545318762767D-02, 1.18338262398482403D-02/ 438 DATA EX1, EX2, HPI, GPI, THPI / 439 1 3.33333333333333333D-01, 6.66666666666666667D-01, 440 2 1.57079632679489662D+00, 3.14159265358979324D+00, 441 3 4.71238898038468986D+00/ 442 DATA ZEROR,ZEROI,CONER,CONEI / 0.0D0, 0.0D0, 1.0D0, 0.0D0 / 443C***FIRST EXECUTABLE STATEMENT ZUNHJ 444 RFNU = 1.0D0/FNU 445C----------------------------------------------------------------------- 446C OVERFLOW TEST (Z/FNU TOO SMALL) 447C----------------------------------------------------------------------- 448 TEST = D1MACH(1)*1.0D+3 449 AC = FNU*TEST 450 IF (ABS(ZR).GT.AC .OR. ABS(ZI).GT.AC) GO TO 15 451 ZETA1R = 2.0D0*ABS(LOG(TEST))+FNU 452 ZETA1I = 0.0D0 453 ZETA2R = FNU 454 ZETA2I = 0.0D0 455 PHIR = 1.0D0 456 PHII = 0.0D0 457 ARGR = 1.0D0 458 ARGI = 0.0D0 459 RETURN 460 15 CONTINUE 461 ZBR = ZR*RFNU 462 ZBI = ZI*RFNU 463 RFNU2 = RFNU*RFNU 464C----------------------------------------------------------------------- 465C COMPUTE IN THE FOURTH QUADRANT 466C----------------------------------------------------------------------- 467 FN13 = FNU**EX1 468 FN23 = FN13*FN13 469 RFN13 = 1.0D0/FN13 470 W2R = CONER - ZBR*ZBR + ZBI*ZBI 471 W2I = CONEI - ZBR*ZBI - ZBR*ZBI 472 AW2 = ZABS(W2R,W2I) 473 IF (AW2.GT.0.25D0) GO TO 130 474C----------------------------------------------------------------------- 475C POWER SERIES FOR ABS(W2).LE.0.25D0 476C----------------------------------------------------------------------- 477 K = 1 478 PR(1) = CONER 479 PI(1) = CONEI 480 SUMAR = GAMA(1) 481 SUMAI = ZEROI 482 AP(1) = 1.0D0 483 IF (AW2.LT.TOL) GO TO 20 484 DO 10 K=2,30 485 PR(K) = PR(K-1)*W2R - PI(K-1)*W2I 486 PI(K) = PR(K-1)*W2I + PI(K-1)*W2R 487 SUMAR = SUMAR + PR(K)*GAMA(K) 488 SUMAI = SUMAI + PI(K)*GAMA(K) 489 AP(K) = AP(K-1)*AW2 490 IF (AP(K).LT.TOL) GO TO 20 491 10 CONTINUE 492 K = 30 493 20 CONTINUE 494 KMAX = K 495 ZETAR = W2R*SUMAR - W2I*SUMAI 496 ZETAI = W2R*SUMAI + W2I*SUMAR 497 ARGR = ZETAR*FN23 498 ARGI = ZETAI*FN23 499 CALL ZSQRT(SUMAR, SUMAI, ZAR, ZAI) 500 CALL ZSQRT(W2R, W2I, STR, STI) 501 ZETA2R = STR*FNU 502 ZETA2I = STI*FNU 503 STR = CONER + EX2*(ZETAR*ZAR-ZETAI*ZAI) 504 STI = CONEI + EX2*(ZETAR*ZAI+ZETAI*ZAR) 505 ZETA1R = STR*ZETA2R - STI*ZETA2I 506 ZETA1I = STR*ZETA2I + STI*ZETA2R 507 ZAR = ZAR + ZAR 508 ZAI = ZAI + ZAI 509 CALL ZSQRT(ZAR, ZAI, STR, STI) 510 PHIR = STR*RFN13 511 PHII = STI*RFN13 512 IF (IPMTR.EQ.1) GO TO 120 513C----------------------------------------------------------------------- 514C SUM SERIES FOR ASUM AND BSUM 515C----------------------------------------------------------------------- 516 SUMBR = ZEROR 517 SUMBI = ZEROI 518 DO 30 K=1,KMAX 519 SUMBR = SUMBR + PR(K)*BETA(K) 520 SUMBI = SUMBI + PI(K)*BETA(K) 521 30 CONTINUE 522 ASUMR = ZEROR 523 ASUMI = ZEROI 524 BSUMR = SUMBR 525 BSUMI = SUMBI 526 L1 = 0 527 L2 = 30 528 BTOL = TOL*(ABS(BSUMR)+ABS(BSUMI)) 529 ATOL = TOL 530 PP = 1.0D0 531 IAS = 0 532 IBS = 0 533 IF (RFNU2.LT.TOL) GO TO 110 534 DO 100 IS=2,7 535 ATOL = ATOL/RFNU2 536 PP = PP*RFNU2 537 IF (IAS.EQ.1) GO TO 60 538 SUMAR = ZEROR 539 SUMAI = ZEROI 540 DO 40 K=1,KMAX 541 M = L1 + K 542 SUMAR = SUMAR + PR(K)*ALFA(M) 543 SUMAI = SUMAI + PI(K)*ALFA(M) 544 IF (AP(K).LT.ATOL) GO TO 50 545 40 CONTINUE 546 50 CONTINUE 547 ASUMR = ASUMR + SUMAR*PP 548 ASUMI = ASUMI + SUMAI*PP 549 IF (PP.LT.TOL) IAS = 1 550 60 CONTINUE 551 IF (IBS.EQ.1) GO TO 90 552 SUMBR = ZEROR 553 SUMBI = ZEROI 554 DO 70 K=1,KMAX 555 M = L2 + K 556 SUMBR = SUMBR + PR(K)*BETA(M) 557 SUMBI = SUMBI + PI(K)*BETA(M) 558 IF (AP(K).LT.ATOL) GO TO 80 559 70 CONTINUE 560 80 CONTINUE 561 BSUMR = BSUMR + SUMBR*PP 562 BSUMI = BSUMI + SUMBI*PP 563 IF (PP.LT.BTOL) IBS = 1 564 90 CONTINUE 565 IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 110 566 L1 = L1 + 30 567 L2 = L2 + 30 568 100 CONTINUE 569 110 CONTINUE 570 ASUMR = ASUMR + CONER 571 PP = RFNU*RFN13 572 BSUMR = BSUMR*PP 573 BSUMI = BSUMI*PP 574 120 CONTINUE 575 RETURN 576C----------------------------------------------------------------------- 577C ABS(W2).GT.0.25D0 578C----------------------------------------------------------------------- 579 130 CONTINUE 580 CALL ZSQRT(W2R, W2I, WR, WI) 581 IF (WR.LT.0.0D0) WR = 0.0D0 582 IF (WI.LT.0.0D0) WI = 0.0D0 583 STR = CONER + WR 584 STI = WI 585 CALL ZDIV(STR, STI, ZBR, ZBI, ZAR, ZAI) 586 CALL ZLOG(ZAR, ZAI, ZCR, ZCI, IDUM) 587 IF (ZCI.LT.0.0D0) ZCI = 0.0D0 588 IF (ZCI.GT.HPI) ZCI = HPI 589 IF (ZCR.LT.0.0D0) ZCR = 0.0D0 590 ZTHR = (ZCR-WR)*1.5D0 591 ZTHI = (ZCI-WI)*1.5D0 592 ZETA1R = ZCR*FNU 593 ZETA1I = ZCI*FNU 594 ZETA2R = WR*FNU 595 ZETA2I = WI*FNU 596 AZTH = ZABS(ZTHR,ZTHI) 597 ANG = THPI 598 IF (ZTHR.GE.0.0D0 .AND. ZTHI.LT.0.0D0) GO TO 140 599 ANG = HPI 600 IF (ZTHR.EQ.0.0D0) GO TO 140 601 ANG = DATAN(ZTHI/ZTHR) 602 IF (ZTHR.LT.0.0D0) ANG = ANG + GPI 603 140 CONTINUE 604 PP = AZTH**EX2 605 ANG = ANG*EX2 606 ZETAR = PP*COS(ANG) 607 ZETAI = PP*SIN(ANG) 608 IF (ZETAI.LT.0.0D0) ZETAI = 0.0D0 609 ARGR = ZETAR*FN23 610 ARGI = ZETAI*FN23 611 CALL ZDIV(ZTHR, ZTHI, ZETAR, ZETAI, RTZTR, RTZTI) 612 CALL ZDIV(RTZTR, RTZTI, WR, WI, ZAR, ZAI) 613 TZAR = ZAR + ZAR 614 TZAI = ZAI + ZAI 615 CALL ZSQRT(TZAR, TZAI, STR, STI) 616 PHIR = STR*RFN13 617 PHII = STI*RFN13 618 IF (IPMTR.EQ.1) GO TO 120 619 RAW = 1.0D0/SQRT(AW2) 620 STR = WR*RAW 621 STI = -WI*RAW 622 TFNR = STR*RFNU*RAW 623 TFNI = STI*RFNU*RAW 624 RAZTH = 1.0D0/AZTH 625 STR = ZTHR*RAZTH 626 STI = -ZTHI*RAZTH 627 RZTHR = STR*RAZTH*RFNU 628 RZTHI = STI*RAZTH*RFNU 629 ZCR = RZTHR*AR(2) 630 ZCI = RZTHI*AR(2) 631 RAW2 = 1.0D0/AW2 632 STR = W2R*RAW2 633 STI = -W2I*RAW2 634 T2R = STR*RAW2 635 T2I = STI*RAW2 636 STR = T2R*C(2) + C(3) 637 STI = T2I*C(2) 638 UPR(2) = STR*TFNR - STI*TFNI 639 UPI(2) = STR*TFNI + STI*TFNR 640 BSUMR = UPR(2) + ZCR 641 BSUMI = UPI(2) + ZCI 642 ASUMR = ZEROR 643 ASUMI = ZEROI 644 IF (RFNU.LT.TOL) GO TO 220 645 PRZTHR = RZTHR 646 PRZTHI = RZTHI 647 PTFNR = TFNR 648 PTFNI = TFNI 649 UPR(1) = CONER 650 UPI(1) = CONEI 651 PP = 1.0D0 652 BTOL = TOL*(ABS(BSUMR)+ABS(BSUMI)) 653 KS = 0 654 KP1 = 2 655 L = 3 656 IAS = 0 657 IBS = 0 658 DO 210 LR=2,12,2 659 LRP1 = LR + 1 660C----------------------------------------------------------------------- 661C COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN 662C NEXT SUMA AND SUMB 663C----------------------------------------------------------------------- 664 DO 160 K=LR,LRP1 665 KS = KS + 1 666 KP1 = KP1 + 1 667 L = L + 1 668 ZAR = C(L) 669 ZAI = ZEROI 670 DO 150 J=2,KP1 671 L = L + 1 672 STR = ZAR*T2R - T2I*ZAI + C(L) 673 ZAI = ZAR*T2I + ZAI*T2R 674 ZAR = STR 675 150 CONTINUE 676 STR = PTFNR*TFNR - PTFNI*TFNI 677 PTFNI = PTFNR*TFNI + PTFNI*TFNR 678 PTFNR = STR 679 UPR(KP1) = PTFNR*ZAR - PTFNI*ZAI 680 UPI(KP1) = PTFNI*ZAR + PTFNR*ZAI 681 CRR(KS) = PRZTHR*BR(KS+1) 682 CRI(KS) = PRZTHI*BR(KS+1) 683 STR = PRZTHR*RZTHR - PRZTHI*RZTHI 684 PRZTHI = PRZTHR*RZTHI + PRZTHI*RZTHR 685 PRZTHR = STR 686 DRR(KS) = PRZTHR*AR(KS+2) 687 DRI(KS) = PRZTHI*AR(KS+2) 688 160 CONTINUE 689 PP = PP*RFNU2 690 IF (IAS.EQ.1) GO TO 180 691 SUMAR = UPR(LRP1) 692 SUMAI = UPI(LRP1) 693 JU = LRP1 694 DO 170 JR=1,LR 695 JU = JU - 1 696 SUMAR = SUMAR + CRR(JR)*UPR(JU) - CRI(JR)*UPI(JU) 697 SUMAI = SUMAI + CRR(JR)*UPI(JU) + CRI(JR)*UPR(JU) 698 170 CONTINUE 699 ASUMR = ASUMR + SUMAR 700 ASUMI = ASUMI + SUMAI 701 TEST = ABS(SUMAR) + ABS(SUMAI) 702 IF (PP.LT.TOL .AND. TEST.LT.TOL) IAS = 1 703 180 CONTINUE 704 IF (IBS.EQ.1) GO TO 200 705 SUMBR = UPR(LR+2) + UPR(LRP1)*ZCR - UPI(LRP1)*ZCI 706 SUMBI = UPI(LR+2) + UPR(LRP1)*ZCI + UPI(LRP1)*ZCR 707 JU = LRP1 708 DO 190 JR=1,LR 709 JU = JU - 1 710 SUMBR = SUMBR + DRR(JR)*UPR(JU) - DRI(JR)*UPI(JU) 711 SUMBI = SUMBI + DRR(JR)*UPI(JU) + DRI(JR)*UPR(JU) 712 190 CONTINUE 713 BSUMR = BSUMR + SUMBR 714 BSUMI = BSUMI + SUMBI 715 TEST = ABS(SUMBR) + ABS(SUMBI) 716 IF (PP.LT.BTOL .AND. TEST.LT.BTOL) IBS = 1 717 200 CONTINUE 718 IF (IAS.EQ.1 .AND. IBS.EQ.1) GO TO 220 719 210 CONTINUE 720 220 CONTINUE 721 ASUMR = ASUMR + CONER 722 STR = -BSUMR*RFN13 723 STI = -BSUMI*RFN13 724 CALL ZDIV(STR, STI, RTZTR, RTZTI, BSUMR, BSUMI) 725 GO TO 120 726 END 727