PyObject* r2k(PyObject *self, PyObject *args)
{
Py_complex alpha;
PyArrayObject* a;
PyArrayObject* b;
double beta;
PyArrayObject* c;
if (!PyArg_ParseTuple(args, "DOOdO", &alpha, &a, &b, &beta, &c))
return NULL;
int n = PyArray_DIMS(a)[0];
int k = PyArray_DIMS(a)[1];
for (int d = 2; d < PyArray_NDIM(a); d++)
k *= PyArray_DIMS(a)[d];
int ldc = PyArray_STRIDES(c)[0] / PyArray_STRIDES(c)[1];
if (PyArray_DESCR(a)->type_num == NPY_DOUBLE)
dsyr2k_("u", "t", &n, &k,
(double*)(&alpha), DOUBLEP(a), &k,
DOUBLEP(b), &k, &beta,
DOUBLEP(c), &ldc);
else
zher2k_("u", "c", &n, &k,
(void*)(&alpha), (void*)COMPLEXP(a), &k,
(void*)COMPLEXP(b), &k, &beta,
(void*)COMPLEXP(c), &ldc);
Py_RETURN_NONE;
}
PyObject* dotu(PyObject *self, PyObject *args)
{
PyArrayObject* a;
PyArrayObject* b;
if (!PyArg_ParseTuple(args, "OO", &a, &b))
return NULL;
int n = PyArray_DIMS(a)[0];
for (int i = 1; i < PyArray_NDIM(a); i++)
n *= PyArray_DIMS(a)[i];
int incx = 1;
int incy = 1;
if (PyArray_DESCR(a)->type_num == NPY_DOUBLE)
{
double result;
result = ddot_(&n, (void*)DOUBLEP(a),
&incx, (void*)DOUBLEP(b), &incy);
return PyFloat_FromDouble(result);
}
else
{
double_complex* ap = COMPLEXP(a);
double_complex* bp = COMPLEXP(b);
double_complex z = 0.0;
for (int i = 0; i < n; i++)
z += ap[i] * bp[i];
return PyComplex_FromDoubles(creal(z), cimag(z));
}
}
PyObject* gemv(PyObject *self, PyObject *args)
{
Py_complex alpha;
PyArrayObject* a;
PyArrayObject* x;
Py_complex beta;
PyArrayObject* y;
char trans = 't';
if (!PyArg_ParseTuple(args, "DOODO|c", &alpha, &a, &x, &beta, &y, &trans))
return NULL;
int m, n, lda, itemsize, incx, incy;
if (trans == 'n')
{
m = PyArray_DIMS(a)[1];
for (int i = 2; i < PyArray_NDIM(a); i++)
m *= PyArray_DIMS(a)[i];
n = PyArray_DIMS(a)[0];
lda = MAX(1, m);
}
else
{
n = PyArray_DIMS(a)[0];
for (int i = 1; i < PyArray_NDIM(a)-1; i++)
n *= PyArray_DIMS(a)[i];
m = PyArray_DIMS(a)[PyArray_NDIM(a)-1];
lda = MAX(1, m);
}
if (PyArray_DESCR(a)->type_num == NPY_DOUBLE)
itemsize = sizeof(double);
else
itemsize = sizeof(double_complex);
incx = PyArray_STRIDES(x)[0]/itemsize;
incy = 1;
if (PyArray_DESCR(a)->type_num == NPY_DOUBLE)
dgemv_(&trans, &m, &n,
&(alpha.real),
DOUBLEP(a), &lda,
DOUBLEP(x), &incx,
&(beta.real),
DOUBLEP(y), &incy);
else
zgemv_(&trans, &m, &n,
&alpha,
(void*)COMPLEXP(a), &lda,
(void*)COMPLEXP(x), &incx,
&beta,
(void*)COMPLEXP(y), &incy);
Py_RETURN_NONE;
}
PyObject* scalapack_redist(PyObject *self, PyObject *args)
{
PyArrayObject* a; // source matrix
PyArrayObject* b; // destination matrix
PyArrayObject* desca; // source descriptor
PyArrayObject* descb; // destination descriptor
char uplo;
char diag='N'; // copy the diagonal
int c_ConTxt;
int m;
int n;
int ia, ja, ib, jb;
if (!PyArg_ParseTuple(args, "OOOOiiiiiiic",
&desca, &descb,
&a, &b,
&m, &n,
&ia, &ja,
&ib, &jb,
&c_ConTxt,
&uplo))
return NULL;
if (uplo == 'G') // General matrix
{
if (a->descr->type_num == PyArray_DOUBLE)
Cpdgemr2d_(m, n,
DOUBLEP(a), ia, ja, INTP(desca),
DOUBLEP(b), ib, jb, INTP(descb),
c_ConTxt);
else
Cpzgemr2d_(m, n,
(void*)COMPLEXP(a), ia, ja, INTP(desca),
(void*)COMPLEXP(b), ib, jb, INTP(descb),
c_ConTxt);
}
else // Trapezoidal matrix
{
if (a->descr->type_num == PyArray_DOUBLE)
Cpdtrmr2d_(&uplo, &diag, m, n,
DOUBLEP(a), ia, ja, INTP(desca),
DOUBLEP(b), ib, jb, INTP(descb),
c_ConTxt);
else
Cpztrmr2d_(&uplo, &diag, m, n,
(void*)COMPLEXP(a), ia, ja, INTP(desca),
(void*)COMPLEXP(b), ib, jb, INTP(descb),
c_ConTxt);
}
Py_RETURN_NONE;
}
scm_complex_t
make_complex(object_heap_t* heap, scm_obj_t real, scm_obj_t imag)
{
assert(!COMPLEXP(real));
assert(!COMPLEXP(imag));
scm_complex_t obj = (scm_complex_t)heap->allocate_collectible(sizeof(scm_complex_rec_t));
obj->hdr = scm_hdr_complex;
obj->real = real;
obj->imag = imag;
return obj;
}
PyObject* gemm(PyObject *self, PyObject *args)
{
Py_complex alpha;
PyArrayObject* a;
PyArrayObject* b;
Py_complex beta;
PyArrayObject* c;
char transa = 'n';
if (!PyArg_ParseTuple(args, "DOODO|c", &alpha, &a, &b, &beta, &c, &transa))
return NULL;
int m, k, lda, ldb, ldc;
if (transa == 'n')
{
m = PyArray_DIMS(a)[1];
for (int i = 2; i < PyArray_NDIM(a); i++)
m *= PyArray_DIMS(a)[i];
k = PyArray_DIMS(a)[0];
lda = MAX(1, PyArray_STRIDES(a)[0] / PyArray_STRIDES(a)[PyArray_NDIM(a) - 1]);
ldb = MAX(1, PyArray_STRIDES(b)[0] / PyArray_STRIDES(b)[1]);
ldc = MAX(1, PyArray_STRIDES(c)[0] / PyArray_STRIDES(c)[PyArray_NDIM(c) - 1]);
}
else
{
k = PyArray_DIMS(a)[1];
for (int i = 2; i < PyArray_NDIM(a); i++)
k *= PyArray_DIMS(a)[i];
m = PyArray_DIMS(a)[0];
lda = MAX(1, k);
ldb = MAX(1, PyArray_STRIDES(b)[0] / PyArray_STRIDES(b)[PyArray_NDIM(b) - 1]);
ldc = MAX(1, PyArray_STRIDES(c)[0] / PyArray_STRIDES(c)[1]);
}
int n = PyArray_DIMS(b)[0];
if (PyArray_DESCR(a)->type_num == NPY_DOUBLE)
dgemm_(&transa, "n", &m, &n, &k,
&(alpha.real),
DOUBLEP(a), &lda,
DOUBLEP(b), &ldb,
&(beta.real),
DOUBLEP(c), &ldc);
else
zgemm_(&transa, "n", &m, &n, &k,
&alpha,
(void*)COMPLEXP(a), &lda,
(void*)COMPLEXP(b), &ldb,
&beta,
(void*)COMPLEXP(c), &ldc);
Py_RETURN_NONE;
}
PyObject* multi_axpy(PyObject *self, PyObject *args)
{
PyArrayObject* alpha;
PyArrayObject* x;
PyArrayObject* y;
if (!PyArg_ParseTuple(args, "OOO", &alpha, &x, &y))
return NULL;
int n0 = PyArray_DIMS(x)[0];
int n = PyArray_DIMS(x)[1];
for (int d = 2; d < PyArray_NDIM(x); d++)
n *= PyArray_DIMS(x)[d];
int incx = 1;
int incy = 1;
if (PyArray_DESCR(alpha)->type_num == NPY_DOUBLE)
{
if (PyArray_DESCR(x)->type_num == NPY_CDOUBLE)
n *= 2;
double *ap = DOUBLEP(alpha);
double *xp = DOUBLEP(x);
double *yp = DOUBLEP(y);
for (int i = 0; i < n0; i++)
{
daxpy_(&n, &ap[i],
(void*)xp, &incx,
(void*)yp, &incy);
xp += n;
yp += n;
}
}
else
{
double_complex *ap = COMPLEXP(alpha);
double_complex *xp = COMPLEXP(x);
double_complex *yp = COMPLEXP(y);
for (int i = 0; i < n0; i++)
{
zaxpy_(&n, (void*)(&ap[i]),
(void*)xp, &incx,
(void*)yp, &incy);
xp += n;
yp += n;
}
}
Py_RETURN_NONE;
}
PyObject* czher(PyObject *self, PyObject *args)
{
double alpha;
PyArrayObject* x;
PyArrayObject* a;
if (!PyArg_ParseTuple(args, "dOO", &alpha, &x, &a))
return NULL;
int n = PyArray_DIMS(x)[0];
for (int d = 1; d < PyArray_NDIM(x); d++)
n *= PyArray_DIMS(x)[d];
int incx = 1;
int lda = MAX(1, n);
zher_("l", &n, &(alpha),
(void*)COMPLEXP(x), &incx,
(void*)COMPLEXP(a), &lda);
Py_RETURN_NONE;
}
PyObject* multi_dotu(PyObject *self, PyObject *args)
{
PyArrayObject* a;
PyArrayObject* b;
PyArrayObject* c;
if (!PyArg_ParseTuple(args, "OOO", &a, &b, &c))
return NULL;
int n0 = PyArray_DIMS(a)[0];
int n = PyArray_DIMS(a)[1];
for (int i = 2; i < PyArray_NDIM(a); i++)
n *= PyArray_DIMS(a)[i];
int incx = 1;
int incy = 1;
if (PyArray_DESCR(a)->type_num == NPY_DOUBLE)
{
double *ap = DOUBLEP(a);
double *bp = DOUBLEP(b);
double *cp = DOUBLEP(c);
for (int i = 0; i < n0; i++)
{
cp[i] = ddot_(&n, (void*)ap,
&incx, (void*)bp, &incy);
ap += n;
bp += n;
}
}
else
{
double_complex* ap = COMPLEXP(a);
double_complex* bp = COMPLEXP(b);
double_complex* cp = COMPLEXP(c);
for (int i = 0; i < n0; i++)
{
cp[i] = 0.0;
for (int j = 0; j < n; j++)
cp[i] += ap[j] * bp[j];
ap += n;
bp += n;
}
}
Py_RETURN_NONE;
}
PyObject* pblas_gemv(PyObject *self, PyObject *args)
{
char transa;
int m, n;
Py_complex alpha;
Py_complex beta;
PyArrayObject *a, *x, *y;
int incx = 1, incy = 1; // what should these be?
PyArrayObject *desca, *descx, *descy;
int one = 1;
if (!PyArg_ParseTuple(args, "iiDOODOOOOc",
&m, &n, &alpha,
&a, &x, &beta, &y,
&desca, &descx,
&descy, &transa)) {
return NULL;
}
// ydesc
// int y_ConTxt = INTP(descy)[1];
// If process not on BLACS grid, then return.
// if (y_ConTxt == -1) Py_RETURN_NONE;
if (y->descr->type_num == PyArray_DOUBLE)
pdgemv_(&transa, &m, &n,
&(alpha.real),
DOUBLEP(a), &one, &one, INTP(desca),
DOUBLEP(x), &one, &one, INTP(descx), &incx,
&(beta.real),
DOUBLEP(y), &one, &one, INTP(descy), &incy);
else
pzgemv_(&transa, &m, &n,
&alpha,
(void*)COMPLEXP(a), &one, &one, INTP(desca),
(void*)COMPLEXP(x), &one, &one, INTP(descx), &incx,
&beta,
(void*)COMPLEXP(y), &one, &one, INTP(descy), &incy);
Py_RETURN_NONE;
}
PyObject* pblas_gemm(PyObject *self, PyObject *args)
{
char transa;
char transb;
int m, n, k;
Py_complex alpha;
Py_complex beta;
PyArrayObject *a, *b, *c;
PyArrayObject *desca, *descb, *descc;
int one = 1;
if (!PyArg_ParseTuple(args, "iiiDOODOOOOcc", &m, &n, &k, &alpha,
&a, &b, &beta, &c,
&desca, &descb, &descc,
&transa, &transb)) {
return NULL;
}
// cdesc
// int c_ConTxt = INTP(descc)[1];
// If process not on BLACS grid, then return.
// if (c_ConTxt == -1) Py_RETURN_NONE;
if (c->descr->type_num == PyArray_DOUBLE)
pdgemm_(&transa, &transb, &m, &n, &k,
&(alpha.real),
DOUBLEP(a), &one, &one, INTP(desca),
DOUBLEP(b), &one, &one, INTP(descb),
&(beta.real),
DOUBLEP(c), &one, &one, INTP(descc));
else
pzgemm_(&transa, &transb, &m, &n, &k,
&alpha,
(void*)COMPLEXP(a), &one, &one, INTP(desca),
(void*)COMPLEXP(b), &one, &one, INTP(descb),
&beta,
(void*)COMPLEXP(c), &one, &one, INTP(descc));
Py_RETURN_NONE;
}
PyObject* axpy(PyObject *self, PyObject *args)
{
Py_complex alpha;
PyArrayObject* x;
PyArrayObject* y;
if (!PyArg_ParseTuple(args, "DOO", &alpha, &x, &y))
return NULL;
int n = PyArray_DIMS(x)[0];
for (int d = 1; d < PyArray_NDIM(x); d++)
n *= PyArray_DIMS(x)[d];
int incx = 1;
int incy = 1;
if (PyArray_DESCR(x)->type_num == NPY_DOUBLE)
daxpy_(&n, &(alpha.real),
DOUBLEP(x), &incx,
DOUBLEP(y), &incy);
else
zaxpy_(&n, &alpha,
(void*)COMPLEXP(x), &incx,
(void*)COMPLEXP(y), &incy);
Py_RETURN_NONE;
}
PyObject* pblas_rk(PyObject *self, PyObject *args)
{
char uplo;
int n, k;
Py_complex alpha;
Py_complex beta;
PyArrayObject *a, *c;
PyArrayObject *desca, *descc;
int one = 1;
if (!PyArg_ParseTuple(args, "iiDODOOOc", &n, &k, &alpha,
&a, &beta, &c,
&desca, &descc,
&uplo)) {
return NULL;
}
// cdesc
// int c_ConTxt = INTP(descc)[1];
// If process not on BLACS grid, then return.
// if (c_ConTxt == -1) Py_RETURN_NONE;
if (c->descr->type_num == PyArray_DOUBLE)
pdsyrk_(&uplo, "T", &n, &k,
&(alpha.real),
DOUBLEP(a), &one, &one, INTP(desca),
&(beta.real),
DOUBLEP(c), &one, &one, INTP(descc));
else
pzherk_(&uplo, "C", &n, &k,
&alpha,
(void*)COMPLEXP(a), &one, &one, INTP(desca),
&beta,
(void*)COMPLEXP(c), &one, &one, INTP(descc));
Py_RETURN_NONE;
}
PyObject* rk(PyObject *self, PyObject *args)
{
double alpha;
PyArrayObject* a;
double beta;
PyArrayObject* c;
char trans = 'c';
if (!PyArg_ParseTuple(args, "dOdO|c", &alpha, &a, &beta, &c, &trans))
return NULL;
int n = PyArray_DIMS(c)[0];
int k, lda;
if (trans == 'c') {
k = PyArray_DIMS(a)[1];
for (int d = 2; d < PyArray_NDIM(a); d++)
k *= PyArray_DIMS(a)[d];
lda = k;
}
else {
k = PyArray_DIMS(a)[0];
lda = n;
}
int ldc = PyArray_STRIDES(c)[0] / PyArray_STRIDES(c)[1];
if (PyArray_DESCR(a)->type_num == NPY_DOUBLE)
dsyrk_("u", &trans, &n, &k,
&alpha, DOUBLEP(a), &lda, &beta,
DOUBLEP(c), &ldc);
else
zherk_("u", &trans, &n, &k,
&alpha, (void*)COMPLEXP(a), &lda, &beta,
(void*)COMPLEXP(c), &ldc);
Py_RETURN_NONE;
}
PyObject* scalapack_set(PyObject *self, PyObject *args)
{
PyArrayObject* a; // matrix;
PyArrayObject* desca; // descriptor
Py_complex alpha;
Py_complex beta;
int m, n;
int ia, ja;
char uplo;
if (!PyArg_ParseTuple(args, "OODDciiii", &a, &desca,
&alpha, &beta, &uplo,
&m, &n, &ia, &ja))
return NULL;
if (a->descr->type_num == PyArray_DOUBLE)
pdlaset_(&uplo, &m, &n, &(alpha.real), &(beta.real), DOUBLEP(a),
&ia, &ja, INTP(desca));
else
pzlaset_(&uplo, &m, &n, &alpha, &beta, (void*)COMPLEXP(a),
&ia, &ja, INTP(desca));
Py_RETURN_NONE;
}
PyObject* scalapack_diagonalize_dc(PyObject *self, PyObject *args)
{
// Standard driver for divide and conquer algorithm
// Computes all eigenvalues and eigenvectors
PyArrayObject* a; // symmetric matrix
PyArrayObject* desca; // symmetric matrix description vector
PyArrayObject* z; // eigenvector matrix
PyArrayObject* w; // eigenvalue array
int one = 1;
char jobz = 'V'; // eigenvectors also
char uplo;
if (!PyArg_ParseTuple(args, "OOcOO", &a, &desca, &uplo, &z, &w))
return NULL;
// adesc
// int a_ConTxt = INTP(desca)[1];
int a_m = INTP(desca)[2];
int a_n = INTP(desca)[3];
// zdesc = adesc; this can be relaxed a bit according to pdsyevd.f
// Only square matrices
assert (a_m == a_n);
int n = a_n;
// If process not on BLACS grid, then return.
// if (a_ConTxt == -1) Py_RETURN_NONE;
// Query part, need to find the optimal size of a number of work arrays
int info;
int querywork = -1;
int* iwork;
int liwork;
int lwork;
int lrwork;
int i_work;
double d_work;
double_complex c_work;
if (a->descr->type_num == PyArray_DOUBLE)
{
pdsyevd_(&jobz, &uplo, &n,
DOUBLEP(a), &one, &one, INTP(desca),
DOUBLEP(w),
DOUBLEP(z), &one, &one, INTP(desca),
&d_work, &querywork, &i_work, &querywork, &info);
lwork = (int)(d_work);
}
else
{
pzheevd_(&jobz, &uplo, &n,
(void*)COMPLEXP(a), &one, &one, INTP(desca),
DOUBLEP(w),
(void*)COMPLEXP(z), &one, &one, INTP(desca),
(void*)&c_work, &querywork, &d_work, &querywork,
&i_work, &querywork, &info);
lwork = (int)(c_work);
lrwork = (int)(d_work);
}
if (info != 0)
{
PyErr_SetString(PyExc_RuntimeError,
"scalapack_diagonalize_dc error in query.");
return NULL;
}
// Computation part
liwork = i_work;
iwork = GPAW_MALLOC(int, liwork);
if (a->descr->type_num == PyArray_DOUBLE)
{
double* work = GPAW_MALLOC(double, lwork);
pdsyevd_(&jobz, &uplo, &n,
DOUBLEP(a), &one, &one, INTP(desca),
DOUBLEP(w),
DOUBLEP(z), &one, &one, INTP(desca),
work, &lwork, iwork, &liwork, &info);
free(work);
}
static void debug_print_flonum(lref_t object, lref_t port, bool machine_readable)
{
_TCHAR buf[STACK_STRBUF_LEN];
UNREFERENCED(machine_readable);
assert(FLONUMP(object));
if (isnan(FLONM(object)))
{
_sntprintf(buf, STACK_STRBUF_LEN, _T("#inan"));
}
else if (!isfinite(FLONM(object)))
{
if (FLONM(object) > 0)
_sntprintf(buf, STACK_STRBUF_LEN, _T("#iposinf"));
else
_sntprintf(buf, STACK_STRBUF_LEN, _T("#ineginf"));
}
else
{
int digits = DEBUG_FLONUM_PRINT_PRECISION;
assert((digits >= 0) && (digits <= 16));
/* Nothing is as easy as it seems...
*
* The sprintf 'g' format code will drop the decimal
* point if all following digits are zero. That causes
* the reader to read such numbers as exact, rather than
* inexact. As a result, we need to implement our own
* switching between scientific and conventional notation.
*/
double scale = 0.0;
if (FLONM(object) != 0.0)
scale = log10(fabs(FLONM(object)));
if (fabs(scale) >= digits)
_sntprintf(buf, STACK_STRBUF_LEN, _T("%.*e"), digits, FLONM(object));
else
{
/* Prevent numbers on the left of the decimal point from
* adding to the number of digits we print. */
if ((scale > 0) && (scale <= digits))
digits -= (int) scale;
_sntprintf(buf, STACK_STRBUF_LEN, _T("%.*f"), digits, FLONM(object));
}
}
write_text(port, buf, _tcslen(buf));
if (COMPLEXP(object))
{
if (CMPLXIM(object) >= 0.0)
write_text(port, _T("+"), 1);
debug_print_flonum(FLOIM(object), port, machine_readable);
write_text(port, _T("i"), 1);
}
}