double get_norm_sy(SEXP obj, const char *typstr)
{
#ifdef HIPLAR_WITH_PLASMA
char typnm[] = {'\0', '\0'};
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym));
double *work = (double *) NULL;
typnm[0] = La_norm_type(typstr);
if ((*typnm == 'F') && (CHECK_VVERSION_BEQ(2,4,5))) {
error("not implemented");
}
if (*typnm == 'F') {
work = (double *) R_alloc(2*R_PLASMA_NUM_THREADS, sizeof(double));
} else {
work = (double *) R_alloc(R_PLASMA_NUM_THREADS, sizeof(double));
}
return P_dlansy(typnm, uplo_P(obj),
dims[0], REAL(GET_SLOT(obj, Matrix_xSym)), dims[0], work);
#endif
return 0.0;
}
double get_norm_sy(SEXP obj, const char *typstr)
{
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' || *typnm == 'O') {
work = (double *) R_alloc(dims[0], sizeof(double));
}
return F77_CALL(dlansy)(typnm, uplo_P(obj),
dims, REAL(GET_SLOT(obj, Matrix_xSym)),
dims, work);
}
static
double get_norm(SEXP obj, const char *typstr)
{
if(any_NA(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);
}
}
double magma_get_norm_sy(SEXP obj, const char *typstr)
{
#ifdef HIPLAR_WITH_MAGMA
char typnm[] = {'\0', '\0'};
int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym));
double *work = (double *) NULL;
int N = dims[0];
int lda = N;
double *A = REAL(GET_SLOT(obj, Matrix_xSym));
typnm[0] = La_norm_type(typstr);
const char *c = uplo_P(obj);
//Magmablas dlansy only does I & M norms
if(GPUFlag == 1 && (*typnm == 'I' || *typnm == 'M')) {
#ifdef HIPLAR_DBG
R_ShowMessage("DBG: Performing norm using magmablas_dlansy");
#endif
double *dwork, *d_A, maxnorm;
cublasAlloc(N, sizeof(double), (void**)&dwork);
cublasAlloc(lda * N, sizeof(double), (void**)&d_A);
cublasSetVector(N * lda, sizeof(double), A, 1, d_A, 1);
maxnorm = magmablas_dlansy(typnm[0], *c ,N, d_A, lda, dwork);
cublasFree(d_A);
cublasFree(dwork);
return maxnorm;
}
else {
if (*typnm == 'I' || *typnm == 'O') {
work = (double *) R_alloc(dims[0], sizeof(double));
}
return F77_CALL(dlansy)(typnm, uplo_P(obj),
dims, A,
dims, work);
}
#endif
return 0.0;
}
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;
}
