Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50212/igetr.f4
There are no other files named igetr.f4 in the archive.
      FUNCTION IGETR(IB,N,INDEX,IVALUE,IF,LOGIC)
C*****PROCESSES RECORD AT LSR RETURNS WITH THAT RECORD IN IB
C*****COMPARES ACTUAL WORDS WITH GIVEN ONES.  IF THE GIVEN CONDITIONS
C*****ARE SATISFIED IGETR=1, IF NOT IGETR=0
C*****************************
C*****N IS NUMBER OF WORDS TO TEST.
C*****INDEX(I),I=1,N I TH WORD NUMBER IB(INDEX(I))
C*****IVALUE(I),I=1,N VALUE TO COMPARE IB(INDEX(I)) WITH
C*****IF(I),I=1,N IS RELATIONSHIP BETWEEN IB(INDEX(I)) AND IVALUE(I)
C*****=1 IF FIRST IS GREATER, =0 IF BOTH ARE EQUAL=-1 IF FIRST IS LESS.
C*****LOGIC=1 IF LOGICAL AND-ING,=0 IF LOGICAL OR-ING OF CONDITIONS.
      DIMENSION IB(260)
      DIMENSION INDEX (8), IF(8), IVALUE (8)
      DIMENSION IPAR(10)
      COMMON IPAR
C		TEST IF INPUT HAS BEEN DEFINED.IF NOT GET IT
	IF(N.NE.0)GO TO 20
	TYPE 100
100	FORMAT(1X,'INPUT NUMBER OF WORDS TO SELECT ON AND LOGIC'/)
	ACCEPT 200,N,LOGIC
200	FORMAT(2I)
	TYPE 101
101	FORMAT(1X,'INDEX,VALUE,-1 0 OR 1'/)
	ACCEPT 201,(INDEX(I),IVALUE(I),IF(I),I=1,N)
201	FORMAT(3I)
C*****READS A RECORD AT LSR INTO IB
20      CALL READR(IB)
C*****COMPARE ACTUAL AND TEST VALUE FOR I TH WORD
      DO 10 I=1,N
      J=INDEX(I)
      ITEST=IB(J)-IVALUE(I)
      IF (ITEST) 1,2,3
1     IF (IF(I)) 4,5,5
2     IF (IF(I)) 5,4,5
3     IF (IF(I)) 5,5,4
4     IF (LOGIC) 10,11,10
5     IF (LOGIC) 12,10,12
10    CONTINUE
      IF (LOGIC) 11,12,11
12    IGETR=0
      RETURN
11    IGETR=1
      RETURN
      END