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.
237 lines
7.4 KiB
237 lines
7.4 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 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
|