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 DBLIST (A, INLINE,
     &   VERB, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &   NAMECO, NAMELB, NAMES, QAREC, INFREC,
     &   TIMES, WHOTIM, NPTIMS, IPTIMS, XN, YN, ZN,
     &   IDELB, LENE, NLNKE, LINKE, ISEVOK,
     &   IDNPS, NNNPS, IDESS, NEESS, NNESS,
     &   NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &   LISHV, LISGV, LISNV, LISEV,
     $   EBNAME, NSNAME, SSNAME, NAMLEN, MAPEL, MAPND)
C=======================================================================

C   --*** DBLIST *** (BLOT) Process LIST/PRINT commands
C   --   Written by Amy Gilkey - revised 05/12/88
C   --
C   --DBLIST processes a LIST or PRINT command.
C   --
C   --This routine uses MDFIND to find the following dynamic memory arrays:
C   --   MAPEL - the element order map
C   --   NUMATR - the number of attributes for each element block
C   --   ATRIB - the attributes for each element block
C   --   IXNNPS - the index of the first node for each node set
C   --   LTNNPS - the nodes for all node sets
C   --   FACNPS - the distribution factors for all node sets
C   --   IXEESS - the index of the first element for each side set
C   --   IXNESS - the index of the first node for each side set
C   --   LTEESS - the elements for all side sets
C   --   LTNESS - the nodes for all side sets
C   --   FACESS - the distribution factors for all side sets
C   --
C   --Parameters:
C   --   A - IN - the dynamic memory base array
C   --   INLINE - IN/OUT - the parsed input lines for the log file
C   --   VERB - IN/OUT - the command verb
C   --   IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field
C   --      reader index and fields
C   --   NAMECO - IN - the names of the coordinates
C   --   NAMELB - IN - the names of the element block types
C   --   NAMES - IN - the variable names
C   --   QAREC - IN - the QA records containing:
C   --      (1) - the analysis code name
C   --      (2) - the analysis code QA descriptor
C   --      (3) - the analysis date
C   --      (4) - the analysis time
C   --   INFREC - IN - the information records
C   --   TIMES - IN - the times for all time steps
C   --   WHOTIM - IN - true iff whole (versus history) time step
C   --   NPTIMS - IN - the number of selected time steps
C   --   IPTIMS - IN - the selected time steps
C   --   XN, YN, ZN - IN - the nodal coordinates
C   --   IDELB - IN - the element block ID for each block
C   --   LENE - IN - the cumulative element counts by element block
C   --   NLNKE - IN - the number of nodes per element for each block
C   --   LINKE - IN - the connectivity array for all blocks
C   --   ISEVOK - IN - the element block variable truth table
C   --   IDNPS - IN - the node set ID for each set
C   --   NNNPS - IN - the number of nodes for each set
C   --   IDESS - IN - the side set ID for each set
C   --   NEESS - IN - the number of elements for each set
C   --   NNESS - IN - the number of nodes for each set
C   --   NCSTEP - IN/OUT - the current step number for display
C   --   LISNP - IN/OUT - the indices of the selected nodes
C   --   NLISEL - IN/OUT - the number of selected elements for each block
C   --   LISEL - IN/OUT - the indices of the selected elements (by block)
C   --   LISNPS - IN/OUT - the indices of the selected node sets
C   --   LISESS - IN/OUT - the indices of the selected side sets
C   --   LISHV - IN/OUT - the indices of the selected history variables
C   --   LISGV - IN/OUT - the indices of the selected global variables
C   --   LISNV - IN/OUT - the indices of the selected nodal variables
C   --   LISEV - IN/OUT - the indices of the selected element variables
C   --
C   --Common Variables:
C   --   Uses NDB of /DBASE/
C   --   Uses TITLE of /DBTITL/
C   --   Uses NDIM, NUMNP, NUMEL, NELBLK, NVARHI, NVARGL, NVARNP, NVAREL,
C   --      NSTEPS of /DBNUMS/
C   --   Uses NUMNPS, LNPSNL, NUMESS, LESSEL, LESSNL of /DBNUMG/
C   --   Uses NQAREC, NINFO of /DBNUMQ/
C   --   Uses NOUT, NCRT, NPRT, ANYPRT of /OUTFIL/

      include 'dbname.blk'
      include 'params.blk'
      include 'progqa.blk'
      include 'dbase.blk'
      include 'dbtitl.blk'
      include 'dbnums.blk'
      include 'dbnumgq.blk'
      include 'outfil.blk'

      DIMENSION A(*)
      CHARACTER*(*) INLINE(*)
      CHARACTER*(*) VERB
      INTEGER     INTYP(*)
      CHARACTER*(*) CFIELD(*)
      INTEGER     IFIELD(*)
      REAL        RFIELD(*)
      CHARACTER*(MXSTLN) NAMECO(*), NAMELB(*)
      CHARACTER*(NAMLEN) NAMES(*)
      CHARACTER*(NAMLEN) EBNAME(*), NSNAME(*), SSNAME(*)
      CHARACTER*(MXSTLN) QAREC(4,*)
      CHARACTER*(MXLNLN) INFREC(*)
      CHARACTER*2048 FILNAM, ERRMSG

      REAL TIMES(*)
      LOGICAL WHOTIM(*)
      INTEGER IPTIMS(*)
      REAL XN(*), YN(*), ZN(*)
      INTEGER IDELB(*), NLNKE(*)
      INTEGER LENE(0:*), LINKE(*)
      LOGICAL ISEVOK(*)
      INTEGER IDNPS(*), NNNPS(*)
      INTEGER IDESS(*), NEESS(*), NNESS(*)
      INTEGER LISNP(0:*)
      INTEGER NLISEL(0:*), LISEL(0:*)
      INTEGER LISNPS(0:*), LISESS(0:*)
      INTEGER LISHV(0:*), LISGV(0:*), LISNV(0:*), LISEV(0:*)
      INTEGER MAPEL(*)
      INTEGER MAPND(*)

      LOGICAL FFEXST

      CHARACTER*(MXNAME) WORD, LISTYP
      CHARACTER*(MXNAME) DUMLIN
      CHARACTER*(MXSTLN) OPT

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

      CHARACTER*(MXSTLN) CMDTBL(32)
      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   'TITLE   ', 'VARS    ',
     2   'COORDINA', 'MAP     ', 'NODEMAP ', 'NMAP    ',
     3   'BLOCKS  ', 'MATERIAL', 'LINK    ', 'CONNECTI', 'ATTRIBUT',
     4   'NSETS   ', 'NNODES  ', 'NFACTORS',
     5   'SSETS   ', 'SELEMS  ', 'SNODES  ', 'SFACTORS',
     6   'QA      ', 'NAMES   ',
     7   'HVARS   ', 'GVARS   ', 'NVARS   ', 'EVARS   ',
     8   'HISTORY ', 'GLOBALS ', 'NODALS  ', 'ELEMENTS',
     9   'STEPS   ', 'TIMES   ', 'MINMAX  ',
     1   '        ' /

C *** Initialization ***

C   --Initialize parameters first time through, then reset

      IF (FIRST) THEN

C      --Set up the print file

         NCRT = -1
         NOUT = NCRT
         NPRT = 21
         ANYPRT = .FALSE.

C      --Reset selection if not done by SELECT command

         CALL DBSEL (A, INLINE,
     &      'reset', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &      NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &      IDELB, LENE, IDNPS, IDESS,
     &      NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &      LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         FIRST = .FALSE.
      END IF

C   --Get the command verb

      IF (VERB .EQ. 'LIST') THEN
         NOUT = NCRT

      ELSE IF (VERB .EQ. 'PRINT') THEN
         IF (NPRT .LE. 0) THEN
            CALL PRTERR ('CMDERR', 'Print file cannot be opened')
            GOTO 150
         END IF

         IF (.NOT. ANYPRT) THEN
           filnam = basenam(:lenstr(basenam)) // '.lis'
           open (unit=nprt, file=filnam(:lenstr(filnam)),
     *       form='formatted', status='unknown', iostat=ierr)
           IF (IERR .NE. 0) THEN
             ERRMSG = 'Print file "'//FILNAM(:LENSTR(FILNAM))//
     *         '" could not be opened.'
             CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
             NPRT = -1
             GOTO 150
           END IF

           CALL BANNER (NPRT, QAINFO,
     &       ' ', ' ', ' ')

           CALL PRINIT ('N', NPRT, NDB, DBNAME, TITLE,
     &       NDIM, NUMNP, NUMEL, NELBLK,
     &       NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSNL,
     &       NVARGL, NVARNP, NVAREL, NVARNS, NVARSS)

           ANYPRT = .TRUE.
         END IF

         NOUT = NPRT

      END IF

      CALL FFADDC (VERB, INLINE(1))

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

C *** GENESIS Print Commands ***

      IF (FFEXST (IFLD, INTYP)) THEN

         IF (LISTYP .EQ. 'COORDINA') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT NODES command')
            CALL DBSEL (A, DUMLIN,
     &         'NODES', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF ((LISTYP .EQ. 'BLOCKS')
     &      .OR. (LISTYP .EQ. 'MATERIAL')) THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT BLOCKS command')
            CALL DBSEL (A, DUMLIN,
     &         'BLOCKS', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF ((LISTYP .EQ. 'LINK') .OR. (LISTYP .EQ. 'CONNECTI')
     &      .OR. (LISTYP .EQ. 'ATTRIBU')) THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT ELEMENTS command')
            CALL DBSEL (A, DUMLIN,
     &         'ELEMENTS', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'NSETS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT NSETS command')
            CALL DBSEL (A, DUMLIN,
     &         'NSETS', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'SSETS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT SSETS command')
            CALL DBSEL (A, DUMLIN,
     &         'SSETS', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'HVARS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT HVARS command')
            CALL DBSEL (A, DUMLIN,
     &         LISTYP, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'GVARS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT GVARS command')
            CALL DBSEL (A, DUMLIN,
     &         LISTYP, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'NVARS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT NVARS command')
            CALL DBSEL (A, DUMLIN,
     &         LISTYP, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'EVARS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT EVARS command')
            CALL DBSEL (A, DUMLIN,
     &         LISTYP, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'NODALS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT NODES command')
            CALL DBSEL (A, DUMLIN,
     &         'NODES', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)

         ELSE IF (LISTYP .EQ. 'ELEMENTS') THEN
            CALL PRTERR ('CMDREQ',
     &         'Please use a SELECT ELEMENTS command')
            CALL DBSEL (A, DUMLIN,
     &         'XELEM', IFLD, INTYP, CFIELD, IFIELD, RFIELD,
     &         NAMES, TIMES, WHOTIM, NPTIMS, IPTIMS,
     &         IDELB, LENE, IDNPS, IDESS,
     &         NCSTEP, LISNP, NLISEL, LISEL, LISNPS, LISESS,
     &         LISHV, LISGV, LISNV, LISEV, MAPEL, MAPND)
         END IF
      END IF

      IF ((LISTYP .EQ. 'TITLE') .OR. (LISTYP .EQ. 'VARS')) THEN
         CALL FFADDC (LISTYP, INLINE(1))

         IF (EXODUS) THEN
            CALL PRINIT ('NTSIV', NOUT, NDB, DBNAME, TITLE,
     &         NDIM, NUMNP, NUMEL, NELBLK,
     &         NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSNL,
     &         NVARGL, NVARNP, NVAREL, NVARNS, NVARSS)
         ELSE
            CALL PRINIT ('NTSI', NOUT, NDB, DBNAME, TITLE,
     &         NDIM, NUMNP, NUMEL, NELBLK,
     &         NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSNL,
     &         NVARGL, NVARNP, NVAREL, NVARNS, NVARSS)
         END IF

      ELSE IF (LISTYP .EQ. 'COORDINA') THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKNONE (NUMNP, .FALSE., 'nodes', *150)
         CALL CKNONE (NDIM, .FALSE., 'coordinates', *150)
         CALL CKNONE (LISNP(0), .TRUE., 'coordinates', *150)

         CALL PRXYZ ('*', NOUT, NDIM, NAMECO, NUMNP, LISNP, XN, YN, ZN,
     &     MAPND)

      ELSE IF (LISTYP .EQ. 'MAP') THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKNONE (NUMEL, .FALSE., 'elements', *150)

         CALL PRMAP ('*', NOUT, NUMEL, MAPEL, 'Element')

      ELSE IF ((LISTYP .EQ. 'NODEMAP') .OR. (LISTYP .EQ. 'NMAP')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKNONE (NUMNP, .FALSE., 'nodes', *150)

         CALL PRMAP ('*', NOUT, NUMNP, MAPND, 'Node')

      ELSE IF ((LISTYP .EQ. 'BLOCKS') .OR. (LISTYP .EQ. 'MATERIAL')
     &   .OR. (LISTYP .EQ. 'LINK') .OR. (LISTYP .EQ. 'CONNECTI')
     &   .OR. (LISTYP .EQ. 'ATTRIBUT')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKNONE (NELBLK, .FALSE., 'element blocks', *150)
         CALL CKNONE (NLISEL(0), .TRUE., 'element blocks', *150)

         CALL MDFIND ('NUMATR', KNATR, IDUM)
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

         IF ((LISTYP .EQ. 'BLOCKS') .OR. (LISTYP .EQ. 'MATERIAL')) THEN
            IF (EXODUS) THEN
               OPT = 'NV'
            ELSE
               OPT = 'N'
            END IF
         ELSE IF ((LISTYP .EQ. 'LINK')
     &      .OR. (LISTYP .EQ. 'CONNECTI')) THEN
            OPT = 'C'
         ELSE IF (LISTYP .EQ. 'ATTRIBUT') THEN
            OPT = 'A'
            CALL MDFIND ('ATRIB', KATRIB, N)
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 150
         END IF

         IF ((LISTYP .EQ. 'LINK')
     &      .OR. (LISTYP .EQ. 'CONNECTI')) THEN
            IF (NDIM .EQ. 2) THEN
               DO 100 I = 1, NELBLK
                  IF (NLNKE(I) .EQ. 8) THEN
                     CALL PRTERR ('WARNING',
     &                  'Connectivity has been reordered')
                     GOTO 110
                  END IF
  100          CONTINUE
  110          CONTINUE
            END IF
         END IF

         CALL DBVIX_BL ('E', 1, IXEV)
         IF ((OPT .EQ. '*') .OR. (INDEX (OPT, 'V') .GT. 0)) THEN
            CALL MDRSRV ('XLISEV', KXLSEV, NVAREL)
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 150
         END IF

         CALL PRELB (OPT, NOUT, NELBLK, NLISEL, LISEL,
     &      IDELB, LENE, NLNKE, A(KNATR), LINKE, A(KATRIB),
     &      NAMELB, EBNAME, NVAREL, NAMES(IXEV), ISEVOK, A(KXLSEV),
     *      MAPEL, MAPND)

         IF ((OPT .EQ. '*') .OR. (INDEX (OPT, 'V') .GT. 0)) THEN
            CALL MDDEL ('XLISEV')
         END IF

      ELSE IF ((LISTYP .EQ. 'NSETS')
     &   .OR. (LISTYP .EQ. 'NNODES')
     &   .OR. (LISTYP .EQ. 'NFACTORS')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKNONE (NUMNPS, .FALSE., 'node sets', *150)
         CALL CKNONE (LISNPS(0), .TRUE., 'node sets', *150)

         CALL MDFIND ('IXNNPS', KIXNNS, IDUM)
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

         IF (LISTYP .EQ. 'NSETS') THEN
            OPT = ' '
         ELSE IF (LISTYP .EQ. 'NNODES') THEN
            OPT = 'N'
            CALL MDFIND ('LTNNPS', KLTNNS, N)
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 150
         ELSE IF (LISTYP .EQ. 'NFACTORS') THEN
            OPT = 'F'
            CALL MDFIND ('FACNPS', KFACNS, N)
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 150
         END IF

         CALL PRNPS (OPT, NOUT, NUMNPS, LISNPS, LNPSNL,
     &      IDNPS, NNNPS, A(KIXNNS), A(KLTNNS), A(KFACNS),
     $      NSNAME, MAPND)

      ELSE IF ((LISTYP .EQ. 'SSETS')
     &   .OR. (LISTYP .EQ. 'SELEMS')
     &   .OR. (LISTYP .EQ. 'SNODES')
     &   .OR. (LISTYP .EQ. 'SFACTORS')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKNONE (NUMESS, .FALSE., 'side sets', *150)
         CALL CKNONE (LISESS(0), .TRUE., 'side sets', *150)

         CALL MDFIND ('IXEESS', KIXESS, IDUM)
         CALL MDFIND ('IXNESS', KIXNSS, IDUM)
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

         IF (LISTYP .EQ. 'SSETS') THEN
            OPT = ' '
         ELSE IF (LISTYP .EQ. 'SELEMS') THEN
            OPT = 'E'
            CALL MDFIND ('LTEESS', KLTESS, N)
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 150
         ELSE IF (LISTYP .EQ. 'SNODES') THEN
            OPT = 'N'
            CALL MDFIND ('LTNESS', KLTNSS, N)
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 150
         ELSE IF (LISTYP .EQ. 'SFACTORS') THEN
            OPT = 'F'
            CALL MDFIND ('FACESS', KFACSS, N)
            CALL MDSTAT (NERR, MEM)
            IF (NERR .GT. 0) GOTO 150
         END IF

         if (nness(1) .lt. 0) then
            call getssn(a, ierr)
         end if

         CALL PRESS (OPT, NOUT, NUMESS, LISESS, LESSEL, LESSNL,
     &      IDESS, NEESS, NNESS, A(KIXESS), A(KIXNSS),
     &      A(KLTESS), A(KLTNSS), A(KFACSS), SSNAME, MAPEL, MAPND)

      ELSE IF (LISTYP .EQ. 'QA') THEN
         CALL FFADDC (LISTYP, INLINE(1))

         CALL PRQA ('*', NOUT, NQAREC, QAREC, NINFO, INFREC)

C *** EXODUS Print Commands ***

      ELSE IF (LISTYP .EQ. 'NAMES') THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKEXOD (EXODUS, *150)

         CALL DBVIX_BL ('H', 1, IXHV)
         CALL DBVIX_BL ('G', 1, IXGV)
         CALL DBVIX_BL ('N', 1, IXNV)
         CALL DBVIX_BL ('E', 1, IXEV)
         CALL DBVIX_BL ('M', 1, IXNS)
         CALL DBVIX_BL ('S', 1, IXSS)
         CALL PRNAME (NOUT, NAMLEN,
     *     NVARGL, NVARNP, NVAREL, NVARNS, NVARSS,
     &     NAMES(IXGV), NAMES(IXNV), NAMES(IXEV),
     *     NAMES(IXNS), NAMES(IXSS))

      ELSE IF ((LISTYP .EQ. 'HVARS') .OR. (LISTYP .EQ. 'HISTORY')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKEXOD (EXODUS, *150)
         CALL CKNONE (NVARHI, .FALSE., 'history variables', *150)
         CALL CKNONE (LISHV(0), .TRUE., 'history variables', *150)

         CALL DBVIX_BL ('H', 1, IXHV)

         CALL MDRSRV ('SCRVAR', KVAR, NVARHI)
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

         CALL GETVAR (A, IXHV, -999, NCSTEP, NVARHI, A(KVAR))

         CALL PRSTEP ('*', NOUT,
     &      TIMES(NCSTEP), WHOTIM(NCSTEP), NCSTEP, NSTEPS)

         CALL PRHIST ('*', NOUT, NVARHI, LISHV, NAMES(IXHV), A(KVAR))

         CALL MDDEL ('SCRVAR')

      ELSE IF ((LISTYP .EQ. 'GVARS') .OR. (LISTYP .EQ. 'GLOBALS')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKEXOD (EXODUS, *150)
         CALL CKNONE (NVARGL, .FALSE., 'global variables', *150)
         CALL CKWHOL (WHOTIM(NCSTEP), *150)
         CALL CKNONE (LISGV(0), .TRUE., 'global variables', *150)

         CALL DBVIX_BL ('G', 1, IXGV)

         CALL MDRSRV ('SCRVAR', KVAR, NVARGL)
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

         CALL GETVAR (A, IXGV, -999, NCSTEP, NVARGL, A(KVAR))

         CALL PRSTEP ('*', NOUT,
     &      TIMES(NCSTEP), WHOTIM(NCSTEP), NCSTEP, NSTEPS)

         CALL PRGLOB ('*', NOUT, NVARGL, LISGV, NAMES(IXGV), A(KVAR))

         CALL MDDEL ('SCRVAR')

      ELSE IF ((LISTYP .EQ. 'NVARS') .OR. (LISTYP .EQ. 'NODALS')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKEXOD (EXODUS, *150)
         CALL CKNONE (NUMNP, .FALSE., 'nodes', *150)
         CALL CKNONE (NVARNP, .FALSE., 'nodal variables', *150)
         CALL CKWHOL (WHOTIM(NCSTEP), *150)
         CALL CKNONE (LISNP(0), .TRUE., 'nodes', *150)
         CALL CKNONE (LISNV(0), .TRUE., 'nodal variables', *150)

         CALL DBVIX_BL ('N', 1, IXNV)

         CALL MDRSRV ('SCRVAR', KVAR, NUMNP * LISNV(0))
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

         DO 120 I = 1, NVARNP
            IX = LOCINT (I, LISNV(0), LISNV(1))
            IF (IX .GT. 0) THEN
               IXV = NUMNP * (IX-1)
               CALL GETVAR (A, IXNV+I-1, -999, NCSTEP, NUMNP,
     &            A(KVAR+IXV))
            END IF
  120    CONTINUE

         CALL PRSTEP ('*', NOUT,
     &      TIMES(NCSTEP), WHOTIM(NCSTEP), NCSTEP, NSTEPS)

         CALL PRNODE ('*', NOUT, NUMNP, LISNP, NVARNP, LISNV,
     &      NAMES(IXNV), A(KVAR), MAPND)

         CALL MDDEL ('SCRVAR')

      ELSE IF ((LISTYP .EQ. 'EVARS') .OR. (LISTYP .EQ. 'ELEMENTS')) THEN
         CALL FFADDC (LISTYP, INLINE(1))
         CALL CKEXOD (EXODUS, *150)
         CALL CKNONE (NUMEL, .FALSE., 'elements', *150)
         CALL CKNONE (NVAREL, .FALSE., 'element variables', *150)
         CALL CKWHOL (WHOTIM(NCSTEP), *150)
         CALL CKNONE (LISEL(0), .TRUE., 'elements', *150)
         CALL CKNONE (LISEV(0), .TRUE., 'element variables', *150)

         CALL DBVIX_BL ('E', 1, IXEV)

         CALL MDRSRV ('SCRVAR', KVAR, NUMEL * LISEV(0))
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

C      --Transfer needed variables to random disk
         DO 130 I = 1, NVAREL
            IX = LOCINT (I, LISEV(0), LISEV(1))
            IF (IX .GT. 0) THEN
               CALL GETVAR (A, IXEV+I-1, -1, -NCSTEP, NUMEL, A(KVAR))
            END IF
  130    CONTINUE

         DO 140 I = 1, NVAREL
            IX = LOCINT (I, LISEV(0), LISEV(1))
            IF (IX .GT. 0) THEN
               IXV = NUMEL * (IX-1)
               CALL GETVAR (A, IXEV+I-1, -1, NCSTEP, NUMEL,
     &            A(KVAR+IXV))
            END IF
  140    CONTINUE

         CALL PRSTEP ('*', NOUT,
     &      TIMES(NCSTEP), WHOTIM(NCSTEP), NCSTEP, NSTEPS)

         CALL PRELEM ('*', NOUT, NELBLK, NUMEL, NLISEL, LISEL, LENE,
     &      NVAREL, LISEV, NAMES(IXEV), ISEVOK, A(KVAR), MAPEL)

         CALL MDDEL ('SCRVAR')

C *** Miscellaneous Commmands ***

      ELSE IF (LISTYP .EQ. 'STEPS') THEN
         CALL PRTIMS ('NM', NOUT, .TRUE., .TRUE.,
     &      NSTEPS, TIMES, WHOTIM)

      ELSE IF (LISTYP .EQ. 'TIMES') THEN
         CALL PRTIMS ('NT', NOUT, .TRUE., .TRUE.,
     &      NSTEPS, TIMES, WHOTIM)

      ELSE IF (LISTYP .EQ. 'MINMAX') THEN
         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', 'Expected variable name')
            GOTO 150
         END IF

         CALL SCALER (A, A, 2, NAMES(IVAR), IVAR,
     &      .FALSE., IDUM, 0, DUMMIN, DUMMAX, MAPEL, MAPND)
         CALL MDSTAT (NERR, MEM)
         IF (NERR .GT. 0) GOTO 150

      ELSE
         CALL SHOCMD ('LIST/PRINT Options:', CMDTBL)
         GOTO 150
      END IF

      GOTO 160

  150 CONTINUE
      INLINE(1) = ' '

  160 CONTINUE
      IF (VERB .NE. 'PRINT') INLINE(1) = ' '
      RETURN
      END
