Beispiel #1
0
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;
}
Beispiel #2
0
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;
}