You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
279 lines
7.7 KiB
279 lines
7.7 KiB
2 years ago
|
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
|