https://github.com/cran/nleqslv
Tip revision: 841972b2cdbfaddf568c3813f28ee733b4382d77 authored by Berend Hasselman on 26 November 2023, 23:30:14 UTC
version 3.3.5
version 3.3.5
Tip revision: 841972b
nwqlsh.f
subroutine nwqlsh(n,xc,fcnorm,d,g,stepmx,xtol,scalex,fvec,
* xp,fp,fpnorm,xw,retcd,gcnt,priter,iter)
integer n,retcd,gcnt
double precision stepmx,xtol,fcnorm,fpnorm
double precision xc(*)
double precision d(*),g(*),xp(*),fp(*),xw(*)
double precision scalex(*)
external fvec
integer priter,iter
c-------------------------------------------------------------------------
c
c Find a next acceptable iterate using a safeguarded quadratic line search
c along the newton direction
c
c Arguments
c
c In n Integer dimension of problem
c In xc Real(*) current iterate
c In fcnorm Real 0.5 * || f(xc) ||**2
c In d Real(*) newton direction
c In g Real(*) gradient at current iterate
c In stepmx Real maximum stepsize
c In xtol Real relative step size at which
c successive iterates are considered
c close enough to terminate algorithm
c In scalex Real(*) diagonal scaling matrix for x()
c In fvec Name name of routine to calculate f()
c In xp Real(*) new x()
c In fp Real(*) new f(x)
c In fpnorm Real .5*||fp||**2
c Out xw Real(*) workspace for unscaling x(*)
c
c Out retcd Integer return code
c 0 new satisfactory x() found
c 1 no satisfactory x() found
c sufficiently distinct from xc()
c
c Out gcnt Integer number of steps taken
c In priter Integer >0 unit if intermediate steps to be printed
c -1 if no printing
c
c-------------------------------------------------------------------------
integer i
double precision alpha,slope,rsclen,oarg(4)
double precision lambda,lamhi,lamlo,t
double precision ddot,dnrm2, nudnrm, ftarg
double precision dlen
integer idamax
parameter (alpha = 1.0d-4)
double precision Rone, Rtwo, Rten
parameter(Rone=1.0d0, Rtwo=2.0d0, Rten=10.0d0)
c safeguard initial step size
dlen = dnrm2(n,d,1)
if( dlen .gt. stepmx ) then
lamhi = stepmx / dlen
else
lamhi = Rone
endif
c compute slope = g-trans * d
slope = ddot(n,g,1,d,1)
c compute the smallest value allowable for the damping
c parameter lambda ==> lamlo
rsclen = nudnrm(n,d,xc)
lamlo = xtol / rsclen
c initialization of retcd and lambda (linesearch length)
retcd = 2
lambda = lamhi
gcnt = 0
do while( retcd .eq. 2 )
c compute next x
do i=1,n
xp(i) = xc(i) + lambda*d(i)
enddo
c evaluate functions and the objective function at xp
call nwfvec(xp,n,scalex,fvec,fp,fpnorm,xw)
gcnt = gcnt + 1
ftarg = fcnorm + alpha * lambda * slope
if( priter .gt. 0) then
oarg(1) = lambda
oarg(2) = ftarg
oarg(3) = fpnorm
oarg(4) = abs(fp(idamax(n,fp,1)))
call nwlsot(iter,1,oarg)
endif
c test whether the standard step produces enough decrease
c of the objective function.
c If not update lambda and compute a new next iterate
if( fpnorm .le. ftarg ) then
retcd = 0
else
t = ((-lambda**2)*slope/Rtwo)/(fpnorm-fcnorm-lambda*slope)
lambda = max(lambda / Rten , t)
if(lambda .lt. lamlo) then
retcd = 1
endif
endif
enddo
return
end