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.
4 Commits
1 Branch
0 Tags
19 MiB
 
 
 
 
 
 
Tag: Branch: Tree: 77bd7563eb
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '77bd7563eb'
${ noResults }
EXODUS/packages/seacas/libraries/mapvarlib/exth.f

278 lines
9.5 KiB
Raw Blame History

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 EXTH(IGLND,INVCN,MAXLN,NOD,INVLEN,XA,YA,ZA,CNTRA,
& SOLEA,SOLENA,ITT,iblk)
C************************************************************************
C Subroutine EXTH sets up the matrix and vectors for a least squares
C linear interpolation/extrapolation of element variable data to the
C nodes for 3-D elements. This routine has been checked out for 8-node
C hex and 4-node and 8-node (treated same as 4-node) tet elements.
C In the special case of data from only 4 elements, the result is not
C a true least squares fit in that the least squares error is zero.
C Calls subroutines FRGE & BS
C Called by ELTON3
C************************************************************************
C IGLND INT The global node number being processed
C INVCN INT Inverse connectivity (1:maxln,1:numnda)
C MAXLN INT The maximum number of elements connected to any node
C NOD INT The local node used to get elements from INVCN
C INVLEN INT The number of elements connected to NOD
C XA,etc REAL Vectors containing nodal coordinates
C CNTRA REAL Array containing the coordinates of the element
C centroids (1:3)
C SOLEA REAL The element variables
C SOLENA REAL Element variables at nodes
C number with the global mesh node number (1:numnda)
C ITT INT truth table
C iblk INT element block being processed (not ID)
C ICOP INT Flag defining co-planarity of elements (0-coplan, 1-not)
C S REAL The coefficient matrix for the least squares fit
C L INT Dummy vector - used in FRGE and BS
C X REAL The solution vector - used in BS
C G REAL Dummy vector - used in FRGE
C F REAL The load vector for the least squares fit
C************************************************************************
include 'aexds1.blk'
include 'amesh.blk'
include 'ebbyeb.blk'
include 'tapes.blk'
DIMENSION INVCN(MAXLN,*),XA(*),YA(*),ZA(*)
DIMENSION CNTRA(NUMEBA,*),SOLEA(NUMEBA,*)
DIMENSION SOLENA(NODESA,NVAREL),ITT(NVAREL,*)
DOUBLE PRECISION S(4,4),G(4),F(4),X(4)
INTEGER L(4)
C************************************************************************
ICOP = 0
C First check elements for coplanarity
C Construct a vector from first element centroid to second
VEC11 = CNTRA(INVCN(2,NOD),1) - CNTRA(INVCN(1,NOD),1)
VEC12 = CNTRA(INVCN(2,NOD),2) - CNTRA(INVCN(1,NOD),2)
VEC13 = CNTRA(INVCN(2,NOD),3) - CNTRA(INVCN(1,NOD),3)
V1MAG = SQRT(VEC11*VEC11 + VEC12*VEC12 + VEC13*VEC13)
C Construct a vector from first element centroid to third
VEC21 = CNTRA(INVCN(3,NOD),1) - CNTRA(INVCN(1,NOD),1)
VEC22 = CNTRA(INVCN(3,NOD),2) - CNTRA(INVCN(1,NOD),2)
VEC23 = CNTRA(INVCN(3,NOD),3) - CNTRA(INVCN(1,NOD),3)
C X-product vector-1 with vector-2 to get normal to plane defined
C by the two vectors then make a unit vector
VN1 = VEC12*VEC23 - VEC22*VEC13
VN2 = VEC13*VEC21 - VEC11*VEC23
VN3 = VEC11*VEC22 - VEC21*VEC12
VNMAG = SQRT(VN1*VN1 + VN2*VN2 + VN3*VN3)
VN1 = VN1 / VNMAG
VN2 = VN2 / VNMAG
VN3 = VN3 / VNMAG
C Dot product of normal vector with vectors from first element
C centroid to the remaining element centroids. If dot product
C is too small, data is coplanar - try the next vector.
C If dot product more then 0.1 times the vector, data is not
C coplanar, set ICOP to 1 and get on with it.
DO 5 I = 4, INVLEN
VEC1 = CNTRA(INVCN(I,NOD),1) - CNTRA(INVCN(1,NOD),1)
VEC2 = CNTRA(INVCN(I,NOD),2) - CNTRA(INVCN(1,NOD),2)
VEC3 = CNTRA(INVCN(I,NOD),3) - CNTRA(INVCN(1,NOD),3)
VIMAG = SQRT(VEC1*VEC1 + VEC2*VEC2 + VEC3*VEC3)
VDTMAG = SQRT(VN1*VEC1*VN1*VEC1 + VN2*VEC2*VN2*VEC2
& + VN3*VEC3*VN3*VEC3)
COMP = VDTMAG * 10.
IF (COMP .LT. VIMAG)THEN
GO TO 5
ELSE
ICOP = 1
go to 6
END IF
5 CONTINUE
C Zero matrix
6 CONTINUE
DO I = 1,4
DO J = 1,4
S(I,J) = 0.D+00
end do
end do
C Branch on coplanar data vs truly 3-d data
IF (ICOP .EQ. 1)THEN
C Set up matrix for linear fit
S(1,1) = DBLE(INVLEN)
DO 20 I = 1, INVLEN
S(1,2) = S(1,2)+DBLE(XA(IGLND) - CNTRA(INVCN(I,NOD),1))
S(1,3) = S(1,3)+DBLE(YA(IGLND) - CNTRA(INVCN(I,NOD),2))
S(1,4) = S(1,4)+DBLE(ZA(IGLND) - CNTRA(INVCN(I,NOD),3))
S(2,2) = S(2,2)+DBLE((XA(IGLND) - CNTRA(INVCN(I,NOD),1)) *
& (XA(IGLND) - CNTRA(INVCN(I,NOD),1)))
S(2,3) = S(2,3)+DBLE((YA(IGLND) - CNTRA(INVCN(I,NOD),2)) *
& (XA(IGLND) - CNTRA(INVCN(I,NOD),1)))
S(2,4) = S(2,4)+DBLE((ZA(IGLND) - CNTRA(INVCN(I,NOD),3)) *
& (XA(IGLND) - CNTRA(INVCN(I,NOD),1)))
S(3,3) = S(3,3)+DBLE((YA(IGLND) - CNTRA(INVCN(I,NOD),2)) *
& (YA(IGLND) - CNTRA(INVCN(I,NOD),2)))
S(3,4) = S(3,4)+DBLE((ZA(IGLND) - CNTRA(INVCN(I,NOD),3)) *
& (YA(IGLND) - CNTRA(INVCN(I,NOD),2)))
S(4,4) = S(4,4)+DBLE((ZA(IGLND) - CNTRA(INVCN(I,NOD),3)) *
& (ZA(IGLND) - CNTRA(INVCN(I,NOD),3)))
20 CONTINUE
S(2,1) = S(1,2)
S(3,1) = S(1,3)
S(4,1) = S(1,4)
S(3,2) = S(2,3)
S(4,2) = S(2,4)
S(4,3) = S(3,4)
C Forward Gauss elimination (Kincaid pg. 220) (double precision)
CALL FRGE(4,S,L,G)
C Set up load vectors - number of element variables
DO 30 IVAR = 1, NVAREL
IF (ITT(IVAR,iblk) .EQ. 0)GO TO 30
F(1) = 0.D+00
F(2) = 0.D+00
F(3) = 0.D+00
F(4) = 0.D+00
DO 40 I = 1, INVLEN
F(1) = F(1) + DBLE(SOLEA(INVCN(I,NOD),IVAR))
F(2) = F(2) + DBLE(SOLEA(INVCN(I,NOD),IVAR) *
& (XA(IGLND) - CNTRA(INVCN(I,NOD),1)))
F(3) = F(3) + DBLE(SOLEA(INVCN(I,NOD),IVAR) *
& (YA(IGLND) - CNTRA(INVCN(I,NOD),2)))
F(4) = F(4) + DBLE(SOLEA(INVCN(I,NOD),IVAR) *
& (ZA(IGLND) - CNTRA(INVCN(I,NOD),3)))
40 CONTINUE
C Back substitution (Kincaid pg. 223) (double precision)
CALL BS(4,S,F,L,X)
C Fill in nodal element value array (SOLENA)
C Note: X and Y distances in S and F are centered on node being
C interpolated to (IGLND), thus X, Y, Z are zero in the eq.
C Value = X(1) + X(2) * X + X(3) * Y + X(4) * Z
SOLENA(IGLND,IVAR) = SNGL(X(1))
30 CONTINUE
ELSE IF (ICOP .EQ. 0)THEN
C first unit vector
V11 = VEC11 / V1MAG
V12 = VEC12 / V1MAG
V13 = VEC13 / V1MAG
C compute 2nd (orthogonal) vector in plane - make it a unit vector
V21 = V12 * VN3 - VN2 * V13
V22 = VN1 * V13 - V11 * VN3
V23 = V11 * VN2 - VN1 * V12
V2MAG = SQRT(V21*V21 + V22*V22 + V23*V23)
V21 = V21 / V2MAG
V22 = V22 / V2MAG
V23 = V23 / V2MAG
C set up matrix for least squares fit
S(1,1) = DBLE(INVLEN)
DO 50 I = 1, INVLEN
C rotate coords
XORI = XA(IGLND)-CNTRA(INVCN(I,NOD),1)
YORI = YA(IGLND)-CNTRA(INVCN(I,NOD),2)
ZORI = ZA(IGLND)-CNTRA(INVCN(I,NOD),3)
XP = XORI*V11 + YORI*V12 + ZORI*V13
YP = XORI*V21 + YORI*V22 + ZORI*V23
S(1,2) = S(1,2)+DBLE(XP)
S(1,3) = S(1,3)+DBLE(YP)
S(2,2) = S(2,2)+DBLE(XP * XP)
S(2,3) = S(2,3)+DBLE(XP * YP)
S(3,3) = S(3,3)+DBLE(YP * YP)
50 CONTINUE
S(2,1) = S(1,2)
S(3,1) = S(1,3)
S(3,2) = S(2,3)
S(1,4) = 0.D+00
S(2,4) = 0.D+00
S(3,4) = 0.D+00
S(4,4) = 1.D+00
S(4,3) = 0.D+00
S(4,2) = 0.D+00
S(4,1) = 0.D+00
C Forward Gauss elimination (Kincaid pg. 220) (double precision)
CALL FRGE(4,S,L,G)
C Set up load vectors - number of element variables
DO 60 IVAR = 1, NVAREL
IF (ITT(IVAR,iblk) .EQ. 0)GO TO 60
F(1) = 0.D+00
F(2) = 0.D+00
F(3) = 0.D+00
F(4) = 0.D+00
DO 70 I = 1, INVLEN
XORI = XA(IGLND)-CNTRA(INVCN(I,NOD),1)
YORI = YA(IGLND)-CNTRA(INVCN(I,NOD),2)
ZORI = ZA(IGLND)-CNTRA(INVCN(I,NOD),3)
XP = XORI*V11 + YORI*V12 + ZORI*V13
YP = XORI*V21 + YORI*V22 + ZORI*V23
F(1) = F(1) + DBLE(SOLEA(INVCN(I,NOD),IVAR))
F(2) = F(2) + DBLE(SOLEA(INVCN(I,NOD),IVAR) * XP)
F(3) = F(3) + DBLE(SOLEA(INVCN(I,NOD),IVAR) * YP)
70 CONTINUE
C Back substitution (Kincaid pg. 223) (double precision)
CALL BS(4,S,F,L,X)
C Ordinaly you would need to rotate back into cartesian coords
C however, we only need X(1) so there is no need to rotate here
C X2 = SNGL(X(2))*V11 + SNGL(X(3))*V21
C X3 = SNGL(X(2))*V12 + SNGL(X(3))*V22
C X4 = SNGL(X(2))*V13 + SNGL(X(3))*V23
C X(2) = X2
C X(3) = X3
C X(4) = X4
C Fill in nodal element value array (SOLENA)
C Note: X and Y distances in S and F are centered on node being
C interpolated to (IGLND), thus X, Y, Z are zero in the eq.
C Value = X(1) + X(2) * X + X(3) * Y + X(4) * Z
SOLENA(IGLND,IVAR) = SNGL(X(1))
60 CONTINUE
END IF
RETURN
END