      SUBROUTINE ESCAN(IVAL)
C 
C 
C     THIS SUBROUTINE SCANS AND EVALUEATES EXPRESSIONS.  THE
C     EXPRESSION SCAN IS ENDED BY A BLANK, COMMA, OR RIGHT
C     PARENTHESIS 
C 
C     ENTRY PARAMETERS
C        ICOL - POINTS TO START OF SCAN 
C        NBASE - BASE OF NUMBERS WITHOUT BASE SPECIFICATIONS
C     EXIT PARAMETERS 
C        IVAL - EXPRESSION VALUE
C        KLEN - EXPRESSION LENGTH 
C        ICOL - POINTS TO COLUMN SCAN ENDED ON
C        IERR - ERROR INDICATOR 
C           1 = NO ERROR, ENDS WITH RIGHT PARENTHESIS,BLANK OR COMMA
C           2 = ARGUMENT ERROR
C           3 = UNDEFINED SYMBOL
C           4 = EXPRESSION ERROR
C           5 = NUMERIC CONSTANT TOO LARGE
C           6 = FIELD LENGTH CONFLICT 
C           7 = EXPRESSION VALUE IS NEGATIVE
C           8 = ILLEGAL CONSTANT MODIFIER 
C           9 = SUB FIELD NAME FOUND
C   
      REAL IVAL,IVAL1,IVAL2,IVAL3,JVAL
      DIMENSION JSYM(14),ITERM(4)
      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 (JSYM(1),IBLNK),(ITERM(1),IBLNK)
C   
C     SET OPERATOR FLAG TO INDICATE NONE
      IOPER = 0
C     SET FLAG TO INDICATE NO EXPRESSION
      IFLG = 0
      IVAL = 0. 
      IVAL1 = 0.
      ESIGN = 1 
      IEXP = 3
      KLEN = 0
      MODE = 0
      IF(IN(ICOL)-ILPAR) 10,5,10
5     MODE = 1
      ICOL = ICOL+1 
10    NCHAR = IN(ICOL)
      IERR = 1
C 
C     CHECK FOR SCAN TERMINATION CHARACTER
C 
11    DO 12 I=1,4 
      IF(NCHAR-ITERM(I)) 12,600,12
12    CONTINUE
14    IF(MODE) 15,20,15 
15    IF(NCHAR-IRPAR) 20,600,20 
C 
C     CHECK FOR A PLUS SIGN 
C 
20    IF(NCHAR-IPLUS) 50,28,50
28    NSIGN = 1 
      GO TO 60
C 
C     CHECK FOR A MINUS SIGN
C 
50    IF(NCHAR-IMIN) 70,54,70 
54    NSIGN = -1
60    IF(IEXP-2) 64,930,64
64    IEXP = 2
      IFLG = 1
      IVAL = IVAL1*ESIGN+IVAL 
      ESIGN = NSIGN 
      IOPER = 0 
      IVAL1 = 0.
      GO TO 900 
C 
C     CHECK FOR MULTIPLY SIGN 
C 
70    IF(NCHAR-IAST) 80,72,80 
72    IOPER = 1 
      GO TO 84
C 
C     CHECK FOR / SIGN
C 
80    IF(NCHAR-IDIV) 100,82,100 
82    IOPER = 2 
84    IF(IEXP-2) 86,930,86
86    IEXP = 2
      IFLG = 1
      GO TO 900 
C 
C     PROCESS THE OPERAND 
C 
100   IF(IEXP-1) 106,930,106
106   IEXP = 1
      JVAL = 0. 
C     CHECK FOR LOCATION COUNTER REFERENCE
200   IF(NCHAR-IDOLR) 300,205,300 
205   GO TO 970 
C     CHECK FOR NUMERIC CONSTANT
300   CALL NUMB(1)
      GO TO (410,400,910,940,410),IERR
C     CHECK FOR LEGAL LABEL 
400   CALL LABEL(1) 
      GO TO (405,920,910),IERR
C     CHECK FOR SUB DIRECTIVE NAME
405   IF(JTYPE-4) 410,920,406 
406   IF(IOPVA-12) 4065,407,4065
4065  IF(IOPVA-13) 910,407,910
407   IF(IFLG) 930,975,930
410   JVAL = CVAL 
C 
C     CHECK FOR CONSTANT MODIFIERS
C 
C     INITIALIZE MODIFIER ARRAY 
420   DO 425 I=1,5
      JATT(I) = 0 
425   CONTINUE
428   DO 430 I=1,4
      IF(IN(ICOL)-IATT(I)) 430,435,430
430   CONTINUE
      GO TO 450 
C     IF JATT BIT ALREADY SET, CHARACTER MUST BE OPERATOR 
435   IF(JATT(I)) 450,440,450 
C     * AND - MAY BE OPERATORS, NOT MODIFIERS 
440   IF(I-2) 441,441,445 
441   ICOL1 = ICOL+1
      DO 442 J=1,14 
      IF(IN(ICOL1)-JSYM(J)) 442,445,442 
442   CONTINUE
C     * OR - IS NOT A CONSTANT MODIFIER 
      GO TO 450 
445   JATT(I) = 1 
      ICOL = ICOL+1 
      GO TO 428 
C     CHECK FOR ILLEGAL MODIFIER COMBINATIONS 
450   CONTINUE
451   CONTINUE
      IF(JATT(1)+JATT(2)-2) 452,970,452 
C     CHECK FOR $ MODIFIER
452   IF(JATT(5)) 453,455,453 
453   JATT(3) = 1 
      JATT(4) = 1 
C     PERFORM OPERATIONS SPECIFIED BY CONSTANT MODIFIERS
C     SET LENGTH FOR MODIFIERS
455   JLEN = LLEN 
      IF(LLEN) 459,456,459
456   JLEN = KLEN 
      IF(ILEN) 459,457,457
457   JLEN = ILEN 
459   DO 495 I=1,4
      IF(JATT(I)) 460,495,460 
460   GO TO (465,470,475,480),I 
C     INVERT CONSTANT 
465   JVAL = ZVAL-JVAL
      GO TO 482 
C     FORM TWO"S COMPLEMENT OF CONSTANT 
470   JVAL = ZVAL-JVAL+1. 
      GO TO 482 
C     RIGHT JUSTIFY VALUE IN FIELD
475   IF(KLEN-JLEN) 476,495,495 
476   KLEN = JLEN 
      GO TO 495 
C     TRUNCATE THE CONSTANT TO SPECIFIED FIELD LENGTH 
C     FORM 2.**JLEN 
480   IF(KLEN-JLEN) 482,482,481 
481   KLEN = JLEN 
482   IVAL2 = 1.
      DO 485 J=1,JLEN 
      IVAL2 = IVAL2+IVAL2 
485   CONTINUE
      K = JVAL/IVAL2
      IVAL3 = K 
      IVAL3 = IVAL3*IVAL2 
      JVAL = JVAL-IVAL3 
495   CONTINUE
      IF(MODE-2) 497,496,497
496   IVAL = JVAL 
      GO TO 850 
497   IF(IERR-1) 498,500,498
498   IF(KLEN-LLEN) 950,500,950 
C 
C     CHECK TO SEE IF ANY ARITHMETIC OPERATIONS SHOULD BE PERFORMED 
C 
500   IF(IOPER-1) 502,504,506 
502   IVAL1 = JVAL
      GO TO 905 
C     PERFORM MULTIPLICATION
504   IVAL1 = IVAL1*JVAL
      GO TO 905 
506   IF(JVAL) 508,510,508
C     PERFORM DIVISION
508   K = IVAL1/JVAL
      IVAL1 = K 
      GO TO 905 
510   IVAL1 = 0.
      GO TO 905 
C 
C     CHECK FOR ILLEGAL GRAMMAR 
C 
600   IF(IEXP-2) 730,930,910
730   IVAL = IVAL+ESIGN*IVAL1 
      IF(IVAL-ZVAL) 740,740,940 
C     CHECK FOR NUMBER OR LABEL ONLY
740   IF(IFLG) 800,825,800
C     SET EXPRESSION LENGTH 
800   DO 810 I=1,IFBIT
C     FORM 2.**(IFBIT-I)
      J = IFBIT-I 
      REAL = 1. 
      IF (J) 801,805,801
801   DO 802 K=1,J
      REAL = REAL+REAL
802   CONTINUE
805   K = IVAL/REAL 
      IF(K) 820,810,820 
810   CONTINUE
      J = -1
820   KLEN = J+1
825   IF(MODE) 830,850,830
830   IF(IN(ICOL)-IRPAR) 910,831,910
C     CHECK FOR CONSTANT MODIFIERS AFTER RIGHT PARENTHESIS
831   ICOL = ICOL+1 
      JVAL = IVAL 
      MODE = 2
      LLEN = 0
      IF(ILEN) 420,835,835
835   LLEN = ILEN 
      GO TO 420 
C     CHECK FOR ILLEGAL NEGATIVE VALUE
850   IF(IVAL) 960,990,990
C 
C     SCAN NEXT TOKEN 
900   ICOL = ICOL+1 
905   IF(ICOL-MCOL) 10,10,910 
C 
C     EXPRESSION ERRORS 
C 
C     ARGUMENT ERROR
910   IERR = 2
      GO TO 990 
C     UNDEFINED SYMBOL
920   IERR = 3
      GO TO 990 
C     EXPRESSION ERROR
930   IERR = 4
      GO TO 990 
C     NUMERIC CONSTANT TOO LARGE
940   IERR = 5
      GO TO 990 
C     IMPLICIT AND EXPLICIT FIELD LENGTH CONFLICT 
950   IERR = 6
      GO TO 990 
C     VALUE IS NEGATIVE, ILLEGAL
960   IERR = 7
      GO TO 990 
C     ILLEGAL MODIFIER
970   IERR = 8
      GO TO 990 
C     SUB FIELD NAME FOUND
975   IERR = 9
990   RETURN
      END 
990 
C     SUB FIELD NAME FOUND
975   IERR = 9
990   RETURN
      END 
