You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
189 lines
6.0 KiB
189 lines
6.0 KiB
2 years ago
|
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
||
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
||
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
||
|
|
C
|
||
|
|
C See packages/seacas/LICENSE for details
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE POSTFX (NUMENT, NAMENT, TYPENT, INXENT, VALENT, ITMENT,
|
||
|
|
& NERR)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** POSTFX *** (ALGEBRA) Convert the equation to postfix form
|
||
|
|
C -- Written by Amy Gilkey - revised 08/18/87
|
||
|
|
C --
|
||
|
|
C --POSTFX converts the equation to postfix form. Parenthesis
|
||
|
|
C --are eliminated. Nothing is done if NERR is non-zero.
|
||
|
|
C --
|
||
|
|
C --Conversion is done using an operator stack. Operators are
|
||
|
|
C --moved to the operator stack and returned to the equation in
|
||
|
|
C --postfix order. Non-operators are simply moved up in the equation.
|
||
|
|
C --Any operator which is moved to the stack has precedence over those
|
||
|
|
C --already in the stack. An operator of lower precedence will move
|
||
|
|
C --the preceding stack operator to the equation. A special case is
|
||
|
|
C --made for a function. It is pushed onto the operator stack, and
|
||
|
|
C --popped back into the equation at the end of the parameters.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NUMENT - IN/OUT - the number of entries (as in /ENT../)
|
||
|
|
C -- NAMENT - IN/OUT - the equation entries (as in /ENT../)
|
||
|
|
C -- TYPENT - IN/OUT - the type of each equation entry (as in /ENT../)
|
||
|
|
C -- INXENT - IN/OUT - based on TYPENT (as in /ENT../)
|
||
|
|
C -- VALENT - IN/OUT - based on TYPENT (as in /ENT../)
|
||
|
|
C -- ITMENT - IN/OUT - based on TYPENT (as in /ENT../)
|
||
|
|
C -- NERR - IN/OUT - the number of errors in the equation, may be set
|
||
|
|
|
||
|
|
include 'ag_namlen.blk'
|
||
|
|
include 'ag_numeqn.blk'
|
||
|
|
PARAMETER (ICURTM = 1, ILSTTM = 2, IONETM = 3)
|
||
|
|
|
||
|
|
CHARACTER*(*) NAMENT(*)
|
||
|
|
CHARACTER TYPENT(*)
|
||
|
|
INTEGER INXENT(*)
|
||
|
|
REAL VALENT(*)
|
||
|
|
INTEGER ITMENT(*)
|
||
|
|
|
||
|
|
CHARACTER*(maxnam) STKNAM(MAXENT)
|
||
|
|
CHARACTER STKTYP(MAXENT)
|
||
|
|
INTEGER STKINX(MAXENT)
|
||
|
|
REAL STKVAL(MAXENT)
|
||
|
|
INTEGER STKITM(MAXENT)
|
||
|
|
C --STK.. - the operand stack; holds the corresponding /ENT../ values
|
||
|
|
INTEGER STKEQU(MAXENT)
|
||
|
|
C --STKEQU - the IOPTBL index for this operand
|
||
|
|
|
||
|
|
INTEGER IEQUIV(0:10)
|
||
|
|
SAVE IEQUIV
|
||
|
|
C --IEQUIV - the IOPTBL index for the given operator
|
||
|
|
|
||
|
|
INTEGER IOPTBL(-1:5,-1:8)
|
||
|
|
SAVE IOPTBL
|
||
|
|
C --IOPTBL - chart of stack actions to be performed
|
||
|
|
C --IOPTBL(i,j) - i = top stack operator, j = current operator
|
||
|
|
C -- = 1 Pop operator from stack into the equation
|
||
|
|
C -- = 2 Push operator onto the stack
|
||
|
|
C -- = 3 Pop matching '(' off the stack
|
||
|
|
C -- = 4 Delete from equation
|
||
|
|
C -- = 0 Error
|
||
|
|
|
||
|
|
C # ~ + - * / ^ ( ) = ,
|
||
|
|
DATA IEQUIV / 0, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8 /
|
||
|
|
C --Index -1 is reserved for the function name
|
||
|
|
|
||
|
|
C F # ~ + * ^ ( ) = ,
|
||
|
|
DATA (IOPTBL(-1,J),J=-1,8) / 0, 1, 0, 1, 1, 1, 2, 1, 0, 1 /
|
||
|
|
DATA (IOPTBL(0,J), J=-1,8) / 2, 4, 2, 2, 2, 2, 2, 0, 0, 0 /
|
||
|
|
DATA (IOPTBL(1,J), J=-1,8) / 2, 1, 0, 1, 1, 1, 2, 1, 0, 1 /
|
||
|
|
DATA (IOPTBL(2,J), J=-1,8) / 2, 1, 2, 1, 2, 2, 2, 1, 0, 1 /
|
||
|
|
DATA (IOPTBL(3,J), J=-1,8) / 2, 1, 2, 1, 1, 2, 2, 1, 0, 1 /
|
||
|
|
DATA (IOPTBL(4,J), J=-1,8) / 2, 1, 2, 1, 1, 2, 2, 1, 0, 1 /
|
||
|
|
DATA (IOPTBL(5,J), J=-1,8) / 2, 0, 2, 2, 2, 2, 2, 3, 0, 4 /
|
||
|
|
|
||
|
|
IF (NERR .NE. 0) GOTO 120
|
||
|
|
|
||
|
|
C --Initialize the operator stack by putting '#' on it
|
||
|
|
|
||
|
|
STKNAM(1) = '#'
|
||
|
|
STKTYP(1) = 'O'
|
||
|
|
STKINX(1) = 0
|
||
|
|
STKVAL(1) = -999
|
||
|
|
STKITM(1) = ICURTM
|
||
|
|
STKEQU(1) = 0
|
||
|
|
IOPTOS = 1
|
||
|
|
C --IOPTOS - the top of the operator stack
|
||
|
|
|
||
|
|
C --Put '#' at end of the equation
|
||
|
|
|
||
|
|
NENT = NUMENT+1
|
||
|
|
NAMENT(NENT) = STKNAM(1)
|
||
|
|
TYPENT(NENT) = STKTYP(1)
|
||
|
|
INXENT(NENT) = STKINX(1)
|
||
|
|
VALENT(NENT) = STKVAL(1)
|
||
|
|
ITMENT(NENT) = STKITM(1)
|
||
|
|
|
||
|
|
IEQTOS = 2
|
||
|
|
C --IEQTOS - the top of new postfix equation stack
|
||
|
|
|
||
|
|
DO 110 NENT = 3, NUMENT+1
|
||
|
|
|
||
|
|
IF ((TYPENT(NENT) .NE. 'O')
|
||
|
|
& .AND. (TYPENT(NENT) .NE. 'F')) THEN
|
||
|
|
|
||
|
|
C --Move entry up in the equation
|
||
|
|
|
||
|
|
IEQTOS = IEQTOS + 1
|
||
|
|
IF (IEQTOS .NE. NENT) THEN
|
||
|
|
NAMENT(IEQTOS) = NAMENT(NENT)
|
||
|
|
TYPENT(IEQTOS) = TYPENT(NENT)
|
||
|
|
INXENT(IEQTOS) = INXENT(NENT)
|
||
|
|
VALENT(IEQTOS) = VALENT(NENT)
|
||
|
|
ITMENT(IEQTOS) = ITMENT(NENT)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
100 CONTINUE
|
||
|
|
IF (TYPENT(NENT) .EQ. 'O') THEN
|
||
|
|
IEQU = IEQUIV(INXENT(NENT))
|
||
|
|
ELSE
|
||
|
|
IEQU = -1
|
||
|
|
END IF
|
||
|
|
J = STKEQU(IOPTOS)
|
||
|
|
IACT = IOPTBL(J,IEQU)
|
||
|
|
|
||
|
|
IF (IACT .EQ. 1) THEN
|
||
|
|
|
||
|
|
C --Pop operator from stack onto the equation, and redo
|
||
|
|
|
||
|
|
IEQTOS = IEQTOS + 1
|
||
|
|
NAMENT(IEQTOS) = STKNAM(IOPTOS)
|
||
|
|
TYPENT(IEQTOS) = STKTYP(IOPTOS)
|
||
|
|
INXENT(IEQTOS) = STKINX(IOPTOS)
|
||
|
|
VALENT(IEQTOS) = STKVAL(IOPTOS)
|
||
|
|
ITMENT(IEQTOS) = STKITM(IOPTOS)
|
||
|
|
IOPTOS = IOPTOS - 1
|
||
|
|
|
||
|
|
GOTO 100
|
||
|
|
|
||
|
|
ELSE IF (IACT .EQ. 2) THEN
|
||
|
|
|
||
|
|
C --Push operator onto the stack
|
||
|
|
|
||
|
|
IOPTOS = IOPTOS + 1
|
||
|
|
STKNAM(IOPTOS) = NAMENT(NENT)
|
||
|
|
STKTYP(IOPTOS) = TYPENT(NENT)
|
||
|
|
STKINX(IOPTOS) = INXENT(NENT)
|
||
|
|
STKVAL(IOPTOS) = VALENT(NENT)
|
||
|
|
STKITM(IOPTOS) = ITMENT(NENT)
|
||
|
|
STKEQU(IOPTOS) = IEQU
|
||
|
|
|
||
|
|
ELSE IF (IACT .EQ. 3) THEN
|
||
|
|
|
||
|
|
C --Pop matching '(' off the stack
|
||
|
|
|
||
|
|
IOPTOS = IOPTOS - 1
|
||
|
|
|
||
|
|
ELSE IF (IACT .EQ. 4) THEN
|
||
|
|
|
||
|
|
C --Delete from equation
|
||
|
|
CONTINUE
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
C --Error
|
||
|
|
|
||
|
|
NERR = NERR + 1
|
||
|
|
CALL PRTERR ('PROGRAM', 'Postfix string problem')
|
||
|
|
GOTO 120
|
||
|
|
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
NUMENT = IEQTOS
|
||
|
|
|
||
|
|
120 CONTINUE
|
||
|
|
RETURN
|
||
|
|
END
|