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

      SUBROUTINE SEW2 (MXND, MLN, NUID, LXK, KXL, NXL, LXN, LNODES,
     &   IAVAIL, NAVAIL, LLL, KKK, NNN, I1, I2, J1, J2, NOROOM, ERR)
C***********************************************************************

C  SUBROUTINE SEW2 = COLLAPSES A LOOP INTO TWO POSSIBLE LOOPS

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

      DIMENSION NUID (MXND)
      DIMENSION LXK (4, MXND), KXL (2, 3*MXND)
      DIMENSION NXL (2, 3*MXND), LXN (4, MXND)
      DIMENSION LNODES (MLN, MXND)
      DIMENSION L1LIST(20)

      LOGICAL ERR, NOROOM

      ERR = .FALSE.

C  GET THE APPROPRIATE LINES AND NODES TO BE DELETED

      IF ((LXN (2, J1) .LT. 0) .AND. (LXN (2, J2) .LT. 0)) THEN
         LSTAY = LNODES (5, J1)
         LGONE = LNODES (5, I1)
         NGONE1 = I1
         NGONE2 = I2
         NSTAY1 = J2
         NSTAY2 = J1

      ELSEIF (LXN (2, J1) .LT. 0) THEN
         LSTAY = LNODES (5, I1)
         LGONE = LNODES (5, J1)
         NGONE1 = J2
         NGONE2 = I2
         NSTAY1 = I1
         NSTAY2 = J1

      ELSEIF (LXN (2, J2) .LT. 0) THEN
         LSTAY = LNODES (5, I1)
         LGONE = LNODES (5, J1)
         NGONE1 = I1
         NGONE2 = J1
         NSTAY1 = J2
         NSTAY2 = I2

      ELSE
         LSTAY = LNODES (5, I1)
         LGONE = LNODES (5, J1)
         NGONE1 = J2
         NGONE2 = J1
         NSTAY1 = I1
         NSTAY2 = I2
      ENDIF

      KOLD = KXL (1, LGONE)
      KNEW = KXL (1, LSTAY)

C  DELETE THE OLD LINE AND REDO LINK ARRAYS

      IF (KNEW .EQ. 0) THEN
         KXL (1, LSTAY) = KOLD
         KXL (2, LSTAY) = 0
      ELSE
         KXL (1, LSTAY) = KNEW
         KXL (2, LSTAY) = KOLD
      ENDIF

      KXL (1, LGONE) = 0
      KXL (2, LGONE) = 0
      NXL (1, LGONE) = 0
      NXL (2, LGONE) = 0

C  FIX THE LINES PER ELEMENT ARRAY FOR THE ONE ELEMENT CHANGING

      IF (KOLD .GT. 0) THEN
         DO 100 II = 1, 4
            IF (LXK (II, KOLD) .EQ. LGONE) THEN
               LXK (II, KOLD) = LSTAY
               GOTO 110
            ENDIF
  100    CONTINUE

         CALL MESSAGE('** PROBLEMS IN SEW2 FIXING THE CHANGING'//
     &      'ELEMENT **')
         ERR = .TRUE.
         GOTO 180

  110    CONTINUE
      ENDIF

C  RECONNECT ALL LINES CONNECTING TO NGONE2 TO NSTAY2

      CALL GETLXN (MXND, LXN, NGONE2, L1LIST, NL, ERR)
      IF (ERR) THEN
         CALL MESSAGE('** PROBLEMS IN SEW2 FINDING LXN FOR NGONE2 **')
         GOTO 180
      ENDIF
      DO 120 II = 1, NL
         LL = L1LIST (II)
         IF (NXL (1, LL) .EQ. NGONE2) THEN
            NXL (1, LL) = NSTAY2
         ELSEIF (NXL (2, LL) .EQ. NGONE2) THEN
            NXL (2, LL) = NSTAY2
         ENDIF
  120 CONTINUE

C  FIX LXN ARRAY
C  UNHOOK LGONE FROM NGONE2 OR NSTAY2 AS NEEDED

      IF (LGONE .EQ. LNODES (5, J1)) THEN
         CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, J1,
     &      LGONE, NNN, ERR, NOROOM)
         IF ((NOROOM) .OR. (ERR)) THEN
            CALL MESSAGE('** PROBLEMS IN SEW2 DELETING NGONE2 LINES **')
            GOTO 180
         ENDIF

      ELSE
         CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, I2,
     &      LGONE, NNN, ERR, NOROOM)
         IF ((NOROOM) .OR. (ERR)) THEN
            CALL MESSAGE('** PROBLEMS IN SEW2 DELETING NGONE2 LINES **')
            GOTO 180
         ENDIF

      ENDIF

C  ADD ALL LINES STILL HOOKED TO NGONE2 TO THE LIST OF LINES FOR NSTAY2

      DO 130 II = 1, NL
         LL = L1LIST (II)
         IF (LL .NE. LGONE) THEN
            CALL ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL,
     &         NSTAY2, LL, NNN, ERR, NOROOM)
            IF ((NOROOM) .OR. (ERR)) THEN
               CALL MESSAGE('** PROBLEMS IN SEW2 ADDING NSTAY2 '//
     &            'LINES **')
               GOTO 180
            ENDIF
         ENDIF
  130 CONTINUE

C  DELETE NGONE2 (UNHOOK EVERYTHING FROM IT)

      DO 140 II = 1, 3
         LXN (II, NGONE2) = 0
  140 CONTINUE
      LXN (4, NGONE2) = IAVAIL
      IAVAIL = NGONE2
      NAVAIL = NAVAIL+1
      NUID (NGONE2) = 0

C  RECONNECT ALL LINES CONNECTING TO NGONE1 TO NSTAY1

      CALL GETLXN (MXND, LXN, NGONE1, L1LIST, NL, ERR)
      IF (ERR) THEN
         CALL MESSAGE('** PROBLEMS IN SEW2 GETTING NGONE1 LINES **')
         GOTO 180
      ENDIF
      DO 150 II = 1, NL
         LL = L1LIST (II)
         IF (NXL (1, LL) .EQ. NGONE1) THEN
            NXL (1, LL) = NSTAY1
         ELSEIF (NXL (2, LL) .EQ. NGONE1) THEN
            NXL (2, LL) = NSTAY1
         ENDIF
  150 CONTINUE

C  FIX LXN ARRAY
C  UNHOOK LGONE FROM NGONE1 OR NSTAY1 AS APPROPRIATE

      IF (LGONE .EQ. LNODES (5, I1)) THEN
         CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, I1,
     &      LGONE, NNN, ERR, NOROOM)
         IF ((NOROOM) .OR. (ERR)) THEN
            CALL MESSAGE('** PROBLEMS IN SEW2 DELETING NGONE1 LINES **')
            GOTO 180
         ENDIF

      ELSE
         CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, J2,
     &      LGONE, NNN, ERR, NOROOM)
         IF ((NOROOM) .OR. (ERR)) THEN
            CALL MESSAGE('** PROBLEMS IN SEW2 DELETING NGONE1 LINES **')
            GOTO 180
         ENDIF

      ENDIF

C  ADD ALL LINES STILL HOOKED TO NGONE1 TO THE LIST OF LINES FOR NSTAY1

      DO 160 II = 1, NL
         LL = L1LIST (II)
         IF (LL .NE. LGONE) THEN
            CALL ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL,
     &         NSTAY1, LL, NNN, ERR, NOROOM)
            IF ((NOROOM) .OR. (ERR)) THEN
               CALL MESSAGE('** PROBLEMS IN SEW2 ADDING NSTAY1'//
     &            ' LINES **')
               GOTO 180
            ENDIF
         ENDIF
  160 CONTINUE

C  DELETE NGONE1 (UNHOOK EVERYTHING FROM IT)

      DO 170 II = 1, 3
         LXN (II, NGONE1) = 0
  170 CONTINUE
      LXN (4, NGONE1) = IAVAIL
      IAVAIL = NGONE1
      NAVAIL = NAVAIL+1
      NUID (NGONE1) = 0

C  NOW FIX THE LNODES ARRAY FOR BOTH OF THE LOOPS

      IF (NGONE2 .EQ. J1) THEN
         LNODES (2, NSTAY2) = LNODES (2, NGONE2)
         LNODES (3, LNODES (2, NGONE2)) = NSTAY2
      ELSE
         LNODES (2, LNODES (3, NGONE2)) = NSTAY2
         LNODES (3, NSTAY2) = LNODES (3, NGONE2)
         LNODES (5, NSTAY2) = LNODES (5, NGONE2)
      ENDIF
      IF (NGONE1 .EQ. J2) THEN
         LNODES (2, LNODES (3, NGONE1)) = NSTAY1
         LNODES (3, NSTAY1) = LNODES (3, NGONE1)
         LNODES (5, NSTAY1) = LNODES (5, NGONE1)
      ELSE
         LNODES (2, NSTAY1) = LNODES (2, NGONE1)
         LNODES (3, LNODES (2, NGONE1)) = NSTAY1
      ENDIF

      I1 = NSTAY1
      I2 = NSTAY2
      J1 = NGONE1
      J2 = NGONE2
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   I1, ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (3, I1), ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (3, LNODES (3, I1)), ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (2, I1), ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (2, LNODES (2, I1)), ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   I2, ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (3, I2), ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (3, LNODES (3, I2)), ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (2, I2), ERR)
      IF (ERR) GOTO 180
      CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
     &   LNODES (2, LNODES (2, I2)), ERR)
      IF (ERR) GOTO 180

  180 CONTINUE

      RETURN

      END
