C Copyright(C) 2009-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     * 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=======================================================================
      SUBROUTINE XYCOMD (A, CURPRO, INLINE,
     &   INVERB, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &   MESHOK)
C=======================================================================

C   --*** XYCOMD *** (XYPLOT) Process XY-plot commands
C   --   Written by Amy Gilkey - revised 02/23/88
C   --
C   --XYCOMD interprets XY-plot commands.
C   --
C   --The commands are listed below with their parameters and their
C   --function.
C   --
C   --Axis size and scaling
C   --   RATIOXY  {ratio}          Set X to Y axis ratio
C   --   XSCALE   {xmin,xmax}      Set X axis scale
C   --   YSCALE   {ymin,ymax}      Set Y axis scale
C   --   XTICK    {xtick}          Set X axis tick interval
C   --   YTICK    {ytick}          Set Y axis tick interval
C   --   XLABEL                    Set X axis label (on following line)
C   --   YLABEL                    Set Y axis label (on following line)
C   --   xaxis                     Reset X axis parameters
C   --   yaxis                     Reset Y axis parameters
C   --   xyaxis                    Reset X and Y axis parameters
C   --
C   --Neutral file options
C   --   ACURVE   {crvnam}         Set neutral file curve name
C   --   NCURVE   {numcrv,inccrv}  Set neutral file curve number and increment
C   --
C   --Display options
C   --   GRID     {ON/OFF}         Draw grid on plot if ON
C   --   LINES    {ON/OFF/VARY}    Plot line, none or vary line
C   --   SYMBOLS  {ON/OFF/#}       Plot varying symbols, none or specific symbol
C   --   CRVNUM   {FIRST/LAST/MIDDLE/OFF} Set curve numbering position
C   --   OVERLAY  {ON/OFF/VARIABLE/TIME} Curves for all variables or all time
C   --                             will be overlaid on one plot
C   --   SAMESCAL {ON/OFF}         Curves will have the same scale if ON
C   --   NORMAL   {ON/OFF}         Curves will be normalized if ON
C   --
C   --Display
C   --   reset                     Reset plot parameters
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 commands
C   --   MESH                      Display mesh with numbering, zoom
C   --
C   --Information
C   --   show     {option}         Display plot parameters and information
C   --   help     {option}         Display system dependent HELP
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   --   CURPRO - IN - the current program name
C   --   IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field
C   --      reader index and fields
C   --   MESHOK - IN - true iff mesh can be displayed
C   --
C   --Common Variables:
C   --   Sets DOGRID, LINTYP, ISYTYP, LABSID, OVERLY, OVERTM,
C   --      IAXSCA of /XYOPT/
C   --   Sets ASPECT, IXSCAL, IYSCAL, XMIN, XMAX, YMIN, YMAX, XTICK, YTICK
C   --      of /XYLIM/
C   --   Sets XLAB, YLAB of /XYLAB/
C   --   Sets NUMCRV, INCCRV and CRVNAM of /NEUTR./

      PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4)

      PARAMETER (NUMSYM = 6, NUMLIN = 6)

      include 'params.blk'
      include 'dbnums.blk'
      include 'xyopt.blk'
      include 'xylim.blk'
      include 'xylab.blk'
      include 'neutr.blk'

      DIMENSION A(*)
      CHARACTER*(*) CURPRO
      CHARACTER*(*) INLINE(*)
      CHARACTER*(*) INVERB
      INTEGER     INTYP(*)
      CHARACTER*(*) CFIELD(*)
      INTEGER     IFIELD(*)
      REAL        RFIELD(*)
      LOGICAL MESHOK

      LOGICAL FFNUMB, MATSTR

      CHARACTER*(MXSTLN) VERB, WORD
      LOGICAL HELP
      LOGICAL ISON

      INTEGER IDUM
      REAL RDUM
      CHARACTER*(MXSTLN) CDUM
      CHARACTER*8 PROMPT
      INTEGER LPROM

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

      LOGICAL XSCSET, YSCSET, XTCSET, YTCSET, XLBSET, YLBSET
      SAVE XSCSET, YSCSET, XTCSET, YTCSET, XLBSET, YLBSET
C      --These flags show whether an axis parameter has been set since
C      --   the start of the plot set

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

      DATA FIRST /.TRUE./
      DATA IDUM / 1 /

C   --Command table follows.  Remember to change the dimensioned size when
C   --changing the table.
      DATA CMDTBL /
     1  'RATIOXY                         ',
     *  'XSCALE                          ',
     *  'YSCALE                          ',
     *  'XTICK                           ',
     *  'YTICK                           ',
     2  'XLABEL                          ',
     *  'YLABEL                          ',
     3  'ACURVE                          ',
     *  'NCURVE                          ',
     4  'GRID                            ',
     *  'LINES                           ',
     *  'SYMBOLS                         ',
     *  'CRVNUM                          ',
     5  'OVERLAY                         ',
     *  'SAMESCALE                       ',
     *  'NORMAL                          ',
     6  'MESH                            ',
     7  '                                ' /

C   --Get the command verb

      WORD = INVERB
      CALL ABRSTR (VERB, WORD, CMDTBL)
      IF (VERB .EQ. ' ') VERB = WORD

C *** Initialization ***

      IF ((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
            IAXSCA = 'PLOT'
            IXSCAL = IAXSCA
            IYSCAL = IAXSCA

            CRVNAM = ' '
            NUMCRV = 1
            INCCRV = 1

            VERB = 'initres'
         END IF

C      --Initialize for program change

         IF (VERB .EQ. 'initprog') THEN

C         --Leave display options the same

C         --Reset axis scaling and labeling

            ASPECT = 1.0
            IXSCAL = IAXSCA
            IYSCAL = IAXSCA
            XMIN = 0.0
            XMAX = 0.0
            YMIN = 0.0
            YMAX = 0.0
            XTICK = 0.0
            YTICK = 0.0
            XLAB = ' '
            YLAB = ' '
         END IF

C      --Reset parameters

         IF ((VERB .EQ. 'reset') .OR. (VERB .EQ. 'initres')) THEN
            DOGRID = .FALSE.
            LINTYP = 1
            ISYTYP = 0
            LABSID = 'LAST'
            OVERLY = .FALSE.
            OVERTM = .FALSE.
            IAXSCA = 'PLOT'

            ASPECT = 1.0
            IXSCAL = IAXSCA
            IYSCAL = IAXSCA
            XMIN = 0.0
            XMAX = 0.0
            YMIN = 0.0
            YMAX = 0.0
            XTICK = 0.0
            YTICK = 0.0
            XLAB = ' '
            YLAB = ' '

            FIRST = .FALSE.
         END IF

C      --Initialize for new plot set

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

         XSCSET = .FALSE.
         YSCSET = .FALSE.
         XTCSET = .FALSE.
         YTCSET = .FALSE.
         XLBSET = .FALSE.
         YLBSET = .FALSE.

         VERB = ' '

C *** Axis size and scaling ***

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

         CALL FFREAL (IFLD, INTYP, RFIELD,
     &      'X to Y axis length ratio', 1.0, ASPECT, *100)
         CALL FFADDR (ASPECT, INLINE(1))

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

         IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
            IXSCAL = IAXSCA
         ELSE
            CALL FFREAL (IFLD, INTYP, RFIELD,
     &         'minimum axis value', XMIN, RMIN, *100)
            CALL FFADDR (ASPECT, INLINE(1))
            CALL FFREAL (IFLD, INTYP, RFIELD,
     &         'maximum axis value', XMAX, RMAX, *100)
            CALL FFADDR (ASPECT, INLINE(1))
            IF (RMIN .GE. RMAX) THEN
               CALL PRTERR ('CMDERR',
     &            'Axis minimum must be less than axis maximum')
               GOTO 100
            END IF
            XMIN = RMIN
            XMAX = RMAX
            IXSCAL = 'SET'
         END IF

C      --Mark the axis scaling as having been set
         XSCSET = .TRUE.

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

         IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
            IYSCAL = IAXSCA
         ELSE
            CALL FFREAL (IFLD, INTYP, RFIELD,
     &         'minimum axis value', YMIN, RMIN, *100)
            CALL FFADDR (ASPECT, INLINE(1))
            CALL FFREAL (IFLD, INTYP, RFIELD,
     &         'maximum axis value', YMAX, RMAX, *100)
            CALL FFADDR (ASPECT, INLINE(1))
            IF (RMIN .GE. RMAX) THEN
               CALL PRTERR ('CMDERR',
     &            'Axis minimum must be less than axis maximum')
               GOTO 100
            END IF
            YMIN = RMIN
            YMAX = RMAX
            IYSCAL = 'SET'
         END IF

C      --Mark the axis scaling as having been set
         YSCSET = .TRUE.

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

         CALL FFREAL (IFLD, INTYP, RFIELD,
     &      'tick interval', 0.0, XTICK, *100)
         CALL FFADDR (ASPECT, INLINE(1))

C      --Mark the axis tic mark as having been set
         XTCSET = .TRUE.

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

         CALL FFREAL (IFLD, INTYP, RFIELD,
     &      'tick interval', 0.0, YTICK, *100)
         CALL FFADDR (ASPECT, INLINE(1))

C      --Mark the axis tic mark as having been set
         YTCSET = .TRUE.

      ELSE IF (VERB .EQ. 'XLABEL') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '
         PROMPT = 'LABEL> '
         LPROM = LENSTR (PROMPT) + 1
         CALL GETINS ('line', IDUM, IDUM, IDUM, CDUM,
     &      IDUM, RDUM, XLAB, IOSTAT,
     &      PROMPT, LPROM, *100)
C        CALL GETINP (0, 0, 'LABEL> ', XLAB, IOSTAT)
         INLINE(2) = XLAB

C      --Mark the axis label as having been set
         XLBSET = .TRUE.

      ELSE IF (VERB .EQ. 'YLABEL') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '
         PROMPT = 'LABEL> '
         LPROM = LENSTR (PROMPT) + 1
         CALL GETINS ('line', IDUM, IDUM, IDUM, CDUM,
     &      IDUM, RDUM, YLAB, IOSTAT,
     &      PROMPT, LPROM, *100)
C        CALL GETINP (0, 0, 'LABEL> ', YLAB, IOSTAT)
         INLINE(2) = YLAB

C      --Mark the axis label as having been set
         YLBSET = .TRUE.

      ELSE IF ((VERB .EQ. 'xaxis') .OR. (VERB .EQ. 'yaxis')
     &   .OR. (VERB .EQ. 'xyaxis')) THEN
         INVERB = ' '

         IF ((VERB .EQ. 'xaxis') .OR. (VERB .EQ. 'xyaxis')) THEN
            IF ((.NOT. XSCSET) .AND. (IXSCAL .EQ. 'SET')) THEN
               CALL PRTERR ('CMDWARN',
     &            'Automatic scaling selected for X axis')
               IXSCAL = IAXSCA
            END IF
            IF ((.NOT. XTCSET) .AND. (XTICK .NE. 0.0)) THEN
               CALL PRTERR ('CMDWARN',
     &            'Automatic scaling selected for X axis tick interval')
               XTICK = 0.0
            END IF
            IF ((.NOT. XLBSET) .AND. (XLAB .NE. ' ')) THEN
               CALL PRTERR ('CMDWARN',
     &            'Default label selected for X axis')
               XLAB = ' '
            END IF
         END IF

         IF ((VERB .EQ. 'yaxis') .OR. (VERB .EQ. 'xyaxis')) THEN
            IF ((.NOT. YSCSET) .AND. (IYSCAL .EQ. 'SET')) THEN
               CALL PRTERR ('CMDWARN',
     &            'Automatic scaling selected for Y axis')
               IYSCAL = IAXSCA
            END IF
            IF ((.NOT. YTCSET) .AND. (YTICK .NE. 0.0)) THEN
               CALL PRTERR ('CMDWARN',
     &            'Automatic scaling selected for Y axis tick interval')
               YTICK = 0.0
            END IF
            IF ((.NOT. YLBSET) .AND. (YLAB .NE. ' ')) THEN
               CALL PRTERR ('CMDWARN',
     &            'Default label selected for Y axis')
               YLAB = ' '
            END IF
         END IF

C *** Neutral file options ***

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

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

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

         CALL FFINTG (IFLD, INTYP, IFIELD,
     &      'curve number', 1, NUMCRV, *100)
         CALL FFADDI (NUMCRV, INLINE(1))
         CALL FFINTG (IFLD, INTYP, IFIELD,
     &      'curve number increment', 1, INCCRV, *100)
         CALL FFADDI (NUMCRV, INLINE(1))

C *** Display options ***

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

         CALL FFONOF (IFLD, INTYP, CFIELD, DOGRID, *100)

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

         CALL FFCHAR (IFLD, INTYP, CFIELD, 'ON', WORD)
         IF (MATSTR (WORD, 'ON', 2)) THEN
            CALL FFADDC ('ON', INLINE(1))
            LINTYP = 1
         ELSE IF (MATSTR (WORD, 'VARY', 1)) THEN
            CALL FFADDC ('VARY', INLINE(1))
            LINTYP = -1
         ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
            CALL FFADDC ('OFF', INLINE(1))
            LINTYP = 0
            IF (ISYTYP .EQ. 0) ISYTYP = -1
         ELSE
            CALL PRTERR ('CMDERR', 'Expected "ON", "VARY" or "OFF"')
            GOTO 100
         END IF

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

         IF (FFNUMB (IFLD, INTYP)) THEN
            CALL FFINTG (IFLD, INTYP, IFIELD,
     &         'symbol number', 1, ISY, *100)
            CALL FFADDI (NUMCRV, INLINE(1))
            ISYTYP = ISY
         ELSE
            CALL FFCHAR (IFLD, INTYP, CFIELD, 'ON', WORD)
            IF (MATSTR (WORD, 'ON', 2)) THEN
               CALL FFADDC ('ON', INLINE(1))
               ISYTYP = -1
            ELSE IF (MATSTR (WORD, 'VARY', 1)) THEN
               CALL FFADDC ('VARY', INLINE(1))
               ISYTYP = -1
            ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
               CALL FFADDC ('OFF', INLINE(1))
               ISYTYP = 0
               IF (LINTYP .EQ. 0) LINTYP = 1
            ELSE
               CALL PRTERR ('CMDERR',
     &            'Expected "VARY", "OFF" or symbol number')
               GOTO 100
            END IF
         END IF

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

         CALL FFCHAR (IFLD, INTYP, CFIELD, 'LAST', WORD)
         IF (MATSTR (WORD, 'FIRST', 1)) THEN
            CALL FFADDC ('FIRST', INLINE(1))
            LABSID = 'FIRST'
         ELSE IF (MATSTR (WORD, 'MIDDLE', 1)) THEN
            CALL FFADDC ('MIDDLE', INLINE(1))
            LABSID = 'MIDDLE'
         ELSE IF (MATSTR (WORD, 'LAST', 1)) THEN
            CALL FFADDC ('LAST', INLINE(1))
            LABSID = 'LAST'
         ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
            CALL FFADDC ('OFF', INLINE(1))
            LABSID = 'NONE'
         ELSE
            CALL PRTERR ('CMDERR',
     &         'Expected "FIRST", "MIDDLE", "LAST" or "OFF"')
            GOTO 100
         END IF

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

         CALL FFCHAR (IFLD, INTYP, CFIELD, 'VARIABLE', WORD)
         IF (MATSTR(WORD, 'VARIABLE', 1)
     &      .OR. MATSTR (WORD, 'ON', 2)) THEN
            CALL FFADDC ('VARIABLE', INLINE(1))
            OVERLY = .TRUE.
            OVERTM = .FALSE.
         ELSE IF (MATSTR (WORD, 'TIME', 1)) THEN
            CALL FFADDC ('TIME', INLINE(1))
            OVERLY = .FALSE.
            OVERTM = .TRUE.
         ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
            CALL FFADDC ('OFF', INLINE(1))
            OVERLY = .FALSE.
            OVERTM = .FALSE.
         ELSE
            CALL PRTERR ('CMDERR',
     &         'Expected "VARIABLE", "TIME" or "OFF"')
            GOTO 100
         END IF

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

         CALL FFONOF (IFLD, INTYP, CFIELD, ISON, *100)
         IF (ISON) THEN
            IAXSCA = 'ALL'
         ELSE
            IAXSCA = 'PLOT'
         END IF

         IF (IXSCAL .NE. 'SET') IXSCAL = IAXSCA
         IF (IYSCAL .NE. 'SET') IYSCAL = IAXSCA

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

         CALL FFONOF (IFLD, INTYP, CFIELD, ISON, *100)
         IF (ISON) THEN
            IAXSCA = 'CURVE'
         ELSE
            IAXSCA = 'PLOT'
         END IF

         IF (IXSCAL .NE. 'SET') IXSCAL = IAXSCA
         IF (IYSCAL .NE. 'SET') IYSCAL = IAXSCA

C *** Curve display commands ***

      ELSE IF ((VERB .EQ. 'plot') .OR. (VERB .EQ. 'hardcopy')
     &   .OR. (VERB .EQ. 'neutral')) THEN
         CONTINUE

C *** Mesh display commands ***

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

         IF (.NOT. MESHOK) THEN
            CALL PRTERR ('CMDERR', 'No mesh is defined')
            GOTO 100
         END IF

         CALL LOWSTR (INVERB, VERB)
         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 XYSHOW (VERB)
            INVERB = ' '
         END IF
         VERB = ' '

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

         ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
         IF (.NOT. ISON)
     &      CALL SHOCMD ('General XY-plot', CMDTBL)
         VERB = ' '

      ELSE
         VERB = ' '
      END IF

      GOTO 110

  100 CONTINUE
      INLINE(1) = ' '

  110 CONTINUE
      IF (VERB .NE. ' ') THEN
         CALL XYSHOW (VERB)
      END IF

      RETURN
      END
