mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
118 lines
3.7 KiB
Fortran
118 lines
3.7 KiB
Fortran
*DECK DINTRV
|
|
SUBROUTINE DINTRV (XT, LXT, X, ILO, ILEFT, MFLAG)
|
|
C***BEGIN PROLOGUE DINTRV
|
|
C***PURPOSE Compute the largest integer ILEFT in 1 .LE. ILEFT .LE. LXT
|
|
C such that XT(ILEFT) .LE. X where XT(*) is a subdivision of
|
|
C the X interval.
|
|
C***LIBRARY SLATEC
|
|
C***CATEGORY E3, K6
|
|
C***TYPE DOUBLE PRECISION (INTRV-S, DINTRV-D)
|
|
C***KEYWORDS B-SPLINE, DATA FITTING, INTERPOLATION, SPLINES
|
|
C***AUTHOR Amos, D. E., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C Written by Carl de Boor and modified by D. E. Amos
|
|
C
|
|
C Abstract **** a double precision routine ****
|
|
C DINTRV is the INTERV routine of the reference.
|
|
C
|
|
C DINTRV computes the largest integer ILEFT in 1 .LE. ILEFT .LE.
|
|
C LXT such that XT(ILEFT) .LE. X where XT(*) is a subdivision of
|
|
C the X interval. Precisely,
|
|
C
|
|
C X .LT. XT(1) 1 -1
|
|
C if XT(I) .LE. X .LT. XT(I+1) then ILEFT=I , MFLAG=0
|
|
C XT(LXT) .LE. X LXT 1,
|
|
C
|
|
C That is, when multiplicities are present in the break point
|
|
C to the left of X, the largest index is taken for ILEFT.
|
|
C
|
|
C Description of Arguments
|
|
C
|
|
C Input XT,X are double precision
|
|
C XT - XT is a knot or break point vector of length LXT
|
|
C LXT - length of the XT vector
|
|
C X - argument
|
|
C ILO - an initialization parameter which must be set
|
|
C to 1 the first time the spline array XT is
|
|
C processed by DINTRV.
|
|
C
|
|
C Output
|
|
C ILO - ILO contains information for efficient process-
|
|
C ing after the initial call and ILO must not be
|
|
C changed by the user. Distinct splines require
|
|
C distinct ILO parameters.
|
|
C ILEFT - largest integer satisfying XT(ILEFT) .LE. X
|
|
C MFLAG - signals when X lies out of bounds
|
|
C
|
|
C Error Conditions
|
|
C None
|
|
C
|
|
C***REFERENCES Carl de Boor, Package for calculating with B-splines,
|
|
C SIAM Journal on Numerical Analysis 14, 3 (June 1977),
|
|
C pp. 441-472.
|
|
C***ROUTINES CALLED (NONE)
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 800901 DATE WRITTEN
|
|
C 890831 Modified array declarations. (WRB)
|
|
C 890831 REVISION DATE from Version 3.2
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 920501 Reformatted the REFERENCES section. (WRB)
|
|
C***END PROLOGUE DINTRV
|
|
C
|
|
INTEGER IHI, ILEFT, ILO, ISTEP, LXT, MFLAG, MIDDLE
|
|
DOUBLE PRECISION X, XT
|
|
DIMENSION XT(*)
|
|
C***FIRST EXECUTABLE STATEMENT DINTRV
|
|
IHI = ILO + 1
|
|
IF (IHI.LT.LXT) GO TO 10
|
|
IF (X.GE.XT(LXT)) GO TO 110
|
|
IF (LXT.LE.1) GO TO 90
|
|
ILO = LXT - 1
|
|
IHI = LXT
|
|
C
|
|
10 IF (X.GE.XT(IHI)) GO TO 40
|
|
IF (X.GE.XT(ILO)) GO TO 100
|
|
C
|
|
C *** NOW X .LT. XT(IHI) . FIND LOWER BOUND
|
|
ISTEP = 1
|
|
20 IHI = ILO
|
|
ILO = IHI - ISTEP
|
|
IF (ILO.LE.1) GO TO 30
|
|
IF (X.GE.XT(ILO)) GO TO 70
|
|
ISTEP = ISTEP*2
|
|
GO TO 20
|
|
30 ILO = 1
|
|
IF (X.LT.XT(1)) GO TO 90
|
|
GO TO 70
|
|
C *** NOW X .GE. XT(ILO) . FIND UPPER BOUND
|
|
40 ISTEP = 1
|
|
50 ILO = IHI
|
|
IHI = ILO + ISTEP
|
|
IF (IHI.GE.LXT) GO TO 60
|
|
IF (X.LT.XT(IHI)) GO TO 70
|
|
ISTEP = ISTEP*2
|
|
GO TO 50
|
|
60 IF (X.GE.XT(LXT)) GO TO 110
|
|
IHI = LXT
|
|
C
|
|
C *** NOW XT(ILO) .LE. X .LT. XT(IHI) . NARROW THE INTERVAL
|
|
70 MIDDLE = (ILO+IHI)/2
|
|
IF (MIDDLE.EQ.ILO) GO TO 100
|
|
C NOTE. IT IS ASSUMED THAT MIDDLE = ILO IN CASE IHI = ILO+1
|
|
IF (X.LT.XT(MIDDLE)) GO TO 80
|
|
ILO = MIDDLE
|
|
GO TO 70
|
|
80 IHI = MIDDLE
|
|
GO TO 70
|
|
C *** SET OUTPUT AND RETURN
|
|
90 MFLAG = -1
|
|
ILEFT = 1
|
|
RETURN
|
|
100 MFLAG = 0
|
|
ILEFT = ILO
|
|
RETURN
|
|
110 MFLAG = 1
|
|
ILEFT = LXT
|
|
RETURN
|
|
END
|