static
double set_rcond_sy(SEXP obj, char *typstr)
{
char typnm[] = {'\0', '\0'};
SEXP rcv = GET_SLOT(obj, Matrix_rcondSym);
double rcond;
typnm[0] = rcond_type(typstr);
rcond = get_double_by_name(rcv, typnm);
if (R_IsNA(rcond)) {
SEXP trf = dsyMatrix_trf(obj);
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;
double anorm = get_norm_sy(obj, "O");
F77_CALL(dsycon)(uplo_P(trf), dims,
REAL (GET_SLOT(trf, Matrix_xSym)), dims,
INTEGER(GET_SLOT(trf, Matrix_permSym)),
&anorm, &rcond,
(double *) R_alloc(2*dims[0], sizeof(double)),
(int *) R_alloc(dims[0], sizeof(int)), &info);
SET_SLOT(obj, Matrix_rcondSym,
set_double_by_name(rcv, rcond, typnm));
}
return rcond;
}
SEXP plasma_dsyMatrix_norm(SEXP obj, SEXP type)
{
#ifdef HIPLAR_WITH_PLASMA
#ifdef HIPLAR_DBG
R_ShowMessage("DBG: Entering plasma_dsyMatrix_norm");
#endif
return ScalarReal(get_norm_sy(obj, CHAR(asChar(type))));
#endif
return R_NilValue;
}
SEXP dpoMatrix_rcond(SEXP obj, SEXP type)
{
SEXP Chol = dpoMatrix_chol(obj);
char typnm[] = {'O', '\0'}; /* always use the one norm */
int *dims = INTEGER(GET_SLOT(Chol, Matrix_DimSym)), info;
double anorm = get_norm_sy(obj, typnm), rcond;
F77_CALL(dpocon)(uplo_P(Chol),
dims, REAL(GET_SLOT(Chol, Matrix_xSym)),
dims, &anorm, &rcond,
(double *) R_alloc(3*dims[0], sizeof(double)),
(int *) R_alloc(dims[0], sizeof(int)), &info);
return ScalarReal(rcond);
}
SEXP dsyMatrix_rcond(SEXP obj, SEXP type)
{
SEXP trf = dsyMatrix_trf(obj);
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;
double anorm = get_norm_sy(obj, "O");
double rcond;
F77_CALL(dsycon)(uplo_P(trf), dims,
REAL (GET_SLOT(trf, Matrix_xSym)), dims,
INTEGER(GET_SLOT(trf, Matrix_permSym)),
&anorm, &rcond,
(double *) R_alloc(2*dims[0], sizeof(double)),
(int *) R_alloc(dims[0], sizeof(int)), &info);
return ScalarReal(rcond);
}
SEXP dsyMatrix_norm(SEXP obj, SEXP type)
{
return ScalarReal(get_norm_sy(obj, CHAR(asChar(type))));
}
