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