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.
198 lines
6.3 KiB
198 lines
6.3 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
|
|
|
|
C=======================================================================
|
|
subroutine snpnod(numnp, ndim, x, y, z,
|
|
* vnorm, neesss, nnesss, ltness,
|
|
* plane, neessm, nnessm, ltnesm,
|
|
* toler, delmax)
|
|
C=======================================================================
|
|
|
|
REAL X(*), Y(*), Z(*), VNORM(3,*), PLANE(4,*)
|
|
DIMENSION LTNESS(4,*), LTNESM(4,*)
|
|
|
|
REAL PI(3)
|
|
REAL SAVEIT(3)
|
|
LOGICAL FOUND
|
|
|
|
glotol = 0.0
|
|
notmat = 0
|
|
matin = 0
|
|
mattol = 0
|
|
numnod = 0
|
|
dmax = 0.0
|
|
delmx2 = delmax**2
|
|
svdel = 0.0
|
|
saveit(1) = 0.0
|
|
saveit(2) = 0.0
|
|
saveit(3) = 0.0
|
|
|
|
do 130 inod = 1, numnp
|
|
armax = -1.0e38
|
|
svmax = -1.0e38
|
|
found = .false.
|
|
if (vnorm(1,inod) .ne. 0.0 .or. vnorm(2,inod) .ne. 0.0 .or.
|
|
* vnorm(3,inod) .ne. 0.0) then
|
|
|
|
numnod = numnod + 1
|
|
|
|
X0 = X(inod)
|
|
Y0 = Y(inod)
|
|
Z0 = Z(inod)
|
|
|
|
AI = VNORM(1, inod)
|
|
BJ = VNORM(2, inod)
|
|
CK = VNORM(3, inod)
|
|
|
|
do 110 ifac = 1, neessm
|
|
A = plane(1,ifac)
|
|
B = plane(2,ifac)
|
|
C = plane(3,ifac)
|
|
D = plane(4,ifac)
|
|
|
|
C ... If denom == 0, then node normal is parallel to plane
|
|
DENOM = A*AI + B*BJ + C*CK
|
|
if (denom .ne. 0.0) then
|
|
T = -(A*X0 + B*Y0 + C*Z0 - D) / DENOM
|
|
|
|
C ... Intersection point
|
|
PI(1) = X0 + T * AI
|
|
PI(2) = Y0 + T * BJ
|
|
PI(3) = Z0 + T * CK
|
|
|
|
dx = abs(x(inod)-pi(1))
|
|
if (dx .gt. delmax) go to 100
|
|
dy = abs(y(inod)-pi(2))
|
|
if (dy .gt. delmax) go to 100
|
|
dz = abs(z(inod)-pi(3))
|
|
if (dz .gt. delmax) go to 100
|
|
|
|
delta2 = dx**2 + dy**2 + dz**2
|
|
if (delta2 .le. delmx2) then
|
|
C ... See if intersection point is inside face.
|
|
XI = X(LTNESM(1,IFAC))
|
|
YI = Y(LTNESM(1,IFAC))
|
|
ZI = Z(LTNESM(1,IFAC))
|
|
|
|
XJ = X(LTNESM(2,IFAC))
|
|
YJ = Y(LTNESM(2,IFAC))
|
|
ZJ = Z(LTNESM(2,IFAC))
|
|
|
|
XK = X(LTNESM(3,IFAC))
|
|
YK = Y(LTNESM(3,IFAC))
|
|
ZK = Z(LTNESM(3,IFAC))
|
|
|
|
XL = X(LTNESM(4,IFAC))
|
|
YL = Y(LTNESM(4,IFAC))
|
|
ZL = Z(LTNESM(4,IFAC))
|
|
|
|
area1 = trarea(xi, yi, zi, xj, yj, zj,
|
|
* pi(1), pi(2), pi(3),
|
|
* plane(1,ifac))
|
|
|
|
area2 = trarea(xj, yj, zj, xk, yk, zk,
|
|
* pi(1), pi(2), pi(3),
|
|
* plane(1,ifac))
|
|
|
|
area3 = trarea(xk, yk, zk, xl, yl, zl,
|
|
* pi(1), pi(2), pi(3),
|
|
* plane(1,ifac))
|
|
|
|
area4 = trarea(xl, yl, zl, xi, yi, zi,
|
|
* pi(1), pi(2), pi(3),
|
|
* plane(1,ifac))
|
|
|
|
if (area1 .ge. 0.0 .and. area2 .ge. 0.0 .and.
|
|
* area3 .ge. 0.0 .and. area4 .ge. 0.0) then
|
|
C ... If we made it this far, then the intersection point is inside the
|
|
C face. Move the node to the intersection point and get the next node
|
|
X(INOD) = PI(1)
|
|
Y(INOD) = PI(2)
|
|
Z(INOD) = PI(3)
|
|
|
|
dmax = max(delta2, dmax)
|
|
matin = matin + 1
|
|
|
|
go to 120
|
|
else if (area1 .ge. -toler .and. area2 .ge. -toler .and.
|
|
* area3 .ge. -toler .and. area4 .ge. -toler) then
|
|
C ... If we made it this far, then the intersection point is slightly
|
|
C outside the face, but is within tolerance. Save this intersection
|
|
C point in case no intersections within the face are found.
|
|
|
|
C ... Want largest negative
|
|
armin = MIN(area1, area2, area3, area4)
|
|
|
|
C ... NOTE: armin < 0, want closest to zero.
|
|
if (armin .gt. svmax) then
|
|
found = .TRUE.
|
|
svmax = armin
|
|
svdel = delta2
|
|
SAVEIT(1) = PI(1)
|
|
SAVEIT(2) = PI(2)
|
|
SAVEIT(3) = PI(3)
|
|
end if
|
|
else
|
|
C ... The node is outside the tolerance, find the most negative of the area*
|
|
C for this face/node combination. Save the maximum (closest to zero)
|
|
C for all face/node combinations.
|
|
armin = MIN(area1, area2, area3, area4)
|
|
armax = MAX(armin, armax)
|
|
end if
|
|
end if
|
|
end if
|
|
100 continue
|
|
110 continue
|
|
if (found) then
|
|
x(inod) = saveit(1)
|
|
y(inod) = saveit(2)
|
|
z(inod) = saveit(3)
|
|
dmax = max(svdel, dmax)
|
|
mattol = mattol + 1
|
|
else
|
|
write (*,10000) inod, -armax
|
|
glotol = MAX(glotol, -armax)
|
|
notmat = notmat + 1
|
|
end if
|
|
end if
|
|
120 continue
|
|
130 continue
|
|
|
|
if (notmat .gt. 0) then
|
|
write (*,10010) notmat, glotol
|
|
end if
|
|
write (*, 10020) sqrt(dmax), numnod, matin, mattol
|
|
10000 format('WARNING - No matching face found for node ',i9,/,
|
|
* ' Tolerance must be at least ',1pe11.4,
|
|
* ' to detect a match.')
|
|
10010 format(/,'WARNING - ',I9,' nodes were not matched.',/,
|
|
* 'Set tolerance greater than ',1pe11.4,' to match all nodes.')
|
|
10020 format(/,'Maximum node movement = ',1pe11.4,
|
|
* /,'Number of unique slave nodes = ',I9,
|
|
* /,'Number of exact matches = ',I9,
|
|
* /,'Number of toleranced matches = ',I9 )
|
|
return
|
|
end
|
|
|
|
real function trarea(A1, A2, A3, B1, B2, B3, C1, C2, C3,
|
|
* RNORM)
|
|
real sum(3), rnorm(3)
|
|
|
|
sum(1) = A2*B3 - A3*B2
|
|
sum(2) = A3*B1 - A1*B3
|
|
sum(3) = A1*B2 - A2*B1
|
|
|
|
sum(1) = sum(1) + B2*C3 - B3*C2
|
|
sum(2) = sum(2) + B3*C1 - B1*C3
|
|
sum(3) = sum(3) + B1*C2 - B2*C1
|
|
|
|
sum(1) = sum(1) + C2*A3 - C3*A2
|
|
sum(2) = sum(2) + C3*A1 - C1*A3
|
|
sum(3) = sum(3) + C1*A2 - C2*A1
|
|
|
|
trarea = sum(1)*rnorm(1) + sum(2)*rnorm(2) + sum(3)*rnorm(3)
|
|
return
|
|
end
|
|
|