added qvalues to metastats. fixed bug with chimera.uchime location. fixed windows...

[mothur.git] / intrv.f

diff --git a/intrv.f b/intrv.f
new file mode 100644 (file)
index 0000000..827b5bd
--- /dev/null
+++ b/intrv.f
@@ -0,0 +1,117 @@
+*DECK INTRV
+      SUBROUTINE INTRV (XT, LXT, X, ILO, ILEFT, MFLAG)
+C***BEGIN PROLOGUE  INTRV
+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
+C            of the X interval.
+C***LIBRARY   SLATEC
+C***CATEGORY  E3, K6
+C***TYPE      SINGLE 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
+C         INTRV is the INTERV routine of the reference.
+C
+C         INTRV 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         Input
+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 INTRV.
+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  INTRV
+C
+      INTEGER IHI, ILEFT, ILO, ISTEP, LXT, MFLAG, MIDDLE
+      Double precision X, XT
+      DIMENSION XT(*)
+C***FIRST EXECUTABLE STATEMENT  INTRV
+      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