FTN4
      SUBROUTINE KEYWD(IARAY),92069-16001 REV.1912 780809 
      INTEGER IARAY(19) 
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-18009
C     RELOC:     92069-16001
C 
C 
C************************************************************ 
C 
C***********************************************************************
C KEYWD SCANS A DATA BASE NAME, SECURITY CODE, OR SET NAME
C     AND ENTERS IT IN IARAY, LEFT-JUSTIFIED,BLANK-FILLED,IN A2 
C     SCANS PAST ALL LEADING BLANKS 
C     TERMINATES AT THE FIRST SEMICOLON,COMMA,OR BLANK
C     SETS L TO LENGTH
C     SETS COL TO POINT TO TERMINATING COMMA,SEMICOLON,OR BLANK 
C CALLING SEQUENCE
C     CALL KEYWD(IARAY) 
C***********************************************************************
C 
C 
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 IBLNK,ICOMA,ISEMI,I1,I6/40B,54B,73B,1,6/ 
C 
C 
C 
C 
C 
C 
C BLANK-FILL IARAY
C 
      CALL SFILL(IARAY,I1,18,IBLNK) 
C 
C SCAN PAST LEADING BLANKS
C 
101   CALL SGET(CARD,COL,CHAR)
      COL=COL+1 
      IF (CHAR.EQ.IBLNK) GO TO 101
C 
C HAVE FOUND FIRST NON-BLANK, ENTER GLOB IN IARAY 
C 
      L=1 
C 
C COMMA, SEMICOLON  OR BLANK? 
C 
102   IF ( (CHAR.EQ.ICOMA).OR.(CHAR.EQ.ISEMI).OR.(CHAR.EQ.IBLNK) )RETURN
        CALL SPUT(IARAY,L,CHAR) 
        L=L+1 
        CALL SGET(CARD,COL,CHAR)
        COL=COL+1 
C 
C     GLOB TOO LONG? IF SO, STOP AT 9 
C 
        IF (L.GT.18) RETURN 
      GO TO 102 
      END 
      END$
                