Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50212/expndf.f4
There are no other files named expndf.f4 in the archive.
      SUBROUTINE EXPNDF(ID,N)
      DIMENSION IB(240),B(240),IPAR(10),IFRMAT(3,1)
	COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,C1,C2
      COMMON IFRMAT
      EQUIVALENCE (IB(1),B(1)), (IPAR(1),IDF)
C     EXPAND MAXAVAILABLE RECORD N RECORDS
C     EXITS WITH ID FILE PARAMETERS IN CORE
C		INEFFICIENT TO USE EXECPT FOR LAST FILE IN PACK
C		NOT TOO BAD IF USED OCCASIONALLY ON OTHER FILES
      CALL SLECTF(ID)
      M=N*NSPR
      LR=MAXR
      MAXR=MAXR+M
      CALL SAVEF
C    GET MASTER FILE PARAMETERS
	LPFPR=IUNPAK(0,6,LR)+1
      CALL DIO(LPFPR,1,IPAR,1)
      LRMFLE  =NAVR-1
      CALL DIO(LRMFLE,1,IPAR,1)
      M1=M/24
      IF(M1)6,6,7
7     NSPR=24
      LSR=LR+M-M1*24
       CALL STRCHF(IB,M1)
6     M2=M-M1*24
      IF(M2)60,60,8
8     LSR=LR
      NSPR=1
      CALL STRCHF(IB,M2)
C   SAVE MASTER FILE PAPAMETERS
60	NSPR=1
       CALL DIO(LRMFLE,0,IPAR,1)
      LR=LPFPR
C     BRING IN POINTER FILE TO CHANGE FILE PARAMETERS OF ALL FILES
C     DEFINED AFTER ID
      CALL DIO(LR,1,IPAR,1)
      IF(IFIND(ID,-1,0))1,1,1
 1    LASTF=NAVR-2
      LFIRST=LSR+1
      IF(LFIRST-LASTF)4,4,5
4     DO24LSR=LFIRST,LASTF,NSPR
      CALL READR(IB)
      DO 2 I=2,7
      IF(I-5)3,2,3
 3    IB(I)=IB(I)+M
 2    CONTINUE
 24   CALL WRITER(IB)
5     CALL SLECTF(ID)
      RETURN
	END