C Copyright(C) 1999-2020, 2022 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 MSCOMD (A, CURPRO, MSHTYP, INLINE, INVERB, IFLD,
     &           INTYP, CFIELD, IFIELD, RFIELD, NAMECO, NAMES,
     &           IDELB, NEWELB, IELBST, NEWMOD,  IDNPS, ISSNPS,
     &           IDESS, ISSESS, BLKCOL, SHDCOL, ISHDCL)
C=======================================================================

C   --*** MSCOMD *** (MESH) Process mesh commands
C   --   Modified by John Glick - 1/13/89
C   --   Written by Amy Gilkey - revised 05/31/88
C   --   Dennis Flanagan, 11/18/82
C   --
C   --MSCOMD interprets mesh commands.
C   --
C   --The commands are listed below with their parameters and their
C   --function.
C   --
C   --Display mode control
C   --   EMPTY                     Set empty window
C   --   DEFORM   {ON/OFF}         Set deformed versus undeformed mesh
C   --   NUMBER   {NODES/ELEMENTS/ALL} Set to number nodes or elements
C   --   MLINES   {ON/OFF}         Set on/off mesh overlay option
C   --   BOUNDARY {ON/OFF}         Set on/off mesh and element block boundary
C   --                             option
C   --   NSETS    {id1,...}        Select node sets
C   --   SSETS    {id1,...}        Select side sets
C   --
C   --Active element control
C   --   VISIBLE  {element blocks} Set ON (displayed) element blocks (3D)
C   --   BLOCKS   {element blocks} Set selected element blocks
C   --   DEATH    {ON,variable}    Enable element birth/death
C   --   DEATH    {OFF}            Disable element birth/death
C   --
C   --Element block color control
C   --   BLKCOL string1 string2 ... stringi
C   --      where
C   --          stringi = block_id1 block_id2 ... block_idj block_coli
C   --                             Sets the color of the element blocks
C   --                             specified.  block_idi is the integer
C   --                             identifier of a block.  block_coli
C   --                             identifies the color to be given
C   --                             to the element blocks specified in
C   --                             stingi.  The color must be identified
C   --                             by its name, although it may be
C   --                             abbreviated to uniqueness within the
C   --                             list of colors.  The available colors
C   --                             are black, white, red, green, yellow,
C   --                             blue, cyan, and magenta.
C   --   MATCOL string1 string2 ... stringi
C   --                             Performs the same function as the
C   --                             BLKCOL command.
C   --
C   --Multiple views control
C   --   VIEW     {IVIEW,command}  Set view-dependent parameter mode for view
C   --   XSYM     {LEFT/RIGHT,xaxsym} Define vertical symmetry axis
C   --   XSYM     {OFF}            Delete vertically divided views
C   --   XVIEW                     Define vertical non-symmetric views
C   --   XVIEW    {OFF}            Same as XSYM OFF
C   --   YSYM     {BOTTOM/TOP,yaxsym} Define horizontal symmetry axis
C   --   YSYM     {OFF}            Delete horizontally divided views
C   --   YVIEW                     Define horizontal non-symmetric views
C   --   YVIEW    {OFF}            Same as YSYM OFF
C   --   MULTTIME {ON/OFF}         Define multiple time views
C   --
C   --Mesh control
C   --   MAGNIFY  {dfac}           Set displacement magnification factor
C   --   HIDDEN   {0/1/2/3}        Set hidden line removal option (3D)
C   --   ZOOM     {left,right,bottom,top} Set output window min/max
C   --   ZOOM     {EACH/SET}       Set window scaling
C   --   SQUARE   {ON/OFF}         Set square/non-square window scaling
C   --   TICK     {ticmsh}         Set mesh axis tick interval
C   --   ROTATE   {X/Y/Z/RESET,value} Rotate the mesh (cumulative) (3D)
C   --   EYE      {x,y,z}          Rotate the mesh to given position (3D)
C   --   CENTER   {x,y,z}          Change the center of rotation (3D)
C   --   CENTER   {RESET}          Reset the center of rotation (3D)
C   --   CUT      {x1,y1,x2,y2,x3,y3} Specify a cutting plane (3D)
C   --   CUT      {OFF}            Delete the cutting plane (3D)
C   --   LINETHICKNESS             Specify thickness for for mesh lines.
C   --   SPHERE or FSPHERE {ON/OFF}
C   --                             Display elements as spheres, taking
C   --                             their radius from the first
C   --                             element attribute.
C   --
C   --Display control
C   --   DEADNODE {ON/OFF}         Enable/Disable dead node display
C   --   color                     Set number of colors
C   --   spectrum                  Set number of spectrum colors
C   --
C   --Display
C   --   reset                     Reset default conditions
C   --   postmesh                  Initialize after a 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   --   mesh                      Exit to plot the mesh
C   --
C   --Information
C   --   show     {option}         Display program information (based on type)
C   --   help     {option}         Display system dependent HELP
C   --
C   --Parameters:
C   --   A      - IN  - the dynamic memory base array
C   --   CURPRO - IN  - the current program name
C   --   MSHTYP - IN  - true iff the current program is a mesh program
C   --   INLINE - I/O - the parsed input lines for the log file
C   --   INVERB - I/O - the command verb
C   --   IFLD,  - I/O - the free-field reader index and fields
C   --   INTYP, - I/O - the free-field reader index and fields
C   --   CFIELD,- I/O - the free-field reader index and fields
C   --   IFIELD,- I/O - the free-field reader index and fields
C   --   RFIELD - I/O - the free-field reader index and fields
C   --   NAMECO - IN  - the coordinate names
C   --   NAMES  - IN  - the variable names
C   --   IDELB  - IN  - the element block ID array
C   --   NEWELB - I/O - the new element blocks flag:
C   --                  0 = no new element blocks (set elsewhere)
C   --                  1 = new selected element blocks
C   --                  2 = new displayed element blocks
C   --                      (implies new selected blocks)
C   --   IELBST - I/O - the element block status:
C   --                  -1 = OFF, 0 = ON, but not selected, 1 = selected
C   --   NEWMOD - OUT - the mode status of each view:
C   --                  -1 = unchanged
C   --                   0 = changed to default
C   --                   n = changed to be like view n
C   --   IDNPS  - IN  - the node set ID for each set
C   --   ISSNPS - I/O - the indices of the selected node sets
C   --   IDESS  - IN  - the side set ID for each set
C   --   ISSESS - I/O - the indices of the selected side sets
C   --   BLKCOL - I/O - the user selected colors of the element blocks.
C   --                    BLKCOL(0) = 1 if the user defined material
C   --                                colors should be used in mesh plots.
C   --                              = -1 if program selected colors should
C   --                                be used.
C   --                    BLKCOL(i) = the user selected color of element
C   --                               block i:
C   --                                  -2 - no color selected by user.
C   --                                  -1 - black
C   --                                   0 - white
C   --                                   1 - red
C   --                                   2 - green
C   --                                   3 - yellow
C   --                                   4 - blue
C   --                                   5 - cyan
C   --                                   6 - magenta
C   --
C   --Common Variables:
C   --   Uses NELBLK, NVARNP, NVAREL of /DBNUMS/
C   --   Uses IS3DIM of /D3NUMS/
C   --   Sets DEFPRO, DFAC, DDFAC of /DEFORM/
C   --   Uses DEFOK, DEFFAC of /DEFORM/
C   --   Sets and uses MSHDEF, MSHNUM, MSHLIN, MLNTYP, IHIDOP, NALVAR, DEADNP
C   --      of /MSHOPT/
C   --   Sets and uses MULTIM, XISSYM, YISSYM, XAXSYM, YAXSYM, LFTSYM, BOTSYM
C   --      of /VIEWS/
C   --   Uses ALMESH of /MSHLIM/
C   --   Sets ZMMESH, RDMESH, TICMSH, MSCTYP, SQMESH of /MSHLIM/
C   --   Sets and uses NEWROT, ROTMAT, ROTCEN, EYE of /ROTOPT/
C   --   Sets NEWCUT, ISCUT, CUTPT, CUTNRM of /CUTOPT/

      PARAMETER (MSHNON=0, MSHBOR=1, MSHDIV=2, MSHSEL=3, MSHALL=4)

      PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4, KNEA=5, KFAR=6)

      include 'params.blk'
      include 'dbnums.blk'
      include 'dbnumgq.blk'
      include 'd3nums.blk'
      include 'deform.blk'
      include 'mshopt.blk'
      include 'views.blk'
      include 'mshlim.blk'
      include 'rotopt.blk'
      include 'cutopt.blk'
      include 'selne.blk'
      include 'sphele.blk'
      include 'light.blk'
      include 'debug.blk'

      DIMENSION A(*)
      CHARACTER*(*) CURPRO
      LOGICAL MSHTYP
      CHARACTER*(*) INLINE(*)
      CHARACTER*(*) INVERB
      INTEGER     INTYP(*)
      CHARACTER*(*) CFIELD(*)
      INTEGER     IFIELD(*)
      REAL        RFIELD(*)
      CHARACTER*(*) NAMECO(*)
      CHARACTER*(*) NAMES(*)
      INTEGER IDELB(NELBLK)
      INTEGER NEWELB
      INTEGER IELBST(NELBLK)
      INTEGER NEWMOD(4)
      INTEGER IDNPS(*)
      INTEGER ISSNPS(NUMNPS,4)
      INTEGER ISSESS(NUMESS,4)
      INTEGER IDESS(*)
      INTEGER BLKCOL(0:NELBLK)
      REAL    SHDCOL(7,NELBLK)
      INTEGER ISHDCL(3,NELBLK)

      LOGICAL FFMATC, FFEXST, MATSTR
      INTEGER NDEFVW, IXVW
      CHARACTER*(MXNAME) WORD
      CHARACTER CDUM
      LOGICAL LDUM1, LDUM2
      LOGICAL HELP
      LOGICAL VWCMD
      LOGICAL ISON
      INTEGER LTYP(-1:1)
      LOGICAL MESHOK

      CHARACTER*(MXNAME) VERB, VERB2
      CHARACTER*(MXNAME) SAVERB
C      --VERB - the command verb used in the SHOW
C      --VERB2 - the secondary SHOW command verb

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

      CHARACTER*(MXSTLN) OLDPRO
      SAVE OLDPRO
C      --OLDPRO - the name of the program that set the defaults for
C      --   the current parameters
      CHARACTER*8 MSCSV
      SAVE MSCSV
C      --MSCSV - the old MSCTYP if set to 'SELECTED'

      LOGICAL NEWZM, SETTIC
      SAVE NEWZM, SETTIC
C      --NEWZM - true iff a new zoom window has been specified
C      --SETTIC - true iff the axis tick interval has been specified by the user
      REAL DFRMAT(3,3), DFRCEN(3)
      SAVE DFRMAT, DFRCEN
C      --DFRMAT - the default rotation matrix, saved on first entry
C      --DFRCEN - the default rotation center, saved on first entry

      CHARACTER*(MXSTLN) CMDTBL(41)
      INTEGER IVWTBL, NVWTBL
      SAVE CMDTBL, IVWTBL, NVWTBL
C      --CMDTBL - the command table
C      --IVWTBL - the VIEW command table starting index
C      --NVWTBL - the number of entries in the VIEW command table

      DATA FIRST / .TRUE. /

      DATA IVWTBL, NVWTBL / 1, 0 /

C   --Command table follows.  The "VIEW" entry starts the VIEW
C   --command table, and all VIEW commands (and only these commands)
C   --must follow this entry.  The table is ended by a blank entry.
C   --Remember to change the dimensioned size when changing the table.
C   --Lowercase entries are for obsolete commands; they are converted to
C   --uppercase before use.
      DATA (CMDTBL(I),I=1,10) /
     1  'VISIBLE                         ',
     *  'BLOCKS                          ',
     *  'MATERIAL                        ',
     *  'DEATH                           ',
     2  'XSYM                            ',
     *  'YSYM                            ',
     *  'XVIEW                           ',
     *  'YVIEW                           ',
     *  'MULTTIME                        ',
     3  'MAGNIFY                         '/
      DATA (CMDTBL(I),I=11,20) /
     *  'HIDDEN                          ',
     4  'ZOOM                            ',
     *  'scale                           ',
     *  'SQUARE                          ',
     *  'TICK                            ',
     5  'ROTATE                          ',
     *  'EYE                             ',
     *  'CENTER                          ',
     *  'CUT                             ',
     *  'LIGHTS                          '/
      DATA (CMDTBL(I),I=21,30) /
     6  'DEADNODE                        ',
     *  'SHDCOLOR                        ',
     *  'AMBIENT                         ',
     7  'PLOT                            ',
     *  'HARDCOPY                        ',
     *  'BLKCOLOR                        ',
     *  'MATCOLOR                        ',
     *  'LINETHICKNESS                   ',
     8  'SPHERE                          ',
     *  'FSPHERE                         '/
      DATA (CMDTBL(I),I=31,41) /
     *  'VIEW                            ',
     *  'EMPTY                           ',
     *  'DEFORM                          ',
     9  'undeform                        ',
     *  'NUMBER                          ',
     *  'MLINES                          ',
     *  'overlay                         ',
     *  'BOUNDARY                        ',
     1  'NSETS                           ',
     *  'SSETS                           ',
     *  '                                ' /

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

      WORD = INVERB
      CALL ABRSTR (VERB, WORD, CMDTBL)
      IF (VERB .NE. ' ') THEN
         VWCMD = (LOCSTR (VERB, NVWTBL, CMDTBL(IVWTBL)) .GT. 0)
      ELSE
         VERB = WORD
         VWCMD = .FALSE.
      END IF

      VERB2 = ' '

C   --Reset NEWMOD

      CALL INIINT (4, -999, NEWMOD)

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

C         --Find the starting entry in the VIEW table

            IVWTBL = LOCSTR ('VIEW', 999, CMDTBL)
            NVWTBL = LOCSTR (' ', 999, CMDTBL(IVWTBL)) - 1

            DDFAC = DEFFAC
            IF (DDFAC .LT. 0.0) DDFAC = 0.0

C         --Set up the default rotation matrix and rotation center

            IF (IS3DIM) THEN
               CALL INIREA (3*3, 0.0, DFRMAT)
               DO 110 I = 1, 3
                  DFRMAT(I,I) = 1.0
  110          CONTINUE

               DFRCEN(1) = 0.5 * (UNMESH(KRGT)-UNMESH(KLFT))
               DFRCEN(2) = 0.5 * (UNMESH(KTOP)-UNMESH(KBOT))
               DFRCEN(3) = 0.5 * (UNMESH(KFAR)-UNMESH(KNEA))
            END IF

C         --Set values that do not change when reset

            LFTSYM = .TRUE.
            XAXSYM = UNMESH(KLFT)
            BOTSYM = .TRUE.
            YAXSYM = UNMESH(KBOT)

C         --Initialize MSCTYP (so SCALAX can be called)

            IF (.NOT. IS3DIM) THEN
               MSCTYP = 'MESH'
            ELSE
               MSCTYP = 'EACH'
            END IF

            VERB = 'initres'

C     --Initialize color map
            CALL STCLST('DETOUR')
         END IF

C      --Initialize for program change

         IF (VERB .EQ. 'initprog') THEN

C         --Mesh is undeformed (may be changed)

            DEFPRO = .FALSE.
            DFAC = 0.0
            CALL SCALAX

            IF ((.NOT. MSHTYP) .OR. (OLDPRO .NE. CURPRO)) THEN

C            --Set mode for all views

               CALL INIINT (3, 1, LTYP)
               CALL SETMSH (2, 'UNDEFORM', 'NONE', MSHSEL, LTYP,
     &            0, IDUM, 0, IDUM, 'WIREFRAM', ' ', ISSNPS, ISSESS)

C            --Set axis scale type and set axis scale

               IF (MSCTYP .EQ. 'SELECTED') THEN
                  SETTIC = .FALSE.
                  TICMSH = 0.0
                  NEWZM = .TRUE.
                  IF (.NOT. IS3DIM) THEN
                     MSCTYP = 'MESH'
                  ELSE
                     MSCTYP = 'EACH'
                  END IF

                  CALL SCALAX
               END IF
            END IF

            OLDPRO = CURPRO
         END IF

C      --Reset parameters

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

C         --Set active element control to all element blocks, no birth/death

            IF (FIRST) NEWELB = 0
            NEWELB = MAX (NEWELB, 1)
            DO 120 IELB = 1, NELBLK
               IF ((.NOT. FIRST) .AND. (IELBST(IELB) .LT. 0)) NEWELB = 2
               IELBST(IELB) = 1
  120       CONTINUE

            NALVAR = 0

C         --Mesh is undeformed (may be changed)

            DEFPRO = .FALSE.
            DFAC = 0.0
            CALL SCALAX

C         --Set rotation matrix and center and cutting plane

            IF (IS3DIM) THEN
               NEWROT = .TRUE.
               CALL CPYREA (3*3, DFRMAT, ROTMAT)
               CALL CPYREA (3, DFRCEN, ROTCEN)
               Z = UNMESH(KFAR) - UNMESH(KNEA)
               CALL UNROT (1, 1, ROTMAT, ROTCEN,
     &            0.0, 0.0, Z, EYE(1), EYE(2), EYE(3))

               ISCUT = .FALSE.
               CALL INIREA (3, 0.0, CUTPT)
               CALL INIREA (3, 0.0, CUTNRM)
            END IF

C         --Set wireframe mode on 1 view

            MULTIM = .FALSE.
            XISSYM = .FALSE.
            YISSYM = .FALSE.

            IF (.NOT. IS3DIM) THEN
               IHIDOP = 0
            ELSE
               if (nshl .gt. 100000) then
                  ihidop = 2
                  CALL PRTERR ('CMDREQ',
     &            'Setting "hidden 2" for faster shell plotting')
                  CALL PRTERR ('CMDREQ',
     &            'Reset via "hidden 3" when zoomed')
               else
                  IHIDOP = 3
               end if
            END IF
            CALL SETMSH (0, 'NONE', CDUM, IDUM, LTYP,
     &         IDUM, IDUM, IDUM, IDUM, 'NONE', CDUM, ISSNPS, ISSESS)
            CALL INIINT (3, 1, LTYP)
            CALL SETMSH (2, 'UNDEFORM', 'NONE', MSHSEL, LTYP,
     &         0, IDUM, 0, IDUM, 'WIREFRAM', ' ', ISSNPS, ISSESS)
C ... NOTE: Since the `init` argument is `.true.`, all other fields are ignored except ishdcl
            CALL SCOLOR (.TRUE., INLINE, IFLD, INTYP,
     &         RFIELD, IFIELD, CFIELD, SHDCOL, ISHDCL, IDELB)

C         --Set display options

            DEADNP = .FALSE.

C         --Set axis scale type and set axis scale

            TICMSH = 0.0
            SETTIC = .FALSE.
            NEWZM = .TRUE.
            SQMESH = .TRUE.
            IF (.NOT. IS3DIM) THEN
               MSCTYP = 'MESH'
            ELSE
               MSCTYP = 'EACH'
            END IF

            CALL SCALAX

            OLDPRO = CURPRO

            FIRST = .FALSE.

C              reset line thicknesses
            CALL LINTHK (INLINE, IFLD, INTYP, IFIELD, RFIELD,
     &         CFIELD, .TRUE.)

C              reset whether to plot elements as spheres

            SPHPLT = 0
         END IF

C      --Initialize after mesh plot

         IF (VERB .EQ. 'postmesh') THEN

C         --Reset mesh scaling factor if selected

            IF (MSCTYP .EQ. 'SELECTED') MSCTYP = MSCSV
         END IF

C      --Initialize for new plot set

         IF (((VERB .EQ. 'postplot') .AND. MSHTYP)
     &      .OR. (VERB .EQ. 'postmesh')) THEN
            CALL QNPICK ('QUERY', ISON, LDUM2,
     &         A, IDUM, IDUM, IDUM, IDUM, IDUM)
            IF (ISON) THEN
               NEWZM = .FALSE.
               SETTIC = .FALSE.
            END IF
         END IF

         OLDPRO = CURPRO
         VERB = ' '

C *** Display Mode control ***

      ELSE IF (VWCMD) THEN
         SAVERB = INVERB
         INVERB = ' '
         IF ((VERB .EQ. 'DEFORM') .or. (verb .eq. 'UNDEFORM')) THEN
            IF (.NOT. DEFPRO) THEN
               CALL PRTERR ('CMDERR',
     &            'Command not allowed in this subprogram')
               GOTO 140
            END IF
         END IF

C      --Set up the view number
         CALL CMDVWC (VERB, INLINE(1),
     &      IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &      IVIEW, JVIEW, *140)

         WORD = VERB
         CALL ABRSTR (VERB, WORD, CMDTBL(IVWTBL))
         IF (VERB .EQ. ' ') THEN
            INVERB = SAVERB
            GOTO 140
         END IF

         CALL CMDMSH (VERB, INLINE(1),
     &      IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &      IVIEW, JVIEW, NEWMOD,
     &      IDNPS, ISSNPS, IDESS, ISSESS, *140)

         INVERB = 'newmod'

C *** Active element control ***

      ELSE IF ((VERB .EQ. 'VISIBLE')
     &   .OR. (VERB .EQ. 'BLOCKS') .OR. (VERB .EQ. 'MATERIAL')
     &   .OR. (VERB .EQ. 'DEATH')) THEN
         INVERB = ' '

         IF ((VERB .EQ. 'VISIBLE')
     &      .OR. (VERB .EQ. 'BLOCKS') .OR. (VERB .EQ. 'MATERIAL')) THEN
            if ((verb .eq. 'BLOCKS') .or. (verb .eq. 'MATERIAL')) then
               if (ffmatc (ifld, intyp, cfield, 'DISPLAY', 1)) then
                  call prterr ('CMDREQ',
     &               'Please use the VISIBLE command')
                  verb = 'VISIBLE'
               end if
            end if

            CALL CMDELB (VERB, INLINE(1), IFLD, INTYP, CFIELD,
     &                   IFIELD, IDELB, IELBST, NEWELB, *140)

         ELSE IF (VERB .EQ. 'DEATH') THEN
            IF (.NOT. DEFPRO) THEN
               CALL PRTERR ('CMDERR',
     &            'Command not allowed in this subprogram')
               GOTO 140
            END IF
            CALL DBVIX_BL ('E', 1, IEV)
            CALL CMDDEA (VERB, INLINE(1), IFLD, INTYP, CFIELD,
     &         RFIELD, NAMES(IEV), NALVAR, ALIVAL, *140)

            IF (NALVAR .GT. 0) VERB2 = 'DEADNODE'
         END IF

         INVERB = 'newele'

C *** Multiple views control ***

      ELSE IF ((VERB .EQ. 'XSYM') .OR. (VERB .EQ. 'XVIEW')
     &   .OR. (VERB .EQ. 'YSYM') .OR. (VERB .EQ. 'YVIEW')) THEN
         INVERB = ' '

         CALL CMDMVW (VERB, INLINE(1),
     &      IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &      UNMESH, NEWMOD, ISSNPS, ISSESS, *140)
         VERB2 = 'VIEW'

         CALL SCALAX

         INVERB = 'newmod'

      ELSE IF (VERB .EQ. 'MULTTIME') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '
         IF (.NOT. DEFPRO) THEN
            CALL PRTERR ('CMDERR',
     &         'Command not allowed in this subprogram')
            GOTO 140
         END IF

         CALL FFONOF (IFLD, INTYP, CFIELD, MULTIM, *140)
         CALL FFADDO (MULTIM, INLINE(1))

C *** Mesh control ***

      ELSE IF (VERB .EQ. 'MAGNIFY') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '
         IF (.NOT. DEFPRO) THEN
            CALL PRTERR ('CMDERR',
     &         'Command not allowed in this subprogram')
            GOTO 140
         END IF
         IF (.NOT. DEFOK) GOTO 140
         IF (DEFFAC .LT. 0.0) THEN
            CALL PRTERR ('CMDERR',
     &         'Magnification is not initialized - Call DETOUR')
            GOTO 140
         END IF

         CALL FFREAL (IFLD, INTYP, RFIELD,
     &      'magnification factor', DEFFAC, DFAC, *140)
         CALL FFADDR (DFAC, INLINE(1))
         IF (DFAC .NE. 0.0) DDFAC = DFAC

         CALL SCALAX

      ELSE IF (VERB .EQ. 'HIDDEN') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '
         IF (.NOT. IS3DIM) THEN
            CALL PRTERR ('CMDERR', 'Command allowed in 3D only')
            GOTO 140
         END IF

         CALL FFINTG (IFLD, INTYP, IFIELD,
     &      'hidden line removal level', IHIDOP, IHID, *140)
         IHIDOP = MAX (0, IHID)
         CALL FFADDI (IHIDOP, INLINE(1))

      ELSE IF ((VERB .EQ. 'ZOOM') .OR. (VERB .EQ. 'TICK')
     &   .or. (verb .eq. 'SCALE') .OR. (VERB .EQ. 'SQUARE')) THEN
         INVERB = ' '

         CALL MDFIND ('MAPND', KMAPND, LDUM)

         CALL CMDZM (VERB, INLINE(1),
     &      IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &      NEWZM, SETTIC, A(KMAPND), A, *140)

         CALL SCALAX

      ELSE IF ((VERB .EQ. 'ROTATE') .OR. (VERB .EQ. 'EYE')
     &   .OR. (VERB .EQ. 'CENTER')) THEN
         INVERB = ' '

         CALL CMDROT (VERB, INLINE(1),
     &      IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &      DFRMAT, DFRCEN,
     &      NEWZM, A, *140)

         CALL SCALAX

      ELSE IF (VERB .EQ. 'LIGHTS') THEN
        INVERB = ' '
        CALL FFADDC (VERB, INLINE(1))
        if (FFMATC (IFLD, INTYP, CFIELD, 'ADD', 3)) THEN
          NLIT = NLIT + 1
          if (NLIT .GT. MAXLIT) THEN
            call prterr('WARNING',
     *        'Too many lights defined, overwriting last defined light')
            NLIT = MAXLIT
          end if
          CALL FFADDC ('ADD', INLINE(1))
        else if (FFMATC (IFLD, INTYP, CFIELD, 'DELETE', 3)) THEN
          CALL FFADDC ('DELETE', INLINE(1))
          IF (FFEXST (IFLD, INTYP)) THEN
            CALL FFINTG (IFLD, INTYP, IFIELD,
     &        'light number', 0, LITN, *125)
            IF (litn .gt. 0 .and. litn .le. nlit) then
              do 122 i = litn+1, nlit
                do 121 j = 1, 4
                  lite(j,i-1) = lite(j,i)
 121            continue
 122          continue
              nlit = nlit - 1
            ELSE
              call prterr ('WARNING', 'Undefined Light')
            END IF
          ELSE
            NLIT = 0
          END IF
          go to 125
        else
          nlit = 1
        end if

        CALL FFREAL (IFLD, INTYP, RFIELD,
     *    'X Component', 1.0, LITE(1,NLIT), *140)
        CALL FFADDR (LITE(1,NLIT), INLINE(1))
        CALL FFREAL (IFLD, INTYP, RFIELD,
     *    'Y Component', 1.0, LITE(2,NLIT), *140)
        CALL FFADDR (LITE(2,NLIT), INLINE(1))
        CALL FFREAL (IFLD, INTYP, RFIELD,
     *    'Z Component', 1.0, LITE(3,NLIT), *140)
        CALL FFADDR (LITE(3,NLIT), INLINE(1))
        CALL FFREAL (IFLD, INTYP, RFIELD,
     *    'Light Intensity', 1.0, LITE(4,NLIT), *140)
        CALL FFADDR (LITE(4,NLIT), INLINE(1))
 125    continue
C ... Normalize light vectors.
        do 127 i = 1, nlit
          vmag = sqrt(lite(1,i)**2 + lite(2,i)**2 + lite(3,i)**2)
          lite(5,i) = lite(1,i) / vmag
          lite(6,i) = lite(2,i) / vmag
          lite(7,i) = lite(3,i) / vmag
          lite(8,i) = lite(4,i)
 127    continue

      ELSE IF (VERB .EQ. 'AMBIENT') THEN
        INVERB = ' '
        CALL FFADDC (VERB, INLINE(1))
        CALL FFREAL (IFLD, INTYP, RFIELD,
     *    'Ambient Intensity', 0.2, AMBIENT, *140)
        CALL FFADDR (AMBIENT, INLINE(1))

      ELSE IF ((VERB .EQ. 'CUT') .OR. (VERB .EQ. 'CUT3')) THEN
         INVERB = ' '

         CALL CMDCUT (VERB, INLINE(1), IFLD, INTYP, CFIELD,
     &                RFIELD, A, *140)

      ELSE IF ((VERB .EQ. 'WHAT') .OR. (VERB .EQ. 'WHAT3')
     &   .OR. (VERB .EQ. 'WHERE')) THEN
         INVERB = ' '

         CALL QNPICK ('ORIGINAL', LDUM1, LDUM2,
     &      A, KXN, KYN, KZN, IDUM, IDUM)
         CALL QNPICK ('DISPLAYED', LDUM1, LDUM2,
     &      A, KXNN, KYNN, KZNN, KHIDEN, KNPSUR)
         CALL MDFIND ('XE', KXE, KLEN)
         CALL MDFIND ('YE', KYE, KLEN)
         IF (IS3DIM) THEN
           CALL MDFIND ('ZE', KZE, KLEN)
         ELSE
           KZE = 1
         END IF
         CALL MDFIND ('MAPEL', KMAPEL, LDUM)
         CALL MDFIND ('MAPND', KMAPND, LDUM)

         CALL CMDWHE (VERB, INLINE(1),
     &      IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &      A(KXN), A(KYN), A(KZN),
     &      A(KXNN), A(KYNN), A(KZNN), A(KHIDEN),
     *      A(KXE), A(KYE), A(KZE), A(KMAPEL), A(KMAPND), *140)

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

         CALL MSCHK (.FALSE., MESHOK)
         IF (MESHOK) THEN
            CALL FFADDC (VERB, INLINE(1))
            CALL LINTHK (INLINE, IFLD, INTYP, IFIELD, RFIELD,
     &         CFIELD, .FALSE.)
            IF (INLINE(1) .EQ. ' ') VERB = ' '
         ELSE
            WRITE (*, 10010)
            VERB = ' '
         ENDIF
         INVERB = ' '

      ELSE IF (VERB .EQ. 'SPHERE'  .OR.  VERB .EQ. 'FSPHERE') THEN
         CALL FFADDC (VERB, INLINE(1))
         ISPHER = 0
         DEFRAD = 1.0
         IF (FFEXST (IFLD, INTYP)) THEN
C           Check that next field has characters in it.
            IF (INTYP(IFLD) .GE. 0) THEN
C              Check for 'ON' or 'OFF'
               IF (CFIELD(IFLD) .EQ. 'ON') THEN
                  IF (VERB .EQ. 'SPHERE') THEN
                     SPHPLT = 1
                  ELSE
                     SPHPLT = -1
                  ENDIF
                  CALL FFADDC ('ON', INLINE(1))
                  ISPHER = 1
                  IFLD = IFLD + 1
               ELSE IF (CFIELD(IFLD) .EQ. 'OFF') THEN
                  SPHPLT = 0
                  CALL FFADDC ('OFF', INLINE(1))
                  ISPHER = 1
                  IFLD = IFLD + 1
               ELSE
                  WRITE (*, 10000)
10000              FORMAT (1X, 'EXPECTED "ON" OR "OFF" AS',
     &               ' PARAMETER TO SPHERE/FSPHERE COMMAND'/)
               ENDIF
            ELSE
               WRITE (*, 10000)
            ENDIF
         ENDIF
         IF (ISPHER .EQ. 0) THEN
            IF (SPHPLT .EQ. 0) THEN
               IF (VERB .EQ. 'SPHERE') THEN
                  SPHPLT = 1
               ELSE
                  SPHPLT = -1
               ENDIF
            ELSE IF (SPHPLT .GE. 1) THEN
               IF (VERB .EQ. 'SPHERE') THEN
                  SPHPLT = 0
               ELSE
                  SPHPLT = -1
               ENDIF
            ELSE
               IF (VERB .EQ. 'SPHERE') THEN
                  SPHPLT = 1
               ELSE
                  SPHPLT = 0
               ENDIF
            ENDIF
         ENDIF
C ... Optional "RADIUS default_radius" option
         IF (FFEXST (IFLD, INTYP)) THEN
C          Check that next field has characters in it.
           IF (INTYP(IFLD) .GE. 0) THEN
             IF (MATSTR (CFIELD(IFLD), 'RADIUS', 1)) THEN
               IFLD = IFLD + 1
               CALL FFADDC ('RADIUS', INLINE)
               CALL FFREAL (IFLD, INTYP, RFIELD,
     &           'default sphere radius multiplier', 1.0, DEFRAD, *140)
             END IF
           END IF
         END IF
C ... Optional integer specifying number of sphere segments
         CALL FFINTG (IFLD, INTYP, IFIELD,
     &     'segments used to draw spheres', 12, ISMULT, *140)
         ISMULT = MIN(ISMULT, NPTSPX)
         SPHPLT = SPHPLT * ISMULT

         INVERB = ' '

C *** Display control ***

      ELSE IF (VERB .EQ. 'DEADNODE') THEN
         CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '
         IF (.NOT. DEFPRO) THEN
            CALL PRTERR ('CMDERR',
     &         'Command not allowed in this subprogram')
            GOTO 140
         END IF

         CALL FFONOF (IFLD, INTYP, CFIELD, DEADNP, *140)
         CALL FFADDO (DEADNP, INLINE(1))

         VERB2 = 'DEATH'

      ELSE IF ((VERB .EQ. 'PLOT') .OR. (VERB .EQ. 'HARDCOPY') .OR.
     &   (VERB .EQ. 'mesh')) THEN
         IF (VERB .NE. 'mesh') CALL FFADDC (VERB, INLINE(1))
         INVERB = ' '

         IF (NDEFVW (.FALSE.) .LE. 0) THEN
            CALL PRTERR ('CMDERR', 'No views are defined')
            VERB = 'PLOT'
            GOTO 140
         END IF

C      --Check if nodes/element selected for mesh plot

         IF (VERB .EQ. 'mesh') THEN

C         --Save mesh scaling type
            MSCSV = MSCTYP

            IF (SELOK) THEN

C            --Set MSCTYP to 'SELECTED' if nodes/element selected for mesh plot
               MSCTYP = 'SELECTED'

C            --Set selected numbering if nodes/element selected for mesh plot
               DO 130 IVW = 1, NDEFVW (.FALSE.)
                  IVIEW = IXVW (.FALSE., IVW)
                  IF (MSHNUM(IVIEW) .EQ. 'NONE')
     &               MSHNUM(IVIEW) = 'SELECTED'
  130          CONTINUE
            END IF
         END IF

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

      ELSE IF (VERB .EQ. 'BLKCOLOR'  .OR.  VERB .EQ. 'MATCOLOR') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL MSCHK (.FALSE., MESHOK)
         VERB = 'BLKCOLOR'
         IF (MESHOK) THEN
            CALL BCOLOR (.FALSE., INLINE, IFLD, INTYP,
     &         IFIELD, CFIELD, BLKCOL)
         ELSE
            WRITE (*, 10010)
10010        FORMAT (1X, 'Command not valid unless valid mesh is',
     &         ' defined')
            VERB = ' '
         ENDIF
         INVERB = ' '

      ELSE IF (VERB .EQ. 'SHDCOLOR') THEN
         CALL FFADDC (VERB, INLINE(1))
         CALL MSCHK (.FALSE., MESHOK)
         VERB = 'SHDCOLOR'
         IF (MESHOK) THEN
            CALL SCOLOR (.FALSE., INLINE, IFLD, INTYP,
     &         RFIELD, IFIELD, CFIELD, SHDCOL, ISHDCL, IDELB)
         ELSE
            WRITE (*, 10010)
            VERB = ' '
         ENDIF
         INVERB = ' '

C *** Information ***

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

         CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
         CALL ABRSTR (VERB, WORD, CMDTBL)
         IF (VERB .NE. ' ') THEN
            IF (.NOT. MSHTYP) THEN
               IF ((VERB .NE. 'PLOT') .AND. (VERB .NE. 'HARDCOPY')) THEN
                  CALL MSSHOW (VERB, NAMECO, NAMES, IDELB, IELBST,
     &               IDNPS, ISSNPS, IDESS, ISSESS, BLKCOL)
                  INVERB = ' '
               END IF
            ELSE
               CALL MSSHOW (VERB, NAMECO, NAMES, IDELB, IELBST,
     &            IDNPS, ISSNPS, IDESS, ISSESS, BLKCOL)
               IF ((VERB .NE. 'PLOT') .AND. (VERB .NE. 'HARDCOPY')
     &            .AND. (VERB .NE. 'VIEW')) THEN
                  INVERB = ' '
               ELSE
                  CFIELD(IFLD-1) = VERB
               END IF
            END IF
         END IF
         VERB = ' '

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

         ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
         IF (.NOT. ISON) THEN
            CALL SHOCMD ('Mesh Commands', CMDTBL)
         END IF
         VERB = ' '

      ELSE
         VERB = ' '
      END IF

      GOTO 150

  140 CONTINUE
      INLINE(1) = ' '

  150 CONTINUE

      IF (VERB .NE. ' ') THEN
         CALL MSSHOW (VERB, NAMECO, NAMES, IDELB, IELBST,
     &      IDNPS, ISSNPS, IDESS, ISSESS, BLKCOL)
      ELSE
         VERB2 = ' '
      END IF

      IF (VERB2 .NE. ' ') THEN
         CALL MSSHOW (VERB2, NAMECO, NAMES, IDELB, IELBST,
     &      IDNPS, ISSNPS, IDESS, ISSESS, BLKCOL)
      END IF

      RETURN
      END
