!==============================================================================
!
!  test_delaunay_f        Originally by FHJ     Last Modified 12/04/2012 (FHJ)
!
!    A simple Fortran program that tests the BerkeleyGW bindings for Qhull.
!
!    This file is part of the BerkeleyGW package.
!
!==============================================================================

#include "f_defs.h"

program test_delaunay_f

  use global_m
  use tile_m
  implicit none

  integer ::  n_nei, dim_, npts, nrep
  integer :: ip, idim_, div, rem
  integer, allocatable ::  indices(:), base(:)
  real(DP), allocatable :: points(:,:), pt(:), coefs(:)
  logical :: show_coords = .true.;
  integer :: ierr
  
  PUSH_SUB(test_delaunay_f)

  !TODO: make this configurable!
  write(6,'(a)') "Testing libtile_qhull - Fortran bindings."
  nrep = 1000
  dim_ = 3
  n_nei = 8
  npts = n_nei ** dim_
  
  write(6,'(a,i1)') "Dimensions: ", dim_
  write(6,'(a,i6,a,i1)') "Mesh size : ",n_nei,"^",dim_
  SAFE_ALLOCATE(points, (dim_, npts))
  SAFE_ALLOCATE(base, (dim_))
  ! To work in arbitrary dimensions, we notice that we can assign each
  !axis a number = (# neighbors)^(axis number)
  base(dim_) = 1
  do idim_ = dim_-1, 1, -1
    base(idim_) = n_nei * base(idim_+1)
  enddo
  do ip = 1, npts
    rem = ip-1
    do idim_ = 1, dim_
      div = rem / base(idim_)
      points(idim_, ip) = div / dble(n_nei)
      rem = rem - div * base(idim_)
    enddo
  enddo
  SAFE_DEALLOCATE(base)

  if (show_coords) then
    write(6,'(/,a)') "Input coordinates:";
    do ip = 1, npts
      call print_vect(ip, points(:,ip), dim_)
    enddo
  endif

  SAFE_ALLOCATE(indices, (dim_+1))
  SAFE_ALLOCATE(coefs, (dim_+1))
  SAFE_ALLOCATE(pt, (dim_))
  pt(:) = 0
  pt(1) = 0.125d0
  pt(2) = 0.75d0
  write(6,'(/,a)') "Test coordinate:"
  call print_vect(0, pt, dim_)
  write(6,*)

  write(6,'(a)') "Calling init_delaunay."
  ierr = init_delaunay(points, npts, dim_)
  write(6,'(a,i8,a)') "Calling find_delaunay_simplex ", nrep, " times."
  do ip = 1, nrep
    ierr = find_delaunay_simplex(pt, indices, coefs)
  enddo
  write(6,'(a)') "Calling free_delaunay."
  ierr = free_delaunay()

  write(6,'(/,a)') "Found vertices:"
  do ip = 1, dim_+1
    call print_vect(indices(ip), points(:,indices(ip)), dim_)
  enddo
  write(6,'(/,a)',advance='no') "Coefficients: "
  call print_vect(-1, coefs, dim_+1)

  SAFE_DEALLOCATE(indices)
  SAFE_DEALLOCATE(coefs)
  SAFE_DEALLOCATE(pt)
  SAFE_DEALLOCATE(points)
  write(6,'(/,a)') "All Done!"

  POP_SUB(test_delaunay_f)

  contains

    subroutine print_vect(id, vec, dims)

      integer, intent(in) :: id
      real(DP), intent(in) :: vec(:)
      integer, intent(in) :: dims

      integer :: jdim_

      PUSH_SUB(print_vect)

      if (id>=0) write(6,'(1x,i4,1x)',advance='no') id
      do jdim_ = 1, dims
        write(6,'(f5.3,1x)',advance='no') vec(jdim_)
      enddo
      write(6,*)

      POP_SUB(print_vect)

    end subroutine print_vect

end program test_delaunay_f
