!
! --------------------------------------------------------------
! Module of evaluation functions
! --------------------------------------------------------------
!
module util_eval
  implicit none
  public :: eval_objfunc           ! evaluate objective function
  public :: eval_minmax            ! get minimize-maximize flag
  public :: rmse                   ! root mean square error
  public :: nse                    ! Nash-sutcliffe efficiency
contains

!----------------------------------------------------------------------
! Evaluate objective function
!----------------------------------------------------------------------
function eval_objfunc(id, n, x, y) result(r)
  integer, intent(in) :: id             ! objective function ID
  integer, intent(in) :: n              ! number of data
  real,    intent(in) :: x(1:n)         ! observation data
  real,    intent(in) :: y(1:n)         ! calculated data
  real                :: r              ! evaluation value
  select case(id)
    case(1)
      r = rmse(n, x, y)
    case(2)
      r = nse(n, x, y)
    case default
      print *, 'eval_objfunc: invalid function ID', id
      stop
  end select
end function eval_objfunc

!----------------------------------------------------------------------
! Get minimize-maximize flag
!----------------------------------------------------------------------
function eval_minmax(id) result(r)
  integer, intent(in) :: id             ! objective function ID
  integer             :: r              ! minimize-maximize flag
  select case(id)
    case(1)                    ! RMSE
      r = -1                   !  minimize
    case(2)                    ! Nash
      r = 1                    !  maximize
    case default
      print *, 'eval_objfunc: invalid function ID', id
      stop
  end select
end function eval_minmax

!----------------------------------------------------------------------
! Root Mean Square Error
!----------------------------------------------------------------------
function rmse(n, x, y) result(r)
  implicit none
  integer, intent(in) :: n
  real,    intent(in) :: x(1:n), y(1:n)
  real                :: r
  real    :: se(1:n)
  integer :: i
  forall(i=1: n) se(i) = (x(i) - y(i))**2
  r = sqrt(sum(se(1:n) / real(n)))
end function rmse

!----------------------------------------------------------------------
! Nash-Sutcliffe Efficiency
!----------------------------------------------------------------------
function nse(n, x, y) result(r)
  implicit none
  integer, intent(in) :: n
  real,    intent(in) :: x(1:n), y(1:n)
  real                :: r
  real    :: xm, s1(1:n), s2(1:n)
  integer :: i
  xm = sum(x(1:n)) / real(n)
  forall(i=1: n) s1(i) = (x(i) - y(i))**2
  forall(i=1: n) s2(i) = (x(i) - xm)**2
  r = 1.0 - sum(s1(1:n)) / sum(s2(1:n))
end function nse

end module util_eval