program test_domain
  use yaml_output
  use f_unittests
  implicit none

  call f_lib_initialize()

  call yaml_sequence_open("Tests")
  call run(creator)
  call run(dict_conversions)
  call run(geometry_operations)
  call yaml_sequence_close()
  
  call f_lib_finalize()

contains

  function is_unity_matrix(mat, tol) result(unity)
    use f_precisions, gp=>f_double
    implicit none
    real(gp), dimension(3,3), intent(in) :: mat
    real(gp), intent(in), optional :: tol
    real(gp), dimension(9), parameter :: I = (/ 1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0 /)
    logical :: unity

    if (.not. present(tol)) then
       unity = all(mat - reshape(I, (/ 3, 3 /)) == 0d0)
    else
       unity = all(abs(mat - reshape(I, (/ 3, 3 /))) < tol)
    end if
  end function is_unity_matrix

  function mat_mult(A, B) result(C)
    use f_precisions, gp=>f_double
    implicit none
    real(gp), dimension(3,3), intent(in) :: A, B
    real(gp), dimension(3,3) :: C
    integer i, j, k

    C = 0d0
    do i = 1, 3
       do j = 1, 3
          do k = 1, 3
             C(i, j) = C(i, j) + A(i, k) * B(k, j)
          end do
       end do
    end do
  end function mat_mult

  subroutine creator(label)
    use f_precisions, gp=>f_double
    use at_domain
    use f_enums
    use numerics, only: pi
    implicit none
    character(len = *), intent(out) :: label

    type(domain) :: dom
    real(gp), dimension(3) :: acell

    label = "Creator"
    
    dom = domain_null()
    call verify(dom%units == -100, "unset units")
    call verify(dom%orthorhombic, "default to orthorhombic")
    call verify(all(dom%bc == -100), "unset boundary conitions")
    call verify(all(dom%angrad == 0d0), "null angles")
    call verify(all(dom%abc == 0d0), "null cell matrix")
    call verify(all(dom%uabc == 0d0), "null cell matrix")
    call verify(all(dom%acell == 0d0), "null cell size")
    call verify(all(dom%gd == 0d0), "null passage matrix")
    call verify(all(dom%gu == 0d0), "null inverse passage matrix")
    call verify(dom%detgd == 0d0, "null determinant")

    dom = domain_new(ANGSTROEM_UNITS, (/ FREE_BC, FREE_BC, FREE_BC /))
    call verify(dom%units == toi(ANGSTROEM_UNITS), "units")
    call verify(dom%orthorhombic, "orthorhombic")
    call verify(domain_geocode(dom) == "F", "boundary conditions")
    call verify(all(dom%angrad == .5 * pi), "angles")
    call verify(is_unity_matrix(dom%gd), "covariant matrix")
    call verify(is_unity_matrix(dom%gu), "contravariant matrix")
    call verify(dom%detgd == 1d0, "determinant")
    call verify(all(dom%acell == 0d0), "cell size")
    call verify(all(dom%abc == 0d0), "cell matrix")
    call verify(is_unity_matrix(dom%uabc), "cell matrix")
    call verify(is_unity_matrix(dom%uabci), "inverse cell matrix")

    acell = (/ 2d0, 0d0, 3d0 /)
    dom = domain_new(NANOMETER_UNITS, (/ PERIODIC_BC, FREE_BC, PERIODIC_BC /), &
         acell = acell, beta_ac = pi / 3d0)
    call to_unit(acell, NANOMETER_UNITS, ATOMIC_UNITS)
    call verify(dom%units == toi(NANOMETER_UNITS), "units")
    call verify(.not. dom%orthorhombic, "orthorhombic")
    call verify(domain_geocode(dom) == "S", "boundary conditions")
    call verify(all(dom%angrad == (/ .5d0 * pi, pi / 3d0, .5d0 * pi /)), "angles")
    call verify(all(dom%acell == acell), "cell size")
    call verify(is_unity_matrix(mat_mult(dom%gd, dom%gu), tol = 1d-12), "co/contravariant matrices in surface BC")
    call verify(is_unity_matrix(mat_mult(dom%uabc, dom%uabci), tol = 1d-12), "cell matrices in surface BC")

    acell = (/ 2d0, 1d0, 3d0 /)
    dom = domain_new(ATOMIC_UNITS, (/ PERIODIC_BC, PERIODIC_BC, PERIODIC_BC /), &
         acell = acell, alpha_bc = pi / 3d0, beta_ac = pi / 3d0, gamma_ab = pi / 3d0)
    call verify(dom%units == toi(ATOMIC_UNITS), "units")
    call verify(.not. dom%orthorhombic, "orthorhombic")
    call verify(domain_geocode(dom) == "P", "boundary conditions")
    call verify(all(dom%angrad == pi / 3d0), "angles")
    call verify(all(dom%acell == acell), "cell size")
    call verify(is_unity_matrix(mat_mult(dom%gd, dom%gu), tol = 1d-12), "co/contravariant matrices in periodic BC")
    call verify(is_unity_matrix(mat_mult(dom%uabc, dom%uabci), tol = 1d-12), "cell matrices in periodic BC")
  end subroutine creator
  
  subroutine dict_conversions(label)
    use at_domain
    use dictionaries
    use numerics, only: pi
    implicit none
    character(len = *), intent(out) :: label

    type(domain) :: dom, dom2
    type(dictionary), pointer :: dict

    label = "Conversions with dictionnaries"

    dom = domain_new(ANGSTROEM_UNITS, (/ FREE_BC, FREE_BC, FREE_BC /))
    dict => dict_new()
    call domain_merge_to_dict(dict, dom)
    call verify(DOMAIN_UNITS .in. dict, "units in free boundary conditions")
    call compare(dict // DOMAIN_UNITS, "angstroem", "unit value in free boundary conditions")
    call verify(.not. (DOMAIN_CELL .in. dict), "no cell in free boundary conditions")
    dom2 = domain_null()
    call domain_set_from_dict(dict, dom2)
    call verify(dom == dom2, "set from dict in free boundary conditions")
    call dict_free(dict)

    dom = domain_new(NANOMETER_UNITS, (/ PERIODIC_BC, FREE_BC, PERIODIC_BC /), &
         acell = (/ 2d0, 0d0, 3d0 /), beta_ac = pi / 3d0)
    dict => dict_new()
    call domain_merge_to_dict(dict, dom)
    call verify(DOMAIN_UNITS .in. dict, "units in surface boundary conditions")
    call compare(dict // DOMAIN_UNITS, "nanometer", "unit value in surface boundary conditions")
    call verify(DOMAIN_CELL .in. dict, "cell in surface boundary conditions")
    call compare(dict // DOMAIN_CELL // 0, "2.0", "cell(1) in surface boundary conditions")
    call compare(dict // DOMAIN_CELL // 1, ".inf", "cell(2) in surface boundary conditions")
    call compare(dict // DOMAIN_CELL // 2, "3.0", "cell(3) in surface boundary conditions")
    call verify(.not. (DOMAIN_ALPHA .in. dict), "no alpha in surface boundary conditions")
    call verify(.not. (DOMAIN_GAMMA .in. dict), "no gamma in surface boundary conditions")
    call verify(DOMAIN_BETA .in. dict, "beta in surface boundary conditions")
    call compare(dict // DOMAIN_BETA, 60d0, "beta value in surface boundary conditions", tol = 1d-11)
    dom2 = domain_null()
    call domain_set_from_dict(dict, dom2)
    call verify(dom == dom2, "set from dict in surface boundary conditions")
    call dict_free(dict)
  end subroutine dict_conversions
  
  subroutine geometry_operations(label)
    use f_precisions, gp=>f_double
    use at_domain
    use numerics, only: pi
    implicit none
    character(len = *), intent(out) :: label

    type(domain) :: dom
    real(gp), dimension(3, 2) :: rxyz, rxyz0

    label = "Geometry operations"

    rxyz(:, 1) = (/ 0d0, 0d0, 0d0 /)
    rxyz(:, 2) = (/ 10d0, 7d0, 9d0 /)
    rxyz0 = rxyz
    dom = domain_new(ATOMIC_UNITS, (/ FREE_BC, FREE_BC, FREE_BC /))
    call domain_fold_into(dom, rxyz)
    call compare(rxyz, rxyz0, "no folding in free boundary conditions")
    
    dom = domain_new(ATOMIC_UNITS, (/ PERIODIC_BC, PERIODIC_BC, PERIODIC_BC /), &
         acell = (/ 5d0, 4d0, 3d0 /))
    call domain_fold_into(dom, rxyz)
    call compare(rxyz(:,1), rxyz0(:,1), "no folding when in box")
    call compare(rxyz(:,2), (/ 0d0, 3d0, 0d0 /), "folding in orthorhombic case")

    rxyz0(:, 1) = (/ 0d0, 0d0, 0d0 /)
    rxyz0(:, 2) = (/ 6.75d0, 5d0, sqrt(3d0)*9d0/4d0 /)
    rxyz = rxyz0
    dom = domain_new(ATOMIC_UNITS, (/ PERIODIC_BC, FREE_BC, PERIODIC_BC /), &
         acell = (/ 3d0, 4d0, 3d0 /), beta_ac = pi / 3d0)
    call domain_fold_into(dom, rxyz, iscart = .true.)
    call compare(rxyz(:,1), rxyz0(:,1), "no folding when in box")
    call compare(rxyz(:,2), (/ 2.25d0, 5d0, sqrt(3d0)*3d0/4d0 /), "folding in non orthorhombic surface case", tol = 1d-12)

    dom = domain_new(ATOMIC_UNITS, (/ PERIODIC_BC, PERIODIC_BC, PERIODIC_BC /), &
         acell = (/ 3d0, 3d0, 3d0 /), alpha_bc = pi / 3d0, beta_ac = pi / 3d0, gamma_ab = pi / 3d0)
    rxyz0(:, 1) = (/ 0d0, 0d0, 0d0 /)
    rxyz0(:, 2) = rxyz_ortho(dom, (/ 1d0, 1.5d0, 2d0 /))
    rxyz = rxyz0
    rxyz(:, 2) = rxyz(:, 2) + rxyz_ortho(dom, (/ 3d0, 6d0, 9d0 /))
    call domain_fold_into(dom, rxyz, iscart = .true.)
    call compare(rxyz(:,1), rxyz0(:,1), "no folding when in box")
    call compare(rxyz(:,2), rxyz0(:, 2), "folding in non orthorhombic periodic case", tol = 1d-12)
  end subroutine geometry_operations

end program test_domain
