dintrv.f 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118
  1. *DECK DINTRV
  2. SUBROUTINE DINTRV (XT, LXT, X, ILO, ILEFT, MFLAG)
  3. C***BEGIN PROLOGUE DINTRV
  4. C***PURPOSE Compute the largest integer ILEFT in 1 .LE. ILEFT .LE. LXT
  5. C such that XT(ILEFT) .LE. X where XT(*) is a subdivision of
  6. C the X interval.
  7. C***LIBRARY SLATEC
  8. C***CATEGORY E3, K6
  9. C***TYPE DOUBLE PRECISION (INTRV-S, DINTRV-D)
  10. C***KEYWORDS B-SPLINE, DATA FITTING, INTERPOLATION, SPLINES
  11. C***AUTHOR Amos, D. E., (SNLA)
  12. C***DESCRIPTION
  13. C
  14. C Written by Carl de Boor and modified by D. E. Amos
  15. C
  16. C Abstract **** a double precision routine ****
  17. C DINTRV is the INTERV routine of the reference.
  18. C
  19. C DINTRV computes the largest integer ILEFT in 1 .LE. ILEFT .LE.
  20. C LXT such that XT(ILEFT) .LE. X where XT(*) is a subdivision of
  21. C the X interval. Precisely,
  22. C
  23. C X .LT. XT(1) 1 -1
  24. C if XT(I) .LE. X .LT. XT(I+1) then ILEFT=I , MFLAG=0
  25. C XT(LXT) .LE. X LXT 1,
  26. C
  27. C That is, when multiplicities are present in the break point
  28. C to the left of X, the largest index is taken for ILEFT.
  29. C
  30. C Description of Arguments
  31. C
  32. C Input XT,X are double precision
  33. C XT - XT is a knot or break point vector of length LXT
  34. C LXT - length of the XT vector
  35. C X - argument
  36. C ILO - an initialization parameter which must be set
  37. C to 1 the first time the spline array XT is
  38. C processed by DINTRV.
  39. C
  40. C Output
  41. C ILO - ILO contains information for efficient process-
  42. C ing after the initial call and ILO must not be
  43. C changed by the user. Distinct splines require
  44. C distinct ILO parameters.
  45. C ILEFT - largest integer satisfying XT(ILEFT) .LE. X
  46. C MFLAG - signals when X lies out of bounds
  47. C
  48. C Error Conditions
  49. C None
  50. C
  51. C***REFERENCES Carl de Boor, Package for calculating with B-splines,
  52. C SIAM Journal on Numerical Analysis 14, 3 (June 1977),
  53. C pp. 441-472.
  54. C***ROUTINES CALLED (NONE)
  55. C***REVISION HISTORY (YYMMDD)
  56. C 800901 DATE WRITTEN
  57. C 890831 Modified array declarations. (WRB)
  58. C 890831 REVISION DATE from Version 3.2
  59. C 891214 Prologue converted to Version 4.0 format. (BAB)
  60. C 920501 Reformatted the REFERENCES section. (WRB)
  61. C***END PROLOGUE DINTRV
  62. C
  63. INTEGER IHI, ILEFT, ILO, ISTEP, LXT, MFLAG, MIDDLE
  64. DOUBLE PRECISION X, XT
  65. DIMENSION XT(*)
  66. C***FIRST EXECUTABLE STATEMENT DINTRV
  67. IHI = ILO + 1
  68. IF (IHI.LT.LXT) GO TO 10
  69. IF (X.GE.XT(LXT)) GO TO 110
  70. IF (LXT.LE.1) GO TO 90
  71. ILO = LXT - 1
  72. IHI = LXT
  73. C
  74. 10 IF (X.GE.XT(IHI)) GO TO 40
  75. IF (X.GE.XT(ILO)) GO TO 100
  76. C
  77. C *** NOW X .LT. XT(IHI) . FIND LOWER BOUND
  78. ISTEP = 1
  79. 20 IHI = ILO
  80. ILO = IHI - ISTEP
  81. IF (ILO.LE.1) GO TO 30
  82. IF (X.GE.XT(ILO)) GO TO 70
  83. ISTEP = ISTEP*2
  84. GO TO 20
  85. 30 ILO = 1
  86. IF (X.LT.XT(1)) GO TO 90
  87. GO TO 70
  88. C *** NOW X .GE. XT(ILO) . FIND UPPER BOUND
  89. 40 ISTEP = 1
  90. 50 ILO = IHI
  91. IHI = ILO + ISTEP
  92. IF (IHI.GE.LXT) GO TO 60
  93. IF (X.LT.XT(IHI)) GO TO 70
  94. ISTEP = ISTEP*2
  95. GO TO 50
  96. 60 IF (X.GE.XT(LXT)) GO TO 110
  97. IHI = LXT
  98. C
  99. C *** NOW XT(ILO) .LE. X .LT. XT(IHI) . NARROW THE INTERVAL
  100. 70 MIDDLE = (ILO+IHI)/2
  101. IF (MIDDLE.EQ.ILO) GO TO 100
  102. C NOTE. IT IS ASSUMED THAT MIDDLE = ILO IN CASE IHI = ILO+1
  103. IF (X.LT.XT(MIDDLE)) GO TO 80
  104. ILO = MIDDLE
  105. GO TO 70
  106. 80 IHI = MIDDLE
  107. GO TO 70
  108. C *** SET OUTPUT AND RETURN
  109. 90 MFLAG = -1
  110. ILEFT = 1
  111. RETURN
  112. 100 MFLAG = 0
  113. ILEFT = ILO
  114. RETURN
  115. 110 MFLAG = 1
  116. ILEFT = LXT
  117. RETURN
  118. END