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