bmv Subroutine

private subroutine bmv(m, Sy, Wt, Col, v, p, Info)

This subroutine computes the product of the 2m x 2m middle matrix in the compact L-BFGS formula of B and a 2m vector v; it returns the product in p.

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, intent(in) :: m

the maximum number of variable metric corrections used to define the limited memory matrix.
real(kind=wp), intent(in) :: Sy(m,m)

specifies the matrix S'Y.
real(kind=wp), intent(in) :: Wt(m,m)

specifies the upper triangular matrix J' which is the Cholesky factor of (thetaS'S+LD^(-1)L').
integer, intent(in) :: Col

specifies the number of s-vectors (or y-vectors) stored in the compact L-BFGS formula.
real(kind=wp), intent(in) :: v(2*Col)

specifies vector v.
real(kind=wp), intent(out) :: p(2*Col)

the product Mv
integer, intent(out) :: Info

On exit:

  • info = 0 for normal return,
  • info /=0 for abnormal return when the system to be solved by dtrsl is singular.

Calls

proc~~bmv~~CallsGraph proc~bmv lbfgsb_module::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~~bmv~~CalledByGraph proc~bmv lbfgsb_module::bmv proc~cauchy lbfgsb_module::cauchy proc~cauchy->proc~bmv proc~cmprlb lbfgsb_module::cmprlb proc~cmprlb->proc~bmv proc~mainlb lbfgsb_module::mainlb proc~mainlb->proc~cauchy proc~mainlb->proc~cmprlb proc~setulb lbfgsb_module::setulb proc~setulb->proc~mainlb

Source Code

      subroutine bmv(m,Sy,Wt,Col,v,p,Info)
      implicit none

      integer,intent(in) :: m !! the maximum number of variable metric corrections
                              !! used to define the limited memory matrix.
      integer,intent(in) :: Col !! specifies the number of s-vectors (or y-vectors)
                                !! stored in the compact L-BFGS formula.
      integer,intent(out) :: Info !! On exit:
                                  !!
                                  !!  * `info = 0` for normal return,
                                  !!  * `info /=0` for abnormal return when the system
                                  !!    to be solved by [[dtrsl]] is singular.
      real(wp),intent(in) :: Sy(m,m) !! specifies the matrix `S'Y`.
      real(wp),intent(in) :: Wt(m,m) !! specifies the upper triangular matrix `J'` which is
                                     !! the Cholesky factor of `(thetaS'S+LD^(-1)L')`.
      real(wp),intent(in) :: v(2*Col) !! specifies vector `v`.
      real(wp),intent(out) :: p(2*Col) !! the product `Mv`

      integer :: i , k , i2
      real(wp) :: sum

      info = 0 ! JW added
      if ( Col==0 ) return

      ! PART I: solve [  D^(1/2)      O ] [ p1 ] = [ v1 ]
      !               [ -L*D^(-1/2)   J ] [ p2 ]   [ v2 ].

      ! solve Jp2=v2+LD^(-1)v1.
      p(Col+1) = v(Col+1)
      do i = 2 , Col
         i2 = Col + i
         sum = zero
         do k = 1 , i - 1
            sum = sum + Sy(i,k)*v(k)/Sy(k,k)
         enddo
         p(i2) = v(i2) + sum
      enddo
      ! Solve the triangular system
      call dtrsl(Wt,m,Col,p(Col+1),11,Info)
      if ( Info/=0 ) return

      ! solve D^(1/2)p1=v1.
      do i = 1 , Col
         p(i) = v(i)/sqrt(Sy(i,i))
      enddo

      ! PART II: solve [ -D^(1/2)   D^(-1/2)*L'  ] [ p1 ] = [ p1 ]
      !                [  0         J'           ] [ p2 ]   [ p2 ].

      ! solve J^Tp2=p2.
      call dtrsl(Wt,m,Col,p(Col+1),01,Info)
      if ( Info/=0 ) return

      ! compute p1=-D^(-1/2)(p1-D^(-1/2)L'p2)
      !           =-D^(-1/2)p1+D^(-1)L'p2.
      do i = 1 , Col
         p(i) = -p(i)/sqrt(Sy(i,i))
      enddo
      do i = 1 , Col
         sum = zero
         do k = i + 1 , Col
            sum = sum + Sy(k,i)*p(Col+k)/Sy(i,i)
         enddo
         p(i) = p(i) + sum
      enddo

      end subroutine bmv