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.
69 lines
2.2 KiB
69 lines
2.2 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 MRKCEN (LINK, XN, NUMCOL, NEROW, IELCEN,
|
||
|
|
& ICOL1, ALLCEN)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** MRKCEN *** (GEN3D) Find center column for each element row
|
||
|
|
C -- Written by Amy Gilkey - revised 04/26/88
|
||
|
|
C --
|
||
|
|
C --MRKCEN identifies whether the first column of each row is on the
|
||
|
|
C --center. This is true iff the first node in the row is located to
|
||
|
|
C --the left of the minimum location of the second node in all rows.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- LINK - IN - the connectivity for the 2D elements, always 4 nodes
|
||
|
|
C -- XN - IN - the coordinates, needed to find node ordering
|
||
|
|
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 - OUT - set to 1 if the first element in the row is on the
|
||
|
|
C -- center, else set to 0
|
||
|
|
C -- ALLCEN - OUT - true iff all rows are on the center column
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses IX1, IX2, IX3, IX4 of /CENPAR/
|
||
|
|
|
||
|
|
INCLUDE 'g3_cenpar.blk'
|
||
|
|
|
||
|
|
INTEGER LINK(4,*)
|
||
|
|
REAL XN(*)
|
||
|
|
C ASSERT: NUMCOL > 0
|
||
|
|
INTEGER IELCEN(NUMCOL,*)
|
||
|
|
INTEGER ICOL1(*)
|
||
|
|
LOGICAL ALLCEN
|
||
|
|
|
||
|
|
C --Find the minimum X for the second node in all rows
|
||
|
|
|
||
|
|
XMIN = 1E36
|
||
|
|
DO 10 IROW = 1, NEROW
|
||
|
|
IEL = IELCEN(1,IROW)
|
||
|
|
INP = LINK(IX2,IEL)
|
||
|
|
XMIN = MIN (XMIN, XN(INP))
|
||
|
|
10 CONTINUE
|
||
|
|
|
||
|
|
C --Mark as on center if the first node in the row is to the left of the
|
||
|
|
C --minimum found above
|
||
|
|
|
||
|
|
ALLCEN = .TRUE.
|
||
|
|
|
||
|
|
DO 20 IROW = 1, NEROW
|
||
|
|
IEL = IELCEN(1,IROW)
|
||
|
|
INP = LINK(IX1,IEL)
|
||
|
|
IF (XN(INP) .LT. XMIN) THEN
|
||
|
|
ICOL1(IROW) = 1
|
||
|
|
ELSE
|
||
|
|
ICOL1(IROW) = 0
|
||
|
|
ALLCEN = .FALSE.
|
||
|
|
END IF
|
||
|
|
20 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|