cmprlb Subroutine

private subroutine cmprlb(n, m, x, g, Ws, Wy, Sy, Wt, z, r, Wa, Index, Theta, Col, Head, Nfree, Cnstnd, Info)

This subroutine computes r=-Z'B(xcp-xk)-Z'g by using wa(2m+1)=W'(xcp-x) from subroutine cauchy.

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
integer :: m
real(kind=wp) :: x(n)
real(kind=wp) :: g(n)
real(kind=wp) :: Ws(n,m)
real(kind=wp) :: Wy(n,m)
real(kind=wp) :: Sy(m,m)
real(kind=wp) :: Wt(m,m)
real(kind=wp) :: z(n)
real(kind=wp) :: r(n)
real(kind=wp) :: Wa(4*m)
integer :: Index(n)
real(kind=wp) :: Theta
integer :: Col
integer :: Head
integer :: Nfree
logical :: Cnstnd
integer :: Info

Calls

proc~~cmprlb~~CallsGraph proc~cmprlb lbfgsb_module::cmprlb proc~bmv lbfgsb_module::bmv proc~cmprlb->proc~bmv proc~dtrsl lbfgsb_linpack_module::dtrsl proc~bmv->proc~dtrsl proc~daxpy lbfgsb_blas_module::daxpy proc~dtrsl->proc~daxpy proc~ddot lbfgsb_blas_module::ddot proc~dtrsl->proc~ddot

Called by

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

Source Code

      subroutine cmprlb(n,m,x,g,Ws,Wy,Sy,Wt,z,r,Wa,Index,Theta,Col,Head,&
                        Nfree,Cnstnd,Info)
      implicit none

      logical :: Cnstnd
      integer :: n , m , Col , Head , Nfree , Info , Index(n)
      real(wp) :: Theta , x(n) , g(n) , z(n) , r(n) , Wa(4*m) , &
                  Ws(n,m) , Wy(n,m) , Sy(m,m) , Wt(m,m)

      integer :: i , j , k , pointr
      real(wp) :: a1 , a2

      if ( .not.Cnstnd .and. Col>0 ) then
         do i = 1 , n
            r(i) = -g(i)
         enddo
      else
         do i = 1 , Nfree
            k = Index(i)
            r(i) = -Theta*(z(k)-x(k)) - g(k)
         enddo
         call bmv(m,Sy,Wt,Col,Wa(2*m+1),Wa(1),Info)
         if ( Info/=0 ) then
            Info = -8
            return
         endif
         pointr = Head
         do j = 1 , Col
            a1 = Wa(j)
            a2 = Theta*Wa(Col+j)
            do i = 1 , Nfree
               k = Index(i)
               r(i) = r(i) + Wy(k,pointr)*a1 + Ws(k,pointr)*a2
            enddo
            pointr = mod(pointr,m) + 1
         enddo
      endif

      end subroutine cmprlb