Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50212/pullf.f4
There are no other files named pullf.f4 in the archive.
SUBROUTINE PULLF (ID,IDF,IB)
C THIS PROGRAM EXTRACTS A SUBFILE FROM MASTER FILE SPECIFIED BY
C THE RECORD ID OF THE TEMPORARY FILE AND DELETS THESE RECORDS FROM
C THE MASTER FILE . ESSENTIALLY IT PERFORMS THE INVERSE OPERATION OF
C MERGF. ALL RECORD ID IN IDF MUST BE INTHE MASTER FILE AND IN CORRESPONDING ORDER.
DIMENSION IPAR(10),IFRMAT(3,1),IB(10)
COMMON IDFILE,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,LPFR,C1
EQUIVALENCE(IPAR(1),IDFILE)
COMMON IFRMAT
CALL SLECTF(IDF)
LSR1=LFR
NSPR1=NSPR
LENGTH=(NAVR-LFR)/NSPR
CALL SLECTF(ID)
LSR=LFR
J=1
DO 1 I=1,LENGTH
CALL DIO(LSR1,1,IB,1)
IDR=IB(1)
4 CALL DIOSEQ(LSR,1,IB,NSPR)
IF(IB(1)-IDR)2,5,2
2 CALL DIO(LSR-(I-J)*NSPR,0,IB,NSPR)
LSR=LSR+NSPR
IF(LSR-NAVR)4,20,20
20 TYPE 100,I,IDR
100 FORMAT(1X,'RECORD',I3,' ID=',I10,' NOT IN FILE')
TYPE 101
101 FORMAT(1X,'EXTRACTION TERMINATED')
21 NAVR=NAVR-(I-J)*NSPR
CALL SAVEF
RETURN
5 CALL DIO(LSR1,0,IB,NSPR1)
LSR1=LSR1+NSPR1
1 LSR=LSR+NSPR
CALL SHRNKF(IB,LENGTH)
CALL SAVEF
RETURN
END