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.
466 lines
14 KiB
466 lines
14 KiB
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 LNCOMD (A, INLINE,
|
|
& INVERB, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
|
|
& NAMES, ISEVOK, IE2ELB, NENUM)
|
|
C=======================================================================
|
|
C TODO: Support for Mapped node/element ids
|
|
|
|
C --*** LNCOMD *** (PATHLN) Process PATHLINE commands
|
|
C -- Written by Amy Gilkey - revised 05/31/88
|
|
C --
|
|
C --LNCOMD interprets PATHLINE 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 requested
|
|
C -- REMOVE {n} Delete plot curve n
|
|
C -- LOCATION {xvar,yvar,zvar,#} Specify pathline plot
|
|
C --
|
|
C --Display
|
|
C -- reset Reset plot parameters
|
|
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 --
|
|
C --Information
|
|
C -- show {option} Display plot parameters and information
|
|
C -- help {option} Display system dependent HELP
|
|
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 global, nodal, and element variable names
|
|
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 - SCRATCH - size = MAX (NUMNP, NUMEL)
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NVARHI, NVARGL, NVARNP, NVAREL of /DBNUMS/
|
|
C -- Uses NPTIMS, NPTIMW of /TIMES/
|
|
C -- Sets NTIMIN, HISTOK of /TIMES/
|
|
C -- Sets NLNCRV, ILVNE, ILVID of /LNVARS/
|
|
|
|
include 'params.blk'
|
|
include 'dbnums.blk'
|
|
include 'times.blk'
|
|
include 'lnvars.blk'
|
|
|
|
DIMENSION A(*)
|
|
CHARACTER*(*) INLINE(*)
|
|
CHARACTER*(*) INVERB
|
|
INTEGER INTYP(*)
|
|
CHARACTER*(*) CFIELD(*)
|
|
INTEGER IFIELD(*)
|
|
REAL RFIELD(*)
|
|
CHARACTER*(*) NAMES(*)
|
|
LOGICAL ISEVOK(NELBLK,NVAREL)
|
|
INTEGER IE2ELB(*)
|
|
INTEGER NENUM(*)
|
|
|
|
LOGICAL FFEXST, FFMATC
|
|
|
|
CHARACTER*(MXNAME) VERB, WORD
|
|
LOGICAL HELP
|
|
LOGICAL ADDCRV
|
|
LOGICAL ISON
|
|
LOGICAL ISPATH, NODVAR
|
|
CHARACTER*5 STRA
|
|
CHARACTER*(MXNAME) NAME
|
|
CHARACTER CDUM
|
|
CHARACTER TYP, T
|
|
INTEGER IID(3)
|
|
|
|
LOGICAL FIRST
|
|
SAVE FIRST, ADDCRV
|
|
C --FIRST - true iff first time through routine
|
|
|
|
CHARACTER*(MXSTLN) CMDTBL(4)
|
|
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 ', 'LOCATION ',
|
|
2 ' ' /
|
|
|
|
C --Get the command verb, which may be a variable name
|
|
|
|
WORD = INVERB
|
|
CALL ABRSTR (VERB, WORD, CMDTBL)
|
|
IF (VERB .EQ. ' ') THEN
|
|
IF (LOCSTR (WORD, NVARHI+NVARGL+NVARNP+NVAREL, NAMES) .GT. 0)
|
|
& THEN
|
|
VERB = 'LOCATION'
|
|
IFLD = IFLD - 1
|
|
ELSE
|
|
VERB = WORD
|
|
END IF
|
|
END IF
|
|
|
|
C *** Initialization ***
|
|
|
|
IF ((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
|
|
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 all times
|
|
HISTOK = (NVARHI .GT. 0)
|
|
NTIMIN = 0
|
|
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
|
|
NLNCRV = 0
|
|
|
|
FIRST = .FALSE.
|
|
END IF
|
|
|
|
C --Initialize for new plot set
|
|
|
|
IF (VERB .EQ. 'postplot') THEN
|
|
CONTINUE
|
|
END IF
|
|
|
|
ADDCRV = .FALSE.
|
|
|
|
VERB = ' '
|
|
|
|
C *** Plot curve 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'
|
|
|
|
100 CONTINUE
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
|
& 'number of the curve to delete', 0, ICRV, *120)
|
|
IF (ICRV .LT. 0) THEN
|
|
NDEL = MIN (-ICRV, NLNCRV)
|
|
CALL FFADDI (-NDEL, INLINE(1))
|
|
NLNCRV = NLNCRV - NDEL
|
|
ELSE
|
|
IF ((ICRV .LT. 1) .OR. (ICRV .GT. NLNCRV)) THEN
|
|
CALL INTSTR (1, 0, ICRV, STRA, L)
|
|
CALL PRTERR ('CMDWARN', 'Curve number ' // STRA(:L) //
|
|
& ' is invalid, ignored')
|
|
GOTO 110
|
|
END IF
|
|
CALL FFADDI (ICRV, INLINE(1))
|
|
ILVID(1,ICRV) = 0
|
|
END IF
|
|
110 CONTINUE
|
|
GOTO 100
|
|
END IF
|
|
|
|
120 CONTINUE
|
|
ICRV = 0
|
|
DO 140 NP = 1, NLNCRV
|
|
IF (ILVID(1,NP) .GT. 0) THEN
|
|
ICRV = ICRV + 1
|
|
IF (ICRV .NE. NP) THEN
|
|
ILVNE(ICRV) = ILVNE(NP)
|
|
DO 130 I = 1, NDIM
|
|
ILVID(I,ICRV) = ILVID(I,NP)
|
|
130 CONTINUE
|
|
END IF
|
|
END IF
|
|
140 CONTINUE
|
|
NLNCRV = ICRV
|
|
|
|
ELSE IF (VERB .EQ. 'LOCATION') THEN
|
|
CALL FFADDC (VERB, INLINE(1))
|
|
INVERB = ' '
|
|
|
|
C --Delete existing curves, if not adding and set to adding
|
|
|
|
IF (.NOT. ADDCRV) THEN
|
|
NLNCRV = 0
|
|
ADDCRV = .TRUE.
|
|
END IF
|
|
|
|
DO 150 IXY = 1, NDIM
|
|
|
|
C --Get the variable name
|
|
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', NAME)
|
|
IF (NAME .EQ. ' ') THEN
|
|
CALL PRTERR ('CMDERR', 'Expected variable name')
|
|
GOTO 200
|
|
END IF
|
|
CALL FFADDC (NAME, INLINE(1))
|
|
IID(IXY) = LOCSTR (NAME, NVARHI+NVARGL+NVARNP+NVAREL, NAMES)
|
|
IF (IID(IXY) .LE. 0) THEN
|
|
CALL PRTERR ('CMDERR', '"' // NAME(:LENSTR(NAME))
|
|
& // '" is an invalid variable name')
|
|
GOTO 200
|
|
END IF
|
|
|
|
C --Get the variable type
|
|
|
|
CALL DBVTYP_BL (IID(IXY), T, IDUM)
|
|
|
|
IF (IXY .EQ. 1) THEN
|
|
TYP = T
|
|
IF (TYP .EQ. 'E') THEN
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Pathlines not allowed on element variables')
|
|
GOTO 200
|
|
END IF
|
|
END IF
|
|
IF (TYP .NE. T) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Variables are of different types')
|
|
GOTO 200
|
|
END IF
|
|
|
|
IF ((NSTEPW .LE. 0) .AND. (TYP .NE. 'H')) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Only history variables are defined on this database')
|
|
GOTO 200
|
|
END IF
|
|
150 CONTINUE
|
|
|
|
C --Get the variable range
|
|
|
|
IF ((TYP .EQ. 'N') .OR. (TYP .EQ. 'E')) THEN
|
|
NNUM = 0
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
IF (TYP .EQ. 'N') THEN
|
|
CALL RIXINT (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
|
& 'node number', NUMNP, NNUM, NENUM, *200)
|
|
ELSE IF (TYP .EQ. 'E') THEN
|
|
CALL RIXINT (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
|
& 'element number', NUMEL, NNUM, NENUM, *200)
|
|
END IF
|
|
END IF
|
|
IF (NNUM .LE. 0) THEN
|
|
CALL PRTERR ('CMDERR', 'Expected node/element number')
|
|
GOTO 200
|
|
END IF
|
|
ELSE
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF (WORD .NE. ' ') THEN
|
|
CALL PRTERR ('CMDERR',
|
|
& 'A number is given for a history/global variable')
|
|
GOTO 200
|
|
END IF
|
|
NNUM = 1
|
|
END IF
|
|
|
|
C --Add the curves to the list (deleted if error)
|
|
|
|
NPTMP = NLNCRV
|
|
DO 180 NP = 1, NNUM
|
|
|
|
C --Check that element variable exists for element block
|
|
|
|
IF (TYP .EQ. 'E') THEN
|
|
IEL = NENUM(NP)
|
|
IELB = IE2ELB(IEL)
|
|
DO 160 IXY = 1, NDIM
|
|
CALL DBVTYP_BL (IID(IXY), CDUM, ID)
|
|
IF (.NOT. ISEVOK (IELB, ID)) THEN
|
|
NAME = NAMES(IID(IXY))
|
|
CALL INTSTR (1, 0, IEL, STRA, LSTRA)
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Variable ' // NAME(:LENSTR(NAME)) //
|
|
& ' does not exist for element ' // STRA(:LSTRA)
|
|
& // ', curve ignored')
|
|
GOTO 180
|
|
END IF
|
|
160 CONTINUE
|
|
END IF
|
|
|
|
C --Add the curve to the list (deleted if error)
|
|
|
|
IF ((NPTMP + 1) .GT. MXLCRV) THEN
|
|
CALL PRTERR ('CMDERR', 'Too many plot variables')
|
|
GOTO 200
|
|
END IF
|
|
|
|
NPTMP = NPTMP + 1
|
|
ILVNE(NPTMP) = NENUM(NP)
|
|
DO 170 IXY = 1, NDIM
|
|
ILVID(IXY,NPTMP) = IID(IXY)
|
|
170 CONTINUE
|
|
180 CONTINUE
|
|
|
|
IF (NLNCRV .EQ. NPTMP) GOTO 200
|
|
|
|
NLNCRV = NPTMP
|
|
|
|
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 RIXINT (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
|
& 'node number', NUMNP, NNENUM, NENUM, *200)
|
|
ELSE
|
|
CALL RIXINT (INLINE(1), IFLD, INTYP, CFIELD, IFIELD,
|
|
& 'element number', NUMEL, NNENUM, NENUM, *200)
|
|
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 220
|
|
|
|
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 *** Display ***
|
|
|
|
ELSE IF ((VERB .EQ. 'plot') .OR. (VERB .EQ. 'hardcopy')) THEN
|
|
CALL FFADDC (VERB, INLINE(1))
|
|
|
|
IF (NLNCRV .EQ. 0) THEN
|
|
CALL PRTERR ('CMDERR', 'No curves are defined')
|
|
GOTO 200
|
|
END IF
|
|
IF (NPTIMS .EQ. 0) THEN
|
|
CALL PRTERR ('CMDERR', 'No times are selected')
|
|
VERB = ' '
|
|
GOTO 200
|
|
END IF
|
|
|
|
C --Check that at least one whole time step is selected for non-history
|
|
C --variables
|
|
|
|
IF (NPTIMW .LE. 0) THEN
|
|
NBAD = 0
|
|
DO 190 NP = 1, NLNCRV
|
|
CALL DBVTYP_BL (ILVID(1,NP), TYP, IDUM)
|
|
IF (TYP .NE. 'H') THEN
|
|
NBAD = NBAD + 1
|
|
END IF
|
|
190 CONTINUE
|
|
IF (NBAD .GT. 0) THEN
|
|
IF (NBAD .GE. NLNCRV) THEN
|
|
CALL PRTERR ('CMDERR',
|
|
& 'All of the curves are undefined'
|
|
& // ' for the selected time steps')
|
|
GOTO 200
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Some of the curves are undefined'
|
|
& // ' for the selected time steps')
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
VERB = ' '
|
|
|
|
C *** Information ***
|
|
|
|
ELSE IF (VERB .EQ. 'show') THEN
|
|
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
|
IF ((WORD .NE. 'PLOT') .AND. (WORD .NE. 'HARDCOPY')
|
|
& .AND. (WORD .NE. 'VIEW')) THEN
|
|
CALL ABRSTR (VERB, WORD, CMDTBL)
|
|
ELSE
|
|
VERB = WORD
|
|
END IF
|
|
IF (VERB .NE. ' ') THEN
|
|
CALL LNSHOW (VERB, NAMES)
|
|
INVERB = ' '
|
|
END IF
|
|
VERB = ' '
|
|
|
|
ELSE IF (VERB .EQ. 'help') THEN
|
|
|
|
ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
|
|
IF (.NOT. ISON)
|
|
& CALL SHOCMD ('PATHLINE Commands', CMDTBL)
|
|
VERB = ' '
|
|
|
|
ELSE
|
|
VERB = ' '
|
|
END IF
|
|
|
|
GOTO 210
|
|
|
|
200 CONTINUE
|
|
INLINE(1) = ' '
|
|
|
|
210 CONTINUE
|
|
IF (VERB .NE. ' ') THEN
|
|
CALL LNSHOW (VERB, NAMES)
|
|
END IF
|
|
|
|
220 CONTINUE
|
|
RETURN
|
|
END
|
|
|