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.

179 lines
6.5 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 CON2D (CRD, NDIM, NUMNP, IX, NNODES, NUMEL, MAT,
* NELBLK, SELECT, ASPECT, SKEW, TAPER, AREA,
* SUMRY, ISUMRY, DEBUG)
C=======================================================================
C *** CON2D *** Calculate state of mesh -- Aspect ratio, Skewness,
C and Taper
C (Greg Sjaardema, 16 April, 1989)
C Based on article by John Robinson, "CRE Method of element testing
C and the Jacobian shape parameters," Eng. Comput., 1987, Vol. 4,
C June, pp 113 - 118
C -- ARRAYS:
C CRD(NUMNP, NDIM) - IN -
C IX(NNODES, NUMEL) - IN -
C MAT(5, NELBLK) - IN -
C SELECT(NUMEL) - IN -
C ASPECT(NUMEL) - OUT- Aspect ratio (1.0 <= AR <= infinity)
C SKEW(NUMEL) - OUT- Skewness of mesh, degrees (0 <= skew <= ?)
C TAPER(NUMEL) - OUT- Taper of mesh, combination of X and Y taper
C AREA(NUMEL) - OUT- Area of element
C -- SCALARS:
C NDIM - Number of spatial dimensions
C NUMNP - Number of nodal points
C NNODES - Number of nodes per element
C NUMEL - Number of elements
C NELBLK - Number of material/element blocks
C E2 E4
C +----------+ +-----------+ +---------+ |
C | | F3 / / / \
C | | / A / / \
C +----------+ +-----------+ +---------------+
C AR = E2/F3 SKEW = SIN(A) TAPER Y
C=======================================================================
REAL CRD(NUMNP, NDIM), ASPECT(*), SKEW(*), TAPER(*), AREA(*)
INTEGER IX(NNODES, NUMEL), MAT(6, NELBLK), ISUMRY(2,4,NELBLK)
REAL SUMRY(4,4,NELBLK)
LOGICAL SELECT(*), DEBUG, ISABRT
include 'nu_io.blk'
CALL INIREA (NUMEL, 0.0, ASPECT)
CALL INIREA (NUMEL, 0.0, SKEW)
CALL INIREA (NUMEL, 0.0, TAPER)
CALL INIREA (NUMEL, 0.0, AREA)
DO 40 IBLK = 1, NELBLK
IF (MAT(5, IBLK) .EQ. 1) THEN
IELBEG = MAT(3, IBLK)
IELEND = MAT(4, IBLK)
IF (ISABRT()) RETURN
DO 30 IEL = IELBEG, IELEND
c .. if doesn't vectorize, remove next line and do select on summary only
IF (SELECT(IEL)) THEN
X1 = CRD(IX(1,IEL), 1)
X2 = CRD(IX(2,IEL), 1)
X3 = CRD(IX(3,IEL), 1)
X4 = CRD(IX(4,IEL), 1)
Y1 = CRD(IX(1,IEL), 2)
Y2 = CRD(IX(2,IEL), 2)
Y3 = CRD(IX(3,IEL), 2)
Y4 = CRD(IX(4,IEL), 2)
C ... Make centroid of element the center of coordinate system
XS = (X1 + X2 + X3 + X4) / 4.0
YS = (Y1 + Y2 + Y3 + Y4) / 4.0
X1 = X1 - XS
X2 = X2 - XS
X3 = X3 - XS
X4 = X4 - XS
Y1 = Y1 - YS
Y2 = Y2 - YS
Y3 = Y3 - YS
Y4 = Y4 - YS
C ... Rotate element such that center of side 2-3 and 4-1 define X axis
AMAG = SQRT((X2+X3-X4-X1)**2 + (Y2+Y3-Y4-Y1)**2)
C = (X2 + X3 - X4 - X1) / AMAG
S = (Y2 + Y3 - Y4 - Y1) / AMAG
XT = C * X1 + S * Y1
Y1 = -S * X1 + C * Y1
X1 = XT
XT = C * X2 + S * Y2
Y2 = -S * X2 + C * Y2
X2 = XT
XT = C * X3 + S * Y3
Y3 = -S * X3 + C * Y3
X3 = XT
XT = C * X4 + S * Y4
Y4 = -S * X4 + C * Y4
X4 = XT
C ... Calculate ``Shape function'' parameters - E1, F1, F2 = 0.0
E2 = -X1 + X2 + X3 - X4
E3 = -X1 - X2 + X3 + X4
E4 = X1 - X2 + X3 - X4
F3 = -Y1 - Y2 + Y3 + Y4
F4 = Y1 - Y2 + Y3 - Y4
ASPECT(IEL) = MAX (E2 / F3, F3 / E2)
SKEW(IEL) = ABS(E3/F3) / SQRT((E3/F3)**2 + 1.0)
TAPER(IEL) = SQRT((F4 / F3)**2 + (E4 / E2)**2)
AREA(IEL) = E2 * F3 / 4.0
END IF
30 CONTINUE
END IF
40 CONTINUE
DO 50 IO=IOMIN, IOMAX
WRITE (IO, 60)
50 CONTINUE
60 FORMAT (/' Shape Parameters for Selected Elements',/
* /2X,'Mat Minimum Elem Maximum Elem Average ',
* ' Std. Dev.'/)
DO 100 ITMP = 1, NELBLK
IBLK = MAT(6, ITMP)
IF (MAT(5, IBLK) .EQ. 1) THEN
IELBEG = MAT(3, IBLK)
IELEND = MAT(4, IBLK)
NUMLST = IELEND - IELBEG + 1
C ... Determine mins, maxs, averages, and std. dev. for selected block/elem
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), ASPECT(IELBEG),
* SUMRY(1,1,IBLK), ISUMRY(1,1,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), SKEW(IELBEG),
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), TAPER(IELBEG),
* SUMRY(1,3,IBLK), ISUMRY(1,3,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), AREA(IELBEG),
* SUMRY(1,4,IBLK), ISUMRY(1,4,IBLK),IELBEG-1)
DO 70 IO= IOMIN, IOMAX
WRITE (IO, 80) MAT(1,IBLK),
* SUMRY(1,1,IBLK), ISUMRY(1,1,IBLK),
* SUMRY(2,1,IBLK), ISUMRY(2,1,IBLK),
* SUMRY(3,1,IBLK), SUMRY(4,1,IBLK), 'Aspect',
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),
* SUMRY(2,2,IBLK), ISUMRY(2,2,IBLK),
* SUMRY(3,2,IBLK), SUMRY(4,2,IBLK), 'Skewness',
* SUMRY(1,3,IBLK), ISUMRY(1,3,IBLK),
* SUMRY(2,3,IBLK), ISUMRY(2,3,IBLK),
* SUMRY(3,3,IBLK), SUMRY(4,3,IBLK), 'Taper',
* SUMRY(1,4,IBLK), ISUMRY(1,4,IBLK),
* SUMRY(2,4,IBLK), ISUMRY(2,4,IBLK),
* SUMRY(3,4,IBLK), SUMRY(4,4,IBLK), 'Area'
WRITE (IO, 90)
70 CONTINUE
80 FORMAT (I5,(T8,2(1PE15.8,I6,2X),2(1PE15.8,2X),3X,A8))
90 FORMAT (' ------------------')
END IF
100 CONTINUE
END