compute_normals.f90

!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!                                                                              |
!              ||===\\                                                         | 
!              ||    \\                                                        |
!              ||     ||   //==\\   ||  ||   //==||  ||/==\\                   |
!              ||     ||  ||    ||  ||  ||  ||   ||  ||    ||                  |
!              ||    //   ||    ||  ||  ||  ||   ||  ||                        |
!              ||===//     \\==//    \\==\\  \\==\\  ||                        |
!                                                                              |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!                                                                              |
!              COMPUTE_NORMALS    Apr. 2007                                    |
!                                                                              |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|

subroutine compute_normals (ns,x,y,z,nt,icon,xn,yn,zn)

!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine  ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
! given a set of points, and a connectivity array of their triangulation,
! this routine computes the normal to each point through cross-products:
! at first one computes the normal to each triangle and add the vector to the 
! three points that make the triangle
! then one loops over the points, and normalises the vectors.

!------------------------------------------------------------------------------|
!((((((((((((((((  declaration of the subroutine arguments  ))))))))))))))))))))
!------------------------------------------------------------------------------|

!use mpi

implicit none

include 'mpif.h'

integer ns
double precision x(ns),y(ns),z(ns)
integer nt
integer icon(3,nt)
double precision xn(ns),yn(ns),zn(ns)

!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|

integer i,i1,i2,i3,ij,k
integer iproc,nproc,ierr
integer, dimension(:),allocatable :: nb
double precision x1,x2,x3
double precision y1,y2,y3
double precision z1,z2,z3
double precision xne,yne,zne
double precision xyzn

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------

call mpi_comm_size (mpi_comm_world,nproc,ierr)
call mpi_comm_rank (mpi_comm_world,iproc,ierr)

allocate(nb(ns))
nb=0

xn=0.d0
yn=0.d0
zn=0.d0
do i=1,nt
   i1=icon(1,i)
   i2=icon(2,i)
   i3=icon(3,i)
   x1=x(i1)
   x2=x(i2)
   x3=x(i3)
   y1=y(i1)
   y2=y(i2)
   y3=y(i3)
   z1=z(i1) 
   z2=z(i2) 
   z3=z(i3) 
   xne=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1)
   yne=(z2-z1)*(x3-x1)-(z3-z1)*(x2-x1)
   zne=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1)
   xyzn=sqrt(xne**2+yne**2+zne**2)
   xne=xne/xyzn
   yne=yne/xyzn
   zne=zne/xyzn
   do k=1,3
      ij=icon(k,i)
      xn(ij)=xn(ij)+xne
      yn(ij)=yn(ij)+yne
      zn(ij)=zn(ij)+zne
      nb(ij)=nb(ij)+1
   enddo
enddo
do i=1,ns
   xyzn=sqrt(xn(i)**2+yn(i)**2+zn(i)**2)
   xn(i)=xn(i)/xyzn
   yn(i)=yn(i)/xyzn
   zn(i)=zn(i)/xyzn
enddo

if (minval(nb).eq.0) then
   do i=1,ns
      if (nb(i).eq.0.and.iproc.eq.0) then
         write (8,*) 'Particle ',i,' at ',x(i),y(i),z(i),' not connected'
      end if
   enddo
   call stop_run ('error in compute_normals_from_triangles$')
else
   if (iproc.eq.0) then
      write(8,*) 'in compute_normals_from_triangles:'
      write(8,*) 'minval(nb)=',minval(nb),' neighbours'
      write(8,*) 'maxval(nb)=',maxval(nb),' neighbours'
   end if            
end if

deallocate(nb)

return
end

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------