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