/*
 * Copyright (C) 1996-2011 Daniel Waggoner and Tao Zha
 *
 * This free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * It is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * If you did not received a copy of the GNU General Public License
 * with this software, see <http://www.gnu.org/licenses/>.
 */

#include "VARio.h"
#include "switchio.h"
#include "dw_error.h"
#include "dw_ascii.h"
#include "dw_parse_cmd.h"
#include "dw_std.h"

#include <stdlib.h>
#include <string.h>
#include <math.h>

static int strlen_int(int n)
{
  int i, j;
  for (i=1, j=10; n >= j; i++, j*=10);
  return i;
}

static void ReadError_VARio(char *id)
{
  char *errmsg, *fmt="Error after line identifier ""%s""";
  sprintf(errmsg=(char*)dw_malloc(strlen(fmt) + strlen(id) - 1),fmt,id);
  dw_UserError(errmsg);
  dw_free(errmsg);
}

static int ReadInteger_VARio(FILE *f_in, char *id)
{
  int i;
  if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %d ",&i) != 1)) ReadError_VARio(id);
  return i;
}

static PRECISION ReadScalar_VARio(FILE *f_in, char *id)
{
  double x;
  if (!dw_SetFilePosition(f_in,id) || (fscanf(f_in," %lf ",&x) != 1)) ReadError_VARio(id);
  return (PRECISION)x;
}

static void ReadMatrix_VARio(FILE *f_in, char *id, TMatrix X)
{
  if (!dw_SetFilePosition(f_in,id) || !dw_ReadMatrix(f_in,X)) ReadError_VARio(id);
}

static void ReadVector_VARio(FILE *f_in, char *id, TVector X)
{
  if (!dw_SetFilePosition(f_in,id) || !dw_ReadVector(f_in,X)) ReadError_VARio(id);
}

static void ReadArray_VARio(FILE *f_in, char *id, void *X)
{
  if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,X)) ReadError_VARio(id);
}

static FILE* OpenFile_VARio(FILE *f, char *filename)
{
  char *errmsg, *fmt="Unable to open %s";
  if (!f)
    if (!filename)
      dw_UserError("Filename pointer is null.");
    else
      if (!(f=fopen(filename,"rt")))
        {
          sprintf(errmsg=(char*)dw_malloc(strlen(fmt) + strlen(filename) - 1),fmt,filename);
          dw_UserError(errmsg);
          dw_free(errmsg);
        }
  return f;
}

/*
   Assumes
     posterior_file : FILE pointer to open file
     model          : pointer to valid TStateModel structure
     flag           : F_FREE - posterior value, likelihood value, theta, q format
                      F_FLAT - flat posterior draw format

   Results
     Upon success, new parameters are pushed into model

   Returns
     One upon success and zero otherwise.

*/
int GetPosteriorDraw(FILE *posterior_file, TStateModel *model, int flag)
{
  int terminal=dw_SetTerminalErrors(0), verbose=dw_SetVerboseErrors(0), rtrn=0, nq, nt;
  TVector draw;
  switch (flag)
    {
    case F_FREE:
      nt=NumberFreeParametersTheta(model);
      nq=NumberFreeParametersQ(model);
      if (dw_ReadVector(posterior_file,draw=CreateVector(2+nt+nq)))
	{
	  ConvertFreeParametersToTheta(model,pElementV(draw)+2);
	  ConvertFreeParametersToQ(model,pElementV(draw)+2+nt);
	  rtrn=1;
	}
      FreeVector(draw);
      break;
    case F_FLAT:
      if (ReadBaseTransitionMatricesFlat(posterior_file,(char*)NULL,model) && Read_VAR_ParametersFlat(posterior_file,model))
	rtrn=1;
      break;
    default:
      dw_SetTerminalErrors(terminal);
      dw_SetVerboseErrors(verbose);
      dw_UserError("Incorrect type passed to GetPosteriorDraw()");
      return rtrn;
    }
  dw_SetTerminalErrors(terminal);
  dw_SetVerboseErrors(verbose);
  return rtrn;
}

/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
/*
  Allocates memory for filename.  Assumes that fmt is of the form

     %s*%s*

  where the first %s will be filled with dir and the second will be
  filled with tag.  If either dir or tag is a null pointer, then the
  the empty sring will be used.  The calling routine must free the
  returned pointer.
*/
char* CreateFilenameFromTag(char *fmt, char *tag, char *dir)
{
  char *filename;
  if (!tag) tag="";
  if (!dir) dir="";
  sprintf(filename=(char*)dw_malloc(strlen(dir) + strlen(fmt) + strlen(tag) - 3),fmt,dir,tag);
  return filename;
}

/*
   Create a full path name by appending a "/" if necessary.  The 
   returned pathname must be freed by he calling routine.
*/
char* CreatePath(char *path)
{
#ifdef _WIN32
#define DIR_DELIMITER '\\'
#else
#define DIR_DELIMITER '/'
#endif
  char *fullpath;
  int n;
  if (!path) path="";
  n=(int)strlen(path);
  if (path[0] && path[n-1] != DIR_DELIMITER)
    {
      memcpy(fullpath=(char*)dw_malloc(n+2),path,n);
      fullpath[n]=DIR_DELIMITER;
      fullpath[n+1]='\0';
    }
  else
    fullpath=dw_DuplicateString(path);
  return fullpath;
#undef DIR_DELIMITER
}

TVARCommandLine* Create_VARCommandLine(void)
{
  TVARCommandLine *cmd=(TVARCommandLine*)dw_malloc(sizeof(TVARCommandLine));
  if (cmd)
    {
       cmd->out_directory=(char*)NULL;
       cmd->in_directory=(char*)NULL;
       cmd->in_tag=(char*)NULL;
       cmd->out_tag=(char*)NULL;
       cmd->out_header=(char*)NULL;

       cmd->specification_filename=(char*)NULL;
       cmd->parameters_filename=(char*)NULL;
       cmd->parameters_header=(char*)NULL;

       cmd->specification_filename_actual=(char*)NULL;
       cmd->parameters_filename_actual=(char*)NULL;
       cmd->parameters_header_actual=(char*)NULL;

       cmd->MLE=0;

       cmd->model=(TStateModel*)NULL;
    }

  return cmd;
}

void Free_VARCommandLine(TVARCommandLine *cmd)
{
  if (cmd)
    {
      if (cmd->out_directory) dw_free(cmd->out_directory);
      if (cmd->in_directory) dw_free(cmd->in_directory);
      if (cmd->in_tag) dw_free(cmd->in_tag);
      if (cmd->out_tag) dw_free(cmd->out_tag);
      if (cmd->out_header) dw_free(cmd->out_header);
      if (cmd->specification_filename) dw_free(cmd->specification_filename);
      if (cmd->parameters_filename) dw_free(cmd->parameters_filename);
      if (cmd->parameters_header) dw_free(cmd->parameters_header);   
      if (cmd->specification_filename_actual) dw_free(cmd->specification_filename_actual);
      if (cmd->parameters_filename_actual) dw_free(cmd->parameters_filename_actual);
      if (cmd->parameters_header_actual) dw_free(cmd->parameters_header_actual);   
      if (cmd->model) FreeStateModel(cmd->model);

      dw_free(cmd);
    }
}

TVARCommandLine* Base_VARCommandLine(int nargs, char **args)
{
  TVARCommandLine *cmd=Create_VARCommandLine();
  if (cmd)
    {
      // input directory
      cmd->in_directory=CreatePath(dw_ParseString_String(nargs,args,"di",""));

      // output directory
      cmd->out_directory=CreatePath(dw_ParseString_String(nargs,args,"do",""));
  
      // specification file
      cmd->specification_filename=dw_DuplicateString(dw_ParseString_String(nargs,args,"fs",(char*)NULL));

      // Parameters file
      cmd->parameters_filename=dw_DuplicateString(dw_ParseString_String(nargs,args,"fp",(char*)NULL));

      // MLE
      cmd->MLE=(dw_FindArgument_String(nargs,args,"MLE") == -1) ? 0 : 1;

      // parameter header
      cmd->parameters_header=dw_DuplicateString(dw_ParseString_String(nargs,args,"ph",(char*)NULL));

      // output file name
      cmd->out_filename=dw_DuplicateString(dw_ParseString_String(nargs,args,"fo",(char*)NULL));
						 
      // output parameters header
      cmd->out_header=dw_DuplicateString(dw_ParseString_String(nargs,args,"pho",(char*)NULL));

      // input file tag
      cmd->in_tag=dw_DuplicateString(dw_ParseString_String(nargs,args,"ft",(char*)NULL));

      // output file tag
      cmd->out_tag=dw_DuplicateString(dw_ParseString_String(nargs,args,"fto",(char*)NULL));
    }
  return cmd;
}

/*
    if cmd->out_tag is null, then sets cmd->out_tag to cmd->in_tag if cmd->in_tag
    is not null and or "notag" if cmd->in_tag is null.
*/
void  OutTag_VARCommandLine(TVARCommandLine *cmd)
{
  if (!cmd->out_tag) cmd->out_tag=dw_DuplicateString(cmd->in_tag ? cmd->in_tag : "notag");
}

/*
   Attempts to get the parameters from the last iteration in the intermediate 
   file.  Returns one and sets cmd->parameters_file_actual, 
   cmd->parameters_header_actual and loads parameters upon success.  Returns 
   zero upon failure.
*/
static int GetLastIteration(TVARCommandLine *cmd)
{
  char *filename, *header, *fmt="Iteration %d: ";
  int cont=1, terminal_errors, i, j, k=1, rtrn=0;
  FILE *f_in;

  filename=CreateFilenameFromTag("%sest_intermediate_%s.out",cmd->in_tag,cmd->in_directory);
  if (!(f_in=fopen(filename,"rt")))
    {
      dw_free(filename);
      return 0;
    }

  terminal_errors=dw_SetTerminalErrors(dw_GetTerminalErrors() & (~USER_ERR));

  do    
    {
      for (j=10, i=1; k >= j; j*=10, i++);
      sprintf(header=(char*)dw_malloc(strlen(fmt) + i - 1),fmt,k);
      if (ReadBaseTransitionMatrices(f_in,(char*)NULL,header,cmd->model) && Read_VAR_Parameters(f_in,(char*)NULL,header,cmd->model))
	k++;
      else
        cont=0;
      dw_free(header);
    }
 while (cont);

 if (k > 1)
   {
     k--;
     for (j=10, i=1; k >= j; j*=10, i++);
     sprintf(header=(char*)dw_malloc(strlen(fmt) + i - 1),fmt,k);
     if (ReadBaseTransitionMatrices(f_in,(char*)NULL,header,cmd->model) && Read_VAR_Parameters(f_in,(char*)NULL,header,cmd->model))
       {
         if (cmd->parameters_filename_actual) dw_free(cmd->parameters_filename_actual);
         cmd->parameters_filename_actual=filename;
         if (cmd->parameters_header_actual) dw_free(cmd->parameters_header_actual);
         cmd->parameters_header_actual=header;
         rtrn=1;
       }
     else
       dw_free(header);
   }
 else
   {
     header="Initial: ";
     if (ReadBaseTransitionMatrices(f_in,(char*)NULL,header,cmd->model)  && Read_VAR_Parameters(f_in,(char*)NULL,header,cmd->model))
       {
         if (cmd->parameters_filename_actual) dw_free(cmd->parameters_filename_actual);
         cmd->parameters_filename_actual=filename;
         if (cmd->parameters_header_actual) dw_free(cmd->parameters_header_actual);
         cmd->parameters_header_actual=dw_DuplicateString(header);
         rtrn=1;
       }
   }

 fclose(f_in);
 if (!rtrn) dw_free(filename);
 dw_SetTerminalErrors(terminal_errors);
 return 0;
}

/*
   Attempts to set up model from command line. 

   specification file
       1) cmd->specification_filename if non-null
       2) if cmd->in_tag is non-null
           a) est_final_<tag>.out if this file exists
           b) init_<tag>.out if this file exists

   parameter file
       1) cmd->parameters_filename if non-null 
          a) Tries to read in a full specification
          b) Tries to read in a file with only free parameters
       2) cmd->specification_filename if non-null
       3) if cmd->in_tag is non-null
           a) est_final_<tag>.out if this file exists
           b) est_intermediate_<tag>.out if this file exists
           c) init_<tag>.out if this file exists

   parameter header
       1) if parameter file is cmd->parameters_filename, cmd->specification_filename, or est_final_<tag>.out
           a) cmd->parameters_header if non-null
           b) "MLE: " if -MLE is present in the command line
           c) "Posterior mode: " if -MLE is not present in the command line
       2) if parameter file is est_intermediate_<tag>.out, then either "Iteration %d: " or "Initial: "
       3) if parameter file is init_<tag>.out, then "Initial: "        
    
   Returns valid pointer to a TVARCommandLine upon success.  A null return indicates a lack of 
   memory.  The if cmd->model or cmd->specification_filename_actual is null, then there was not enough 
   information on the command line to create the model.  If cmd->parameters_filename_actual
   or cmd->parameters_header_actual is null, then the there was not enough information on the 
   command line to initialize the parameters.
*/
TVARCommandLine* CreateTStateModel_VARCommandLine(int nargs, char **args, TVARCommandLine *cmd)
{
  char *filename, *header;
  int terminal_errors;

  if (!cmd && !(cmd=Base_VARCommandLine(nargs,args))) return cmd;

  terminal_errors=dw_SetTerminalErrors(dw_GetTerminalErrors() & (~USER_ERR));

  if (cmd->specification_filename)
    {
      filename=CreateFilenameFromTag("%s%s",cmd->specification_filename,cmd->in_directory);
      if (!(cmd->model=Read_VAR_Specification((FILE*)NULL,filename)))
        {
          dw_free(filename);
          dw_SetTerminalErrors(terminal_errors);
          return cmd;
        }
    }
  else
    if (cmd->in_tag)
      {
        filename=CreateFilenameFromTag("%sest_final_%s.out",cmd->in_tag,cmd->in_directory);
        if (!(cmd->model=Read_VAR_Specification((FILE*)NULL,filename)))
          {
            dw_free(filename);
            filename=CreateFilenameFromTag("%sinit_%s.dat",cmd->in_tag,cmd->in_directory);
            if (!(cmd->model=Read_VAR_Specification((FILE*)NULL,filename)))
              {
                dw_free(filename);
                dw_SetTerminalErrors(terminal_errors);
                return cmd;
              }
          }
      }
    else
      {
        dw_SetTerminalErrors(terminal_errors);
        return cmd;
      }

  if (cmd->specification_filename_actual) dw_free(cmd->specification_filename_actual);
  cmd->specification_filename_actual=filename;
 
  header=cmd->parameters_header ? cmd->parameters_header : (cmd->MLE ? "MLE: " : "Posterior mode: ");

  if (cmd->parameters_filename)
    {
      filename=CreateFilenameFromTag("%s%s",cmd->parameters_filename,cmd->in_directory);
      if (!ReadBaseTransitionMatrices((FILE*)NULL,filename,header,cmd->model) || !Read_VAR_Parameters((FILE*)NULL,filename,header,cmd->model))
        {
          /* now try to initialize the parameters from a free paramter form */
          if (!ReadFreeParameters((FILE*)NULL,filename,cmd->model))
            {
              dw_free(filename);
              dw_SetTerminalErrors(terminal_errors);
              return cmd;
            }
        }
    }
  else
    if (cmd->specification_filename)
      {
        filename=CreateFilenameFromTag("%s%s",cmd->specification_filename,cmd->in_directory);
        if (!ReadBaseTransitionMatrices((FILE*)NULL,filename,header,cmd->model) || !Read_VAR_Parameters((FILE*)NULL,filename,header,cmd->model))
          {
            dw_free(filename);
            dw_SetTerminalErrors(terminal_errors);
            return cmd;
          }
      }
    else
      if (cmd->in_tag)
        {
          filename=CreateFilenameFromTag("%sest_final_%s.out",cmd->in_tag,cmd->in_directory);
          if (!ReadBaseTransitionMatrices((FILE*)NULL,filename,header,cmd->model) || !Read_VAR_Parameters((FILE*)NULL,filename,header,cmd->model))
            {
              dw_free(filename);
              if (GetLastIteration(cmd))
                {
                  dw_SetTerminalErrors(terminal_errors);
                  return cmd;
                }
              else
                {                                   
                  header="Initial: ";
                  filename=CreateFilenameFromTag("%sinit_%s.dat",cmd->in_tag,cmd->in_directory);
                  if (!ReadBaseTransitionMatrices((FILE*)NULL,filename,header,cmd->model) || !Read_VAR_Parameters((FILE*)NULL,filename,header,cmd->model))
                    {
		      dw_free(filename);
                      dw_SetTerminalErrors(terminal_errors);
                      return cmd;
                    }
                }
            }
        }

  if (cmd->parameters_filename_actual) dw_free(cmd->parameters_filename_actual);
  cmd->parameters_filename_actual=filename;
  if (cmd->parameters_header_actual) dw_free(cmd->parameters_header_actual);
  cmd->parameters_header_actual=dw_DuplicateString(header);

  dw_SetTerminalErrors(terminal_errors);
  return cmd;
}
/******************************************************************************/
/******************************************************************************/
/******************************************************************************/



/*
   Assumes:
    f:  valid file pointer or null
    filename:  pointer to null terminated string or null

   Returns:
    A pointer to a valid TStateModel upon success and null pointer upon failure.
    Upon failure, the routine prints an error message if USER_ERR is a verbose 
    error and terminates if USER_ERR is a terminal error.  The terminal errors 
    and verbose errors can be set with dw_SetTerminalErrors() and 
    dw_SetVerboseErrors().  

   Results:
    Upon success, a valid TStateModel is created and initialized.

   Notes:
    One of f and filename must not be null.  
*/
TStateModel* Read_VAR_Specification(FILE *f, char *filename)
{
  TMarkovStateVariable *sv;
  T_VAR_Parameters *p;
  char *id, *fmt;
  int *IV;
  int j, spec, nvars, nlags, nexg, npre, nstates, nobs;   
  PRECISION lambda_prior=0.0;                                               
  TVector zeta_a_prior, zeta_b_prior;
  TMatrix *U, *V, *W, *A0_prior, *Aplus_prior, Y, X;                                         
  int **coef_states, **var_states;     
  PRECISION** A0_Metropolis_Scale=(PRECISION**)NULL;

  // Valid file
  FILE *f_in=OpenFile_VARio(f,filename);
  if (!f_in) return (TStateModel*)NULL;

  // Read Markov specifications
  if (!(sv=ReadMarkovSpecification(f_in,(char*)NULL)))
    {
      if (!f) fclose(f_in);
      return (TStateModel*)NULL;
    }

  //=== Sizes ===//
  nvars=ReadInteger_VARio(f_in,"//== Number Variables ==//");
  nlags=ReadInteger_VARio(f_in,"//== Number Lags ==//");
  nexg=ReadInteger_VARio(f_in,"//== Exogenous Variables ==//");
  nstates=ReadInteger_VARio(f_in,"//== Number States ==//");
  nobs=ReadInteger_VARio(f_in,"//== Number Observations ==//");
  npre=nvars*nlags+nexg;
  if (nstates != sv->nstates)
    {
      dw_UserError("Read_VAR_Specification():  different values for nstates.");
      if (!f) fclose(f_in);
      return (TStateModel*)NULL;
    }

  //=== Restrictions - U[j] ===//
  ReadArray_VARio(f_in,"//== Number of free parameters in each column of A0 ==//",IV=dw_CreateArray_int(nvars));
  U=dw_CreateArray_matrix(nvars);
  for (j=0; j < nvars; j++)
    {
      fmt="//== U[%d] ==//";
      sprintf(id=(char*)dw_malloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
      ReadMatrix_VARio(f_in,id,U[j]=CreateMatrix(nvars,IV[j]));
      dw_free(id);
    }
  dw_FreeArray(IV);

  //=== Restrictions - V[j] ===//
  ReadArray_VARio(f_in,"//== Number of free parameters in each column of Aplus ==//",IV=dw_CreateArray_int(nvars));
  V=dw_CreateArray_matrix(nvars);
  for (j=0; j < nvars; j++)
    if (IV[j] > 0)
      {
	fmt="//== V[%d] ==//";
	sprintf(id=(char*)dw_malloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
	ReadMatrix_VARio(f_in,id,V[j]=CreateMatrix(npre,IV[j]));
	dw_free(id);
      }
  dw_FreeArray(IV);

  //=== Restrictions - W[j] ===//
  ReadArray_VARio(f_in,"//== Non-zero W[j] ==//",IV=dw_CreateArray_int(nvars));
  W=dw_CreateArray_matrix(nvars);
  for (j=0; j < nvars; j++)
    if (IV[j])
      {
	fmt="//== W[%d] ==//";
	sprintf(id=(char*)dw_malloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
	ReadMatrix_VARio(f_in,id,W[j]=CreateMatrix(npre,nvars));
	dw_free(id);
      }
  dw_FreeArray(IV);

  //====== Priors ======
  ReadVector_VARio(f_in,"//== Gamma prior on zeta - a ==//",zeta_a_prior=CreateVector(nvars));
  ReadVector_VARio(f_in,"//== Gamma prior on zeta - b ==//",zeta_b_prior=CreateVector(nvars));

  A0_prior=dw_CreateArray_matrix(nvars);
  for (j=0; j < nvars; j++)
    {
      fmt="//== Variance of Gaussian prior on column %d of A0 ==//";
      sprintf(id=(char*)dw_malloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
      ReadMatrix_VARio(f_in,id,A0_prior[j]=CreateMatrix(nvars,nvars));
      dw_free(id);
    }

  Aplus_prior=dw_CreateArray_matrix(nvars);
  for (j=0; j < nvars; j++)
    {
      fmt="//== Variance of Gaussian prior on column %d of Aplus ==//";
      sprintf(id=(char*)dw_malloc(strlen(fmt) + strlen_int(j+1) - 1),fmt,j+1);
      ReadMatrix_VARio(f_in,id,Aplus_prior[j]=CreateMatrix(npre,npre));
      dw_free(id);
    }

  //=== Specification ===//
  spec=ReadInteger_VARio(f_in,"//== Specification (0=default  1=Sims-Zha  2=Random Walk) ==//");
  switch (spec)
    {
    case 0: spec=0; break;
    case 1: spec=SPEC_SIMS_ZHA | SPEC_RANDOM_WALK; break;
    case 2: spec=SPEC_RANDOM_WALK; break;
    default: ReadError_VARio("//== Specification (0=default  1=Sims-Zha  2=Random Walk) ==//"); dw_exit(0);
    }
  if (spec & SPEC_SIMS_ZHA)
    lambda_prior=ReadScalar_VARio(f_in,"//== Variance of Gaussian prior on lambda ==//");

  //====== coefficient and variance state variables ======
  ReadArray_VARio(f_in,"//== Translation table for coefficient states ==//",coef_states=dw_CreateRectangularArray_int(nvars,nstates));
  ReadArray_VARio(f_in,"//== Translation table for variance states ==//",var_states=dw_CreateRectangularArray_int(nvars,nstates));

  //====== Metropolis jumping kernel info for A0 ======
  if (dw_SetFilePosition(f_in,id="//== Metropolis kernel scales for A0 ==//"))
    {
      A0_Metropolis_Scale=dw_CreateArray_array(nvars);
      for (j=nvars-1; j >= 0; j--)
	A0_Metropolis_Scale[j]=dw_CreateArray_scalar(GetNumberStatesFromTranslationMatrix(j,coef_states));
      if (!dw_ReadArray(f_in,A0_Metropolis_Scale)) ReadError_VARio(id);
    }

  //=== Data  ===
  ReadMatrix_VARio(f_in,"//== Data Y (nobs x nvars) ==//",Y=CreateMatrix(nobs,nvars));
  ReadMatrix_VARio(f_in,"//== Data X (nobs x npre) ==//",X=CreateMatrix(nobs,npre));

  //=== Create T_VAR_Parameters structure ===
  p=CreateTheta_VAR(spec,nvars,nlags,nexg,nstates,nobs,coef_states,var_states,U,V,W,Y,X);
  if (spec & SPEC_SIMS_ZHA)
    SetPriors_VAR_SimsZha(p,A0_prior,Aplus_prior,zeta_a_prior,zeta_b_prior,lambda_prior);
  else
    SetPriors_VAR(p,A0_prior,Aplus_prior,zeta_a_prior,zeta_b_prior);

  if (A0_Metropolis_Scale) SetupMetropolisInformation(A0_Metropolis_Scale,p);

  //=== Close output file ===
  if (!f) fclose(f_in);

  //=== Free memory ===
  dw_FreeArray(U);
  dw_FreeArray(V);
  dw_FreeArray(W);
  FreeVector(zeta_a_prior);
  FreeVector(zeta_b_prior);
  dw_FreeArray(A0_prior);
  dw_FreeArray(Aplus_prior);
  FreeMatrix(X);
  FreeMatrix(Y);
  dw_FreeArray(coef_states);
  dw_FreeArray(var_states);
  dw_FreeArray(A0_Metropolis_Scale);

  //=== return TStateModel structure ===
  return CreateStateModel(nobs,sv,CreateRoutines_VAR(),p);
}

/*
   Writes the specification
*/
void Write_VAR_Specification(FILE *f, char *filename, TStateModel *model)
{
  int j, t;
  FILE *f_out=f ? f : dw_CreateTextFile(filename);
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);

  // Write Markov specifications
  WriteMarkovSpecification(f_out,(char*)NULL,model);

  //=== Sizes ===//
  fprintf(f_out,"//== Number Variables ==//\n%d\n\n",p->nvars);
  fprintf(f_out,"//== Number Lags ==//\n%d\n\n",p->nlags);
  fprintf(f_out,"//== Exogenous Variables ==//\n%d\n\n",p->npre - p->nvars * p->nlags);
  fprintf(f_out,"//== Number States ==//\n%d\n\n",p->nstates);
  fprintf(f_out,"//== Number Observations ==//\n%d\n\n",p->nobs);

  //=== Restrictions - U[j] ===//
  fprintf(f_out,"//== Number of free parameters in each column of A0 ==//\n");
  for (j=0; j < p->nvars; j++)
    fprintf(f_out,"%d ",ColM(p->U[j]));
  fprintf(f_out,"\n\n");
  for (j=0; j < p->nvars; j++)
    {
      fprintf(f_out,"//== U[%d] ==//\n",j+1);
      dw_PrintMatrix(f_out,p->U[j],"%22.14le ");
      fprintf(f_out,"\n");
    }

  //=== Restrictions - V[j] ===//
  fprintf(f_out,"//== Number of free parameters in each column of Aplus ==//\n");
  for (j=0; j < p->nvars; j++)
    fprintf(f_out,"%d ",p->V[j] ? ColM(p->V[j]) : 0);
  fprintf(f_out,"\n\n");
  for (j=0; j < p->nvars; j++)
    if (p->V[j])
      {
	fprintf(f_out,"//== V[%d] ==//\n",j+1);
	dw_PrintMatrix(f_out,p->V[j],"%22.14le ");
	fprintf(f_out,"\n");
      }

  //=== Restrictions - W[j] ===//
  fprintf(f_out,"//== Non-zero W[j] ==//\n");
  for (j=0; j < p->nvars; j++)
    fprintf(f_out,"%d ",p->W[j] ? 1 : 0);
  fprintf(f_out,"\n\n");
  for (j=0; j < p->nvars; j++)
    if (p->W[j])
      {
	fprintf(f_out,"//== W[%d] ==//\n",j+1);
	dw_PrintMatrix(f_out,p->W[j],"%22.14le ");
	fprintf(f_out,"\n");
      }

  //====== Priors ======
  fprintf(f_out,"//== Gamma prior on zeta - a ==//\n");
  dw_PrintVector(f_out,p->zeta_a_prior,"%22.14le ");
  fprintf(f_out,"\n");
  fprintf(f_out,"//== Gamma prior on zeta - b ==//\n");
  dw_PrintVector(f_out,p->zeta_b_prior,"%22.14le ");
  fprintf(f_out,"\n");

  for (j=0; j < p->nvars; j++)
    {
      fprintf(f_out,"//== Variance of Gaussian prior on column %d of A0 ==//\n",j+1);
      dw_PrintMatrix(f_out,p->A0_prior[j],"%22.14le ");
      fprintf(f_out,"\n");
    }

  for (j=0; j < p->nvars; j++)
    {
      fprintf(f_out,"//== Variance of Gaussian prior on column %d of Aplus ==//\n",j+1);
      dw_PrintMatrix(f_out,p->Aplus_prior[j],"%22.14le ");
      fprintf(f_out,"\n");
    }

  //=== Model specification ===//
  fprintf(f_out,"//== Specification (0=default  1=Sims-Zha  2=Random Walk) ==//\n");
  if (p->Specification & SPEC_SIMS_ZHA)
    fprintf(f_out,"1\n\n");
  else
    if (p->Specification & SPEC_RANDOM_WALK)
      fprintf(f_out,"2\n\n");
    else
      fprintf(f_out,"0\n\n");
  if ((p->Specification & SPEC_SIMS_ZHA) == SPEC_SIMS_ZHA)
    fprintf(f_out,"//== Variance of Gaussian prior on lambda ==//\n%22.14le\n\n",p->lambda_prior);

  //====== coefficient and variance state variables ======
  fprintf(f_out,"//== Translation table for coefficient states ==//\n");
  dw_PrintArray(f_out,p->coef_states,"%4d ");

  fprintf(f_out,"//== Translation table for variance states ==//\n");
  dw_PrintArray(f_out,p->var_states,"%4d ");

  //====== Metropolis jumping kernel info for A0 ======
  fprintf(f_out,"//== Metropolis kernel scales for A0 ==//\n");
  dw_PrintArray(f_out,p->A0_Metropolis_Scale,"%22.14le ");

  //=== Data  ===
  fprintf(f_out,"//== Data Y (nobs x nvars) ==//\n");
  for (t=1; t <= p->nobs; t++)
    dw_PrintVector(f_out,p->Y[t],"%22.14le ");
  fprintf(f_out,"\n");

  fprintf(f_out,"//== Data X (nobs x npre) ==//\n");
  for (t=1; t <= p->nobs; t++)
    dw_PrintVector(f_out,p->X[t],"%22.14le ");
  fprintf(f_out,"\n");

  //=== Close output file ===
  if (!f) fclose(f_out);
}

/*
   Assumes:
    f:  valid file pointer or null
    filename:  pointer to null terminated string or null
    model:  pointer to valid TStateModel structure

   Returns:
    One upon success.  Upon failure, the routine prints an error message if 
    USER_ERR is a verbose error, terminates if USER_ERR is a terminal error and
    returns zero if USER_ERR is not a terminal error.  The terminal errors and
    verbose errors can be set with dw_SetTerminalErrors() and 
    dw_SetVerboseErrors().  

   Results:
    Upon success, the following fields of p will be filled:

                         A0, Aplus, Zeta, b0, bplus.

    If the Sims-Zha specification is used, the following fields will also be 
    filled

                               lambda, psi.

    The routine Thetahanged() will be called.

   Notes:
    One of f and filename must not be null.  

    The file must contain line identifiers of the form

                           //== A0[s] ==//
                           //== Aplus[s] ==//
                           //== Zeta[s] ==//
FreeParametersToVAR
    for 1 <= s <= p->nstates.

    Zeta is checked for non-negativity.  No checks are made to ensure that A0[s], 
    Aplus[s], or Zeta[s] satisfy any restrictions.
*/
int Read_VAR_Parameters(FILE *f, char *filename, char *header, TStateModel *model)
{
  FILE *f_in;
  char *idbuffer, *fmt;
  TMatrix *A0, *Aplus, *Zeta;
  int i, j, s;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);

  // Valid file
  f_in=OpenFile_VARio(f,filename);
  if (!f_in) return 0;

  if (!header) header="";

  // Allocate memory
  A0=dw_CreateArray_matrix(p->nstates);
  Aplus=dw_CreateArray_matrix(p->nstates);
  Zeta=dw_CreateArray_matrix(p->nstates);

  // Read File
  for (s=0; s < p->nstates; s++)
    {
      fmt="//== %sA0[%d] ==//";
      sprintf(idbuffer=(char*)dw_malloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
      if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,A0[s]=CreateMatrix(p->nvars,p->nvars))) 
	{
	  ReadError_VARio(idbuffer);
	  dw_free(idbuffer);
      if (!f) fclose(f_in);
	  return 0;
	}
      dw_free(idbuffer);

      fmt="//== %sAplus[%d] ==//";
      sprintf(idbuffer=(char*)dw_malloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
      if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,Aplus[s]=CreateMatrix(p->npre,p->nvars))) 
	{
	  ReadError_VARio(idbuffer);
	  dw_free(idbuffer);
      if (!f) fclose(f_in);
	  return 0;
	}
      dw_free(idbuffer);

      fmt="//== %sZeta[%d] ==//";
      sprintf(idbuffer=(char*)dw_malloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
      if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,Zeta[s]=CreateMatrix(p->nvars,p->nvars))) 
	{
	  ReadError_VARio(idbuffer);
	  dw_free(idbuffer);
      if (!f) fclose(f_in);
	  return 0;
	}
      dw_free(idbuffer);
    }
  if (!f) fclose(f_in);

  // Set A0, Aplus, and Zeta
  for (j=0; j < p->nvars; j++)
    for (s=0; s < p->nstates; s++)
      {
	for (i=0; i < p->nvars; i++)
	  ElementV(p->A0[j][p->coef_states[j][s]],i)=ElementM(A0[s],i,j);

	for (i=0; i < p->npre; i++)
	  ElementV(p->Aplus[j][p->coef_states[j][s]],i)=ElementM(Aplus[s],i,j);

	p->Zeta[j][p->var_states[j][s]]=ElementM(Zeta[s],j,j);
      }

  // Free memory
  dw_FreeArray(A0);
  dw_FreeArray(Aplus);
  dw_FreeArray(Zeta);

  // Check Zeta non-negative
  for (j=p->nvars-1; j >= 0; j--)
    for (s=p->n_var_states[j]-1; s >= 0; s--)
      if (p->Zeta[j][s] < 0.0)
	{
	  dw_UserError("Zeta has negative value.");
	  p->valid_parameters=0;
	  ThetaChanged(model);
	  return 0;
	}

  // Update b0, bplus, lambda, psi
  Update_b0_bplus_from_A0_Aplus(p);
  if ((p->Specification & SPEC_SIMS_ZHA) == SPEC_SIMS_ZHA) Update_lambda_psi_from_bplus(p);

  // Flags and notification that the VAR parameters have changed
  p->valid_parameters=1;
  ThetaChanged(model);

  return 1;
}

/*
    Reads VAR parameters from f_in.  For 0 <= s < nstates, reads A0[s], Aplus[s], 
    and Zeta[s].  Assumes A0[s] and Aplus[s] were written in column major format,
    and only the diagonal of Zeta[s] was written.
*/
int Read_VAR_ParametersFlat(FILE *f_in, TStateModel *model)
{
  TMatrix *A0, *Aplus;
  TVector *Zeta;
  int i, j, s, rtrn=0;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);

  // Allocate memory
  A0=dw_CreateArray_matrix(p->nstates);
  Aplus=dw_CreateArray_matrix(p->nstates);
  Zeta=dw_CreateArray_vector(p->nstates);

  // Read File
  for (s=0; s < p->nstates; s++)
    {
      A0[s]=CreateMatrix(p->nvars,p->nvars);
      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->nvars; i++)
	  if (fscanf(f_in," %lf ",&ElementM(A0[s],i,j)) != 1)
	    goto ERRORCOND;

      Aplus[s]=CreateMatrix(p->npre,p->nvars);
      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->npre; i++)
	  if (fscanf(f_in," %lf ",&ElementM(Aplus[s],i,j)) != 1)
	    goto ERRORCOND;

      Zeta[s]=CreateVector(p->nvars);
      for (j=0; j < p->nvars; j++)
	if (fscanf(f_in," %lf ",&ElementV(Zeta[s],j)) != 1)
	  goto ERRORCOND;
	else
	  if (ElementV(Zeta[s],j) < 0.0)
	    goto ERRORCOND;
    }

  // Set A0, Aplus, and Zeta
  for (j=0; j < p->nvars; j++)
    for (s=0; s < p->nstates; s++)
      {
	for (i=0; i < p->nvars; i++)
	  ElementV(p->A0[j][p->coef_states[j][s]],i)=ElementM(A0[s],i,j);

	for (i=0; i < p->npre; i++)
	  ElementV(p->Aplus[j][p->coef_states[j][s]],i)=ElementM(Aplus[s],i,j);

	p->Zeta[j][p->var_states[j][s]]=ElementV(Zeta[s],j);
      }

  // Update b0, bplus, lambda, psi
  Update_b0_bplus_from_A0_Aplus(p);
  if ((p->Specification & SPEC_SIMS_ZHA) == SPEC_SIMS_ZHA) Update_lambda_psi_from_bplus(p);

  // Flags and notification that the VAR parameters have changed
  p->valid_parameters=1;
  ThetaChanged(model);
  rtrn=1;

 ERRORCOND:

  // Free memory
  dw_FreeArray(A0);
  dw_FreeArray(Aplus);
  dw_FreeArray(Zeta);

  return rtrn;
}

/*
   Writes the VAR parameters to a file.  The identifiers are

     //== <header>A0[s] ==//
     //== <header>Aplus[s] ==//
     //== <header>Zeta[s] ==//

   for 1 <= s <= nstates
*/
int Write_VAR_Parameters(FILE *f, char *filename, char *header, TStateModel *model)
{
  TMatrix X;
  int s;
  FILE *f_out;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);

  f_out=f ? f :dw_CreateTextFile(filename);

  if (!header) header="";

  for (s=0; s < p->nstates; s++)
    {
      X=MakeA0((TMatrix)NULL,s,p);
      fprintf(f_out,"//== %sA0[%d] ==//\n",header,s+1);
      dw_PrintMatrix(f_out,X,"%22.14le ");
      fprintf(f_out,"\n");
      FreeMatrix(X);

      X=MakeAplus((TMatrix)NULL,s,p);
      fprintf(f_out,"//== %sAplus[%d] ==//\n",header,s+1);
      dw_PrintMatrix(f_out,X,"%22.14le ");
      fprintf(f_out,"\n");
      FreeMatrix(X);

      X=MakeZeta((TMatrix)NULL,s,p);
      fprintf(f_out,"//== %sZeta[%d] ==//\n",header,s+1);
      dw_PrintMatrix(f_out,X,"%22.14le ");
      fprintf(f_out,"\n");
      FreeMatrix(X);
    }

  if (!f) fclose(f_out);

  return 1;
}

#if defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
/*
  Writes A0, Aplus, Zeta and the Base Transition Matrix to either
  a Matlab or an Octave .mat file
 */
int Write_VAR_Parameters_Mat(TStateModel *model, char *out_tag)
{
  TMatrix Q, *A0 = (TMatrix *)NULL,
    *Aplus = (TMatrix *)NULL,
    *Zeta = (TMatrix *)NULL;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
  mxArray *A0mat, *Aplusmat, *Zetamat, *Qmat;
  mwSize dims[3];
  int s, status, nrows, ncols, i, j;
  double *data;

#if defined(MATLAB_MEX_FILE)
  MATFile *matFile;
#else
  size_t dims_i[3];
  mat_t *matFile;
  matvar_t *towrite;
#endif

  char *fullFilename = (char *)mxMalloc(strlen(out_tag) + strlen(".mat") - 1);
  strcpy(fullFilename, out_tag);
  strcat(fullFilename, ".mat");
#if defined(MATLAB_MEX_FILE)
  matFile = matOpen(fullFilename, "wz");
#else
  matFile = Mat_Create(fullFilename, NULL);
#endif
  if (matFile == NULL)
    {
      mexPrintf("Error opening mat file %s in Write_VAR_Parameters_Mat.\n", fullFilename);
      mxFree(fullFilename);
      dw_exit(0);
    }
  mxFree(fullFilename);

  A0 = MakeA0_All(A0, p);
  Aplus = MakeAplus_All(Aplus, p);
  Zeta = MakeZeta_All(Zeta, p);
  Q = model->sv->baseQ;

  /* A0 */
  dims[0] = nrows = RowM(A0[0]);
  dims[1] = ncols = ColM(A0[0]);
  dims[2] = p->nstates;
  A0mat = mxCreateNumericArray(3, (mwSize *)dims, mxDOUBLE_CLASS, mxREAL);
  data = mxGetPr(A0mat);

  for (s=0; s < p->nstates; s++)
    for (i=0; i < nrows; i++)
      for (j=0; j < ncols; j++)
        data[s*(nrows*ncols)+i+j*nrows] = (double)(ElementM(A0[s], i, j));

#if defined(MATLAB_MEX_FILE)
  status = matPutVariable(matFile, "A0", A0mat);
#else
  for (i=0; i<3; i++)
    dims_i[i] = dims[i];
  towrite = Mat_VarCreate("A0", MAT_C_DOUBLE, MAT_T_DOUBLE, 3, dims_i, data, 0);
  status = Mat_VarWrite(matFile, towrite, MAT_COMPRESSION_NONE);
#endif
  if (status != 0)
    {
      mexPrintf("Error writing A0 to matfile in Write_VAR_Parameters_Mat.\n");
      dw_exit(0);
    }

  /* Aplus */
  dims[0] = nrows = RowM(Aplus[0]);
  dims[1] = ncols = ColM(Aplus[0]);
  Aplusmat = mxCreateNumericArray(3, (mwSize *)dims, mxDOUBLE_CLASS, mxREAL);
  data = mxGetPr(Aplusmat);

  for (s=0; s < p->nstates; s++)
    for (i=0; i < nrows; i++)
      for (j=0; j < ncols; j++)
        data[s*(nrows*ncols)+i+j*nrows] = (double)(ElementM(Aplus[s], i, j));

#if defined(MATLAB_MEX_FILE)
  status = matPutVariable(matFile, "Aplus", Aplusmat);
#else
  for (i=0; i<2; i++)
    dims_i[i] = dims[i];
  towrite = Mat_VarCreate("Aplus", MAT_C_DOUBLE, MAT_T_DOUBLE, 3, dims_i, data, 0);
  status = Mat_VarWrite(matFile, towrite, MAT_COMPRESSION_NONE);
#endif
  if (status != 0)
    {
      mexPrintf("Error writing Aplus to matfile in Write_VAR_Parameters_Mat.\n");
      dw_exit(0);
    }

  /* Zeta */
  dims[0] = nrows = RowM(Zeta[0]);
  dims[1] = ncols = ColM(Zeta[0]);
  Zetamat = mxCreateNumericArray(3, (mwSize *)dims, mxDOUBLE_CLASS, mxREAL);
  data = mxGetPr(Zetamat);

  for (s=0; s < p->nstates; s++)
    for (i=0; i < nrows; i++)
      for (j=0; j < ncols; j++)
        data[s*(nrows*ncols)+i+j*nrows] = (double)(ElementM(Zeta[s], i, j));

#if defined(MATLAB_MEX_FILE)
  status = matPutVariable(matFile, "Zeta", Zetamat);
#else
  for (i=0; i<2; i++)
    dims_i[i] = dims[i];
  towrite = Mat_VarCreate("Zeta", MAT_C_DOUBLE, MAT_T_DOUBLE, 3, dims_i, data, 0);
  status = Mat_VarWrite(matFile, towrite, MAT_COMPRESSION_NONE);
#endif
  if (status != 0)
    {
      mexPrintf("Error writing Zeta to matfile in Write_VAR_Parameters_Mat.\n");
      dw_exit(0);
    }

  /* Q */
  dims[0] = nrows = RowM(Q);
  dims[1] = ncols = ColM(Q);
  dims[2] = 0;
  Qmat = mxCreateNumericArray(2, (mwSize *)dims, mxDOUBLE_CLASS, mxREAL);
  data = mxGetPr(Qmat);

  for (i=0; i < nrows; i++)
    for (j=0; j < ncols; j++)
      data[i+j*nrows] = (double)(ElementM(Q, i, j));

#if defined(MATLAB_MEX_FILE)
  status = matPutVariable(matFile, "Q", Qmat);
#else
  for (i=0; i<3; i++)
    dims_i[i] = dims[i];
  towrite = Mat_VarCreate("Q", MAT_C_DOUBLE, MAT_T_DOUBLE, 2, dims_i, data, 0);
  status = Mat_VarWrite(matFile, towrite, MAT_COMPRESSION_NONE);
#endif
  if (status != 0)
    {
      mexPrintf("Error writing Q to matfile in Write_VAR_Parameters_Mat.\n");
      dw_exit(0);
    }

#if defined(MATLAB_MEX_FILE)
  matClose(matFile);
#else
  Mat_Close(matFile);
#endif
  for (s=0; s < p->nstates; s++)
    {
      FreeMatrix(A0[s]);
      FreeMatrix(Aplus[s]);
      FreeMatrix(Zeta[s]);
    }
  return 1;
}
#endif

/*
   Writes the headers for Write_VAR_ParametersFlat().  This routine can
   be used to give the ordering for Write_VAR_ParametersFlat().
*/
int Write_VAR_ParametersFlat_Headers(FILE *f_out, TStateModel *model)
{
  int i, j, s;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);

  if (!f_out) return 0;

  for (s=0; s < p->nstates; s++)
    {
      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->nvars; i++)
	  fprintf(f_out,"A0[%d](%d,%d) ",s+1,i+1,j+1);

      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->npre; i++)
	  fprintf(f_out,"Aplus[%d](%d,%d) ",s+1,i+1,j+1);

      for (j=0; j < p->nvars; j++)
	fprintf(f_out,"Zeta[%d](%d,%d) ",s+1,j+1,j+1);
    }

  return 1;
}

/*
   For each state the VAR parameters are printed as follows
    A0    (by columns)
    Aplus (by columns)
    Zeta  (diagonal)
*/
int Write_VAR_ParametersFlat(FILE *f, TStateModel *model, char *fmt)
{
  TMatrix A0, Aplus;
  int s, i, j;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);

  if (!f) return 0;

  if (!fmt) fmt="%lf ";

  A0=CreateMatrix(p->nvars,p->nvars);
  Aplus=CreateMatrix(p->npre,p->nvars);

  for (s=0; s < p->nstates; s++)
    {
      MakeA0(A0,s,p);
      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->nvars; i++)
	  fprintf(f,fmt,ElementM(A0,i,j));
     

      MakeAplus(Aplus,s,p);
      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->npre; i++)
	  fprintf(f,fmt,ElementM(Aplus,i,j));

      for (j=0; j < p->nvars; j++)
	fprintf(f,fmt,p->Zeta[j][p->var_states[j][s]]);
    }

  FreeMatrix(Aplus);
  FreeMatrix(A0);

  return 1;
}

/*
   For each state the VAR parameters are printed as follows
    A0    (by columns)
    Aplus (by columns)
    Zeta  (diagonal)
   The system is normalized so that the diagonal of A0 is one.
*/
int Write_VAR_ParametersFlat_A0_Diagonal_One(FILE *f, TStateModel *model, char *fmt)
{
  TMatrix A0, Aplus;
  TVector i_diagonal, s_diagonal;
  int s, i, j;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);
  PRECISION x;

  if (!f) return 0;

  if (!fmt) fmt="%lf ";

  A0=CreateMatrix(p->nvars,p->nvars);
  Aplus=CreateMatrix(p->npre,p->nvars);
  s_diagonal=CreateVector(p->nvars);
  i_diagonal=CreateVector(p->nvars);

  for (s=0; s < p->nstates; s++)
    {
      MakeA0(A0,s,p);
      for (i=p->nvars-1; i >= 0; i--) 
	{
	  ElementV(i_diagonal,i)=1.0/(x=ElementM(A0,i,i));
	  ElementV(s_diagonal,i)=x*x;
	}

      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->nvars; i++)
	  fprintf(f,fmt,ElementM(A0,i,j)*ElementV(i_diagonal,j));   

      MakeAplus(Aplus,s,p);
      for (j=0; j < p->nvars; j++)
	for (i=0; i < p->npre; i++)
	  fprintf(f,fmt,ElementM(Aplus,i,j)*ElementV(i_diagonal,j));

      for (j=0; j < p->nvars; j++)
	fprintf(f,fmt,p->Zeta[j][p->var_states[j][s]] * ElementV(s_diagonal,j));
    }

  FreeVector(i_diagonal);
  FreeVector(s_diagonal);
  FreeMatrix(Aplus);
  FreeMatrix(A0);

  return 1;
}

/*
   Attempts to read all parameters.  The identifiers are

     //== <id>States ==// 
     //== <id>Transition matrix[] ==//
     //== <id>A0[s] ==//
     //== <id>Aplus[s] ==//
     //== <id>Zeta[s] ==//

   for 1 <= s <= nstates
*/
void ReadAllParameters(FILE *f, char *filename, char *id, TStateModel *model)
{
  char *buffer, *fmt="//== %sStates ==//";
  FILE *f_in=f ? f :dw_OpenTextFile(filename);

  if (!id) id="";

  sprintf(buffer=(char*)dw_malloc(strlen(fmt) + strlen(id) - 1),fmt,id);
  ReadArray_VARio(f_in,buffer,model->S);
  dw_free(buffer);

  ReadBaseTransitionMatrices(f_in,(char*)NULL,id,model);
  Read_VAR_Parameters(f_in,(char*)NULL,id,model);

  if (!f) fclose(f_in);
}

/*
   Attempts to write all parameters using a format readable by the routine
   ReadAllParameters().
*/
void WriteAllParameters(FILE *f, char *filename, char *id, TStateModel *model)
{
  FILE *f_in=f ? f : dw_CreateTextFile(filename);

  if (!id) id="";

  fprintf(f_in,"//== %sStates ==//\n",id);
  dw_PrintArray(f_in,model->S,(char*)NULL);
  fprintf(f_in,"\n");

  WriteBaseTransitionMatrices(f_in,(char*)NULL,id,model);
  Write_VAR_Parameters(f_in,(char*)NULL,id,model);

  if (!f) fclose(f_in);
}

/*******************************************************************************/
/******************************** Input/Output *********************************/
/*******************************************************************************/
void Write_ReducedFormVAR_Parameters(FILE *f, char *filename, T_VAR_Parameters *p)
{
  TMatrix A0, Aplus, Zeta, C, Sigma;
  int k;
  FILE *f_out;

  f_out=f ? f :dw_CreateTextFile(filename);

  A0=CreateMatrix(p->nvars,p->nvars);
  Aplus=CreateMatrix(p->npre,p->nvars);
  Zeta=CreateMatrix(p->nvars,p->nvars);
  C=CreateMatrix(p->npre,p->nvars);
  Sigma=CreateMatrix(p->nvars,p->nvars);

  for (k=0; k < p->nstates; k++)
    {
      MakeA0(A0,k,p);
      MakeAplus(Aplus,k,p);
      MakeZeta(Zeta,k,p);

      //ProductInverseMM(C,Aplus,A0);
      //ProductMM(A0,A0,Xi);
      //ProductTransposeMM(Sigma,A0,A0);
      //Inverse_LU(Sigma,Sigma);

      fprintf(f_out,"//== Reduced Form[%d] ==//\n",k+1);
      dw_PrintMatrix(f_out,C,"%lf ");
      fprintf(f_out,"\n");

      fprintf(f_out,"//== Variance[%d] ==//\n",k+1);
      dw_PrintMatrix(f_out,Sigma,"%lf ");
      fprintf(f_out,"\n");
    }

  FreeMatrix(A0);
  FreeMatrix(Aplus);
  FreeMatrix(Zeta);
  FreeMatrix(C);
  FreeMatrix(Sigma);

  if (!f) fclose(f_out);
}

/*
   Create Model from data file.  Assumes that the state variables have a flat
   structure.
*/
void Write_VAR_Info(FILE *f, char *filename, T_VAR_Parameters *p)
{
  FILE *f_out;
  int j;

  if (!f)
    f_out=dw_CreateTextFile(filename);
  else
    f_out=f;

  //=== Write sizes ===//
  fprintf(f_out,"//== Number Observations ==//\n%d\n\n",p->nobs);
  fprintf(f_out,"//== Number Variables ==//\n%d\n\n",p->nvars);
  fprintf(f_out,"//== Number Lags ==//\n%d\n\n",p->nlags);
  fprintf(f_out,"//== Exogenous Variables ==//\n%d\n\n",p->npre - p->nvars * p->nlags);

  //=== Restrictions - U[j] ===//
  fprintf(f_out,"//== Number of free parameters in jth column of A0 ==//\n");
  for (j=0; j < p->nvars; j++)
    fprintf(f_out,"%d ",ColM(p->U[j]));
  fprintf(f_out,"\n\n");
  fprintf(f_out,"//== U[j] 0 <= j < nvars ==//\n");
  for (j=0; j < p->nvars; j++)
    {
      dw_PrintMatrix(f_out,p->U[j],"%lf ");
      fprintf(f_out,"\n");
    }

  //=== Restrictions - V[j] ===//
  fprintf(f_out,"//== Number of free parameters in jth column of Aplus ==//\n");
  for (j=0; j < p->nvars; j++)
    fprintf(f_out,"%d ",p->V[j] ? ColM(p->V[j]) : 0);
  fprintf(f_out,"\n\n");
  fprintf(f_out,"//== V[j] 0 <= j < nvars ==//\n");
  for (j=0; j < p->nvars; j++)
    if (p->V[j])
      {
	dw_PrintMatrix(f_out,p->V[j],"%lf ");
	fprintf(f_out,"\n");
      }

  //=== Restrictions - W[j] ===//
  fprintf(f_out,"//== Non-zero W[j] ==//\n");
  for (j=0; j < p->nvars; j++)
    fprintf(f_out,"%d ",p->W[j] ? 1 : 0);
  fprintf(f_out,"\n\n");
  fprintf(f_out,"//== W[j] 0 <= j < nvars ==//\n");
  for (j=0; j < p->nvars; j++)
    if (p->W[j])
      {
	dw_PrintMatrix(f_out,p->W[j],"%lf ");
	fprintf(f_out,"\n");
      }

  //====== Priors ======
  fprintf(f_out,"//== Gamma prior on Xi ==//\n");
  for (j=0; j < p->nvars; j++)
    fprintf(f_out,"%lf %lf\n",ElementV(p->zeta_a_prior,j),ElementV(p->zeta_b_prior,j));
  fprintf(f_out,"\n");

  fprintf(f_out,"//== Prior on jth column of A0 - Gaussian variance ==//\n");
  for (j=0; j < p->nvars; j++)
    {
      dw_PrintMatrix(f_out,p->A0_prior[j],"%lf ");
      fprintf(f_out,"\n");
    }

  fprintf(f_out,"//== Prior on jth column of Aplus - Gaussian variance ==//\n");
  for (j=0; j < p->nvars; j++)
    {
      dw_PrintMatrix(f_out,p->Aplus_prior[j],"%lf ");
      fprintf(f_out,"\n");
    }

/*   //====== coefficient/variance state variables ====== */
/*   CStates=dw_CreateRegularArrayList_int(2,p->nvars,sv->n_state_variables); */
/*   id="//== Controlling states variables for coefficients ==//"; */
/*   if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,CStates)) dw_Error(PARSE_ERR); */

/*   VStates=dw_CreateRegularArrayList_int(2,p->nvars,sv->n_state_variables); */
/*   id="//== Controlling states variables for variance ==//"; */
/*   if (!dw_SetFilePosition(f_in,id) || !dw_ReadArray(f_in,VStates)) dw_Error(PARSE_ERR); */

/*   //=== Read Data  === */
/*   if (!dw_SetFilePosition(f_in,"//== Data Y (T x nvars) ==//") */
/*       || !dw_SetFilePosition(f_in,"//== Data X (T x npre) ==//")) */
/*     p->X=p->Y=(TVector*)NULL; */
/*   else */
/*     { */
/*       // Initialize Y */
/*       id="//== Data Y (T x nvars) ==//"; */
/*       if (!dw_SetFilePosition(f_in,id)) dw_Error(PARSE_ERR); */
/*       p->Y=dw_CreateArray_vector(p->nobs+1); */
/*       for (t=1; t <= p->nobs; t++) */
/* 	if (!dw_ReadVector(f_in,p->Y[t]=CreateVector(p->nvars))) dw_Error(PARSE_ERR); */

/*       // Initialize X */
/*       id="//== Data X (T x npre) ==//"; */
/*       if (!dw_SetFilePosition(f_in,id)) dw_Error(PARSE_ERR); */
/*       p->X=dw_CreateArray_vector(p->nobs+1); */
/*       for (t=1; t <= p->nobs; t++) */
/* 	if (!dw_ReadVector(f_in,p->X[t]=CreateVector(p->npre))) */
/* 	  dw_Error(PARSE_ERR); */
/*     } */

  //=== Close output file ===
  if (!f) fclose(f_out);
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/
/*
   There was a bug in the original coded that could cause a perturbation in the 
   initial values.  If was found that this perturbation sometimes inproved the
   performance of the estimation procedure.  We include this technique so the 
   results of original code can reproduced.  A more systematic approach to
   perturbation is now used.
*/
static void Update_lambda_psi_from_bplus_original(T_VAR_Parameters *p)
{
  int j, k, i, m, n, dim=p->nlags*p->nvars;
  PRECISION *p_bplus, *p_lambda, *p_psi;
  for (j=p->nvars-1; j >= 0; j--)
    {
      p_psi=pElementV(p->psi[j]);
      p_bplus=pElementV(p->bplus[j][0]);
      memcpy(p_psi,p_bplus,dim*sizeof(PRECISION));
      ElementV(p->constant[j],0)=p_bplus[dim];
      InitializeVector(p->lambda[j][0],1.0);

      for (k=dw_DimA(p->bplus[j])-1; k > 0; k--)
	{
	  p_bplus=pElementV(p->bplus[j][k]);
	  p_lambda=pElementV(p->lambda[j][k]);
	  ElementV(p->constant[j],k)=p_bplus[dim];
	  for (m=p->nvars-1; m >= 0; m--)
	    {
	      for (n=dim+m, i=n-p->nvars; i >= 0; i-=p->nvars)
		if (fabs(p_psi[i]) > fabs(p_psi[n])) n=i;
	      p_lambda[m]=(p_psi[n] != 0) ? p_bplus[n]/p_psi[n] : 0;
	    }
	}
    }
}
int Read_VAR_Parameters_Original(FILE *f, char *filename, char *header, TStateModel *model)
{
  FILE *f_in;
  char *idbuffer, *fmt;
  TMatrix *A0, *Aplus, *Zeta;
  int i, j, s;
  T_VAR_Parameters *p=(T_VAR_Parameters*)(model->theta);

  // Valid file
  f_in=OpenFile_VARio(f,filename);
  if (!f_in) return 0;

  if (!header) header="";

  // Allocate memory
  A0=dw_CreateArray_matrix(p->nstates);
  Aplus=dw_CreateArray_matrix(p->nstates);
  Zeta=dw_CreateArray_matrix(p->nstates);

  // Read File
  for (s=0; s < p->nstates; s++)
    {
      fmt="//== %sA0[%d] ==//";
      sprintf(idbuffer=(char*)dw_malloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
      if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,A0[s]=CreateMatrix(p->nvars,p->nvars))) 
	{
	  ReadError_VARio(idbuffer);
	  dw_free(idbuffer);
      if (!f) fclose(f_in);
	  return 0;
	}
      dw_free(idbuffer);

      fmt="//== %sAplus[%d] ==//";
      sprintf(idbuffer=(char*)dw_malloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
      if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,Aplus[s]=CreateMatrix(p->npre,p->nvars))) 
	{
	  ReadError_VARio(idbuffer);
	  dw_free(idbuffer);
      if (!f) fclose(f_in);
	  return 0;
	}
      dw_free(idbuffer);

      fmt="//== %sZeta[%d] ==//";
      sprintf(idbuffer=(char*)dw_malloc(strlen(fmt)+strlen(header)+strlen_int(s+1)-3),fmt,header,s+1);
      if (!dw_SetFilePosition(f_in,idbuffer) || !dw_ReadMatrix(f_in,Zeta[s]=CreateMatrix(p->nvars,p->nvars))) 
	{
	  ReadError_VARio(idbuffer);
	  dw_free(idbuffer);
      if (!f) fclose(f_in);
	  return 0;
	}
      dw_free(idbuffer);
    }
  if (!f) fclose(f_in);

  // Set A0, Aplus, and Zeta
  for (j=0; j < p->nvars; j++)
    for (s=0; s < p->nstates; s++)
      {
	for (i=0; i < p->nvars; i++)
	  ElementV(p->A0[j][p->coef_states[j][s]],i)=ElementM(A0[s],i,j);

	for (i=0; i < p->npre; i++)
	  ElementV(p->Aplus[j][p->coef_states[j][s]],i)=ElementM(Aplus[s],i,j);

	p->Zeta[j][p->var_states[j][s]]=ElementM(Zeta[s],j,j);
      }

  // Free memory
  dw_FreeArray(A0);
  dw_FreeArray(Aplus);
  dw_FreeArray(Zeta);

  // Check Zeta non-negative
  for (j=p->nvars-1; j >= 0; j--)
    for (s=p->n_var_states[j]-1; s >= 0; s--)
      if (p->Zeta[j][s] < 0.0)
	{
	  dw_UserError("Zeta has negative value.");
	  p->valid_parameters=0;
	  ThetaChanged(model);
	  return 0;
	}

  // Update b0, bplus, lambda, psi
  Update_b0_bplus_from_A0_Aplus(p);
  if ((p->Specification & SPEC_SIMS_ZHA) == SPEC_SIMS_ZHA) Update_lambda_psi_from_bplus_original(p);

  // Flags and notification that the VAR parameters have changed
  p->valid_parameters=1;
  ThetaChanged(model);

  return 1;
}
/*******************************************************************************/
/*******************************************************************************/
/*******************************************************************************/


/*
   Create Model from data file.  Assumes that the state variables have a flat
   structure.
*/
/**
TStateModel* CreateStateModel_VAR_File(FILE *f, char *filename)
{
  TMarkovStateVariable *sv;
  T_VAR_Parameters *p;

  //=== Create Markov State Variable ===
  sv=CreateMarkovStateVariable_File(f,filename,0);

  //=== Create VAR Parameters
  p=Create_VAR_Parameters_File(f,filename,sv);

  //=== Create TStateModel ===
  return CreateStateModel_new(sv,CreateRoutines_VAR(),p);
}
**/
