diff --git a/src/mo_optimization_utils.f90 b/src/mo_optimization_utils.f90
index 57d1939e9fba20494cd08abe941bb5fc234319dc..d7e48755af6cdbcb14282bbad2854c49cfbf9528 100644
--- a/src/mo_optimization_utils.f90
+++ b/src/mo_optimization_utils.f90
@@ -8,6 +8,7 @@
module mo_optimization_utils
use mo_kind, only : dp
+ use mo_message, only : error_message
implicit none
@@ -24,7 +25,7 @@ module mo_optimization_utils
abstract interface
subroutine eval_interface(config, opti_sim)
use mo_optimization_types, only : config_t, opti_sim_t
- type(config_t), intent(in) :: config
+ type(config_t), intent(in) :: config
type(opti_sim_t), dimension(:), pointer, optional, intent(inout) :: opti_sim
end subroutine
end interface
@@ -33,7 +34,7 @@ module mo_optimization_utils
!> \details The optional arguments are motivated by likelihood objective functions.
! ToDo: eval optional
interface
- function objective_interface (parameterset, eval, arg1, arg2, arg3)
+ function objective_interface(parameterset, eval, arg1, arg2, arg3)
use mo_kind, only : dp
import eval_interface
real(dp), intent(in), dimension(:) :: parameterset !< parameter set
@@ -46,4 +47,134 @@ module mo_optimization_utils
end function objective_interface
end interface
+
+ !> \brief abstract type 'optimizee' to be used by optimizers
+ type, abstract :: optimizee
+ contains
+ !> \brief evaluate the optimizee
+ procedure(evaluate_interface), deferred :: evaluate
+ end type optimizee
+
+ !> \brief Abstract interface for deferred procedures
+ abstract interface
+ function evaluate_interface(self, parameters, sigma, stddev_new, likeli_new) result(value)
+ use mo_kind, only : dp
+ import :: optimizee
+ class(optimizee), intent(inout) :: self
+ real(dp), intent(in), dimension(:) :: parameters !< parameter set
+ real(dp), intent(in), optional :: sigma !< likelihood: standard deviation of data
+ real(dp), intent(out), optional :: stddev_new !< likelihood: standard deviation of errors using parameters
+ real(dp), intent(out), optional :: likeli_new !< likelihood: likelihood using stddev_new
+ real(dp) :: value !< output value
+ end function evaluate_interface
+ end interface
+
+ !> \brief Optimizee for a simple function: f(vec)
+ type, extends(optimizee) :: function_optimizee
+ procedure(func_interface), pointer, nopass :: func_pointer => null() !< Pointer to the function
+ contains
+ procedure :: evaluate => evaluate_function
+ end type function_optimizee
+
+ !> \brief Abstract interface for the function pointer
+ abstract interface
+ function func_interface(parameters) result(value)
+ use mo_kind, only : dp
+ real(dp), dimension(:), intent(in) :: parameters !< parameter set
+ real(dp) :: value !< output value
+ end function func_interface
+ end interface
+
+ !> \brief Optimizee for a likelihood function: f(vec, sigma, stddev_new, likeli_new)
+ type, extends(optimizee) :: likelihood_optimizee
+ procedure(likelihood_interface), pointer, nopass :: likelihood_pointer => null() !< Pointer to the likelihood
+ contains
+ procedure :: evaluate => evaluate_likelihood
+ end type likelihood_optimizee
+
+ !> \brief Abstract interface for the likelihood pointer
+ abstract interface
+ function likelihood_interface(parameters, sigma, stddev_new, likeli_new) result(value)
+ use mo_kind, only : dp
+ real(dp), dimension(:), intent(in) :: parameters !< parameter set
+ real(dp), intent(in), optional :: sigma !< standard deviation of data
+ real(dp), intent(out), optional :: stddev_new !< standard deviation of errors using parameters
+ real(dp), intent(out), optional :: likeli_new !< likelihood using stddev_new,
+ real(dp) :: value !< output value
+ end function likelihood_interface
+ end interface
+
+ !> \brief Optimizee for a eval-objective pair
+ type, extends(optimizee) :: eval_optimizee
+ procedure(eval_interface), pointer, nopass :: eval_pointer => null() !< Pointer to the eval
+ procedure(objective_interface), pointer, nopass :: obj_pointer => null() !< Pointer to the objective
+ contains
+ procedure :: evaluate => evaluate_obj_eval
+ end type eval_optimizee
+
+contains
+
+ !> \brief Implementation of the evaluate procedure for a simple function
+ function evaluate_function(self, parameters, sigma, stddev_new, likeli_new) result(value)
+ class(function_optimizee), intent(inout) :: self
+ real(dp), dimension(:), intent(in) :: parameters !< parameter set
+ real(dp), intent(in), optional :: sigma !< likelihood: standard deviation of data
+ real(dp), intent(out), optional :: stddev_new !< likelihood: standard deviation of errors using parameters
+ real(dp), intent(out), optional :: likeli_new !< likelihood: likelihood using stddev_new
+ real(dp) :: value !< output value
+
+ ! Ensure the function pointer is set
+ if (.not. associated(self%func_pointer)) then
+ call error_message("Function pointer is not set in function_optimizee!")
+ end if
+
+ ! Check optional arguments
+ if (present(sigma) .or. present(stddev_new) .or. present(likeli_new)) then
+ call error_message("function_optimizee doesn't support 'sigma', 'stddev_new' or 'likeli_new'!")
+ end if
+
+ ! Call the function pointer
+ value = self%func_pointer(parameters)
+ end function evaluate_function
+
+ !> \brief Implementation of the evaluate procedure for a likelihood function
+ function evaluate_likelihood(self, parameters, sigma, stddev_new, likeli_new) result(value)
+ class(likelihood_optimizee), intent(inout) :: self
+ real(DP), dimension(:), intent(in) :: parameters
+ real(DP), intent(in), optional :: sigma
+ real(DP), intent(out), optional :: stddev_new
+ real(DP), intent(out), optional :: likeli_new
+ real(DP) :: value
+
+ ! Ensure the likelihood function pointer is set
+ if (.not. associated(self%likelihood_pointer)) then
+ call error_message("Likelihood function pointer is not set in likelihood_optimizee!")
+ end if
+
+ ! Call the likelihood function pointer
+ value = self%likelihood_pointer(parameters, sigma, stddev_new, likeli_new)
+ end function evaluate_likelihood
+
+ !> \brief Implementation of the evaluate procedure for a eval-objective pair
+ function evaluate_obj_eval(self, parameters, sigma, stddev_new, likeli_new) result(value)
+ class(eval_optimizee), intent(inout) :: self
+ real(DP), dimension(:), intent(in) :: parameters
+ real(DP), intent(in), optional :: sigma
+ real(DP), intent(out), optional :: stddev_new
+ real(DP), intent(out), optional :: likeli_new
+ real(DP) :: value
+
+ ! Ensure the eval function pointer is set
+ if (.not. associated(self%eval_pointer)) then
+ call error_message("Eval function pointer is not set in eval_optimizee!")
+ end if
+ ! Ensure the objective function pointer is set
+ if (.not. associated(self%obj_pointer)) then
+ call error_message("Objective function pointer is not set in eval_optimizee!")
+ end if
+
+ ! Call the objective function pointer
+ value = self%obj_pointer(parameters, self%eval_pointer, sigma, stddev_new, likeli_new)
+ end function evaluate_obj_eval
+
end module mo_optimization_utils