SUBROUTINE UPDATE(INT,SUB,FILNM,LENG,CHAN,L2,OPTION) C L2 IS LENGTH OF EMPTY BLOCK C LENG IS LENGTH OF THE FILE INTEGER*2 SUB,CHAN,ADDTN,S,T2,C,E,DATE,DIR(2048),S1 BYTE FILNM(8),OPTION COMMON DIR,/DAT/DATE C READ IN BLOCK THAT REQUIRES UPDATE I=IROS8W(256,DIR,INT,CHAN) IF(I.LT.0)STOP 'BAD READW' C STORE 256 12 BIT WORD DIRECTORY IN TEMP CALL IC(DIR,DIR(257)) C REQUIRED BLOCK IS NOW LOADED ADDTN=-NUMB(DIR(261)) !NUMBER OF ADDITIONAL WORDS E=-NUMB(DIR(257)) !NUMBER OF ENTRIES IN THIS BLOCK LX=262 !START OF ENTRIES S=LX IF(OPTION.EQ.'R')GOTO 600 IF(SUB.EQ.1)GOTO 55 DO 40 IX=1,SUB-1 IF(DIR(LX).EQ.0)GOTO 60 LX=LX+ADDTN+5 GOTO 40 60 LX=LX+2 40 CONTINUE C LX NOW POINTS TO EMPTY ENTRY 55 DO 65 IK=1,LX-257 65 DIR(IK)=DIR(IK+256) C NOW UPDATE THE ENTRY AND SHIFT ALL OTHER ENTRIES DOWN S1=LX-256 IF(OPTION.EQ.'D')GOTO 200 !TO DELETE FILE C INSERT FILE DO 100 I=1,4 100 DIR(S1+I-1)=IAPACK(FILNM(I*2-1),FILNM(I*2)) C LAST LOOP PUTS IN NAME OF FILE LX=LX+2 !LX POINTS TO NEXT ENTRY IN TEMP C NOW FILL IN ADDTIONAL WORDS S1=S1+4 !POINTS TO FIRST ADDITIONAL WORD DIR(S1)=DATE !SET DATE S1=S1+1 !NOW POINTS AT LENGTH T2=-LENG DIR(S1)=IACON(T2) C IS NEW FILE SHORTER THAN THE EMPTY BLOCK C IF SO INSERT EMPTY BLOCK AT END OF NEW FILE LDIFF=L2-LENG !DIFFERENCE BETWEEN FILES IF(LDIFF.EQ.0)GOTO 240 !SAME SIZE S1=S1+1 !POINTS TO NEXT ENTRY IN DIR DIR(S1)=0 !INSERT EMPTY BLOCK S1=S1+1 DIR(S1)=IACON(-LDIFF) !INSERT LENGTH OF EMPTY BLOCK E=E+1 !ADD ONE TO NUMBER OF ENTRIES DIR(1)=IACON(-E) !CHANGE NUMBER OF ENTRIES C=506 !NUMBER OF WORDS TO BE FILLED GOTO 250 C SINCE WE DID NOT INSERT EMPTY BLOCK WE HAVE TWO MORE C WORDS TO FILL IN FROM TEMP TO DIR 240 C=508 C NOW SHIFT ALL OTHER ENTRIES DOWN 250 DO 201 ILK=LX,C S1=S1+1 201 DIR(S1)=DIR(ILK) C NOW CONVERT TO CORRECT FORMAT 500 MASK="162745 CALL IBIT(DIR,DIR(257),MASK) I=IWRITW(256,DIR(257),INT,CHAN) IF(I.LT.0)STOP 'BAD WRITEW' RETURN 200 DIR(S1)=0 S1=S1+1 DIR(S1)=IACON(-LENG) S1=S1+1 C S1 POINTS TO NEXT ENTRY IN DIR C LX POINTS TO NEXT ENTRY IN TEMP STORAGE LX=LX+6 DO 300 IZ=LX,512 DIR(S1)=DIR(IZ) 300 S1=S1+1 DO 400 IZ=252,256 400 DIR(IZ)=DIR(IZ+256) GOTO 500 C RENAME THE FILE ,1ST MOVE THROUGH THE DIRECTORY TO REQUIRED FILE 600 IF(SUB.EQ.1)GOTO 654 DO 610 I=1,SUB-1 IF(DIR(LX).EQ.0)GOTO 620 !EMPTY FILE LX=LX+ADDTN+5 GOTO 610 620 LX=LX+2 610 CONTINUE 654 DO 655 I=1,4 655 DIR(LX+I-1)=IAPACK(FILNM(I*2-1),FILNM(I*2)) DO 657 I=1,256 657 DIR(I)=DIR(I+256) GOTO 500 END