Start with Fortran source downloaded from Netlib

src/fmin.f

@@ -0,0 +1,159 @@
+      double precision function fmin(ax,bx,f,tol)
+      double precision ax,bx,f,tol
+c
+c      an approximation  x  to the point where  f  attains a minimum  on
+c  the interval  (ax,bx)  is determined.
+c
+c
+c  input..
+c
+c  ax    left endpoint of initial interval
+c  bx    right endpoint of initial interval
+c  f     function subprogram which evaluates  f(x)  for any  x
+c        in the interval  (ax,bx)
+c  tol   desired length of the interval of uncertainty of the final
+c        result ( .ge. 0.0d0)
+c
+c
+c  output..
+c
+c  fmin  abcissa approximating the point where  f  attains a minimum
+c
+c
+c      the method used is a combination of  golden  section  search  and
+c  successive parabolic interpolation.  convergence is never much slower
+c  than  that  for  a  fibonacci search.  if  f  has a continuous second
+c  derivative which is positive at the minimum (which is not  at  ax  or
+c  bx),  then  convergence  is  superlinear, and usually of the order of
+c  about  1.324....
+c      the function  f  is never evaluated at two points closer together
+c  than  eps*abs(fmin) + (tol/3), where eps is  approximately the square
+c  root  of  the  relative  machine  precision.   if   f   is a unimodal
+c  function and the computed values of   f   are  always  unimodal  when
+c  separated by at least  eps*abs(x) + (tol/3), then  fmin  approximates
+c  the abcissa of the global minimum of  f  on the interval  ax,bx  with
+c  an error less than  3*eps*abs(fmin) + tol.  if   f   is not unimodal,
+c  then fmin may approximate a local, but perhaps non-global, minimum to
+c  the same accuracy.
+c      this function subprogram is a slightly modified  version  of  the
+c  algol  60 procedure  localmin  given in richard brent, algorithms for
+c  minimization without derivatives, prentice - hall, inc. (1973).
+c
+c
+      double precision  a,b,c,d,e,eps,xm,p,q,r,tol1,tol2,u,v,w
+      double precision  fu,fv,fw,fx,x
+      double precision  dabs,dsqrt,dsign
+c
+c  c is the squared inverse of the golden ratio
+c
+      c = 0.5d0*(3. - dsqrt(5.0d0))
+c
+c  eps is approximately the square root of the relative machine
+c  precision.
+c
+      eps = 1.0d00
+   10 eps = eps/2.0d00
+      tol1 = 1.0d0 + eps
+      if (tol1 .gt. 1.0d00) go to 10
+      eps = dsqrt(eps)
+c
+c  initialization
+c
+      a = ax
+      b = bx
+      v = a + c*(b - a)
+      w = v
+      x = v
+      e = 0.0d0
+      fx = f(x)
+      fv = fx
+      fw = fx
+c
+c  main loop starts here
+c
+   20 xm = 0.5d0*(a + b)
+      tol1 = eps*dabs(x) + tol/3.0d0
+      tol2 = 2.0d0*tol1
+c
+c  check stopping criterion
+c
+      if (dabs(x - xm) .le. (tol2 - 0.5d0*(b - a))) go to 90
+c
+c is golden-section necessary
+c
+      if (dabs(e) .le. tol1) go to 40
+c
+c  fit parabola
+c
+      r = (x - w)*(fx - fv)
+      q = (x - v)*(fx - fw)
+      p = (x - v)*q - (x - w)*r
+      q = 2.0d00*(q - r)
+      if (q .gt. 0.0d0) p = -p
+      q =  dabs(q)
+      r = e
+      e = d
+c
+c  is parabola acceptable
+c
+   30 if (dabs(p) .ge. dabs(0.5d0*q*r)) go to 40
+      if (p .le. q*(a - x)) go to 40
+      if (p .ge. q*(b - x)) go to 40
+c
+c  a parabolic interpolation step
+c
+      d = p/q
+      u = x + d
+c
+c  f must not be evaluated too close to ax or bx
+c
+      if ((u - a) .lt. tol2) d = dsign(tol1, xm - x)
+      if ((b - u) .lt. tol2) d = dsign(tol1, xm - x)
+      go to 50
+c
+c  a golden-section step
+c
+   40 if (x .ge. xm) e = a - x
+      if (x .lt. xm) e = b - x
+      d = c*e
+c
+c  f must not be evaluated too close to x
+c
+   50 if (dabs(d) .ge. tol1) u = x + d
+      if (dabs(d) .lt. tol1) u = x + dsign(tol1, d)
+      fu = f(u)
+c
+c  update  a, b, v, w, and x
+c
+      if (fu .gt. fx) go to 60
+      if (u .ge. x) a = x
+      if (u .lt. x) b = x
+      v = w
+      fv = fw
+      w = x
+      fw = fx
+      x = u
+      fx = fu
+      go to 20
+   60 if (u .lt. x) a = u
+      if (u .ge. x) b = u
+      if (fu .le. fw) go to 70
+      if (w .eq. x) go to 70
+      if (fu .le. fv) go to 80
+      if (v .eq. x) go to 80
+      if (v .eq. w) go to 80
+      go to 20
+   70 v = w
+      fv = fw
+      w = u
+      fw = fu
+      go to 20
+   80 v = u
+      fv = fu
+      go to 20
+c
+c  end of main loop
+c
+   90 fmin = x
+      return
+      end