HYPRE_Int
utilities_FortranMatrixPrint( utilities_FortranMatrix* mtx, const char *fileName) {
hypre_longint i, j, h, w, jump;
double* p;
FILE* fp;
hypre_assert( mtx != NULL );
if ( !(fp = fopen(fileName,"w")) )
return 1;
h = mtx->height;
w = mtx->width;
hypre_fprintf(fp,"%ld\n",h);
hypre_fprintf(fp,"%ld\n",w);
jump = mtx->globalHeight - h;
for ( j = 0, p = mtx->value; j < w; j++ ) {
for ( i = 0; i < h; i++, p++ )
hypre_fprintf(fp,"%.14e\n",*p);
p += jump;
}
fclose(fp);
return 0;
}
void PrintMatUsingGetRow(void* A, HYPRE_Int beg_row, HYPRE_Int m,
HYPRE_Int *n2o_row, HYPRE_Int *n2o_col, char *filename)
{
START_FUNC_DH
FILE *fp;
HYPRE_Int *o2n_col = NULL, pe, i, j, *cval, len;
HYPRE_Int newCol, newRow;
double *aval;
/* form inverse column permutation */
if (n2o_col != NULL) {
o2n_col = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
for (i=0; i<m; ++i) o2n_col[n2o_col[i]] = i;
}
for (pe=0; pe<np_dh; ++pe) {
hypre_MPI_Barrier(comm_dh);
if (myid_dh == pe) {
if (pe == 0) {
fp=fopen(filename, "w");
} else {
fp=fopen(filename, "a");
}
if (fp == NULL) {
hypre_sprintf(msgBuf_dh, "can't open %s for writing\n", filename);
SET_V_ERROR(msgBuf_dh);
}
for (i=0; i<m; ++i) {
if (n2o_row == NULL) {
EuclidGetRow(A, i+beg_row, &len, &cval, &aval); CHECK_V_ERROR;
for (j=0; j<len; ++j) {
hypre_fprintf(fp, "%i %i %g\n", i+1, cval[j], aval[j]);
}
EuclidRestoreRow(A, i, &len, &cval, &aval); CHECK_V_ERROR;
} else {
newRow = n2o_row[i] + beg_row;
EuclidGetRow(A, newRow, &len, &cval, &aval); CHECK_V_ERROR;
for (j=0; j<len; ++j) {
newCol = o2n_col[cval[j]-beg_row] + beg_row;
hypre_fprintf(fp, "%i %i %g\n", i+1, newCol, aval[j]);
}
EuclidRestoreRow(A, i, &len, &cval, &aval); CHECK_V_ERROR;
}
}
fclose(fp);
}
}
if (n2o_col != NULL) {
FREE_DH(o2n_col); CHECK_V_ERROR;
}
END_FUNC_DH
}
void mat_dh_print_graph_private(HYPRE_Int m, HYPRE_Int beg_row, HYPRE_Int *rp, HYPRE_Int *cval,
double *aval, HYPRE_Int *n2o, HYPRE_Int *o2n, Hash_i_dh hash, FILE* fp)
{
START_FUNC_DH
HYPRE_Int i, j, row, col;
double val;
bool private_n2o = false;
bool private_hash = false;
if (n2o == NULL) {
private_n2o = true;
create_nat_ordering_private(m, &n2o); CHECK_V_ERROR;
create_nat_ordering_private(m, &o2n); CHECK_V_ERROR;
}
if (hash == NULL) {
private_hash = true;
Hash_i_dhCreate(&hash, -1); CHECK_V_ERROR;
}
for (i=0; i<m; ++i) {
row = n2o[i];
for (j=rp[row]; j<rp[row+1]; ++j) {
col = cval[j];
if (col < beg_row || col >= beg_row+m) {
HYPRE_Int tmp = col;
/* nonlocal column: get permutation from hash table */
tmp = Hash_i_dhLookup(hash, col); CHECK_V_ERROR;
if (tmp == -1) {
hypre_sprintf(msgBuf_dh, "beg_row= %i m= %i; nonlocal column= %i not in hash table",
beg_row, m, col);
SET_V_ERROR(msgBuf_dh);
} else {
col = tmp;
}
} else {
col = o2n[col];
}
if (aval == NULL) {
val = _MATLAB_ZERO_;
} else {
val = aval[j];
}
hypre_fprintf(fp, "%i %i %g\n", 1+row+beg_row, 1+col, val);
}
}
if (private_n2o) {
destroy_nat_ordering_private(n2o); CHECK_V_ERROR;
destroy_nat_ordering_private(o2n); CHECK_V_ERROR;
}
if (private_hash) {
Hash_i_dhDestroy(hash); CHECK_V_ERROR;
}
END_FUNC_DH
}
HYPRE_Int
hypre_PrintBoxArrayData( FILE *file,
hypre_BoxArray *box_array,
hypre_BoxArray *data_space,
HYPRE_Int num_values,
double *data )
{
HYPRE_Int ierr = 0;
hypre_Box *box;
hypre_Box *data_box;
HYPRE_Int data_box_volume;
HYPRE_Int datai;
hypre_Index loop_size;
hypre_IndexRef start;
hypre_Index stride;
HYPRE_Int i, j;
HYPRE_Int loopi, loopj, loopk;
/*----------------------------------------
* Print data
*----------------------------------------*/
hypre_SetIndex(stride, 1, 1, 1);
hypre_ForBoxI(i, box_array)
{
box = hypre_BoxArrayBox(box_array, i);
data_box = hypre_BoxArrayBox(data_space, i);
start = hypre_BoxIMin(box);
data_box_volume = hypre_BoxVolume(data_box);
hypre_BoxGetSize(box, loop_size);
hypre_BoxLoop1Begin(loop_size,
data_box, start, stride, datai);
hypre_BoxLoop1For(loopi, loopj, loopk, datai)
{
for (j = 0; j < num_values; j++)
{
hypre_fprintf(file, "%d: (%d, %d, %d; %d) %.14e\n",
i,
hypre_IndexX(start) + loopi,
hypre_IndexY(start) + loopj,
hypre_IndexZ(start) + loopk,
j,
data[datai + j*data_box_volume]);
}
}
hypre_BoxLoop1End(datai);
data += num_values*data_box_volume;
}
/* Process the error with code ierr raised in the given line of the
given source file. */
void hypre_error_handler(const char *filename, HYPRE_Int line, HYPRE_Int ierr, const char *msg)
{
hypre_error_flag |= ierr;
#ifdef HYPRE_PRINT_ERRORS
if (msg)
{
hypre_fprintf(
stderr, "hypre error in file \"%s\", line %d, error code = %d - %s\n",
filename, line, ierr, msg);
}
else
{
hypre_fprintf(
stderr, "hypre error in file \"%s\", line %d, error code = %d\n",
filename, line, ierr);
}
#endif
}
HYPRE_Int
hypre_CSRBooleanMatrixPrint( hypre_CSRBooleanMatrix *matrix,
const char *file_name )
{
FILE *fp;
HYPRE_Int *matrix_i;
HYPRE_Int *matrix_j;
HYPRE_Int num_rows;
HYPRE_Int file_base = 1;
HYPRE_Int j;
HYPRE_Int ierr = 0;
/*----------------------------------------------------------
* Print the matrix data
*----------------------------------------------------------*/
matrix_i = hypre_CSRBooleanMatrix_Get_I(matrix);
matrix_j = hypre_CSRBooleanMatrix_Get_J(matrix);
num_rows = hypre_CSRBooleanMatrix_Get_NRows(matrix);
fp = fopen(file_name, "w");
hypre_fprintf(fp, "%d\n", num_rows);
for (j = 0; j <= num_rows; j++)
{
hypre_fprintf(fp, "%d\n", matrix_i[j] + file_base);
}
for (j = 0; j < matrix_i[num_rows]; j++)
{
hypre_fprintf(fp, "%d\n", matrix_j[j] + file_base);
}
fclose(fp);
return ierr;
}
void sigHandler_dh(hypre_int sig)
{
hypre_fprintf(stderr, "\n[%i] Euclid Signal Handler got: %s\n", myid_dh, SIGNAME[sig]);
hypre_fprintf(stderr, "[%i] ========================================================\n", myid_dh);
hypre_fprintf(stderr, "[%i] function calling sequence that led to the exception:\n", myid_dh);
hypre_fprintf(stderr, "[%i] ========================================================\n", myid_dh);
printFunctionStack(stderr);
hypre_fprintf(stderr, "\n\n");
if (logFile != NULL) {
hypre_fprintf(logFile, "\n[%i] Euclid Signal Handler got: %s\n", myid_dh, SIGNAME[sig]);
hypre_fprintf(logFile, "[%i] ========================================================\n", myid_dh);
hypre_fprintf(logFile, "[%i] function calling sequence that led to the exception:\n", myid_dh);
hypre_fprintf(logFile, "[%i] ========================================================\n", myid_dh);
printFunctionStack(logFile);
hypre_fprintf(logFile, "\n\n");
}
EUCLID_EXIT;
}
HYPRE_Int hypre_ParCSRBooleanMatrixPrint( hypre_ParCSRBooleanMatrix *matrix,
const char *file_name )
{
MPI_Comm comm = hypre_ParCSRBooleanMatrix_Get_Comm(matrix);
HYPRE_Int global_num_rows = hypre_ParCSRBooleanMatrix_Get_GlobalNRows(matrix);
HYPRE_Int global_num_cols = hypre_ParCSRBooleanMatrix_Get_GlobalNCols(matrix);
HYPRE_Int *col_map_offd = hypre_ParCSRBooleanMatrix_Get_ColMapOffd(matrix);
HYPRE_Int *row_starts = hypre_ParCSRBooleanMatrix_Get_RowStarts(matrix);
HYPRE_Int *col_starts = hypre_ParCSRBooleanMatrix_Get_ColStarts(matrix);
HYPRE_Int my_id, i, num_procs;
char new_file_d[80], new_file_o[80], new_file_info[80];
HYPRE_Int ierr = 0;
FILE *fp;
HYPRE_Int num_cols_offd = 0;
if (hypre_ParCSRBooleanMatrix_Get_Offd(matrix)) num_cols_offd =
hypre_CSRBooleanMatrix_Get_NCols(hypre_ParCSRBooleanMatrix_Get_Offd(matrix));
hypre_MPI_Comm_rank(comm, &my_id);
hypre_MPI_Comm_size(comm, &num_procs);
hypre_sprintf(new_file_d,"%s.D.%d",file_name,my_id);
hypre_sprintf(new_file_o,"%s.O.%d",file_name,my_id);
hypre_sprintf(new_file_info,"%s.INFO.%d",file_name,my_id);
hypre_CSRBooleanMatrixPrint(hypre_ParCSRBooleanMatrix_Get_Diag(matrix),new_file_d);
if (num_cols_offd != 0)
hypre_CSRBooleanMatrixPrint(hypre_ParCSRBooleanMatrix_Get_Offd(matrix),
new_file_o);
fp = fopen(new_file_info, "w");
hypre_fprintf(fp, "%d\n", global_num_rows);
hypre_fprintf(fp, "%d\n", global_num_cols);
hypre_fprintf(fp, "%d\n", num_cols_offd);
for (i=0; i < num_procs; i++)
hypre_fprintf(fp, "%d %d\n", row_starts[i], col_starts[i]);
for (i=0; i < num_cols_offd; i++)
hypre_fprintf(fp, "%d\n", col_map_offd[i]);
fclose(fp);
return ierr;
}
HYPRE_Int
hypre_ParVectorPrint( hypre_ParVector *vector,
const char *file_name )
{
char new_file_name[80];
hypre_Vector *local_vector;
MPI_Comm comm;
HYPRE_Int my_id, num_procs, i;
HYPRE_Int *partitioning;
HYPRE_Int global_size;
FILE *fp;
if (!vector)
{
hypre_error_in_arg(1);
return hypre_error_flag;
}
local_vector = hypre_ParVectorLocalVector(vector);
comm = hypre_ParVectorComm(vector);
partitioning = hypre_ParVectorPartitioning(vector);
global_size = hypre_ParVectorGlobalSize(vector);
hypre_MPI_Comm_rank(comm,&my_id);
hypre_MPI_Comm_size(comm,&num_procs);
hypre_sprintf(new_file_name,"%s.%d",file_name,my_id);
hypre_SeqVectorPrint(local_vector,new_file_name);
hypre_sprintf(new_file_name,"%s.INFO.%d",file_name,my_id);
fp = fopen(new_file_name, "w");
hypre_fprintf(fp, "%d\n", global_size);
#ifdef HYPRE_NO_GLOBAL_PARTITION
for (i=0; i < 2; i++)
hypre_fprintf(fp, "%d\n", partitioning[i]);
#else
for (i=0; i < num_procs; i++)
hypre_fprintf(fp, "%d\n", partitioning[i]);
#endif
fclose (fp);
return hypre_error_flag;
}
void MemStat(Mem *m, FILE *stream, char *msg)
{
hypre_fprintf(stream, "****** Mem: %s ******\n", msg);
hypre_fprintf(stream, "num_blocks : %d\n", m->num_blocks);
hypre_fprintf(stream, "num_over : %d\n", m->num_over);
hypre_fprintf(stream, "total_bytes: %ld\n", m->total_bytes);
hypre_fprintf(stream, "bytes_alloc: %ld\n", m->bytes_alloc);
if (m->bytes_alloc != 0)
hypre_fprintf(stream, "efficiency : %f\n", m->total_bytes /
(double) m->bytes_alloc);
hypre_fprintf(stream, "*********************\n");
fflush(stream);
}
/*************************************************************************
* This function prints an error message and exits
**************************************************************************/
void hypre_errexit(const char *f_str, ...)
{
va_list argp;
/*hypre_fprintf(stdout,"[%3d]", mype);*/
va_start(argp, f_str);
vfprintf(stdout, f_str, argp);
va_end(argp);
hypre_fprintf(stdout,"\n");
fflush(stdout);
abort();
}
void mat_dh_print_csr_private(HYPRE_Int m, HYPRE_Int *rp, HYPRE_Int *cval, double *aval, FILE* fp)
{
START_FUNC_DH
HYPRE_Int i, nz = rp[m];
/* print header line */
hypre_fprintf(fp, "%i %i\n", m, rp[m]);
/* print rp[] */
for (i=0; i<=m; ++i) hypre_fprintf(fp, "%i ", rp[i]);
hypre_fprintf(fp, "\n");
/* print cval[] */
for (i=0; i<nz; ++i) hypre_fprintf(fp, "%i ", cval[i]);
hypre_fprintf(fp, "\n");
/* print aval[] */
for (i=0; i<nz; ++i) hypre_fprintf(fp, "%1.19e ", aval[i]);
hypre_fprintf(fp, "\n");
END_FUNC_DH
}
HYPRE_Int
hypre_PrintBoxArrayData( FILE *file,
hypre_BoxArray *box_array,
hypre_BoxArray *data_space,
HYPRE_Int num_values,
HYPRE_Int dim,
HYPRE_Complex *data )
{
hypre_Box *box;
hypre_Box *data_box;
HYPRE_Int data_box_volume;
HYPRE_Int datai;
hypre_Index loop_size;
hypre_IndexRef start;
hypre_Index stride;
hypre_Index index;
HYPRE_Int i, j, d;
HYPRE_Complex value;
/*----------------------------------------
* Print data
*----------------------------------------*/
hypre_SetIndex(stride, 1);
hypre_ForBoxI(i, box_array)
{
box = hypre_BoxArrayBox(box_array, i);
data_box = hypre_BoxArrayBox(data_space, i);
start = hypre_BoxIMin(box);
data_box_volume = hypre_BoxVolume(data_box);
hypre_BoxGetSize(box, loop_size);
hypre_BoxLoop1Begin(dim, loop_size,
data_box, start, stride, datai);
hypre_BoxLoop1For(datai)
{
/* Print lines of the form: "%d: (%d, %d, %d; %d) %.14e\n" */
hypre_BoxLoopGetIndex(index);
for (j = 0; j < num_values; j++)
{
hypre_fprintf(file, "%d: (%d",
i, hypre_IndexD(start, 0) + hypre_IndexD(index, 0));
for (d = 1; d < dim; d++)
{
hypre_fprintf(file, ", %d",
hypre_IndexD(start, d) + hypre_IndexD(index, d));
}
value = data[datai + j*data_box_volume];
#ifdef HYPRE_COMPLEX
hypre_fprintf(file, "; %d) %.14e , %.14e\n",
j, hypre_creal(value), hypre_cimag(value));
#else
hypre_fprintf(file, "; %d) %.14e\n", j, value);
#endif
}
}
hypre_BoxLoop1End(datai);
data += num_values*data_box_volume;
}
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 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 generateStriped(MatGenFD mg, HYPRE_Int *rp, HYPRE_Int *cval, double *aval, Mat_dh A, Vec_dh b)
{
START_FUNC_DH
HYPRE_Int mGlobal;
HYPRE_Int m = mg->m;
HYPRE_Int beg_row, end_row;
HYPRE_Int i, j, k, row;
bool threeD = mg->threeD;
HYPRE_Int idx = 0;
double *stencil = mg->stencil;
bool debug = false;
HYPRE_Int plane, nodeRemainder;
HYPRE_Int naborx1, naborx2, nabory1, nabory2;
double *rhs;
bool applyBdry = true;
double hhalf;
double bcx1 = mg->bcX1;
double bcx2 = mg->bcX2;
double bcy1 = mg->bcY1;
double bcy2 = mg->bcY2;
/* double bcz1 = mg->bcZ1; */
/* double bcz2 = mg->bcZ2; */
HYPRE_Int nx, ny;
printf_dh("@@@ using striped partitioning\n");
if (mg->debug && logFile != NULL) debug = true;
/* recompute values (yuck!) */
m = 9;
Parser_dhReadInt(parser_dh,"-m", &m); /* global grid dimension */
mGlobal = m*m; /* global unkknowns */
if (threeD) mGlobal *= m;
i = mGlobal/mg->np; /* unknowns per processor */
beg_row = i*mg->id; /* global number of 1st local row */
end_row = beg_row + i;
if (mg->id == mg->np-1) end_row = mGlobal;
nx = ny = m;
mg->hh = 1.0/(m-1);
hhalf = 0.5 * mg->hh;
A->n = m*m;
A->m = end_row - beg_row;
A->beg_row = beg_row;
Vec_dhInit(b, A->m); CHECK_V_ERROR;
rhs = b->vals;
plane = m*m;
if (debug) {
hypre_fprintf(logFile, "generateStriped: beg_row= %i; end_row= %i; m= %i\n", beg_row+1, end_row+1, m);
}
for (row = beg_row; row<end_row; ++row) {
HYPRE_Int localRow = row-beg_row;
/* compute current node's position in grid */
k = (row / plane);
nodeRemainder = row - (k*plane); /* map row to 1st plane */
j = nodeRemainder / m;
i = nodeRemainder % m;
if (debug) {
hypre_fprintf(logFile, "row= %i x= %i y= %i z= %i\n", row+1, i,j,k);
}
/* compute column values and rhs entry for the current node */
getstencil(mg,i,j,k);
/* only homogenous Dirichlet boundary conditions presently supported */
/* down plane */
if (threeD) {
if (k > 0) {
cval[idx] = row - plane;
aval[idx++] = BACK(stencil);
}
}
/* south */
if (j > 0) {
nabory1 = cval[idx] = row - m;
aval[idx++] = SOUTH(stencil);
}
/* west */
if (i > 0) {
naborx1 = cval[idx] = row - 1;
aval[idx++] = WEST(stencil);
}
/* center node */
cval[idx] = row;
aval[idx++] = CENTER(stencil);
/* east */
if (i < m-1) {
naborx2 = cval[idx] = row + 1;
aval[idx++] = EAST(stencil);
}
/* north */
if (j < m-1) {
nabory2 = cval[idx] = row + m;
aval[idx++] = NORTH(stencil);
}
/* up plane */
if (threeD) {
if (k < m-1) {
cval[idx] = row + plane;
aval[idx++] = FRONT(stencil);
}
}
rhs[localRow] = 0.0;
++localRow;
rp[localRow] = idx;
/* apply boundary conditions; only for 2D! */
if (!threeD && applyBdry) {
HYPRE_Int offset = rp[localRow-1];
HYPRE_Int len = rp[localRow] - rp[localRow-1];
double ctr, coeff;
/* hypre_fprintf(logFile, "globalRow = %i; naborx2 = %i\n", row+1, row); */
if (i == 0) { /* if x1 */
coeff = mg->A(mg->a, i+hhalf,j,k);
ctr = mg->A(mg->a, i-hhalf,j,k);
setBoundary_private(row, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcx1, coeff, ctr, naborx2);
} else if (i == nx-1) { /* if x2 */
coeff = mg->A(mg->a, i-hhalf,j,k);
ctr = mg->A(mg->a, i+hhalf,j,k);
setBoundary_private(row, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcx2, coeff, ctr, naborx1);
} else if (j == 0) { /* if y1 */
coeff = mg->B(mg->b, i, j+hhalf,k);
ctr = mg->B(mg->b, i, j-hhalf,k);
setBoundary_private(row, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcy1, coeff, ctr, nabory2);
} else if (j == ny-1) { /* if y2 */
coeff = mg->B(mg->b, i, j-hhalf,k);
ctr = mg->B(mg->b, i, j+hhalf,k);
setBoundary_private(row, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcy2, coeff, ctr, nabory1);
}
}
}
END_FUNC_DH
}
HYPRE_Int symbolic_row_private(HYPRE_Int localRow,
HYPRE_Int *list, HYPRE_Int *marker, HYPRE_Int *tmpFill,
HYPRE_Int len, HYPRE_Int *CVAL, double *AVAL,
HYPRE_Int *o2n_col, Euclid_dh ctx, bool debug)
{
START_FUNC_DH
HYPRE_Int level = ctx->level, m = ctx->F->m;
HYPRE_Int *cval = ctx->F->cval, *diag = ctx->F->diag, *rp = ctx->F->rp;
HYPRE_Int *fill = ctx->F->fill;
HYPRE_Int count = 0;
HYPRE_Int j, node, tmp, col, head;
HYPRE_Int fill1, fill2, beg_row;
double val;
double thresh = ctx->sparseTolA;
REAL_DH scale;
scale = ctx->scale[localRow];
ctx->stats[NZA_STATS] += (double)len;
beg_row = ctx->sg->beg_row[myid_dh];
/* Insert col indices in linked list, and values in work vector.
* List[m] points to the first (smallest) col in the linked list.
* Column values are adjusted from global to local numbering.
*/
list[m] = m;
for (j=0; j<len; ++j) {
tmp = m;
col = *CVAL++;
col -= beg_row; /* adjust to zero based */
col = o2n_col[col]; /* permute the column */
val = *AVAL++;
val *= scale; /* scale the value */
if (fabs(val) > thresh || col == localRow) { /* sparsification */
++count;
while (col > list[tmp]) tmp = list[tmp];
list[col] = list[tmp];
list[tmp] = col;
tmpFill[col] = 0;
marker[col] = localRow;
}
}
/* insert diag if not already present */
if (marker[localRow] != localRow) {
tmp = m;
while (localRow > list[tmp]) tmp = list[tmp];
list[localRow] = list[tmp];
list[tmp] = localRow;
tmpFill[localRow] = 0;
marker[localRow] = localRow;
++count;
}
ctx->stats[NZA_USED_STATS] += (double)count;
/* update row from previously factored rows */
head = m;
if (level > 0) {
while (list[head] < localRow) {
node = list[head];
fill1 = tmpFill[node];
if (debug) {
hypre_fprintf(logFile, "ILU_seq sf updating from row: %i\n", 1+node);
}
if (fill1 < level) {
for (j = diag[node]+1; j<rp[node+1]; ++j) {
col = cval[j];
fill2 = fill1 + fill[j] + 1;
if (fill2 <= level) {
/* if newly discovered fill entry, mark it as discovered;
* if entry has level <= K, add it to the linked-list.
*/
if (marker[col] < localRow) {
tmp = head;
marker[col] = localRow;
tmpFill[col] = fill2;
while (col > list[tmp]) tmp = list[tmp];
list[col] = list[tmp];
list[tmp] = col;
++count; /* increment fill count */
}
/* if previously-discovered fill, update the entry's level. */
else {
tmpFill[col] = (fill2 < tmpFill[col]) ? fill2 : tmpFill[col];
}
}
}
} /* fill1 < level */
head = list[head]; /* advance to next item in linked list */
}
}
END_FUNC_VAL(count)
}
HYPRE_Int numeric_row_private(HYPRE_Int localRow,
HYPRE_Int len, HYPRE_Int *CVAL, double *AVAL,
REAL_DH *work, HYPRE_Int *o2n_col, Euclid_dh ctx, bool debug)
{
START_FUNC_DH
double pc, pv, multiplier;
HYPRE_Int j, k, col, row;
HYPRE_Int *rp = ctx->F->rp, *cval = ctx->F->cval;
HYPRE_Int *diag = ctx->F->diag;
HYPRE_Int beg_row;
double val;
REAL_DH *aval = ctx->F->aval, scale;
scale = ctx->scale[localRow];
beg_row = ctx->sg->beg_row[myid_dh];
/* zero work vector */
/* note: indices in col[] are already permuted. */
for (j=rp[localRow]; j<rp[localRow+1]; ++j) {
col = cval[j];
work[col] = 0.0;
}
/* init work vector with values from A */
/* (note: some values may be na due to sparsification; this is O.K.) */
for (j=0; j<len; ++j) {
col = *CVAL++;
col -= beg_row;
val = *AVAL++;
col = o2n_col[col]; /* note: we permute the indices from A */
work[col] = val*scale;
}
/*hypre_fprintf(stderr, "local row= %i\n", 1+localRow);
*/
for (j=rp[localRow]; j<diag[localRow]; ++j) {
row = cval[j]; /* previously factored row */
pc = work[row];
pv = aval[diag[row]]; /* diagonal of previously factored row */
/*
if (pc == 0.0 || pv == 0.0) {
hypre_fprintf(stderr, "pv= %g; pc= %g\n", pv, pc);
}
*/
if (pc != 0.0 && pv != 0.0) {
multiplier = pc / pv;
work[row] = multiplier;
if (debug) {
hypre_fprintf(logFile, "ILU_seq nf updating from row: %i; multiplier= %g\n", 1+row, multiplier);
}
for (k=diag[row]+1; k<rp[row+1]; ++k) {
col = cval[k];
work[col] -= (multiplier * aval[k]);
}
} else {
if (debug) {
hypre_fprintf(logFile, "ILU_seq nf NO UPDATE from row %i; pc = %g; pv = %g\n", 1+row, pc, pv);
}
}
}
/* check for zero or too small of a pivot */
#if 0
if (fabs(work[i]) <= pivotTol) {
/* yuck! assume row scaling, and just stick in a value */
aval[diag[i]] = pivotFix;
}
#endif
END_FUNC_VAL(0)
}
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 generateBlocked(MatGenFD mg, HYPRE_Int *rp, HYPRE_Int *cval, double *aval, Mat_dh A, Vec_dh b)
{
START_FUNC_DH
bool applyBdry = true;
double *stencil = mg->stencil;
HYPRE_Int id = mg->id;
bool threeD = mg->threeD;
HYPRE_Int px = mg->px, py = mg->py, pz = mg->pz; /* processor grid dimensions */
HYPRE_Int p, q, r; /* this proc's position in processor grid */
HYPRE_Int cc = mg->cc; /* local grid dimension (grid of unknowns) */
HYPRE_Int nx = cc, ny = cc, nz = cc;
HYPRE_Int lowerx, upperx, lowery, uppery, lowerz, upperz;
HYPRE_Int startRow;
HYPRE_Int x, y, z;
bool debug = false;
HYPRE_Int idx = 0, localRow = 0; /* nabor; */
HYPRE_Int naborx1, naborx2, nabory1, nabory2, naborz1, naborz2;
double *rhs;
double hhalf = 0.5 * mg->hh;
double bcx1 = mg->bcX1;
double bcx2 = mg->bcX2;
double bcy1 = mg->bcY1;
double bcy2 = mg->bcY2;
/* double bcz1 = mg->bcZ1; */
/* double bcz2 = mg->bcZ2; */
Vec_dhInit(b, A->m); CHECK_V_ERROR;
rhs = b->vals;
if (mg->debug && logFile != NULL) debug = true;
if (! threeD) nz = 1;
/* compute p,q,r from P,Q,R and myid */
p = id % px;
q = (( id - p)/px) % py;
r = ( id - p - px*q)/( px*py );
if (debug) {
hypre_sprintf(msgBuf_dh, "this proc's position in subdomain grid: p= %i q= %i r= %i", p,q,r);
SET_INFO(msgBuf_dh);
}
/* compute ilower and iupper from p,q,r and nx,ny,nz */
/* zero-based */
lowerx = nx*p;
upperx = lowerx + nx;
lowery = ny*q;
uppery = lowery + ny;
lowerz = nz*r;
upperz = lowerz + nz;
if (debug) {
hypre_sprintf(msgBuf_dh, "local grid parameters: lowerx= %i upperx= %i", lowerx, upperx);
SET_INFO(msgBuf_dh);
hypre_sprintf(msgBuf_dh, "local grid parameters: lowery= %i uppery= %i", lowery, uppery);
SET_INFO(msgBuf_dh);
hypre_sprintf(msgBuf_dh, "local grid parameters: lowerz= %i upperz= %i", lowerz, upperz);
SET_INFO(msgBuf_dh);
}
startRow = mg->first;
rp[0] = 0;
for (z=lowerz; z<upperz; z++) {
for (y=lowery; y<uppery; y++) {
for (x=lowerx; x<upperx; x++) {
if (debug) {
hypre_fprintf(logFile, "row= %i x= %i y= %i z= %i\n", localRow+startRow+1, x, y, z);
}
/* compute row values and rhs, at the current node */
getstencil(mg,x,y,z);
/* down plane */
if (threeD) {
if (z > 0) {
naborz1 = rownum(threeD, x,y,z-1,nx,ny,nz,px,py);
cval[idx] = naborz1;
aval[idx++] = FRONT(stencil);
}
}
/* south */
if (y > 0) {
nabory1 = rownum(threeD, x,y-1,z,nx,ny,nz,px,py);
cval[idx] = nabory1;
aval[idx++] = SOUTH(stencil);
}
/* west */
if (x > 0) {
naborx1 = rownum(threeD, x-1,y,z,nx,ny,nz,px,py);
cval[idx] = naborx1;
aval[idx++] = WEST(stencil);
/*hypre_fprintf(logFile, "--- row: %i; naborx1= %i\n", localRow+startRow+1, 1+naborx1);
*/
}
/*
else {
hypre_fprintf(logFile, "--- row: %i; x >= nx*px-1; naborx1 has old value: %i\n", localRow+startRow+1,1+naborx1);
}
*/
/* center node */
cval[idx] = localRow+startRow;
aval[idx++] = CENTER(stencil);
/* east */
if (x < nx*px-1) {
naborx2 = rownum(threeD,x+1,y,z,nx,ny,nz,px,py);
cval[idx] = naborx2;
aval[idx++] = EAST(stencil);
}
/*
else {
hypre_fprintf(logFile, "--- row: %i; x >= nx*px-1; nobors2 has old value: %i\n", localRow+startRow,1+naborx2);
}
*/
/* north */
if (y < ny*py-1) {
nabory2 = rownum(threeD,x,y+1,z,nx,ny,nz,px,py);
cval[idx] = nabory2;
aval[idx++] = NORTH(stencil);
}
/* up plane */
if (threeD) {
if (z < nz*pz-1) {
naborz2 = rownum(threeD,x,y,z+1,nx,ny,nz,px,py);
cval[idx] = naborz2;
aval[idx++] = BACK(stencil);
}
}
/* rhs[rhsIdx++] = RHS(stencil); */
rhs[localRow] = 0.0;
++localRow;
rp[localRow] = idx;
/* apply boundary conditions; only for 2D! */
if (!threeD && applyBdry) {
HYPRE_Int globalRow = localRow+startRow-1;
HYPRE_Int offset = rp[localRow-1];
HYPRE_Int len = rp[localRow] - rp[localRow-1];
double ctr, coeff;
/* hypre_fprintf(logFile, "globalRow = %i; naborx2 = %i\n", globalRow+1, naborx2+1); */
if (x == 0) { /* if x1 */
coeff = mg->A(mg->a, x+hhalf,y,z);
ctr = mg->A(mg->a, x-hhalf,y,z);
setBoundary_private(globalRow, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcx1, coeff, ctr, naborx2);
} else if (x == nx*px-1) { /* if x2 */
coeff = mg->A(mg->a, x-hhalf,y,z);
ctr = mg->A(mg->a, x+hhalf,y,z);
setBoundary_private(globalRow, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcx2, coeff, ctr, naborx1);
} else if (y == 0) { /* if y1 */
coeff = mg->B(mg->b, x, y+hhalf,z);
ctr = mg->B(mg->b, x, y-hhalf,z);
setBoundary_private(globalRow, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcy1, coeff, ctr, nabory2);
} else if (y == ny*py-1) { /* if y2 */
coeff = mg->B(mg->b, x, y-hhalf,z);
ctr = mg->B(mg->b, x, y+hhalf,z);
setBoundary_private(globalRow, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcy2, coeff, ctr, nabory1);
} else if (threeD) {
if (z == 0) {
coeff = mg->B(mg->b, x, y, z+hhalf);
ctr = mg->B(mg->b, x, y, z-hhalf);
setBoundary_private(globalRow, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcy1, coeff, ctr, naborz2);
} else if (z == nz*nx-1) {
coeff = mg->B(mg->b, x, y, z-hhalf);
ctr = mg->B(mg->b, x, y, z+hhalf);
setBoundary_private(globalRow, cval+offset, aval+offset, len,
&(rhs[localRow-1]), bcy1, coeff, ctr, naborz1);
}
}
}
}
}
}
END_FUNC_DH
}
HYPRE_Int
hypre_ParVectorPrintIJ( hypre_ParVector *vector,
HYPRE_Int base_j,
const char *filename )
{
MPI_Comm comm;
HYPRE_Int global_size;
HYPRE_Int *partitioning;
double *local_data;
HYPRE_Int myid, num_procs, i, j, part0;
char new_filename[255];
FILE *file;
if (!vector)
{
hypre_error_in_arg(1);
return hypre_error_flag;
}
comm = hypre_ParVectorComm(vector);
global_size = hypre_ParVectorGlobalSize(vector);
partitioning = hypre_ParVectorPartitioning(vector);
/* multivector code not written yet >>> */
hypre_assert( hypre_ParVectorNumVectors(vector) == 1 );
if ( hypre_ParVectorNumVectors(vector) != 1 ) hypre_error_in_arg(1);
hypre_MPI_Comm_rank(comm, &myid);
hypre_MPI_Comm_size(comm, &num_procs);
hypre_sprintf(new_filename,"%s.%05d", filename, myid);
if ((file = fopen(new_filename, "w")) == NULL)
{
hypre_printf("Error: can't open output file %s\n", new_filename);
hypre_error_in_arg(3);
return hypre_error_flag;
}
local_data = hypre_VectorData(hypre_ParVectorLocalVector(vector));
hypre_fprintf(file, "%d \n", global_size);
#ifdef HYPRE_NO_GLOBAL_PARTITION
for (i=0; i <= 2; i++)
#else
for (i=0; i <= num_procs; i++)
#endif
{
hypre_fprintf(file, "%d \n", partitioning[i] + base_j);
}
#ifdef HYPRE_NO_GLOBAL_PARTITION
part0 = partitioning[0];
for (j = part0; j < partitioning[1]; j++)
#else
part0 = partitioning[myid];
for (j = part0; j < partitioning[myid+1]; j++)
#endif
{
hypre_fprintf(file, "%d %.14e\n", j + base_j, local_data[j-part0]);
}
fclose(file);
return hypre_error_flag;
}
void mat_dh_print_graph_private(HYPRE_Int m, HYPRE_Int beg_row, HYPRE_Int *rp, HYPRE_Int *cval,
double *aval, HYPRE_Int *n2o, HYPRE_Int *o2n, Hash_i_dh hash, FILE* fp)
{
START_FUNC_DH
HYPRE_Int i, j, row, col;
bool private_n2o = false;
bool private_hash = false;
HYPRE_Int *work = NULL;
work = (HYPRE_Int*)MALLOC_DH(m*sizeof(HYPRE_Int)); CHECK_V_ERROR;
if (n2o == NULL) {
private_n2o = true;
create_nat_ordering_private(m, &n2o); CHECK_V_ERROR;
create_nat_ordering_private(m, &o2n); CHECK_V_ERROR;
}
if (hash == NULL) {
private_hash = true;
Hash_i_dhCreate(&hash, -1); CHECK_V_ERROR;
}
for (i=0; i<m; ++i) {
for (j=0; j<m; ++j) work[j] = 0;
row = n2o[i];
for (j=rp[row]; j<rp[row+1]; ++j) {
col = cval[j];
/* local column */
if (col >= beg_row || col < beg_row+m) {
col = o2n[col];
}
/* nonlocal column: get permutation from hash table */
else {
HYPRE_Int tmp = col;
tmp = Hash_i_dhLookup(hash, col); CHECK_V_ERROR;
if (tmp == -1) {
hypre_sprintf(msgBuf_dh, "beg_row= %i m= %i; nonlocal column= %i not in hash table",
beg_row, m, col);
SET_V_ERROR(msgBuf_dh);
} else {
col = tmp;
}
}
work[col] = 1;
}
for (j=0; j<m; ++j) {
if (work[j]) {
hypre_fprintf(fp, " x ");
} else {
hypre_fprintf(fp, " ");
}
}
hypre_fprintf(fp, "\n");
}
if (private_n2o) {
destroy_nat_ordering_private(n2o); CHECK_V_ERROR;
destroy_nat_ordering_private(o2n); CHECK_V_ERROR;
}
if (private_hash) {
Hash_i_dhDestroy(hash); CHECK_V_ERROR;
}
if (work != NULL) { FREE_DH(work); CHECK_V_ERROR; }
END_FUNC_DH
}
HYPRE_Int hypre_ParCSRBooleanMatrixPrintIJ( hypre_ParCSRBooleanMatrix *matrix,
const char *filename )
{
MPI_Comm comm = hypre_ParCSRBooleanMatrix_Get_Comm(matrix);
HYPRE_Int global_num_rows = hypre_ParCSRBooleanMatrix_Get_GlobalNRows(matrix);
HYPRE_Int global_num_cols = hypre_ParCSRBooleanMatrix_Get_GlobalNCols(matrix);
HYPRE_Int first_row_index = hypre_ParCSRBooleanMatrix_Get_StartRow(matrix);
HYPRE_Int first_col_diag = hypre_ParCSRBooleanMatrix_Get_FirstColDiag(matrix);
HYPRE_Int *col_map_offd = hypre_ParCSRBooleanMatrix_Get_ColMapOffd(matrix);
HYPRE_Int num_rows = hypre_ParCSRBooleanMatrix_Get_NRows(matrix);
HYPRE_Int *diag_i;
HYPRE_Int *diag_j;
HYPRE_Int *offd_i;
HYPRE_Int *offd_j;
HYPRE_Int myid, i, j, I, J;
HYPRE_Int ierr = 0;
char new_filename[255];
FILE *file;
hypre_CSRBooleanMatrix *diag = hypre_ParCSRBooleanMatrix_Get_Diag(matrix);
hypre_CSRBooleanMatrix *offd = hypre_ParCSRBooleanMatrix_Get_Offd(matrix);
HYPRE_Int num_cols_offd = 0;
if (offd) num_cols_offd =
hypre_CSRBooleanMatrix_Get_NCols(hypre_ParCSRBooleanMatrix_Get_Offd(matrix));
hypre_MPI_Comm_rank(comm, &myid);
hypre_sprintf(new_filename,"%s.%05d", filename, myid);
if ((file = fopen(new_filename, "w")) == NULL)
{
hypre_printf("Error: can't open output file %s\n", new_filename);
exit(1);
}
hypre_fprintf(file, "%d, %d\n", global_num_rows, global_num_cols);
hypre_fprintf(file, "%d\n", num_rows);
diag_i = hypre_CSRBooleanMatrix_Get_I(diag);
diag_j = hypre_CSRBooleanMatrix_Get_J(diag);
if (num_cols_offd)
{
offd_i = hypre_CSRBooleanMatrix_Get_I(offd);
offd_j = hypre_CSRBooleanMatrix_Get_J(offd);
}
for (i = 0; i < num_rows; i++)
{
I = first_row_index + i;
/* print diag columns */
for (j = diag_i[i]; j < diag_i[i+1]; j++)
{
J = first_col_diag + diag_j[j];
hypre_fprintf(file, "%d, %d\n", I, J );
}
/* print offd columns */
if (num_cols_offd)
{
for (j = offd_i[i]; j < offd_i[i+1]; j++)
{
J = col_map_offd[offd_j[j]];
hypre_fprintf(file, "%d, %d \n", I, J);
}
}
}
fclose(file);
return ierr;
}
HYPRE_Int
HYPRE_IJMatrixPrint( HYPRE_IJMatrix matrix,
const char *filename )
{
MPI_Comm comm;
HYPRE_Int *row_partitioning;
HYPRE_Int *col_partitioning;
HYPRE_Int ilower, iupper, jlower, jupper;
HYPRE_Int i, j, ii;
HYPRE_Int ncols, *cols;
HYPRE_Complex *values;
HYPRE_Int myid;
char new_filename[255];
FILE *file;
void *object;
if (!matrix)
{
hypre_error_in_arg(1);
return hypre_error_flag;
}
if ( (hypre_IJMatrixObjectType(matrix) != HYPRE_PARCSR) )
{
hypre_error_in_arg(1);
return hypre_error_flag;
}
comm = hypre_IJMatrixComm(matrix);
hypre_MPI_Comm_rank(comm, &myid);
hypre_sprintf(new_filename,"%s.%05d", filename, myid);
if ((file = fopen(new_filename, "w")) == NULL)
{
hypre_error_in_arg(2);
return hypre_error_flag;
}
row_partitioning = hypre_IJMatrixRowPartitioning(matrix);
col_partitioning = hypre_IJMatrixColPartitioning(matrix);
#ifdef HYPRE_NO_GLOBAL_PARTITION
ilower = row_partitioning[0];
iupper = row_partitioning[1] - 1;
jlower = col_partitioning[0];
jupper = col_partitioning[1] - 1;
#else
ilower = row_partitioning[myid];
iupper = row_partitioning[myid+1] - 1;
jlower = col_partitioning[myid];
jupper = col_partitioning[myid+1] - 1;
#endif
hypre_fprintf(file, "%d %d %d %d\n", ilower, iupper, jlower, jupper);
HYPRE_IJMatrixGetObject(matrix, &object);
for (i = ilower; i <= iupper; i++)
{
if ( hypre_IJMatrixObjectType(matrix) == HYPRE_PARCSR )
{
#ifdef HYPRE_NO_GLOBAL_PARTITION
ii = i - hypre_IJMatrixGlobalFirstRow(matrix);
#else
ii = i - row_partitioning[0];
#endif
HYPRE_ParCSRMatrixGetRow((HYPRE_ParCSRMatrix) object,
ii, &ncols, &cols, &values);
for (j = 0; j < ncols; j++)
{
#ifdef HYPRE_NO_GLOBAL_PARTITION
cols[j] += hypre_IJMatrixGlobalFirstCol(matrix);
#else
cols[j] += col_partitioning[0];
#endif
}
}
for (j = 0; j < ncols; j++)
{
hypre_fprintf(file, "%d %d %.14e\n", i, cols[j], values[j]);
}
if ( hypre_IJMatrixObjectType(matrix) == HYPRE_PARCSR )
{
for (j = 0; j < ncols; j++)
{
#ifdef HYPRE_NO_GLOBAL_PARTITION
cols[j] -= hypre_IJMatrixGlobalFirstCol(matrix);
#else
cols[j] -= col_partitioning[0];
#endif
}
HYPRE_ParCSRMatrixRestoreRow((HYPRE_ParCSRMatrix) object,
ii, &ncols, &cols, &values);
}
}
fclose(file);
return hypre_error_flag;
}
