An approximation x to the point where f attains a minimum on
the interval (ax,bx) is determined.
the method used is a combination of golden section search and
successive parabolic interpolation. convergence is never much slower
than that for a fibonacci search. if f has a continuous second
derivative which is positive at the minimum (which is not at ax or
bx), then convergence is superlinear, and usually of the order of
about 1.324.
the function f is never evaluated at two points closer together
than eps*abs(fmin) + (tol/3), where eps is approximately the square
root of the relative machine precision. if f is a unimodal
function and the computed values of f are always unimodal when
separated by at least eps*abs(x) + (tol/3), then fmin approximates
the abcissa of the global minimum of f on the interval ax,bx with
an error less than 3*eps*abs(fmin) + tol. if f is not unimodal,
then fmin may approximate a local, but perhaps non-global, minimum to
the same accuracy.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| procedure(func) | :: | f |
the function to minimize |
|||
| real(kind=wp), | intent(in) | :: | ax |
left endpoint of initial interval |
||
| real(kind=wp), | intent(in) | :: | bx |
right endpoint of initial interval |
||
| real(kind=wp), | intent(in) | :: | tol |
desired length of the interval of uncertainty of the final result (>=0) |
abcissa approximating the point where f attains a minimum
function fmin(f,ax,bx,tol) result(xmin) implicit none procedure(func) :: f !! the function to minimize real(wp),intent(in) :: ax !! left endpoint of initial interval real(wp),intent(in) :: bx !! right endpoint of initial interval real(wp),intent(in) :: tol !! desired length of the interval of !! uncertainty of the final result (>=0) real(wp) :: xmin !! abcissa approximating the point where !! f attains a minimum real(wp) :: a,b,d,e,xm,p,q,r,tol1,tol2,u,v,w real(wp) :: fu,fv,fw,fx,x real(wp),parameter :: c = (3.0_wp-sqrt(5.0_wp))/2.0_wp !! squared inverse of golden ratio real(wp),parameter :: half = 0.5_wp real(wp),parameter :: sqrteps = sqrt(epsilon(1.0_wp)) ! initialization a = ax b = bx v = a + c*(b - a) w = v x = v e = 0.0_wp fx = f(x) fv = fx fw = fx do ! main loop starts here xm = half*(a + b) tol1 = sqrteps*abs(x) + tol/3.0_wp tol2 = 2.0_wp*tol1 ! check stopping criterion if (abs(x - xm) <= (tol2 - half*(b - a))) then ! write(*,*) 'x = ', x ! write(*,*) 'xm = ', xm ! write(*,*) 'abs(x - xm) = ', abs(x - xm) ! write(*,*) 'tol2 = ', tol2 ! write(*,*) 'half*(b - a) = ', half*(b - a) exit end if ! is golden-section necessary if (abs(e) <= tol1) then ! a golden-section step if (x >= xm) then e = a - x else e = b - x end if d = c*e else ! fit parabola r = (x - w)*(fx - fv) q = (x - v)*(fx - fw) p = (x - v)*q - (x - w)*r q = 2.0_wp*(q - r) if (q > 0.0_wp) p = -p q = abs(q) r = e e = d ! is parabola acceptable if ((abs(p) >= abs(half*q*r)) .or. (p <= q*(a - x)) .or. (p >= q*(b - x))) then ! a golden-section step if (x >= xm) then e = a - x else e = b - x end if d = c*e else ! a parabolic interpolation step d = p/q u = x + d ! f must not be evaluated too close to ax or bx if (((u - a) < tol2) .or. ((b - u) < tol2)) d = sign(tol1, xm - x) end if end if ! f must not be evaluated too close to x if (abs(d) >= tol1) then u = x + d else u = x + sign(tol1, d) end if fu = f(u) ! update a, b, v, w, and x if (fu <= fx) then if (u >= x) a = x if (u < x) b = x v = w fv = fw w = x fw = fx x = u fx = fu else if (u < x) a = u if (u >= x) b = u if (fu <= fw .or. w == x) then v = w fv = fw w = u fw = fu else if (fu <= fv .or. v == x .or. v == w ) then v = u fv = fu end if end if end do ! end of main loop xmin = x end function fmin