C    Copyright(C) 2008-2017 National Technology & Engineering Solutions of
C    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    Redistribution and use in source and binary forms, with or without
C    modification, are permitted provided that the following conditions are
C    met:
C
C    * Redistributions of source code must retain the above copyright
C       notice, this list of conditions and the following disclaimer.
C
C    * Redistributions in binary form must reproduce the above
C      copyright notice, this list of conditions and the following
C      disclaimer in the documentation and/or other materials provided
C      with the distribution.
C
C    * Neither the name of NTESS nor the names of its
C      contributors may be used to endorse or promote products derived
C      from this software without specific prior written permission.
C
C    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C    A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C    OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C    OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
C
C=======================================================================
      SUBROUTINE COMAND (A, INLINE, INTYP, CFIELD, IFIELD, RFIELD,
     &   NAMECO, BLKTYP, NAMES, TIMES, IPTIMS,
     &   IDELB, VISELB, SELELB,
     &   QAREC, INFREC, RETVRB, MERR)
C=======================================================================
C   --*** COMAND *** (ALGEBRA) Process command
C   --   Written by Amy Gilkey - revised 05/18/88
C   --
C   --COMAND processes an ALGEBRA command.  The commands are:
C   --
C   --   TITLE                     Change database title
C   --
C   --   SAVE     {N,E,G,A,var,...} Save input database variable
C   --   DELETE   {var,var,...}    Delete assigned variable
C   --   ALIAS    {name,var,n}     Assign alias to vector/tensor variables
C   --
C   --   TMIN     {TMIN}           Set minimum selected time
C   --   TMAX     {TMAX}           Set maximum selected time
C   --   DELTIME  {DELT}           Set selected time interval
C   --   NINTV    {NINTV}          Change selected time interval
C   --   ZINTV    {NINTV}          Change selected time interval(zero interval)
C   --   ALLTIMES                  Select all times
C   --   TIMES    {t1,t2...}       Select specified times
C   --   STEPS    {n1,n2...}       Select specified steps
C   --
C   --   ZOOM     {x1,x2,y1,y2,z1,z2} Set zoomed mesh limits
C   --   VISIBLE  {id1,...}        Set element blocks to be written
C   --   BLOCKS   {id1,...}        Set selected element blocks
C   --   MATERIAL {id1,...}        Set selected element blocks
C   --
C   --   LIST     {option}         Display database information
C   --   SHOW     {option}         Display parameter setting
C   --   HELP     {option}         Help on ALGEBRA
C   --
C   --   END                       Exit to evaluate equations (also EXIT)
C   --   QUIT                      Exit but do not write database
C   --
C   --Parameters:
C   --   A         - IN - the dynamic memory base array
C   --   INLINE    - IN/OUT - the parsed input lines for the log file
C   --   INTYP     - IN - the input types from the free field reader
C   --   CFIELD    - IN - the character fields
C   --   IFIELD    - IN - the integer fields
C   --   RFIELD    - IN - the real fields
C   --   NAMECO    - IN - the coordinate names
C   --   BLKTYP    - IN - the element block names
C   --   NAMES     - IN - the global, nodal, and element variable names
C   --   TIMES     - IN - the database time steps
C   --   IPTIMS    - IN/OUT - the selected times steps
C   --   IDELB     - IN - the element block IDs
C   --   VISELB(i) - IN/OUT - true iff element block i is to be written
C   --   SELELB(i) - IN/OUT - true iff element block i is selected
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   --   RETVRB    - OUT - returned action verb (END, QUIT, PRINT, LOG)
C   --
C   --Common Variables:
C   --   Uses NDIM, NSTEPS of /DBNUMS/
C   --   Sets TITLEO of /DBTITL/
C   --   Sets NPTIMS, TMIN, TMAX, DELT, NINTV, WHONLY of /TIMES/
C   --   Sets ISZOOM, ZMLIM of /ZOOM/
C   --   Uses FNCNAM of /FNCTBL/

      include 'exodusII.inc'
      include 'ag_namlen.blk'
      include 'ag_dbnums.blk'
      include 'ag_dbtitl.blk'
      include 'ag_times.blk'
      include 'ag_zoom.blk'
      include 'ag_filter.blk'
      include 'ag_remove.blk'
      include 'ag_fnctbc.blk'

      common /debugc/ cdebug
      common /debugn/ idebug
      character*(mxstln) cdebug

      LOGICAL FFEXST, FFNUMB, MATSTR

      DIMENSION A(*)
      CHARACTER*(*) INLINE(*)
      INTEGER       INTYP(*)
      CHARACTER*(*) CFIELD(*)
      INTEGER       IFIELD(*)
      REAL          RFIELD(*)
      CHARACTER*(namlen) NAMECO(*)
      CHARACTER*(MXSTLN) BLKTYP(*)
      CHARACTER*(namlen) NAMES(*)
      REAL TIMES(*)
      INTEGER IPTIMS(*)
      INTEGER IDELB(*)
      LOGICAL VISELB(NELBLK)
      LOGICAL SELELB(NELBLK)
      CHARACTER*(MXSTLN) QAREC(4,*)
      CHARACTER*(MXLNLN) INFREC(*)
      CHARACTER*(*) RETVRB
      CHARACTER*1 OPTION

      CHARACTER*(maxnam) VERB, WORD
      CHARACTER*(mxstln) HLPTYP
      LOGICAL ISON
      LOGICAL HELP
      LOGICAL XLIM, YLIM, ZLIM
      INTEGER MERR

      CHARACTER*(mxstln) CMDTBL(26)
      SAVE CMDTBL
C      --CMDTBL - the commands table

      CHARACTER*(mxstln) HLPTBL(4)
      SAVE HLPTBL
C      --HLPTBL - the HELP type table

      MERR = 0

C   --Command table follows.  Remember to change the dimensioned size when
C   --changing the table.
      DATA CMDTBL /
     1  'TITLE                           ',
     2  'SAVE                            ',
     3  'DELETE                          ',
     4  'ALIAS                           ',
     5  'TMIN                            ',
     6  'TMAX                            ',
     7  'DELTIME                         ',
     8  'NINTV                           ',
     9  'ZINTV                           ',
     *  'ALLTIMES                        ',
     1  'TIMES                           ',
     2  'STEPS                           ',
     3  'ZOOM                            ',
     4  'FILTER                          ',
     5  'VISIBLE                         ',
     6  'BLOCKS                          ',
     7  'MATERIAL                        ',
     8  'LOG                             ',
     9  'LIST                            ',
     *  'SHOW                            ',
     1  'HELP                            ',
     2  'END                             ',
     3  'EXIT                            ',
     4  'QUIT                            ',
     4  'REMOVE                          ',
     *  '                                ' /

C   --HELP type table follows.  Remember to change the dimensioned size when
C   --changing the table.
      DATA HLPTBL /
     &  'RULES                           ',
     *  'COMMANDS                        ',
     *  'FUNCTION                        ',
     &  '                                ' /

      RETVRB = ' '

      IFLD = 1
      CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
      CALL ABRSTR (VERB, WORD, CMDTBL)
      IF (VERB .EQ. ' ') VERB = WORD

      IF (VERB .EQ. 'TITLE') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL GETINP (0, 0, 'TITLE> ', TITLEO, IOSTAT)
         INLINE(2) = TITLEO

      ELSE IF (VERB .EQ. 'ALIAS') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL ALICMD (INLINE, INTYP(IFLD), CFIELD(IFLD), IFIELD(IFLD),
     &      NAMES, *150)

      ELSE IF (VERB .EQ. 'SAVE') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL SAVCMD (INLINE, INTYP(IFLD), CFIELD(IFLD), NAMES, *150)

      ELSE IF (VERB .EQ. 'DELETE') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL DELCMD (INLINE, INTYP(IFLD), CFIELD(IFLD), *150)

      ELSE IF ((VERB .EQ. 'TMIN') .OR. (VERB .EQ. 'TMAX')
     &   .OR. (VERB .EQ. 'DELTIME')
     &   .OR. (VERB .EQ. 'NINTV') .OR. (VERB .EQ. 'ZINTV')
     &   .OR. (VERB .EQ. 'ALLTIMES')
     &   .OR. (VERB .EQ. 'TIMES') .OR. (VERB .EQ. 'STEPS')) THEN
         CALL CMDTIM (INLINE, VERB, IFLD, INTYP, CFIELD, IFIELD,
     &                RFIELD, NSTEPS, TIMES, TMIN, TMAX, DELT,
     &                NINTV, NPTIMS, IPTIMS)
      ELSE IF (VERB .EQ. 'FILTER') THEN
         CALL FFADDC (VERB, INLINE(1))
C ... Get name of element variable to use for filtering
         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         if (.not. matstr(word, 'ELEMENTS', 1)) THEN
           CALL PRTERR ('CMDERR',
     &       'Expected "ELEMENTS".  Syntax: FILTER ELEMENTS {elem_var}')
           VERB = ' '
           GOTO 150
         ENDIF
         CALL FFADDC (word, INLINE(1))
         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         CALL DBVIX('E', 1, IEV)
         IDXFLT = LOCSTR (WORD, NVAREL, NAMES(IEV))
         if (idxflt .eq. 0) then
           CALL PRTERR ('CMDERR',
     &       'Variable name specified does not exist on database.')
           VERB = ' '
           GOTO 150
         end if
         CALL FFADDC (NAMES(idxflt+iev-1), INLINE(1))

C ... Check for comparison -- uses fortran LT, LE, EQ, NE, GT, GE
         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         if (.not. matstr(word, 'LT', 2) .and.
     *       .not. matstr(word, 'LE', 2) .and.
     *       .not. matstr(word, 'EQ', 2) .and.
     *       .not. matstr(word, 'NE', 2) .and.
     *       .not. matstr(word, 'GT', 2) .and.
     *       .not. matstr(word, 'GE', 2)) then
           CALL PRTERR ('CMDERR',
     &       'Expected "LT", "LE", "EQ", "NE", "GT", or "GE".')
           VERB = ' '
           GOTO 150
         end if
         CALL FFADDC (word, INLINE(1))
         if (matstr(word, 'LT', 2)) cmpflt = 1
         if (matstr(word, 'LE', 2)) cmpflt = 2
         if (matstr(word, 'EQ', 2)) cmpflt = 3
         if (matstr(word, 'NE', 2)) cmpflt = 4
         if (matstr(word, 'GT', 2)) cmpflt = 5
         if (matstr(word, 'GE', 2)) cmpflt = 6

         CALL FFREAL (IFLD, INTYP, RFIELD,
     &     'filter value', 0.0, VALFLT, *150)
         CALL FFADDR (VALFLT, INLINE(1))

         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         if (.not. matstr(word, 'TIME', 1)) THEN
           CALL PRTERR ('CMDERR',
     &       'Expected "TIME". Syntax:')
           CALL PRTERR ('CMDSPEC',
     *       'FILTER ELEMENTS {elem_var} {CMP} {value} TIME {time}')
           VERB = ' '
           GOTO 150
         ENDIF
         CALL FFADDC (word, INLINE(1))

         CALL FFREAL (IFLD, INTYP, RFIELD,
     &     'database time', 0.0, TIMFLT, *150)
C ... Check that specified time is in range of times on database. Assume TIMES() is sorted.
         if (timflt .lt. times(1)) then
           call prterr('WARNING',
     *       'Specified time is less than minimum database time.')
           call prterr('CMDSPEC',
     *       'Setting filter time to minimum database time.')
           timflt = times(1)
         else if (timflt .gt. times(nsteps)) then
           call prterr('WARNING',
     *       'Specified time is greater than maximum database time.')
           call prterr('CMDSPEC',
     *       'Setting filter time to maximum database time.')
           timflt = times(nsteps)
         end if
         CALL FFADDR (TIMFLT, INLINE(1))
         ISFILTER = .TRUE.

      ELSE IF (VERB .EQ. 'REMOVE') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         if (.not. matstr(word, 'ELEMENTS', 1)) THEN
           CALL PRTERR ('CMDERR',
     &       'Expected "ELEMENTS".  Syntax: FILTER ELEMENTS {elem_var}')
           VERB = ' '
           GOTO 150
         ENDIF
         CALL FFADDC (word, INLINE(1))
C ... See if LOCAL or GLOBAL or nothing specified for id space...
         IF (INTYP(IFLD) .EQ. 0) THEN
           call ffchar(IFLD, INTYP, CFIELD, ' ', WORD)
           if (matstr(word, 'GLOBAL', 1)) then
             idsglobal = .true.
           else if (matstr(word, 'LOCAL', 1)) then
             idsglobal = .false.
           end if
         else
C ... Default is local ids or last set value.
           if (irmcnt .eq. 0) then
             idsglobal = .false.
           end if
         END IF
C ... Gather ids of elements to delete...
 99      continue
         IF (FFEXST (IFLD, INTYP)) THEN
           CALL FFINTG (IFLD, INTYP, IFIELD,
     &         'element ID', 0, ID, *129)
           IRMCNT = IRMCNT + 1
           if (IRMCNT .gt. 1024) then
             CALL PRTERR ('CMDERR',
     &         'Can only specify a maximum of 1024 elements to delete')
             goto 129
           end if
           idsrem(irmcnt) = id
           goto 99
         END IF
 129     continue
         ISREMOVE = .TRUE.

      ELSE IF (VERB .EQ. 'ZOOM') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL FFNEED (IFLD, INTYP, 'R', MIN(3,NDIM)*2,
     &      'zoom mesh limits for all dimensions', *150)
         DO 100 I = 1, MIN(3,NDIM)*2
            CALL FFREAL (IFLD, INTYP, RFIELD,
     &         'zoom mesh limit', 0.0, ZMLIM(I), *150)
            CALL FFADDR (ZMLIM(I), INLINE(1))
  100    CONTINUE
         CALL FFCHAR (IFLD, INTYP, CFIELD, 'INSIDE', WORD)
         IF (MATSTR (WORD, 'INSIDE', 1)) THEN
           CALL FFADDC ('INSIDE', INLINE(1))
           ZOOMIN = .TRUE.
         ELSE IF (MATSTR (WORD, 'OUTSIDE', 1)) THEN
           CALL FFADDC ('OUTSIDE', INLINE(1))
           ZOOMIN = .FALSE.
         END IF
C        Set logical variables which determine if zoom mesh limits
C        are of the correct format (minlimit < maxlimit)
         XLIM = (ZMLIM(1) .LE. ZMLIM(2))
         YLIM = (ZMLIM(3) .LE. ZMLIM(4))
         IF (NDIM .EQ. 3) THEN
            ZLIM = (ZMLIM(5) .LE. ZMLIM(6))
         ELSE
            ZLIM = .TRUE.
         ENDIF
         IF ((.NOT. XLIM) .OR. (.NOT. YLIM) .OR.
     &       (.NOT. ZLIM)) THEN
C           Zoom limits are incorrect
            CALL PRTERR ('CMDERR',
     &      'Zoom limits are incorrect. (minlimit > maxlimit)')
            INLINE(1) = ' '
         ELSE
            ISZOOM = .TRUE.
         END IF
      ELSE IF (VERB .EQ. 'VISIBLE') THEN
         CALL FFADDC (VERB, INLINE(1))

         IF (.NOT. FFEXST (IFLD, INTYP)) THEN

C         --Select all element blocks if no parameters

            CALL INILOG (NELBLK, .TRUE., VISELB)
            OPTION = '+'

         ELSE IF (.NOT. FFNUMB (IFLD, INTYP)) THEN

C         --Strip off ADD or DELETE option
            CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
            IF (MATSTR (WORD, 'ADD', 1)) THEN
               CALL FFADDC ('ADD', INLINE(1))
               OPTION = '+'
            ELSE IF (MATSTR (WORD, 'DELETE', 1)) THEN
               CALL FFADDC ('DELETE', INLINE(1))
               OPTION = '-'
            ELSE
               CALL PRTERR ('CMDERR',
     &            'Expected "ADD" or "DELETE" or element block ID')
               GOTO 160
            END IF

         ELSE

C         --De-select all element blocks so only listed blocks are selected
            CALL INILOG (NELBLK, .FALSE., VISELB)
            OPTION = '+'
         END IF

  110    CONTINUE
         IF (FFEXST (IFLD, INTYP)) THEN
            CALL FFINTG (IFLD, INTYP, IFIELD,
     &         'element block ID', 0, ID, *120)
            IELB = LOCINT (ID, NELBLK, IDELB)
            IF (IELB .GT. 0) THEN
               CALL FFADDI (ID, INLINE(1))
               VISELB(IELB) = (OPTION .EQ. '+')
            ELSE
               CALL INTSTR (1, 0, ID, WORD, LSTR)
               CALL PRTERR ('CMDERR', 'Element block ID ' //
     &            WORD(:LSTR) // ' does not exist, ignored')
            END IF
  120       CONTINUE
            GOTO 110
         END IF

      ELSE IF ((VERB .EQ. 'BLOCKS') .OR. (VERB .EQ. 'MATERIAL')) THEN
         CALL FFADDC (VERB, INLINE(1))
         IF (VERB .EQ. 'MATERIAL') VERB = 'BLOCKS'

         IF (.NOT. FFEXST (IFLD, INTYP)) THEN

C         --Select all element blocks if no parameters
            CALL INILOG (NELBLK, .TRUE., SELELB)
            OPTION = '+'

         ELSE IF (.NOT. FFNUMB (IFLD, INTYP)) THEN

C         --Strip off ADD or DELETE option
            CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
            IF (MATSTR (WORD, 'ADD', 1)) THEN
               CALL FFADDC ('ADD', INLINE(1))
               OPTION = '+'
            ELSE IF (MATSTR (WORD, 'DELETE', 1)) THEN
               CALL FFADDC ('DELETE', INLINE(1))
               OPTION = '-'
            ELSE
               CALL PRTERR ('CMDERR',
     &            'Expected "ADD" or "DELETE" or element block ID')
               GOTO 160
            END IF

         ELSE

C         --De-select all element blocks so only listed blocks are selected
            CALL INILOG (NELBLK, .FALSE., SELELB)
            OPTION = '+'
         END IF

  130    CONTINUE
         IF (FFEXST (IFLD, INTYP)) THEN
            CALL FFINTG (IFLD, INTYP, IFIELD,
     &         'element block ID', 0, ID, *140)
            IELB = LOCINT (ID, NELBLK, IDELB)
            IF (IELB .GT. 0) THEN
               CALL FFADDI (ID, INLINE(1))
               SELELB(IELB) = (OPTION .EQ. '+')
            ELSE
               CALL INTSTR (1, 0, ID, WORD, LSTR)
               CALL PRTERR ('CMDERR', 'Element block ID ' //
     &            WORD(:LSTR) // ' does not exist, ignored')
            END IF
  140       CONTINUE
            GOTO 130
         END IF

         RETVRB = 'BLOCKS'

      ELSE IF ((VERB .EQ. 'LOG') .or. (verb .eq. 'SAVELOG')) THEN
         if (verb .eq. 'SAVELOG') then
            call prterr ('CMDSPEC', 'Please use the LOG command')
            verb = 'LOG'
         end if
         VERB = ' '
         RETVRB = 'LOG'

      ELSE IF (VERB .EQ. 'LIST') THEN
         VERB = ' '
         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         CALL DBLIST (WORD, A, NAMECO, BLKTYP, NAMES,
     &                TIMES, IDELB, QAREC, INFREC, MERR)
         IF (MERR .EQ. 1) RETURN

      ELSE IF (VERB .EQ. 'SHOW') THEN
         VERB = ' '
         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         CALL SHOW (WORD, CMDTBL, NAMECO, BLKTYP, NAMES,
     &        TIMES, IPTIMS, IDELB, VISELB, SELELB)

         IF (WORD .EQ. ' ') RETVRB = 'PRINT'

      ELSE IF (VERB .EQ. 'HELP') THEN
         VERB = ' '
         CALL ABRSTR (HLPTYP, WORD, HLPTBL)
         ISON = HELP ('ALGEBRA', HLPTYP, ' ')
         IF (.NOT. ISON) THEN
            IF (HLPTYP .EQ. 'RULES') THEN
               CONTINUE
            ELSE IF (HLPTYP .EQ. 'COMMANDS') THEN
               CALL SHOCMD ('COMMANDS', CMDTBL)
            ELSE IF (HLPTYP .EQ. 'FUNCTION') THEN
               CALL SHOCMD ('Available Functions:', FNCNAM)
            ELSE
               CALL SHOCMD ('HELP Options:', HLPTBL)
            END IF
         END IF

         RETVRB = 'PRINT'

      ELSE IF ((VERB .EQ. 'END') .OR. (VERB .EQ. 'EXIT')) THEN
         VERB = ' '
         CALL FFADDC ('END', INLINE(1))
         RETVRB = 'END'

      ELSE IF (VERB .EQ. 'QUIT') THEN
         VERB = ' '
         CALL FFADDC ('QUIT', INLINE(1))
         RETVRB = 'QUIT'

C   --This command allows selectable debugging
      else if (verb .eq. 'DEBUG') then
         verb = ' '
         call ffchar (ifld, intyp, cfield, ' ', cdebug)
         if (matstr (cdebug, 'EQUATION', 3)) then
            call prtdeb ('EQUATION', 0)
         else if (matstr (cdebug, 'VARIABLE', 3)) then
            call prtdeb ('VARIABLE', 0)
         else if (matstr (cdebug, 'ALL', 3)) then
            call prtdeb ('VARIABLE', 0)
            call prtdeb ('EQUATION', -1)
         end if

      ELSE
         CALL PRTERR ('CMDERR', '"' // VERB(:LENSTR(VERB))
     &      // '" is an invalid command')
         VERB = ' '
         GOTO 150
      END IF

      GOTO 160

  150 CONTINUE
      INLINE(1) = ' '

  160 CONTINUE
      IF (VERB .NE. ' ') THEN
         CALL SHOW (VERB, CMDTBL, NAMECO, BLKTYP, NAMES,
     &      TIMES, IPTIMS, IDELB, VISELB, SELELB)
      END IF

      RETURN
      END
