nonlin_optimize.f90

! nonlin_optimize.f90
 
! REF:
! http://ab-initio.mit.edu/wiki/index.php/NLopt_Algorithms#Nelder-Mead_Simplex
! http://ab-initio.mit.edu/wiki/index.php/NLopt_Algorithms
! https://scicomp.stackexchange.com/questions/14787/fortran-library-for-minimization-or-maximization-of-functions-optimization-prob
! http://ab-initio.mit.edu/wiki/index.php/NLopt
 
module nonlin_optimize
    use, intrinsic :: iso_fortran_env, only : int32, real64
    use ferror
    use nonlin_linesearch, only : line_search, limit_search_vector
    use nonlin_constants
    use nonlin_core
    use linalg, only : rank1_update, tri_mtx_mult, cholesky_rank1_update, &
        cholesky_rank1_downdate, solve_cholesky, la_matrix_format_error
    implicit none
    private
    public :: nelder_mead
    public :: line_search_optimizer
    public :: bfgs
 
! ******************************************************************************
! NONLIN_OPTIMIZE_NELDER_MEAD.F90
! ------------------------------------------------------------------------------
    type, extends(equation_optimizer) :: nelder_mead
        private
        real(real64), allocatable, dimension(:,:) :: m_simplex
        real(real64) :: m_initsize = 1.0d0
    contains
        procedure, public :: solve => nm_solve
        procedure, public :: get_simplex => nm_get_simplex
        procedure, public :: set_simplex => nm_set_simplex
        procedure, public :: get_initial_size => nm_get_size
        procedure, public :: set_initial_size => nm_set_size
 
        procedure, private :: extrapolate => nm_extrapolate
    end type
 
! ------------------------------------------------------------------------------
    interface
        module subroutine nm_solve(this, fcn, x, fout, ib, err)
            class(nelder_mead), intent(inout) :: this
            class(fcnnvar_helper), intent(in) :: fcn
            real(real64), intent(inout), dimension(:) :: x
            real(real64), intent(out), optional :: fout
            type(iteration_behavior), optional :: ib
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module function nm_extrapolate(this, fcn, y, pcent, ihi, fac, neval, &
                work) result(ytry)
            class(nelder_mead), intent(inout) :: this
            class(fcnnvar_helper), intent(in) :: fcn
            real(real64), intent(inout), dimension(:) :: y, pcent
            integer(int32), intent(in) :: ihi
            real(real64), intent(in) :: fac
            integer(int32), intent(inout) :: neval
            real(real64), intent(out), dimension(:) :: work
            real(real64) :: ytry
        end function
 
        pure module function nm_get_simplex(this) result(p)
            class(nelder_mead), intent(in) :: this
            real(real64), allocatable, dimension(:,:) :: p
        end function
 
        module subroutine nm_set_simplex(this, x)
            class(nelder_mead), intent(inout) :: this
            real(real64), dimension(:,:) :: x
        end subroutine
 
        pure module function nm_get_size(this) result(x)
            class(nelder_mead), intent(in) :: this
            real(real64) :: x
        end function
 
        module subroutine nm_set_size(this, x)
            class(nelder_mead), intent(inout) :: this
            real(real64), intent(in) :: x
        end subroutine
    end interface
 
! ******************************************************************************
! NONLIN_OPTIMIZE_LINE_SEARCH.F90
! ------------------------------------------------------------------------------
    type, abstract, extends(equation_optimizer) :: line_search_optimizer
        private
        class(line_search), allocatable :: m_linesearch
        logical :: m_uselinesearch = .true.
        real(real64) :: m_xtol = 1.0d-12
    contains
        procedure, public :: get_line_search => lso_get_line_search
        procedure, public :: set_line_search => lso_set_line_search
        procedure, public :: set_default_line_search => lso_set_default
        procedure, public :: is_line_search_defined => &
            lso_is_line_search_defined
        procedure, public :: get_use_line_search => lso_get_use_search
        procedure, public :: set_use_line_search => lso_set_use_search
        procedure, public :: get_var_tolerance => lso_get_var_tol
        procedure, public :: set_var_tolerance => lso_set_var_tol
    end type
 
! ------------------------------------------------------------------------------
    interface
        module subroutine lso_get_line_search(this, ls)
            class(line_search_optimizer), intent(in) :: this
            class(line_search), intent(out), allocatable :: ls
        end subroutine
 
        module subroutine lso_set_line_search(this, ls)
            class(line_search_optimizer), intent(inout) :: this
            class(line_search), intent(in) :: ls
        end subroutine
 
        module subroutine lso_set_default(this)
            class(line_search_optimizer), intent(inout) :: this
            type(line_search) :: ls
        end subroutine
 
        pure module function lso_is_line_search_defined(this) result(x)
            class(line_search_optimizer), intent(in) :: this
            logical :: x
        end function
 
        pure module function lso_get_use_search(this) result(x)
            class(line_search_optimizer), intent(in) :: this
            logical :: x
        end function
 
        module subroutine lso_set_use_search(this, x)
            class(line_search_optimizer), intent(inout) :: this
            logical, intent(in) :: x
        end subroutine
 
        pure module function lso_get_var_tol(this) result(x)
            class(line_search_optimizer), intent(in) :: this
            real(real64) :: x
        end function
 
        module subroutine lso_set_var_tol(this, x)
            class(line_search_optimizer), intent(inout) :: this
            real(real64), intent(in) :: x
        end subroutine
    end interface
 
! ------------------------------------------------------------------------------
    type, extends(line_search_optimizer) :: bfgs
    contains
        procedure, public :: solve => bfgs_solve
    end type
 
! ------------------------------------------------------------------------------
    interface
        module subroutine bfgs_solve(this, fcn, x, fout, ib, err)
            class(bfgs), intent(inout) :: this
            class(fcnnvar_helper), intent(in) :: fcn
            real(real64), intent(inout), dimension(:) :: x
            real(real64), intent(out), optional :: fout
            type(iteration_behavior), optional :: ib
            class(errors), intent(inout), optional, target :: err
        end subroutine
    end interface
 
end module