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.
252 lines
8.2 KiB
252 lines
8.2 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---5---10---15---20---25---30---35---40---45---50---55---60---65---70--
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE GRCOLT
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** GRCOLT *** (GRPLIB) Set alternate color table (PLT)
|
||
|
|
C -- Written by Amy Gilkey - revised 04/11/88
|
||
|
|
C --
|
||
|
|
C --GRCOLT sets the alternate color table (colors 8..) to a specified
|
||
|
|
C --color table map. The following maps are defined:
|
||
|
|
C -- spectrum colors blue to red
|
||
|
|
C -- rainbow colors violet to red
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses DEVOK, ICURDV, NUMCOL, MAPALT of /GRPCOM/
|
||
|
|
C -- Sets MAPUSE of /GRPCOM/
|
||
|
|
|
||
|
|
C --Routines Called:
|
||
|
|
C -- PLTCOL - (PLTLIB) Set color table color
|
||
|
|
C -- PLTIQC - (PLTLIB) Get color table color
|
||
|
|
|
||
|
|
EXTERNAL BLKDAT
|
||
|
|
|
||
|
|
PARAMETER (KCOLOR=1)
|
||
|
|
PARAMETER (KCOLIN=6, KCOSYM=44)
|
||
|
|
|
||
|
|
include 'grpcom.blk'
|
||
|
|
|
||
|
|
C Flag for rainbow spectrum
|
||
|
|
include 'icrnbw.blk'
|
||
|
|
|
||
|
|
REAL SRED(0:4), SGREEN(0:4), SBLUE(0:4)
|
||
|
|
SAVE SRED, SGREEN, SBLUE
|
||
|
|
C --SRED, SGREEN, SBLUE - color ratios for RGB settings; spectrum is
|
||
|
|
C -- divided in 4 parts
|
||
|
|
|
||
|
|
REAL RRED(32:255), RGREEN(32:255), RBLUE(32:255)
|
||
|
|
SAVE RRED, RGREEN, RBLUE
|
||
|
|
C RRED, RGREEN, RBLUE - color ratios for RGB settings; rainbow is
|
||
|
|
C from TOOPLOT color table; numbering 32-255 has been retained
|
||
|
|
C in order to use original coding to generate table.
|
||
|
|
C The original routineS used 0-255 for color definition values.
|
||
|
|
C These are scaled to the range 0.-1. here.
|
||
|
|
|
||
|
|
INTEGER LSTALT(2), LSTNUM(2)
|
||
|
|
SAVE LSTALT, LSTNUM, SATLST, IRNBWL
|
||
|
|
C --LSTALT - the color type last set for the device
|
||
|
|
C --LSTNUM - the number of colors last set for the device
|
||
|
|
|
||
|
|
DATA SRED / 0.20, 0.50, 0.80, 0.85, 1.00 /
|
||
|
|
DATA SGREEN / 0.60, 0.70, 0.80, 0.60, 0.10 /
|
||
|
|
DATA SBLUE / 1.00, 0.50, 0.25, 0.10, 0.10 /
|
||
|
|
|
||
|
|
C INITIALIZE ALL RAINBOW COLORS TO ZERO - COLOR TABLE HAS NOT BEEN CREATED
|
||
|
|
DATA RRED / 224*0. /
|
||
|
|
DATA RGREEN / 224*0. /
|
||
|
|
DATA RBLUE / 224*0. /
|
||
|
|
|
||
|
|
DATA LSTALT / 0, 0 /
|
||
|
|
DATA LSTNUM / 0, 0 /
|
||
|
|
DATA SATLST / 0.0 /
|
||
|
|
DATA IRNBWL / -1 /
|
||
|
|
|
||
|
|
IF (MAPALT(ICURDV) .LE. 0) THEN
|
||
|
|
CONTINUE
|
||
|
|
|
||
|
|
ELSE IF ((MAPALT(ICURDV) .NE. LSTALT(ICURDV))
|
||
|
|
& .OR. (NUMCOL(MAPALT(ICURDV),ICURDV) .NE. LSTNUM(ICURDV))
|
||
|
|
& .OR. IRNBWL.NE.IRAINB .OR. SATUR .NE. SATLST) THEN
|
||
|
|
|
||
|
|
IF (MAPALT(ICURDV) .EQ. 1) THEN
|
||
|
|
|
||
|
|
C --Set up a spectrum of colors in colors 8+
|
||
|
|
|
||
|
|
IF(IRAINB.EQ.0 .AND. ISPEC .EQ. 0)THEN
|
||
|
|
C Blue-brown-red spectrum (DEFAULT)
|
||
|
|
|
||
|
|
IF (NUMCOL(1,ICURDV) .EQ. 1) THEN
|
||
|
|
CALL PLTCOL (8+0, 0.0, 0.0, 1.0)
|
||
|
|
|
||
|
|
ELSE IF (NUMCOL(1,ICURDV) .EQ. 2) THEN
|
||
|
|
if (isinv .eq. 0) then
|
||
|
|
CALL PLTCOL (8+0, 0.0, 0.0, 1.0)
|
||
|
|
CALL PLTCOL (8+1, 1.0, 0.0, 0.0)
|
||
|
|
else
|
||
|
|
CALL PLTCOL (8+1, 0.0, 0.0, 1.0)
|
||
|
|
CALL PLTCOL (8+0, 1.0, 0.0, 0.0)
|
||
|
|
end if
|
||
|
|
ELSE IF (NUMCOL(1,ICURDV) .EQ. 3) THEN
|
||
|
|
if (isinv .eq. 0) then
|
||
|
|
CALL PLTCOL (8+0, 0.0, 0.0, 1.0)
|
||
|
|
CALL PLTCOL (8+1, 0.0, 1.0, 0.0)
|
||
|
|
CALL PLTCOL (8+2, 1.0, 0.0, 0.0)
|
||
|
|
else
|
||
|
|
CALL PLTCOL (8+2, 0.0, 0.0, 1.0)
|
||
|
|
CALL PLTCOL (8+1, 0.0, 1.0, 0.0)
|
||
|
|
CALL PLTCOL (8+0, 1.0, 0.0, 0.0)
|
||
|
|
end if
|
||
|
|
ELSE IF (NUMCOL(1,ICURDV) .EQ. 5) THEN
|
||
|
|
if (isinv .eq. 0) then
|
||
|
|
CALL PLTCOL (8+0, 0.0, 0.0, 1.0)
|
||
|
|
CALL PLTCOL (8+1, 0.0, 1.0, 1.0)
|
||
|
|
CALL PLTCOL (8+2, 0.0, 1.0, 0.0)
|
||
|
|
CALL PLTCOL (8+3, 1.0, 1.0, 0.0)
|
||
|
|
CALL PLTCOL (8+4, 1.0, 0.0, 0.0)
|
||
|
|
else
|
||
|
|
CALL PLTCOL (8+4, 0.0, 0.0, 1.0)
|
||
|
|
CALL PLTCOL (8+3, 0.0, 1.0, 1.0)
|
||
|
|
CALL PLTCOL (8+2, 0.0, 1.0, 0.0)
|
||
|
|
CALL PLTCOL (8+1, 1.0, 1.0, 0.0)
|
||
|
|
CALL PLTCOL (8+0, 1.0, 0.0, 0.0)
|
||
|
|
end if
|
||
|
|
ELSE
|
||
|
|
NEWCOL = NUMCOL(1,ICURDV) - 1
|
||
|
|
DO 10 I = 0, NEWCOL
|
||
|
|
FRAC = DBLE(I) / DBLE(NEWCOL)
|
||
|
|
ISEG = INT (FRAC * 4)
|
||
|
|
REM = FRAC * 4 - ISEG
|
||
|
|
if (iseg .lt. 4) then
|
||
|
|
XRED = SRED(ISEG)
|
||
|
|
& - REM * (SRED(ISEG) - SRED(ISEG+1))
|
||
|
|
XGREEN = SGREEN(ISEG)
|
||
|
|
& - REM * (SGREEN(ISEG) - SGREEN(ISEG+1))
|
||
|
|
XBLUE = SBLUE(ISEG)
|
||
|
|
& - REM * (SBLUE(ISEG) - SBLUE(ISEG+1))
|
||
|
|
else
|
||
|
|
XRED = SRED(ISEG)
|
||
|
|
XGREEN = SGREEN(ISEG)
|
||
|
|
XBLUE = SBLUE(ISEG)
|
||
|
|
end if
|
||
|
|
if (isinv .eq. 0) then
|
||
|
|
CALL PLTCOL (8+I, XRED, XGREEN, XBLUE)
|
||
|
|
else
|
||
|
|
CALL PLTCOL (8+NEWCOL-I, XRED, XGREEN, XBLUE)
|
||
|
|
end if
|
||
|
|
10 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF(IRAINB.EQ.0 .AND. ISPEC .GE. 1)THEN
|
||
|
|
NEWCOL = NUMCOL(1,ICURDV) - 1
|
||
|
|
call textur (SATUR, NUMCOL(1,ICURDV), ISPEC, ISINV,
|
||
|
|
* RMULT, GMULT, BMULT)
|
||
|
|
SATLST = SATUR
|
||
|
|
ELSE
|
||
|
|
C Rainbow spectrum
|
||
|
|
IF(RRED(32).EQ.0.)THEN
|
||
|
|
|
||
|
|
C Color table has not been created. Generate it
|
||
|
|
|
||
|
|
C Define colors 32-56 to be a linear variation from red to orange
|
||
|
|
C Red = 255,0,0 (R,G,B)
|
||
|
|
C Orange = 255,168,0 (R,G,B)
|
||
|
|
|
||
|
|
XIPCOL=168.0/24.0
|
||
|
|
DO 50 I=32,56
|
||
|
|
RRED(I)=1.
|
||
|
|
RGREEN(I)=(I-32)*XIPCOL/255.
|
||
|
|
RBLUE(I)=0.
|
||
|
|
50 CONTINUE
|
||
|
|
|
||
|
|
C Define colors 57-106 to be a linear variation from orange to yello
|
||
|
|
C Orange = 255,168,0 (R,G,B)
|
||
|
|
C Yellow = 255,255,0 (R,G,B)
|
||
|
|
|
||
|
|
XIPCOL=87.0/50.0
|
||
|
|
DO 60 I=57,106
|
||
|
|
RRED(I)=1.
|
||
|
|
RGREEN(I)=(168.0+(I-56)*XIPCOL)/255.
|
||
|
|
RBLUE(I)=0.
|
||
|
|
60 CONTINUE
|
||
|
|
|
||
|
|
C Define colors 107-166 to be a linear variation from yellow to gree
|
||
|
|
C Yellow = 255,255,0 (R,G,B)
|
||
|
|
C Green = 0,255,0 (R,G,B)
|
||
|
|
|
||
|
|
XIPCOL=255.0/60.0
|
||
|
|
DO 70 I=107,166
|
||
|
|
RRED(I)=(255.0-(I-106)*XIPCOL)/255.
|
||
|
|
RGREEN(I)=1.
|
||
|
|
RBLUE(I)=0.
|
||
|
|
70 CONTINUE
|
||
|
|
|
||
|
|
C Define colors 167-210 to be a linear variation from green to blue
|
||
|
|
C Green = 0,255,0 (R,G,B)
|
||
|
|
C Blue = 0,0,255 (R,G,B)
|
||
|
|
|
||
|
|
XIPCOL=255.0/44.0
|
||
|
|
DO 80 I=167,210
|
||
|
|
RRED(I)=0.
|
||
|
|
RGREEN(I)=(255.0-(I-166)*XIPCOL)/255.
|
||
|
|
RBLUE(I)=(I-166)*XIPCOL/255.
|
||
|
|
80 CONTINUE
|
||
|
|
|
||
|
|
C Define colors 211-255 to be a linear variation from blue to violet
|
||
|
|
C Blue = 0,0,255 (R,G,B)
|
||
|
|
C Purple = 180,0,180 (R,G,B)
|
||
|
|
|
||
|
|
XICOLB = 75.0/45.0
|
||
|
|
XICOLR = 180.0/45.0
|
||
|
|
DO 90 I=211,255
|
||
|
|
RRED(I)=(I-210)*XICOLR/255.
|
||
|
|
RGREEN(I)=0.
|
||
|
|
RBLUE(I)=(255.0-(I-210)*XICOLB)/255.
|
||
|
|
90 CONTINUE
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF (NUMCOL(1,ICURDV) .EQ. 1) THEN
|
||
|
|
CALL PLTCOL (8+0, 0.7059, 0.0, 0.7059)
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
NEWCOL = NUMCOL(1,ICURDV) - 1
|
||
|
|
DO 100 I = 0, NEWCOL
|
||
|
|
C Interpolate on color number, not color values.
|
||
|
|
C For a spectrum with less than 224 colors, choose
|
||
|
|
C equally-spaced color numbers from the range 255-32
|
||
|
|
FRAC = DBLE(I) / DBLE(NEWCOL)
|
||
|
|
NC=NINT(255.-FRAC*223.)
|
||
|
|
CALL PLTCOL (8+I, RRED(NC), RGREEN(NC), RBLUE(NC))
|
||
|
|
100 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Change old alternate colors to black
|
||
|
|
|
||
|
|
IF (LSTALT(ICURDV) .GT. 0) THEN
|
||
|
|
DO 110 I = NEWCOL+1, LSTNUM(ICURDV)-1
|
||
|
|
CALL PLTCOL (8+I, 0.0, 0.0, 0.0)
|
||
|
|
110 CONTINUE
|
||
|
|
END IF
|
||
|
|
CALL PLTFLU
|
||
|
|
|
||
|
|
LSTALT(ICURDV) = MAPALT(ICURDV)
|
||
|
|
LSTNUM(ICURDV) = NUMCOL(LSTALT(ICURDV),ICURDV)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
MAPUSE(ICURDV) = MAPALT(ICURDV)
|
||
|
|
|
||
|
|
IRNBWL=IRAINB
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|