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");
}
CMajEnv *initConstrainedMajorization(float *packedMat, int n,
int *ordering, int *levels,
int num_levels)
{
int i, level = -1, start_of_level_above = 0;
CMajEnv *e = GNEW(CMajEnv);
e->A = NULL;
e->n = n;
e->ordering = ordering;
e->levels = levels;
e->num_levels = num_levels;
e->A = unpackMatrix(packedMat, n);
e->lev = N_GNEW(n, int);
for (i = 0; i < e->n; i++) {
if (i >= start_of_level_above) {
level++;
start_of_level_above =
(level == num_levels) ? e->n : levels[level];
}
e->lev[ordering[i]] = level;
}
e->fArray1 = N_GNEW(n, float);
e->fArray2 = N_GNEW(n, float);
e->fArray3 = N_GNEW(n, float);
e->fArray4 = N_GNEW(n, float);
e->iArray1 = N_GNEW(n, int);
e->iArray2 = N_GNEW(n, int);
e->iArray3 = N_GNEW(n, int);
e->iArray4 = N_GNEW(n, int);
return e;
}
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");
}
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");
}
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_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");
}
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_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");
}
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;
}
