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 HIDEDG (HIDEF, HIDENP, LENF, NLNKE, NLNKF, LINKF,
     &   NOTSEL, IELBST, IEDSET, NEDGES, NREF, LREF, MREF,
     *  ISBACK, NAMELB)
C=======================================================================

C   --*** HIDEDG *** (MESH) Identify 3D lines on edge of visible mesh
C   --   Written by Amy Gilkey - revised 02/26/88
C   --
C   --HIDEDG finds all lines that may make up the visible edge of the mesh.
C   --"Edges" are lines of partially visible faces or lines of
C   --totally visible faces which have no matching edge.
C   --
C   --Parameters:
C   --   HIDEF(i) - IN - true iff face i is hidden
C   --   HIDENP - IN - node status (as in HIDDEN)
C   --   LENF - IN - the cumulative face counts by element block
C   --   NLNKE - IN - the number of nodes per element
C   --   NLNKF - IN - the number of nodes per face
C   --   LINKF - IN - the connectivity for all faces
C   --   NOTSEL - IN - true iff faces with selected element blocks
C   --      are not needed
C   --   IELBST - IN - the element block status (>0 if selected)
C   --   IEDSET - OUT - the edge line set; (0) = face defining edge
C   --   NEDGES - OUT - the number of lines in the edge set
C   --   NREF - SCRATCH - the number of references to a node in the edge set;
C   --      length = NUMNPF
C   --   LREF - SCRATCH - the last edge set index of a node in the edge set;
C   --      length = NUMNPF
C   --
C   --Common Variables:
C   --   Uses NELBLK of /DBNUMS/
C   --   Uses NUMNPF of /D3NUMS/

      PARAMETER (KFVIS=0, KFNODH=10, KFPOUT=20, KFOUT=90, KFAWAY=100)
      PARAMETER (KNVIS=0, KNFOVR=10, KNHID=100)

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

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

      INTEGER HIDEF(*)
      INTEGER HIDENP(*)
      INTEGER LENF(0:NELBLK)
      INTEGER NLNKE(NELBLK)
      INTEGER NLNKF(NELBLK)
      INTEGER LINKF(*)
      LOGICAL NOTSEL
      INTEGER IELBST(NELBLK)
      INTEGER IEDSET(0:2,*)
      INTEGER NREF(NUMNPF), LREF(NUMNPF), MREF(NUMNPF)
      LOGICAL ISBACK(NUMNPF)
      CHARACTER*(*) NAMELB(*)

      LOGICAL ANYBRI, ANYSHE

      ANYBRI = .FALSE.
      ANYSHE = .FALSE.
      DO 100 IELB = 1, NELBLK
         IF (NLNKE(IELB) .GT. 4) ANYBRI = .TRUE.
         IF (NAMELB(IELB)(:3) .EQ. 'TET') ANYBRI = .TRUE.
         IF (NLNKE(IELB) .EQ. 4 .AND. NAMELB(IELB)(:3) .NE. 'TET')
     $        ANYSHE = .TRUE.
  100 CONTINUE

      CALL INIINT (NUMNPF, 0, LREF)

      IF (.NOT. ANYBRI) GOTO 200

C   --Mark nodes in faces that point away

      CALL INILOG (NUMNPF, .FALSE., ISBACK)

      DO 130 IELB = 1, NELBLK
         IF (NLNKE(IELB) .GT. 4 .OR. NAMELB(IELB)(:3) .eq. 'TET') THEN
            IXL0 = IDBLNK (IELB, 0, LENF, NLNKF) - 1
            DO 120 IFAC = LENF(IELB-1)+1, LENF(IELB)
               IF (HIDEF(IFAC) .GE. KFAWAY) THEN
                  DO 110 ILINK = 1, NLNKF(IELB)
                     ISBACK(LINKF(IXL0+ILINK)) = .TRUE.
  110             CONTINUE
               END IF
               IXL0 = IXL0 + NLNKF(IELB)
  120       CONTINUE
         END IF
  130 CONTINUE

      NEDGES = 0
      nmov = 0
      DO 190 IELB = 1, NELBLK
         IF (NLNKE(IELB) .GT. 4 .OR. NAMELB(IELB)(:3) .eq. 'TET') THEN

C         --Eliminate faces of a selected element block
            IF (NOTSEL .AND. (IELBST(IELB) .GT. 0)) GOTO 190

            DO 180 IFAC = LENF(IELB-1)+1, LENF(IELB)
               IF (HIDEF(IFAC) .LT. KFOUT) THEN
                  IXL0 = IDBLNK (IELB, IFAC, LENF, NLNKF) - 1

C               --Eliminate faces that do not have any nodes in faces
C               --that point away

                  NBACK = 0
                  DO 140 ILINK = 1, NLNKF(IELB)
                     IF (ISBACK(LINKF(IXL0+ILINK))) NBACK = NBACK + 1
  140             CONTINUE
                  IF (NBACK .LT. 2) GOTO 180

C               --Extract face lines

                  NOLD = NEDGES
                  N2 = LINKF(IXL0+NLNKF(IELB))
                  LREFN2 = LREF(N2)
                  LSTREF = LREFN2

                  DO 170 ILINK = 1, NLNKF(IELB)
                     N1 = N2
                     N2 = LINKF(IXL0+ILINK)
                     LREFN1 = LREFN2
                     IF (ILINK .LT. NLNKF(IELB)) THEN
                        LREFN2 = LREF(N2)
                     ELSE
                        LREFN2 = LSTREF
                     END IF

                     IF (n1 .eq. n2) goto 170
                     IF (.NOT. ISBACK(N1)) GOTO 170
                     IF (.NOT. ISBACK(N2)) GOTO 170
                     IF ((HIDENP(N1) .GT. KNVIS)
     &                  .AND. (HIDENP(N2) .GT. KNVIS)) GOTO 170
                     IF (HIDENP(N1) .GE. KNHID) GOTO 170
                     IF (HIDENP(N2) .GE. KNHID) GOTO 170
                     NMIN = MIN (N1, N2)
                     NMAX = MAX (N1, N2)

C                  --Search for line in existing lines

                     DO 150 IL = MIN (LREFN1, LREFN2, NOLD), 1, -1
                       IF (IEDSET(1,IL) .EQ. NMIN .AND.
     *                     IEDSET(2,IL) .EQ. NMAX) GOTO 160
  150                CONTINUE
  160                CONTINUE

C                  --Insert new line or pointer to face if duplicate

                     IF (IL .GT. 0) THEN
                        IF (NBACK .LE. 2) IEDSET(0,IL) = IFAC
                        nmov = nmov + 1
                     ELSE
                        NEDGES = NEDGES + 1
                        IEDSET(0,NEDGES) = IFAC
                        IEDSET(1,NEDGES) = NMIN
                        IEDSET(2,NEDGES) = NMAX
                        LREF(N1) = NEDGES
                        LREF(N2) = NEDGES
                     END IF
  170             CONTINUE
               END IF
  180       CONTINUE
         END IF
  190 CONTINUE

      if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
     &   write (*, '(1x,a,i5)') 'non-shell visible edge set =', nedges
      if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
     &   write (*, '(1x,a,i5)') '***removed =', nmov
  200 CONTINUE

      IF (.NOT. ANYSHE) GOTO 320

C   --Mark nodes in shell faces with any nodes hidden

      DO 210 INP = 1, NUMNPF
         IF (LREF(INP) .LE. 0) THEN
            NREF(INP) = 0
         ELSE
            NREF(INP) = 1
         END IF
  210 CONTINUE

      CALL INILOG (NUMNPF, .FALSE., ISBACK)

      DO 250 IELB = 1, NELBLK
         IF (NLNKE(IELB) .EQ. 4 .AND. NAMELB(IELB)(:3) .ne. 'TET') THEN
            IXL0 = IDBLNK (IELB, 0, LENF, NLNKF) - 1
            DO 240 IFAC = LENF(IELB-1)+1, LENF(IELB)
               NHID = 0
               DO 220 ILINK = 1, NLNKF(IELB)
                  IF (HIDENP(LINKF(IXL0+ILINK)) .GT. KNVIS)
     &               NHID = NHID + 1
  220          CONTINUE
               IF (NHID .GT. 0) THEN
                  DO 230 ILINK = 1, NLNKF(IELB)
C????                     ISBACK(LINKF(IXL0+ILINK)) = .TRUE.
  230             CONTINUE
               END IF
               IXL0 = IXL0 + NLNKF(IELB)
  240       CONTINUE
         END IF
  250 CONTINUE

      NEWEDG = NEDGES + 1
      nmov = 0

      call iniint(numnpf, 0, mref)
      do i=nedges, 1, -1
        mref(iedset(1,i)) = i
        mref(iedset(2,i)) = i
      end do

      DO 310 IELB = 1, NELBLK
         IF (NLNKE(IELB) .EQ. 4 .AND. NAMELB(IELB)(:3) .ne. 'TET') THEN

C         --Eliminate faces of a selected element block
            IF (NOTSEL .AND. (IELBST(IELB) .GT. 0)) GOTO 310

            DO 300 IFAC = LENF(IELB-1)+1, LENF(IELB)
               IF (HIDEF(IFAC) .LT. KFOUT) THEN
                  IXL0 = IDBLNK (IELB, IFAC, LENF, NLNKF) - 1

C               --Extract face lines

                  NOLD = NEDGES
                  N2 = LINKF(IXL0+NLNKF(IELB))
                  LREFN2 = LREF(N2)
                  LSTREF = LREFN2

                  DO 290 ILINK = 1, NLNKF(IELB)
                     N1 = N2
                     N2 = LINKF(IXL0+ILINK)
                     LREFN1 = LREFN2
                     IF (ILINK .LT. NLNKF(IELB)) THEN
                        LREFN2 = LREF(N2)
                     ELSE
                        LREFN2 = LSTREF
                     END IF

                     IF ((HIDENP(N1) .GT. KNVIS)
     &                  .AND. (HIDENP(N2) .GT. KNVIS)) GOTO 290
                     IF (HIDENP(N1) .GE. KNHID) GOTO 290
                     IF (HIDENP(N2) .GE. KNHID) GOTO 290
                     NMIN = MIN (N1, N2)
                     NMAX = MAX (N1, N2)

C                  --Search for line in existing lines

                     IMIN = max(mref(n1), mref(n2),1)
                     DO 260 IL = MIN (LREFN1, LREFN2, NOLD), IMIN, -1
                       IF (IEDSET(1,IL) .EQ. NMIN .AND.
     *                     IEDSET(2,IL) .EQ. NMAX) GOTO 270
 260                 CONTINUE
 270                 CONTINUE

                     IF (IL .GT. 0) THEN
                        IF (IL .LT. NEWEDG) THEN

C                        --Leave edge matching non-shell as edge
                           CONTINUE

                        ELSE IF (ISBACK(N1) .OR. ISBACK(N2)) THEN

C                        --Adjust pointer to face if duplicate line and either
C                        --node is hidden in a shell quad
                           NHID = 0
                           DO 280 I = 1, NLNKF(IELB)
                              IF (HIDENP(LINKF(IXL0+I)) .GT. KNVIS)
     &                           NHID = NHID + 1
  280                      CONTINUE
                           IF (NHID .LE. 0) IEDSET(0,NEDGES) = IFAC
C????C should check the ZQ coordinate

                        ELSE

C                        --Delete duplicate line if both nodes visible
C                        --in all shell quads

                           IEDSET(0,IL) = IEDSET(0,NEDGES)
                           IEDSET(1,IL) = IEDSET(1,NEDGES)
                           IEDSET(2,IL) = IEDSET(2,NEDGES)
                           NREF(N1) = NREF(N1) - 1
                           NREF(N2) = NREF(N2) - 1
                           IF (NREF(N1) .LE. 0) LREF(N1) = 0
                           IF (NREF(N2) .LE. 0) LREF(N2) = 0
                           NEDGES = NEDGES - 1
                           IF (NOLD .GT. NEDGES) NOLD = NEDGES
                           nmov = nmov + 1
                        END IF
                     ELSE

C                     --Insert new line

                        NEDGES = NEDGES + 1
                        IEDSET(0,NEDGES) = IFAC
                        IEDSET(1,NEDGES) = NMIN
                        IEDSET(2,NEDGES) = NMAX
                        NREF(N1) = NREF(N1) + 1
                        NREF(N2) = NREF(N2) + 1
                        LREF(N1) = NEDGES
                        LREF(N2) = NEDGES
                        if (mref(n1) .eq. 0) mref(n1) = nedges
                        if (mref(n2) .eq. 0) mref(n2) = nedges
                     END IF
  290             CONTINUE
               END IF
  300       CONTINUE
         END IF
  310 CONTINUE

      if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
     &   write (*, '(1x,a,i5)') 'shell visible edge set =',
     &   nedges - newedg + 1
      if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
     &   write (*, '(1x,a,i5)') '***removed =', nmov
  320 CONTINUE

C   --Make sure hidden node is in IEDSET(2,x)

      DO 330 IEDG = 1, NEDGES
         IF (HIDENP(IEDSET(1,IEDG)) .GT. KNVIS) THEN
            I = IEDSET(1,IEDG)
            IEDSET(1,IEDG) = IEDSET(2,IEDG)
            IEDSET(2,IEDG) = I
         END IF
  330 CONTINUE

      RETURN
      END
