Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50212/mergef.f4
There are no other files named mergef.f4 in the archive.
      SUBROUTINE MERGEF(ID,IDF,IB)
C     MERGES MASTER FILE (ID) WITH INPUT FILE (IDF)
C     FILES MUST BE SORTED IN PROPER ORDER.
C     IB1 IS RECORD BUFFERS.
      DIMENSION IPAR(10),IFRMAT(1),IB(10)
	COMMON IDFILE,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,LPFR,C1
      EQUIVALENCE (IPAR(1),IDFILE)
      COMMON IFRMAT
      CALL SLECTF(ID)
      NAVR1=NAVR
      LNG1=(MAXR-NAVR)/NSPR+1
      CALL SLECTF(IDF)
	NSPR1=NSPR
      LENGTH=(IPAR(3)-IPAR(2))/IPAR(5)
      IF(LNG1-LENGTH)69,68,68
68    IF(LENGTH)50,50,60
60    J=1
	NAVR2=NAVR
	CALL SLECTF(ID)
	LSR=NAVR-NSPR
      DO 1 I=1,LENGTH
      LSR1=NAVR2-I*NSPR1
	CALL DIO(LSR1,1,IB,NSPR1)
      IDR=IB(1)
5     IF(LSR-LFR)2,6,6
6     CALL DIOSEQ(LSR,1,IB,NSPR)
      IF(IB(1)-IDR)2,3,4
2     CALL DIO(LSR1,1,IB,NSPR)
      CALL DIO(LSR+(LENGTH-I+1)*NSPR,0,IB,NSPR)
      GO TO 1
4     CALL DIO(LSR+(LENGTH-I+1)*NSPR,0,IB,NSPR)
      LSR=LSR-NSPR
      GO TO 5
1	CONTINUE
      NAVR=NAVR1+LENGTH*NSPR
	LSR=LFR
      CALL SAVEF
	RETURN
3     TYPE 100,IDR
100   FORMAT(8HERROR ID,I10,9H1N MERGEF)
      TYPE 101
101    FORMAT(41HTHE ABOVE ID IS DUPLICATED IN MASTER FILE)
      GO TO 2
69    TYPE106,LENGTH,LNG1

106   FORMAT(1X, 13HTRYING TO ADD,1X,I10,1X, 13HONLY ROOM FOR,I10)
      CALL EXIT
50	CALL SLECTF(ID)
	RETURN
	END