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