*
*  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 precision 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 precision matrix used for time-varying
*      matrix.
*    CONTIGHT = precision (std. dev.) 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:
*     November, 1989. Original write
*     July, 1991    . Bug fix. Signs wrong in setting LAGDECAY vectors
*     February, 1992. Update to Version 4.0.
*     June, 1993    . Change references to DECAYFAC to DECAY.
*     July, 1993    . Move setting of UNIVAR vector before system
*                     definition to conform with 4.0 treatment of VECTOR
*                     on KFSET.
*     May, 2002     . Fixed the Version 5 distribution copy to include
*                     the July 1993 change.
*
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 autoregression 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 initial coefficient vector (for standard R.W. prior)
*
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
