FTN4
      PROGRAM BCLO2(5,90),92069-16001 REV.1912 780814 
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-18006
C     RELOC:     92069-16001
C 
C 
C************************************************************ 
C 
C***********************************************************************
C BCLOS PERFORMS TERMINATION ACTIONS
C     THE DATA BASE IS CLOSED 
C     IF NO ERRORS OCCURRED, THE MESSAGE IS PRINTED OUT:
C      DATA BASE SUCCESSFULLY BUILT OR UPDATED
C***********************************************************************
      INTEGER M3(11),M4(22),M5(22),IA(3),M6(24),M7(36),M8(22),M9(29)
      INTEGER DUMMY,ISTAT(10) 
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$  AUGUST 10,1978 $$$
      INTEGER ERROR,P,PLEN,CARD,LOG,COL 
      INTEGER ELECT,ITEM,LENTH,TYPE 
      INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST
      INTEGER IBASE 
      INTEGER SETERR
      INTEGER TRUE,FALSE,SEMI,COMMA 
      INTEGER L,CHAR
      INTEGER SETNO 
      INTEGER QTFLAG
C 
      COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL 
      COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129)
      COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST 
      COMMON IBASE(10)
      COMMON SETERR 
      COMMON L,CHAR 
      COMMON SETNO
      COMMON QTFLAG 
      COMMON/CONST/TRUE,FALSE,SEMI,COMMA
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$  OCTOBER 16,1978 $$
      DATA I0,I1/0,1/ 
      DATA I2,I208/2,208/ 
      DATA N22,N40,N44,N48,N58,N72/-22,-40,-44,-48,-58,-72/ 
      DATA M3/2H N,2HUM,2HBE,2HR ,2HOF,2H E,2HRR,2HOR,2HS:,2H  ,2H  / 
      DATA M4/2H D,2HAT,2HA ,2HBA,2HSE,2H S,2HUC,2HCE,2HSS,2HFU,
     12HLL,2HY ,2HBU,2HIL,2HT ,2HOR,2H U,2HPD,2HAT,2HED/
      DATA M5/2H F,2HAT,2HAL,2H E,2HRR,2HOR,2H. ,2HTH,2HE ,2HDA,2HTA, 
     12H B,2HAS,2HE ,2HHA,2HS ,2HBE,2HEN,2H P,2HUR,2HGE,2HD./ 
      DATA M6/2H O,2HNL,2HY ,2HER,2HRO,2HR-,2HFR,2HEE,2H E,2HNT,2HRI, 
     12HES,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H D,2HAT,2HA ,2HBA,2HSE,2H. / 
      DATA M7/2H O,2HNL,2HY ,2HTH,2HOS,2HE ,2HEN,2HTR,2HIE,2HS ,
     12HEN,2HCO,2HUN,2HTE,2HRE,2HD ,2HBE,2HFO,2HRE,2H T,2HHE,2H E,
     12HRR,2HOR,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H D,2HAT,2HA , 
     12HBA,2HSE,2H. / 
      DATA M8/2H C,2HAN,2HNO,2HT ,2HPR,2HOC,2HES,2HS ,2HTH,2HIS,2H S, 
     12HET,2H. ,2HON,2HLY,2H T,2HHO,2HSE,2H E,2HNT,2HRI,2HES/ 
      DATA M9/2H E,2HNC,2HOU,2HNT,2HER,2HED,2H B,2HEF,2HOR,2HE ,2HTH, 
     12HIS,2H E,2HRR,2HOR,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H T,2HHE,
     12H D,2HAT,2HA ,2HBA,2HSE,2H. /
C 
C 
C 
C 
C 
C 
C CLOSE THE DATA BASE 
C 
      CALL DBCLS(IBASE,DUMMY,1,ISTAT) 
      IF(ERROR .EQ. -1) STOP
      IF(ISTAT .NE. 0) CALL ERROT(ISTAT)
C 
C 
C     WRITE "NUMBER OF ERRORS:" ERROR 
C 
      CALL CITA(ERROR,IA) 
      M3(10)=IA(2)
      M3(11)=IA(3)
      CALL OUTLN(M3,11) 
C 
C WRITE TERMINATION MESSAGES
C 
      IF (CHECK.EQ. TRUE) GOTO 110
      IF (ERROR.NE.0) GO TO 105 
C 
C     WRITE "DATA BASE SUCCESSFULLY BUILT OR UPDATED" 
C 
      CALL OUTLN(M4,20) 
      GOTO 110
C 
C 
C 
105   IF (QTFLAG.EQ. TRUE) GO TO 106
      IF (SETERR.EQ.-1) GO TO 108 
C 
C     WRITE "ONLY ERROR-FREE ENTRIES WERE PUT IN DATA BASE" 
C 
      CALL OUTLN(M6,24) 
      GOTO 110
C 
C     WRITE "ONLY THOSE ENTRIES ENCOUNTERED BEFORE THE ERROR WERE 
C      PUT IN THE DATA BASE"
C 
106   CALL OUTLN(M7,36) 
      GOTO 110
C 
C     WRITE "CANNOT PROCESS THIS SET.  ONLY THOSE ERROR-FREE ENTRIES
C      ENCOUNTERED BEFORE THIS ERROR WERE PUT IN THE DATA BASE" 
C 
108   CALL OUTLN(M8,22) 
      CALL OUTLN(M9,29) 
110   CALL HALT 
      END 
      END$
                                                                                                        