C Copyright(C) 2011 Sandia Corporation.  Under the terms of Contract
C DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains
C certain rights in this software
C 
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions are
C met:
C 
C * Redistributions of source code must retain the above copyright
C    notice, this list of conditions and the following disclaimer.
C           
C * Redistributions in binary form must reproduce the above
C   copyright notice, this list of conditions and the following
C   disclaimer in the documentation and/or other materials provided
C   with the distribution.
C                         
C * Neither the name of Sandia Corporation nor the names of its
C   contributors may be used to endorse or promote products derived
C   from this software without specific prior written permission.
C                                                 
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
C 

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
 
