FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18408 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C CLOSE LIST FILE C OR UNLOCK LU C SUBROUTINE ACCLL ,92067-16361 REV.1940 790721 DIMENSION LU2(2) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) DATA LU2 /0,1100B / IF(LIST(1).LE.0) RETURN IF(IAND(LIST(4),3).EQ.3) GO TO 100 C C TOP OF FORM C LU2(1)=IOR(LIST,100000B) CALL XLUEX(3,LU2,-1) C C UNLOCK LU C CALL LURQ(70000B,LU2,1) GO TO 110 50 LIST(1)=-1 RETURN C C CLOSE LIST FILE C 100 CALL ACCLS(LDCB,LIST(7)) 110 LIST(1)=-1 GO TO 50 END C C C THIS ROUTINE CLOSES AND TRUNCATES THE LIST FILES C C CALL ACCLS(IDCB,ITYPE) CC CC WHERE : IDCB IS THE DCB FOR THE FILE CC ITYPE IS FILE TYPE CC CC FILE TYPES 1 AND 2 WILL NOT CC BE TRUNCATED. C SUBROUTINE ACCLS(IDCB,ITYPE),92067-16361 REV.1940 790722 ITRUN=0 IF(ITYPE.LT.3) GO TO 105 C C FIND OUT WHERE WE ARE AND HOW BIG THE FILE IS C CALL LOCF(IDCB,IERR,I,IRB,I,JSEC) C C COMPUTE HOW MANY SECTORS TO DELETE C FOR THE STUPID (DUMB) FILE MANAGER C ITRUN=JSEC/2-IRB-1 C C CLOSE AND TRUNCATE C C (IF ITRUN=0 THEN NO TRUNCATION TAKES PLACE) 105 CALL CLOSE(IDCB,IERR,ITRUN) RETURN END