static PetscErrorCode PCRedundantGetKSP_Redundant(PC pc,KSP *innerksp)
{
PetscErrorCode ierr;
PC_Redundant *red = (PC_Redundant*)pc->data;
MPI_Comm comm,subcomm;
const char *prefix;
PetscFunctionBegin;
if (!red->psubcomm) {
ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
ierr = PetscSubcommCreate(comm,&red->psubcomm);CHKERRQ(ierr);
ierr = PetscSubcommSetNumber(red->psubcomm,red->nsubcomm);CHKERRQ(ierr);
ierr = PetscSubcommSetType(red->psubcomm,PETSC_SUBCOMM_INTERLACED);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)pc,sizeof(PetscSubcomm));CHKERRQ(ierr);
/* create a new PC that processors in each subcomm have copy of */
subcomm = PetscSubcommChild(red->psubcomm);
ierr = KSPCreate(subcomm,&red->ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(red->ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)red->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)red->ksp);CHKERRQ(ierr);
ierr = KSPSetType(red->ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(red->ksp,&red->pc);CHKERRQ(ierr);
ierr = PCSetType(red->pc,PCLU);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(red->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(red->ksp,"redundant_");CHKERRQ(ierr);
}
*innerksp = red->ksp;
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "PCCreate_Redistribute"
PetscErrorCode PCCreate_Redistribute(PC pc)
{
PetscErrorCode ierr;
PC_Redistribute *red;
const char *prefix;
PetscFunctionBegin;
ierr = PetscNewLog(pc,PC_Redistribute,&red);CHKERRQ(ierr);
pc->data = (void*)red;
pc->ops->apply = PCApply_Redistribute;
pc->ops->applytranspose = 0;
pc->ops->setup = PCSetUp_Redistribute;
pc->ops->destroy = PCDestroy_Redistribute;
pc->ops->setfromoptions = PCSetFromOptions_Redistribute;
pc->ops->view = PCView_Redistribute;
ierr = KSPCreate(((PetscObject)pc)->comm,&red->ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)red->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent(pc,red->ksp);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(red->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(red->ksp,"redistribute_");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "PCRedundantGetPC_Redundant"
PetscErrorCode PETSCKSP_DLLEXPORT PCRedundantGetPC_Redundant(PC pc,PC *innerpc)
{
PetscErrorCode ierr;
PC_Redundant *red = (PC_Redundant*)pc->data;
MPI_Comm comm,subcomm;
const char *prefix;
PetscFunctionBegin;
if (!red->psubcomm) {
ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
ierr = PetscSubcommCreate(comm,red->nsubcomm,&red->psubcomm);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(pc,sizeof(PetscSubcomm));CHKERRQ(ierr);
/* create a new PC that processors in each subcomm have copy of */
subcomm = red->psubcomm->comm;
ierr = KSPCreate(subcomm,&red->ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)red->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent(pc,red->ksp);CHKERRQ(ierr);
ierr = KSPSetType(red->ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(red->ksp,&red->pc);CHKERRQ(ierr);
ierr = PCSetType(red->pc,PCLU);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(red->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(red->ksp,"redundant_");CHKERRQ(ierr);
}
ierr = KSPGetPC(red->ksp,innerpc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void createMG(LocalData* data) {
assert(data != NULL);
int nlevels = 1;
PetscOptionsGetInt(PETSC_NULL, "-nlevels", &nlevels, PETSC_NULL);
int coarseSize = 1 + (((data->N) - 1)>>(nlevels - 1));
int rank;
MPI_Comm_rank((data->commAll), &rank);
if(!rank) {
std::cout<<"nlevels = "<<nlevels<<std::endl;
std::cout<<"coarseSize = "<<coarseSize<<std::endl;
}
DMMGCreate(PETSC_COMM_SELF, -nlevels, PETSC_NULL, &(data->mgObj));
DMMGSetOptionsPrefix(data->mgObj, "loc_");
DA da;
DACreate2d(PETSC_COMM_SELF, DA_NONPERIODIC, DA_STENCIL_BOX, coarseSize, coarseSize,
PETSC_DECIDE, PETSC_DECIDE, (data->dofsPerNode), 1, PETSC_NULL, PETSC_NULL, &da);
DMMGSetDM((data->mgObj), (DM)da);
DADestroy(da);
DMMGSetKSP((data->mgObj), PETSC_NULL, &computeMGmatrix);
PetscObjectIncrementTabLevel((PetscObject)(DMMGGetKSP(data->mgObj)), PETSC_NULL, 2);
}
/*
Creates the default smoother type.
This is SNESNRICHARDSON on each fine level and SNESNEWTONLS on the coarse level.
*/
PetscErrorCode SNESFASCycleCreateSmoother_Private(SNES snes, SNES *smooth)
{
SNES_FAS *fas;
const char *optionsprefix;
char tprefix[128];
PetscErrorCode ierr;
SNES nsmooth;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
fas = (SNES_FAS*)snes->data;
ierr = SNESGetOptionsPrefix(fas->fine, &optionsprefix);CHKERRQ(ierr);
/* create the default smoother */
ierr = SNESCreate(PetscObjectComm((PetscObject)snes), &nsmooth);CHKERRQ(ierr);
if (fas->level == 0) {
sprintf(tprefix,"fas_coarse_");
ierr = SNESAppendOptionsPrefix(nsmooth, optionsprefix);CHKERRQ(ierr);
ierr = SNESAppendOptionsPrefix(nsmooth, tprefix);CHKERRQ(ierr);
ierr = SNESSetType(nsmooth, SNESNEWTONLS);CHKERRQ(ierr);
ierr = SNESSetTolerances(nsmooth, nsmooth->abstol, nsmooth->rtol, nsmooth->stol, nsmooth->max_its, nsmooth->max_funcs);CHKERRQ(ierr);
} else {
sprintf(tprefix,"fas_levels_%d_",(int)fas->level);
ierr = SNESAppendOptionsPrefix(nsmooth, optionsprefix);CHKERRQ(ierr);
ierr = SNESAppendOptionsPrefix(nsmooth, tprefix);CHKERRQ(ierr);
ierr = SNESSetType(nsmooth, SNESNRICHARDSON);CHKERRQ(ierr);
ierr = SNESSetTolerances(nsmooth, 0.0, 0.0, 0.0, fas->max_down_it, nsmooth->max_funcs);CHKERRQ(ierr);
}
ierr = PetscObjectIncrementTabLevel((PetscObject)nsmooth, (PetscObject)snes, 1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)snes,(PetscObject)nsmooth);CHKERRQ(ierr);
ierr = PetscObjectCopyFortranFunctionPointers((PetscObject)snes, (PetscObject)nsmooth);CHKERRQ(ierr);
*smooth = nsmooth;
PetscFunctionReturn(0);
}
static PetscErrorCode KSPChebyshevEstEigSet_Chebyshev(KSP ksp,PetscReal a,PetscReal b,PetscReal c,PetscReal d)
{
KSP_Chebyshev *cheb = (KSP_Chebyshev*)ksp->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (a != 0.0 || b != 0.0 || c != 0.0 || d != 0.0) {
if (!cheb->kspest) { /* should this block of code be moved to KSPSetUp_Chebyshev()? */
ierr = KSPCreate(PetscObjectComm((PetscObject)ksp),&cheb->kspest);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)cheb->kspest,(PetscObject)ksp,1);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(cheb->kspest,((PetscObject)ksp)->prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(cheb->kspest,"esteig_");CHKERRQ(ierr);
ierr = KSPSetSkipPCSetFromOptions(cheb->kspest,PETSC_TRUE);CHKERRQ(ierr);
ierr = KSPSetPC(cheb->kspest,ksp->pc);CHKERRQ(ierr);
ierr = KSPSetComputeEigenvalues(cheb->kspest,PETSC_TRUE);CHKERRQ(ierr);
/* We cannot turn off convergence testing because GMRES will break down if you attempt to keep iterating after a zero norm is obtained */
ierr = KSPSetTolerances(cheb->kspest,1.e-12,PETSC_DEFAULT,PETSC_DEFAULT,cheb->eststeps);CHKERRQ(ierr);
}
if (a >= 0) cheb->tform[0] = a;
if (b >= 0) cheb->tform[1] = b;
if (c >= 0) cheb->tform[2] = c;
if (d >= 0) cheb->tform[3] = d;
cheb->amatid = 0;
cheb->pmatid = 0;
cheb->amatstate = -1;
cheb->pmatstate = -1;
} else {
ierr = KSPDestroy(&cheb->kspest);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
void createOuterKsp(OuterContext* ctx) {
KSPCreate((ctx->data)->commAll, &(ctx->outerKsp));
PetscObjectIncrementTabLevel((PetscObject)(ctx->outerKsp), PETSC_NULL, 0);
KSPSetType(ctx->outerKsp, KSPFGMRES);
KSPSetTolerances(ctx->outerKsp, 1.0e-12, 1.0e-12, PETSC_DEFAULT, 50);
KSPSetPC(ctx->outerKsp, ctx->outerPC);
KSPSetOptionsPrefix(ctx->outerKsp, "outer_");
KSPSetFromOptions(ctx->outerKsp);
KSPSetOperators(ctx->outerKsp, ctx->outerMat,
ctx->outerMat, SAME_NONZERO_PATTERN);
KSPSetUp(ctx->outerKsp);
}
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "SNESMultiblockSetFields_Default"
PetscErrorCode SNESMultiblockSetFields_Default(SNES snes, const char name[], PetscInt n, const PetscInt fields[])
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc newblock, next = mb->blocks;
char prefix[128];
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
if (mb->defined) {
ierr = PetscInfo1(snes, "Ignoring new block \"%s\" because the blocks have already been defined\n", name);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
for (i = 0; i < n; ++i) {
if (fields[i] >= mb->bs) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Field %D requested but only %D exist", fields[i], mb->bs);
if (fields[i] < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Negative field %D requested", fields[i]);
}
ierr = PetscNew(struct _BlockDesc, &newblock);CHKERRQ(ierr);
if (name) {
ierr = PetscStrallocpy(name, &newblock->name);CHKERRQ(ierr);
} else {
PetscInt len = floor(log10(mb->numBlocks))+1;
ierr = PetscMalloc((len+1)*sizeof(char), &newblock->name);CHKERRQ(ierr);
ierr = PetscSNPrintf(newblock->name, len, "%s", mb->numBlocks);CHKERRQ(ierr);
}
newblock->nfields = n;
ierr = PetscMalloc(n*sizeof(PetscInt), &newblock->fields);CHKERRQ(ierr);
ierr = PetscMemcpy(newblock->fields, fields, n*sizeof(PetscInt));CHKERRQ(ierr);
newblock->next = PETSC_NULL;
ierr = SNESCreate(((PetscObject) snes)->comm, &newblock->snes);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject) newblock->snes, (PetscObject) snes, 1);CHKERRQ(ierr);
ierr = SNESSetType(newblock->snes, SNESNRICHARDSON);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject) snes, (PetscObject) newblock->snes);CHKERRQ(ierr);
ierr = PetscSNPrintf(prefix, sizeof(prefix), "%smultiblock_%s_", ((PetscObject) snes)->prefix ? ((PetscObject) snes)->prefix : "", newblock->name);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(newblock->snes, prefix);CHKERRQ(ierr);
if (!next) {
mb->blocks = newblock;
newblock->previous = PETSC_NULL;
} else {
while (next->next) {
next = next->next;
}
next->next = newblock;
newblock->previous = next;
}
mb->numBlocks++;
PetscFunctionReturn(0);
}
PetscErrorCode MatCreate_LMVM(Mat B)
{
Mat_LMVM *lmvm;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscNewLog(B, &lmvm);CHKERRQ(ierr);
B->data = (void*)lmvm;
lmvm->m = 5;
lmvm->k = -1;
lmvm->nupdates = 0;
lmvm->nrejects = 0;
lmvm->nresets = 0;
lmvm->ksp_max_it = 20;
lmvm->ksp_rtol = 0.0;
lmvm->ksp_atol = 0.0;
lmvm->shift = 0.0;
lmvm->eps = PetscPowReal(PETSC_MACHINE_EPSILON, 2.0/3.0);
lmvm->allocated = PETSC_FALSE;
lmvm->prev_set = PETSC_FALSE;
lmvm->user_scale = PETSC_FALSE;
lmvm->user_pc = PETSC_FALSE;
lmvm->user_ksp = PETSC_FALSE;
lmvm->square = PETSC_FALSE;
B->ops->destroy = MatDestroy_LMVM;
B->ops->setfromoptions = MatSetFromOptions_LMVM;
B->ops->view = MatView_LMVM;
B->ops->setup = MatSetUp_LMVM;
B->ops->getvecs = MatGetVecs_LMVM;
B->ops->shift = MatShift_LMVM;
B->ops->duplicate = MatDuplicate_LMVM;
B->ops->mult = MatMult_LMVM;
B->ops->multadd = MatMultAdd_LMVM;
B->ops->copy = MatCopy_LMVM;
lmvm->ops->update = MatUpdate_LMVM;
lmvm->ops->allocate = MatAllocate_LMVM;
lmvm->ops->reset = MatReset_LMVM;
ierr = KSPCreate(PetscObjectComm((PetscObject)B), &lmvm->J0ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)lmvm->J0ksp, (PetscObject)B, 1);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(lmvm->J0ksp, "mat_lmvm_");CHKERRQ(ierr);
ierr = KSPSetType(lmvm->J0ksp, KSPGMRES);CHKERRQ(ierr);
ierr = KSPSetTolerances(lmvm->J0ksp, lmvm->ksp_rtol, lmvm->ksp_atol, PETSC_DEFAULT, lmvm->ksp_max_it);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PETSCKSP_DLLEXPORT PCKSPCreateKSP_KSP(PC pc)
{
PetscErrorCode ierr;
const char *prefix;
PC_KSP *jac = (PC_KSP *)pc->data;
PetscFunctionBegin;
ierr = KSPCreate(((PetscObject)pc)->comm,&jac->ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)jac->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(jac->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(jac->ksp,"ksp_");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_END
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "SNESMultiblockSetIS_Default"
PetscErrorCode SNESMultiblockSetIS_Default(SNES snes, const char name[], IS is)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc newblock, next = mb->blocks;
char prefix[128];
PetscErrorCode ierr;
PetscFunctionBegin;
if (mb->defined) {
ierr = PetscInfo1(snes, "Ignoring new block \"%s\" because the blocks have already been defined\n", name);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = PetscNew(struct _BlockDesc, &newblock);CHKERRQ(ierr);
if (name) {
ierr = PetscStrallocpy(name, &newblock->name);CHKERRQ(ierr);
} else {
PetscInt len = floor(log10(mb->numBlocks))+1;
ierr = PetscMalloc((len+1)*sizeof(char), &newblock->name);CHKERRQ(ierr);
ierr = PetscSNPrintf(newblock->name, len, "%s", mb->numBlocks);CHKERRQ(ierr);
}
newblock->is = is;
ierr = PetscObjectReference((PetscObject) is);CHKERRQ(ierr);
newblock->next = PETSC_NULL;
ierr = SNESCreate(((PetscObject) snes)->comm, &newblock->snes);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject) newblock->snes, (PetscObject) snes, 1);CHKERRQ(ierr);
ierr = SNESSetType(newblock->snes, SNESNRICHARDSON);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject) snes, (PetscObject) newblock->snes);CHKERRQ(ierr);
ierr = PetscSNPrintf(prefix, sizeof(prefix), "%smultiblock_%s_", ((PetscObject) snes)->prefix ? ((PetscObject) snes)->prefix : "", newblock->name);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(newblock->snes, prefix);CHKERRQ(ierr);
if (!next) {
mb->blocks = newblock;
newblock->previous = PETSC_NULL;
} else {
while (next->next) {
next = next->next;
}
next->next = newblock;
newblock->previous = next;
}
mb->numBlocks++;
PetscFunctionReturn(0);
}
static PetscErrorCode PCKSPCreateKSP_KSP(PC pc)
{
PetscErrorCode ierr;
const char *prefix;
PC_KSP *jac = (PC_KSP*)pc->data;
PetscFunctionBegin;
ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&jac->ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(jac->ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)jac->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(jac->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(jac->ksp,"ksp_");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESFASSetLevels - Sets the number of levels to use with FAS.
Must be called before any other FAS routine.
Input Parameters:
+ snes - the snes context
. levels - the number of levels
- comms - optional communicators for each level; this is to allow solving the coarser
problems on smaller sets of processors. Use NULL_OBJECT for default in
Fortran.
Level: intermediate
Notes:
If the number of levels is one then the multigrid uses the -fas_levels prefix
for setting the level options rather than the -fas_coarse prefix.
.keywords: FAS, MG, set, levels, multigrid
.seealso: SNESFASGetLevels()
@*/
PetscErrorCode SNESFASSetLevels(SNES snes, PetscInt levels, MPI_Comm * comms)
{
PetscErrorCode ierr;
PetscInt i;
const char *optionsprefix;
char tprefix[128];
SNES_FAS *fas = (SNES_FAS*)snes->data;
SNES prevsnes;
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr);
if (levels == fas->levels) {
if (!comms) PetscFunctionReturn(0);
}
/* user has changed the number of levels; reset */
ierr = SNESReset(snes);CHKERRQ(ierr);
/* destroy any coarser levels if necessary */
if (fas->next) SNESDestroy(&fas->next);CHKERRQ(ierr);
fas->next = NULL;
fas->previous = NULL;
prevsnes = snes;
/* setup the finest level */
ierr = SNESGetOptionsPrefix(snes, &optionsprefix);CHKERRQ(ierr);
for (i = levels - 1; i >= 0; i--) {
if (comms) comm = comms[i];
fas->level = i;
fas->levels = levels;
fas->fine = snes;
fas->next = NULL;
if (i > 0) {
ierr = SNESCreate(comm, &fas->next);CHKERRQ(ierr);
ierr = SNESGetOptionsPrefix(fas->fine, &optionsprefix);CHKERRQ(ierr);
sprintf(tprefix,"fas_levels_%d_cycle_",(int)fas->level);
ierr = SNESAppendOptionsPrefix(fas->next,optionsprefix);CHKERRQ(ierr);
ierr = SNESAppendOptionsPrefix(fas->next,tprefix);CHKERRQ(ierr);
ierr = SNESSetType(fas->next, SNESFAS);CHKERRQ(ierr);
ierr = SNESSetTolerances(fas->next, fas->next->abstol, fas->next->rtol, fas->next->stol, fas->n_cycles, fas->next->max_funcs);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)fas->next, (PetscObject)snes, levels - i);CHKERRQ(ierr);
((SNES_FAS*)fas->next->data)->previous = prevsnes;
prevsnes = fas->next;
fas = (SNES_FAS*)prevsnes->data;
}
}
PetscFunctionReturn(0);
}
/*@
PCMGGetSmootherUp - Gets the KSP context to be used as smoother after
coarse grid correction (post-smoother).
Not Collective, KSP returned is parallel if PC is
Input Parameters:
+ pc - the multigrid context
- l - the level (0 is coarsest) to supply
Ouput Parameters:
. ksp - the smoother
Level: advanced
Notes: calling this will result in a different pre and post smoother so you may need to
set options on the pre smoother also
.keywords: MG, multigrid, get, smoother, up, post-smoother, level
.seealso: PCMGGetSmootherUp(), PCMGGetSmootherDown()
@*/
PetscErrorCode PCMGGetSmootherUp(PC pc,PetscInt l,KSP *ksp)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
const char *prefix;
MPI_Comm comm;
PetscFunctionBegin;
PetscValidHeaderSpecific(pc,PC_CLASSID,1);
/*
This is called only if user wants a different pre-smoother from post.
Thus we check if a different one has already been allocated,
if not we allocate it.
*/
if (!l) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_OUTOFRANGE,"There is no such thing as a up smoother on the coarse grid");
if (mglevels[l]->smoothu == mglevels[l]->smoothd) {
KSPType ksptype;
PCType pctype;
PC ipc;
PetscReal rtol,abstol,dtol;
PetscInt maxits;
KSPNormType normtype;
ierr = PetscObjectGetComm((PetscObject)mglevels[l]->smoothd,&comm);CHKERRQ(ierr);
ierr = KSPGetOptionsPrefix(mglevels[l]->smoothd,&prefix);CHKERRQ(ierr);
ierr = KSPGetTolerances(mglevels[l]->smoothd,&rtol,&abstol,&dtol,&maxits);CHKERRQ(ierr);
ierr = KSPGetType(mglevels[l]->smoothd,&ksptype);CHKERRQ(ierr);
ierr = KSPGetNormType(mglevels[l]->smoothd,&normtype);CHKERRQ(ierr);
ierr = KSPGetPC(mglevels[l]->smoothd,&ipc);CHKERRQ(ierr);
ierr = PCGetType(ipc,&pctype);CHKERRQ(ierr);
ierr = KSPCreate(comm,&mglevels[l]->smoothu);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(mglevels[l]->smoothu,pc->erroriffailure);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)mglevels[l]->smoothu,(PetscObject)pc,mglevels[0]->levels-l);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(mglevels[l]->smoothu,prefix);CHKERRQ(ierr);
ierr = KSPSetTolerances(mglevels[l]->smoothu,rtol,abstol,dtol,maxits);CHKERRQ(ierr);
ierr = KSPSetType(mglevels[l]->smoothu,ksptype);CHKERRQ(ierr);
ierr = KSPSetNormType(mglevels[l]->smoothu,normtype);CHKERRQ(ierr);
ierr = KSPSetConvergenceTest(mglevels[l]->smoothu,KSPConvergedSkip,NULL,NULL);CHKERRQ(ierr);
ierr = KSPGetPC(mglevels[l]->smoothu,&ipc);CHKERRQ(ierr);
ierr = PCSetType(ipc,pctype);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)mglevels[l]->smoothu);CHKERRQ(ierr);
ierr = PetscObjectComposedDataSetInt((PetscObject) mglevels[l]->smoothu, PetscMGLevelId, mglevels[l]->level);CHKERRQ(ierr);
}
if (ksp) *ksp = mglevels[l]->smoothu;
PetscFunctionReturn(0);
}
static PetscErrorCode SNESCompositeAddSNES_Composite(SNES snes,SNESType type)
{
SNES_Composite *jac;
SNES_CompositeLink next,ilink;
PetscErrorCode ierr;
PetscInt cnt = 0;
const char *prefix;
char newprefix[20];
DM dm;
PetscFunctionBegin;
ierr = PetscNewLog(snes,&ilink);CHKERRQ(ierr);
ilink->next = 0;
ierr = SNESCreate(PetscObjectComm((PetscObject)snes),&ilink->snes);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)snes,(PetscObject)ilink->snes);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = SNESSetDM(ilink->snes,dm);CHKERRQ(ierr);
ierr = SNESSetTolerances(ilink->snes,ilink->snes->abstol,ilink->snes->rtol,ilink->snes->stol,1,ilink->snes->max_funcs);CHKERRQ(ierr);
ierr = PetscObjectCopyFortranFunctionPointers((PetscObject)snes,(PetscObject)ilink->snes);CHKERRQ(ierr);
jac = (SNES_Composite*)snes->data;
next = jac->head;
if (!next) {
jac->head = ilink;
ilink->previous = NULL;
} else {
cnt++;
while (next->next) {
next = next->next;
cnt++;
}
next->next = ilink;
ilink->previous = next;
}
ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(ilink->snes,prefix);CHKERRQ(ierr);
sprintf(newprefix,"sub_%d_",(int)cnt);
ierr = SNESAppendOptionsPrefix(ilink->snes,newprefix);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ilink->snes,(PetscObject)snes,1);CHKERRQ(ierr);
ierr = SNESSetType(ilink->snes,type);CHKERRQ(ierr);
ierr = SNESSetNormSchedule(ilink->snes, SNES_NORM_FINAL_ONLY);CHKERRQ(ierr);
ilink->dmp = 1.0;
jac->nsnes++;
PetscFunctionReturn(0);
}
PetscErrorCode PCSetFromOptions_Exotic(PetscOptions *PetscOptionsObject,PC pc)
{
PetscErrorCode ierr;
PetscBool flg;
PC_MG *mg = (PC_MG*)pc->data;
PCExoticType mgctype;
PC_Exotic *ctx = (PC_Exotic*) mg->innerctx;
PetscFunctionBegin;
ierr = PetscOptionsHead(PetscOptionsObject,"Exotic coarse space options");
CHKERRQ(ierr);
ierr = PetscOptionsEnum("-pc_exotic_type","face or wirebasket","PCExoticSetType",PCExoticTypes,(PetscEnum)ctx->type,(PetscEnum*)&mgctype,&flg);
CHKERRQ(ierr);
if (flg) {
ierr = PCExoticSetType(pc,mgctype);
CHKERRQ(ierr);
}
ierr = PetscOptionsBool("-pc_exotic_direct_solver","use direct solver to construct interpolation","None",ctx->directSolve,&ctx->directSolve,NULL);
CHKERRQ(ierr);
if (!ctx->directSolve) {
if (!ctx->ksp) {
const char *prefix;
ierr = KSPCreate(PETSC_COMM_SELF,&ctx->ksp);
CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(ctx->ksp,pc->erroriffailure);
CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ctx->ksp,(PetscObject)pc,1);
CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ctx->ksp);
CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);
CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(ctx->ksp,prefix);
CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(ctx->ksp,"exotic_");
CHKERRQ(ierr);
}
ierr = KSPSetFromOptions(ctx->ksp);
CHKERRQ(ierr);
}
ierr = PetscOptionsTail();
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode NEPInterpolGetPEP_Interpol(NEP nep,PEP *pep)
{
PetscErrorCode ierr;
NEP_INTERPOL *ctx = (NEP_INTERPOL*)nep->data;
ST st;
PetscFunctionBegin;
if (!ctx->pep) {
ierr = PEPCreate(PetscObjectComm((PetscObject)nep),&ctx->pep);CHKERRQ(ierr);
ierr = PEPSetOptionsPrefix(ctx->pep,((PetscObject)nep)->prefix);CHKERRQ(ierr);
ierr = PEPAppendOptionsPrefix(ctx->pep,"nep_");CHKERRQ(ierr);
ierr = PEPGetST(ctx->pep,&st);CHKERRQ(ierr);
ierr = STSetOptionsPrefix(st,((PetscObject)ctx->pep)->prefix);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ctx->pep,(PetscObject)nep,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)nep,(PetscObject)ctx->pep);CHKERRQ(ierr);
}
*pep = ctx->pep;
PetscFunctionReturn(0);
}
static PetscErrorCode NEPSLPGetEPS_SLP(NEP nep,EPS *eps)
{
PetscErrorCode ierr;
NEP_SLP *ctx = (NEP_SLP*)nep->data;
ST st;
PetscFunctionBegin;
if (!ctx->eps) {
ierr = EPSCreate(PetscObjectComm((PetscObject)nep),&ctx->eps);CHKERRQ(ierr);
ierr = EPSSetOptionsPrefix(ctx->eps,((PetscObject)nep)->prefix);CHKERRQ(ierr);
ierr = EPSAppendOptionsPrefix(ctx->eps,"nep_");CHKERRQ(ierr);
ierr = EPSGetST(ctx->eps,&st);CHKERRQ(ierr);
ierr = STSetOptionsPrefix(st,((PetscObject)ctx->eps)->prefix);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ctx->eps,(PetscObject)nep,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)nep,(PetscObject)ctx->eps);CHKERRQ(ierr);
}
*eps = ctx->eps;
PetscFunctionReturn(0);
}
static PetscErrorCode PEPLinearGetEPS_Linear(PEP pep,EPS *eps)
{
PetscErrorCode ierr;
PEP_LINEAR *ctx = (PEP_LINEAR*)pep->data;
ST st;
PetscFunctionBegin;
if (!ctx->eps) {
ierr = EPSCreate(PetscObjectComm((PetscObject)pep),&ctx->eps);CHKERRQ(ierr);
ierr = EPSSetOptionsPrefix(ctx->eps,((PetscObject)pep)->prefix);CHKERRQ(ierr);
ierr = EPSAppendOptionsPrefix(ctx->eps,"pep_");CHKERRQ(ierr);
ierr = EPSGetST(ctx->eps,&st);CHKERRQ(ierr);
ierr = STSetOptionsPrefix(st,((PetscObject)ctx->eps)->prefix);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ctx->eps,(PetscObject)pep,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pep,(PetscObject)ctx->eps);CHKERRQ(ierr);
ierr = EPSMonitorSet(ctx->eps,EPSMonitor_Linear,pep,NULL);CHKERRQ(ierr);
}
*eps = ctx->eps;
PetscFunctionReturn(0);
}
static PetscErrorCode KSPChebyshevSetEstimateEigenvalues_Chebyshev(KSP ksp,PetscReal a,PetscReal b,PetscReal c,PetscReal d)
{
KSP_Chebyshev *cheb = (KSP_Chebyshev*)ksp->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (a != 0.0 || b != 0.0 || c != 0.0 || d != 0.0) {
if (!cheb->kspest) { /* should this block of code be moved to KSPSetUp_Chebyshev()? */
PetscBool nonzero;
ierr = KSPCreate(PetscObjectComm((PetscObject)ksp),&cheb->kspest);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)cheb->kspest,(PetscObject)ksp,1);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(cheb->kspest,((PetscObject)ksp)->prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(cheb->kspest,"est_");CHKERRQ(ierr);
ierr = KSPGetPC(cheb->kspest,&cheb->pcnone);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)cheb->pcnone);CHKERRQ(ierr);
ierr = PCSetType(cheb->pcnone,PCNONE);CHKERRQ(ierr);
ierr = KSPSetPC(cheb->kspest,ksp->pc);CHKERRQ(ierr);
ierr = KSPGetInitialGuessNonzero(ksp,&nonzero);CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(cheb->kspest,nonzero);CHKERRQ(ierr);
ierr = KSPSetComputeEigenvalues(cheb->kspest,PETSC_TRUE);CHKERRQ(ierr);
/* Estimate with a fixed number of iterations */
ierr = KSPSetConvergenceTest(cheb->kspest,KSPConvergedSkip,0,0);CHKERRQ(ierr);
ierr = KSPSetNormType(cheb->kspest,KSP_NORM_NONE);CHKERRQ(ierr);
ierr = KSPSetTolerances(cheb->kspest,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,cheb->eststeps);CHKERRQ(ierr);
}
if (a >= 0) cheb->tform[0] = a;
if (b >= 0) cheb->tform[1] = b;
if (c >= 0) cheb->tform[2] = c;
if (d >= 0) cheb->tform[3] = d;
cheb->estimate_current = PETSC_FALSE;
} else {
ierr = KSPDestroy(&cheb->kspest);CHKERRQ(ierr);
ierr = PCDestroy(&cheb->pcnone);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode PCLSCAllocate_Private(PC pc)
{
PC_LSC *lsc = (PC_LSC*)pc->data;
Mat A;
PetscErrorCode ierr;
PetscFunctionBegin;
if (lsc->allocated) PetscFunctionReturn(0);
ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&lsc->kspL);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(lsc->kspL,pc->erroriffailure);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)lsc->kspL,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetType(lsc->kspL,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(lsc->kspL,((PetscObject)pc)->prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(lsc->kspL,"lsc_");CHKERRQ(ierr);
ierr = MatSchurComplementGetSubMatrices(pc->mat,&A,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&lsc->x0,&lsc->y0);CHKERRQ(ierr);
ierr = MatCreateVecs(pc->pmat,&lsc->x1,NULL);CHKERRQ(ierr);
if (lsc->scalediag) {
ierr = VecDuplicate(lsc->x0,&lsc->scale);CHKERRQ(ierr);
}
lsc->allocated = PETSC_TRUE;
PetscFunctionReturn(0);
}
/*@C
PCMGSetLevels - Sets the number of levels to use with MG.
Must be called before any other MG routine.
Logically Collective on PC
Input Parameters:
+ pc - the preconditioner context
. levels - the number of levels
- comms - optional communicators for each level; this is to allow solving the coarser problems
on smaller sets of processors. Use NULL_OBJECT for default in Fortran
Level: intermediate
Notes:
If the number of levels is one then the multigrid uses the -mg_levels prefix
for setting the level options rather than the -mg_coarse prefix.
.keywords: MG, set, levels, multigrid
.seealso: PCMGSetType(), PCMGGetLevels()
@*/
PetscErrorCode PCMGSetLevels(PC pc,PetscInt levels,MPI_Comm *comms)
{
PetscErrorCode ierr;
PC_MG *mg = (PC_MG*)pc->data;
MPI_Comm comm;
PC_MG_Levels **mglevels = mg->levels;
PCMGType mgtype = mg->am;
PetscInt mgctype = (PetscInt) PC_MG_CYCLE_V;
PetscInt i;
PetscMPIInt size;
const char *prefix;
PC ipc;
PetscInt n;
PetscFunctionBegin;
PetscValidHeaderSpecific(pc,PC_CLASSID,1);
PetscValidLogicalCollectiveInt(pc,levels,2);
ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
if (mg->nlevels == levels) PetscFunctionReturn(0);
if (mglevels) {
mgctype = mglevels[0]->cycles;
/* changing the number of levels so free up the previous stuff */
ierr = PCReset_MG(pc);CHKERRQ(ierr);
n = mglevels[0]->levels;
for (i=0; i<n; i++) {
if (mglevels[i]->smoothd != mglevels[i]->smoothu) {
ierr = KSPDestroy(&mglevels[i]->smoothd);CHKERRQ(ierr);
}
ierr = KSPDestroy(&mglevels[i]->smoothu);CHKERRQ(ierr);
ierr = PetscFree(mglevels[i]);CHKERRQ(ierr);
}
ierr = PetscFree(mg->levels);CHKERRQ(ierr);
}
mg->nlevels = levels;
ierr = PetscMalloc1(levels,&mglevels);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)pc,levels*(sizeof(PC_MG*)));CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
mg->stageApply = 0;
for (i=0; i<levels; i++) {
ierr = PetscNewLog(pc,&mglevels[i]);CHKERRQ(ierr);
mglevels[i]->level = i;
mglevels[i]->levels = levels;
mglevels[i]->cycles = mgctype;
mg->default_smoothu = 2;
mg->default_smoothd = 2;
mglevels[i]->eventsmoothsetup = 0;
mglevels[i]->eventsmoothsolve = 0;
mglevels[i]->eventresidual = 0;
mglevels[i]->eventinterprestrict = 0;
if (comms) comm = comms[i];
ierr = KSPCreate(comm,&mglevels[i]->smoothd);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(mglevels[i]->smoothd,pc->erroriffailure);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)mglevels[i]->smoothd,(PetscObject)pc,levels-i);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(mglevels[i]->smoothd,prefix);CHKERRQ(ierr);
ierr = PetscObjectComposedDataSetInt((PetscObject) mglevels[i]->smoothd, PetscMGLevelId, mglevels[i]->level);CHKERRQ(ierr);
if (i || levels == 1) {
char tprefix[128];
ierr = KSPSetType(mglevels[i]->smoothd,KSPCHEBYSHEV);CHKERRQ(ierr);
ierr = KSPSetConvergenceTest(mglevels[i]->smoothd,KSPConvergedSkip,NULL,NULL);CHKERRQ(ierr);
ierr = KSPSetNormType(mglevels[i]->smoothd,KSP_NORM_NONE);CHKERRQ(ierr);
ierr = KSPGetPC(mglevels[i]->smoothd,&ipc);CHKERRQ(ierr);
ierr = PCSetType(ipc,PCSOR);CHKERRQ(ierr);
ierr = KSPSetTolerances(mglevels[i]->smoothd,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT, mg->default_smoothd);CHKERRQ(ierr);
sprintf(tprefix,"mg_levels_%d_",(int)i);
ierr = KSPAppendOptionsPrefix(mglevels[i]->smoothd,tprefix);CHKERRQ(ierr);
} else {
ierr = KSPAppendOptionsPrefix(mglevels[0]->smoothd,"mg_coarse_");CHKERRQ(ierr);
/* coarse solve is (redundant) LU by default; set shifttype NONZERO to avoid annoying zero-pivot in LU preconditioner */
ierr = KSPSetType(mglevels[0]->smoothd,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(mglevels[0]->smoothd,&ipc);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size > 1) {
ierr = PCSetType(ipc,PCREDUNDANT);CHKERRQ(ierr);
} else {
ierr = PCSetType(ipc,PCLU);CHKERRQ(ierr);
}
ierr = PCFactorSetShiftType(ipc,MAT_SHIFT_INBLOCKS);CHKERRQ(ierr);
}
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)mglevels[i]->smoothd);CHKERRQ(ierr);
mglevels[i]->smoothu = mglevels[i]->smoothd;
mg->rtol = 0.0;
mg->abstol = 0.0;
mg->dtol = 0.0;
mg->ttol = 0.0;
mg->cyclesperpcapply = 1;
}
mg->levels = mglevels;
ierr = PCMGSetType(pc,mgtype);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCISSetUp(PC pc)
{
PC_IS *pcis = (PC_IS*)(pc->data);
Mat_IS *matis;
PetscErrorCode ierr;
PetscBool flg,issbaij;
Vec counter;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject)pc->pmat,MATIS,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONG,"Preconditioner type of Neumann Neumman requires matrix of type MATIS");
matis = (Mat_IS*)pc->pmat->data;
pcis->pure_neumann = matis->pure_neumann;
/* get info on mapping */
ierr = PetscObjectReference((PetscObject)matis->mapping);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingDestroy(&pcis->mapping);CHKERRQ(ierr);
pcis->mapping = matis->mapping;
ierr = ISLocalToGlobalMappingGetSize(pcis->mapping,&pcis->n);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingGetInfo(pcis->mapping,&(pcis->n_neigh),&(pcis->neigh),&(pcis->n_shared),&(pcis->shared));CHKERRQ(ierr);
/* Creating local and global index sets for interior and inteface nodes. */
{
PetscInt n_I;
PetscInt *idx_I_local,*idx_B_local,*idx_I_global,*idx_B_global;
PetscInt *array;
PetscInt i,j;
/* Identifying interior and interface nodes, in local numbering */
ierr = PetscMalloc1(pcis->n,&array);CHKERRQ(ierr);
ierr = PetscMemzero(array,pcis->n*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0;i<pcis->n_neigh;i++)
for (j=0;j<pcis->n_shared[i];j++)
array[pcis->shared[i][j]] += 1;
ierr = PetscMalloc1(pcis->n,&idx_I_local);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n,&idx_B_local);CHKERRQ(ierr);
for (i=0, pcis->n_B=0, n_I=0; i<pcis->n; i++) {
if (!array[i]) {
idx_I_local[n_I] = i;
n_I++;
} else {
idx_B_local[pcis->n_B] = i;
pcis->n_B++;
}
}
/* Getting the global numbering */
idx_B_global = idx_I_local + n_I; /* Just avoiding allocating extra memory, since we have vacant space */
idx_I_global = idx_B_local + pcis->n_B;
ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcis->n_B,idx_B_local,idx_B_global);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingApply(pcis->mapping,n_I, idx_I_local,idx_I_global);CHKERRQ(ierr);
/* Creating the index sets. */
ierr = ISCreateGeneral(PETSC_COMM_SELF,pcis->n_B,idx_B_local,PETSC_COPY_VALUES, &pcis->is_B_local);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,pcis->n_B,idx_B_global,PETSC_COPY_VALUES,&pcis->is_B_global);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,n_I,idx_I_local,PETSC_COPY_VALUES, &pcis->is_I_local);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,n_I,idx_I_global,PETSC_COPY_VALUES,&pcis->is_I_global);CHKERRQ(ierr);
/* Freeing memory and restoring arrays */
ierr = PetscFree(idx_B_local);CHKERRQ(ierr);
ierr = PetscFree(idx_I_local);CHKERRQ(ierr);
ierr = PetscFree(array);CHKERRQ(ierr);
}
/*
Extracting the blocks A_II, A_BI, A_IB and A_BB from A. If the numbering
is such that interior nodes come first than the interface ones, we have
[ | ]
[ A_II | A_IB ]
A = [ | ]
[-----------+------]
[ A_BI | A_BB ]
*/
ierr = MatGetSubMatrix(matis->A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_II);CHKERRQ(ierr);
ierr = MatGetSubMatrix(matis->A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_BB);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
if (!issbaij) {
ierr = MatGetSubMatrix(matis->A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_IB);CHKERRQ(ierr);
ierr = MatGetSubMatrix(matis->A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_BI);CHKERRQ(ierr);
} else {
Mat newmat;
ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_IB);CHKERRQ(ierr);
ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_BI);CHKERRQ(ierr);
ierr = MatDestroy(&newmat);CHKERRQ(ierr);
}
/*
Creating work vectors and arrays
*/
ierr = VecDuplicate(matis->x,&pcis->vec1_N);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_N,&pcis->vec2_N);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,pcis->n-pcis->n_B,&pcis->vec1_D);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_D,&pcis->vec2_D);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_D,&pcis->vec3_D);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_D,&pcis->vec4_D);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,pcis->n_B,&pcis->vec1_B);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_B,&pcis->vec2_B);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_B,&pcis->vec3_B);CHKERRQ(ierr);
ierr = MatCreateVecs(pc->pmat,&pcis->vec1_global,0);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n,&pcis->work_N);CHKERRQ(ierr);
/* Creating the scatter contexts */
ierr = VecScatterCreate(pcis->vec1_global,pcis->is_I_global,pcis->vec1_D,(IS)0,&pcis->global_to_D);CHKERRQ(ierr);
ierr = VecScatterCreate(pcis->vec1_N,pcis->is_B_local,pcis->vec1_B,(IS)0,&pcis->N_to_B);CHKERRQ(ierr);
ierr = VecScatterCreate(pcis->vec1_global,pcis->is_B_global,pcis->vec1_B,(IS)0,&pcis->global_to_B);CHKERRQ(ierr);
/* Creating scaling "matrix" D */
ierr = PetscOptionsGetBool(((PetscObject)pc)->prefix,"-pc_is_use_stiffness_scaling",&pcis->use_stiffness_scaling,NULL);CHKERRQ(ierr);
if (!pcis->D) {
ierr = VecDuplicate(pcis->vec1_B,&pcis->D);CHKERRQ(ierr);
if (!pcis->use_stiffness_scaling) {
ierr = VecSet(pcis->D,pcis->scaling_factor);CHKERRQ(ierr);
} else {
ierr = MatGetDiagonal(matis->A,pcis->vec1_N);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
}
ierr = VecCopy(pcis->D,pcis->vec1_B);CHKERRQ(ierr);
ierr = MatCreateVecs(pc->pmat,&counter,0);CHKERRQ(ierr); /* temporary auxiliar vector */
ierr = VecSet(counter,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,counter,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_B,counter,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->global_to_B,counter,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->global_to_B,counter,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecPointwiseDivide(pcis->D,pcis->D,pcis->vec1_B);CHKERRQ(ierr);
ierr = VecDestroy(&counter);CHKERRQ(ierr);
/* See historical note 01, at the bottom of this file. */
/*
Creating the KSP contexts for the local Dirichlet and Neumann problems.
*/
if (pcis->computesolvers) {
PC pc_ctx;
/* Dirichlet */
ierr = KSPCreate(PETSC_COMM_SELF,&pcis->ksp_D);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)pcis->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetOperators(pcis->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(pcis->ksp_D,"is_localD_");CHKERRQ(ierr);
ierr = KSPGetPC(pcis->ksp_D,&pc_ctx);CHKERRQ(ierr);
ierr = PCSetType(pc_ctx,PCLU);CHKERRQ(ierr);
ierr = KSPSetType(pcis->ksp_D,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetFromOptions(pcis->ksp_D);CHKERRQ(ierr);
/* the vectors in the following line are dummy arguments, just telling the KSP the vector size. Values are not used */
ierr = KSPSetUp(pcis->ksp_D);CHKERRQ(ierr);
/* Neumann */
ierr = KSPCreate(PETSC_COMM_SELF,&pcis->ksp_N);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)pcis->ksp_N,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetOperators(pcis->ksp_N,matis->A,matis->A);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(pcis->ksp_N,"is_localN_");CHKERRQ(ierr);
ierr = KSPGetPC(pcis->ksp_N,&pc_ctx);CHKERRQ(ierr);
ierr = PCSetType(pc_ctx,PCLU);CHKERRQ(ierr);
ierr = KSPSetType(pcis->ksp_N,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetFromOptions(pcis->ksp_N);CHKERRQ(ierr);
{
PetscBool damp_fixed = PETSC_FALSE,
remove_nullspace_fixed = PETSC_FALSE,
set_damping_factor_floating = PETSC_FALSE,
not_damp_floating = PETSC_FALSE,
not_remove_nullspace_floating = PETSC_FALSE;
PetscReal fixed_factor,
floating_factor;
ierr = PetscOptionsGetReal(((PetscObject)pc_ctx)->prefix,"-pc_is_damp_fixed",&fixed_factor,&damp_fixed);CHKERRQ(ierr);
if (!damp_fixed) fixed_factor = 0.0;
ierr = PetscOptionsGetBool(((PetscObject)pc_ctx)->prefix,"-pc_is_damp_fixed",&damp_fixed,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(((PetscObject)pc_ctx)->prefix,"-pc_is_remove_nullspace_fixed",&remove_nullspace_fixed,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(((PetscObject)pc_ctx)->prefix,"-pc_is_set_damping_factor_floating",
&floating_factor,&set_damping_factor_floating);CHKERRQ(ierr);
if (!set_damping_factor_floating) floating_factor = 0.0;
ierr = PetscOptionsGetBool(((PetscObject)pc_ctx)->prefix,"-pc_is_set_damping_factor_floating",&set_damping_factor_floating,NULL);CHKERRQ(ierr);
if (!set_damping_factor_floating) floating_factor = 1.e-12;
ierr = PetscOptionsGetBool(((PetscObject)pc_ctx)->prefix,"-pc_is_not_damp_floating",¬_damp_floating,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(((PetscObject)pc_ctx)->prefix,"-pc_is_not_remove_nullspace_floating",¬_remove_nullspace_floating,NULL);CHKERRQ(ierr);
if (pcis->pure_neumann) { /* floating subdomain */
if (!(not_damp_floating)) {
ierr = PCFactorSetShiftType(pc_ctx,MAT_SHIFT_NONZERO);CHKERRQ(ierr);
ierr = PCFactorSetShiftAmount(pc_ctx,floating_factor);CHKERRQ(ierr);
}
if (!(not_remove_nullspace_floating)) {
MatNullSpace nullsp;
ierr = MatNullSpaceCreate(PETSC_COMM_SELF,PETSC_TRUE,0,NULL,&nullsp);CHKERRQ(ierr);
ierr = KSPSetNullSpace(pcis->ksp_N,nullsp);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullsp);CHKERRQ(ierr);
}
} else { /* fixed subdomain */
if (damp_fixed) {
ierr = PCFactorSetShiftType(pc_ctx,MAT_SHIFT_NONZERO);CHKERRQ(ierr);
ierr = PCFactorSetShiftAmount(pc_ctx,floating_factor);CHKERRQ(ierr);
}
if (remove_nullspace_fixed) {
MatNullSpace nullsp;
ierr = MatNullSpaceCreate(PETSC_COMM_SELF,PETSC_TRUE,0,NULL,&nullsp);CHKERRQ(ierr);
ierr = KSPSetNullSpace(pcis->ksp_N,nullsp);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullsp);CHKERRQ(ierr);
}
}
}
/* the vectors in the following line are dummy arguments, just telling the KSP the vector size. Values are not used */
ierr = KSPSetUp(pcis->ksp_N);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
EXTERN_C_END
/* -------------------------------------------------------------------------- */
/*
PCNNCreateCoarseMatrix -
*/
#undef __FUNCT__
#define __FUNCT__ "PCNNCreateCoarseMatrix"
PetscErrorCode PCNNCreateCoarseMatrix (PC pc)
{
MPI_Request *send_request, *recv_request;
PetscErrorCode ierr;
PetscInt i, j, k;
PetscScalar* mat; /* Sub-matrix with this subdomain's contribution to the coarse matrix */
PetscScalar** DZ_OUT; /* proc[k].DZ_OUT[i][] = bit of vector to be sent from processor k to processor i */
/* aliasing some names */
PC_IS* pcis = (PC_IS*)(pc->data);
PC_NN* pcnn = (PC_NN*)pc->data;
PetscInt n_neigh = pcis->n_neigh;
PetscInt* neigh = pcis->neigh;
PetscInt* n_shared = pcis->n_shared;
PetscInt** shared = pcis->shared;
PetscScalar** DZ_IN; /* Must be initialized after memory allocation. */
PetscFunctionBegin;
/* Allocate memory for mat (the +1 is to handle the case n_neigh equal to zero) */
ierr = PetscMalloc((n_neigh*n_neigh+1)*sizeof(PetscScalar),&mat);CHKERRQ(ierr);
/* Allocate memory for DZ */
/* Notice that DZ_OUT[0] is allocated some space that is never used. */
/* This is just in order to DZ_OUT and DZ_IN to have exactly the same form. */
{
PetscInt size_of_Z = 0;
ierr = PetscMalloc ((n_neigh+1)*sizeof(PetscScalar*),&pcnn->DZ_IN);CHKERRQ(ierr);
DZ_IN = pcnn->DZ_IN;
ierr = PetscMalloc ((n_neigh+1)*sizeof(PetscScalar*),&DZ_OUT);CHKERRQ(ierr);
for (i=0; i<n_neigh; i++) {
size_of_Z += n_shared[i];
}
ierr = PetscMalloc ((size_of_Z+1)*sizeof(PetscScalar),&DZ_IN[0]);CHKERRQ(ierr);
ierr = PetscMalloc ((size_of_Z+1)*sizeof(PetscScalar),&DZ_OUT[0]);CHKERRQ(ierr);
}
for (i=1; i<n_neigh; i++) {
DZ_IN[i] = DZ_IN [i-1] + n_shared[i-1];
DZ_OUT[i] = DZ_OUT[i-1] + n_shared[i-1];
}
/* Set the values of DZ_OUT, in order to send this info to the neighbours */
/* First, set the auxiliary array pcis->work_N. */
ierr = PCISScatterArrayNToVecB(pcis->work_N,pcis->D,INSERT_VALUES,SCATTER_REVERSE,pc);CHKERRQ(ierr);
for (i=1; i<n_neigh; i++){
for (j=0; j<n_shared[i]; j++) {
DZ_OUT[i][j] = pcis->work_N[shared[i][j]];
}
}
/* Non-blocking send/receive the common-interface chunks of scaled nullspaces */
/* Notice that send_request[] and recv_request[] could have one less element. */
/* We make them longer to have request[i] corresponding to neigh[i]. */
{
PetscMPIInt tag;
ierr = PetscObjectGetNewTag((PetscObject)pc,&tag);CHKERRQ(ierr);
ierr = PetscMalloc((2*(n_neigh)+1)*sizeof(MPI_Request),&send_request);CHKERRQ(ierr);
recv_request = send_request + (n_neigh);
for (i=1; i<n_neigh; i++) {
ierr = MPI_Isend((void*)(DZ_OUT[i]),n_shared[i],MPIU_SCALAR,neigh[i],tag,((PetscObject)pc)->comm,&(send_request[i]));CHKERRQ(ierr);
ierr = MPI_Irecv((void*)(DZ_IN [i]),n_shared[i],MPIU_SCALAR,neigh[i],tag,((PetscObject)pc)->comm,&(recv_request[i]));CHKERRQ(ierr);
}
}
/* Set DZ_IN[0][] (recall that neigh[0]==rank, always) */
for(j=0; j<n_shared[0]; j++) {
DZ_IN[0][j] = pcis->work_N[shared[0][j]];
}
/* Start computing with local D*Z while communication goes on. */
/* Apply Schur complement. The result is "stored" in vec (more */
/* precisely, vec points to the result, stored in pc_nn->vec1_B) */
/* and also scattered to pcnn->work_N. */
ierr = PCNNApplySchurToChunk(pc,n_shared[0],shared[0],DZ_IN[0],pcis->work_N,pcis->vec1_B,
pcis->vec2_B,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
/* Compute the first column, while completing the receiving. */
for (i=0; i<n_neigh; i++) {
MPI_Status stat;
PetscMPIInt ind=0;
if (i>0) { ierr = MPI_Waitany(n_neigh-1,recv_request+1,&ind,&stat);CHKERRQ(ierr); ind++;}
mat[ind*n_neigh+0] = 0.0;
for (k=0; k<n_shared[ind]; k++) {
mat[ind*n_neigh+0] += DZ_IN[ind][k] * pcis->work_N[shared[ind][k]];
}
}
/* Compute the remaining of the columns */
for (j=1; j<n_neigh; j++) {
ierr = PCNNApplySchurToChunk(pc,n_shared[j],shared[j],DZ_IN[j],pcis->work_N,pcis->vec1_B,
pcis->vec2_B,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
for (i=0; i<n_neigh; i++) {
mat[i*n_neigh+j] = 0.0;
for (k=0; k<n_shared[i]; k++) {
mat[i*n_neigh+j] += DZ_IN[i][k] * pcis->work_N[shared[i][k]];
}
}
}
/* Complete the sending. */
if (n_neigh>1) {
MPI_Status *stat;
ierr = PetscMalloc((n_neigh-1)*sizeof(MPI_Status),&stat);CHKERRQ(ierr);
if (n_neigh-1) {ierr = MPI_Waitall(n_neigh-1,&(send_request[1]),stat);CHKERRQ(ierr);}
ierr = PetscFree(stat);CHKERRQ(ierr);
}
/* Free the memory for the MPI requests */
ierr = PetscFree(send_request);CHKERRQ(ierr);
/* Free the memory for DZ_OUT */
if (DZ_OUT) {
ierr = PetscFree(DZ_OUT[0]);CHKERRQ(ierr);
ierr = PetscFree(DZ_OUT);CHKERRQ(ierr);
}
{
PetscMPIInt size;
ierr = MPI_Comm_size(((PetscObject)pc)->comm,&size);CHKERRQ(ierr);
/* Create the global coarse vectors (rhs and solution). */
ierr = VecCreateMPI(((PetscObject)pc)->comm,1,size,&(pcnn->coarse_b));CHKERRQ(ierr);
ierr = VecDuplicate(pcnn->coarse_b,&(pcnn->coarse_x));CHKERRQ(ierr);
/* Create and set the global coarse AIJ matrix. */
ierr = MatCreate(((PetscObject)pc)->comm,&(pcnn->coarse_mat));CHKERRQ(ierr);
ierr = MatSetSizes(pcnn->coarse_mat,1,1,size,size);CHKERRQ(ierr);
ierr = MatSetType(pcnn->coarse_mat,MATAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(pcnn->coarse_mat,1,PETSC_NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(pcnn->coarse_mat,1,PETSC_NULL,1,PETSC_NULL);CHKERRQ(ierr);
ierr = MatSetValues(pcnn->coarse_mat,n_neigh,neigh,n_neigh,neigh,mat,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(pcnn->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (pcnn->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
{
PetscMPIInt rank;
PetscScalar one = 1.0;
ierr = MPI_Comm_rank(((PetscObject)pc)->comm,&rank);CHKERRQ(ierr);
/* "Zero out" rows of not-purely-Neumann subdomains */
if (pcis->pure_neumann) { /* does NOT zero the row; create an empty index set. The reason is that MatZeroRows() is collective. */
ierr = MatZeroRows(pcnn->coarse_mat,0,PETSC_NULL,one,0,0);CHKERRQ(ierr);
} else { /* here it DOES zero the row, since it's not a floating subdomain. */
PetscInt row = (PetscInt) rank;
ierr = MatZeroRows(pcnn->coarse_mat,1,&row,one,0,0);CHKERRQ(ierr);
}
}
/* Create the coarse linear solver context */
{
PC pc_ctx, inner_pc;
KSP inner_ksp;
ierr = KSPCreate(((PetscObject)pc)->comm,&pcnn->ksp_coarse);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)pcnn->ksp_coarse,(PetscObject)pc,2);CHKERRQ(ierr);
ierr = KSPSetOperators(pcnn->ksp_coarse,pcnn->coarse_mat,pcnn->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
ierr = KSPGetPC(pcnn->ksp_coarse,&pc_ctx);CHKERRQ(ierr);
ierr = PCSetType(pc_ctx,PCREDUNDANT);CHKERRQ(ierr);
ierr = KSPSetType(pcnn->ksp_coarse,KSPPREONLY);CHKERRQ(ierr);
ierr = PCRedundantGetKSP(pc_ctx,&inner_ksp);CHKERRQ(ierr);
ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
ierr = PCSetType(inner_pc,PCLU);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(pcnn->ksp_coarse,"nn_coarse_");CHKERRQ(ierr);
ierr = KSPSetFromOptions(pcnn->ksp_coarse);CHKERRQ(ierr);
/* the vectors in the following line are dummy arguments, just telling the KSP the vector size. Values are not used */
ierr = KSPSetUp(pcnn->ksp_coarse);CHKERRQ(ierr);
}
/* Free the memory for mat */
ierr = PetscFree(mat);CHKERRQ(ierr);
/* for DEBUGGING, save the coarse matrix to a file. */
{
PetscBool flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL,"-pc_nn_save_coarse_matrix",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
PetscViewer viewer;
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"coarse.m",&viewer);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
ierr = MatView(pcnn->coarse_mat,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
}
/* Set the variable pcnn->factor_coarse_rhs. */
pcnn->factor_coarse_rhs = (pcis->pure_neumann) ? 1.0 : 0.0;
/* See historical note 02, at the bottom of this file. */
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_PCD_Feelpp(PC pc)
{
PetscErrorCode ierr;
PC_PCD_Feelpp *pcpcd = (PC_PCD_Feelpp*)pc->data;
if ( !pcpcd->allocated )
{
ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcpcd->kspAp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)pcpcd->kspAp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetType(pcpcd->kspAp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(pcpcd->kspAp,((PetscObject)pc)->prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(pcpcd->kspAp,"pcd_Ap");CHKERRQ(ierr);
ierr = KSPSetFromOptions(pcpcd->kspAp);CHKERRQ(ierr);
ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcpcd->kspMp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)pcpcd->kspMp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetType(pcpcd->kspMp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(pcpcd->kspMp,((PetscObject)pc)->prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(pcpcd->kspMp,"pcd_Mp");CHKERRQ(ierr);
ierr = KSPSetFromOptions(pcpcd->kspMp);CHKERRQ(ierr);
#if PETSC_VERSION_LESS_THAN(3,6,0)
ierr = MatGetVecs(pcpcd->matFp,&pcpcd->x2,&pcpcd->x1);CHKERRQ(ierr);
#else
ierr = MatCreateVecs(pcpcd->matFp,&pcpcd->x2,&pcpcd->x1);CHKERRQ(ierr);
#endif
pcpcd->allocated = PETSC_TRUE;
}
PetscBool isBTBt;
PetscStrcmp(pcpcd->pcdApType,"BTBt",&isBTBt);
if ( isBTBt )
{
if (!pcpcd->MvDiag )
{
#if PETSC_VERSION_LESS_THAN(3,6,0)
ierr = MatGetVecs(pcpcd->matMv,&pcpcd->MvDiag,NULL);CHKERRQ(ierr);
#else
ierr = MatCreateVecs(pcpcd->matMv,&pcpcd->MvDiag,NULL);CHKERRQ(ierr);
#endif
}
Mat B, C;
#if PETSC_VERSION_GREATER_OR_EQUAL_THAN( 3,5,0 )
ierr = MatSchurComplementGetSubMatrices(pc->mat,NULL,NULL,&B,&C,NULL);CHKERRQ(ierr);
#else
ierr = MatSchurComplementGetSubmatrices(pc->mat,NULL,NULL,&B,&C,NULL);CHKERRQ(ierr);
#endif
ierr = MatGetDiagonal(pcpcd->matMv,pcpcd->MvDiag);CHKERRQ(ierr);
ierr = VecReciprocal(pcpcd->MvDiag);CHKERRQ(ierr);
// diag(F)^-1 * B
ierr = MatDiagonalScale( B, pcpcd->MvDiag ,NULL);CHKERRQ(ierr);
// C* diag(F)^-1 * B
if ( !pcpcd->matApBTBt )
ierr = MatMatMult(C,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcpcd->matApBTBt);
else
ierr = MatMatMult(C,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcpcd->matApBTBt);
CHKERRQ(ierr);
ierr = VecReciprocal(pcpcd->MvDiag);CHKERRQ(ierr);
ierr = MatDiagonalScale( B, pcpcd->MvDiag ,NULL);CHKERRQ(ierr);
pcpcd->matAp = pcpcd->matApBTBt;
}
else
pcpcd->matAp = pcpcd->matApLaplacian;
#if PETSC_VERSION_GREATER_OR_EQUAL_THAN( 3,5,0 )
ierr = KSPSetOperators(pcpcd->kspAp,pcpcd->matAp,pcpcd->matAp);CHKERRQ(ierr);
ierr = KSPSetOperators(pcpcd->kspMp,pcpcd->matMp,pcpcd->matMp);CHKERRQ(ierr);
#else
ierr = KSPSetOperators(pcpcd->kspAp,pcpcd->matAp,pcpcd->matAp,SAME_PRECONDITIONER);CHKERRQ(ierr);
ierr = KSPSetOperators(pcpcd->kspMp,pcpcd->matMp,pcpcd->matMp,SAME_PRECONDITIONER);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_Redundant(PC pc)
{
PC_Redundant *red = (PC_Redundant*)pc->data;
PetscErrorCode ierr;
PetscInt mstart,mend,mlocal,m,mlocal_sub,rstart_sub,rend_sub,mloc_sub;
PetscMPIInt size;
MatReuse reuse = MAT_INITIAL_MATRIX;
MatStructure str = DIFFERENT_NONZERO_PATTERN;
MPI_Comm comm = ((PetscObject)pc)->comm,subcomm;
Vec vec;
PetscMPIInt subsize,subrank;
const char *prefix;
const PetscInt *range;
PetscFunctionBegin;
ierr = MatGetVecs(pc->pmat,&vec,0);CHKERRQ(ierr);
ierr = VecGetSize(vec,&m);CHKERRQ(ierr);
if (!pc->setupcalled) {
if (!red->psubcomm) {
ierr = PetscSubcommCreate(comm,red->nsubcomm,&red->psubcomm);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(pc,sizeof(PetscSubcomm));CHKERRQ(ierr);
/* create a new PC that processors in each subcomm have copy of */
subcomm = red->psubcomm->comm;
ierr = KSPCreate(subcomm,&red->ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)red->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent(pc,red->ksp);CHKERRQ(ierr);
ierr = KSPSetType(red->ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(red->ksp,&red->pc);CHKERRQ(ierr);
ierr = PCSetType(red->pc,PCLU);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(red->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(red->ksp,"redundant_");CHKERRQ(ierr);
} else {
subcomm = red->psubcomm->comm;
}
/* create working vectors xsub/ysub and xdup/ydup */
ierr = VecGetLocalSize(vec,&mlocal);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(vec,&mstart,&mend);CHKERRQ(ierr);
/* get local size of xsub/ysub */
ierr = MPI_Comm_size(subcomm,&subsize);CHKERRQ(ierr);
ierr = MPI_Comm_rank(subcomm,&subrank);CHKERRQ(ierr);
ierr = MatGetOwnershipRanges(pc->pmat,&range);CHKERRQ(ierr);
rstart_sub = range[red->psubcomm->n*subrank]; /* rstart in xsub/ysub */
if (subrank+1 < subsize){
rend_sub = range[red->psubcomm->n*(subrank+1)];
} else {
rend_sub = m;
}
mloc_sub = rend_sub - rstart_sub;
ierr = VecCreateMPI(subcomm,mloc_sub,PETSC_DECIDE,&red->ysub);CHKERRQ(ierr);
/* create xsub with empty local arrays, because xdup's arrays will be placed into it */
ierr = VecCreateMPIWithArray(subcomm,mloc_sub,PETSC_DECIDE,PETSC_NULL,&red->xsub);CHKERRQ(ierr);
/* create xdup and ydup. ydup has empty local arrays because ysub's arrays will be place into it.
Note: we use communicator dupcomm, not ((PetscObject)pc)->comm! */
ierr = VecCreateMPI(red->psubcomm->dupparent,mloc_sub,PETSC_DECIDE,&red->xdup);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(red->psubcomm->dupparent,mloc_sub,PETSC_DECIDE,PETSC_NULL,&red->ydup);CHKERRQ(ierr);
/* create vec scatters */
if (!red->scatterin){
IS is1,is2;
PetscInt *idx1,*idx2,i,j,k;
ierr = PetscMalloc2(red->psubcomm->n*mlocal,PetscInt,&idx1,red->psubcomm->n*mlocal,PetscInt,&idx2);CHKERRQ(ierr);
j = 0;
for (k=0; k<red->psubcomm->n; k++){
for (i=mstart; i<mend; i++){
idx1[j] = i;
idx2[j++] = i + m*k;
}
}
ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx1,&is1);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx2,&is2);CHKERRQ(ierr);
ierr = VecScatterCreate(vec,is1,red->xdup,is2,&red->scatterin);CHKERRQ(ierr);
ierr = ISDestroy(is1);CHKERRQ(ierr);
ierr = ISDestroy(is2);CHKERRQ(ierr);
ierr = ISCreateStride(comm,mlocal,mstart+ red->psubcomm->color*m,1,&is1);CHKERRQ(ierr);
ierr = ISCreateStride(comm,mlocal,mstart,1,&is2);CHKERRQ(ierr);
ierr = VecScatterCreate(red->xdup,is1,vec,is2,&red->scatterout);CHKERRQ(ierr);
ierr = ISDestroy(is1);CHKERRQ(ierr);
ierr = ISDestroy(is2);CHKERRQ(ierr);
ierr = PetscFree2(idx1,idx2);CHKERRQ(ierr);
}
}
ierr = VecDestroy(vec);CHKERRQ(ierr);
/* if pmatrix set by user is sequential then we do not need to gather the parallel matrix */
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size == 1) {
red->useparallelmat = PETSC_FALSE;
}
if (red->useparallelmat) {
if (pc->setupcalled == 1 && pc->flag == DIFFERENT_NONZERO_PATTERN) {
/* destroy old matrices */
if (red->pmats) {
ierr = MatDestroy(red->pmats);CHKERRQ(ierr);
}
} else if (pc->setupcalled == 1) {
reuse = MAT_REUSE_MATRIX;
str = SAME_NONZERO_PATTERN;
}
/* grab the parallel matrix and put it into processors of a subcomminicator */
/*--------------------------------------------------------------------------*/
ierr = VecGetLocalSize(red->ysub,&mlocal_sub);CHKERRQ(ierr);
ierr = MatGetRedundantMatrix(pc->pmat,red->psubcomm->n,red->psubcomm->comm,mlocal_sub,reuse,&red->pmats);CHKERRQ(ierr);
/* tell PC of the subcommunicator its operators */
ierr = KSPSetOperators(red->ksp,red->pmats,red->pmats,str);CHKERRQ(ierr);
} else {
ierr = KSPSetOperators(red->ksp,pc->mat,pc->pmat,pc->flag);CHKERRQ(ierr);
}
if (pc->setfromoptionscalled){
ierr = KSPSetFromOptions(red->ksp);CHKERRQ(ierr);
}
ierr = KSPSetUp(red->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void createInnerKsp(LocalData* data) {
int rank, npes;
MPI_Comm_rank(data->commAll, &rank);
MPI_Comm_size(data->commAll, &npes);
if((rank%2) == 0) {
if(rank < (npes - 1)) {
KSPCreate(data->commLow, &(data->lowSchurKsp));
PetscObjectIncrementTabLevel((PetscObject)(data->lowSchurKsp), PETSC_NULL, 1);
KSPSetType(data->lowSchurKsp, KSPFGMRES);
KSPSetTolerances(data->lowSchurKsp, 1.0e-12, 1.0e-12, PETSC_DEFAULT, 2);
KSPSetOptionsPrefix(data->lowSchurKsp, "inner_");
PC pc;
KSPGetPC(data->lowSchurKsp, &pc);
PCSetType(pc, PCNONE);
KSPSetFromOptions(data->lowSchurKsp);
KSPSetOperators(data->lowSchurKsp, data->lowSchurMat,
data->lowSchurMat, SAME_NONZERO_PATTERN);
KSPSetUp(data->lowSchurKsp);
} else {
data->lowSchurKsp = PETSC_NULL;
}
} else {
KSPCreate(data->commHigh, &(data->highSchurKsp));
PetscObjectIncrementTabLevel((PetscObject)(data->highSchurKsp), PETSC_NULL, 1);
KSPSetType(data->highSchurKsp, KSPFGMRES);
KSPSetTolerances(data->highSchurKsp, 1.0e-12, 1.0e-12, PETSC_DEFAULT, 2);
KSPSetOptionsPrefix(data->highSchurKsp, "inner_");
PC pc;
KSPGetPC(data->highSchurKsp, &pc);
PCSetType(pc, PCNONE);
KSPSetFromOptions(data->highSchurKsp);
KSPSetOperators(data->highSchurKsp, data->highSchurMat,
data->highSchurMat, SAME_NONZERO_PATTERN);
KSPSetUp(data->highSchurKsp);
}
if((rank%2) == 0) {
if(rank > 0) {
KSPCreate(data->commHigh, &(data->highSchurKsp));
PetscObjectIncrementTabLevel((PetscObject)(data->highSchurKsp), PETSC_NULL, 1);
KSPSetType(data->highSchurKsp, KSPFGMRES);
KSPSetTolerances(data->highSchurKsp, 1.0e-12, 1.0e-12, PETSC_DEFAULT, 2);
KSPSetOptionsPrefix(data->highSchurKsp, "inner_");
PC pc;
KSPGetPC(data->highSchurKsp, &pc);
PCSetType(pc, PCNONE);
KSPSetFromOptions(data->highSchurKsp);
KSPSetOperators(data->highSchurKsp, data->highSchurMat,
data->highSchurMat, SAME_NONZERO_PATTERN);
KSPSetUp(data->highSchurKsp);
} else {
data->highSchurKsp = PETSC_NULL;
}
} else {
if(rank < (npes - 1)) {
KSPCreate(data->commLow, &(data->lowSchurKsp));
PetscObjectIncrementTabLevel((PetscObject)(data->lowSchurKsp), PETSC_NULL, 1);
KSPSetType(data->lowSchurKsp, KSPFGMRES);
KSPSetTolerances(data->lowSchurKsp, 1.0e-12, 1.0e-12, PETSC_DEFAULT, 2);
KSPSetOptionsPrefix(data->lowSchurKsp, "inner_");
PC pc;
KSPGetPC(data->lowSchurKsp, &pc);
PCSetType(pc, PCNONE);
KSPSetFromOptions(data->lowSchurKsp);
KSPSetOperators(data->lowSchurKsp, data->lowSchurMat,
data->lowSchurMat, SAME_NONZERO_PATTERN);
KSPSetUp(data->lowSchurKsp);
} else {
data->lowSchurKsp = PETSC_NULL;
}
}
}
/*@C
DMMGSetKSP - Sets the linear solver object that will use the grid hierarchy
Collective on DMMG
Input Parameter:
+ dmmg - the context
. func - function to compute linear system matrix on each grid level
- rhs - function to compute right hand side on each level (need only work on the finest grid
if you do not use grid sequencing)
Level: advanced
Notes: For linear problems my be called more than once, reevaluates the matrices if it is called more
than once. Call DMMGSolve() directly several times to solve with the same matrix but different
right hand sides.
.seealso DMMGCreate(), DMMGDestroy, DMMGSetDM(), DMMGSolve(), DMMGSetMatType()
@*/
PetscErrorCode PETSCSNES_DLLEXPORT DMMGSetKSP(DMMG *dmmg,PetscErrorCode (*rhs)(DMMG,Vec),PetscErrorCode (*func)(DMMG,Mat,Mat))
{
PetscErrorCode ierr;
PetscInt i,nlevels = dmmg[0]->nlevels,level;
PetscTruth ismg,galerkin=PETSC_FALSE;
PC pc;
KSP lksp;
PetscFunctionBegin;
if (!dmmg) SETERRQ(PETSC_ERR_ARG_NULL,"Passing null as DMMG");
if (!dmmg[0]->ksp) {
/* create solvers for each level if they don't already exist*/
for (i=0; i<nlevels; i++) {
ierr = KSPCreate(dmmg[i]->comm,&dmmg[i]->ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)dmmg[i]->ksp,PETSC_NULL,nlevels-i);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(dmmg[i]->ksp,dmmg[i]->prefix);CHKERRQ(ierr);
ierr = DMMGSetUpLevel(dmmg,dmmg[i]->ksp,i+1);CHKERRQ(ierr);
ierr = KSPSetFromOptions(dmmg[i]->ksp);CHKERRQ(ierr);
/* if the multigrid is being run with Galerkin then these matrices do not need to be created except on the finest level
we do not take advantage of this because it may be that Galerkin has not yet been selected for the KSP object
These are also used if grid sequencing is selected for the linear problem. We should probably turn off grid sequencing
for the linear problem */
if (!dmmg[i]->B) {
ierr = DMGetMatrix(dmmg[i]->dm,dmmg[nlevels-1]->mtype,&dmmg[i]->B);CHKERRQ(ierr);
}
if (!dmmg[i]->J) {
dmmg[i]->J = dmmg[i]->B;
ierr = PetscObjectReference((PetscObject) dmmg[i]->J);CHKERRQ(ierr);
}
dmmg[i]->solve = DMMGSolveKSP;
dmmg[i]->rhs = rhs;
}
}
/* evalute matrix on each level */
ierr = KSPGetPC(dmmg[nlevels-1]->ksp,&pc);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)pc,PCMG,&ismg);CHKERRQ(ierr);
if (ismg) {
ierr = PCMGGetGalerkin(pc,&galerkin);CHKERRQ(ierr);
}
if (func) {
if (galerkin) {
ierr = (*func)(dmmg[nlevels-1],dmmg[nlevels-1]->J,dmmg[nlevels-1]->B);CHKERRQ(ierr);
} else {
for (i=0; i<nlevels; i++) {
ierr = (*func)(dmmg[i],dmmg[i]->J,dmmg[i]->B);CHKERRQ(ierr);
}
}
}
for (i=0; i<nlevels-1; i++) {
ierr = KSPSetOptionsPrefix(dmmg[i]->ksp,"dmmg_");CHKERRQ(ierr);
}
for (level=0; level<nlevels; level++) {
ierr = KSPSetOperators(dmmg[level]->ksp,dmmg[level]->J,dmmg[level]->B,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPGetPC(dmmg[level]->ksp,&pc);CHKERRQ(ierr);
if (ismg) {
for (i=0; i<=level; i++) {
ierr = PCMGGetSmoother(pc,i,&lksp);CHKERRQ(ierr);
ierr = KSPSetOperators(lksp,dmmg[i]->J,dmmg[i]->B,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_Redundant(PC pc)
{
PC_Redundant *red = (PC_Redundant*)pc->data;
PetscErrorCode ierr;
PetscInt mstart,mend,mlocal,M;
PetscMPIInt size;
MPI_Comm comm,subcomm;
Vec x;
const char *prefix;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
/* if pmatrix set by user is sequential then we do not need to gather the parallel matrix */
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size == 1) red->useparallelmat = PETSC_FALSE;
if (!pc->setupcalled) {
PetscInt mloc_sub;
if (!red->psubcomm) {
ierr = PetscSubcommCreate(comm,&red->psubcomm);CHKERRQ(ierr);
ierr = PetscSubcommSetNumber(red->psubcomm,red->nsubcomm);CHKERRQ(ierr);
ierr = PetscSubcommSetType(red->psubcomm,PETSC_SUBCOMM_CONTIGUOUS);CHKERRQ(ierr);
/* enable runtime switch of psubcomm type, e.g., '-psubcomm_type interlaced */
ierr = PetscSubcommSetFromOptions(red->psubcomm);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)pc,sizeof(PetscSubcomm));CHKERRQ(ierr);
/* create a new PC that processors in each subcomm have copy of */
subcomm = PetscSubcommChild(red->psubcomm);
ierr = KSPCreate(subcomm,&red->ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(red->ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)red->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)red->ksp);CHKERRQ(ierr);
ierr = KSPSetType(red->ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(red->ksp,&red->pc);CHKERRQ(ierr);
ierr = PCSetType(red->pc,PCLU);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(red->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(red->ksp,"redundant_");CHKERRQ(ierr);
} else {
subcomm = PetscSubcommChild(red->psubcomm);
}
if (red->useparallelmat) {
/* grab the parallel matrix and put it into processors of a subcomminicator */
ierr = MatCreateRedundantMatrix(pc->pmat,red->psubcomm->n,subcomm,MAT_INITIAL_MATRIX,&red->pmats);CHKERRQ(ierr);
ierr = KSPSetOperators(red->ksp,red->pmats,red->pmats);CHKERRQ(ierr);
/* get working vectors xsub and ysub */
ierr = MatCreateVecs(red->pmats,&red->xsub,&red->ysub);CHKERRQ(ierr);
/* create working vectors xdup and ydup.
xdup concatenates all xsub's contigously to form a mpi vector over dupcomm (see PetscSubcommCreate_interlaced())
ydup concatenates all ysub and has empty local arrays because ysub's arrays will be place into it.
Note: we use communicator dupcomm, not PetscObjectComm((PetscObject)pc)! */
ierr = MatGetLocalSize(red->pmats,&mloc_sub,NULL);CHKERRQ(ierr);
ierr = VecCreateMPI(PetscSubcommContiguousParent(red->psubcomm),mloc_sub,PETSC_DECIDE,&red->xdup);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PetscSubcommContiguousParent(red->psubcomm),1,mloc_sub,PETSC_DECIDE,NULL,&red->ydup);CHKERRQ(ierr);
/* create vecscatters */
if (!red->scatterin) { /* efficiency of scatterin is independent from psubcomm_type! */
IS is1,is2;
PetscInt *idx1,*idx2,i,j,k;
ierr = MatCreateVecs(pc->pmat,&x,0);CHKERRQ(ierr);
ierr = VecGetSize(x,&M);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x,&mstart,&mend);CHKERRQ(ierr);
mlocal = mend - mstart;
ierr = PetscMalloc2(red->psubcomm->n*mlocal,&idx1,red->psubcomm->n*mlocal,&idx2);CHKERRQ(ierr);
j = 0;
for (k=0; k<red->psubcomm->n; k++) {
for (i=mstart; i<mend; i++) {
idx1[j] = i;
idx2[j++] = i + M*k;
}
}
ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx1,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx2,PETSC_COPY_VALUES,&is2);CHKERRQ(ierr);
ierr = VecScatterCreate(x,is1,red->xdup,is2,&red->scatterin);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
ierr = ISDestroy(&is2);CHKERRQ(ierr);
/* Impl below is good for PETSC_SUBCOMM_INTERLACED (no inter-process communication) and PETSC_SUBCOMM_CONTIGUOUS (communication within subcomm) */
ierr = ISCreateStride(comm,mlocal,mstart+ red->psubcomm->color*M,1,&is1);CHKERRQ(ierr);
ierr = ISCreateStride(comm,mlocal,mstart,1,&is2);CHKERRQ(ierr);
ierr = VecScatterCreate(red->xdup,is1,x,is2,&red->scatterout);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
ierr = ISDestroy(&is2);CHKERRQ(ierr);
ierr = PetscFree2(idx1,idx2);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
}
} else { /* !red->useparallelmat */
ierr = KSPSetOperators(red->ksp,pc->mat,pc->pmat);CHKERRQ(ierr);
}
} else { /* pc->setupcalled */
if (red->useparallelmat) {
MatReuse reuse;
/* grab the parallel matrix and put it into processors of a subcomminicator */
/*--------------------------------------------------------------------------*/
if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
/* destroy old matrices */
ierr = MatDestroy(&red->pmats);CHKERRQ(ierr);
reuse = MAT_INITIAL_MATRIX;
} else {
reuse = MAT_REUSE_MATRIX;
}
ierr = MatCreateRedundantMatrix(pc->pmat,red->psubcomm->n,PetscSubcommChild(red->psubcomm),reuse,&red->pmats);CHKERRQ(ierr);
ierr = KSPSetOperators(red->ksp,red->pmats,red->pmats);CHKERRQ(ierr);
} else { /* !red->useparallelmat */
ierr = KSPSetOperators(red->ksp,pc->mat,pc->pmat);CHKERRQ(ierr);
}
}
if (pc->setfromoptionscalled) {
ierr = KSPSetFromOptions(red->ksp);CHKERRQ(ierr);
}
ierr = KSPSetUp(red->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESSetUp_Multiblock(SNES snes)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc blocks;
PetscInt i, numBlocks;
PetscErrorCode ierr;
PetscFunctionBegin;
/* ierr = SNESDefaultGetWork(snes, 1);CHKERRQ(ierr); */
ierr = SNESMultiblockSetDefaults(snes);CHKERRQ(ierr);
numBlocks = mb->numBlocks;
blocks = mb->blocks;
/* Create ISs */
if (!mb->issetup) {
PetscInt ccsize, rstart, rend, nslots, bs;
PetscBool sorted;
mb->issetup = PETSC_TRUE;
bs = mb->bs;
ierr = MatGetOwnershipRange(snes->jacobian_pre, &rstart, &rend);CHKERRQ(ierr);
ierr = MatGetLocalSize(snes->jacobian_pre, PETSC_NULL, &ccsize);CHKERRQ(ierr);
nslots = (rend - rstart)/bs;
for (i = 0; i < numBlocks; ++i) {
if (mb->defaultblocks) {
ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+i, numBlocks, &blocks->is);CHKERRQ(ierr);
} else if (!blocks->is) {
if (blocks->nfields > 1) {
PetscInt *ii, j, k, nfields = blocks->nfields, *fields = blocks->fields;
ierr = PetscMalloc(nfields*nslots*sizeof(PetscInt), &ii);CHKERRQ(ierr);
for (j = 0; j < nslots; ++j) {
for (k = 0; k < nfields; ++k) {
ii[nfields*j + k] = rstart + bs*j + fields[k];
}
}
ierr = ISCreateGeneral(((PetscObject) snes)->comm, nslots*nfields, ii, PETSC_OWN_POINTER, &blocks->is);CHKERRQ(ierr);
} else {
ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+blocks->fields[0], bs, &blocks->is);CHKERRQ(ierr);
}
}
ierr = ISSorted(blocks->is, &sorted);CHKERRQ(ierr);
if (!sorted) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Fields must be sorted when creating split");
blocks = blocks->next;
}
}
#if 0
/* Create matrices */
ilink = jac->head;
if (!jac->pmat) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->pmat);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
}
if (jac->realdiagonal) {
ilink = jac->head;
if (!jac->mat) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->mat);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->mat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
if (jac->mat[i]) {ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->mat[i]);CHKERRQ(ierr);}
ilink = ilink->next;
}
}
} else {
jac->mat = jac->pmat;
}
#endif
#if 0
if (jac->type != PC_COMPOSITE_ADDITIVE && jac->type != PC_COMPOSITE_SCHUR) {
/* extract the rows of the matrix associated with each field: used for efficient computation of residual inside algorithm */
ilink = jac->head;
if (!jac->Afield) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->Afield);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_INITIAL_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_REUSE_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
}
}
#endif
if (mb->type == PC_COMPOSITE_SCHUR) {
#if 0
IS ccis;
PetscInt rstart,rend;
if (nsplit != 2) SETERRQ(((PetscObject)pc)->comm,PETSC_ERR_ARG_INCOMP,"To use Schur complement preconditioner you must have exactly 2 fields");
/* When extracting off-diagonal submatrices, we take complements from this range */
ierr = MatGetOwnershipRangeColumn(pc->mat,&rstart,&rend);CHKERRQ(ierr);
/* need to handle case when one is resetting up the preconditioner */
if (jac->schur) {
ilink = jac->head;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->B);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ilink = ilink->next;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->C);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ierr = MatSchurComplementUpdate(jac->schur,jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->pmat[1],pc->flag);CHKERRQ(ierr);
ierr = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),pc->flag);CHKERRQ(ierr);
} else {
KSP ksp;
char schurprefix[256];
/* extract the A01 and A10 matrices */
ilink = jac->head;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->B);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ilink = ilink->next;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->C);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
/* Use mat[0] (diagonal block of the real matrix) preconditioned by pmat[0] */
ierr = MatCreateSchurComplement(jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->mat[1],&jac->schur);CHKERRQ(ierr);
/* set tabbing and options prefix of KSP inside the MatSchur */
ierr = MatSchurComplementGetKSP(jac->schur,&ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ksp,(PetscObject)pc,2);CHKERRQ(ierr);
ierr = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",jac->head->splitname);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(ksp,schurprefix);CHKERRQ(ierr);
ierr = MatSetFromOptions(jac->schur);CHKERRQ(ierr);
ierr = KSPCreate(((PetscObject)pc)->comm,&jac->kspschur);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)jac->kspschur);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)jac->kspschur,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
if (jac->schurpre == PC_FIELDSPLIT_SCHUR_PRE_SELF) {
PC pc;
ierr = KSPGetPC(jac->kspschur,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr);
/* Note: This is bad if there exist preconditioners for MATSCHURCOMPLEMENT */
}
ierr = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",ilink->splitname);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(jac->kspschur,schurprefix);CHKERRQ(ierr);
/* really want setfromoptions called in PCSetFromOptions_FieldSplit(), but it is not ready yet */
ierr = KSPSetFromOptions(jac->kspschur);CHKERRQ(ierr);
ierr = PetscMalloc2(2,Vec,&jac->x,2,Vec,&jac->y);CHKERRQ(ierr);
ierr = MatGetVecs(jac->pmat[0],&jac->x[0],&jac->y[0]);CHKERRQ(ierr);
ierr = MatGetVecs(jac->pmat[1],&jac->x[1],&jac->y[1]);CHKERRQ(ierr);
ilink = jac->head;
ilink->x = jac->x[0]; ilink->y = jac->y[0];
ilink = ilink->next;
ilink->x = jac->x[1]; ilink->y = jac->y[1];
}
#endif
} else {
/* Set up the individual SNESs */
blocks = mb->blocks;
i = 0;
while (blocks) {
/*TODO: Set these correctly */
/*ierr = SNESSetFunction(blocks->snes, blocks->x, func);CHKERRQ(ierr);*/
/*ierr = SNESSetJacobian(blocks->snes, blocks->x, jac);CHKERRQ(ierr);*/
ierr = VecDuplicate(blocks->snes->vec_sol, &blocks->x);CHKERRQ(ierr);
/* really want setfromoptions called in SNESSetFromOptions_Multiblock(), but it is not ready yet */
ierr = SNESSetFromOptions(blocks->snes);CHKERRQ(ierr);
ierr = SNESSetUp(blocks->snes);CHKERRQ(ierr);
blocks = blocks->next;
i++;
}
}
/* Compute scatter contexts needed by multiplicative versions and non-default splits */
if (!mb->blocks->sctx) {
Vec xtmp;
blocks = mb->blocks;
ierr = MatGetVecs(snes->jacobian_pre, &xtmp, PETSC_NULL);CHKERRQ(ierr);
while(blocks) {
ierr = VecScatterCreate(xtmp, blocks->is, blocks->x, PETSC_NULL, &blocks->sctx);CHKERRQ(ierr);
blocks = blocks->next;
}
ierr = VecDestroy(&xtmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
