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.
704 lines
22 KiB
704 lines
22 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 DTCOMD (A, INLINE, INVERB, IFLD, INTYP, CFIELD,
|
||
|
& IFIELD, RFIELD, NEWMOD, NAMES, IELBST,
|
||
|
& ISSNPS, ISSESS, LIDSP, MAPEL, MAPND, NAMLEN)
|
||
|
C=======================================================================
|
||
|
|
||
|
C --*** DTCOMD *** (DETOUR) Process DETOUR commands
|
||
|
C -- Modified by John Glick - 11/1/88
|
||
|
C -- Written by Amy Gilkey - revised 05/16/88
|
||
|
C -- Dennis Flanagan, 11/18/82
|
||
|
C --
|
||
|
C --DTCOMD interprets DETOUR commands.
|
||
|
C --
|
||
|
C --The commands are listed below with their parameters and their
|
||
|
C --function.
|
||
|
C --
|
||
|
C --Display mode control
|
||
|
C -- newmod
|
||
|
C -- WIREFRAM Set wireframe mesh mode
|
||
|
C -- SOLID Set solid mesh mode
|
||
|
C -- NSETS {id1,...} Set sets mode and select node sets
|
||
|
C -- SSETS {id1,...} Set sets mode and select side sets
|
||
|
C -- CONTOUR {variable} Set line contour mode
|
||
|
C -- PAINT {variable} Set paint contour mode
|
||
|
C -- VECTOR {2 or 3 variables} Set vector mode
|
||
|
C -- SYMBOL {type,variable} Set element symbol mode
|
||
|
C -- GAUSS {4 variables} Set element symbol gauss mode
|
||
|
C -- variable Select contour variable, and set contour
|
||
|
C -- range; in vector mode, set the vector
|
||
|
C -- variables; in symbol mode, set the symbol
|
||
|
C -- variable
|
||
|
C --
|
||
|
C --Active element control
|
||
|
C -- newele
|
||
|
C --
|
||
|
C --Contour control
|
||
|
C -- NCNTRS {ncntrs} Set number of contours, round DELC
|
||
|
C -- CRANGE {cmin,cmax} Set minimum and maximum contour value
|
||
|
C -- CMIN {cmin,cmax} Set minimum contour value
|
||
|
C -- CMAX {cmax} Set maximum contour value
|
||
|
C -- CSHIFT {cval} Shift contour limits to fall on CVAL
|
||
|
C -- DELCNTR {delc,cmin} Set contour interval, adjust limits
|
||
|
C -- CINTV {c1,c2,...} Set specific contour intervals
|
||
|
C --
|
||
|
C --Display control
|
||
|
C -- COPEN {ON/OFF,ON/OFF} Set contour minimum / maximum open or closed
|
||
|
C -- CLABEL {OFF/ON/labinc} Label every LABINC interior mesh line
|
||
|
C -- with contour letter
|
||
|
C -- CSYMBOLS {maxmin,maxmax} Specify maximum number of min/max symbols
|
||
|
C -- to plot on contour plots.
|
||
|
C -- VSCALE {vecscl} Set vector length / symbol scale factor
|
||
|
C -- color Set number of colors
|
||
|
C -- spectrum Set number of spectrum colors
|
||
|
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 default conditions
|
||
|
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 program information (based on type)
|
||
|
C -- help {option} Display system dependent HELP
|
||
|
C --
|
||
|
C --Parameters:
|
||
|
C -- A - IN - the dynamic memory base array
|
||
|
C -- INLINE - I/O - the parsed input lines for the log file
|
||
|
C -- INVERB - I/O - the command verb
|
||
|
C -- IFLD,
|
||
|
C -- INTYP,
|
||
|
C -- CFIELD,
|
||
|
C -- IFIELD,
|
||
|
C -- RFIELD - I/O - the free-field reader index and fields
|
||
|
C -- NEWMOD - IN - the mode status of each view:
|
||
|
C -- -1 = unchanged
|
||
|
C -- 0 = changed to default
|
||
|
C -- n = changed to be like view n
|
||
|
C -- NAMES - IN - the variable names
|
||
|
C -- IELBST - IN - the element block status:
|
||
|
C -- -1 = OFF, 0 = ON, but not selected, 1 = selected
|
||
|
C -- ISSNPS - I/O - the indices of the selected node sets
|
||
|
C -- ISSESS - I/O - the indices of the selected side sets
|
||
|
C -- LIDSP(0:*) - I/O - 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 -- LIDSP(i) > 0, LIDSP(i) is the id of a history var.
|
||
|
C -- LIDSP(i) < 0, -LIDSP(i) is the id of a global var.
|
||
|
C -- LIDSP(i) = 0, TIME is displayed on the plot legend.
|
||
|
C --
|
||
|
C --Common Variables:
|
||
|
C -- Uses NELBLK, NVARNP, NVAREL of /DBNUMS/
|
||
|
C -- Uses IS3DIM of /D3NUMS/
|
||
|
C -- Uses NPTIMS of /TIMES/
|
||
|
C -- Sets NTIMIN, HISTOK of /TIMES/
|
||
|
C -- Sets VECSCL of /ETCOPT/
|
||
|
C -- Sets DEFPRO, DFAC of /DEFORM/
|
||
|
C -- Uses DDFAC of /DEFORM/
|
||
|
C -- Sets and uses MSHDEF, MSHNUM, MSHLIN, MLNTYP of /MSHOPT/
|
||
|
C -- Sets and uses MODDET, MODTYP, IDTVAR, NNDVAR, NEDVAR of /DETOPT/
|
||
|
C -- Sets and uses CINTOK, LINCON, NCNTR, CMIN, CMAX, DELC, CINTV,
|
||
|
C -- NOCMIN, NOCMAX, LABINC, MAXMIN, MAXMAX of /CNTR/
|
||
|
|
||
|
PARAMETER (MSHNON=0, MSHBOR=1, MSHDIV=2, MSHSEL=3, MSHALL=4)
|
||
|
PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4, KNEA=5, KFAR=6)
|
||
|
|
||
|
EXTERNAL BLKDAT
|
||
|
|
||
|
include 'debug.blk'
|
||
|
C common /debugc/ cdebug
|
||
|
C common /debugn/ idebug
|
||
|
C character*8 cdebug
|
||
|
|
||
|
include 'params.blk'
|
||
|
include 'dbnums.blk'
|
||
|
include 'dbnumgq.blk'
|
||
|
include 'd3nums.blk'
|
||
|
include 'times.blk'
|
||
|
include 'etcopt.blk'
|
||
|
include 'deform.blk'
|
||
|
include 'mshopt.blk'
|
||
|
include 'detopt.blk'
|
||
|
include 'cntr.blk'
|
||
|
|
||
|
C Flag for exact contour values for each plot
|
||
|
include 'icexct.blk'
|
||
|
include 'axsplt.blk'
|
||
|
|
||
|
DIMENSION A(*)
|
||
|
CHARACTER*(*) INLINE(*)
|
||
|
CHARACTER*(*) INVERB
|
||
|
INTEGER INTYP(*)
|
||
|
CHARACTER*(*) CFIELD(*)
|
||
|
INTEGER IFIELD(*)
|
||
|
REAL RFIELD(*)
|
||
|
INTEGER NEWMOD(4)
|
||
|
CHARACTER*(*) NAMES(*)
|
||
|
INTEGER IELBST(NELBLK)
|
||
|
INTEGER ISSNPS(NUMNPS,4)
|
||
|
INTEGER ISSESS(NUMESS,4)
|
||
|
INTEGER LIDSP(0:*)
|
||
|
INTEGER MAPEL(*), MAPND(*)
|
||
|
|
||
|
LOGICAL FFNUMB, MATSTR
|
||
|
INTEGER NUMMOD
|
||
|
CHARACTER*(MXNAME) VERB, VERB2
|
||
|
C --VERB - the command verb used in the SHOW
|
||
|
C --VERB2 - the secondary SHOW command verb
|
||
|
|
||
|
CHARACTER*(MXNAME) WORD
|
||
|
LOGICAL HELP
|
||
|
LOGICAL VWCMD
|
||
|
LOGICAL ISON
|
||
|
LOGICAL INL, INE
|
||
|
CHARACTER TYP
|
||
|
INTEGER LTYP(-1:1)
|
||
|
|
||
|
LOGICAL FIRST
|
||
|
SAVE FIRST
|
||
|
C --FIRST - true iff first time through routine
|
||
|
|
||
|
INTEGER NVOLD(4), NCOLD
|
||
|
LOGICAL FIXCON
|
||
|
SAVE NVOLD, NCOLD, FIXCON
|
||
|
C --NVOLD - the last variables
|
||
|
C --NCOLD - the last contour variable (for range)
|
||
|
C --FIXCON - true iff contour parameters are fixed
|
||
|
REAL FMINC, FMAXC
|
||
|
SAVE FMINC, FMAXC
|
||
|
C --FMINC, FMAXC - the minimum and maximum variable values,
|
||
|
C -- saved to recalculate contour range
|
||
|
|
||
|
CHARACTER*(MXSTLN) CMDTBL(29)
|
||
|
INTEGER IVWTBL, NVWTBL
|
||
|
SAVE CMDTBL, IVWTBL, NVWTBL
|
||
|
C --CMDTBL - the command table
|
||
|
C --IVWTBL - the VIEW command table starting index
|
||
|
C --NVWTBL - the number of entries in the VIEW command table
|
||
|
|
||
|
DATA FIRST / .TRUE. /
|
||
|
|
||
|
DATA IVWTBL, NVWTBL / 1, 0 /
|
||
|
|
||
|
C --Command table follows. The "VIEW" entry starts the VIEW
|
||
|
C --command table, and all VIEW commands (and only these commands)
|
||
|
C --must follow this entry. The table is ended by a blank entry.
|
||
|
C --Remember to change the dimensioned size when changing the table.
|
||
|
C --Lowercase entries are for obsolete commands; they are converted to
|
||
|
C --uppercase before use.
|
||
|
DATA CMDTBL /
|
||
|
1 'NCNTRS ', 'CRANGE ', 'CMIN ', 'CMAX ',
|
||
|
2 'CSHIFT ', 'DELCNTR ', 'CINTV ', 'CLABEL ',
|
||
|
3 'lines ', 'COPEN ', 'DISPVAR ', 'opencntr',
|
||
|
4 'CSYMBOLS', 'minmax ', 'VSCALE ', 'vecscl ', 'CGLOBAL ',
|
||
|
5 'VIEW ', 'WIREFRAM', 'SOLID ',
|
||
|
6 'CONTOUR ', 'PAINT ', 'EPAINT ',
|
||
|
7 'VECTOR ', 'SYMBOL ', 'GAUSS ',
|
||
|
8 'deform ', 'undeform',
|
||
|
9 ' ' /
|
||
|
|
||
|
C --Find the command verb, which may be a variable name
|
||
|
|
||
|
WORD = INVERB
|
||
|
CALL ABRSTR (VERB, WORD, CMDTBL)
|
||
|
|
||
|
IF (VERB .NE. ' ') THEN
|
||
|
VWCMD = (LOCSTR (VERB, NVWTBL, CMDTBL(IVWTBL)) .GT. 0)
|
||
|
ELSE
|
||
|
CALL DBVIX_BL ('N', 1, INV)
|
||
|
CALL DBVIX_BL ('E', 1, IEV)
|
||
|
if (inv .gt. 0) then
|
||
|
inl = LOCSTR (WORD, NVARNP, NAMES(INV)) .GT. 0
|
||
|
else
|
||
|
inl = .FALSE.
|
||
|
end if
|
||
|
if (iev .gt. 0) then
|
||
|
ine = LOCSTR (WORD, NVAREL, NAMES(IEV)) .GT. 0
|
||
|
else
|
||
|
ine = .FALSE.
|
||
|
end if
|
||
|
if (inl .or. ine) then
|
||
|
VERB = ' '
|
||
|
VWCMD = .TRUE.
|
||
|
IFLD = IFLD - 1
|
||
|
ELSE
|
||
|
VERB = WORD
|
||
|
VWCMD = .FALSE.
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
VERB2 = ' '
|
||
|
|
||
|
C -- CHECK FOR AXIS ONLY PLOTTING
|
||
|
IF(VERB .EQ. 'plot') THEN
|
||
|
IF( MATSTR(CFIELD(IFLD),'AXIS', 2)) THEN
|
||
|
AXONLY = .TRUE.
|
||
|
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
|
||
|
|
||
|
C --Change the command table to upper case
|
||
|
|
||
|
L = LOCSTR (' ', 999, CMDTBL) - 1
|
||
|
DO 100 I = 1, L
|
||
|
CALL EXUPCS (CMDTBL(I))
|
||
|
100 CONTINUE
|
||
|
|
||
|
C --Find the starting entry in the VIEW table
|
||
|
|
||
|
IVWTBL = LOCSTR ('VIEW', 999, CMDTBL)
|
||
|
NVWTBL = LOCSTR (' ', 999, CMDTBL(IVWTBL)) - 1
|
||
|
|
||
|
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
|
||
|
|
||
|
C --Set default magnification factor
|
||
|
|
||
|
DEFPRO = .TRUE.
|
||
|
IF (DFAC .EQ. 0.0) DFAC = DDFAC
|
||
|
CALL SCALAX
|
||
|
|
||
|
C --Set deformed wireframe mode on all views
|
||
|
|
||
|
CALL INIINT (3, 1, LTYP)
|
||
|
CALL SETMSH (0, 'DEFORM', 'NONE', MSHSEL, LTYP,
|
||
|
& 0, IDUM, 0, IDUM, 'WIREFRAM', ' ', ISSNPS, ISSESS)
|
||
|
END IF
|
||
|
|
||
|
C --Reset parameters
|
||
|
|
||
|
IF ((VERB .EQ. 'reset') .OR. (VERB .EQ. 'initres')) THEN
|
||
|
|
||
|
IF (VERB .EQ. 'reset') THEN
|
||
|
C --Set list of display variables
|
||
|
CALL DISPV (.TRUE., INLINE, IFLD, INTYP,
|
||
|
& CFIELD, NAMES, LIDSP, NAMLEN)
|
||
|
ENDIF
|
||
|
|
||
|
C --Set default magnification factor
|
||
|
|
||
|
DEFPRO = .TRUE.
|
||
|
IF (DFAC .EQ. 0.0) DFAC = DDFAC
|
||
|
CALL SCALAX
|
||
|
|
||
|
C --Set wireframe on all defined views
|
||
|
|
||
|
CALL INIINT (3, 1, LTYP)
|
||
|
CALL SETMSH (0, 'DEFORM', 'NONE', MSHSEL, LTYP,
|
||
|
& 0, IDUM, 0, IDUM, 'WIREFRAM', ' ', ISSNPS, ISSESS)
|
||
|
|
||
|
CALL INIINT (4, 0, IDTVAR)
|
||
|
CALL INIINT (4, 0, NVOLD)
|
||
|
|
||
|
NCOLD = 0
|
||
|
FIXCON = .FALSE.
|
||
|
CINTOK = .FALSE.
|
||
|
CALL INIREA (256, 0.0, CINTV)
|
||
|
LINCON = .TRUE.
|
||
|
NCNTR = 6
|
||
|
CMIN = 0.0
|
||
|
CMAX = 0.0
|
||
|
DELC = 0.0
|
||
|
|
||
|
C --Set display options
|
||
|
|
||
|
LABINC = 0
|
||
|
NOCMIN = .FALSE.
|
||
|
NOCMAX = .FALSE.
|
||
|
MAXMIN = 10
|
||
|
MAXMAX = 10
|
||
|
|
||
|
VECSCL = 1.0
|
||
|
|
||
|
FIRST = .FALSE.
|
||
|
END IF
|
||
|
|
||
|
C --Initialize for new plot set
|
||
|
|
||
|
IF (VERB .EQ. 'postplot') THEN
|
||
|
CONTINUE
|
||
|
END IF
|
||
|
|
||
|
VERB = ' '
|
||
|
|
||
|
C *** Display mode control ***
|
||
|
|
||
|
ELSE IF (VWCMD) THEN
|
||
|
INVERB = ' '
|
||
|
|
||
|
C --Set up the view number
|
||
|
CALL CMDVWC (VERB, INLINE,
|
||
|
& IFLD, INTYP, CFIELD, IFIELD, RFIELD,
|
||
|
& IVIEW, JVIEW, *150)
|
||
|
|
||
|
IF (VERB .NE. ' ') THEN
|
||
|
WORD = VERB
|
||
|
CALL ABRSTR (VERB, WORD, CMDTBL(IVWTBL))
|
||
|
IF (VERB .EQ. ' ') THEN
|
||
|
IF ((LOCSTR (WORD, NVARNP, NAMES(INV)) .GT. 0)
|
||
|
& .OR. (LOCSTR (WORD, NVAREL, NAMES(IEV)) .GT. 0)) THEN
|
||
|
VERB = ' '
|
||
|
IFLD = IFLD - 1
|
||
|
ELSE
|
||
|
VERB = 'VIEW'
|
||
|
CALL PRTERR ('CMDERR',
|
||
|
& 'Expected view-dependent command')
|
||
|
GOTO 150
|
||
|
END IF
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
CALL CMDMOD (VERB, VERB2, INLINE(1),
|
||
|
& IFLD, INTYP, CFIELD, IFIELD, RFIELD,
|
||
|
& IVIEW, JVIEW, NAMES, NVOLD, NCOLD, FIXCON, VECSCL,
|
||
|
& ISSNPS, ISSESS, *150)
|
||
|
|
||
|
ELSE IF (VERB .EQ. 'newmod') THEN
|
||
|
INVERB = ' '
|
||
|
|
||
|
ISON = .FALSE.
|
||
|
DO 110 I = 1, 4
|
||
|
IF (NEWMOD(I) .LT. 0) THEN
|
||
|
CONTINUE
|
||
|
ELSE IF (NEWMOD(I) .EQ. 0) THEN
|
||
|
ISON = .TRUE.
|
||
|
IF ((MSHDEF(I) .EQ. 'NONE')
|
||
|
& .OR. (MSHDEF(I) .EQ. 'EMPTY')) THEN
|
||
|
CALL SETMOD (I, 'NONE', ' ')
|
||
|
ELSE
|
||
|
CALL SETMOD (I, 'WIREFRAM', ' ')
|
||
|
END IF
|
||
|
ELSE
|
||
|
ISON = .TRUE.
|
||
|
J = NEWMOD(I)
|
||
|
IF ((MSHDEF(J) .EQ. 'NONE')
|
||
|
& .OR. (MSHDEF(J) .EQ. 'EMPTY')) THEN
|
||
|
CALL SETMOD (I, 'NONE', ' ')
|
||
|
ELSE
|
||
|
CALL SETMOD (I, MODDET(J), MODTYP(J))
|
||
|
END IF
|
||
|
END IF
|
||
|
110 CONTINUE
|
||
|
|
||
|
VERB = ' '
|
||
|
IF (ISON) VERB = 'PLOT'
|
||
|
VWCMD = .TRUE.
|
||
|
|
||
|
ELSE IF (VERB .EQ. 'newele') THEN
|
||
|
INVERB = ' '
|
||
|
|
||
|
VERB = ' '
|
||
|
VWCMD = .TRUE.
|
||
|
|
||
|
C --Force all element variables to be re-scaled
|
||
|
DO 120 I = 1, 4
|
||
|
CALL DBVTYP_BL (IDTVAR(I), TYP, IDUM)
|
||
|
IF (TYP .EQ. 'E') NVOLD(I) = 0
|
||
|
120 CONTINUE
|
||
|
|
||
|
C --Force the contour range to be re-calculated (if element variable)
|
||
|
CALL DBVTYP_BL (IDTVAR(1), TYP, IDUM)
|
||
|
IF ((.NOT. FIXCON) .AND. (TYP .EQ. 'E')) NCOLD = 0
|
||
|
|
||
|
C *** Contour control ***
|
||
|
|
||
|
ELSE IF ((VERB .EQ. 'NCNTRS') .OR. (VERB .EQ. 'CRANGE')
|
||
|
& .OR. (VERB .EQ. 'CMIN') .OR. (VERB .EQ. 'CMAX')
|
||
|
& .OR. (VERB .EQ. 'CSHIFT') .OR. (VERB .EQ. 'DELCNTR')
|
||
|
& .OR. (VERB .EQ. 'CINTV')) THEN
|
||
|
INVERB = ' '
|
||
|
|
||
|
CALL CMDCON (VERB, INLINE(1), IFLD, INTYP,
|
||
|
& IFIELD, RFIELD, *150)
|
||
|
|
||
|
C --Fix the contour type
|
||
|
FIXCON = .TRUE.
|
||
|
IEXCON=0
|
||
|
|
||
|
ELSE IF (VERB .EQ. 'CGLOBAL')THEN
|
||
|
C CGLOBAL toggles the flag for using the globally defined contours
|
||
|
C or setting to contour limits to the exact (plus/minus epsilon)
|
||
|
C values for the plot being drawn
|
||
|
IF(IEXCON.EQ.0)THEN
|
||
|
IEXCON=1
|
||
|
CALL PRTERR('CMDSPEC','Using exact contour values'
|
||
|
& //' for each plot.')
|
||
|
ELSEIF(IEXCON.EQ.1)THEN
|
||
|
CALL PRTERR('CMDSPEC','Using global contour values'
|
||
|
& //' for each plot.')
|
||
|
IEXCON=0
|
||
|
ENDIF
|
||
|
INVERB = ' '
|
||
|
|
||
|
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 = ' '
|
||
|
|
||
|
ELSE IF ((VERB .EQ. 'CLABEL') .or. (verb .eq. 'LINES')) THEN
|
||
|
if (verb .eq. 'LINES') then
|
||
|
call prterr ('CMDREQ', 'Please use the CLABEL command')
|
||
|
verb = 'CLABEL'
|
||
|
end if
|
||
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
|
||
|
INVERB = ' '
|
||
|
|
||
|
IF (FFNUMB (IFLD, INTYP)) THEN
|
||
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
& 'labeling density', 0, LABINC, *150)
|
||
|
CALL FFADDI (LABINC, INLINE(1))
|
||
|
ELSE
|
||
|
CALL FFCHAR (IFLD, INTYP, CFIELD, 'ON', WORD)
|
||
|
IF (MATSTR (WORD, 'ON', 2)) THEN
|
||
|
CALL FFADDC ('ON', INLINE(1))
|
||
|
LABINC = 0
|
||
|
ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
|
||
|
CALL FFADDC ('OFF', INLINE(1))
|
||
|
LABINC = -1
|
||
|
ELSE
|
||
|
CALL PRTERR ('CMDERR',
|
||
|
& 'Expected "ON", "OFF" or contour labeling density')
|
||
|
GOTO 150
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
ELSE IF ((VERB .EQ. 'COPEN') .or. (verb .eq. 'OPENCNTR')) THEN
|
||
|
if (verb .eq. 'OPENCNTR') then
|
||
|
call prterr ('CMDREQ', 'Please use the command COPEN')
|
||
|
verb = 'COPEN'
|
||
|
end if
|
||
|
|
||
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
INVERB = ' '
|
||
|
|
||
|
CALL FFONOF (IFLD, INTYP, CFIELD, NOCMIN, *150)
|
||
|
CALL FFADDO (NOCMIN, INLINE(1))
|
||
|
CALL FFONOF (IFLD, INTYP, CFIELD, NOCMAX, *150)
|
||
|
CALL FFADDO (NOCMAX, INLINE(1))
|
||
|
|
||
|
ELSE IF ((VERB .EQ. 'CSYMBOLS') .or. (verb .eq. 'MINMAX')) THEN
|
||
|
if (verb .eq. 'MINMAX') then
|
||
|
call prterr ('CMDREQ', 'Please use the command CSYMBOLS')
|
||
|
verb = 'CSYMBOLS'
|
||
|
end if
|
||
|
|
||
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
INVERB = ' '
|
||
|
|
||
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
& 'maximum number of minimums', 10, MM, *150)
|
||
|
CALL FFADDI (MM, INLINE(1))
|
||
|
CALL FFINTG (IFLD, INTYP, IFIELD,
|
||
|
& 'maximum number of maximums', MM, MAXMAX, *150)
|
||
|
CALL FFADDI (MAXMAX, INLINE(1))
|
||
|
MAXMIN = MM
|
||
|
|
||
|
ELSE IF ((VERB .EQ. 'VSCALE') .or. (VERB .EQ. 'VECSCL')) THEN
|
||
|
if (verb .eq. 'VECSCL') then
|
||
|
call prterr ('CMDREQ', 'Please use the command VSCALE')
|
||
|
verb = 'VSCALE'
|
||
|
end if
|
||
|
|
||
|
CALL FFADDC (VERB, INLINE(1))
|
||
|
INVERB = ' '
|
||
|
|
||
|
CALL FFREAL (IFLD, INTYP, RFIELD,
|
||
|
& 'vector/symbol scale factor', 1.0, VECSCL, *150)
|
||
|
CALL FFADDR (VECSCL, INLINE(1))
|
||
|
|
||
|
ELSE IF ((VERB .EQ. 'color') .OR. (VERB .EQ. 'spectrum')) THEN
|
||
|
VERB = ' '
|
||
|
|
||
|
C --Reset the number of contours when the colors change
|
||
|
|
||
|
IF (.NOT. CINTOK) THEN
|
||
|
NCOL = 0
|
||
|
IF (VERB .EQ. 'color') THEN
|
||
|
DO 130 IDEV = 1, 2
|
||
|
CALL GRGPARD ('DEVICE', IDEV, ISON, WORD)
|
||
|
IF (ISON) THEN
|
||
|
CALL GRGPAR ('SPECTRUM', IDEV, IFIELD, WORD)
|
||
|
IF (IFIELD(3) .GT. 0) NCOL = -999
|
||
|
END IF
|
||
|
130 CONTINUE
|
||
|
END IF
|
||
|
IF (NCOL .EQ. 0) THEN
|
||
|
DO 140 IDEV = 1, 2
|
||
|
CALL GRGPARD ('DEVICE', IDEV, ISON, WORD)
|
||
|
IF (ISON) THEN
|
||
|
CALL GRGPAR ('SPECTRUM', IDEV, IFIELD, WORD)
|
||
|
NCOL = MAX (NCOL, IFIELD(1))
|
||
|
END IF
|
||
|
140 CONTINUE
|
||
|
END IF
|
||
|
IF ((NCOL .GT. 0) .AND. (NCNTR .NE. NCOL)) THEN
|
||
|
NCNTR = NCOL
|
||
|
IF (NCNTR .GE. 256) THEN
|
||
|
CALL PRTERR ('CMDWARN',
|
||
|
& 'Number of contours reduced to 255')
|
||
|
NCNTR = 255
|
||
|
END IF
|
||
|
IF (.NOT. FIXCON) THEN
|
||
|
VWCMD = .TRUE.
|
||
|
NCOLD = 0
|
||
|
ELSE
|
||
|
CALL ADJCON (.FALSE.)
|
||
|
VERB = 'NCNTRS'
|
||
|
END IF
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
ELSE IF ((VERB .EQ. 'plot') .OR. (VERB .EQ. 'hardcopy')) THEN
|
||
|
|
||
|
IF (NPTIMS .LE. 0) THEN
|
||
|
CALL PRTERR ('CMDERR', 'No times are selected')
|
||
|
VERB = ' '
|
||
|
GOTO 150
|
||
|
END IF
|
||
|
CALL CHKVAR (MODDET, MODTYP, -999, IDTVAR, NVOLD,
|
||
|
& NNDVAR, NEDVAR, ISON)
|
||
|
IF (.NOT. ISON) THEN
|
||
|
VERB = 'PLOT'
|
||
|
GOTO 150
|
||
|
END IF
|
||
|
|
||
|
VERB = ' '
|
||
|
|
||
|
C *** Information ***
|
||
|
|
||
|
ELSE IF (VERB .EQ. 'show') THEN
|
||
|
VERB = ' '
|
||
|
|
||
|
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 DTSHOW (VERB, NAMES, LIDSP)
|
||
|
INVERB = ' '
|
||
|
END IF
|
||
|
VERB = ' '
|
||
|
|
||
|
ELSE IF (VERB .EQ. 'help') THEN
|
||
|
VERB = ' '
|
||
|
|
||
|
ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
|
||
|
IF (.NOT. ISON) THEN
|
||
|
CALL SHOCMD ('DETOUR Commands', CMDTBL)
|
||
|
END IF
|
||
|
|
||
|
ELSE
|
||
|
VERB = ' '
|
||
|
END IF
|
||
|
|
||
|
GOTO 160
|
||
|
|
||
|
150 CONTINUE
|
||
|
INLINE(1) = ' '
|
||
|
|
||
|
160 CONTINUE
|
||
|
IF (VERB .NE. ' ') THEN
|
||
|
CALL DTSHOW (VERB, NAMES, LIDSP)
|
||
|
ELSE
|
||
|
VERB2 = ' '
|
||
|
END IF
|
||
|
|
||
|
IF (VWCMD) THEN
|
||
|
|
||
|
C --Scale requested variable
|
||
|
|
||
|
NNEDVAR = MAX (NNDVAR, NEDVAR)
|
||
|
|
||
|
DO 170 IVAR = 1, NNEDVAR
|
||
|
IF (IDTVAR(IVAR) .NE. NVOLD(IVAR)) THEN
|
||
|
IF (IDTVAR(IVAR) .EQ. 0) THEN
|
||
|
FMIN = 0.0
|
||
|
FMAX = 0.0
|
||
|
ELSE
|
||
|
CALL SCALER (A, A, 1, NAMES(IDTVAR(IVAR)),
|
||
|
* IDTVAR(IVAR),
|
||
|
& .TRUE., IELBST, NALVAR, FMIN, FMAX, MAPEL, MAPND)
|
||
|
END IF
|
||
|
|
||
|
IF (IVAR .EQ. 1) THEN
|
||
|
FMINC = FMIN
|
||
|
FMAXC = FMAX
|
||
|
END IF
|
||
|
|
||
|
NVOLD(IVAR) = IDTVAR(IVAR)
|
||
|
END IF
|
||
|
170 CONTINUE
|
||
|
|
||
|
C --Compute contour range, if changed
|
||
|
|
||
|
IF (((NUMMOD (MODDET, ' ', 'CONTOUR', ' ') .GE. 1)
|
||
|
& .OR. (NUMMOD (MODDET, ' ', 'ELEMCONT', ' ') .GE. 1))
|
||
|
& .AND. (IDTVAR(1) .GT. 0)) THEN
|
||
|
ISON = (NUMMOD (MODDET, MODTYP, 'CONTOUR', 'LINE') .GE. 1)
|
||
|
& .OR. (NUMMOD (MODDET, MODTYP, 'ELEMCONT', 'LINE') .GE. 1)
|
||
|
IF ((IDTVAR(1) .NE. NCOLD) .OR.
|
||
|
& ((.NOT. FIXCON) .AND. (ISON .NEQV. LINCON))) THEN
|
||
|
C --Recompute and display contour parameters
|
||
|
CINTOK = .FALSE.
|
||
|
CALL CONRNG (ISON, FMINC, FMAXC, NCNTR, DELC, CMIN, CMAX)
|
||
|
NCOLD = IDTVAR(1)
|
||
|
LINCON = ISON
|
||
|
IF (VERB2 .EQ. ' ') VERB2 = 'CMIN'
|
||
|
ELSE IF (ISON .NEQV. LINCON) THEN
|
||
|
C --Recompute CMAX for current parameters if changed from
|
||
|
C --line to painted contours
|
||
|
LINCON = ISON
|
||
|
CALL ADJCON (.TRUE.)
|
||
|
END IF
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
IF (VERB2 .NE. ' ') THEN
|
||
|
CALL DTSHOW (VERB2, NAMES, LIDSP)
|
||
|
END IF
|
||
|
|
||
|
RETURN
|
||
|
END
|