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.
 
 
 
 
 
 

182 lines
3.7 KiB

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
subroutine 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, JACMN)
REAL JACOBI, JACMN
REAL XXI(3), XET(3), XZE(3)
JACMN = 1.0e38
C... Jacobian at mid-point:
xxi(1) = x2 + x3 + x6 + x7 - x1 - x4 - x5 - x8
xet(1) = x3 + x4 + x7 + x8 - x1 - x2 - x5 - x6
xze(1) = x5 + x6 + x7 + x8 - x1 - x2 - x3 - x4
xxi(2) = y2 + y3 + y6 + y7 - y1 - y4 - y5 - y8
xet(2) = y3 + y4 + y7 + y8 - y1 - y2 - y5 - y6
xze(2) = y5 + y6 + y7 + y8 - y1 - y2 - y3 - y4
xxi(3) = z2 + z3 + z6 + z7 - z1 - z4 - z5 - z8
xet(3) = z3 + z4 + z7 + z8 - z1 - z2 - z5 - z6
xze(3) = z5 + z6 + z7 + z8 - z1 - z2 - z3 - z4
jacobi = CRSDOT(xxi,xet,xze)/64.0
jacmn = min(jacobi, jacmn)
C... J(0,0,0):
xxi(1) = x2 - x1
xet(1) = x4 - x1
xze(1) = x5 - x1
xxi(2) = y2 - y1
xet(2) = y4 - y1
xze(2) = y5 - y1
xxi(3) = z2 - z1
xet(3) = z4 - z1
xze(3) = z5 - z1
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
C... J(1,0,0):
xxi(1) = x2 - x1
xet(1) = x3 - x2
xze(1) = x6 - x2
xxi(2) = y2 - y1
xet(2) = y3 - y2
xze(2) = y6 - y2
xxi(3) = z2 - z1
xet(3) = z3 - z2
xze(3) = z6 - z2
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
C... J(0,1,0):
xxi(1) = x3 - x4
xet(1) = x4 - x1
xze(1) = x8 - x4
xxi(2) = y3 - y4
xet(2) = y4 - y1
xze(2) = y8 - y4
xxi(3) = z3 - z4
xet(3) = z4 - z1
xze(3) = z8 - z4
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
C... J(0,0,1):
xxi(1) = x6 - x5
xet(1) = x8 - x5
xze(1) = x5 - x1
xxi(2) = y6 - y5
xet(2) = y8 - y5
xze(2) = y5 - y1
xxi(3) = z6 - z5
xet(3) = z8 - z5
xze(3) = z5 - z1
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
C... J(1,1,0):
xxi(1) = x3 - x4
xet(1) = x3 - x2
xze(1) = x7 - x3
xxi(2) = y3 - y4
xet(2) = y3 - y2
xze(2) = y7 - y3
xxi(3) = z3 - z4
xet(3) = z3 - z2
xze(3) = z7 - z3
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
C... J(1,0,1):
xxi(1) = x6 - x5
xet(1) = x7 - x6
xze(1) = x6 - x2
xxi(2) = y6 - y5
xet(2) = y7 - y6
xze(2) = y6 - y2
xxi(3) = z6 - z5
xet(3) = z7 - z6
xze(3) = z6 - z2
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
C... J(0,1,1):
xxi(1) = x7 - x8
xet(1) = x8 - x5
xze(1) = x8 - x4
xxi(2) = y7 - y8
xet(2) = y8 - y5
xze(2) = y8 - y4
xxi(3) = z7 - z8
xet(3) = z8 - z5
xze(3) = z8 - z4
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
C... J(1,1,1):
xxi(1) = x7 - x8
xet(1) = x7 - x6
xze(1) = x7 - x3
xxi(2) = y7 - y8
xet(2) = y7 - y6
xze(2) = y7 - y3
xxi(3) = z7 - z8
xet(3) = z7 - z6
xze(3) = z7 - z3
jacobi = CRSDOT(xxi,xet,xze)
jacmn = min(jacobi, jacmn)
return
end
REAL FUNCTION CRSDOT(a, b, c)
REAL a(3), b(3), c(3)
C ... Compute d = a dot (b cross c)
REAL xcross, ycross, zcross
xcross = b(2) * c(3) - b(3) * c(2)
ycross = b(3) * c(1) - b(1) * c(3)
zcross = b(1) * c(2) - b(2) * c(1)
crsdot = (a(1) * xcross + a(2) * ycross + a(3) * zcross)
return
end