module Assertions

  ! ------------------------------------------------------------------------
  ! !DESCRIPTION:
  ! This module contains various assertion methods that can be used in self-tests
  !
  ! When an assertion fails, it will call endrun

  use shr_kind_mod, only : r8 => shr_kind_r8, i4 => shr_kind_i4
  use abortutils, only : endrun
  use clm_varctl, only : iulog

  implicit none
  private
  save

  public :: assert_equal

  interface assert_equal
     !TYPE double,int,logical
     module procedure assert_equal_1d_{TYPE}

     !TYPE double,int,logical
     module procedure assert_equal_2d_{TYPE}

     !TYPE double,int,logical
     module procedure assert_equal_3d_{TYPE}
  end interface assert_equal

  interface vals_are_equal
     !TYPE double,int,logical
     module procedure vals_are_equal_{TYPE}
  end interface vals_are_equal

contains

  !-----------------------------------------------------------------------
  !TYPE double,int,logical
  subroutine assert_equal_1d_{TYPE}(expected, actual, msg, abs_tol)
    !
    ! !DESCRIPTION:
    ! Assert 1-d arrays are equal
    !
    ! !ARGUMENTS:
    {VTYPE}, intent(in) :: expected(:)
    {VTYPE}, intent(in) :: actual(:)
    character(len=*), intent(in) :: msg

    ! absolute tolerance; if not specified, require exact equality; ignored for logicals
    real(r8), intent(in), optional :: abs_tol
    !
    ! !LOCAL VARIABLES:
    integer :: i

    character(len=*), parameter :: subname = 'assert_equal_1d_{TYPE}'
    !-----------------------------------------------------------------------

    if (any(shape(actual) /= shape(expected))) then
       write(iulog,*) 'ERROR in assert_equal: ', msg
       write(iulog,*) 'Shape mismatch:'
       write(iulog,*) 'Actual shape:   ', shape(actual)
       write(iulog,*) 'Expected shape: ', shape(expected)
       call endrun('ERROR in assert_equal')
    end if

    do i = 1, size(expected, 1)
       if (.not. vals_are_equal(actual(i), expected(i), abs_tol)) then
          write(iulog,*) 'ERROR in assert_equal: ', msg
          write(iulog,*) 'Data mismatch: first mismatch at index: ', i
          write(iulog,*) 'Actual  : ', actual(i)
          write(iulog,*) 'Expected: ', expected(i)
          call endrun('ERROR in assert_equal')
       end if
    end do

  end subroutine assert_equal_1d_{TYPE}

  !-----------------------------------------------------------------------
  !TYPE double,int,logical
  subroutine assert_equal_2d_{TYPE}(expected, actual, msg, abs_tol)
    !
    ! !DESCRIPTION:
    ! Assert 2-d arrays are equal
    !
    ! !ARGUMENTS:
    {VTYPE}, intent(in) :: expected(:,:)
    {VTYPE}, intent(in) :: actual(:,:)
    character(len=*), intent(in) :: msg

    ! absolute tolerance; if not specified, require exact equality; ignored for logicals
    real(r8), intent(in), optional :: abs_tol
    !
    ! !LOCAL VARIABLES:
    integer :: i, j

    character(len=*), parameter :: subname = 'assert_equal_2d_{TYPE}'
    !-----------------------------------------------------------------------

    if (any(shape(actual) /= shape(expected))) then
       write(iulog,*) 'ERROR in assert_equal: ', msg
       write(iulog,*) 'Shape mismatch:'
       write(iulog,*) 'Actual shape:   ', shape(actual)
       write(iulog,*) 'Expected shape: ', shape(expected)
       call endrun('ERROR in assert_equal')
    end if

    do j = 1, size(expected, 2)
       do i = 1, size(expected, 1)
          if (.not. vals_are_equal(actual(i,j), expected(i,j), abs_tol)) then
             write(iulog,*) 'ERROR in assert_equal: ', msg
             write(iulog,*) 'Data mismatch: first mismatch at index: ', i, j
             write(iulog,*) 'Actual  : ', actual(i,j)
             write(iulog,*) 'Expected: ', expected(i,j)
             call endrun('ERROR in assert_equal')
          end if
       end do
    end do

  end subroutine assert_equal_2d_{TYPE}

  !-----------------------------------------------------------------------
  !TYPE double,int,logical
  subroutine assert_equal_3d_{TYPE}(expected, actual, msg, abs_tol)
    !
    ! !DESCRIPTION:
    ! Assert 3-d arrays are equal
    !
    ! !ARGUMENTS:
    {VTYPE}, intent(in) :: expected(:,:,:)
    {VTYPE}, intent(in) :: actual(:,:,:)
    character(len=*), intent(in) :: msg

    ! absolute tolerance; if not specified, require exact equality; ignored for logicals
    real(r8), intent(in), optional :: abs_tol
    !
    ! !LOCAL VARIABLES:
    integer :: i, j, k

    character(len=*), parameter :: subname = 'assert_equal_3d_{TYPE}'
    !-----------------------------------------------------------------------

    if (any(shape(actual) /= shape(expected))) then
       write(iulog,*) 'ERROR in assert_equal: ', msg
       write(iulog,*) 'Shape mismatch:'
       write(iulog,*) 'Actual shape:   ', shape(actual)
       write(iulog,*) 'Expected shape: ', shape(expected)
       call endrun('ERROR in assert_equal')
    end if

    do k = 1, size(expected, 3)
       do j = 1, size(expected, 2)
          do i = 1, size(expected, 1)
             if (.not. vals_are_equal(actual(i,j,k), expected(i,j,k), abs_tol)) then
                write(iulog,*) 'ERROR in assert_equal: ', msg
                write(iulog,*) 'Data mismatch: first mismatch at index: ', i, j, k
                write(iulog,*) 'Actual  : ', actual(i,j,k)
                write(iulog,*) 'Expected: ', expected(i,j,k)
                call endrun('ERROR in assert_equal')
             end if
          end do
       end do
    end do

  end subroutine assert_equal_3d_{TYPE}

  !-----------------------------------------------------------------------
  !TYPE double,int,logical
  function vals_are_equal_{TYPE}(actual, expected, abs_tol) result(vals_equal)
    !
    ! !DESCRIPTION:
    ! Returns true if actual is the same as expected, false otherwise
    !
    ! !ARGUMENTS:
    logical :: vals_equal  ! function result
    {VTYPE}, intent(in) :: actual
    {VTYPE}, intent(in) :: expected

    ! absolute tolerance; if not specified, require exact equality; ignored for logicals
    real(r8), intent(in), optional :: abs_tol
    !
    ! !LOCAL VARIABLES:
    real(r8) :: abs_tol_loc  ! local version of abs_tol

    character(len=*), parameter :: subname = 'vals_are_equal_{TYPE}'
    !-----------------------------------------------------------------------

#if ({ITYPE}==TYPELOGICAL)
    vals_equal = (actual .eqv. expected)
#else
    if (present(abs_tol)) then
       abs_tol_loc = abs_tol
    else
       abs_tol_loc = 0._r8
    end if

    vals_equal = (abs(actual - expected) <= abs_tol_loc)
#endif

  end function vals_are_equal_{TYPE}

end module Assertions