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.
68 lines
1.8 KiB
68 lines
1.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 LSWAP (MXND, LXK, KXL, K1, L1, K2, L2, ERR)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE LSWAP = EXCHANGE LINE L1 IN ELEMENT K1 WITH LINE L2 IN
|
|
C ELEMENT K2
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION LXK (4, MXND), KXL (2, 3*MXND)
|
|
|
|
LOGICAL ERR
|
|
ERR = .TRUE.
|
|
|
|
C INSERT L2 FOR L1
|
|
|
|
DO 130 I = 1, 4
|
|
IF (LXK (I, K1) .EQ. L1) THEN
|
|
LXK (I, K1) = L2
|
|
|
|
C INSERT L1 FOR L2
|
|
|
|
DO 120 J = 1, 4
|
|
IF (LXK (J, K2) .EQ. L2) THEN
|
|
LXK (J, K2) = L1
|
|
|
|
C INSERT K2 FOR K1
|
|
|
|
DO 110 K = 1, 2
|
|
IF (KXL (K, L1) .EQ. K1) THEN
|
|
KXL (K, L1) = K2
|
|
|
|
C INSERT K1 FOR K2
|
|
|
|
DO 100 L = 1, 2
|
|
IF (KXL (L, L2) .EQ. K2) THEN
|
|
KXL (L, L2) = K1
|
|
|
|
C EVERYTHING INSERTED OK
|
|
|
|
ERR = .FALSE.
|
|
RETURN
|
|
ENDIF
|
|
100 CONTINUE
|
|
WRITE ( * , 10000)K1, L1, K2, L2
|
|
RETURN
|
|
ENDIF
|
|
110 CONTINUE
|
|
WRITE ( * , 10000)K1, L1, K2, L2
|
|
RETURN
|
|
ENDIF
|
|
120 CONTINUE
|
|
WRITE ( * , 10000)K1, L1, K2, L2
|
|
RETURN
|
|
ENDIF
|
|
130 CONTINUE
|
|
WRITE ( * , 10000)K1, L1, K2, L2
|
|
|
|
RETURN
|
|
|
|
10000 FORMAT (' ERROR IN LSWAP. K1, L1, K2, L2 :', 4I5)
|
|
|
|
END
|
|
|