C Copyright(C) 2009 Sandia Corporation. Under the terms of Contract
C DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
C 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 Sandia Corporation 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 NUMBER (NUMTYP, LENF, NLNKF, IX2NP, IF2EL,
     &   HIDENP, HIDEF, XN, YN, ZN, XF, YF, ZF,
     &   IELBST, IN2ELB, DODEAD, IDN2B,
     &   ISELTY, NNESEL, NESEL, BLKCOL, IDELB, MAPEL, MAPND, *)
C=======================================================================

C   --*** NUMBER *** (MESH) Number nodes and elements on mesh
C   --   Written by Amy Gilkey - revised 03/31/88
C   --
C   --NUMBER numbers nodes and/or elements.  Node numbers are in white
C   --to the top and left of the node.  Element numbers are in the
C   --element block color in the center of the element.
C   --
C   --Parameters:
C   --   NUMTYP - IN - the numbering type (as in MSHNUM of /MSHOPT/)
C   --   LENF - IN - the cumulative face counts by element block
C   --   NLNKF - IN - the number of nodes per face
C   --   IX2NP - IN - the node number for each mesh index
C   --   IF2EL - IN - the element number of each face
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   --   XN, YN, ZN - IN - the nodal coordinates
C   --   XF, YF, ZF - IN - the element center coordinates
C   --   IELBST - IN - the element block status (>0 if selected)
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   --   DODEAD - IN - number dead nodes iff true
C   --   IDN2B - IN - the element block for each dead node; dead if >= 0
C   --   ISELTY - IN - the type of selected nodes/elements
C   --      (as in MSHNUM of /MSHOPT/)
C   --   NNESEL - IN - the number of selected nodes/elements
C   --   NESEL - IN - the selected nodes/elements
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
C   --   * - return statement if the cancel function is active
C   --
C   --Common Variables:
C   --   Uses NELBLK of /DBNUMS/
C   --   Uses IS3DIM, NUMNPF of /D3NUMS/

      PARAMETER (KHCHSZ=1, KSCHSZ=2)

      common /debugc/ cdebug
      common /debugn/ idebug
      character*8 cdebug

      include 'dbnums.blk'
      COMMON /D3NUMS/ IS3DIM, NNPSUR, NUMNPF, LLNSET
      LOGICAL IS3DIM

      CHARACTER*(*) NUMTYP
      INTEGER LENF(0:NELBLK)
      INTEGER NLNKF(NELBLK)
      INTEGER IX2NP(NUMNPF)
      INTEGER IF2EL(*)
      LOGICAL HIDENP(NUMNPF)
      LOGICAL HIDEF(*)
      REAL XN(NUMNPF), YN(NUMNPF), ZN(NUMNPF)
      REAL XF(*), YF(*), ZF(*)
      INTEGER IELBST(NELBLK)
      INTEGER IN2ELB(NUMNPF)
      LOGICAL DODEAD
      INTEGER IDN2B(NUMNPF)
      CHARACTER*(*) ISELTY
      INTEGER NESEL(*)
      INTEGER BLKCOL(0:NELBLK)
      INTEGER IDELB(*)
      INTEGER MAPEL(*), MAPND(*)

      LOGICAL PLTGTT, LDUM
      LOGICAL GRABRT
      LOGICAL EXISTS
      LOGICAL SOFTCH
      logical logt
      LOGICAL OK1, OK2
      CHARACTER*10 ISTR
      INTEGER IFACES(10)

      EXISTS (M) = (MOD(M,2) .NE. 0)

C   --Get software character flag for current device
      CALL GRGPAR ('SOFTCHAR', 0, SOFTCH, ISTR)

      IF ((NUMTYP .EQ. 'SELECTED') .AND. (ISELTY .EQ. 'NODE')) THEN

C      --Number selected nodes

         IF (SOFTCH) THEN
            DXO = .001
            DYO = .002
         ELSE
            DXO = 0.0
            DYO = 0.0
         END IF

         CALL UGRCOL (0, BLKCOL)

         DO 100 INE = 1, NNESEL
            INP = NESEL(INE)
            IF (IS3DIM) THEN
               IF (HIDENP(INP)) GOTO 100
            END IF

            if (IN2ELB(inp) .GE. 0) then 
               logt = .true.
            else if (dodead) then
               if (IDN2B(inp) .GE. 0) logt = .true.
            end if

            if (logt) then
               IF (GRABRT ()) RETURN 1
               NNUM = MAPND(INP)
               CALL INTSTR (1, 0, NNUM, ISTR, LSTR)
               CALL MP2PT (1, XN(INP), YN(INP), DX0, DY0, MASK)
               IF (EXISTS (MASK))
     &            CALL GRTEXT (DX0+DXO, DY0+DYO, ISTR(:LSTR))
            END IF
  100    CONTINUE

         CALL PLTFLU

      ELSE IF ((NUMTYP .EQ. 'NODE') .OR. (NUMTYP .EQ. 'ALL')) THEN

C      --Number all nodes

         IF (SOFTCH) THEN
            DXO = .001
            DYO = .002
         ELSE
            DXO = 0.0
            DYO = 0.0
         END IF

         CALL UGRCOL (0, BLKCOL)

         DO 110 INP = 1, NUMNPF
            IF (IS3DIM) THEN
               IF (HIDENP(INP)) GOTO 110
            END IF

            if (IN2ELB(inp) .GE. 0) then 
               logt = .true.
            else if (dodead) then
               if (IDN2B(inp) .GE. 0) logt = .true.
            end if

            if (logt) then
               IF (GRABRT ()) RETURN 1
               NNUM = MAPND(INP)
               CALL INTSTR (1, 0, NNUM, ISTR, LSTR)
               CALL MP2PT (1, XN(INP), YN(INP), DX0, DY0, MASK)
               IF (EXISTS (MASK))
     &            CALL GRTEXT (DX0+DXO, DY0+DYO, ISTR(:LSTR))
            END IF
  110    CONTINUE

         CALL PLTFLU
      END IF

      IF (ISELTY .EQ. 'NODE') THEN

C      --Draw arrows

         CALL GRCOLR (3)

         OK2 = .FALSE.
         DO 120 INE = 1, NNESEL
            OK1 = OK2
            OK2 = .FALSE.

            INP = NESEL(INE)
            IF (IS3DIM) THEN
               IF (HIDENP(INP)) GOTO 120
            END IF

            if (IN2ELB(inp) .GE. 0) then 
               logt = .true.
            else if (dodead) then
               if (IDN2B(inp) .GE. 0) logt = .true.
            end if

            if (logt) then
               X2 = XN(INP)
               Y2 = YN(INP)
               OK2 = .TRUE.

               IF (OK1 .AND. OK2) THEN
                  IF (GRABRT ()) RETURN 1
                  CALL MP2VC (1, X1, Y1, X2, Y2,
     &               DX1, DY1, DX2, DY2, MASK)
                  IF (EXISTS (MASK))
     &               CALL PLTARR (DX1, DY1, DX2, DY2, .5, .0075)
               END IF

               X1 = X2
               Y1 = Y2
            END IF
  120    CONTINUE

         CALL PLTFLU
      END IF

      IF ((NUMTYP .EQ. 'SELECTED') .AND. (ISELTY .EQ. 'ELEMENT')) THEN

         IF (SOFTCH) THEN
            LDUM = PLTGTT (KSCHSZ, CHSIZ)
         ELSE
            LDUM = PLTGTT (KHCHSZ, CHSIZ)
         END IF
         DXO = 0.0
         DYO = -.5 * CHSIZ

C      --Number selected elements by element block color

         DO 140 IELB = 1, NELBLK
            IF (IELBST(IELB) .GT. 0) THEN

c               CALL UGRCOL (IDELB(IELB), BLKCOL)
               CALL UGRCOL (IELB, BLKCOL)

               DO 130 IFAC = LENF(IELB-1)+1, LENF(IELB)
                  IF (IS3DIM) THEN
                     IF (HIDEF(IFAC)) GOTO 130
                  END IF

                  IEL = IF2EL(IFAC)
                  IF (LOCINT (IEL, NNESEL, NESEL) .GT. 0) THEN
                     IF (GRABRT ()) RETURN 1
                     if ((cdebug .eq. 'HIDDEN')
     &                  .or. (cdebug .eq. 'NUMBER')) iel = ifac
                     NNUM = MAPEL(IEL)
                     CALL INTSTR (1, 0, NNUM, ISTR, LSTR)
                     CALL MP2PT (1, XF(IFAC), YF(IFAC), DX0, DY0, MASK)
                     IF (EXISTS (MASK))
     &                  CALL GRTEXC (DX0+DXO, DY0+DYO, ISTR(:LSTR))
                  END IF
  130          CONTINUE
            END IF
  140    CONTINUE

         CALL PLTFLU

      ELSE IF ((NUMTYP .EQ. 'ELEMENT') .OR. (NUMTYP .EQ. 'ALL')) THEN

         IF (SOFTCH) THEN
            LDUM = PLTGTT (KSCHSZ, CHSIZ)
         ELSE
            LDUM = PLTGTT (KHCHSZ, CHSIZ)
         END IF
         DXO = 0.0
         DYO = -.5 * CHSIZ

C      --Number elements by element block color

         DO 160 IELB = 1, NELBLK
            IF (IELBST(IELB) .GT. 0) THEN

c               CALL UGRCOL (IDELB(IELB), BLKCOL)
               CALL UGRCOL (IELB, BLKCOL)

               DO 150 IFAC = LENF(IELB-1)+1, LENF(IELB)
                  IF (IS3DIM) THEN
                     IF (HIDEF(IFAC)) GOTO 150
                  END IF

                  IEL = IF2EL(IFAC)
                  IF (GRABRT ()) RETURN 1
                  if ((cdebug .eq. 'HIDDEN')
     &               .or. (cdebug .eq. 'NUMBER')) iel = ifac
                  CALL INTSTR (1, 0, MAPEL(IEL), ISTR, LSTR)
                  CALL MP2PT (1, XF(IFAC), YF(IFAC), DX0, DY0, MASK)
                  IF (EXISTS (MASK))
     &               CALL GRTEXC (DX0+DXO, DY0+DYO, ISTR(:LSTR))
  150          CONTINUE
            END IF
  160    CONTINUE

         CALL PLTFLU
      END IF

      IF (ISELTY .EQ. 'ELEMENT') THEN

C      --Draw arrows

         DYO = -.5 * CHSIZ - .002

         CALL GRCOLR (3)

         OK2 = .FALSE.
         DO 180 INE = 1, NNESEL
            OK1 = OK2
            OK2 = .FALSE.

            IEL = NESEL(INE)
            NQARY = 10
            CALL FNDE2F (IEL, LENF, IF2EL, NQARY, IFACES, IELB)

            IF ((NQARY .GT. 0) .AND. (IELBST(IELB) .GT. 0)) THEN
               NOK = 0
               X2 = 0.0
               Y2 = 0.0
               DO 170 N = 1, NQARY
                  IFAC = IFACES(N)
                  IF (IS3DIM) THEN
                     IF (HIDEF(IFAC)) GOTO 170
                  END IF
                  X2 = X2 + XF(IFAC)
                  Y2 = Y2 + YF(IFAC)
                  NOK = NOK + 1
                  OK2 = .TRUE.
  170          CONTINUE
               IF (NOK .GT. 1) THEN
                  X2 = X2 / NOK
                  Y2 = Y2 / NOK
               END IF

               IF (OK1 .AND. OK2) THEN
                  IF (GRABRT ()) RETURN 1
                  CALL MP2VC (1, X1, Y1, X2, Y2,
     &               DX1, DY1, DX2, DY2, MASK)
                  IF (EXISTS (MASK))
     &               CALL PLTARR (DX1, DY1+DYO, DX2, DY2+DYO, .5, .0075)
               END IF

               X1 = X2
               Y1 = Y2
            END IF
  180    CONTINUE

         CALL PLTFLU
      END IF

      RETURN
      END
