Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50212/deletf.f4
There are no other files named deletf.f4 in the archive.
      SUBROUTINE DELETF
C*****DELETES THE FILE WHOSE PARAMETERS ARE IN COMMON. IT RETURNS WITH
C*****THE DISK POINTER FILES IN COMMON
C*****WHEN AT ALL POSSIBLE THE FILES SHOULD BE DELETED BY THE LAST IN
C*****FIRST OUT ALGORITHM
      DIMENSION IB(10),IPAR(10)
	COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,LPFR,C1
	EQUIVALENCE (IPAR(1),IDF)
C*****SAVE FIRST AND LAST SECTOR ADDRESS AND FILE NAME
      LFSA=LFMT
	IF(LFMT.EQ.0)LFSA=LFR
      LLSA=MAXR+1
      IDFILE=IDF
	IF(LFSA)7,7,6
7	LFSA=LFR-NSPR
C*****CHECK TO SEE WHICH DISK PACK THE FILE IS ON
6	MOD=LFR/1000000
	LR=MOD*1000000+1
C*****DELETE THE POINTER FILE RECORD
11    CALL DIO (LR,1,IPAR,1)
	CALL ADDMSK(MOD)
      CALL DELETR(IDFILE,IB)
	CALL SAVEF
C*****CHANGE THE POINTER FILE PARAMETERS FOR ALL FILES DEFINED AFTER ID
C*****AND WRITE THEM BACK ON DISK
      LASTF=NAVR-2
      IF(LSR-LASTF)4,4,5
4     DO 1 LSR=LSR,LASTF,NSPR
      CALL READR(IB)
      DO 10 I=2,7
      IF(I-5)3,10,3
3     IB(I)=IB(I)-LLSA+LFSA
10    CONTINUE
      IB(9)=IB(9)-1
1     CALL WRITER(IB)
C*****READ MASTER FILE PARAMETERS INTO COMMON
5      LR=NAVR-1
      CALL DIO(LR,1,IPAR,1)
	CALL ADDMSK(MOD)
      IPAR(9)=LR
C*****MOVE ALL FILES INTO PROPER POSITION, SAVE IDS POINTER FILE IN
C*****COMMON AND RETURN
      LSR=LLSA
      CALL SHRNKF(IB,LLSA-LFSA)
      CALL SAVEF
50    RETURN
	END