      SUBROUTINE CBSSLK (A, CN, W)
C     ******************************************************************
C     FORTRAN SUBROUTINE FOR MODIFIED BESSEL FUNCTION OF SECOND KIND
C     ******************************************************************
C     A  = ARGUMENT (COMPLEX NUMBER)
C     CN = ORDER (REAL NUMBER)
C     W  = FUNCTION (COMPLEX NUMBER)
C     -------------------
      COMPLEX A, W
      REAL AN, IN, FN
      DIMENSION AZ(2), SZ(2), RZ(2), ZL(2), ZN(2)
      DIMENSION GN(5), CD(60), CE(60)
      DIMENSION TS(2), TM(2), SM(2), SL(2), SQ(2), SR(2), QF(2), PQ(2)
      DATA GN(1)/2.67893853470775/,  GN(2)/1.35411793942640/,
     1     GN(3)/1.00000000000000/,  GN(4)/.892979511569249/,
     2     GN(5)/.902745292950934/
      DATA CD(1) / 0.00000000000000E00/,  CD(2) /-1.64899505142212E-2/,
     1     CD(3) /-7.18621880068536E-2/,  CD(4) /-1.67086878124866E-1/,
     2     CD(5) /-3.02582250219469E-1/,  CD(6) /-4.80613945245927E-1/,
     3     CD(7) /-7.07075239357898E-1/,  CD(8) /-9.92995790539516E-1/,
     4     CD(9) /-1.35583925612592E00/,  CD(10)/-1.82105907899132E00/,
     5     CD(11)/-2.42482175310879E00/,  CD(12)/-3.21956655708750E00/,
     6     CD(13)/-4.28658077248384E00/,  CD(14)/-5.77022816798128E00/,
     7     CD(15)/-8.01371260952526E00/
      DATA CD(16)/ 0.00000000000000E00/,  CD(17)/-1.43634645193874E-2/,
     1     CD(18)/-6.82970613762194E-2/,  CD(19)/-1.62614594313292E-1/,
     2     CD(20)/-2.97453854394717E-1/,  CD(21)/-4.74905269210066E-1/,
     3     CD(22)/-7.00738020935054E-1/,  CD(23)/-9.85896148575488E-1/,
     4     CD(24)/-1.34779102478027E00/,  CD(25)/-1.81185027721404E00/,
     5     CD(26)/-2.41423269310999E00/,  CD(27)/-3.20738009691766E00/,
     6     CD(28)/-4.27258430158885E00/,  CD(29)/-5.75419973213219E00/,
     7     CD(30)/-7.99534689573026E00/
      DATA CD(31)/ 0.00000000000000E00/,  CD(32)/-1.00240816164779E-2/,
     1     CD(33)/-5.99787054739528E-2/,  CD(34)/-1.51634354299347E-1/,
     2     CD(35)/-2.84536839896524E-1/,  CD(36)/-4.60321823655018E-1/,
     3     CD(37)/-6.84413350523445E-1/,  CD(38)/-9.67511434953410E-1/,
     4     CD(39)/-1.32687600632023E00/,  CD(40)/-1.78785773017729E00/,
     5     CD(41)/-2.38658964041105E00/,  CD(42)/-3.17551709143577E00/,
     6     CD(43)/-4.23594209338649E00/,  CD(44)/-5.71219366103793E00/,
     7     CD(45)/-7.94717247697930E00/
      DATA CD(46)/ 0.00000000000000E00/,  CD(47)/-5.57742429879505E-3/,
     1     CD(48)/-4.99112944172476E-2/,  CD(49)/-1.37440911652397E-1/,
     2     CD(50)/-2.67233784710566E-1/,  CD(51)/-4.40380166808682E-1/,
     3     CD(52)/-6.61813614872541E-1/,  CD(53)/-9.41861077665017E-1/,
     4     CD(54)/-1.29754130468326E00/,  CD(55)/-1.75407696719816E00/,
     5     CD(56)/-2.34755299882276E00/,  CD(57)/-3.13041332689196E00/,
     6     CD(58)/-4.18397120563729E00/,  CD(59)/-5.65251799214994E00/,
     7     CD(60)/-7.87863959810677E00/
      DATA CE(1) / 0.00000000000000E00/,  CE(2) /-4.80942336387447E-3/,
     1     CE(3) /-1.31366200347759E-2/,  CE(4) /-1.94843834008458E-2/,
     2     CE(5) /-2.19948900032003E-2/,  CE(6) /-2.09396625676519E-2/,
     3     CE(7) /-1.74600268458650E-2/,  CE(8) /-1.27937813362085E-2/,
     4     CE(9) /-8.05234421796592E-3/,  CE(10)/-4.15817375002760E-3/,
     5     CE(11)/-1.64317738747922E-3/,  CE(12)/-4.49175585314709E-4/,
     6     CE(13)/-7.28594765574007E-5/,  CE(14)/-5.38265230658285E-6/,
     7     CE(15)/-9.93779048036289E-8/
      DATA CE(16)/ 0.00000000000000E00/,  CE(17)/-3.30813042285545E-3/,
     1     CE(18)/-7.99254148978034E-3/,  CE(19)/-1.11495395114937E-2/,
     2     CE(20)/-1.21494476705697E-2/,  CE(21)/-1.13105026157270E-2/,
     3     CE(22)/-9.29061638353528E-3/,  CE(23)/-6.73833882986422E-3/,
     4     CE(24)/-4.21202905342050E-3/,  CE(25)/-2.16563487211798E-3/,
     5     CE(26)/-8.53765538861239E-4/,  CE(27)/-2.33200049044042E-4/,
     6     CE(28)/-3.78457715452543E-5/,  CE(29)/-2.80039617976332E-6/,
     7     CE(30)/-5.18394383970871E-8/
      DATA CE(31)/ 0.00000000000000E00/,  CE(32)/ 8.35626961303607E-3/,
     1     CE(33)/ 1.42158979208058E-2/,  CE(34)/ 1.66149296043451E-2/,
     2     CE(35)/ 1.63213589155081E-2/,  CE(36)/ 1.42153292660657E-2/,
     3     CE(37)/ 1.11616518245676E-2/,  CE(38)/ 7.84652123541615E-3/,
     4     CE(39)/ 4.80077650522908E-3/,  CE(40)/ 2.43384130831436E-3/,
     5     CE(41)/ 9.51525149698134E-4/,  CE(42)/ 2.58924910973838E-4/,
     6     CE(43)/ 4.20190595178487E-5/,  CE(44)/ 3.11882510679533E-6/,
     7     CE(45)/ 5.80836240038579E-8/
      DATA CE(46)/ 0.00000000000000E00/,  CE(47)/ 7.53805779200591E-2/,
     1     CE(48)/ 7.12293537403464E-2/,  CE(49)/ 6.33116224228200E-2/,
     2     CE(50)/ 5.28240264523301E-2/,  CE(51)/ 4.13305359441492E-2/,
     3     CE(52)/ 3.01350573947510E-2/,  CE(53)/ 2.01043439592720E-2/,
     4     CE(54)/ 1.18552223068074E-2/,  CE(55)/ 5.86055510956010E-3/,
     5     CE(56)/ 2.25465148267325E-3/,  CE(57)/ 6.08173041536336E-4/,
     6     CE(58)/ 9.84215550625747E-5/,  CE(59)/ 7.32139093038089E-6/,
     7     CE(60)/ 1.37279667384666E-7/
C     -------------------
      AZ(1)=REAL(A)
      AZ(2)=AIMAG(A)
      ZS=AZ(1)*AZ(1)+AZ(2)*AZ(2)
      ZL(1)=0.5*ALOG(ZS)
      ZL(2)=ATAN2(AZ(2),AZ(1))
      AN=ABS(CN)
      IN=AINT(AN)
      FN=AN-IN
  002 IF(FN.EQ.0.0)GO TO 009
  003 IF(FN-0.5)007,004,008
  004 FN=1.5
      QM=1.25331413731550*EXP(-0.5*ZL(1)-AZ(1))
      QF(1)=QM*COS(-0.5*ZL(2)-AZ(2))
      QF(2)=QM*SIN(-0.5*ZL(2)-AZ(2))
  005 IF(CN.GT.1.0)GO TO 006
      SM(1)=QF(1)
      SM(2)=QF(2)
      GO TO 041
  006 SQ(1)=QF(1)
      SQ(2)=QF(2)
      SR(1)=QF(1)
      SR(2)=QF(2)
      GO TO 038
  007 FN=1.0
      GO TO 009
  008 FN=2.0
  009 IF(ZS-1.0)024,024,010
  010 IF(ZS-289.0)011,012,012
  011 IF(AZ(1)+0.096*AZ(2)*AZ(2))024,024,018
  012 QM=1.25331413731550*EXP(-0.5*ZL(1)-AZ(1))
      QF(1)=QM*COS(-0.5*ZL(2)-AZ(2))
      QF(2)=QM*SIN(-0.5*ZL(2)-AZ(2))
  013 IF(AN.GT.1.0)GO TO 015
      PN=IN+FN/3.0
      ASSIGN 014 TO LA
      GO TO 100
  014 TS(1)=QF(1)*SM(1)-QF(2)*SM(2)
      TS(2)=QF(1)*SM(2)+QF(2)*SM(1)
      SM(1)=TS(1)
      SM(2)=TS(2)
      GO TO 041
  015 PN=1.0-FN/3.0
      ASSIGN 016 TO LA
      GO TO 100
  016 SQ(1)=QF(1)*SM(1)-QF(2)*SM(2)
      SQ(2)=QF(1)*SM(2)+QF(2)*SM(1)
      PN=FN/3.0
      ASSIGN 017 TO LA
      GO TO 100
  017 SR(1)=QF(1)*SM(1)-QF(2)*SM(2)
      SR(2)=QF(1)*SM(2)+QF(2)*SM(1)
      GO TO 038
  018 QM=1.25331413731550*EXP(-0.5*ZL(1)-AZ(1))
      QF(1)=QM*COS(-0.5*ZL(2)-AZ(2))
      QF(2)=QM*SIN(-0.5*ZL(2)-AZ(2))
  019 IF(AN.GT.1.0)GO TO 021
      PN=45.0*IN+15.0*FN
      ASSIGN 020 TO LR
      GO TO 104
  020 TS(1)=QF(1)*SM(1)-QF(2)*SM(2)
      TS(2)=QF(1)*SM(2)+QF(2)*SM(1)
      SM(1)=TS(1)
      SM(2)=TS(2)
      GO TO 041
  021 PN=45.0-15.0*FN
      ASSIGN 022 TO LR
      GO TO 104
  022 SQ(1)=QF(1)*SM(1)-QF(2)*SM(2)
      SQ(2)=QF(1)*SM(2)+QF(2)*SM(1)
      PN=15.0*FN
      ASSIGN 023 TO LR
      GO TO 104
  023 SR(1)=QF(1)*SM(1)-QF(2)*SM(2)
      SR(2)=QF(1)*SM(2)+QF(2)*SM(1)
      GO TO 038
  024 IF(FN.NE.0.0)GO TO 029
  025 IF(AN.GT.1.0)GO TO 026
      PN=IN
      ASSIGN 041 TO LK
      GO TO 106
  026 PN=1.0
      ASSIGN 027 TO LK
      GO TO 106
  027 SQ(1)=SM(1)
      SQ(2)=SM(2)
      PN=0.0
      ASSIGN 028 TO LK
      GO TO 106
  028 SR(1)=SM(1)
      SR(2)=SM(2)
      GO TO 038
  029 ZM=EXP(FN*(-0.693147180559945+ZL(1))/3.0)
      ZN(1)=ZM*COS(FN*ZL(2)/3.0)
      ZN(2)=ZM*SIN(FN*ZL(2)/3.0)
      SN=ZM*ZM
  030 IF(AN.GT.1.0)GO TO 033
      PN=FN
      PQ(1)=ZN(1)
      PQ(2)=ZN(2)
      ASSIGN 031 TO LI
      GO TO 113
  031 SR(1)=SM(1)
      SR(2)=SM(2)
      PN=-FN
      PQ(1)=+ZN(1)/SN
      PQ(2)=-ZN(2)/SN
      ASSIGN 032 TO LI
      GO TO 113
  032 SM(1)=1.57079632679490*(SM(1)-SR(1))/0.866025403784439
      SM(2)=1.57079632679490*(SM(2)-SR(2))/0.866025403784439
      GO TO 041
  033 PN=3.0-FN
      PQ(1)=0.5*(ZN(1)*AZ(1)+ZN(2)*AZ(2))/SN
      PQ(2)=0.5*(ZN(1)*AZ(2)-ZN(2)*AZ(1))/SN
      ASSIGN 034 TO LI
      GO TO 113
  034 SQ(1)=SM(1)
      SQ(2)=SM(2)
      PN=FN-3.0
      PQ(1)=2.0*(AZ(1)*ZN(1)+AZ(2)*ZN(2))/ZS
      PQ(2)=2.0*(AZ(1)*ZN(2)-AZ(2)*ZN(1))/ZS
      ASSIGN 035 TO LI
      GO TO 113
  035 SQ(1)=1.57079632679490*(SM(1)-SQ(1))/0.866025403784439
      SQ(2)=1.57079632679490*(SM(2)-SQ(2))/0.866025403784439
      PN=+FN
      PQ(1)=ZN(1)
      PQ(2)=ZN(2)
      ASSIGN 036 TO LI
      GO TO 113
  036 SR(1)=SM(1)
      SR(2)=SM(2)
      PN=-FN
      PQ(1)=+ZN(1)/SN
      PQ(2)=-ZN(1)/SN
      ASSIGN 037 TO LI
      GO TO 113
  037 SR(1)=1.57079632679490*(SM(1)-SR(1))/0.866025403784439
      SR(2)=1.57079632679490*(SM(2)-SR(2))/0.866025403784439
  038 RZ(1)=+AZ(1)/ZS
      RZ(2)=-AZ(2)/ZS
      PN=0.0
      GO TO 040
  039 SQ(1)=SR(1)
      SQ(2)=SR(2)
      SR(1)=SM(1)
      SR(2)=SM(2)
  040 QN=PN+FN/3.0
      SM(1)=2.0*QN*(RZ(1)*SR(1)-RZ(2)*SR(2))+SQ(1)
      SM(2)=2.0*QN*(RZ(1)*SR(2)+RZ(2)*SR(1))+SQ(2)
      PN=PN+1.0
      IF(PN.LT.IN)GO TO 039
  041 W=CMPLX(SM(1),SM(2))
      RETURN
  100 SM(1)=0.0
      SM(2)=0.0
      RZ(1)=+0.5*AZ(1)/ZS
      RZ(2)=-0.5*AZ(2)/ZS
      QN=(PN-0.5)*(PN+0.5)
      TM(1)=1.0
      TM(2)=0.0
      PM=0.0
      GO TO 102
  101 QN=QN-2.0*PM
      PM=PM+1.0
      TS(1)=RZ(1)*TM(1)-RZ(2)*TM(2)
      TS(2)=RZ(1)*TM(2)+RZ(2)*TM(1)
      TM(1)=QN*TS(1)/PM
      TM(2)=QN*TS(2)/PM
      IF(ABS(SM(1))+ABS(TM(1)).NE.ABS(SM(1)))GO TO 102
      IF(ABS(SM(2))+ABS(TM(2)).EQ.ABS(SM(2)))GO TO 103
  102 SM(1)=SM(1)+TM(1)
      SM(2)=SM(2)+TM(2)
      IF(PM.LT.36.0)GO TO 101
  103 GO TO LA,(014,016,017)
  104 SM(1)=1.0
      SM(2)=0.0
      M=PN+2.0
      N=PN+15.0
      DO 105 I=M,N
      TS(1)=AZ(1)-CD(I)
      TS(2)=AZ(2)
      SS=TS(1)*TS(1)+TS(2)*TS(2)
      TM(1)=+CE(I)*TS(1)/SS
      TM(2)=-CE(I)*TS(2)/SS
      SM(1)=SM(1)+TM(1)
      SM(2)=SM(2)+TM(2)
  105 CONTINUE
      GO TO LR,(020,022,023)
  106 PQ(1)=1.0
      PQ(2)=0.0
      RN=0.0
      SN=-1.0
      PM=0.0
      GO TO 108
  107 PM=PM+1.0
      RN=RN+0.5/PM
      SN=-SN
      TS(1)=0.5*(AZ(1)*PQ(1)-AZ(2)*PQ(2))
      TS(2)=0.5*(AZ(1)*PQ(2)+AZ(2)*PQ(1))
      PQ(1)=TS(1)/PM
      PQ(2)=TS(2)/PM
  108 IF(PM.LT.PN)GO TO 107
      SZ(1)=0.25*(AZ(1)-AZ(2))*(AZ(1)+AZ(2))
      SZ(2)=0.5*AZ(1)*AZ(2)
      SR(1)=0.0
      SR(2)=0.0
      SS=PQ(1)*PQ(1)+PQ(2)*PQ(2)
      TM(1)=+PQ(1)/SS
      TM(2)=-PQ(2)/SS
      PM=0.0
      GO TO 110
  109 TM(1)=TM(1)/(PN-PM)
      TM(2)=TM(2)/(PN-PM)
      SR(1)=SR(1)+0.5*TM(1)
      SR(2)=SR(2)+0.5*TM(2)
      PM=PM+1.0
      TS(1)=SZ(1)*TM(1)-SZ(2)*TM(2)
      TS(2)=SZ(1)*TM(2)+SZ(2)*TM(1)
      TM(1)=-TS(1)/PM
      TM(2)=-TS(2)/PM
  110 IF(PM.LT.PN)GO TO 109
      SM(1)=0.0
      SM(2)=0.0
      RM=1.0
      QM=0.0
      PQ(1)=SN*PQ(1)
      PQ(2)=SN*PQ(2)
      SL(1)=-0.115931515658412+ZL(1)-RN
      SL(2)=+ZL(2)
      PM=0.0
      GO TO 112
  111 QM=QM+RM
      PM=PM+1.0
      RM=0.25*ZS*RM/(PM*(PN+PM))
      TS(1)=SZ(1)*PQ(1)-SZ(2)*PQ(2)
      TS(2)=SZ(1)*PQ(2)+SZ(2)*PQ(1)
      PQ(1)=TS(1)/(PM*(PN+PM))
      PQ(2)=TS(2)/(PM*(PN+PM))
      SL(1)=SL(1)-0.5/PM-0.5/(PN+PM)
  112 TM(1)=PQ(1)*SL(1)-PQ(2)*SL(2)
      TM(2)=PQ(1)*SL(2)+PQ(2)*SL(1)
      SM(1)=SM(1)+TM(1)
      SM(2)=SM(2)+TM(2)
      IF(QM+RM.GT.QM)GO TO 111
      SM(1)=SR(1)+SM(1)
      SM(2)=SR(2)+SM(2)
      GO TO LK,(027,028,041)
  113 SM(1)=0.0
      SM(2)=0.0
      SZ(1)=0.25*(AZ(1)-AZ(2))*(AZ(1)+AZ(2))
      SZ(2)=0.5*AZ(1)*AZ(2)
      N=3.0+PN
      TM(1)=PQ(1)/GN(N)
      TM(2)=PQ(2)/GN(N)
      PN=PN/3.0
      PM=0.0
      GO TO 115
  114 PM=PM+1.0
      TS(1)=SZ(1)*TM(1)-SZ(2)*TM(2)
      TS(2)=SZ(1)*TM(2)+SZ(2)*TM(1)
      TM(1)=TS(1)/(PM*(PN+PM))
      TM(2)=TS(2)/(PM*(PN+PM))
      IF(ABS(SM(1))+ABS(TM(1)).NE.ABS(SM(1)))GO TO 115
      IF(ABS(SM(2))+ABS(TM(2)).EQ.ABS(SM(2)))GO TO 116
  115 SM(1)=SM(1)+TM(1)
      SM(2)=SM(2)+TM(2)
      GO TO 114
  116 GO TO LI,(031,032,034,035,036,037)
      END
