static int stepy_ (integer *n, integer *p, doublereal *a,
doublereal *d, doublereal *b, doublereal *ada,
integer *info)
{
integer i, m = *p * *p;
int attempt = 0;
int err = 0;
try_again:
for (i=0; i<m; i++) {
ada[i] = 0.0;
}
for (i=0; i<*n; i++) {
dsyr_("U", p, &d[i], &a[i * *p], &one, ada, p);
}
if (attempt == 0) {
dposv_("U", p, &one, ada, p, b, p, info);
if (*info != 0) {
fprintf(stderr, "stepy: dposv gave info = %d\n", *info);
attempt = 1;
goto try_again;
}
} else {
gretl_matrix A, B;
gretl_matrix_init(&A);
gretl_matrix_init(&B);
A.rows = A.cols = *p;
A.val = ada;
B.rows = *p;
B.cols = 1;
B.val = b;
err = gretl_LU_solve(&A, &B);
if (err) {
fprintf(stderr, "stepy: gretl_LU_solve: err = %d\n", err);
}
}
return err;
}
static int qr_make_hac (MODEL *pmod, const DATASET *dset,
gretl_matrix *XTXi)
{
gretl_matrix *X, *XOX, *V = NULL;
gretl_matrix umat;
VCVInfo vi;
int T = pmod->nobs;
int err = 0;
X = make_data_X(pmod, dset);
if (X == NULL) {
return E_ALLOC;
}
/* pmod->uhat is a full-length series: we must take an offset
into it, equal to the offset of the data on which the model
is actually estimated.
*/
gretl_matrix_init(&umat);
umat.rows = T;
umat.cols = 1;
umat.val = pmod->uhat + pmod->t1;
XOX = HAC_XOX(&umat, X, &vi, 0, &err);
if (!err) {
V = gretl_matrix_alloc(XOX->rows, XOX->rows);
if (V == NULL) {
err = E_ALLOC;
}
}
if (!err) {
gretl_matrix_qform(XTXi, GRETL_MOD_TRANSPOSE, XOX,
V, GRETL_MOD_NONE);
/* Transcribe vcv into triangular representation */
err = qr_make_vcv(pmod, V, VCV_ROBUST);
}
if (!err) {
gretl_model_set_full_vcv_info(pmod, vi.vmaj, vi.vmin,
vi.order, vi.flags,
vi.bw);
if (!na(vi.bw)) {
gretl_model_set_double(pmod, "hac_bw", vi.bw);
} else {
gretl_model_set_double(pmod, "hac_bw", (double) vi.order);
}
}
gretl_matrix_free(X);
gretl_matrix_free(XOX);
gretl_matrix_free(V);
return err;
}
