mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
86 lines
2.3 KiB
Fortran
86 lines
2.3 KiB
Fortran
*DECK BKISR
|
|
SUBROUTINE BKISR (X, N, SUM, IERR)
|
|
C***BEGIN PROLOGUE BKISR
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to BSKIN
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (BKISR-S, DBKISR-D)
|
|
C***AUTHOR Amos, D. E., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C BKISR computes repeated integrals of the K0 Bessel function
|
|
C by the series for N=0,1, and 2.
|
|
C
|
|
C***SEE ALSO BSKIN
|
|
C***ROUTINES CALLED PSIXN, R1MACH
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 820601 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900328 Added TYPE section. (WRB)
|
|
C 910722 Updated AUTHOR section. (ALS)
|
|
C***END PROLOGUE BKISR
|
|
INTEGER I, IERR, K, KK, KKN, K1, N, NP
|
|
REAL AK, ATOL, BK, C, FK, FN, HX, HXS, POL, PR, SUM, TKP, TOL,
|
|
* TRM, X, XLN
|
|
REAL PSIXN, R1MACH
|
|
DIMENSION C(2)
|
|
SAVE C
|
|
C
|
|
DATA C(1), C(2) /1.57079632679489662E+00,1.0E0/
|
|
C***FIRST EXECUTABLE STATEMENT BKISR
|
|
IERR=0
|
|
TOL = MAX(R1MACH(4),1.0E-18)
|
|
IF (X.LT.TOL) GO TO 50
|
|
PR = 1.0E0
|
|
POL = 0.0E0
|
|
IF (N.EQ.0) GO TO 20
|
|
DO 10 I=1,N
|
|
POL = -POL*X + C(I)
|
|
PR = PR*X/I
|
|
10 CONTINUE
|
|
20 CONTINUE
|
|
HX = X*0.5E0
|
|
HXS = HX*HX
|
|
XLN = LOG(HX)
|
|
NP = N + 1
|
|
TKP = 3.0E0
|
|
FK = 2.0E0
|
|
FN = N
|
|
BK = 4.0E0
|
|
AK = 2.0E0/((FN+1.0E0)*(FN+2.0E0))
|
|
SUM = AK*(PSIXN(N+3)-PSIXN(3)+PSIXN(2)-XLN)
|
|
ATOL = SUM*TOL*0.75E0
|
|
DO 30 K=2,20
|
|
AK = AK*(HXS/BK)*((TKP+1.0E0)/(TKP+FN+1.0E0))*(TKP/(TKP+FN))
|
|
K1 = K + 1
|
|
KK = K1 + K
|
|
KKN = KK + N
|
|
TRM = (PSIXN(K1)+PSIXN(KKN)-PSIXN(KK)-XLN)*AK
|
|
SUM = SUM + TRM
|
|
IF (ABS(TRM).LE.ATOL) GO TO 40
|
|
TKP = TKP + 2.0E0
|
|
BK = BK + TKP
|
|
FK = FK + 1.0E0
|
|
30 CONTINUE
|
|
GO TO 80
|
|
40 CONTINUE
|
|
SUM = (SUM*HXS+PSIXN(NP)-XLN)*PR
|
|
IF (N.EQ.1) SUM = -SUM
|
|
SUM = POL + SUM
|
|
RETURN
|
|
C-----------------------------------------------------------------------
|
|
C SMALL X CASE, X.LT.WORD TOLERANCE
|
|
C-----------------------------------------------------------------------
|
|
50 CONTINUE
|
|
IF (N.GT.0) GO TO 60
|
|
HX = X*0.5E0
|
|
SUM = PSIXN(1) - LOG(HX)
|
|
RETURN
|
|
60 CONTINUE
|
|
SUM = C(N)
|
|
RETURN
|
|
80 CONTINUE
|
|
IERR=2
|
|
RETURN
|
|
END
|