GNU Octave: libcruft/amos/zbinu.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZBINU(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL,
00002      * TOL, ELIM, ALIM)
00003 C***BEGIN PROLOGUE  ZBINU
00004 C***REFER TO  ZBESH,ZBESI,ZBESJ,ZBESK,ZAIRY,ZBIRY
00005 C
00006 C     ZBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE
00007 C
00008 C***ROUTINES CALLED  XZABS,ZASYI,ZBUNI,ZMLRI,ZSERI,ZUOIK,ZWRSK
00009 C***END PROLOGUE  ZBINU
00010       DOUBLE PRECISION ALIM, AZ, CWI, CWR, CYI, CYR, DFNU, ELIM, FNU,
00011      * FNUL, RL, TOL, ZEROI, ZEROR, ZI, ZR, XZABS
00012       INTEGER I, INW, KODE, N, NLAST, NN, NUI, NW, NZ
00013       DIMENSION CYR(N), CYI(N), CWR(2), CWI(2)
00014       DATA ZEROR,ZEROI / 0.0D0, 0.0D0 /
00015 C
00016       NZ = 0
00017       AZ = XZABS(ZR,ZI)
00018       NN = N
00019       DFNU = FNU + DBLE(FLOAT(N-1))
00020       IF (AZ.LE.2.0D0) GO TO 10
00021       IF (AZ*AZ*0.25D0.GT.DFNU+1.0D0) GO TO 20
00022    10 CONTINUE
00023 C-----------------------------------------------------------------------
00024 C     POWER SERIES
00025 C-----------------------------------------------------------------------
00026       CALL ZSERI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM)
00027       INW = IABS(NW)
00028       NZ = NZ + INW
00029       NN = NN - INW
00030       IF (NN.EQ.0) RETURN
00031       IF (NW.GE.0) GO TO 120
00032       DFNU = FNU + DBLE(FLOAT(NN-1))
00033    20 CONTINUE
00034       IF (AZ.LT.RL) GO TO 40
00035       IF (DFNU.LE.1.0D0) GO TO 30
00036       IF (AZ+AZ.LT.DFNU*DFNU) GO TO 50
00037 C-----------------------------------------------------------------------
00038 C     ASYMPTOTIC EXPANSION FOR LARGE Z
00039 C-----------------------------------------------------------------------
00040    30 CONTINUE
00041       CALL ZASYI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, RL, TOL, ELIM,
00042      * ALIM)
00043       IF (NW.LT.0) GO TO 130
00044       GO TO 120
00045    40 CONTINUE
00046       IF (DFNU.LE.1.0D0) GO TO 70
00047    50 CONTINUE
00048 C-----------------------------------------------------------------------
00049 C     OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM
00050 C-----------------------------------------------------------------------
00051       CALL ZUOIK(ZR, ZI, FNU, KODE, 1, NN, CYR, CYI, NW, TOL, ELIM,
00052      * ALIM)
00053       IF (NW.LT.0) GO TO 130
00054       NZ = NZ + NW
00055       NN = NN - NW
00056       IF (NN.EQ.0) RETURN
00057       DFNU = FNU+DBLE(FLOAT(NN-1))
00058       IF (DFNU.GT.FNUL) GO TO 110
00059       IF (AZ.GT.FNUL) GO TO 110
00060    60 CONTINUE
00061       IF (AZ.GT.RL) GO TO 80
00062    70 CONTINUE
00063 C-----------------------------------------------------------------------
00064 C     MILLER ALGORITHM NORMALIZED BY THE SERIES
00065 C-----------------------------------------------------------------------
00066       CALL ZMLRI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL)
00067       IF(NW.LT.0) GO TO 130
00068       GO TO 120
00069    80 CONTINUE
00070 C-----------------------------------------------------------------------
00071 C     MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN
00072 C-----------------------------------------------------------------------
00073 C-----------------------------------------------------------------------
00074 C     OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN
00075 C-----------------------------------------------------------------------
00076       CALL ZUOIK(ZR, ZI, FNU, KODE, 2, 2, CWR, CWI, NW, TOL, ELIM,
00077      * ALIM)
00078       IF (NW.GE.0) GO TO 100
00079       NZ = NN
00080       DO 90 I=1,NN
00081         CYR(I) = ZEROR
00082         CYI(I) = ZEROI
00083    90 CONTINUE
00084       RETURN
00085   100 CONTINUE
00086       IF (NW.GT.0) GO TO 130
00087       CALL ZWRSK(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, CWR, CWI, TOL,
00088      * ELIM, ALIM)
00089       IF (NW.LT.0) GO TO 130
00090       GO TO 120
00091   110 CONTINUE
00092 C-----------------------------------------------------------------------
00093 C     INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD
00094 C-----------------------------------------------------------------------
00095       NUI = INT(SNGL(FNUL-DFNU)) + 1
00096       NUI = MAX0(NUI,0)
00097       CALL ZBUNI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, NUI, NLAST, FNUL,
00098      * TOL, ELIM, ALIM)
00099       IF (NW.LT.0) GO TO 130
00100       NZ = NZ + NW
00101       IF (NLAST.EQ.0) GO TO 120
00102       NN = NLAST
00103       GO TO 60
00104   120 CONTINUE
00105       RETURN
00106   130 CONTINUE
00107       NZ = -1
00108       IF(NW.EQ.(-2)) NZ=-2
00109       RETURN
00110       END