!===============================================================================
!
! MODULE:
!
! tile_m                                          Last Modified: Dec/2012 (FHJ)
!
!>  Tiling and tessellation routines for the R^2/R^3. Currently, only Delaunay 
!!  triangulation is available, but Voronoi tessellation should be added soon.
!
! DESCRIPTION:
!
!   This module is an abstraction layer that provides tessellation methods in
!   arbitrary dimensions. The "API" declared here (in the `contains` section)
!   should be generic, and the methods may be implemented by in external 
!   libraries. In this case, please write appropriate wrappers so that the
!   routines declared here do not depend on the technical details of the
!   external back end.
!
!   We currently use Qhull as the back end for the Delaunay tessellation.
!
!===============================================================================

#include "f_defs.h"

module tile_m

  use global_m

  implicit none

  public :: &
#ifdef USEVORO
    pts2bz, &
#endif
    init_delaunay, &
    find_delaunay_simplex, &
    get_num_simplices, &
    get_simplices, &
    get_neighbors, &
    free_delaunay

  private
  
  interface

    !---------------------------------------------------------------------------
    ! FHJ: these tessellation functions are implemented in qhull/libtile_qhull.a

    integer function qhull_init_delaunay(points, num_points, dimensions, inode)
      implicit none
      real(8), intent(in) :: points
      integer, intent(in) :: num_points
      integer, intent(in) :: dimensions
      integer, intent(in) :: inode
    end function qhull_init_delaunay

    integer function qhull_find_delaunay_simplex(point, indices, coefs)
      implicit none
      real(8), intent(in) :: point
      integer, intent(out) :: indices
      real(8), intent(out) :: coefs
    end function qhull_find_delaunay_simplex

    integer function qhull_get_num_simplices(num_simplices)
      implicit none
      integer, intent(out) :: num_simplices
    end function qhull_get_num_simplices

    integer function qhull_get_simplices(indices)
      implicit none
      integer, intent(out) :: indices
    end function qhull_get_simplices

    integer function qhull_get_neighbors(neighbors)
      implicit none
      integer, intent(out) :: neighbors
    end function qhull_get_neighbors

    integer function qhull_free_delaunay()
      implicit none
    end function qhull_free_delaunay

#ifdef USEVORO
    !---------------------------------------------------------------------------
    ! FHJ: this function is implemented in voro/libtile_voro.a

    integer function voro_pts2bz(M, pts_cart, npts, umks)
      implicit none
      real(8), intent(in) :: M
      real(8), intent(in) :: pts_cart
      integer, intent(in) :: npts
      integer, intent(out) :: umks
    end function voro_pts2bz

    !---------------------------------------------------------------------------
#endif

  end interface

contains

  !> Calculates the Delaunay triangulation/tetrahedralization of a set of points.
  !!
  !! For performance issues, only one Delaunay triangulation can be active at
  !! a given time.
  !!
  !! \param points [inout] coarse points (dim, npts)
  !! \param num_points [in] number of points.
  !! \param dim [in] number of dimensions
  !! \return 0 for success
  integer function init_delaunay(points, num_points, dimensions)
    real(DP), intent(in) :: points(:,:)
    integer, intent(in) :: num_points
    integer, intent(in) :: dimensions
    
    PUSH_SUB(init_delaunay)
    init_delaunay = qhull_init_delaunay(points(1,1), num_points, dimensions, peinf%inode)
    POP_SUB(init_delaunay)
    return

  end function init_delaunay

  !> Finds the Delaunay triangle/tetrahedron that encloses point.
  !!
  !! \param point [in] real array (dim) containing the coordinates.
  !! \param indices [out] integer array (dim+1) with the indices of the vertices.
  !! \param coefs [out] coefficients of point in barycentric coordinates.
  integer function find_delaunay_simplex(point, indices, coefs)
    real(DP), intent(in) :: point(:)
    integer, intent(out) :: indices(:)
    real(DP), intent(out) :: coefs(:)

    PUSH_SUB(find_delaunay_simplex)
    find_delaunay_simplex = qhull_find_delaunay_simplex(point(1), indices(1), coefs(1))
    POP_SUB(find_delaunay_simplex)
    return

  end function find_delaunay_simplex

  !> Returns the total number of simplices obtained from the Delaunay
  !! triangulation.
  !!
  !! \param num_simplices [out] number of simplices.
  integer function get_num_simplices(num_simplices)
    integer, intent(out) :: num_simplices

    PUSH_SUB(get_num_simplices)
    get_num_simplices = qhull_get_num_simplices(num_simplices)
    POP_SUB(get_num_simplices)
    return

  end function get_num_simplices

  !> Returns the indices of the points that define each simplex.
  !!
  !! \param simplices [out] (ndims+1, num_simplices) Vertex ivert of
  !! simplex isimp corresponds to the point simplices(ivert,isimp) of
  !! the original list of points.
  integer function get_simplices(simplices)
    integer, intent(out) :: simplices(:,:)

    PUSH_SUB(get_simplices)
    get_simplices = qhull_get_simplices(simplices(1,1))
    POP_SUB(get_simplices)
    return

  end function get_simplices

  !> Returns the indices of the neighbors for each simplex.
  !!
  !! \param neighbors [out] (ndims+1, num_simplices) The neighbor ivert
  !! of simplex isimp is neighbors(ivert,isimp), and corresponds to the
  !! simplex reached by following the ridge opposite to vertex ivert.
  integer function get_neighbors(neighbors)
    integer, intent(out) :: neighbors(:,:)

    PUSH_SUB(get_neighbors)
    get_neighbors = qhull_get_neighbors(neighbors(1,1))
    POP_SUB(get_neighbors)
    return

  end function get_neighbors

  !> Frees buffers associated to the Delaunay triangulation.
  integer function free_delaunay()

    PUSH_SUB(free_delaunay)
    free_delaunay = qhull_free_delaunay()
    POP_SUB(free_delaunay)
    return

  end function free_delaunay

#ifdef USEVORO
  !> Puts points into Brillouin Zone
  !!
  !! \param bdot [in] (3,3) reciprocal metric
  !! \param pts_crys [in] (3,npts) input points, in crystal coords
  !! \param umks [out] (3,npts) umklapp vectors, defined such that:
  !!   pts_crys_bz = pts_crys + umks
  subroutine pts2bz(bdot, pts_crys, umks)
    real(DP), intent(in) :: bdot(3,3)
    real(DP), intent(in) :: pts_crys(:,:)
    integer, intent(out) :: umks(:,:)

    real(DP), parameter :: FX=1d0+1d-12, FY=1d0+1d-13, FZ=1d0+1d-14
    real(DP) :: xx, xy, xz, yy, yz, zz, M(6)
    real(DP), allocatable :: pts_cart(:,:)
    integer :: npts, ierr

    PUSH_SUB(pts2bz)

#if defined(VERBOSE) && defined(DEBUG)
    write(6,*) 'BDOT'
    write(6,'(3(f12.9,1x))') bdot
#endif

    ! FHJ: Cholesky decomposition of the metric, required by voro++
    xx = sqrt(bdot(1,1))
    xy = bdot(2,1)/xx
    xz = bdot(3,1)/xx
    yy = sqrt(bdot(2,2)-xy*xy)
    yz = (bdot(3,2)-xy*xz)/yy
    zz = sqrt(bdot(3,3)-(xz*xz+xy*xy))
    M = (/xx, xy, yy, xz, yz, zz/)

    npts = size(pts_crys, 2)
    SAFE_ALLOCATE(pts_cart, (3,npts))
    ! FHJ: We slightly shift the crystal coords to make the umklapp vectors unique
    pts_cart(1,:) = xx*(pts_crys(1,:)*FX) + xy*(pts_crys(2,:)*FY) + xz*(pts_crys(3,:)*FZ)
    pts_cart(2,:) = yy*(pts_crys(2,:)*FY) + yz*(pts_crys(3,:)*FZ)
    pts_cart(3,:) = zz*(pts_crys(3,:)*FZ)

#if defined(VERBOSE) && defined(DEBUG)
    write(6,'(a,f12.9)') 'xx=',xx
    write(6,'(a,f12.9)') 'xy=',xy
    write(6,'(a,f12.9)') 'xz=',xz
    write(6,'(a,f12.9)') 'yy=',yy
    write(6,'(a,f12.9)') 'yz=',yz
    write(6,'(a,f12.9)') 'zz=',zz
    write(6,*) 'M'
    write(6,'(6(f12.9,1x))') M
#endif

    ierr = voro_pts2bz(M(1), pts_cart(1,1), npts, umks(1,1))
    SAFE_DEALLOCATE(pts_cart)

    POP_SUB(pts2bz)

  end subroutine pts2bz
#endif

end module tile_m
