MINICERN/packlib/kernlib/kernnum/e106fort/locati.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:48:49  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #if !defined(CERNLIB_QMIBMVF)
  10 #include "kernnum/pilot.h"
  11       FUNCTION LOCATI(ARRAY,LENGTH,OBJECT)
  12 C         BINARY SEARCH THRU 'ARRAY'  TO FIND  'OBJECT'
  13 C         'ARRAY' IS ASSUMED TO BE SORTED PRIOR TO CALL
  14 C         IF MATCH IS FOUND, FUNCTION RETURNS POSITION OF ELEMENT
  15 C         IF NO MATCH FOUND, FUNCTION GIVES NEGATIVE OF NEAREST ELEMENT
  16 C                                SMALLER THAN OBJECT
  17 C         F. JAMES ,  SEPT.,1974
  18       DIMENSION ARRAY(2)
  19       INTEGER ARRAY,OBJECT
  20       NABOVE = LENGTH + 1
  21       NBELOW = 0
  22    10 IF (NABOVE-NBELOW .LE. 1)  GO TO 200
  23       MIDDLE = (NABOVE+NBELOW) / 2
  24       IF (OBJECT - ARRAY(MIDDLE))  100, 180, 140
  25   100 NABOVE = MIDDLE
  26       GO TO 10
  27   140 NBELOW = MIDDLE
  28       GO TO 10
  29   180 LOCATI = MIDDLE
  30       GO TO 300
  31   200 LOCATI = -NBELOW
  32   300 RETURN
  33       END
  34 #endif