program test_iobox
  use yaml_output
  use f_unittests
  implicit none

  character(len = 128) :: path
  integer :: ierr

  call f_lib_initialize()

  call get_command_argument(1, value = path, status = ierr)
  if (ierr /= 0) then
     path = './'
  end if

  call yaml_sequence_open("Tests")
  call run(nofile)
  call run(malformed_header)
  call run(read_header)
  call run(read_astruct)
  call run(read_field)
  call yaml_sequence_close()

  call f_lib_finalize()

contains

  subroutine nofile(label)
    use IObox
    use f_precisions
    implicit none
    character(len = *), intent(out) :: label

    integer, dimension(3) :: ndims
    integer :: nspin
    real(f_double), dimension(3) :: hgrids
    real(f_double), dimension(1,1) :: rho
    
    label = "No file"
    call read_field_dimensions("nofile.cube", 'P', ndims, nspin)
    !call ensure_error()
    call read_field("nofile.cube", 'P', ndims, hgrids, nspin, 1, 1, rho)
    !call ensure_error()
  end subroutine nofile

  subroutine malformed_header(label)
    use IObox
    implicit none
    character(len = *), intent(out) :: label

    integer, dimension(3) :: ndims
    integer :: nspin
    
    label = "Malformed header"
    call read_field_dimensions(trim(path) // "malformed_header.cube", 'P', ndims, nspin)
    !call ensure_error()
  end subroutine malformed_header

  subroutine read_header(label)
    use IObox
    implicit none
    character(len = *), intent(out) :: label

    integer, dimension(3) :: ndims
    integer :: nspin
    
    label = "Read header"
    call read_field_dimensions(trim(path) // "h2o-pot.cube", 'P', ndims, nspin)
    call compare(ndims, (/ 40, 40, 40 /), "n dimensions")
    call compare(nspin, 1)

    call read_field_dimensions(trim(path) // "h2o-pot.cube", 'S', ndims, nspin)
    call compare(ndims, (/ 40, 71, 40 /), "n dimensions")
    call compare(nspin, 1)

    call read_field_dimensions(trim(path) // "h2o-pot.cube", 'F', ndims, nspin)
    call compare(ndims, (/ 71, 71, 71 /), "n dimensions")
    call compare(nspin, 1)
  end subroutine read_header

  subroutine read_astruct(label)
    use IObox, read_field_io => read_field
    use f_precisions
    use dynamic_memory
    implicit none
    character(len = *), intent(out) :: label

    integer, dimension(3) :: ndims
    integer :: nspin, nat
    real(f_double), dimension(3) :: hgrids
    real(f_double), dimension(:, :), allocatable :: rho
    real(f_double), dimension(:, :), pointer :: rxyz
    integer, dimension(:), pointer :: iatypes, znucl
    
    label = "Read astruct"

    call read_field_dimensions(trim(path) // "h2o-pot.cube", 'P', ndims, nspin)
    rho = f_malloc((/ product(ndims), nspin /), id = "rho")
    call read_field_io(trim(path) // "h2o-pot.cube", 'P', ndims, hgrids, nspin, &
         & size(rho, 1), size(rho, 2), rho, nat, rxyz, iatypes, znucl)
    call compare(nat, 3, "number of atoms")
    call verify(associated(iatypes), "iatypes")
    call compare(iatypes, (/ 1, 2, 2 /))
    call verify(associated(znucl), "znucl")
    call compare(znucl, (/ 8, 1 /))
    call verify(associated(rxyz), "rxyz")
    call compare(rxyz(:, 1), (/ 5.488739_f_double, 5.669178_f_double, 5.530722_f_double /))
    call f_free(rho)
    call f_free_ptr(rxyz)
    call f_free_ptr(iatypes)
    call f_free_ptr(znucl)
  end subroutine read_astruct
  
  subroutine read_field(label)
    use IObox, read_field_io => read_field
    use f_precisions
    use dynamic_memory
    implicit none
    character(len = *), intent(out) :: label

    integer, dimension(3) :: ndims
    integer :: nspin
    real(f_double), dimension(3) :: hgrids
    real(f_double), dimension(:, :), allocatable :: rho
    
    label = "Read field"

    call read_field_dimensions(trim(path) // "h2o-pot.cube", 'P', ndims, nspin)
    rho = f_malloc((/ product(ndims), nspin /), id = "rho")
    call read_field_io(trim(path) // "h2o-pot.cube", 'P', ndims, hgrids, nspin, &
         & size(rho, 1), size(rho, 2), rho)
    call compare(hgrids, (/ 0.283459_f_double, 0.283459_f_double, 0.283459_f_double /), "hgrids")
    call compare(rho(1,1), 0.63761E-02_f_double, "rho(1,1)")
    call compare(rho(2,1), 0.66566E-02_f_double, "rho(2,1)")
    call compare(sum(rho) * product(hgrids), 7.508221652419523_f_double, "|rho|")
    call f_free(rho)

    call read_field_dimensions(trim(path) // "h2o-pot.cube", 'S', ndims, nspin)
    rho = f_malloc((/ product(ndims), nspin /), id = "rho")
    call read_field_io(trim(path) // "h2o-pot.cube", 'S', ndims, hgrids, nspin, &
         & size(rho, 1), size(rho, 2), rho)
    call compare(hgrids, (/ 0.283459_f_double, 0.283459_f_double, 0.283459_f_double /), "hgrids")
    call compare(rho(1 + 14 * ndims(1),1), 0.63761E-02_f_double, "rho(1,1)")
    call compare(rho(2 + 14 * ndims(1),1), 0.66566E-02_f_double, "rho(2,1)")
    call compare(sum(rho) * product(hgrids), 7.508221652419523_f_double, "|rho|")
    call f_free(rho)

    call read_field_dimensions(trim(path) // "h2o-pot.cube", 'F', ndims, nspin)
    rho = f_malloc((/ product(ndims), nspin /), id = "rho")
    call read_field_io(trim(path) // "h2o-pot.cube", 'F', ndims, hgrids, nspin, &
         & size(rho, 1), size(rho, 2), rho)
    call compare(hgrids, (/ 0.283459_f_double, 0.283459_f_double, 0.283459_f_double /), "hgrids")
    call compare(rho(1 + 14 * (ndims(1) * ndims(2) + ndims(1) + 1),1), 0.63761E-02_f_double, "rho(1,1)")
    call compare(rho(2 + 14 * (ndims(1) * ndims(2) + ndims(1) + 1),1), 0.66566E-02_f_double, "rho(2,1)")
    call compare(sum(rho) * product(hgrids), 7.508221652419523_f_double, "|rho|")
    call f_free(rho)
  end subroutine read_field

  
!!$  use IObox
!!$  use dynamic_memory
!!$  use yaml_output
!!$  use yaml_strings
!!$  use dictionaries
!!$  use f_precisions
!!$  implicit none
!!$
!!$  character(len = 128) :: arg
!!$  character(len = 1), parameter :: geocode = 'P'
!!$  integer, dimension(3) :: ndims
!!$  integer :: nspin, ierr, nat, iat
!!$  real(f_double), dimension(3) :: hgrids
!!$  real(f_double), dimension(:, :), allocatable :: rho
!!$
!!$  call f_lib_initialize()
!!$
!!$  call get_command_argument(1, value = arg, status = ierr)
!!$  if (ierr /= 0) then
!!$     call f_err_throw('Error in get_command_argument, ierr='//trim(yaml_toa(ierr)))
!!$  end if
!!$
!!$  call read_field_dimensions(trim(arg), geocode, ndims, nspin)
!!$  call yaml_mapping_open(trim(arg))
!!$  call yaml_map("geocode", geocode)
!!$  call yaml_map("dimensions", ndims)
!!$  call yaml_map("nspin", nspin)
!!$
!!$  rho = f_malloc((/ product(ndims), nspin /), id = "rho")
!!$
!!$  call read_field(trim(arg), geocode, ndims, hgrids, nspin, size(rho, 1), size(rho, 2), rho, &
!!$       & nat, rxyz, iatypes, znucl)
!!$  call yaml_map("rho(1~7)", rho(1:7, 1), fmt = "(1pe13.6)")
!!$
!!$  call yaml_map("norm", sum(rho) * product(hgrids))
!!$
!!$  call f_free(rho)
!!$
!!$  call yaml_sequence_open("astruct")
!!$  do iat = 1, nat
!!$     call yaml_map(yaml_toa(znucl(iatypes(iat))), rxyz(:, iat))
!!$  end do
!!$  call yaml_sequence_close()
!!$
!!$  call f_free_ptr(rxyz)
!!$  call f_free_ptr(iatypes)
!!$  call f_free_ptr(znucl)
!!$  
!!$  call yaml_mapping_close()
!!$
!!$  call f_lib_finalize()
end program test_iobox
