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.
393 lines
13 KiB
393 lines
13 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 SPLAB (A, NPTIMS, IPTIMS, TIMES, NENUM,
|
|
& IPVAR, NCURVE, NUMCRV, NAMES, TXLAB, TYLAB, LIDSP,
|
|
& BLKCOL, MAPEL, MAPND, *)
|
|
C=======================================================================
|
|
|
|
C --*** SPLAB *** (SPLOT) Label plot
|
|
C -- Modified by John Glick - 11/9/88
|
|
C -- Written by Amy Gilkey - revised 05/02/88
|
|
C --
|
|
C --SPLAB erases the display surface then labels the plot legend
|
|
C --with the following:
|
|
C --
|
|
C -- BANNER - the title, creator, modifier, and drawn-by information.
|
|
C -- Constant for entire run. If QA only.
|
|
C -- CAPTION - the plot caption.
|
|
C -- LABEL - the node/element range, the plot variable names, the plot time.
|
|
C --
|
|
C --The vertical-to-horizontal aspect ratio is assumed to be 0.75.
|
|
C --Label locations are set for a horizontal layout.
|
|
C --
|
|
C --Parameters:
|
|
C -- A - IN - the dynamic memory base array
|
|
C -- NPTIMS - IN - the number of selected times
|
|
C -- IPTIMS - IN - the selected time steps
|
|
C -- TIMES - IN - the database times
|
|
C -- NENUM - IN - the selected node/element numbers
|
|
C -- IPVAR - IN - the /SPVARS/ index of the starting plot variable
|
|
C -- NCURVE - IN - the number of curves on the plot
|
|
C -- NUMCRV - IN - true iff curves are to be numbered
|
|
C -- NAMES - IN - the variable names
|
|
C -- TXLAB, TYLAB - OUT - labels for the X and Y axis
|
|
C -- LIDSP(0:*) - IN/OUT - the indices of the selected variables
|
|
C -- whose values will be displayed on the plot legend.
|
|
C -- ABS(LIDSP(0)) = the number of variables in the list.
|
|
C -- SIGN(LIDSP(0)) specifies whether the variables in the
|
|
C -- list should have their values displayed on
|
|
C -- the plot legend. If >0, they should;
|
|
C -- If <=0, they should not.
|
|
C -- LIDSP(i) identifies the ith variable in the list.
|
|
C -- If LIDSP(i) > 0, LIDSP(i) is the id of a history variable.
|
|
C -- If LIDSP(i) < 0, -LIDSP(i) is the id of a global variable.
|
|
C -- If LIDSP(i) = 0, TIME is to be displayed on the plot legend.
|
|
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 -- * - the return statement if the cancel function is active
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses TITLE, CREATE, MODIFY, DRAW of /DBTITL/
|
|
C -- Uses NODVAR, NNENUM of /SELNE/
|
|
C -- Uses ISVID of /SPVARS/
|
|
C -- Uses DOQA, DOLEG, CAPTN of /LEGOPT/
|
|
C -- Uses LINTYP, ISYTYP, OVERLY, OVERTM of /XYOPT/
|
|
C -- Uses XLAB, YLAB of /XYLAB/
|
|
C -- Uses CHLSIZ, DBORD0, DVIEW0 of /LAYOUT/
|
|
|
|
PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4)
|
|
|
|
PARAMETER (NUMSYM = 6, NUMLIN = 6)
|
|
|
|
include 'params.blk'
|
|
include 'dbtitl.blk'
|
|
include 'selne.blk'
|
|
include 'spvars.blk'
|
|
include 'legopt.blk'
|
|
include 'xyopt.blk'
|
|
include 'xylim.blk'
|
|
include 'xylab.blk'
|
|
include 'layout.blk'
|
|
include 'dbnums.blk'
|
|
|
|
common /debugc/ cdebug
|
|
common /debugn/ idebug
|
|
character*8 cdebug
|
|
|
|
DIMENSION A(*)
|
|
INTEGER IPTIMS(NPTIMS)
|
|
REAL TIMES(*)
|
|
INTEGER NENUM(NNENUM)
|
|
LOGICAL NUMCRV
|
|
CHARACTER*(*) NAMES(*)
|
|
CHARACTER*(*) TXLAB, TYLAB
|
|
INTEGER MAPEL(*), MAPND(*)
|
|
|
|
LOGICAL GRABRT
|
|
CHARACTER*64 LABSTR
|
|
CHARACTER*20 RSTR(3)
|
|
CHARACTER*20 FMT
|
|
REAL RNUM(3)
|
|
REAL DLEGND(KTOP)
|
|
INTEGER LIDSP(0:*)
|
|
INTEGER BLKCOL(0:NELBLK)
|
|
|
|
LOGICAL FIRSTH, FIRSTG
|
|
CHARACTER*(MXSTLN+1) DISPVL
|
|
|
|
CHARACTER*3 SYMBOL(NUMSYM)
|
|
CHARACTER*7 LTYPES(NUMLIN)
|
|
SAVE SYMBOL, LTYPES
|
|
|
|
#if NeedsDoubleEscape
|
|
DATA SYMBOL / '\\SQ', '\\DI', '\\CS', '\\X ', '\\TR', '\\CI' /
|
|
DATA LTYPES / '\\SLINE ', '\\DLINE ', '\\DDLINE',
|
|
& '\\SDLINE', '\\LDLINE', '\\MDLINE' /
|
|
#else
|
|
DATA SYMBOL / '\SQ', '\DI', '\CS', '\X ', '\TR', '\CI' /
|
|
DATA LTYPES / '\SLINE ', '\DLINE ', '\DDLINE',
|
|
& '\SDLINE', '\LDLINE', '\MDLINE' /
|
|
#endif
|
|
C --Set up axes labeling (needed before standard labeling)
|
|
|
|
IF (XLAB .NE. ' ') THEN
|
|
TXLAB = XLAB
|
|
ELSE
|
|
TXLAB = 'DISTANCE'
|
|
END IF
|
|
IF (YLAB .NE. ' ') THEN
|
|
TYLAB = YLAB
|
|
ELSE IF (.NOT. OVERLY) THEN
|
|
TYLAB = NAMES(ISVID(IPVAR))
|
|
ELSE
|
|
TYLAB = ' '
|
|
END IF
|
|
|
|
C *** Standard plot labeling ***
|
|
|
|
CALL QALAB (DBORD0, DVIEW0, CHLSIZ,
|
|
& DOQA(2), DOAXIS(2), (TXLAB .NE. ' '),
|
|
& CAPTN(1,2), TITLE, CREATE, MODIFY, DRAW, DLEGND,
|
|
& BLKCOL, *140)
|
|
|
|
C *** Plot legend ***
|
|
|
|
IF (.NOT. DOLEG(2)) GOTO 130
|
|
|
|
C --Find middle of the remaining legend area and set limits
|
|
|
|
NUMDSP = LIDSP(0)
|
|
IF (NUMDSP .GT. 0) THEN
|
|
NDSPL = NUMDSP * NPTIMS
|
|
ELSE
|
|
NDSPL = 0
|
|
ENDIF
|
|
NLINE = 1 + 1 + NCURVE + 1 + NDSPL
|
|
DTOP = DLEGND(KTOP) - CHLSIZ
|
|
DBOT = DLEGND(KBOT)
|
|
IF (DOQA(2)) THEN
|
|
DTOP = DTOP - 2*CHLSIZ
|
|
DBOT = DBOT + 2*CHLSIZ
|
|
END IF
|
|
CALL GRYCEN (CHLSIZ, DTOP, DBOT, NLINE, NOVER)
|
|
IF (DOQA(2) .AND. (NOVER .GT. 0)) NOVER = NOVER - 2
|
|
C --Allow 2 extra lines if QA (DBOT is invalid)
|
|
|
|
C --Display node/element numbers
|
|
|
|
IF (GRABRT ()) RETURN 1
|
|
IF (NODVAR) THEN
|
|
WRITE (RSTR(1), 10000, IOSTAT=IDUM) MAPND(NENUM(1)),
|
|
* MAPND(NENUM(NNENUM))
|
|
CALL PCKSTR (1, RSTR(1))
|
|
CALL GRTEXT (DLEGND(KLFT), DTOP, 'NODES ' // RSTR(1))
|
|
ELSE
|
|
WRITE (RSTR(1), 10000, IOSTAT=IDUM) MAPEL(NENUM(1)),
|
|
* MAPEL(NENUM(NNENUM))
|
|
CALL PCKSTR (1, RSTR(1))
|
|
CALL GRTEXT (DLEGND(KLFT), DTOP, 'ELEMENTS ' // RSTR(1))
|
|
END IF
|
|
DTOP = DTOP - CHLSIZ
|
|
|
|
C --Display plot item(s) (variable name and number) for each curve
|
|
|
|
DTOP = DTOP - CHLSIZ
|
|
|
|
NCRV = NCURVE
|
|
IF (NOVER .GT. 0) THEN
|
|
IF (NCURVE .GT. 1) THEN
|
|
NCRV = MIN (NCURVE, NLINE-4)
|
|
IF (NCRV .LT. NCURVE) NCRV = NCRV - 1
|
|
ELSE
|
|
NCRV = 1
|
|
ENDIF
|
|
ENDIF
|
|
NUSED = NCRV + 3
|
|
IF (NCRV .LT. NCURVE) NUSED = NUSED + 1
|
|
|
|
N = IPVAR
|
|
DO 100 NP = 1, NCRV
|
|
IF (GRABRT ()) RETURN 1
|
|
IF (.NOT. OVERTM) CALL GRCOLR (NP)
|
|
|
|
IF ((.NOT. NUMCRV) .OR. (.NOT. OVERLY)) THEN
|
|
LABSTR = NAMES(ISVID(N))
|
|
ELSE
|
|
IF (NP .LE. 1) THEN
|
|
IF (NCRV .LT. 10) THEN
|
|
FMT = '(I1, 1X, A)'
|
|
ELSE
|
|
FMT = '(I2, 1X, A)'
|
|
END IF
|
|
END IF
|
|
WRITE (LABSTR, FMT, IOSTAT=IDUM) NP, NAMES(ISVID(N))
|
|
CALL GRCALN (LABSTR, L)
|
|
END IF
|
|
|
|
IF ((.NOT. OVERLY)
|
|
& .OR. ((ISYTYP .GE. 0) .AND. (LINTYP .GE. 0))) THEN
|
|
CALL GRTEXT (DLEGND(KLFT), DTOP, LABSTR)
|
|
ELSE
|
|
CALL PLTXSE (DX, RDUM)
|
|
IF (LINTYP .LT. 0) THEN
|
|
ITYP = MOD (NP-1, NUMLIN) + 1
|
|
CALL PLTXTS (DLEGND(KLFT), DTOP,
|
|
& LTYPES(ITYP)(:LENSTR(LTYPES(ITYP))))
|
|
CALL PLTXSE (DX, RDUM)
|
|
END IF
|
|
IF (ISYTYP .LT. 0) THEN
|
|
ISYM = MOD (NP-1, NUMSYM) + 1
|
|
IF (LINTYP .GE. 0) THEN
|
|
CALL PLTXTS (DLEGND(KLFT), DTOP,
|
|
& SYMBOL(ISYM)(:LENSTR(SYMBOL(ISYM))))
|
|
CALL PLTXSE (DX, RDUM)
|
|
ELSE
|
|
DXX = 0.5 * (DLEGND(KLFT) + DX)
|
|
& - 0.75 * 5.0/7.0*CHLSIZ
|
|
CALL PLTXTS (DXX, DTOP,
|
|
& SYMBOL(ISYM)(:LENSTR(SYMBOL(ISYM))))
|
|
END IF
|
|
END IF
|
|
CALL GRTEXT (DX, DTOP, ' ' // LABSTR)
|
|
END IF
|
|
DTOP = DTOP - CHLSIZ
|
|
N = N + 1
|
|
100 CONTINUE
|
|
|
|
IF (.NOT. OVERTM) CALL UGRCOL (0, BLKCOL)
|
|
|
|
IF (NCRV .LT. NCURVE) THEN
|
|
IF (GRABRT ()) RETURN 1
|
|
CALL GRTEXT (DLEGND(KLFT), DTOP, '...')
|
|
DTOP = DTOP - CHLSIZ
|
|
END IF
|
|
|
|
C --Show display variables for each curve
|
|
|
|
DTOP = DTOP - CHLSIZ
|
|
|
|
IF (NPTIMS .GT. 1) THEN
|
|
RNUM(2) = TIMES(IPTIMS(1))
|
|
IF ((RNUM(2) .EQ. 0.0) .AND. (NPTIMS .GT. 1))
|
|
& RNUM(2) = TIMES(IPTIMS(2))
|
|
RNUM(3) = TIMES(IPTIMS(NPTIMS))
|
|
END IF
|
|
|
|
NLEFT = NLINE - NUSED
|
|
IF (NDSPL .GT. NLEFT) THEN
|
|
NDSP = NLEFT - 1
|
|
ELSE
|
|
NDSP = NDSPL
|
|
ENDIF
|
|
NTIM = NDSP / NUMDSP
|
|
IF (MOD(NDSP, NUMDSP) .GT. 0) NTIM = NTIM + 1
|
|
|
|
NP = 1
|
|
NL = 1
|
|
110 CONTINUE
|
|
IF (NL .LE. NDSP) THEN
|
|
IF (GRABRT ()) RETURN 1
|
|
IF (OVERTM) CALL GRCOLR (NP)
|
|
|
|
FIRSTH = .TRUE.
|
|
FIRSTG = .TRUE.
|
|
ND = 1
|
|
120 CONTINUE
|
|
IF ((ND .LE. NUMDSP) .AND. (NL .LE. NDSP)) THEN
|
|
IF (LIDSP(ND) .EQ. 0) THEN
|
|
DISPVL = 'TIME'
|
|
VARVAL = TIMES(IPTIMS(NP))
|
|
ELSE IF (LIDSP(ND) .GT. 0)THEN
|
|
IF (FIRSTH) THEN
|
|
CALL DBVIX_BL ('H', 1, IXHV)
|
|
CALL MDRSRV ('SCRH', KVARH, NVARHI)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0)GOTO 130
|
|
CALL GETVAR (A, IXHV, 0, IPTIMS(NP), NVARHI,
|
|
& A(KVARH))
|
|
FIRSTH = .FALSE.
|
|
ENDIF
|
|
CALL DBVIX_BL ('H', LIDSP(ND), IDVAR)
|
|
DISPVL = NAMES(IDVAR)
|
|
VARVAL = A(KVARH+LIDSP(ND)-1)
|
|
ELSE
|
|
IF (FIRSTG) THEN
|
|
CALL DBVIX_BL ('G', 1, IXGV)
|
|
CALL MDRSRV ('SCRG', KVARG, NVARGL)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0)GOTO 130
|
|
CALL GETVAR (A, IXGV, 0, IPTIMS(NP), NVARGL,
|
|
& A(KVARG))
|
|
FIRSTG = .FALSE.
|
|
ENDIF
|
|
CALL DBVIX_BL ('G', -LIDSP(ND), IDVAR)
|
|
DISPVL = NAMES(IDVAR)
|
|
VARVAL = A(KVARG-LIDSP(ND)-1)
|
|
ENDIF
|
|
|
|
RNUM(1) = VARVAL
|
|
CALL NUMSTR (MIN(NPTIMS,3), 4, RNUM, RSTR, LSTR)
|
|
IF ((.NOT. NUMCRV) .OR. (.NOT. OVERTM)) THEN
|
|
LABSTR = DISPVL(:LENSTR(DISPVL)) // ' ' // RSTR(1)
|
|
ELSE
|
|
IF (NP .LE. 1) THEN
|
|
IF (NTIM .LT. 10) THEN
|
|
FMT = '(I1, 1X, A, A)'
|
|
ELSE
|
|
FMT = '(I2, 1X, A, A)'
|
|
END IF
|
|
END IF
|
|
WRITE (LABSTR, FMT, IOSTAT=IDUM) NP,
|
|
* DISPVL(:LENSTR(DISPVL)) // ' ' // RSTR(1)
|
|
END IF
|
|
CALL GRCALN (LABSTR, LSTR)
|
|
|
|
IF ((.NOT. OVERTM)
|
|
& .OR. ((ISYTYP .GE. 0) .AND. (LINTYP .GE. 0))) THEN
|
|
CALL GRTEXT (DLEGND(KLFT), DTOP, LABSTR)
|
|
ELSE
|
|
IF (ISYTYP .LT. 0) THEN
|
|
ISYM = MOD (NP-1, NUMSYM) + 1
|
|
CALL PLTXTS (DLEGND(KLFT), DTOP,
|
|
& SYMBOL(ISYM)(:LENSTR(SYMBOL(ISYM))))
|
|
ELSE IF (LINTYP .LT. 0) THEN
|
|
ITYP = MOD (NP-1, NUMLIN) + 1
|
|
CALL PLTXTS (DLEGND(KLFT), DTOP,
|
|
& LTYPES(ITYP)(:LENSTR(LTYPES(ITYP))))
|
|
END IF
|
|
CALL PLTXSE (DX, RDUM)
|
|
CALL GRTEXT (DX, DTOP, ' ' // LABSTR)
|
|
END IF
|
|
DTOP = DTOP - CHLSIZ
|
|
N = N + 1
|
|
|
|
NL = NL + 1
|
|
ND = ND + 1
|
|
GO TO 120
|
|
ENDIF
|
|
|
|
IF (.NOT. FIRSTH) CALL MDDEL ('SCRH')
|
|
IF (.NOT. FIRSTG) CALL MDDEL ('SCRG')
|
|
NP = NP + 1
|
|
GO TO 110
|
|
ENDIF
|
|
|
|
IF (OVERTM) CALL UGRCOL (0, BLKCOL)
|
|
|
|
IF (NDSP .LT. NDSPL) THEN
|
|
IF (GRABRT ()) RETURN 1
|
|
CALL GRTEXT (DLEGND(KLFT), DTOP, '...')
|
|
DTOP = DTOP - CHLSIZ
|
|
END IF
|
|
|
|
130 CONTINUE
|
|
|
|
C --Flush buffer, so label is complete at this point
|
|
CALL PLTFLU
|
|
|
|
RETURN
|
|
|
|
140 CONTINUE
|
|
RETURN 1
|
|
|
|
10000 FORMAT (I6, '..', I6)
|
|
END
|
|
|