From 13ae3bba0c9e613b69ecb107deff946b127e581c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 06:47:36 -0500 Subject: [PATCH] Added interfaces to minimizer module to help with debugging --- src/fraggle/fraggle_generate.f90 | 2 +- src/misc/minimizer_module.f90 | 77 +++++++++++++++++++++++++++++--- 2 files changed, 71 insertions(+), 8 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index fe27bc9fd..73a2c0255 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -851,6 +851,6 @@ function radial_objective_function(v_r_mag_input) result(fval) return end function radial_objective_function - end subroutine fraggle_generate_rad_vel + end subroutine fraggle_generate_rad_vel end submodule s_fraggle_generate diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index a52fe2b00..5a189ad03 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -32,6 +32,70 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) logical, intent(out) :: lerr real(DP), dimension(:), intent(out), allocatable :: x1 end subroutine minimize_bfgs + + module function gradf(f, N, x1, dx, lerr) result(grad) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x1 + real(DP), intent(in) :: dx + logical, intent(out) :: lerr + real(DP), dimension(N) :: grad + end function gradf + + module function minimize1D(f, x0, S, N, eps, lerr) result(astar) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + logical, intent(out) :: lerr + real(DP) :: astar + end function minimize1D + + module function n2one(f, x0, S, N, a, lerr) result(fnew) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: a + logical, intent(out) :: lerr + real(DP) :: fnew + end function n2one + + module subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: gam, step + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + end subroutine bracket + + module subroutine golden(f, x0, S, N, eps, lo, hi, lerr) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + end subroutine golden + + module subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + end subroutine quadfit end interface contains @@ -153,7 +217,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) end subroutine minimize_bfgs - function gradf(f, N, x1, dx, lerr) result(grad) + module function gradf(f, N, x1, dx, lerr) result(grad) !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! Purpose: Estimates the gradient of a function using a central difference !! approximation @@ -211,7 +275,7 @@ function gradf(f, N, x1, dx, lerr) result(grad) end function gradf - function minimize1D(f, x0, S, N, eps, lerr) result(astar) + module function minimize1D(f, x0, S, N, eps, lerr) result(astar) !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This program find the minimum of a function of N variables in a single direction !! S using in sequence: @@ -286,7 +350,7 @@ function minimize1D(f, x0, S, N, eps, lerr) result(astar) end function minimize1D - function n2one(f, x0, S, N, a, lerr) result(fnew) + module function n2one(f, x0, S, N, a, lerr) result(fnew) implicit none ! Arguments integer(I4B), intent(in) :: N @@ -294,7 +358,6 @@ function n2one(f, x0, S, N, a, lerr) result(fnew) real(DP), dimension(:), intent(in) :: x0, S real(DP), intent(in) :: a logical, intent(out) :: lerr - ! Return real(DP) :: fnew ! Internals @@ -313,7 +376,7 @@ function n2one(f, x0, S, N, a, lerr) result(fnew) end function n2one - subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) + module subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This subroutine brackets the minimum. It recieves as input: !! f%eval(x) : lambda function object containing the objective function as the eval metho @@ -420,7 +483,7 @@ subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) end subroutine bracket - subroutine golden(f, x0, S, N, eps, lo, hi, lerr) + module subroutine golden(f, x0, S, N, eps, lo, hi, lerr) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. !! It recieves as input: @@ -482,7 +545,7 @@ subroutine golden(f, x0, S, N, eps, lo, hi, lerr) end subroutine golden - subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) + module subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses a quadratic polynomial fit to locate the minimum of a function !! to some accuracy eps. It recieves as input: