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 
                                                                                                            