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.
116 lines
3.9 KiB
116 lines
3.9 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 ADJTRI (MXND, MLN, LNODES, XN, YN, ZN, NUID, LXK, KXL,
|
||
|
|
& NXL, LXN, NNN, NAVAIL, IAVAIL, NODE, KELEM, ANG, TOLER1,
|
||
|
|
& TOLER2, N1, N2, N3, KREG, XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX,
|
||
|
|
& KKK, LLL, DEV1, DONE, CHECK, GRAPH, VIDEO, NOROOM, ERR, KKKADD)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE ADJTRI = ADJUSTS A TRIANGULAR SHAPED ELEMENT WHERE
|
||
|
|
C POSSIBLE
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE CALLED BY TRIDEL
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C THERE ARE THREE POSSIBILITIES FOR CHANGE:
|
||
|
|
C 1) ANYTHING OVER TOLER1 GETS THE CORRESPONDING ELEMENT
|
||
|
|
C DELETED
|
||
|
|
C 2) ANYTHING OVER TOLER2 AND HOOKED TO ANOTHER 3-LINE NODE GETS
|
||
|
|
C THE CORRESPONDING ELEMENT DELETED
|
||
|
|
C 3) AN ELONGATED ELEMENT OVER 150 DEGREES GETS A 3 ELEMENT
|
||
|
|
C 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), ZN(MXND), NUID(MXND)
|
||
|
|
DIMENSION LNODES (MLN, MXND)
|
||
|
|
|
||
|
|
CHARACTER*3 DEV1
|
||
|
|
|
||
|
|
LOGICAL NOROOM, ERR, DONE, GRAPH, CHECK, VIDEO
|
||
|
|
|
||
|
|
C CHECK FOR CASE 1
|
||
|
|
|
||
|
|
IF (ANG .GT. TOLER1) THEN
|
||
|
|
IF (GRAPH) THEN
|
||
|
|
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
|
||
|
|
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
|
||
|
|
CALL LCOLOR ('PINK ')
|
||
|
|
CALL D2NODE (MXND, XN, YN, NODE, N1)
|
||
|
|
CALL D2NODE (MXND, XN, YN, NODE, N2)
|
||
|
|
CALL LCOLOR ('WHITE')
|
||
|
|
CALL SFLUSH
|
||
|
|
ENDIF
|
||
|
|
100 CONTINUE
|
||
|
|
CALL DELEM (MXND, XN, YN, NUID, LXK, KXL, NXL, LXN,
|
||
|
|
& NNN, NAVAIL, IAVAIL, NODE, KELEM, NODE1, NODE3, DONE,
|
||
|
|
& CHECK, NOROOM, ERR)
|
||
|
|
IF ((NOROOM) .OR. (ERR)) GOTO 120
|
||
|
|
IF (LXN (3, NODE1) .LE. 0) THEN
|
||
|
|
NODE = NODE1
|
||
|
|
KELEM = KXL (1, LXN (1, NODE))
|
||
|
|
CHECK = .FALSE.
|
||
|
|
GOTO 100
|
||
|
|
ELSEIF (LXN (3, NODE3) .LE. 0) THEN
|
||
|
|
NODE = NODE3
|
||
|
|
KELEM = KXL (1, LXN (1, NODE))
|
||
|
|
CHECK = .FALSE.
|
||
|
|
GOTO 100
|
||
|
|
ENDIF
|
||
|
|
CHECK = .TRUE.
|
||
|
|
IF ((ERR) .OR. (DONE)) GOTO 120
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C CHECK FOR CASE 2
|
||
|
|
|
||
|
|
IF ( (ANG .GT. TOLER2) .AND. (LXN (4, N3) .EQ. 0) .AND.
|
||
|
|
& (LXN (3, N3) .GT. 0) .AND. (LXN (2, N3) .GT. 0)) THEN
|
||
|
|
IF (GRAPH) THEN
|
||
|
|
CALL RPLOTL (MXND, XN, YN, ZN, NXL, XMIN, XMAX, YMIN,
|
||
|
|
& YMAX, ZMIN, ZMAX, LLL, DEV1, KREG)
|
||
|
|
CALL LCOLOR ('PINK ')
|
||
|
|
CALL D2NODE (MXND, XN, YN, NODE, N1)
|
||
|
|
CALL D2NODE (MXND, XN, YN, NODE, N2)
|
||
|
|
CALL LCOLOR ('WHITE')
|
||
|
|
CALL SFLUSH
|
||
|
|
ENDIF
|
||
|
|
110 CONTINUE
|
||
|
|
CALL DELEM (MXND, XN, YN, NUID, LXK, KXL, NXL, LXN,
|
||
|
|
& NNN, NAVAIL, IAVAIL, NODE, KELEM, NODE1, NODE3, DONE,
|
||
|
|
& CHECK, NOROOM, ERR)
|
||
|
|
IF ((NOROOM) .OR. (ERR)) GOTO 120
|
||
|
|
IF (LXN (3, NODE1) .LE. 0) THEN
|
||
|
|
NODE = NODE1
|
||
|
|
KELEM = KXL (1, LXN (1, NODE))
|
||
|
|
CHECK = .FALSE.
|
||
|
|
GOTO 110
|
||
|
|
ELSEIF (LXN (3, NODE3) .LE. 0) THEN
|
||
|
|
NODE = NODE3
|
||
|
|
KELEM = KXL (1, LXN (1, NODE))
|
||
|
|
CHECK = .FALSE.
|
||
|
|
GOTO 110
|
||
|
|
ENDIF
|
||
|
|
CHECK = .TRUE.
|
||
|
|
IF ((ERR) .OR. (DONE)) GOTO 120
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C CHECK FOR CASE 3
|
||
|
|
|
||
|
|
CALL LONGEL (MXND, MLN, LNODES, XN, YN, NUID, LXK, KXL, NXL,
|
||
|
|
& LXN, NNN, NAVAIL, IAVAIL, NODE, KELEM, ANG, TOLER2,
|
||
|
|
& N1, N2, KREG, XMIN, XMAX, YMIN, YMAX, KKK, LLL, DONE, GRAPH,
|
||
|
|
& VIDEO, NOROOM, ERR, KKKADD)
|
||
|
|
|
||
|
|
120 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|