1*DECK ZACON
2      SUBROUTINE ZACON (ZR, ZI, FNU, KODE, MR, N, YR, YI, NZ, RL, FNUL,
3     +   TOL, ELIM, ALIM)
4C***BEGIN PROLOGUE  ZACON
5C***SUBSIDIARY
6C***PURPOSE  Subsidiary to ZBESH and ZBESK
7C***LIBRARY   SLATEC
8C***TYPE      ALL (CACON-A, ZACON-A)
9C***AUTHOR  Amos, D. E., (SNL)
10C***DESCRIPTION
11C
12C     ZACON APPLIES THE ANALYTIC CONTINUATION FORMULA
13C
14C         K(FNU,ZN*EXP(MP))=K(FNU,ZN)*EXP(-MP*FNU) - MP*I(FNU,ZN)
15C                 MP=PI*MR*CMPLX(0.0,1.0)
16C
17C     TO CONTINUE THE K FUNCTION FROM THE RIGHT HALF TO THE LEFT
18C     HALF Z PLANE
19C
20C***SEE ALSO  ZBESH, ZBESK
21C***ROUTINES CALLED  D1MACH, ZABS, ZBINU, ZBKNU, ZMLT, ZS1S2
22C***REVISION HISTORY  (YYMMDD)
23C   830501  DATE WRITTEN
24C   910415  Prologue converted to Version 4.0 format.  (BAB)
25C***END PROLOGUE  ZACON
26C     COMPLEX CK,CONE,CSCL,CSCR,CSGN,CSPN,CY,CZERO,C1,C2,RZ,SC1,SC2,ST,
27C    *S1,S2,Y,Z,ZN
28      DOUBLE PRECISION ALIM, ARG, ASCLE, AS2, AZN, BRY, BSCLE, CKI,
29     * CKR, CONER, CPN, CSCL, CSCR, CSGNI, CSGNR, CSPNI, CSPNR,
30     * CSR, CSRR, CSSR, CYI, CYR, C1I, C1M, C1R, C2I, C2R, ELIM, FMR,
31     * FN, FNU, FNUL, PI, PTI, PTR, RAZN, RL, RZI, RZR, SC1I, SC1R,
32     * SC2I, SC2R, SGN, SPN, STI, STR, S1I, S1R, S2I, S2R, TOL, YI, YR,
33     * YY, ZEROR, ZI, ZNI, ZNR, ZR, D1MACH, ZABS
34      INTEGER I, INU, IUF, KFLAG, KODE, MR, N, NN, NW, NZ
35      DIMENSION YR(N), YI(N), CYR(2), CYI(2), CSSR(3), CSRR(3), BRY(3)
36      EXTERNAL ZABS
37      DATA PI / 3.14159265358979324D0 /
38      DATA ZEROR,CONER / 0.0D0,1.0D0 /
39C***FIRST EXECUTABLE STATEMENT  ZACON
40      NZ = 0
41      ZNR = -ZR
42      ZNI = -ZI
43      NN = N
44      CALL ZBINU(ZNR, ZNI, FNU, KODE, NN, YR, YI, NW, RL, FNUL, TOL,
45     * ELIM, ALIM)
46      IF (NW.LT.0) GO TO 90
47C-----------------------------------------------------------------------
48C     ANALYTIC CONTINUATION TO THE LEFT HALF PLANE FOR THE K FUNCTION
49C-----------------------------------------------------------------------
50      NN = MIN(2,N)
51      CALL ZBKNU(ZNR, ZNI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM)
52      IF (NW.NE.0) GO TO 90
53      S1R = CYR(1)
54      S1I = CYI(1)
55      FMR = MR
56      SGN = -DSIGN(PI,FMR)
57      CSGNR = ZEROR
58      CSGNI = SGN
59      IF (KODE.EQ.1) GO TO 10
60      YY = -ZNI
61      CPN = COS(YY)
62      SPN = SIN(YY)
63      CALL ZMLT(CSGNR, CSGNI, CPN, SPN, CSGNR, CSGNI)
64   10 CONTINUE
65C-----------------------------------------------------------------------
66C     CALCULATE CSPN=EXP(FNU*PI*I) TO MINIMIZE LOSSES OF SIGNIFICANCE
67C     WHEN FNU IS LARGE
68C-----------------------------------------------------------------------
69      INU = FNU
70      ARG = (FNU-INU)*SGN
71      CPN = COS(ARG)
72      SPN = SIN(ARG)
73      CSPNR = CPN
74      CSPNI = SPN
75      IF (MOD(INU,2).EQ.0) GO TO 20
76      CSPNR = -CSPNR
77      CSPNI = -CSPNI
78   20 CONTINUE
79      IUF = 0
80      C1R = S1R
81      C1I = S1I
82      C2R = YR(1)
83      C2I = YI(1)
84      ASCLE = 1.0D+3*D1MACH(1)/TOL
85      IF (KODE.EQ.1) GO TO 30
86      CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF)
87      NZ = NZ + NW
88      SC1R = C1R
89      SC1I = C1I
90   30 CONTINUE
91      CALL ZMLT(CSPNR, CSPNI, C1R, C1I, STR, STI)
92      CALL ZMLT(CSGNR, CSGNI, C2R, C2I, PTR, PTI)
93      YR(1) = STR + PTR
94      YI(1) = STI + PTI
95      IF (N.EQ.1) RETURN
96      CSPNR = -CSPNR
97      CSPNI = -CSPNI
98      S2R = CYR(2)
99      S2I = CYI(2)
100      C1R = S2R
101      C1I = S2I
102      C2R = YR(2)
103      C2I = YI(2)
104      IF (KODE.EQ.1) GO TO 40
105      CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF)
106      NZ = NZ + NW
107      SC2R = C1R
108      SC2I = C1I
109   40 CONTINUE
110      CALL ZMLT(CSPNR, CSPNI, C1R, C1I, STR, STI)
111      CALL ZMLT(CSGNR, CSGNI, C2R, C2I, PTR, PTI)
112      YR(2) = STR + PTR
113      YI(2) = STI + PTI
114      IF (N.EQ.2) RETURN
115      CSPNR = -CSPNR
116      CSPNI = -CSPNI
117      AZN = ZABS(ZNR,ZNI)
118      RAZN = 1.0D0/AZN
119      STR = ZNR*RAZN
120      STI = -ZNI*RAZN
121      RZR = (STR+STR)*RAZN
122      RZI = (STI+STI)*RAZN
123      FN = FNU + 1.0D0
124      CKR = FN*RZR
125      CKI = FN*RZI
126C-----------------------------------------------------------------------
127C     SCALE NEAR EXPONENT EXTREMES DURING RECURRENCE ON K FUNCTIONS
128C-----------------------------------------------------------------------
129      CSCL = 1.0D0/TOL
130      CSCR = TOL
131      CSSR(1) = CSCL
132      CSSR(2) = CONER
133      CSSR(3) = CSCR
134      CSRR(1) = CSCR
135      CSRR(2) = CONER
136      CSRR(3) = CSCL
137      BRY(1) = ASCLE
138      BRY(2) = 1.0D0/ASCLE
139      BRY(3) = D1MACH(2)
140      AS2 = ZABS(S2R,S2I)
141      KFLAG = 2
142      IF (AS2.GT.BRY(1)) GO TO 50
143      KFLAG = 1
144      GO TO 60
145   50 CONTINUE
146      IF (AS2.LT.BRY(2)) GO TO 60
147      KFLAG = 3
148   60 CONTINUE
149      BSCLE = BRY(KFLAG)
150      S1R = S1R*CSSR(KFLAG)
151      S1I = S1I*CSSR(KFLAG)
152      S2R = S2R*CSSR(KFLAG)
153      S2I = S2I*CSSR(KFLAG)
154      CSR = CSRR(KFLAG)
155      DO 80 I=3,N
156        STR = S2R
157        STI = S2I
158        S2R = CKR*STR - CKI*STI + S1R
159        S2I = CKR*STI + CKI*STR + S1I
160        S1R = STR
161        S1I = STI
162        C1R = S2R*CSR
163        C1I = S2I*CSR
164        STR = C1R
165        STI = C1I
166        C2R = YR(I)
167        C2I = YI(I)
168        IF (KODE.EQ.1) GO TO 70
169        IF (IUF.LT.0) GO TO 70
170        CALL ZS1S2(ZNR, ZNI, C1R, C1I, C2R, C2I, NW, ASCLE, ALIM, IUF)
171        NZ = NZ + NW
172        SC1R = SC2R
173        SC1I = SC2I
174        SC2R = C1R
175        SC2I = C1I
176        IF (IUF.NE.3) GO TO 70
177        IUF = -4
178        S1R = SC1R*CSSR(KFLAG)
179        S1I = SC1I*CSSR(KFLAG)
180        S2R = SC2R*CSSR(KFLAG)
181        S2I = SC2I*CSSR(KFLAG)
182        STR = SC2R
183        STI = SC2I
184   70   CONTINUE
185        PTR = CSPNR*C1R - CSPNI*C1I
186        PTI = CSPNR*C1I + CSPNI*C1R
187        YR(I) = PTR + CSGNR*C2R - CSGNI*C2I
188        YI(I) = PTI + CSGNR*C2I + CSGNI*C2R
189        CKR = CKR + RZR
190        CKI = CKI + RZI
191        CSPNR = -CSPNR
192        CSPNI = -CSPNI
193        IF (KFLAG.GE.3) GO TO 80
194        PTR = ABS(C1R)
195        PTI = ABS(C1I)
196        C1M = MAX(PTR,PTI)
197        IF (C1M.LE.BSCLE) GO TO 80
198        KFLAG = KFLAG + 1
199        BSCLE = BRY(KFLAG)
200        S1R = S1R*CSR
201        S1I = S1I*CSR
202        S2R = STR
203        S2I = STI
204        S1R = S1R*CSSR(KFLAG)
205        S1I = S1I*CSSR(KFLAG)
206        S2R = S2R*CSSR(KFLAG)
207        S2I = S2I*CSSR(KFLAG)
208        CSR = CSRR(KFLAG)
209   80 CONTINUE
210      RETURN
211   90 CONTINUE
212      NZ = -1
213      IF(NW.EQ.(-2)) NZ=-2
214      RETURN
215      END
216