bfgs_variable_metric_update Subroutine

private subroutine bfgs_variable_metric_update(n, h, g, s, xo, go, r, po, nit, kit, iterh, met, met1, mec)

variable metric update of a dense symmetric positive definite matrix using the factorization b=ldtrans(l).

Method

bfgs variable metric method.

Note

This routine was formerly called pudbg1.

Arguments

Type IntentOptional Attributes Name
integer :: n

actual number of variables.
real(kind=wp) :: h(*)

h(m) factorization b=ldtrans(l) of a positive definite approximation of the hessian matrix.
real(kind=wp) :: g(*)

g(nf) gradient of the objective function.
real(kind=wp) :: s(*)

s(nf) auxiliary vector.
real(kind=wp) :: xo(*)

xo(nf) vectors of variables difference.
real(kind=wp) :: go(*)

go(nf) gradients difference.
real(kind=wp) :: r

value of the stepsize parameter.
real(kind=wp) :: po

old value of the directional derivative.
integer :: nit

actual number of iterations.
integer :: kit

number of the iteration after last restart.
integer :: iterh

termination indicator.

  • iterh<0-bad decomposition.
  • iterh=0-successful update.
  • iterh>0-nonpositive parameters.
integer :: met
integer :: met1

selection of self scaling.

  • met1=1-self scaling suppressed.
  • met1=2 initial self scaling.
integer :: mec

correction if the negative curvature occurs.

  • mec=1-correction suppressed.
  • mec=2-powell's correction.

Calls

proc~~bfgs_variable_metric_update~~CallsGraph proc~bfgs_variable_metric_update bfgs_variable_metric_update proc~mxdpgb mxdpgb proc~bfgs_variable_metric_update->proc~mxdpgb proc~mxdpgp mxdpgp proc~bfgs_variable_metric_update->proc~mxdpgp proc~mxdpgs mxdpgs proc~bfgs_variable_metric_update->proc~mxdpgs proc~mxdpgu mxdpgu proc~bfgs_variable_metric_update->proc~mxdpgu proc~mxvcop mxvcop proc~bfgs_variable_metric_update->proc~mxvcop proc~mxvdif mxvdif proc~bfgs_variable_metric_update->proc~mxvdif proc~mxvdir mxvdir proc~bfgs_variable_metric_update->proc~mxvdir proc~mxvdot mxvdot proc~bfgs_variable_metric_update->proc~mxvdot proc~mxvscl mxvscl proc~bfgs_variable_metric_update->proc~mxvscl proc~mxdpgu->proc~mxvscl

Called by

proc~~bfgs_variable_metric_update~~CalledByGraph proc~bfgs_variable_metric_update bfgs_variable_metric_update proc~psqp psqp_class%psqp proc~psqp->proc~bfgs_variable_metric_update proc~psqpn psqp_class%psqpn proc~psqpn->proc~psqp

Source Code

   subroutine bfgs_variable_metric_update(n, h, g, s, xo, go, r, po, nit, &
                                          kit, iterh, met, met1, mec)

      real(wp) :: po  !! old value of the directional derivative.
      real(wp) :: r  !! value of the stepsize parameter.
      integer :: iterh   !! termination indicator.
                         !!
                         !! * iterh<0-bad decomposition.
                         !! * iterh=0-successful update.
                         !! * iterh>0-nonpositive parameters.
      integer :: kit   !! number of the iteration after last restart.
      integer :: met   !!
      integer :: met1   !! selection of self scaling.
                        !!
                        !! * met1=1-self scaling suppressed.
                        !! * met1=2 initial self scaling.
      integer :: mec   !! correction if the negative curvature occurs.
                       !!
                       !! * mec=1-correction suppressed.
                       !! * mec=2-powell's correction.
      integer :: n   !! actual number of variables.
      integer :: nit  !! actual number of iterations.
      real(wp) :: g(*)   !! g(nf)  gradient of the objective function.
      real(wp) :: go(*)   !! go(nf)  gradients difference.
      real(wp) :: h(*)   !! h(m)  factorization b=l*d*trans(l) of a positive
                         !! definite approximation of the hessian matrix.
      real(wp) :: s(*)   !! s(nf)  auxiliary vector.
      real(wp) :: xo(*)  !! xo(nf)  vectors of variables difference.

      real(wp) :: a, b, c, gam, par, den, dis
      logical :: l1, l3

      l1 = met1 >= 3 .or. met1 == 2 .and. nit == kit
      l3 = .not. l1

      ! determination of the parameters b, c
      b = mxvdot(n, xo, go)
      a = 0.0_wp
      if (l1) then
         call mxvcop(n, go, s)
         call mxdpgb(n, h, s, 1)
         a = mxdpgp(n, h, s, s)
         if (a <= 0.0_wp) then
            iterh = 1
            return
         end if
      end if
      call mxvdif(n, go, g, s)
      call mxvscl(n, r, s, s)
      c = -r*po
      if (c <= 0.0_wp) then
         iterh = 3
         return
      end if
      if (mec > 1) then
         if (b <= 1.0e-4_wp*c) then
            ! powell's correction
            dis = (1.0_wp - 0.1_wp)*c/(c - b)
            call mxvdif(n, go, s, go)
            call mxvdir(n, dis, go, s, go)
            b = c + dis*(b - c)
            if (l1) a = c + 2.0_wp*(1.0_wp - dis)*(b - c) + dis*dis*(a - c)
         end if
      elseif (b <= 1.0e-4_wp*c) then
         iterh = 2
         return
      end if
      if (l1) then
         ! determination of the parameter gam (self scaling)
         if (met == 1) then
            par = c/b
         elseif (a <= 0.0_wp) then
            par = c/b
         else
            par = sqrt(c/a)
         end if
         gam = par
         if (met1 > 1) then
            if (nit /= kit) l3 = gam < 0.5_wp .or. gam > 4.0_wp
         end if
      end if
      if (l3) then
         gam = 1.0_wp
         par = gam
      end if
      if (met == 1) then
         ! bfgs update
         call mxdpgu(n, h, par/b, go, xo)
         call mxdpgu(n, h, -1.0_wp/c, s, xo)
      else
         ! hoshino update
         den = par*b + c
         dis = 0.5_wp*b
         call mxvdir(n, par, go, s, s)
         call mxdpgu(n, h, par/dis, go, xo)
         call mxdpgu(n, h, -1.0_wp/den, s, xo)
      end if
      iterh = 0
      if (gam == 1.0_wp) return
      call mxdpgs(n, h, 1.0_wp/gam)

   end subroutine bfgs_variable_metric_update