Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50212/dfnf.f4
There are no other files named dfnf.f4 in the archive.
SUBROUTINE DFNF(ID,NSPR,MAX,NCPR,NMOD)
C*****SETS UP NEW POINTER FILE AND ALTERS DISK POINTER FILE
C*****APPROPRIATELY*****************************************************
C*****NEW FILE PARAMETERS ARE LEFT IN COMMON
C*****ID,NSPR AND NCPR OF NEW FILE
C MAX - MAXIMUM NUMBER OF RECORDS IN FILE
C NMOD = 0 ,1,2,3 . . .LOGICAL PACK NUMBER
DIMENSION IPAR(10),IFRMTF(1)
COMMON IDF,LFR,NAVR,MAXF,NSPRPF,LSR,LFMT,NCPRPF,LPFR,C1
COMMON IFRMTF
EQUIVALENCE (IPAR(1),IDF)
DIMENSION IB(10)
C*****READS DISK POINTER FILE INTO IPAR
LR=NMOD*1000000+1
4 CALL DIO(LR,1,IPAR,1)
CALL ADDMSK(NMOD)
LRP=LR
2 LR=NAVR-1
DO 66 I=LRP,LR
CALL DIO(I,1,IB,1)
IF (IB(1)-ID) 66,68,66
66 CONTINUE
GO TO 968
68 IF(IB(5).EQ.NSPR)GO TO 71
69 TYPE 200, ID,IB(5),IB(8),NSPR,NCPR
200 FORMAT(28HTHERE IS A FILE BY THE NAME ,A5,21H ALREADY ON THE DISK.
1/26X,4HNSPR,16X,4HNCPR/13HEXISTING FILE,7X,I10,10X,I10
2/9HYOUR FILE,11X,I10,10X,I10)
CALL EXIT
71 LSR=I
CALL SUBMSK(NMOD)
CALL DIO(LRP,0,IPAR,1)
CALL DIO(I,1,IPAR,1)
NAVR=LFR
LSR=LFR
CALL DIO(I,0,IPAR,1)
CALL ADDMSK(NMOD)
RETURN
968 CONTINUE
C*****READS LAST POINTER FILE FOR DISK INTO IPAR
CALL DIO(LR,1,IPAR,1)
C*****SETS I ACCORDING TO NCPR
CALL ADDMSK(NMOD)
IF(NCPR)81,81,80
81 I=0
GO TO 8
80 I=(3*NCPR)/10+1
C*****CHECKS TO SEE IF THERE IS AVAILABLE ROOM ON THE DISK AND SETS
C*****IPAR(2)
8 LFMTR=NAVR
MXAVS=IPAR(4)
LFR=LFMTR+I+NSPR
IF (LFR+MAX*NSPR-MXAVS) 7,7,19
C*****IF NO AVAILABLE ROOM ON DISK, TYPES MESSAGE AND EXITS
19 TYPE 101
101 FORMAT(31H DK ERROR, NO AVAILABLE RECORDS)
CALL EXIT
C*****SETS UP NEW POINTER FILE AND WRITES IT OVER OLD INFORMATION
7 IPAR(1)=ID
MAXF=LFR+MAX*NSPR
IPAR(5)=NSPR
LSR=LFR
IPAR(7)=LFMTR
IPAR(8)=NCPR
IPAR(9)=LR
IPAR(10)=0
NAVR=LFR
CALL SUBMSK(NMOD)
CALL DIO(LR,0,IPAR,1)
C*****INFOMATION NEEDED FOR LAST POINTER FILE ON DISK
LR1=LR+1
IB(3)=MAXF+NSPR
C*****READS DISK POINTER FILE INTO IPAR, UPDATES NAVR AND LSR AND
C*****WRITES IT BACK ON DISK
LR=LRP
CALL DIO(LR,1,IPAR,1)
NAVR=NAVR+NSPRPF
LSR=NAVR-2
CALL DIO(LR,0,IPAR,1)
C*****SETS UP LAST POINTER FILE FOR DISK AND WRITES IT ON DISK
IB(1)=0
IB(2)=MAXF+1
IB(4)=MXAVS-NMOD*1000000
IB(5)=1
IB(6)=IB(2)
IB(7)=0
IB(8)=0
IB(9)=LR1-NMOD*1000000
IB(10)=0
CALL DIO (LR1,0,IB,1)
C*****READS NEW POINTER FILE INTO COMMON AND RETURNS TO MAIN PROGRAM
CALL DIO(LR1-1,1,IPAR,1)
CALL ADDMSK(NMOD)
RETURN
END