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 TPPLOT (NEUTRL, MAXPTS, NPTS, TIMLIM, PLTVAL,
& NAMES, BLKCOL, MAPEL, MAPND)
C=======================================================================
C --*** TPPLOT *** (TPLOT) Plot the curves
C -- Written by Amy Gilkey - revised 01/22/88
C --
C --TPPLOT does all the plotting for a set, including labeling.
C --It also calculates the scaling information for each curve.
C --
C --Parameters:
C -- NEUTRL - IN - the type of neutral file to write.
C -- MAXPTS - IN - the maximum number of points on a curve
C -- NPTS - IN - the number of points on each curve
C -- TIMLIM - IN - the starting and ending time
C -- PLTVAL - IN - the plot data;
C -- PLTVAL(x,NTPVAR+1) holds the times if TIMPLT
C -- PLTVAL(x,NTPVAR+2) holds the compressed times if TIMPLT and needed
C -- NAMES - IN - the variable names
C -- BLKCOL - IN/OUT - the user selected colors of the element blocks.
C -- BLKCOL(0) = 1 if the user defined material
C -- colors should be used in mesh plots.
C -- = -1 if program selected colors should
C -- be used.
C -- BLKCOL(i) = the user selected color of element
C -- block i:
C -- -2 - no color selected by user.
C -- -1 - black
C -- 0 - white
C -- 1 - red
C -- 2 - green
C -- 3 - yellow
C -- 4 - blue
C -- 5 - cyan
C -- 6 - magenta
C --
C --Common Variables:
C -- Uses NTPCRV, NTPVAR, TIMPLT of /TPVARS/
C -- Uses DOGRID, LINTYP, ISYTYP, OVERLY of /XYOPT/
C -- Sets XMIN, XMAX, YMIN, YMAX of /XYLIM/
PARAMETER (NUMSYM = 6, NUMLIN = 6)
include 'params.blk'
include 'neutral.blk'
include 'dbnums.blk'
include 'tpvars.blk'
include 'xyopt.blk'
include 'xylim.blk'
INTEGER NPTS(NTPVAR)
REAL TIMLIM(2)
REAL PLTVAL(MAXPTS,NTPVAR+2)
CHARACTER*(*) NAMES(*)
INTEGER BLKCOL(0:NELBLK)
INTEGER MAPEL(*), MAPND(*)
LOGICAL GRABRT, gobck
LOGICAL SCACRV
LOGICAL NUMCRV
LOGICAL DOLEG
CHARACTER*1024 PLTITL
CHARACTER*1024 TXLAB, TYLAB
LOGICAL SVOVER
CHARACTER*8 SVLSID
C --Save user-set parameters and set program parameters (to eliminate
C --checks for senseless conditions)
SVOVER = OVERLY
SVLSID = LABSID
IF ((NEUTRL .NE. 0) .OR. (NTPCRV .LE. 1)) OVERLY = .FALSE.
IF (IXSCAL .NE. 'SET') THEN
IXSCAL = IAXSCA
IF (TIMPLT) THEN
IXSCAL = 'ALL'
ELSE IF (NEUTRL .NE. 0) THEN
IXSCAL = 'CURVE'
ELSE IF (NTPCRV .EQ. 1) THEN
IXSCAL = 'ALL'
ELSE IF (OVERLY) THEN
IF (IXSCAL .EQ. 'PLOT') IXSCAL = 'ALL'
ELSE
IF (IXSCAL .EQ. 'CURVE') IXSCAL = 'PLOT'
END IF
END IF
IF (IYSCAL .NE. 'SET') THEN
IYSCAL = IAXSCA
IF (NEUTRL .NE. 0) THEN
IYSCAL = 'CURVE'
ELSE IF (NTPCRV .EQ. 1) THEN
IYSCAL = 'ALL'
ELSE IF (OVERLY) THEN
IF (IYSCAL .EQ. 'PLOT') IYSCAL = 'ALL'
ELSE
IF (IYSCAL .EQ. 'CURVE') IYSCAL = 'PLOT'
END IF
END IF
IF ((.NOT. OVERLY)
& .OR. ((ISYTYP .LT. 0) .AND. (NUMSYM .GE. NTPCRV))
& .OR. ((LINTYP .LT. 0) .AND. (NUMLIN .GE. NTPCRV)))
& LABSID = 'NONE'
NUMCRV = (LABSID .NE. 'NONE')
C --Calculate axis limits if same scale
IF (IXSCAL .EQ. 'ALL') THEN
IF (TIMPLT) THEN
CALL MINMAX (MAXPTS, PLTVAL(1,NTPVAR+1), XMIN, XMAX)
ELSE
CALL CRVLIM ('X', TIMPLT, MAXPTS, NPTS, 1, NTPVAR, PLTVAL)
END IF
IF (NEUTRL .EQ. 0)
* CALL EXPMAX (LABSID, XMIN, XMAX)
END IF
IF (IYSCAL .EQ. 'ALL') THEN
CALL CRVLIM ('Y', TIMPLT, MAXPTS, NPTS, 1, NTPVAR, PLTVAL)
IF (NEUTRL .EQ. 0)
* CALL EXPMAX (' ', YMIN, YMAX)
END IF
SCACRV = (IXSCAL .EQ. 'CURVE') .OR. (IYSCAL .EQ. 'CURVE')
C --Label plot if overlaid
100 CONTINUE
IF (OVERLY) THEN
CALL TPLAB (1, NTPCRV, NUMCRV, TIMLIM, NAMES,
& TXLAB, TYLAB, BLKCOL, MAPEL, MAPND, *130)
IF (.NOT. SCACRV)
& CALL XYAXIS (0, DOGRID, TXLAB, TYLAB, BLKCOL, *130)
END IF
gobck = .false.
if (neutrl .ne. csv .and. neutrl .ne. raw) then
N = 1
np = 1
120 continue
IF (TIMPLT) THEN
IF (NPTS(N) .EQ. MAXPTS) THEN
NX = NTPVAR+1
ELSE
NX = NTPVAR+2
END IF
NY = N
ELSE
NX = N
NY = N+1
END IF
C --Calculate min/max if needed
IF ((IXSCAL .EQ. 'PLOT') .OR. (IXSCAL .EQ. 'CURVE')) THEN
CALL CRVLIM ('X', TIMPLT, MAXPTS, NPTS, N, NY, PLTVAL)
IF (NEUTRL .EQ. 0)
* CALL EXPMAX (LABSID, XMIN, XMAX)
END IF
IF ((IYSCAL .EQ. 'PLOT') .OR. (IYSCAL .EQ. 'CURVE')) THEN
CALL CRVLIM ('Y', TIMPLT, MAXPTS, NPTS, N, NY, PLTVAL)
IF (NEUTRL .EQ. 0)
* CALL EXPMAX (' ', YMIN, YMAX)
END IF
IF (OVERLY) THEN
IF (SCACRV)
& CALL XYAXIS (NP, DOGRID, TXLAB, TYLAB, BLKCOL, *130)
END IF
IF (NEUTRL .EQ. 0) THEN
C --Label plot if needed
110 CONTINUE
IF (.NOT. OVERLY) THEN
CALL TPLAB (N, 1, NUMCRV, TIMLIM, NAMES,
& TXLAB, TYLAB, BLKCOL, MAPEL, MAPND, *130)
CALL XYAXIS (0, DOGRID, TXLAB, TYLAB, BLKCOL, *130)
END IF
IF (GRABRT()) GOTO 130
IF (OVERLY) THEN
CALL GRCOLR (NP)
CALL GRSYMB (LINTYP, ISYTYP, NP)
ELSE
CALL GRCOLR (1)
CALL GRSYMB (LINTYP, ISYTYP, 1)
END IF
C --Plot variable against time or variable against variable
IF (GRABRT()) GOTO 130
CALL PLTCUR (PLTVAL(1,NX), PLTVAL(1,NY), NPTS(N))
IF (NUMCRV) THEN
IF (GRABRT()) GOTO 130
CALL GRNCRV (LABSID, NP, NPTS(N),
& PLTVAL(1,NX), PLTVAL(1,NY), (LINTYP .EQ. 0))
END IF
C --Finish plot
IF (OVERLY) THEN
CALL PLTFLU
gobck = .false.
END IF
IF (.NOT. OVERLY) THEN
C --Set color in case text is requested
CALL UGRCOL (0, BLKCOL)
gobck = .true.
CALL GRPEND (.TRUE., .TRUE., NP, NTPCRV, GOBCK,
$ *110, *130)
END IF
ELSE
gobck = .false.
C --Get plot labels
CALL TPLABN (N, TIMLIM, NAMES, PLTITL, TXLAB, TYLAB,
* MAPEL, MAPND)
C --Plot variable against time or variable against variable
IF (NEUTRL .EQ. XMGR) THEN
CALL WRTNEU (NPTS(N), PLTVAL(1,NX), PLTVAL(1,NY),
& PLTITL, TXLAB, TYLAB)
ELSE IF (NEUTRL .EQ. GRAF) THEN
CALL GRFNEU (NPTS(N), PLTVAL(1,NX), PLTVAL(1,NY),
& PLTITL, TXLAB, TYLAB)
END IF
END IF
if (gobck) then
n = ny -1
np = np - 1
if (n .lt. 1) n = 1
if (np .lt. 1) np = 1
else
N = NY+1
np = np + 1
end if
if (np .le. ntpcrv) go to 120
else
if (neutrl .eq. csv) then
doleg = .true.
else
doleg = .false.
end if
C ... CSV format neutral file selected...
CALL TPLABN (1, TIMLIM, NAMES, PLTITL, TXLAB, TYLAB,
* MAPEL, MAPND)
call wrtcsv(ntpcrv, maxpts, npts, pltval, txlab, names, doleg,
* MAPEL, MAPND)
end if
C --Finish overlaid plot
IF (OVERLY) THEN
C --Set color in case text is requested
CALL UGRCOL (0, BLKCOL)
CALL GRPEND (.TRUE., .TRUE., 0, 0, .FALSE., *100, *130)
END IF
130 CONTINUE
C --Restore user-set parameters
OVERLY = SVOVER
LABSID = SVLSID
IF (IXSCAL .NE. 'SET') IXSCAL = IAXSCA
IF (IYSCAL .NE. 'SET') IYSCAL = IAXSCA
RETURN
END