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.
248 lines
8.1 KiB
248 lines
8.1 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 UGRCOL (INDX, BLKCOL)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** UGRCOL *** (BLOT) Set color (PLT)
|
||
|
|
C -- Written by John Glick - 11/29/88
|
||
|
|
C --
|
||
|
|
C --UGRCOL is similar to the GRCOLR routine of GRPLIB in that it
|
||
|
|
C --sets the color of lines depending on the passed index.
|
||
|
|
C --The colors are chosen differently than GRCOLR, however.
|
||
|
|
C --If appropriate, the BLKCOL array is used to select the color.
|
||
|
|
C --
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- INDX - IN - the color index or block id:
|
||
|
|
C -- If = -1, black is chosen as the color.
|
||
|
|
C -- If = 0, the foreground color is chosen as the color.
|
||
|
|
C -- If the foreground color is not available on
|
||
|
|
C -- the current device, white is chosen.
|
||
|
|
C -- If > 0, it is assumed to be an element block identifier.
|
||
|
|
C -- If BLKCOL(INDX) > -2, then BLKCOL(INDX) is the
|
||
|
|
C -- color index chosen (if it is a supported color on
|
||
|
|
C -- the current device).
|
||
|
|
C -- BLKCOL - IN - 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 -- not 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 ICURDV, MAXCOL, NUMCOL, MAPUSE of /GRPCOM/
|
||
|
|
|
||
|
|
C --Routines Called:
|
||
|
|
C -- PLTICL - (PLTLIB) Get color index from name
|
||
|
|
C -- PLTSTD - (PLTLIB) Set device parameter
|
||
|
|
C -- 1 = (KCOLOR) set color
|
||
|
|
C -- PLTSTG - (PLTLIB) Set graph parameter
|
||
|
|
C -- 6 = (KCOLIN) set line color for PLTGRH lines
|
||
|
|
C -- 44 = (KCOSYM) set symbol color for PLTGRH lines
|
||
|
|
|
||
|
|
PARAMETER (KCOLOR=1)
|
||
|
|
PARAMETER (KCOLIN=6, KCOSYM=44)
|
||
|
|
|
||
|
|
COMMON /GRPCOC/ DEVNAM(2), DEVCOD(2)
|
||
|
|
CHARACTER*3 DEVNAM
|
||
|
|
CHARACTER*8 DEVCOD
|
||
|
|
COMMON /GRPCOM/ ICURDV, ISHARD, DEVOK(2), TALKOK(2),
|
||
|
|
& NSNAP(2), IFONT(2), SOFTCH(2), AUTOPL(2),
|
||
|
|
& MAXCOL(2), NUMCOL(0:1,2), MAPALT(2), MAPUSE(2)
|
||
|
|
LOGICAL ISHARD, DEVOK, TALKOK, SOFTCH, AUTOPL
|
||
|
|
include 'dbnums.blk'
|
||
|
|
include 'grcol.blk'
|
||
|
|
|
||
|
|
COMMON /BCOLR/ BCOLCH
|
||
|
|
LOGICAL BCOLCH
|
||
|
|
|
||
|
|
include 'plcol2.blk'
|
||
|
|
include 'params.blk'
|
||
|
|
include 'cmap-lst.blk'
|
||
|
|
INTEGER LSTD2
|
||
|
|
SAVE LSTD2
|
||
|
|
|
||
|
|
INTEGER INDX
|
||
|
|
INTEGER BLKCOL(0:NELBLK)
|
||
|
|
|
||
|
|
LOGICAL LDUM, PLTSTG, PLTSTD, PLTICL
|
||
|
|
|
||
|
|
LOGICAL COLSPC(NCOLOR)
|
||
|
|
INTEGER NUMFRE, FRECOL(NCOLOR)
|
||
|
|
SAVE COLSPC, NUMFRE, FRECOL
|
||
|
|
|
||
|
|
CHARACTER*8 BLCOLR, WHCOLR
|
||
|
|
SAVE BLCOLR, WHCOLR
|
||
|
|
|
||
|
|
DATA LSTD2 / 0 /
|
||
|
|
DATA BLCOLR, WHCOLR / 'BLACK ', 'WHITE ' /
|
||
|
|
|
||
|
|
IF (ICURDV .NE. LSTDEV) THEN
|
||
|
|
LSTDEV = ICURDV
|
||
|
|
LSTMAP = 0
|
||
|
|
|
||
|
|
C --Reset last color
|
||
|
|
LSTCOL = -999
|
||
|
|
|
||
|
|
C --Set device black and white
|
||
|
|
IF (MAXCOL(ICURDV) .GT. 0) THEN
|
||
|
|
LDUM = PLTICL (WHCOLR, RWHITE)
|
||
|
|
IWHITE = INT(RWHITE)
|
||
|
|
LDUM = PLTICL (BLCOLR, RBLACK)
|
||
|
|
IBLACK = INT(RBLACK)
|
||
|
|
ELSE
|
||
|
|
IBLACK = 0
|
||
|
|
IWHITE = 1
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (MAPUSE(ICURDV) .NE. LSTMAP) THEN
|
||
|
|
|
||
|
|
C --Reset last color
|
||
|
|
LSTCOL = -999
|
||
|
|
LSTMAP = MAPUSE(ICURDV)
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF (ICURDV .NE. LSTD2) THEN
|
||
|
|
C Get mapping of colors
|
||
|
|
DO 100 I = 1, NCOLOR
|
||
|
|
IF (PLTICL (COLLST(I+2), RCOLOR)) THEN
|
||
|
|
COLMAP(I) = RCOLOR
|
||
|
|
ELSE
|
||
|
|
COLMAP(I) = -1
|
||
|
|
ENDIF
|
||
|
|
100 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF (BCOLCH .OR. (ICURDV .NE. LSTD2)) THEN
|
||
|
|
BCOLCH = .FALSE.
|
||
|
|
DO 110 I = 1, NCOLOR
|
||
|
|
COLSPC(I) = .FALSE.
|
||
|
|
110 CONTINUE
|
||
|
|
IF (BLKCOL(0) .EQ. 1) THEN
|
||
|
|
DO 120 I = 1, NELBLK
|
||
|
|
IF ((BLKCOL(I) .GT. 0) .AND.
|
||
|
|
& (COLMAP(BLKCOL(I)) .NE. -1))
|
||
|
|
& COLSPC(BLKCOL(I)) = .TRUE.
|
||
|
|
120 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
NUMFRE = 0
|
||
|
|
DO 130 I = 1, NCOLOR
|
||
|
|
IF ((.NOT. COLSPC(I)) .AND. (COLMAP(I) .NE. -1)) THEN
|
||
|
|
NUMFRE = NUMFRE + 1
|
||
|
|
FRECOL(NUMFRE) = I
|
||
|
|
ENDIF
|
||
|
|
130 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF (ICURDV .NE. LSTD2) LSTD2 = ICURDV
|
||
|
|
|
||
|
|
NCOL = NUMCOL(MAPUSE(ICURDV),ICURDV)
|
||
|
|
|
||
|
|
IF (BLKCOL(0) .EQ. 1) THEN
|
||
|
|
IF (INDX .EQ. -1) THEN
|
||
|
|
ICOLOR = IBLACK
|
||
|
|
ELSE IF (INDX .EQ. 0) THEN
|
||
|
|
IDFORT = IDFOR
|
||
|
|
IF (IDFOR .EQ. 1) THEN
|
||
|
|
ICOLOR = IBLACK
|
||
|
|
ELSE IF (IDFOR .EQ. 2) THEN
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
ELSE IF (COLMAP(IDFOR-2) .GE. 0.0) THEN
|
||
|
|
ICOLOR = INT(COLMAP(IDFOR-2))
|
||
|
|
ELSE
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
IDFORT = 2
|
||
|
|
ENDIF
|
||
|
|
COLFOR = REAL (ICOLOR)
|
||
|
|
ELSE IF ((BLKCOL(INDX) .GT. 0) .AND.
|
||
|
|
& (COLMAP(BLKCOL(INDX)) .NE. -1)) THEN
|
||
|
|
ICOLOR = INT(COLMAP(BLKCOL(INDX)))
|
||
|
|
ELSE IF (BLKCOL(INDX) .EQ. 0) THEN
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
ELSE IF (BLKCOL(INDX) .EQ. -1) THEN
|
||
|
|
ICOLOR = IBLACK
|
||
|
|
ELSE
|
||
|
|
IF (NUMFRE .GT. 0) THEN
|
||
|
|
NBLNSP = 0
|
||
|
|
DO 140 I = 1, INDX
|
||
|
|
IF (BLKCOL(I) .EQ. -2) THEN
|
||
|
|
NBLNSP = NBLNSP + 1
|
||
|
|
ELSE IF (BLKCOL(I) .GT. 0) THEN
|
||
|
|
IF (COLMAP(BLKCOL(I)) .EQ. -1) THEN
|
||
|
|
NBLNSP = NBLNSP + 1
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
140 CONTINUE
|
||
|
|
ICOLOR = INT(COLMAP (FRECOL(MOD (NBLNSP-1, NUMFRE)+1)))
|
||
|
|
ELSE
|
||
|
|
IDFORT = IDFOR
|
||
|
|
IF (IDFOR .EQ. 1) THEN
|
||
|
|
ICOLOR = IBLACK
|
||
|
|
ELSE IF (IDFOR .EQ. 2) THEN
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
ELSE IF (COLMAP(IDFOR-2) .GE. 0.0) THEN
|
||
|
|
ICOLOR = INT(COLMAP(IDFOR-2))
|
||
|
|
ELSE
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
IDFORT = 2
|
||
|
|
ENDIF
|
||
|
|
COLFOR = REAL (ICOLOR)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
IF ((INDX .GT. 0) .AND. (NCOL .GT. 0)) THEN
|
||
|
|
C ... This is a temporary kludge by GDS for Ultrix -
|
||
|
|
ICOLOR = MOD (INDX-1, NCOL) +1
|
||
|
|
C ICOLOR = MOD (INDX-1, NCOL)
|
||
|
|
IF (MAPUSE(ICURDV) .EQ. 0) THEN
|
||
|
|
IF (ICOLOR .GE. IBLACK) ICOLOR = ICOLOR + 1
|
||
|
|
IF (ICOLOR .GE. IWHITE) ICOLOR = ICOLOR + 1
|
||
|
|
IF (ICOLOR .GT. IBLACK .AND.
|
||
|
|
& ICOLOR .LT. IWHITE) ICOLOR = INT(COLMAP(ICOLOR))
|
||
|
|
ELSE
|
||
|
|
ICOLOR = ICOLOR + (6 + 2)
|
||
|
|
END IF
|
||
|
|
ELSE IF (INDX .EQ. -1) THEN
|
||
|
|
ICOLOR = IBLACK
|
||
|
|
ELSE
|
||
|
|
IDFORT = IDFOR
|
||
|
|
IF (IDFOR .EQ. 1) THEN
|
||
|
|
ICOLOR = IBLACK
|
||
|
|
ELSE IF (IDFOR .EQ. 2) THEN
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
ELSE IF (COLMAP(IDFOR-2) .GE. 0.0) THEN
|
||
|
|
ICOLOR = INT(COLMAP(IDFOR-2))
|
||
|
|
ELSE
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
IDFORT = 2
|
||
|
|
ENDIF
|
||
|
|
COLFOR = REAL (ICOLOR)
|
||
|
|
END IF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF (ICOLOR .NE. LSTCOL) THEN
|
||
|
|
LDUM = PLTSTD (KCOLOR, REAL (ICOLOR))
|
||
|
|
LDUM = PLTSTG (KCOLIN, REAL (ICOLOR))
|
||
|
|
LDUM = PLTSTG (KCOSYM, REAL (ICOLOR))
|
||
|
|
LSTCOL = ICOLOR
|
||
|
|
END IF
|
||
|
|
RETURN
|
||
|
|
END
|