EXODUS/packages/seacas/applications/grepos/gp_movnod.f

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 movnod(numnp, ndim, x, y, z,
     *  vnorm, neesss, nnesss, ltness,
     *  plane, neessm, nnessm, ltnesm,
     *  toler, delmax, index, vector, gap)
C=======================================================================

      REAL X(*), Y(*), Z(*), VNORM(3,*), PLANE(4,*)
      DIMENSION LTNESS(4,*), LTNESM(4,*)
      INTEGER INDEX(*)
      REAL VECTOR(3)
      LOGICAL FOUND

      REAL PI(3)

      dmax = 0.0
      dmin = 1.0e15
      delmx2 = delmax**2
      match = 0

      do 130 inod = 1, numnp
        found = .FALSE.
        smin = 1.0e15
        smax = 0.0
        armax = -1.0e38
        if (vnorm(1,inod) .ne. 0.0 .or. vnorm(2,inod) .ne. 0.0 .or.
     *    vnorm(3,inod) .ne. 0.0) then

          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

              if (t .lt. 0.0) go to 100
              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. Save the minimum distance found so far.
                  dmin = min(delta2, dmin)
                  dmax = max(delta2, dmax)
                  match = match + 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 outside the
C     face, but inside the toler. Save the minimum distance found so far.
                  found = .true.
                  smin = min(delta2, smin)
                  smax = max(delta2, smax)
                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
C ... The node did not intersect any face, but it did find one within
C     the tolerance. Use the closest one
            dmin = smin
          end if
        end if
 120    continue
 130  continue

C ... Update the node positions based on the minimum distance found
C     and the specified vector.
      if (match .gt. 0) then
        AI = vector(1)
        BJ = vector(2)
        CK = vector(3)

        dmin = sqrt(dmin)
        dmin = dmin - gap

        do 140 inod=1, numnp
          if (index(inod) .eq. 1) then
            X0 = X(inod)
            Y0 = Y(inod)
            Z0 = Z(inod)

C ... Update the nodes position (Currently, assumes in vector direction)
            X(inod) = X0 + dmin * AI
            Y(inod) = Y0 + dmin * BJ
            Z(inod) = Z0 + dmin * CK
          end if
 140    continue
        write (*, 10020) dmin
      else
        write (*,*) 'No node movement.'
      end if

10020 format(/,'Node movement = ',1pe11.4)
      return
      end