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 CONTF (CNTR, VARNP, NLNKF, LINKF1,
     &   XN, YN, ZN, XF, YF, ZF)
C=======================================================================

C   --*** CONTF *** (DETOUR) Plot line contours for a face
C   --   Written by Amy Gilkey - revised 10/22/87
C   --   D. P. Flanagan, 03/30/83
C   --
C   --CONTF draws a contour line for a face.  The contour algorithm
C   --assumes that the elements do not contain internal nodes.
C   --The element interpolation field is approximated by logically drawing
C   --lines from each node to the element center and, thusly, dividing the
C   --element into triangles.  Contour lines are then drawn by connecting
C   --the intersection points of the sub-element edges and the contour plane.
C   --
C   --Parameters:
C   --   CNTR - the contour value
C   --   VARNP - IN - the contour function values
C   --   NLNKF - IN - the number of nodes per face
C   --   LINKF1 - IN - the connectivity for the face
C   --   XN, YN, ZN - IN - the nodal coordinates
C   --   XF, YF, ZF - IN - the face center coordinates
C   --   * - return statement if the cancel function is active
C   --
C   --Common Variables:
C   --   Uses IS3DIM of /D3NUMS/

      include 'd3nums.blk'

      REAL VARNP(*)
      INTEGER LINKF1(NLNKF)
      REAL XN(*), YN(*), ZN(*)

      LOGICAL INTERP_BL
      LOGICAL CROSSL, CROSSN

C   --Compute the minimum and maximum values for the face

      FEMAX = VARNP(LINKF1(1))
      FEMIN = VARNP(LINKF1(1))
      DO 100 K = 2, NLNKF
         FEMAX = MAX (FEMAX, VARNP(LINKF1(K)))
         FEMIN = MIN (FEMIN, VARNP(LINKF1(K)))
  100 CONTINUE

      IF ((FEMIN .LE. CNTR) .AND. (FEMAX .GE. CNTR)) THEN

C      --Contour line runs through the face

         IF (NLNKF .EQ. 3) THEN

C         --Special case - triangle element

            N = LINKF1(2)
            FM = VARNP(N)
            XM = XN(N)
            YM = YN(N)
            NTRI = 1
            NNPF = NLNKF

         ELSE IF ((.NOT. IS3DIM) .AND. (NLNKF .EQ. 8)) THEN

C         --Compute center function value and coordinates

            FM = 0.0
            DO 110 K = 1, NLNKF, 2
               FM = FM - .25 * VARNP(LINKF1(K))
  110       CONTINUE
            DO 120 K = 2, NLNKF, 2
               FM = FM + .5 * VARNP(LINKF1(K))
  120       CONTINUE
            FM = FM
            XM = XF
            YM = YF
            NTRI = NLNKF
            NNPF = NLNKF

         ELSE IF ((.NOT. IS3DIM) .AND. (NLNKF .EQ. 9)) THEN

C         --Get center function value and coordinates

            FM = VARNP(LINKF1(9))
            XM = XN(LINKF1(9))
            YM = YN(LINKF1(9))
            NTRI = NLNKF - 1
            NNPF = NLNKF - 1

         ELSE

C         --Compute center function value and coordinates

            FM = 0.0
            DO 130 K = 1, NLNKF
               FM = FM + VARNP(LINKF1(K))
  130       CONTINUE
            FM = FM / NLNKF
            XM = XF
            YM = YF
            NTRI = NLNKF
            NNPF = NLNKF
         END IF

         N = LINKF1(NNPF)
         CROSSN = (INTERP_BL (CNTR, FM, VARNP(N), PSI))
         IF (CROSSN) THEN
            XCN = XM * (1.-PSI) + XN(N) * PSI
            YCN = YM * (1.-PSI) + YN(N) * PSI
         END IF

         DO 140 K = 1, NTRI
            L = N
            N = LINKF1(K)
            CROSSL = CROSSN
            IF (CROSSL) THEN
               XCL = XCN
               YCL = YCN
            END IF
            CROSSN = (INTERP_BL (CNTR, FM, VARNP(N), PSI))
            IF (CROSSN) THEN
               XCN = XM * (1.-PSI) + XN(N) * PSI
               YCN = YM * (1.-PSI) + YN(N) * PSI
            END IF

            IF (CROSSL .OR. CROSSN) THEN
               IF (INTERP_BL (CNTR, VARNP(N), VARNP(L), PSI)) THEN
                  XC0 = XN(N) * (1.-PSI) + XN(L) * PSI
                  YC0 = YN(N) * (1.-PSI) + YN(L) * PSI
                  IF (CROSSL .AND. CROSSN) THEN
C                  --There are three cases where the contour crosses the
C                  --side and both middle lines: contour = middle point
C                  --(go either way), contour = side last corner (go to
C                  --next), contour = side next corner (go to last)
                     IF ((ABS (XC0 - XCL) + ABS (YC0 - YCL)) .LT.
     &                  (ABS (XC0 - XCN) + ABS (YC0 - YCN)))
     &                  CROSSL = .FALSE.
                  END IF
                  IF (CROSSL) THEN
                     CALL MPD2VC (1, XCL, YCL, XC0, YC0)
                  ELSE
                     CALL MPD2VC (1, XC0, YC0, XCN, YCN)
                  END IF
               ELSE IF (CROSSL .AND. CROSSN) THEN
                  CALL MPD2VC (1, XCL, YCL, XCN, YCN)
               ELSE
C               --If the contour crosses the next middle line but not
C               --the side or the last middle line (impossible with
C               --absolute accuracy), ignore crossing.
                  CROSSN = .FALSE.
               END IF
            END IF
  140    CONTINUE
      END IF

      RETURN
      END
