*
* $Id: locatf.F,v 1.2 1996/05/24 10:56:52 jamie Exp $
*
* $Log: locatf.F,v $
* Revision 1.2  1996/05/24 10:56:52  jamie
* add locatr entry for consistency with wrup
*
* Revision 1.1.1.1  1996/02/15 17:48:49  mclareni
* Kernlib
*
*
#if !defined(CERNLIB_QMIBMVF)
*#include "kernnum/pilot.h"
*
*     Name change (consistancy)
*
      FUNCTION LOCATR(ARRAY,LENGTH,OBJECT)
      DIMENSION ARRAY(*)
      LOCATR=LOCATF(ARRAY,LENGTH,OBJECT)
      END

      FUNCTION LOCATF(ARRAY,LENGTH,OBJECT)
C         BINARY SEARCH THRU 'ARRAY'  TO FIND  'OBJECT'
C         'ARRAY' IS ASSUMED TO BE SORTED PRIOR TO CALL
C         IF MATCH IS FOUND, FUNCTION RETURNS POSITION OF ELEMENT
C         IF NO MATCH FOUND, FUNCTION GIVES NEGATIVE OF NEAREST ELEMENT
C                                SMALLER THAN OBJECT
C         F. JAMES ,  SEPT.,1974
      DIMENSION ARRAY(2)
      NABOVE = LENGTH + 1
      NBELOW = 0
   10 IF (NABOVE-NBELOW .LE. 1)  GO TO 200
      MIDDLE = (NABOVE+NBELOW) / 2
      IF (OBJECT - ARRAY(MIDDLE))  100, 180, 140
  100 NABOVE = MIDDLE
      GO TO 10
  140 NBELOW = MIDDLE
      GO TO 10
  180 LOCATF = MIDDLE
      GO TO 300
  200 LOCATF = -NBELOW
  300 RETURN
      END
#endif
