C Copyright(C) 2009 Sandia Corporation. Under the terms of Contract
C DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
C 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     * Neither the name of Sandia Corporation 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=======================================================================
      SUBROUTINE SPCOMD (A, INLINE,
     &   INVERB, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &   NAMES, LENE, NLNKE, LINKE, XN, YN, ZN, XE, YE, ZE,
     &   ISEVOK, IE2ELB, NENUM, LIDSP, MAPEL, MAPND, NAMLEN)
C=======================================================================

C   --*** SPCOMD *** (SPLOT) Process SPLOT commands
C   --   Modified by John Glick - 11/1/88
C   --   Written by Amy Gilkey - revised 05/31/88
C   --
C   --SPCOMD interprets SPLOT commands.
C   --
C   --The commands are listed below with their parameters and their
C   --function.
C   --
C   --Plot curve selection
C   --   ADD                       Save plot curves, otherwise a new plot set
C   --                             is started if a curve is defined
C   --   REMOVE   {n}              Delete plot curve n
C   --   SYPLOT   {variable}       Specify plot variable
C   --   variable                  Specify time plot
C   --   NODES    {# range}        Select node numbers
C   --   ELEMENTS {# range}        Select element numbers
C   --
C   --Display Control
C   --   DISPVAR [ADD] {var1,...}  Selects history variables, global
C   --                             variables, and/or TIME whose values
C   --                             will be displayed on the plot legend.
C   --
C   --Display
C   --   reset                     Reset plot parameters
C   --   postmesh                  Initialize after mesh plot
C   --   postplot                  Initialize after plot
C   --   initprog                  Initialize for program change
C   --   initres                   Initialize for program change and reset
C   --   PLOT                      Exit to plot the plot set
C   --   HARDCOPY                  Exit to plot the plot set on hardcopy device
C   --   NEUTRAL                   Exit to write the plot set to neutral file
C   --
C   --Mesh Display
C   --   ECHO                      Plot mesh with selected nodes/elements
C   --
C   --Information
C   --   show     {option}         Display plot parameters and information
C   --   help     {option}         Display system dependent HELP
C   --
C   --This routine uses MDFIND to find the following dynamic memory arrays:
C   --   IPATH - optimization information for FNDPTH
C   --
C   --Parameters:
C   --   A - IN - the dynamic memory base array
C   --   INLINE - IN/OUT - the parsed input lines for the log file
C   --   INVERB - IN/OUT - the command verb
C   --   IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field
C   --      reader index and fields
C   --   NAMES - IN - the variable names
C   --   LENE - IN - the cumulative element counts by element block
C   --   NLNKE - IN - the number of nodes per element
C   --   LINKE - IN - the element connectivity
C   --   XN, YN, ZN - IN - the nodal mesh coordinates
C   --   XE, YE, ZE - IN - the element centroid mesh coordinates
C   --   ISEVOK - IN - the element block variable truth table;
C   --      variable i of block j exists iff ISEVOK(j,i)
C   --   IE2ELB - IN - the element block for each element
C   --   NENUM - IN/OUT - the selected node/element numbers
C   --   LIDSP(0:*)  - IN/OUT - the indices of the selected variables
C   --          whose values will be displayed on the plot legend.
C   --          LIDSP(0) = the number of variables in the list.
C   --          LIDSP(i) identifies the ith variable in the list.
C   --          If LIDSP(i) > 0, LIDSP(i) is the id of a history variable.
C   --          If LIDSP(i) < 0, -LIDSP(i) is the id of a global variable.
C   --          If LIDSP(i) = 0, TIME is to be displayed on the plot legend.
C   --
C   --Common Variables:
C   --   Uses NVARNP, NVAREL of /DBNUMS/
C   --   Uses NPTIMS of /TIMES/
C   --   Sets NTIMIN, HISTOK of /TIMES/
C   --   Sets NODVAR, NNENUM of /SELNE/
C   --   Sets NSPVAR of /SPVARS/
C   --   Sets OVERLY, OVERTM of /XYOPT/

      include 'params.blk'
      include 'dbnums.blk'
      include 'times.blk'
      include 'selne.blk'
      include 'spvars.blk'
      include 'xyopt.blk'

      DIMENSION A(*)
      CHARACTER*(*) INLINE(*)
      CHARACTER*(*) INVERB
      INTEGER     INTYP(*)
      CHARACTER*(*) CFIELD(*)
      INTEGER     IFIELD(*)
      REAL        RFIELD(*)
      CHARACTER*(*) NAMES(*)
      INTEGER LENE(0:NELBLK), LINKE(*)
      INTEGER NLNKE(NELBLK)
      REAL XN(*), YN(*), ZN(*)
      REAL XE(*), YE(*), ZE(*)
      LOGICAL ISEVOK(NELBLK,NVAREL)
      INTEGER IE2ELB(*)
      INTEGER NENUM(*)
      INTEGER LIDSP(0:*)
      INTEGER MAPEL(*)
      INTEGER MAPND(*)

      LOGICAL FFEXST, FFMATC

      CHARACTER*(MXNAME) VERB, WORD
      CHARACTER*5 STRA
      CHARACTER TYP
      LOGICAL HELP
      LOGICAL ADDCRV
      LOGICAL ISON, ISPATH

      LOGICAL FIRST
      SAVE FIRST, ADDCRV
C      --FIRST - true iff first time through routine

      CHARACTER*(MXSTLN) CMDTBL(15)
      SAVE CMDTBL
C      --CMDTBL - the valid commands table

      DATA FIRST /.TRUE./

C   --Command table follows.  Remember to change the dimensioned size when
C   --changing the table.
      DATA CMDTBL /
     1  'ADD                             ',
     *  'REMOVE                          ',
     *  'delete                          ',
     2  'SYPLOT                          ',
     *  'NODES                           ',
     *  'ELEMENTS                        ',
     *  'DISPVAR                         ',
     3  'PLOT                            ',
     *  'HARDCOPY                        ',
     *  'NEUTRAL                         ',
     *  'GRAFAID                         ',
     *  'XMGR                            ',
     *  'CSV                             ',
     *  'ECHO                            ',
     4  '                                ' /

C   --Get the command verb, which may be a variable name

      WORD = INVERB
      CALL ABRSTR (VERB, WORD, CMDTBL)
      IF (VERB .EQ. ' ') THEN
         CALL DBVIX_BL ('N', 1, INV)
         CALL DBVIX_BL ('E', 1, IEV)
         IF ((LOCSTR (WORD, NVARNP, NAMES(INV)) .GT. 0)
     &      .OR. (LOCSTR (WORD, NVAREL, NAMES(IEV)) .GT. 0)) THEN
            VERB = 'SYPLOT'
            IFLD = IFLD - 1
         ELSE
            VERB = WORD
         END IF
      END IF

C *** Initialization ***

      IF ((VERB .EQ. 'postmesh')
     &   .OR. (VERB .EQ. 'postplot') .OR. (VERB .EQ. 'initprog')
     &   .OR. (VERB .EQ. 'initres') .OR. (VERB .EQ. 'reset')) THEN
         INVERB = VERB

C      --Initialize parameters first time through, then reset

         IF (FIRST) THEN

C         --Change the command table to upper case

            L = LOCSTR (' ', 999, CMDTBL) - 1
            DO 100 I = 1, L
               CALL EXUPCS (CMDTBL(I))
  100       CONTINUE

            VERB = 'initres'
         END IF

C      --Initialize time step selection default

         IF ((VERB .EQ. 'initprog') .OR. (VERB .EQ. 'initres')) THEN

C         --Set default time step selection to 10 times with delta interval
            HISTOK = .FALSE.
            NTIMIN = 10
         END IF

C      --Initialize for program change

         IF (VERB .EQ. 'initprog') THEN
            CONTINUE
         END IF

C      --Reset parameters

         IF ((VERB .EQ. 'reset') .OR. (VERB .EQ. 'initres')) THEN

            IF (VERB .EQ. 'reset') THEN
C           --reset display variable list
               CALL DISPV (.TRUE., INLINE, IFLD, INTYP,
     &            CFIELD, NAMES, LIDSP, NAMLEN)
            ENDIF


            SELOK = .FALSE.
            NODVAR = .TRUE.
            NNENUM = 0
            NSPVAR = 0

            FIRST = .FALSE.
         END IF

C      --Initialize for new plot set

         IF (VERB .EQ. 'postplot') THEN
            CONTINUE
         END IF

C      --Initialize after mesh plot

         IF (VERB .EQ. 'postmesh') THEN
            SELOK = .FALSE.
         END IF

         ADDCRV = .FALSE.

         VERB = ' '

C *** Plot variable selection ***

      ELSE IF (VERB .EQ. 'ADD') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '

         VERB = 'PLOT'
         ADDCRV = .TRUE.

      ELSE IF (VERB .EQ. 'REMOVE') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '

         VERB = 'PLOT'

  110    CONTINUE
         IF (FFEXST (IFLD, INTYP)) THEN
            CALL FFINTG (IFLD, INTYP, IFIELD,
     &         'number of the curve to delete', 0, ICRV, *130)
            IF (ICRV .LT. 0) THEN
               NDEL = MIN (-ICRV, NSPVAR)
               CALL FFADDI (-NDEL, INLINE(1))
               NSPVAR = NSPVAR - NDEL
            ELSE
               IF ((ICRV .LT. 1) .OR. (ICRV .GT. NSPVAR)) THEN
                  CALL INTSTR (1, 0, ICRV, STRA, L)
                  CALL PRTERR ('CMDWARN', 'Curve number ' // STRA(:L) //
     &               ' is invalid, ignored')
                  GOTO 120
               END IF
               CALL FFADDI (ICRV, INLINE(1))
               ISVID(ICRV) = 0
            END IF
  120       CONTINUE
            GOTO 110
         END IF

  130    CONTINUE
         ICRV = 0
         DO 140 NP = 1, NSPVAR
            IF (ISVID(NP) .GT. 0) THEN
               ICRV = ICRV + 1
               IF (ICRV .NE. NP) THEN
                  ISVID(ICRV) = ISVID(NP)
               END IF
            END IF
  140    CONTINUE
         NSPVAR = ICRV

      else if (verb .eq. 'DELETE') then
         call prterr ('CMDREQ', 'Please use the REMOVE command')

         call ffaddc (verb, inline(1))
         inverb = ' '

         verb = 'PLOT'
         call ffintg (ifld, intyp, ifield,
     &      'number of curves to delete', 1, ndel, *180)
         ndel = max (0, min (ndel, nspvar))
         call ffaddi (ndel, inline(1))
         nspvar = nspvar - ndel

      ELSE IF (VERB .EQ. 'SYPLOT') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '

         IF (.NOT. ADDCRV) THEN
            NSPVAR = 0
            ADDCRV = .TRUE.
         END IF

         IF (NNENUM .EQ. 0) THEN
            CALL PRTERR ('CMDERR',
     &         'A NODES/ELEMENTS command must be issued')
            GOTO 180
         END IF

C      --Get variable name

         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         CALL FFADDC (WORD, INLINE(1))

         IVAR = LOCSTR (WORD, NVARHI+NVARGL+NVARNP+NVAREL, NAMES)
         IF (IVAR .LE. 0) THEN
            CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
     &         // '" is an invalid variable name')
            GOTO 180
         END IF

C      --Get variable type

         CALL DBVTYP_BL (IVAR, TYP, IDUM)

         IF (NODVAR) THEN
            IF (TYP .NE. 'N') THEN
               CALL PRTERR ('CMDERR',
     &            'Only nodal variables may be specified')
               GOTO 180
            END IF
         ELSE
            IF (TYP .NE. 'E') THEN
               CALL PRTERR ('CMDERR',
     &            'Only element variables may be specified')
               GOTO 180
            END IF
         END IF

C      --Add variable to the plot variable list

         IF (NSPVAR .GE. MXSVAR) THEN
            CALL PRTERR ('CMDERR', 'Too many plot variables')
            GOTO 180
         END IF
         NSPVAR = NSPVAR + 1
         ISVID(NSPVAR) = IVAR

C      --Set Y axis to automatic scaling, etc if not set
         INVERB = 'yaxis'

      ELSE IF ((VERB .EQ. 'NODES') .OR. (VERB .EQ. 'ELEMENTS')) THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '

         ISON = (VERB .EQ. 'NODES')
C      --Change the verb to lower-case for SHOW
         WORD = VERB
         CALL LOWSTR (VERB, WORD)

         ISPATH = FFMATC (IFLD, INTYP, CFIELD, 'PATH', 1)
         IF (ISPATH) CALL FFADDC ('PATH', INLINE(1))

C      --Make a list of the selected nodes

         IF (FFEXST (IFLD, INTYP)) THEN
            IF (ISON) THEN
               CALL RXINTA (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
     &            'node number', NUMNP, NNENUM, NENUM, MAPND, *180)
            ELSE
               CALL RXINTA (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
     &            'element number', NUMEL, NNENUM, NENUM, MAPEL, *180)
            END IF
         END IF

         IF (ISON .NEQV. NODVAR) NSPVAR = 0
         NODVAR = ISON

C      --Determine a path between the nodes/element, if requested

         IF (ISPATH) THEN
C         --Get memory for path efficiency information
            CALL MDFIND ('IPATH', KIPATH, L)
            IF (L .LE. 0) THEN
               CALL MDLONG ('IPATH', KIPATH, 2*NUMNP)
            END IF
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 200

            IF (NODVAR) THEN
               CALL FNDPTH (NODVAR, LENE, NLNKE, LINKE, XN, YN, ZN,
     &            A(KIPATH), NUMNP, NNENUM, NENUM)
            ELSE
               CALL FNDPTH (NODVAR, LENE, NLNKE, LINKE, XE, YE, ZE,
     &            A(KIPATH), NUMEL, NNENUM, NENUM)
            END IF
         END IF

C      --Set X axis to automatic scaling, etc if not set
         INVERB = 'xaxis'

C *** Display control ***

      ELSE IF (VERB .EQ. 'DISPVAR') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL DISPV (.FALSE., INLINE, IFLD, INTYP,
     &      CFIELD, NAMES, LIDSP, NAMLEN)
         INVERB = ' '

C *** Display ***

      ELSE IF ((VERB .EQ. 'PLOT') .OR. (VERB .EQ. 'HARDCOPY') .OR.
     &         (VERB .EQ. 'NEUTRAL') .OR. (VERB .EQ. 'GRAFAID') .OR.
     *         (VERB .EQ. 'XMGR')    .OR. (VERB .EQ. 'CSV')) THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '

         IF (NNENUM .EQ. 0) THEN
            CALL PRTERR ('CMDERR', 'No nodes or elements are selected')
            GOTO 180
         END IF
         IF (NSPVAR .EQ. 0) THEN
            CALL PRTERR ('CMDERR', 'No curves are defined')
            GOTO 180
         END IF
         IF (NPTIMS .EQ. 0) THEN
            CALL PRTERR ('CMDERR', 'No times are selected')
            VERB = ' '
            GOTO 180
         END IF

C      --Check that at least one selected element is defined for each selected
C      --element variable

         IF (.NOT. NODVAR) THEN
            NBAD = 0
            DO 170 IP = 1, NSPVAR
               CALL DBVTYP_BL (ISVID(IP), TYP, IVAR)
               IF (NUMEQL (.FALSE., NELBLK, ISEVOK(1,IVAR)) .GT. 0) THEN
                  DO 150 IX = 1, NNENUM
                     IF (ISEVOK(IE2ELB(NENUM(IX)),IVAR)) GOTO 160
  150             CONTINUE
                  NBAD = NBAD + 1
  160             CONTINUE
               END IF
  170       CONTINUE
            IF (NBAD .GT. 0) THEN
               IF (NBAD .GE. NSPVAR) THEN
                  CALL PRTERR ('CMDERR',
     &               'All of the curve variables are undefined'
     &               // ' for the requested elements')
                  GOTO 180
               ELSE
                  CALL PRTERR ('CMDERR',
     &               'Some of the curve variables are undefined'
     &               // ' for the requested elements')
               END IF
            END IF
         END IF

C      --PLOT, HARDCOPY, and NEUTRAL are to be passed as lower-case commands
         CALL LOWSTR (INVERB, VERB)
         VERB = ' '

C *** Mesh display commands ***

      ELSE IF (VERB .EQ. 'ECHO') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '

         IF (NNENUM .EQ. 0) THEN
            CALL PRTERR ('CMDERR', 'No nodes or elements are selected')
            GOTO 180
         END IF
         SELOK = .TRUE.

         INVERB = 'mesh'
         VERB = ' '

C *** Information ***

      ELSE IF (VERB .EQ. 'show') THEN

         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         CALL ABRSTR (VERB, WORD, CMDTBL)
         IF (VERB .NE. ' ') THEN
            CALL SPSHOW (VERB, NAMES, NENUM, LIDSP)
            INVERB = ' '
         END IF
         VERB = ' '

      ELSE IF (VERB .EQ. 'help') THEN

         ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
         IF (.NOT. ISON)
     &      CALL SHOCMD ('SPLOT Commands', CMDTBL)
         VERB = ' '

      ELSE
         VERB = ' '
      END IF

      GOTO 190

  180 CONTINUE
      INLINE(1) = ' '

  190 CONTINUE
      IF (VERB .NE. ' ') THEN
         CALL SPSHOW (VERB, NAMES, NENUM, LIDSP)
      END IF

  200 CONTINUE
      RETURN
      END
