| 1 |
nikolas |
1.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 |
Parent Directory
| 
Revision Log