FTN4
      SUBROUTINE LSCAN(KARS,I,J,K),92069-16061 REV.1912 781107
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-18090
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
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   $$$$$$$$$$$$$$$$$$$$$
      DIMENSION KARS(1) 
C 
C     VALUE OF K INDICATES ROUTINE IS PROCESSING
C     BLANKS(1), SYMBOLS(2), LITERALS(3), TERMINATORS(4)
C 
      K = 1 
   80 CONTINUE
      J = ISCAN - 1 
   99 J = J + 1 
C     GET CHARACTER FROM KARS STRING
      IF (J.LE.IEND) GOTO 70
      CALL INPUT
      GO TO 80
C 
C 
C 
C BRANCH ON CHARACTER TYPE
C     1 = IGNORE
C     2 = ALPHABETIC CHARACTER
C     3 = NUMBER OR SPECIAL SYMBOL
C     4 = SEPARATOR OR TERMINATOR 
C     5 = ILLEGAL CHARACTER 
C     6 = START OF LITERAL
C 
   70 CALL SGET(KARS,J,KAR) 
      KAR = KAR - 37B 
      GO TO (1,3,6,3,3,3,3,3, 
C              ! " # $ % & '
C 
     1       3,3,3,3,4,3,4,3, 
C            ( ) * + , - . /
C 
     2       3,3,3,3,3,3,3,3, 
C            0 1 2 3 4 5 6 7
C 
     3       3,3,3,4,3,4,3,3, 
C            8 9 : ; < = > ?
C 
     4       3,2,2,2,2,2,2,2, 
C            @ A B C D E F G
C 
     5       2,2,2,2,2,2,2,2, 
C            H I J K L M N O
C 
     6       2,2,2,2,2,2,2,2, 
C            P Q R S T U V W
C 
     7       2,2,2,3,3,3,3,5), KAR
C            X Y Z [ \ ] ^
C 
C     BLANK 
    1 GO TO (99,24,99), K 
C     LETTER
    2 GO TO (21,99,99), K 
C     DIGIT OR B-CHAR 
    3 GO TO (21,99,99), K 
C     TERMINATOR ,/;/=
    4 GO TO (23,24,99), K 
C     OTHER CHARACTR
    5 GO TO (25,25,99), K 
C     QUOTE 
    6 GO TO (22,25,26), K 
C     START OF SYMBOL 
   21 I = J 
      K = 2 
      GO TO 99
C     START OF LITERAL VALUE
   22 I = J + 1 
      K = 3 
      GO TO 99
C     TERMINATOR
   23 I = J 
      ISCAN = J + 1 
C     COMMA 
      IF (KAR.EQ.13) K = 4
C     SEMI-COLON
      IF (KAR.EQ.28) K = 5
C     EQUALS
      IF (KAR.EQ.30) K = 6
C PERIOD
      IF(KAR .EQ. 15) K=7 
      RETURN
C     TERMINATE SYMBOL
   24 J = J - 1 
      ISCAN = J + 1 
      RETURN
C     ILLEGAL CHARACTER 
   25 I = J 
      ISCAN = J + 1 
      K = -1
      RETURN
C     TERMINATE LITERAL VALUE 
   26 ISCAN = J + 1 
      CALL SGET(KARS,ISCAN,KAR) 
      IF(KAR.EQ.42B) GO TO 30 
      J = J - 1 
      RETURN
   30 CALL SMOVE(KARS,ISCAN+1,IEND,KARS,ISCAN)
      IEND = IEND - 1 
      GO TO 99
      END 
$ 
                                                                                                                  