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.
101 lines
3.1 KiB
101 lines
3.1 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
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE ZLNK (NELB, IDELB, NUMELB, NUMLNK, LINK, NEWLNK,
|
||
|
|
$ NUMATR, ATRIB, NUMEL, MAP, MAPNOD, BLKTYP)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** *** (GREPOS)
|
||
|
|
C -- Written by Greg Sjaardema - revised 03/02/90
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NELB - IN - the number of element blocks
|
||
|
|
C -- IDELB - IN - the element block IDs for each block
|
||
|
|
C -- NUMELB - IN - the number of elements in each block
|
||
|
|
C -- NUMLNK - IN - the number of nodes per element in each block
|
||
|
|
C -- LINK - IN - the connectivity for each block
|
||
|
|
C -- NEWLNK - OUT - the new connectivity for each block
|
||
|
|
C -- MAP - OUT - list of active nodes
|
||
|
|
C -- map(i) > 0 for active node
|
||
|
|
C -- map(i) = length of map()+1 for deleted node
|
||
|
|
|
||
|
|
include 'gp_params.blk'
|
||
|
|
INTEGER IDELB(NELB)
|
||
|
|
INTEGER NUMELB(NELB)
|
||
|
|
INTEGER NUMLNK(NELB)
|
||
|
|
INTEGER LINK(*), NEWLNK(*)
|
||
|
|
INTEGER NUMATR(NELB)
|
||
|
|
REAL ATRIB(*)
|
||
|
|
INTEGER MAP(NUMEL), MAPNOD(*)
|
||
|
|
CHARACTER*(MXSTLN) BLKTYP(*)
|
||
|
|
|
||
|
|
CALL INIINT (NUMEL, 0, MAP)
|
||
|
|
|
||
|
|
IOFF = 0
|
||
|
|
IOFFA = 0
|
||
|
|
IELNK = 0
|
||
|
|
IEATR = 0
|
||
|
|
IEELE = 0
|
||
|
|
DO 40 IELB = 1, NELB
|
||
|
|
ISLNK = IELNK + 1
|
||
|
|
IELNK = IELNK + NUMLNK(IELB) * NUMELB(IELB)
|
||
|
|
ISATR = IEATR + 1
|
||
|
|
IEATR = IEATR + NUMATR(IELB) * NUMELB(IELB)
|
||
|
|
ISELE = IEELE + 1
|
||
|
|
IEELE = IEELE + NUMELB(IELB)
|
||
|
|
|
||
|
|
IF (IDELB(IELB) .EQ. 0) THEN
|
||
|
|
C -- deleted element block
|
||
|
|
IOFF = IOFF + NUMLNK(IELB) * NUMELB(IELB)
|
||
|
|
IOFFA = IOFFA + NUMATR(IELB) * NUMELB(IELB)
|
||
|
|
ELSE
|
||
|
|
C?? IF (IOFF .NE. 0) THEN
|
||
|
|
DO 10 I = ISLNK, IELNK
|
||
|
|
NEWLNK(I-IOFF) = MAPNOD(LINK(I))
|
||
|
|
10 CONTINUE
|
||
|
|
C?? END IF
|
||
|
|
IF (IOFFA .NE. 0) THEN
|
||
|
|
DO 20 I = ISATR, IEATR
|
||
|
|
ATRIB(I-IOFFA) = ATRIB(I)
|
||
|
|
20 CONTINUE
|
||
|
|
END IF
|
||
|
|
DO 30 I = ISELE, IEELE
|
||
|
|
MAP(I) = 1
|
||
|
|
30 CONTINUE
|
||
|
|
END IF
|
||
|
|
40 CONTINUE
|
||
|
|
|
||
|
|
C .. Set up map of old number to new number. If old id = I, then
|
||
|
|
C new id = MAP(I)
|
||
|
|
NEWID = 0
|
||
|
|
DO 50 IEL = 1, NUMEL
|
||
|
|
IF (MAP(IEL) .GT. 0) THEN
|
||
|
|
NEWID = NEWID + 1
|
||
|
|
MAP(IEL) = NEWID
|
||
|
|
ELSE
|
||
|
|
MAP(IEL) = NUMEL+1
|
||
|
|
END IF
|
||
|
|
50 CONTINUE
|
||
|
|
NUMEL = NEWID
|
||
|
|
|
||
|
|
C .. Update element block counter arrays
|
||
|
|
IAELB = 0
|
||
|
|
DO 60 IELB = 1, NELB
|
||
|
|
IF (IDELB(IELB) .NE. 0) THEN
|
||
|
|
IAELB = IAELB + 1
|
||
|
|
IDELB(IAELB) = IDELB(IELB)
|
||
|
|
NUMELB(IAELB) = NUMELB(IELB)
|
||
|
|
NUMLNK(IAELB) = NUMLNK(IELB)
|
||
|
|
NUMATR(IAELB) = NUMATR(IELB)
|
||
|
|
BLKTYP(IAELB) = BLKTYP(IELB)
|
||
|
|
END IF
|
||
|
|
60 CONTINUE
|
||
|
|
NELB = IAELB
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|