      SUBROUTINE HANKEL (ZR, ZI, IH)
      IMPLICIT REAL*8 (A - H, K, O - Z)
      INTEGER FLPS, FLQUAD
      COMMON /HAN/ H2R,H2I,H1R,H1I,H2PR,H2PI,H1PR,H1PI,R
      COMMON /LIMIT/ TLIM,EXPONT, SLIM
      DIMENSION A(40),B(40),C(40),D(40),C4(20),D4(20),ZMLA2(40),
     1 XPR(40), XPI(40), C5(20), D5(20), ZMLA5(20)
      DATA (A(I),I=1,36) /
     :   -1.5507278615487157 D-01,    5.16909287182905237D-03,
     1   -7.17929565531812830D-05,    5.43886034493797598D-07,
     2   -2.58993349758951237D-09,    8.46383495944285089D-12,
     3   -2.01519879986734545D-14,    3.65072246352779973D-17,
     4   -5.20045934975470047D-20,    5.97753948247666720D-23,
     5   -5.66054875234532879D-26,    4.49249900979787999D-29,
     6   -3.03137585006604588D-32,    1.76038086531129261D-35,
     7   -8.89081245106713441D-39,    3.94096296589855249D-42,
     8   -1.54547567290139313D-45,    5.39998488085741835D-49,
     9   -1.69172458673478018D-52,    4.77888301337508527D-56,
     :   -1.22347235365465573D-59,    2.85191690828591078D-63,
     :   -6.07825428023425146D-67,    1.18901687798009614D-70,
     :   -2.14237275311729034D-74,    3.56705420099448941D-78,
     :   -5.50471327313964415D-82,    7.89545793623012643D-86,
     :   -1.05526034966989126D-89,    1.31742865127327249D-93,
     :   -1.53977168218007537D-97,    1.68834614274131072D-101,
     :   -1.74020422875830830D-105,   1.68919067050893836D-109,
     :   -1.54687790339646370D-113,   1.33859285513712678D-117/
C                                                                               
      DATA (B(I),I=1,36) /
     1   -5.6524893762022989D-002,    1.34583080385769022D-03,
     1   -1.49536755984187802D-05,    9.58568948616588476D-08,
     2   -3.99403728590245199D-10,    1.16784715962060000D-12,
     3   -2.52780770480649350D-15,    4.21301284134415583D-18,
     4   -5.57276830865629078D-21,    5.99222398780246320D-24,
     5   -5.34066309073303316D-27,    4.00950682487464952D-30,
     6   -2.57019668261195482D-33,    1.42314323511182437D-36,
     7   -6.87508809232765398D-40,    2.92308167190801615D-43,
     8   -1.10221782500302268D-46,    3.71117112795630532D-50,
     9   -1.12255630004727929D-53,    3.06709371597617291D-57,
     A   -7.60687925589328600D-61,    1.72023501942408096D-64,
     B   -3.56156318721341813D-68,    6.77618566821426585D-72,
     C   -1.18880450319548524D-75,    1.92925106003811301D-79,
     D   -2.90462369773880309D-83,    4.06810041700112477D-87,
     E   -5.31361078500669380D-91,    6.48792525641842955D-95,
     F   -7.42155714529676224D-99,    7.96988525053346460D-103,
     G   -8.05038914195299455D-107,   7.66265861598419431D-111,
     H   -6.88468878345390325D-115,   5.84835948305632284D-119/
C                                                                               
      DATA (C(I),I=1,36) /
     1   -3.1014557230974314D-002,    6.46136608978631547D-04,
     1   -6.52663241392557118D-06,    3.88490024638426856D-08,
     2   -1.52349029269971316D-10,    4.23191747972142544D-13,
     3   -8.76173391246671935D-16,    1.40412402443376913D-18,
     4   -1.79326184474300016D-21,    1.86798108827395850D-24,
     5   -1.61729964352723680D-27,    1.18223658152575789D-30,
     6   -7.39359963430742897D-34,    4.00086560298021048D-37,
     7   -1.89166222363130519D-40,    7.88192593179710497D-44,
     8   -2.91599183566300591D-47,    9.64283014438824705D-51,
     9   -2.86732980802505116D-54,    7.70787582802433108D-58,
     A   -1.88226515946870112D-61,    4.19399545336163351D-65,
     B   -8.56092152145669220D-69,    1.60677956483796775D-72,
     C   -2.78230227677570174D-76,    4.45881775124311176D-80,
     D   -6.63218466643330621D-84,    9.18076504212805399D-88,
     E   -1.18568578614594524D-91,    1.43198766442747010D-95,
     F   -1.62081229703165829D-99,    1.72280218647072522D-103,
     G   -1.72297448391911713D-107,   1.62422179856628689D-111,
     H   -1.44568028354809692D-115,   1.21690259557920616D-119/
C                                                                               
      DATA (D(I),I=1,36) /
     1   -2.2609957504809195D-001,    9.42081562700383155D-03,
     1   -1.49536755984187802D-04,    1.24613963320156502D-06,
     2   -6.39045965744392318D-09,    2.21890960327913999D-11,
     3   -5.56117695057428569D-14,    1.05325321033603896D-16,
     4   -1.56037512642376142D-19,    1.85758943621876359D-22,
     5   -1.81582545084923127D-25,    1.48351752520362032D-28,
     6   -1.02807867304478193D-31,    6.11951591098084481D-35,
     7   -3.16254052247072083D-38,    1.43231001923492791D-41,
     8   -5.73153269001571794D-45,    2.04114412037596793D-48,
     9   -6.51082654027421986D-52,    1.87092716674546548D-55,
     A   -4.86840272377170304D-59,    1.15255746301413424D-62,
     B   -2.49309423104939269D-66,    4.94661553779641407D-70,
     C   -9.03491422428568780D-74,    1.52410833743010928D-77,
     D   -2.38179143214581853D-81,    3.45788535445095606D-85,
     E   -4.67597749080589054D-89,    5.90401198334077089D-93,
     F   -6.97626371657895650D-97,    7.73078869301746066D-101,
     G   -8.05038914195299455D-105,   7.89253837446372014D-109,
     H   -7.29777011046113744D-113,   6.37471183653139190D-117/
C                                                                               
      DATA(C4(I), I=1,19) /
     *      .1041666666666666666D000,     -.5876374421296296294D000,
     *     -.2290716053934337712D001,     -.5115246914604383039D001,
     *     -.9062847663874030839D001,     -.1413420435039637896D002,
     *     -.2032967817611733257D002,     -.2764948541118776109D002,
     *     -.3609376712592949187D002,     -.4566262114618547916D002,
     *     -.5635611849738394099D002,     -.6817431262327333036D002,
     *     -.8111724483308463849D002,     -.9518494701182174927D002,
     *     -.1103774469890957246D003,     -.1266948822584689090D003,
     *     -.1441391353710093869D003,     -.1627327073751970376D003,
     *     -.1826444261146441383D003/
      DATA(D4(I), I=1,19) /
     *     -.1458333333333333333D000,     -.5242693865740740734D000,
     *     -.2190010740010626122D001,     -.4986228080782250417D001,
     *     -.8910269876251375731D001,     -.1396107513192384956D002,
     *     -.2013810597032928847D002,     -.2744104880120119211D002,
     *     -.3586970305443466737D002,     -.4542393171194671533D002,
     *     -.5610363644805757000D002,     -.6790874395729851569D002,
     *     -.8083919802992951438D002,     -.9489495581082038481D002,
     *     -.1100759893558574910D003,     -.1263823305425793323D003,
     *     -.1438158255226323270D003,     -.1624125356051020867D003,
     *     -.1826430810500566861D003/
      DATA(C5(I), I=1,19) /
     *     -.8020833333333333322D000,     -.2285545023696682453D001,
     *     -.3778635359389885240D001,     -.5274623160711059862D001,
     *     -.6771926170404923857D001,     -.8269954941340274075D001,
     *     -.9768433620097970692D001,     -.1126721374768006806D002,
     *     -.1276620743800279721D002,     -.1426535892246475774D002,
     *     -.1576463088778327385D002,     -.1726399730395179650D002,
     *     -.1876343942052581175D002,     -.2026294344140785724D002,
     *     -.2176249668603070326D002,     -.2326204842605378820D002,
     *     -.2476104285001339985D002,     -.2625430055269059493D002,
     *     -.2772097924164600240D002/
      DATA(D5(I), I=1,19) /
     *     -.6770833333333333322D000,     -.2202914798206278015D001,
     *     -.3712590308861503947D001,     -.5218010289498877822D001,
     *     -.6721592615807936173D001,     -.8224186533352991837D001,
     *     -.9726176955678393129D001,     -.1122776696710578781D002,
     *     -.1272907520499096141D002,     -.1423017624892113601D002,
     *     -.1573111965670700007D002,     -.1723193982027220702D002,
     *     -.1873266140557309258D002,     -.2023330232819351955D002,
     *     -.2173387494048982910D002,     -.2323435992394561375D002,
     *     -.2473404635295374440D002,     -.2622252877088035571D002,
     *     -.2758686258346552864D002/
      DATA (ZMLA5(I), I=1,17) / 1.E9,715., 207., 103., 47., 36.4, 27.,
     * 22.6, 18.5, 16.6, 14.7, 14., 12.9, 12.2, 11.5, 10.8, 9.2 /
      DATA LA2, LA5 /36,17/
      DATA (ZMLA2(I),I=1,40) /
     12.6944301D-12,4.7348244D-6,7.0803713D-4,9.6398932D-3,
     24.9271494D-2,1.5267301D-1,3.5324772D-1,6.7835277D-1,
     31.1475215D0,1.7731141D0,2.5617749D0,3.9957181D0,5.2159327D0,
     46.6020702D0,8.1490972D0,9.8514112D0,1.2320405D1,1.4917923D1,
     51.7163634D1,1.9540309D1,2.3030246D1,2.6446844D1,2.9292820D1,
     63.3549744D1,3.7541246D1,4.0802980D1,4.5784933D1,5.0287133D1,
     75.3917166D1,5.9582285D1,6.4537858D1,7.0701377D1,7.5978472D1,
     88.0163399D1,8.6945766D1,9.2594255D1,9.983446D1,
     91.0575183D2,1.1039828D2,1.1820169D2/
      DATA   C1 / 0.57735 026918962576D0  /
      DATA   C2 / 0.66666 666666666666D0  /
      DATA   C3 / 0.86602 540378443864D0  /
      DATA FPI12 / 1.30899693899574718D0/
      DATA   CON4 / .7071067811865475244D0/
      A0 = 9.30436716929229427D-01
      B0 = 6.78298725144275871D-01
      C0 = 4.65218358464614714D-01
      D0 = 6.78298725144275871D-01
      K =   0.85366721883895156D0
      ZMSQ = ZR*ZR +ZI*ZI
      RZR = ZR
      TEMP = ZI
      IF (TEMP .LT. 0.) TEMP = -TEMP
      IF (RZR .LE. 0.) GO TO 51
      IF (RZR .GT. 4.4) GO TO 120
      TEM1 = 7. - .2632 * RZR**2
      IF (TEMP .GT. TEM1) GO TO 120
      GO TO 53
 51   IF (RZR .LT. -9.) GO TO 120
      TEM1 = 4.4 + .1375 * RZR
      IF (TEMP .GT. TEM1) GO TO 120
 53   FLPS = 1
      STORE1 = ZR*ZR-ZI*ZI
      STORE2 = 2.*ZR*ZI
      XR = STORE1*ZR -STORE2*ZI
      XI = STORE1*ZI +STORE2*ZR
      DO 55 MLS=1,LA2
      IF (ZMSQ - ZMLA2(MLS)) 62,62,55
 55   CONTINUE
 62   FR = A0
      FI = 0.0
      XPR(1) = XR
      XPI(1) = XI
      DO 65 M = 1,MLS
      FR=FR+A(M)*XPR(M)
      FI=FI+A(M)*XPI(M)
      XPR(M+1)=XR*XPR(M)-XI*XPI(M)
      XPI(M+1) = XI * XPR(M) + XR * XPI(M)
 65   CONTINUE
      GR=B0
      GI=0.0
      DO 72 M = 1,MLS
      GR=GR+B(M)*XPR(M)
      GI=GI+B(M)*XPI(M)
 72   CONTINUE
      X =ZR*GR-ZI*GI
      GI=ZR*GI+ZI*GR
      GR=X
      SR=-C1*(GI-FI-FI)
      SI=C1*(GR-FR-FR)
      H2R=GR-SR
      H2I=GI-SI
      GO TO 317
 120  FLPS = 0
      ZM = SQRT(ZMSQ)
      ZRT2M = SQRT(ZM)
      IF (ZR .LT. 0.D0) GO TO 125
      ZRT2R = SQRT (0.5D0 * (ZR + ZM))
      ZRT2I = ZI / (ZRT2R + ZRT2R)
      Z32R = ZR*ZRT2R - ZI*ZRT2I
      Z32I = ZR*ZRT2I + ZI*ZRT2R
      GO TO 130
 125  ZRT2I = SQRT (0.5D0 * (ZM - ZR))
      IF (ZI .LT. 0.D0) ZRT2I = -ZRT2I
      ZRT2R = ZI / (ZRT2I + ZRT2I)
      Z32R = ZR*ZRT2R - ZI*ZRT2I
      Z32I = ZR*ZRT2I + ZI*ZRT2R
      ZM1R = ABS(Z32I)
      IF (ZM1R .LT. TLIM) GO TO 130
      R = (TLIM / ZM1R)
      Z32R = Z32R * R
      R = R**(1.D0 /3.)
      ZRT2R = ZRT2R * R
      ZRT2I = ZRT2I * R
      ZRT2M = ZRT2M * R
      R = R * R
      ZM = ZM * R
      ZMSQ = ZM**2
      ZR = ZR * R
      ZI = ZI * R
 130  ZRT4R = SQRT (0.5D0 * (ZRT2R + ZRT2M))
      ZRT4I = 0.5D0 * ZRT2I / ZRT4R
      ZRTM4R = ZRT4R/ZRT2M
      ZRTM4I = -ZRT4I/ZRT2M
      IF (ZR .GT. 0.) GO TO 210
      IF (ZM1R .LT. TLIM) GO TO 210
      ABK = ABS(K2)
      IF (Z32I .GT. 0.) GO TO 205
      K1 = K * EXPONT
      K2 = K / EXPONT
      Z32I = -TLIM
      GO TO 220
 205  K2 = K * EXPONT
      K1 = K / EXPONT
      Z32I = TLIM
      GO TO 220
 210  K2 = C2 * Z32I
      S2 = EXP(K2)
      K2 = K*S2
      K1 = K/S2
 220  THR = FPI12 - C2 * Z32R
      STHR = SIN(THR)
      CTHR = COS(THR)
      STP = -C3*CTHR +0.5*STHR
      CTP = -C3*STHR -0.5*CTHR
      TEMP = ABS (Z32R)
      TEM1 = ABS (Z32I)
      IF (TEMP .LT. TEM1) TEMP = TEM1
 230  DO 235  ML = 1,LA5
      IF (TEMP .GT. ZMLA5(ML)) GO TO 250
 235  CONTINUE
 250  CONTINUE
      YR = Z32I
      YI = -Z32R
      CALL CFR (YR, YI, F2R, F2I, C4, C5, ML)
      CPR = F2R
      CPI = F2I
      STORE3=K2*(ZRTM4R*F2R-ZRTM4I*F2I)
      STORE4=K2*(ZRTM4I*F2R+ZRTM4R*F2I)
      H22R =STORE3*CTHR-STORE4*STHR
      H22I =STORE3*STHR+STORE4*CTHR
      IF (ZR) 280,270,270
 270  FLQUAD =0
      GO TO 300
 280  IF (ZI) 290,310,310
 290   FLQUAD = 1
 300  H2R = H22R
      H2I = H22I
      GO TO 317
 310  FLQUAD = -1
      YR = -Z32I
      YI = Z32R
      CALL CFR (YR, YI, F1R, F1I, C4, C5, ML)
      CPR = F1R
      CPI = F1I
      STORE5=K1*(ZRTM4R*F1R-ZRTM4I*F1I)
      STORE6=K1*(ZRTM4R*F1I+ZRTM4I*F1R)
      H21R=STORE5*CTP-STORE6*STP
      H21I=STORE5*STP+STORE6*CTP
      H2R=H21R+H22R
      H2I=H21I+H22I
 317  IF (IH .EQ. 2)GO TO 80
 60   IF (FLPS .NE. 1) GO TO 320
 70   H1R = GR+SR
      H1I = GI+SI
      GO TO 362
 320  IF (FLQUAD .LT. 0)GO TO 340
 330  YR = -Z32I
      YI = Z32R
      CALL CFR (YR, YI, F1R, F1I, C4, C5, ML)
 340  STORE7=K1*(ZRTM4R*F1R-ZRTM4I*F1I)
      STORE8=K1*(ZRTM4I*F1R+ZRTM4R*F1I)
      H11R=STORE7*CTHR+STORE8*STHR
      H11I=STORE7*(-STHR)+STORE8*CTHR
      IF (FLQUAD .LE. 0) GO TO 360
 350  STORE9=K2*(ZRTM4R*F2R-ZRTM4I*F2I)
      STOR10=K2*(ZRTM4I*F2R+ZRTM4R*F2I)
      H12R = STORE9*CTP+STOR10*STP
      H12I = STORE9*(-STP)+STOR10*CTP
      H1R = H11R+H12R
      H1I = H11I+H12I
      GO TO 362
 360  H1R = H11R
      H1I = H11I
 362  IF (IH .EQ. 1)GO TO 999
 80   IF (FLPS .NE. 1) GO TO 380
 90   FPR = C0
      FPI = 0.0
      DO 92 M = 1,MLS
      FPR=FPR+C(M)*XPR(M)
 92   FPI=FPI+C(M)*XPI(M)
      X  =-(STORE1*FPR-STORE2*FPI)
      FPI=-(STORE1*FPI+STORE2*FPR)
      FPR = X
      GPR = D0
      GPI = 0.0
      DO 94 M = 1,MLS
      GPR=GPR+D(M)*XPR(M)
 94   GPI=GPI+D(M)*XPI(M)
      SPR=-C1*(GPI-FPI-FPI)
      SPI=C1*(GPR-FPR-FPR)
      H2PR=GPR-SPR
      H2PI=GPI-SPI
      GO TO 414
 380  YR =  Z32I
      YI = -Z32R
      CALL CFR (YR, YI, G2R, G2I, D4, D5, ML)
      STOR11 = K2*(ZRT4R*G2R-ZRT4I*G2I)
      STOR12 = K2*(ZRT4R*G2I+ZRT4I*G2R)
      H22PR=STOR11*STHR+STOR12*CTHR
      H22PI=STOR11*(-CTHR) +STOR12*STHR
 390  IF (FLQUAD .LT. 0) GO TO 410
 400  H2PR = H22PR
      H2PI = H22PI
      GO TO 414
 410  YR = -Z32I
      YI = Z32R
      CALL CFR (YR, YI, G1R, G1I, D4, D5, ML)
      STOR13 = K1*(ZRT4R*G1R-ZRT4I*G1I)
      STOR14 = K1*(ZRT4R*G1I+ZRT4I*G1R)
      H21PR=STOR13*(-STP) -STOR14*CTP
      H21PI=STOR14*(-STP) +STOR13*CTP
      H2PR = H21PR+H22PR
      H2PI = H21PI+H22PI
 414  IF (IH .EQ. 2) GO TO 999
 100  IF (FLPS .NE. 1) GO TO 420
 110  H1PR = GPR+SPR
      H1PI = GPI+SPI
      GO TO 999
 420  IF (FLQUAD .LT. 0) GO TO 440
 430  YR = -Z32I
      YI = Z32R
      CALL CFR (YR, YI, G1R, G1I, D4, D5, ML)
 440  STOR15 = K1*(ZRT4R*G1R -ZRT4I*G1I)
      STOR16 = K1*(ZRT4R*G1I +ZRT4I*G1R)
      H11PR = STOR15*STHR -STOR16*CTHR
      H11PI = STOR15*CTHR +STOR16*STHR
 450  IF (FLQUAD .GT. 0) GO TO 470
 460  H1PR = H11PR
      H1PI = H11PI
      GO TO 999
 470  STOR17 = K2*(ZRT4R*G2R -ZRT4I*G2I)
      STOR18 = K2*(ZRT4R*G2I +ZRT4I*G2R)
      H12PR = STOR17*(-STP) +STOR18*CTP
      H12PI = STOR17*(-CTP) -STOR18*STP
      H1PR = H12PR+H11PR
      H1PI = H12PI+H11PI
 999  CONTINUE
      RETURN
      END


      SUBROUTINE CFR(X, Y, SR, SI, A, B, M)
      IMPLICIT REAL *8 (A-H,O-Z)
      DIMENSION A(*), B(*)
      SR = 0.D0
      SI = 0.D0
      DO 10 J = 1,M
      I = M - J + 1
      TEMR = X + SR + B(I)
      TEMI = Y + SI
      TEMP = A(I) / (TEMR**2 + TEMI**2)
      SR = TEMR * TEMP
      SI = -TEMI * TEMP
 10   CONTINUE
      SR = SR + 1.D0
      RETURN
      END
