Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.

104 lines
3.7 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 MRKFAC (NUMFAC, F, HIDEF, XF, YF, ZF,
& NMIN, NMAX, FMIN, FMAX, BLKCOL, *)
C=======================================================================
C --*** MRKFAC *** (DETOUR) Mark minimum/maximum face values
C -- Written by Amy Gilkey - revised 03/09/88
C --
C --MRKFAC marks the faces which have the minimum or maximum values
C --with symbols.
C --
C --Parameters:
C -- NUMFAC - IN - the number of surface faces
C -- F - IN - the face variable values
C -- HIDEF(i) - IN - true iff face i is hidden (3D only)
C -- XF, YF, ZF - IN - the face center coordinates
C -- NMIN, NMAX - IN - the number of variables values matching the
C -- minimum and the maximum
C -- FMIN, FMAX - IN - the minimum and maximum function values
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 -- 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 -- * - return statement if the cancel function is active
C --
C --Common Variables:
C -- Uses IS3DIM, NNPSUR of /D3NUMS/
C -- Uses MAXMIN, MAXMAX of /CNTR/
include 'dbnums.blk'
include 'd3nums.blk'
include 'cntr.blk'
REAL F(*)
LOGICAL HIDEF(*)
REAL XF(*), YF(*), ZF(*)
INTEGER BLKCOL(0:NELBLK)
LOGICAL GRABRT
LOGICAL MRKMIN, MRKMAX
CALL UGRCOL (0, BLKCOL)
MRKMIN = (MAXMIN .GE. NMIN)
MRKMAX = (MAXMAX .GE. NMAX)
IF ((FMIN .NE. FMAX) .AND. (MRKMIN .OR. MRKMAX)) THEN
C --Mark minimum and maximum values with centered symbols
DO 100 IFAC = 1, NUMFAC
IF (IS3DIM) THEN
IF (HIDEF(IFAC)) GOTO 100
END IF
IF (FMIN .EQ. F(IFAC)) THEN
IF (MRKMIN) THEN
IF (GRABRT ()) RETURN 1
#if NeedsDoubleEscape
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\\CCI')
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\\CCS')
#else
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\CCI')
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\CCS')
#endif
END IF
ELSE IF (FMAX .EQ. F(IFAC)) THEN
IF (MRKMAX) THEN
IF (GRABRT ()) RETURN 1
#if NeedsDoubleEscape
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\\CX')
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\\CCS')
#else
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\CX')
CALL MPD2SY (1, XF(IFAC), YF(IFAC), '\CCS')
#endif
END IF
END IF
100 CONTINUE
CALL PLTFLU
END IF
RETURN
END