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.
70 lines
1.8 KiB
70 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 ADDLXN (MXND, LXN, NUID, NAVAIL, IAVAIL, NODE, LINE,
|
|
& NNN, ERR, NOROOM)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE ADDLXN = ADDS LINE TO THE LIST OF LINES FOR THIS NODE
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION LXN (4, MXND), NUID (MXND)
|
|
|
|
LOGICAL ERR, NOROOM
|
|
|
|
ERR = .FALSE.
|
|
NN = NODE
|
|
100 CONTINUE
|
|
|
|
C LINK TO CONTINUATION
|
|
|
|
IF (LXN (4, NN) .LT. 0) THEN
|
|
NN = IABS (LXN (4, NN))
|
|
GOTO 100
|
|
|
|
C THERE IS ROOM FOR THE NEW LINE WITHOUT CONTINUING
|
|
|
|
ELSEIF (LXN (4, NN) .EQ. 0) THEN
|
|
DO 110 I = 1, 4
|
|
IF (LXN (I, NN) .EQ. 0) THEN
|
|
LXN (I, NN) = LINE
|
|
RETURN
|
|
ENDIF
|
|
110 CONTINUE
|
|
|
|
C THIS CAN'T HAPPEN
|
|
|
|
CALL MESSAGE('ERROR IN ADDLXN')
|
|
ERR = .TRUE.
|
|
ELSE
|
|
|
|
C CREATE A CONTINUATION ENTRY
|
|
|
|
IF (NAVAIL .LT. 1) THEN
|
|
WRITE ( * , 10000)NODE
|
|
ERR = .TRUE.
|
|
NOROOM = .TRUE.
|
|
RETURN
|
|
ENDIF
|
|
|
|
NEW = IAVAIL
|
|
IF (NEW .GT. NNN)NNN = NEW
|
|
IAVAIL = LXN (4, IAVAIL)
|
|
NAVAIL = NAVAIL - 1
|
|
LXN (1, NEW) = - LXN (4, NN)
|
|
LXN (2, NEW) = LINE
|
|
IF (LXN (2, NN) .LT. 0)LXN (2, NEW) = - LINE
|
|
LXN (3, NEW) = 0
|
|
LXN (4, NEW) = 0
|
|
LXN (4, NN) = - NEW
|
|
NUID (NEW) = 0
|
|
ENDIF
|
|
RETURN
|
|
|
|
10000 FORMAT (' NODE TABLE OVERFLOW IN ADDLXN AT NODE', I5)
|
|
|
|
END
|
|
|