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);
}
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);
}
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);
}
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 PCCompositeAddPC_Composite(PC pc,PCType type)
{
PC_Composite *jac;
PC_CompositeLink next,ilink;
PetscErrorCode ierr;
PetscInt cnt = 0;
const char *prefix;
char newprefix[8];
PetscFunctionBegin;
ierr = PetscNewLog(pc,&ilink);CHKERRQ(ierr);
ilink->next = 0;
ierr = PCCreate(PetscObjectComm((PetscObject)pc),&ilink->pc);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ilink->pc);CHKERRQ(ierr);
jac = (PC_Composite*)pc->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 = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = PCSetOptionsPrefix(ilink->pc,prefix);CHKERRQ(ierr);
sprintf(newprefix,"sub_%d_",(int)cnt);
ierr = PCAppendOptionsPrefix(ilink->pc,newprefix);CHKERRQ(ierr);
/* type is set after prefix, because some methods may modify prefix, e.g. pcksp */
ierr = PCSetType(ilink->pc,type);CHKERRQ(ierr);
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);
}
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);
}
/*
I should not modify setup called!!
This is handled via petsc.
*/
PetscErrorCode BSSCR_PCSetUp_GtKG( PC pc )
{
PC_GtKG ctx = (PC_GtKG)pc->data;
PetscReal fill;
Mat Ident;
Vec diag;
PetscInt M,N, m,n;
MPI_Comm comm;
PetscInt nnz_I, nnz_G;
const MatType mtype;
const char *prefix;
PetscTruth wasSetup;
if( ctx->K == PETSC_NULL ) {
Stg_SETERRQ( PETSC_ERR_SUP, "gtkg: K not set" );
}
if( ctx->G == PETSC_NULL ) {
Stg_SETERRQ( PETSC_ERR_SUP, "gtkg: G not set" );
}
PetscObjectGetComm( (PetscObject)ctx->K, &comm );
/* Check for existence of objects and trash any which exist */
if( ctx->form_GtG == PETSC_TRUE && ctx->GtG != PETSC_NULL ) {
Stg_MatDestroy(&ctx->GtG );
ctx->GtG = PETSC_NULL;
}
if( ctx->s != PETSC_NULL ) {
Stg_VecDestroy(&ctx->s );
ctx->s = PETSC_NULL;
}
if( ctx->X != PETSC_NULL ) {
Stg_VecDestroy(&ctx->X );
ctx->X = PETSC_NULL;
}
if( ctx->t != PETSC_NULL ) {
Stg_VecDestroy(&ctx->t );
ctx->t = PETSC_NULL;
}
if( ctx->inv_diag_M != PETSC_NULL ) {
Stg_VecDestroy(&ctx->inv_diag_M );
ctx->inv_diag_M = PETSC_NULL;
}
/* Create vectors */
MatGetVecs( ctx->K, &ctx->s, &ctx->X );
MatGetVecs( ctx->G, &ctx->t, PETSC_NULL );
if( ctx->M != PETSC_NULL ) {
MatGetVecs( ctx->K, &ctx->inv_diag_M, PETSC_NULL );
MatGetDiagonal( ctx->M, ctx->inv_diag_M );
VecReciprocal( ctx->inv_diag_M );
/* change the pc_apply routines */
pc->ops->apply = BSSCR_BSSCR_PCApply_GtKG_diagonal_scaling;
pc->ops->applytranspose = BSSCR_BSSCR_PCApplyTranspose_GtKG_diagonal_scaling;
}
/* Assemble GtG */
MatGetSize( ctx->G, &M, &N );
MatGetLocalSize( ctx->G, &m, &n );
MatGetVecs( ctx->G, PETSC_NULL, &diag );
VecSet( diag, 1.0 );
MatCreate( comm, &Ident );
MatSetSizes( Ident, m,m , M, M );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(Ident);
#endif
MatGetType( ctx->G, &mtype );
MatSetType( Ident, mtype );
if( ctx->M == PETSC_NULL ) {
MatDiagonalSet( Ident, diag, INSERT_VALUES );
}
else {
MatDiagonalSet( Ident, ctx->inv_diag_M, INSERT_VALUES );
}
BSSCR_get_number_nonzeros_AIJ( Ident, &nnz_I );
BSSCR_get_number_nonzeros_AIJ( ctx->G, &nnz_G );
//fill = 1.0;
/*
Not sure the best way to estimate the fill factor.
GtG is a laplacian on the pressure space.
This might tell us something useful...
*/
fill = (PetscReal)(nnz_G)/(PetscReal)( nnz_I );
MatPtAP( Ident, ctx->G, MAT_INITIAL_MATRIX, fill, &ctx->GtG );
Stg_MatDestroy(&Ident);
Stg_VecDestroy(&diag );
Stg_KSPSetOperators( ctx->ksp, ctx->GtG, ctx->GtG, SAME_NONZERO_PATTERN );
if (!pc->setupcalled) {
wasSetup = PETSC_FALSE;
PCGetOptionsPrefix( pc,&prefix );
KSPSetOptionsPrefix( ctx->ksp, prefix );
KSPAppendOptionsPrefix( ctx->ksp, "pc_gtkg_" ); /* -pc_GtKG_ksp_type <type>, -ksp_GtKG_pc_type <type> */
}
else {
wasSetup = PETSC_TRUE;
}
// if (!wasSetup && pc->setfromoptionscalled) {
if (!wasSetup) {
KSPSetFromOptions(ctx->ksp);
}
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);
}
/*
Builds
B Y1 X1 Bt
and creates a ksp when C=0, otherwise it builds
B Y1 X1 Bt - C
*/
PetscErrorCode BSSCR_PCScGtKGUseStandardBBtOperator( PC pc )
{
PC_SC_GtKG ctx = (PC_SC_GtKG)pc->data;
PetscReal fill;
Mat diag_mat,C;
Vec diag;
PetscInt M,N, m,n;
MPI_Comm comm;
PetscInt nnz_I, nnz_G;
MatType mtype;
const char *prefix;
Mat BBt;
KSP ksp;
PetscTruth ivalue, flg, has_cnst_nullsp;
BSSCR_BSSCR_pc_error_ScGtKG( pc, __func__ );
/* Assemble BBt */
MatGetSize( ctx->Bt, &M, &N );
MatGetLocalSize( ctx->Bt, &m, &n );
MatGetVecs( ctx->Bt, PETSC_NULL, &diag );
/* Define diagonal matrix Y1 X1 */
VecPointwiseMult( diag, ctx->Y1, ctx->X1 );
PetscObjectGetComm( (PetscObject)ctx->F, &comm );
MatCreate( comm, &diag_mat );
MatSetSizes( diag_mat, m,m , M, M );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(diag_mat);
#endif
MatGetType( ctx->Bt, &mtype );
MatSetType( diag_mat, mtype );
MatDiagonalSet( diag_mat, diag, INSERT_VALUES );
/* Build operator B Y1 X1 Bt */
BSSCR_BSSCR_get_number_nonzeros_AIJ_ScGtKG( diag_mat, &nnz_I );
BSSCR_BSSCR_get_number_nonzeros_AIJ_ScGtKG( ctx->Bt, &nnz_G );
/*
Not sure the best way to estimate the fill factor.
BBt is a laplacian on the pressure space.
This might tell us something useful...
*/
fill = (PetscReal)(nnz_G)/(PetscReal)( nnz_I );
MatPtAP( diag_mat, ctx->Bt, MAT_INITIAL_MATRIX, fill, &BBt );
Stg_MatDestroy(&diag_mat );
Stg_VecDestroy(&diag );
C = ctx->C;
if( C !=PETSC_NULL ) {
MatAXPY( BBt, -1.0, C, DIFFERENT_NONZERO_PATTERN );
}
/* Build the solver */
KSPCreate( ((PetscObject)pc)->comm, &ksp );
Stg_KSPSetOperators( ksp, BBt, BBt, SAME_NONZERO_PATTERN );
PCGetOptionsPrefix( pc,&prefix );
KSPSetOptionsPrefix( ksp, prefix );
KSPAppendOptionsPrefix( ksp, "pc_gtkg_" ); /* -pc_GtKG_ksp_type <type>, -ksp_GtKG_pc_type <type> */
BSSCR_PCScGtKGSetKSP( pc, ksp );
BSSCR_MatContainsConstNullSpace( BBt, NULL, &has_cnst_nullsp );
if( has_cnst_nullsp == PETSC_TRUE ) {
BSSCR_PCScGtKGAttachNullSpace( pc );
}
PetscOptionsGetTruth( PETSC_NULL, "-pc_gtkg_monitor", &ivalue, &flg );
BSSCR_PCScGtKGSetSubKSPMonitor( pc, ivalue );
Stg_KSPDestroy(&ksp);
Stg_MatDestroy(&BBt);
PetscFunctionReturn(0);
}
