dcsrch – lbfgsb

private subroutine dcsrch(f, g, Stp, Ftol, Gtol, Xtol, Stpmin, Stpmax, Task, Isave, Dsave)

This subroutine finds a step that satisfies a sufficient decrease condition and a curvature condition.

Each call of the subroutine updates an interval with endpoints stx and sty. The interval is initially chosen so that it contains a minimizer of the modified function

psi(stp) = f(stp) - f(0) - ftol*stp*f'(0).

If psi(stp) <= 0 and f'(stp) >= 0 for some step, then the interval is chosen so that it contains a minimizer of f.

The algorithm is designed to find a step that satisfies the sufficient decrease condition

f(stp) <= f(0) + ftol*stp*f'(0),

and the curvature condition

abs(f'(stp)) <= gtol*abs(f'(0)).

If ftol is less than gtol and if, for example, the function is bounded below, then there is always a step which satisfies both conditions.

If no step can be found that satisfies both conditions, then the algorithm stops with a warning. In this case stp only satisfies the sufficient decrease condition.

A typical invocation of dcsrch has the following outline:

     task = 'START'
     main : block
       call dcsrch( ... )
       if (task == 'FG') then
          ! Evaluate the function and the gradient at stp
          cycle main
       end if

Note: The user must not alter work arrays between calls.

Credits

MINPACK-1 Project. June 1983. Argonne National Laboratory. Jorge J. More' and David J. Thuente.
MINPACK-2 Project. October 1993. Argonne National Laboratory and University of Minnesota. Brett M. Averick, Richard G. Carter, and Jorge J. More'.

Arguments

Type	Intent		Name
real(kind=wp),	intent(inout)	::	f	On initial entry `f` is the value of the function at 0. On subsequent entries `f` is the value of the function at `stp`. On exit `f` is the value of the function at `stp`.
real(kind=wp),	intent(inout)	::	g	On initial entry `g` is the derivative of the function at 0. On subsequent entries `g` is the derivative of the function at `stp`. On exit `g` is the derivative of the function at `stp`.
real(kind=wp),	intent(inout)	::	Stp	On entry `stp` is the current estimate of a satisfactory step. On initial entry, a positive initial estimate must be provided. On exit `stp` is the current estimate of a satisfactory step if `task = 'FG'`. If `task = 'CONV'` then `stp` satisfies the sufficient decrease and curvature condition.
real(kind=wp),	intent(in)	::	Ftol	`ftol` specifies a nonnegative tolerance for the sufficient decrease condition.
real(kind=wp),	intent(in)	::	Gtol	`gtol` specifies a nonnegative tolerance for the curvature condition.
real(kind=wp),	intent(in)	::	Xtol	`xtol` specifies a nonnegative relative tolerance for an acceptable step. The subroutine exits with a warning if the relative difference between `sty` and `stx` is less than `xtol`.
real(kind=wp),	intent(in)	::	Stpmin	a nonnegative lower bound for the step.
real(kind=wp),	intent(in)	::	Stpmax	a nonnegative upper bound for the step.
character(len=*),	intent(inout)	::	Task	`task` is a character variable of length at least 60: On initial entry `task` must be set to 'START'. On exit `task` indicates the required action: If `task(1:2) = 'FG'` then evaluate the function and derivative at stp and call dcsrch again. If `task(1:4) = 'CONV'` then the search is successful. If `task(1:4) = 'WARN'` then the subroutine is not able to satisfy the convergence conditions. The exit value of `stp` contains the best point found during the search. If `task(1:5) = 'ERROR'` then there is an error in the input arguments. On exit with convergence, a warning or an error, the variable task contains additional information.
integer		::	Isave(2)	integer work array
real(kind=wp)		::	Dsave(13)	real work array

Calls

Help

Called by

Help

Source Code

      subroutine dcsrch(f,g,Stp,Ftol,Gtol,Xtol,Stpmin,Stpmax,Task,Isave,Dsave)

      implicit none

      character(len=*),intent(inout) :: Task !! `task` is a character variable of length at least 60:
                                             !!
                                             !!  * On initial entry `task` must be set to 'START'.
                                             !!  * On exit `task` indicates the required action:
                                             !!     * If `task(1:2) = 'FG'` then evaluate the function and
                                             !!       derivative at stp and call dcsrch again.
                                             !!     * If `task(1:4) = 'CONV'` then the search is successful.
                                             !!     * If `task(1:4) = 'WARN'` then the subroutine is not able
                                             !!       to satisfy the convergence conditions. The exit value of
                                             !!       `stp` contains the best point found during the search.
                                             !!     * If `task(1:5) = 'ERROR'` then there is an error in the
                                             !!       input arguments.
                                             !!  * On exit with convergence, a warning or an error, the
                                             !!    variable task contains additional information.
      real(wp),intent(inout) :: f !! * On initial entry `f` is the value of the function at 0.
                                  !!   On subsequent entries `f` is the value of the
                                  !!   function at `stp`.
                                  !! * On exit `f` is the value of the function at `stp`.
      real(wp),intent(inout) :: g !! * On initial entry `g` is the derivative of the function at 0.
                                  !!   On subsequent entries `g` is the derivative of the
                                  !!   function at `stp`.
                                  !! * On exit `g` is the derivative of the function at `stp`.
      real(wp),intent(inout) :: Stp !! * On entry `stp` is the current estimate of a satisfactory
                                    !!   step. On initial entry, a positive initial estimate
                                    !!   must be provided.
                                    !! * On exit `stp` is the current estimate of a satisfactory step
                                    !!   if `task = 'FG'`. If `task = 'CONV'` then `stp` satisfies
                                    !!   the sufficient decrease and curvature condition.
      real(wp),intent(in) :: Ftol !! `ftol` specifies a nonnegative tolerance for the
                                  !! sufficient decrease condition.
      real(wp),intent(in) :: Gtol !! `gtol` specifies a nonnegative tolerance for the curvature condition.
      real(wp),intent(in) :: Xtol !! `xtol` specifies a nonnegative relative tolerance
                                  !! for an acceptable step. The subroutine exits with a
                                  !! warning if the relative difference between `sty` and `stx`
                                  !! is less than `xtol`.
      real(wp),intent(in) :: Stpmin !! a nonnegative lower bound for the step.
      real(wp),intent(in) :: Stpmax !! a nonnegative upper bound for the step.
      integer :: Isave(2) !! integer work array
      real(wp) :: Dsave(13) !! real work array

      real(wp), parameter :: p5     = 0.5_wp
      real(wp), parameter :: p66    = 0.66_wp
      real(wp), parameter :: xtrapl = 1.1_wp
      real(wp), parameter :: xtrapu = 4.0_wp

      logical :: brackt
      integer :: stage
      real(wp) :: finit , ftest , fm , fx , fxm , fy , fym ,       &
                  ginit , gtest , gm , gx , gxm , gy , gym , stx , &
                  sty , stmin , stmax , width , width1

      ! Initialization block.

      if ( Task(1:5)=='START' ) then

         ! Check the input arguments for errors.

         if ( Stp<Stpmin )    Task = 'ERROR: STP < STPMIN'
         if ( Stp>Stpmax )    Task = 'ERROR: STP > STPMAX'
         if ( g>=zero )       Task = 'ERROR: INITIAL G >= ZERO'
         if ( Ftol<zero )     Task = 'ERROR: FTOL < ZERO'
         if ( Gtol<zero )     Task = 'ERROR: GTOL < ZERO'
         if ( Xtol<zero )     Task = 'ERROR: XTOL < ZERO'
         if ( Stpmin<zero )   Task = 'ERROR: STPMIN < ZERO'
         if ( Stpmax<Stpmin ) Task = 'ERROR: STPMAX < STPMIN'

         ! Exit if there are errors on input.

         if ( Task(1:5)=='ERROR' ) return

         ! Initialize local variables.

         brackt = .false.
         stage = 1
         finit = f
         ginit = g
         gtest = Ftol*ginit
         width = Stpmax - Stpmin
         width1 = width/p5

         ! The variables stx, fx, gx contain the values of the step,
         ! function, and derivative at the best step.
         ! The variables sty, fy, gy contain the value of the step,
         ! function, and derivative at sty.
         ! The variables stp, f, g contain the values of the step,
         ! function, and derivative at stp.

         stx = zero
         fx = finit
         gx = ginit
         sty = zero
         fy = finit
         gy = ginit
         stmin = zero
         stmax = Stp + xtrapu*Stp
         Task = 'FG'

         call save_locals()
         return

      else

         ! Restore local variables.

         if ( Isave(1)==1 ) then
            brackt = .true.
         else
            brackt = .false.
         endif
         stage = Isave(2)
         ginit = Dsave(1)
         gtest = Dsave(2)
         gx = Dsave(3)
         gy = Dsave(4)
         finit = Dsave(5)
         fx = Dsave(6)
         fy = Dsave(7)
         stx = Dsave(8)
         sty = Dsave(9)
         stmin = Dsave(10)
         stmax = Dsave(11)
         width = Dsave(12)
         width1 = Dsave(13)

      endif

      ! If psi(stp) <= 0 and f'(stp) >= 0 for some step, then the
      ! algorithm enters the second stage.

      ftest = finit + Stp*gtest
      if ( stage==1 .and. f<=ftest .and. g>=zero ) stage = 2

      ! Test for warnings.

      if ( brackt .and. (Stp<=stmin .or. Stp>=stmax) )           &
           Task = 'WARNING: ROUNDING ERRORS PREVENT PROGRESS'
      if ( brackt .and. stmax-stmin<=Xtol*stmax )                &
           Task = 'WARNING: XTOL TEST SATISFIED'
      if ( Stp==Stpmax .and. f<=ftest .and. g<=gtest )           &
           Task = 'WARNING: STP = STPMAX'
      if ( Stp==Stpmin .and. (f>ftest .or. g>=gtest) )           &
           Task = 'WARNING: STP = STPMIN'

      ! Test for convergence.

      if ( f<=ftest .and. abs(g)<=Gtol*(-ginit) ) Task = 'CONVERGENCE'

      ! Test for termination.

      if ( Task(1:4)=='WARN' .or. Task(1:4)=='CONV' ) then
         call save_locals()
         return
      end if

      ! A modified function is used to predict the step during the
      ! first stage if a lower function value has been obtained but
      ! the decrease is not sufficient.

      if ( stage==1 .and. f<=fx .and. f>ftest ) then

         ! Define the modified function and derivative values.

         fm = f - Stp*gtest
         fxm = fx - stx*gtest
         fym = fy - sty*gtest
         gm = g - gtest
         gxm = gx - gtest
         gym = gy - gtest

         ! Call dcstep to update stx, sty, and to compute the new step.

         call dcstep(stx,fxm,gxm,sty,fym,gym,Stp,fm,gm,brackt,stmin, &
                     stmax)

         ! Reset the function and derivative values for f.

         fx = fxm + stx*gtest
         fy = fym + sty*gtest
         gx = gxm + gtest
         gy = gym + gtest

      else

         ! Call dcstep to update stx, sty, and to compute the new step.

         call dcstep(stx,fx,gx,sty,fy,gy,Stp,f,g,brackt,stmin,stmax)

      endif

      ! Decide if a bisection step is needed.

      if ( brackt ) then
         if ( abs(sty-stx)>=p66*width1 ) Stp = stx + p5*(sty-stx)
         width1 = width
         width = abs(sty-stx)
      endif

      ! Set the minimum and maximum steps allowed for stp.

      if ( brackt ) then
         stmin = min(stx,sty)
         stmax = max(stx,sty)
      else
         stmin = Stp + xtrapl*(Stp-stx)
         stmax = Stp + xtrapu*(Stp-stx)
      endif

      ! Force the step to be within the bounds stpmax and stpmin.

      Stp = max(Stp,Stpmin)
      Stp = min(Stp,Stpmax)

      ! If further progress is not possible, let stp be the best
      ! point obtained during the search.

      if ( brackt .and. (Stp<=stmin .or. Stp>=stmax) .or. &
         & (brackt .and. stmax-stmin<=Xtol*stmax) ) Stp = stx

      ! Obtain another function and derivative.

      Task = 'FG'

      call save_locals()

      contains

      subroutine save_locals()

         !! Save local variables.

         if ( brackt ) then
            Isave(1) = 1
         else
            Isave(1) = 0
         endif
         Isave(2) = stage
         Dsave(1) = ginit
         Dsave(2) = gtest
         Dsave(3) = gx
         Dsave(4) = gy
         Dsave(5) = finit
         Dsave(6) = fx
         Dsave(7) = fy
         Dsave(8) = stx
         Dsave(9) = sty
         Dsave(10) = stmin
         Dsave(11) = stmax
         Dsave(12) = width
         Dsave(13) = width1

      end subroutine save_locals

      end subroutine dcsrch

dcsrch Subroutine

Contents

Source Code

private subroutine dcsrch(f, g, Stp, Ftol, Gtol, Xtol, Stpmin, Stpmax, Task, Isave, Dsave)

Credits

Arguments

Calls

Called by

Source Code