Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
C	TITLE   S L S U B F
C		MAKES A SUBFILE OF A MASTER FILE BY
C		SELECTING RECORDS ACCORDING TO SPECIFIED PARAMERERS
      DIMENSION IB(260),B(260),IPAR(10),IFRMAT(3,20),IR(260)
      DIMENSION INDEX(8),IVALUE(8),IF(8)
      DIMENSION IPRSVE(10,2)
	COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT ,NCPR,LPFR,C1
      COMMON IFRMAT
	EQUIVALENCE (IB(1),B(1)),(IPAR(1),IDF),(IB(1),IR(1))
	TYPE 200
200	FORMAT(1X,'INPUT MASTER FILE ID'/)
      	ACCEPT100,IDFILE
 100  FORMAT(A5)
	TYPE 201
201	FORMAT(1X,'INPUT TEMP FILE ID,NSPR,MAXR,NCPR'/)
	ACCEPT 101,IDF1,NSPR1,MAXR1,NCPR1
101  	FORMAT(A5,3I)
	TYPE 202
202	FORMAT(1X,'INPUT NUMBER OF WORDS TO SELECT ON,1-ALL 0-OR'/)
      ACCEPT102,N,LOGIC
 102  FORMAT(2I)
	TYPE 203
203	FORMAT(1X,'INPUT WORD #,VALUE TO COMPARE,COMPARISON CODE'/)
      ACCEPT103,(INDEX(I),IVALUE(I),IF(I),I=1,N)
 103  FORMAT(3I)
      LR=1
      CALL DIO(LR,1,IPAR,1)
      IF(IFIND(IDF1,1,0))4,1,4
 1    CALL DFINEF(IDF1,NSPR1,MAXR1,NCPR1)
      CALL SAVEF
 4    CALL SLECTF(IDFILE)
      LR=NAVR-NSPR
      CALL PTF(1,IPRSVE)
      CALL SLECTF(IDF1)
      CALL CLEAR(IB)
      NAVR=LFR
      LSR=LFR
      CALL PTF(2,IPRSVE)
      CALL GTF(1,IPRSVE)
      DO2LSR=LFR,LR,NSPR
      IF(IGETR(IR,N,INDEX,IVALUE,IF,LOGIC))3,2,3
3     PRINT104,(IB(I),I=1,6)
 104  FORMAT(1X,I10,5A5)
      CALL EXCHGF(1,2,IPRSVE)
      LSR=NAVR
      NAVR=NAVR+NSPR
      CALL WRITER(IB)
      CALL EXCHGF(2,1,IPRSVE)
 2    CONTINUE
      CALL GTF(2,IPRSVE)
      CALL SAVEF
      CALL EXIT
	END