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