void init_GPU_data(GlobalParams &p) {
int n_known = p.nRegions;
int n_total = p.pred_dist.n_rows;
int n_pred = n_total-n_known;
scatr_magma_init();
arma::mat dist12 = p.pred_dist(arma::span(0,n_known-1), arma::span(n_known, n_total-1));
arma::mat dist22 = p.pred_dist(arma::span(n_known, n_total-1), arma::span(n_known, n_total-1));
checkCublasError( cublasCreate_v2(&p.handle), "handle (Create)" );
cudaMalloc((void**) &p.d_dist12, n_known*n_pred*sizeof(double)); checkCudaError("dist12 (Malloc)");
checkCublasError(
cublasSetMatrix(n_known, n_pred, sizeof(double), dist12.memptr(), n_known, p.d_dist12, n_known),
"dist12 (Set)"
);
cudaMalloc((void**) &p.d_dist22, n_pred*n_pred * sizeof(double)); checkCudaError("dist22 (Malloc)");
checkCublasError(
cublasSetMatrix(n_pred, n_pred, sizeof(double), dist22.memptr(), n_pred, p.d_dist22, n_pred),
"dist22 (Set)"
);
cudaMalloc((void**) &p.d_cov12, n_known * n_pred * sizeof(double)); checkCudaError("cov12 (Malloc)");
cudaMalloc((void**) &p.d_cov22, n_pred * n_pred * sizeof(double)); checkCudaError("cov22 (Malloc)");
cudaMalloc((void**) &p.d_invcov11, n_known * n_known * sizeof(double)); checkCudaError("invcov11 (Malloc)");
cudaMalloc((void**) &p.d_tmp, n_pred * n_known * sizeof(double)); checkCudaError("tmp (Malloc)");
}
void d_gemm(SEXP rtransa, SEXP rtransb, SEXP ralpha, SEXP ra, SEXP rlda,
SEXP rb, SEXP rldb, SEXP rbeta, SEXP rc, SEXP rldc)
{
char
transa = getTranspose(rtransa),
transb = getTranspose(rtransb);
double
alpha = asReal(ralpha), beta = asReal(rbeta),
* a, * b, * c;
int
m, n, k,
rowsa, colsa, lda = asInteger(rlda),
rowsb, colsb, ldb = asInteger(rldb),
rowsc, colsc, ldc = asInteger(rldc);
unpackMatrix(ra, &rowsa, &colsa, &a);
unpackMatrix(rb, &rowsb, &colsb, &b);
unpackMatrix(rc, &rowsc, &colsc, &c);
m = rowsa;
n = colsb;
k = colsa;
if(isTranspose(transa)) {
m = colsa;
k = rowsa;
}
if(isTranspose(transb))
n = rowsb;
cublasDgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc);
checkCublasError("d_gemm");
}
void d_syr2k(SEXP ruplo, SEXP rtrans, SEXP ralpha, SEXP ra, SEXP rlda,
SEXP rb, SEXP rldb, SEXP rbeta, SEXP rc, SEXP rldc)
{
char
trans = getTranspose(rtrans),
uplo = getSymLoc(ruplo);
double
alpha = asReal(ralpha), beta = asReal(rbeta),
* a, * b, * c;
int
k,
rowsa, colsa, lda = asInteger(rlda),
rowsb, colsb, ldb = asInteger(rldb),
rowsc, colsc, ldc = asInteger(rldc);
k = rowsa;
if((trans == 'N') || (trans == 'n')) {
k = colsa;
}
unpackMatrix(ra, &rowsa, &colsa, &a);
unpackMatrix(rb, &rowsb, &colsb, &b);
unpackMatrix(rc, &rowsc, &colsc, &c);
cublasDsyr2k(uplo, trans, rowsc, k, alpha, a, lda, b, ldb, beta, c, ldc);
checkCublasError("d_syr2k");
}
SEXP d_setVector(SEXP v)
{
int n = length(v);
double * d_v;
cublasAlloc(n, sizeof(double), (void **)&d_v);
cublasSetVector(n, sizeof(double), REAL(v), 1, d_v, 1);
checkCublasError("d_setVector");
return packVector(n, d_v);
}
SEXP d_setMatrix(SEXP m)
{
int
rows = nrows(m), cols = ncols(m);
double * d_m;
cublasAlloc(rows * cols, sizeof(double), (void **)&d_m);
cublasSetMatrix(rows, cols, sizeof(double), REAL(m), rows, d_m, rows);
checkCublasError("d_setMatrix");
return packMatrix(rows, cols, d_m);
}
void d_scal(SEXP ralpha, SEXP rx, SEXP rincx)
{
int
n,
incx = asInteger(rincx);
double
* x, alpha = asReal(ralpha);
unpackVector(rx, &n, &x);
cublasDscal(n, alpha, x, incx);
checkCublasError("d_scal");
}
SEXP d_asum(SEXP vList, SEXP inc)
{
int n, increment = asInteger(inc);
double * dPtr;
unpackVector(vList, &n, &dPtr);
SEXP out;
PROTECT(out = allocVector(REALSXP, 1));
REAL(out)[0] = cublasDasum(n, dPtr, increment);
checkCublasError("d_asum");
UNPROTECT(1);
return out;
}
SEXP d_getVector(SEXP vList, SEXP inc)
{
int n, increment = asInteger(inc);
double * dPtr;
unpackVector(vList, &n, &dPtr);
SEXP out;
PROTECT(out = allocVector(REALSXP, n));
cublasGetVector(n, sizeof(double), dPtr, increment, REAL(out), 1);
checkCublasError("d_getVector");
UNPROTECT(1);
return out;
}
void cleanup_GPU_data(GlobalParams &p) {
scatr_magma_finalize();
checkCublasError(
cublasDestroy_v2(p.handle), "handle (Destroy)"
);
cudaFree(p.d_dist12); checkCudaError("dist12 (Free)");
cudaFree(p.d_dist22); checkCudaError("dist22 (Free)");
cudaFree(p.d_cov12); checkCudaError("cov12 (Free)");
cudaFree(p.d_cov22); checkCudaError("cov22 (Free)");
cudaFree(p.d_invcov11); checkCudaError("invcov11 (Free)");
cudaFree(p.d_tmp); checkCudaError("tmp (Free)");
}
void d_swap(SEXP rx, SEXP rincx, SEXP ry, SEXP rincy)
{
int
nx, ny, n,
incx = asInteger(rincx),
incy = asInteger(rincy);
double
* x, * y;
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
n = imin2(nx, ny);
cublasDswap(n, x, incx, y, incy);
checkCublasError("d_swap");
}
SEXP d_nrm2(SEXP rx, SEXP rincx)
{
int
n,
incx = asInteger(rincx);
double * x;
unpackVector(rx, &n, &x);
SEXP out;
PROTECT(out = allocVector(REALSXP, 1));
REAL(out)[0] = cublasDnrm2(n, x, incx);
checkCublasError("d_nrm2");
UNPROTECT(1);
return out;
}
void d_syr(SEXP ruplo, SEXP ralpha, SEXP rx, SEXP rincx, SEXP ra, SEXP rlda)
{
char
uplo = getSymLoc(ruplo);
double
alpha = asReal(ralpha), * a, * x;
int
rowsa, colsa, lda = asInteger(rlda),
nx, incx = asInteger(rincx);
unpackVector(rx, &nx, &x);
unpackMatrix(ra, &rowsa, &colsa, &a);
cublasDsyr(uplo, rowsa, alpha, x, incx, a, lda);
checkCublasError("d_syr");
}
void d_axpy(SEXP ralpha, SEXP rx, SEXP rincx, SEXP ry, SEXP rincy)
{
int
nx, ny, n,
incx = asInteger(rincx),
incy = asInteger(rincy);
double
alpha = asReal(ralpha),
* x, * y;
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
n = imin2(nx, ny);
cublasDaxpy(n, alpha, x, incx, y, incy);
checkCublasError("d_axpy");
}
void d_rot(SEXP rx, SEXP rincx, SEXP ry, SEXP rincy, SEXP rsc, SEXP rss)
{
int
nx, ny, n,
incx = asInteger(rincx),
incy = asInteger(rincy);
double
sc = asReal(rsc),
ss = asReal(rss),
* x, * y;
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
n = imin2(nx, ny);
cublasDrot(n, x, incx, y, incy, sc, ss);
checkCublasError("d_rot");
}
void d_rotm(SEXP rx, SEXP rincx, SEXP ry, SEXP rincy, SEXP rsparam)
{
int
nx, ny, n, ns,
incx = asInteger(rincx),
incy = asInteger(rincy);
double
* sparam,
* x, * y;
unpackVector(rsparam, &ns, &sparam);
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
n = imin2(nx, ny);
cublasDrotm(n, x, incx, y, incy, sparam);
checkCublasError("d_rotm");
}
void d_tpsv(SEXP ruplo, SEXP rtrans, SEXP rdiag, SEXP ra, SEXP rx, SEXP rincx)
{
char
uplo = getSymLoc(ruplo),
trans = getTranspose(rtrans),
diag = getUnitTri(rdiag);
double
* a, * x;
int
rowsa, colsa,
nx, incx = asInteger(rincx);
unpackVector(rx, &nx, &x);
unpackMatrix(ra, &rowsa, &colsa, &a);
cublasDtpsv(uplo, trans, diag, rowsa, a, x, incx);
checkCublasError("d_tpsv");
}
void d_spmv(SEXP ruplo, SEXP ralpha, SEXP ra, SEXP rx, SEXP rincx,
SEXP rbeta, SEXP ry, SEXP rincy)
{
char
uplo = getSymLoc(ruplo);
double
alpha = asReal(ralpha), beta = asReal(rbeta),
* a, * x, * y;
int
rowsa, colsa,
nx, ny, incx = asInteger(rincx), incy = asInteger(rincy);
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
unpackMatrix(ra, &rowsa, &colsa, &a);
cublasDspmv(uplo, rowsa, alpha, a, x, incx, beta, y, incy);
checkCublasError("d_spmv");
}
SEXP d_dot(SEXP rx, SEXP rincx, SEXP ry, SEXP rincy)
{
int
nx, ny, n,
incx = asInteger(rincx),
incy = asInteger(rincy);
double
* x, * y;
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
n = imin2(nx, ny);
SEXP out;
PROTECT(out = allocVector(REALSXP, 1));
REAL(out)[0] = cublasDdot(n, x, incx, y, incy);
checkCublasError("d_dot");
UNPROTECT(1);
return out;
}
void d_ger(SEXP ralpha, SEXP rx, SEXP rincx, SEXP ry, SEXP rincy,
SEXP ra, SEXP rlda)
{
double
alpha = asReal(ralpha),
* a, * x, * y;
int
rowsa, colsa,
lda = asInteger(rlda),
nx, ny,
incx = asInteger(rincx),
incy = asInteger(rincy);
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
unpackMatrix(ra, &rowsa, &colsa, &a);
cublasDger(rowsa, colsa, alpha, x, incx, y, incy, a, lda);
checkCublasError("d_ger");
}
void d_trsm(SEXP rside, SEXP ruplo, SEXP rtrans, SEXP rdiag,
SEXP ralpha, SEXP ra, SEXP rlda, SEXP rb, SEXP rldb)
{
char
trans = getTranspose(rtrans),
diag = getUnitTri(rdiag),
side = getSide(rside),
uplo = getSymLoc(ruplo);
double
alpha = asReal(ralpha),
* a, * b;
int
rowsa, colsa, lda = asInteger(rlda),
rowsb, colsb, ldb = asInteger(rldb);
unpackMatrix(ra, &rowsa, &colsa, &a);
unpackMatrix(rb, &rowsb, &colsb, &b);
cublasDtrsm(side, uplo, trans, diag, rowsb, colsb, alpha, a, lda, b, ldb);
checkCublasError("d_trsm");
}
SEXP d_getMatrix(SEXP mList, SEXP rld)
{
int
rows, cols, ld = asInteger(rld);
double * dPtr;
unpackMatrix(mList, &rows, &cols, &dPtr);
SEXP out, dim;
PROTECT(out = allocVector(REALSXP, rows * cols));
cublasGetMatrix(rows, cols, sizeof(double), dPtr, ld, REAL(out), rows);
checkCublasError("d_getMatrix");
PROTECT(dim = allocVector(INTSXP, 2));
INTEGER(dim)[0] = rows;
INTEGER(dim)[1] = cols;
setAttrib(out, R_DimSymbol, dim);
UNPROTECT(2);
return out;
}
void d_gemv(SEXP rtrans, SEXP ralpha, SEXP ra, SEXP rlda, SEXP rx, SEXP rincx,
SEXP rbeta, SEXP ry, SEXP rincy)
{
char
trans = getTranspose(rtrans);
double
alpha = asReal(ralpha), beta = asReal(rbeta),
* a, * x, * y;
int
nx, ny, rowsa, colsa,
lda = asInteger(rlda),
incx = asInteger(rincx),
incy = asInteger(rincy);
unpackVector(rx, &nx, &x);
unpackVector(ry, &ny, &y);
unpackMatrix(ra, &rowsa, &colsa, &a);
cublasDgemv(trans, rowsa, colsa, alpha, a, lda, x, incx, beta, y, incy);
checkCublasError("d_gemv");
}
void d_symm(SEXP rside, SEXP ruplo, SEXP ralpha, SEXP ra, SEXP rlda,
SEXP rb, SEXP rldb, SEXP rbeta, SEXP rc, SEXP rldc)
{
char
side = getSide(rside),
uplo = getSymLoc(ruplo);
double
alpha = asReal(ralpha), beta = asReal(rbeta),
* a, * b, * c;
int
rowsa, colsa, lda = asInteger(rlda),
rowsb, colsb, ldb = asInteger(rldb),
rowsc, colsc, ldc = asInteger(rldc);
unpackMatrix(ra, &rowsa, &colsa, &a);
unpackMatrix(rb, &rowsb, &colsb, &b);
unpackMatrix(rc, &rowsc, &colsc, &c);
cublasDsymm(side, uplo, rowsb, colsb, alpha, a, lda, b, ldb,
beta, c, ldc);
checkCublasError("d_symm");
}
