C    Copyright(C) 1999-2021 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

      SUBROUTINE LONGEL (MXND, MLN, LNODES, XN, YN, NUID, LXK, KXL, NXL,
     &   LXN, NNN, NAVAIL, IAVAIL, NODE, KELEM, ANG, TOLER,
     &   N1, N2, KREG, XMIN, XMAX, YMIN, YMAX, KKK, LLL, DONE, GRAPH,
     &   VIDEO, NOROOM, ERR, KKKADD)
C***********************************************************************

C  SUBROUTINE LONGEL = AN ELONGATED ELEMENT OVER 150 DEGREES GETS A
C                      3 ELEMENT REPLACEMENT FOR THE TWO ELEMENTS THERE

C***********************************************************************

      DIMENSION LXK(4, MXND), NXL(2, 3*MXND), KXL(2, 3*MXND)
      DIMENSION LXN(4, MXND), XN(MXND), YN(MXND), NUID(MXND)
      DIMENSION LNODES (MLN, MXND)
      DIMENSION NODES(4)

      LOGICAL NOROOM, ERR, DONE, GRAPH, CCW, VIDEO

      CCW = .TRUE.

C  SEE IF THE ANGLE IS WITHIN BOUNDS

      IF (ANG .GT. TOLER) THEN
         CALL GNXKA (MXND, XN, YN, KELEM, NODES, AREA, LXK, NXL, CCW)
         NODE2 = NODES(1) + NODES(2) + NODES(3) + NODES(4) - NODE
     &      - N1 - N2
         D12 = SQRT ( ((XN (NODE2) - XN (N1)) ** 2) +
     &      ((YN (NODE2) - YN (N1)) ** 2) )
         D22 = SQRT ( ((XN (NODE2) - XN (N2)) ** 2) +
     &      ((YN (NODE2) - YN (N2)) ** 2) )
         DN1 = SQRT ( ((XN (NODE) - XN (N1)) ** 2) +
     &      ((YN (NODE) - YN (N1)) ** 2) )
         DN2 = SQRT ( ((XN (NODE) - XN (N2)) ** 2) +
     &      ((YN (NODE) - YN (N2)) ** 2) )
         DMIN = ((DN1 + DN2) * .5) * 1.7
         DMAX = (DN1 + DN2) * .5

C  SEE IF IT IS A LONG LEGGED BEAST

         IF ((D12 .GT. DMIN) .OR. (D22 .GT. DMIN)) THEN

C  FIND L1, L2, L3, AND L4

            DO 100 I = 1, 4
               LTEST = LXK (I, KELEM)
               IF ( ((NXL (1, LTEST) .EQ. NODE) .AND.
     &            (NXL (2, LTEST) .EQ. N1)) .OR.
     &            ((NXL (2, LTEST) .EQ. NODE) .AND.
     &            (NXL (1, LTEST) .EQ. N1)) ) THEN
                  L1 = LTEST
                  GOTO 110
               ENDIF
  100       CONTINUE
            CALL MESSAGE('** PROBLEMS IN LONGEL FINDING L1 **')
            ERR = .TRUE.
            GOTO 250
  110       CONTINUE

            DO 120 I = 1, 4
               LTEST = LXK (I, KELEM)
               IF ( ((NXL (1, LTEST) .EQ. NODE) .AND.
     &            (NXL (2, LTEST) .EQ. N2)) .OR.
     &            ((NXL (2, LTEST) .EQ. NODE) .AND.
     &            (NXL (1, LTEST) .EQ. N2)) ) THEN
                  L2 = LTEST
                  GOTO 130
               ENDIF
  120       CONTINUE
            CALL MESSAGE('** PROBLEMS IN LONGEL FINDING L2 **')
            ERR = .TRUE.
            GOTO 250
  130       CONTINUE

            DO 140 I = 1, 4
               LTEST = LXK (I, KELEM)
               IF ( ((NXL (1, LTEST) .EQ. NODE2) .AND.
     &            (NXL (2, LTEST) .EQ. N1)) .OR.
     &            ((NXL (2, LTEST) .EQ. NODE2) .AND.
     &            (NXL (1, LTEST) .EQ. N1)) ) THEN
                  IF (D12 .GT. D22) THEN
                     L4 = LTEST
                  ELSE
                     L3 = LTEST
                  ENDIF
                  GOTO 150
               ENDIF
  140       CONTINUE
            CALL MESSAGE('** PROBLEMS IN LONGEL FINDING L4/L3 **')
            ERR = .TRUE.
            GOTO 250
  150       CONTINUE

            DO 160 I = 1, 4
               LTEST = LXK (I, KELEM)
               IF ( ((NXL (1, LTEST) .EQ. NODE2) .AND.
     &            (NXL (2, LTEST) .EQ. N2)) .OR.
     &            ((NXL (2, LTEST) .EQ. NODE2) .AND.
     &            (NXL (1, LTEST) .EQ. N2)) ) THEN
                  IF (D12 .GT. D22) THEN
                     L3 = LTEST
                  ELSE
                     L4 = LTEST
                  ENDIF
                  GOTO 170
               ENDIF
  160       CONTINUE
            CALL MESSAGE('** PROBLEMS IN LONGEL FINDING L3/L4 **')
            ERR = .TRUE.
            GOTO 250
  170       CONTINUE

C  NOW FIND KELEM2

            KELEM2 = KXL (1, L4) + KXL (2, L4) - KELEM
            IF (KELEM2 .EQ. 0) GOTO 250

C  NOW FIND NODE3 - THE NODE THAT WILL BE PART OF THE NEWLY
C  FORMED ELEMENT

            CALL GNXKA (MXND, XN, YN, KELEM2, NODES, AREA,
     &         LXK, NXL, CCW)

            IF (D12 .GT. D22) THEN
               DO 180 I = 1, 4
                  IF (NODES (I) .EQ. N1) THEN
                     IF (I .EQ. 1) THEN
                        NODE3 = NODES (4)
                     ELSE
                        NODE3 = NODES (I - 1)
                     ENDIF
                     GOTO 190
                  ENDIF
  180          CONTINUE
               CALL MESSAGE('**PROBLEMS IN LONGEL FINDING NODE3/D11**')
               ERR = .TRUE.
               GOTO 250
  190          CONTINUE

            ELSE
               DO 200 I = 1, 4
                  IF (NODES (I) .EQ. N2) THEN
                     IF (I .EQ. 4) THEN
                        NODE3 = NODES (1)
                     ELSE
                        NODE3 = NODES (I + 1)
                     ENDIF
                     GOTO 210
                  ENDIF
  200          CONTINUE
               CALL MESSAGE('**PROBLEMS IN LONGEL FINDING NODE3/D11**')
               ERR = .TRUE.
               GOTO 250
  210          CONTINUE
            ENDIF

C  NOW FIND L5

            DO 220 I = 1, 4
               LTEST = LXK (I, KELEM2)
               IF (D12 .GT. D22) THEN
                  IF ( ( (NXL (1, LTEST) .EQ. NODE3) .AND.
     &               (NXL (2, LTEST) .EQ. N1) ) .OR.
     &               ( (NXL (1, LTEST) .EQ. N1) .AND.
     &               (NXL (2, LTEST) .EQ. NODE3) ) ) THEN
                     L5 = LTEST
                     GOTO 230
                  ENDIF
               ELSE
                  IF ( ( (NXL (1, LTEST) .EQ. NODE3) .AND.
     &               (NXL (2, LTEST) .EQ. N2) ) .OR.
     &               ( (NXL (1, LTEST) .EQ. N2) .AND.
     &               (NXL (2, LTEST) .EQ. NODE3) ) ) THEN
                     L5 = LTEST
                     GOTO 230
                  ENDIF
               ENDIF
  220       CONTINUE
            CALL MESSAGE('** PROBLEMS IN LONGEL FINDING L5 **')
            ERR = .TRUE.
            GOTO 250
  230       CONTINUE

C  NOW CHECK TO SEE IF IT MAKES SENSE TO ADD THE EXTRA ELEMENT TO
C  IMPROVE AN ELONGATED ONE

            DL3 = SQRT ( ((XN (NXL (1, L3)) - XN (NXL (2, L3))) ** 2) +
     &         ((YN (NXL (1, L3)) - YN (NXL (2, L3))) ** 2) )
            DL4 = SQRT ( ((XN (NXL (1, L4)) - XN (NXL (2, L4))) ** 2) +
     &         ((YN (NXL (1, L4)) - YN (NXL (2, L4))) ** 2) )
            DL5 = SQRT ( ((XN (NXL (1, L5)) - XN (NXL (2, L5))) ** 2) +
     &         ((YN (NXL (1, L5)) - YN (NXL (2, L5))) ** 2) )
            IF ((DL3 .GT. DMAX) .OR. (DL5 .GT. DL4)) GOTO 250

C  ADD THE EXTRA ELEMENT

            IF (GRAPH) THEN
               CALL LCOLOR ('PINK ')
               DO 240 IL = 1, 4
                  IL1 = NXL (1, LXK (IL, KELEM))
                  IL2 = NXL (2, LXK (IL, KELEM))
                  CALL D2NODE (MXND, XN, YN, IL1, IL2)
                  IL1 = NXL (1, LXK (IL, KELEM2))
                  IL2 = NXL (2, LXK (IL, KELEM2))
                  CALL D2NODE (MXND, XN, YN, IL1, IL2)
  240          CONTINUE
               CALL LCOLOR ('WHITE')
               CALL SFLUSH
            ENDIF
            IF ((D12 .GT. D22) .AND. (LXN (4, N1) .NE. 0)) THEN
               CALL UNDELM (MXND, MLN, LNODES, XN, YN, NUID, LXK, KXL,
     &            NXL, LXN, NNN, LLL, KKK, NAVAIL, IAVAIL, NODE2, NODE3,
     &            N1, NODE, L5, L1, L4, KELEM, KELEM2, NOROOM, ERR,
     &            GRAPH, VIDEO)
               IF ((ERR) .OR. (DONE)) GOTO 250
               DONE = .TRUE.
            ELSEIF (LXN (4, N2) .NE. 0) THEN
               CALL UNDELM (MXND, MLN, LNODES, XN, YN, NUID, LXK, KXL,
     &            NXL, LXN, NNN, LLL, KKK, NAVAIL, IAVAIL, NODE2, NODE,
     &            N2, NODE3, L2, L5, L4, KELEM2, KELEM, NOROOM, ERR,
     &            GRAPH, VIDEO)
               IF ((ERR) .OR. (DONE)) GOTO 250
               DONE = .TRUE.
            ENDIF
            KKKADD = KKK
         ENDIF
      ENDIF

  250 CONTINUE
      RETURN

      END
