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.
279 lines
9.4 KiB
279 lines
9.4 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 (TYPE, CMDTBL, NAMECO, BLKTYP, NAMES, TIMES,
|
||
|
& IPTIMS, IDELB, VISELB, SELELB)
|
||
|
C=======================================================================
|
||
|
|
||
|
C --*** SHOW *** (ALGEBRA) Display ALGEBRA information
|
||
|
C -- Written by Amy Gilkey - revised 05/18/88
|
||
|
C --
|
||
|
C --SHOW prints out the requested information.
|
||
|
C --
|
||
|
C --Parameters:
|
||
|
C -- TYPE - IN - the type of SHOW requested (none, VARS)
|
||
|
C -- CMDTBL - IN - the table of valid SHOW options; if empty, show if
|
||
|
C -- not equal to default only
|
||
|
C -- NAMECO - IN - the coordinate names
|
||
|
C -- BLKTYP - IN - the element block names
|
||
|
C -- NAMES - IN - the global, nodal, and element variable names
|
||
|
C -- TIMES - IN - the database time steps
|
||
|
C -- IPTIMS - IN - the selected times steps
|
||
|
C -- IDELB - IN - the element block IDs
|
||
|
C -- VISELB(i) - IN - true iff element block i is to be written
|
||
|
C -- SELELB(i) - IN - true iff element block i is selected
|
||
|
C --
|
||
|
C --Common Variables:
|
||
|
C -- Uses IXLHS, NAMVAR, ISTVAR of /VAR../
|
||
|
C -- Uses NUMALI, NAMALI, NIXALI, IXALI of /ALIAS../
|
||
|
C -- Uses NDBIN of /DBASE/
|
||
|
C -- Uses TITLE, TITLEO of /DBTITL/
|
||
|
C -- Uses NDIM, NUMNP, NUMEL, NELBLK, NVARNP, NVAREL, NVARGL
|
||
|
C -- of /DBNUMS/
|
||
|
C -- Uses NPTIMS, TMIN, TMAX, DELT, NINTV, WHONLY of /TIMES/
|
||
|
C -- Uses ISZOOM, ZMLIM of /ZOOM/
|
||
|
|
||
|
include 'exodusII.inc'
|
||
|
include 'ag_namlen.blk'
|
||
|
include 'ag_numeqn.blk'
|
||
|
include 'ag_var.blk'
|
||
|
include 'ag_alias.blk'
|
||
|
include 'ag_dbase.blk'
|
||
|
include 'ag_dbtitl.blk'
|
||
|
include 'ag_dbnums.blk'
|
||
|
include 'ag_dbnumg.blk'
|
||
|
include 'ag_dbnumq.blk'
|
||
|
include 'ag_times.blk'
|
||
|
include 'ag_zoom.blk'
|
||
|
include 'ag_filter.blk'
|
||
|
include 'ag_remove.blk'
|
||
|
|
||
|
PARAMETER (ICURTM = 1, ILSTTM = 2, IONETM = 3)
|
||
|
|
||
|
CHARACTER*(*) TYPE
|
||
|
CHARACTER*(*) CMDTBL(*)
|
||
|
CHARACTER*(namlen) NAMECO(*)
|
||
|
CHARACTER*(MXSTLN) BLKTYP(*)
|
||
|
CHARACTER*(namlen) NAMES(*)
|
||
|
REAL TIMES(*)
|
||
|
INTEGER IPTIMS(*)
|
||
|
INTEGER IDELB(*)
|
||
|
LOGICAL VISELB(NELBLK)
|
||
|
LOGICAL SELELB(NELBLK)
|
||
|
|
||
|
LOGICAL IFDEF
|
||
|
CHARACTER*(MXSTLN) SHOTYP
|
||
|
CHARACTER*(MAXNAM) STRING
|
||
|
CHARACTER*20 RSTR(6)
|
||
|
INTEGER INAM(MAXVAR)
|
||
|
|
||
|
IFDEF = (CMDTBL(1) .NE. ' ')
|
||
|
IF (CMDTBL(1) .NE. ' ') THEN
|
||
|
CALL ABRSTR (SHOTYP, TYPE, CMDTBL)
|
||
|
IF (SHOTYP .EQ. ' ') SHOTYP = TYPE
|
||
|
ELSE
|
||
|
SHOTYP = TYPE
|
||
|
END IF
|
||
|
|
||
|
IF (SHOTYP .EQ. 'TITLE') THEN
|
||
|
WRITE (*, 10030) 'Output database title:'
|
||
|
WRITE (*, 10030) TITLEO(:LENSTR(TITLEO))
|
||
|
ELSE IF (SHOTYP .EQ. 'SAVE') THEN
|
||
|
N = 0
|
||
|
DO 100 IVAR = MAXVAR, IXLHS, -1
|
||
|
IF (ISTVAR(ICURTM,IVAR) .EQ. -2) THEN
|
||
|
N = N + 1
|
||
|
INAM(N) = IVAR
|
||
|
END IF
|
||
|
100 CONTINUE
|
||
|
IF (N .GT. 0) THEN
|
||
|
WRITE (*, 10030) 'SAVEd variables:'
|
||
|
WRITE (*, 10000) (NAMVAR(INAM(I))(:namlen), I=1,N)
|
||
|
10000 FORMAT ((12X, 2(A, :, 1X)))
|
||
|
ELSE IF (IFDEF) THEN
|
||
|
WRITE (*, 10030) 'There are no SAVEd variables'
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (SHOTYP .EQ. 'DELETE') THEN
|
||
|
N = 0
|
||
|
DO 110 IVAR = MAXVAR, IXLHS, -1
|
||
|
IF (ISTVAR(ICURTM,IVAR) .EQ. -1) THEN
|
||
|
N = N + 1
|
||
|
INAM(N) = IVAR
|
||
|
END IF
|
||
|
110 CONTINUE
|
||
|
IF (N .GT. 0) THEN
|
||
|
maxn = 0
|
||
|
do i=1, n
|
||
|
k = lenstr(namvar(inam(i)))
|
||
|
if (k .gt. maxn) maxn = k
|
||
|
end do
|
||
|
WRITE (*, 10030) 'Temporary variables:'
|
||
|
WRITE (*, 10000) (NAMVAR(INAM(I))(:maxn), I=1,N)
|
||
|
ELSE IF (IFDEF) THEN
|
||
|
WRITE (*, 10030) 'There are no temporary variables'
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (SHOTYP .EQ. 'ALIAS') THEN
|
||
|
IF (NUMALI .GT. 0) THEN
|
||
|
WRITE (*, 10030) 'Defined aliases:'
|
||
|
END IF
|
||
|
DO 120 IALI = 1, NUMALI
|
||
|
WRITE (STRING, 10010)
|
||
|
& NAMALI(IALI), (NAMES(IXALI(J,IALI)), J=1,NIXALI(IALI))
|
||
|
10010 FORMAT (A, ' = ', 10 (A, ' '))
|
||
|
CALL SQZSTR (STRING, LSTR)
|
||
|
WRITE (*, 10030) ' ', STRING(:LSTR)
|
||
|
120 CONTINUE
|
||
|
|
||
|
ELSE IF ((SHOTYP .EQ. 'TMIN') .OR. (SHOTYP .EQ. 'TMAX')
|
||
|
& .OR. (SHOTYP .EQ. 'DELTIME')
|
||
|
& .OR. (SHOTYP .EQ. 'NINTV') .OR. (SHOTYP .EQ. 'ZINTV')
|
||
|
& .OR. (SHOTYP .EQ. 'ALLTIMES')
|
||
|
& .OR. (SHOTYP .EQ. 'STEPS') .OR. (SHOTYP .EQ. 'TIMES')) THEN
|
||
|
|
||
|
IF (IFDEF .OR. (NPTIMS .NE. NSTEPS)) THEN
|
||
|
CALL SHOTSP (TMIN, TMAX, DELT, NINTV, NPTIMS)
|
||
|
END IF
|
||
|
|
||
|
IF (((SHOTYP .EQ. 'STEPS') .OR. (SHOTYP .EQ. 'TIMES'))
|
||
|
& .AND. (NPTIMS .GT. 0)) THEN
|
||
|
CALL SHPTIM (NPTIMS, IPTIMS, TIMES)
|
||
|
END IF
|
||
|
else if ((shotyp .eq. 'PTIME') .or. (shotyp .eq. 'PTIMES')) then
|
||
|
call prterr ('CMDREQ', 'Please use SHOW TIMES')
|
||
|
|
||
|
ELSE IF (SHOTYP .EQ. 'ZOOM') THEN
|
||
|
IF (ISZOOM) THEN
|
||
|
CALL NUMSTR (MIN(3,NDIM)*2, 4, ZMLIM, RSTR, LSTR)
|
||
|
WRITE (STRING, 10020) (RSTR(I)(:LSTR), I=1,MIN(3,NDIM)*2)
|
||
|
10020 FORMAT (6 (A, ' '))
|
||
|
CALL SQZSTR (STRING, LSTR)
|
||
|
if (zoomin) then
|
||
|
rstr(1) = ' Retain Inside'
|
||
|
else
|
||
|
rstr(1) = ' Retain Outside'
|
||
|
end if
|
||
|
WRITE (*, 10030) 'Zoomed mesh: ', STRING(:LSTR), rstr(1)
|
||
|
ELSE IF (IFDEF) THEN
|
||
|
WRITE (*, 10030) 'Zoomed mesh is not defined'
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (SHOTYP .EQ. 'FILTER') THEN
|
||
|
IF (ISFILTER) THEN
|
||
|
CALL NUMSTR1 (4, VALFLT, RSTR(1), LSTR1)
|
||
|
CALL NUMSTR1 (4, TIMFLT, RSTR(2), LSTR2)
|
||
|
if (cmpflt .eq. 1) RSTR(3) = 'lt'
|
||
|
if (cmpflt .eq. 2) RSTR(3) = 'le'
|
||
|
if (cmpflt .eq. 3) RSTR(3) = 'eq'
|
||
|
if (cmpflt .eq. 4) RSTR(3) = 'ne'
|
||
|
if (cmpflt .eq. 5) RSTR(3) = 'gt'
|
||
|
if (cmpflt .eq. 6) RSTR(3) = 'ge'
|
||
|
|
||
|
CALL DBVIX('E', 1, IEV)
|
||
|
WRITE (*, 10030) 'Remove elements with ',
|
||
|
* names(idxflt+iev-1)(:lenstr(names(idxflt+iev-1))),
|
||
|
* ' ',RSTR(3)(:2), ' ',RSTR(1)(:LSTR1),' at time ',
|
||
|
* RSTR(2)(:LSTR2)
|
||
|
ELSE IF (IFDEF) THEN
|
||
|
WRITE (*, 10030) 'Filtering is not defined'
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (SHOTYP .EQ. 'REMOVE') THEN
|
||
|
if (idsglobal) then
|
||
|
rstr(1) = 'GLOBAL'
|
||
|
else
|
||
|
rstr(1) = 'LOCAL'
|
||
|
end if
|
||
|
IF (ISREMOVE) THEN
|
||
|
write (*, 10040) rstr(1)(:lenstr(rstr(1))),
|
||
|
* (idsrem(i),i=1,irmcnt)
|
||
|
ELSE IF (IFDEF) THEN
|
||
|
WRITE (*, 10030) 'Removal by element id is not defined'
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (SHOTYP .EQ. 'VISIBLE') THEN
|
||
|
NVIS = NUMEQL (.TRUE., NELBLK, VISELB)
|
||
|
IF (NVIS .LT. NELBLK) THEN
|
||
|
if (NVIS .GT. 0) then
|
||
|
WRITE (*, 10030) 'Write elements of element blocks: '
|
||
|
else
|
||
|
WRITE(*,*) 'Element blocks are not visible'
|
||
|
endif
|
||
|
ELSE IF (IFDEF) THEN
|
||
|
WRITE (*, 10030) 'Write elements of ALL element blocks: '
|
||
|
END IF
|
||
|
|
||
|
if (NVIS .GT. 0) THEN
|
||
|
N = 0
|
||
|
STRING = ' '
|
||
|
DO 130 IELB = 1, NELBLK
|
||
|
IF (VISELB(IELB)) THEN
|
||
|
N = N + 1
|
||
|
WRITE (STRING((N-1)*6+1:N*6), '(I5, 1X)')
|
||
|
& IDELB(IELB)
|
||
|
if ((n+1)*6 .gt. 80) THEN
|
||
|
lstr = lenstr(string)
|
||
|
write (*,10030) ' ',string(:lstr)
|
||
|
N = 0
|
||
|
STRING = ' '
|
||
|
end if
|
||
|
END IF
|
||
|
130 CONTINUE
|
||
|
if (n .gt. 0) then
|
||
|
lstr = lenstr(string)
|
||
|
write (*,10030) ' ',string(:lstr)
|
||
|
end if
|
||
|
END IF
|
||
|
|
||
|
ELSE IF ((SHOTYP .EQ. 'BLOCKS')
|
||
|
& .OR. (SHOTYP .EQ. 'MATERIAL')) THEN
|
||
|
NSEL = NUMEQL (.TRUE., NELBLK, SELELB)
|
||
|
IF (NSEL .LT. NELBLK) THEN
|
||
|
WRITE (*, 10030) 'Selected element blocks: '
|
||
|
ELSE IF (IFDEF) THEN
|
||
|
WRITE (*, 10030) 'ALL element blocks selected: '
|
||
|
END IF
|
||
|
|
||
|
if (nsel .gt. 0) then
|
||
|
N = 0
|
||
|
STRING = ' '
|
||
|
DO 140 IELB = 1, NELBLK
|
||
|
IF (SELELB(IELB)) THEN
|
||
|
N = N + 1
|
||
|
WRITE (STRING((N-1)*6+1:N*6), '(I5, 1X)')
|
||
|
& IDELB(IELB)
|
||
|
if ((n+1)*6 .gt. 80) THEN
|
||
|
lstr = lenstr(string)
|
||
|
write (*,10030) ' ',string(:lstr)
|
||
|
N = 0
|
||
|
STRING = ' '
|
||
|
end if
|
||
|
END IF
|
||
|
140 CONTINUE
|
||
|
if (n .gt. 0) then
|
||
|
lstr = lenstr(string)
|
||
|
write (*,10030) ' ',string(:lstr)
|
||
|
end if
|
||
|
end if
|
||
|
|
||
|
ELSE IF ((SHOTYP .EQ. 'LOG')
|
||
|
& .OR. (SHOTYP .EQ. 'LIST') .OR. (SHOTYP .EQ. 'SHOW')
|
||
|
& .OR. (SHOTYP .EQ. 'HELP')
|
||
|
& .OR. (SHOTYP .EQ. 'END') .OR. (SHOTYP .EQ. 'EXIT')
|
||
|
& .OR. (SHOTYP .EQ. 'QUIT')) THEN
|
||
|
CALL PRTERR ('CMDERR',
|
||
|
& 'SHOW is not available for this command')
|
||
|
|
||
|
ELSE
|
||
|
CALL SHOCMD ('SHOW Options:', CMDTBL)
|
||
|
END IF
|
||
|
|
||
|
RETURN
|
||
|
10030 FORMAT (1X, 10A)
|
||
|
10040 FORMAT (1X, 'Remove elements with ',A,' ids: ',:,/,(10I10))
|
||
|
END
|