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.
220 lines
7.0 KiB
220 lines
7.0 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 MAKCOL (LINK, NUMNP, NUMCOL, NEROW, IELCEN, ICOL1,
|
||
|
|
& IRBOT, IRTOP, IRBDIF,
|
||
|
|
& NPBROW, NPBCOL, NPTROW, NPTCOL)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** MAKCOL *** (GEN3D) Compute center block row x column
|
||
|
|
C -- Written by Amy Gilkey - revised 04/26/88
|
||
|
|
C --
|
||
|
|
C --MAKCOL orders the elements in a center block by row and column.
|
||
|
|
C --The elements have already been ordered into rows, so this routine
|
||
|
|
C --needs to determine which column the first element of a row is in.
|
||
|
|
C --It does this by comparing the rows on top and bottom of a given row.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- LINK - IN - the connectivity for the 2D elements, always 4 nodes
|
||
|
|
C -- NUMNP - IN - the number of nodes
|
||
|
|
C -- NUMCOL - IN - the number of columns in the center blocks
|
||
|
|
C -- NEROW - IN - the number of element rows in the center blocks
|
||
|
|
C -- IELCEN - IN - the element numbers of the center elements
|
||
|
|
C -- by column and row (column 1 is not necessarily the center)
|
||
|
|
C -- ICOL1 - IN/OUT - the column number of the first element in a row;
|
||
|
|
C -- upon entry, 1 iff center row, else 0; destroyed
|
||
|
|
C -- IRBOT, IRTOP - OUT - the row number of the row on top and bottom
|
||
|
|
C -- IRBDIF - SCRATCH - size = NEROW
|
||
|
|
C -- NPBROW, NPBCOL, NPTROW, NPTCOL - SCRATCH - size = NUMNP
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses IX1, IX2, IX3, IX4 of /CENPAR/
|
||
|
|
|
||
|
|
INCLUDE 'g3_cenpar.blk'
|
||
|
|
|
||
|
|
INTEGER LINK(4,*)
|
||
|
|
INTEGER IELCEN(NUMCOL,*)
|
||
|
|
INTEGER ICOL1(*)
|
||
|
|
INTEGER IRBOT(*), IRTOP(*)
|
||
|
|
INTEGER IRBDIF(*)
|
||
|
|
INTEGER NPBROW(*), NPBCOL(*), NPTROW(*), NPTCOL(*)
|
||
|
|
|
||
|
|
LOGICAL PROBLM
|
||
|
|
|
||
|
|
PROBLM = .FALSE.
|
||
|
|
|
||
|
|
C --Find out the corresponding rows and columns for each node
|
||
|
|
|
||
|
|
CALL INIINT (NUMNP, 0, NPBROW)
|
||
|
|
CALL INIINT (NUMNP, 0, NPTROW)
|
||
|
|
|
||
|
|
DO 20 IROW = 1, NEROW
|
||
|
|
DO 10 ICOL = 1, NUMCOL
|
||
|
|
IEL = IELCEN(ICOL,IROW)
|
||
|
|
IF (IEL .LE. 0) GOTO 10
|
||
|
|
INP = LINK(IX1,IEL)
|
||
|
|
NPTROW(INP) = IROW
|
||
|
|
NPTCOL(INP) = ICOL
|
||
|
|
INP = LINK(IX4,IEL)
|
||
|
|
NPBROW(INP) = IROW
|
||
|
|
NPBCOL(INP) = ICOL
|
||
|
|
10 CONTINUE
|
||
|
|
20 CONTINUE
|
||
|
|
|
||
|
|
C --Find the row on top and on bottom of each row and check column differences
|
||
|
|
|
||
|
|
CALL INIINT (NEROW, 0, IRBOT)
|
||
|
|
CALL INIINT (NEROW, 0, IRTOP)
|
||
|
|
CALL INIINT (NEROW, 0, IRBDIF)
|
||
|
|
|
||
|
|
DO 40 IROW = 1, NEROW
|
||
|
|
DO 30 ICOL = 1, NUMCOL
|
||
|
|
IEL = IELCEN(ICOL,IROW)
|
||
|
|
IF (IEL .LE. 0) GOTO 30
|
||
|
|
INP = LINK(IX1,IEL)
|
||
|
|
|
||
|
|
ITROW = NPTROW(INP)
|
||
|
|
|
||
|
|
IF (NPBROW(INP) .NE. 0) THEN
|
||
|
|
C --Mark the bottom row and point back to this row
|
||
|
|
IBROW = NPBROW(INP)
|
||
|
|
IRBOT(ITROW) = IBROW
|
||
|
|
IRTOP(IBROW) = ITROW
|
||
|
|
C --Mark column differences
|
||
|
|
IRBDIF(ITROW) = NPTCOL(INP) - NPBCOL(INP)
|
||
|
|
GOTO 40
|
||
|
|
END IF
|
||
|
|
30 CONTINUE
|
||
|
|
40 CONTINUE
|
||
|
|
|
||
|
|
C --Check columns of bottom and top row
|
||
|
|
|
||
|
|
DO 60 IROW = 1, NEROW
|
||
|
|
|
||
|
|
DO 50 ICOL = 1, NUMCOL
|
||
|
|
IEL = IELCEN(ICOL,IROW)
|
||
|
|
IF (IEL .LE. 0) GOTO 50
|
||
|
|
IB = LINK(IX1,IEL)
|
||
|
|
IT = LINK(IX4,IEL)
|
||
|
|
|
||
|
|
C --Check that node is not connected to two top or bottom rows
|
||
|
|
IF (NPTROW(IB) .NE. IROW) PROBLM = .TRUE.
|
||
|
|
IF (NPBROW(IT) .NE. IROW) PROBLM = .TRUE.
|
||
|
|
|
||
|
|
IF (NPBROW(IB) .NE. 0) THEN
|
||
|
|
C --Check that same bottom row this node
|
||
|
|
IF (NPBROW(IB) .NE. IRBOT(IROW)) PROBLM = .TRUE.
|
||
|
|
C --Check column difference
|
||
|
|
IF ((NPTCOL(IB) - NPBCOL(IB)) .NE. IRBDIF(IROW))
|
||
|
|
& PROBLM = .TRUE.
|
||
|
|
ELSE IF (NPTROW(IT) .NE. 0) THEN
|
||
|
|
C --Check that same top row this node
|
||
|
|
IF (NPTROW(IT) .NE. IRTOP(IROW)) PROBLM = .TRUE.
|
||
|
|
C --Check column difference
|
||
|
|
ITROW = NPTROW(IT)
|
||
|
|
IF ((NPTCOL(IT) - NPBCOL(IT)) .NE. IRBDIF(ITROW))
|
||
|
|
& PROBLM = .TRUE.
|
||
|
|
END IF
|
||
|
|
|
||
|
|
50 CONTINUE
|
||
|
|
60 CONTINUE
|
||
|
|
|
||
|
|
C --Get the column numbers of non-center rows by following a chain of rows
|
||
|
|
C --through the top rows
|
||
|
|
|
||
|
|
DO 90 IROW = 1, NEROW
|
||
|
|
C --Start at a center row
|
||
|
|
IF (ICOL1(IROW) .NE. 1) GOTO 90
|
||
|
|
|
||
|
|
NROW = IROW
|
||
|
|
70 CONTINUE
|
||
|
|
C --Check the row if it has top-bottom row pairing
|
||
|
|
IF (IRBOT(NROW) .GT. 0) THEN
|
||
|
|
IBROW = IRBOT(NROW)
|
||
|
|
|
||
|
|
C --Calculate the column from the paired row column and offset
|
||
|
|
ICOL = ICOL1(NROW) + IRBDIF(NROW)
|
||
|
|
|
||
|
|
IF ((ICOL1(IBROW) .GT. 1) .OR. (ICOL .LE. 0)) THEN
|
||
|
|
C --If the paired row is already marked, stop chain
|
||
|
|
IF (ICOL .LE. 0) PROBLM = .TRUE.
|
||
|
|
IF (ICOL1(IBROW) .NE. ICOL) PROBLM = .TRUE.
|
||
|
|
ICOL = 1
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF ((ICOL .GT. 1) .AND. (ICOL .LE. NUMCOL)) THEN
|
||
|
|
C --Chain to the paired row
|
||
|
|
ICOL1(IBROW) = ICOL
|
||
|
|
NROW = IBROW
|
||
|
|
|
||
|
|
GOTO 70
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
NROW = IROW
|
||
|
|
80 CONTINUE
|
||
|
|
C --Check the row if it has top-bottom row pairing
|
||
|
|
IF (IRTOP(NROW) .GT. 0) THEN
|
||
|
|
ITROW = IRTOP(NROW)
|
||
|
|
|
||
|
|
C --Calculate the column from the paired row column and offset
|
||
|
|
ICOL = ICOL1(NROW) - IRBDIF(ITROW)
|
||
|
|
|
||
|
|
IF ((ICOL1(ITROW) .GE. 1) .OR. (ICOL .LE. 0)) THEN
|
||
|
|
C --If the paired row is already marked, stop chain
|
||
|
|
IF (ICOL .LE. 0) PROBLM = .TRUE.
|
||
|
|
IF (ICOL1(ITROW) .NE. ICOL) PROBLM = .TRUE.
|
||
|
|
ICOL = 1
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF ((ICOL .GT. 1) .AND. (ICOL .LE. NUMCOL)) THEN
|
||
|
|
C --Chain to the paired row
|
||
|
|
ICOL1(ITROW) = ICOL
|
||
|
|
NROW = ITROW
|
||
|
|
|
||
|
|
GOTO 80
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
90 CONTINUE
|
||
|
|
|
||
|
|
C --Shift rows over if not on first column
|
||
|
|
|
||
|
|
NROW = NEROW
|
||
|
|
NEROW = 0
|
||
|
|
DO 120 IROW = 1, NROW
|
||
|
|
C --Eliminate row if its first column is too big
|
||
|
|
IF ((ICOL1(IROW) .LT. 1) .OR. (ICOL1(IROW) .GT. NUMCOL)) THEN
|
||
|
|
ICOL1(IROW) = 0
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
NEROW = NEROW + 1
|
||
|
|
|
||
|
|
IC = NUMCOL - ICOL1(IROW) + 1
|
||
|
|
DO 100 ICOL = NUMCOL, ICOL1(IROW), -1
|
||
|
|
IELCEN(ICOL,NEROW) = IELCEN(IC,IROW)
|
||
|
|
IC = IC - 1
|
||
|
|
100 CONTINUE
|
||
|
|
DO 110 ICOL = 1, ICOL1(IROW)-1
|
||
|
|
IELCEN(ICOL,NEROW) = 0
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
ICOL1(IROW) = NEROW
|
||
|
|
END IF
|
||
|
|
120 CONTINUE
|
||
|
|
|
||
|
|
C --Connect the row top/bottom pointers to the renumbered rows
|
||
|
|
|
||
|
|
DO 130 IROW = 1, NEROW
|
||
|
|
IR = IRTOP(IROW)
|
||
|
|
IF (IR .GT. 0) IRTOP(IROW) = ICOL1(IR)
|
||
|
|
IR = IRBOT(IROW)
|
||
|
|
IF (IR .GT. 0) IRBOT(IROW) = ICOL1(IR)
|
||
|
|
130 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|