MINICERN/mathlib/gen/e/lkkspl.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:26  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       FUNCTION LKKSPL(X,T,M)
  11
  12 #include "gen/imp64.inc"
  13       DIMENSION T(*)
  14
  15 ************************************************************************
  16 *   NORBAS, VERSION: 15.03.1993
  17 ************************************************************************
  18 *
  19 *   FOR GIVEN  X  AND A NON-DECREASING SEQUENCE  T(1) , T(2) ,..., T(M)
  20 *   THE FUNCTION  LKKSPL  COMPUTES AND RETURNS THE UNIQUELY DETERMINED
  21 *   INDEX  KK  SUCH THAT THE RELATION
  22 *              T(KK-1) <=  X  < T(KK)
  23 *   HOLDS.
  24 *   IT RETURNS  KK = 1 ,    IF   X <  T(1) ,   AND
  25 *               KK = M+1 ,  IF   X >= T(M) .
  26 *
  27 *   (THE SEARCH ALGORITHM IS OF REGULA FALSI - TYPE).
  28 *
  29 ************************************************************************
  30
  31       IF(X .GE. T(M)) THEN
  32        LKKSPL=M+1
  33       ELSEIF(X .LT. T(1)) THEN
  34        LKKSPL=1
  35       ELSE
  36        M1=1
  37        M2=M
  38        T1=T(M1)
  39        T2=T(M2)
  40    10  M3=M1+(M2-M1)*(X-T1)/(T2-T1)
  41        M4=M3+1
  42        T3=T(M3)
  43        T4=T(M4)
  44        IF((T3 .GT. X .OR. X .GE. T4) .AND.
  45      +    (T3 .NE. X .OR. X .NE. T4)) THEN
  46         IF(X .GE. T3) THEN
  47          M1=M4
  48          T1=T4
  49         ELSE
  50          M2=M3
  51          T2=T3
  52         ENDIF
  53         GO TO 10
  54        ENDIF
  55    20  LKKSPL=M4
  56        IF(X .GE. T(M4)) THEN
  57         M4=M4+1
  58         GO TO 20
  59        ENDIF
  60       ENDIF
  61
  62       RETURN
  63       END
  64
  65
  66