Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.

522 lines
16 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 SPCOMD (A, INLINE,
& INVERB, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
& NAMES, LENE, NLNKE, LINKE, XN, YN, ZN, XE, YE, ZE,
& ISEVOK, IE2ELB, NENUM, LIDSP, MAPEL, MAPND, NAMLEN)
C=======================================================================
C --*** SPCOMD *** (SPLOT) Process SPLOT commands
C -- Modified by John Glick - 11/1/88
C -- Written by Amy Gilkey - revised 05/31/88
C --
C --SPCOMD interprets SPLOT commands.
C --
C --The commands are listed below with their parameters and their
C --function.
C --
C --Plot curve selection
C -- ADD Save plot curves, otherwise a new plot set
C -- is started if a curve is defined
C -- REMOVE {n} Delete plot curve n
C -- SYPLOT {variable} Specify plot variable
C -- variable Specify time plot
C -- NODES {# range} Select node numbers
C -- ELEMENTS {# range} Select element numbers
C --
C --Display Control
C -- DISPVAR [ADD] {var1,...} Selects history variables, global
C -- variables, and/or TIME whose values
C -- will be displayed on the plot legend.
C --
C --Display
C -- reset Reset plot parameters
C -- postmesh Initialize after mesh plot
C -- postplot Initialize after plot
C -- initprog Initialize for program change
C -- initres Initialize for program change and reset
C -- PLOT Exit to plot the plot set
C -- HARDCOPY Exit to plot the plot set on hardcopy device
C -- NEUTRAL Exit to write the plot set to neutral file
C --
C --Mesh Display
C -- ECHO Plot mesh with selected nodes/elements
C --
C --Information
C -- show {option} Display plot parameters and information
C -- help {option} Display system dependent HELP
C --
C --This routine uses MDFIND to find the following dynamic memory arrays:
C -- IPATH - optimization information for FNDPTH
C --
C --Parameters:
C -- A - IN - the dynamic memory base array
C -- INLINE - IN/OUT - the parsed input lines for the log file
C -- INVERB - IN/OUT - the command verb
C -- IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field
C -- reader index and fields
C -- NAMES - IN - the variable names
C -- LENE - IN - the cumulative element counts by element block
C -- NLNKE - IN - the number of nodes per element
C -- LINKE - IN - the element connectivity
C -- XN, YN, ZN - IN - the nodal mesh coordinates
C -- XE, YE, ZE - IN - the element centroid mesh coordinates
C -- ISEVOK - IN - the element block variable truth table;
C -- variable i of block j exists iff ISEVOK(j,i)
C -- IE2ELB - IN - the element block for each element
C -- NENUM - IN/OUT - the selected node/element numbers
C -- LIDSP(0:*) - IN/OUT - the indices of the selected variables
C -- whose values will be displayed on the plot legend.
C -- LIDSP(0) = the number of variables in the list.
C -- LIDSP(i) identifies the ith variable in the list.
C -- If LIDSP(i) > 0, LIDSP(i) is the id of a history variable.
C -- If LIDSP(i) < 0, -LIDSP(i) is the id of a global variable.
C -- If LIDSP(i) = 0, TIME is to be displayed on the plot legend.
C --
C --Common Variables:
C -- Uses NVARNP, NVAREL of /DBNUMS/
C -- Uses NPTIMS of /TIMES/
C -- Sets NTIMIN, HISTOK of /TIMES/
C -- Sets NODVAR, NNENUM of /SELNE/
C -- Sets NSPVAR of /SPVARS/
C -- Sets OVERLY, OVERTM of /XYOPT/
include 'params.blk'
include 'dbnums.blk'
include 'times.blk'
include 'selne.blk'
include 'spvars.blk'
include 'xyopt.blk'
DIMENSION A(*)
CHARACTER*(*) INLINE(*)
CHARACTER*(*) INVERB
INTEGER INTYP(*)
CHARACTER*(*) CFIELD(*)
INTEGER IFIELD(*)
REAL RFIELD(*)
CHARACTER*(*) NAMES(*)
INTEGER LENE(0:NELBLK), LINKE(*)
INTEGER NLNKE(NELBLK)
REAL XN(*), YN(*), ZN(*)
REAL XE(*), YE(*), ZE(*)
LOGICAL ISEVOK(NELBLK,NVAREL)
INTEGER IE2ELB(*)
INTEGER NENUM(*)
INTEGER LIDSP(0:*)
INTEGER MAPEL(*)
INTEGER MAPND(*)
LOGICAL FFEXST, FFMATC
CHARACTER*(MXNAME) VERB, WORD
CHARACTER*5 STRA
CHARACTER TYP
LOGICAL HELP
LOGICAL ADDCRV
LOGICAL ISON, ISPATH
LOGICAL FIRST
SAVE FIRST, ADDCRV
C --FIRST - true iff first time through routine
CHARACTER*(MXSTLN) CMDTBL(15)
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 'ADD ',
* 'REMOVE ',
* 'delete ',
2 'SYPLOT ',
* 'NODES ',
* 'ELEMENTS ',
* 'DISPVAR ',
3 'PLOT ',
* 'HARDCOPY ',
* 'NEUTRAL ',
* 'GRAFAID ',
* 'XMGR ',
* 'CSV ',
* 'ECHO ',
4 ' ' /
C --Get the command verb, which may be a variable name
WORD = INVERB
CALL ABRSTR (VERB, WORD, CMDTBL)
IF (VERB .EQ. ' ') THEN
CALL DBVIX_BL ('N', 1, INV)
CALL DBVIX_BL ('E', 1, IEV)
IF ((LOCSTR (WORD, NVARNP, NAMES(INV)) .GT. 0)
& .OR. (LOCSTR (WORD, NVAREL, NAMES(IEV)) .GT. 0)) THEN
VERB = 'SYPLOT'
IFLD = IFLD - 1
ELSE
VERB = WORD
END IF
END IF
C *** Initialization ***
IF ((VERB .EQ. 'postmesh')
& .OR. (VERB .EQ. 'postplot') .OR. (VERB .EQ. 'initprog')
& .OR. (VERB .EQ. 'initres') .OR. (VERB .EQ. 'reset')) THEN
INVERB = VERB
C --Initialize parameters first time through, then reset
IF (FIRST) THEN
C --Change the command table to upper case
L = LOCSTR (' ', 999, CMDTBL) - 1
DO 100 I = 1, L
CALL EXUPCS (CMDTBL(I))
100 CONTINUE
VERB = 'initres'
END IF
C --Initialize time step selection default
IF ((VERB .EQ. 'initprog') .OR. (VERB .EQ. 'initres')) THEN
C --Set default time step selection to 10 times with delta interval
HISTOK = .FALSE.
NTIMIN = 10
END IF
C --Initialize for program change
IF (VERB .EQ. 'initprog') THEN
CONTINUE
END IF
C --Reset parameters
IF ((VERB .EQ. 'reset') .OR. (VERB .EQ. 'initres')) THEN
IF (VERB .EQ. 'reset') THEN
C --reset display variable list
CALL DISPV (.TRUE., INLINE, IFLD, INTYP,
& CFIELD, NAMES, LIDSP, NAMLEN)
ENDIF
SELOK = .FALSE.
NODVAR = .TRUE.
NNENUM = 0
NSPVAR = 0
FIRST = .FALSE.
END IF
C --Initialize for new plot set
IF (VERB .EQ. 'postplot') THEN
CONTINUE
END IF
C --Initialize after mesh plot
IF (VERB .EQ. 'postmesh') THEN
SELOK = .FALSE.
END IF
ADDCRV = .FALSE.
VERB = ' '
C *** Plot variable selection ***
ELSE IF (VERB .EQ. 'ADD') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
VERB = 'PLOT'
ADDCRV = .TRUE.
ELSE IF (VERB .EQ. 'REMOVE') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
VERB = 'PLOT'
110 CONTINUE
IF (FFEXST (IFLD, INTYP)) THEN
CALL FFINTG (IFLD, INTYP, IFIELD,
& 'number of the curve to delete', 0, ICRV, *130)
IF (ICRV .LT. 0) THEN
NDEL = MIN (-ICRV, NSPVAR)
CALL FFADDI (-NDEL, INLINE(1))
NSPVAR = NSPVAR - NDEL
ELSE
IF ((ICRV .LT. 1) .OR. (ICRV .GT. NSPVAR)) THEN
CALL INTSTR (1, 0, ICRV, STRA, L)
CALL PRTERR ('CMDWARN', 'Curve number ' // STRA(:L) //
& ' is invalid, ignored')
GOTO 120
END IF
CALL FFADDI (ICRV, INLINE(1))
ISVID(ICRV) = 0
END IF
120 CONTINUE
GOTO 110
END IF
130 CONTINUE
ICRV = 0
DO 140 NP = 1, NSPVAR
IF (ISVID(NP) .GT. 0) THEN
ICRV = ICRV + 1
IF (ICRV .NE. NP) THEN
ISVID(ICRV) = ISVID(NP)
END IF
END IF
140 CONTINUE
NSPVAR = ICRV
else if (verb .eq. 'DELETE') then
call prterr ('CMDREQ', 'Please use the REMOVE command')
call ffaddc (verb, inline(1))
inverb = ' '
verb = 'PLOT'
call ffintg (ifld, intyp, ifield,
& 'number of curves to delete', 1, ndel, *180)
ndel = max (0, min (ndel, nspvar))
call ffaddi (ndel, inline(1))
nspvar = nspvar - ndel
ELSE IF (VERB .EQ. 'SYPLOT') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (.NOT. ADDCRV) THEN
NSPVAR = 0
ADDCRV = .TRUE.
END IF
IF (NNENUM .EQ. 0) THEN
CALL PRTERR ('CMDERR',
& 'A NODES/ELEMENTS command must be issued')
GOTO 180
END IF
C --Get variable name
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
CALL FFADDC (WORD, INLINE(1))
IVAR = LOCSTR (WORD, NVARHI+NVARGL+NVARNP+NVAREL, NAMES)
IF (IVAR .LE. 0) THEN
CALL PRTERR ('CMDERR', '"' // WORD(:LENSTR(WORD))
& // '" is an invalid variable name')
GOTO 180
END IF
C --Get variable type
CALL DBVTYP_BL (IVAR, TYP, IDUM)
IF (NODVAR) THEN
IF (TYP .NE. 'N') THEN
CALL PRTERR ('CMDERR',
& 'Only nodal variables may be specified')
GOTO 180
END IF
ELSE
IF (TYP .NE. 'E') THEN
CALL PRTERR ('CMDERR',
& 'Only element variables may be specified')
GOTO 180
END IF
END IF
C --Add variable to the plot variable list
IF (NSPVAR .GE. MXSVAR) THEN
CALL PRTERR ('CMDERR', 'Too many plot variables')
GOTO 180
END IF
NSPVAR = NSPVAR + 1
ISVID(NSPVAR) = IVAR
C --Set Y axis to automatic scaling, etc if not set
INVERB = 'yaxis'
ELSE IF ((VERB .EQ. 'NODES') .OR. (VERB .EQ. 'ELEMENTS')) THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
ISON = (VERB .EQ. 'NODES')
C --Change the verb to lower-case for SHOW
WORD = VERB
CALL LOWSTR (VERB, WORD)
ISPATH = FFMATC (IFLD, INTYP, CFIELD, 'PATH', 1)
IF (ISPATH) CALL FFADDC ('PATH', INLINE(1))
C --Make a list of the selected nodes
IF (FFEXST (IFLD, INTYP)) THEN
IF (ISON) THEN
CALL RXINTA (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
& 'node number', NUMNP, NNENUM, NENUM, MAPND, *180)
ELSE
CALL RXINTA (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
& 'element number', NUMEL, NNENUM, NENUM, MAPEL, *180)
END IF
END IF
IF (ISON .NEQV. NODVAR) NSPVAR = 0
NODVAR = ISON
C --Determine a path between the nodes/element, if requested
IF (ISPATH) THEN
C --Get memory for path efficiency information
CALL MDFIND ('IPATH', KIPATH, L)
IF (L .LE. 0) THEN
CALL MDLONG ('IPATH', KIPATH, 2*NUMNP)
END IF
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 200
IF (NODVAR) THEN
CALL FNDPTH (NODVAR, LENE, NLNKE, LINKE, XN, YN, ZN,
& A(KIPATH), NUMNP, NNENUM, NENUM)
ELSE
CALL FNDPTH (NODVAR, LENE, NLNKE, LINKE, XE, YE, ZE,
& A(KIPATH), NUMEL, NNENUM, NENUM)
END IF
END IF
C --Set X axis to automatic scaling, etc if not set
INVERB = 'xaxis'
C *** Display control ***
ELSE IF (VERB .EQ. 'DISPVAR') THEN
CALL FFADDC (VERB, INLINE(1))
CALL DISPV (.FALSE., INLINE, IFLD, INTYP,
& CFIELD, NAMES, LIDSP, NAMLEN)
INVERB = ' '
C *** Display ***
ELSE IF ((VERB .EQ. 'PLOT') .OR. (VERB .EQ. 'HARDCOPY') .OR.
& (VERB .EQ. 'NEUTRAL') .OR. (VERB .EQ. 'GRAFAID') .OR.
* (VERB .EQ. 'XMGR') .OR. (VERB .EQ. 'CSV')) THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (NNENUM .EQ. 0) THEN
CALL PRTERR ('CMDERR', 'No nodes or elements are selected')
GOTO 180
END IF
IF (NSPVAR .EQ. 0) THEN
CALL PRTERR ('CMDERR', 'No curves are defined')
GOTO 180
END IF
IF (NPTIMS .EQ. 0) THEN
CALL PRTERR ('CMDERR', 'No times are selected')
VERB = ' '
GOTO 180
END IF
C --Check that at least one selected element is defined for each selected
C --element variable
IF (.NOT. NODVAR) THEN
NBAD = 0
DO 170 IP = 1, NSPVAR
CALL DBVTYP_BL (ISVID(IP), TYP, IVAR)
IF (NUMEQL (.FALSE., NELBLK, ISEVOK(1,IVAR)) .GT. 0) THEN
DO 150 IX = 1, NNENUM
IF (ISEVOK(IE2ELB(NENUM(IX)),IVAR)) GOTO 160
150 CONTINUE
NBAD = NBAD + 1
160 CONTINUE
END IF
170 CONTINUE
IF (NBAD .GT. 0) THEN
IF (NBAD .GE. NSPVAR) THEN
CALL PRTERR ('CMDERR',
& 'All of the curve variables are undefined'
& // ' for the requested elements')
GOTO 180
ELSE
CALL PRTERR ('CMDERR',
& 'Some of the curve variables are undefined'
& // ' for the requested elements')
END IF
END IF
END IF
C --PLOT, HARDCOPY, and NEUTRAL are to be passed as lower-case commands
CALL LOWSTR (INVERB, VERB)
VERB = ' '
C *** Mesh display commands ***
ELSE IF (VERB .EQ. 'ECHO') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (NNENUM .EQ. 0) THEN
CALL PRTERR ('CMDERR', 'No nodes or elements are selected')
GOTO 180
END IF
SELOK = .TRUE.
INVERB = 'mesh'
VERB = ' '
C *** Information ***
ELSE IF (VERB .EQ. 'show') THEN
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
CALL ABRSTR (VERB, WORD, CMDTBL)
IF (VERB .NE. ' ') THEN
CALL SPSHOW (VERB, NAMES, NENUM, LIDSP)
INVERB = ' '
END IF
VERB = ' '
ELSE IF (VERB .EQ. 'help') THEN
ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
IF (.NOT. ISON)
& CALL SHOCMD ('SPLOT Commands', CMDTBL)
VERB = ' '
ELSE
VERB = ' '
END IF
GOTO 190
180 CONTINUE
INLINE(1) = ' '
190 CONTINUE
IF (VERB .NE. ' ') THEN
CALL SPSHOW (VERB, NAMES, NENUM, LIDSP)
END IF
200 CONTINUE
RETURN
END