Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
 
 
 
 
 
 

98 lines
2.8 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 SETN02 (MXND, NXL, LXK, KXL, LINE, NEND, NODE, N0, N2)
C***********************************************************************
C SUBROUTINE SETN02 = PICKS THE NEXT LINE AROUND THE ELEMENTS ATTACHED
C TO LINE WITH ONE END AT NEND, AND THE OTHER END
C NOT AT NODE, AND FROM THE CONNECTIVITY OF THE
C ELEMENTS DETERMINES THE BOUNDING ANGULAR LINES
C AND NODES.
C***********************************************************************
DIMENSION NXL(2, 3*MXND)
DIMENSION LXK(4, MXND), KXL(2, 3*MXND)
K1 = KXL (1, LINE)
K2 = KXL (2, LINE)
C FIND THE NEXT LINE IN K1
DO 100 I = 1, 4
IL = LXK (I, K1)
IF ((NXL (1, IL) .EQ. NEND) .AND.
& (NXL (2, IL) .NE. NODE)) THEN
L1 = IL
NNEW1 = NXL (2, IL)
GOTO 110
ELSEIF ((NXL (2, IL) .EQ. NEND) .AND.
& (NXL (1, IL) .NE. NODE)) THEN
L1 = IL
NNEW1 = NXL (1, IL)
GOTO 110
ENDIF
100 CONTINUE
CALL MESSAGE('** PROBLEMS IN SETN02 FINDING NNEW1 **')
RETURN
110 CONTINUE
C FIND THE NEXT LINE IN K2
DO 120 I = 1, 4
IL = LXK (I, K2)
IF ((NXL (1, IL) .EQ. NEND) .AND.
& (NXL (2, IL) .NE. NODE)) THEN
NNEW2 = NXL (2, IL)
GOTO 130
ELSEIF ((NXL (2, IL) .EQ. NEND) .AND.
& (NXL (1, IL) .NE. NODE)) THEN
NNEW2 = NXL (1, IL)
GOTO 130
ENDIF
120 CONTINUE
CALL MESSAGE('** PROBLEMS IN SETN02 FINDING NNEW2 **')
RETURN
130 CONTINUE
C NOW DETERMINE WHICH OF THESE NODES IS N0 AND WHICH IS N2 BASED
C ON THE FACT THAT THE CONNECTIVITY OF THE ELEMENTS LINES IS ALWAYS IN
C COUNTER-CLOCKWISE ORDER
DO 140 I = 1, 4
IF (LXK (I, K1) .EQ. LINE) THEN
I0 = I - 1
I2 = I + 1
IF (I .EQ. 1) THEN
I0 = 4
ELSEIF (I .EQ. 4) THEN
I2 = 1
ENDIF
L0 = LXK (I0, K1)
L2 = LXK (I2, K1)
IF (L0 .EQ. L1) THEN
N0 = NNEW1
N2 = NNEW2
ELSEIF (L2 .EQ. L1) THEN
N0 = NNEW2
N2 = NNEW1
ELSE
CALL MESSAGE('** PROBLEMS IN SETN02 FINDING N0 '//
& 'AND N2 **')
ENDIF
GOTO 150
ENDIF
140 CONTINUE
CALL MESSAGE('** PROBLEMS IN SETN02 FINDING LINE AGAIN **')
150 CONTINUE
RETURN
END