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);
}
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);
}
/*@
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);
}
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 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 PCBDDCNullSpaceAdaptGlobal(PC pc)
{
PC_IS* pcis = (PC_IS*)(pc->data);
PC_BDDC* pcbddc = (PC_BDDC*)(pc->data);
KSP inv_change;
const Vec *nsp_vecs;
Vec *new_nsp_vecs;
PetscInt i,nsp_size,new_nsp_size,start_new;
PetscBool nsp_has_cnst;
MatNullSpace new_nsp;
PetscErrorCode ierr;
PetscFunctionBegin;
/* create KSP for change of basis */
ierr = MatGetSize(pcbddc->ChangeOfBasisMatrix,&i,NULL);CHKERRQ(ierr);
ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&inv_change);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(inv_change,pc->erroriffailure);CHKERRQ(ierr);
ierr = KSPSetOperators(inv_change,pcbddc->ChangeOfBasisMatrix,pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
ierr = KSPSetTolerances(inv_change,1.e-8,1.e-8,PETSC_DEFAULT,2*i);CHKERRQ(ierr);
if (pcbddc->dbg_flag) {
ierr = KSPMonitorSet(inv_change,KSPMonitorDefault,pcbddc->dbg_viewer,NULL);CHKERRQ(ierr);
}
ierr = KSPSetUp(inv_change);CHKERRQ(ierr);
/* get nullspace and transform it */
ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr);
new_nsp_size = nsp_size;
if (nsp_has_cnst) {
new_nsp_size++;
}
ierr = VecDuplicateVecs(pcis->vec1_global,new_nsp_size,&new_nsp_vecs);CHKERRQ(ierr);
start_new = 0;
if (nsp_has_cnst) {
start_new = 1;
ierr = VecSet(new_nsp_vecs[0],1.0);CHKERRQ(ierr);
if (pcbddc->dbg_flag) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Mapping constant in nullspace\n");CHKERRQ(ierr);
}
ierr = KSPSolve(inv_change,new_nsp_vecs[0],new_nsp_vecs[0]);CHKERRQ(ierr);
}
for (i=0;i<nsp_size;i++) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Mapping %dth vector in nullspace\n",i);CHKERRQ(ierr);
ierr = KSPSolve(inv_change,nsp_vecs[i],new_nsp_vecs[i+start_new]);CHKERRQ(ierr);
}
ierr = PCBDDCOrthonormalizeVecs(new_nsp_size,new_nsp_vecs);CHKERRQ(ierr);
ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)pc),PETSC_FALSE,new_nsp_size,new_nsp_vecs,&new_nsp);CHKERRQ(ierr);
ierr = PCBDDCSetNullSpace(pc,new_nsp);CHKERRQ(ierr);
/* free */
ierr = KSPDestroy(&inv_change);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&new_nsp);CHKERRQ(ierr);
ierr = VecDestroyVecs(new_nsp_size,&new_nsp_vecs);CHKERRQ(ierr);
/* check */
if (pcbddc->dbg_flag) {
PetscBool nsp_t=PETSC_FALSE;
Mat temp_mat;
Mat_IS* matis = (Mat_IS*)pc->pmat->data;
temp_mat = matis->A;
matis->A = pcbddc->local_mat;
pcbddc->local_mat = temp_mat;
ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr);
ierr = PetscPrintf(PetscObjectComm((PetscObject)(pc->pmat)),"Check nullspace with change of basis: %d\n",nsp_t);CHKERRQ(ierr);
temp_mat = matis->A;
matis->A = pcbddc->local_mat;
pcbddc->local_mat = temp_mat;
}
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);
}
/*
PCISSetUp -
*/
PetscErrorCode PCISSetUp(PC pc, PetscBool computesolvers)
{
PC_IS *pcis = (PC_IS*)(pc->data);
Mat_IS *matis;
MatReuse reuse;
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;
/* first time creation, get info on substructuring */
if (!pc->setupcalled) {
PetscInt n_I;
PetscInt *idx_I_local,*idx_B_local,*idx_I_global,*idx_B_global;
PetscBT bt;
PetscInt i,j;
/* get info on mapping */
ierr = PetscObjectReference((PetscObject)pc->pmat->rmap->mapping);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingDestroy(&pcis->mapping);CHKERRQ(ierr);
pcis->mapping = pc->pmat->rmap->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);
/* Identifying interior and interface nodes, in local numbering */
ierr = PetscBTCreate(pcis->n,&bt);CHKERRQ(ierr);
for (i=0;i<pcis->n_neigh;i++)
for (j=0;j<pcis->n_shared[i];j++) {
ierr = PetscBTSet(bt,pcis->shared[i][j]);CHKERRQ(ierr);
}
/* Creating local and global index sets for interior and inteface nodes. */
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 (!PetscBTLookup(bt,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 */
ierr = PetscFree(idx_B_local);CHKERRQ(ierr);
ierr = PetscFree(idx_I_local);CHKERRQ(ierr);
ierr = PetscBTDestroy(&bt);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);
/* scaling vector */
if (!pcis->D) { /* it can happen that the user passed in a scaling vector via PCISSetSubdomainDiagonalScaling */
ierr = VecDuplicate(pcis->vec1_B,&pcis->D);CHKERRQ(ierr);
ierr = VecSet(pcis->D,pcis->scaling_factor);CHKERRQ(ierr);
}
/* Creating the scatter contexts */
ierr = VecScatterCreate(pcis->vec1_N,pcis->is_I_local,pcis->vec1_D,(IS)0,&pcis->N_to_D);CHKERRQ(ierr);
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);
/* map from boundary to local */
ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&pcis->BtoNmap);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 ]
*/
reuse = MAT_INITIAL_MATRIX;
if (pcis->reusesubmatrices && pc->setupcalled) {
if (pc->flag == SAME_NONZERO_PATTERN) {
reuse = MAT_REUSE_MATRIX;
} else {
reuse = MAT_INITIAL_MATRIX;
}
}
if (reuse == MAT_INITIAL_MATRIX) {
ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
}
ierr = MatGetSubMatrix(matis->A,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
ierr = MatGetSubMatrix(matis->A,pcis->is_B_local,pcis->is_B_local,reuse,&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,reuse,&pcis->A_IB);CHKERRQ(ierr);
ierr = MatGetSubMatrix(matis->A,pcis->is_B_local,pcis->is_I_local,reuse,&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,reuse,&pcis->A_IB);CHKERRQ(ierr);
ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
ierr = MatDestroy(&newmat);CHKERRQ(ierr);
}
/* Creating scaling vector D */
ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_is_use_stiffness_scaling",&pcis->use_stiffness_scaling,NULL);CHKERRQ(ierr);
if (pcis->use_stiffness_scaling) {
ierr = MatGetDiagonal(pcis->A_BB,pcis->D);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->D,counter,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(pcis->global_to_B,pcis->D,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 (computesolvers) {
PC pc_ctx;
pcis->pure_neumann = matis->pure_neumann;
/* Dirichlet */
ierr = KSPCreate(PETSC_COMM_SELF,&pcis->ksp_D);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(pcis->ksp_D,pc->erroriffailure);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 = KSPSetErrorIfNotConverged(pcis->ksp_N,pc->erroriffailure);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)->options,((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)->options,((PetscObject)pc_ctx)->prefix,"-pc_is_damp_fixed",&damp_fixed,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(((PetscObject)pc_ctx)->options,((PetscObject)pc_ctx)->prefix,"-pc_is_remove_nullspace_fixed",&remove_nullspace_fixed,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(((PetscObject)pc_ctx)->options,((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)->options,((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)->options,((PetscObject)pc_ctx)->prefix,"-pc_is_not_damp_floating",¬_damp_floating,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(((PetscObject)pc_ctx)->options,((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 = MatSetNullSpace(matis->A,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 = MatSetNullSpace(matis->A,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);
}
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);
}
