1*DECK ZKSCL
2      SUBROUTINE ZKSCL (ZRR, ZRI, FNU, N, YR, YI, NZ, RZR, RZI, ASCLE,
3     +   TOL, ELIM)
4C***BEGIN PROLOGUE  ZKSCL
5C***SUBSIDIARY
6C***PURPOSE  Subsidiary to ZBESK
7C***LIBRARY   SLATEC
8C***TYPE      ALL (CKSCL-A, ZKSCL-A)
9C***AUTHOR  Amos, D. E., (SNL)
10C***DESCRIPTION
11C
12C     SET K FUNCTIONS TO ZERO ON UNDERFLOW, CONTINUE RECURRENCE
13C     ON SCALED FUNCTIONS UNTIL TWO MEMBERS COME ON SCALE, THEN
14C     RETURN WITH MIN(NZ+2,N) VALUES SCALED BY 1/TOL.
15C
16C***SEE ALSO  ZBESK
17C***ROUTINES CALLED  ZABS, ZLOG, ZUCHK
18C***REVISION HISTORY  (YYMMDD)
19C   830501  DATE WRITTEN
20C   910415  Prologue converted to Version 4.0 format.  (BAB)
21C   930122  Added ZLOG to EXTERNAL statement.  (RWC)
22C***END PROLOGUE  ZKSCL
23C     COMPLEX CK,CS,CY,CZERO,RZ,S1,S2,Y,ZR,ZD,CELM
24      DOUBLE PRECISION ACS, AS, ASCLE, CKI, CKR, CSI, CSR, CYI,
25     * CYR, ELIM, FN, FNU, RZI, RZR, STR, S1I, S1R, S2I,
26     * S2R, TOL, YI, YR, ZEROI, ZEROR, ZRI, ZRR, ZABS,
27     * ZDR, ZDI, CELMR, ELM, HELIM, ALAS
28      INTEGER I, IC, IDUM, KK, N, NN, NW, NZ
29      DIMENSION YR(N), YI(N), CYR(2), CYI(2)
30      EXTERNAL ZABS, ZLOG
31      DATA ZEROR,ZEROI / 0.0D0 , 0.0D0 /
32C***FIRST EXECUTABLE STATEMENT  ZKSCL
33      NZ = 0
34      IC = 0
35      NN = MIN(2,N)
36      DO 10 I=1,NN
37        S1R = YR(I)
38        S1I = YI(I)
39        CYR(I) = S1R
40        CYI(I) = S1I
41        AS = ZABS(S1R,S1I)
42        ACS = -ZRR + LOG(AS)
43        NZ = NZ + 1
44        YR(I) = ZEROR
45        YI(I) = ZEROI
46        IF (ACS.LT.(-ELIM)) GO TO 10
47        CALL ZLOG(S1R, S1I, CSR, CSI, IDUM)
48        CSR = CSR - ZRR
49        CSI = CSI - ZRI
50        STR = EXP(CSR)/TOL
51        CSR = STR*COS(CSI)
52        CSI = STR*SIN(CSI)
53        CALL ZUCHK(CSR, CSI, NW, ASCLE, TOL)
54        IF (NW.NE.0) GO TO 10
55        YR(I) = CSR
56        YI(I) = CSI
57        IC = I
58        NZ = NZ - 1
59   10 CONTINUE
60      IF (N.EQ.1) RETURN
61      IF (IC.GT.1) GO TO 20
62      YR(1) = ZEROR
63      YI(1) = ZEROI
64      NZ = 2
65   20 CONTINUE
66      IF (N.EQ.2) RETURN
67      IF (NZ.EQ.0) RETURN
68      FN = FNU + 1.0D0
69      CKR = FN*RZR
70      CKI = FN*RZI
71      S1R = CYR(1)
72      S1I = CYI(1)
73      S2R = CYR(2)
74      S2I = CYI(2)
75      HELIM = 0.5D0*ELIM
76      ELM = EXP(-ELIM)
77      CELMR = ELM
78      ZDR = ZRR
79      ZDI = ZRI
80C
81C     FIND TWO CONSECUTIVE Y VALUES ON SCALE. SCALE RECURRENCE IF
82C     S2 GETS LARGER THAN EXP(ELIM/2)
83C
84      DO 30 I=3,N
85        KK = I
86        CSR = S2R
87        CSI = S2I
88        S2R = CKR*CSR - CKI*CSI + S1R
89        S2I = CKI*CSR + CKR*CSI + S1I
90        S1R = CSR
91        S1I = CSI
92        CKR = CKR + RZR
93        CKI = CKI + RZI
94        AS = ZABS(S2R,S2I)
95        ALAS = LOG(AS)
96        ACS = -ZDR + ALAS
97        NZ = NZ + 1
98        YR(I) = ZEROR
99        YI(I) = ZEROI
100        IF (ACS.LT.(-ELIM)) GO TO 25
101        CALL ZLOG(S2R, S2I, CSR, CSI, IDUM)
102        CSR = CSR - ZDR
103        CSI = CSI - ZDI
104        STR = EXP(CSR)/TOL
105        CSR = STR*COS(CSI)
106        CSI = STR*SIN(CSI)
107        CALL ZUCHK(CSR, CSI, NW, ASCLE, TOL)
108        IF (NW.NE.0) GO TO 25
109        YR(I) = CSR
110        YI(I) = CSI
111        NZ = NZ - 1
112        IF (IC.EQ.KK-1) GO TO 40
113        IC = KK
114        GO TO 30
115   25   CONTINUE
116        IF(ALAS.LT.HELIM) GO TO 30
117        ZDR = ZDR - ELIM
118        S1R = S1R*CELMR
119        S1I = S1I*CELMR
120        S2R = S2R*CELMR
121        S2I = S2I*CELMR
122   30 CONTINUE
123      NZ = N
124      IF(IC.EQ.N) NZ=N-1
125      GO TO 45
126   40 CONTINUE
127      NZ = KK - 2
128   45 CONTINUE
129      DO 50 I=1,NZ
130        YR(I) = ZEROR
131        YI(I) = ZEROI
132   50 CONTINUE
133      RETURN
134      END
135