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.
415 lines
13 KiB
415 lines
13 KiB
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 RDEQNS (A, C, NAMECO, BLKTYP, NAMES, QAREC, INFREC,
|
|
& TIMES, IPTIMS, SELELB, IDELB, VISELB, KIEVOK, MAXSTK, NLOG,
|
|
* MERR)
|
|
C=======================================================================
|
|
|
|
C --*** RDEQNS *** (ALGEBRA) Read and check the equations
|
|
C -- Written by Amy Gilkey - revised 05/23/88
|
|
C -- Modified for ExodusIIV2 format - 9/5/95
|
|
C --
|
|
C --RDEQNS processes the input equations as follows:
|
|
C -- o Reads the line and parses it into fields.
|
|
C -- o Checks the equation for syntax.
|
|
C -- o Stores the variable names from the equations.
|
|
C -- o Puts the equation in postfix form.
|
|
C -- o Adds the equation variables to a global list.
|
|
C --
|
|
C --If any errors are found, that equation is ignored.
|
|
C --After all the equations have been read in, all the variables are
|
|
C --gathered into the /VAR../ arrays. The assigned variables are
|
|
C --after the expression variables.
|
|
C --
|
|
C --Parameters:
|
|
C -- A - IN/OUT - the dynamic memory base array
|
|
C -- NAMECO - IN - the coordinate names
|
|
C -- BLKTYP - IN - the element block names
|
|
C -- NAMES - IN - the database variable names
|
|
C -- QAREC - IN - the QA records containing:
|
|
C -- (1) - the analysis code name
|
|
C -- (2) - the analysis code QA descriptor
|
|
C -- (3) - the analysis date
|
|
C -- (4) - the analysis time
|
|
C -- INFREC - IN - the information records
|
|
C -- TIMES - IN - the database time steps
|
|
C -- IPTIMS - OUT - the selected times steps
|
|
C -- SELELB - OUT - the selected element blocks?
|
|
C -- IDELB - IN - the element block IDs
|
|
C -- VISELB(i) - OUT - true iff element block i is to be written
|
|
C -- KIEVOK - IN/OUT - the dynamic memory index of ISEVOK;
|
|
C -- input variables on input, temporary and
|
|
C -- output added on output
|
|
C -- MAXSTK - OUT - the maximum stack size needed for any equation
|
|
C -- MERR - OUT - error flag
|
|
C --
|
|
C --Common Variables:
|
|
C -- Sets and uses NUMEQN, NUMENT of /ENT../
|
|
C -- Uses NAMENT of /ENT../
|
|
C -- Sets NUMINP, IXLHS, NAMVAR, TYPVAR, IDVAR, ISTVAR, IEVVAR of /VAR../
|
|
C -- Uses NSTEPS of /DBNUMS/
|
|
C -- Sets NPTIMS, TMIN, TMAX, DELT, NINTV, WHONLY of /TIMES/
|
|
C -- Sets ISZOOM of /ZOOM/
|
|
C -- Sets EQNLIN of /EQNLNS/
|
|
|
|
include 'exodusII.inc'
|
|
include 'ag_namlen.blk'
|
|
include 'ag_numeqn.blk'
|
|
include 'ag_ent.blk'
|
|
include 'ag_var.blk'
|
|
include 'ag_times.blk'
|
|
include 'ag_dbnums.blk'
|
|
include 'ag_zoom.blk'
|
|
include 'ag_filter.blk'
|
|
include 'ag_remove.blk'
|
|
include 'ag_eqnlns.blk'
|
|
|
|
PARAMETER (ICURTM = 1, ILSTTM = 2, IONETM = 3)
|
|
|
|
DIMENSION A(*)
|
|
CHARACTER*1 C(1)
|
|
CHARACTER*(namlen) NAMECO(*)
|
|
CHARACTER*(MXSTLN) BLKTYP(*)
|
|
CHARACTER*(namlen) NAMES(*)
|
|
CHARACTER*(MXSTLN) QAREC(4,*)
|
|
CHARACTER*(MXLNLN) INFREC(*)
|
|
REAL TIMES(*)
|
|
INTEGER IPTIMS(*)
|
|
LOGICAL SELELB(NELBLK)
|
|
INTEGER IDELB(*)
|
|
LOGICAL VISELB(NELBLK)
|
|
INTEGER KIEVOK
|
|
INTEGER MAXSTK
|
|
INTEGER MERR
|
|
|
|
INTEGER IENTYP(MAXENT+1)
|
|
CHARACTER*(maxnam) CENTRY(MAXENT)
|
|
INTEGER IENTRY(MAXENT)
|
|
REAL RENTRY(MAXENT)
|
|
|
|
CHARACTER*132 LINE
|
|
CHARACTER*256 INLINE(5)
|
|
CHARACTER*(MXSTLN) RETVRB
|
|
CHARACTER*5 STRA
|
|
LOGICAL PRTEQN
|
|
LOGICAL SAVLOG
|
|
LOGICAL ISEQN
|
|
|
|
C Open the log file - temporary file unless the user decides to save it
|
|
SAVLOG = .FALSE.
|
|
|
|
MERR = 0
|
|
|
|
C WHONLY = .FALSE.
|
|
|
|
C --Initialize the selected times (0 = select all times)
|
|
CALL INITIM (0, NSTEPS, TIMES, TMIN, TMAX,
|
|
& DELT, NINTV, NPTIMS, IPTIMS)
|
|
|
|
ISZOOM = .FALSE.
|
|
ISFILTER = .FALSE.
|
|
ISREMOVE = .FALSE.
|
|
IRMCNT = 0
|
|
do i=1, 1024
|
|
idsrem(i) = 0
|
|
end do
|
|
|
|
C Initializes all logicals in a list to a specified value
|
|
CALL INILOG (NELBLK, .TRUE., VISELB)
|
|
|
|
IDEFEV = 0
|
|
|
|
CALL INILOG (NELBLK, .TRUE., SELELB)
|
|
|
|
C --TIME is always an input variable
|
|
|
|
NAMVAR(1) = 'TIME'
|
|
TYPVAR(1) = 'T'
|
|
IDVAR(1) = -999
|
|
ISTVAR(ICURTM,1) = 1
|
|
ISTVAR(ILSTTM,1) = 0
|
|
ISTVAR(IONETM,1) = 0
|
|
IEVVAR(1) = -999
|
|
|
|
NUMINP = 1
|
|
IXLHS = MAXVAR + 1
|
|
|
|
NUMEQN = 0
|
|
MAXSTK = 0
|
|
NUMEV = NVAREL
|
|
MAXEV = NUMEV
|
|
|
|
WRITE (*, *)
|
|
WRITE (*, 10000) 'Enter the equations'
|
|
WRITE (*, *)
|
|
PRTEQN = .FALSE.
|
|
|
|
100 CONTINUE
|
|
IF (.TRUE.) THEN
|
|
|
|
C --Write out all lines input so far
|
|
|
|
IF (PRTEQN) THEN
|
|
WRITE (*, *)
|
|
CALL SHOW ('TMIN', ' ',
|
|
& NAMECO, BLKTYP, NAMES,
|
|
& TIMES, IPTIMS, IDELB, VISELB, SELELB)
|
|
CALL SHOW ('ZOOM', ' ',
|
|
& NAMECO, BLKTYP, NAMES,
|
|
& TIMES, IPTIMS, IDELB, VISELB, SELELB)
|
|
CALL SHOW ('BLOCKS', ' ',
|
|
& NAMECO, BLKTYP, NAMES,
|
|
& TIMES, IPTIMS, IDELB, VISELB, SELELB)
|
|
CALL SHOW ('SAVE', ' ',
|
|
& NAMECO, BLKTYP, NAMES,
|
|
& TIMES, IPTIMS, IDELB, VISELB, SELELB)
|
|
CALL SHOW ('DELETE', ' ',
|
|
& NAMECO, BLKTYP, NAMES,
|
|
& TIMES, IPTIMS, IDELB, VISELB, SELELB)
|
|
|
|
WRITE (*, *)
|
|
DO 110 I = 1, NUMEQN
|
|
WRITE (*, 10000) 'ALG> ', EQNLIN(I)(:LENSTR(EQNLIN(I)))
|
|
110 CONTINUE
|
|
|
|
PRTEQN = .FALSE.
|
|
END IF
|
|
|
|
C --Read in equations and commands
|
|
|
|
CALL GETINP (0, 0, 'ALG> ', LINE, IOSTAT)
|
|
|
|
C --Check for comment ''''
|
|
ICMT = INDEX(LINE, '''')
|
|
IF (ICMT .EQ. 1) THEN
|
|
C ... Only comment on line
|
|
GO TO 100
|
|
ELSE IF (ICMT .GT. 1) THEN
|
|
LINE(ICMT-1:) = ' '
|
|
END IF
|
|
|
|
EQNLIN(NUMEQN+1) = LINE
|
|
120 CONTINUE
|
|
I = INDEX (EQNLIN(NUMEQN+1), '>')
|
|
IF (I .GT. 0) THEN
|
|
CALL GETINP (0, 0, ' > ', LINE, IOSTAT)
|
|
EQNLIN(NUMEQN+1)(I:) = LINE
|
|
GOTO 120
|
|
END IF
|
|
IF (IOSTAT .LT. 0) THEN
|
|
CALL PRTERR ('CMDSPEC', 'End of command stream before END')
|
|
RETVRB = 'END'
|
|
GOTO 180
|
|
END IF
|
|
|
|
C --Parse the equation or command
|
|
|
|
ISEQN = (INDEX (EQNLIN(NUMEQN+1), '=') .GT. 0)
|
|
|
|
IF (ISEQN) THEN
|
|
c CALL APARSE(input_line, max_num_parsed_flds,
|
|
C num_parsed_flds, field_type, alphnum_flds, numeric_fld)
|
|
CALL APARSE (EQNLIN(NUMEQN+1), MAXENT,
|
|
& NENT, IENTYP, CENTRY, RENTRY)
|
|
ELSE
|
|
ICONT = 0
|
|
CALL FFISTR (EQNLIN(NUMEQN+1), MAXENT, ICONT,
|
|
& NENT, IENTYP, CENTRY, IENTRY, RENTRY)
|
|
IENTYP(MIN(NENT,MAXENT)+1) = -999
|
|
END IF
|
|
IF (NENT .EQ. 0) GOTO 100
|
|
|
|
IF (.NOT. ISEQN) THEN
|
|
C --Input was a command not an equation
|
|
C --Process command line
|
|
|
|
INLINE(1) = ' '
|
|
DO 130 I = 2, 5
|
|
INLINE(I) = CHAR(0)
|
|
130 CONTINUE
|
|
|
|
C --Process command
|
|
CALL COMAND (A, INLINE, IENTYP, CENTRY, IENTRY, RENTRY,
|
|
& NAMECO, BLKTYP, NAMES, TIMES, IPTIMS, IDELB,
|
|
& VISELB, SELELB, QAREC, INFREC, RETVRB, MERR)
|
|
|
|
C --Write command to log file
|
|
IF ((NLOG .GT. 0) .AND. (INLINE(1) .NE. ' ')) THEN
|
|
DO 140 I = 1, 5
|
|
IF (INLINE(I)(1:1) .EQ. CHAR(0)) GOTO 150
|
|
WRITE (NLOG, '(A)') INLINE(I)(:LENSTR(INLINE(I)))
|
|
140 CONTINUE
|
|
150 CONTINUE
|
|
END IF
|
|
|
|
C --Handle special commands
|
|
|
|
PRTEQN = .FALSE.
|
|
IF (RETVRB .EQ. 'PRINT') THEN
|
|
PRTEQN = .TRUE.
|
|
|
|
ELSE IF (RETVRB .EQ. 'END') THEN
|
|
GOTO 170
|
|
|
|
ELSE IF (RETVRB .EQ. 'QUIT') THEN
|
|
GOTO 170
|
|
|
|
ELSE IF (RETVRB .EQ. 'LOG') THEN
|
|
IF (NLOG .LE. 0) THEN
|
|
CALL PRTERR ('CMDERR', 'Log file cannot be opened')
|
|
ELSE
|
|
SAVLOG = .TRUE.
|
|
WRITE (*, 10000) 'Log file will be saved'
|
|
END IF
|
|
|
|
ELSE IF (RETVRB .EQ. 'BLOCKS') THEN
|
|
C --unable to move to main program
|
|
C --Expand the ISEVOK array for the new default selection
|
|
NUMEV = NUMEV + 1
|
|
IF (NUMEV .GT. MAXEV) THEN
|
|
MAXEV = MAXEV + 50
|
|
c CALL MDGET (NELBLK * MAXEV)
|
|
CALL MDLONG ('ISEVOK', KIEVOK, NELBLK * MAXEV)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
MERR = 1
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
|
|
C --Put default selection in ISEVOK array
|
|
IDEFEV = NUMEV
|
|
K = NELBLK * (IDEFEV-1)
|
|
CALL CPYLOG (NELBLK, SELELB, A(KIEVOK+K))
|
|
|
|
C --Make this command a dummy equation
|
|
IF (NUMEQN .GE. MAXEQN) THEN
|
|
CALL INTSTR (1, 0, MAXEQN, STRA, LSTRA)
|
|
CALL PRTERR ('CMDSPEC', 'Only ' // STRA(:LSTRA)
|
|
& // ' equations will be accepted')
|
|
GOTO 170
|
|
END IF
|
|
NUMEQN = NUMEQN + 1
|
|
NUMENT(NUMEQN) = 0
|
|
END IF
|
|
|
|
ELSE
|
|
|
|
C --Process equation
|
|
|
|
IF (NUMEQN .GE. MAXEQN) THEN
|
|
CALL INTSTR (1, 0, MAXEQN, STRA, LSTRA)
|
|
CALL PRTERR ('CMDSPEC', 'Only ' // STRA(:LSTRA)
|
|
& // ' equations will be accepted')
|
|
GOTO 170
|
|
END IF
|
|
C Equation is accepted - increment number of equations
|
|
NUMEQN = NUMEQN + 1
|
|
|
|
C Initialize number of equation errors
|
|
NEQERR = 0
|
|
|
|
C --Assign the fields to the equation entries and check syntax
|
|
C CALL CHKSYN(num_parsed_flds, fld_type, alphanum_fld, real,fld,
|
|
C GNEnames, max_ent_line, nument_eqn, eqn_entries,
|
|
C type_each_eqn_entry, inxent_typent, valent_typent,
|
|
C itment_typent, num_error_eqn)
|
|
CALL CHKSYN (NENT, IENTYP, CENTRY, RENTRY, NAMES, MAXENT,
|
|
& NUMENT(NUMEQN), NAMENT(1,NUMEQN), TYPENT(1,NUMEQN),
|
|
& INXENT(1,NUMEQN), VALENT(1,NUMEQN), ITMENT(1,NUMEQN),
|
|
& NEQERR)
|
|
|
|
C --Put the equation into postfix form
|
|
CALL POSTFX (
|
|
& NUMENT(NUMEQN), NAMENT(1,NUMEQN), TYPENT(1,NUMEQN),
|
|
& INXENT(1,NUMEQN), VALENT(1,NUMEQN), ITMENT(1,NUMEQN),
|
|
& NEQERR)
|
|
|
|
C --unable to move to main program
|
|
C --Expand the ISEVOK array for temporary and output variables
|
|
IF (NUMEV + 20 .GT. MAXEV) THEN
|
|
MAXEV = MAXEV + 50
|
|
c CALL MDGET (NELBLK * MAXEV)
|
|
CALL MDLONG ('ISEVOK', KIEVOK, NELBLK * MAXEV)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
MERR = 1
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
|
|
C --Determine if the variables are in the database and where
|
|
C --and enter the new variables into the /VAR../ arrays
|
|
CALL LOCEQV (NAMECO, NAMES,
|
|
& NUMENT(NUMEQN), NAMENT(1,NUMEQN), TYPENT(1,NUMEQN),
|
|
& INXENT(1,NUMEQN), VALENT(1,NUMEQN),
|
|
& ITMENT(1,NUMEQN), IEVENT(1,NUMEQN), VSZENT(1,NUMEQN),
|
|
& A(KIEVOK), IDEFEV, NUMEV, NSTK, NEQERR)
|
|
|
|
C --Check for syntax errors
|
|
IF (NEQERR .GT. 0) THEN
|
|
CALL PRTERR ('CMDSPEC', 'Equation ignored')
|
|
NUMEQN = NUMEQN - 1
|
|
GOTO 160
|
|
END IF
|
|
|
|
C --Handle special case of X = Y
|
|
IF (IDEFEV .LE. 0) THEN
|
|
IF ((NUMENT(NUMEQN) .EQ. 3) .AND.
|
|
& (NAMENT(1,NUMEQN) .EQ. NAMENT(3,NUMEQN))) THEN
|
|
NUMENT(NUMEQN) = 0
|
|
END IF
|
|
END IF
|
|
|
|
C --Adjust the maximum stack size
|
|
MAXSTK = MAX (MAXSTK, NSTK)
|
|
|
|
C --Write equation to log file
|
|
IF (NLOG .GT. 0) THEN
|
|
WRITE (NLOG,'(A)') EQNLIN(NUMEQN)(:LENSTR(EQNLIN(NUMEQN)))
|
|
END IF
|
|
END IF
|
|
|
|
160 CONTINUE
|
|
GOTO 100
|
|
END IF
|
|
|
|
170 CONTINUE
|
|
|
|
C --Scan lines after END
|
|
CALL SCNEOF
|
|
|
|
180 CONTINUE
|
|
|
|
IF (SAVLOG) THEN
|
|
IF (NLOG .GT. 0) THEN
|
|
CLOSE (NLOG, IOSTAT=IDUM)
|
|
END IF
|
|
ELSE
|
|
IF (NLOG .GT. 0) THEN
|
|
CLOSE (NLOG, STATUS='DELETE', IOSTAT=IDUM)
|
|
END IF
|
|
END IF
|
|
|
|
C --Adjust the ISEVOK array length
|
|
c CALL MDGET (NELBLK * MAXEV)
|
|
CALL MDLONG ('ISEVOK', KIEVOK, NELBLK * MAXEV)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
MERR = 1
|
|
RETURN
|
|
END IF
|
|
|
|
C Simulate error so that no output file is generated
|
|
IF (RETVRB .EQ. 'QUIT') MERR = 1
|
|
RETURN
|
|
|
|
10000 FORMAT (1X, 5A)
|
|
END
|
|
|