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.
543 lines
18 KiB
543 lines
18 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 LOCEQV (NAMECO, NAMES,
|
||
|
|
& NUMENT, NAMENT, TYPENT, INXENT, VALENT, ITMENT, IEVENT, VSZENT,
|
||
|
|
& ISEVOK, IDEFEV, NUMEV, MAXSTK, NERR)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** LOCEQV *** (ALGEBRA) Locate equation variables and add to list
|
||
|
|
C -- Written by Amy Gilkey - revised 05/25/88
|
||
|
|
C --
|
||
|
|
C --LOCEQV determines the type, location, and node/element specific (if any)
|
||
|
|
C --of an equation's variables. The variable names, types, and
|
||
|
|
C --database indices (for input variables) are added to the /VAR../
|
||
|
|
C --arrays.
|
||
|
|
C --
|
||
|
|
C --The variable name in the NAMVAR array is stripped of any specifier
|
||
|
|
C --to eliminate multiple references to a single variable.
|
||
|
|
C --The node/element specifier is stored in VALENT and associated with
|
||
|
|
C --the equation reference. Similarly, all global input variables are
|
||
|
|
C --assigned one dummy name, and the variable number is stored in VALENT.
|
||
|
|
C --
|
||
|
|
C --If there have been no errors up to this point, the equation is in
|
||
|
|
C --postfix form. Each entry in the equation is assigned a number
|
||
|
|
C --representing the number of items expected after the entry is put
|
||
|
|
C --on the stack. With a nodal or element variable (or an action
|
||
|
|
C --involving such a variable), this is simply the number of nodes or
|
||
|
|
C --elements. With a constant, TIME or global variable, this may be
|
||
|
|
C --one or the number of nodes or element if the value must be converted
|
||
|
|
C --to an array.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NAMECO - IN - the coordinate names
|
||
|
|
C -- NAMES - IN - the global, nodal, and element variable names
|
||
|
|
C -- NUMENT - IN - the number of entries (as in /ENT../)
|
||
|
|
C -- NAMENT - IN/OUT - the equation entries (as in /ENT../)
|
||
|
|
C -- TYPENT - IN - 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 -- IEVENT - IN/OUT - the ISEVOK index for this entry (as in /ENT../)
|
||
|
|
C -- VSZENT - OUT - the type of variable on the stack after processing
|
||
|
|
C -- this entry (as in /ENT../)
|
||
|
|
C -- ISEVOK - IN/OUT - the element variable truth table;
|
||
|
|
C -- includes input, temporary, and output variables
|
||
|
|
C -- IDEFEV - IN - the default ISEVOK variable index
|
||
|
|
C -- NUMEV - IN/OUT - the maximum ISEVOK variable index
|
||
|
|
C -- MAXSTK - OUT - the maximum stack size for this equation
|
||
|
|
C -- NERR - IN/OUT - the number of errors in the equation, may be set
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Sets NUMINP, IXLHS, NAMVAR, TYPVAR, IDVAR, ISTVAR, IEVVAR of /VAR../
|
||
|
|
C -- Uses NDIM, NUMNP, NUMEL, NVARNP, NVAREL, NVARGL of /DBNUMS/
|
||
|
|
C -- Uses FNCTYP of /FNCTB./
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
include 'ag_namlen.blk'
|
||
|
|
include 'ag_numeqn.blk'
|
||
|
|
include 'ag_var.blk'
|
||
|
|
include 'ag_dbnums.blk'
|
||
|
|
include 'ag_fnctbc.blk'
|
||
|
|
PARAMETER (ICURTM = 1, ILSTTM = 2, IONETM = 3)
|
||
|
|
|
||
|
|
CHARACTER*(*) NAMECO(*)
|
||
|
|
CHARACTER*(*) NAMES(*)
|
||
|
|
CHARACTER*(*) NAMENT(*)
|
||
|
|
CHARACTER TYPENT(*)
|
||
|
|
INTEGER INXENT(*)
|
||
|
|
REAL VALENT(*)
|
||
|
|
INTEGER ITMENT(*)
|
||
|
|
INTEGER IEVENT(*)
|
||
|
|
CHARACTER VSZENT(*)
|
||
|
|
LOGICAL ISEVOK(NELBLK,*)
|
||
|
|
|
||
|
|
CHARACTER*(maxnam) NAME
|
||
|
|
CHARACTER TYPEQV
|
||
|
|
CHARACTER VTYP
|
||
|
|
LOGICAL ALLSAM
|
||
|
|
CHARACTER*5 STRA, STRB
|
||
|
|
|
||
|
|
CHARACTER TYPSTK(MAXENT)
|
||
|
|
INTEGER INXSTK(MAXENT)
|
||
|
|
C --TYPSTK - type of variables for stack item
|
||
|
|
C --INXSTK - equation entry which pushed this stack item
|
||
|
|
|
||
|
|
C --Save the /VAR../ indices so they can be restored in case of error
|
||
|
|
NINP = NUMINP
|
||
|
|
ILHS = IXLHS
|
||
|
|
|
||
|
|
C --Set up to check postfix stack if no errors so far
|
||
|
|
ITOS = 0
|
||
|
|
INERR = NERR
|
||
|
|
IF (INERR .NE. 0) TYPSTK(1) = 'G'
|
||
|
|
|
||
|
|
MAXSTK = 0
|
||
|
|
|
||
|
|
VTYP = ' '
|
||
|
|
DO 100 NENT = 1, NUMENT
|
||
|
|
IEVENT(NENT) = -999
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
DO 180 NENT = 3, NUMENT
|
||
|
|
|
||
|
|
IF (TYPENT(NENT) .EQ. 'V') THEN
|
||
|
|
|
||
|
|
C --Get the name and the node/element specifier, if any
|
||
|
|
|
||
|
|
NAME = NAMENT(NENT)
|
||
|
|
NENUM = INT(VALENT(NENT))
|
||
|
|
|
||
|
|
C --Locate where the variable name is in the list of variables
|
||
|
|
|
||
|
|
CALL LOCNAM (NAME, NAMECO, NAMES,
|
||
|
|
& NENUM, TYPEQV, IDEQV, NERR)
|
||
|
|
|
||
|
|
C --Reference variable from entry
|
||
|
|
|
||
|
|
VALENT(NENT) = NENUM
|
||
|
|
IF (IDEQV .LT. 0) THEN
|
||
|
|
INXENT(NENT) = -1
|
||
|
|
ELSE
|
||
|
|
INXENT(NENT) = +1
|
||
|
|
END IF
|
||
|
|
C --Set INXENT -1 for reference to LHS variable, +1 for
|
||
|
|
C --input variable; used to link variables
|
||
|
|
IF (TYPEQV .EQ. 'E') THEN
|
||
|
|
NEWEV = NUMEV + 1
|
||
|
|
IEVOLD = IDEFEV
|
||
|
|
IF (IDEQV .GE. 0) THEN
|
||
|
|
IEVNEW = IDEQV
|
||
|
|
ELSE
|
||
|
|
IEVNEW = IEVVAR(IABS(IDEQV))
|
||
|
|
END IF
|
||
|
|
CALL MAKEVO (NELBLK, ISEVOK,
|
||
|
|
& IEVOLD, IEVNEW, NEWEV, IEVOLD)
|
||
|
|
NEWEV = IEVOLD
|
||
|
|
IF (NEWEV .GT. NUMEV) NUMEV = NEWEV
|
||
|
|
IEVENT(NENT) = NEWEV
|
||
|
|
ELSE
|
||
|
|
IEVENT(NENT) = -999
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Correct variable name to eliminate duplicate references in
|
||
|
|
C --the variable array
|
||
|
|
|
||
|
|
IF (((TYPEQV .EQ. 'H') .OR. (TYPEQV .EQ. 'G'))
|
||
|
|
& .AND. (IDEQV .GE. 0)) THEN
|
||
|
|
C --Input history and global variables are all in the same entry
|
||
|
|
IF (TYPEQV .EQ. 'H') THEN
|
||
|
|
NAME = '.GLOBAL'
|
||
|
|
ELSE
|
||
|
|
NAME = '.GLOBAL'
|
||
|
|
END IF
|
||
|
|
NAMENT(NENT) = NAME
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Insert name in list of input variables, if not LHS and not
|
||
|
|
C --already there; update time reference
|
||
|
|
|
||
|
|
IF (TYPEQV .EQ. 'C') ITMENT(NENT) = ICURTM
|
||
|
|
IF (IDEQV .GE. 0) THEN
|
||
|
|
IVAR = LOCSTR (NAME, NUMINP, NAMVAR)
|
||
|
|
IF (IVAR .LE. 0) THEN
|
||
|
|
NUMINP = NUMINP + 1
|
||
|
|
IVAR = NUMINP
|
||
|
|
IF (NUMINP .LT. IXLHS) THEN
|
||
|
|
NAMVAR(IVAR) = NAME
|
||
|
|
TYPVAR(IVAR) = TYPEQV
|
||
|
|
IDVAR(IVAR) = IDEQV
|
||
|
|
ISTVAR(ICURTM,IVAR) = 0
|
||
|
|
ISTVAR(ILSTTM,IVAR) = 0
|
||
|
|
ISTVAR(IONETM,IVAR) = 0
|
||
|
|
IF (TYPEQV .EQ. 'E') THEN
|
||
|
|
IEVVAR(IVAR) = IDEQV
|
||
|
|
ELSE
|
||
|
|
IEVVAR(IVAR) = -999
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
ITM = ITMENT(NENT)
|
||
|
|
ISTVAR(ITM,IVAR) = 1
|
||
|
|
ELSE
|
||
|
|
ITM = ITMENT(NENT)
|
||
|
|
IF (ITM .NE. ICURTM) THEN
|
||
|
|
NUMLHS = MAXVAR - IXLHS + 1
|
||
|
|
IVAR = LOCSTR (NAME, NUMLHS, NAMVAR(IXLHS))
|
||
|
|
IF (IVAR .GT. 0) THEN
|
||
|
|
IVAR = IXLHS + IVAR - 1
|
||
|
|
ISTVAR(ITM,IVAR) = 1
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Get the variable type to check arrays
|
||
|
|
|
||
|
|
IF ((TYPEQV .EQ. ' ') .OR. (TYPEQV .EQ. 'T') .OR.
|
||
|
|
* (TYPEQV .EQ. 'G')) THEN
|
||
|
|
VTYP = 'G'
|
||
|
|
ELSE IF (TYPEQV .EQ. 'H') THEN
|
||
|
|
VTYP = 'H'
|
||
|
|
ELSE
|
||
|
|
IF (NENUM .NE. 0) THEN
|
||
|
|
VTYP = 'G'
|
||
|
|
ELSE IF (TYPEQV .EQ. 'C') THEN
|
||
|
|
VTYP = 'N'
|
||
|
|
ELSE
|
||
|
|
VTYP = TYPEQV
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Get the equation variable type, and check for mixed array errors
|
||
|
|
|
||
|
|
IF (INERR .EQ. 0) THEN
|
||
|
|
|
||
|
|
C --Check by manipulating the postfix string
|
||
|
|
|
||
|
|
IF (TYPENT(NENT) .EQ. 'C') THEN
|
||
|
|
|
||
|
|
C --Constant - push global type
|
||
|
|
|
||
|
|
ITOS = ITOS + 1
|
||
|
|
IF (ITOS .GT. MAXENT) GOTO 190
|
||
|
|
MAXSTK = MAX (MAXSTK, ITOS)
|
||
|
|
|
||
|
|
TYPSTK(ITOS) = 'G'
|
||
|
|
INXSTK(ITOS) = NENT
|
||
|
|
VSZENT(NENT) = 'G'
|
||
|
|
|
||
|
|
ELSE IF (TYPENT(NENT) .EQ. 'V') THEN
|
||
|
|
|
||
|
|
C --Variable - push variable array type
|
||
|
|
|
||
|
|
ITOS = ITOS + 1
|
||
|
|
IF (ITOS .GT. MAXENT) GOTO 190
|
||
|
|
MAXSTK = MAX (MAXSTK, ITOS)
|
||
|
|
|
||
|
|
TYPSTK(ITOS) = VTYP
|
||
|
|
INXSTK(ITOS) = NENT
|
||
|
|
VSZENT(NENT) = VTYP
|
||
|
|
|
||
|
|
ELSE IF (TYPENT(NENT) .EQ. 'O') THEN
|
||
|
|
|
||
|
|
C --Operator - pop operands, push type of any operand array
|
||
|
|
|
||
|
|
IF (INXENT(NENT) .LE. 1) THEN
|
||
|
|
NOP = 1
|
||
|
|
ELSE
|
||
|
|
NOP = 2
|
||
|
|
END IF
|
||
|
|
IOP1 = ITOS - NOP + 1
|
||
|
|
ILAST = ITOS
|
||
|
|
ITOS = IOP1
|
||
|
|
IF (ITOS .LE. 0) GOTO 190
|
||
|
|
|
||
|
|
ALLSAM = .TRUE.
|
||
|
|
VTYP = TYPSTK(IOP1)
|
||
|
|
DO 110 I = IOP1+1, ILAST
|
||
|
|
IF (VTYP .NE. TYPSTK(I)) ALLSAM = .FALSE.
|
||
|
|
IF (TYPSTK(I) .NE. VTYP) THEN
|
||
|
|
IF (TYPSTK(I) .EQ. 'H') THEN
|
||
|
|
CONTINUE
|
||
|
|
ELSE IF (TYPSTK(I) .EQ. 'G') THEN
|
||
|
|
IF ((VTYP .EQ. 'T') .OR. (VTYP .EQ. 'H'))
|
||
|
|
& VTYP = TYPSTK(I)
|
||
|
|
ELSE IF ((TYPSTK(I) .EQ. 'N')
|
||
|
|
& .OR. (TYPSTK(I) .EQ. 'E')) THEN
|
||
|
|
IF ((VTYP .EQ. 'N') .OR. (VTYP .EQ. 'E')) THEN
|
||
|
|
IF (TYPSTK(I) .NE. VTYP) VTYP = '?'
|
||
|
|
ELSE
|
||
|
|
IF (VTYP .NE. '?') VTYP = TYPSTK(I)
|
||
|
|
END IF
|
||
|
|
ELSE IF (TYPSTK(I) .EQ. '?') THEN
|
||
|
|
VTYP = TYPSTK(I)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
IF (VTYP .EQ. 'E') THEN
|
||
|
|
NEWEV = NUMEV + 1
|
||
|
|
IEVOLD = IDEFEV
|
||
|
|
DO 120 I = IOP1, ILAST
|
||
|
|
IF (TYPSTK(I) .EQ. 'E') THEN
|
||
|
|
IEVNEW = IEVENT(INXSTK(I))
|
||
|
|
CALL MAKEVO (NELBLK, ISEVOK,
|
||
|
|
& IEVOLD, IEVNEW, NEWEV, IEVOLD)
|
||
|
|
END IF
|
||
|
|
120 CONTINUE
|
||
|
|
NEWEV = IEVOLD
|
||
|
|
IF (NEWEV .GT. NUMEV) NUMEV = NEWEV
|
||
|
|
IEVENT(NENT) = NEWEV
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (.NOT. ALLSAM) THEN
|
||
|
|
DO 130 I = IOP1, ILAST
|
||
|
|
IF (VTYP .NE. TYPSTK(I)) THEN
|
||
|
|
VSZENT(INXSTK(I)) = VTYP
|
||
|
|
END IF
|
||
|
|
130 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
TYPSTK(ITOS) = VTYP
|
||
|
|
INXSTK(ITOS) = NENT
|
||
|
|
VSZENT(NENT) = VTYP
|
||
|
|
|
||
|
|
ELSE IF (TYPENT(NENT) .EQ. 'F') THEN
|
||
|
|
|
||
|
|
C --Function - pop parameters and push type of function
|
||
|
|
|
||
|
|
NPARM = INT(VALENT(NENT))
|
||
|
|
IPARM = ITOS - NPARM + 1
|
||
|
|
ILAST = ITOS
|
||
|
|
ITOS = IPARM
|
||
|
|
IF (ITOS .LE. 0) GOTO 190
|
||
|
|
|
||
|
|
IF (FNCTYP(INXENT(NENT)) .EQ. ' ') THEN
|
||
|
|
|
||
|
|
C --Get function type from parameter types
|
||
|
|
|
||
|
|
ALLSAM = .TRUE.
|
||
|
|
VTYP = TYPSTK(IPARM)
|
||
|
|
DO 140 I = IPARM+1, ILAST
|
||
|
|
IF (VTYP .NE. TYPSTK(I)) ALLSAM = .FALSE.
|
||
|
|
IF (TYPSTK(I) .NE. VTYP) THEN
|
||
|
|
IF (TYPSTK(I) .EQ. 'H') THEN
|
||
|
|
CONTINUE
|
||
|
|
ELSE IF (TYPSTK(I) .EQ. 'G') THEN
|
||
|
|
IF (VTYP .EQ. 'H') VTYP = TYPSTK(I)
|
||
|
|
ELSE IF ((TYPSTK(I) .EQ. 'N')
|
||
|
|
& .OR. (TYPSTK(I) .EQ. 'E')) THEN
|
||
|
|
IF ((VTYP .EQ. 'N')
|
||
|
|
& .OR. (VTYP .EQ. 'E')) THEN
|
||
|
|
IF (TYPSTK(I) .NE. VTYP) VTYP = '?'
|
||
|
|
ELSE
|
||
|
|
IF (VTYP .NE. '?') VTYP = TYPSTK(I)
|
||
|
|
END IF
|
||
|
|
ELSE IF (TYPSTK(I) .EQ. '?') THEN
|
||
|
|
VTYP = TYPSTK(I)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
140 CONTINUE
|
||
|
|
|
||
|
|
IF (.NOT. ALLSAM) THEN
|
||
|
|
DO 150 I = IPARM, ILAST
|
||
|
|
IF (VTYP .NE. TYPSTK(I)) THEN
|
||
|
|
VSZENT(INXSTK(I)) = VTYP
|
||
|
|
END IF
|
||
|
|
150 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
C --Function has a defined type, parameters may be mixed types
|
||
|
|
|
||
|
|
VTYP = FNCTYP(INXENT(NENT))
|
||
|
|
DO 160 I = IPARM, ILAST
|
||
|
|
IF (TYPSTK(I) .EQ. '?') VTYP = TYPSTK(I)
|
||
|
|
IF ((TYPSTK(I) .EQ. 'H')
|
||
|
|
& .OR. (TYPSTK(I) .EQ. 'G')) THEN
|
||
|
|
VSZENT(INXSTK(I)) = '*'
|
||
|
|
END IF
|
||
|
|
160 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
NEV = 0
|
||
|
|
NEWEV = NUMEV + 1
|
||
|
|
IEVOLD = IDEFEV
|
||
|
|
DO 170 I = IPARM, ILAST
|
||
|
|
IF (TYPSTK(I) .EQ. 'E') THEN
|
||
|
|
NEV = NEV + 1
|
||
|
|
IEVNEW = IEVENT(INXSTK(I))
|
||
|
|
CALL MAKEVO (NELBLK, ISEVOK,
|
||
|
|
& IEVOLD, IEVNEW, NEWEV, IEVOLD)
|
||
|
|
END IF
|
||
|
|
170 CONTINUE
|
||
|
|
IF (NEV .GT. 0) THEN
|
||
|
|
NEWEV = IEVOLD
|
||
|
|
IF (NEWEV .GT. NUMEV) NUMEV = NEWEV
|
||
|
|
IEVENT(NENT) = NEWEV
|
||
|
|
END IF
|
||
|
|
|
||
|
|
TYPSTK(ITOS) = VTYP
|
||
|
|
INXSTK(ITOS) = NENT
|
||
|
|
VSZENT(NENT) = VTYP
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
|
||
|
|
C --Do simple check that variable types match since postfix string
|
||
|
|
C --is incorrect
|
||
|
|
|
||
|
|
IF (TYPENT(NENT) .EQ. 'V') THEN
|
||
|
|
|
||
|
|
C --Check that there are no mixed array types
|
||
|
|
|
||
|
|
IF (TYPSTK(1) .NE. ' ') THEN
|
||
|
|
IF (TYPSTK(1) .NE. VTYP) THEN
|
||
|
|
IF (TYPSTK(1) .EQ. 'H') THEN
|
||
|
|
CONTINUE
|
||
|
|
ELSE IF (TYPSTK(1) .EQ. 'G') THEN
|
||
|
|
IF (VTYP .EQ. 'H') VTYP = TYPSTK(1)
|
||
|
|
ELSE IF ((TYPSTK(1) .EQ. 'N')
|
||
|
|
& .OR. (TYPSTK(1) .EQ. 'E')) THEN
|
||
|
|
IF ((VTYP .EQ. 'N') .OR. (VTYP .EQ. 'E')) THEN
|
||
|
|
IF (TYPSTK(1) .NE. VTYP) VTYP = '?'
|
||
|
|
ELSE
|
||
|
|
IF (VTYP .NE. '?') VTYP = '?'
|
||
|
|
END IF
|
||
|
|
ELSE IF (TYPSTK(1) .EQ. '?') THEN
|
||
|
|
VTYP = TYPSTK(1)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (TYPENT(NENT) .EQ. 'F') THEN
|
||
|
|
|
||
|
|
C --If defined-type function is present, do not check array types
|
||
|
|
|
||
|
|
IF (FNCTYP(INXENT(NENT)) .NE. ' ') THEN
|
||
|
|
IF (TYPSTK(1) .NE. '?') TYPSTK(1) = ' '
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
END IF
|
||
|
|
180 CONTINUE
|
||
|
|
|
||
|
|
IF (TYPENT(1) .EQ. 'V') THEN
|
||
|
|
|
||
|
|
NAME = NAMENT(1)
|
||
|
|
|
||
|
|
C --Specifier is not valid on the assigned variable
|
||
|
|
|
||
|
|
IF (VALENT(1) .GT. 0) THEN
|
||
|
|
NERR = NERR + 1
|
||
|
|
CALL PRTERR ('CMDSPEC', 'Node/element specifier not allowed'
|
||
|
|
& // ' on assigned variable')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (ITMENT(1) .NE. ICURTM) THEN
|
||
|
|
NERR = NERR + 1
|
||
|
|
CALL PRTERR ('CMDSPEC', 'Time specifier not allowed'
|
||
|
|
& // ' on assigned variable')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
INXENT(1) = -1
|
||
|
|
C --Set INXENT -1 for reference to LHS variable
|
||
|
|
VALENT(1) = 0
|
||
|
|
IF (TYPEQV .EQ. 'E') THEN
|
||
|
|
IEVENT(1) = NEWEV
|
||
|
|
ELSE
|
||
|
|
IEVENT(1) = -999
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
NAME = ' '
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Assign and check the type for the assigned variable
|
||
|
|
|
||
|
|
IF (TYPSTK(1) .EQ. '?') THEN
|
||
|
|
TYPEQV = 'G'
|
||
|
|
NERR = NERR + 1
|
||
|
|
CALL PRTERR ('CMDSPEC',
|
||
|
|
& 'Nodal and element variables are mixed')
|
||
|
|
ELSE
|
||
|
|
TYPEQV = TYPSTK(1)
|
||
|
|
END IF
|
||
|
|
VSZENT(1) = TYPEQV
|
||
|
|
|
||
|
|
IF (NAME .EQ. 'TIME') THEN
|
||
|
|
IF (TYPEQV .NE. 'G') THEN
|
||
|
|
NERR = NERR + 1
|
||
|
|
CALL PRTERR ('CMDSPEC', 'TIME must be a global variable')
|
||
|
|
END IF
|
||
|
|
TYPEQV = 'T'
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --If the assigned variable does not exist, add it to the list,
|
||
|
|
C --else check that its type has not changed
|
||
|
|
|
||
|
|
NUMLHS = MAXVAR - IXLHS + 1
|
||
|
|
IVAR = LOCSTR (NAME, NUMLHS, NAMVAR(IXLHS))
|
||
|
|
|
||
|
|
IF (IVAR .LE. 0) THEN
|
||
|
|
IXLHS = IXLHS - 1
|
||
|
|
IF (NUMINP .LT. IXLHS) THEN
|
||
|
|
NAMVAR(IXLHS) = NAME
|
||
|
|
TYPVAR(IXLHS) = TYPEQV
|
||
|
|
IDVAR(IXLHS) = -999
|
||
|
|
ISTVAR(ICURTM,IXLHS) = 1
|
||
|
|
ISTVAR(ILSTTM,IXLHS) = 0
|
||
|
|
ISTVAR(IONETM,IXLHS) = 0
|
||
|
|
IF (TYPEQV .EQ. 'E') THEN
|
||
|
|
IEVVAR(IXLHS) = NEWEV
|
||
|
|
ELSE
|
||
|
|
IEVVAR(IXLHS) = -999
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
ELSE
|
||
|
|
IVAR = IXLHS + IVAR - 1
|
||
|
|
IF (TYPEQV .NE. TYPVAR(IVAR)) THEN
|
||
|
|
IF (TYPEQV .NE. ' ') THEN
|
||
|
|
NERR = NERR + 1
|
||
|
|
CALL PRTERR ('CMDSPEC', NAME(:LENSTR(NAME))
|
||
|
|
& // ' was previously assigned as a different type')
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Change DELETEd or SAVEd variable to assigned variable
|
||
|
|
IF ((NERR .EQ. 0) .AND. (ISTVAR(ICURTM,IVAR) .NE. 1))
|
||
|
|
& ISTVAR(ICURTM,IVAR) = 1
|
||
|
|
END IF
|
||
|
|
|
||
|
|
GOTO 200
|
||
|
|
|
||
|
|
190 CONTINUE
|
||
|
|
NERR = NERR + 1
|
||
|
|
CALL PRTERR ('PROGRAM', 'Program stack problem in LOCEQV')
|
||
|
|
|
||
|
|
200 CONTINUE
|
||
|
|
|
||
|
|
IF (NUMINP .GE. IXLHS) THEN
|
||
|
|
NERR = NERR + 1
|
||
|
|
N = NUMINP + (MAXVAR - IXLHS + 1)
|
||
|
|
CALL INTSTR (1, 0, N, STRA, LSTRA)
|
||
|
|
CALL INTSTR (1, 0, MAXVAR, STRB, LSTRB)
|
||
|
|
CALL PRTERR ('CMDSPEC',
|
||
|
|
& 'Too many variable names to store, '
|
||
|
|
& // STRA(:LSTRA) // ' > ' // STRB(:LSTRB))
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (NERR .GT. 0) THEN
|
||
|
|
NUMINP = NINP
|
||
|
|
IXLHS = ILHS
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|