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.
 
 
 
 
 
 

236 lines
7.4 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
C=======================================================================
SUBROUTINE RENUMB (A, BLKTYP, NUMELB, LINK, XN, YN,
& IXEL, INCEL, NREL, IELCOL, IXNP, NRNP, NPCEN, IELROW, IROT)
C=======================================================================
C --*** RENUMB *** (GEN3D) Find the new element and node numbers
C -- Written by Amy Gilkey - revised 04/22/88
C --
C --RENUMB calculates the new node and element numbers and the number
C --of nodes/element generated for each node/element. Unless the
C --node or element is part of a center block, the number generated
C --is simply the number of repetitions. For a center block, the
C --elements and nodes are ordered by row and column, and the number
C --of repetitions is assigned from the column number. The new node
C --number is assigned so that the node and all the nodes it generates
C --are grouped together. For example, if the new node number is 20,
C --the node it generates in the first translation would be 21. The
C --elements are handled the same way.
C --
C --The output number of nodes and elements are set.
C --
C --Parameters:
C -- A - IN - the dynamic memory base
C -- BLKTYP - IN - the element block type
C -- NUMELB - IN - the number of elements for each block
C -- LINK - IN - the connectivity for the 2D elements, always 4 nodes
C -- XN, YN - IN - the nodal coordinates
C -- IXEL - OUT - the new index for each element
C -- INCEL - OUT - the increment for each element, needed for blocks that
C -- become multiple blocks
C -- NREL - OUT - the number of new elements generated for each element
C -- IELCOL - OUT - the row number for each element, 0 if not needed,
C -- needed for single point center, useful for other centers
C -- IXNP - OUT - the new index for each node
C -- NRNP - OUT - the number of new nodes generated for each node
C -- NPCEN - OUT - the node numbers of the center nodes by column and row
C -- IELROW - SCRATCH - size = NUMEL
C -- IROT - OUT - tracks connectivity rotation to update sset faces
C --
C --Common Variables:
C -- Uses NUMNP, NUMEL of /DBNUMS/
C -- Sets NUMNP3, NUMEL3 of /DBNUM3/
C -- Uses NNREPL, NEREPL, DIM3, NUMCOL, NUMROW of /PARAMS/
INCLUDE 'g3_dbnums.blk'
INCLUDE 'g3_dbnum3.blk'
INCLUDE 'g3_params.blk'
DIMENSION A(*)
CHARACTER BLKTYP(*)
INTEGER NUMELB(*)
INTEGER LINK(4,*)
REAL XN(NUMNP), YN(NUMNP)
INTEGER IXEL(*), INCEL(*), NREL(*), IELCOL(*)
INTEGER IXNP(*), NRNP(*)
C.............NPCEN(NUMCOL,NUMROW)
INTEGER NPCEN(*)
INTEGER IELROW(NUMEL)
INTEGER IROT(NUMEL)
LOGICAL ALLCEN
C --Most elements generate an element for each plate/slice
DO 10 I = 1, NUMEL
NREL(I) = NEREPL
IELCOL(I) = 0
IROT(I) = 1
10 CONTINUE
C --Most nodes generate a node for each plate/slice (+1)
DO 20 INP = 1, NUMNP
NRNP(INP) = NNREPL
20 CONTINUE
IF (NUMCOL .GT. 0) THEN
NEROW = 0
NUMROW = 0
C --Save the element numbers of center block element in IELROW
NCEN = 0
IEL = 1
DO 40 IELB = 1, NELBLK
IF (BLKTYP(IELB) .EQ. 'C') THEN
DO 30 I = 1, NUMELB(IELB)
NCEN = NCEN + 1
IELROW(NCEN) = IEL
IEL = IEL + 1
30 CONTINUE
ELSE
IEL = IEL + NUMELB(IELB)
END IF
40 CONTINUE
C --Set up the connectivity indices
CALL IXLINK (NCEN, IELROW, LINK, XN, YN, IROT)
C --Order elements by rows and columns
CALL MDRSRV ('IXROW', KIXROW, NUMEL+1)
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
CALL MAKROW (LINK, XN, NCEN, NUMCOL, NEROW, IELROW, A(KIXROW))
CALL MDLONG ('IXROW', KIXROW, NEROW+1)
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
C --Put elements into row by column array (column 1 of each row is
C --not necessarily the center)
CALL MDRSRV ('IELCEN', KELCEN, NUMCOL * NEROW)
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
CALL FELCEN (NUMCOL, NEROW, IELROW, A(KIXROW), A(KELCEN))
CALL MDDEL ('IXROW')
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
C --Determine which elements are on the center column
CALL MDRSRV ('ICOL1', KICOL1, NEROW)
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
CALL MRKCEN (LINK, XN, NUMCOL, NEROW, A(KELCEN),
& A(KICOL1), ALLCEN)
C --Find the proper columns for the elements
CALL MDRSRV ('IRBOT', KIRBOT, NEROW)
CALL MDRSRV ('IRTOP', KIRTOP, NEROW)
CALL MDRSRV ('IRBDIF', KIBDIF, NEROW)
CALL MDRSRV ('NPBROW', KNPBR, NUMNP)
CALL MDRSRV ('NPBCOL', KNPBC, NUMNP)
CALL MDRSRV ('NPTROW', KNPTR, NUMNP)
CALL MDRSRV ('NPTCOL', KNPTC, NUMNP)
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
CALL MAKCOL (LINK, NUMNP,
& NUMCOL, NEROW, A(KELCEN), A(KICOL1),
& A(KIRBOT), A(KIRTOP), A(KIBDIF),
& A(KNPBR), A(KNPBC), A(KNPTR), A(KNPTC))
CALL MDDEL ('NPBROW')
CALL MDDEL ('NPBCOL')
CALL MDDEL ('NPTROW')
CALL MDDEL ('NPTCOL')
CALL MDDEL ('IRBDIF')
CALL MDDEL ('ICOL1')
C --Fill in the number of repetitions for the elements and nodes
C --(NREL and NRNP) and the element column numbers (IELCOL) and
C --the node rows and columns (NPCEN)
CALL MDRSRV ('NRBOT', KNRBOT, NEROW)
CALL MDRSRV ('NRTOP', KNRTOP, NEROW)
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
N4 = NINT (DIM3 / 90)
CALL FNPCEN (LINK, N4, NUMCOL, NEROW, A(KELCEN),
& A(KIRBOT), A(KIRTOP), NUMROW, NPCEN, NREL, IELCOL, NRNP,
& A(KNRBOT), A(KNRTOP))
CALL MDDEL ('NRBOT')
CALL MDDEL ('NRTOP')
CALL MDDEL ('IRBOT')
CALL MDDEL ('IRTOP')
CALL MDDEL ('IELCEN')
CALL MDSTAT (NERR, MEM)
IF (NERR .GT. 0) GOTO 90
END IF
C --Calculate the new element numbers and increments
IEL = 1
JEL = 1
DO 70 IELB = 1, NELBLK
IF ((BLKTYP(IELB) .EQ. 'T') .OR. (BLKTYP(IELB) .EQ. 'S')) THEN
C --Blocks that become multiple blocks do a plate/slice at a time
DO 50 I = 1, NUMELB(IELB)
IXEL(IEL) = JEL
INCEL(IEL) = NUMELB(IELB)
JEL = JEL + 1
IEL = IEL + 1
50 CONTINUE
JEL = JEL + (NEREPL-1) * NUMELB(IELB)
ELSE
C --Other elements do an element at a time
DO 60 I = 1, NUMELB(IELB)
IXEL(IEL) = JEL
INCEL(IEL) = 1
JEL = JEL + NREL(IEL)
IEL = IEL + 1
60 CONTINUE
END IF
70 CONTINUE
C --New number of elements
NUMEL3 = JEL - 1
C --Calculate the new node numbers
JNP = 1
DO 80 INP = 1, NUMNP
IXNP(INP) = JNP
JNP = JNP + NRNP(INP)
80 CONTINUE
C --New number of nodes
NUMNP3 = JNP - 1
90 CONTINUE
RETURN
END