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.
112 lines
3.3 KiB
112 lines
3.3 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 GRCOLR (INDX)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** GRCOLR *** (GRPLIB) Set color (PLT)
|
||
|
|
C -- Written by Amy Gilkey - revised 04/11/88
|
||
|
|
C --
|
||
|
|
C --GRCOLR sets the color of lines depending on the passed index.
|
||
|
|
C --The colors are chosen consecutively up to the maximum set,
|
||
|
|
C --skipping black and white, and wrapping around if necessary.
|
||
|
|
C --The colors of lines and symbols drawn by PLTGRH are also set.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- INDX - IN - the color index:
|
||
|
|
C -- -1 = black
|
||
|
|
C -- =0 = white
|
||
|
|
C -- +n = color number n
|
||
|
|
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)
|
||
|
|
include 'params.blk'
|
||
|
|
include 'cmap-lst.blk'
|
||
|
|
|
||
|
|
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 'grcol.blk'
|
||
|
|
|
||
|
|
INTEGER INDX
|
||
|
|
|
||
|
|
LOGICAL LDUM, PLTSTG, PLTSTD, PLTICL
|
||
|
|
CHARACTER*8 BLCOLR, WHCOLR
|
||
|
|
SAVE BLCOLR, WHCOLR
|
||
|
|
|
||
|
|
DATA BLCOLR, WHCOLR / 'BLACK ', 'WHITE ' /
|
||
|
|
LSTDEV = 0
|
||
|
|
|
||
|
|
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)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
NCOL = NUMCOL(MAPUSE(ICURDV),ICURDV)
|
||
|
|
|
||
|
|
IF ((INDX .GT. 0) .AND. (NCOL .GT. 0)) THEN
|
||
|
|
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
|
||
|
|
ICOLOR = IWHITE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
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
|