lnsrch

 Copyright (C) 2001 Michel Juillard

0001 % Copyright (C) 2001 Michel Juillard
0002 %
0003 function [x,f,fvec,check]=lnsrch(xold,fold,g,p,stpmax,func,varargin)
0004 
0005   alf = 1e-4 ;
0006   tolx = 3.7e-11 ;
0007   alam = 1;
0008   
0009   nn = size(xold,1) ;
0010   summ = sqrt(sum(p.*p)) ;
0011   if ~isfinite(summ)
0012     error(['Some element of Newton direction isn''t finite. Jacobian maybe' ...
0013        ' singular or there is a problem with initial values'])
0014   end
0015   
0016   if summ > stpmax
0017     p=p.*stpmax/summ ;
0018   end
0019 
0020   slope = g'*p ;
0021   
0022   test = max(abs(p)'./max([abs(xold)';ones(1,nn)])) ;
0023   alamin = tolx/test ;
0024 
0025   if alamin > 0.1
0026     alamin = 0.1;
0027   end
0028   
0029   while 1
0030     if alam < alamin
0031       check = 1 ;
0032       return
0033     end
0034     
0035     x = xold + (alam*p) ;
0036     fvec = feval(func,x,varargin{:}) ;
0037     f = 0.5*fvec'*fvec ;
0038 
0039     if any(isnan(fvec))
0040       alam = alam/2 ;
0041       alam2 = alam ;
0042       f2 = f ;
0043       fold2 = fold ;
0044     else
0045 
0046       if f <= fold+alf*alam*slope
0047     check = 0;
0048     break ;
0049       else
0050     if alam == 1
0051       tmplam = -slope/(2*(f-fold-slope)) ;
0052     else
0053       rhs1 = f-fold-alam*slope ;
0054       rhs2 = f2-fold2-alam2*slope ;
0055       a = (rhs1/(alam^2)-rhs2/(alam2^2))/(alam-alam2) ;
0056       b = (-alam2*rhs1/(alam^2)+alam*rhs2/(alam2^2))/(alam-alam2) ;
0057       if a == 0
0058         tmplam = -slope/(2*b) ;
0059       else
0060         disc = (b^2)-3*a*slope ;
0061 
0062         if disc < 0
0063           error ('Roundoff problem in nlsearch') ;
0064         else
0065           tmplam = (-b+sqrt(disc))/(3*a) ;
0066         end
0067 
0068       end
0069 
0070       if tmplam > 0.5*alam
0071         tmplam = 0.5*alam;
0072       end
0073 
0074     end
0075 
0076     alam2 = alam ;
0077     f2 = f ;
0078     fold2 = fold ;
0079     alam = max([tmplam;(0.1*alam)]) ;
0080       end
0081     end
0082   end
0083 
0084 % 01/14/01 MJ lnsearch is now a separate function
0085 % 01/12/03 MJ check for finite summ to avoid infinite loop when Jacobian
0086 %             is singular or model is denormalized