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