PetscErrorCode BSSCR_PCGtKGAttachNullSpace( PC pc )
{
PC_GtKG ctx = (PC_GtKG)pc->data;
MatNullSpace nsp;
BSSCR_pc_error( pc, "__func__" );
/* Attach a null space */
MatNullSpaceCreate( PETSC_COMM_WORLD, PETSC_TRUE, PETSC_NULL, PETSC_NULL, &nsp );
#if ( (PETSC_VERSION_MAJOR >= 3) && (PETSC_VERSION_MINOR <6) )
KSPSetNullSpace( ctx->ksp, nsp );
#else
Mat A;
KSPGetOperators(ctx->ksp,&A,NULL);//Note: DOES NOT increase the reference counts of the matrix, so you should NOT destroy them.
MatSetNullSpace( A, nsp);
#endif
/*
NOTE: This does NOT destroy the memory for nsp, it just decrements the nsp->refct, so that
the next time MatNullSpaceDestroy() is called, the memory will be released. The next time this
is called will be by KSPDestroy();
*/
MatNullSpaceDestroy( nsp );
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_GCR(KSP ksp)
{
KSP_GCR *ctx = (KSP_GCR*)ksp->data;
PetscErrorCode ierr;
Mat A, B;
Vec r,b,x;
PetscReal norm_r;
PetscFunctionBegin;
ierr = KSPGetOperators(ksp, &A, &B);CHKERRQ(ierr);
x = ksp->vec_sol;
b = ksp->vec_rhs;
r = ctx->R;
/* compute initial residual */
ierr = KSP_MatMult(ksp,A, x, r);CHKERRQ(ierr);
ierr = VecAYPX(r, -1.0, b);CHKERRQ(ierr); /* r = b - A x */
ierr = VecNorm(r, NORM_2, &norm_r);CHKERRQ(ierr);
KSPCheckNorm(ksp,norm_r);
ksp->its = 0;
ksp->rnorm0 = norm_r;
ierr = KSPLogResidualHistory(ksp,ksp->rnorm0);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,ksp->its,ksp->rnorm0);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its,ksp->rnorm0,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
do {
ierr = KSPSolve_GCR_cycle(ksp);CHKERRQ(ierr);
if (ksp->reason) break; /* catch case when convergence occurs inside the cycle */
} while (ksp->its < ksp->max_it);CHKERRQ(ierr);
if (ksp->its >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSetUp_TSIRM(KSP ksp)
{
PetscErrorCode ierr;
KSP_TSIRM *tsirm = (KSP_TSIRM*)ksp->data;
PetscFunctionBegin;
/* Initialization */
tsirm->tol_ls = 1e-40;
tsirm->size_ls = 12;
tsirm->maxiter_ls = 15;
tsirm->cgls = 0;
/* Matrix of the system */
ierr = KSPGetOperators(ksp,&tsirm->A,NULL);
CHKERRQ(ierr); /* Matrix of the system */
ierr = MatGetSize(tsirm->A,&tsirm->size,NULL);
CHKERRQ(ierr); /* Size of the system */
ierr = MatGetOwnershipRange(tsirm->A,&tsirm->Istart,&tsirm->Iend);
CHKERRQ(ierr);
/* Matrix S of residuals */
ierr = MatCreate(PETSC_COMM_WORLD,&tsirm->S);
CHKERRQ(ierr);
ierr = MatSetSizes(tsirm->S,tsirm->Iend-tsirm->Istart,PETSC_DECIDE,tsirm->size,tsirm->size_ls);
CHKERRQ(ierr);
ierr = MatSetType(tsirm->S,MATDENSE);
CHKERRQ(ierr);
ierr = MatSetUp(tsirm->S);
CHKERRQ(ierr);
/* Residual and vector Alpha computed in the minimization step */
ierr = MatCreateVecs(tsirm->S,&tsirm->Alpha,&tsirm->r);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_KSP(PC pc)
{
PetscErrorCode ierr;
PC_KSP *jac = (PC_KSP*)pc->data;
Mat mat;
PetscBool A;
PetscFunctionBegin;
if (!jac->ksp) {ierr = PCKSPCreateKSP_KSP(pc);CHKERRQ(ierr);}
ierr = KSPSetFromOptions(jac->ksp);CHKERRQ(ierr);
if (jac->use_true_matrix) mat = pc->mat;
else mat = pc->pmat;
ierr = KSPGetOperatorsSet(jac->ksp,&A,PETSC_NULL);CHKERRQ(ierr);
if (!A) {
ierr = KSPSetOperators(jac->ksp,mat,pc->pmat,pc->flag);CHKERRQ(ierr);
} else if (pc->flag != SAME_PRECONDITIONER) {
Mat Amat,Bmat;
ierr = KSPGetOperators(jac->ksp,&Amat,&Bmat,PETSC_NULL);CHKERRQ(ierr);
if (Amat == mat && Bmat == pc->pmat) {
/* The user has not replaced the matrices so we are expected to forward the update. This incorrectly diagnoses
* changed matrices at the top level as the user manually changing the inner matrices, but we have no way to
* identify that in this context. The longer term solution is to track matrix state internally.
*/
ierr = KSPSetOperators(jac->ksp,mat,pc->pmat,pc->flag);CHKERRQ(ierr);
}
}
ierr = KSPSetUp(jac->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCApply_MG(PC pc,Vec b,Vec x)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
PetscInt levels = mglevels[0]->levels,i;
PetscFunctionBegin;
if (mg->stageApply) {ierr = PetscLogStagePush(mg->stageApply);CHKERRQ(ierr);}
/* When the DM is supplying the matrix then it will not exist until here */
for (i=0; i<levels; i++) {
if (!mglevels[i]->A) {
ierr = KSPGetOperators(mglevels[i]->smoothu,&mglevels[i]->A,NULL);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)mglevels[i]->A);CHKERRQ(ierr);
}
}
mglevels[levels-1]->b = b;
mglevels[levels-1]->x = x;
if (mg->am == PC_MG_MULTIPLICATIVE) {
ierr = VecSet(x,0.0);CHKERRQ(ierr);
for (i=0; i<mg->cyclesperpcapply; i++) {
ierr = PCMGMCycle_Private(pc,mglevels+levels-1,NULL);CHKERRQ(ierr);
}
} else if (mg->am == PC_MG_ADDITIVE) {
ierr = PCMGACycle_Private(pc,mglevels);CHKERRQ(ierr);
} else if (mg->am == PC_MG_KASKADE) {
ierr = PCMGKCycle_Private(pc,mglevels);CHKERRQ(ierr);
} else {
ierr = PCMGFCycle_Private(pc,mglevels);CHKERRQ(ierr);
}
if (mg->stageApply) {ierr = PetscLogStagePop();CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_CGLS(KSP ksp)
{
PetscErrorCode ierr;
KSP_CGLS *cgls = (KSP_CGLS*)ksp->data;
Mat A;
Vec x,b,r,p,q,ss;
PetscScalar beta;
PetscReal alpha,gamma,oldgamma;
PetscInt maxiter_ls = 15;
PetscFunctionBegin;
ierr = KSPGetOperators(ksp,&A,NULL);CHKERRQ(ierr); /* Matrix of the system */
/* vectors of length n, where system size is mxn */
x = ksp->vec_sol; /* Solution vector */
p = cgls->vwork_n[0];
ss = cgls->vwork_n[1];
/* vectors of length m, where system size is mxn */
b = ksp->vec_rhs; /* Right-hand side vector */
r = cgls->vwork_m[0];
q = cgls->vwork_m[1];
/* Minimization with the CGLS method */
ksp->its = 0;
ierr = MatMult(A,x,r);CHKERRQ(ierr);
ierr = VecAYPX(r,-1,b);CHKERRQ(ierr); /* r_0 = b - A * x_0 */
ierr = MatMultTranspose(A,r,p);CHKERRQ(ierr); /* p_0 = A^T * r_0 */
ierr = VecCopy(p,ss);CHKERRQ(ierr); /* s_0 = p_0 */
ierr = VecNorm(ss,NORM_2,&gamma);CHKERRQ(ierr);
KSPCheckNorm(ksp,gamma);
ksp->rnorm = gamma;
ierr = (*ksp->converged)(ksp,ksp->its,ksp->rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
gamma = gamma*gamma; /* gamma = norm2(s)^2 */
do {
ierr = MatMult(A,p,q);CHKERRQ(ierr); /* q = A * p */
ierr = VecNorm(q,NORM_2,&alpha);CHKERRQ(ierr);
KSPCheckNorm(ksp,alpha);
alpha = alpha*alpha; /* alpha = norm2(q)^2 */
alpha = gamma / alpha; /* alpha = gamma / alpha */
ierr = VecAXPY(x,alpha,p);CHKERRQ(ierr); /* x += alpha * p */
ierr = VecAXPY(r,-alpha,q);CHKERRQ(ierr); /* r -= alpha * q */
ierr = MatMultTranspose(A,r,ss);CHKERRQ(ierr); /* ss = A^T * r */
oldgamma = gamma; /* oldgamma = gamma */
ierr = VecNorm(ss,NORM_2,&gamma);CHKERRQ(ierr);
KSPCheckNorm(ksp,gamma);
ksp->its++;
ksp->rnorm = gamma;
ierr = KSPMonitor(ksp,ksp->its,ksp->rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its,ksp->rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
gamma = gamma*gamma; /* gamma = norm2(s)^2 */
beta = gamma/oldgamma; /* beta = gamma / oldgamma */
ierr = VecAYPX(p,beta,ss);CHKERRQ(ierr); /* p = s + beta * p */
} while (ksp->its<ksp->max_it && !ksp->reason);
if (ksp->its>=maxiter_ls && !ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
/*
KSPFischerGuessReset - This is called whenever KSPSetOperators() is called to tell the
initial guess object that the matrix is changed and so the initial guess object
must restart from scratch building the subspace where the guess is computed from.
*/
PetscErrorCode KSPFischerGuessReset(KSPFischerGuess itg)
{
PetscErrorCode ierr;
PetscFunctionBegin;
itg->curl = 0;
ierr = KSPGetOperators(itg->ksp,&itg->mat,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
KSP ksp;
PetscReal norm;
DM da;
Vec x,b,r;
Mat A;
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);
CHKERRQ(ierr);
ierr = DMDACreate3d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,-7,-7,-7,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,0,0,0,&da);
CHKERRQ(ierr);
ierr = DMSetInitialGuess(da,ComputeInitialGuess);
CHKERRQ(ierr);
ierr = KSPSetComputeRHS(ksp,ComputeRHS,PETSC_NULL);
CHKERRQ(ierr);
ierr = KSPSetComputeOperators(ksp,ComputeMatrix,PETSC_NULL);
CHKERRQ(ierr);
ierr = KSPSetDM(ksp,da);
CHKERRQ(ierr);
ierr = DMDestroy(&da);
CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);
CHKERRQ(ierr);
ierr = KSPSolve(ksp,PETSC_NULL,PETSC_NULL);
CHKERRQ(ierr);
ierr = KSPGetSolution(ksp,&x);
CHKERRQ(ierr);
ierr = KSPGetRhs(ksp,&b);
CHKERRQ(ierr);
ierr = VecDuplicate(b,&r);
CHKERRQ(ierr);
ierr = KSPGetOperators(ksp,&A,PETSC_NULL,PETSC_NULL);
CHKERRQ(ierr);
ierr = MatMult(A,x,r);
CHKERRQ(ierr);
ierr = VecAXPY(r,-1.0,b);
CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&norm);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Residual norm %G\n",norm);
CHKERRQ(ierr);
ierr = VecDestroy(&r);
CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);
CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
static PetscErrorCode PCApplyRichardson_MG(PC pc,Vec b,Vec x,Vec w,PetscReal rtol,PetscReal abstol, PetscReal dtol,PetscInt its,PetscBool zeroguess,PetscInt *outits,PCRichardsonConvergedReason *reason)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
PetscInt levels = mglevels[0]->levels,i;
PetscFunctionBegin;
/* When the DM is supplying the matrix then it will not exist until here */
for (i=0; i<levels; i++) {
if (!mglevels[i]->A) {
ierr = KSPGetOperators(mglevels[i]->smoothu,&mglevels[i]->A,NULL);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)mglevels[i]->A);CHKERRQ(ierr);
}
}
mglevels[levels-1]->b = b;
mglevels[levels-1]->x = x;
mg->rtol = rtol;
mg->abstol = abstol;
mg->dtol = dtol;
if (rtol) {
/* compute initial residual norm for relative convergence test */
PetscReal rnorm;
if (zeroguess) {
ierr = VecNorm(b,NORM_2,&rnorm);CHKERRQ(ierr);
} else {
ierr = (*mglevels[levels-1]->residual)(mglevels[levels-1]->A,b,x,w);CHKERRQ(ierr);
ierr = VecNorm(w,NORM_2,&rnorm);CHKERRQ(ierr);
}
mg->ttol = PetscMax(rtol*rnorm,abstol);
} else if (abstol) mg->ttol = abstol;
else mg->ttol = 0.0;
/* since smoother is applied to full system, not just residual we need to make sure that smoothers don't
stop prematurely due to small residual */
for (i=1; i<levels; i++) {
ierr = KSPSetTolerances(mglevels[i]->smoothu,0,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
if (mglevels[i]->smoothu != mglevels[i]->smoothd) {
ierr = KSPSetTolerances(mglevels[i]->smoothd,0,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
}
}
*reason = (PCRichardsonConvergedReason)0;
for (i=0; i<its; i++) {
ierr = PCMGMCycle_Private(pc,mglevels+levels-1,reason);CHKERRQ(ierr);
if (*reason) break;
}
if (!*reason) *reason = PCRICHARDSON_CONVERGED_ITS;
*outits = i;
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
KSP ksp; /* linear solver context */
Mat A; /* linear system matrix */
Vec x,b; /* approx solution, RHS */
PetscInt Ii,Istart,Iend;
PetscErrorCode ierr;
PetscScalar v[3] = {-1./2., 1., -1./2.};
PetscInt j[3];
PetscInt k=15;
PetscInt M,m=420;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsGetInt(NULL,NULL,"-k",&k,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPGetOperators(ksp,&A,NULL);CHKERRQ(ierr);
ierr = MatSetSizes(A,m,m,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
ierr = MatGetSize(A,&M,NULL);CHKERRQ(ierr);
for (Ii=Istart; Ii<Iend; Ii++) {
j[0] = Ii - k;
j[1] = Ii;
j[2] = (Ii + k) < M ? (Ii + k) : -1;
ierr = MatSetValues(A,1,&Ii,3,j,v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&x,&b);CHKERRQ(ierr);
ierr = VecSetFromOptions(b);CHKERRQ(ierr);
ierr = VecSet(b,1.0);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecSet(x,2.0);CHKERRQ(ierr);
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/*@C
KSPFischerGuessCreate - Implements Paul Fischer's initial guess algorithm Method 1 and 2 for situations where
a linear system is solved repeatedly
References:
http://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/19940020363_1994020363.pdf
Notes: the algorithm is different from the paper because we do not CHANGE the right hand side of the new
problem and solve the problem with an initial guess of zero, rather we solve the original new problem
with a nonzero initial guess (this is done so that the linear solver convergence tests are based on
the original RHS.) But we use the xtilde = x - xguess as the new direction so that it is not
mostly orthogonal to the previous solutions.
These are not intended to be used directly, they are called by KSP automatically when the
KSP option KSPSetFischerGuess(KSP,PetscInt,PetscInt) or -ksp_guess_fischer <int,int>
Method 2 is only for positive definite matrices, since it uses the A norm.
This is not currently programmed as a PETSc class because there are only two methods; if more methods
are introduced it should be changed. For example the Knoll guess should be included
Level: advanced
@*/
PetscErrorCode KSPFischerGuessCreate(KSP ksp,PetscInt method,PetscInt maxl,KSPFischerGuess *itg)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (method == 1) {
ierr = KSPFischerGuessCreate_Method1(ksp,maxl,(KSPFischerGuess_Method1 **)itg);CHKERRQ(ierr);
} else if (method == 2) {
ierr = KSPFischerGuessCreate_Method2(ksp,maxl,(KSPFischerGuess_Method2 **)itg);CHKERRQ(ierr);
} else SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Method can only be 1 or 2");
(*itg)->method = method;
(*itg)->curl = 0;
(*itg)->maxl = maxl;
(*itg)->ksp = ksp;
(*itg)->refcnt = 1;
ierr = KSPGetOperators(ksp,&(*itg)->mat,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSetUp_GCR( KSP ksp )
{
KSP_GCR *ctx = (KSP_GCR*)ksp->data;
PetscErrorCode ierr;
Mat A;
PetscBool diagonalscale;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
ierr = KSPGetOperators( ksp, &A, 0, 0 );CHKERRQ(ierr);
ierr = MatGetVecs( A, &ctx->R, PETSC_NULL );CHKERRQ(ierr);
ierr = VecDuplicateVecs( ctx->R, ctx->restart, &ctx->VV );CHKERRQ(ierr);
ierr = VecDuplicateVecs( ctx->R, ctx->restart, &ctx->SS );CHKERRQ(ierr);
ierr = PetscMalloc( sizeof(PetscScalar)*ctx->restart, &ctx->val );CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
KSP ksp;
DM da;
AppCtx user;
Mat A;
Vec b,b2;
Vec x;
PetscReal nrm;
PetscInitialize(&argc,&argv,(char*)0,help);
user.k = 1;
user.e = .99;
ierr = PetscOptionsGetInt(0,"-k",&user.k,0);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(0,"-e",&user.e,0);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,-3,1,1,0,&da);CHKERRQ(ierr);
ierr = KSPSetDM(ksp,da);CHKERRQ(ierr);
ierr = KSPSetComputeRHS(ksp,ComputeRHS,&user);CHKERRQ(ierr);
ierr = KSPSetComputeOperators(ksp,ComputeMatrix,&user);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp,NULL,NULL);CHKERRQ(ierr);
ierr = KSPGetOperators(ksp,&A,NULL);CHKERRQ(ierr);
ierr = KSPGetSolution(ksp,&x);CHKERRQ(ierr);
ierr = KSPGetRhs(ksp,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&b2);CHKERRQ(ierr);
ierr = MatMult(A,x,b2);CHKERRQ(ierr);
ierr = VecAXPY(b2,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(b2,NORM_MAX,&nrm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Residual norm %g\n",(double)nrm);CHKERRQ(ierr);
ierr = VecDestroy(&b2);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode KSPSolve_GCR_cycle( KSP ksp )
{
KSP_GCR *ctx = (KSP_GCR*)ksp->data;
PetscErrorCode ierr;
PetscScalar r_dot_v;
Mat A, B;
PC pc;
Vec s,v,r;
PetscReal norm_r,nrm;
PetscInt k, i, restart;
Vec x;
PetscReal res;
PetscFunctionBegin;
restart = ctx->restart;
ierr = KSPGetPC( ksp, &pc );CHKERRQ(ierr);
ierr = KSPGetOperators( ksp, &A, &B, 0 );CHKERRQ(ierr);
x = ksp->vec_sol;
r = ctx->R;
for ( k=0; k<restart; k++ ) {
v = ctx->VV[k];
s = ctx->SS[k];
if (ctx->modifypc) {
ierr = (*ctx->modifypc)(ksp,ksp->its,ksp->rnorm,ctx->modifypc_ctx);CHKERRQ(ierr);
}
ierr = PCApply( pc, r, s );CHKERRQ(ierr); /* s = B^{-1} r */
ierr = MatMult( A, s, v );CHKERRQ(ierr); /* v = A s */
ierr = VecMDot( v,k, ctx->VV, ctx->val );CHKERRQ(ierr);
for (i=0; i<k; i++) ctx->val[i] = -ctx->val[i];
ierr = VecMAXPY(v,k,ctx->val,ctx->VV);CHKERRQ(ierr); /* v = v - sum_{i=0}^{k-1} alpha_i v_i */
ierr = VecMAXPY(s,k,ctx->val,ctx->SS);CHKERRQ(ierr); /* s = s - sum_{i=0}^{k-1} alpha_i s_i */
ierr = VecDotNorm2(r,v,&r_dot_v,&nrm);CHKERRQ(ierr);
nrm = PetscSqrtReal(nrm);
r_dot_v = r_dot_v/nrm;
ierr = VecScale( v, 1.0/nrm );CHKERRQ(ierr);
ierr = VecScale( s, 1.0/nrm );CHKERRQ(ierr);
ierr = VecAXPY( x, r_dot_v, s );CHKERRQ(ierr);
ierr = VecAXPY( r, -r_dot_v, v );CHKERRQ(ierr);
if (ksp->its > ksp->chknorm ) {
ierr = VecNorm( r, NORM_2, &norm_r );CHKERRQ(ierr);
}
/* update the local counter and the global counter */
ksp->its++;
res = norm_r;
ksp->rnorm = res;
KSPLogResidualHistory(ksp,res);
ierr = KSPMonitor(ksp,ksp->its,res);CHKERRQ(ierr);
if ( ksp->its > ksp->chknorm ) {
ierr = (*ksp->converged)(ksp,ksp->its,res,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
}
if ( ksp->its >= ksp->max_it ) {
ksp->reason = KSP_CONVERGED_ITS;
break;
}
}
ctx->n_restarts++;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
KSP ksp;
DM da;
PetscReal norm;
PetscErrorCode ierr;
PetscInt i,j,k,mx,my,mz,xm,ym,zm,xs,ys,zs;
PetscScalar Hx,Hy,Hz;
PetscScalar ***array;
Vec x,b,r;
Mat J;
PetscInitialize(&argc,&argv,(char*)0,help);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,-12,-12,-12,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,0,0,0,&da);CHKERRQ(ierr);
ierr = DMDASetInterpolationType(da, DMDA_Q0);CHKERRQ(ierr);
ierr = KSPSetDM(ksp,da);CHKERRQ(ierr);
ierr = KSPSetComputeRHS(ksp,ComputeRHS,NULL);CHKERRQ(ierr);
ierr = KSPSetComputeOperators(ksp,ComputeMatrix,NULL);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp,NULL,NULL);CHKERRQ(ierr);
ierr = KSPGetSolution(ksp,&x);CHKERRQ(ierr);
ierr = KSPGetRhs(ksp,&b);CHKERRQ(ierr);
ierr = KSPGetOperators(ksp,NULL,&J);CHKERRQ(ierr);
ierr = VecDuplicate(b,&r);CHKERRQ(ierr);
ierr = MatMult(J,x,r);CHKERRQ(ierr);
ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Residual norm %g\n",(double)norm);CHKERRQ(ierr);
ierr = DMDAGetInfo(da, 0, &mx, &my, &mz, 0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
Hx = 1.0 / (PetscReal)(mx);
Hy = 1.0 / (PetscReal)(my);
Hz = 1.0 / (PetscReal)(mz);
ierr = DMDAGetCorners(da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, x, &array);CHKERRQ(ierr);
for (k=zs; k<zs+zm; k++) {
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
array[k][j][i] -=
PetscCosScalar(2*PETSC_PI*(((PetscReal)i+0.5)*Hx))*
PetscCosScalar(2*PETSC_PI*(((PetscReal)j+0.5)*Hy))*
PetscCosScalar(2*PETSC_PI*(((PetscReal)k+0.5)*Hz));
}
}
}
ierr = DMDAVecRestoreArray(da, x, &array);CHKERRQ(ierr);
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Error norm %g\n",(double)norm);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_1,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Error norm %g\n",(double)(norm/((PetscReal)(mx)*(PetscReal)(my)*(PetscReal)(mz))));CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Error norm %g\n",(double)(norm/((PetscReal)(mx)*(PetscReal)(my)*(PetscReal)(mz))));CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
static PetscErrorCode PCBDDCScalingExtension_Deluxe(PC pc, Vec x, Vec y)
{
PC_IS* pcis=(PC_IS*)pc->data;
PC_BDDC* pcbddc=(PC_BDDC*)pc->data;
PCBDDCDeluxeScaling deluxe_ctx = pcbddc->deluxe_ctx;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecSet(pcbddc->work_scaling,0.0);CHKERRQ(ierr);
ierr = VecSet(y,0.0);CHKERRQ(ierr);
if (deluxe_ctx->n_simple) { /* scale deluxe vertices using diagonal scaling */
PetscInt i;
const PetscScalar *array_x,*array_D;
PetscScalar *array;
ierr = VecGetArrayRead(x,&array_x);CHKERRQ(ierr);
ierr = VecGetArrayRead(pcis->D,&array_D);CHKERRQ(ierr);
ierr = VecGetArray(pcbddc->work_scaling,&array);CHKERRQ(ierr);
for (i=0;i<deluxe_ctx->n_simple;i++) {
array[deluxe_ctx->idx_simple_B[i]] = array_x[deluxe_ctx->idx_simple_B[i]]*array_D[deluxe_ctx->idx_simple_B[i]];
}
ierr = VecRestoreArray(pcbddc->work_scaling,&array);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(pcis->D,&array_D);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(x,&array_x);CHKERRQ(ierr);
}
/* sequential part : all problems and Schur applications collapsed into a single matrix vector multiplication or a matvec and a solve */
if (deluxe_ctx->seq_mat) {
PetscInt i;
for (i=0;i<deluxe_ctx->seq_n;i++) {
if (deluxe_ctx->change) {
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work2[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work2[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (deluxe_ctx->change_with_qr) {
Mat change;
ierr = KSPGetOperators(deluxe_ctx->change[i],&change,NULL);CHKERRQ(ierr);
ierr = MatMultTranspose(change,deluxe_ctx->seq_work2[i],deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
} else {
ierr = KSPSolve(deluxe_ctx->change[i],deluxe_ctx->seq_work2[i],deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
}
} else {
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work1[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work1[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
ierr = MatMultTranspose(deluxe_ctx->seq_mat[i],deluxe_ctx->seq_work1[i],deluxe_ctx->seq_work2[i]);CHKERRQ(ierr);
if (deluxe_ctx->seq_mat_inv_sum[i]) {
PetscScalar *x;
ierr = VecGetArray(deluxe_ctx->seq_work2[i],&x);CHKERRQ(ierr);
ierr = VecPlaceArray(deluxe_ctx->seq_work1[i],x);CHKERRQ(ierr);
ierr = VecRestoreArray(deluxe_ctx->seq_work2[i],&x);CHKERRQ(ierr);
ierr = MatSolveTranspose(deluxe_ctx->seq_mat_inv_sum[i],deluxe_ctx->seq_work1[i],deluxe_ctx->seq_work2[i]);CHKERRQ(ierr);
ierr = VecResetArray(deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
}
if (deluxe_ctx->change) {
Mat change;
ierr = KSPGetOperators(deluxe_ctx->change[i],&change,NULL);CHKERRQ(ierr);
ierr = MatMult(change,deluxe_ctx->seq_work2[i],deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work1[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work1[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
} else {
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work2[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work2[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
}
}
/* put local boundary part in global vector */
ierr = VecScatterBegin(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCBDDCScalingSetUp_Deluxe_Private(PC pc)
{
PC_BDDC *pcbddc=(PC_BDDC*)pc->data;
PCBDDCDeluxeScaling deluxe_ctx=pcbddc->deluxe_ctx;
PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
PetscScalar *matdata,*matdata2;
PetscInt i,max_subset_size,cum,cum2;
const PetscInt *idxs;
PetscBool newsetup = PETSC_FALSE;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!sub_schurs) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Missing PCBDDCSubSchurs");
if (!sub_schurs->n_subs) PetscFunctionReturn(0);
/* Allocate arrays for subproblems */
if (!deluxe_ctx->seq_n) {
deluxe_ctx->seq_n = sub_schurs->n_subs;
ierr = PetscCalloc5(deluxe_ctx->seq_n,&deluxe_ctx->seq_scctx,deluxe_ctx->seq_n,&deluxe_ctx->seq_work1,deluxe_ctx->seq_n,&deluxe_ctx->seq_work2,deluxe_ctx->seq_n,&deluxe_ctx->seq_mat,deluxe_ctx->seq_n,&deluxe_ctx->seq_mat_inv_sum);CHKERRQ(ierr);
newsetup = PETSC_TRUE;
} else if (deluxe_ctx->seq_n != sub_schurs->n_subs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Number of deluxe subproblems %D is different from the sub_schurs %D",deluxe_ctx->seq_n,sub_schurs->n_subs);
/* the change of basis is just a reference to sub_schurs->change (if any) */
deluxe_ctx->change = sub_schurs->change;
deluxe_ctx->change_with_qr = sub_schurs->change_with_qr;
/* Create objects for deluxe */
max_subset_size = 0;
for (i=0;i<sub_schurs->n_subs;i++) {
PetscInt subset_size;
ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
max_subset_size = PetscMax(subset_size,max_subset_size);
}
if (newsetup) {
ierr = PetscMalloc1(2*max_subset_size,&deluxe_ctx->workspace);CHKERRQ(ierr);
}
cum = cum2 = 0;
ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(sub_schurs->S_Ej_all,&matdata);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_all,&matdata2);CHKERRQ(ierr);
for (i=0;i<deluxe_ctx->seq_n;i++) {
PetscInt subset_size;
ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
if (newsetup) {
IS sub;
/* work vectors */
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,subset_size,deluxe_ctx->workspace,&deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,subset_size,deluxe_ctx->workspace+subset_size,&deluxe_ctx->seq_work2[i]);CHKERRQ(ierr);
/* scatters */
ierr = ISCreateGeneral(PETSC_COMM_SELF,subset_size,idxs+cum,PETSC_COPY_VALUES,&sub);CHKERRQ(ierr);
ierr = VecScatterCreate(pcbddc->work_scaling,sub,deluxe_ctx->seq_work1[i],NULL,&deluxe_ctx->seq_scctx[i]);CHKERRQ(ierr);
ierr = ISDestroy(&sub);CHKERRQ(ierr);
}
/* S_E_j */
ierr = MatDestroy(&deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,matdata+cum2,&deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
/* \sum_k S^k_E_j */
ierr = MatDestroy(&deluxe_ctx->seq_mat_inv_sum[i]);CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,matdata2+cum2,&deluxe_ctx->seq_mat_inv_sum[i]);CHKERRQ(ierr);
ierr = MatSetOption(deluxe_ctx->seq_mat_inv_sum[i],MAT_SPD,sub_schurs->is_posdef);CHKERRQ(ierr);
ierr = MatSetOption(deluxe_ctx->seq_mat_inv_sum[i],MAT_HERMITIAN,sub_schurs->is_hermitian);CHKERRQ(ierr);
if (sub_schurs->is_hermitian) {
ierr = MatCholeskyFactor(deluxe_ctx->seq_mat_inv_sum[i],NULL,NULL);CHKERRQ(ierr);
} else {
ierr = MatLUFactor(deluxe_ctx->seq_mat_inv_sum[i],NULL,NULL,NULL);CHKERRQ(ierr);
}
if (pcbddc->deluxe_singlemat) {
Mat X,Y;
if (!sub_schurs->is_hermitian) {
ierr = MatTranspose(deluxe_ctx->seq_mat[i],MAT_INITIAL_MATRIX,&X);CHKERRQ(ierr);
} else {
ierr = PetscObjectReference((PetscObject)deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
X = deluxe_ctx->seq_mat[i];
}
ierr = MatDuplicate(X,MAT_DO_NOT_COPY_VALUES,&Y);CHKERRQ(ierr);
if (!sub_schurs->is_hermitian) {
ierr = PCBDDCMatTransposeMatSolve_SeqDense(deluxe_ctx->seq_mat_inv_sum[i],X,Y);CHKERRQ(ierr);
} else {
ierr = MatMatSolve(deluxe_ctx->seq_mat_inv_sum[i],X,Y);CHKERRQ(ierr);
}
ierr = MatDestroy(&deluxe_ctx->seq_mat_inv_sum[i]);CHKERRQ(ierr);
ierr = MatDestroy(&deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
ierr = MatDestroy(&X);CHKERRQ(ierr);
if (deluxe_ctx->change) {
Mat C,CY;
if (!deluxe_ctx->change_with_qr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only QR based change of basis");
ierr = KSPGetOperators(deluxe_ctx->change[i],&C,NULL);CHKERRQ(ierr);
ierr = MatMatMult(C,Y,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&CY);CHKERRQ(ierr);
ierr = MatMatTransposeMult(CY,C,MAT_REUSE_MATRIX,PETSC_DEFAULT,&Y);CHKERRQ(ierr);
ierr = MatDestroy(&CY);CHKERRQ(ierr);
}
ierr = MatTranspose(Y,MAT_INPLACE_MATRIX,&Y);CHKERRQ(ierr);
deluxe_ctx->seq_mat[i] = Y;
}
cum += subset_size;
cum2 += subset_size*subset_size;
}
ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs);CHKERRQ(ierr);
ierr = MatSeqAIJRestoreArray(sub_schurs->S_Ej_all,&matdata);CHKERRQ(ierr);
ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_all,&matdata2);CHKERRQ(ierr);
if (pcbddc->deluxe_singlemat) {
deluxe_ctx->change = NULL;
deluxe_ctx->change_with_qr = PETSC_FALSE;
}
if (deluxe_ctx->change && !deluxe_ctx->change_with_qr) {
for (i=0;i<deluxe_ctx->seq_n;i++) {
if (newsetup) {
PC pc;
ierr = KSPGetPC(deluxe_ctx->change[i],&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCLU);CHKERRQ(ierr);
ierr = KSPSetFromOptions(deluxe_ctx->change[i]);CHKERRQ(ierr);
}
ierr = KSPSetUp(deluxe_ctx->change[i]);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCNullSpaceAssembleCorrection(PC pc, PetscBool isdir, IS local_dofs)
{
PC_BDDC *pcbddc = (PC_BDDC*)pc->data;
PC_IS *pcis = (PC_IS*)pc->data;
Mat_IS* matis = (Mat_IS*)pc->pmat->data;
KSP local_ksp;
PC newpc;
NullSpaceCorrection_ctx shell_ctx;
Mat local_mat,local_pmat,small_mat,inv_small_mat;
Vec work1,work2;
const Vec *nullvecs;
VecScatter scatter_ctx;
IS is_aux;
MatFactorInfo matinfo;
PetscScalar *basis_mat,*Kbasis_mat,*array,*array_mat;
PetscScalar one = 1.0,zero = 0.0, m_one = -1.0;
PetscInt basis_dofs,basis_size,nnsp_size,i,k;
PetscBool nnsp_has_cnst;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Infer the local solver */
ierr = ISGetSize(local_dofs,&basis_dofs);CHKERRQ(ierr);
if (isdir) {
/* Dirichlet solver */
local_ksp = pcbddc->ksp_D;
} else {
/* Neumann solver */
local_ksp = pcbddc->ksp_R;
}
ierr = KSPGetOperators(local_ksp,&local_mat,&local_pmat);CHKERRQ(ierr);
/* Get null space vecs */
ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nnsp_has_cnst,&nnsp_size,&nullvecs);CHKERRQ(ierr);
basis_size = nnsp_size;
if (nnsp_has_cnst) {
basis_size++;
}
if (basis_dofs) {
/* Create shell ctx */
ierr = PetscNew(&shell_ctx);CHKERRQ(ierr);
/* Create work vectors in shell context */
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_small_1,basis_size,basis_size);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_small_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_small_1,&shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_full_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_full_1,basis_dofs,basis_dofs);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_full_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&shell_ctx->work_full_2);CHKERRQ(ierr);
/* Allocate workspace */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->basis_mat );CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->Kbasis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Restrict local null space on selected dofs (Dirichlet or Neumann)
and compute matrices N and K*N */
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecScatterCreate(pcis->vec1_N,local_dofs,work1,(IS)0,&scatter_ctx);CHKERRQ(ierr);
}
for (k=0;k<nnsp_size;k++) {
ierr = VecScatterBegin(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (basis_dofs) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
}
if (basis_dofs) {
if (nnsp_has_cnst) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecSet(work1,one);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Assemble another Mat object in shell context */
ierr = MatTransposeMatMult(shell_ctx->basis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&small_mat);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,basis_size,0,1,&is_aux);CHKERRQ(ierr);
ierr = MatLUFactor(small_mat,is_aux,is_aux,&matinfo);CHKERRQ(ierr);
ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
ierr = PetscMalloc1(basis_size*basis_size,&array_mat);CHKERRQ(ierr);
for (k=0;k<basis_size;k++) {
ierr = VecSet(shell_ctx->work_small_1,zero);CHKERRQ(ierr);
ierr = VecSetValue(shell_ctx->work_small_1,k,one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecAssemblyEnd(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = MatSolve(small_mat,shell_ctx->work_small_1,shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecGetArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
for (i=0;i<basis_size;i++) {
array_mat[i*basis_size+k]=array[i];
}
ierr = VecRestoreArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
}
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_size,basis_size,array_mat,&inv_small_mat);CHKERRQ(ierr);
ierr = MatMatMult(shell_ctx->basis_mat,inv_small_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&shell_ctx->Lbasis_mat);CHKERRQ(ierr);
ierr = PetscFree(array_mat);CHKERRQ(ierr);
ierr = MatDestroy(&inv_small_mat);CHKERRQ(ierr);
ierr = MatDestroy(&small_mat);CHKERRQ(ierr);
ierr = MatScale(shell_ctx->Kbasis_mat,m_one);CHKERRQ(ierr);
/* Rebuild local PC */
ierr = KSPGetPC(local_ksp,&shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PCCreate(PETSC_COMM_SELF,&newpc);CHKERRQ(ierr);
ierr = PCSetOperators(newpc,local_mat,local_mat);CHKERRQ(ierr);
ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr);
ierr = PCShellSetContext(newpc,shell_ctx);CHKERRQ(ierr);
ierr = PCShellSetApply(newpc,PCBDDCApplyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCShellSetDestroy(newpc,PCBDDCDestroyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCSetUp(newpc);CHKERRQ(ierr);
ierr = KSPSetPC(local_ksp,newpc);CHKERRQ(ierr);
ierr = PCDestroy(&newpc);CHKERRQ(ierr);
ierr = KSPSetUp(local_ksp);CHKERRQ(ierr);
}
/* test */
if (pcbddc->dbg_flag && basis_dofs) {
KSP check_ksp;
PC check_pc;
Mat test_mat;
Vec work3;
PetscReal test_err,lambda_min,lambda_max;
PetscBool setsym,issym=PETSC_FALSE;
PetscInt tabs;
ierr = PetscViewerASCIIGetTab(pcbddc->dbg_viewer,&tabs);CHKERRQ(ierr);
ierr = KSPGetPC(local_ksp,&check_pc);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work3);CHKERRQ(ierr);
ierr = VecSetRandom(shell_ctx->work_small_1,NULL);CHKERRQ(ierr);
ierr = MatMult(shell_ctx->basis_mat,shell_ctx->work_small_1,work1);CHKERRQ(ierr);
ierr = VecCopy(work1,work2);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work3);CHKERRQ(ierr);
ierr = PCApply(check_pc,work3,work1);CHKERRQ(ierr);
ierr = VecAXPY(work1,m_one,work2);CHKERRQ(ierr);
ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace correction for ",PetscGlobalRank);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_FALSE);CHKERRQ(ierr);
if (isdir) {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Dirichlet ");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Neumann ");CHKERRQ(ierr);
}
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"solver is :%1.14e\n",test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISetTab(pcbddc->dbg_viewer,tabs);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatTransposeMatMult(shell_ctx->Lbasis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&test_mat);CHKERRQ(ierr);
ierr = MatShift(test_mat,one);CHKERRQ(ierr);
ierr = MatNorm(test_mat,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = MatDestroy(&test_mat);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace matrices is :%1.14e\n",PetscGlobalRank,test_err);CHKERRQ(ierr);
/* Create ksp object suitable for extreme eigenvalues' estimation */
ierr = KSPCreate(PETSC_COMM_SELF,&check_ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(check_ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = KSPSetOperators(check_ksp,local_mat,local_mat);CHKERRQ(ierr);
ierr = KSPSetTolerances(check_ksp,1.e-8,1.e-8,PETSC_DEFAULT,basis_dofs);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
if (issym) {
ierr = KSPSetType(check_ksp,KSPCG);CHKERRQ(ierr);
}
ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
ierr = VecSetRandom(work1,NULL);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = KSPSolve(check_ksp,work2,work2);CHKERRQ(ierr);
ierr = VecAXPY(work2,m_one,work1);CHKERRQ(ierr);
ierr = VecNorm(work2,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for adapted KSP %1.14e (it %d, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecDestroy(&work3);CHKERRQ(ierr);
}
/* all processes shoud call this, even the void ones */
if (pcbddc->dbg_flag) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
PetscErrorCode ierr;
DomainData dd;
PetscReal norm,maxeig,mineig;
PetscScalar scalar_value;
PetscInt ndofs,its;
Mat A =0,F=0;
KSP KSPwithBDDC =0,KSPwithFETIDP=0;
Vec fetidp_solution_all=0,bddc_solution=0,bddc_rhs=0;
Vec exact_solution =0,fetidp_solution=0,fetidp_rhs=0;
/* Init PETSc */
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
/* Initialize DomainData */
ierr = InitializeDomainData(&dd);CHKERRQ(ierr);
/* Decompose domain */
ierr = DomainDecomposition(&dd);CHKERRQ(ierr);
#if DEBUG
printf("Subdomain data\n");
printf("IPS : %d %d %d\n",dd.ipx,dd.ipy,dd.ipz);
printf("NEG : %d %d %d\n",dd.nex,dd.ney,dd.nez);
printf("NEL : %d %d %d\n",dd.nex_l,dd.ney_l,dd.nez_l);
printf("LDO : %d %d %d\n",dd.xm_l,dd.ym_l,dd.zm_l);
printf("SIZES : %d %d %d\n",dd.xm,dd.ym,dd.zm);
printf("STARTS: %d %d %d\n",dd.startx,dd.starty,dd.startz);
#endif
/* assemble global matrix */
ierr = ComputeMatrix(dd,&A);CHKERRQ(ierr);
/* get work vectors */
ierr = MatCreateVecs(A,&bddc_solution,NULL);CHKERRQ(ierr);
ierr = VecDuplicate(bddc_solution,&bddc_rhs);CHKERRQ(ierr);
ierr = VecDuplicate(bddc_solution,&fetidp_solution_all);CHKERRQ(ierr);
ierr = VecDuplicate(bddc_solution,&exact_solution);CHKERRQ(ierr);
/* create and customize KSP/PC for BDDC */
ierr = ComputeKSPBDDC(dd,A,&KSPwithBDDC);CHKERRQ(ierr);
/* create KSP/PC for FETIDP */
ierr = ComputeKSPFETIDP(dd,KSPwithBDDC,&KSPwithFETIDP);CHKERRQ(ierr);
/* create random exact solution */
ierr = VecSetRandom(exact_solution,NULL);CHKERRQ(ierr);
ierr = VecShift(exact_solution,-0.5);CHKERRQ(ierr);
ierr = VecScale(exact_solution,100.0);CHKERRQ(ierr);
ierr = VecGetSize(exact_solution,&ndofs);CHKERRQ(ierr);
if (dd.pure_neumann) {
ierr = VecSum(exact_solution,&scalar_value);CHKERRQ(ierr);
scalar_value = -scalar_value/(PetscScalar)ndofs;
ierr = VecShift(exact_solution,scalar_value);CHKERRQ(ierr);
}
/* assemble BDDC rhs */
ierr = MatMult(A,exact_solution,bddc_rhs);CHKERRQ(ierr);
/* test ksp with BDDC */
ierr = KSPSolve(KSPwithBDDC,bddc_rhs,bddc_solution);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(KSPwithBDDC,&its);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(KSPwithBDDC,&maxeig,&mineig);CHKERRQ(ierr);
if (dd.pure_neumann) {
ierr = VecSum(bddc_solution,&scalar_value);CHKERRQ(ierr);
scalar_value = -scalar_value/(PetscScalar)ndofs;
ierr = VecShift(bddc_solution,scalar_value);CHKERRQ(ierr);
}
/* check exact_solution and BDDC solultion */
ierr = VecAXPY(bddc_solution,-1.0,exact_solution);CHKERRQ(ierr);
ierr = VecNorm(bddc_solution,NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"---------------------BDDC stats-------------------------------\n");CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Number of degrees of freedom : %8D \n",ndofs);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Number of iterations : %8D \n",its);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Eigenvalues preconditioned operator : %1.2e %1.2e\n",(double)mineig,(double)maxeig);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Error betweeen exact and computed solution : %1.2e\n",(double)norm);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"--------------------------------------------------------------\n");CHKERRQ(ierr);
/* assemble fetidp rhs on the space of Lagrange multipliers */
ierr = KSPGetOperators(KSPwithFETIDP,&F,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(F,&fetidp_solution,&fetidp_rhs);CHKERRQ(ierr);
ierr = PCBDDCMatFETIDPGetRHS(F,bddc_rhs,fetidp_rhs);CHKERRQ(ierr);
ierr = VecSet(fetidp_solution,0.0);CHKERRQ(ierr);
/* test ksp with FETIDP */
ierr = KSPSolve(KSPwithFETIDP,fetidp_rhs,fetidp_solution);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(KSPwithFETIDP,&its);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(KSPwithFETIDP,&maxeig,&mineig);CHKERRQ(ierr);
/* assemble fetidp solution on physical domain */
ierr = PCBDDCMatFETIDPGetSolution(F,fetidp_solution,fetidp_solution_all);CHKERRQ(ierr);
/* check FETIDP sol */
if (dd.pure_neumann) {
ierr = VecSum(fetidp_solution_all,&scalar_value);CHKERRQ(ierr);
scalar_value = -scalar_value/(PetscScalar)ndofs;
ierr = VecShift(fetidp_solution_all,scalar_value);CHKERRQ(ierr);
}
ierr = VecAXPY(fetidp_solution_all,-1.0,exact_solution);CHKERRQ(ierr);
ierr = VecNorm(fetidp_solution_all,NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = VecGetSize(fetidp_solution,&ndofs);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"------------------FETI-DP stats-------------------------------\n");CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Number of degrees of freedom : %8D \n",ndofs);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Number of iterations : %8D \n",its);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Eigenvalues preconditioned operator : %1.2e %1.2e\n",(double)mineig,(double)maxeig);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"Error betweeen exact and computed solution : %1.2e\n",(double)norm);CHKERRQ(ierr);
ierr = PetscPrintf(dd.gcomm,"--------------------------------------------------------------\n");CHKERRQ(ierr);
/* Free workspace */
ierr = VecDestroy(&exact_solution);CHKERRQ(ierr);
ierr = VecDestroy(&bddc_solution);CHKERRQ(ierr);
ierr = VecDestroy(&fetidp_solution);CHKERRQ(ierr);
ierr = VecDestroy(&fetidp_solution_all);CHKERRQ(ierr);
ierr = VecDestroy(&bddc_rhs);CHKERRQ(ierr);
ierr = VecDestroy(&fetidp_rhs);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = KSPDestroy(&KSPwithBDDC);CHKERRQ(ierr);
ierr = KSPDestroy(&KSPwithFETIDP);CHKERRQ(ierr);
/* Quit PETSc */
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode PCSetUp_MG(PC pc)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
PetscInt i,n = mglevels[0]->levels;
PC cpc;
PetscBool dump = PETSC_FALSE,opsset,use_amat,missinginterpolate = PETSC_FALSE;
Mat dA,dB;
Vec tvec;
DM *dms;
PetscViewer viewer = 0;
PetscFunctionBegin;
/* FIX: Move this to PCSetFromOptions_MG? */
if (mg->usedmfornumberoflevels) {
PetscInt levels;
ierr = DMGetRefineLevel(pc->dm,&levels);CHKERRQ(ierr);
levels++;
if (levels > n) { /* the problem is now being solved on a finer grid */
ierr = PCMGSetLevels(pc,levels,NULL);CHKERRQ(ierr);
n = levels;
ierr = PCSetFromOptions(pc);CHKERRQ(ierr); /* it is bad to call this here, but otherwise will never be called for the new hierarchy */
mglevels = mg->levels;
}
}
ierr = KSPGetPC(mglevels[0]->smoothd,&cpc);CHKERRQ(ierr);
/* If user did not provide fine grid operators OR operator was not updated since last global KSPSetOperators() */
/* so use those from global PC */
/* Is this what we always want? What if user wants to keep old one? */
ierr = KSPGetOperatorsSet(mglevels[n-1]->smoothd,NULL,&opsset);CHKERRQ(ierr);
if (opsset) {
Mat mmat;
ierr = KSPGetOperators(mglevels[n-1]->smoothd,NULL,&mmat);CHKERRQ(ierr);
if (mmat == pc->pmat) opsset = PETSC_FALSE;
}
if (!opsset) {
ierr = PCGetUseAmat(pc,&use_amat);CHKERRQ(ierr);
if(use_amat){
ierr = PetscInfo(pc,"Using outer operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->mat,pc->pmat);CHKERRQ(ierr);
}
else {
ierr = PetscInfo(pc,"Using matrix (pmat) operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->pmat,pc->pmat);CHKERRQ(ierr);
}
}
for (i=n-1; i>0; i--) {
if (!(mglevels[i]->interpolate || mglevels[i]->restrct)) {
missinginterpolate = PETSC_TRUE;
continue;
}
}
/*
Skipping if user has provided all interpolation/restriction needed (since DM might not be able to produce them (when coming from SNES/TS)
Skipping for galerkin==2 (externally managed hierarchy such as ML and GAMG). Cleaner logic here would be great. Wrap ML/GAMG as DMs?
*/
if (missinginterpolate && pc->dm && mg->galerkin != 2 && !pc->setupcalled) {
/* construct the interpolation from the DMs */
Mat p;
Vec rscale;
ierr = PetscMalloc1(n,&dms);CHKERRQ(ierr);
dms[n-1] = pc->dm;
/* Separately create them so we do not get DMKSP interference between levels */
for (i=n-2; i>-1; i--) {ierr = DMCoarsen(dms[i+1],MPI_COMM_NULL,&dms[i]);CHKERRQ(ierr);}
for (i=n-2; i>-1; i--) {
DMKSP kdm;
PetscBool dmhasrestrict;
ierr = KSPSetDM(mglevels[i]->smoothd,dms[i]);CHKERRQ(ierr);
if (mg->galerkin) {ierr = KSPSetDMActive(mglevels[i]->smoothd,PETSC_FALSE);CHKERRQ(ierr);}
ierr = DMGetDMKSPWrite(dms[i],&kdm);CHKERRQ(ierr);
/* Ugly hack so that the next KSPSetUp() will use the RHS that we set. A better fix is to change dmActive to take
* a bitwise OR of computing the matrix, RHS, and initial iterate. */
kdm->ops->computerhs = NULL;
kdm->rhsctx = NULL;
if (!mglevels[i+1]->interpolate) {
ierr = DMCreateInterpolation(dms[i],dms[i+1],&p,&rscale);CHKERRQ(ierr);
ierr = PCMGSetInterpolation(pc,i+1,p);CHKERRQ(ierr);
if (rscale) {ierr = PCMGSetRScale(pc,i+1,rscale);CHKERRQ(ierr);}
ierr = VecDestroy(&rscale);CHKERRQ(ierr);
ierr = MatDestroy(&p);CHKERRQ(ierr);
}
ierr = DMHasCreateRestriction(dms[i],&dmhasrestrict);CHKERRQ(ierr);
if (dmhasrestrict && !mglevels[i+1]->restrct){
ierr = DMCreateRestriction(dms[i],dms[i+1],&p);CHKERRQ(ierr);
ierr = PCMGSetRestriction(pc,i+1,p);CHKERRQ(ierr);
ierr = MatDestroy(&p);CHKERRQ(ierr);
}
}
for (i=n-2; i>-1; i--) {ierr = DMDestroy(&dms[i]);CHKERRQ(ierr);}
ierr = PetscFree(dms);CHKERRQ(ierr);
}
if (pc->dm && !pc->setupcalled) {
/* finest smoother also gets DM but it is not active, independent of whether galerkin==2 */
ierr = KSPSetDM(mglevels[n-1]->smoothd,pc->dm);CHKERRQ(ierr);
ierr = KSPSetDMActive(mglevels[n-1]->smoothd,PETSC_FALSE);CHKERRQ(ierr);
}
if (mg->galerkin == 1) {
Mat B;
/* currently only handle case where mat and pmat are the same on coarser levels */
ierr = KSPGetOperators(mglevels[n-1]->smoothd,&dA,&dB);CHKERRQ(ierr);
if (!pc->setupcalled) {
for (i=n-2; i>-1; i--) {
if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0");
if (!mglevels[i+1]->interpolate) {
ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr);
}
if (!mglevels[i+1]->restrct) {
ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr);
}
if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) {
ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr);
} else {
ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr);
}
ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr);
if (i != n-2) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);}
dB = B;
}
if (n > 1) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);}
} else {
for (i=n-2; i>-1; i--) {
if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0");
if (!mglevels[i+1]->interpolate) {
ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr);
}
if (!mglevels[i+1]->restrct) {
ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr);
}
ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&B);CHKERRQ(ierr);
if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) {
ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr);
} else {
ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr);
}
ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr);
dB = B;
}
}
} else if (!mg->galerkin && pc->dm && pc->dm->x) {
/* need to restrict Jacobian location to coarser meshes for evaluation */
for (i=n-2; i>-1; i--) {
Mat R;
Vec rscale;
if (!mglevels[i]->smoothd->dm->x) {
Vec *vecs;
ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vecs,0,NULL);CHKERRQ(ierr);
mglevels[i]->smoothd->dm->x = vecs[0];
ierr = PetscFree(vecs);CHKERRQ(ierr);
}
ierr = PCMGGetRestriction(pc,i+1,&R);CHKERRQ(ierr);
ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr);
ierr = MatRestrict(R,mglevels[i+1]->smoothd->dm->x,mglevels[i]->smoothd->dm->x);CHKERRQ(ierr);
ierr = VecPointwiseMult(mglevels[i]->smoothd->dm->x,mglevels[i]->smoothd->dm->x,rscale);CHKERRQ(ierr);
}
}
if (!mg->galerkin && pc->dm) {
for (i=n-2; i>=0; i--) {
DM dmfine,dmcoarse;
Mat Restrict,Inject;
Vec rscale;
ierr = KSPGetDM(mglevels[i+1]->smoothd,&dmfine);CHKERRQ(ierr);
ierr = KSPGetDM(mglevels[i]->smoothd,&dmcoarse);CHKERRQ(ierr);
ierr = PCMGGetRestriction(pc,i+1,&Restrict);CHKERRQ(ierr);
ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr);
Inject = NULL; /* Callback should create it if it needs Injection */
ierr = DMRestrict(dmfine,Restrict,rscale,Inject,dmcoarse);CHKERRQ(ierr);
}
}
if (!pc->setupcalled) {
for (i=0; i<n; i++) {
ierr = KSPSetFromOptions(mglevels[i]->smoothd);CHKERRQ(ierr);
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu && (mglevels[i]->smoothu != mglevels[i]->smoothd)) {
ierr = KSPSetFromOptions(mglevels[i]->smoothu);CHKERRQ(ierr);
}
}
/* insure that if either interpolation or restriction is set the other other one is set */
for (i=1; i<n; i++) {
ierr = PCMGGetInterpolation(pc,i,NULL);CHKERRQ(ierr);
ierr = PCMGGetRestriction(pc,i,NULL);CHKERRQ(ierr);
}
for (i=0; i<n-1; i++) {
if (!mglevels[i]->b) {
Vec *vec;
ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr);
ierr = PCMGSetRhs(pc,i,*vec);CHKERRQ(ierr);
ierr = VecDestroy(vec);CHKERRQ(ierr);
ierr = PetscFree(vec);CHKERRQ(ierr);
}
if (!mglevels[i]->r && i) {
ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr);
ierr = PCMGSetR(pc,i,tvec);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
}
if (!mglevels[i]->x) {
ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr);
ierr = PCMGSetX(pc,i,tvec);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
}
}
if (n != 1 && !mglevels[n-1]->r) {
/* PCMGSetR() on the finest level if user did not supply it */
Vec *vec;
ierr = KSPCreateVecs(mglevels[n-1]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr);
ierr = PCMGSetR(pc,n-1,*vec);CHKERRQ(ierr);
ierr = VecDestroy(vec);CHKERRQ(ierr);
ierr = PetscFree(vec);CHKERRQ(ierr);
}
}
if (pc->dm) {
/* need to tell all the coarser levels to rebuild the matrix using the DM for that level */
for (i=0; i<n-1; i++) {
if (mglevels[i]->smoothd->setupstage != KSP_SETUP_NEW) mglevels[i]->smoothd->setupstage = KSP_SETUP_NEWMATRIX;
}
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu == mglevels[i]->smoothd || mg->am == PC_MG_FULL || mg->am == PC_MG_KASKADE || mg->cyclesperpcapply > 1){
/* if doing only down then initial guess is zero */
ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothd,PETSC_TRUE);CHKERRQ(ierr);
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[i]->smoothd);CHKERRQ(ierr);
if (mglevels[i]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
if (!mglevels[i]->residual) {
Mat mat;
ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&mat);CHKERRQ(ierr);
ierr = PCMGSetResidual(pc,i,PCMGResidualDefault,mat);CHKERRQ(ierr);
}
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu && mglevels[i]->smoothu != mglevels[i]->smoothd) {
Mat downmat,downpmat;
/* check if operators have been set for up, if not use down operators to set them */
ierr = KSPGetOperatorsSet(mglevels[i]->smoothu,&opsset,NULL);CHKERRQ(ierr);
if (!opsset) {
ierr = KSPGetOperators(mglevels[i]->smoothd,&downmat,&downpmat);CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[i]->smoothu,downmat,downpmat);CHKERRQ(ierr);
}
ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothu,PETSC_TRUE);CHKERRQ(ierr);
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[i]->smoothu);CHKERRQ(ierr);
if (mglevels[i]->smoothu->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
}
}
if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[0]->smoothd);CHKERRQ(ierr);
if (mglevels[0]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
/*
Dump the interpolation/restriction matrices plus the
Jacobian/stiffness on each level. This allows MATLAB users to
easily check if the Galerkin condition A_c = R A_f R^T is satisfied.
Only support one or the other at the same time.
*/
#if defined(PETSC_USE_SOCKET_VIEWER)
ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_matlab",&dump,NULL);CHKERRQ(ierr);
if (dump) viewer = PETSC_VIEWER_SOCKET_(PetscObjectComm((PetscObject)pc));
dump = PETSC_FALSE;
#endif
ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_binary",&dump,NULL);CHKERRQ(ierr);
if (dump) viewer = PETSC_VIEWER_BINARY_(PetscObjectComm((PetscObject)pc));
if (viewer) {
for (i=1; i<n; i++) {
ierr = MatView(mglevels[i]->restrct,viewer);CHKERRQ(ierr);
}
for (i=0; i<n; i++) {
ierr = KSPGetPC(mglevels[i]->smoothd,&pc);CHKERRQ(ierr);
ierr = MatView(pc->mat,viewer);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PETSC_EXTERN void PETSC_STDCALL kspgetoperators_(KSP ksp,Mat *Amat,Mat *Pmat, int *__ierr ){
*__ierr = KSPGetOperators(
(KSP)PetscToPointer((ksp) ),Amat,Pmat);
}
static PetscErrorCode PCSetUp_Redistribute(PC pc)
{
PC_Redistribute *red = (PC_Redistribute*)pc->data;
PetscErrorCode ierr;
MPI_Comm comm;
PetscInt rstart,rend,i,nz,cnt,*rows,ncnt,dcnt,*drows;
PetscLayout map,nmap;
PetscMPIInt size,imdex,tag,n;
PetscInt *source = PETSC_NULL;
PetscMPIInt *nprocs = PETSC_NULL,nrecvs;
PetscInt j,nsends;
PetscInt *owner = PETSC_NULL,*starts = PETSC_NULL,count,slen;
PetscInt *rvalues,*svalues,recvtotal;
PetscMPIInt *onodes1,*olengths1;
MPI_Request *send_waits = PETSC_NULL,*recv_waits = PETSC_NULL;
MPI_Status recv_status,*send_status;
Vec tvec,diag;
Mat tmat;
const PetscScalar *d;
PetscFunctionBegin;
if (pc->setupcalled) {
ierr = KSPGetOperators(red->ksp,PETSC_NULL,&tmat,PETSC_NULL);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->pmat,red->is,red->is,MAT_REUSE_MATRIX,&tmat);CHKERRQ(ierr);
ierr = KSPSetOperators(red->ksp,tmat,tmat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
PetscInt NN;
ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)pc,&tag);CHKERRQ(ierr);
/* count non-diagonal rows on process */
ierr = MatGetOwnershipRange(pc->mat,&rstart,&rend);CHKERRQ(ierr);
cnt = 0;
for (i=rstart; i<rend; i++) {
ierr = MatGetRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
if (nz > 1) cnt++;
ierr = MatRestoreRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
}
ierr = PetscMalloc(cnt*sizeof(PetscInt),&rows);CHKERRQ(ierr);
ierr = PetscMalloc((rend - rstart - cnt)*sizeof(PetscInt),&drows);CHKERRQ(ierr);
/* list non-diagonal rows on process */
cnt = 0; dcnt = 0;
for (i=rstart; i<rend; i++) {
ierr = MatGetRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
if (nz > 1) rows[cnt++] = i;
else drows[dcnt++] = i - rstart;
ierr = MatRestoreRow(pc->mat,i,&nz,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
}
/* create PetscLayout for non-diagonal rows on each process */
ierr = PetscLayoutCreate(comm,&map);CHKERRQ(ierr);
ierr = PetscLayoutSetLocalSize(map,cnt);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(map,1);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(map);CHKERRQ(ierr);
rstart = map->rstart;
rend = map->rend;
/* create PetscLayout for load-balanced non-diagonal rows on each process */
ierr = PetscLayoutCreate(comm,&nmap);CHKERRQ(ierr);
ierr = MPI_Allreduce(&cnt,&ncnt,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
ierr = PetscLayoutSetSize(nmap,ncnt);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(nmap,1);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(nmap);CHKERRQ(ierr);
ierr = MatGetSize(pc->pmat,&NN,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscInfo2(pc,"Number of diagonal rows eliminated %d, percentage eliminated %g\n",NN-ncnt,((PetscReal)(NN-ncnt))/((PetscReal)(NN)));CHKERRQ(ierr);
/*
this code is taken from VecScatterCreate_PtoS()
Determines what rows need to be moved where to
load balance the non-diagonal rows
*/
/* count number of contributors to each processor */
ierr = PetscMalloc2(size,PetscMPIInt,&nprocs,cnt,PetscInt,&owner);CHKERRQ(ierr);
ierr = PetscMemzero(nprocs,size*sizeof(PetscMPIInt));CHKERRQ(ierr);
j = 0;
nsends = 0;
for (i=rstart; i<rend; i++) {
if (i < nmap->range[j]) j = 0;
for (; j<size; j++) {
if (i < nmap->range[j+1]) {
if (!nprocs[j]++) nsends++;
owner[i-rstart] = j;
break;
}
}
}
/* inform other processors of number of messages and max length*/
ierr = PetscGatherNumberOfMessages(comm,PETSC_NULL,nprocs,&nrecvs);CHKERRQ(ierr);
ierr = PetscGatherMessageLengths(comm,nsends,nrecvs,nprocs,&onodes1,&olengths1);CHKERRQ(ierr);
ierr = PetscSortMPIIntWithArray(nrecvs,onodes1,olengths1);CHKERRQ(ierr);
recvtotal = 0; for (i=0; i<nrecvs; i++) recvtotal += olengths1[i];
/* post receives: rvalues - rows I will own; count - nu */
ierr = PetscMalloc3(recvtotal,PetscInt,&rvalues,nrecvs,PetscInt,&source,nrecvs,MPI_Request,&recv_waits);CHKERRQ(ierr);
count = 0;
for (i=0; i<nrecvs; i++) {
ierr = MPI_Irecv((rvalues+count),olengths1[i],MPIU_INT,onodes1[i],tag,comm,recv_waits+i);CHKERRQ(ierr);
count += olengths1[i];
}
/* do sends:
1) starts[i] gives the starting index in svalues for stuff going to
the ith processor
*/
ierr = PetscMalloc3(cnt,PetscInt,&svalues,nsends,MPI_Request,&send_waits,size,PetscInt,&starts);CHKERRQ(ierr);
starts[0] = 0;
for (i=1; i<size; i++) { starts[i] = starts[i-1] + nprocs[i-1];}
for (i=0; i<cnt; i++) {
svalues[starts[owner[i]]++] = rows[i];
}
for (i=0; i<cnt; i++) rows[i] = rows[i] - rstart;
red->drows = drows;
red->dcnt = dcnt;
ierr = PetscFree(rows);CHKERRQ(ierr);
starts[0] = 0;
for (i=1; i<size; i++) { starts[i] = starts[i-1] + nprocs[i-1];}
count = 0;
for (i=0; i<size; i++) {
if (nprocs[i]) {
ierr = MPI_Isend(svalues+starts[i],nprocs[i],MPIU_INT,i,tag,comm,send_waits+count++);CHKERRQ(ierr);
}
}
/* wait on receives */
count = nrecvs;
slen = 0;
while (count) {
ierr = MPI_Waitany(nrecvs,recv_waits,&imdex,&recv_status);CHKERRQ(ierr);
/* unpack receives into our local space */
ierr = MPI_Get_count(&recv_status,MPIU_INT,&n);CHKERRQ(ierr);
slen += n;
count--;
}
if (slen != recvtotal) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Total message lengths %D not expected %D",slen,recvtotal);
ierr = ISCreateGeneral(comm,slen,rvalues,PETSC_COPY_VALUES,&red->is);CHKERRQ(ierr);
/* free up all work space */
ierr = PetscFree(olengths1);CHKERRQ(ierr);
ierr = PetscFree(onodes1);CHKERRQ(ierr);
ierr = PetscFree3(rvalues,source,recv_waits);CHKERRQ(ierr);
ierr = PetscFree2(nprocs,owner);CHKERRQ(ierr);
if (nsends) { /* wait on sends */
ierr = PetscMalloc(nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr);
ierr = MPI_Waitall(nsends,send_waits,send_status);CHKERRQ(ierr);
ierr = PetscFree(send_status);CHKERRQ(ierr);
}
ierr = PetscFree3(svalues,send_waits,starts);CHKERRQ(ierr);
ierr = PetscLayoutDestroy(&map);CHKERRQ(ierr);
ierr = PetscLayoutDestroy(&nmap);CHKERRQ(ierr);
ierr = VecCreateMPI(comm,slen,PETSC_DETERMINE,&red->b);CHKERRQ(ierr);
ierr = VecDuplicate(red->b,&red->x);CHKERRQ(ierr);
ierr = MatGetVecs(pc->pmat,&tvec,PETSC_NULL);CHKERRQ(ierr);
ierr = VecScatterCreate(tvec,red->is,red->b,PETSC_NULL,&red->scatter);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->pmat,red->is,red->is,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
ierr = KSPSetOperators(red->ksp,tmat,tmat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatDestroy(&tmat);CHKERRQ(ierr);
}
/* get diagonal portion of matrix */
ierr = PetscMalloc(red->dcnt*sizeof(PetscScalar),&red->diag);CHKERRQ(ierr);
ierr = MatGetVecs(pc->pmat,&diag,PETSC_NULL);CHKERRQ(ierr);
ierr = MatGetDiagonal(pc->pmat,diag);CHKERRQ(ierr);
ierr = VecGetArrayRead(diag,&d);CHKERRQ(ierr);
for (i=0; i<red->dcnt; i++) {
red->diag[i] = 1.0/d[red->drows[i]];
}
ierr = VecRestoreArrayRead(diag,&d);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
ierr = KSPSetUp(red->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
KSP ksp;
DM da;
UserContext user;
PetscReal norm;
const char *bcTypes[2] = {"dirichlet","neumann"};
PetscErrorCode ierr;
PetscInt bc;
PetscInt i,j,k,mx,my,mz,xm,ym,zm,xs,ys,zs;
PetscScalar Hx,Hy,Hz;
PetscScalar ***array;
Vec x,b,r;
Mat J;
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = DMDACreate3d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,12,12,12,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,0,0,0,&da);CHKERRQ(ierr);
ierr = DMDASetInterpolationType(da, DMDA_Q0);CHKERRQ(ierr);
ierr = KSPSetDM(ksp,da);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD, "", "Options for the inhomogeneous Poisson equation", "DM");
bc = (PetscInt)NEUMANN;
ierr = PetscOptionsEList("-bc_type","Type of boundary condition","ex34.c",bcTypes,2,bcTypes[0],&bc,PETSC_NULL);CHKERRQ(ierr);
user.bcType = (BCType)bc;
ierr = PetscOptionsEnd();
ierr = KSPSetComputeRHS(ksp,ComputeRHS,&user);CHKERRQ(ierr);
ierr = KSPSetComputeOperators(ksp,ComputeMatrix,&user);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = KSPGetSolution(ksp,&x);CHKERRQ(ierr);
ierr = KSPGetRhs(ksp,&b);CHKERRQ(ierr);
ierr = KSPGetOperators(ksp,PETSC_NULL,&J,PETSC_NULL);CHKERRQ(ierr);
ierr = VecDuplicate(b,&r);CHKERRQ(ierr);
ierr = MatMult(J,x,r);CHKERRQ(ierr);
ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Residual norm %G\n",norm);CHKERRQ(ierr);
ierr = DMDAGetInfo(da, 0, &mx, &my, &mz, 0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
Hx = 1.0 / (PetscReal)(mx);
Hy = 1.0 / (PetscReal)(my);
Hz = 1.0 / (PetscReal)(mz);
ierr = DMDAGetCorners(da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da, x, &array);CHKERRQ(ierr);
for (k=zs; k<zs+zm; k++){
for (j=ys; j<ys+ym; j++){
for(i=xs; i<xs+xm; i++){
array[k][j][i] -=
PetscCosScalar(2*PETSC_PI*(((PetscReal)i+0.5)*Hx))*
PetscCosScalar(2*PETSC_PI*(((PetscReal)j+0.5)*Hy))*
PetscCosScalar(2*PETSC_PI*(((PetscReal)k+0.5)*Hz));
}
}
}
ierr = DMDAVecRestoreArray(da, x, &array);CHKERRQ(ierr);
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Error norm %g\n",norm);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_1,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Error norm %g\n",norm/((PetscReal)(mx)*(PetscReal)(my)*(PetscReal)(mz)));CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Error norm %g\n",norm/((PetscReal)(mx)*(PetscReal)(my)*(PetscReal)(mz)));CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}