Google
 

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