C ****************************************************************** C ****************************************************************** subroutine spgls(n,x,l,u,m,lambda,rho,equatn,linear,f,g,lamspg, +xp,fp,lsinfo,inform) implicit none C SCALAR ARGUMENTS integer inform,lsinfo,m,n double precision f,fp,lamspg C ARRAY ARGUMENTS logical equatn(m),linear(m) double precision g(n),l(n),lambda(m),rho(m),u(n),x(n),xp(n) C This subroutine computes a line serach in the Spectral Projected C Gradient direction. C C lsinfo: C C 0: Armijo satisfied C 1: Small step with functional value similar to the current one C 2: Unbounded objective function? C 3: Too small backtracking step. Wrong gradient? #include "dim.par" #include "outtyp.com" #include "counters.com" C LOCAL SCALARS integer i double precision alpha,dsupn,gtd,xsupn C LOCAL ARRAYS double precision d(nmax) C EXTERNAL SUBROUTINES external sevalal C ------------------------------------------------------------------ C Compute search direction, directional derivative, dsupn, xsupn and C first trial C ------------------------------------------------------------------ gtd = 0.0d0 dsupn = 0.0d0 xsupn = 0.0d0 do i = 1,n d(i) = - lamspg * g(i) xp(i) = x(i) + d(i) if ( xp(i) .lt. l(i) .or. xp(i) .gt. u(i) ) then xp(i) = max( l(i), min( xp(i), u(i) ) ) d(i) = xp(i) - x(i) end if gtd = gtd + g(i) * d(i) dsupn = max( dsupn, abs( d(i) ) ) xsupn = max( xsupn, abs( x(i) ) ) end do if ( iprintinn .ge. 6 ) then write(* ,100) xsupn,lamspg,dsupn write(10,100) xsupn,lamspg,dsupn end if call sevalal(n,xp,m,lambda,rho,equatn,linear,fp,inform) if ( inform .lt. 0 ) return alpha = 1.0d0 if ( iprintinn .ge. 6 ) then write(*, 110) alpha,fp,fcnt write(10,110) alpha,fp,fcnt end if C ================================================================== C ================================================================== C Backtracking C ================================================================== C ================================================================== call backtracking(n,x,m,lambda,rho,equatn,linear,f,xsupn,d,gtd, +dsupn,alpha,fp,xp,sevalal,lsinfo,inform) if ( inform .lt. 0 ) return C ================================================================== C End of backtracking C ================================================================== C NON-EXECUTABLE STATEMENTS 100 format(/,5X,'SPG Line search (xsupn = ',1P,D7.1,1X,'SPGstep= ', + 1P,D7.1,1X,'dsupn = ',1P,D7.1,')') 110 format( 5X,'Alpha = ',1P,D7.1,' F = ',1P,D24.16,' FE = ',I7) end