C Copyright(C) 2009-2017 National Technology & Engineering Solutions of
C 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 Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions are
C met:
C
C     * Redistributions of source code must retain the above copyright
C       notice, this list of conditions and the following disclaimer.
C
C     * Redistributions in binary form must reproduce the above
C       copyright notice, this list of conditions and the following
C       disclaimer in the documentation and/or other materials provided
C       with the distribution.
C     * Neither the name of NTESS nor the names of its
C       contributors may be used to endorse or promote products derived
C       from this software without specific prior written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

C=======================================================================
      SUBROUTINE DTPLT1 (A, MSHNUM, MSHLIN, MLNTYP, MODDET, MODTYP,
     &   LENF, NLNKF, LINKF, LENL, LINSET,
     &   HIDENP, HIDEF, DOIXF, NXFAC, IXFAC,
     &   XN, YN, ZN, XF, YF, ZF,
     &   IELBST, ISEVOK, IN2ELB, IVN2B, DODEAD, IDN2B,
     &   NNPSET, ISSNPS, NESSET, ISSESS,
     &   IDTVAR, VARNP, VARFAC, NMIN, NMAX, FMIN, FMAX, VECMAX, ISVOK,
     &   BLKCOL, IDELB, IHIDOP, MAPEL, MAPND, *)
C=======================================================================

C   --*** DTPLT1 *** (DETOUR) Plot one view
C   --   Modified by John Glick - 11/28/88
C   --   Written by Amy Gilkey - revised 04/11/88
C   --   Modified version 1.1a  - November 1990 - R.J. Meyers
C   --           added color coded sphere capability
C   --
C   --DTPLT1 does the plotting for a single view.  The labeling of the view
C   --is done elsewhere.
C   --
C   --Parameters:
C   --   A - IN - the dynamic memory array
C   --   MSHNUM - IN - the mesh numbering (as in /MSHOPT/)
C   --   MSHLIN - IN - the display type for the mesh lines (as in /MSHOPT/)
C   --   MLNTYP - IN - the line type of lines (as in /MSHOPT/)
C   --   MODDET - IN - the display mode (as in /DETOPT/)
C   --   MODTYP - IN - the display mode type (as in /DETOPT/)
C   --   LENF - IN - the cumulative face counts by element block
C   --   NLNKF - IN - the number of nodes per face
C   --   LINKF - IN - the connectivity for all faces
C   --   LENL - IN - the cumulative line counts by element block
C   --   LINSET - IN - the sorted line set
C   --   HIDENP(i) - IN - true iff node i is hidden (3D only)
C   --   HIDEF(i) - IN - true iff face i is hidden (3D only)
C   --   DOIXF - IN - IXFAC valid iff true
C   --   NXFAC - IN - the number of ordered faces (if DOIXF)
C   --   IXFAC - IN - the indices of the ordered faces (if DOIXF)
C   --   XN, YN, ZN - IN - the nodal coordinates
C   --   XF, YF, ZF - IN - the face center coordinates
C   --   IELBST - IN - the element block status (>0 if selected)
C   --   ISEVOK - IN - the element block variable truth table;
C   --      variable i of block j exists iff ISEVOK(j,i)
C   --   IN2ELB - IN - the element block for each node;
C   --      <0 if not in any selected element block
C   --      =0 if in more than one selected element block
C   --   IVN2B - IN - the element block for each node for the contour variable;
C   --      <0 if not in any selected element block
C   --      =0 if in more than one selected element block
C   --   DODEAD - IN - true iff dead nodes are to be displayed
C   --   IDN2B - IN - the element block for each dead node; dead if >= 0
C   --   NNPSET - IN - the number of selected node sets
C   --   ISSNPS - IN - the indices of the selected node sets
C   --   NESSET - IN - the number of selected side sets
C   --   ISSESS - IN - the indices of the selected side sets
C   --   IDTVAR - IN - the variable numbers, if any
C   --   VARNP - IN - the nodal variable values
C   --   VARFAC - IN - the face variable values
C   --   NMIN, NMAX - IN - the number of variables values matching the
C   --      minimum and the maximum (for contour plots only)
C   --   FMIN, FMAX - IN - the nodal variable minimum and maximum
C   --      (for contour modes only)
C   --   VECMAX - IN - the vector maximum, scaled (for vector only)
C   --   ISVOK - SCRATCH - size = NELBLK, only if any variables
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 cancel function active
C   --
C   --Common Variables:
C   --   Uses NELBLK of /DBNUMS/
C   --   Uses IS3DIM, NUMNPF of /D3NUMS/

      include 'dbnums.blk'
      include 'dbnumgq.blk'
      include 'd3nums.blk'

      DIMENSION A(*)
      CHARACTER*(*) MSHNUM
      INTEGER MLNTYP(-1:1)
      CHARACTER*8 MODDET, MODTYP
      INTEGER LENF(0:NELBLK)
      INTEGER NLNKF(NELBLK)
      INTEGER LINKF(*)
      INTEGER LENL(-2:NELBLK), LINSET(LLNSET,*)
      LOGICAL HIDENP(NUMNPF)
      LOGICAL HIDEF(*)
      LOGICAL DOIXF
      INTEGER IXFAC(*)
      REAL XN(NUMNPF), YN(NUMNPF), ZN(NUMNPF)
      REAL XF(*), YF(*), ZF(*)
      INTEGER IELBST(NELBLK)
      LOGICAL ISEVOK(NELBLK,*)
      INTEGER IN2ELB(NUMNPF)
      INTEGER IVN2B(NUMNPF)
      LOGICAL DODEAD
      INTEGER IDN2B(NUMNPF)
      INTEGER ISSNPS(*)
      INTEGER ISSESS(*)
      INTEGER IDTVAR(*)
      REAL VARNP(*), VARFAC(*)
      REAL VECMAX
      LOGICAL ISVOK(NELBLK)
      INTEGER BLKCOL(0:NELBLK)
      INTEGER IDELB(*)
      INTEGER MAPEL(*), MAPND(*)

      LOGICAL WIDLIN
      LOGICAL LDUM

C   --Call appropriate paint function routine, if any; mesh is drawn
C   --over paint

      IF (MODDET .EQ. 'SOLID') THEN
        IF (DOIXF) THEN
          IF (is3dim .and. IHIDOP .EQ. 5) then
            CALL MDFIND('SHDCOL', KSHDCL, LEN)
            CALL MDFIND('ISHDCL', KISHCL, LEN)
            CALL SHADE (LENF, NLNKF, LINKF, NXFAC, IXFAC,
     &        XN, YN, ZN, IELBST, BLKCOL, IDELB,
     *        A(KSHDCL), A(KISHCL), IHIDOP, *100)
          else if (is3dim .and. ihidop .ge. 6) then
            CALL WRTRAY (LENF, NLNKF, LINKF, NXFAC, IXFAC,
     &        XN, YN, ZN, IELBST, BLKCOL, IDELB, *100)
          ELSE
            CALL SOLID (LENF, NLNKF, LINKF, NXFAC, IXFAC,
     &        XN, YN, ZN, IELBST, BLKCOL, IDELB, *100)
          END IF
        ELSE
          CALL QSOLID (LENF, NLNKF, LINKF, HIDEF,
     &      XN, YN, ZN, IELBST, BLKCOL, IDELB, *100)
        END IF

      ELSE IF (MODDET .EQ. 'CONTOUR') THEN
         IF (MODTYP .EQ. 'PAINT') THEN
C         --Use the selected color table
            CALL GRCOLU ('ALTERNATE')

            CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
            IF (DOIXF) THEN
               CALL PAINT (VARNP, LENF, NLNKF, LINKF, NXFAC, IXFAC,
     &            XN, YN, ZN, XF, YF, ZF, ISVOK, FMIN, FMAX, *100)
            ELSE
               CALL QPAINT (VARNP, LENF, NLNKF, LINKF, HIDEF,
     &            XN, YN, ZN, XF, YF, ZF, ISVOK, FMIN, FMAX, *100)
            END IF

C         --Use the standard color table
            CALL GRCOLU ('STANDARD')
         END IF

      ELSE IF (MODDET .EQ. 'ELEMCONT') THEN
         IF (MODTYP .EQ. 'PAINT') THEN
C         --Use the selected color table
            CALL GRCOLU ('ALTERNATE')

            CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
            IF (DOIXF) THEN
               CALL EPAINT (VARFAC, LENF, NLNKF, LINKF, NXFAC, IXFAC,
     &            XN, YN, ZN, ISVOK, FMIN, FMAX, *100)
            ELSE
               CALL QEPAIN (VARFAC, LENF, NLNKF, LINKF, HIDEF,
     &            XN, YN, ZN, ISVOK, FMIN, FMAX, *100)
            END IF

C         --Use the standard color table
            CALL GRCOLU ('STANDARD')
         END IF
      END IF

C   --Draw mesh (with numbering, etc.)

      WIDLIN = (MODDET .EQ. 'WIREFRAM')

      CALL MSPLT1 (A, WIDLIN, MSHNUM, MSHLIN, MLNTYP,
     &   LENF, NLNKF, LINKF, LENL, LINSET,
     &   HIDENP, HIDEF, XN, YN, ZN, XF, YF, ZF,
     &   IELBST, IN2ELB, DODEAD, IDN2B,
     &   .FALSE., 0, IDUM,
     &   NNPSET, ISSNPS, NESSET, ISSESS, BLKCOL,
     &   IDELB, VARNP, MODDET, IHIDOP, MAPEL, MAPND, *100)

C   --Call appropriate function routine

      IF (MODDET .EQ. 'CONTOUR') THEN
         IF (MODTYP .EQ. 'LINE') THEN
C         --Use the selected color table
            CALL GRCOLU ('ALTERNATE')

            CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
            CALL CONTOR (VARNP, LENF, NLNKF, LINKF, HIDEF,
     &         XN, YN, ZN, XF, YF, ZF, LENL, LINSET,
     &         IVN2B, ISVOK, FMIN, FMAX, *100)

C         --Use the standard color table
            CALL GRCOLU ('STANDARD')
         END IF

         CALL MRKNOD (VARNP, HIDENP,
     &      XN, YN, ZN, IVN2B, NMIN, NMAX, FMIN, FMAX,
     &      BLKCOL,  *100)

      ELSE IF (MODDET .EQ. 'ELEMCONT') THEN
         CALL MRKFAC (LENF(NELBLK), VARFAC, HIDEF, XF, YF, ZF,
     &      NMIN, NMAX, FMIN, FMAX, BLKCOL, *100)

      ELSE IF (MODDET .EQ. 'VECTOR') THEN
         IF ((MODTYP .EQ. 'NODE') .OR. (MODTYP .EQ. 'ELEMENT')) THEN
            N = NDIM
         ELSE
            N = 3
         END IF
         IF (MODTYP .EQ. 'NODE') THEN
            CALL VECTOR (MODTYP, VARNP, NUMNPF, IDUM, IDUM,
     &         HIDENP, XN, YN, ZN, IN2ELB, LDUM, VECMAX,
     &         BLKCOL,  IDELB, *100)
         ELSE
            CALL EVAROK (N, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
            CALL VECTOR (MODTYP, VARFAC, LENF(NELBLK), LENF, NLNKF,
     &         HIDEF, XF, YF, ZF, IDUM, ISVOK, VECMAX, BLKCOL,
     &         IDELB, *100)
         END IF

      ELSE IF (MODDET .EQ. 'SYMBOL') THEN
         CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
         IF (MODTYP .NE. 'STATE') THEN
            CALL SYMBOL_BL (MODTYP, VARFAC, LENF, NLNKF, HIDEF,
     &         XF, YF, ZF, ISVOK, BLKCOL, IDELB, *100)
         ELSE
            CALL ELESTA (MODTYP, VARFAC, LENF, NLNKF, LINKF, HIDEF,
     &         XN, YN, ZN, ISVOK, *100)
         END IF

      ELSE IF (MODDET .EQ. 'GAUSS') THEN
         CALL EVAROK (4, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
         LVARF = LENF(NELBLK)
         CALL GAUSS_BL (MODTYP, VARFAC, LENF, NLNKF, LINKF, HIDEF,
     &      XN, YN, ZN, ISVOK, LVARF, *100)
      END IF

      RETURN

  100 CONTINUE
      RETURN 1
      END
