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.
350 lines
11 KiB
350 lines
11 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 DBSEL (A, IA, INLINE,
|
||
|
|
& SELTYP, 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)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** DBSEL *** (BLOT) Process SELECT commands
|
||
|
|
C -- Written by Amy Gilkey - revised 03/07/88
|
||
|
|
C --
|
||
|
|
C --DBSEL inputs and executes a SELECT command.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- A - IN - the dynamic memory base array
|
||
|
|
C -- INLINE - IN/OUT - the parsed input lines for the log file
|
||
|
|
C -- SELTYP - IN - the selection type
|
||
|
|
C -- IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field
|
||
|
|
C -- reader index and fields
|
||
|
|
C -- NAMES - IN - the variable names
|
||
|
|
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 -- IDELB - IN - the element block ID for each block
|
||
|
|
C -- LENE - IN - the cumulative element counts by element block
|
||
|
|
C -- IDNPS - IN - the node set ID for each set
|
||
|
|
C -- IDESS - IN - the side set ID for each set
|
||
|
|
C -- NCSTEP - IN/OUT - the current step number for display
|
||
|
|
C -- LISNP - IN/OUT - the indices of the selected coordinates
|
||
|
|
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 NDIM, NUMNP, NUMEL, NELBLK, NVARHI, NVARGL, NVARNP, NVAREL,
|
||
|
|
C -- NSTEPS of /DBNUMS/
|
||
|
|
C -- Uses NUMNPS, NUMESS of /DBNUMG/
|
||
|
|
|
||
|
|
include 'params.blk'
|
||
|
|
include 'dbnums.blk'
|
||
|
|
include 'dbnumgq.blk'
|
||
|
|
|
||
|
|
DIMENSION A(*)
|
||
|
|
INTEGER IA(*)
|
||
|
|
|
||
|
|
CHARACTER*(*) INLINE(*)
|
||
|
|
CHARACTER*(*) SELTYP
|
||
|
|
INTEGER INTYP(*)
|
||
|
|
CHARACTER*(*) CFIELD(*)
|
||
|
|
INTEGER IFIELD(*)
|
||
|
|
REAL RFIELD(*)
|
||
|
|
CHARACTER*(*) NAMES(*)
|
||
|
|
REAL TIMES(*)
|
||
|
|
LOGICAL WHOTIM(*)
|
||
|
|
INTEGER IPTIMS(*)
|
||
|
|
INTEGER IDELB(*)
|
||
|
|
INTEGER LENE(0:*)
|
||
|
|
INTEGER IDNPS(*)
|
||
|
|
INTEGER IDESS(*)
|
||
|
|
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(*)
|
||
|
|
|
||
|
|
CHARACTER*(MXSTLN) STYP
|
||
|
|
|
||
|
|
LOGICAL FIRST
|
||
|
|
SAVE FIRST
|
||
|
|
C --FIRST - true iff first time through routine
|
||
|
|
|
||
|
|
CHARACTER*(MXSTLN) CMDTBL(14)
|
||
|
|
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 'NODES ', 'ELEMENTS', 'BLOCKS ', 'MATERIAL',
|
||
|
|
2 'NSETS ', 'SSETS ',
|
||
|
|
3 'HVARS ', 'GVARS ', 'NVARS ', 'EVARS ',
|
||
|
|
4 'READ ', 'STEP ', 'TIME ',
|
||
|
|
5 ' ' /
|
||
|
|
|
||
|
|
C --Get the command STYP
|
||
|
|
|
||
|
|
CALL ABRSTR (STYP, SELTYP, CMDTBL)
|
||
|
|
IF (STYP .EQ. ' ') STYP = SELTYP
|
||
|
|
|
||
|
|
C *** Initialization ***
|
||
|
|
|
||
|
|
C --Reset parameters
|
||
|
|
|
||
|
|
IF (FIRST .OR. (STYP .EQ. 'RESET')) THEN
|
||
|
|
|
||
|
|
LISNP(0) = NUMNP
|
||
|
|
DO 100 I = 1, NUMNP
|
||
|
|
LISNP(I) = I
|
||
|
|
100 CONTINUE
|
||
|
|
NLISEL(0) = NELBLK
|
||
|
|
DO 110 I = 1, NELBLK
|
||
|
|
NLISEL(I) = LENE(I) - LENE(I-1)
|
||
|
|
110 CONTINUE
|
||
|
|
LISEL(0) = NUMEL
|
||
|
|
DO 120 I = 1, NUMEL
|
||
|
|
LISEL(I) = I
|
||
|
|
120 CONTINUE
|
||
|
|
LISNPS(0) = NUMNPS
|
||
|
|
DO 130 I = 1, NUMNPS
|
||
|
|
LISNPS(I) = I
|
||
|
|
130 CONTINUE
|
||
|
|
LISESS(0) = NUMESS
|
||
|
|
DO 140 I = 1, NUMESS
|
||
|
|
LISESS(I) = I
|
||
|
|
140 CONTINUE
|
||
|
|
IF (EXODUS) THEN
|
||
|
|
LISHV(0) = NVARHI
|
||
|
|
DO 150 I = 1, NVARHI
|
||
|
|
LISHV(I) = I
|
||
|
|
150 CONTINUE
|
||
|
|
LISGV(0) = NVARGL
|
||
|
|
DO 160 I = 1, NVARGL
|
||
|
|
LISGV(I) = I
|
||
|
|
160 CONTINUE
|
||
|
|
LISNV(0) = NVARNP
|
||
|
|
DO 170 I = 1, NVARNP
|
||
|
|
LISNV(I) = I
|
||
|
|
170 CONTINUE
|
||
|
|
LISEV(0) = NVAREL
|
||
|
|
DO 180 I = 1, NVAREL
|
||
|
|
LISEV(I) = I
|
||
|
|
180 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
NCSTEP = MIN (1, NSTEPS)
|
||
|
|
|
||
|
|
FIRST = .FALSE.
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF ((STYP .EQ. 'RESET') .OR. (STYP .EQ. 'reset')) GOTO 230
|
||
|
|
|
||
|
|
C *** GENESIS Print Commands ***
|
||
|
|
|
||
|
|
IF (STYP .EQ. 'NODES') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKNONE (NUMNP, .FALSE., 'nodes', *220)
|
||
|
|
|
||
|
|
CALL RMIXINT (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
||
|
|
& 'node number', NUMNP, LISNP(0), LISNP(1), MAPND, *220)
|
||
|
|
|
||
|
|
IF (LISNP(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (LISNP(0), NUMNP, 'nodes')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (STYP .EQ. 'ELEMENTS') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKNONE (NUMEL, .FALSE., 'elements', *220)
|
||
|
|
|
||
|
|
CALL MDRSRV ('SCRSEL', KLEL, 1+NUMEL)
|
||
|
|
CALL MDSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) GOTO 220
|
||
|
|
|
||
|
|
CALL RMIXINT (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
||
|
|
& 'element number', NUMEL, IA(KLEL), IA(KLEL+1), MAPEL, *190)
|
||
|
|
190 CONTINUE
|
||
|
|
|
||
|
|
CALL DBSBEL (NELBLK, NUMEL, LENE, A(KLEL), NLISEL, LISEL)
|
||
|
|
|
||
|
|
CALL MDDEL ('SCRSEL')
|
||
|
|
|
||
|
|
IF (NLISEL(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (NLISEL(0), NELBLK, 'element blocks')
|
||
|
|
CALL PRNSEL (LISEL(0), NUMEL, 'elements')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF ((STYP .EQ. 'BLOCKS') .OR. (STYP .EQ. 'MATERIAL')) THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKNONE (NELBLK, .FALSE., 'element blocks', *220)
|
||
|
|
|
||
|
|
CALL MDRSRV ('SCRSEL', KLELB, 1+NELBLK)
|
||
|
|
CALL MDSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) GOTO 220
|
||
|
|
|
||
|
|
CALL RIXID (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
||
|
|
& 'element block ID',
|
||
|
|
& NELBLK, IDELB, IA(KLELB), IA(KLELB+1), *200)
|
||
|
|
200 CONTINUE
|
||
|
|
|
||
|
|
CALL DBSELB (NELBLK, NUMEL, LENE, A(KLELB), NLISEL, LISEL)
|
||
|
|
|
||
|
|
CALL MDDEL ('SCRSEL')
|
||
|
|
|
||
|
|
IF (NLISEL(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (NLISEL(0), NELBLK, 'element blocks')
|
||
|
|
CALL PRNSEL (LISEL(0), NUMEL, 'elements')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (STYP .EQ. 'NSETS') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKNONE (NUMNPS, .FALSE., 'node sets', *220)
|
||
|
|
|
||
|
|
CALL RIXID (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
||
|
|
& 'node set ID',
|
||
|
|
& NUMNPS, IDNPS, LISNPS(0), LISNPS(1), *220)
|
||
|
|
|
||
|
|
IF (LISNPS(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (LISNPS(0), NUMNPS, 'node sets')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (STYP .EQ. 'SSETS') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKNONE (NUMESS, .FALSE., 'side sets', *220)
|
||
|
|
|
||
|
|
CALL RIXID (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
||
|
|
& 'side set ID',
|
||
|
|
& NUMESS, IDESS, LISESS(0), LISESS(1), *220)
|
||
|
|
|
||
|
|
IF (LISESS(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (LISESS(0), NUMESS, 'side sets')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C *** EXODUS Print Commands ***
|
||
|
|
|
||
|
|
ELSE IF (STYP .EQ. 'HVARS') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKEXOD (EXODUS, *220)
|
||
|
|
CALL CKNONE (NVARHI, .FALSE., 'history variables', *220)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('H', 1, IXHV)
|
||
|
|
|
||
|
|
CALL RIXWRD (INLINE(1), IFLD, INTYP, CFIELD,
|
||
|
|
& 'history variable name', NVARHI, NAMES(IXHV),
|
||
|
|
& LISHV(0), LISHV(1), *220)
|
||
|
|
|
||
|
|
IF (LISHV(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (LISHV(0), NVARHI, 'history variables')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (STYP .EQ. 'GVARS') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKEXOD (EXODUS, *220)
|
||
|
|
CALL CKNONE (NVARGL, .FALSE., 'global variables', *220)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('G', 1, IXGV)
|
||
|
|
|
||
|
|
CALL RIXWRD (INLINE(1), IFLD, INTYP, CFIELD,
|
||
|
|
& 'global variable name', NVARGL, NAMES(IXGV),
|
||
|
|
& LISGV(0), LISGV(1), *220)
|
||
|
|
|
||
|
|
IF (LISGV(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (LISGV(0), NVARGL, 'global variables')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (STYP .EQ. 'NVARS') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKEXOD (EXODUS, *220)
|
||
|
|
CALL CKNONE (NVARNP, .FALSE., 'nodal variables', *220)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('N', 1, IXNV)
|
||
|
|
|
||
|
|
CALL RIXWRD (INLINE(1), IFLD, INTYP, CFIELD,
|
||
|
|
& 'nodal variable name', NVARNP, NAMES(IXNV),
|
||
|
|
& LISNV(0), LISNV(1), *220)
|
||
|
|
|
||
|
|
IF (LISNV(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (LISNV(0), NVARNP, 'nodal variables')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (STYP .EQ. 'EVARS') THEN
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKEXOD (EXODUS, *220)
|
||
|
|
CALL CKNONE (NVAREL, .FALSE., 'element variables', *220)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('E', 1, IXEV)
|
||
|
|
|
||
|
|
CALL RIXWRD (INLINE(1), IFLD, INTYP, CFIELD,
|
||
|
|
& 'element variable name', NVAREL, NAMES(IXEV),
|
||
|
|
& LISEV(0), LISEV(1), *220)
|
||
|
|
|
||
|
|
IF (LISEV(0) .GT. 0) THEN
|
||
|
|
CALL PRNSEL (LISEV(0), NVAREL, 'element variables')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C *** EXODUS Movement Commands ***
|
||
|
|
|
||
|
|
ELSE IF ((STYP .EQ. 'READ') .OR. (STYP .EQ. 'STEP')
|
||
|
|
& .OR. (STYP .EQ. 'TIME')) THEN
|
||
|
|
nstep = 0
|
||
|
|
CALL FFADDC (STYP, INLINE(1))
|
||
|
|
CALL CKEXOD (EXODUS, *220)
|
||
|
|
CALL CKNONE (NSTEPS, .FALSE., 'time steps', *220)
|
||
|
|
|
||
|
|
IF (STYP .EQ. 'READ') THEN
|
||
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
|
& 'number of steps to read', 1, N, *210)
|
||
|
|
CALL FFADDI (N, INLINE(1))
|
||
|
|
NSTEP = MAX (1, NCSTEP + N)
|
||
|
|
ELSE IF (STYP .EQ. 'STEP') THEN
|
||
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
|
& 'step number', NCSTEP, N, *210)
|
||
|
|
CALL FFADDI (N, INLINE(1))
|
||
|
|
NSTEP = N
|
||
|
|
ELSE IF (STYP .EQ. 'TIME') THEN
|
||
|
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
||
|
|
& 'time step time', TIMES(NCSTEP), T, *210)
|
||
|
|
CALL FFADDR (T, INLINE(1))
|
||
|
|
NSTEP = LOCREA (T, NSTEPS, TIMES)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
NCSTEP = NSTEP
|
||
|
|
IF (NCSTEP .GT. NSTEPS) THEN
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'All time steps have been read from the database')
|
||
|
|
NCSTEP = NSTEPS
|
||
|
|
END IF
|
||
|
|
|
||
|
|
210 CONTINUE
|
||
|
|
CALL PRSTEP ('*', -1,
|
||
|
|
& TIMES(NCSTEP), WHOTIM(NCSTEP), NCSTEP, NSTEPS)
|
||
|
|
|
||
|
|
ELSE IF (STYP .NE. 'RESET') THEN
|
||
|
|
CALL SHOCMD ('SELECT Options:', CMDTBL)
|
||
|
|
GOTO 220
|
||
|
|
END IF
|
||
|
|
|
||
|
|
GOTO 230
|
||
|
|
|
||
|
|
220 CONTINUE
|
||
|
|
INLINE(1) = ' '
|
||
|
|
|
||
|
|
230 CONTINUE
|
||
|
|
RETURN
|
||
|
|
END
|