lib
/
EXODUS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
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.
3 Commits
1 Branch
0 Tags
19 MiB
Tag: Branch: Tree: ec572c6da6
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'ec572c6da6'
${ noResults }
EXODUS/packages/seacas/applications/numbers/nu_con3d.f

456 lines
18 KiB
Raw Normal View History Unescape

Initial commit
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 CON3D (CRD, NDIM, NUMNP, IX, NNODES, NUMEL, MAT,
* NELBLK, SELECT, ASPECT1, ASPECT2, ASPECT3, AREA,
* SUMRY, ISUMRY, SKEWX, SKEWY, SKEWZ, TAPERX, TAPERY, TAPERZ,
* JAC, DEBUG)
C=======================================================================
C *** CON3D *** Calculate state of mesh -- Aspect ratio, Skewness,
C and Taper (Three-dimensional mesh)
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 NOTE: This is an experimental routine.
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=======================================================================
C REAL CRD(NUMNP, NDIM), ASPECT(*), SKEW(*), TAPER(*), AREA(*)
REAL CRD(NUMNP, NDIM)
REAL ASPECT1(*), ASPECT2(*), ASPECT3(*), AREA(*)
INTEGER IX(NNODES, NUMEL), MAT(6, NELBLK), ISUMRY(2,4,NELBLK)
REAL SUMRY(4,4,NELBLK)
LOGICAL SELECT(*), DEBUG, ISABRT
REAL SKEWX(*), SKEWY(*), SKEWZ(*)
REAL TAPERX(*), TAPERY(*), TAPERZ(*)
REAL JAC(*)
C REAL CRD(8,3)
C REAL ASPECT1(1), ASPECT2(1), ASPECT3(1), AREA(1)
C INTEGER IX(8,1), MAT(5, 1), ISUMRY(2,4,1)
C REAL SUMRY(4,4,1)
C LOGICAL SELECT(1)
C REAL SKEWX(1), SKEWY(1)
C REAL TAPERX(1), TAPERY(1), TAPERZ(1)
C DATA IX/1,2,3,4,5,6,7,8/
C DATA MAT /1,1,1,1,1/
C DATA SELECT /.TRUE./
C DATA NELBLK /1/
include 'nu_io.blk'
C IOMIN = 6
C IOMAX = 6
DO 50 IBLK = 1, NELBLK
IF (MAT(5, IBLK) .EQ. 1) THEN
IELBEG = MAT(3, IBLK)
IELEND = MAT(4, IBLK)
DO 40 IEL = IELBEG, IELEND
IF (ISABRT()) RETURN
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)
X5 = CRD(IX(5,IEL), 1)
X6 = CRD(IX(6,IEL), 1)
X7 = CRD(IX(7,IEL), 1)
X8 = CRD(IX(8,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)
Y5 = CRD(IX(5,IEL), 2)
Y6 = CRD(IX(6,IEL), 2)
Y7 = CRD(IX(7,IEL), 2)
Y8 = CRD(IX(8,IEL), 2)
Z1 = CRD(IX(1,IEL), 3)
Z2 = CRD(IX(2,IEL), 3)
Z3 = CRD(IX(3,IEL), 3)
Z4 = CRD(IX(4,IEL), 3)
Z5 = CRD(IX(5,IEL), 3)
Z6 = CRD(IX(6,IEL), 3)
Z7 = CRD(IX(7,IEL), 3)
Z8 = CRD(IX(8,IEL), 3)
E2 = -X1 + X2 + X3 - X4 - X5 + X6 + X7 - X8
F3 = -Y1 - Y2 + Y3 + Y4 - Y5 - Y6 + Y7 + Y8
G4 = -Z1 - Z2 - Z3 - Z4 + Z5 + Z6 + Z7 + Z8
C ... Make centroid of element the center of coordinate system
XS = (X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8) / 8.0
YS = (Y1 + Y2 + Y3 + Y4 + Y5 + Y6 + Y7 + Y8) / 8.0
ZS = (Z1 + Z2 + Z3 + Z4 + Z5 + Z6 + Z7 + Z8) / 8.0
X1 = X1 - XS
X2 = X2 - XS
X3 = X3 - XS
X4 = X4 - XS
X5 = X5 - XS
X6 = X6 - XS
X7 = X7 - XS
X8 = X8 - XS
Y1 = Y1 - YS
Y2 = Y2 - YS
Y3 = Y3 - YS
Y4 = Y4 - YS
Y5 = Y5 - YS
Y6 = Y6 - YS
Y7 = Y7 - YS
Y8 = Y8 - YS
Z1 = Z1 - ZS
Z2 = Z2 - ZS
Z3 = Z3 - ZS
Z4 = Z4 - ZS
Z5 = Z5 - ZS
Z6 = Z6 - ZS
Z7 = Z7 - ZS
Z8 = Z8 - ZS
C ... Rotate element such that center of side 2-3 and 4-1 define X axis
X2376 = X2 + X3 + X6 + X7
X1485 = X1 + X4 + X8 + X5
Y2376 = Y2 + Y3 + Y6 + Y7
Y1485 = Y1 + Y4 + Y8 + Y5
Z2376 = Z2 + Z3 + Z7 + Z6
Z1485 = Z1 + Z4 + Z8 + Z5
DX = X2376 - X1485
DY = Y2376 - Y1485
DZ = Z2376 - Z1485
AMAGX = SQRT(DX**2 + DZ**2)
AMAGY = SQRT(DX**2 + DY**2 + DZ**2)
FMAGX = SIGN(0.5, AMAGX) + SIGN(0.5, -AMAGX)
FMAGY = SIGN(0.5, AMAGY) + SIGN(0.5, -AMAGY)
CZ = DX / (AMAGX + FMAGX) + FMAGX
SZ = DZ / (AMAGX + FMAGX)
CY = SQRT(DX**2 + DZ**2) / (AMAGY + FMAGY) + FMAGY
SY = DY / (AMAGY + FMAGY)
XT = CY * CZ * X1 + CY * SZ * Z1 + SY * Y1
Y1 = -SY * CZ * X1 - SY * SZ * Z1 + CY * Y1
Z1 = -SZ * X1 + CZ * Z1
X1 = XT
XT = CY * CZ * X2 + CY * SZ * Z2 + SY * Y2
Y2 = -SY * CZ * X2 - SY * SZ * Z2 + CY * Y2
Z2 = -SZ * X2 + CZ * Z2
X2 = XT
XT = CY * CZ * X3 + CY * SZ * Z3 + SY * Y3
Y3 = -SY * CZ * X3 - SY * SZ * Z3 + CY * Y3
Z3 = -SZ * X3 + CZ * Z3
X3 = XT
XT = CY * CZ * X4 + CY * SZ * Z4 + SY * Y4
Y4 = -SY * CZ * X4 - SY * SZ * Z4 + CY * Y4
Z4 = -SZ * X4 + CZ * Z4
X4 = XT
XT = CY * CZ * X5 + CY * SZ * Z5 + SY * Y5
Y5 = -SY * CZ * X5 - SY * SZ * Z5 + CY * Y5
Z5 = -SZ * X5 + CZ * Z5
X5 = XT
XT = CY * CZ * X6 + CY * SZ * Z6 + SY * Y6
Y6 = -SY * CZ * X6 - SY * SZ * Z6 + CY * Y6
Z6 = -SZ * X6 + CZ * Z6
X6 = XT
XT = CY * CZ * X7 + CY * SZ * Z7 + SY * Y7
Y7 = -SY * CZ * X7 - SY * SZ * Z7 + CY * Y7
Z7 = -SZ * X7 + CZ * Z7
X7 = XT
XT = CY * CZ * X8 + CY * SZ * Z8 + SY * Y8
Y8 = -SY * CZ * X8 - SY * SZ * Z8 + CY * Y8
Z8 = -SZ * X8 + CZ * Z8
X8 = XT
C ... Now, rotate about Y
X3487 = X3 + X4 + X8 + X7
Y3487 = Y3 + Y4 + Y8 + Y7
Z3487 = Z3 + Z4 + Z8 + Z7
X1562 = X1 + X5 + X6 + X2
Y1562 = Y1 + Y5 + Y6 + Y2
Z1562 = Z1 + Z5 + Z6 + Z2
DX = X3487 - X1562
DY = Y3487 - Y1562
DZ = Z3487 - Z1562
AMAGY = SQRT(DY**2 + DZ**2)
FMAGY = SIGN(0.5, AMAGY) + SIGN(0.5, -AMAGY)
CX = DY / (AMAGY + FMAGY) + FMAGY
SX = DZ / (AMAGY + FMAGY)
YT = CX * Y1 + SX * Z1
Z1 = -SX * Y1 + CX * Z1
Y1 = YT
YT = CX * Y2 + SX * Z2
Z2 = -SX * Y2 + CX * Z2
Y2 = YT
YT = CX * Y3 + SX * Z3
Z3 = -SX * Y3 + CX * Z3
Y3 = YT
YT = CX * Y4 + SX * Z4
Z4 = -SX * Y4 + CX * Z4
Y4 = YT
YT = CX * Y5 + SX * Z5
Z5 = -SX * Y5 + CX * Z5
Y5 = YT
YT = CX * Y6 + SX * Z6
Z6 = -SX * Y6 + CX * Z6
Y6 = YT
YT = CX * Y7 + SX * Z7
Z7 = -SX * Y7 + CX * Z7
Y7 = YT
YT = CX * Y8 + SX * Z8
Z8 = -SX * Y8 + CX * Z8
Y8 = YT
C ... Calculate ``Shape function'' parameters - E1, F1, F2 = 0.0
E1 = X1 + X2 + X3 + X4 + X5 + X6 + X7 + X8
E2 = -X1 + X2 + X3 - X4 - X5 + X6 + X7 - X8
E3 = -X1 - X2 + X3 + X4 - X5 - X6 + X7 + X8
E4 = -X1 - X2 - X3 - X4 + X5 + X6 + X7 + X8
E5 = X1 + X2 - X3 - X4 - X5 - X6 + X7 + X8
E6 = X1 - X2 - X3 + X4 - X5 + X6 + X7 - X8
E7 = X1 - X2 + X3 - X4 + X5 - X6 + X7 - X8
E8 = -X1 + X2 - X3 + X4 + X5 - X6 + X7 - X8
F1 = Y1 + Y2 + Y3 + Y4 + Y5 + Y6 + Y7 + Y8
F2 = -Y1 + Y2 + Y3 - Y4 - Y5 + Y6 + Y7 - Y8
F3 = -Y1 - Y2 + Y3 + Y4 - Y5 - Y6 + Y7 + Y8
F4 = -Y1 - Y2 - Y3 - Y4 + Y5 + Y6 + Y7 + Y8
F5 = Y1 + Y2 - Y3 - Y4 - Y5 - Y6 + Y7 + Y8
F6 = Y1 - Y2 - Y3 + Y4 - Y5 + Y6 + Y7 - Y8
F7 = Y1 - Y2 + Y3 - Y4 + Y5 - Y6 + Y7 - Y8
F8 = -Y1 + Y2 - Y3 + Y4 + Y5 - Y6 + Y7 - Y8
G1 = Z1 + Z2 + Z3 + Z4 + Z5 + Z6 + Z7 + Z8
G2 = -Z1 + Z2 + Z3 - Z4 - Z5 + Z6 + Z7 - Z8
G3 = -Z1 - Z2 + Z3 + Z4 - Z5 - Z6 + Z7 + Z8
G4 = -Z1 - Z2 - Z3 - Z4 + Z5 + Z6 + Z7 + Z8
G5 = Z1 + Z2 - Z3 - Z4 - Z5 - Z6 + Z7 + Z8
G6 = Z1 - Z2 - Z3 + Z4 - Z5 + Z6 + Z7 - Z8
G7 = Z1 - Z2 + Z3 - Z4 + Z5 - Z6 + Z7 - Z8
G8 = -Z1 + Z2 - Z3 + Z4 + Z5 - Z6 + Z7 - Z8
IF (DEBUG) THEN
WRITE (99, 20) 'Element Number ',IEL
WRITE (99, 10) 'COLM', 1., 2., 3., 4., 5., 6., 7., 8.
WRITE (99, 10) 'CSCS', CX, SX, CY, SY, CZ, SZ
WRITE (99, 10) 'X', X1,X2,X3,X4,X5,X6,X7,X8
WRITE (99, 10) 'Y', Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8
WRITE (99, 10) 'Z', Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8
WRITE (99, 10) 'E', E1,E2,E3,E4,E5,E6,E7,E8
WRITE (99, 10) 'F', F1,F2,F3,F4,F5,F6,F7,F8
WRITE (99, 10) 'G', G1,G2,G3,G4,G5,G6,G7,G8
END IF
10 FORMAT (1X,A4,8(2X,F7.3))
20 FORMAT (/,1X,A,I6)
IF (DEBUG) THEN
IF (E2 .EQ. 0.0) THEN
WRITE (*, 30) 'E2', IEL
E2 = 1.0
END IF
IF (F3 .EQ. 0.0) THEN
WRITE (*, 30) 'F3', IEL
F3 = 1.0
END IF
IF (G4 .EQ. 0.0) THEN
WRITE (*, 30) 'G4', IEL
G4 = 1.0
END IF
END IF
30 FORMAT (1X,A2,' zero at element ',I6)
ASPECT1(IEL) = MAX (E2, F3) / MIN(E2, F3)
ASPECT2(IEL) = MAX (E2, G4) / MIN(E2, G4)
ASPECT3(IEL) = MAX (F3, G4) / MIN(F3, G4)
AREA(IEL) = E2 * F3 * G4 / 64.0
SKEWX(IEL) = ABS(F4/G4) / SQRT((F4/G4)**2 + 1.0)
SKEWY(IEL) = ABS(E4/G4) / SQRT((E4/G4)**2 + 1.0)
SKEWZ(IEL) = ABS(E3/F3) / SQRT((E3/F3)**2 + 1.0)
TAPERX(IEL) = E5 / E2
TAPERY(IEL) = F5 / F3
TAPERZ(IEL) = G5 / G4
IF (DEBUG) THEN
WRITE (99, 10) 'ASPS', ASPECT1(IEL), ASPECT2(IEL),
& ASPECT3(IEL), AREA(IEL)
WRITE (99, 10) 'SKEW', SKEWX(IEL), SKEWY(IEL),
& SKEWZ(IEL)
WRITE (99, 10) 'TAPR', TAPERX(IEL), TAPERY(IEL),
& TAPERZ(IEL)
END IF
CALL JACOB(x1,x2,x3,x4,x5,x6,x7,x8,
* y1,y2,y3,y4,y5,y6,y7,y8,
* z1,z2,z3,z4,z5,z6,z7,z8, JAC(IEL))
END IF
40 CONTINUE
END IF
50 CONTINUE
C IF (.FALSE.) THEN
IF (.TRUE.) THEN
DO 60 IO=IOMIN, IOMAX
WRITE (IO, 70)
WRITE (IO, 80)
60 CONTINUE
70 FORMAT (/' **** EXPERIMENTAL ROUTINE - CHECK RESULTS ****')
80 FORMAT (/' Shape Parameters for Selected Elements',/
* /1X,' Mat Minimum Elem Maximum Elem',
* ' Average Std. Dev.'/)
DO 140 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), ASPECT1(IELBEG),
* SUMRY(1,1,IBLK), ISUMRY(1,1,IBLK),IELBEG-1)
CALL SUMMRY (' ',NUMLST, SELECT(IELBEG), ASPECT2(IELBEG),
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),IELBEG-1)
CALL SUMMRY (' ',NUMLST, SELECT(IELBEG), ASPECT3(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 90 IO= IOMIN, IOMAX
WRITE (IO, 120) 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), 'AspectXY',
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),
* SUMRY(2,2,IBLK), ISUMRY(2,2,IBLK),
* SUMRY(3,2,IBLK), SUMRY(4,2,IBLK), 'AspectXZ',
* SUMRY(1,3,IBLK), ISUMRY(1,3,IBLK),
* SUMRY(2,3,IBLK), ISUMRY(2,3,IBLK),
* SUMRY(3,3,IBLK), SUMRY(4,3,IBLK), 'AspectYZ',
* SUMRY(1,4,IBLK), ISUMRY(1,4,IBLK),
* SUMRY(2,4,IBLK), ISUMRY(2,4,IBLK),
* SUMRY(3,4,IBLK), SUMRY(4,4,IBLK), 'Volume'
90 CONTINUE
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), SKEWX(IELBEG),
* SUMRY(1,1,IBLK), ISUMRY(1,1,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), SKEWY(IELBEG),
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), SKEWZ(IELBEG),
* SUMRY(1,3,IBLK), ISUMRY(1,3,IBLK),IELBEG-1)
DO 100 IO= IOMIN, IOMAX
WRITE (IO, 120) 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), 'Skew X',
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),
* SUMRY(2,2,IBLK), ISUMRY(2,2,IBLK),
* SUMRY(3,2,IBLK), SUMRY(4,2,IBLK), 'Skew Y',
* SUMRY(1,3,IBLK), ISUMRY(1,3,IBLK),
* SUMRY(2,3,IBLK), ISUMRY(2,3,IBLK),
* SUMRY(3,3,IBLK), SUMRY(4,3,IBLK), 'Skew Z'
100 CONTINUE
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), TAPERX(IELBEG),
* SUMRY(1,1,IBLK), ISUMRY(1,1,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), TAPERY(IELBEG),
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), TAPERZ(IELBEG),
* SUMRY(1,3,IBLK), ISUMRY(1,3,IBLK),IELBEG-1)
CALL SUMMRY (' ', NUMLST, SELECT(IELBEG), JAC(IELBEG),
* SUMRY(1,4,IBLK), ISUMRY(1,4,IBLK),IELBEG-1)
DO 110 IO= IOMIN, IOMAX
WRITE (IO, 120) 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), 'TaperX',
* SUMRY(1,2,IBLK), ISUMRY(1,2,IBLK),
* SUMRY(2,2,IBLK), ISUMRY(2,2,IBLK),
* SUMRY(3,2,IBLK), SUMRY(4,2,IBLK), 'TaperY',
* SUMRY(1,3,IBLK), ISUMRY(1,3,IBLK),
* SUMRY(2,3,IBLK), ISUMRY(2,3,IBLK),
* SUMRY(3,3,IBLK), SUMRY(4,3,IBLK), 'TaperZ',
* SUMRY(1,4,IBLK), ISUMRY(1,4,IBLK),
* SUMRY(2,4,IBLK), ISUMRY(2,4,IBLK),
* SUMRY(3,4,IBLK), SUMRY(4,4,IBLK), 'MinJacob'
WRITE (IO, 130)
110 CONTINUE
120 FORMAT (I4,(T7,2(1PE15.8,I9,1X),2(1PE15.8,2X),A8))
130 FORMAT (' ------------------')
END IF
140 CONTINUE
END IF
END