void MatGenFD_Create(MatGenFD *mg)
{
START_FUNC_DH
struct _matgenfd* tmp =(struct _matgenfd*)MALLOC_DH(sizeof(struct _matgenfd)); CHECK_V_ERROR;
*mg = tmp;
tmp->debug = Parser_dhHasSwitch(parser_dh, "-debug_matgen");
tmp->m = 9;
tmp->px = tmp->py = 1;
tmp->pz = 0;
Parser_dhReadInt(parser_dh,"-m",&tmp->m);
Parser_dhReadInt(parser_dh,"-px",&tmp->px);
Parser_dhReadInt(parser_dh,"-py",&tmp->py);
Parser_dhReadInt(parser_dh,"-pz",&tmp->pz);
if (tmp->px < 1) tmp->px = 1;
if (tmp->py < 1) tmp->py = 1;
if (tmp->pz < 0) tmp->pz = 0;
tmp->threeD = false;
if (tmp->pz) {
tmp->threeD = true;
} else {
tmp->pz = 1;
}
if (Parser_dhHasSwitch(parser_dh,"-threeD")) tmp->threeD = true;
tmp->a = tmp->b = tmp->c = 1.0;
tmp->d = tmp->e = tmp->f = 0.0;
tmp->g = tmp->h = 0.0;
Parser_dhReadDouble(parser_dh,"-dx",&tmp->a);
Parser_dhReadDouble(parser_dh,"-dy",&tmp->b);
Parser_dhReadDouble(parser_dh,"-dz",&tmp->c);
Parser_dhReadDouble(parser_dh,"-cx",&tmp->d);
Parser_dhReadDouble(parser_dh,"-cy",&tmp->e);
Parser_dhReadDouble(parser_dh,"-cz",&tmp->f);
tmp->a = -1*fabs(tmp->a);
tmp->b = -1*fabs(tmp->b);
tmp->c = -1*fabs(tmp->c);
tmp->allocateMem = true;
tmp->A = tmp->B = tmp->C = tmp->D = tmp->E
= tmp->F = tmp->G = tmp->H = konstant;
tmp->bcX1 = tmp->bcX2 = tmp->bcY1 = tmp->bcY2
= tmp->bcZ1 = tmp->bcZ2 = 0.0;
Parser_dhReadDouble(parser_dh,"-bcx1",&tmp->bcX1);
Parser_dhReadDouble(parser_dh,"-bcx2",&tmp->bcX2);
Parser_dhReadDouble(parser_dh,"-bcy1",&tmp->bcY1);
Parser_dhReadDouble(parser_dh,"-bcy2",&tmp->bcY2);
Parser_dhReadDouble(parser_dh,"-bcz1",&tmp->bcZ1);
Parser_dhReadDouble(parser_dh,"-bcz2",&tmp->bcZ2);
END_FUNC_DH
}
void ExternalRows_dhCreate(ExternalRows_dh *er)
{
START_FUNC_DH
struct _extrows_dh* tmp = (struct _extrows_dh*)MALLOC_DH(sizeof(struct _extrows_dh)); CHECK_V_ERROR;
*er = tmp;
if (MAX_MPI_TASKS < np_dh) {
SET_V_ERROR("MAX_MPI_TASKS is too small; change, then recompile!");
}
{ HYPRE_Int i;
for (i=0; i<MAX_MPI_TASKS; ++i) {
tmp->rcv_row_lengths[i] = NULL;
tmp->rcv_row_numbers[i] = NULL;
}
}
tmp->cvalExt = NULL;
tmp->fillExt = NULL;
tmp->avalExt = NULL;
tmp->my_row_counts = NULL;
tmp->my_row_numbers = NULL;
tmp->cvalSend = NULL;
tmp->fillSend = NULL;
tmp->avalSend = NULL;
tmp->rowLookup = NULL;
tmp->sg = NULL;
tmp->F = NULL;
tmp->debug = Parser_dhHasSwitch(parser_dh, "-debug_ExtRows");
END_FUNC_DH
}
void sigRegister_dh()
{
if (Parser_dhHasSwitch(parser_dh, "-sig_dh")) {
hypre_int i;
for (i=0; i<euclid_signals_len; ++i) {
signal(euclid_signals[i], sigHandler_dh);
}
}
}
void Numbering_dhCreate(Numbering_dh *numb)
{
START_FUNC_DH
struct _numbering_dh* tmp = (struct _numbering_dh*)MALLOC_DH(sizeof(struct _numbering_dh)); CHECK_V_ERROR;
*numb = tmp;
tmp->size = 0;
tmp->first = 0;
tmp->m = 0;
tmp->num_ext = 0;
tmp->num_extLo = 0;
tmp->num_extHi = 0;
tmp->idx_ext = NULL;
tmp->idx_extLo = NULL;
tmp->idx_extHi = NULL;
tmp->idx_ext = NULL;
tmp->debug = Parser_dhHasSwitch(parser_dh, "-debug_Numbering");
END_FUNC_DH
}
void
Factor_dhCreate (Factor_dh * mat)
{
START_FUNC_DH struct _factor_dh *tmp;
if (np_dh > MAX_MPI_TASKS)
{
SET_V_ERROR ("you must change MAX_MPI_TASKS and recompile!");
}
tmp = (struct _factor_dh *) MALLOC_DH (sizeof (struct _factor_dh));
CHECK_V_ERROR;
*mat = tmp;
tmp->m = 0;
tmp->n = 0;
tmp->id = myid_dh;
tmp->beg_row = 0;
tmp->first_bdry = 0;
tmp->bdry_count = 0;
tmp->blockJacobi = false;
tmp->rp = NULL;
tmp->cval = NULL;
tmp->aval = NULL;
tmp->fill = NULL;
tmp->diag = NULL;
tmp->alloc = 0;
tmp->work_y_lo = tmp->work_x_hi = NULL;
tmp->sendbufLo = tmp->sendbufHi = NULL;
tmp->sendindLo = tmp->sendindHi = NULL;
tmp->num_recvLo = tmp->num_recvHi = 0;
tmp->num_sendLo = tmp->num_sendHi = 0;
tmp->sendlenLo = tmp->sendlenHi = 0;
tmp->solveIsSetup = false;
tmp->numbSolve = NULL;
tmp->debug = Parser_dhHasSwitch (parser_dh, "-debug_Factor");
/* Factor_dhZeroTiming(tmp); CHECK_V_ERROR; */
END_FUNC_DH}
void iluk_seq(Euclid_dh ctx)
{
START_FUNC_DH
HYPRE_Int *rp, *cval, *diag;
HYPRE_Int *CVAL;
HYPRE_Int i, j, len, count, col, idx = 0;
HYPRE_Int *list, *marker, *fill, *tmpFill;
HYPRE_Int temp, m, from = ctx->from, to = ctx->to;
HYPRE_Int *n2o_row, *o2n_col, beg_row, beg_rowP;
double *AVAL;
REAL_DH *work, *aval;
Factor_dh F = ctx->F;
SubdomainGraph_dh sg = ctx->sg;
bool debug = false;
if (logFile != NULL && Parser_dhHasSwitch(parser_dh, "-debug_ilu")) debug = true;
m = F->m;
rp = F->rp;
cval = F->cval;
fill = F->fill;
diag = F->diag;
aval = F->aval;
work = ctx->work;
count = rp[from];
if (sg == NULL) {
SET_V_ERROR("subdomain graph is NULL");
}
n2o_row = ctx->sg->n2o_row;
o2n_col = ctx->sg->o2n_col;
beg_row = ctx->sg->beg_row[myid_dh];
beg_rowP = ctx->sg->beg_rowP[myid_dh];
/* allocate and initialize working space */
list = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
marker = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
tmpFill = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
for (i=0; i<m; ++i) marker[i] = -1;
/* working space for values */
for (i=0; i<m; ++i) work[i] = 0.0;
/* printf_dh("====================== starting iluk_seq; level= %i\n\n", ctx->level);
*/
/*---------- main loop ----------*/
for (i=from; i<to; ++i) {
HYPRE_Int row = n2o_row[i]; /* local row number */
HYPRE_Int globalRow = row+beg_row; /* global row number */
/*hypre_fprintf(logFile, "--------------------------------- localRow= %i\n", 1+i);
*/
if (debug) {
hypre_fprintf(logFile, "ILU_seq ================================= starting local row: %i, (global= %i) level= %i\n", i+1, i+1+sg->beg_rowP[myid_dh], ctx->level);
}
EuclidGetRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;
/* compute scaling value for row(i) */
if (ctx->isScaled) {
compute_scaling_private(i, len, AVAL, ctx); CHECK_V_ERROR;
}
/* Compute symbolic factor for row(i);
this also performs sparsification
*/
count = symbolic_row_private(i, list, marker, tmpFill,
len, CVAL, AVAL,
o2n_col, ctx, debug); CHECK_V_ERROR;
/* Ensure adequate storage; reallocate, if necessary. */
if (idx + count > F->alloc) {
Factor_dhReallocate(F, idx, count); CHECK_V_ERROR;
SET_INFO("REALLOCATED from ilu_seq");
cval = F->cval;
fill = F->fill;
aval = F->aval;
}
/* Copy factored symbolic row to permanent storage */
col = list[m];
while (count--) {
cval[idx] = col;
fill[idx] = tmpFill[col];
++idx;
/*hypre_fprintf(logFile, " col= %i\n", 1+col);
*/
col = list[col];
}
/* add row-pointer to start of next row. */
rp[i+1] = idx;
/* Insert pointer to diagonal */
temp = rp[i];
while (cval[temp] != i) ++temp;
diag[i] = temp;
/*hypre_fprintf(logFile, " diag[i]= %i\n", diag);
*/
/* compute numeric factor for current row */
numeric_row_private(i, len, CVAL, AVAL,
work, o2n_col, ctx, debug); CHECK_V_ERROR
EuclidRestoreRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;
/* Copy factored numeric row to permanent storage,
and re-zero work vector
*/
if (debug) {
hypre_fprintf(logFile, "ILU_seq: ");
for (j=rp[i]; j<rp[i+1]; ++j) {
col = cval[j];
aval[j] = work[col];
work[col] = 0.0;
hypre_fprintf(logFile, "%i,%i,%g ; ", 1+cval[j], fill[j], aval[j]);
fflush(logFile);
}
hypre_fprintf(logFile, "\n");
} else {
for (j=rp[i]; j<rp[i+1]; ++j) {
col = cval[j];
aval[j] = work[col];
work[col] = 0.0;
}
}
/* check for zero diagonal */
if (! aval[diag[i]]) {
hypre_sprintf(msgBuf_dh, "zero diagonal in local row %i", i+1);
SET_V_ERROR(msgBuf_dh);
}
}
FREE_DH(list); CHECK_V_ERROR;
FREE_DH(tmpFill); CHECK_V_ERROR;
FREE_DH(marker); CHECK_V_ERROR;
/* adjust column indices back to global */
if (beg_rowP) {
HYPRE_Int start = rp[from];
HYPRE_Int stop = rp[to];
for (i=start; i<stop; ++i) cval[i] += beg_rowP;
}
/* for debugging: this is so the Print methods will work, even if
F hasn't been fully factored
*/
for (i=to+1; i<m; ++i) rp[i] = 0;
END_FUNC_DH
}
void ilut_seq(Euclid_dh ctx)
{
START_FUNC_DH
HYPRE_Int *rp, *cval, *diag, *CVAL;
HYPRE_Int i, len, count, col, idx = 0;
HYPRE_Int *list, *marker;
HYPRE_Int temp, m, from, to;
HYPRE_Int *n2o_row, *o2n_col, beg_row, beg_rowP;
double *AVAL, droptol;
REAL_DH *work, *aval, val;
Factor_dh F = ctx->F;
SubdomainGraph_dh sg = ctx->sg;
bool debug = false;
if (logFile != NULL && Parser_dhHasSwitch(parser_dh, "-debug_ilu")) debug = true;
m = F->m;
rp = F->rp;
cval = F->cval;
diag = F->diag;
aval = F->aval;
work = ctx->work;
from = ctx->from;
to = ctx->to;
count = rp[from];
droptol = ctx->droptol;
if (sg == NULL) {
SET_V_ERROR("subdomain graph is NULL");
}
n2o_row = ctx->sg->n2o_row;
o2n_col = ctx->sg->o2n_col;
beg_row = ctx->sg->beg_row[myid_dh];
beg_rowP = ctx->sg->beg_rowP[myid_dh];
/* allocate and initialize working space */
list = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
marker = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
for (i=0; i<m; ++i) marker[i] = -1;
rp[0] = 0;
/* working space for values */
for (i=0; i<m; ++i) work[i] = 0.0;
/* ----- main loop start ----- */
for (i=from; i<to; ++i) {
HYPRE_Int row = n2o_row[i]; /* local row number */
HYPRE_Int globalRow = row + beg_row; /* global row number */
EuclidGetRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;
/* compute scaling value for row(i) */
compute_scaling_private(i, len, AVAL, ctx); CHECK_V_ERROR;
/* compute factor for row i */
count = ilut_row_private(i, list, o2n_col, marker,
len, CVAL, AVAL, work, ctx, debug); CHECK_V_ERROR;
EuclidRestoreRow(ctx->A, globalRow, &len, &CVAL, &AVAL); CHECK_V_ERROR;
/* Ensure adequate storage; reallocate, if necessary. */
if (idx + count > F->alloc) {
Factor_dhReallocate(F, idx, count); CHECK_V_ERROR;
SET_INFO("REALLOCATED from ilu_seq");
cval = F->cval;
aval = F->aval;
}
/* Copy factored row to permanent storage,
apply 2nd drop test,
and re-zero work vector
*/
col = list[m];
while (count--) {
val = work[col];
if (col == i || fabs(val) > droptol) {
cval[idx] = col;
aval[idx++] = val;
work[col] = 0.0;
}
col = list[col];
}
/* add row-pointer to start of next row. */
rp[i+1] = idx;
/* Insert pointer to diagonal */
temp = rp[i];
while (cval[temp] != i) ++temp;
diag[i] = temp;
/* check for zero diagonal */
if (! aval[diag[i]]) {
hypre_sprintf(msgBuf_dh, "zero diagonal in local row %i", i+1);
SET_V_ERROR(msgBuf_dh);
}
} /* --------- main loop end --------- */
/* adjust column indices back to global */
if (beg_rowP) {
HYPRE_Int start = rp[from];
HYPRE_Int stop = rp[to];
for (i=start; i<stop; ++i) cval[i] += beg_rowP;
}
FREE_DH(list);
FREE_DH(marker);
END_FUNC_DH
}
void iluk_seq_block(Euclid_dh ctx)
{
START_FUNC_DH
HYPRE_Int *rp, *cval, *diag;
HYPRE_Int *CVAL;
HYPRE_Int h, i, j, len, count, col, idx = 0;
HYPRE_Int *list, *marker, *fill, *tmpFill;
HYPRE_Int temp, m;
HYPRE_Int *n2o_row, *o2n_col, *beg_rowP, *n2o_sub, blocks;
HYPRE_Int *row_count, *dummy = NULL, dummy2[1];
double *AVAL;
REAL_DH *work, *aval;
Factor_dh F = ctx->F;
SubdomainGraph_dh sg = ctx->sg;
bool bj = false, constrained = false;
HYPRE_Int discard = 0;
HYPRE_Int gr = -1; /* globalRow */
bool debug = false;
if (logFile != NULL && Parser_dhHasSwitch(parser_dh, "-debug_ilu")) debug = true;
/*hypre_fprintf(stderr, "====================== starting iluk_seq_block; level= %i\n\n", ctx->level);
*/
if (!strcmp(ctx->algo_par, "bj")) bj = true;
constrained = ! Parser_dhHasSwitch(parser_dh, "-unconstrained");
m = F->m;
rp = F->rp;
cval = F->cval;
fill = F->fill;
diag = F->diag;
aval = F->aval;
work = ctx->work;
if (sg != NULL) {
n2o_row = sg->n2o_row;
o2n_col = sg->o2n_col;
row_count = sg->row_count;
/* beg_row = sg->beg_row ; */
beg_rowP = sg->beg_rowP;
n2o_sub = sg->n2o_sub;
blocks = sg->blocks;
}
else {
dummy = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
for (i=0; i<m; ++i) dummy[i] = i;
n2o_row = dummy;
o2n_col = dummy;
dummy2[0] = m; row_count = dummy2;
/* beg_row = 0; */
beg_rowP = dummy;
n2o_sub = dummy;
blocks = 1;
}
/* allocate and initialize working space */
list = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
marker = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
tmpFill = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
for (i=0; i<m; ++i) marker[i] = -1;
/* working space for values */
for (i=0; i<m; ++i) work[i] = 0.0;
/*---------- main loop ----------*/
for (h=0; h<blocks; ++h) {
/* 1st and last row in current block, with respect to A */
HYPRE_Int curBlock = n2o_sub[h];
HYPRE_Int first_row = beg_rowP[curBlock];
HYPRE_Int end_row = first_row + row_count[curBlock];
if (debug) {
hypre_fprintf(logFile, "\n\nILU_seq BLOCK: %i @@@@@@@@@@@@@@@ \n", curBlock);
}
for (i=first_row; i<end_row; ++i) {
HYPRE_Int row = n2o_row[i];
++gr;
if (debug) {
hypre_fprintf(logFile, "ILU_seq global: %i local: %i =================================\n", 1+gr, 1+i-first_row);
}
/*prinft("first_row= %i end_row= %i\n", first_row, end_row);
*/
EuclidGetRow(ctx->A, row, &len, &CVAL, &AVAL); CHECK_V_ERROR;
/* compute scaling value for row(i) */
if (ctx->isScaled) {
compute_scaling_private(i, len, AVAL, ctx); CHECK_V_ERROR;
}
/* Compute symbolic factor for row(i);
this also performs sparsification
*/
count = symbolic_row_private(i, list, marker, tmpFill,
len, CVAL, AVAL,
o2n_col, ctx, debug); CHECK_V_ERROR;
/* Ensure adequate storage; reallocate, if necessary. */
if (idx + count > F->alloc) {
Factor_dhReallocate(F, idx, count); CHECK_V_ERROR;
SET_INFO("REALLOCATED from ilu_seq");
cval = F->cval;
fill = F->fill;
aval = F->aval;
}
/* Copy factored symbolic row to permanent storage */
col = list[m];
while (count--) {
/* constrained pilu */
if (constrained && !bj) {
if (col >= first_row && col < end_row) {
cval[idx] = col;
fill[idx] = tmpFill[col];
++idx;
} else {
if (check_constraint_private(ctx, curBlock, col)) {
cval[idx] = col;
fill[idx] = tmpFill[col];
++idx;
} else {
++discard;
}
}
col = list[col];
}
/* block jacobi case */
else if (bj) {
if (col >= first_row && col < end_row) {
cval[idx] = col;
fill[idx] = tmpFill[col];
++idx;
} else {
++discard;
}
col = list[col];
}
/* general case */
else {
cval[idx] = col;
fill[idx] = tmpFill[col];
++idx;
col = list[col];
}
}
/* add row-pointer to start of next row. */
rp[i+1] = idx;
/* Insert pointer to diagonal */
temp = rp[i];
while (cval[temp] != i) ++temp;
diag[i] = temp;
/* compute numeric factor for current row */
numeric_row_private(i, len, CVAL, AVAL,
work, o2n_col, ctx, debug); CHECK_V_ERROR
EuclidRestoreRow(ctx->A, row, &len, &CVAL, &AVAL); CHECK_V_ERROR;
/* Copy factored numeric row to permanent storage,
and re-zero work vector
*/
if (debug) {
hypre_fprintf(logFile, "ILU_seq: ");
for (j=rp[i]; j<rp[i+1]; ++j) {
col = cval[j];
aval[j] = work[col];
work[col] = 0.0;
hypre_fprintf(logFile, "%i,%i,%g ; ", 1+cval[j], fill[j], aval[j]);
}
hypre_fprintf(logFile, "\n");
}
/* normal operation */
else {
for (j=rp[i]; j<rp[i+1]; ++j) {
col = cval[j];
aval[j] = work[col];
work[col] = 0.0;
}
}
/* check for zero diagonal */
if (! aval[diag[i]]) {
hypre_sprintf(msgBuf_dh, "zero diagonal in local row %i", i+1);
SET_V_ERROR(msgBuf_dh);
}
}
}
/* hypre_printf("bj= %i constrained= %i discarded= %i\n", bj, constrained, discard); */
if (dummy != NULL) { FREE_DH(dummy); CHECK_V_ERROR; }
FREE_DH(list); CHECK_V_ERROR;
FREE_DH(tmpFill); CHECK_V_ERROR;
FREE_DH(marker); CHECK_V_ERROR;
END_FUNC_DH
}
void bicgstab_euclid(Mat_dh A, Euclid_dh ctx, double *x, double *b, HYPRE_Int *itsOUT)
{
START_FUNC_DH
HYPRE_Int its, m = ctx->m;
bool monitor;
HYPRE_Int maxIts = ctx->maxIts;
double atol = ctx->atol, rtol = ctx->rtol;
/* scalars */
double alpha, alpha_1,
beta_1,
widget, widget_1,
rho_1, rho_2,
s_norm, eps,
exit_a, b_iprod, r_iprod;
/* vectors */
double *t, *s, *s_hat, *v, *p, *p_hat, *r, *r_hat;
monitor = Parser_dhHasSwitch(parser_dh, "-monitor");
/* allocate working space */
t = (double*)MALLOC_DH(m*sizeof(double));
s = (double*)MALLOC_DH(m*sizeof(double));
s_hat = (double*)MALLOC_DH(m*sizeof(double));
v = (double*)MALLOC_DH(m*sizeof(double));
p = (double*)MALLOC_DH(m*sizeof(double));
p_hat = (double*)MALLOC_DH(m*sizeof(double));
r = (double*)MALLOC_DH(m*sizeof(double));
r_hat = (double*)MALLOC_DH(m*sizeof(double));
/* r = b - Ax */
Mat_dhMatVec(A, x, s); /* s = Ax */
CopyVec(m, b, r); /* r = b */
Axpy(m, -1.0, s, r); /* r = b-Ax */
CopyVec(m, r, r_hat); /* r_hat = r */
/* compute stopping criteria */
b_iprod = InnerProd(m, b, b); CHECK_V_ERROR;
exit_a = atol*atol*b_iprod; CHECK_V_ERROR; /* absolute stopping criteria */
eps = rtol*rtol*b_iprod; /* relative stoping criteria (residual reduction) */
its = 0;
while(1) {
++its;
rho_1 = InnerProd(m, r_hat, r);
if (rho_1 == 0) {
SET_V_ERROR("(r_hat . r) = 0; method fails");
}
if (its == 1) {
CopyVec(m, r, p); /* p = r_0 */ CHECK_V_ERROR;
} else {
beta_1 = (rho_1/rho_2)*(alpha_1/widget_1);
/* p_i = r_(i-1) + beta_(i-1)*( p_(i-1) - w_(i-1)*v_(i-1) ) */
Axpy(m, -widget_1, v, p); CHECK_V_ERROR;
ScaleVec(m, beta_1, p); CHECK_V_ERROR;
Axpy(m, 1.0, r, p); CHECK_V_ERROR;
}
/* solve M*p_hat = p_i */
Euclid_dhApply(ctx, p, p_hat); CHECK_V_ERROR;
/* v_i = A*p_hat */
Mat_dhMatVec(A, p_hat, v); CHECK_V_ERROR;
/* alpha_i = rho_(i-1) / (r_hat^T . v_i ) */
{ double tmp = InnerProd(m, r_hat, v); CHECK_V_ERROR;
alpha = rho_1/tmp;
}
/* s = r_(i-1) - alpha_i*v_i */
CopyVec(m, r, s); CHECK_V_ERROR;
Axpy(m, -alpha, v, s); CHECK_V_ERROR;
/* check norm of s; if small enough:
* set x_i = x_(i-1) + alpha_i*p_i and stop.
* (Actually, we use the square of the norm)
*/
s_norm = InnerProd(m, s, s);
if (s_norm < exit_a) {
SET_INFO("reached absolute stopping criteria");
break;
}
/* solve M*s_hat = s */
Euclid_dhApply(ctx, s, s_hat); CHECK_V_ERROR;
/* t = A*s_hat */
Mat_dhMatVec(A, s_hat, t); CHECK_V_ERROR;
/* w_i = (t . s)/(t . t) */
{ double tmp1, tmp2;
tmp1 = InnerProd(m, t, s); CHECK_V_ERROR;
tmp2 = InnerProd(m, t, t); CHECK_V_ERROR;
widget = tmp1/tmp2;
}
/* x_i = x_(i-1) + alpha_i*p_hat + w_i*s_hat */
Axpy(m, alpha, p_hat, x); CHECK_V_ERROR;
Axpy(m, widget, s_hat, x); CHECK_V_ERROR;
/* r_i = s - w_i*t */
CopyVec(m, s, r); CHECK_V_ERROR;
Axpy(m, -widget, t, r); CHECK_V_ERROR;
/* check convergence; continue if necessary;
* for continuation it is necessary thea w != 0.
*/
r_iprod = InnerProd(m, r, r); CHECK_V_ERROR;
if (r_iprod < eps) {
SET_INFO("stipulated residual reduction achieved");
break;
}
/* monitor convergence */
if (monitor && myid_dh == 0) {
hypre_fprintf(stderr, "[it = %i] %e\n", its, sqrt(r_iprod/b_iprod));
}
/* prepare for next iteration */
rho_2 = rho_1;
widget_1 = widget;
alpha_1 = alpha;
if (its >= maxIts) {
its = -its;
break;
}
}
*itsOUT = its;
FREE_DH(t);
FREE_DH(s);
FREE_DH(s_hat);
FREE_DH(v);
FREE_DH(p);
FREE_DH(p_hat);
FREE_DH(r);
FREE_DH(r_hat);
END_FUNC_DH
}
void cg_euclid(Mat_dh A, Euclid_dh ctx, double *x, double *b, HYPRE_Int *itsOUT)
{
START_FUNC_DH
HYPRE_Int its, m = A->m;
double *p, *r, *s;
double alpha, beta, gamma, gamma_old, eps, bi_prod, i_prod;
bool monitor;
HYPRE_Int maxIts = ctx->maxIts;
/* double atol = ctx->atol */
double rtol = ctx->rtol;
monitor = Parser_dhHasSwitch(parser_dh, "-monitor");
/* compute square of absolute stopping threshold */
/* bi_prod = <b,b> */
bi_prod = InnerProd(m, b, b); CHECK_V_ERROR;
eps = (rtol*rtol)*bi_prod;
p = (double *) MALLOC_DH(m * sizeof(double));
s = (double *) MALLOC_DH(m * sizeof(double));
r = (double *) MALLOC_DH(m * sizeof(double));
/* r = b - Ax */
Mat_dhMatVec(A, x, r); /* r = Ax */ CHECK_V_ERROR;
ScaleVec(m, -1.0, r); /* r = b */ CHECK_V_ERROR;
Axpy(m, 1.0, b, r); /* r = r + b */ CHECK_V_ERROR;
/* solve Mp = r */
Euclid_dhApply(ctx, r, p); CHECK_V_ERROR;
/* gamma = <r,p> */
gamma = InnerProd(m, r, p); CHECK_V_ERROR;
its = 0;
while (1) {
++its;
/* s = A*p */
Mat_dhMatVec(A, p, s); CHECK_V_ERROR;
/* alpha = gamma / <s,p> */
{ double tmp = InnerProd(m, s, p); CHECK_V_ERROR;
alpha = gamma / tmp;
gamma_old = gamma;
}
/* x = x + alpha*p */
Axpy(m, alpha, p, x); CHECK_V_ERROR;
/* r = r - alpha*s */
Axpy(m, -alpha, s, r); CHECK_V_ERROR;
/* solve Ms = r */
Euclid_dhApply(ctx, r, s); CHECK_V_ERROR;
/* gamma = <r,s> */
gamma = InnerProd(m, r, s); CHECK_V_ERROR;
/* set i_prod for convergence test */
i_prod = InnerProd(m, r, r); CHECK_V_ERROR;
if (monitor && myid_dh == 0) {
hypre_fprintf(stderr, "iter = %i rel. resid. norm: %e\n", its, sqrt(i_prod/bi_prod));
}
/* check for convergence */
if (i_prod < eps) break;
/* beta = gamma / gamma_old */
beta = gamma / gamma_old;
/* p = s + beta p */
ScaleVec(m, beta, p); CHECK_V_ERROR;
Axpy(m, 1.0, s, p); CHECK_V_ERROR;
if (its >= maxIts) {
its = -its;
break;
}
}
*itsOUT = its;
FREE_DH(p);
FREE_DH(s);
FREE_DH(r);
END_FUNC_DH
}
void MatGenFD_Run(MatGenFD mg, HYPRE_Int id, HYPRE_Int np, Mat_dh *AOut, Vec_dh *rhsOut)
{
/* What this function does:
* 0. creates return objects (A and rhs)
* 1. computes "nice to have" values;
* 2. allocates storage, if required;
* 3. calls generateBlocked() or generateStriped().
* 4. initializes variable in A and rhs.
*/
START_FUNC_DH
Mat_dh A;
Vec_dh rhs;
bool threeD = mg->threeD;
HYPRE_Int nnz;
HYPRE_Int m = mg->m; /* local unknowns */
bool debug = false, striped;
if (mg->debug && logFile != NULL) debug = true;
striped = Parser_dhHasSwitch(parser_dh,"-striped");
/* 0. create objects */
Mat_dhCreate(AOut); CHECK_V_ERROR;
Vec_dhCreate(rhsOut); CHECK_V_ERROR;
A = *AOut;
rhs = *rhsOut;
/* ensure that processor grid contains the same number of
nodes as there are processors.
*/
if (! Parser_dhHasSwitch(parser_dh, "-noChecks")) {
if (!striped) {
HYPRE_Int npTest = mg->px*mg->py;
if (threeD) npTest *= mg->pz;
if (npTest != np) {
hypre_sprintf(msgBuf_dh, "numbers don't match: np_dh = %i, px*py*pz = %i", np, npTest);
SET_V_ERROR(msgBuf_dh);
}
}
}
/* 1. compute "nice to have" values */
/* each proc's subgrid dimension */
mg->cc = m;
if (threeD) {
m = mg->m = m*m*m;
} else {
m = mg->m = m*m;
}
mg->first = id*m;
mg->hh = 1.0/(mg->px*mg->cc - 1);
if (debug) {
hypre_sprintf(msgBuf_dh, "cc (local grid dimension) = %i", mg->cc);
SET_INFO(msgBuf_dh);
if (threeD) { hypre_sprintf(msgBuf_dh, "threeD = true"); }
else { hypre_sprintf(msgBuf_dh, "threeD = false"); }
SET_INFO(msgBuf_dh);
hypre_sprintf(msgBuf_dh, "np= %i id= %i", np, id);
SET_INFO(msgBuf_dh);
}
mg->id = id;
mg->np = np;
nnz = threeD ? m*7 : m*5;
/* 2. allocate storage */
if (mg->allocateMem) {
A->rp = (HYPRE_Int*)MALLOC_DH((m+1)*sizeof(HYPRE_Int)); CHECK_V_ERROR;
A->rp[0] = 0;
A->cval = (HYPRE_Int*)MALLOC_DH(nnz*sizeof(HYPRE_Int)); CHECK_V_ERROR
A->aval = (double*)MALLOC_DH(nnz*sizeof(double)); CHECK_V_ERROR;
/* rhs->vals = (double*)MALLOC_DH(m*sizeof(double)); CHECK_V_ERROR; */
}
/* 4. initialize variables in A and rhs */
rhs->n = m;
A->m = m;
A->n = m*mg->np;
A->beg_row = mg->first;
/* 3. generate matrix */
isThreeD = threeD; /* yuck! used in box_XX() */
if (Parser_dhHasSwitch(parser_dh,"-striped")) {
generateStriped(mg, A->rp, A->cval, A->aval, A, rhs); CHECK_V_ERROR;
} else {
generateBlocked(mg, A->rp, A->cval, A->aval, A, rhs); CHECK_V_ERROR;
}
/* add in bdry conditions */
/* only implemented for 2D mats! */
if (! threeD) {
/* fdaddbc(nx, ny, nz, rp, cval, diag, aval, rhs, h, mg); */
}
END_FUNC_DH
}
void readMat(Mat_dh *Aout, char *ft, char *fn, HYPRE_Int ignore)
{
START_FUNC_DH
bool makeStructurallySymmetric;
bool fixDiags;
*Aout = NULL;
makeStructurallySymmetric =
Parser_dhHasSwitch(parser_dh, "-makeSymmetric");
fixDiags =
Parser_dhHasSwitch(parser_dh, "-fixDiags");
if (fn == NULL) {
SET_V_ERROR("passed NULL filename; can't open for reading!");
}
if (!strcmp(ft, "csr"))
{
Mat_dhReadCSR(Aout, fn); CHECK_V_ERROR;
}
else if (!strcmp(ft, "trip"))
{
Mat_dhReadTriples(Aout, ignore, fn); CHECK_V_ERROR;
}
else if (!strcmp(ft, "ebin"))
{
Mat_dhReadBIN(Aout, fn); CHECK_V_ERROR;
}
#ifdef PETSC_MODE
else if (!strcmp(ft, "petsc")) {
Viewer_DH viewer;
Mat Apetsc;
HYPRE_Int ierr;
ierr = ViewerBinaryOpen_DH(comm_dh, fn, BINARY_RDONLY_DH, &viewer);
if (ierr) { SET_V_ERROR("ViewerBinaryOpen failed! [PETSc lib]"); }
ierr = MatLoad(viewer, MATSEQAIJ, &Apetsc);
if (ierr) { SET_V_ERROR("MatLoad failed! [PETSc lib]"); }
ierr = ViewerDestroy_DH(viewer);
if (ierr) { SET_V_ERROR("ViewerDestroy failed! [PETSc lib]"); }
ierr = convertPetscToEuclidMat(Apetsc, Aout);
if (ierr) { SET_V_ERROR("convertPetscToEuclidMat failed!"); }
ierr = MatDestroy(Apetsc);
if (ierr) { SET_V_ERROR("MatDestroy failed! [PETSc lib]"); }
}
#else
else if (!strcmp(ft, "petsc")) {
hypre_sprintf(msgBuf_dh, "must recompile Euclid using petsc mode!");
SET_V_ERROR(msgBuf_dh);
}
#endif
else
{
hypre_sprintf(msgBuf_dh, "unknown filetype: -ftin %s", ft);
SET_V_ERROR(msgBuf_dh);
}
if (makeStructurallySymmetric) {
hypre_printf("\npadding with zeros to make structurally symmetric\n");
Mat_dhMakeStructurallySymmetric(*Aout); CHECK_V_ERROR;
}
if ( (*Aout)->m == 0) {
SET_V_ERROR("row count = 0; something's wrong!");
}
if (fixDiags) {
fix_diags_private(*Aout); CHECK_V_ERROR;
}
END_FUNC_DH
}
