! Module  : utest_cubint_m
! Purpose : Testing routines for utest_cubint_m
!
! Copyright 2021-2022 Rich Townsend & The MSG Team
!
! This file is part of MSG. MSG is free software: you can redistribute
! it and/or modify it under the terms of the GNU General Public
! License as published by the Free Software Foundation, version 3.
!
! MSG is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
! License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program.  If not, see <http://www.gnu.org/licenses/>.

#:include 'forum.inc'

module utest_cubint_m

  ! Uses

  use forum_m

  use cubint_m

  use ISO_FORTRAN_ENV

  ! No implicit typing

  implicit none

  ! Access specifiers

  private

  public :: test

contains

   subroutine test ()

      call test_cubint_()

   end subroutine test

   !****

   subroutine test_cubint_()

      integer, parameter :: n_x = 5
      integer, parameter :: n_over = 50
      integer, parameter :: n_x_int = n_over*(n_x-1) + 1

      real(RD)       :: x(n_x)
      real(RD)       :: f(n_x)
      real(RD)       :: df_dx(n_x)
      real(RD)       :: x_int(n_x_int)
      real(RD)       :: f_int(n_x_int)
      real(RD)       :: df_dx_int(n_x_int)
      real(RD)       :: int_f_int(n_x_int)
      real(RD)       :: f_chk(n_x_int)
      real(RD)       :: df_dx_chk(n_x_int)
      real(RD)       :: int_f_chk(n_x_int)
      type(cubint_t) :: ci
      
      call cubint_arrange_()
      call cubint_act_()
      call cubint_assert_()

      ! Finish

      return

   contains

      subroutine cubint_arrange_()

         integer :: i
         integer :: m

         ! Set up the function

         do i = 1, n_x

            x(i) = i-1

            call eval_cubic_(x(i), f(i), df_dx(i))

         end do

         ! Set up the interpolation abscissa

         do i = 1, n_x-1
            do m = 1, n_over
               x_int(n_over*(i-1)+m) = x(i) + (x(i+1) - x(i))*(m-1)/n_over
            end do
         end do

         x_int(n_x_int) = x(n_x)

         ! Finish

         return

      end subroutine cubint_arrange_

      !****

      subroutine cubint_act_()

         integer :: i
         integer :: m

         ! Set up the cubic interpolant

         ci = cubint_t(x, f, df_dx)

         do i = 1, n_x_int

            ! Interpolate

            f_int(i) = ci%func(x_int(i))
            df_dx_int(i) = ci%deriv(x_int(i))
            int_f_int(i) = ci%integ(x_int(i))

            ! Evaluate

            call eval_cubic_(x_int(i), f_chk(i), df_dx_chk(i), int_f_chk(i))

         end do
         
         ! Finish

         return

      end subroutine cubint_act_

      !****

      subroutine cubint_assert_()

         real(RD), parameter :: tol = 1E-14_RD

         real(RD), allocatable :: f_err(:)
         real(RD), allocatable :: df_dx_err(:)
         real(RD), allocatable :: int_f_err(:)

         f_err = (f_int - f_chk)/f_chk
         df_dx_err = (df_dx_int - df_dx_chk)/f_chk
         int_f_err = (int_f_int - int_f_chk)/f_chk

         if (ALL(ABS(f_err) < tol)) then
            print *,'  PASS f'
         else
            print *,'  FAIL f:', MAXVAL(ABS(f_err)), '>', tol
         end if

         if (ALL(ABS(df_dx_err) < tol)) then
            print *,'  PASS df_dx'
         else
            print *,'  FAIL df_dx:', MAXVAL(ABS(df_dx_err)), '>', tol
         end if

         if (ALL(ABS(int_f_err) < tol)) then
            print *,'  PASS int_f'
         else
            print *,'  FAIL int_f:', MAXVAL(ABS(int_f_err)), '>', tol
         end if

         ! Finish

         return

      end subroutine cubint_assert_

   end subroutine test_cubint_

   !****

   subroutine eval_cubic_(x, f, df_dx, int_f)

      real(RD), intent(in)            :: x
      real(RD), intent(out)           :: f
      real(RD), intent(out), optional :: df_dx
      real(RD), intent(out), optional :: int_f

      f = 2*x**3 + x**2 - 4*x + 7

      if (PRESENT(df_dx)) df_dx = 6*x**2 + 2*x - 4
      if (PRESENT(int_f)) int_f = x**4/2 + x**3/3 - 2*x**2 + 7*x

   end subroutine eval_cubic_

end module utest_cubint_m
