dynare_solve

 Copyright (C) 2001 Michel Juillard

0001 % Copyright (C) 2001 Michel Juillard
0002 %
0003 function [x,cheik] = dynare_solve(func,x,jacobian_flag,varargin)
0004   global options_
0005   
0006   options_ = set_default_option(options_,'solve_algo',2);
0007   cheik = 0;
0008   if options_.solve_algo == 0
0009     if ~isempty(which('fsolve')) & sscanf(version('-release'),'%d') >= 13;
0010       options=optimset('fsolve');
0011       options.MaxFunEvals = 20000;
0012       options.TolFun=1e-8;
0013       options.Display = 'off';
0014       if jacobian_flag
0015     options.Jacobian = 'on';
0016       else
0017     options.Jacobian = 'on';
0018       end
0019       [x,fval,exitval,output] = fsolve(func,x,options,varargin{:});
0020       if exitval > 0
0021     cheik = 0;
0022       else
0023     cheik = 1;
0024       end
0025       return
0026     else 
0027       options_.solve_algo = 1;
0028     end
0029   end
0030 
0031   if options_.solve_algo == 1
0032     nn = size(x,1) ;
0033     [x,cheik]=solve1(func,x,1:nn,1:nn,jacobian_flag,varargin{:});
0034   elseif options_.solve_algo == 2
0035     nn = size(x,1) ;
0036     tolf = eps^(2/3) ;
0037 
0038     if jacobian_flag
0039       [fvec,fjac] = feval(func,x,varargin{:});
0040     else
0041       fvec = feval(func,x,varargin{:});
0042       fjac = zeros(nn,nn) ;
0043     end
0044 
0045     i = find(~isfinite(fvec));
0046     
0047     if ~isempty(i)
0048       disp(['STEADY:  numerical initial values incompatible with the following' ...
0049         ' equations'])
0050       disp(i')
0051       error('exiting ...')
0052     end
0053     
0054     f = 0.5*fvec'*fvec ;
0055 
0056     if max(abs(fvec)) < 0.01*tolf
0057       return ;
0058     end
0059 
0060     if ~jacobian_flag
0061       fjac = zeros(nn,nn) ;
0062       dh = max(abs(x),options_.gstep*ones(nn,1))*eps^(1/3);
0063       for j = 1:nn
0064     xdh = x ;
0065     xdh(j) = xdh(j)+dh(j) ;
0066     fjac(:,j) = (feval(func,xdh,varargin{:}) - fvec)./dh(j) ;
0067       end
0068     end
0069 
0070     [j1,j2,r,s] = dmperm(fjac);
0071     
0072     for i=length(r)-1:-1:1
0073       [x,cheik]=solve1(func,x,j1(r(i):r(i+1)-1),j2(r(i):r(i+1)-1),jacobian_flag,varargin{:});
0074       if cheik
0075     error(sprintf('Solve block = %d check = %d\n',i,cheik));
0076       end
0077     end
0078     [x,cheik]=solve1(func,x,1:nn,1:nn,jacobian_flag,varargin{:});
0079       
0080   end
0081 %    fvec1 = feval(func,x,varargin{:})
0082 
0083   % 08/28/03 MJ add a final call to solve1 for solve_algo == 1 in case
0084   %             initvals generates 'false' zeros in the Jacobian
0085