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.
373 lines
11 KiB
373 lines
11 KiB
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 RESTRY (MXND, K, K2, LXK, NXL, KXL, LXN, XN, YN, NUID,
|
|
& NAVAIL, IAVAIL, NNN, DONE, ERR, NOROOM)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE RESTRY = TRY TO RESTRUCTURE K AND ONE OF ITS NEIGHBORS
|
|
|
|
C***********************************************************************
|
|
|
|
C NOTE:
|
|
C THE ELEMENT OPPOSITE THE LONGEST - OR IN SOME CASES THE SECOND
|
|
C LONGEST - SIDE OF ELEMENT K WILL BE FOUND.
|
|
C A RESTRUCTURE WILL ONLY BE DONE THEN IF
|
|
C - THIS SAME SIDE IS THE LONGEST SIDE (OR NEARLY SO)
|
|
C OF THE SECOND ELEMENT ALSO.
|
|
C - NO ANGLES LARGER THAN 180 DEGREES ARE CREATED
|
|
C - THE MAX AND AVERAGE Q - NUMBERS BOTH DECREASE
|
|
C - AN AREA BREAKDOWN CONSISTENT WITH THE IMPROVEMENT
|
|
C IN THE AVERAGE Q - NUMBER OCCURS
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION LXK (4, MXND), NXL (2, 3*MXND)
|
|
DIMENSION KXL (2, 3*MXND), XN (MXND)
|
|
DIMENSION YN (MXND), NUID (MXND), LXN (4, MXND)
|
|
DIMENSION NSA (4), NSB (4), NSC (4), NSD (4)
|
|
DIMENSION NS1 (4), AL1 (4), ANG1 (4)
|
|
DIMENSION NS2 (4), AL2 (4), ANG2 (4)
|
|
|
|
LOGICAL ERR, CCW, CAREA, IOKB, IOKF, IBGOOD
|
|
LOGICAL IFGOOD, DONE, LSIDE, NOROOM
|
|
|
|
DONE = .FALSE.
|
|
ERR = .FALSE.
|
|
PI = ATAN2(0.0, -1.0)
|
|
PITOL = PI* (195. / 180.)
|
|
|
|
C GET DATA FOR ELEMENT K
|
|
|
|
CCW = .TRUE.
|
|
CAREA = .FALSE.
|
|
CALL GNXKA (MXND, XN, YN, K, NS1, AREA1, LXK, NXL, CCW)
|
|
CALL QAAVAL (MXND, NS1, ANG1, QRAT1, DUMMY, XN, YN, CAREA)
|
|
CALL CONDNO (MXND, NS1, QRAT1, SRAT1, COND1, AL1, XN, YN, LSIDE)
|
|
|
|
C FIND LONGEST AND SECOND LONGEST SIDES, EXCLUDING BOUNDARY LINES
|
|
|
|
S1MAX = - 1.
|
|
L1MAX = 0
|
|
A1MAX = 0.
|
|
S2MAX = - 1.
|
|
DO 130 I = 1, 4
|
|
IF (AL1 (I) .GT. S2MAX) THEN
|
|
N1 = NS1 (I)
|
|
J = I + 1
|
|
IF (I .EQ. 4)J = 1
|
|
N2 = NS1 (J)
|
|
DO 100 IL = 1, 4
|
|
L = LXK (IL, K)
|
|
NODE = NXL (1, L)
|
|
IF ( (NODE .EQ. N1) .OR. (NODE .EQ. N2)) THEN
|
|
NODE = NXL (2, L)
|
|
IF ( (NODE .EQ. N1) .OR. (NODE .EQ. N2)) THEN
|
|
IF (KXL (2, L) .GT. 0) THEN
|
|
GOTO 110
|
|
ELSE
|
|
GOTO 120
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
100 CONTINUE
|
|
WRITE (*, 10000)N1, N2, K
|
|
ERR = .TRUE.
|
|
RETURN
|
|
|
|
C N1 TO N2 IS AN INTERIOR LINE
|
|
|
|
110 CONTINUE
|
|
|
|
C LONGEST INTERIOR LINE SO FAR
|
|
|
|
IF (AL1 (I) .GT. S1MAX) THEN
|
|
S2MAX = S1MAX
|
|
L2MAX = L1MAX
|
|
A2MAX = A1MAX
|
|
S1MAX = AL1 (I)
|
|
L1MAX = L
|
|
A1MAX = ANG1 (I) + ANG1 (J)
|
|
|
|
C SECOND LONGEST LINE SO FAR
|
|
|
|
ELSE
|
|
S2MAX = AL1 (I)
|
|
L2MAX = L
|
|
A2MAX = ANG1 (I) + ANG1 (J)
|
|
ENDIF
|
|
ENDIF
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
|
|
C***********************************************************************
|
|
C NOTE:
|
|
C IF LONGEST SIDE IS SUBSTANTIALLY LONGER THAN SECOND
|
|
C LONGEST, PAIR WITH ELEMENT OPPOSITE LONGEST SIDE.
|
|
C IF LONGEST SIDE IS NOT SUBSTANTIALLY LONGER THAN SECOND
|
|
C LONGEST SIDE, PAIR WITH THE ELEMENT OPPOSITE EITHER THE
|
|
C LONGEST OR SECOND LONGEST SIDE DEPENDING ON WHICH HAS THE
|
|
C SMALLER SUM OF ADJACENT ANGLES. (LOOK AT A TRAPEZOID TO
|
|
C SEE WHY THIS IS REASONABLE.)
|
|
|
|
C***********************************************************************
|
|
|
|
IF (L1MAX .LE. 0) RETURN
|
|
SLEN = S1MAX
|
|
LINT = L1MAX
|
|
IF ( (L2MAX .GT. 0) .AND. (S1MAX .LE. 1.15 * S2MAX) .AND.
|
|
& (A1MAX .GT. A2MAX)) THEN
|
|
SLEN = S2MAX
|
|
LINT = L2MAX
|
|
ENDIF
|
|
K2 = KXL (1, LINT) + KXL (2, LINT) - K
|
|
|
|
C DOUBLE CHECK
|
|
|
|
IF (K2 .LE. 0) RETURN
|
|
|
|
C GET DATA FOR ELEMENT K2
|
|
|
|
CALL GNXKA (MXND, XN, YN, K2, NS2, AREA2, LXK, NXL, CCW)
|
|
CALL QAAVAL (MXND, NS2, ANG2, QRAT2, DUMMY, XN, YN, CAREA)
|
|
CALL CONDNO (MXND, NS2, QRAT2, SRAT2, COND2, AL2, XN, YN, LSIDE)
|
|
|
|
C FIND LONGEST SIDE IN SECOND ELEMENT
|
|
|
|
SMAXB = AMAX1 (AL2 (1), AL2 (2), AL2 (3), AL2 (4))
|
|
|
|
C IF THE INTERFACE SIDE IS SIGNIFICANTLY SHORTER THAN THE
|
|
C LONGEST SIDE OF THE SECOND ELEMENT, SKIP THE RESTRUCTURE.
|
|
|
|
IF (SLEN .LT. 0.50 * SMAXB) RETURN
|
|
|
|
C CIRCULARLY SHIFT THE TWO NODE LISTS TO CREATE CANONICAL ORDER.
|
|
C IN CANONICAL ORDER THE FIRST NODE IS THE NODE IN BOTH ELEMENTS
|
|
C WHOSE COUNTER - CLOCKWISE SUCCESSOR IN THE FIRST ELEMENT IS NOT
|
|
C ALSO IN THE SECOND ELEMENT.
|
|
C NOTE : ORDER OF SIDE LENGTH AND ANGLE DATA IS NO GOOD AFTER THIS
|
|
|
|
N1 = NXL (1, LINT)
|
|
CALL NXKORD (NS1, N1)
|
|
DO 140 I = 1, 4
|
|
IF (NS2 (I) .EQ. NS1 (2)) THEN
|
|
N1 = NXL (2, LINT)
|
|
CALL NXKORD (NS1, N1)
|
|
CALL NXKORD (NS2, N1)
|
|
GOTO 150
|
|
ENDIF
|
|
140 CONTINUE
|
|
CALL NXKORD (NS2, N1)
|
|
150 CONTINUE
|
|
|
|
C SEE IF THEY MATCH AS THEY SHOULD (BUTTERFLY ELEMENTS MAY CAUSE
|
|
C PROBLEMS WITH THE CCW ROUTINES
|
|
|
|
IF (NS1 (4) .NE. NS2 (2)) THEN
|
|
NSHOLD = NS2 (2)
|
|
NS2 (2) = NS2 (4)
|
|
NS2 (4) = NSHOLD
|
|
IF (NS1 (4) .NE. NS2 (2)) THEN
|
|
NSHOLD = NS1 (2)
|
|
NS1 (2) = NS1 (4)
|
|
NS1 (4) = NSHOLD
|
|
IF (NS1 (4) .NE. NS2 (2)) THEN
|
|
|
|
C ERROR MATCHING ELEMENTS ALONG A COMMON SIDE
|
|
|
|
WRITE ( * , 10010)K, K2, NS1 (1), NS1 (4)
|
|
ERR = .TRUE.
|
|
RETURN
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C COMPUTE ALL RELEVANT DATA FOR ALL THREE STRUCTURES
|
|
|
|
C ORIGINAL STRUCTURE
|
|
|
|
QMAX = AMAX1 (QRAT1, QRAT2)
|
|
TOLQX = .95 * QMAX + .05
|
|
QAVG = 0.5 * (QRAT1 + QRAT2)
|
|
AMIN = AMIN1 (AREA1, AREA2)
|
|
IF (AMIN .GT. 0.) THEN
|
|
ARAT = AMAX1 (AREA1, AREA2) / AMIN
|
|
ELSE
|
|
ARAT = 1.0E10
|
|
ENDIF
|
|
|
|
C * BACKWARDS * STRUCTURE
|
|
|
|
NSA (1) = NS2 (4)
|
|
NSA (2) = NS1 (1)
|
|
NSA (3) = NS1 (2)
|
|
NSA (4) = NS1 (3)
|
|
NSB (1) = NS2 (4)
|
|
NSB (2) = NS1 (3)
|
|
NSB (3) = NS2 (2)
|
|
NSB (4) = NS2 (3)
|
|
CAREA = .TRUE.
|
|
CALL QAAVAL (MXND, NSA, ANG1, QRAT1B, AREA1B, XN, YN, CAREA)
|
|
CALL QAAVAL (MXND, NSB, ANG2, QRAT2B, AREA2B, XN, YN, CAREA)
|
|
IF ( (AMAX1 (ANG1 (1), ANG1 (2), ANG1 (3), ANG1 (4)) .GT. PITOL)
|
|
& .OR.
|
|
& (AMAX1 (ANG2 (1), ANG2 (2), ANG2 (3), ANG2 (4)) .GT. PITOL))
|
|
& THEN
|
|
IOKB = .FALSE.
|
|
ELSE
|
|
IOKB = .TRUE.
|
|
ENDIF
|
|
QMAXB = AMAX1 (QRAT1B, QRAT2B)
|
|
QAVGB = 0.5 * (QRAT1B + QRAT2B)
|
|
AMIN = AMIN1 (AREA1B, AREA2B)
|
|
IF (AMIN .GT. 0.) THEN
|
|
ARATB = AMAX1 (AREA1B, AREA2B) / AMIN
|
|
ELSE
|
|
ARATB = 1.0E10
|
|
ENDIF
|
|
|
|
C * FORWARDS * STRUCTURE
|
|
|
|
NSC (1) = NS1 (2)
|
|
NSC (2) = NS1 (3)
|
|
NSC (3) = NS1 (4)
|
|
NSC (4) = NS2 (3)
|
|
NSD (1) = NS1 (2)
|
|
NSD (2) = NS2 (3)
|
|
NSD (3) = NS2 (4)
|
|
NSD (4) = NS2 (1)
|
|
CALL QAAVAL (MXND, NSC, ANG1, QRAT1F, AREA1F, XN, YN, CAREA)
|
|
CALL QAAVAL (MXND, NSD, ANG2, QRAT2F, AREA2F, XN, YN, CAREA)
|
|
IF ( (AMAX1 (ANG1 (1), ANG1 (2), ANG1 (3), ANG1 (4)) .GT. PITOL)
|
|
& .OR.
|
|
& (AMAX1 (ANG2 (1), ANG2 (2), ANG2 (3), ANG2 (4)) .GT. PITOL))
|
|
& THEN
|
|
IOKF = .FALSE.
|
|
ELSE
|
|
IOKF = .TRUE.
|
|
ENDIF
|
|
QMAXF = AMAX1 (QRAT1F, QRAT2F)
|
|
QAVGF = 0.5 * (QRAT1F + QRAT2F)
|
|
AMIN = AMIN1 (AREA1F, AREA2F)
|
|
IF (AMIN .GT. 0.) THEN
|
|
ARATF = AMAX1 (AREA1F, AREA2F) / AMIN
|
|
ELSE
|
|
ARATF = 1.0E10
|
|
ENDIF
|
|
|
|
C SEE IF BACKWARD IS BETTER THAN ORIGINAL
|
|
|
|
IF ( (IOKB) .AND. (QMAXB .LE. TOLQX) .AND. (QAVGB .LE. QAVG) .AND.
|
|
& (ARATB * QAVGB .LE. ARAT * QAVG)) THEN
|
|
IBGOOD = .TRUE.
|
|
ELSE
|
|
IBGOOD = .FALSE.
|
|
ENDIF
|
|
|
|
C SEE IF FORWARD IS BETTER THAN ORIGINAL
|
|
|
|
IF ( (IOKF) .AND. (QMAXF .LE. TOLQX) .AND. (QAVGF .LE. QAVG) .AND.
|
|
& (ARATF * QAVGF .LE. ARAT * QAVG)) THEN
|
|
IFGOOD = .TRUE.
|
|
ELSE
|
|
IFGOOD = .FALSE.
|
|
ENDIF
|
|
|
|
C CHOOSE BEST ALTERNATIVE
|
|
C IF BOTH FORWARD AND BACKWARD IS BETTER THAN ORIGINAL, THEN
|
|
C COMPUTE PAIR - VALUES TO CHOOSE BETWEEN FORWARD AND BACKWARD.
|
|
C VALUE = (AVERAGE CONDITION NUMBER) * SQRT (AREA RATIO)
|
|
|
|
IF ( (IFGOOD) .AND. (IBGOOD)) THEN
|
|
LSIDE = .FALSE.
|
|
CALL CONDNO (MXND, NSA, QRAT1B, SRAT1B, COND1B, AL1, XN, YN,
|
|
& LSIDE)
|
|
CALL CONDNO (MXND, NSB, QRAT2B, SRAT2B, COND2B, AL1, XN, YN,
|
|
& LSIDE)
|
|
VALUEB = ARATB * (COND1B + COND2B) **2
|
|
CALL CONDNO (MXND, NSC, QRAT1F, SRAT1F, COND1F, AL1, XN, YN,
|
|
& LSIDE)
|
|
CALL CONDNO (MXND, NSD, QRAT2F, SRAT2F, COND2F, AL1, XN, YN,
|
|
& LSIDE)
|
|
VALUEF = ARATF * (COND1F + COND2F) **2
|
|
IF (VALUEB .GT. VALUEF)IBGOOD = .FALSE.
|
|
ENDIF
|
|
|
|
C BACKWARD STRUCTURE IS BEST. IMPLEMENT IT.
|
|
|
|
C FIRST FIX LXK AND KXL ARRAYS
|
|
|
|
IF (IBGOOD) THEN
|
|
CALL FNDLNK (MXND, LXK, NXL, K, NS1 (3), NS1 (4), L1EE, ERR)
|
|
IF (ERR) RETURN
|
|
CALL FNDLNK (MXND, LXK, NXL, K2, NS2 (1), NS2 (4), L2EE, ERR)
|
|
IF (ERR) RETURN
|
|
CALL LSWAP (MXND, LXK, KXL, K, L1EE, K2, L2EE, ERR)
|
|
IF (ERR) RETURN
|
|
|
|
C FIX NXL ARRAY (MOVE THE DIAGONAL)
|
|
|
|
NXL (1, LINT) = NS2 (4)
|
|
NXL (2, LINT) = NS1 (3)
|
|
|
|
C FIX LXN ARRAY
|
|
|
|
CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS1 (1), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS1 (4), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
CALL ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS1 (3), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
CALL ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS2 (4), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
DONE = .TRUE.
|
|
|
|
C FORWARD STRUCTURE IS BEST. IMPLEMENT IT.
|
|
|
|
C FIX LXK AND KXL ARRAYS
|
|
|
|
ELSEIF (IFGOOD) THEN
|
|
CALL FNDLNK (MXND, LXK, NXL, K, NS1 (1), NS1 (2), L1EE, ERR)
|
|
IF (ERR) RETURN
|
|
CALL FNDLNK (MXND, LXK, NXL, K2, NS2 (2), NS2 (3), L2EE, ERR)
|
|
IF (ERR) RETURN
|
|
CALL LSWAP (MXND, LXK, KXL, K, L1EE, K2, L2EE, ERR)
|
|
IF (ERR) RETURN
|
|
|
|
C FIX NXL ARRAY (MOVE THE DIAGONAL)
|
|
|
|
NXL (1, LINT) = NS1 (2)
|
|
NXL (2, LINT) = NS2 (3)
|
|
|
|
C FIX LXN ARRAY
|
|
|
|
CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS1 (1), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
CALL DELLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS1 (4), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
CALL ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS1 (2), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
CALL ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NS2 (3), LINT,
|
|
& NNN, ERR, NOROOM)
|
|
IF (ERR) RETURN
|
|
DONE = .TRUE.
|
|
ENDIF
|
|
|
|
RETURN
|
|
|
|
10000 FORMAT (' IN RESTRY, NODES', 2I5, /,
|
|
& ' DO NOT DEFINE A LINE IN ELEMENT', I5)
|
|
10010 FORMAT (' IN RESTRY, ELEMENTS', 2I5, /,
|
|
& ' DO NOT CONTAIN A COMMON SIDE USING NODES', 2I5)
|
|
|
|
END
|
|
|