update Subroutine

private subroutine update(n, npt, bmat, zmat, ndim, vlag, beta, denom, knew, w)

Arguments

Type IntentOptional Attributes Name
integer :: n
integer :: npt
real :: bmat
real :: zmat
integer :: ndim
real :: vlag
real :: beta
real :: denom
integer :: knew
real :: w

Called by

proc~~update~3~~CalledByGraph proc~update~3 update proc~bobyqb bobyqb proc~bobyqb->proc~update~3 proc~rescue rescue proc~bobyqb->proc~rescue proc~rescue->proc~update~3 proc~bobyqa bobyqa proc~bobyqa->proc~bobyqb proc~bobyqa_test bobyqa_test proc~bobyqa_test->proc~bobyqa

Source Code

    subroutine update (n, npt, bmat, zmat, ndim, vlag, beta, denom, knew, w)

        implicit real (wp) (a-h, o-z)

        dimension bmat (ndim,*), zmat (npt,*), vlag (*), w (*)
!
!     The arrays BMAT and ZMAT are updated, as required by the new position
!     of the interpolation point that has the index KNEW. The vector VLAG has
!     N+NPT components, set on entry to the first NPT and last N components
!     of the product Hw in equation (4.11) of the Powell (2006) paper on
!     NEWUOA. Further, BETA is set on entry to the value of the parameter
!     with that name, and DENOM is set to the denominator of the updating
!     formula. Elements of ZMAT may be treated as zero if their moduli are
!     at most ZTEST. The first NDIM elements of W are used for working space.
!
!     Set some constants.
!
        one = 1.0_wp
        zero = 0.0_wp
        nptm = npt - n - 1
        ztest = zero
        do k = 1, npt
            do j = 1, nptm
                ztest = max (ztest, abs(zmat(k, j)))
            end do
        end do
        ztest = 1.0e-20_wp * ztest
!
!     Apply the rotations that put zeros in the KNEW-th row of ZMAT.
!
        jl = 1
        do j = 2, nptm
            if (abs(zmat(knew, j)) > ztest) then
                temp = sqrt (zmat(knew, 1)**2+zmat(knew, j)**2)
                tempa = zmat (knew, 1) / temp
                tempb = zmat (knew, j) / temp
                do i = 1, npt
                    temp = tempa * zmat (i, 1) + tempb * zmat (i, j)
                    zmat (i, j) = tempa * zmat (i, j) - tempb * zmat (i, 1)
                    zmat (i, 1) = temp
                end do
            end if
            zmat (knew, j) = zero
        end do
!
!     Put the first NPT components of the KNEW-th column of HLAG into W,
!     and calculate the parameters of the updating formula.
!
        do i = 1, npt
            w (i) = zmat (knew, 1) * zmat (i, 1)
        end do
        alpha = w (knew)
        tau = vlag (knew)
        vlag (knew) = vlag (knew) - one
!
!     Complete the updating of ZMAT.
!
        temp = sqrt (denom)
        tempb = zmat (knew, 1) / temp
        tempa = tau / temp
        do i = 1, npt
            zmat (i, 1) = tempa * zmat (i, 1) - tempb * vlag (i)
        end do
!
!     Finally, update the matrix BMAT.
!
        do j = 1, n
            jp = npt + j
            w (jp) = bmat (knew, j)
            tempa = (alpha*vlag(jp)-tau*w(jp)) / denom
            tempb = (-beta*w(jp)-tau*vlag(jp)) / denom
            do i = 1, jp
                bmat (i, j) = bmat (i, j) + tempa * vlag (i) + tempb * w (i)
                if (i > npt) bmat (jp, i-npt) = bmat (i, j)
            end do
        end do

    end subroutine update