xref: /phasta/phSolver/common/elem-search.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)

      subroutine elem_search(xl,xts1,xts2,xts3,xsic,elmt, idfile)
c
c----------------------------------------------------------------------
c This subroutine finds for a particular point in which element it lays
c and what are its local coordinates
c
c input:
c  xl      (npro, nshl, nsd)    : local node coordinates
c  xts1, xts2, xts3		: point coordinates
c
c output:
c  xsic   (nsd)           	: point's local coordinates
c  elmt  			: element number
c
c
c  Elaine Bohr
c  April 2002
c----------------------------------------------------------------------
c
      use spebc
      include "common.h"

      dimension shape(nelint,nshl), xsic(nsd),
     &     xl(nelint,nenl,nsd)

      real*8 al(nelint,nenl,nsd),
     &       zi0(nelint,nsd), detaij(nelint), dzi0(nelint,nsd),
     &       neg(nelint), distance(nelint)
      integer testing(4), found(nelint), negativ(nelint)

      real*8 xts1, xts2, xts3, min
      integer e, elmt, result, count, counting, find

      tolpt = 0.000001
      call get_coeff_tet(xl,al)

      detaij(:) = -al(:,2,1)*al(:,3,2)*al(:,4,3) +
     &           al(:,2,1)*al(:,4,2)*al(:,3,3) + al(:,2,2)*
     &           al(:,3,1)*al(:,4,3) - al(:,2,2)*al(:,4,1)*
     &           al(:,3,3) - al(:,2,3)*al(:,3,1)*al(:,4,2)+
     &           al(:,2,3)*al(:,4,1)*al(:,3,2)

      detaij = 1./detaij

      zi0(:,1) = detaij(:)*((al(:,4,2)*al(:,3,3)
     &           - al(:,3,2)*al(:,4,3))*(xts1-al(:,1,1)) +
     &           (al(:,3,1)*al(:,4,3)
     &           - al(:,4,1)*al(:,3,3))*(xts2-al(:,1,2)) +
     &           (al(:,4,1)*al(:,3,2)
     &           - al(:,3,1)*al(:,4,2))*(xts3-al(:,1,3)))


      zi0(:,2) = detaij(:)*((al(:,2,2)*al(:,4,3)
     &           - al(:,4,2)*al(:,2,3))*(xts1-al(:,1,1)) +
     &           (al(:,4,1)*al(:,2,3)
     &           - al(:,2,1)*al(:,4,3))*(xts2-al(:,1,2)) +
     &           (al(:,2,1)*al(:,4,2)
     &           - al(:,4,1)*al(:,2,2))*(xts3-al(:,1,3)))

      zi0(:,3) = detaij(:)*((al(:,3,2)*al(:,2,3)
     &           - al(:,2,2)*al(:,3,3))*(xts1-al(:,1,1)) +
     &           (al(:,2,1)*al(:,3,3)
     &           - al(:,3,1)*al(:,2,3))*(xts2-al(:,1,2)) +
     &           (al(:,3,1)*al(:,2,2)
     &           - al(:,2,1)*al(:,3,2))*(xts3-al(:,1,3)))

c      zi0(:,4) = 1 - zi0(:,1) - zi0(:,2) - zi0(:,3)

      elmt = 0
      counting = 0
      neg(:) = 0
      negativ(:) = 0
      found(:) = 0
c      distance(:) = 0
      do e = 1, nelint

	 count = 0
	 testing(:) = 0
         if (zi0(e,1).lt.(one+tolpt).and.
     &          zi0(e,1).gt.(zero-tolpt)) then
             testing(1) = 1
	     count = count + 1
	 endif
         if (zi0(e,2).lt.(one+tolpt).and.
     &          zi0(e,2).gt.(zero-tolpt)) then
             testing(2) = 1
	     count = count + 1
	 endif
         if (zi0(e,3).lt.(one+tolpt).and.
     &          zi0(e,3).gt.(zero-tolpt)) then
             testing(3) = 1
	     count = count + 1
	 endif
         if ((1-zi0(e,1)-zi0(e,2)-zi0(e,3)).lt.(one+tolpt).and.
     &       (1-zi0(e,1)-zi0(e,2)-zi0(e,3)).gt.(zero-tolpt)) then
             testing(4) = 1
	     count = count + 1
	 endif

         result = 1
	 do i = 1, 4
	    result = result*testing(i)
	 enddo

         if (result .eq. 1) then
             xsic(:) = zi0(e,:)
	     elmt = e

	     return

	 elseif (count .eq. 3) then
	    counting = counting + 1
	    do i = 1, 3
	       if (testing(i) .eq. 0 .and.
     &		       zi0(e,i) .lt. 0.0) then
                  found(counting) = e
		  neg(counting) = zi0(e,i)
		  negativ(counting) = i
c		  distance(counting) = sqrt(zi0(e,1)*zi0(e,1)+
c    &		          zi0(e,2)*zi0(e,2)+zi0(e,3)*zi0(e,3))
	       endif
	    enddo
	    if (testing(4) .eq. 0) then
	       found(counting) = e
	       neg(counting) = 1-zi0(e,1)-zi0(e,2)-zi0(e,3)
	       negativ(counting) = 4
c	       distance(counting) = sqrt(zi0(e,1)*zi0(e,1)+
c     &		       zi0(e,2)*zi0(e,2)+zi0(e,3)*zi0(e,3))
	    endif
	 endif


      enddo

      min = neg(1)
      elmt = found(1)
      find = 1
      do i = 2, counting
         if (min .lt. neg(i)) then
	    min = neg(i)
	    elmt = found(i)
	    find = i
	 endif
      enddo
      if (negativ(find) .eq. 4) then
         prop = zi0(elmt,1)+zi0(elmt,2)+zi0(elmt,3)
	 xsic(:) = zi0(elmt,:) / prop
      else
         xsic(:) = zi0(elmt,:)
         xsic(negativ(find)) = 0.0
      endif
c      call error ('elem_search ', 'outrange', idfile)

      return


      end