src/f77/locatf.F

*
* $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
1	*
2	* $Id: locatf.F,v 1.2 1996/05/24 10:56:52 jamie Exp $
3	*
4	* $Log: locatf.F,v $
5	* Revision 1.2 1996/05/24 10:56:52 jamie
6	* add locatr entry for consistency with wrup
7	*
8	* Revision 1.1.1.1 1996/02/15 17:48:49 mclareni
9	* Kernlib
10	*
11	*
12	#if !defined(CERNLIB_QMIBMVF)
13	*#include "kernnum/pilot.h"
14	*
15	* Name change (consistancy)
16	*
17	FUNCTION LOCATR(ARRAY,LENGTH,OBJECT)
18	DIMENSION ARRAY(*)
19	LOCATR=LOCATF(ARRAY,LENGTH,OBJECT)
20	END
21
22	FUNCTION LOCATF(ARRAY,LENGTH,OBJECT)
23	C BINARY SEARCH THRU 'ARRAY' TO FIND 'OBJECT'
24	C 'ARRAY' IS ASSUMED TO BE SORTED PRIOR TO CALL
25	C IF MATCH IS FOUND, FUNCTION RETURNS POSITION OF ELEMENT
26	C IF NO MATCH FOUND, FUNCTION GIVES NEGATIVE OF NEAREST ELEMENT
27	C SMALLER THAN OBJECT
28	C F. JAMES , SEPT.,1974
29	DIMENSION ARRAY(2)
30	NABOVE = LENGTH + 1
31	NBELOW = 0
32	10 IF (NABOVE-NBELOW .LE. 1) GO TO 200
33	MIDDLE = (NABOVE+NBELOW) / 2
34	IF (OBJECT - ARRAY(MIDDLE)) 100, 180, 140
35	100 NABOVE = MIDDLE
36	GO TO 10
37	140 NBELOW = MIDDLE
38	GO TO 10
39	180 LOCATF = MIDDLE
40	GO TO 300
41	200 LOCATF = -NBELOW
42	300 RETURN
43	END
44	#endif