SEXP dtrMatrix_rcond(SEXP obj, SEXP type)
{
char typnm[] = {'\0', '\0'};
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;
double rcond;
typnm[0] = La_rcond_type(CHAR(asChar(type)));
F77_CALL(dtrcon)(typnm, uplo_P(obj), diag_P(obj), dims,
REAL(GET_SLOT(obj, Matrix_xSym)), dims, &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);
char typnm[] = {'\0', '\0'};
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;
double anorm = get_norm_sy(obj, "O");
double rcond;
typnm[0] = La_rcond_type(CHAR(asChar(type)));
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 dgeMatrix_rcond(SEXP obj, SEXP type)
{
SEXP LU = PROTECT(dgeMatrix_LU_(obj, FALSE));/* <- not warning about singularity */
char typnm[] = {'\0', '\0'};
int *dims = INTEGER(GET_SLOT(LU, Matrix_DimSym)), info;
double anorm, rcond;
if (dims[0] != dims[1] || dims[0] < 1) {
UNPROTECT(1);
error(_("rcond requires a square, non-empty matrix"));
}
typnm[0] = La_rcond_type(CHAR(asChar(type)));
anorm = get_norm(obj, typnm);
F77_CALL(dgecon)(typnm,
dims, REAL(GET_SLOT(LU, Matrix_xSym)),
dims, &anorm, &rcond,
(double *) R_alloc(4*dims[0], sizeof(double)),
(int *) R_alloc(dims[0], sizeof(int)), &info);
UNPROTECT(1);
return ScalarReal(rcond);
}
