Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50212/ifind.f4
There are no other files named ifind.f4 in the archive.
FUNCTION IFIND (ID,IDIR,IHOW)
C*****SEARCHES THE FILE WHOSE PARAMETERS
C*****ARE IN COMMON FOR A RECORD THAT IS LESS THAN, EQUAL TO OR GREATER
C*****THAN *ID*
C*****IDR =1 SEARCH TO RIGHT =-1 SEARCH TO LEFT IN BOTH CASES AFTER
C***** 15 RECORDS A BINARY SEARCH IS CALLED
C*****IDR =0 SEARCH TO RIGHT TREATING FILE AS CIRCLE NO BINARY SEARCH
C*****IHOW =0 SEARCHES FOR RECORD = ID, =1 SEARCHES FOR FIRST RECORD
C*****GREATER THAN ID, =-1 FOR FIRST RECORD LESS THAN ID
C*****IF RECORD IS FOUND IFIND=0 AND LSR IS SET AT APPROPRIATE RECORD
C*****IF SUCH A RECORD IS NOT FOUND IFIND=0 AND LSR IS UNCHANGED
DIMENSION IPARF(10), IFRMTF(1)
DIMENSION IB(10)
COMMON IPARF,IFRMTF
C*****CALCULATE THE NUMBER OF RECORDS IN THE FILE
12 CONTINUE
NR=(IPARF(3)-IPARF(2))/IPARF(5)
IF(NR)7,11,7
C*****LOOP THROUGH ALL THE RECORDS
C****** IDIR=0 MAKE LINEAR SEARCH ON FILE
7 IF(IDIR)77,78,77
78 LNGTH=NR
GO TO 79
77 LNGTH=15
79 DO 1 I=1,LNGTH
C*****READ ONE SECTOR FROM THE RECORD AT LSR INTO IB
CALL DIO(IPARF(6),1,IB,1)
C*****SEE IF THE EXISTING RELATIONSHIP SATISFIES THE PARAMETER IHOW
IF(IB(1)-ID)2,3,4
2 IF(IHOW) 5,6,6
3 IF(IHOW)6,5,6
4 IF(IHOW) 6,6,5
C*****IF THIS RECORD DOES NOT SATISFY IHOW, INVESTIGATE A FURTHER SEARCH
C*****IF IDIR=-1 SEARCH TO LEFT IDIR=1 SEARCH RIGHT IDIR=0 RETURN
6 IF(IDIR) 10,120,120
C*****UPDATE LSR AND GO BACK AND LOOK AT NEXT RECORD
10 CALL LEFT(1)
GO TO 1
120 CALL RIGHT(1)
1 CONTINUE
IF(IFIND2(ID,IHOW))11,11,5
11 IFIND=0
RETURN
C*****RETURNS WITH LSR SET TO THAT RECORD WHICH SATISFY THE GIVEN PARAM
5 IFIND=1
RETURN
END