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
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
|