dr1

 Copyright (C) 2001 Michel Juillard

0001 % Copyright (C) 2001 Michel Juillard
0002 %
0003 function [dr,info]=dr1(dr,task)
0004 global M_ options_ oo_
0005 
0006 global olr_state
0007 % info = 1: the model doesn't define current variables uniquely
0008 % info = 2: problem in mjdgges.dll info(2) contains error code
0009 % info = 3: BK order condition not satisfied info(2) contains "distance"
0010 %           absence of stable trajectory
0011 % info = 4: BK order condition not satisfied info(2) contains "distance"
0012 %           indeterminacy
0013 % info = 5: BK rank condition not satisfied
0014 
0015 
0016 
0017   info = 0;
0018   
0019   options_ = set_default_option(options_,'loglinear',0);
0020   options_ = set_default_option(options_,'noprint',0);
0021   options_ = set_default_option(options_,'olr',0);
0022   options_ = set_default_option(options_,'olr_beta',1);
0023   options_ = set_default_option(options_,'qz_criterium',1.000001);
0024 
0025 xlen = M_.maximum_lead + M_.maximum_lag + 1;
0026 klen = M_.maximum_lag + M_.maximum_lead + 1;
0027 iyv = M_.lead_lag_incidence';
0028 iyv = iyv(:);
0029 iyr0 = find(iyv) ;
0030 it_ = M_.maximum_lag + 1 ;
0031 
0032 if M_.exo_nbr == 0
0033   oo_.exo_steady_state = [] ;
0034 end
0035 
0036 tempex = oo_.exo_simul;
0037 
0038 it_ = M_.maximum_lag + 1;
0039 if options_.olr
0040   z = repmat(zeros(M_.endo_nbr,1),1,klen);
0041 else
0042   z = repmat(dr.ys,1,klen);
0043 end
0044 z = z(iyr0) ;
0045 if options_.order == 1
0046   [junk,jacobia_] = feval([M_.fname '_dynamic'],z,tempex);
0047 elseif options_.order == 2
0048     [junk,jacobia_,hessian] = feval([M_.fname '_dynamic'],z,...
0049                     [oo_.exo_simul ...
0050                              oo_.exo_det_simul]);
0051 end
0052 
0053 oo_.exo_simul = tempex ;
0054 tempex = [];
0055 
0056 % expanding system for Optimal Linear Regulator
0057 if options_.olr
0058   bet = options_.olr_beta;
0059   jacobia1 = [];
0060   n_inst = size(options_.olr_inst,1);
0061 
0062   if ~isfield(olr_state_,'done')
0063     olr_state_.done = 1;
0064     olr_state_.old_M_.maximum_lag = M_.maximum_lag;
0065     olr_state_.old_M_.maximum_lead = M_.maximum_lead;
0066     olr_state_.old_M_.endo_nbr = M_.endo_nbr;
0067     olr_state_.old_M_.lead_lag_incidence = M_.lead_lag_incidence;
0068     
0069     for i=1:M_.endo_nbr
0070       temp = ['mult_' int2str(i)];
0071       lgoo_.endo_simul = strvcat(lgoo_.endo_simul,temp);
0072     end
0073     M_.endo_nbr = 2*M_.endo_nbr-n_inst;
0074     M_.maximum_lag = max(M_.maximum_lag,M_.maximum_lead);
0075     M_.maximum_lead = M_.maximum_lag;
0076   end    
0077   nj = olr_state_.old_M_.endo_nbr-n_inst;
0078   offset_min = M_.maximum_lag - olr_state_.old_M_.maximum_lag;
0079   offset_max = M_.maximum_lead - olr_state_.old_M_.maximum_lead;
0080   newiy = zeros(2*M_.maximum_lag+1,nj+olr_state_.old_M_.endo_nbr);
0081   jacobia_ = jacobia_(1:nj,:);
0082   for i=1:2*M_.maximum_lag+1
0083     if i > offset_min & i <= 2*M_.maximum_lag+1-offset_max
0084       [junk,k1,k2] = find(olr_state_.old_M_.lead_lag_incidence(i-offset_min,:));
0085       if i == M_.maximum_lag+1
0086     jacobia1 = [jacobia1 [jacobia_(:,k2); 2*options_.olr_w]];
0087       else
0088     jacobia1 = [jacobia1 [jacobia_(:,k2); ...
0089             zeros(olr_state_.old_M_.endo_nbr,length(k1))]];
0090       end
0091       newiy(i,k1) = ones(1,length(k1));
0092     end
0093     i1  = 2*M_.maximum_lag+2-i;
0094     if i1 <= 2*M_.maximum_lag+1-offset_max & i1 > offset_min 
0095       [junk,k1,k2] = find(olr_state_.old_M_.lead_lag_incidence(i1-offset_min,:));
0096       k3 = find(any(jacobia_(:,k2),2));
0097       x = zeros(olr_state_.old_M_.endo_nbr,length(k3));
0098       x(k1,:) = bet^(-i1+M_.maximum_lag+1)*jacobia_(k3,k2)';
0099       jacobia1  = [jacobia1 [zeros(nj,length(k3)); x]];
0100       newiy(i,k3+olr_state_.old_M_.endo_nbr) = ones(1,length(k3));
0101     end      
0102   end
0103   jacobia1 = [jacobia1 [jacobia_(:,end-M_.exo_nbr+1:end); ...
0104             zeros(olr_state_.old_M_.endo_nbr, M_.exo_nbr)]];
0105   newiy = newiy';
0106   newiy = find(newiy(:));
0107   M_.lead_lag_incidence = zeros(M_.endo_nbr*(M_.maximum_lag+M_.maximum_lead+1),1);
0108   M_.lead_lag_incidence(newiy) = [1:length(newiy)]';
0109   M_.lead_lag_incidence =reshape(M_.lead_lag_incidence,M_.endo_nbr,M_.maximum_lag+M_.maximum_lead+1)';
0110   jacobia_ = jacobia1;
0111   clear jacobia1
0112   % computes steady state
0113   resid = feval([M_.fname '_steady'],zeros(olr_state_.old_M_.endo_nbr,1));
0114   if resid'*resid < 1e-12
0115     dr.ys =[dr.ys; zeros(nj,1)];
0116   else
0117     AA = zeros(M_.endo_nbr,M_.endo_nbr);
0118     for i=1:M_.maximum_lag+M_.maximum_lead+1
0119       [junk,k1,k2] = find(M_.lead_lag_incidence(i,:));
0120       AA(:,k1) = AA(:,k1)+jacobia_(:,k2);
0121     end
0122     dr.ys = -AA\[resid; zeros(nj,1)];
0123   end
0124 end
0125 % end of code section for Optimal Linear Regulator
0126 
0127 klen = M_.maximum_lag + M_.maximum_lead + 1;
0128 dr=set_state_space(dr);
0129 kstate = dr.kstate;
0130 kad = dr.kad;
0131 kae = dr.kae;
0132 nstatic = dr.nstatic;
0133 nfwrd = dr.nfwrd;
0134 npred = dr.npred;
0135 nboth = dr.nboth;
0136 order_var = dr.order_var;
0137 nd = size(kstate,1);
0138 nz = nnz(M_.lead_lag_incidence);
0139 
0140 sdyn = M_.endo_nbr - nstatic;
0141 
0142 k0 = M_.lead_lag_incidence(M_.maximum_lag+1,order_var);
0143 k1 = M_.lead_lag_incidence(find([1:klen] ~= M_.maximum_lag+1),:);
0144 b = jacobia_(:,k0);
0145 
0146 if M_.maximum_lead == 0;  % backward models
0147   a = jacobia_(:,nonzeros(k1'));
0148   dr.ghx = zeros(size(a));
0149   m = 0;
0150   for i=M_.maximum_lag:-1:1
0151     k = nonzeros(M_.lead_lag_incidence(i,order_var));
0152     dr.ghx(:,m+[1:length(k)]) = -b\a(:,k);
0153     m = m+length(k);
0154   end
0155   if M_.exo_nbr
0156     dr.ghu = -b\jacobia_(:,nz+1:end);
0157   end
0158   dr.eigval = eig(transition_matrix(dr));
0159   dr.rank = 0;
0160   if any(abs(dr.eigval) > options_.qz_criterium)
0161     temp = sort(abs(dr.eigval));
0162     nba = nnz(abs(dr.eigval) > options_.qz_criterium);
0163     temp = temp(nd-nba+1:nd)-1-options_.qz_criterium;
0164     info(1) = 3;
0165     info(2) = temp'*temp;
0166   end
0167   return;
0168 end
0169 
0170 %forward--looking models
0171 if nstatic > 0
0172   [Q,R] = qr(b(:,1:nstatic));
0173   aa = Q'*jacobia_;
0174 else
0175   aa = jacobia_;
0176 end
0177 a = aa(:,nonzeros(k1'));
0178 b = aa(:,k0);
0179 b10 = b(1:nstatic,1:nstatic);
0180 b11 = b(1:nstatic,nstatic+1:end);
0181 b2 = b(nstatic+1:end,nstatic+1:end);
0182 if any(isinf(a(:)))
0183   info = 1;
0184   return
0185 end
0186 if M_.exo_nbr
0187   fu = aa(:,nz+(1:M_.exo_nbr));
0188 end
0189 clear aa;
0190 
0191 % buildind D and E
0192 d = zeros(nd,nd) ;
0193 e = d ;
0194 
0195 k = find(kstate(:,2) >= M_.maximum_lag+2 & kstate(:,3));
0196 d(1:sdyn,k) = a(nstatic+1:end,kstate(k,3)) ;
0197 k1 = find(kstate(:,2) == M_.maximum_lag+2);
0198 e(1:sdyn,k1) =  -b2(:,kstate(k1,1)-nstatic);
0199 k = find(kstate(:,2) <= M_.maximum_lag+1 & kstate(:,4));
0200 e(1:sdyn,k) = -a(nstatic+1:end,kstate(k,4)) ;
0201 k2 = find(kstate(:,2) == M_.maximum_lag+1);
0202 k2 = k2(~ismember(kstate(k2,1),kstate(k1,1)));
0203 d(1:sdyn,k2) = b2(:,kstate(k2,1)-nstatic);
0204 
0205 if ~isempty(kad)
0206   for j = 1:size(kad,1)
0207     d(sdyn+j,kad(j)) = 1 ;
0208     e(sdyn+j,kae(j)) = 1 ;
0209   end
0210 end
0211 
0212 if ~exist('mjdgges')
0213   % using Chris Sim's routines
0214   use_qzdiv = 1;
0215   [ss,tt,qq,w] = qz(e,d);
0216   [tt,ss,qq,w] = qzdiv(options_.qz_criterium,tt,ss,qq,w);
0217   ss1=diag(ss);
0218   tt1=diag(tt);
0219   warning_state = warning;
0220   warning off;
0221   dr.eigval = ss1./tt1 ;
0222   warning warning_state;
0223   nba = nnz(abs(dr.eigval) > options_.qz_criterium);
0224 else
0225   use_qzdiv = 0;
0226   [ss,tt,w,sdim,dr.eigval,info1] = mjdgges(e,d,options_.qz_criterium);
0227   if info1
0228     info(1) = 2;
0229     info(2) = info1;
0230     return
0231   end
0232   nba = nd-sdim;
0233 end
0234 
0235 nyf = sum(kstate(:,2) > M_.maximum_lag+1);
0236 
0237 if task == 1
0238   dr.rank = rank(w(1:nyf,nd-nyf+1:end));
0239   dr.eigval = eig(e,d);
0240   return
0241 end
0242 
0243 if nba ~= nyf
0244   temp = sort(abs(dr.eigval));
0245   if nba > nyf
0246     temp = temp(nd-nba+1:nd-nyf)-1-options_.qz_criterium;
0247     info(1) = 3;
0248   elseif nba < nyf;
0249     temp = temp(nd-nyf+1:nd-nba)-1-options_.qz_criterium;
0250     info(1) = 4;
0251   end
0252   info(2) = temp'*temp;
0253   return
0254 end
0255 
0256 np = nd - nyf;
0257 n2 = np + 1;
0258 n3 = nyf;
0259 n4 = n3 + 1;
0260 % derivatives with respect to dynamic state variables
0261 % forward variables
0262 w1 =w(1:n3,n2:nd);
0263 if condest(w1) > 1e9;
0264   info(1) = 5;
0265   info(2) = condest(w1);
0266   return;
0267 else
0268   gx = -w1'\w(n4:nd,n2:nd)';
0269 end  
0270 
0271 % predetermined variables
0272 hx = w(1:n3,1:np)'*gx+w(n4:nd,1:np)';
0273 hx = (tt(1:np,1:np)*hx)\(ss(1:np,1:np)*hx);
0274 
0275 k1 = find(kstate(n4:nd,2) == M_.maximum_lag+1);
0276 k2 = find(kstate(1:n3,2) == M_.maximum_lag+2);
0277 dr.ghx = [hx(k1,:); gx(k2(nboth+1:end),:)];
0278 
0279 %lead variables actually present in the model
0280 j3 = nonzeros(kstate(:,3));
0281 j4  = find(kstate(:,3));
0282 % derivatives with respect to exogenous variables
0283 if M_.exo_nbr
0284   a1 = b;
0285   aa1 = [];
0286   if nstatic > 0
0287     aa1 = a1(:,1:nstatic);
0288   end
0289   dr.ghu = -[aa1 a(:,j3)*gx(j4,1:npred)+a1(:,nstatic+1:nstatic+ ...
0290                           npred) a1(:,nstatic+npred+1:end)]\fu;
0291 end
0292 
0293 % static variables
0294 if nstatic > 0
0295   temp = -a(1:nstatic,j3)*gx(j4,:)*hx;
0296   j5 = find(kstate(n4:nd,4));
0297   temp(:,j5) = temp(:,j5)-a(1:nstatic,nonzeros(kstate(:,4)));
0298   temp = b10\(temp-b11*dr.ghx);
0299   dr.ghx = [temp; dr.ghx];
0300   temp = [];
0301 end
0302 
0303 if options_.loglinear == 1
0304     k = find(dr.kstate(:,2) <= M_.maximum_lag+1);
0305     klag = dr.kstate(k,[1 2]);
0306     k1 = dr.order_var;
0307 
0308     dr.ghx = repmat(1./dr.ys(k1),1,size(dr.ghx,2)).*dr.ghx.* ...
0309          repmat(dr.ys(k1(klag(:,1)))',size(dr.ghx,1),1);
0310     dr.ghu = repmat(1./dr.ys(k1),1,size(dr.ghu,2)).*dr.ghu;
0311 end
0312 
0313 %necessary when using Sims' routines
0314 if use_qzdiv
0315   gx = real(gx);
0316   hx = real(hx);
0317   dr.ghx = real(dr.ghx);
0318   dr.ghu = real(dr.ghu);
0319 end
0320 
0321 %exogenous deterministic variables
0322 if M_.exo_det_nbr > 0
0323   f1 = sparse(jacobia_(:,nonzeros(M_.lead_lag_incidence(M_.maximum_lag+2:end,order_var))));
0324   f0 = sparse(jacobia_(:,nonzeros(M_.lead_lag_incidence(M_.maximum_lag+1,order_var))));
0325   fudet = sparse(jacobia_(:,nz+M_.exo_nbr+1:end));
0326   M1 = inv(f0+[zeros(M_.endo_nbr,nstatic) f1*gx zeros(M_.endo_nbr,nyf-nboth)]);
0327   M2 = M1*f1;
0328   dr.ghud = cell(M_.exo_det_length,1);
0329   dr.ghud{1} = -M1*fudet;
0330   for i = 2:M_.exo_det_length
0331     dr.ghud{i} = -M2*dr.ghud{i-1}(end-nyf+1:end,:);
0332   end
0333 end
0334 
0335 if options_.order == 1
0336   return
0337 end
0338 
0339 % Second order
0340 %tempex = oo_.exo_simul ;
0341 
0342 %hessian = real(hessext('ff1_',[z; oo_.exo_steady_state]))' ;
0343 kk = flipud(cumsum(flipud(M_.lead_lag_incidence(M_.maximum_lag+1:end,order_var)),1));
0344 if M_.maximum_lag > 0
0345   kk = [cumsum(M_.lead_lag_incidence(1:M_.maximum_lag,order_var),1); kk];
0346 end
0347 kk = kk';
0348 kk = find(kk(:));
0349 nk = size(kk,1) + M_.exo_nbr + M_.exo_det_nbr;
0350 k1 = M_.lead_lag_incidence(:,order_var);
0351 k1 = k1';
0352 k1 = k1(:);
0353 k1 = k1(kk);
0354 k2 = find(k1);
0355 kk1(k1(k2)) = k2;
0356 kk1 = [kk1 length(k1)+1:length(k1)+M_.exo_nbr+M_.exo_det_nbr];
0357 kk = reshape([1:nk^2],nk,nk);
0358 kk1 = kk(kk1,kk1);
0359 %[junk,junk,hessian] = feval([M_.fname '_dynamic'],z, oo_.exo_steady_state);
0360 hessian(:,kk1(:)) = hessian;
0361 
0362 %oo_.exo_simul = tempex ;
0363 %clear tempex
0364 
0365 n1 = 0;
0366 n2 = np;
0367 zx = zeros(np,np);
0368 zu=zeros(np,M_.exo_nbr);
0369 for i=2:M_.maximum_lag+1
0370   k1 = sum(kstate(:,2) == i);
0371   zx(n1+1:n1+k1,n2-k1+1:n2)=eye(k1);
0372   n1 = n1+k1;
0373   n2 = n2-k1;
0374 end
0375 kk = flipud(cumsum(flipud(M_.lead_lag_incidence(M_.maximum_lag+1:end,order_var)),1));
0376 k0 = [1:M_.endo_nbr];
0377 gx1 = dr.ghx;
0378 hu = dr.ghu(nstatic+[1:npred],:);
0379 zx = [zx; gx1];
0380 zu = [zu; dr.ghu];
0381 for i=1:M_.maximum_lead
0382   k1 = find(kk(i+1,k0) > 0);
0383   zu = [zu; gx1(k1,1:npred)*hu];
0384   gx1 = gx1(k1,:)*hx;
0385   zx = [zx; gx1];
0386   kk = kk(:,k0);
0387   k0 = k1;
0388 end
0389 zx=[zx; zeros(M_.exo_nbr,np);zeros(M_.exo_det_nbr,np)];
0390 zu=[zu; eye(M_.exo_nbr);zeros(M_.exo_det_nbr,M_.exo_nbr)];
0391 [n1,n2] = size(zx);
0392 if n1*n1*n2*n2 > 1e7
0393   rhs = zeros(M_.endo_nbr,n2*n2);
0394   k1 = 1;
0395   for i1 = 1:n2
0396       for i2 = 1:n2
0397     rhs(:,k1) = hessian*kron(zx(:,i1),zx(:,i2));
0398     k1 = k1 + 1; 
0399       end
0400   end
0401 else
0402   rhs = hessian*kron(zx,zx);
0403 end
0404 rhs = -rhs;
0405 
0406 %lhs
0407 n = M_.endo_nbr+sum(kstate(:,2) > M_.maximum_lag+1 & kstate(:,2) < M_.maximum_lag+M_.maximum_lead+1);
0408 A = zeros(n,n);
0409 B = zeros(n,n);
0410 A(1:M_.endo_nbr,1:M_.endo_nbr) = jacobia_(:,M_.lead_lag_incidence(M_.maximum_lag+1,order_var));
0411 % variables with the highest lead
0412 k1 = find(kstate(:,2) == M_.maximum_lag+M_.maximum_lead+1);
0413 if M_.maximum_lead > 1
0414   k2 = find(kstate(:,2) == M_.maximum_lag+M_.maximum_lead);
0415   [junk,junk,k3] = intersect(kstate(k1,1),kstate(k2,1));
0416 else
0417   k2 = [1:M_.endo_nbr];
0418   k3 = kstate(k1,1);
0419 end
0420 % Jacobian with respect to the variables with the highest lead
0421 B(1:M_.endo_nbr,end-length(k2)+k3) = jacobia_(:,kstate(k1,3)+M_.endo_nbr);
0422 offset = M_.endo_nbr;
0423 k0 = [1:M_.endo_nbr];
0424 gx1 = dr.ghx;
0425 for i=1:M_.maximum_lead-1
0426   k1 = find(kstate(:,2) == M_.maximum_lag+i+1);
0427   [k2,junk,k3] = find(kstate(k1,3));
0428   A(1:M_.endo_nbr,offset+k2) = jacobia_(:,k3+M_.endo_nbr);
0429   n1 = length(k1);
0430   A(offset+[1:n1],nstatic+[1:npred]) = -gx1(kstate(k1,1),1:npred);
0431   gx1 = gx1*hx;
0432   A(offset+[1:n1],offset+[1:n1]) = eye(n1);
0433   n0 = length(k0);
0434   E = eye(n0);
0435   if i == 1
0436     [junk,junk,k4]=intersect(kstate(k1,1),[1:M_.endo_nbr]);
0437   else
0438     [junk,junk,k4]=intersect(kstate(k1,1),kstate(k0,1));
0439   end
0440   i1 = offset-n0+n1;
0441   B(offset+[1:n1],offset-n0+[1:n0]) = -E(k4,:);
0442   k0 = k1;
0443   offset = offset + n1;
0444 end
0445 [junk,k1,k2] = find(M_.lead_lag_incidence(M_.maximum_lag+M_.maximum_lead+1,order_var));
0446 A(1:M_.endo_nbr,nstatic+1:nstatic+npred)=...
0447     A(1:M_.endo_nbr,nstatic+[1:npred])+jacobia_(:,k2)*gx1(k1,1:npred);
0448 C = hx;
0449 D = [rhs; zeros(n-M_.endo_nbr,size(rhs,2))];
0450 dr.ghxx = gensylv(2,A,B,C,D);
0451 if exist('gensylv')
0452   dr.ghxx = gensylv(2,A,B,C,D);
0453 else
0454   C = kron(hx,hx); 
0455   x0 = sylvester3(A,B,C,D);
0456   dr.ghxx = sylvester3a(x0,A,B,C,D);
0457 end
0458 
0459 %ghxu
0460 %rhs
0461 hu = dr.ghu(nstatic+1:nstatic+npred,:);
0462 %kk = reshape([1:np*np],np,np);
0463 %kk = kk(1:npred,1:npred);
0464 %rhs = -hessian*kron(zx,zu)-f1*dr.ghxx(end-nyf+1:end,kk(:))*kron(hx(1:npred,:),hu(1:npred,:));
0465 if n1*n1*n2*M_.exo_nbr > 1e7
0466   rhs = zeros(M_.endo_nbr,n2*M_.exo_nbr);
0467   k1 = 1;
0468   for i1 = 1:n2
0469       for i2 = 1:M_.exo_nbr
0470     rhs(:,k1) = hessian*kron(zx(:,i1),zu(:,i2));
0471     k1 = k1 + 1; 
0472       end
0473   end
0474 else
0475   rhs = hessian*kron(zx,zu);
0476 end
0477 nyf1 = sum(kstate(:,2) == M_.maximum_lag+2);
0478 hu1 = [hu;zeros(np-npred,M_.exo_nbr)];
0479 %B1 = [B(1:M_.endo_nbr,:);zeros(size(A,1)-M_.endo_nbr,size(B,2))];
0480 rhs = -[rhs; zeros(n-M_.endo_nbr,size(rhs,2))]-B*dr.ghxx*kron(hx,hu1);
0481 
0482 
0483 %lhs
0484 dr.ghxu = A\rhs;
0485 
0486 %ghuu
0487 %rhs
0488 kk = reshape([1:np*np],np,np);
0489 kk = kk(1:npred,1:npred);
0490 if n1*n1*M_.exo_nbr*M_.exo_nbr > 1e7
0491   rhs = zeros(M_.endo_nbr,M_.exo_nbr*M_.exo_nbr);
0492   k1 = 1;
0493   for i1 = 1:M_.exo_nbr
0494       for i2 = 1:M_.exo_nbr
0495     rhs(:,k1) = hessian*kron(zu(:,i1),zu(:,i2));
0496     k1 = k1 + 1; 
0497       end
0498   end
0499 else
0500   rhs = hessian*kron(zu,zu);
0501 end
0502 
0503 rhs = -[rhs; zeros(n-M_.endo_nbr,size(rhs,2))]-B*dr.ghxx*kron(hu1,hu1);
0504 
0505 %lhs
0506 dr.ghuu = A\rhs;
0507 
0508 dr.ghxx = dr.ghxx(1:M_.endo_nbr,:);
0509 dr.ghxu = dr.ghxu(1:M_.endo_nbr,:);
0510 dr.ghuu = dr.ghuu(1:M_.endo_nbr,:);
0511 
0512 
0513 % dr.ghs2
0514 % derivatives of F with respect to forward variables
0515 % reordering predetermined variables in diminishing lag order
0516 O1 = zeros(M_.endo_nbr,nstatic);
0517 O2 = zeros(M_.endo_nbr,M_.endo_nbr-nstatic-npred);
0518 LHS = jacobia_(:,M_.lead_lag_incidence(M_.maximum_lag+1,order_var));
0519 RHS = zeros(M_.endo_nbr,M_.exo_nbr^2);
0520 kk = find(kstate(:,2) == M_.maximum_lag+2);
0521 gu = dr.ghu; 
0522 guu = dr.ghuu; 
0523 Gu = [dr.ghu(nstatic+[1:npred],:); zeros(np-npred,M_.exo_nbr)];
0524 Guu = [dr.ghuu(nstatic+[1:npred],:); zeros(np-npred,M_.exo_nbr*M_.exo_nbr)];
0525 E = eye(M_.endo_nbr);
0526 M_.lead_lag_incidenceordered = flipud(cumsum(flipud(M_.lead_lag_incidence(M_.maximum_lag+1:end,order_var)),1));
0527 if M_.maximum_lag > 0
0528   M_.lead_lag_incidenceordered = [cumsum(M_.lead_lag_incidence(1:M_.maximum_lag,order_var),1); M_.lead_lag_incidenceordered];
0529 end
0530 M_.lead_lag_incidenceordered = M_.lead_lag_incidenceordered';
0531 M_.lead_lag_incidenceordered = M_.lead_lag_incidenceordered(:);
0532 k1 = find(M_.lead_lag_incidenceordered);
0533 M_.lead_lag_incidenceordered(k1) = [1:length(k1)]';
0534 M_.lead_lag_incidenceordered =reshape(M_.lead_lag_incidenceordered,M_.endo_nbr,M_.maximum_lag+M_.maximum_lead+1)';
0535 kh = reshape([1:nk^2],nk,nk);
0536 kp = sum(kstate(:,2) <= M_.maximum_lag+1);
0537 E1 = [eye(npred); zeros(kp-npred,npred)];
0538 H = E1;
0539 hxx = dr.ghxx(nstatic+[1:npred],:);
0540 for i=1:M_.maximum_lead
0541   for j=i:M_.maximum_lead
0542     [junk,k2a,k2] = find(M_.lead_lag_incidence(M_.maximum_lag+j+1,order_var));
0543     [junk,k3a,k3] = find(M_.lead_lag_incidenceordered(M_.maximum_lag+j+1,:));
0544     RHS = RHS + jacobia_(:,k2)*guu(k2a,:)+hessian(:,kh(k3,k3))* ...
0545       kron(gu(k3a,:),gu(k3a,:));
0546   end
0547 
0548   % LHS
0549   [junk,k2a,k2] = find(M_.lead_lag_incidence(M_.maximum_lag+i+1,order_var));
0550   LHS = LHS + jacobia_(:,k2)*(E(k2a,:)+[O1(k2a,:) dr.ghx(k2a,:)*H O2(k2a,:)]);
0551   
0552   if i == M_.maximum_lead 
0553     break
0554   end
0555   
0556   kk = find(kstate(:,2) == M_.maximum_lag+i+1);
0557   gu = dr.ghx*Gu;
0558   GuGu = kron(Gu,Gu);
0559   guu = dr.ghx*Guu+dr.ghxx*GuGu;
0560   Gu = hx*Gu;
0561   Guu = hx*Guu;
0562   Guu(end-npred+1:end,:) = Guu(end-npred+1:end,:) + hxx*GuGu;
0563 
0564   H = E1 + hx*H;
0565 end
0566 RHS = RHS*M_.Sigma_e(:);
0567 dr.fuu = RHS;
0568 RHS = -RHS-dr.fbias;
0569 dr.ghs2 = LHS\RHS;
0570 
0571 % deterministic exogenous variables
0572 if M_.exo_det_nbr > 0
0573   hud = dr.ghud{1}(nstatic+1:nstatic+npred,:);
0574   zud=[zeros(np,M_.exo_det_nbr);dr.ghud{1};gx(:,1:npred)*hud;zeros(M_.exo_nbr,M_.exo_det_nbr);eye(M_.exo_det_nbr)];
0575   R1 = hessian*kron(zx,zud);
0576   dr.ghxud = cell(M_.exo_det_length,1);
0577   kf = [M_.endo_nbr-nyf+1:M_.endo_nbr];
0578   kp = nstatic+[1:npred];
0579   dr.ghxud{1} = -M1*(R1+f1*dr.ghxx(kf,:)*kron(dr.ghx(kp,:),dr.ghud{1}(kp,:)));
0580   Eud = eye(M_.exo_det_nbr);
0581   for i = 2:M_.exo_det_length
0582     hudi = dr.ghud{i}(kp,:);
0583     zudi=[zeros(np,M_.exo_det_nbr);dr.ghud{i};gx(:,1:npred)*hudi;zeros(M_.exo_nbr+M_.exo_det_nbr,M_.exo_det_nbr)];
0584     R2 = hessian*kron(zx,zudi);
0585     dr.ghxud{i} = -M2*(dr.ghxud{i-1}(kf,:)*kron(hx,Eud)+dr.ghxx(kf,:)*kron(dr.ghx(kp,:),dr.ghud{i}(kp,:)))-M1*R2;
0586   end
0587   R1 = hessian*kron(zu,zud);
0588   dr.ghudud = cell(M_.exo_det_length,1);
0589   kf = [M_.endo_nbr-nyf+1:M_.endo_nbr];
0590 
0591   dr.ghuud{1} = -M1*(R1+f1*dr.ghxx(kf,:)*kron(dr.ghu(kp,:),dr.ghud{1}(kp,:)));
0592   Eud = eye(M_.exo_det_nbr);
0593   for i = 2:M_.exo_det_length
0594     hudi = dr.ghud{i}(kp,:);
0595     zudi=[zeros(np,M_.exo_det_nbr);dr.ghud{i};gx(:,1:npred)*hudi;zeros(M_.exo_nbr+M_.exo_det_nbr,M_.exo_det_nbr)];
0596     R2 = hessian*kron(zu,zudi);
0597     dr.ghuud{i} = -M2*dr.ghxud{i-1}(kf,:)*kron(hu,Eud)-M1*R2;
0598   end
0599   R1 = hessian*kron(zud,zud);
0600   dr.ghudud = cell(M_.exo_det_length,M_.exo_det_length);
0601   dr.ghudud{1,1} = -M1*R1-M2*dr.ghxx(kf,:)*kron(hud,hud);
0602   for i = 2:M_.exo_det_length
0603     hudi = dr.ghud{i}(nstatic+1:nstatic+npred,:);
0604     zudi=[zeros(np,M_.exo_det_nbr);dr.ghud{i};gx(:,1:npred)*hudi+dr.ghud{i-1}(kf,:);zeros(M_.exo_nbr+M_.exo_det_nbr,M_.exo_det_nbr)];
0605     R2 = hessian*kron(zudi,zudi);
0606     dr.ghudud{i,i} = -M2*(dr.ghudud{i-1,i-1}(kf,:)+...
0607               2*dr.ghxud{i-1}(kf,:)*kron(hudi,Eud) ...
0608               +dr.ghxx(kf,:)*kron(hudi,hudi))-M1*R2;
0609     R2 = hessian*kron(zud,zudi);
0610     dr.ghudud{1,i} = -M2*(dr.ghxud{i-1}(kf,:)*kron(hud,Eud)+...
0611               dr.ghxx(kf,:)*kron(hud,hudi))...
0612     -M1*R2;
0613     for j=2:i-1
0614       hudj = dr.ghud{j}(kp,:);
0615       zudj=[zeros(np,M_.exo_det_nbr);dr.ghud{j};gx(:,1:npred)*hudj;zeros(M_.exo_nbr+M_.exo_det_nbr,M_.exo_det_nbr)];
0616       R2 = hessian*kron(zudj,zudi);
0617       dr.ghudud{j,i} = -M2*(dr.ghudud{j-1,i-1}(kf,:)+dr.ghxud{j-1}(kf,:)* ...
0618                 kron(hudi,Eud)+dr.ghxud{i-1}(kf,:)* ...
0619                 kron(hudj,Eud)+dr.ghxx(kf,:)*kron(hudj,hudi))-M1*R2;
0620     end
0621     
0622   end
0623 end
0624 % 01/08/2001 MJ put return on iorder == 1 after defining dr.kstate and dr.kdyn
0625 % 01/17/2001 MJ added dr.delta_s: correction factor for order = 2
0626 % 01/21/2001 FC correction of delta_s for more than 1 shock
0627 % 01/23/2001 MJ suppression of redundant sum() in delta_s formula
0628 % 02/22/2001 MJ stderr_ replaced by Sigma_e_
0629 % 08/24/2001 MJ changed the order of the variables, separates static
0630 %               variables and handles only one instance of variables both
0631 %               in lead and lag
0632 % 08/24/2001 MJ added sigma to state variables as in Schmitt-Grohe and
0633 %               Uribe (2001)
0634 % 10/20/2002 MJ corrected lags on several periods bug
0635 % 10/30/2002 MJ corrected lags on several periods bug on static when some
0636 %               intermediary lags are missing
0637 % 12/08/2002 MJ uses sylvester3 to solve for dr.ghxx
0638 % 01/01/2003 MJ added dr.fbias for iterative for dr_algo == 1
0639 % 02/21/2003 MJ corrected bug for models without lagged variables
0640 % 03/02/2003 MJ fixed second order for lag on several periods
0641 % 05/21/2003 MJ add check call argument and make computation for CHECK
0642 % 06/01/2003 MJ added a test for M_.maximum_lead > 1 and order > 1
0643 % 08/28/2003 MJ corrected bug in computation of 2nd order (ordering of
0644 %               forward variable in LHS)
0645 % 08/29/2003 MJ use Sims routine if mjdgges isn't available
0646 
0647    
0648 
0649 
0650 
0651 
0652