mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2024-12-29 13:03:42 +01:00
110 lines
3.8 KiB
Fortran
110 lines
3.8 KiB
Fortran
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 ZABS,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, ZABS
|
|
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 = ZABS(COMPLEX(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
|