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.
 
 
 
 
 
 

596 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 XYCOMD (A, CURPRO, INLINE,
& INVERB, IFLD, INTYP, CFIELD, IFIELD, RFIELD,
& MESHOK)
C=======================================================================
C --*** XYCOMD *** (XYPLOT) Process XY-plot commands
C -- Written by Amy Gilkey - revised 02/23/88
C --
C --XYCOMD interprets XY-plot commands.
C --
C --The commands are listed below with their parameters and their
C --function.
C --
C --Axis size and scaling
C -- RATIOXY {ratio} Set X to Y axis ratio
C -- XSCALE {xmin,xmax} Set X axis scale
C -- YSCALE {ymin,ymax} Set Y axis scale
C -- XTICK {xtick} Set X axis tick interval
C -- YTICK {ytick} Set Y axis tick interval
C -- XLABEL Set X axis label (on following line)
C -- YLABEL Set Y axis label (on following line)
C -- xaxis Reset X axis parameters
C -- yaxis Reset Y axis parameters
C -- xyaxis Reset X and Y axis parameters
C --
C --Neutral file options
C -- ACURVE {crvnam} Set neutral file curve name
C -- NCURVE {numcrv,inccrv} Set neutral file curve number and increment
C --
C --Display options
C -- GRID {ON/OFF} Draw grid on plot if ON
C -- LINES {ON/OFF/VARY} Plot line, none or vary line
C -- SYMBOLS {ON/OFF/#} Plot varying symbols, none or specific symbol
C -- CRVNUM {FIRST/LAST/MIDDLE/OFF} Set curve numbering position
C -- OVERLAY {ON/OFF/VARIABLE/TIME} Curves for all variables or all time
C -- will be overlaid on one plot
C -- SAMESCAL {ON/OFF} Curves will have the same scale if ON
C -- NORMAL {ON/OFF} Curves will be normalized if ON
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 -- neutral Exit to write the plot set to neutral file
C --
C --Mesh display commands
C -- MESH Display mesh with numbering, zoom
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 -- CURPRO - IN - the current program name
C -- IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field
C -- reader index and fields
C -- MESHOK - IN - true iff mesh can be displayed
C --
C --Common Variables:
C -- Sets DOGRID, LINTYP, ISYTYP, LABSID, OVERLY, OVERTM,
C -- IAXSCA of /XYOPT/
C -- Sets ASPECT, IXSCAL, IYSCAL, XMIN, XMAX, YMIN, YMAX, XTICK, YTICK
C -- of /XYLIM/
C -- Sets XLAB, YLAB of /XYLAB/
C -- Sets NUMCRV, INCCRV and CRVNAM of /NEUTR./
PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4)
PARAMETER (NUMSYM = 6, NUMLIN = 6)
include 'params.blk'
include 'dbnums.blk'
include 'xyopt.blk'
include 'xylim.blk'
include 'xylab.blk'
include 'neutr.blk'
DIMENSION A(*)
CHARACTER*(*) CURPRO
CHARACTER*(*) INLINE(*)
CHARACTER*(*) INVERB
INTEGER INTYP(*)
CHARACTER*(*) CFIELD(*)
INTEGER IFIELD(*)
REAL RFIELD(*)
LOGICAL MESHOK
LOGICAL FFNUMB, MATSTR
CHARACTER*(MXSTLN) VERB, WORD
LOGICAL HELP
LOGICAL ISON
INTEGER IDUM
REAL RDUM
CHARACTER*(MXSTLN) CDUM
CHARACTER*8 PROMPT
INTEGER LPROM
LOGICAL FIRST
SAVE FIRST
C --FIRST - true iff first time through routine
LOGICAL XSCSET, YSCSET, XTCSET, YTCSET, XLBSET, YLBSET
SAVE XSCSET, YSCSET, XTCSET, YTCSET, XLBSET, YLBSET
C --These flags show whether an axis parameter has been set since
C -- the start of the plot set
CHARACTER*(MXSTLN) CMDTBL(18)
SAVE CMDTBL
C --CMDTBL - the valid commands table
DATA FIRST /.TRUE./
DATA IDUM / 1 /
C --Command table follows. Remember to change the dimensioned size when
C --changing the table.
DATA CMDTBL /
1 'RATIOXY ',
* 'XSCALE ',
* 'YSCALE ',
* 'XTICK ',
* 'YTICK ',
2 'XLABEL ',
* 'YLABEL ',
3 'ACURVE ',
* 'NCURVE ',
4 'GRID ',
* 'LINES ',
* 'SYMBOLS ',
* 'CRVNUM ',
5 'OVERLAY ',
* 'SAMESCALE ',
* 'NORMAL ',
6 'MESH ',
7 ' ' /
C --Get the command verb
WORD = INVERB
CALL ABRSTR (VERB, WORD, CMDTBL)
IF (VERB .EQ. ' ') VERB = WORD
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
IAXSCA = 'PLOT'
IXSCAL = IAXSCA
IYSCAL = IAXSCA
CRVNAM = ' '
NUMCRV = 1
INCCRV = 1
VERB = 'initres'
END IF
C --Initialize for program change
IF (VERB .EQ. 'initprog') THEN
C --Leave display options the same
C --Reset axis scaling and labeling
ASPECT = 1.0
IXSCAL = IAXSCA
IYSCAL = IAXSCA
XMIN = 0.0
XMAX = 0.0
YMIN = 0.0
YMAX = 0.0
XTICK = 0.0
YTICK = 0.0
XLAB = ' '
YLAB = ' '
END IF
C --Reset parameters
IF ((VERB .EQ. 'reset') .OR. (VERB .EQ. 'initres')) THEN
DOGRID = .FALSE.
LINTYP = 1
ISYTYP = 0
LABSID = 'LAST'
OVERLY = .FALSE.
OVERTM = .FALSE.
IAXSCA = 'PLOT'
ASPECT = 1.0
IXSCAL = IAXSCA
IYSCAL = IAXSCA
XMIN = 0.0
XMAX = 0.0
YMIN = 0.0
YMAX = 0.0
XTICK = 0.0
YTICK = 0.0
XLAB = ' '
YLAB = ' '
FIRST = .FALSE.
END IF
C --Initialize for new plot set
IF (VERB .EQ. 'postplot') THEN
CONTINUE
END IF
XSCSET = .FALSE.
YSCSET = .FALSE.
XTCSET = .FALSE.
YTCSET = .FALSE.
XLBSET = .FALSE.
YLBSET = .FALSE.
VERB = ' '
C *** Axis size and scaling ***
ELSE IF (VERB .EQ. 'RATIOXY') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFREAL (IFLD, INTYP, RFIELD,
& 'X to Y axis length ratio', 1.0, ASPECT, *100)
CALL FFADDR (ASPECT, INLINE(1))
ELSE IF (VERB .EQ. 'XSCALE') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
IXSCAL = IAXSCA
ELSE
CALL FFREAL (IFLD, INTYP, RFIELD,
& 'minimum axis value', XMIN, RMIN, *100)
CALL FFADDR (ASPECT, INLINE(1))
CALL FFREAL (IFLD, INTYP, RFIELD,
& 'maximum axis value', XMAX, RMAX, *100)
CALL FFADDR (ASPECT, INLINE(1))
IF (RMIN .GE. RMAX) THEN
CALL PRTERR ('CMDERR',
& 'Axis minimum must be less than axis maximum')
GOTO 100
END IF
XMIN = RMIN
XMAX = RMAX
IXSCAL = 'SET'
END IF
C --Mark the axis scaling as having been set
XSCSET = .TRUE.
ELSE IF (VERB .EQ. 'YSCALE') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
IYSCAL = IAXSCA
ELSE
CALL FFREAL (IFLD, INTYP, RFIELD,
& 'minimum axis value', YMIN, RMIN, *100)
CALL FFADDR (ASPECT, INLINE(1))
CALL FFREAL (IFLD, INTYP, RFIELD,
& 'maximum axis value', YMAX, RMAX, *100)
CALL FFADDR (ASPECT, INLINE(1))
IF (RMIN .GE. RMAX) THEN
CALL PRTERR ('CMDERR',
& 'Axis minimum must be less than axis maximum')
GOTO 100
END IF
YMIN = RMIN
YMAX = RMAX
IYSCAL = 'SET'
END IF
C --Mark the axis scaling as having been set
YSCSET = .TRUE.
ELSE IF (VERB .EQ. 'XTICK') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFREAL (IFLD, INTYP, RFIELD,
& 'tick interval', 0.0, XTICK, *100)
CALL FFADDR (ASPECT, INLINE(1))
C --Mark the axis tic mark as having been set
XTCSET = .TRUE.
ELSE IF (VERB .EQ. 'YTICK') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFREAL (IFLD, INTYP, RFIELD,
& 'tick interval', 0.0, YTICK, *100)
CALL FFADDR (ASPECT, INLINE(1))
C --Mark the axis tic mark as having been set
YTCSET = .TRUE.
ELSE IF (VERB .EQ. 'XLABEL') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
PROMPT = 'LABEL> '
LPROM = LENSTR (PROMPT) + 1
CALL GETINS ('line', IDUM, IDUM, IDUM, CDUM,
& IDUM, RDUM, XLAB, IOSTAT,
& PROMPT, LPROM, *100)
C CALL GETINP (0, 0, 'LABEL> ', XLAB, IOSTAT)
INLINE(2) = XLAB
C --Mark the axis label as having been set
XLBSET = .TRUE.
ELSE IF (VERB .EQ. 'YLABEL') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
PROMPT = 'LABEL> '
LPROM = LENSTR (PROMPT) + 1
CALL GETINS ('line', IDUM, IDUM, IDUM, CDUM,
& IDUM, RDUM, YLAB, IOSTAT,
& PROMPT, LPROM, *100)
C CALL GETINP (0, 0, 'LABEL> ', YLAB, IOSTAT)
INLINE(2) = YLAB
C --Mark the axis label as having been set
YLBSET = .TRUE.
ELSE IF ((VERB .EQ. 'xaxis') .OR. (VERB .EQ. 'yaxis')
& .OR. (VERB .EQ. 'xyaxis')) THEN
INVERB = ' '
IF ((VERB .EQ. 'xaxis') .OR. (VERB .EQ. 'xyaxis')) THEN
IF ((.NOT. XSCSET) .AND. (IXSCAL .EQ. 'SET')) THEN
CALL PRTERR ('CMDWARN',
& 'Automatic scaling selected for X axis')
IXSCAL = IAXSCA
END IF
IF ((.NOT. XTCSET) .AND. (XTICK .NE. 0.0)) THEN
CALL PRTERR ('CMDWARN',
& 'Automatic scaling selected for X axis tick interval')
XTICK = 0.0
END IF
IF ((.NOT. XLBSET) .AND. (XLAB .NE. ' ')) THEN
CALL PRTERR ('CMDWARN',
& 'Default label selected for X axis')
XLAB = ' '
END IF
END IF
IF ((VERB .EQ. 'yaxis') .OR. (VERB .EQ. 'xyaxis')) THEN
IF ((.NOT. YSCSET) .AND. (IYSCAL .EQ. 'SET')) THEN
CALL PRTERR ('CMDWARN',
& 'Automatic scaling selected for Y axis')
IYSCAL = IAXSCA
END IF
IF ((.NOT. YTCSET) .AND. (YTICK .NE. 0.0)) THEN
CALL PRTERR ('CMDWARN',
& 'Automatic scaling selected for Y axis tick interval')
YTICK = 0.0
END IF
IF ((.NOT. YLBSET) .AND. (YLAB .NE. ' ')) THEN
CALL PRTERR ('CMDWARN',
& 'Default label selected for Y axis')
YLAB = ' '
END IF
END IF
C *** Neutral file options ***
ELSE IF (VERB .EQ. 'ACURVE') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', CRVNAM)
CALL FFADDC (CRVNAM, INLINE(1))
ELSE IF (VERB .EQ. 'NCURVE') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFINTG (IFLD, INTYP, IFIELD,
& 'curve number', 1, NUMCRV, *100)
CALL FFADDI (NUMCRV, INLINE(1))
CALL FFINTG (IFLD, INTYP, IFIELD,
& 'curve number increment', 1, INCCRV, *100)
CALL FFADDI (NUMCRV, INLINE(1))
C *** Display options ***
ELSE IF (VERB .EQ. 'GRID') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFONOF (IFLD, INTYP, CFIELD, DOGRID, *100)
ELSE IF (VERB .EQ. 'LINES') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFCHAR (IFLD, INTYP, CFIELD, 'ON', WORD)
IF (MATSTR (WORD, 'ON', 2)) THEN
CALL FFADDC ('ON', INLINE(1))
LINTYP = 1
ELSE IF (MATSTR (WORD, 'VARY', 1)) THEN
CALL FFADDC ('VARY', INLINE(1))
LINTYP = -1
ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
CALL FFADDC ('OFF', INLINE(1))
LINTYP = 0
IF (ISYTYP .EQ. 0) ISYTYP = -1
ELSE
CALL PRTERR ('CMDERR', 'Expected "ON", "VARY" or "OFF"')
GOTO 100
END IF
ELSE IF (VERB .EQ. 'SYMBOLS') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (FFNUMB (IFLD, INTYP)) THEN
CALL FFINTG (IFLD, INTYP, IFIELD,
& 'symbol number', 1, ISY, *100)
CALL FFADDI (NUMCRV, INLINE(1))
ISYTYP = ISY
ELSE
CALL FFCHAR (IFLD, INTYP, CFIELD, 'ON', WORD)
IF (MATSTR (WORD, 'ON', 2)) THEN
CALL FFADDC ('ON', INLINE(1))
ISYTYP = -1
ELSE IF (MATSTR (WORD, 'VARY', 1)) THEN
CALL FFADDC ('VARY', INLINE(1))
ISYTYP = -1
ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
CALL FFADDC ('OFF', INLINE(1))
ISYTYP = 0
IF (LINTYP .EQ. 0) LINTYP = 1
ELSE
CALL PRTERR ('CMDERR',
& 'Expected "VARY", "OFF" or symbol number')
GOTO 100
END IF
END IF
ELSE IF (VERB .EQ. 'CRVNUM') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFCHAR (IFLD, INTYP, CFIELD, 'LAST', WORD)
IF (MATSTR (WORD, 'FIRST', 1)) THEN
CALL FFADDC ('FIRST', INLINE(1))
LABSID = 'FIRST'
ELSE IF (MATSTR (WORD, 'MIDDLE', 1)) THEN
CALL FFADDC ('MIDDLE', INLINE(1))
LABSID = 'MIDDLE'
ELSE IF (MATSTR (WORD, 'LAST', 1)) THEN
CALL FFADDC ('LAST', INLINE(1))
LABSID = 'LAST'
ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
CALL FFADDC ('OFF', INLINE(1))
LABSID = 'NONE'
ELSE
CALL PRTERR ('CMDERR',
& 'Expected "FIRST", "MIDDLE", "LAST" or "OFF"')
GOTO 100
END IF
ELSE IF (VERB .EQ. 'OVERLAY') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFCHAR (IFLD, INTYP, CFIELD, 'VARIABLE', WORD)
IF (MATSTR(WORD, 'VARIABLE', 1)
& .OR. MATSTR (WORD, 'ON', 2)) THEN
CALL FFADDC ('VARIABLE', INLINE(1))
OVERLY = .TRUE.
OVERTM = .FALSE.
ELSE IF (MATSTR (WORD, 'TIME', 1)) THEN
CALL FFADDC ('TIME', INLINE(1))
OVERLY = .FALSE.
OVERTM = .TRUE.
ELSE IF (MATSTR (WORD, 'OFF', 3)) THEN
CALL FFADDC ('OFF', INLINE(1))
OVERLY = .FALSE.
OVERTM = .FALSE.
ELSE
CALL PRTERR ('CMDERR',
& 'Expected "VARIABLE", "TIME" or "OFF"')
GOTO 100
END IF
ELSE IF (VERB .EQ. 'SAMESCAL') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFONOF (IFLD, INTYP, CFIELD, ISON, *100)
IF (ISON) THEN
IAXSCA = 'ALL'
ELSE
IAXSCA = 'PLOT'
END IF
IF (IXSCAL .NE. 'SET') IXSCAL = IAXSCA
IF (IYSCAL .NE. 'SET') IYSCAL = IAXSCA
ELSE IF (VERB .EQ. 'NORMAL') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
CALL FFONOF (IFLD, INTYP, CFIELD, ISON, *100)
IF (ISON) THEN
IAXSCA = 'CURVE'
ELSE
IAXSCA = 'PLOT'
END IF
IF (IXSCAL .NE. 'SET') IXSCAL = IAXSCA
IF (IYSCAL .NE. 'SET') IYSCAL = IAXSCA
C *** Curve display commands ***
ELSE IF ((VERB .EQ. 'plot') .OR. (VERB .EQ. 'hardcopy')
& .OR. (VERB .EQ. 'neutral')) THEN
CONTINUE
C *** Mesh display commands ***
ELSE IF (VERB .EQ. 'MESH') THEN
CALL FFADDC (VERB, INLINE(1))
INVERB = ' '
IF (.NOT. MESHOK) THEN
CALL PRTERR ('CMDERR', 'No mesh is defined')
GOTO 100
END IF
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 XYSHOW (VERB)
INVERB = ' '
END IF
VERB = ' '
ELSE IF (VERB .EQ. 'help') THEN
ISON = HELP ('BLOT', 'COMMANDS', CFIELD(IFLD))
IF (.NOT. ISON)
& CALL SHOCMD ('General XY-plot', CMDTBL)
VERB = ' '
ELSE
VERB = ' '
END IF
GOTO 110
100 CONTINUE
INLINE(1) = ' '
110 CONTINUE
IF (VERB .NE. ' ') THEN
CALL XYSHOW (VERB)
END IF
RETURN
END