1*DECK ZBUNI 2 SUBROUTINE ZBUNI (ZR, ZI, FNU, KODE, N, YR, YI, NZ, NUI, NLAST, 3 + FNUL, TOL, ELIM, ALIM) 4C***BEGIN PROLOGUE ZBUNI 5C***SUBSIDIARY 6C***PURPOSE Subsidiary to ZBESI and ZBESK 7C***LIBRARY SLATEC 8C***TYPE ALL (CBUNI-A, ZBUNI-A) 9C***AUTHOR Amos, D. E., (SNL) 10C***DESCRIPTION 11C 12C ZBUNI COMPUTES THE I BESSEL FUNCTION FOR LARGE ABS(Z).GT. 13C FNUL AND FNU+N-1.LT.FNUL. THE ORDER IS INCREASED FROM 14C FNU+N-1 GREATER THAN FNUL BY ADDING NUI AND COMPUTING 15C ACCORDING TO THE UNIFORM ASYMPTOTIC EXPANSION FOR I(FNU,Z) 16C ON IFORM=1 AND THE EXPANSION FOR J(FNU,Z) ON IFORM=2 17C 18C***SEE ALSO ZBESI, ZBESK 19C***ROUTINES CALLED D1MACH, ZABS, ZUNI1, ZUNI2 20C***REVISION HISTORY (YYMMDD) 21C 830501 DATE WRITTEN 22C 910415 Prologue converted to Version 4.0 format. (BAB) 23C***END PROLOGUE ZBUNI 24C COMPLEX CSCL,CSCR,CY,RZ,ST,S1,S2,Y,Z 25 DOUBLE PRECISION ALIM, AX, AY, CSCLR, CSCRR, CYI, CYR, DFNU, 26 * ELIM, FNU, FNUI, FNUL, GNU, RAZ, RZI, RZR, STI, STR, S1I, S1R, 27 * S2I, S2R, TOL, YI, YR, ZI, ZR, ZABS, ASCLE, BRY, C1R, C1I, C1M, 28 * D1MACH 29 INTEGER I, IFLAG, IFORM, K, KODE, N, NL, NLAST, NUI, NW, NZ 30 DIMENSION YR(N), YI(N), CYR(2), CYI(2), BRY(3) 31 EXTERNAL ZABS 32C***FIRST EXECUTABLE STATEMENT ZBUNI 33 NZ = 0 34 AX = ABS(ZR)*1.7321D0 35 AY = ABS(ZI) 36 IFORM = 1 37 IF (AY.GT.AX) IFORM = 2 38 IF (NUI.EQ.0) GO TO 60 39 FNUI = NUI 40 DFNU = FNU + (N-1) 41 GNU = DFNU + FNUI 42 IF (IFORM.EQ.2) GO TO 10 43C----------------------------------------------------------------------- 44C ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN 45C -PI/3.LE.ARG(Z).LE.PI/3 46C----------------------------------------------------------------------- 47 CALL ZUNI1(ZR, ZI, GNU, KODE, 2, CYR, CYI, NW, NLAST, FNUL, TOL, 48 * ELIM, ALIM) 49 GO TO 20 50 10 CONTINUE 51C----------------------------------------------------------------------- 52C ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU 53C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I 54C AND HPI=PI/2 55C----------------------------------------------------------------------- 56 CALL ZUNI2(ZR, ZI, GNU, KODE, 2, CYR, CYI, NW, NLAST, FNUL, TOL, 57 * ELIM, ALIM) 58 20 CONTINUE 59 IF (NW.LT.0) GO TO 50 60 IF (NW.NE.0) GO TO 90 61 STR = ZABS(CYR(1),CYI(1)) 62C---------------------------------------------------------------------- 63C SCALE BACKWARD RECURRENCE, BRY(3) IS DEFINED BUT NEVER USED 64C---------------------------------------------------------------------- 65 BRY(1)=1.0D+3*D1MACH(1)/TOL 66 BRY(2) = 1.0D0/BRY(1) 67 BRY(3) = BRY(2) 68 IFLAG = 2 69 ASCLE = BRY(2) 70 CSCLR = 1.0D0 71 IF (STR.GT.BRY(1)) GO TO 21 72 IFLAG = 1 73 ASCLE = BRY(1) 74 CSCLR = 1.0D0/TOL 75 GO TO 25 76 21 CONTINUE 77 IF (STR.LT.BRY(2)) GO TO 25 78 IFLAG = 3 79 ASCLE=BRY(3) 80 CSCLR = TOL 81 25 CONTINUE 82 CSCRR = 1.0D0/CSCLR 83 S1R = CYR(2)*CSCLR 84 S1I = CYI(2)*CSCLR 85 S2R = CYR(1)*CSCLR 86 S2I = CYI(1)*CSCLR 87 RAZ = 1.0D0/ZABS(ZR,ZI) 88 STR = ZR*RAZ 89 STI = -ZI*RAZ 90 RZR = (STR+STR)*RAZ 91 RZI = (STI+STI)*RAZ 92 DO 30 I=1,NUI 93 STR = S2R 94 STI = S2I 95 S2R = (DFNU+FNUI)*(RZR*STR-RZI*STI) + S1R 96 S2I = (DFNU+FNUI)*(RZR*STI+RZI*STR) + S1I 97 S1R = STR 98 S1I = STI 99 FNUI = FNUI - 1.0D0 100 IF (IFLAG.GE.3) GO TO 30 101 STR = S2R*CSCRR 102 STI = S2I*CSCRR 103 C1R = ABS(STR) 104 C1I = ABS(STI) 105 C1M = MAX(C1R,C1I) 106 IF (C1M.LE.ASCLE) GO TO 30 107 IFLAG = IFLAG+1 108 ASCLE = BRY(IFLAG) 109 S1R = S1R*CSCRR 110 S1I = S1I*CSCRR 111 S2R = STR 112 S2I = STI 113 CSCLR = CSCLR*TOL 114 CSCRR = 1.0D0/CSCLR 115 S1R = S1R*CSCLR 116 S1I = S1I*CSCLR 117 S2R = S2R*CSCLR 118 S2I = S2I*CSCLR 119 30 CONTINUE 120 YR(N) = S2R*CSCRR 121 YI(N) = S2I*CSCRR 122 IF (N.EQ.1) RETURN 123 NL = N - 1 124 FNUI = NL 125 K = NL 126 DO 40 I=1,NL 127 STR = S2R 128 STI = S2I 129 S2R = (FNU+FNUI)*(RZR*STR-RZI*STI) + S1R 130 S2I = (FNU+FNUI)*(RZR*STI+RZI*STR) + S1I 131 S1R = STR 132 S1I = STI 133 STR = S2R*CSCRR 134 STI = S2I*CSCRR 135 YR(K) = STR 136 YI(K) = STI 137 FNUI = FNUI - 1.0D0 138 K = K - 1 139 IF (IFLAG.GE.3) GO TO 40 140 C1R = ABS(STR) 141 C1I = ABS(STI) 142 C1M = MAX(C1R,C1I) 143 IF (C1M.LE.ASCLE) GO TO 40 144 IFLAG = IFLAG+1 145 ASCLE = BRY(IFLAG) 146 S1R = S1R*CSCRR 147 S1I = S1I*CSCRR 148 S2R = STR 149 S2I = STI 150 CSCLR = CSCLR*TOL 151 CSCRR = 1.0D0/CSCLR 152 S1R = S1R*CSCLR 153 S1I = S1I*CSCLR 154 S2R = S2R*CSCLR 155 S2I = S2I*CSCLR 156 40 CONTINUE 157 RETURN 158 50 CONTINUE 159 NZ = -1 160 IF(NW.EQ.(-2)) NZ=-2 161 RETURN 162 60 CONTINUE 163 IF (IFORM.EQ.2) GO TO 70 164C----------------------------------------------------------------------- 165C ASYMPTOTIC EXPANSION FOR I(FNU,Z) FOR LARGE FNU APPLIED IN 166C -PI/3.LE.ARG(Z).LE.PI/3 167C----------------------------------------------------------------------- 168 CALL ZUNI1(ZR, ZI, FNU, KODE, N, YR, YI, NW, NLAST, FNUL, TOL, 169 * ELIM, ALIM) 170 GO TO 80 171 70 CONTINUE 172C----------------------------------------------------------------------- 173C ASYMPTOTIC EXPANSION FOR J(FNU,Z*EXP(M*HPI)) FOR LARGE FNU 174C APPLIED IN PI/3.LT.ABS(ARG(Z)).LE.PI/2 WHERE M=+I OR -I 175C AND HPI=PI/2 176C----------------------------------------------------------------------- 177 CALL ZUNI2(ZR, ZI, FNU, KODE, N, YR, YI, NW, NLAST, FNUL, TOL, 178 * ELIM, ALIM) 179 80 CONTINUE 180 IF (NW.LT.0) GO TO 50 181 NZ = NW 182 RETURN 183 90 CONTINUE 184 NLAST = N 185 RETURN 186 END 187