      INTEGER FUNCTION EXPR(LOGEX)
C
C     LOGEX IS A DUMMY ARG , NEVER USED
C     FALSE IF AN ARITHMETIC EXPRESSION WAS FOUND
C     PRE IS PRECEDENCE TABLE,  PRE(I,J) GIVES ACTION TAKEN WHEN OP I
C     IS ON THE STACK, OP J IN THE INPUT
C     CUROP IS CURRENT TOKEN TYPE
C     PREVOP IS PREVIOUS TOKEN TYPE (LAST ONE PROCESSED BEFORE CUROP)
C     STACK IS OPERAND STACK GROWING FROM TOP (1,2 ETC)
C     OPERATER STACK GROWING FROM BOTTOM UP(100,99 ETC)
C     PARENS COUNTS NESTING LEVEL OF PARENTHESES AND FUNCTION CALLS
C
C*****EXPRS
C     PT (INT) POINTER TO NEXT FREE WORD ON OPERAND STACK (GROWS
C     FROM STACK(1))
C     PB (INT) POINTER TO NEXT FREE WORD ON OPERATOR STACK (GROWS
C     FROM STACK(LSTACK))
C     AO(*,*) (INT) ARRAY GIVES TYPES OF ARITH OPERATIONS
C     AO(I,J) = TYPE OF (TYPE I <ARITH-OP> TYPE J)
C     RO(*,*) (INT) ARRAY TELLS LEGALITY OF RELATIONAL OPERATIONS
C     RO(I,J) = 1 IF TYPE I <RELOP> TYPEJ IS LEGAL; ELSE IS 0
C     EX(*,*) (INT) ARRAY GIVES TYPES OF ** OPERATION
C     EX(I,J) = TYPE OF (TYPE I <**> TYPE J)
C
      INTEGER PRE(12,12), EX(4,4), AO(4,4), CUROP, PREVOP, RO(3,3),
     *    STACK, PARENS, STMT, PSTMT, PT, PB, SYMLEN, PDSA, OUTUT,
     *    GETTOK, IBR(14), JBR(13), ADJ(5,4), OUTUT2, DSA, OUTUT3,
     *    OUTUT4, PREF, REF
      LOGICAL FLUSH, ERR, SYSERR, CALLST, DOVAR, OPT, ABORT, P1ERR
      LOGICAL INTEXT
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
      COMMON /EXPRS/ PT, PB, AO, RO, EX
      COMMON /CEXPRS/ LSTACK, STACK(620)
      COMMON /CREF/ LREF, PREF, REF(100)
      COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, OUTUT2, OUTUT3,
     *    OUTUT4
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
      COMMON /OPTNS/ OPT(5), P1ERR
      COMMON /FACTS/ NAME, NOST, ITYP, IASF
      DATA K /0/
      DATA PRE(1,1) /6/, PRE(1,2) /6/, PRE(1,3) /4/, PRE(1,5) /4/,
     *    PRE(1,6) /2/, PRE(1,7) /4/, PRE(1,8) /6/, PRE(1,9) /6/,
     *    PRE(1,10) /6/, PRE(1,4) /-1/, PRE(1,11) /6/, PRE(2,1) /-1/,
     *    PRE(2,2) /-1/, PRE(2,3) /-1/, PRE(2,5) /-1/, PRE(2,6) /-1/,
     *    PRE(2,7) /-1/, PRE(2,8) /-1/, PRE(2,9) /-1/, PRE(2,10) /-1/,
     *    PRE(2,4) /-1/, PRE(2,11) /-1/, PRE(3,1) /6/, PRE(3,2) /6/,
     *    PRE(3,3) /-1/, PRE(3,5) /4/, PRE(3,6) /2/, PRE(3,7) /6/,
     *    PRE(3,8) /6/, PRE(3,9) /6/, PRE(3,10) /6/, PRE(3,4) /-1/,
     *    PRE(3,11) /6/, PRE(5,1) /5/, PRE(5,2) /7/, PRE(5,3) /4/,
     *    PRE(5,5) /4/, PRE(5,6) /2/, PRE(5,7) /4/, PRE(5,8) /-1/,
     *    PRE(5,9) /4/, PRE(5,10) /4/, PRE(5,4) /4/, PRE(5,11) /4/,
     *    PRE(6,1) /5/, PRE(6,2) /1/, PRE(6,3) /4/, PRE(6,5) /4/,
     *    PRE(6,6) /2/, PRE(6,7) /4/, PRE(6,8) /3/, PRE(6,9) /4/,
     *    PRE(6,10) /4/, PRE(6,4) /4/, PRE(6,11) /4/
      DATA PRE(7,1) /6/, PRE(7,2) /6/, PRE(7,3) /4/, PRE(7,5) /4/,
     *    PRE(7,6) /2/, PRE(7,7) /6/, PRE(7,8) /6/, PRE(7,9) /6/,
     *    PRE(7,10) /6/, PRE(7,4) /-1/, PRE(7,11) /6/, PRE(8,1) /-1/,
     *    PRE(8,2) /-1/, PRE(8,3) /-1/, PRE(8,5) /-1/, PRE(8,6) /-1/,
     *    PRE(8,7) /-1/, PRE(8,8) /-1/, PRE(8,9) /-1/, PRE(8,10) /-1/,
     *    PRE(8,4) /-1/, PRE(8,11) /-1/, PRE(9,1) /5/, PRE(9,2) /6/,
     *    PRE(9,3) /4/, PRE(9,5) /4/, PRE(9,6) /2/, PRE(9,7) /4/,
     *    PRE(9,8) /6/, PRE(9,9) /6/, PRE(9,10) /6/, PRE(9,4) /4/,
     *    PRE(9,11) /4/, PRE(10,1) /5/, PRE(10,2) /6/, PRE(10,3) /4/,
     *    PRE(10,5) /4/, PRE(10,6) /2/, PRE(10,7) /4/, PRE(10,8) /6/,
     *    PRE(10,9) /4/, PRE(10,10) /6/, PRE(10,4) /4/, PRE(10,11) /4/,
     *    PRE(4,1) /5/, PRE(4,2) /6/, PRE(4,3) /4/, PRE(4,5) /4/,
     *    PRE(4,6) /2/, PRE(4,7) /4/, PRE(4,8) /6/, PRE(4,9) /6/,
     *    PRE(4,10) /6/, PRE(4,4) /-1/, PRE(4,11) /4/, PRE(11,1) /5/,
     *    PRE(11,2) /6/, PRE(11,3) /4/, PRE(11,5) /4/, PRE(11,6) /2/,
     *    PRE(11,7) /4/, PRE(11,8) /6/, PRE(11,9) /6/, PRE(11,10) /6/,
     *    PRE(11,4) /-1/, PRE(11,11) /6/
      DATA PRE(12,1), PRE(12,3), PRE(12,7), PRE(12,11) /4*6/, PRE(12,2)
     *    /6/, PRE(12,5) /4/, PRE(12,6) /2/, PRE(12,8) /6/, PRE(12,4),
     *    PRE(12,9), PRE(12,10) /3*6/, PRE(1,12), PRE(2,12), PRE(3,12),
     *    PRE(7,12), PRE(12,12) /5*-1/, PRE(5,12), PRE(6,12),
     *    PRE(8,12), PRE(9,12), PRE(10,12), PRE(4,12), PRE(11,12) /7*4/
      DATA IBR(1), IBR(3), IBR(7), IBR(12) /4*1/, IBR(2) /2/, IBR(4),
     *    IBR(11) /2*3/, IBR(9), IBR(10) /2*5/, IBR(8), IBR(5), IBR(6)
     *    /3*4/, IBR(13) /2/, IBR(14) /4/, JBR(1), JBR(12) /2*1/,
     *    JBR(2), JBR(3), JBR(7), JBR(9), JBR(10), JBR(11), JBR(8)
     *    /7*2/, JBR(4) /3/, JBR(5), JBR(6) /2*4/, JBR(13) /4/
      DATA ADJ(1,1), ADJ(1,2), ADJ(1,3) /3*-1/, ADJ(1,4) /0/, ADJ(2,1),
     *    ADJ(2,2) /2*0/, ADJ(2,3), ADJ(2,4) /2*-1/, ADJ(3,1) /1/,
     *    ADJ(3,4) /0/, ADJ(3,2), ADJ(3,3) /2*-1/, ADJ(5,1) /1/,
     *    ADJ(5,3), ADJ(5,4) /2*0/, ADJ(5,2) /-1/, ADJ(4,1), ADJ(4,3),
     *    ADJ(4,4) /3*0/, ADJ(4,2) /-1/
C
C     CODES IN OPERAND STACK
C     0....DOUBLE PRECISION       1....REAL   2....INTEGER
C     3....COMPLEX      4....LOGICAL   5....HOLLERITH
C     6....PROCEDURE NAME
C     CODES FOR OPERATORS
C     11 +,-    12 )   13 **  14 .NOT.  15 (  16  FCN(
C     17 /,*  18 ,  19 .AND.  20 .OR.  21 .EQ.  22 UNARY -,+
C
      PB = LSTACK
      PT = 1
      CALLST = .FALSE.
      PREVOP = -1
      CUROP = 0
      PARENS = 0
      FLUSH = .FALSE.
      EXPR = -1
   10 IF (PSTMT.LT.NSTMT .AND. .NOT.CALLST) GO TO 110
C
C     FINISH RECOGNITION OF EXPRESSION; POP OPERAND STACK AND RETURN
C     TYPE OF EXPRESSION
C
   20 IF (PARENS.EQ.0) GO TO 40
   30 CALL ERROR1(37H UNBALANCED PARENTHESES IN EXPRESSION, 37)
      IF (FLUSH) GO TO 530
      GO TO 80
   40 IF (PB.EQ.LSTACK .OR. CALLST) GO TO 60
   50 CALL POP
      IF (ERR) GO TO 530
      IF (PB.LT.LSTACK) GO TO 50
   60 IF (PT.NE.3) GO TO 90
      IF (STACK(1).EQ.0) GO TO 70
      I = IGATT1(STACK(1),8)
      IF (I.EQ.0) CALL SATT1(STACK(1), 8, 10)
   70 EXPR = STACK(2)
   80 PSTMT = K2
      ERR = .FALSE.
      RETURN
   90 CALL ERROR1(29H INVALID SYNTAX IN EXPRESSION, 29)
      IF (FLUSH) GO TO 530
      GO TO 80
  100 CALL ERROR1(31H EXPRESSION TOO LONG TO PROCESS, 31)
      GO TO 530
C
C     CONTINUING PROCESSING THE EXPRESSION, IDENTIFY NEXT TOKEN,
C
  110 CUROP = GETTOK(PSTMT,K2)
      IF (ERR) GO TO 80
C
C     SEE END OF EXPRESSION:  ")" <ID> OR <LABEL>; GETTOK RETURNS
C     SAME CODES AS THOSE ABOVE EXCEPT 6 IS ID, 16 IS FCN( OR ARRAY ELE
C
      IF (CUROP.NE.6 .AND. CUROP.NE.2 .AND. CUROP.NE.16 .OR.
     *    PREVOP.NE.12) GO TO 120
      K2 = PSTMT
      GO TO 20
C
C     CHECK FOR ADJACENT OPERATORS OR OPERANDS.
C
  120 IF (PREVOP.LE.6) GO TO 130
      I = IBR(PREVOP-10)
      GO TO 140
  130 I = IBR(13)
      IF(PREVOP.EQ.(-1)) I = IBR(14)
  140 IF (CUROP.LE.6) GO TO 150
      I2 = JBR(CUROP-10)
      GO TO 160
  150 I2 = JBR(13)
  160 IF (I.GE.3 .AND. I2.EQ.1) CUROP = 22
      IF (ADJ(I,I2)) 170, 190, 180
  170 CALL ERROR1(44H ADJACENT PLACEMENT OF OPERATORS OR OPERANDS, 44)
      GO TO 530
  180 CALL ERROR1(
     *    54H WARNING - ADJACENT PLACEMENT OF OPERATOR AND UNARY -+, 54)
  190 IF (CUROP.GT.6 .AND. CUROP.NE.16) GO TO 290
      IF (CUROP.LT.6) GO TO 280
C
C     PROCESS ID OR FCN( OR ARRAY ELEMENT OR ARRAY
C     LOOKUP SYMBOL TABLE ENTRY TO IDENTIFY ARRAYS AND TO IMPLICITLY
C     TYPE IDENTIFIERS IF NECESSARY.
C
      IF (CUROP.EQ.6) GO TO 200
      K = LOOKUP(K2-1,.FALSE.)
      GO TO 210
  200 K = LOOKUP(K2,.FALSE.)
  210 IF (SYSERR) GO TO 530
      I1 = IGATT1(K,1)
      I2 = IGATT1(K,7)
      I3 = IGATT1(K,8)
C
C     IMPLICITLY TYPE IDENTIFIERS AND FCNS
C
      IF (I1.GT.0) GO TO 220
      I1 = 1
      IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
      CALL SATT1(K, 1, I1)
C
C     SEPARATE ARRAY ELEMENT, FCN REFERENCE,ASF REF.
C
  220 I1 = MOD(I1,8)
      IF (CUROP.NE.16) GO TO 250
      IF (I2.EQ.0) GO TO 240
C
C     ARRAY ELEMENT--CHECK FOR BEING IN ASF DEF AND  PEEL  OFF
C     SUBSCRIPTS, CHECKING THEIR NUMBER
C
      IF (ITYP.NE.31) GO TO 230
      CALL ERROR1(39H ILLEGAL USE OF ARRAY IN ASF DEFINITION, 39)
  230 CUROP = I1
      I1 = CUROP + 16
      PSTMT = K2
      CALL SUBS(K2, I2)
      IF (ERR .OR. SYSERR) GO TO 80
      GO TO 270
C
C     PROCESS FCN( OR ASF( REFERENCE; CHECK USAGE TO SEE
C     IF IS A LEGAL FCN OR ASF NAME I.E. IF WAS USED
C     AS A FCN, SUBR, ASF, OR WAS IN AN EXTERNAL STMT.
C
  240 IF (I3.EQ.0 .OR. I3.EQ.2 .OR. I3.EQ.5 .OR. I3.EQ.6 .OR. I3.EQ.13
     *    .OR. I3.EQ.14) GO TO 290
C
C     ACTUAL USAGE WILL BE DETERMINED BY CODE WHICH
C     STORES CALL TEMPLATE
C
      CALL ERROR1(18H ILLEGAL USE OF ID, 18)
      GO TO 530
C
C     VARIABLE, ARRAY, PROCEDURE NAME
C
  250 IF (I2.EQ.0) GO TO 260
C
C     ARRAY
C
      CUROP = I1
      I1 = CUROP + 8
      IF (I3.EQ.0) CALL SATT1(K, 8, 10)
      GO TO 270
C
C     VARIABLE OR PROCEDURE
C     LEAVE IDS USAGE UNSET
C     THEY WILL BE SET LATER BY APPEARING AS OPERANDS OR BY BEING
C     DEFINED AS FCN  OR SUBROUTINE REFS BY FOLLOWING PGMS
C
  260 IF (I3.EQ.0) GO TO 270
      IF (I3.EQ.5 .OR. I3.EQ.6 .OR. I3.EQ.13) I1 = 6
      IF (I3.EQ.10 .OR. I1.EQ.6) GO TO 270
      IF (ITYP.EQ.31 .AND. I3.EQ.1 .AND. DSA(K+2).EQ.IASF) GO TO 270
      CALL ERROR1(36H ILLEGAL VARIABLE USED IN EXPRESSION, 36)
      GO TO 530
C
C     ENTER ARRAY,ID, PROCEDURE NAME, ARRAY ELEMENT INTO OPERAND STACK
C     UPDATE PREVOP,PSTMT.  ALSO ENTER SYMBOL TABLE INDEX FOR THESE
C     PREVOP = 0,1,...6 FOR OPERANDS
C     11,12,...22 FOR OPERATORS
C
  270 IF (PT+2.GE.PB) GO TO 100
      STACK(PT) = K
      STACK(PT+1) = I1
      PT = PT + 2
      PREVOP = CUROP
      PSTMT = K2
      GO TO 10
C
C     ARE PROCESSING A CONSTANT
C
  280 I1 = CUROP
      K = 0
      GO TO 270
C
C     ARE PROCESSING AN OPERATER
C     PRE(I,J) CONTAINS ACTION TAKEN GIVEN OPERATOR I ON STACK
C     AND OPERATOR J IN INPUT
C
  290 KNAME = K
      IF (CUROP.EQ.15 .OR. CUROP.EQ.16) PARENS = PARENS + 1
      IF (CUROP.EQ.12) PARENS = PARENS - 1
      IF (PARENS.GE.0) GO TO 300
      FLUSH = .TRUE.
      GO TO 30
C
C     CHECKS FOR LEADING UNARY +,- IN EXPRESSIONS
C
  300 IF (PB.EQ.LSTACK) GO TO 460
      I = STACK(PB+1) - 10
      I2 = CUROP - 10
      K = PRE(I,I2)
  310 IF (-1.NE.K) GO TO 320
      FLUSH = .TRUE.
      GO TO 90
  320 GO TO (330, 470, 520, 480, 480, 490, 510), K
C
C     CREATE TEMPLATE FROM FCN CALL
C
  330 IF (ITYP.EQ.18 .AND. PARENS.EQ.0) CALLST = .TRUE.
      L1 = STACK(PB+2)
      L2 = PT - 1
C
C     CHECK FOR NO ARGS
C
      IF (L2.GT.L1) GO TO 340
      CALL ERROR1(18H MISSING ARGUMENTS, 18)
      GO TO 450
C
C     CHECK FOR NOT CHANGING THROUGH SUBROUTINE CALL THE DO CONTROL
C     VARIABLE OF A CURRENT LOOP OR ANY ADJUSTIBLE DIMENSION DUMMY ARG
C
  340 DO 380 I=L1,L2,2
        IF (STACK(I)) 350, 380, 350
  350   IF (DOVAR(STACK(I))) STACK(I+1) = STACK(I+1) + 32
        I1 = IGATT1(STACK(I),4)
        IF (I1) 380, 380, 360
  360   I1 = IGATT1(STACK(I),6)
        IF (I1) 380, 380, 370
  370   STACK(I+1) = STACK(I+1) + 64
  380 CONTINUE
C
C     CHECK FOR USE OF ID AS FCN ONCE AND AS SUBROUTINE LATER
C     OR VICE VERSA
C
      I = STACK(PB+3)
      L = IGATT1(I,8)
      IF (L.EQ.2 .OR. L.EQ.5 .OR. L.EQ.6) GO TO 410
      IF (.NOT.INTEXT(I,L1,L2,.TRUE.)) GO TO 390
C
C     FOUND AN INTRINSIC FCN
C      CHECK NOT IN A CALL STMT USED AS A SUBROUTINE
C
      IF (CALLST) GO TO 420
      GO TO 450
C
C     DEFINE FCN( USAGE IF UNSET
C     SET USAGE OF ID USED AS A PROC
C
  390 IF (CALLST) GO TO 400
      CALL SATT1(I, 8, 5)
      GO TO 430
  400 CALL SATT1(I, 8, 6)
      GO TO 430
C
C     CHECK USAGE OF PROC ALREADY USED IN PROGRAM UNIT
C
  410 IF (CALLST .AND. L.EQ.6 .OR. .NOT.CALLST .AND. (L.EQ.5 .OR.
     *    L.EQ.2)) GO TO 430
  420 CALL ERROR1(18H ILLEGAL REFERENCE, 18)
      GO TO 450
  430 IF (.NOT.OPT(3) .OR. P1ERR) GO TO 450
C
C     LOAD INTO STACK COUNT OF WORDS IN  DESCRIPTOR, INDEX OF FCN
C     IN SYMBOL TABLE,  STMT NO  OF  REFERENCE
C
      IF (PT+3.GE.PB) GO TO 100
      STACK(PT) = PT - STACK(PB+2)
      STACK(PT+1) = STACK(PB+3)
      STACK(PT+2) = NOST
      STACK(PT+3) = 6 - IGATT1(STACK(PB+3),8)
      L3 = PT + 3
      ICOD = 2
      L = L2 - L1 + 5
      IF (L.LE.LREF) GO TO 440
      CALL ERROR1(44H IN EXPR, TABLE OVERFLOW OF REF, REF IGNORED, 44)
      GO TO 450
  440 WRITE (OUTUT3) L, ICOD, (STACK(I),I=PT,L3), (STACK(I),I=L1,L2)
C
C     FCN REF POPPED AND PROPER TYPE PUT ON OPERAND STACK
C
  450 PT = STACK(PB+2)
      I1 = IGATT1(STACK(PB+3),1)
      STACK(PT) = 0
      STACK(PT+1) = MOD(I1,8)
      PT = PT + 2
      PB = PB + 3
      GO TO 520
C
C     HANDLES FIRST OPERATOR IN EXPRESSION--WILL ALWAYS BE PUSHED ONTO
C     OPERATOR STACK.  FCN( HAS SPECIAL PUSH.
C
  460 IF (CUROP.NE.16) GO TO 480
C
C     FOUND "FCN(" CONSTRUCT  ; STORE 3 THINGS IN STACK
C     PTR TO FCN NAME IN SYMBOL TABLE; PTR TO 1ST ARGE IN STACK   ;
C     OPERAND CODE FOR FCN(
C
  470 IF (PB-3.LE.PT) GO TO 100
      STACK(PB) = KNAME
      STACK(PB-1) = PT
      STACK(PB-2) = CUROP
      PB = PB - 3
      GO TO 520
C
C     SIMPLE PUSH ONTO OPERATOR STACK
C
  480 IF (PB-1.EQ.PT) GO TO 100
      STACK(PB) = CUROP
      PB = PB - 1
      GO TO 520
C
C     POP OPERATOR FROM STACK.  IF STACK EMPTY, PUSH CUROP ONTO
C     STACK.  ELSE TAKE ACTION SPECIFIED BY PRE(TOP OPERATOR,CUROP).
C
  490 CALL POP
      IF (ERR) GO TO 530
      IF (PB.LT.LSTACK) GO TO 500
      GO TO 480
  500 I = STACK(PB+1) - 10
      K = PRE(I,CUROP-10)
      GO TO 310
C
C     POP "(" WHEN HAVE FINISHED A PARENTHESIZED EXPRESSION
C
  510 CALL POP
      IF (ERR) GO TO 530
C
C     UPDATE PREVOP,PSTMT AFTER FINISHING PROCESSING AN OPERATOR
C
  520 PREVOP = CUROP
      PSTMT = K2
      GO TO 10
C
C     JOB OF THIS CODE IS TO FLISH TO END OF UNRECOGNIZABLE
C     EXPRESSION
C
  530 K2 = PSTMT
      ERR = .FALSE.
  540 IF (K2.GE.NSTMT) GO TO 80
      IF (STMT(K2).EQ.65) PARENS = PARENS + 1
      IF (STMT(K2).NE.62) GO TO 550
      PARENS = PARENS - 1
      IF (PARENS.EQ.0) GO TO 560
  550 K2 = K2 + 1
      GO TO 540
  560 I = GETTOK(K2,I2)
      K2 = I2
      IF ((I.EQ.1 .OR. I.EQ.6) .OR. ERR) GO TO 80
      GO TO 540
      END
