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.
263 lines
7.5 KiB
263 lines
7.5 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 GETANG (MXND, MLN, XN, YN, LNODES, LXK, KXL, NXL,
|
||
|
|
& LXN, I, J, K, ANGLE, ERR)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE GETANG = RETURNS THE CCW ANGLE FROM A VECTOR DRAWN
|
||
|
|
C FROM NODE J TO K TO A VECTOR DRAWN
|
||
|
|
C FROM NODE J TO I
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION LNODES (MLN, *)
|
||
|
|
DIMENSION XN (*), YN (*)
|
||
|
|
DIMENSION LXN(4, *), NXL(2, *)
|
||
|
|
DIMENSION LXK(4, *), KXL(2, *)
|
||
|
|
|
||
|
|
LOGICAL CORNP, SIDEP, DISCTP, ERR
|
||
|
|
|
||
|
|
C ... The save statement was added during debugging on the AMD Opteron
|
||
|
|
C system using the pgf77 5.1-3 compiler. Without the save, the
|
||
|
|
C code coredumps at line 120 if optimized.... Could not track
|
||
|
|
C down a problem, but adding the SAVE did work...
|
||
|
|
|
||
|
|
SAVE
|
||
|
|
|
||
|
|
TWOPI = 2.0 * ATAN2(0.0, -1.0)
|
||
|
|
|
||
|
|
IOPP = 0
|
||
|
|
KOPP = 0
|
||
|
|
I1 = 0
|
||
|
|
KK1 = 0
|
||
|
|
|
||
|
|
C CHECK FOR NODES ON TOP OF EACH OTHER
|
||
|
|
|
||
|
|
IF (((XN (J) .EQ. XN (K)) .AND. (YN (J) .EQ. YN (K)) ) .OR.
|
||
|
|
& ( (XN (I) .EQ. XN (J)) .AND. (YN (I) .EQ. YN (J)) ) .OR.
|
||
|
|
& ( (XN (I) .EQ. XN (K)) .AND. (YN (I) .EQ. YN (K)) ) ) THEN
|
||
|
|
ANGLE = 0.
|
||
|
|
GOTO 220
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
V1 = ATAN2 (YN (K)-YN (J), XN (K)-XN (J))
|
||
|
|
IF (V1 .LT. 0.) V1 = V1 + TWOPI
|
||
|
|
V2 = ATAN2 (YN (I)-YN (J), XN (I)-XN (J))
|
||
|
|
IF (V2 .LT. 0.) V2 = V2 + TWOPI
|
||
|
|
ANGLE = V2 - V1
|
||
|
|
IF (ANGLE .LT. 0.) ANGLE = ANGLE + TWOPI
|
||
|
|
|
||
|
|
C NOW CHECK TO MAKE SURE THAT THE ANGLE HAS NOT CROSSED THE PREVIOUS
|
||
|
|
C ELEMENTS SIDES
|
||
|
|
|
||
|
|
L1 = LNODES (5, I)
|
||
|
|
L2 = LNODES (5, J)
|
||
|
|
K1 = KXL (1, L1)
|
||
|
|
K2 = KXL (1, L2)
|
||
|
|
IF (K1 .EQ. K2) GOTO 210
|
||
|
|
|
||
|
|
C SEE IF L2 CROSSES INTO K1 - FIRST GET THE NODE OPPOSITE I
|
||
|
|
C AND THEN CHECK THE ANGLE FROM VECTOR J TO K AND VECTOR
|
||
|
|
C J TO IOPP AGAINST THE INTERNAL ANGLE - SMALLER AND IT HAS
|
||
|
|
C CROSSED OVER.
|
||
|
|
|
||
|
|
IF (K1 .NE. 0) THEN
|
||
|
|
DO 100 II = 1, 4
|
||
|
|
LTEST = LXK (II, K1)
|
||
|
|
IF (LTEST .NE. L1) THEN
|
||
|
|
IF (NXL (1, LTEST) .EQ. J) THEN
|
||
|
|
IOPP = NXL (2, LTEST)
|
||
|
|
L3 = LTEST
|
||
|
|
GOTO 110
|
||
|
|
ELSEIF (NXL (2, LTEST) .EQ. J) THEN
|
||
|
|
IOPP = NXL (1, LTEST)
|
||
|
|
L3 = LTEST
|
||
|
|
GOTO 110
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
CALL MESSAGE('** PROBLEMS IN GETANG GETTING IOPP **')
|
||
|
|
ERR = .TRUE.
|
||
|
|
GOTO 220
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
C NOW TEST FOR CROSS-OVER
|
||
|
|
|
||
|
|
V2OPP = ATAN2 (YN (IOPP) - YN (J), XN (IOPP) - XN (J))
|
||
|
|
IF (V2OPP .LT. 0.) V2OPP = V2OPP + TWOPI
|
||
|
|
ANGLE1 = V2OPP - V2
|
||
|
|
IF (ANGLE1 .LT. 0.) ANGLE1 = ANGLE1 + TWOPI
|
||
|
|
ANGLE2 = V2OPP - V1
|
||
|
|
IF (ANGLE2 .LT. 0.) ANGLE2 = ANGLE2 + TWOPI
|
||
|
|
IF (ANGLE2 .LE. ANGLE1) THEN
|
||
|
|
ANGLE = ANGLE - TWOPI
|
||
|
|
GOTO 210
|
||
|
|
ENDIF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C SEE IF L2 CROSSES INTO K1 - FIRST GET THE NODE OPPOSITE K
|
||
|
|
C AND THEN CHECK THE ANGLE FROM VECTOR J TO K AND VECTOR
|
||
|
|
C J TO IOPP AGAINST THE INTERNAL ANGLE - SMALLER AND IT HAS
|
||
|
|
C CROSSED OVER.
|
||
|
|
|
||
|
|
120 CONTINUE
|
||
|
|
IF (K2 .EQ. 0) GOTO 210
|
||
|
|
DO 130 II = 1, 4
|
||
|
|
LTEST = LXK (II, K2)
|
||
|
|
IF (LTEST .NE. L2) THEN
|
||
|
|
IF (NXL (1, LTEST) .EQ. J) THEN
|
||
|
|
KOPP = NXL (2, LTEST)
|
||
|
|
GOTO 140
|
||
|
|
ELSEIF (NXL (2, LTEST) .EQ. J) THEN
|
||
|
|
KOPP = NXL (1, LTEST)
|
||
|
|
GOTO 140
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
130 CONTINUE
|
||
|
|
|
||
|
|
CALL MESSAGE('** PROBLEMS IN GETANG GETTING KOPP **')
|
||
|
|
ERR = .TRUE.
|
||
|
|
GOTO 220
|
||
|
|
140 CONTINUE
|
||
|
|
|
||
|
|
C NOW TEST FOR CROSS-OVER
|
||
|
|
|
||
|
|
V1OPP = ATAN2 (YN (KOPP) - YN (J), XN (KOPP) - XN (J))
|
||
|
|
IF (V1OPP .LT. 0.) V1OPP = V1OPP + TWOPI
|
||
|
|
ANGLE1 = V1 - V1OPP
|
||
|
|
IF (ANGLE1 .LT. 0.) ANGLE1 = ANGLE1 + TWOPI
|
||
|
|
ANGLE2 = V2 - V1OPP
|
||
|
|
IF (ANGLE2 .LT. 0.) ANGLE2 = ANGLE2 + TWOPI
|
||
|
|
IF (ANGLE2 .LE. ANGLE1) THEN
|
||
|
|
ANGLE = ANGLE - TWOPI
|
||
|
|
GOTO 210
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C NOW CHECK TO MAKE SURE THAT THE ANGLE HAS NOT CROSSED OVER TWO
|
||
|
|
C ELEMENT SIDES IF THE NODE IS ATTACHED TO 5 OR MORE LINES
|
||
|
|
|
||
|
|
IF (LXN (4, J) .LT. 0) THEN
|
||
|
|
K3 = KXL (1, L3) + KXL (2, L3) - K1
|
||
|
|
IF (K3 .EQ. K2) GOTO 210
|
||
|
|
|
||
|
|
C SEE IF L2 CROSSES INTO K3 - FIRST GET THE NODE OPPOSITE J
|
||
|
|
C AND THEN CHECK THE ANGLE FROM VECTOR J TO K AND VECTOR
|
||
|
|
C J TO IOPP AGAINST THE INTERNAL ANGLE - SMALLER AND IT HAS
|
||
|
|
C CROSSED OVER.
|
||
|
|
|
||
|
|
IF (K3 .EQ. 0) GOTO 120
|
||
|
|
DO 150 II = 1, 4
|
||
|
|
LTEST = LXK (II, K3)
|
||
|
|
IF (LTEST .NE. L3) THEN
|
||
|
|
IF (NXL (1, LTEST) .EQ. J) THEN
|
||
|
|
IOPP3 = NXL (2, LTEST)
|
||
|
|
GOTO 160
|
||
|
|
ELSEIF (NXL (2, LTEST) .EQ. J) THEN
|
||
|
|
IOPP3 = NXL (1, LTEST)
|
||
|
|
GOTO 160
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
150 CONTINUE
|
||
|
|
|
||
|
|
CALL MESSAGE('** PROBLEMS IN GETANG GETTING IOPP3 **')
|
||
|
|
ERR = .TRUE.
|
||
|
|
GOTO 220
|
||
|
|
160 CONTINUE
|
||
|
|
|
||
|
|
C NOW TEST FOR CROSS-OVER
|
||
|
|
|
||
|
|
V3OPP = ATAN2 (YN (IOPP3) - YN (J), XN (IOPP3) - XN (J))
|
||
|
|
IF (V3OPP .LT. 0.) V3OPP = V3OPP + TWOPI
|
||
|
|
ANGLE1 = V3OPP - V2
|
||
|
|
IF (ANGLE1 .LT. 0.) ANGLE1 = ANGLE1 + TWOPI
|
||
|
|
ANGLE2 = V3OPP - V1
|
||
|
|
IF (ANGLE2 .LT. 0.) ANGLE2 = ANGLE2 + TWOPI
|
||
|
|
IF (ANGLE2 .LE. ANGLE1) THEN
|
||
|
|
ANGLE = ANGLE - TWOPI
|
||
|
|
GOTO 210
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C NOW CHECK FOR AN INVERTED THREE NODE ANGLE - VERY SPECIAL
|
||
|
|
C CASE THAT FALLS THROUGH THE PREVIOUS CHECK
|
||
|
|
|
||
|
|
IF (KOPP .EQ. IOPP) THEN
|
||
|
|
DO 170 II = 1, 4
|
||
|
|
LTEST = LXK (II, K1)
|
||
|
|
IF ( (NXL (1, LTEST) .EQ. IOPP) .AND.
|
||
|
|
& (NXL (2, LTEST) .NE. J) ) THEN
|
||
|
|
I1 = NXL (2, LTEST)
|
||
|
|
GOTO 180
|
||
|
|
ELSEIF ( (NXL (2, LTEST) .EQ. IOPP) .AND.
|
||
|
|
& (NXL (1, LTEST) .NE. J) ) THEN
|
||
|
|
I1 = NXL (1, LTEST)
|
||
|
|
GOTO 180
|
||
|
|
ENDIF
|
||
|
|
170 CONTINUE
|
||
|
|
|
||
|
|
CALL MESSAGE('** PROBLEMS IN GETANG GETTING I1 **')
|
||
|
|
GOTO 220
|
||
|
|
180 CONTINUE
|
||
|
|
DO 190 II = 1, 4
|
||
|
|
LTEST = LXK (II, K2)
|
||
|
|
IF ( (NXL (1, LTEST) .EQ. KOPP) .AND.
|
||
|
|
& (NXL (2, LTEST) .NE. J) ) THEN
|
||
|
|
KK1 = NXL (2, LTEST)
|
||
|
|
GOTO 200
|
||
|
|
ELSEIF ( (NXL (2, LTEST) .EQ. KOPP) .AND.
|
||
|
|
& (NXL (1, LTEST) .NE. J) ) THEN
|
||
|
|
KK1 = NXL (1, LTEST)
|
||
|
|
GOTO 200
|
||
|
|
ENDIF
|
||
|
|
190 CONTINUE
|
||
|
|
|
||
|
|
CALL MESSAGE('** PROBLEMS IN GETANG KK1 **')
|
||
|
|
GOTO 220
|
||
|
|
200 CONTINUE
|
||
|
|
|
||
|
|
C NOW TEST FOR INVERSION
|
||
|
|
|
||
|
|
VVJ = ATAN2 (YN (J) - YN (KOPP), XN (J) - XN (KOPP))
|
||
|
|
IF (VVJ .LT. 0.) VVJ = VVJ + TWOPI
|
||
|
|
VVI1 = ATAN2 (YN (I1) - YN (KOPP), XN (I1) - XN (KOPP))
|
||
|
|
IF (VVI1 .LT. 0.) VVI1 = VVI1 + TWOPI
|
||
|
|
VVK1 = ATAN2 (YN (KK1) - YN (KOPP), XN (KK1) - XN (KOPP))
|
||
|
|
IF (VVK1 .LT. 0.) VVK1 = VVK1 + TWOPI
|
||
|
|
ANGLE1 = VVI1 - VVK1
|
||
|
|
IF (ANGLE1 .LT. 0.) ANGLE1 = ANGLE1 + TWOPI
|
||
|
|
ANGLE2 = VVJ - VVK1
|
||
|
|
IF (ANGLE2 .LT. 0.) ANGLE2 = ANGLE2 + TWOPI
|
||
|
|
IF (ANGLE2 .GT. ANGLE1) THEN
|
||
|
|
ANGLE = ANGLE - TWOPI
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C GET THE RIGHT CLASSIFICATION
|
||
|
|
|
||
|
|
210 CONTINUE
|
||
|
|
IF (CORNP (ANGLE)) THEN
|
||
|
|
IF (SIDEP (ANGLE)) THEN
|
||
|
|
LNODES (6, J) = 2
|
||
|
|
ELSE
|
||
|
|
LNODES (6, J) = 1
|
||
|
|
ENDIF
|
||
|
|
ELSEIF (SIDEP (ANGLE)) THEN
|
||
|
|
IF (DISCTP (ANGLE)) THEN
|
||
|
|
LNODES (6, J) = 4
|
||
|
|
ELSE
|
||
|
|
LNODES (6, J) = 3
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
LNODES (6, J) = 5
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
220 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|