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.
 
 
 
 
 
 

55 lines
1.7 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 CLOSE4 (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N0, N1, N2, N3, KKK, ERR)
C***********************************************************************
C SUBROUTINE CLOSE4 = CLOSES THE AREA AROUND A FOUR NODE ELEMENT
C***********************************************************************
DIMENSION LXK (4, MXND), KXL (2, 3*MXND), LNODES (MLN, MXND)
DIMENSION NXL (2, 3*MXND), LXN (4, MXND)
LOGICAL ERR
C SET ALL THE LOOP NODES TO BE INTERIOR
LNODES (4, N0) = - 2
LNODES (4, N1) = - 2
LNODES (4, N2) = - 2
LNODES (4, N3) = - 2
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N0, ERR)
IF (ERR) GOTO 100
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N1, ERR)
IF (ERR) GOTO 100
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N2, ERR)
IF (ERR) GOTO 100
CALL MARKSM (MXND, MLN, LXK, KXL, NXL, LXN, LNODES,
& N3, ERR)
IF (ERR) GOTO 100
C MAKE THE LXK AND THE KXL ARRAY
KKK = KKK+1
LXK (1, KKK) = LNODES (5, N0)
LXK (2, KKK) = LNODES (5, N1)
LXK (3, KKK) = LNODES (5, N2)
LXK (4, KKK) = LNODES (5, N3)
CALL ADDKXL (MXND, KXL, KKK, LNODES (5, N0))
CALL ADDKXL (MXND, KXL, KKK, LNODES (5, N1))
CALL ADDKXL (MXND, KXL, KKK, LNODES (5, N2))
CALL ADDKXL (MXND, KXL, KKK, LNODES (5, N3))
100 CONTINUE
RETURN
END