qpms/amos/zbinu.f

111 lines
3.8 KiB
FortranFixed
Raw Normal View History

SUBROUTINE ZBINU(ZR, ZI, FNU, KODE, N, CYR, CYI, NZ, RL, FNUL,
* TOL, ELIM, ALIM)
C***BEGIN PROLOGUE ZBINU
C***REFER TO ZBESH,ZBESI,ZBESJ,ZBESK,ZAIRY,ZBIRY
C
C ZBINU COMPUTES THE I FUNCTION IN THE RIGHT HALF Z PLANE
C
C***ROUTINES CALLED AZABS,ZASYI,ZBUNI,ZMLRI,ZSERI,ZUOIK,ZWRSK
C***END PROLOGUE ZBINU
DOUBLE PRECISION ALIM, AZ, CWI, CWR, CYI, CYR, DFNU, ELIM, FNU,
* FNUL, RL, TOL, ZEROI, ZEROR, ZI, ZR, AZABS
INTEGER I, INW, KODE, N, NLAST, NN, NUI, NW, NZ
DIMENSION CYR(N), CYI(N), CWR(2), CWI(2)
DATA ZEROR,ZEROI / 0.0D0, 0.0D0 /
C
NZ = 0
AZ = AZABS(ZR,ZI)
NN = N
DFNU = FNU + DBLE(FLOAT(N-1))
IF (AZ.LE.2.0D0) GO TO 10
IF (AZ*AZ*0.25D0.GT.DFNU+1.0D0) GO TO 20
10 CONTINUE
C-----------------------------------------------------------------------
C POWER SERIES
C-----------------------------------------------------------------------
CALL ZSERI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL, ELIM, ALIM)
INW = IABS(NW)
NZ = NZ + INW
NN = NN - INW
IF (NN.EQ.0) RETURN
IF (NW.GE.0) GO TO 120
DFNU = FNU + DBLE(FLOAT(NN-1))
20 CONTINUE
IF (AZ.LT.RL) GO TO 40
IF (DFNU.LE.1.0D0) GO TO 30
IF (AZ+AZ.LT.DFNU*DFNU) GO TO 50
C-----------------------------------------------------------------------
C ASYMPTOTIC EXPANSION FOR LARGE Z
C-----------------------------------------------------------------------
30 CONTINUE
CALL ZASYI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, RL, TOL, ELIM,
* ALIM)
IF (NW.LT.0) GO TO 130
GO TO 120
40 CONTINUE
IF (DFNU.LE.1.0D0) GO TO 70
50 CONTINUE
C-----------------------------------------------------------------------
C OVERFLOW AND UNDERFLOW TEST ON I SEQUENCE FOR MILLER ALGORITHM
C-----------------------------------------------------------------------
CALL ZUOIK(ZR, ZI, FNU, KODE, 1, NN, CYR, CYI, NW, TOL, ELIM,
* ALIM)
IF (NW.LT.0) GO TO 130
NZ = NZ + NW
NN = NN - NW
IF (NN.EQ.0) RETURN
DFNU = FNU+DBLE(FLOAT(NN-1))
IF (DFNU.GT.FNUL) GO TO 110
IF (AZ.GT.FNUL) GO TO 110
60 CONTINUE
IF (AZ.GT.RL) GO TO 80
70 CONTINUE
C-----------------------------------------------------------------------
C MILLER ALGORITHM NORMALIZED BY THE SERIES
C-----------------------------------------------------------------------
CALL ZMLRI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, TOL)
IF(NW.LT.0) GO TO 130
GO TO 120
80 CONTINUE
C-----------------------------------------------------------------------
C MILLER ALGORITHM NORMALIZED BY THE WRONSKIAN
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C OVERFLOW TEST ON K FUNCTIONS USED IN WRONSKIAN
C-----------------------------------------------------------------------
CALL ZUOIK(ZR, ZI, FNU, KODE, 2, 2, CWR, CWI, NW, TOL, ELIM,
* ALIM)
IF (NW.GE.0) GO TO 100
NZ = NN
DO 90 I=1,NN
CYR(I) = ZEROR
CYI(I) = ZEROI
90 CONTINUE
RETURN
100 CONTINUE
IF (NW.GT.0) GO TO 130
CALL ZWRSK(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, CWR, CWI, TOL,
* ELIM, ALIM)
IF (NW.LT.0) GO TO 130
GO TO 120
110 CONTINUE
C-----------------------------------------------------------------------
C INCREMENT FNU+NN-1 UP TO FNUL, COMPUTE AND RECUR BACKWARD
C-----------------------------------------------------------------------
NUI = INT(SNGL(FNUL-DFNU)) + 1
NUI = MAX0(NUI,0)
CALL ZBUNI(ZR, ZI, FNU, KODE, NN, CYR, CYI, NW, NUI, NLAST, FNUL,
* TOL, ELIM, ALIM)
IF (NW.LT.0) GO TO 130
NZ = NZ + NW
IF (NLAST.EQ.0) GO TO 120
NN = NLAST
GO TO 60
120 CONTINUE
RETURN
130 CONTINUE
NZ = -1
IF(NW.EQ.(-2)) NZ=-2
RETURN
END