Google
 

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