PetscErrorCode MatPartitioningHierarchical_AssembleSubdomain(Mat adj,IS destination,Mat *sadj, ISLocalToGlobalMapping *mapping)
{
IS irows,icols;
PetscInt irows_ln;
PetscMPIInt rank;
const PetscInt *irows_indices;
MPI_Comm comm;
PetscErrorCode ierr;
PetscFunctionBegin;
/*get comm*/
ierr = PetscObjectGetComm((PetscObject)adj,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
/*get rows from remote and local */
ierr = ISBuildTwoSided(destination,NULL,&irows);CHKERRQ(ierr);
ierr = ISDuplicate(irows,&icols);CHKERRQ(ierr);
/*get rows information */
ierr = ISGetLocalSize(irows,&irows_ln);CHKERRQ(ierr);
ierr = ISGetIndices(irows,&irows_indices);CHKERRQ(ierr);
/* create a mapping from local to global */
ierr = ISLocalToGlobalMappingCreate(comm,1,irows_ln,irows_indices,PETSC_COPY_VALUES,mapping);CHKERRQ(ierr);
ierr = ISRestoreIndices(irows,&irows_indices);CHKERRQ(ierr);
/* extract a submatrix*/
ierr = MatGetSubMatrices(adj,1,&irows,&icols,MAT_INITIAL_MATRIX,&sadj);CHKERRQ(ierr);
ierr = ISDestroy(&irows);CHKERRQ(ierr);
ierr = ISDestroy(&icols);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
ISInvertPermutation - Creates a new permutation that is the inverse of
a given permutation.
Collective on IS
Input Parameter:
+ is - the index set
- nlocal - number of indices on this processor in result (ignored for 1 proccessor) or
use PETSC_DECIDE
Output Parameter:
. isout - the inverse permutation
Level: intermediate
Notes: For parallel index sets this does the complete parallel permutation, but the
code is not efficient for huge index sets (10,000,000 indices).
Concepts: inverse permutation
Concepts: permutation^inverse
Concepts: index sets^inverting
@*/
PetscErrorCode ISInvertPermutation(IS is,PetscInt nlocal,IS *isout)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(isout,3);
if (!is->isperm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Not a permutation, must call ISSetPermutation() on the IS first");
if (is->isidentity) {
ierr = ISDuplicate(is,isout);
CHKERRQ(ierr);
} else {
ierr = (*is->ops->invertpermutation)(is,nlocal,isout);
CHKERRQ(ierr);
ierr = ISSetPermutation(*isout);
CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESSolve_VINEWTONRSLS(SNES snes)
{
SNES_VINEWTONRSLS *vi = (SNES_VINEWTONRSLS*)snes->data;
PetscErrorCode ierr;
PetscInt maxits,i,lits;
PetscBool lssucceed;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscReal fnorm,gnorm,xnorm=0,ynorm;
Vec Y,X,F;
KSPConvergedReason kspreason;
PetscFunctionBegin;
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->work[0]; /* work vectors */
ierr = SNESLineSearchSetVIFunctions(snes->linesearch, SNESVIProjectOntoBounds, SNESVIComputeInactiveSetFnorm);CHKERRQ(ierr);
ierr = SNESLineSearchSetVecs(snes->linesearch, X, PETSC_NULL, PETSC_NULL, PETSC_NULL, PETSC_NULL);CHKERRQ(ierr);
ierr = SNESLineSearchSetUp(snes->linesearch);CHKERRQ(ierr);
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.0;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
ierr = SNESVIProjectOntoBounds(snes,X);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
ierr = SNESVIComputeInactiveSetFnorm(snes,F,X,&fnorm);CHKERRQ(ierr);
ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr); /* xnorm <- ||x|| */
ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(fnorm)) SETERRQ(((PetscObject)X)->comm,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,fnorm,0);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* set parameter for default relative tolerance convergence test */
snes->ttol = fnorm*snes->rtol;
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
for (i=0; i<maxits; i++) {
IS IS_act,IS_inact; /* _act -> active set _inact -> inactive set */
IS IS_redact; /* redundant active set */
VecScatter scat_act,scat_inact;
PetscInt nis_act,nis_inact;
Vec Y_act,Y_inact,F_inact;
Mat jac_inact_inact,prejac_inact_inact;
PetscBool isequal;
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
/* Create active and inactive index sets */
/*original
ierr = SNESVICreateIndexSets_RS(snes,X,F,&IS_act,&IS_inact);CHKERRQ(ierr);
*/
ierr = SNESVIGetActiveSetIS(snes,X,F,&IS_act);CHKERRQ(ierr);
if (vi->checkredundancy) {
(*vi->checkredundancy)(snes,IS_act,&IS_redact,vi->ctxP);CHKERRQ(ierr);
if (IS_redact){
ierr = ISSort(IS_redact);CHKERRQ(ierr);
ierr = ISComplement(IS_redact,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_redact);CHKERRQ(ierr);
}
else {
ierr = ISComplement(IS_act,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
}
} else {
ierr = ISComplement(IS_act,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
}
/* Create inactive set submatrix */
ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
if (0) { /* Dead code (temporary developer hack) */
IS keptrows;
ierr = MatFindNonzeroRows(jac_inact_inact,&keptrows);CHKERRQ(ierr);
if (keptrows) {
PetscInt cnt,*nrows,k;
const PetscInt *krows,*inact;
PetscInt rstart=jac_inact_inact->rmap->rstart;
ierr = MatDestroy(&jac_inact_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_act);CHKERRQ(ierr);
ierr = ISGetLocalSize(keptrows,&cnt);CHKERRQ(ierr);
ierr = ISGetIndices(keptrows,&krows);CHKERRQ(ierr);
ierr = ISGetIndices(IS_inact,&inact);CHKERRQ(ierr);
ierr = PetscMalloc(cnt*sizeof(PetscInt),&nrows);CHKERRQ(ierr);
for (k=0; k<cnt; k++) {
nrows[k] = inact[krows[k]-rstart];
}
ierr = ISRestoreIndices(keptrows,&krows);CHKERRQ(ierr);
ierr = ISRestoreIndices(IS_inact,&inact);CHKERRQ(ierr);
ierr = ISDestroy(&keptrows);CHKERRQ(ierr);
ierr = ISDestroy(&IS_inact);CHKERRQ(ierr);
ierr = ISCreateGeneral(((PetscObject)snes)->comm,cnt,nrows,PETSC_OWN_POINTER,&IS_inact);CHKERRQ(ierr);
ierr = ISComplement(IS_inact,F->map->rstart,F->map->rend,&IS_act);CHKERRQ(ierr);
ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
}
}
ierr = DMSetVI(snes->dm,IS_inact);CHKERRQ(ierr);
/* remove later */
/*
ierr = VecView(vi->xu,PETSC_VIEWER_BINARY_(((PetscObject)(vi->xu))->comm));CHKERRQ(ierr);
ierr = VecView(vi->xl,PETSC_VIEWER_BINARY_(((PetscObject)(vi->xl))->comm));CHKERRQ(ierr);
ierr = VecView(X,PETSC_VIEWER_BINARY_(((PetscObject)X)->comm));CHKERRQ(ierr);
ierr = VecView(F,PETSC_VIEWER_BINARY_(((PetscObject)F)->comm));CHKERRQ(ierr);
ierr = ISView(IS_inact,PETSC_VIEWER_BINARY_(((PetscObject)IS_inact)->comm));CHKERRQ(ierr);
*/
/* Get sizes of active and inactive sets */
ierr = ISGetLocalSize(IS_act,&nis_act);CHKERRQ(ierr);
ierr = ISGetLocalSize(IS_inact,&nis_inact);CHKERRQ(ierr);
/* Create active and inactive set vectors */
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_inact,&F_inact);CHKERRQ(ierr);
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_act,&Y_act);CHKERRQ(ierr);
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_inact,&Y_inact);CHKERRQ(ierr);
/* Create scatter contexts */
ierr = VecScatterCreate(Y,IS_act,Y_act,PETSC_NULL,&scat_act);CHKERRQ(ierr);
ierr = VecScatterCreate(Y,IS_inact,Y_inact,PETSC_NULL,&scat_inact);CHKERRQ(ierr);
/* Do a vec scatter to active and inactive set vectors */
ierr = VecScatterBegin(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Active set direction = 0 */
ierr = VecSet(Y_act,0);CHKERRQ(ierr);
if (snes->jacobian != snes->jacobian_pre) {
ierr = MatGetSubMatrix(snes->jacobian_pre,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&prejac_inact_inact);CHKERRQ(ierr);
} else prejac_inact_inact = jac_inact_inact;
ierr = ISEqual(vi->IS_inact_prev,IS_inact,&isequal);CHKERRQ(ierr);
if (!isequal) {
ierr = SNESVIResetPCandKSP(snes,jac_inact_inact,prejac_inact_inact);CHKERRQ(ierr);
flg = DIFFERENT_NONZERO_PATTERN;
}
/* ierr = ISView(IS_inact,0);CHKERRQ(ierr); */
/* ierr = ISView(IS_act,0);CHKERRQ(ierr);*/
/* ierr = MatView(snes->jacobian_pre,0); */
ierr = KSPSetOperators(snes->ksp,jac_inact_inact,prejac_inact_inact,flg);CHKERRQ(ierr);
ierr = KSPSetUp(snes->ksp);CHKERRQ(ierr);
{
PC pc;
PetscBool flg;
ierr = KSPGetPC(snes->ksp,&pc);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCFIELDSPLIT,&flg);CHKERRQ(ierr);
if (flg) {
KSP *subksps;
ierr = PCFieldSplitGetSubKSP(pc,PETSC_NULL,&subksps);CHKERRQ(ierr);
ierr = KSPGetPC(subksps[0],&pc);CHKERRQ(ierr);
ierr = PetscFree(subksps);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCBJACOBI,&flg);CHKERRQ(ierr);
if (flg) {
PetscInt n,N = 101*101,j,cnts[3] = {0,0,0};
const PetscInt *ii;
ierr = ISGetSize(IS_inact,&n);CHKERRQ(ierr);
ierr = ISGetIndices(IS_inact,&ii);CHKERRQ(ierr);
for (j=0; j<n; j++) {
if (ii[j] < N) cnts[0]++;
else if (ii[j] < 2*N) cnts[1]++;
else if (ii[j] < 3*N) cnts[2]++;
}
ierr = ISRestoreIndices(IS_inact,&ii);CHKERRQ(ierr);
ierr = PCBJacobiSetTotalBlocks(pc,3,cnts);CHKERRQ(ierr);
}
}
}
ierr = SNES_KSPSolve(snes,snes->ksp,F_inact,Y_inact);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
break;
}
}
ierr = VecScatterBegin(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecDestroy(&F_inact);CHKERRQ(ierr);
ierr = VecDestroy(&Y_act);CHKERRQ(ierr);
ierr = VecDestroy(&Y_inact);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scat_act);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scat_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_act);CHKERRQ(ierr);
if (!isequal) {
ierr = ISDestroy(&vi->IS_inact_prev);CHKERRQ(ierr);
ierr = ISDuplicate(IS_inact,&vi->IS_inact_prev);CHKERRQ(ierr);
}
ierr = ISDestroy(&IS_inact);CHKERRQ(ierr);
ierr = MatDestroy(&jac_inact_inact);CHKERRQ(ierr);
if (snes->jacobian != snes->jacobian_pre) {
ierr = MatDestroy(&prejac_inact_inact);CHKERRQ(ierr);
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
/*
if (snes->ops->precheck) {
PetscBool changed_y = PETSC_FALSE;
ierr = (*snes->ops->precheck)(snes,X,Y,snes->precheck,&changed_y);CHKERRQ(ierr);
}
if (PetscLogPrintInfo){
ierr = SNESVICheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
}
*/
/* Compute a (scaled) negative update in the line search routine:
Y <- X - lambda*Y
and evaluate G = function(Y) (depends on the line search).
*/
ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
ynorm = 1; gnorm = fnorm;
ierr = SNESLineSearchApply(snes->linesearch, X, F, &gnorm, Y);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(snes->linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",(double)fnorm,(double)gnorm,(double)ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
ierr = DMDestroyVI(snes->dm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = SNESLineSearchGetSuccess(snes->linesearch, &lssucceed);CHKERRQ(ierr);
if (!lssucceed) {
if (++snes->numFailures >= snes->maxFailures) {
PetscBool ismin;
snes->reason = SNES_DIVERGED_LINE_SEARCH;
ierr = SNESVICheckLocalMin_Private(snes,snes->jacobian,F,X,gnorm,&ismin);CHKERRQ(ierr);
if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
break;
}
}
/* Update function and solution vectors */
fnorm = gnorm;
/* Monitor convergence */
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,snes->norm,lits);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence, xnorm = || X || */
if (snes->ops->converged != SNESSkipConverged) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
ierr = DMDestroyVI(snes->dm);CHKERRQ(ierr);
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
static PetscErrorCode VecNestSetSubVec_Private(Vec X,PetscInt idxm,Vec x)
{
Vec_Nest *bx = (Vec_Nest*)X->data;
PetscInt i,offset=0,n=0,bs;
IS is;
PetscErrorCode ierr;
PetscBool issame = PETSC_FALSE;
PetscInt N=0;
/* check if idxm < bx->nb */
if (idxm >= bx->nb) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Out of range index value %D maximum %D",idxm,bx->nb);
PetscFunctionBegin;
ierr = VecDestroy(&bx->v[idxm]);CHKERRQ(ierr); /* destroy the existing vector */
ierr = VecDuplicate(x,&bx->v[idxm]);CHKERRQ(ierr); /* duplicate the layout of given vector */
ierr = VecCopy(x,bx->v[idxm]);CHKERRQ(ierr); /* copy the contents of the given vector */
/* check if we need to update the IS for the block */
offset = X->map->rstart;
for (i=0; i<idxm; i++) {
n=0;
ierr = VecGetLocalSize(bx->v[i],&n);CHKERRQ(ierr);
offset += n;
}
/* get the local size and block size */
ierr = VecGetLocalSize(x,&n);CHKERRQ(ierr);
ierr = VecGetBlockSize(x,&bs);CHKERRQ(ierr);
/* create the new IS */
ierr = ISCreateStride(PetscObjectComm((PetscObject)x),n,offset,1,&is);CHKERRQ(ierr);
ierr = ISSetBlockSize(is,bs);CHKERRQ(ierr);
/* check if they are equal */
ierr = ISEqual(is,bx->is[idxm],&issame);CHKERRQ(ierr);
if (!issame) {
/* The IS of given vector has a different layout compared to the existing block vector.
Destroy the existing reference and update the IS. */
ierr = ISDestroy(&bx->is[idxm]);CHKERRQ(ierr);
ierr = ISDuplicate(is,&bx->is[idxm]);CHKERRQ(ierr);
ierr = ISCopy(is,bx->is[idxm]);CHKERRQ(ierr);
offset += n;
/* Since the current IS[idxm] changed, we need to update all the subsequent IS */
for (i=idxm+1; i<bx->nb; i++) {
/* get the local size and block size */
ierr = VecGetLocalSize(bx->v[i],&n);CHKERRQ(ierr);
ierr = VecGetBlockSize(bx->v[i],&bs);CHKERRQ(ierr);
/* destroy the old and create the new IS */
ierr = ISDestroy(&bx->is[i]);CHKERRQ(ierr);
ierr = ISCreateStride(((PetscObject)bx->v[i])->comm,n,offset,1,&bx->is[i]);CHKERRQ(ierr);
ierr = ISSetBlockSize(bx->is[i],bs);CHKERRQ(ierr);
offset += n;
}
n=0;
ierr = VecSize_Nest_Recursive(X,PETSC_TRUE,&N);CHKERRQ(ierr);
ierr = VecSize_Nest_Recursive(X,PETSC_FALSE,&n);CHKERRQ(ierr);
ierr = PetscLayoutSetSize(X->map,N);CHKERRQ(ierr);
ierr = PetscLayoutSetLocalSize(X->map,n);CHKERRQ(ierr);
}
ierr = ISDestroy(&is);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
ISSum - Computes the sum (union) of two index sets.
Only sequential version (at the moment)
Input Parameter:
+ is1 - index set to be extended
- is2 - index values to be added
Output Parameter:
. is3 - the sum; this can not be is1 or is2
Notes:
If n1 and n2 are the sizes of the sets, this takes O(n1+n2) time;
Both index sets need to be sorted on input.
Level: intermediate
.seealso: ISDestroy(), ISView(), ISDifference(), ISExpand()
Concepts: index sets^union
Concepts: IS^union
@*/
PetscErrorCode ISSum(IS is1,IS is2,IS *is3)
{
MPI_Comm comm;
PetscBool f;
PetscMPIInt size;
const PetscInt *i1,*i2;
PetscInt n1,n2,n3, p1,p2, *iout;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(is1,IS_CLASSID,1);
PetscValidHeaderSpecific(is2,IS_CLASSID,2);
ierr = PetscObjectGetComm((PetscObject)(is1),&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size>1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Currently only for uni-processor IS");
ierr = ISSorted(is1,&f);CHKERRQ(ierr);
if (!f) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Arg 1 is not sorted");
ierr = ISSorted(is2,&f);CHKERRQ(ierr);
if (!f) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Arg 2 is not sorted");
ierr = ISGetLocalSize(is1,&n1);CHKERRQ(ierr);
ierr = ISGetLocalSize(is2,&n2);CHKERRQ(ierr);
if (!n2) PetscFunctionReturn(0);
ierr = ISGetIndices(is1,&i1);CHKERRQ(ierr);
ierr = ISGetIndices(is2,&i2);CHKERRQ(ierr);
p1 = 0; p2 = 0; n3 = 0;
do {
if (p1==n1) { /* cleanup for is2 */ n3 += n2-p2; break;
} else {
while (p2<n2 && i2[p2]<i1[p1]) {
n3++; p2++;
}
if (p2==n2) {
/* cleanup for is1 */
n3 += n1-p1; break;
} else {
if (i2[p2]==i1[p1]) { n3++; p1++; p2++; }
}
}
if (p2==n2) {
/* cleanup for is1 */
n3 += n1-p1; break;
} else {
while (p1<n1 && i1[p1]<i2[p2]) {
n3++; p1++;
}
if (p1==n1) {
/* clean up for is2 */
n3 += n2-p2; break;
} else {
if (i1[p1]==i2[p2]) { n3++; p1++; p2++; }
}
}
} while (p1<n1 || p2<n2);
if (n3==n1) { /* no new elements to be added */
ierr = ISRestoreIndices(is1,&i1);CHKERRQ(ierr);
ierr = ISRestoreIndices(is2,&i2);CHKERRQ(ierr);
ierr = ISDuplicate(is1,is3);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = PetscMalloc1(n3,&iout);CHKERRQ(ierr);
p1 = 0; p2 = 0; n3 = 0;
do {
if (p1==n1) { /* cleanup for is2 */
while (p2<n2) iout[n3++] = i2[p2++];
break;
} else {
while (p2<n2 && i2[p2]<i1[p1]) iout[n3++] = i2[p2++];
if (p2==n2) { /* cleanup for is1 */
while (p1<n1) iout[n3++] = i1[p1++];
break;
} else {
if (i2[p2]==i1[p1]) { iout[n3++] = i1[p1++]; p2++; }
}
}
if (p2==n2) { /* cleanup for is1 */
while (p1<n1) iout[n3++] = i1[p1++];
break;
} else {
while (p1<n1 && i1[p1]<i2[p2]) iout[n3++] = i1[p1++];
if (p1==n1) { /* clean up for is2 */
while (p2<n2) iout[n3++] = i2[p2++];
break;
} else {
if (i1[p1]==i2[p2]) { iout[n3++] = i1[p1++]; p2++; }
}
}
} while (p1<n1 || p2<n2);
ierr = ISRestoreIndices(is1,&i1);CHKERRQ(ierr);
ierr = ISRestoreIndices(is2,&i2);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,n3,iout,PETSC_OWN_POINTER,is3);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt i,n,*ix,*iy,*tomap,start;
Vec x,y;
PetscMPIInt nproc,rank;
IS isx,isy;
const PetscInt *ranges;
VecScatter vscat;
PetscFunctionBegin;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&nproc);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
if (nproc != 2) SETERRQ(PETSC_COMM_SELF,1,"This test must run with exactly two MPI ranks\n");
/* ====================================================================
(1) test VecScatterRemap on a parallel to parallel (PtoP) vecscatter
====================================================================
*/
n = 64; /* long enough to trigger memcpy optimizations both in local scatter and remote scatter */
/* create two MPI vectors x, y of length n=64, N=128 */
ierr = VecCreateMPI(PETSC_COMM_WORLD,n,PETSC_DECIDE,&x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&y);CHKERRQ(ierr);
/* Initialize x as {0~127} */
ierr = VecGetOwnershipRanges(x,&ranges);CHKERRQ(ierr);
for (i=ranges[rank]; i<ranges[rank+1]; i++) { ierr = VecSetValue(x,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr); }
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
/* create two general index sets isx = {0~127} and isy = {32~63,64~95,96~127,0~31}. isx is sequential, but we use
it as general and let PETSc detect the pattern and optimize it. indices in isy are set to make the vecscatter
have both local scatter and remote scatter (i.e., MPI communication)
*/
ierr = PetscMalloc2(n,&ix,n,&iy);CHKERRQ(ierr);
start = ranges[rank];
for (i=ranges[rank]; i<ranges[rank+1]; i++) ix[i-start] = i;
ierr = ISCreateGeneral(PETSC_COMM_WORLD,n,ix,PETSC_COPY_VALUES,&isx);CHKERRQ(ierr);
if (!rank) { for (i=0; i<n; i++) iy[i] = i+32; }
else for (i=0; i<n/2; i++) { iy[i] = i+96; iy[i+n/2] = i; }
ierr = ISCreateGeneral(PETSC_COMM_WORLD,n,iy,PETSC_COPY_VALUES,&isy);CHKERRQ(ierr);
/* create a vecscatter that shifts x to the tail by quater periodically and puts the results in y */
ierr = VecScatterCreateWithData(x,isx,y,isy,&vscat);CHKERRQ(ierr);
ierr = VecScatterBegin(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* view y to check the result. y should be {Q3,Q0,Q1,Q2} of x, that is {96~127,0~31,32~63,64~95} */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Before VecScatterRemap on PtoP, MPI vector y is:\n");CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* now call the weird subroutine VecScatterRemap to slightly change the vecscatter. It changes where we read vector
x entries to send out, but does not change the communication pattern (i.e., send/recv pairs and msg lengths).
We create tomap as {32~63,0~31}. Originaly, we read from indices {0~64} of the local x to send out. The remap
does indices[i] = tomap[indices[i]]. Therefore, after the remap, we read from indices {32~63,0~31} of the local x.
isy is unchanged. So, we will shift x to {Q2,Q1,Q0,Q3}, that is {64~95,32~63,0~31,96~127}
*/
ierr = PetscMalloc1(n,&tomap);CHKERRQ(ierr);
for (i=0; i<n/2; i++) { tomap[i] = i+n/2; tomap[i+n/2] = i; };
ierr = VecScatterRemap(vscat,tomap,NULL);CHKERRQ(ierr);
ierr = VecScatterBegin(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* view y to check the result. y should be {64~95,32~63,0~31,96~127} */
ierr = PetscPrintf(PETSC_COMM_WORLD,"After VecScatterRemap on PtoP, MPI vector y is:\n");CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* destroy everything before we recreate them in different types */
ierr = PetscFree2(ix,iy);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = ISDestroy(&isx);CHKERRQ(ierr);
ierr = ISDestroy(&isy);CHKERRQ(ierr);
ierr = PetscFree(tomap);CHKERRQ(ierr);
ierr = VecScatterDestroy(&vscat);CHKERRQ(ierr);
/* ==========================================================================================
(2) test VecScatterRemap on a sequential general to sequential general (SGToSG) vecscatter
==========================================================================================
*/
n = 64; /* long enough to trigger memcpy optimizations in local scatter */
/* create two seq vectors x, y of length n */
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&y);CHKERRQ(ierr);
/* Initialize x as {0~63} */
for (i=0; i<n; i++) { ierr = VecSetValue(x,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr); }
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
/* create two general index sets isx = isy = {0~63}, which are sequential, but we use them as
general and let PETSc detect the pattern and optimize it */
ierr = PetscMalloc2(n,&ix,n,&iy);CHKERRQ(ierr);
for (i=0; i<n; i++) ix[i] = i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,ix,PETSC_COPY_VALUES,&isx);CHKERRQ(ierr);
ierr = ISDuplicate(isx,&isy);CHKERRQ(ierr);
/* create a vecscatter that just copies x to y */
ierr = VecScatterCreateWithData(x,isx,y,isy,&vscat);CHKERRQ(ierr);
ierr = VecScatterBegin(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* view y to check the result. y should be {0~63} */
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nBefore VecScatterRemap on SGToSG, SEQ vector y is:\n");CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* now call the weird subroutine VecScatterRemap to slightly change the vecscatter.
Create tomap as {32~63,0~31}. Originaly, we read from indices {0~64} of seq x to write to y. The remap
does indices[i] = tomap[indices[i]]. Therefore, after the remap, we read from indices{32~63,0~31} of seq x.
*/
ierr = PetscMalloc1(n,&tomap);CHKERRQ(ierr);
for (i=0; i<n/2; i++) { tomap[i] = i+n/2; tomap[i+n/2] = i; };
ierr = VecScatterRemap(vscat,tomap,NULL);CHKERRQ(ierr);
ierr = VecScatterBegin(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* view y to check the result. y should be {32~63,0~31} */
ierr = PetscPrintf(PETSC_COMM_WORLD,"After VecScatterRemap on SGToSG, SEQ vector y is:\n");CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* destroy everything before we recreate them in different types */
ierr = PetscFree2(ix,iy);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = ISDestroy(&isx);CHKERRQ(ierr);
ierr = ISDestroy(&isy);CHKERRQ(ierr);
ierr = PetscFree(tomap);CHKERRQ(ierr);
ierr = VecScatterDestroy(&vscat);CHKERRQ(ierr);
/* ===================================================================================================
(3) test VecScatterRemap on a sequential general to sequential stride 1 (SGToSS_Stride1) vecscatter
===================================================================================================
*/
n = 64; /* long enough to trigger memcpy optimizations in local scatter */
/* create two seq vectors x of length n, and y of length n/2 */
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&x);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,n/2,&y);CHKERRQ(ierr);
/* Initialize x as {0~63} */
for (i=0; i<n; i++) { ierr = VecSetValue(x,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr); }
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
/* create a general index set isx = {0:63:2}, which actually is a stride IS with first=0, n=32, step=2,
but we use it as general and let PETSc detect the pattern and optimize it. */
ierr = PetscMalloc2(n/2,&ix,n/2,&iy);CHKERRQ(ierr);
for (i=0; i<n/2; i++) ix[i] = i*2;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n/2,ix,PETSC_COPY_VALUES,&isx);CHKERRQ(ierr);
/* create a stride1 index set isy = {0~31}. We intentionally set the step to 1 to trigger optimizations */
ierr = ISCreateStride(PETSC_COMM_SELF,32,0,1,&isy);CHKERRQ(ierr);
/* create a vecscatter that just copies even entries of x to y */
ierr = VecScatterCreateWithData(x,isx,y,isy,&vscat);CHKERRQ(ierr);
ierr = VecScatterBegin(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* view y to check the result. y should be {0:63:2} */
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nBefore VecScatterRemap on SGToSS_Stride1, SEQ vector y is:\n");CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* now call the weird subroutine VecScatterRemap to slightly change the vecscatter.
Create tomap as {32~63,0~31}. Originaly, we read from indices{0:63:2} of seq x to write to y. The remap
does indices[i] = tomap[indices[i]]. Therefore, after the remap, we read from indices{32:63:2,0:31:2} of seq x.
*/
ierr = PetscMalloc1(n,&tomap);CHKERRQ(ierr);
for (i=0; i<n/2; i++) { tomap[i] = i+n/2; tomap[i+n/2] = i; };
ierr = VecScatterRemap(vscat,tomap,NULL);CHKERRQ(ierr);
ierr = VecScatterBegin(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(vscat,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* view y to check the result. y should be {32:63:2,0:31:2} */
ierr = PetscPrintf(PETSC_COMM_WORLD,"After VecScatterRemap on SGToSS_Stride1, SEQ vector y is:\n");CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* destroy everything before PetscFinalize */
ierr = PetscFree2(ix,iy);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = ISDestroy(&isx);CHKERRQ(ierr);
ierr = ISDestroy(&isy);CHKERRQ(ierr);
ierr = PetscFree(tomap);CHKERRQ(ierr);
ierr = VecScatterDestroy(&vscat);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **args)
{
Mat A, *S;
IS rowis[2], colis[2];
PetscInt n,N,i,j,k,l,nsub,Jlow[2] = {0,1}, *jlow, Jhigh[2] = {3,4}, *jhigh, row, col, *subindices, ncols;
const PetscInt *cols;
PetscScalar v;
PetscMPIInt rank, size, p, inversions, total_inversions;
PetscBool sort_rows, sort_cols, show_inversions;
PetscErrorCode ierr;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size>2) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_WRONG, "A uniprocessor or two-processor example only.\n");
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
if (size > 1) {
n = 8; N = 16;
} else {
n = 16; N = 16;
}
ierr = MatSetSizes(A,n,n,N,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
/* Don't care if the entries are set multiple times by different procs. */
for (i=0; i<4; ++i) {
for (j = 0; j<4; ++j) {
row = j*4+i;
v = -1.0;
if (i>0) {
col = row-1; ierr = MatSetValues(A,1,&row,1,&col,&v,INSERT_VALUES);CHKERRQ(ierr);
}
if (i<3) {
col = row+1; ierr = MatSetValues(A,1,&row,1,&col,&v,INSERT_VALUES);CHKERRQ(ierr);
}
if (j>0) {
col = row-4; ierr = MatSetValues(A,1,&row,1,&col,&v,INSERT_VALUES);CHKERRQ(ierr);
}
if (j<3) {
col = row+4; ierr = MatSetValues(A,1,&row,1,&col,&v,INSERT_VALUES);CHKERRQ(ierr);
}
v = 4.0;
ierr = MatSetValues(A,1,&row,1,&row,&v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "Original matrix\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
if (size > 1) {
nsub = 1; /* one subdomain per rank */
}
else {
nsub = 2; /* both subdomains on rank 0 */
}
if (rank) {
jlow = Jlow+1; jhigh = Jhigh+1;
}
else {
jlow = Jlow; jhigh = Jhigh;
}
sort_rows = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL, "-sort_rows", &sort_rows, NULL);CHKERRQ(ierr);
sort_cols = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL, "-sort_cols", &sort_cols, NULL);CHKERRQ(ierr);
for (l = 0; l < nsub; ++l) {
ierr = PetscMalloc1(12, &subindices);CHKERRQ(ierr);
k = 0;
for (i = 0; i < 4; ++i) {
for (j = jlow[l]; j < jhigh[l]; ++j) {
subindices[k] = j*4+i;
k++;
}
}
ierr = ISCreateGeneral(PETSC_COMM_SELF, 12, subindices, PETSC_OWN_POINTER, rowis+l);CHKERRQ(ierr);
if ((sort_rows && !sort_cols) || (!sort_rows && sort_cols)) {
ierr = ISDuplicate(rowis[l],colis+l);CHKERRQ(ierr);
} else {
ierr = PetscObjectReference((PetscObject)rowis[l]);CHKERRQ(ierr);
colis[l] = rowis[l];
}
if (sort_rows) {
ierr = ISSort(rowis[l]);CHKERRQ(ierr);
}
if (sort_cols) {
ierr = ISSort(colis[l]);CHKERRQ(ierr);
}
}
ierr = PetscMalloc1(nsub, &S);CHKERRQ(ierr);
ierr = MatGetSubMatrices(A,nsub,rowis,colis,MAT_INITIAL_MATRIX, &S);CHKERRQ(ierr);
show_inversions = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL, "-show_inversions", &show_inversions, NULL);CHKERRQ(ierr);
inversions = 0;
for (p = 0; p < size; ++p) {
if (p == rank) {
ierr = PetscPrintf(PETSC_COMM_SELF, "[%D:%D]: Number of subdomains: %D:\n", rank, size, nsub);CHKERRQ(ierr);
for (l = 0; l < nsub; ++l) {
PetscInt i0, i1;
ierr = PetscPrintf(PETSC_COMM_SELF, "[%D:%D]: Subdomain row IS %D:\n", rank, size, l);CHKERRQ(ierr);
ierr = ISView(rowis[l],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, "[%D:%D]: Subdomain col IS %D:\n", rank, size, l);CHKERRQ(ierr);
ierr = ISView(colis[l],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF, "[%D:%D]: Submatrix %D:\n", rank, size, l);CHKERRQ(ierr);
ierr = MatView(S[l],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
if (show_inversions) {
ierr = MatGetOwnershipRange(S[l], &i0,&i1);CHKERRQ(ierr);
for (i = i0; i < i1; ++i) {
ierr = MatGetRow(S[l], i, &ncols, &cols, NULL);CHKERRQ(ierr);
for (j = 1; j < ncols; ++j) {
if (cols[j] < cols[j-1]) {
ierr = PetscPrintf(PETSC_COMM_SELF, "***Inversion in row %D: col[%D] = %D < %D = col[%D]\n", i, j, cols[j], cols[j-1], j-1);CHKERRQ(ierr);
inversions++;
}
}
ierr = MatRestoreRow(S[l], i, &ncols, &cols, NULL);CHKERRQ(ierr);
}
}
}
}
ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
}
if (show_inversions) {
ierr = MPI_Reduce(&inversions,&total_inversions,1,MPIU_INT, MPIU_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "*Total inversions: %D\n", total_inversions);CHKERRQ(ierr);
}
ierr = MatDestroy(&A);CHKERRQ(ierr);
for (l = 0; l < nsub; ++l) {
ierr = MatDestroy(&(S[l]));CHKERRQ(ierr);
ierr = ISDestroy(&(rowis[l]));CHKERRQ(ierr);
ierr = ISDestroy(&(colis[l]));CHKERRQ(ierr);
}
ierr = PetscFree(S);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
void PETSC_STDCALL isduplicate_(IS is,IS *newIS, int *__ierr ){
*__ierr = ISDuplicate(
(IS)PetscToPointer((is) ),newIS);
}
PetscErrorCode PCBDDCSubSchursSetUp(PCBDDCSubSchurs sub_schurs, Mat S, IS is_A_I, IS is_A_B, PetscInt ncc, IS is_cc[], PetscInt xadj[], PetscInt adjncy[], PetscInt nlayers)
{
Mat A_II,A_IB,A_BI,A_BB;
ISLocalToGlobalMapping BtoNmap,ItoNmap;
PetscBT touched;
PetscInt i,n_I,n_B,n_local,*local_numbering;
PetscBool is_sorted;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = ISSorted(is_A_I,&is_sorted);CHKERRQ(ierr);
if (!is_sorted) {
SETERRQ(PetscObjectComm((PetscObject)is_A_I),PETSC_ERR_PLIB,"IS for I dofs should be shorted");
}
ierr = ISSorted(is_A_B,&is_sorted);CHKERRQ(ierr);
if (!is_sorted) {
SETERRQ(PetscObjectComm((PetscObject)is_A_B),PETSC_ERR_PLIB,"IS for B dofs should be shorted");
}
/* get sizes */
ierr = ISGetLocalSize(is_A_I,&n_I);CHKERRQ(ierr);
ierr = ISGetLocalSize(is_A_B,&n_B);CHKERRQ(ierr);
n_local = n_I+n_B;
/* maps */
ierr = ISLocalToGlobalMappingCreateIS(is_A_B,&BtoNmap);CHKERRQ(ierr);
if (nlayers >= 0 && xadj != NULL && adjncy != NULL) { /* I problems have a different size of the original ones */
ierr = ISLocalToGlobalMappingCreateIS(is_A_I,&ItoNmap);CHKERRQ(ierr);
/* allocate some auxiliary space */
ierr = PetscMalloc1(n_local,&local_numbering);CHKERRQ(ierr);
ierr = PetscBTCreate(n_local,&touched);CHKERRQ(ierr);
} else {
ItoNmap = 0;
local_numbering = 0;
touched = 0;
}
/* get Schur complement matrices */
ierr = MatSchurComplementGetSubMatrices(S,&A_II,NULL,&A_IB,&A_BI,&A_BB);CHKERRQ(ierr);
/* allocate space for schur complements */
ierr = PetscMalloc5(ncc,&sub_schurs->is_AEj_I,ncc,&sub_schurs->is_AEj_B,ncc,&sub_schurs->S_Ej,ncc,&sub_schurs->work1,ncc,&sub_schurs->work2);CHKERRQ(ierr);
sub_schurs->n_subs = ncc;
/* cycle on subsets and extract schur complements */
for (i=0;i<sub_schurs->n_subs;i++) {
Mat AE_II,AE_IE,AE_EI,AE_EE;
IS is_I,is_subset_B;
/* get IS for subsets in B numbering */
ierr = ISDuplicate(is_cc[i],&sub_schurs->is_AEj_B[i]);CHKERRQ(ierr);
ierr = ISSort(sub_schurs->is_AEj_B[i]);CHKERRQ(ierr);
ierr = ISGlobalToLocalMappingApplyIS(BtoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_B[i],&is_subset_B);CHKERRQ(ierr);
/* BB block on subset */
ierr = MatGetSubMatrix(A_BB,is_subset_B,is_subset_B,MAT_INITIAL_MATRIX,&AE_EE);CHKERRQ(ierr);
if (ItoNmap) { /* is ItoNmap has been computed, extracts only a part of I dofs */
const PetscInt* idx_B;
PetscInt n_local_dofs,n_prev_added,j,layer,subset_size;
/* all boundary dofs must be skipped when adding layers */
ierr = PetscBTMemzero(n_local,touched);CHKERRQ(ierr);
ierr = ISGetIndices(is_A_B,&idx_B);CHKERRQ(ierr);
for (j=0;j<n_B;j++) {
ierr = PetscBTSet(touched,idx_B[j]);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(is_A_B,&idx_B);CHKERRQ(ierr);
/* add next layers of dofs */
ierr = ISGetLocalSize(is_cc[i],&subset_size);CHKERRQ(ierr);
ierr = ISGetIndices(is_cc[i],&idx_B);CHKERRQ(ierr);
ierr = PetscMemcpy(local_numbering,idx_B,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
ierr = ISRestoreIndices(is_cc[i],&idx_B);CHKERRQ(ierr);
n_local_dofs = subset_size;
n_prev_added = subset_size;
for (layer=0;layer<nlayers;layer++) {
PetscInt n_added;
if (n_local_dofs == n_I+subset_size) break;
if (n_local_dofs > n_I+subset_size) {
SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error querying layer %d. Out of bound access (%d > %d)",layer,n_local_dofs,n_I+subset_size);
}
ierr = PCBDDCAdjGetNextLayer_Private(local_numbering+n_local_dofs,n_prev_added,touched,xadj,adjncy,&n_added);CHKERRQ(ierr);
n_prev_added = n_added;
n_local_dofs += n_added;
if (!n_added) break;
}
/* IS for I dofs in original numbering and in I numbering */
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)ItoNmap),n_local_dofs-subset_size,local_numbering+subset_size,PETSC_COPY_VALUES,&sub_schurs->is_AEj_I[i]);CHKERRQ(ierr);
ierr = ISSort(sub_schurs->is_AEj_I[i]);CHKERRQ(ierr);
ierr = ISGlobalToLocalMappingApplyIS(ItoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_I[i],&is_I);CHKERRQ(ierr);
/* II block */
ierr = MatGetSubMatrix(A_II,is_I,is_I,MAT_INITIAL_MATRIX,&AE_II);CHKERRQ(ierr);
} else { /* in this case we can take references of already existing IS and matrices for I dofs */
/* IS for I dofs in original numbering */
ierr = PetscObjectReference((PetscObject)is_A_I);CHKERRQ(ierr);
sub_schurs->is_AEj_I[i] = is_A_I;
/* IS for I dofs in I numbering TODO: "first" argument of ISCreateStride is not general */
ierr = ISCreateStride(PetscObjectComm((PetscObject)is_A_I),n_I,0,1,&is_I);CHKERRQ(ierr);
/* II block is the same */
ierr = PetscObjectReference((PetscObject)A_II);CHKERRQ(ierr);
AE_II = A_II;
}
/* IE block */
ierr = MatGetSubMatrix(A_IB,is_I,is_subset_B,MAT_INITIAL_MATRIX,&AE_IE);CHKERRQ(ierr);
/* EI block */
ierr = MatGetSubMatrix(A_BI,is_subset_B,is_I,MAT_INITIAL_MATRIX,&AE_EI);CHKERRQ(ierr);
/* setup Schur complements on subset */
ierr = MatCreateSchurComplement(AE_II,AE_II,AE_IE,AE_EI,AE_EE,&sub_schurs->S_Ej[i]);CHKERRQ(ierr);
ierr = MatGetVecs(sub_schurs->S_Ej[i],&sub_schurs->work1[i],&sub_schurs->work2[i]);CHKERRQ(ierr);
if (AE_II == A_II) { /* we can reuse the same ksp */
KSP ksp;
ierr = MatSchurComplementGetKSP(S,&ksp);CHKERRQ(ierr);
ierr = MatSchurComplementSetKSP(sub_schurs->S_Ej[i],ksp);CHKERRQ(ierr);
} else { /* build new ksp object which inherits ksp and pc types from the original one */
KSP origksp,schurksp;
PC origpc,schurpc;
KSPType ksp_type;
PCType pc_type;
PetscInt n_internal;
ierr = MatSchurComplementGetKSP(S,&origksp);CHKERRQ(ierr);
ierr = MatSchurComplementGetKSP(sub_schurs->S_Ej[i],&schurksp);CHKERRQ(ierr);
ierr = KSPGetType(origksp,&ksp_type);CHKERRQ(ierr);
ierr = KSPSetType(schurksp,ksp_type);CHKERRQ(ierr);
ierr = KSPGetPC(schurksp,&schurpc);CHKERRQ(ierr);
ierr = KSPGetPC(origksp,&origpc);CHKERRQ(ierr);
ierr = PCGetType(origpc,&pc_type);CHKERRQ(ierr);
ierr = PCSetType(schurpc,pc_type);CHKERRQ(ierr);
ierr = ISGetSize(is_I,&n_internal);CHKERRQ(ierr);
if (n_internal) { /* UMFPACK gives error with 0 sized problems */
MatSolverPackage solver=NULL;
ierr = PCFactorGetMatSolverPackage(origpc,(const MatSolverPackage*)&solver);CHKERRQ(ierr);
if (solver) {
ierr = PCFactorSetMatSolverPackage(schurpc,solver);CHKERRQ(ierr);
}
}
ierr = KSPSetUp(schurksp);CHKERRQ(ierr);
}
/* free */
ierr = MatDestroy(&AE_II);CHKERRQ(ierr);
ierr = MatDestroy(&AE_EE);CHKERRQ(ierr);
ierr = MatDestroy(&AE_IE);CHKERRQ(ierr);
ierr = MatDestroy(&AE_EI);CHKERRQ(ierr);
ierr = ISDestroy(&is_I);CHKERRQ(ierr);
ierr = ISDestroy(&is_subset_B);CHKERRQ(ierr);
}
/* free */
ierr = ISLocalToGlobalMappingDestroy(&ItoNmap);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
ierr = PetscFree(local_numbering);CHKERRQ(ierr);
ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
