! Module  : utest_fit_m
! Purpose : Testing routines for utest_fit_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_fit_m

  ! Uses

  use forum_m

  use fit_m

  use ISO_FORTRAN_ENV

  ! No implicit typing

  implicit none

  ! Access specifiers

  private

  public :: test

contains
 
   subroutine test ()

      call test_gls_fit_()

   end subroutine test

   !****

   subroutine test_gls_fit_ ()

      integer, parameter :: n_x = 10
      integer, parameter :: n_a = 4

      real(RD) :: x(n_x)
      real(RD) :: y(n_x)
      real(RD) :: a_chk(n_a)
      real(RD) :: a(n_a)

      call gls_fit_arrange_()
      call gls_fit_act_()
      call gls_fit_assert_()

   contains

      subroutine gls_fit_arrange_()

         integer :: i

         x =  [(i,i=1,n_x)]
         y = SIN(x)
         a_chk = [ &
              3.294862083657227547e+00_RD, &
              -2.361968464010496760e+00_RD, &
              4.583475895500784825e-01_RD, &
              -2.581586410629988990e-02_RD &
              ]

      end subroutine gls_fit_arrange_

      !****
  
      subroutine gls_fit_act_()

         call gls_fit(x, y, gls_fit_func_, a)

      end subroutine gls_fit_act_

      !****

      function gls_fit_func_(x, n) result (func)

         real(RD), intent(in) :: x
         integer, intent(in)  :: n
         real(RD)             :: func(n)
         
         integer :: i
         
         do i = 1, n
            func(i) = x**(i-1)
         end do

      end function gls_fit_func_

      !****

      subroutine gls_fit_assert_()

         real(RD) :: err(n_a)

         err = (a - a_chk)/a_chk
         
         if (ALL(ABS(err) < 1E-13)) then
            print *,'  PASS'
         else
            print *,'  FAIL:', err
         end if

      end subroutine gls_fit_assert_

   end subroutine test_gls_fit_

end module utest_fit_m
