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.

67 lines
1.7 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 KXNADD (MAXKXN, NNXK, KXN, NUMKXN, K, NODE, ERR)
C************************************************************************
C SUBROUTINE KXNADD = ADDS K AS AN ELEMENT OF NODE
C***********************************************************************
C NOTE:
C IT IS ASSUMED K IS NOT ALREADY AN ELEMENT OF NODE
C***********************************************************************
DIMENSION KXN (NNXK, MAXKXN)
LOGICAL ERR
ERR = .FALSE.
NN = NODE
100 CONTINUE
C LINE CONTINUES - FIND NEW CONTINUATION LINE
IF (KXN (4, NN) .LT. 0) THEN
NN = IABS (KXN (4, NN))
GOTO 100
C ADD THE ELEMENT TO NODE
ELSEIF (KXN (4, NN) .EQ. 0) THEN
DO 110 I = 1, 4
IF (KXN (I, NN) .EQ. 0) THEN
KXN (I, NN) = K
RETURN
ENDIF
110 CONTINUE
CALL MESSAGE('IMPOSSIBLE SITUATION IN KXNADD')
WRITE ( * , 10000)K, NODE
ERR = .TRUE.
RETURN
C ADD A CONTINUATION LINE, AND ADD THE ELEMENT TO NODE
ELSE
IF (NUMKXN .GE. MAXKXN) THEN
CALL MESSAGE('NO ROOM FOR KXN TABLE IN KXNADD')
ERR = .TRUE.
RETURN
ENDIF
NUMKXN = NUMKXN + 1
KXN (1, NUMKXN) = KXN (4, NN)
KXN (2, NUMKXN) = K
KXN (3, NUMKXN) = 0
KXN (4, NUMKXN) = 0
KXN (4, NN) = - NUMKXN
RETURN
ENDIF
10000 FORMAT ('FOR ELEMENT', I5, ', AND NODE', I5)
END