C Copyright(C) 2011-2017 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 Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions are
C met:
C
C * Redistributions of source code must retain the above copyright
C    notice, this list of conditions and the following disclaimer.
C
C * Redistributions in binary form must reproduce the above
C   copyright notice, this list of conditions and the following
C   disclaimer in the documentation and/or other materials provided
C   with the distribution.
C
C * Neither the name of NTESS nor the names of its
C   contributors may be used to endorse or promote products derived
C   from this software without specific prior written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

C=======================================================================
      SUBROUTINE SHOW (STYP, INTYP, IDNPS, IDESS, IDNSET, IDESET,
     &   BLKTYP, IBPARM, IDELB, NUMELB, NUMLNK)
C=======================================================================

C   --*** SHOW *** (GEN3D) Display information
C   --   Written by Amy Gilkey - revised 03/07/88
C   --
C   --SHOW displays information about the database and the plot parameters.
C   --
C   --The SHOW options with the items they display are:
C   --   TRANSLAT - number of translations or rotations
C   --   ROTATE   -
C   --   EXPROTAT -
C   --   WARP     -
C   --   TWIST    -
C   --   PROJECT  -
C   --   OFFSET   - generated mesh offsets
C   --   REVOLVE  - generated mesh rotation matrix
C   --   REVCEN   - generated mesh rotation center
C   --   MIRROR   - axes about which mesh is reflected
C   --   BLOCK    - information on all element blocks
C   --   CENTER   -    (number of elements, defined type, etc)
C   --   TUNNEL   -
C   --   NSETS    - IDs of existing and front and back node sets
C   --   SSETS    - IDs of existing and front and back side sets
C   --   VARS     - database title and initial variables
C   --
C   --Parameters:
C   --   STYP - IN - the exact SHOW option string
C   --   INTYP - IN - the abbreviated SHOW option string, ' ' if exact
C   --   IDNPS - IN - the IDs of existing node sets; (0) = length
C   --   IDESS - IN - the IDs of existing side sets; (0) = length
C   --   IDNSET - OUT - the IDs of the front and back surface node sets;
C   --      (0) = length
C   --   IDESET - OUT - the IDs of the front and back surface side sets;
C   --      (0) = length
C   --   BLKTYP - IN - the element block type
C   --   IBPARM - IN - the block parameters (defined by the block type)
C   --   IDELB - IN - the ids for each block
C   --   NUMELB - IN - the number of elements for each block
C   --   NUMLNK - IN - the number of nodes per element for each block
C   --
C   --Common Variables:
C   --   Uses NDBIN, NDBOUT of /DBASE/
C   --   Uses TITLE of /DBTITL/
C   --   Uses NDIM, NUMNP, NUMEL, NELBLK,
C   --      NUMNPS, LNPSNL, NUMESS, LESSEL, LESSNL of /DBNUMS/
C   --   Uses DOTRAN, NNREPL, NEREPL, DIM3, NRTRAN, D3TRAN, ZGRAD,
C   --      CENTER, NUMCOL of /PARAMS/
C   --   Uses XOFFS, YOFFS, ZOFFS of /XYZOFF/
C   --   Uses ROT3D, ROTMAT of /XYZROT/

      INCLUDE 'g3_dbase.blk'
      INCLUDE 'g3_dbtitl.blk'
      INCLUDE 'g3_dbnums.blk'
      INCLUDE 'g3_params.blk'
      INCLUDE 'g3_xyzoff.blk'
      INCLUDE 'g3_xyzrot.blk'
      INCLUDE 'g3_cmdsho.blk'
      INCLUDE 'g3_xyzmir.blk'
      INCLUDE 'g3_xyzscl.blk'
      INCLUDE 'g3_xyzero.blk'

      CHARACTER*(*) STYP
      CHARACTER*(*) INTYP
      INTEGER IDNPS(*), IDESS(*)
      INTEGER IDNSET(0:MAXSET,2), IDESET(0:MAXSET,2)
      CHARACTER BLKTYP(*)
      INTEGER IBPARM(4,*)
      INTEGER IDELB(*)
      INTEGER NUMELB(*)
      INTEGER NUMLNK(*)

      CHARACTER*8 SHOTYP
      CHARACTER*80 STRING
      REAL RNUM(9)
      CHARACTER*20 RSTR(9)
      CHARACTER*20 STRA, STRB

      CHARACTER*8 SHOTBL(28)
      SAVE SHOTBL
C      --SHOTBL - the special save option table

      DATA SHOTBL /
     &  'TRANSLAT', 'INTERVAL', 'ROTATE  ', 'EXPROTAT', 'WARP    ',
     &  'TWIST   ', 'PROJECT ', 'SPLINE  ', 'CPOINT  ', 'MIRROR  ',
     &  'OFFSET  ', 'SHIFT   ', 'ZERO    ', 'SCALE   ', 'REVOLVE ',
     &  'REVCEN  ', 'ROTCEN  ', 'ROTAXIS ', 'BLOCK   ', 'TUNNEL  ',
     &  'CENTER  ', 'SPECIAL ', 'NSETS   ', 'NODESETS', 'SSETS   ',
     &  'SIDESETS', 'VARS    ', '        ' /

C   --Determine the show option

      IF ((INTYP .EQ. ' ') .OR. (STYP .EQ. INTYP)) THEN
         SHOTYP = STYP
      ELSE
         CALL ABRSTR (SHOTYP, INTYP, SHOTBL)
         IF ((STYP .NE. ' ')
     &      .AND. ((SHOTYP .EQ. ' ') .OR. (SHOTYP .NE. INTYP)))
     &      SHOTYP = STYP
      END IF

      IF ((    SHOTYP .EQ. 'TRANSLAT')
     &   .OR. (SHOTYP .EQ. 'INTERVAL')
     &   .OR. (SHOTYP .EQ. 'ROTATE')
     &   .OR. (SHOTYP .EQ. 'EXPROTAT')
     &   .OR. (SHOTYP .EQ. 'WARP')
     &   .OR. (SHOTYP .EQ. 'TWIST')
     &   .OR. (SHOTYP .EQ. 'PROJECT')
     &   .OR. (SHOTYP .EQ. 'SPLINE')
     &   .OR. (SHOTYP .EQ. 'CPOINT')) THEN

         IF (ITRANT .NE. 2) THEN
            CALL SHWINT (ITRANT, NEREPL, DIM3, NRTRAN, D3TRAN, ZGRAD)
         END IF

         IF (ITRANT .EQ. 1) THEN
            CONTINUE
         ELSE IF (ITRANT .EQ. 2) THEN
            CALL INTSTR (1, 0, NEREPL, STRA, LSTRA)
            CALL NUMSTR (1, 4, DIM3, RSTR(1), LR)

            IF (ABS (RGRAD - 1.0) .LE. 1.0E-6) THEN
               WRITE (*, 130) 'Rotate mesh ', STRA(:LSTRA),
     &            ' times for a total of ', RSTR(1)(:LR), ' degrees'
            ELSE
               CALL NUMSTR (1, 3, RGRAD, RSTR(2), LR2)
               WRITE (*, 130) 'Rotate mesh ', STRA(:LSTRA),
     &            ' times for a total of ', RSTR(1)(:LR), ' degrees',
     &            ' with a gradient of ', RSTR(2)(:LR2)
            END IF

            if (rotax .eq. 0) then
              write (*, 130) '   About the Y Axis'
            else
              write (*, 130) '   About the X Axis'
            end if

            IF (CPOINT) THEN
               IF (NUMCOL .EQ. 1) THEN
                  WRITE (*, 130) '   Single point of rotation'
               ELSE
                  WRITE (*, 130) '   Single point of rotation'
     &               , ' (undefined)'
               END IF
            ELSE IF (NUMCOL .GT. 0) THEN
               CALL INTSTR (1, 0, NUMCOL, STRA, LSTRA)
               WRITE (*, 130) '   Center of rotation in ',
     &            STRA(:LSTRA), ' columns'
            ELSE
               CALL NUMSTR (1, 4, CENTER, RSTR(1), LR)
               WRITE (*, 130) '   Center of rotation = ', RSTR(1)(:LR)
            END IF

         ELSE IF (ITRANT .EQ. 4) THEN
            CALL NUMSTR (1, 3, DWARP, RSTR(1), LR1)
            IF (IWARP .EQ.  1) STRB = 'Point'
            IF (IWARP .EQ. -1) STRB = 'X Axis'
            IF (IWARP .EQ. -2) STRB = 'Y Axis'
            IF (IWARP .EQ. 1) THEN
               WRITE (*, 130) '   At a distance of ', RSTR(1)(:LR1),
     *            ' from the ',STRB(:LENSTR(STRB)),
     *            ' X = 0.0, Y = 0.0, Z = ',RSTR(1)(:LR1)
            ELSE
               WRITE (*, 130) '   At a distance of ', RSTR(1)(:LR1),
     *            ' from the ',STRB(:LENSTR(STRB))
            END IF
            IF (VEDGE) THEN
               WRITE (*, 130) '   With vertical edges'
            ELSE
               WRITE (*, 130) '   With radial edges'
            END IF
         ELSE IF (ITRANT .EQ. 8) THEN
            CONTINUE
         ELSE IF (ITRANT .EQ. 16) THEN
            CONTINUE
         ELSE IF (ITRANT .EQ. 32) THEN
            IF (CPOINT) THEN
               IF (NUMCOL .EQ. 1) THEN
                  WRITE (*, 130) '   Single point of rotation'
               ELSE
                  WRITE (*, 130) '   Single point of rotation'
     &               , ' (undefined)'
               END IF
            ELSE IF (NUMCOL .GT. 0) THEN
               CALL INTSTR (1, 0, NUMCOL, STRA, LSTRA)
               WRITE (*, 130) '   Center of rotation in ',
     &            STRA(:LSTRA), ' columns'
            ELSE
               CALL NUMSTR (1, 4, CENTER, RSTR(1), LR)
               WRITE (*, 130) '   Center of rotation = ', RSTR(1)(:LR)
            END IF
         ELSE IF (ITRANT .EQ. 64) THEN
            CONTINUE
         END IF

      ELSE IF (SHOTYP .EQ. 'MIRROR') THEN
         IF (XMIRR .EQ. -1.) THEN
            STRING = 'New X = - Old X'
            WRITE (*, 130) '   ', STRING(:LENSTR(STRING))
         END IF
         IF (YMIRR .EQ. -1.) THEN
            STRING = 'New Y = - Old Y'
            WRITE (*, 130) '   ', STRING(:LENSTR(STRING))
         END IF
         IF (ZMIRR .EQ. -1.) THEN
            STRING = 'New Z = - Old Z'
            WRITE (*, 130) '   ', STRING(:LENSTR(STRING))
         END IF

      ELSE IF (SHOTYP .EQ. 'OFFSET' .OR. SHOTYP .EQ. 'SHIFT') THEN
         RNUM(1) = XOFFS
         RNUM(2) = YOFFS
         RNUM(3) = ZOFFS
         CALL NUMSTR (3, 4, RNUM, RSTR, LR)
         WRITE (*, 130)
     &      'Coordinate offsets =', (' ', RSTR(I)(:LR), I=1,3)

      ELSE IF (SHOTYP .EQ. 'ZERO') THEN
         RNUM(1) = XZERO
         RNUM(2) = YZERO
         RNUM(3) = ZZERO
         CALL NUMSTR (3, 4, RNUM, RSTR, LR)
         WRITE (*, 130) 'Minimum nonzero coordinates =',
     *      (' ', RSTR(I)(:LR), I=1,3)

      ELSE IF (SHOTYP .EQ. 'SCALE') THEN
         RNUM(1) = XSCAL
         RNUM(2) = YSCAL
         RNUM(3) = ZSCAL
         CALL NUMSTR (3, 4, RNUM, RSTR, LR)
         WRITE (*, 130)
     &      'Coordinate scale factors =', (' ', RSTR(I)(:LR), I=1,3)

      ELSE IF (SHOTYP .EQ. 'REVOLVE') THEN
         IF (ROT3D) THEN
            WRITE (*, 130) 'Rotation matrix for generated mesh:'
            DO 30 I = 1, 3
               IX = (I-1) * 3
               DO 20 J = 1, 3
                  RNUM(IX+J) = ROTMAT(I,J)
   20          CONTINUE
   30       CONTINUE
            CALL NUMSTR (9, 4, RNUM, RSTR, LR)
            DO 40 I = 1, 3
               IX = (I-1) * 3
               WRITE (*, 130) ('   ', RSTR(IX+J)(:LR), J=1,3)
   40       CONTINUE
         ELSE
            WRITE (*, 130) 'No rotation defined for generated mesh'
         END IF

      ELSE IF (SHOTYP .EQ. 'REVCEN') THEN
         CALL NUMSTR (3, 4, ROTCEN, RSTR, LR)
         WRITE (*, 130)
     &      'Center of revolution =', (' ', RSTR(I)(:LR), I=1,3)
         IF (.NOT. ROT3D) THEN
            WRITE (*, 130) 'No revolution defined for generated mesh'
         END IF

      ELSE IF (SHOTYP .EQ. 'ROTCEN') THEN
         CALL NUMSTR (1, 4, CENTER, RSTR, LR)
         WRITE (*, 130)
     &      'Center of rotation = ',RSTR(1)(:LR)

      ELSE IF (SHOTYP .EQ. 'ROTAXIS') THEN
            if (rotax .eq. 0) then
              write (*, 130) 'Rotate about the Y Axis'
            else
              write (*, 130) 'Rotate about the X Axis'
            end if

      ELSE IF ((SHOTYP .EQ. 'BLOCK') .OR. (SHOTYP .EQ. 'CENTER')
     &   .OR. (SHOTYP .EQ. 'TUNNEL') .OR. (SHOTYP .EQ. 'SPECIAL'))
     &   THEN

         NCEN = 0
         NTUN = 0
         NSPEC = 0
         DO 70 IELB = 1, NELBLK
            WRITE (STRA, 50, IOSTAT=IDUM) IELB
 50         FORMAT ('(#', I5, ')')
            CALL PCKSTR (1, STRA)
            LSTRA = LENSTR (STRA)
            WRITE (*, 60, IOSTAT=IDUM)
     &         IDELB(IELB), STRA(:LSTRA), NUMELB(IELB), NUMLNK(IELB)
   60       FORMAT (1X, 'Block', I6, 1X, A, ':',
     &         I6, ' elements', I4, '-node')
            IF (BLKTYP(IELB) .EQ. ' ') THEN
               CONTINUE
            ELSE IF (BLKTYP(IELB) .EQ. 'C') THEN
               NCEN = NCEN + 1
            ELSE IF (BLKTYP(IELB) .EQ. 'T') THEN
               NTUN = NTUN + 1
            ELSE IF (BLKTYP(IELB) .EQ. 'S') THEN
               NSPEC = NSPEC + 1
            END IF
   70    CONTINUE

         IF ((NCEN .GT. 0) .AND. (NUMCOL .GT. 0)) THEN
            WRITE (*, *)
            WRITE (*, 130) 'Rotation Center Block IDs:'
            N = 0
            STRING = ' '
            DO 80 IELB = 1, NELBLK
               IF (BLKTYP(IELB) .EQ. 'C') THEN
                  N = N + 1
                  WRITE (STRING((N-1)*6+1:N*6), '(I6)', IOSTAT=IDUM)
     &               IDELB(IELB)
                  IF (N .GE. 12) THEN
                     WRITE (*, 130) '   ', STRING(:LENSTR(STRING))
                     N = 0
                     STRING = ' '
                  END IF
               END IF
   80       CONTINUE
            IF (N .GT. 0) THEN
               WRITE (*, 130) '   ', STRING(:LENSTR(STRING))
            END IF
         END IF

         IF (NTUN .GT. 0) THEN
            WRITE (*, *)
            DO 110 IELB = 1, NELBLK
               IF (BLKTYP(IELB) .EQ. 'T') THEN
                  IF (IBPARM(2,IELB) .GT. 0) THEN
                     WRITE (STRB, '(I5)', IOSTAT=IDUM) IBPARM(2,IELB)
                     WRITE (STRING, 90)
     &                  IBPARM(1,IELB), STRB(:5), IBPARM(3,IELB)
                  ELSE
                     WRITE (STRING, 90)
     &                  IBPARM(1,IELB), 'end', IBPARM(3,IELB)
                  END IF
   90             FORMAT ('Tunnel from step ', I5, ' to ', A,
     &               ', changes every ', I5, ' step')
                  CALL SQZSTR (STRING, LSTR)
                  WRITE (*, 100) IDELB(IELB), STRING(:LSTR)
  100             FORMAT (1X, 'Block', I5, ' (ID):', 2X, A)
               END IF
  110       CONTINUE
         END IF

         IF (NSPEC .GT. 0) THEN
            WRITE (*, *)
            WRITE (*, 130) 'Special Block IDs:'
            N = 0
            STRING = ' '
            DO 120 IELB = 1, NELBLK
               IF (BLKTYP(IELB) .EQ. 'S') THEN
                  N = N + 1
                  WRITE (STRING((N-1)*6+1:N*6), '(I6)', IOSTAT=IDUM)
     &               IDELB(IELB)
                  IF (N .GE. 12) THEN
                     WRITE (*, 130) '   ', STRING(:LENSTR(STRING))
                     N = 0
                     STRING = ' '
                  END IF
               END IF
  120       CONTINUE
            IF (N .GT. 0) THEN
               WRITE (*, 130) '   ', STRING(:LENSTR(STRING))
            END IF
         END IF

      ELSE IF ((SHOTYP .EQ. 'NSETS') .OR. (SHOTYP .EQ. 'NODESETS')) THEN
         WRITE (*, 140, IOSTAT=IDUM)
     &      'IDs for INPUT node sets',
     &      (IDNPS(I), I=1,NUMNPS)
         WRITE (*, 140, IOSTAT=IDUM)
     &      'IDs for FRONT node sets',
     &      (IDNSET(I,1), I=1,IDNSET(0,1))
         WRITE (*, 140, IOSTAT=IDUM)
     &      'IDs for BACK node sets',
     &      (IDNSET(I,2), I=1,IDNSET(0,2))

      ELSE IF ((SHOTYP .EQ. 'SSETS') .OR. (SHOTYP .EQ. 'SIDESETS')) THEN
         WRITE (*, 140, IOSTAT=IDUM)
     &      'IDs for INPUT side sets',
     &      (IDESS(I), I=1,NUMESS)
         WRITE (*, 140, IOSTAT=IDUM)
     &      'IDs for FRONT side sets',
     &      (IDESET(I,1), I=1,IDESET(0,1))
         WRITE (*, 140, IOSTAT=IDUM)
     &      'IDs for BACK side sets',
     &      (IDESET(I,2), I=1,IDESET(0,2))

      ELSE IF (SHOTYP .EQ. 'VARS') THEN
         CALL DBPINI ('TIS', NDBIN, TITLE, NDIM, NUMNP, NUMEL, NELBLK,
     &      NUMNPS, LNPSNL, LNPSNL, NUMESS, LESSEL, LESSNL, LESSNL,
     &      IDUM, IDUM, IDUM, ' ')

      ELSE IF (SHOTYP .EQ. ' ') THEN
        CALL SHOCMD ('LIST/SHOW Options', SHOTBL)
      ELSE
         CALL PRTERR ('CMDWARN', 'Invalid SHOW option')
      END IF

      RETURN
  130 FORMAT (1X, 10A)
  140 FORMAT (1X, A, ':', T36, 5I6, :, /, (1X, 15I6))
      END
