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.
 
 
 
 
 
 

595 lines
18 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 TPCOMD (A, INLINE,
& INVERB, IFLD, INTYP, CFIELD, IFIELD, RFIELD, MAXFLD,
& NAMES, ISEVOK, IE2ELB, NENUM, NNENUM, MAPEL, MAPND)
C=======================================================================
C --*** TPCOMD *** (TPLOT) Process TPLOT commands
C -- Written by Amy Gilkey - revised 05/31/88
C --
C --TPCOMD interprets TPLOT 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 -- TYPLOT Specify time plot
C -- (variable, # on following line)
C -- XYPLOT Specify X-Y plot
C -- (variable, # on following two lines)
C -- variable, # Specify time plot
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 --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, MAXFLD - IN/OUT - the free-field
C -- reader index and fields
C -- NAMES - IN - the 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 = 2 * NNENUM
C -- NNENUM - used to properly dimension NENUM
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 NTPCRV, NTPVAR, TIMPLT, ITVID of /TPVARS/
C -- Sets OVERLY of /XYOPT/
include 'params.blk'
include 'dbnums.blk'
include 'times.blk'
include 'tpvars.blk'
include 'xyopt.blk'
DIMENSION A(*)
CHARACTER*(*) INLINE(*)
CHARACTER*(*) INVERB
INTEGER INTYP(*)
CHARACTER*(*) CFIELD(*)
INTEGER IFIELD(*)
REAL RFIELD(*)
CHARACTER*(*) NAMES(*)
LOGICAL ISEVOK(NELBLK,NVAREL)
INTEGER NENUM(NNENUM,2)
INTEGER IE2ELB(*)
INTEGER MAPEL(*)
INTEGER MAPND(*)
LOGICAL FFEXST
LOGICAL BATCH
CHARACTER*(MXNAME) VERB, WORD
LOGICAL HELP
LOGICAL ADDCRV
LOGICAL ISON
LOGICAL TYPLOT
CHARACTER*5 STRA
CHARACTER*(MXNAME) NAME
CHARACTER CDUM
CHARACTER TYP(2)
INTEGER IID(2)
CHARACTER TYPX, TYPY
CHARACTER*12 PROMPT
INTEGER LPROM
LOGICAL FIRST
SAVE FIRST, ADDCRV
C --FIRST - true iff first time through routine
CHARACTER*(MXSTLN) CMDTBL(13)
SAVE CMDTBL
C --CMDTBL - the valid commands table
DATA FIRST /.TRUE./
DATA LASTX /-1/
DATA LASTY /-1/
C --Command table follows. Remember to change the dimensioned size when
C --changing the table.
DATA CMDTBL /
1 'ADD ',
* 'REMOVE ',
* 'delete ',
* 'TYPLOT ',
* 'XYPLOT ',
2 'PLOT ',
* 'HARDCOPY ',
* 'NEUTRAL ',
* 'XMGR ',
* 'CSV ',
* 'RAW ',
* 'GRAFAID ',
3 ' ' /
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 = 'TYPLOT'
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
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
NTPVAR = 0
NTPCRV = 0
TIMPLT = .TRUE.
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
CONTINUE
END IF
ADDCRV = .FALSE.
IF (NTPVAR .GT. 0) THEN
IF (TIMPLT) THEN
LASTX = 0
ELSE
LASTX = ITVID(NTPVAR-1)
END IF
LASTY = ITVID(NTPVAR)
ELSE
LASTX = -1
LASTY = -1
END IF
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, NTPCRV)
CALL FFADDI (-NDEL, INLINE(1))
IF (TIMPLT) THEN
NTPVAR = NTPVAR - NDEL
ELSE
NTPVAR = NTPVAR - 2*NDEL
END IF
NTPCRV = NTPCRV - NDEL
ELSE
IF ((ICRV .LT. 1) .OR. (ICRV .GT. NTPCRV)) 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))
IF (TIMPLT) THEN
ITVID(ICRV) = 0
ELSE
ITVID(2*ICRV-1) = 0
ITVID(2*ICRV) = 0
END IF
END IF
110 CONTINUE
GOTO 100
END IF
120 CONTINUE
N = 0
ICRV = 0
DO 130 NP = 1, NTPCRV
N = N + 1
IF (.NOT. TIMPLT) N = N + 1
IF (ITVID(N) .GT. 0) THEN
ICRV = ICRV + 1
IF (ICRV .NE. NP) THEN
IF (TIMPLT) THEN
ITVID(ICRV) = ITVID(N)
ITVNE(ICRV) = ITVNE(NP)
ELSE
ITVID(2*ICRV-1) = ITVID(N-1)
ITVNE(2*ICRV-1) = ITVNE(N-1)
ITVID(2*ICRV) = ITVID(N)
ITVNE(2*ICRV) = ITVNE(N)
END IF
END IF
END IF
130 CONTINUE
IF (TIMPLT) THEN
NTPVAR = ICRV
ELSE
NTPVAR = 2*ICRV
END IF
NTPCRV = 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, *210)
ndel = max (0, min (ndel, ntpcrv))
call ffaddi (ndel, inline(1))
if (timplt) then
ntpvar = ntpvar - ndel
else
ntpvar = ntpvar - 2*ndel
end if
ntpcrv = ntpcrv - ndel
ELSE IF ((VERB .EQ. 'TYPLOT') .OR. (VERB .EQ. 'XYPLOT')) THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
C --Delete existing curves, if not adding and set to adding
IF (.NOT. ADDCRV) THEN
NTPVAR = 0
NTPCRV = 0
ADDCRV = .TRUE.
END IF
C --Determine if X-Y plot or time-Y plot
TYPLOT = (VERB .EQ. 'TYPLOT')
IF ((TIMPLT .NEQV. TYPLOT) .AND. (NTPCRV .GT. 0)) THEN
CALL PRTERR ('CMDERR',
& 'Time curves and X-Y curves must be defined separately')
GOTO 210
END IF
IF (TYPLOT) THEN
ISTART = 2
ELSE
ISTART = 1
END IF
NOK = ISTART - 1
DO 160 IXY = ISTART, 2
IF (ISTART .EQ. 1) THEN
ILIN = IXY + 1
ELSE
ILIN = IXY
END IF
INLINE(ILIN) = ' '
C --Input the variable line
IF ((IXY .GT. ISTART)
& .OR. (.NOT. FFEXST (IFLD, INTYP))) THEN
IF (IXY .EQ. 1) THEN
PROMPT = 'X VARIABLE> '
LPROM = LENSTR (PROMPT)
CALL GETINS ('parse', MAXFLD, NUMFLD, INTYP,
& CFIELD, IFIELD, RFIELD, ' ', IOSTAT, PROMPT,
& LPROM, *140)
ELSE
PROMPT = 'Y VARIABLE> '
LPROM = LENSTR (PROMPT)
CALL GETINS ('parse', MAXFLD, NUMFLD, INTYP,
& CFIELD, IFIELD, RFIELD, ' ', IOSTAT, PROMPT,
& LPROM, *140)
END IF
140 CONTINUE
IF (IOSTAT .LT. 0) NUMFLD = 0
INTYP(MIN(NUMFLD,MAXFLD)+1) = -999
IFLD = 1
END IF
C --Get the variable name
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', NAME)
CALL FFADDC (NAME, INLINE(ILIN))
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 150
END IF
C --Get the variable type
CALL DBVTYP_BL (IID(IXY), TYP(IXY), ID)
IF ((NSTEPW .LE. 0) .AND. (TYP(IXY) .NE. 'H')) THEN
CALL PRTERR ('CMDERR',
& 'Only history variables are defined on this database')
GOTO 150
END IF
C --Get the variable range
IF ((TYP(IXY) .EQ. 'N') .OR. (TYP(IXY) .EQ. 'E')) THEN
NNUM = 0
IF (FFEXST (IFLD, INTYP)) THEN
IF (TYP(IXY) .EQ. 'N') THEN
CALL RMIXINT (INLINE(ILIN),
& IFLD, INTYP, CFIELD, IFIELD,
& 'node number', NUMNP, NNUM, NENUM(1,IXY),
& MAPND, *150)
ELSE IF (TYP(IXY) .EQ. 'E') THEN
CALL RMIXINT (INLINE(ILIN),
& IFLD, INTYP, CFIELD, IFIELD,
& 'element number', NUMEL, NNUM, NENUM(1,IXY),
& MAPEL, *150)
END IF
END IF
IF (NNUM .LE. 0) THEN
CALL PRTERR ('CMDERR', 'Expected node/element number')
GOTO 150
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 150
END IF
NNUM = 1
END IF
IF (IXY .EQ. 1) THEN
NX = NNUM
ELSE
NY = NNUM
END IF
NOK = NOK + 1
150 CONTINUE
IF ((.NOT. BATCH ()) .AND. (NOK .LT. IXY)) GOTO 210
160 CONTINUE
IF (NOK .NE. 2) GOTO 210
C --Get the number of X and Y parts
IF (ISTART .EQ. 2) NX = NY
IF ((TYP(2) .EQ. 'N') .OR. (TYP(2) .EQ. 'E')) THEN
IF ((NX .NE. NY) .AND. (NX .NE. 1) .AND. (NY .NE. 1)) THEN
CALL PRTERR ('CMDERR',
& 'Ranges of X and Y variables do not match')
GOTO 210
END IF
END IF
C --Add the curves to the list (deleted if error)
NPTMP = NTPVAR
DO 190 IENT = 1, MAX (NX, NY)
C --Check that element variable exists for element block
DO 170 IXY = ISTART, 2
IF (TYP(IXY) .EQ. 'E') THEN
IEL = NENUM(IENT,IXY)
IELB = IE2ELB(IEL)
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 ('CMDWARN',
& 'Variable ' // NAME(:LENSTR(NAME)) //
& ' does not exist for element ' // STRA(:LSTRA)
& // ', curve ignored')
GOTO 190
END IF
END IF
170 CONTINUE
C --Add the curve to the list
IF ((NPTMP + (2 - ISTART + 1)) .GT. MXTVAR) THEN
CALL PRTERR ('CMDERR', 'Too many plot variables')
GOTO 210
END IF
DO 180 IXY = ISTART, 2
NPTMP = NPTMP + 1
ITVID(NPTMP) = IID(IXY)
IF ((TYP(IXY) .EQ. 'N') .OR. (TYP(IXY) .EQ. 'E')) THEN
ITVNE(NPTMP) = NENUM(IENT,IXY)
ELSE
ITVNE(NPTMP) = 0
END IF
180 CONTINUE
190 CONTINUE
IF (NTPVAR .EQ. NPTMP) GOTO 210
NTPVAR = NPTMP
TIMPLT = TYPLOT
NTPCRV = NTPCRV + MAX (NX, NY)
C --Reset the X and Y axis if the variables have changed
IF (TYPLOT) IID(1) = 0
NEWX = IID(1)
NEWY = IID(2)
IF (LASTX .NE. NEWX) THEN
INVERB = 'xaxis'
LASTX = NEWX
END IF
IF (LASTY .NE. NEWY) THEN
IF (INVERB .EQ. ' ') THEN
INVERB = 'yaxis'
ELSE
INVERB = 'xyaxis'
END IF
LASTY = NEWY
END IF
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') .OR.
* (VERB .EQ. 'RAW' )) THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (NTPVAR .EQ. 0) THEN
CALL PRTERR ('CMDERR', 'No curves are defined')
GOTO 210
END IF
IF (NPTIMS .EQ. 0) THEN
CALL PRTERR ('CMDERR', 'No times are selected')
VERB = ' '
GOTO 210
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
IF (TIMPLT) TYPX = 'H'
N = 0
DO 200 NP = 1, NTPCRV
IF (.NOT. TIMPLT) THEN
N = N + 1
CALL DBVTYP_BL (ITVID(N), TYPX, IDUM)
END IF
N = N + 1
CALL DBVTYP_BL (ITVID(N), TYPY, IDUM)
IF ((TYPX .NE. 'H') .OR. (TYPY .NE. 'H')) THEN
NBAD = NBAD + 1
END IF
200 CONTINUE
IF (NBAD .GT. 0) THEN
IF (NBAD .GE. NTPCRV) THEN
CALL PRTERR ('CMDERR',
& 'All of the curves are undefined'
& // ' for the selected time steps')
GOTO 210
ELSE
CALL PRTERR ('CMDERR',
& 'Some of the curves are undefined'
& // ' for the selected time steps')
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 *** Information ***
ELSE IF (VERB .EQ. 'show') THEN
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
CALL ABRSTR (VERB, WORD, CMDTBL)
IF (VERB .NE. ' ') THEN
CALL TPSHOW (VERB, NAMES, MAPEL, MAPND)
INVERB = ' '
END IF
VERB = ' '
ELSE IF (VERB .EQ. 'help') THEN
ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
IF (.NOT. ISON)
& CALL SHOCMD ('TPLOT Commands', CMDTBL)
VERB = ' '
ELSE
VERB = ' '
END IF
GOTO 220
210 CONTINUE
INLINE(1) = ' '
220 CONTINUE
IF (VERB .NE. ' ') THEN
CALL TPSHOW (VERB, NAMES, MAPEL, MAPND)
END IF
RETURN
END