      SUBROUTINE SCAN(IVAL)
C 
C 
C     THIS ROUTINE SCANS A DEFINITION FIELD FOR A DEF OR SUB
C     DIRECTIVE.  THE FIELD TYPE AND LENGTH ARE DETERMINED. 
C 
C 
C     ENTRY PARAMETERS
C        ICOL - POINTS TO COLUMN THAT SCAN STARTS IN
C     EXIT PARAMETERS 
C        ICOL - POINTS TO COLUMN THAT SCAN ENDED ON 
C        IVAL - VALUE OF FIELD IF FIELD IS A CONSTANT 
C        ILEN - LENGTH OF FIELD 
C        JATT - ARRAY SPECIFING FIELD ATTRIBUTES
C        FTYPE - FIELD TYPE 
C           0 = X, DONT CARE FIELD
C           1 = C, CONSTANT FIELD 
C           2 = V, VARIABLE FIELD 
C           3 = V, VARIABLE FIELD WITH DEFAULT
C           4 = SUBFIELD NAME FOUND ON DEF SCAN 
C           5 = NO VALID FIELDS LEFT
C        IERR - ERROR INDICATOR 
C           1 = NO ERROR
C           2 = ILLEGAL FIELD TYPE
C           3 = ILLEGAL CHARACTER
C           4 = UNDEFINED SYMBOL
C           5 = ILLEGAL FIELD LENGTH
C           6 = FIELD LENGTH CONFLICT 
C           7 = VALUE ERROR 
C           8 = ATTRIBUTE ERROR
C           9 = ARGUMENT ERROR
C          10 = EXPRESSION ERROR
C          11 = ILLEGAL NEGATIVE VALUE
C   
      REAL IVAL
      DIMENSION NUMS(16)
      DIMENSION JCVAL(4)
      DIMENSION ITERM(4),JSYM(19)
      INTEGER FTYPE
      REAL ITABV(249) 
      COMMON ICRD,IPRT,MCFLE,IDFLE,MCREC,IDREC,IFORM,ITRUN,ILOUT,IXCOL
      COMMON MLAB,MOPC,IBIT,ICCNT,IWORD,IERRL,IERRI,IEND,IFRMC
      COMMON LSOR,LIF,LSYM,LREF,LDEF,LOCT,ITRMI,ITRMO
      COMMON ILEN,KLEN,LLEN,KWORD,IFLD(2400),IYFLD,IZFLD
      COMMON IFBIT,ZVAL,CVAL,JREAD,IN(80),INB(80),LINE,IPAGE,LISN
      COMMON IALPH(37),IAST,IDOLR,ISHRP
      COMMON ICOLN,IBLNK,ICTAB,ISEMI,ICOMM,IPLUS,IMIN,IMULT,IDIV
      COMMON IRPAR,ILPAR,IATT(9),JATT(5),LATT(9),IFPAR(16),NBASE,JBASE
      COMMON ICOL,IFCOL,MCOL,MLCOL,IOLIN,ICNT,LTITL(50),IADDR(4,12) 
      COMMON ITYPE,JTYPE,FTYPE,IERR,IERRS,IOPVA,JCOL,IBUG 
      COMMON ITAB(4,249),ITABS(249),ITABV,NAME(4),INDEX,INDET,ISYM,LTAB 
      COMMON IXTAB(256),MXREF,IXT,IXPNT,IXCNT,IXPAG,MCORE(128) 
C INCLUDE(:F1:METAD.COM)
      EQUIVALENCE (IBLNK,JSYM(1)) 
      EQUIVALENCE (IBLNK,ITERM(1))
      EQUIVALENCE (NUMS(1),IALPH(1))
      EQUIVALENCE (ICHRV,IALPH(32)),(ICHRX,IALPH(34)) 
      EQUIVALENCE (ICHR0,IALPH(1)),(ICHR9,IALPH(10))
      DATA JCVAL(1),JCVAL(2),JCVAL(3),JCVAL(4) /2,8,16,10/
C 
      IVAL = 0. 
C     INITIALIZE ATTRIBUTE AND MODIFIER ARRAYS
      DO 50 I=1,9 
      LATT(I) = 0 
50    CONTINUE
      FTYPE = 0 
      ILEN = -1
C     SCAN TO NON-BLANK CHARACTER
60    IF(ICOL-MCOL) 65,65,77
65    IF(IN(ICOL)-IBLNK) 66,70,66
66    IF(IN(ICOL)-ICTAB) 72,70,72 
70    ICOL = ICOL+1 
      GO TO 60
C     CHECK FOR A COMMENT LINE
72    IF(IN(ICOL)-ISEMI) 120,77,120 
C     READ NEXT LINE, CHECK FOR CONTINUATION
77    CALL INOUT(1) 
      LCOL = IFCOL
C     SCAN TO FIRST NON-BLANK CHARACTER 
80    IF(LCOL-MCOL) 85,85,945 
85    IF(INB(LCOL)-IBLNK) 86,87,86
86    IF(INB(LCOL)-ICTAB) 90,87,90
87    LCOL = LCOL+1 
      GO TO 80
90    IF(INB(LCOL)-IDIV) 110,92,110 
92    CALL LOUT(1)
C     MOVE NEW LINE TO INPUT BUFFER 
      DO 93 I=1,80
      IN(I) = INB(I)
93    CONTINUE
      ICOL = LCOL+1 
      IXCOL = IFCOL 
C     SCAN TO FIRST NON-BLANK CHARACTER
      GO TO 60
110   JREAD = 1 
      FTYPE = 5 
      GO TO 990 
120   LCOL = ICOL 
C     CHECK FOR A DECIMAL NUMBER INDICATING FIELD LENGTH
      IF(IN(ICOL) .GT. ICHR9) GO TO 160
      IF(IN(ICOL) .LT. ICHR0) GO TO 160
C     CONVERT FIELD LENGTH TO BINARY
150   ILEN = 0
151   DO 152 I=1,10 
      IF(IN(ICOL)-NUMS(I)) 152,155,152
152   CONTINUE
C     CHECK FOR NO FIELD SPECIFICATION
      DO 153 I=1,4
      IF(IN(ICOL)-ITERM(I)) 153,910,153
153   CONTINUE
      GO TO 160 
155   ILEN = ILEN*10+I-1
      ICOL = ICOL+1 
      GO TO 151 
C     CHECK FIELD LENGTH TO SEE IF V OR X FIELD POSSIBLE
160   IF(ILEN) 300,180,180
C     CHECK FOR DON"T CARE FIELD
180   IF(IN(ICOL)-ICHRX) 200,185,200
185   ICOL = ICOL+1 
C     CHECK FOR A TERMINATOR
      DO 190 I=1,4
      IF(IN(ICOL)-ITERM(I)) 190,195,190
190   CONTINUE
      ICOL = LCOL 
      GO TO 300 
C     SET TYPE TO DONT CARE                                  -- X 
195   FTYPE = 0 
      GO TO 800 
C     CHECK FOR VARIABLE FIELD
200   IF(IN(ICOL)-ICHRV) 300,225,300
225   ICOL = ICOL+1 
C     CHECK FOR A TERMINATOR
      DO 230 I=1,19 
      IF(IN(ICOL)-JSYM(I)) 230,235,230
230   CONTINUE
      IF(IN(ICOL)-ICHRX) 231,235,231
231   ICOL = ICOL-1 
      GO TO 300 
C     SET TYPE TO INDICATE VARIABLE FIELD                    -- V
235   FTYPE = 2
C     CHECK FOR ATTRIBUTES
240   DO 250 I=1,5
      IF(IN(ICOL)-IATT(I)) 250,260,250
250   CONTINUE
C     CHECK FOR NUMERIC DEFAULT
      DO 251 I=6,9
      IF(IN(ICOL)-IATT(I)) 251,2515,251
251   CONTINUE
      GO TO 254
2515  ICOL = ICOL+1
      LATT(I) = 1
      IF(IN(ICOL).EQ.ISHRP) GO TO 252
      ICOL=ICOL-1
      GO TO 2536
252   ICOL = ICOL+1
      I = I-5
      J = JCVAL(I)
      DO 253 I=1,J
      IF(IN(ICOL)-IALPH(I)) 253,2535,253
253   CONTINUE
      GO TO 802
2535  ICOL = ICOL-2
2536  FTYPE = 3
      CALL ESCAN(IVAL)
      IF(IERR-1) 305,550,305
C     CHECK FOR DONT CARE DEFAULT
254   IF(IN(ICOL).NE.ICHRX) GO TO 258
      ICOL = ICOL+1
      DO 255 I= 1,4
      IF(IN(ICOL)-ITERM(I)) 255,256,255
255   CONTINUE
      ICOL=ICOL-1
      GO TO 2536
256   IVAL = -1.
      FTYPE = 3
      GO TO 550
C     IF NOT A TERMINATOR, THEN ASSUME IT IS A SYMBOL
258   DO 259 I=1,4
      IF(IN(ICOL)-ITERM(I)) 259,550,259
259   CONTINUE
      GO TO 2536
C     FOUND ATTRIBUTE, MARK IN ARRAY
260   IF(LATT(I) .NE. 0) GO TO 940
      LATT(I) = 1
C     CHECK FOR ILLEGAL ATTRIBUTE COMBINATION
      IF ((LATT(1)+LATT(2)) .GE. 2) GO TO 940
C     CHECK FOR $ ATTRIBUTE
      IF (LATT(5) .EQ. 0) GO TO 270
      LATT(3) = 1
      LATT(4) = 1
270   ICOL = ICOL+1
      GO TO 240
C     CHECK FOR A NUMBER, LABEL, OR EXPRESSION
300   IF(IN(ICOL)-ILPAR) 302,303,302
302   ICOL = LCOL
303   CALL ESCAN(IVAL)
305   GO TO (400,945,920,950,935,930,960,940,310),IERR
C     FOUND SUB FIELD NAME                                   -- SUB
310   FTYPE = 4
      GO TO 900
C     SET FIELD TYPE TO CONSTANT                             -- C
400   FTYPE = 1
C     CHECK TO SEE IF FIELD LENGTH HAS BEEN SPECIFIED
500   IF(ILEN) 510,520,520
510   ILEN = KLEN 
C     CHECK TO SEE IF ACTUAL FIELD LENGTH EQUALS SPECIFIED FIELD LENGTH 
520   IF(ILEN-KLEN) 930,550,930 
C     SEE IF FIELD LENGTH EXCEEDS MAXIMUM ALLOWABLE 
550   IF(ILEN-IFBIT) 800,800,925
C     CHECK TO SEE IF FIELD LENGTH EXCEEDS WORD LENGTH
800   IF(ILEN-KWORD) 801,801,925
801   IF(ILEN) 802,930,802
C     CHECK FOR CORRECT TERMINATION CHARACTER 
802   DO 810 I=1,4
      IF(IN(ICOL)-ITERM(I)) 810,900,810 
810   CONTINUE
      GO TO 945 
C 
C     VALID FIELD FOUND 
C 
900   IERR = 1
      GO TO 990 
C 
C     SCAN ERRORS 
C 
C     ILLEGAL FIELD TYPE
910   IERR = 2
      GO TO 990 
C     ILLEGAL CHARACTER 
915   IERR = 3
      GO TO 990 
C     UNDEFINED SYMBOL
920   IERR = 4
      GO TO 990 
C     FIELD LENGTH TOO LARGE
925   IERR = 5
      GO TO 990 
C     FIELD LENGTH CONFLICT 
930   IERR = 6
      GO TO 990 
C     NUMERIC CONSTANT TOO LARGE
935   IERR = 7
      GO TO 990 
C     FIELD OR CONSTANT ATTRIBUTE ERROR 
940   IERR = 8
      GO TO 990 
C     ARGUMENT ERROR IN FIELD 
945   IERR = 9
      GO TO 990 
C     EXPRESSION ERROR IN FIELD 
950   IERR = 10 
      GO TO 990 
C     VALUE IS NEGATIVE, ILLEGAL
960   IERR = 11 
990   RETURN
      END 
D 
950   IERR = 10 
      GO TO 990 
C     VALUE IS NEGATIVE, ILLEGAL
960   IERR = 11 
990   RETURN
      END 
