Google
 

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