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.
238 lines
8.1 KiB
238 lines
8.1 KiB
2 years ago
|
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
|