FTN4
      PROGRAM QY16(5,90),92069-16060 REV.1912 790326
C 
C 
C*************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C*************************************************************
C 
C 
C     SOURCE:    92069-18079
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C  EXIT SERVICE MODULE
C  CLOSE DATA-BASE AND RETURN TO SYSTEM 
C 
      INTEGER ISTAT(10) 
      INTEGER ERROR(9)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ 
      INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM 
      INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR 
      INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN
      LOGICAL BREAK 
      INTEGER IPFLAG,IOFLAG,RMOTE 
      LOGICAL BATCH,XQBCH 
      INTEGER PAGCNT,LNCNT
      INTEGER PAGLEN,COLLIM 
      REAL    RRCNT 
      REAL    SELT,RSEC 
      INTEGER IPTR
      REAL    RCOUNT
      INTEGER S,R3,TRKNM,IDILU
      INTEGER R6
      REAL    ATOTAL
      INTEGER LIST,L,T,U
      INTEGER LEVSTR,LEVLEN 
      INTEGER IBUFF 
      INTEGER SS(7,100) 
C 
      COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145)
      COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) 
      COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR
      COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN
      COMMON BREAK
      COMMON IPFLAG,IOFLAG,RMOTE
      COMMON BATCH,XQBCH
      COMMON PAGCNT,LNCNT 
      COMMON PAGLEN,COLLIM
      COMMON RRCNT
      COMMON SELT(64),RSEC
      COMMON IPTR 
      COMMON RCOUNT 
      COMMON S(15,50),R3,TRKNM,IDILU
      COMMON R6 
      COMMON ATOTAL(6,5)
      COMMON LIST(101,6),L(7),T(5),U(7,5) 
      COMMON LEVSTR(66,5),LEVLEN(5) 
      COMMON IBUFF(2048)
C 
      EQUIVALENCE (S,SS)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
C 
C 
C 
C 
C 
C 
      DATA ERROR/2H  ,2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
C 
C 
      IF(DBNAM(2) .EQ. 2H  ) GOTO 100 
      CALL DBCLS(DBNAM,IDUM,1,ISTAT)
      IF(ISTAT .EQ. 0) GOTO 100 
      CALL CITA(ISTAT,ERROR(7)) 
      CALL QRIO(2,ITTY,ERROR,9) 
C 
C RELEASE 'QSKIB' TRACK 
C 
100   CONTINUE
      CALL EXEC(5,-1) 
C 
C CLOSE THE SELECT FILE 
C 
      CALL ECLOS(JDCB)
C 
C CLOSE THE PROCEDURE FILE
C 
      CALL CLEOF(RMOTE,IDCB)
C 
C CLOSE THE INPUT FILE OR DEVICE
C 
      CALL CLEOF(RMOTE,INLU)
C 
C CLOSE THE LIST FILE OR DEVICE 
C 
      CALL CLEOF(RMOTE,ILP) 
C 
C CLOSE THE LOG DEVICE OR FILE
C 
      CALL CLEOF(RMOTE,ITTY)
C 
C CLOSE THE XEQ FILE
C 
      CALL CLEOF(RMOTE,XEQ) 
      STOP
      END 
C 
C 
C 
C 
      SUBROUTINE CLEOF(NODE,LU),92069-16060 REV.1912 790220 
      INTEGER NODE,LU(145)
C 
C 
C 
C ABSTRACT: 
C 
C THIS ROUTINE CLOSES FILES, OR WRITES AN EOF TO THE DEVICE THEN UNLOCKS
C THE DEVICE.  THE DEVICES MAY BE LOCAL OR REMOTE.   WHEN NODE IS EQUAL 
C TO -1, THE DEVICE IS LOCAL TO QUERY, OTHERWISE THE DEVICE IS REMOTE.
C THE FIRST WORD OF THE LU DATA STRUCTURE INDICATES WHETHER THIS IS A 
C FILE OR A DEVICE.  WHEN THE FIRST WORD IS -1, THIS IS A FILE.  OTHER- 
C WISE, THIS IS A DEVICE LU.
C 
C 
C CALLING SEQUENCE: 
C 
C     CALL CLEOF(NODE,LU) 
C 
C       WHERE:
C 
C          NODE 
C          IS THE NODE NUMBER.  -1 INDICATES LOCAL NODE.
C 
C          LU 
C          IS THE LU DATA STRUCTURE.
C            WORD 1  INDICATES FILE OR LU 
C                    -1 IMPLIES FILE
C                       OTHERWISE IT IS AN LU 
C            WORD 2-145 IS THE FMP DCB FOR THE FILE 
C 
C 
C 
C 
C 
C BEGIN 
C 
      LU2 = IAND(LU,77B) + 100B 
C 
C IF THIS IS A FILE, GO CLOSE IT
C 
      IF(LU .LT. 0) GOTO 20 
C 
C IF THIS IS A LOCAL LU, GO WRITE A LOCAL EOF 
C 
      IF(NODE .LT. 0) GOTO 10 
C 
C WRITE A REMOTE EOF TO THE LU
C 
      CALL DEXEC(NODE,100003B,LU2)
      GOTO 30 
777   GOTO 15 
C 
C WRITE A LOCAL EOF 
C 
10    CONTINUE
      CALL EXEC(100003B,LU2)
      GOTO 30 
C 
C RELEASE THE LU LOCK 
C 
15    CONTINUE
      CALL LUREQ(NODE,0,LU,IERR)
      GOTO 30 
C 
C CLOSE THE FILE
C 
20    CONTINUE
      CALL ECLOS(LU(2)) 
C 
C EXIT
C 
30    CONTINUE
      RETURN
      END 
                                                              