subroutine LSUPDXX( & nn, ifail, lphprint & , jmin, jmax, nupdate & , ff, fmin, fold, gnorm0, dotdg & , gg, dd, xx, xdiff & , tmin, tmax, tact, epsx & ) c ================================================================== c SUBROUTINE lsupdxx c ================================================================== c c o conceived for variable online/offline version c computes - new descent direction dd based on latest c available gradient c - new tact based on new dd c - new control vector xx needed for offline run c c o started: Patrick Heimbach, MIT/EAPS c 29-Feb-2000: c c o Version 2.1.0, 02-Mar-2000: Patrick Heimbach, MIT/EAPS c c ================================================================== c SUBROUTINE lsupdxx c ================================================================== c #include "blas1.h" implicit none c----------------------------------------- c declare arguments c----------------------------------------- integer nn, jmin, jmax, nupdate, ifail double precision ff, fmin, fold, gnorm0, dotdg double precision gg(nn), dd(nn), xx(nn), xdiff(nn) double precision tmin, tmax, tact, epsx logical lphprint c----------------------------------------- C declare local variables c----------------------------------------- integer i double precision fdiff, preco double precision DDOT external c ================================================================== c----------------------------------------- c use Fletchers scaling c and initialize diagional to 1. c----------------------------------------- c if ( ( jmax .eq. 0 ) .or. (nupdate .eq. 0 ) ) then if (jmax .eq. 0) then fold = fmin if (lphprint) & print *, 'pathei-lsopt: using fold = fmin = ', fmin end
if fdiff = fold - ff if (jmax .eq. 0) fdiff = ABS(fdiff) preco = 2. * fdiff / (gnorm0*gnorm0) do i = 1, nn dd(i) = -gg(i)*preco end
do if (lphprint) & print *, 'pathei-lsopt: first estimate of dd via ', & 'fold - ff' c----------------------------------------- c use the matrix stored in [diag] c and the (y,s) pairs c----------------------------------------- else do i = 1, nn dd(i) = -gg(i) end
do if (jmax .gt. 0) then call HESSUPD( nn, nupdate, dd, jmin, jmax, xdiff, & lphprint ) else if (lphprint) & print *, 'pathei-lsopt: no hessupd for first optim.' end
if endif c----------------------------------------- c check whether new direction is a descent one c----------------------------------------- dotdg = DDOT( nn, dd, 1, gg, 1 ) if (dotdg .ge. 0.0) then ifail = 4 goto 999 end
if c---------------------------------- c declare arguments c---------------------------------- tmin = 0. do i = 1, nn tmin = max( tmin, abs(dd(i)) ) end
do tmin = epsx/tmin c---------------------------------- c make sure that t is between c tmin and tmax c---------------------------------- tact = 1.0 tmax = 1.0e+10 if (tact.le.tmin) then tact = tmin if (tact.gt.tmax) then tmin = tmax endif endif if (tact .gt. tmax) then tact = tmax ifail = 7 endif c---------------------------------- c compute new x c---------------------------------- do i = 1, nn xdiff(i) = xx(i) + tact*dd(i) end
do c---------------------------------- c save new x to file for offline version c---------------------------------- 999 continue return end