lnsrlb Subroutine

private subroutine lnsrlb(n, l, u, Nbd, x, f, Fold, Gd, Gdold, g, d, r, t, z, Stp, Dnorm, Dtd, Xstep, Stpmx, Iter, Ifun, Iback, Nfgv, Info, Task, Boxed, Cnstnd, Csave, Isave, Dsave)

This subroutine calls subroutine dcsrch from the Minpack2 library to perform the line search. Subroutine dscrch is safeguarded so that all trial points lie within the feasible region.

Credits

  • NEOS, November 1994. (Latest revision June 1996.) Optimization Technology Center. Argonne National Laboratory and Northwestern University. Written by Ciyou Zhu in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.

Arguments

Type IntentOptional Attributes Name
integer :: n
real(kind=wp) :: l(n)
real(kind=wp) :: u(n)
integer :: Nbd(n)
real(kind=wp) :: x(n)
real(kind=wp) :: f
real(kind=wp) :: Fold
real(kind=wp) :: Gd
real(kind=wp) :: Gdold
real(kind=wp) :: g(n)
real(kind=wp) :: d(n)
real(kind=wp) :: r(n)
real(kind=wp) :: t(n)
real(kind=wp) :: z(n)
real(kind=wp) :: Stp
real(kind=wp) :: Dnorm
real(kind=wp) :: Dtd
real(kind=wp) :: Xstep
real(kind=wp) :: Stpmx
integer :: Iter
integer :: Ifun
integer :: Iback
integer :: Nfgv
integer :: Info
character(len=60) :: Task
logical :: Boxed
logical :: Cnstnd
character(len=60) :: Csave
integer :: Isave(2)
real(kind=wp) :: Dsave(13)

Calls

proc~~lnsrlb~~CallsGraph proc~lnsrlb lbfgsb_module::lnsrlb proc~dcopy lbfgsb_blas_module::dcopy proc~lnsrlb->proc~dcopy proc~dcsrch lbfgsb_module::dcsrch proc~lnsrlb->proc~dcsrch proc~ddot lbfgsb_blas_module::ddot proc~lnsrlb->proc~ddot proc~dcstep lbfgsb_module::dcstep proc~dcsrch->proc~dcstep

Called by

proc~~lnsrlb~~CalledByGraph proc~lnsrlb lbfgsb_module::lnsrlb proc~mainlb lbfgsb_module::mainlb proc~mainlb->proc~lnsrlb proc~setulb lbfgsb_module::setulb proc~setulb->proc~mainlb

Source Code

      subroutine lnsrlb(n,l,u,Nbd,x,f,Fold,Gd,Gdold,g,d,r,t,z,Stp,Dnorm,&
                        Dtd,Xstep,Stpmx,Iter,Ifun,Iback,Nfgv,Info,Task, &
                        Boxed,Cnstnd,Csave,Isave,Dsave)
      implicit none

      character(len=60) :: Task , Csave
      logical :: Boxed , Cnstnd
      integer :: n , Iter , Ifun , Iback , Nfgv , Info , Nbd(n) , Isave(2)
      real(wp) :: f , Fold , Gd , Gdold , Stp , Dnorm , Dtd , &
                  Xstep , Stpmx , x(n) , l(n) , u(n) , g(n) , &
                  d(n) , r(n) , t(n) , z(n) , Dsave(13)

      integer :: i
      real(wp) :: a1 , a2

      real(wp),parameter :: big  = 1.0e+10_wp
      real(wp),parameter :: ftol = 1.0e-3_wp
      real(wp),parameter :: gtol = 0.9_wp
      real(wp),parameter :: xtol = 0.1_wp

      if ( Task(1:5)/='FG_LN' ) then

         Dtd = ddot(n,d,1,d,1)
         Dnorm = sqrt(Dtd)

         ! Determine the maximum step length.

         Stpmx = big
         if ( Cnstnd ) then
            if ( Iter==0 ) then
               Stpmx = one
            else
               do i = 1 , n
                  a1 = d(i)
                  if ( Nbd(i)/=0 ) then
                     if ( a1<zero .and. Nbd(i)<=2 ) then
                        a2 = l(i) - x(i)
                        if ( a2>=zero ) then
                           Stpmx = zero
                        else if ( a1*Stpmx<a2 ) then
                           Stpmx = a2/a1
                        endif
                     else if ( a1>zero .and. Nbd(i)>=2 ) then
                        a2 = u(i) - x(i)
                        if ( a2<=zero ) then
                           Stpmx = zero
                        else if ( a1*Stpmx>a2 ) then
                           Stpmx = a2/a1
                        endif
                     endif
                  endif
               enddo
            endif
         endif

         if ( Iter==0 .and. .not.Boxed ) then
            Stp = min(one/Dnorm,Stpmx)
         else
            Stp = one
         endif

         call dcopy(n,x,1,t,1)
         call dcopy(n,g,1,r,1)
         Fold = f
         Ifun = 0
         Iback = 0
         Csave = 'START'

      end if

      Gd = ddot(n,g,1,d,1)
      if ( Ifun==0 ) then
         Gdold = Gd
         if ( Gd>=zero ) then
            ! the directional derivative >=0.
            ! Line search is impossible.
            write (output_unit,*) ' ascent direction in projection gd = ' , Gd
            Info = -4
            return
         endif
      endif

      call dcsrch(f,Gd,Stp,ftol,gtol,xtol,zero,Stpmx,Csave,Isave,Dsave)

      Xstep = Stp*Dnorm
      if ( Csave(1:4)/='CONV' .and. Csave(1:4)/='WARN' ) then
         Task = 'FG_LNSRCH'
         Ifun = Ifun + 1
         Nfgv = Nfgv + 1
         Iback = Ifun - 1
         if ( Stp==one ) then
            call dcopy(n,z,1,x,1)
         else
            do i = 1 , n
               x(i) = Stp*d(i) + t(i)
            enddo
         endif
      else
         Task = 'NEW_X'
      endif

      end subroutine lnsrlb