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; }