zunhj.f

Go to the documentation of this file.

      SUBROUTINE zunhj(ZR, ZI, FNU, IPMTR, TOL, PHIR, PHII, ARGR, ARGI,
     * ZETA1R, ZETA1I, ZETA2R, ZETA2I, ASUMR, ASUMI, BSUMR, BSUMI)
C***BEGIN PROLOGUE  ZUNHJ
C***REFER TO  ZBESI,ZBESK
C
C     REFERENCES
C         HANDBOOK OF MATHEMATICAL FUNCTIONS BY M. ABRAMOWITZ AND I.A.
C         STEGUN, AMS55, NATIONAL BUREAU OF STANDARDS, 1965, CHAPTER 9.
C
C         ASYMPTOTICS AND SPECIAL FUNCTIONS BY F.W.J. OLVER, ACADEMIC
C         PRESS, N.Y., 1974, PAGE 420
C
C     ABSTRACT
C         ZUNHJ COMPUTES PARAMETERS FOR BESSEL FUNCTIONS C(FNU,Z) =
C         J(FNU,Z), Y(FNU,Z) OR H(I,FNU,Z) I=1,2 FOR LARGE ORDERS FNU
C         BY MEANS OF THE UNIFORM ASYMPTOTIC EXPANSION
C
C         C(FNU,Z)=C1*PHI*( ASUM*AIRY(ARG) + C2*BSUM*DAIRY(ARG) )
C
C         FOR PROPER CHOICES OF C1, C2, AIRY AND DAIRY WHERE AIRY IS
C         AN AIRY FUNCTION AND DAIRY IS ITS DERIVATIVE.
C
C               (2/3)*FNU*ZETA**1.5 = ZETA1-ZETA2,
C
C         ZETA1=0.5*FNU*CLOG((1+W)/(1-W)), ZETA2=FNU*W FOR SCALING
C         PURPOSES IN AIRY FUNCTIONS FROM CAIRY OR CBIRY.
C
C         MCONJ=SIGN OF AIMAG(Z), BUT IS AMBIGUOUS WHEN Z IS REAL AND
C         MUST BE SPECIFIED. IPMTR=0 RETURNS ALL PARAMETERS. IPMTR=
C         1 COMPUTES ALL EXCEPT ASUM AND BSUM.
C
C***ROUTINES CALLED  XZABS,ZDIV,XZLOG,XZSQRT,D1MACH
C***END PROLOGUE  ZUNHJ
C     COMPLEX ARG,ASUM,BSUM,CFNU,CONE,CR,CZERO,DR,P,PHI,PRZTH,PTFN,
C    *RFN13,RTZTA,RZTH,SUMA,SUMB,TFN,T2,UP,W,W2,Z,ZA,ZB,ZC,ZETA,ZETA1,
C    *ZETA2,ZTH
      DOUBLE PRECISION ALFA, ANG, AP, AR, ARGI, ARGR, ASUMI, ASUMR,
     * atol, aw2, azth, beta, br, bsumi, bsumr, btol, c, conei, coner,
     * cri, crr, dri, drr, ex1, ex2, fnu, fn13, fn23, gama, gpi, hpi,
     * phii, phir, pi, pp, pr, przthi, przthr, ptfni, ptfnr, raw, raw2,
     * razth, rfnu, rfnu2, rfn13, rtzti, rtztr, rzthi, rzthr, sti, str,
     * sumai, sumar, sumbi, sumbr, test, tfni, tfnr, thpi, tol, tzai,
     * tzar, t2i, t2r, upi, upr, wi, wr, w2i, w2r, zai, zar, zbi, zbr,
     * zci, zcr, zeroi, zeror, zetai, zetar, zeta1i, zeta1r, zeta2i,
     * zeta2r, zi, zr, zthi, zthr, xzabs, ac, d1mach
      INTEGER IAS, IBS, IPMTR, IS, J, JR, JU, K, KMAX, KP1, KS, L, LR,
     * lrp1, l1, l2, m, idum
      dimension ar(14), br(14), c(105), alfa(180), beta(210), gama(30),
     * ap(30), pr(30), pi(30), upr(14), upi(14), crr(14), cri(14),
     * drr(14), dri(14)
      DATA ar(1), ar(2), ar(3), ar(4), ar(5), ar(6), ar(7), ar(8),
     1     ar(9), ar(10), ar(11), ar(12), ar(13), ar(14)/
     2     1.00000000000000000d+00,     1.04166666666666667d-01,
     3     8.35503472222222222d-02,     1.28226574556327160d-01,
     4     2.91849026464140464d-01,     8.81627267443757652d-01,
     5     3.32140828186276754d+00,     1.49957629868625547d+01,
     6     7.89230130115865181d+01,     4.74451538868264323d+02,
     7     3.20749009089066193d+03,     2.40865496408740049d+04,
     8     1.98923119169509794d+05,     1.79190200777534383d+06/
      DATA br(1), br(2), br(3), br(4), br(5), br(6), br(7), br(8),
     1     br(9), br(10), br(11), br(12), br(13), br(14)/
     2     1.00000000000000000d+00,    -1.45833333333333333d-01,
     3    -9.87413194444444444d-02,    -1.43312053915895062d-01,
     4    -3.17227202678413548d-01,    -9.42429147957120249d-01,
     5    -3.51120304082635426d+00,    -1.57272636203680451d+01,
     6    -8.22814390971859444d+01,    -4.92355370523670524d+02,
     7    -3.31621856854797251d+03,    -2.48276742452085896d+04,
     8    -2.04526587315129788d+05,    -1.83844491706820990d+06/
      DATA c(1), c(2), c(3), c(4), c(5), c(6), c(7), c(8), c(9), c(10),
     1     c(11), c(12), c(13), c(14), c(15), c(16), c(17), c(18),
     2     c(19), c(20), c(21), c(22), c(23), c(24)/
     3     1.00000000000000000d+00,    -2.08333333333333333d-01,
     4     1.25000000000000000d-01,     3.34201388888888889d-01,
     5    -4.01041666666666667d-01,     7.03125000000000000d-02,
     6    -1.02581259645061728d+00,     1.84646267361111111d+00,
     7    -8.91210937500000000d-01,     7.32421875000000000d-02,
     8     4.66958442342624743d+00,    -1.12070026162229938d+01,
     9     8.78912353515625000d+00,    -2.36408691406250000d+00,
     a     1.12152099609375000d-01,    -2.82120725582002449d+01,
     b     8.46362176746007346d+01,    -9.18182415432400174d+01,
     c     4.25349987453884549d+01,    -7.36879435947963170d+00,
     d     2.27108001708984375d-01,     2.12570130039217123d+02,
     e    -7.65252468141181642d+02,     1.05999045252799988d+03/
      DATA c(25), c(26), c(27), c(28), c(29), c(30), c(31), c(32),
     1     c(33), c(34), c(35), c(36), c(37), c(38), c(39), c(40),
     2     c(41), c(42), c(43), c(44), c(45), c(46), c(47), c(48)/
     3    -6.99579627376132541d+02,     2.18190511744211590d+02,
     4    -2.64914304869515555d+01,     5.72501420974731445d-01,
     5    -1.91945766231840700d+03,     8.06172218173730938d+03,
     6    -1.35865500064341374d+04,     1.16553933368645332d+04,
     7    -5.30564697861340311d+03,     1.20090291321635246d+03,
     8    -1.08090919788394656d+02,     1.72772750258445740d+00,
     9     2.02042913309661486d+04,    -9.69805983886375135d+04,
     a     1.92547001232531532d+05,    -2.03400177280415534d+05,
     b     1.22200464983017460d+05,    -4.11926549688975513d+04,
     c     7.10951430248936372d+03,    -4.93915304773088012d+02,
     d     6.07404200127348304d+00,    -2.42919187900551333d+05,
     e     1.31176361466297720d+06,    -2.99801591853810675d+06/
      DATA c(49), c(50), c(51), c(52), c(53), c(54), c(55), c(56),
     1     c(57), c(58), c(59), c(60), c(61), c(62), c(63), c(64),
     2     c(65), c(66), c(67), c(68), c(69), c(70), c(71), c(72)/
     3     3.76327129765640400d+06,    -2.81356322658653411d+06,
     4     1.26836527332162478d+06,    -3.31645172484563578d+05,
     5     4.52187689813627263d+04,    -2.49983048181120962d+03,
     6     2.43805296995560639d+01,     3.28446985307203782d+06,
     7    -1.97068191184322269d+07,     5.09526024926646422d+07,
     8    -7.41051482115326577d+07,     6.63445122747290267d+07,
     9    -3.75671766607633513d+07,     1.32887671664218183d+07,
     a    -2.78561812808645469d+06,     3.08186404612662398d+05,
     b    -1.38860897537170405d+04,     1.10017140269246738d+02,
     c    -4.93292536645099620d+07,     3.25573074185765749d+08,
     d    -9.39462359681578403d+08,     1.55359689957058006d+09,
     e    -1.62108055210833708d+09,     1.10684281682301447d+09/
      DATA c(73), c(74), c(75), c(76), c(77), c(78), c(79), c(80),
     1     c(81), c(82), c(83), c(84), c(85), c(86), c(87), c(88),
     2     c(89), c(90), c(91), c(92), c(93), c(94), c(95), c(96)/
     3    -4.95889784275030309d+08,     1.42062907797533095d+08,
     4    -2.44740627257387285d+07,     2.24376817792244943d+06,
     5    -8.40054336030240853d+04,     5.51335896122020586d+02,
     6     8.14789096118312115d+08,    -5.86648149205184723d+09,
     7     1.86882075092958249d+10,    -3.46320433881587779d+10,
     8     4.12801855797539740d+10,    -3.30265997498007231d+10,
     9     1.79542137311556001d+10,    -6.56329379261928433d+09,
     a     1.55927986487925751d+09,    -2.25105661889415278d+08,
     b     1.73951075539781645d+07,    -5.49842327572288687d+05,
     c     3.03809051092238427d+03,    -1.46792612476956167d+10,
     d     1.14498237732025810d+11,    -3.99096175224466498d+11,
     e     8.19218669548577329d+11,    -1.09837515608122331d+12/
      DATA c(97), c(98), c(99), c(100), c(101), c(102), c(103), c(104),
     1     c(105)/
     2     1.00815810686538209d+12,    -6.45364869245376503d+11,
     3     2.87900649906150589d+11,    -8.78670721780232657d+10,
     4     1.76347306068349694d+10,    -2.16716498322379509d+09,
     5     1.43157876718888981d+08,    -3.87183344257261262d+06,
     6     1.82577554742931747d+04/
      DATA alfa(1), alfa(2), alfa(3), alfa(4), alfa(5), alfa(6),
     1     alfa(7), alfa(8), alfa(9), alfa(10), alfa(11), alfa(12),
     2     alfa(13), alfa(14), alfa(15), alfa(16), alfa(17), alfa(18),
     3     alfa(19), alfa(20), alfa(21), alfa(22)/
     4    -4.44444444444444444d-03,    -9.22077922077922078d-04,
     5    -8.84892884892884893d-05,     1.65927687832449737d-04,
     6     2.46691372741792910d-04,     2.65995589346254780d-04,
     7     2.61824297061500945d-04,     2.48730437344655609d-04,
     8     2.32721040083232098d-04,     2.16362485712365082d-04,
     9     2.00738858762752355d-04,     1.86267636637545172d-04,
     a     1.73060775917876493d-04,     1.61091705929015752d-04,
     b     1.50274774160908134d-04,     1.40503497391269794d-04,
     c     1.31668816545922806d-04,     1.23667445598253261d-04,
     d     1.16405271474737902d-04,     1.09798298372713369d-04,
     e     1.03772410422992823d-04,     9.82626078369363448d-05/
      DATA alfa(23), alfa(24), alfa(25), alfa(26), alfa(27), alfa(28),
     1     alfa(29), alfa(30), alfa(31), alfa(32), alfa(33), alfa(34),
     2     alfa(35), alfa(36), alfa(37), alfa(38), alfa(39), alfa(40),
     3     alfa(41), alfa(42), alfa(43), alfa(44)/
     4     9.32120517249503256d-05,     8.85710852478711718d-05,
     5     8.42963105715700223d-05,     8.03497548407791151d-05,
     6     7.66981345359207388d-05,     7.33122157481777809d-05,
     7     7.01662625163141333d-05,     6.72375633790160292d-05,
     8     6.93735541354588974d-04,     2.32241745182921654d-04,
     9    -1.41986273556691197d-05,    -1.16444931672048640d-04,
     a    -1.50803558053048762d-04,    -1.55121924918096223d-04,
     b    -1.46809756646465549d-04,    -1.33815503867491367d-04,
     c    -1.19744975684254051d-04,    -1.06184319207974020d-04,
     d    -9.37699549891194492d-05,    -8.26923045588193274d-05,
     e    -7.29374348155221211d-05,    -6.44042357721016283d-05/
      DATA alfa(45), alfa(46), alfa(47), alfa(48), alfa(49), alfa(50),
     1     alfa(51), alfa(52), alfa(53), alfa(54), alfa(55), alfa(56),
     2     alfa(57), alfa(58), alfa(59), alfa(60), alfa(61), alfa(62),
     3     alfa(63), alfa(64), alfa(65), alfa(66)/
     4    -5.69611566009369048d-05,    -5.04731044303561628d-05,
     5    -4.48134868008882786d-05,    -3.98688727717598864d-05,
     6    -3.55400532972042498d-05,    -3.17414256609022480d-05,
     7    -2.83996793904174811d-05,    -2.54522720634870566d-05,
     8    -2.28459297164724555d-05,    -2.05352753106480604d-05,
     9    -1.84816217627666085d-05,    -1.66519330021393806d-05,
     a    -1.50179412980119482d-05,    -1.35554031379040526d-05,
     b    -1.22434746473858131d-05,    -1.10641884811308169d-05,
     c    -3.54211971457743841d-04,    -1.56161263945159416d-04,
     d     3.04465503594936410d-05,     1.30198655773242693d-04,
     e     1.67471106699712269d-04,     1.70222587683592569d-04/
      DATA alfa(67), alfa(68), alfa(69), alfa(70), alfa(71), alfa(72),
     1     alfa(73), alfa(74), alfa(75), alfa(76), alfa(77), alfa(78),
     2     alfa(79), alfa(80), alfa(81), alfa(82), alfa(83), alfa(84),
     3     alfa(85), alfa(86), alfa(87), alfa(88)/
     4     1.56501427608594704d-04,     1.36339170977445120d-04,
     5     1.14886692029825128d-04,     9.45869093034688111d-05,
     6     7.64498419250898258d-05,     6.07570334965197354d-05,
     7     4.74394299290508799d-05,     3.62757512005344297d-05,
     8     2.69939714979224901d-05,     1.93210938247939253d-05,
     9     1.30056674793963203d-05,     7.82620866744496661d-06,
     a     3.59257485819351583d-06,     1.44040049814251817d-07,
     b    -2.65396769697939116d-06,    -4.91346867098485910d-06,
     c    -6.72739296091248287d-06,    -8.17269379678657923d-06,
     d    -9.31304715093561232d-06,    -1.02011418798016441d-05,
     e    -1.08805962510592880d-05,    -1.13875481509603555d-05/
      DATA alfa(89), alfa(90), alfa(91), alfa(92), alfa(93), alfa(94),
     1     alfa(95), alfa(96), alfa(97), alfa(98), alfa(99), alfa(100),
     2     alfa(101), alfa(102), alfa(103), alfa(104), alfa(105),
     3     alfa(106), alfa(107), alfa(108), alfa(109), alfa(110)/
     4    -1.17519675674556414d-05,    -1.19987364870944141d-05,
     5     3.78194199201772914d-04,     2.02471952761816167d-04,
     6    -6.37938506318862408d-05,    -2.38598230603005903d-04,
     7    -3.10916256027361568d-04,    -3.13680115247576316d-04,
     8    -2.78950273791323387d-04,    -2.28564082619141374d-04,
     9    -1.75245280340846749d-04,    -1.25544063060690348d-04,
     a    -8.22982872820208365d-05,    -4.62860730588116458d-05,
     b    -1.72334302366962267d-05,     5.60690482304602267d-06,
     c     2.31395443148286800d-05,     3.62642745856793957d-05,
     d     4.58006124490188752d-05,     5.24595294959114050d-05,
     e     5.68396208545815266d-05,     5.94349820393104052d-05/
      DATA alfa(111), alfa(112), alfa(113), alfa(114), alfa(115),
     1     alfa(116), alfa(117), alfa(118), alfa(119), alfa(120),
     2     alfa(121), alfa(122), alfa(123), alfa(124), alfa(125),
     3     alfa(126), alfa(127), alfa(128), alfa(129), alfa(130)/
     4     6.06478527578421742d-05,     6.08023907788436497d-05,
     5     6.01577894539460388d-05,     5.89199657344698500d-05,
     6     5.72515823777593053d-05,     5.52804375585852577d-05,
     7     5.31063773802880170d-05,     5.08069302012325706d-05,
     8     4.84418647620094842d-05,     4.60568581607475370d-05,
     9    -6.91141397288294174d-04,    -4.29976633058871912d-04,
     a     1.83067735980039018d-04,     6.60088147542014144d-04,
     b     8.75964969951185931d-04,     8.77335235958235514d-04,
     c     7.49369585378990637d-04,     5.63832329756980918d-04,
     d     3.68059319971443156d-04,     1.88464535514455599d-04/
      DATA alfa(131), alfa(132), alfa(133), alfa(134), alfa(135),
     1     alfa(136), alfa(137), alfa(138), alfa(139), alfa(140),
     2     alfa(141), alfa(142), alfa(143), alfa(144), alfa(145),
     3     alfa(146), alfa(147), alfa(148), alfa(149), alfa(150)/
     4     3.70663057664904149d-05,    -8.28520220232137023d-05,
     5    -1.72751952869172998d-04,    -2.36314873605872983d-04,
     6    -2.77966150694906658d-04,    -3.02079514155456919d-04,
     7    -3.12594712643820127d-04,    -3.12872558758067163d-04,
     8    -3.05678038466324377d-04,    -2.93226470614557331d-04,
     9    -2.77255655582934777d-04,    -2.59103928467031709d-04,
     a    -2.39784014396480342d-04,    -2.20048260045422848d-04,
     b    -2.00443911094971498d-04,    -1.81358692210970687d-04,
     c    -1.63057674478657464d-04,    -1.45712672175205844d-04,
     d    -1.29425421983924587d-04,    -1.14245691942445952d-04/
      DATA alfa(151), alfa(152), alfa(153), alfa(154), alfa(155),
     1     alfa(156), alfa(157), alfa(158), alfa(159), alfa(160),
     2     alfa(161), alfa(162), alfa(163), alfa(164), alfa(165),
     3     alfa(166), alfa(167), alfa(168), alfa(169), alfa(170)/
     4     1.92821964248775885d-03,     1.35592576302022234d-03,
     5    -7.17858090421302995d-04,    -2.58084802575270346d-03,
     6    -3.49271130826168475d-03,    -3.46986299340960628d-03,
     7    -2.82285233351310182d-03,    -1.88103076404891354d-03,
     8    -8.89531718383947600d-04,     3.87912102631035228d-06,
     9     7.28688540119691412d-04,     1.26566373053457758d-03,
     a     1.62518158372674427d-03,     1.83203153216373172d-03,
     b     1.91588388990527909d-03,     1.90588846755546138d-03,
     c     1.82798982421825727d-03,     1.70389506421121530d-03,
     d     1.55097127171097686d-03,     1.38261421852276159d-03/
      DATA alfa(171), alfa(172), alfa(173), alfa(174), alfa(175),
     1     alfa(176), alfa(177), alfa(178), alfa(179), alfa(180)/
     2     1.20881424230064774d-03,     1.03676532638344962d-03,
     3     8.71437918068619115d-04,     7.16080155297701002d-04,
     4     5.72637002558129372d-04,     4.42089819465802277d-04,
     5     3.24724948503090564d-04,     2.20342042730246599d-04,
     6     1.28412898401353882d-04,     4.82005924552095464d-05/
      DATA beta(1), beta(2), beta(3), beta(4), beta(5), beta(6),
     1     beta(7), beta(8), beta(9), beta(10), beta(11), beta(12),
     2     beta(13), beta(14), beta(15), beta(16), beta(17), beta(18),
     3     beta(19), beta(20), beta(21), beta(22)/
     4     1.79988721413553309d-02,     5.59964911064388073d-03,
     5     2.88501402231132779d-03,     1.80096606761053941d-03,
     6     1.24753110589199202d-03,     9.22878876572938311d-04,
     7     7.14430421727287357d-04,     5.71787281789704872d-04,
     8     4.69431007606481533d-04,     3.93232835462916638d-04,
     9     3.34818889318297664d-04,     2.88952148495751517d-04,
     a     2.52211615549573284d-04,     2.22280580798883327d-04,
     b     1.97541838033062524d-04,     1.76836855019718004d-04,
     c     1.59316899661821081d-04,     1.44347930197333986d-04,
     d     1.31448068119965379d-04,     1.20245444949302884d-04,
     e     1.10449144504599392d-04,     1.01828770740567258d-04/
      DATA beta(23), beta(24), beta(25), beta(26), beta(27), beta(28),
     1     beta(29), beta(30), beta(31), beta(32), beta(33), beta(34),
     2     beta(35), beta(36), beta(37), beta(38), beta(39), beta(40),
     3     beta(41), beta(42), beta(43), beta(44)/
     4     9.41998224204237509d-05,     8.74130545753834437d-05,
     5     8.13466262162801467d-05,     7.59002269646219339d-05,
     6     7.09906300634153481d-05,     6.65482874842468183d-05,
     7     6.25146958969275078d-05,     5.88403394426251749d-05,
     8    -1.49282953213429172d-03,    -8.78204709546389328d-04,
     9    -5.02916549572034614d-04,    -2.94822138512746025d-04,
     a    -1.75463996970782828d-04,    -1.04008550460816434d-04,
     b    -5.96141953046457895d-05,    -3.12038929076098340d-05,
     c    -1.26089735980230047d-05,    -2.42892608575730389d-07,
     d     8.05996165414273571d-06,     1.36507009262147391d-05,
     e     1.73964125472926261d-05,     1.98672978842133780d-05/
      DATA beta(45), beta(46), beta(47), beta(48), beta(49), beta(50),
     1     beta(51), beta(52), beta(53), beta(54), beta(55), beta(56),
     2     beta(57), beta(58), beta(59), beta(60), beta(61), beta(62),
     3     beta(63), beta(64), beta(65), beta(66)/
     4     2.14463263790822639d-05,     2.23954659232456514d-05,
     5     2.28967783814712629d-05,     2.30785389811177817d-05,
     6     2.30321976080909144d-05,     2.28236073720348722d-05,
     7     2.25005881105292418d-05,     2.20981015361991429d-05,
     8     2.16418427448103905d-05,     2.11507649256220843d-05,
     9     2.06388749782170737d-05,     2.01165241997081666d-05,
     a     1.95913450141179244d-05,     1.90689367910436740d-05,
     b     1.85533719641636667d-05,     1.80475722259674218d-05,
     c     5.52213076721292790d-04,     4.47932581552384646d-04,
     d     2.79520653992020589d-04,     1.52468156198446602d-04,
     e     6.93271105657043598d-05,     1.76258683069991397d-05/
      DATA beta(67), beta(68), beta(69), beta(70), beta(71), beta(72),
     1     beta(73), beta(74), beta(75), beta(76), beta(77), beta(78),
     2     beta(79), beta(80), beta(81), beta(82), beta(83), beta(84),
     3     beta(85), beta(86), beta(87), beta(88)/
     4    -1.35744996343269136d-05,    -3.17972413350427135d-05,
     5    -4.18861861696693365d-05,    -4.69004889379141029d-05,
     6    -4.87665447413787352d-05,    -4.87010031186735069d-05,
     7    -4.74755620890086638d-05,    -4.55813058138628452d-05,
     8    -4.33309644511266036d-05,    -4.09230193157750364d-05,
     9    -3.84822638603221274d-05,    -3.60857167535410501d-05,
     a    -3.37793306123367417d-05,    -3.15888560772109621d-05,
     b    -2.95269561750807315d-05,    -2.75978914828335759d-05,
     c    -2.58006174666883713d-05,    -2.41308356761280200d-05,
     d    -2.25823509518346033d-05,    -2.11479656768912971d-05,
     e    -1.98200638885294927d-05,    -1.85909870801065077d-05/
      DATA beta(89), beta(90), beta(91), beta(92), beta(93), beta(94),
     1     beta(95), beta(96), beta(97), beta(98), beta(99), beta(100),
     2     beta(101), beta(102), beta(103), beta(104), beta(105),
     3     beta(106), beta(107), beta(108), beta(109), beta(110)/
     4    -1.74532699844210224d-05,    -1.63997823854497997d-05,
     5    -4.74617796559959808d-04,    -4.77864567147321487d-04,
     6    -3.20390228067037603d-04,    -1.61105016119962282d-04,
     7    -4.25778101285435204d-05,     3.44571294294967503d-05,
     8     7.97092684075674924d-05,     1.03138236708272200d-04,
     9     1.12466775262204158d-04,     1.13103642108481389d-04,
     a     1.08651634848774268d-04,     1.01437951597661973d-04,
     b     9.29298396593363896d-05,     8.40293133016089978d-05,
     c     7.52727991349134062d-05,     6.69632521975730872d-05,
     d     5.92564547323194704d-05,     5.22169308826975567d-05,
     e     4.58539485165360646d-05,     4.01445513891486808d-05/
      DATA beta(111), beta(112), beta(113), beta(114), beta(115),
     1     beta(116), beta(117), beta(118), beta(119), beta(120),
     2     beta(121), beta(122), beta(123), beta(124), beta(125),
     3     beta(126), beta(127), beta(128), beta(129), beta(130)/
     4     3.50481730031328081d-05,     3.05157995034346659d-05,
     5     2.64956119950516039d-05,     2.29363633690998152d-05,
     6     1.97893056664021636d-05,     1.70091984636412623d-05,
     7     1.45547428261524004d-05,     1.23886640995878413d-05,
     8     1.04775876076583236d-05,     8.79179954978479373d-06,
     9     7.36465810572578444d-04,     8.72790805146193976d-04,
     a     6.22614862573135066d-04,     2.85998154194304147d-04,
     b     3.84737672879366102d-06,    -1.87906003636971558d-04,
     c    -2.97603646594554535d-04,    -3.45998126832656348d-04,
     d    -3.53382470916037712d-04,    -3.35715635775048757d-04/
      DATA beta(131), beta(132), beta(133), beta(134), beta(135),
     1     beta(136), beta(137), beta(138), beta(139), beta(140),
     2     beta(141), beta(142), beta(143), beta(144), beta(145),
     3     beta(146), beta(147), beta(148), beta(149), beta(150)/
     4    -3.04321124789039809d-04,    -2.66722723047612821d-04,
     5    -2.27654214122819527d-04,    -1.89922611854562356d-04,
     6    -1.55058918599093870d-04,    -1.23778240761873630d-04,
     7    -9.62926147717644187d-05,    -7.25178327714425337d-05,
     8    -5.22070028895633801d-05,    -3.50347750511900522d-05,
     9    -2.06489761035551757d-05,    -8.70106096849767054d-06,
     a     1.13698686675100290d-06,     9.16426474122778849d-06,
     b     1.56477785428872620d-05,     2.08223629482466847d-05,
     c     2.48923381004595156d-05,     2.80340509574146325d-05,
     d     3.03987774629861915d-05,     3.21156731406700616d-05/
      DATA beta(151), beta(152), beta(153), beta(154), beta(155),
     1     beta(156), beta(157), beta(158), beta(159), beta(160),
     2     beta(161), beta(162), beta(163), beta(164), beta(165),
     3     beta(166), beta(167), beta(168), beta(169), beta(170)/
     4    -1.80182191963885708d-03,    -2.43402962938042533d-03,
     5    -1.83422663549856802d-03,    -7.62204596354009765d-04,
     6     2.39079475256927218d-04,     9.49266117176881141d-04,
     7     1.34467449701540359d-03,     1.48457495259449178d-03,
     8     1.44732339830617591d-03,     1.30268261285657186d-03,
     9     1.10351597375642682d-03,     8.86047440419791759d-04,
     a     6.73073208165665473d-04,     4.77603872856582378d-04,
     b     3.05991926358789362d-04,     1.60315694594721630d-04,
     c     4.00749555270613286d-05,    -5.66607461635251611d-05,
     d    -1.32506186772982638d-04,    -1.90296187989614057d-04/
      DATA beta(171), beta(172), beta(173), beta(174), beta(175),
     1     beta(176), beta(177), beta(178), beta(179), beta(180),
     2     beta(181), beta(182), beta(183), beta(184), beta(185),
     3     beta(186), beta(187), beta(188), beta(189), beta(190)/
     4    -2.32811450376937408d-04,    -2.62628811464668841d-04,
     5    -2.82050469867598672d-04,    -2.93081563192861167d-04,
     6    -2.97435962176316616d-04,    -2.96557334239348078d-04,
     7    -2.91647363312090861d-04,    -2.83696203837734166d-04,
     8    -2.73512317095673346d-04,    -2.61750155806768580d-04,
     9     6.38585891212050914d-03,     9.62374215806377941d-03,
     a     7.61878061207001043d-03,     2.83219055545628054d-03,
     b    -2.09841352012720090d-03,    -5.73826764216626498d-03,
     c    -7.70804244495414620d-03,    -8.21011692264844401d-03,
     d    -7.65824520346905413d-03,    -6.47209729391045177d-03/
      DATA beta(191), beta(192), beta(193), beta(194), beta(195),
     1     beta(196), beta(197), beta(198), beta(199), beta(200),
     2     beta(201), beta(202), beta(203), beta(204), beta(205),
     3     beta(206), beta(207), beta(208), beta(209), beta(210)/
     4    -4.99132412004966473d-03,    -3.45612289713133280d-03,
     5    -2.01785580014170775d-03,    -7.59430686781961401d-04,
     6     2.84173631523859138d-04,     1.10891667586337403d-03,
     7     1.72901493872728771d-03,     2.16812590802684701d-03,
     8     2.45357710494539735d-03,     2.61281821058334862d-03,
     9     2.67141039656276912d-03,     2.65203073395980430d-03,
     a     2.57411652877287315d-03,     2.45389126236094427d-03,
     b     2.30460058071795494d-03,     2.13684837686712662d-03,
     c     1.95896528478870911d-03,     1.77737008679454412d-03,
     d     1.59690280765839059d-03,     1.42111975664438546d-03/
      DATA gama(1), gama(2), gama(3), gama(4), gama(5), gama(6),
     1     gama(7), gama(8), gama(9), gama(10), gama(11), gama(12),
     2     gama(13), gama(14), gama(15), gama(16), gama(17), gama(18),
     3     gama(19), gama(20), gama(21), gama(22)/
     4     6.29960524947436582d-01,     2.51984209978974633d-01,
     5     1.54790300415655846d-01,     1.10713062416159013d-01,
     6     8.57309395527394825d-02,     6.97161316958684292d-02,
     7     5.86085671893713576d-02,     5.04698873536310685d-02,
     8     4.42600580689154809d-02,     3.93720661543509966d-02,
     9     3.54283195924455368d-02,     3.21818857502098231d-02,
     a     2.94646240791157679d-02,     2.71581677112934479d-02,
     b     2.51768272973861779d-02,     2.34570755306078891d-02,
     c     2.19508390134907203d-02,     2.06210828235646240d-02,
     d     1.94388240897880846d-02,     1.83810633800683158d-02,
     e     1.74293213231963172d-02,     1.65685837786612353d-02/
      DATA gama(23), gama(24), gama(25), gama(26), gama(27), gama(28),
     1     gama(29), gama(30)/
     2     1.57865285987918445d-02,     1.50729501494095594d-02,
     3     1.44193250839954639d-02,     1.38184805735341786d-02,
     4     1.32643378994276568d-02,     1.27517121970498651d-02,
     5     1.22761545318762767d-02,     1.18338262398482403d-02/
      DATA ex1, ex2, hpi, gpi, thpi /
     1     3.33333333333333333d-01,     6.66666666666666667d-01,
     2     1.57079632679489662d+00,     3.14159265358979324d+00,
     3     4.71238898038468986d+00/
      DATA zeror,zeroi,coner,conei / 0.0d0, 0.0d0, 1.0d0, 0.0d0 /
C
      rfnu = 1.0d0/fnu
C-----------------------------------------------------------------------
C     OVERFLOW TEST (Z/FNU TOO SMALL)
C-----------------------------------------------------------------------
      test = d1mach(1)*1.0d+3
      ac = fnu*test
      IF (dabs(zr).GT.ac .OR. dabs(zi).GT.ac) GO TO 15
      zeta1r = 2.0d0*dabs(dlog(test))+fnu
      zeta1i = 0.0d0
      zeta2r = fnu
      zeta2i = 0.0d0
      phir = 1.0d0
      phii = 0.0d0
      argr = 1.0d0
      argi = 0.0d0
      RETURN
   15 CONTINUE
      zbr = zr*rfnu
      zbi = zi*rfnu
      rfnu2 = rfnu*rfnu
C-----------------------------------------------------------------------
C     COMPUTE IN THE FOURTH QUADRANT
C-----------------------------------------------------------------------
      fn13 = fnu**ex1
      fn23 = fn13*fn13
      rfn13 = 1.0d0/fn13
      w2r = coner - zbr*zbr + zbi*zbi
      w2i = conei - zbr*zbi - zbr*zbi
      aw2 = xzabs(w2r,w2i)
      IF (aw2.GT.0.25d0) GO TO 130
C-----------------------------------------------------------------------
C     POWER SERIES FOR CABS(W2).LE.0.25D0
C-----------------------------------------------------------------------
      k = 1
      pr(1) = coner
      pi(1) = conei
      sumar = gama(1)
      sumai = zeroi
      ap(1) = 1.0d0
      IF (aw2.LT.tol) GO TO 20
      DO 10 k=2,30
        pr(k) = pr(k-1)*w2r - pi(k-1)*w2i
        pi(k) = pr(k-1)*w2i + pi(k-1)*w2r
        sumar = sumar + pr(k)*gama(k)
        sumai = sumai + pi(k)*gama(k)
        ap(k) = ap(k-1)*aw2
        IF (ap(k).LT.tol) GO TO 20
   10 CONTINUE
      k = 30
   20 CONTINUE
      kmax = k
      zetar = w2r*sumar - w2i*sumai
      zetai = w2r*sumai + w2i*sumar
      argr = zetar*fn23
      argi = zetai*fn23
      CALL xzsqrt(sumar, sumai, zar, zai)
      CALL xzsqrt(w2r, w2i, str, sti)
      zeta2r = str*fnu
      zeta2i = sti*fnu
      str = coner + ex2*(zetar*zar-zetai*zai)
      sti = conei + ex2*(zetar*zai+zetai*zar)
      zeta1r = str*zeta2r - sti*zeta2i
      zeta1i = str*zeta2i + sti*zeta2r
      zar = zar + zar
      zai = zai + zai
      CALL xzsqrt(zar, zai, str, sti)
      phir = str*rfn13
      phii = sti*rfn13
      IF (ipmtr.EQ.1) GO TO 120
C-----------------------------------------------------------------------
C     SUM SERIES FOR ASUM AND BSUM
C-----------------------------------------------------------------------
      sumbr = zeror
      sumbi = zeroi
      DO 30 k=1,kmax
        sumbr = sumbr + pr(k)*beta(k)
        sumbi = sumbi + pi(k)*beta(k)
   30 CONTINUE
      asumr = zeror
      asumi = zeroi
      bsumr = sumbr
      bsumi = sumbi
      l1 = 0
      l2 = 30
      btol = tol*(dabs(bsumr)+dabs(bsumi))
      atol = tol
      pp = 1.0d0
      ias = 0
      ibs = 0
      IF (rfnu2.LT.tol) GO TO 110
      DO 100 is=2,7
        atol = atol/rfnu2
        pp = pp*rfnu2
        IF (ias.EQ.1) GO TO 60
        sumar = zeror
        sumai = zeroi
        DO 40 k=1,kmax
          m = l1 + k
          sumar = sumar + pr(k)*alfa(m)
          sumai = sumai + pi(k)*alfa(m)
          IF (ap(k).LT.atol) GO TO 50
   40   CONTINUE
   50   CONTINUE
        asumr = asumr + sumar*pp
        asumi = asumi + sumai*pp
        IF (pp.LT.tol) ias = 1
   60   CONTINUE
        IF (ibs.EQ.1) GO TO 90
        sumbr = zeror
        sumbi = zeroi
        DO 70 k=1,kmax
          m = l2 + k
          sumbr = sumbr + pr(k)*beta(m)
          sumbi = sumbi + pi(k)*beta(m)
          IF (ap(k).LT.atol) GO TO 80
   70   CONTINUE
   80   CONTINUE
        bsumr = bsumr + sumbr*pp
        bsumi = bsumi + sumbi*pp
        IF (pp.LT.btol) ibs = 1
   90   CONTINUE
        IF (ias.EQ.1 .AND. ibs.EQ.1) GO TO 110
        l1 = l1 + 30
        l2 = l2 + 30
  100 CONTINUE
  110 CONTINUE
      asumr = asumr + coner
      pp = rfnu*rfn13
      bsumr = bsumr*pp
      bsumi = bsumi*pp
  120 CONTINUE
      RETURN
C-----------------------------------------------------------------------
C     CABS(W2).GT.0.25D0
C-----------------------------------------------------------------------
  130 CONTINUE
      CALL xzsqrt(w2r, w2i, wr, wi)
      IF (wr.LT.0.0d0) wr = 0.0d0
      IF (wi.LT.0.0d0) wi = 0.0d0
      str = coner + wr
      sti = wi
      CALL zdiv(str, sti, zbr, zbi, zar, zai)
      CALL xzlog(zar, zai, zcr, zci, idum)
      IF (zci.LT.0.0d0) zci = 0.0d0
      IF (zci.GT.hpi) zci = hpi
      IF (zcr.LT.0.0d0) zcr = 0.0d0
      zthr = (zcr-wr)*1.5d0
      zthi = (zci-wi)*1.5d0
      zeta1r = zcr*fnu
      zeta1i = zci*fnu
      zeta2r = wr*fnu
      zeta2i = wi*fnu
      azth = xzabs(zthr,zthi)
      ang = thpi
      IF (zthr.GE.0.0d0 .AND. zthi.LT.0.0d0) GO TO 140
      ang = hpi
      IF (zthr.EQ.0.0d0) GO TO 140
      ang = datan(zthi/zthr)
      IF (zthr.LT.0.0d0) ang = ang + gpi
  140 CONTINUE
      pp = azth**ex2
      ang = ang*ex2
      zetar = pp*dcos(ang)
      zetai = pp*dsin(ang)
      IF (zetai.LT.0.0d0) zetai = 0.0d0
      argr = zetar*fn23
      argi = zetai*fn23
      CALL zdiv(zthr, zthi, zetar, zetai, rtztr, rtzti)
      CALL zdiv(rtztr, rtzti, wr, wi, zar, zai)
      tzar = zar + zar
      tzai = zai + zai
      CALL xzsqrt(tzar, tzai, str, sti)
      phir = str*rfn13
      phii = sti*rfn13
      IF (ipmtr.EQ.1) GO TO 120
      raw = 1.0d0/dsqrt(aw2)
      str = wr*raw
      sti = -wi*raw
      tfnr = str*rfnu*raw
      tfni = sti*rfnu*raw
      razth = 1.0d0/azth
      str = zthr*razth
      sti = -zthi*razth
      rzthr = str*razth*rfnu
      rzthi = sti*razth*rfnu
      zcr = rzthr*ar(2)
      zci = rzthi*ar(2)
      raw2 = 1.0d0/aw2
      str = w2r*raw2
      sti = -w2i*raw2
      t2r = str*raw2
      t2i = sti*raw2
      str = t2r*c(2) + c(3)
      sti = t2i*c(2)
      upr(2) = str*tfnr - sti*tfni
      upi(2) = str*tfni + sti*tfnr
      bsumr = upr(2) + zcr
      bsumi = upi(2) + zci
      asumr = zeror
      asumi = zeroi
      IF (rfnu.LT.tol) GO TO 220
      przthr = rzthr
      przthi = rzthi
      ptfnr = tfnr
      ptfni = tfni
      upr(1) = coner
      upi(1) = conei
      pp = 1.0d0
      btol = tol*(dabs(bsumr)+dabs(bsumi))
      ks = 0
      kp1 = 2
      l = 3
      ias = 0
      ibs = 0
      DO 210 lr=2,12,2
        lrp1 = lr + 1
C-----------------------------------------------------------------------
C     COMPUTE TWO ADDITIONAL CR, DR, AND UP FOR TWO MORE TERMS IN
C     NEXT SUMA AND SUMB
C-----------------------------------------------------------------------
        DO 160 k=lr,lrp1
          ks = ks + 1
          kp1 = kp1 + 1
          l = l + 1
          zar = c(l)
          zai = zeroi
          DO 150 j=2,kp1
            l = l + 1
            str = zar*t2r - t2i*zai + c(l)
            zai = zar*t2i + zai*t2r
            zar = str
  150     CONTINUE
          str = ptfnr*tfnr - ptfni*tfni
          ptfni = ptfnr*tfni + ptfni*tfnr
          ptfnr = str
          upr(kp1) = ptfnr*zar - ptfni*zai
          upi(kp1) = ptfni*zar + ptfnr*zai
          crr(ks) = przthr*br(ks+1)
          cri(ks) = przthi*br(ks+1)
          str = przthr*rzthr - przthi*rzthi
          przthi = przthr*rzthi + przthi*rzthr
          przthr = str
          drr(ks) = przthr*ar(ks+2)
          dri(ks) = przthi*ar(ks+2)
  160   CONTINUE
        pp = pp*rfnu2
        IF (ias.EQ.1) GO TO 180
        sumar = upr(lrp1)
        sumai = upi(lrp1)
        ju = lrp1
        DO 170 jr=1,lr
          ju = ju - 1
          sumar = sumar + crr(jr)*upr(ju) - cri(jr)*upi(ju)
          sumai = sumai + crr(jr)*upi(ju) + cri(jr)*upr(ju)
  170   CONTINUE
        asumr = asumr + sumar
        asumi = asumi + sumai
        test = dabs(sumar) + dabs(sumai)
        IF (pp.LT.tol .AND. test.LT.tol) ias = 1
  180   CONTINUE
        IF (ibs.EQ.1) GO TO 200
        sumbr = upr(lr+2) + upr(lrp1)*zcr - upi(lrp1)*zci
        sumbi = upi(lr+2) + upr(lrp1)*zci + upi(lrp1)*zcr
        ju = lrp1
        DO 190 jr=1,lr
          ju = ju - 1
          sumbr = sumbr + drr(jr)*upr(ju) - dri(jr)*upi(ju)
          sumbi = sumbi + drr(jr)*upi(ju) + dri(jr)*upr(ju)
  190   CONTINUE
        bsumr = bsumr + sumbr
        bsumi = bsumi + sumbi
        test = dabs(sumbr) + dabs(sumbi)
        IF (pp.LT.btol .AND. test.LT.btol) ibs = 1
  200   CONTINUE
        IF (ias.EQ.1 .AND. ibs.EQ.1) GO TO 220
  210 CONTINUE
  220 CONTINUE
      asumr = asumr + coner
      str = -bsumr*rfn13
      sti = -bsumi*rfn13
      CALL zdiv(str, sti, rtztr, rtzti, bsumr, bsumi)
      GO TO 120
      END