You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
410 lines
14 KiB
410 lines
14 KiB
2 years ago
|
C Copyright(C) 1999-2020 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 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)
|
||
|
RNUM(1) = DIM3
|
||
|
RNUM(2) = RGRAD
|
||
|
CALL NUMSTR (2, 4, RNUM, 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
|
||
|
WRITE (*, 130) 'Rotate mesh ', STRA(:LSTRA),
|
||
|
& ' times for a total of ', RSTR(1)(:LR), ' degrees',
|
||
|
& ' with a gradient of ', RSTR(2)(:LR)
|
||
|
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 NUMSTR1 (4, CENTER, RSTR(1), LR)
|
||
|
WRITE (*, 130) ' Center of rotation = ', RSTR(1)(:LR)
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (ITRANT .EQ. 4) THEN
|
||
|
CALL NUMSTR1 (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 NUMSTR1 (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 NUMSTR1 (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
|