EXODUS/packages/seacas/applications/blot/mshcol.f

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 MSHCOL (FNCT, IELB, MLNTYP, WIDLIN, BLKCOL,
     &   IDELB)
C=======================================================================

C   --*** MSHCOL *** (MESH) Set line color, type, and width
C   --   Modified by John Glick - 1/17/89
C   --   Written by Amy Gilkey - revised 03/29/88
C   --
C   --MSHCOL sets the line color, type, and width.  The lines have been
C   --divided into parts as follows:
C   --   -1) Mesh boundary
C   --    0) Element block boundary
C   --    n) Interior within element block 'n'
C   --
C   --Be sure to call this routine to reset the line type and line width
C   --to the default before exiting the mesh-drawing routine.
C   --
C   --Parameters:
C   --   FNCT - IN - the type of lines being drawn:
C   --      'RESET'    - reset line type, etc.
C   --      'INTERIOR' - the interior mesh lines (small)
C   --      'BOUNDARY' - mesh boundaries defined by hidden lines
C   --      'LINE'     - normal mesh lines
C   --      'DEBUG'    - lines for debugging (blue)
C   --   IELB - IN - the line "part" (as above)
C   --   MLNTYP - IN - the line type (and color) of lines (as in /MSHOPT/)
C   --   WIDLIN - IN - true iff mesh lines should be wide versus narrow
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

      PARAMETER (KWIDLN=2)

      include 'dbnums.blk'

      COMMON /LINTHC/ MSHBND, BLKBND, ELEBND, THKNSS
      REAL MSHBND, BLKBND, ELEBND
C      --      Line thickness specification for lines appearing
C      --      on mesh plots.  Specification is a real value in the
C      --      range 0. - 1000., with 0. being the thinest line and
C      --      1000. being the thickest.
C      -- MSHBND - Thickness of lines forming the mesh boundary.
C      -- BLKBND - Thickness of lines forming element block boundaries.
C      -- ELEBND - Thickness of lines forming element boundaries.
      REAL THKNSS(3)
C     --       Line thickness specifications for THICK, MEDIUM,
C     --       and THIN keywords.

      CHARACTER*(*) FNCT
      INTEGER MLNTYP(-1:1)
      LOGICAL WIDLIN
      INTEGER BLKCOL(0:NELBLK)
      INTEGER IDELB(*)

      LOGICAL PLTGTV, PLTSTV, LDUM

      LOGICAL FIRST
      SAVE FIRST

      DATA FIRST / .TRUE. /

      IF (FIRST) THEN
C      --Get the default line width
         LDUM = PLTGTV (KWIDLN, WIDLN)
         FIRST = .FALSE.
      END IF

      IF ((FNCT .EQ. 'RESET') .OR. (IELB .LT. -1)) THEN
C      --Reset to default color, line type, and line width
         ICOLOR = 0
         LTYP = 1
         WID = 160.
C         WID = 1.00
      ELSE IF (IELB .EQ. -1) THEN
         ICOLOR = 0
         IF (MLNTYP(-1) .LT. 0) ICOLOR = -1
         LTYP = IABS (MLNTYP(-1))
C         WID = 1.75
         WID = MSHBND
      ELSE IF (IELB .EQ. 0) THEN
         ICOLOR = 0
         IF (MLNTYP(0) .LT. 0) ICOLOR = -1
         LTYP = IABS (MLNTYP(0))
C         WID = 1.25
         WID = BLKBND
      ELSE
         ICOLOR = IELB
         IF (MLNTYP(1) .LT. 0) ICOLOR = -1
         LTYP = IABS (MLNTYP(1))
         IF (WIDLIN) THEN
C            WID = 1.00
            WID = ELEBND
         ELSE
C            WID = 0.50
            WID = ELEBND / 2
         END IF
      END IF

      IF (FNCT .EQ. 'INTERIOR') THEN
C      --Interior lines as thin lines
         WID = 0.5 * WID
      ELSE IF (FNCT .EQ. 'BOUNDARY') THEN
C      --Element lines on hidden line boundaries - line type as
C      --boundary lines, black => white as boundary
         IF (IELB .GT. 0) THEN
            IF ((ICOLOR .EQ. -1) .AND. (MLNTYP(0) .GT. 0)) ICOLOR = 0
            LTYP = IABS (MLNTYP(0))
         END IF
      ELSE IF (FNCT .EQ. 'LINE') THEN
C      --Normal mesh lines are ok
         CONTINUE
      ELSE IF (FNCT .EQ. 'DEBUG') THEN
C      --Lines for debugging are blue
         CALL GRCOLR (4)
      END IF

C   --Make line size of dotted lines smaller
      IF (LTYP .NE. 1) THEN
         IF ((IELB .LE. 0) .OR. WIDLIN) THEN
            WID = 0.75 * WID
         END IF
      END IF

C      IF (ICOLOR .GT. 0) ICOLOR = IDELB(IELB)
C ... Test by Sjaardema, should pass ielb?
      IF (ICOLOR .GT. 0) ICOLOR = IELB
      CALL UGRCOL (ICOLOR, BLKCOL)
      LDUM = PLTSTV (1, 1.0 * LTYP)
      LDUM = PLTSTV (KWIDLN, WID)

      RETURN
      END