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