*
*  Procedure TVARSET
*
*  TVARSET( options )
*  #  list of dependent variables
*
*  TVARSET sets up a time-varying parameters VAR system for estimation
*  using the Kalman filter.  As written, it is based upon the simple
*  symmetric Bayesian VAR prior, with the time-variation proportional to
*  the initial covariance matrix
*
*  Options:
*    LAGS =number of lags for each dependent variable.
*    SEFACTOR = fraction of OLS autoregression variance used for variance
*      of the observation equations [.9].
*    TVREL = fraction of the initial covariance matrix used for time-varying
*      matrix.
*    CONTIGHT = standard deviation on the constant term.
*
*  The following options correspond to similar options on the SPECIFY
*  instruction.  (OTHER is the symmetry parameter on SPECIFY)
*
*    TIGHT=overall tightness of prior  [.2]
*    OTHER=relative weight on other lags [1.0]
*    LAGTYPE=[HARMONIC]/GEOMETRIC  type of lag decay
*    DECAY=parameter of lag decay [no decay]
*
*  TVARSET uses the following as global variables:
*    XXX     = VECTOR[SYMMETRIC] covariance matrices of the states
*    TVX     = VECTOR[SYMMETRIC] time-varying variances
*    NVARCOS = number of coefficients
*    LIKELY  = LIKELIHOOD array for KFSET
*
*  Revision Schedule:
*     11/1989 Original write
*     11/1991 Bug fix. Signs wrong in setting LAGDECAY vectors
*     02/1992 Update to Version 4.0
*     07/2003 Update to Version 5.02, correcting the order of calculations
*
proc tvarset
*
option integer  lags       4
option real     sefactor  .9
option real     tight     .2
option choice   lagtype    1 harmonic geometric
option real     decay
option real     other      1.0
option real     tvrel      0.00000001
option real     contight   0.0001
*
local index list
local vector lagdecay univar cvector
local integer number i j l
local real basescal decayfac
declare vector[symm] xxx tvx
*
enter(varying,entries=number) list
compute nvarcos=number*lags+1
dim xxx(number) tvx(number)
dim univar(number) cvector(nvarcos) lagdecay(lags)
*
*  Compute univariate autoregressions and put SEFACTOR * its regression
*  variance into UNIVAR
*
do i=1,number
  linreg(noprint) list(i)
  # constant list(i){1 to lags}
  compute univar(i)=sefactor*%seesq
end do i
*
system 1 to number
variables list
det constant
lags 1 to lags
kfset(noscale,vector=univar,likelihood=likely) xxx
tvarying tvx
end(system)
*
*  Set the initial coefficient vectors to the random walk mean
*
do i=1,number
  ewise cvector(j)=(j==(i-1)*lags+1)
  associate i cvector
end do i
*
*  Set lag decay. These give relative prior variances, not precisions.
*
if .not.%defined(decay)
   ewise lagdecay(i)=1.0
else if lagtype==1
   ewise lagdecay(i)=i**(-2*decayfac)
else
   ewise lagdecay(i)=decay**(2*(i-1))
*
*  Set up the XXX and TVX matrices
*
do i=1,number
  dim xxx(i)(nvarcos,nvarcos)
  compute xxx(i)=%const(0.0)
  do j=1,number
    compute basescal=tight**2*%if(i==j,1.0,(univar(i)*other**2)/univar(j))
    do l=1,lags
       compute xxx(i)((j-1)*lags+l,(j-1)*lags+l)=basescal*lagdecay(l)
    end do l
  end do j
  compute xxx(i)(nvarcos,nvarcos)=contight**2*univar(i)
  compute tvx(i)=tvrel*xxx(i)
end do i
end

