static
double get_norm(SEXP obj, const char *typstr)
{
if(any_NA_in_x(obj))
return NA_REAL;
else {
char typnm[] = {'\0', '\0'};
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym));
double *work = (double *) NULL;
typnm[0] = La_norm_type(typstr);
if (*typnm == 'I') {
work = (double *) R_alloc(dims[0], sizeof(double));
}
return F77_CALL(dlange)(typstr, dims, dims+1,
REAL(GET_SLOT(obj, Matrix_xSym)),
dims, work);
}
}
static
double magma_get_norm(SEXP obj, const char *typstr)
{
#ifdef HIPLAR_WITH_MAGMA
if(any_NA_in_x(obj))
return NA_REAL;
else {
char typnm[] = {'\0', '\0'};
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym));
double *work = (double *) NULL;
typnm[0] = La_norm_type(typstr);
if (*typnm == 'I') {
work = (double *) R_alloc(dims[0], sizeof(double));
if(GPUFlag == 1 && (dims[0] % 64 == 0) && (dims[1] % 64 == 0)) {
#ifdef HIPLAR_DBG
R_ShowMessage("DBG: Getting norm using magmablas_dlange");
#endif
double *d_work, *d_A, *A, val;
A = REAL(GET_SLOT(obj, Matrix_xSym));
cublasAlloc(dims[0] * dims[1], sizeof(double), (void**)&d_A);
cublasAlloc(dims[0], sizeof(double), (void**)&d_work);
cublasSetVector(dims[0] * dims[1], sizeof(double), A, 1, d_A, 1);
val = magmablas_dlange(*typstr, dims[0], dims[1], d_A, dims[0], d_work);
cudaFree(d_A);
cudaFree(d_work);
return val;
}
}
return F77_CALL(dlange)(typstr, dims, dims+1,
REAL(GET_SLOT(obj, Matrix_xSym)),
dims, work);
}
#endif
return 0.0;
}
