void
mvm_hmatrix_avector(phmatrix hm, char trans, pcavector x, pavector y)
{
int rsons = hm->rsons;
int csons = hm->csons;
if(hm->f) {
addeval_amatrix_avector(1.0, hm->f, h2_col_major, trans, x, 1.0, y);
}
else if (hm->r) {
addeval_rkmatrix_avector(1.0, hm->r, trans, x, 1.0, y);
}
else {
assert(hm->r==NULL && hm->f==NULL);
if (h2_ntrans == trans) {
int xoffset = 0;
for (int j=0;j<csons;++j) {
pavector xsub = new_sub_avector(x, hm->son[j*rsons]->cc->size, xoffset);
int yoffset = 0;
for (int i=0;i<hm->rsons;++i) {
pavector ysub = new_sub_avector(y, hm->son[i]->rc->size, yoffset);
mvm_hmatrix_avector(hm->son[i+j*rsons], trans, xsub, ysub);
yoffset += hm->son[i]->rc->size;
uninit_avector(ysub);
}
assert(yoffset == hm->rc->size);
xoffset += hm->son[j*rsons]->cc->size;
uninit_avector(xsub);
}
assert(xoffset == hm->cc->size);
}
else {
int xoffset = 0;
for (int i=0;i<rsons;++i) {
pavector xsub = new_sub_avector(x, hm->son[i]->rc->size, xoffset);
int yoffset = 0;
for (int j=0;j<csons;++j) {
pavector ysub = new_sub_avector(y, hm->son[j*rsons]->cc->size, yoffset);
mvm_hmatrix_avector(hm->son[i+j*rsons], trans, xsub, ysub);
yoffset += hm->son[j*rsons]->cc->size;
uninit_avector(ysub);
}
assert(yoffset == hm->cc->size);
xoffset += hm->son[i]->rc->size;
uninit_avector(xsub);
}
assert(xoffset == hm->rc->size);
}
}
}
real
norm2chol_sparsematrix(pchmatrix LU, pcsparsematrix sp)
{
avector tmp1, tmp2;
uint rows = LU->rc->size;
uint cols = LU->cc->size;
pavector x, y;
real norm;
uint j;
assert(sp->rows == rows);
assert(sp->cols == cols);
x = init_avector(&tmp1, cols);
y = init_avector(&tmp2, rows);
random_avector(x);
norm = norm2_avector(x);
scale_avector(1.0 / norm, x);
for (j = 0; j < NORM_STEPS; j++) {
// printf("norm = %g \n", sqrt( norm));
clear_avector(y);
mvm_sparsematrix_avector(1.0, false, sp, x, y);
triangularsolve_hmatrix_avector(true, false, false, LU, y);
triangularsolve_hmatrix_avector(true, false, true, LU, y);
add_avector(-1.0, y, x);
copy_avector(x, y);
triangularsolve_hmatrix_avector(true, false, false, LU, y);
triangularsolve_hmatrix_avector(true, false, true, LU, y);
mvm_sparsematrix_avector(-1.0, true, sp, y, x);
norm = norm2_avector(x);
scale_avector(1.0 / norm, x);
}
uninit_avector(y);
uninit_avector(x);
return REAL_SQRT(norm);
}
void
addeval_hmatrix_avector(field alpha, phmatrix hm, char trans, pcavector x, field beta, pavector y)
{
pavector xp, yp;
avector xtmp, ytmp;
int i, ip;
assert(x->dim == hm->cc->size);
assert(y->dim == hm->rc->size);
/* Permutation of x */
xp = init_avector(&xtmp, x->dim);
for (i = 0; i < xp->dim; i++) {
ip = hm->cc->idx[i];
assert(ip < x->dim);
xp->v[i] = x->v[ip];
}
/* Permutation of y */
yp = init_avector(&ytmp, y->dim);
for (i = 0; i < yp->dim; i++) {
ip = hm->rc->idx[i];
assert(ip < y->dim);
yp->v[i] = y->v[ip];
}
/* Matrix-vector multiplication */
//hmat_avec_prod(hm, trans, xp, yp);
fastaddeval_hmatrix_avector(alpha, hm, trans, xp, beta, yp);
/* Reverse permutation of y */
for (i = 0; i < yp->dim; i++) {
ip = hm->rc->idx[i];
assert(ip < y->dim);
y->v[ip] = yp->v[i];
}
uninit_avector(yp);
uninit_avector(xp);
}
void
mvm_uniform_avector(field alpha, bool trans, pcuniform u,
pcavector x, pavector y)
{
avector tmp1, tmp2;
pavector xt, yt;
if (trans) {
xt = init_avector(&tmp1, u->rb->kbranch);
yt = init_avector(&tmp2, u->cb->kbranch);
compress_clusterbasis_avector(u->rb, x, xt);
clear_avector(yt);
mvm_amatrix_avector(alpha, true, &u->S, xt, yt);
expand_clusterbasis_avector(u->cb, yt, y);
uninit_avector(yt);
uninit_avector(xt);
}
else {
xt = init_avector(&tmp1, u->cb->kbranch);
yt = init_avector(&tmp2, u->rb->kbranch);
compress_clusterbasis_avector(u->cb, x, xt);
clear_avector(yt);
mvm_amatrix_avector(alpha, false, &u->S, xt, yt);
expand_clusterbasis_avector(u->rb, yt, y);
uninit_avector(yt);
uninit_avector(xt);
}
}
static void
check_triangularsolve(bool lower, bool unit, bool atrans,
pcamatrix a, bool xtrans)
{
uint n = a->rows;
amatrix xtmp, btmp;
pamatrix x, b;
avector xvtmp, bvtmp;
pavector xv, bv;
real error;
assert(n == a->cols);
/*
* amatrix
*/
x = init_amatrix(&xtmp, n, n);
random_amatrix(x);
b = init_zero_amatrix(&btmp, n, n);
if (xtrans)
addmul_amatrix(1.0, false, x, !atrans, a, b);
else
addmul_amatrix(1.0, atrans, a, false, x, b);
triangularsolve_amatrix(lower, unit, atrans, a, xtrans, b);
add_amatrix(-1.0, false, x, b);
error = norm2_amatrix(b) / norm2_amatrix(x);
(void) printf("Checking amatrix triangularsolve\n"
" (lower=%s, unit=%s, atrans=%s, xtrans=%s)\n"
" Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
(unit ? "tr" : "fl"), (atrans ? "tr" : "fl"),
(xtrans ? "tr" : "fl"), error,
(IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : " NOT "));
if (!IS_IN_RANGE(0.0, error, 1.0e-14))
problems++;
copy_amatrix(false, x, b);
triangulareval_amatrix(lower, unit, atrans, a, xtrans, b);
triangularsolve_amatrix(lower, unit, atrans, a, xtrans, b);
add_amatrix(-1.0, false, x, b);
error = norm2_amatrix(b) / norm2_amatrix(x);
(void) printf("Checking amatrix triangulareval/triangularsolve\n"
" (lower=%s, unit=%s, atrans=%s, xtrans=%s):\n"
" Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
(unit ? "tr" : "fl"), (atrans ? "tr" : "fl"),
(xtrans ? "tr" : "fl"), error,
(IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : " NOT "));
if (!IS_IN_RANGE(0.0, error, 1.0e-14))
problems++;
/*
* avector
*/
xv = init_avector(&xvtmp, n);
random_avector(xv);
bv = init_avector(&bvtmp, n);
clear_avector(bv);
if (atrans) {
addevaltrans_amatrix_avector(1.0, a, xv, bv);
}
else {
addeval_amatrix_avector(1.0, a, xv, bv);
}
triangularsolve_amatrix_avector(lower, unit, atrans, a, bv);
add_avector(-1.0, xv, bv);
error = norm2_avector(bv) / norm2_avector(xv);
(void) printf("Checking avector triangularsolve\n"
" (lower=%s, unit=%s, atrans=%s)\n"
" Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
(unit ? "tr" : "fl"), (atrans ? "tr" : "fl"), error,
(IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : " NOT "));
if (!IS_IN_RANGE(0.0, error, 1.0e-14))
problems++;
copy_avector(xv, bv);
triangulareval_amatrix_avector(lower, unit, atrans, a, bv);
triangularsolve_amatrix_avector(lower, unit, atrans, a, bv);
add_avector(-1.0, xv, bv);
error = norm2_avector(bv) / norm2_avector(xv);
(void) printf("Checking avector triangulareval/triangularsolve\n"
" (lower=%s, unit=%s, atrans=%s):\n"
" Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
(unit ? "tr" : "fl"), (atrans ? "tr" : "fl"), error,
(IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : " NOT "));
if (!IS_IN_RANGE(0.0, error, 1.0e-14))
problems++;
uninit_amatrix(b);
uninit_amatrix(x);
uninit_avector(bv);
uninit_avector(xv);
}
int
hmat_cg(phmatrix hm, pavector b, pavector x)
{
if (hm->rc->size != b->dim) {
return -1;
}
else {
double ep = 1e-2;
pavector r = new_avector(b->dim);
pavector p = new_avector(b->dim);
pavector q = new_avector(b->dim);
pavector tempq = new_avector(b->dim);
pavector newb = new_avector(b->dim);
pavector bp, xp;
avector btmp, xtmp;
int ip;
/* Permutation of b */
bp = init_avector(&btmp, b->dim);
for (int i = 0; i < bp->dim; i++) {
ip = hm->cc->idx[i];
assert(ip < x->dim);
bp->v[i] = b->v[ip];
}
/* Permutation of y */
xp = init_avector(&xtmp, x->dim);
fastaddeval_hmatrix_avector(1.0, hm, CblasConjTrans, bp, 0.0, newb);
for (int i=0;i<bp->dim;i++) {
r->v[i] = newb->v[i];
xp->v[i] = 0;
}
int i;
field alpha, beta;
field rr1;
field rr;
for (i=0;i<400;i++) {
rr = dot_prod_avec('c', r, r);
if (i == 0) {
for (int j=0;j<bp->dim;j++) {
p->v[j] = r->v[j];
}
}
else {
beta = rr / rr1;
add_avec(1, r, beta, p);
}
fastaddeval_hmatrix_avector(1.0, hm, CblasNoTrans, p, 0.0, tempq);
fastaddeval_hmatrix_avector(1.0, hm, CblasConjTrans, tempq, 0.0, q);
alpha = rr / dot_prod_avec('c', q, p);
add_avec(alpha, p, 1, xp);
add_avec(-alpha, q, 1, r);
rr1 = rr;
if (LAPACKE_zlange(LAPACK_ROW_MAJOR, 'f', 1, r->dim, (MKL_Complex16 *)r->v, r->dim) < ep) {
continue;
//break;
}
}
/* Reverse permutation of y */
for (int i = 0; i < xp->dim; i++) {
ip = hm->rc->idx[i];
assert(ip < xp->dim);
x->v[ip] = xp->v[i];
}
uninit_avector(bp);
uninit_avector(xp);
return i;
}
}
void
fastaddeval_hmatrix_avector(field alpha, phmatrix hm, char trans, pcavector x, field beta, pavector y)
{
pavector newy = new_avector(y->dim);
mvm_hmatrix_avector(hm, trans, x, newy);
add_avec(alpha, newy, beta, y);
/*
for (int i=0;i<y->dim;i++) {
y->v[i] = alpha * newy->v[i] + beta *y->v[i];
}
*/
#if 0
if (hm->f) {
addeval_amatrix_avector(alpha, hm->f, h2_col_major, trans, x, 0, y);
}
else if (hm->r) {
addeval_rkmatrix_avector(alpha, hm->r, trans, x, 0, y);
}
else {
assert(hm->r==NULL && hm->f==NULL);
int yoffset = 0;
if (CblasNoTrans == trans) {
for (int i=0;i<hm->rsons;i++) {
pavector ysub = new_sub_avector(y, hm->son[i]->rc->size, yoffset);
pavector ytemp = new_avector(hm->son[i]->rc->size);
int xoffset = 0;
for (int j=0;j<hm->csons;j++) {
pavector xsub = new_sub_avector((pavector)x, hm->son[j*hm->rsons+i]->cc->size, xoffset);
fastaddeval_hmatrix_avector(alpha, hm->son[j*hm->rsons+i], trans, xsub, beta, ytemp);
add_avec(alpha, ytemp, 1, ysub);
xoffset += hm->son[j*hm->rsons+i]->cc->size;
uninit_avector(xsub);
// in urgent need to be optimized
}
yoffset += hm->son[i]->rc->size;
uninit_avector(ysub);
uninit_avector(ytemp);
//free(ysub);
}
}
else if (CblasTrans == trans || CblasConjTrans == trans) {
for (int i=0;i<hm->csons;i++) {
pavector ysub = new_sub_avector(y, hm->son[i*hm->rsons]->cc->size, yoffset);
pavector ytemp = new_avector(hm->son[i*hm->rsons]->cc->size);
int xoffset = 0;
for (int j=0;j<hm->rsons;j++) {
pavector xsub = new_sub_avector((pavector)x, hm->son[i*hm->rsons+j]->rc->size, xoffset);
fastaddeval_hmatrix_avector(alpha, hm->son[i*hm->rsons+j], trans, xsub, beta, ytemp);
add_avec(alpha, ytemp, 1, ysub);
xoffset += hm->son[i*hm->rsons+j]->rc->size;
uninit_avector(xsub);
}
yoffset += hm->son[i*hm->rsons]->cc->size;
uninit_avector(ysub);
uninit_avector(ytemp);
}
}
else {
cout<<"Error! Clarify the Trans Type\n"<<endl;
}
}
#endif
}