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
