int main(int argc,char **argv)
{
PetscMPIInt rank,size;
PetscInt i,j,n,cnt=0,rstart,rend,*indices;
IS is,isc;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = 3*size; /* Number of local indices, same on each process. */
rstart = 3*(size+2)*rank; /* start of local range */
rend = 3*(size+2)*(rank+1); /* end of local range */
ierr = PetscMalloc1(n,&indices);CHKERRQ(ierr);
for (i=0; i<3; i++) {
for (j=0; j<size; j++) indices[cnt++] = rstart+i*(size+2)+j;
}
if (cnt != n) SETERRQ(PETSC_COMM_SELF,1,"inconsistent count");
ierr = ISCreateGeneral(PETSC_COMM_WORLD,n,indices,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = PetscFree(indices);CHKERRQ(ierr);
ierr = ISComplement(is,rstart,rend,&isc);CHKERRQ(ierr);
ierr = ISView(is,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = ISView(isc,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = ISDestroy(&isc);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode SNESCreateIndexSets_VINEWTONRSLS(SNES snes,Vec X,Vec F,IS* ISact,IS* ISinact)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = SNESVIGetActiveSetIS(snes,X,F,ISact);CHKERRQ(ierr);
ierr = ISComplement(*ISact,X->map->rstart,X->map->rend,ISinact);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
ISComplementVec - Creates the complement of the index set relative to a layout defined by a Vec
Collective on IS
Input Parameter:
+ S - a PETSc IS
- V - the reference vector space
Output Parameter:
. T - the complement of S
.seealso ISCreateGeneral()
Level: advanced
@*/
PetscErrorCode ISComplementVec(IS S, Vec V, IS *T)
{
PetscErrorCode ierr;
PetscInt start, end;
PetscFunctionBegin;
ierr = VecGetOwnershipRange(V,&start,&end);CHKERRQ(ierr);
ierr = ISComplement(S,start,end,T);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESVICreateIndexSets_RS(SNES snes,Vec X,Vec F,IS *ISact,IS *ISinact)
{
PetscErrorCode ierr;
PetscInt rstart,rend;
PetscFunctionBegin;
ierr = SNESVIGetActiveSetIS(snes,X,F,ISact);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(X,&rstart,&rend);CHKERRQ(ierr);
ierr = ISComplement(*ISact,rstart,rend,ISinact);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc, char *argv[])
{
MPI_Comm comm;
Vec X,Y,Z;
PetscMPIInt rank,size;
PetscInt i,rstart,rend;
PetscScalar *x;
PetscViewer viewer;
IS is0,is1;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,0,help);if (ierr) return ierr;
comm = PETSC_COMM_WORLD;
viewer = PETSC_VIEWER_STDOUT_WORLD;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = VecCreate(comm,&X);CHKERRQ(ierr);
ierr = VecSetSizes(X,10,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetFromOptions(X);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(X,&rstart,&rend);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
for (i=0; i<rend-rstart; i++) x[i] = rstart+i;
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
ierr = ISCreateStride(comm,(rend-rstart)/3+3*(rank>size/2),rstart,1,&is0);CHKERRQ(ierr);
ierr = ISComplement(is0,rstart,rend,&is1);CHKERRQ(ierr);
ierr = ISView(is0,viewer);CHKERRQ(ierr);
ierr = ISView(is1,viewer);CHKERRQ(ierr);
ierr = VecGetSubVector(X,is0,&Y);CHKERRQ(ierr);
ierr = VecGetSubVector(X,is1,&Z);CHKERRQ(ierr);
ierr = VecView(Y,viewer);CHKERRQ(ierr);
ierr = VecView(Z,viewer);CHKERRQ(ierr);
ierr = VecRestoreSubVector(X,is0,&Y);CHKERRQ(ierr);
ierr = VecRestoreSubVector(X,is1,&Z);CHKERRQ(ierr);
ierr = ISDestroy(&is0);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
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);
}
PetscErrorCode DMSetUp_AKKT(DM dm) {
DM_AKKT *kkt = (DM_AKKT*)(dm->data);
PetscErrorCode ierr;
PetscFunctionBegin;
if(dm->setupcalled) PetscFunctionReturn(0);
if(!kkt->Aff){
if(kkt->dm) {
ierr = DMCreateMatrix(kkt->dm, MATAIJ, &kkt->Aff); CHKERRQ(ierr);
}
else SETERRQ(((PetscObject)dm)->comm, PETSC_ERR_ARG_WRONGSTATE, "Neither matrix nor DM set");
}
if(!kkt->isf[0] && !kkt->isf[0]) {
if(kkt->detect_saddle_point) {
ierr = MatFindZeroDiagonals(kkt->Aff,&kkt->isf[1]);CHKERRQ(ierr);
}
else if(kkt->dm && kkt->dname) {
DM ddm;
PetscInt n;
char **names;
IS *iss;
DM *dms;
PetscInt i;
ierr = DMCreateFieldDecompositionDM(kkt->dm, kkt->dname, &ddm); CHKERRQ(ierr);
ierr = DMCreateFieldDecomposition(ddm, &n, &names, &iss, &dms); CHKERRQ(ierr);
if(n < 1 || n > 2)
SETERRQ2(((PetscObject)dm)->comm, PETSC_ERR_ARG_WRONG, "Number of parts in decomposition %s must be between 1 and 2. Got %D instead",kkt->dname, n);
for(i = 0; i < n; ++i) {
if(!iss[i] && dms[i]) {
const char* label;
if(i == 0)
label = "primal";
else
label = "dual";
SETERRQ1(((PetscObject)dm)->comm, PETSC_ERR_ARG_WRONG, "Decomposition defines %s subDM, but no embedding IS is given", label);
}
}
ierr = DMAKKTSetFieldDecomposition(dm, n, (const char**)names, iss, dms); CHKERRQ(ierr);
for(i = 0; i < n; ++i) {
ierr = PetscFree(names[i]); CHKERRQ(ierr);
ierr = ISDestroy(&(iss[i])); CHKERRQ(ierr);
ierr = DMDestroy(&(dms[i])); CHKERRQ(ierr);
}
}
}
if(!kkt->isf[0] && !kkt->isf[1]) SETERRQ(((PetscObject)dm)->comm, PETSC_ERR_ARG_WRONGSTATE, "Decomposition ISs not set and could not be derived. ");
if(!kkt->isf[0] || !kkt->isf[1]) {
PetscInt lstart, lend;
ierr = MatGetOwnershipRange(kkt->Aff, &lstart, &lend); CHKERRQ(ierr);
if(!kkt->isf[0]) {
ierr = ISComplement(kkt->isf[0], lstart, lend, kkt->isf+1); CHKERRQ(ierr);
}
else {
ierr = ISComplement(kkt->isf[1], lstart, lend, kkt->isf+0); CHKERRQ(ierr);
}
}
/* FIX: Should we allow a combination of empty kkt->dmf[0] and non-empty kkt->dmf[1]? */
if(!kkt->dmf[0]) {
/* Construct a GAMG proxy to coarsen the primal block. */
Mat A0f0f;
IS is00;
PetscInt lstart, lend;
const char* primal = {"all"};
ierr = DMCreate(((PetscObject)dm)->comm, kkt->dmf+0); CHKERRQ(ierr);
ierr = DMSetType(kkt->dmf[0],DMAKKT); CHKERRQ(ierr);
ierr = MatGetSubMatrix(kkt->Aff, kkt->isf[0], kkt->isf[0], MAT_INITIAL_MATRIX, &A0f0f); CHKERRQ(ierr);
ierr = DMAKKTSetMatrix(kkt->dmf[0], A0f0f); CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A0f0f, &lstart, &lend); CHKERRQ(ierr);
ierr = ISCreateStride(((PetscObject)A0f0f)->comm, lend-lstart, lstart, 1, &is00); CHKERRQ(ierr);
ierr = DMAKKTSetFieldDecomposition(kkt->dmf[0], 1, &primal, &is00, PETSC_NULL); CHKERRQ(ierr);
}
dm->setupcalled = PETSC_TRUE;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
Userctx user;
Vec p;
PetscScalar *x_ptr;
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt i;
KSP ksp;
PC pc;
PetscInt *idx2;
Tao tao;
TaoConvergedReason reason;
Vec lowerb,upperb;
PetscFunctionBeginUser;
ierr = PetscInitialize(&argc,&argv,"petscoptions",help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
ierr = VecCreateSeq(PETSC_COMM_WORLD,1,&user.vec_q);CHKERRQ(ierr);
user.neqs_gen = 9*ngen; /* # eqs. for generator subsystem */
user.neqs_net = 2*nbus; /* # eqs. for network subsystem */
user.neqs_pgrid = user.neqs_gen + user.neqs_net;
/* Create indices for differential and algebraic equations */
ierr = PetscMalloc1(7*ngen,&idx2);CHKERRQ(ierr);
for (i=0; i<ngen; i++) {
idx2[7*i] = 9*i; idx2[7*i+1] = 9*i+1; idx2[7*i+2] = 9*i+2; idx2[7*i+3] = 9*i+3;
idx2[7*i+4] = 9*i+6; idx2[7*i+5] = 9*i+7; idx2[7*i+6] = 9*i+8;
}
ierr = ISCreateGeneral(PETSC_COMM_WORLD,7*ngen,idx2,PETSC_COPY_VALUES,&user.is_diff);CHKERRQ(ierr);
ierr = ISComplement(user.is_diff,0,user.neqs_pgrid,&user.is_alg);CHKERRQ(ierr);
ierr = PetscFree(idx2);CHKERRQ(ierr);
/* Set run time options */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Transient stability fault options","");CHKERRQ(ierr);
{
user.tfaulton = 1.0;
user.tfaultoff = 1.2;
user.Rfault = 0.0001;
user.faultbus = 8;
ierr = PetscOptionsReal("-tfaulton","","",user.tfaulton,&user.tfaulton,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tfaultoff","","",user.tfaultoff,&user.tfaultoff,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-faultbus","","",user.faultbus,&user.faultbus,NULL);CHKERRQ(ierr);
user.t0 = 0.0;
user.tmax = 1.5;
ierr = PetscOptionsReal("-t0","","",user.t0,&user.t0,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tmax","","",user.tmax,&user.tmax,NULL);CHKERRQ(ierr);
user.freq_u = 61.0;
user.freq_l = 59.0;
user.pow = 2;
ierr = PetscOptionsReal("-frequ","","",user.freq_u,&user.freq_u,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-freql","","",user.freq_l,&user.freq_l,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-pow","","",user.pow,&user.pow,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* Create DMs for generator and network subsystems */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_gen,1,1,NULL,&user.dmgen);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmgen,"dmgen_");CHKERRQ(ierr);
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_net,1,1,NULL,&user.dmnet);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmnet,"dmnet_");CHKERRQ(ierr);
/* Create a composite DM packer and add the two DMs */
ierr = DMCompositeCreate(PETSC_COMM_WORLD,&user.dmpgrid);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmpgrid,"pgrid_");CHKERRQ(ierr);
ierr = DMCompositeAddDM(user.dmpgrid,user.dmgen);CHKERRQ(ierr);
ierr = DMCompositeAddDM(user.dmpgrid,user.dmnet);CHKERRQ(ierr);
/* Create TAO solver and set desired solution method */
ierr = TaoCreate(PETSC_COMM_WORLD,&tao);CHKERRQ(ierr);
ierr = TaoSetType(tao,TAOBLMVM);CHKERRQ(ierr);
/*
Optimization starts
*/
/* Set initial solution guess */
ierr = VecCreateSeq(PETSC_COMM_WORLD,3,&p);CHKERRQ(ierr);
ierr = VecGetArray(p,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = PG[0]; x_ptr[1] = PG[1]; x_ptr[2] = PG[2];
ierr = VecRestoreArray(p,&x_ptr);CHKERRQ(ierr);
ierr = TaoSetInitialVector(tao,p);CHKERRQ(ierr);
/* Set routine for function and gradient evaluation */
ierr = TaoSetObjectiveRoutine(tao,FormFunction,(void *)&user);CHKERRQ(ierr);
ierr = TaoSetGradientRoutine(tao,TaoDefaultComputeGradient,(void *)&user);CHKERRQ(ierr);
/* Set bounds for the optimization */
ierr = VecDuplicate(p,&lowerb);CHKERRQ(ierr);
ierr = VecDuplicate(p,&upperb);CHKERRQ(ierr);
ierr = VecGetArray(lowerb,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.5; x_ptr[1] = 0.5; x_ptr[2] = 0.5;
ierr = VecRestoreArray(lowerb,&x_ptr);CHKERRQ(ierr);
ierr = VecGetArray(upperb,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2.0; x_ptr[1] = 2.0; x_ptr[2] = 2.0;
ierr = VecRestoreArray(upperb,&x_ptr);CHKERRQ(ierr);
ierr = TaoSetVariableBounds(tao,lowerb,upperb);
/* Check for any TAO command line options */
ierr = TaoSetFromOptions(tao);CHKERRQ(ierr);
ierr = TaoGetKSP(tao,&ksp);CHKERRQ(ierr);
if (ksp) {
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr);
}
/* SOLVE THE APPLICATION */
ierr = TaoSolve(tao); CHKERRQ(ierr);
/* Get information on termination */
ierr = TaoGetConvergedReason(tao,&reason);CHKERRQ(ierr);
if (reason <= 0){
ierr=PetscPrintf(MPI_COMM_WORLD, "Try another method! \n");CHKERRQ(ierr);
}
ierr = VecView(p,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* Free TAO data structures */
ierr = TaoDestroy(&tao);CHKERRQ(ierr);
ierr = VecDestroy(&user.vec_q);CHKERRQ(ierr);
ierr = VecDestroy(&lowerb);CHKERRQ(ierr);
ierr = VecDestroy(&upperb);CHKERRQ(ierr);
ierr = VecDestroy(&p);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmgen);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmnet);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmpgrid);CHKERRQ(ierr);
ierr = ISDestroy(&user.is_diff);CHKERRQ(ierr);
ierr = ISDestroy(&user.is_alg);CHKERRQ(ierr);
ierr = PetscFinalize();
return(0);
}
int main(int argc,char **argv)
{
TS ts;
SNES snes_alg;
PetscErrorCode ierr;
PetscMPIInt size;
Userctx user;
PetscViewer Xview,Ybusview;
Vec X;
Mat J;
PetscInt i;
/* sensitivity context */
PetscScalar *y_ptr;
Vec lambda[1];
PetscInt *idx2;
Vec Xdot;
Vec F_alg;
PetscInt row_loc,col_loc;
PetscScalar val;
ierr = PetscInitialize(&argc,&argv,"petscoptions",help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
user.neqs_gen = 9*ngen; /* # eqs. for generator subsystem */
user.neqs_net = 2*nbus; /* # eqs. for network subsystem */
user.neqs_pgrid = user.neqs_gen + user.neqs_net;
/* Create indices for differential and algebraic equations */
ierr = PetscMalloc1(7*ngen,&idx2);CHKERRQ(ierr);
for (i=0; i<ngen; i++) {
idx2[7*i] = 9*i; idx2[7*i+1] = 9*i+1; idx2[7*i+2] = 9*i+2; idx2[7*i+3] = 9*i+3;
idx2[7*i+4] = 9*i+6; idx2[7*i+5] = 9*i+7; idx2[7*i+6] = 9*i+8;
}
ierr = ISCreateGeneral(PETSC_COMM_WORLD,7*ngen,idx2,PETSC_COPY_VALUES,&user.is_diff);CHKERRQ(ierr);
ierr = ISComplement(user.is_diff,0,user.neqs_pgrid,&user.is_alg);CHKERRQ(ierr);
ierr = PetscFree(idx2);CHKERRQ(ierr);
/* Read initial voltage vector and Ybus */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"X.bin",FILE_MODE_READ,&Xview);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"Ybus.bin",FILE_MODE_READ,&Ybusview);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&user.V0);CHKERRQ(ierr);
ierr = VecSetSizes(user.V0,PETSC_DECIDE,user.neqs_net);CHKERRQ(ierr);
ierr = VecLoad(user.V0,Xview);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&user.Ybus);CHKERRQ(ierr);
ierr = MatSetSizes(user.Ybus,PETSC_DECIDE,PETSC_DECIDE,user.neqs_net,user.neqs_net);CHKERRQ(ierr);
ierr = MatSetType(user.Ybus,MATBAIJ);CHKERRQ(ierr);
/* ierr = MatSetBlockSize(user.Ybus,2);CHKERRQ(ierr); */
ierr = MatLoad(user.Ybus,Ybusview);CHKERRQ(ierr);
/* Set run time options */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Transient stability fault options","");CHKERRQ(ierr);
{
user.tfaulton = 1.0;
user.tfaultoff = 1.2;
user.Rfault = 0.0001;
user.faultbus = 8;
ierr = PetscOptionsReal("-tfaulton","","",user.tfaulton,&user.tfaulton,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tfaultoff","","",user.tfaultoff,&user.tfaultoff,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-faultbus","","",user.faultbus,&user.faultbus,NULL);CHKERRQ(ierr);
user.t0 = 0.0;
user.tmax = 5.0;
ierr = PetscOptionsReal("-t0","","",user.t0,&user.t0,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tmax","","",user.tmax,&user.tmax,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscViewerDestroy(&Xview);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&Ybusview);CHKERRQ(ierr);
/* Create DMs for generator and network subsystems */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_gen,1,1,NULL,&user.dmgen);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmgen,"dmgen_");CHKERRQ(ierr);
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_net,1,1,NULL,&user.dmnet);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmnet,"dmnet_");CHKERRQ(ierr);
/* Create a composite DM packer and add the two DMs */
ierr = DMCompositeCreate(PETSC_COMM_WORLD,&user.dmpgrid);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmpgrid,"pgrid_");CHKERRQ(ierr);
ierr = DMCompositeAddDM(user.dmpgrid,user.dmgen);CHKERRQ(ierr);
ierr = DMCompositeAddDM(user.dmpgrid,user.dmnet);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(user.dmpgrid,&X);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,user.neqs_pgrid,user.neqs_pgrid);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = PreallocateJacobian(J,&user);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr);
ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SetInitialGuess(X,&user);CHKERRQ(ierr);
/* Just to set up the Jacobian structure */
ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
ierr = IJacobian(ts,0.0,X,Xdot,0.0,J,J,&user);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
/*
Save trajectory of solution so that TSAdjointSolve() may be used
*/
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = TSSetDuration(ts,1000,user.tfaulton);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,0.01);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
user.alg_flg = PETSC_FALSE;
/* Prefault period */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* Create the nonlinear solver for solving the algebraic system */
/* Note that although the algebraic system needs to be solved only for
Idq and V, we reuse the entire system including xgen. The xgen
variables are held constant by setting their residuals to 0 and
putting a 1 on the Jacobian diagonal for xgen rows
*/
ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,&user);CHKERRQ(ierr);
ierr = MatZeroEntries(J);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,&user);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
/* Apply disturbance - resistive fault at user.faultbus */
/* This is done by adding shunt conductance to the diagonal location
in the Ybus matrix */
row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1; /* Location for G */
val = 1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus; /* Location for G */
val = 1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
user.alg_flg = PETSC_TRUE;
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
/* Disturbance period */
ierr = TSSetDuration(ts,1000,user.tfaultoff);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,user.tfaulton,.01);CHKERRQ(ierr);
user.alg_flg = PETSC_FALSE;
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* Remove the fault */
row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1;
val = -1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus;
val = -1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatZeroEntries(J);CHKERRQ(ierr);
user.alg_flg = PETSC_TRUE;
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
/* Post-disturbance period */
ierr = TSSetDuration(ts,1000,user.tmax);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,user.tfaultoff,.01);CHKERRQ(ierr);
user.alg_flg = PETSC_TRUE;
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetPostStep(ts,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(J,&lambda[0],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecZeroEntries(lambda[0]);CHKERRQ(ierr);
ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 1.0;
ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,lambda,NULL);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: \n");CHKERRQ(ierr);
ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = MatDestroy(&user.Ybus);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&user.V0);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmgen);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmnet);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmpgrid);CHKERRQ(ierr);
ierr = ISDestroy(&user.is_diff);CHKERRQ(ierr);
ierr = ISDestroy(&user.is_alg);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc, char **argv)
{
Vec vec, tagged, untagged;
VecScatter taggedScatter, untaggedScatter;
PetscInt bs;
PetscInt n, nloc, nint, i, j, k, localStart, localEnd, ntagged, nuntagged;
MPI_Comm comm;
VecTagger tagger;
PetscScalar *array;
PetscRandom rand;
VecTaggerBox *defaultBox;
VecTaggerBox *boxes;
IS is, isBlockGlobal, isComp;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr;
n = 10.;
bs = 1;
comm = PETSC_COMM_WORLD;
ierr = PetscOptionsBegin(comm, "" , "VecTagger Test Options", "Vec");CHKERRQ(ierr);
ierr = PetscOptionsInt("-bs","The block size of the vector","ex1.c",bs,&bs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-n","The size of the vector (in blocks)","ex1.c",n,&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscRandomCreate(comm,&rand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
ierr = VecCreate(comm,&vec);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)vec,"Vec to Tag");CHKERRQ(ierr);
ierr = VecSetBlockSize(vec,bs);CHKERRQ(ierr);
ierr = VecSetSizes(vec,PETSC_DECIDE,n);CHKERRQ(ierr);
ierr = VecSetUp(vec);CHKERRQ(ierr);
ierr = VecGetLocalSize(vec,&nloc);CHKERRQ(ierr);
ierr = VecGetArray(vec,&array);CHKERRQ(ierr);
for (i = 0; i < nloc; i++) {
PetscScalar val;
ierr = PetscRandomGetValue(rand,&val);CHKERRQ(ierr);
array[i] = val;
}
ierr = VecRestoreArray(vec,&array);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = VecViewFromOptions(vec,NULL,"-vec_view");CHKERRQ(ierr);
ierr = VecTaggerCreate(comm,&tagger);CHKERRQ(ierr);
ierr = VecTaggerSetBlockSize(tagger,bs);CHKERRQ(ierr);
ierr = VecTaggerSetType(tagger,VECTAGGERABSOLUTE);CHKERRQ(ierr);
ierr = PetscMalloc1(bs,&defaultBox);CHKERRQ(ierr);
for (i = 0; i < bs; i++) {
#if !defined(PETSC_USE_COMPLEX)
defaultBox[i].min = 0.1;
defaultBox[i].max = 1.5;
#else
defaultBox[i].min = PetscCMPLX(0.1,0.1);
defaultBox[i].max = PetscCMPLX(1.5,1.5);
#endif
}
ierr = VecTaggerAbsoluteSetBox(tagger,defaultBox);CHKERRQ(ierr);
ierr = PetscFree(defaultBox);CHKERRQ(ierr);
ierr = VecTaggerSetFromOptions(tagger);CHKERRQ(ierr);
ierr = VecTaggerSetUp(tagger);CHKERRQ(ierr);
ierr = PetscObjectViewFromOptions((PetscObject)tagger,NULL,"-vec_tagger_view");CHKERRQ(ierr);
ierr = VecTaggerGetBlockSize(tagger,&bs);CHKERRQ(ierr);
ierr = VecTaggerComputeBoxes(tagger,vec,&nint,&boxes);
if (ierr && ierr != PETSC_ERR_SUP) CHKERRQ(ierr);
else {
PetscViewer viewer = NULL;
ierr = PetscOptionsGetViewer(comm,NULL,NULL,"-vec_tagger_boxes_view",&viewer,NULL,NULL);CHKERRQ(ierr);
if (viewer) {
PetscBool iascii;
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
if (iascii) {
ierr = PetscViewerASCIIPrintf(viewer,"Num boxes: %D\n",nint);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
for (i = 0, k = 0; i < nint; i++) {
ierr = PetscViewerASCIIPrintf(viewer,"%D: ",i);CHKERRQ(ierr);
for (j = 0; j < bs; j++, k++) {
if (j) {ierr = PetscViewerASCIIPrintf(viewer," x ");CHKERRQ(ierr);}
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer,"[%g,%g]",(double)boxes[k].min,(double)boxes[k].max);CHKERRQ(ierr);
#else
ierr = PetscViewerASCIIPrintf(viewer,"[%g+%gi,%g+%gi]",(double)PetscRealPart(boxes[k].min),(double)PetscImaginaryPart(boxes[k].min),(double)PetscRealPart(boxes[k].max),(double)PetscImaginaryPart(boxes[k].max));CHKERRQ(ierr);
#endif
}
ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
}
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscFree(boxes);CHKERRQ(ierr);
}
ierr = VecTaggerComputeIS(tagger,vec,&is);CHKERRQ(ierr);
ierr = ISGetBlockGlobalIS(is,vec,bs,&isBlockGlobal);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)isBlockGlobal,"Tagged IS (block global)");CHKERRQ(ierr);
ierr = ISViewFromOptions(isBlockGlobal,NULL,"-tagged_is_view");CHKERRQ(ierr);
ierr = VecGetOwnershipRange(vec,&localStart,&localEnd);CHKERRQ(ierr);
ierr = ISComplement(isBlockGlobal,localStart,localEnd,&isComp);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)isComp,"Untagged IS (global)");CHKERRQ(ierr);
ierr = ISViewFromOptions(isComp,NULL,"-untagged_is_view");CHKERRQ(ierr);
ierr = ISGetLocalSize(isBlockGlobal,&ntagged);CHKERRQ(ierr);
ierr = ISGetLocalSize(isComp,&nuntagged);CHKERRQ(ierr);
ierr = VecCreate(comm,&tagged);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)tagged,"Tagged selection");CHKERRQ(ierr);
ierr = VecSetSizes(tagged,ntagged,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetUp(tagged);CHKERRQ(ierr);
ierr = VecCreate(comm,&untagged);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)untagged,"Untagged selection");CHKERRQ(ierr);
ierr = VecSetSizes(untagged,nuntagged,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetUp(untagged);CHKERRQ(ierr);
ierr = VecScatterCreate(vec,isBlockGlobal,tagged,NULL,&taggedScatter);CHKERRQ(ierr);
ierr = VecScatterCreate(vec,isComp,untagged,NULL,&untaggedScatter);CHKERRQ(ierr);
ierr = VecScatterBegin(taggedScatter,vec,tagged,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(taggedScatter,vec,tagged,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(untaggedScatter,vec,untagged,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(untaggedScatter,vec,untagged,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecViewFromOptions(tagged,NULL,"-tagged_vec_view");CHKERRQ(ierr);
ierr = VecViewFromOptions(untagged,NULL,"-untagged_vec_view");CHKERRQ(ierr);
ierr = VecScatterDestroy(&untaggedScatter);CHKERRQ(ierr);
ierr = VecScatterDestroy(&taggedScatter);CHKERRQ(ierr);
ierr = VecDestroy(&untagged);CHKERRQ(ierr);
ierr = VecDestroy(&tagged);CHKERRQ(ierr);
ierr = ISDestroy(&isComp);CHKERRQ(ierr);
ierr = ISDestroy(&isBlockGlobal);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = VecTaggerDestroy(&tagger);CHKERRQ(ierr);
ierr = VecDestroy(&vec);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts;
SNES snes_alg;
PetscErrorCode ierr;
PetscMPIInt size;
Userctx user;
PetscViewer Xview,Ybusview;
Vec X;
Mat J;
PetscInt i;
ierr = PetscInitialize(&argc,&argv,"petscoptions",help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
user.neqs_gen = 9*ngen; /* # eqs. for generator subsystem */
user.neqs_net = 2*nbus; /* # eqs. for network subsystem */
user.neqs_pgrid = user.neqs_gen + user.neqs_net;
/* Create indices for differential and algebraic equations */
PetscInt *idx2;
ierr = PetscMalloc1(7*ngen,&idx2);CHKERRQ(ierr);
for (i=0; i<ngen; i++) {
idx2[7*i] = 9*i; idx2[7*i+1] = 9*i+1; idx2[7*i+2] = 9*i+2; idx2[7*i+3] = 9*i+3;
idx2[7*i+4] = 9*i+6; idx2[7*i+5] = 9*i+7; idx2[7*i+6] = 9*i+8;
}
ierr = ISCreateGeneral(PETSC_COMM_WORLD,7*ngen,idx2,PETSC_COPY_VALUES,&user.is_diff);CHKERRQ(ierr);
ierr = ISComplement(user.is_diff,0,user.neqs_pgrid,&user.is_alg);CHKERRQ(ierr);
ierr = PetscFree(idx2);CHKERRQ(ierr);
/* Read initial voltage vector and Ybus */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"X.bin",FILE_MODE_READ,&Xview);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"Ybus.bin",FILE_MODE_READ,&Ybusview);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&user.V0);CHKERRQ(ierr);
ierr = VecSetSizes(user.V0,PETSC_DECIDE,user.neqs_net);CHKERRQ(ierr);
ierr = VecLoad(user.V0,Xview);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&user.Ybus);CHKERRQ(ierr);
ierr = MatSetSizes(user.Ybus,PETSC_DECIDE,PETSC_DECIDE,user.neqs_net,user.neqs_net);CHKERRQ(ierr);
ierr = MatSetType(user.Ybus,MATBAIJ);CHKERRQ(ierr);
/* ierr = MatSetBlockSize(user.Ybus,2);CHKERRQ(ierr); */
ierr = MatLoad(user.Ybus,Ybusview);CHKERRQ(ierr);
/* Set run time options */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Transient stability fault options","");CHKERRQ(ierr);
{
user.tfaulton = 1.0;
user.tfaultoff = 1.2;
user.Rfault = 0.0001;
user.faultbus = 8;
ierr = PetscOptionsReal("-tfaulton","","",user.tfaulton,&user.tfaulton,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tfaultoff","","",user.tfaultoff,&user.tfaultoff,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-faultbus","","",user.faultbus,&user.faultbus,NULL);CHKERRQ(ierr);
user.t0 = 0.0;
user.tmax = 5.0;
ierr = PetscOptionsReal("-t0","","",user.t0,&user.t0,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tmax","","",user.tmax,&user.tmax,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscViewerDestroy(&Xview);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&Ybusview);CHKERRQ(ierr);
/* Create DMs for generator and network subsystems */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_gen,1,1,NULL,&user.dmgen);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmgen,"dmgen_");CHKERRQ(ierr);
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_net,1,1,NULL,&user.dmnet);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmnet,"dmnet_");CHKERRQ(ierr);
/* Create a composite DM packer and add the two DMs */
ierr = DMCompositeCreate(PETSC_COMM_WORLD,&user.dmpgrid);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(user.dmpgrid,"pgrid_");CHKERRQ(ierr);
ierr = DMCompositeAddDM(user.dmpgrid,user.dmgen);CHKERRQ(ierr);
ierr = DMCompositeAddDM(user.dmpgrid,user.dmnet);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(user.dmpgrid,&X);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,user.neqs_pgrid,user.neqs_pgrid);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = PreallocateJacobian(J,&user);CHKERRQ(ierr);
/* Create matrix to save solutions at each time step */
user.stepnum = 0;
ierr = MatCreateSeqDense(PETSC_COMM_SELF,user.neqs_pgrid+1,1002,NULL,&user.Sol);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetEquationType(ts,TS_EQ_DAE_IMPLICIT_INDEX1);CHKERRQ(ierr);
ierr = TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr);
ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SetInitialGuess(X,&user);CHKERRQ(ierr);
/* Just to set up the Jacobian structure */
Vec Xdot;
MatStructure flg;
ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
ierr = IJacobian(ts,0.0,X,Xdot,0.0,J,J,&flg,&user);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
/* Save initial solution */
PetscScalar *x,*mat;
PetscInt idx=user.stepnum*(user.neqs_pgrid+1);
ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
mat[idx] = 0.0;
ierr = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
user.stepnum++;
ierr = TSSetDuration(ts,1000,user.tfaulton);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,0.01);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr);
user.alg_flg = PETSC_FALSE;
/* Prefault period */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* Create the nonlinear solver for solving the algebraic system */
/* Note that although the algebraic system needs to be solved only for
Idq and V, we reuse the entire system including xgen. The xgen
variables are held constant by setting their residuals to 0 and
putting a 1 on the Jacobian diagonal for xgen rows
*/
Vec F_alg;
ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,&user);CHKERRQ(ierr);
ierr = MatZeroEntries(J);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,&user);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
/* Apply disturbance - resistive fault at user.faultbus */
/* This is done by adding shunt conductance to the diagonal location
in the Ybus matrix */
PetscInt row_loc,col_loc;
PetscScalar val;
row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1; /* Location for G */
val = 1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus; /* Location for G */
val = 1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
user.alg_flg = PETSC_TRUE;
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
/* Save fault-on solution */
idx = user.stepnum*(user.neqs_pgrid+1);
ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
mat[idx] = user.tfaulton;
ierr = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
user.stepnum++;
/* Disturbance period */
ierr = TSSetDuration(ts,1000,user.tfaultoff);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,user.tfaulton,.01);CHKERRQ(ierr);
user.alg_flg = PETSC_FALSE;
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* Remove the fault */
row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1;
val = -1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus;
val = -1/user.Rfault;
ierr = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatZeroEntries(J);CHKERRQ(ierr);
user.alg_flg = PETSC_TRUE;
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
/* Save tfault off solution */
idx = user.stepnum*(user.neqs_pgrid+1);
ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
mat[idx] = user.tfaultoff;
ierr = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
user.stepnum++;
/* Post-disturbance period */
ierr = TSSetDuration(ts,1000,user.tmax);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,user.tfaultoff,.01);CHKERRQ(ierr);
user.alg_flg = PETSC_TRUE;
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = MatAssemblyBegin(user.Sol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(user.Sol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
Mat A;
PetscScalar *amat;
ierr = MatCreateSeqDense(PETSC_COMM_SELF,user.neqs_pgrid+1,user.stepnum,NULL,&A);CHKERRQ(ierr);
ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(A,&amat);CHKERRQ(ierr);
ierr = PetscMemcpy(amat,mat,(user.stepnum*(user.neqs_pgrid+1))*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(A,&amat);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
PetscViewer viewer;
ierr = PetscViewerBinaryOpen(PETSC_COMM_SELF,"out.bin",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
ierr = MatView(A,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = MatDestroy(&user.Ybus);CHKERRQ(ierr);
ierr = MatDestroy(&user.Sol);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&user.V0);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmgen);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmnet);CHKERRQ(ierr);
ierr = DMDestroy(&user.dmpgrid);CHKERRQ(ierr);
ierr = ISDestroy(&user.is_diff);CHKERRQ(ierr);
ierr = ISDestroy(&user.is_alg);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return(0);
}
PetscErrorCode SNESSetUp_Multiblock(SNES snes)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc blocks;
PetscInt i, numBlocks;
PetscErrorCode ierr;
PetscFunctionBegin;
/* ierr = SNESDefaultGetWork(snes, 1);CHKERRQ(ierr); */
ierr = SNESMultiblockSetDefaults(snes);CHKERRQ(ierr);
numBlocks = mb->numBlocks;
blocks = mb->blocks;
/* Create ISs */
if (!mb->issetup) {
PetscInt ccsize, rstart, rend, nslots, bs;
PetscBool sorted;
mb->issetup = PETSC_TRUE;
bs = mb->bs;
ierr = MatGetOwnershipRange(snes->jacobian_pre, &rstart, &rend);CHKERRQ(ierr);
ierr = MatGetLocalSize(snes->jacobian_pre, PETSC_NULL, &ccsize);CHKERRQ(ierr);
nslots = (rend - rstart)/bs;
for (i = 0; i < numBlocks; ++i) {
if (mb->defaultblocks) {
ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+i, numBlocks, &blocks->is);CHKERRQ(ierr);
} else if (!blocks->is) {
if (blocks->nfields > 1) {
PetscInt *ii, j, k, nfields = blocks->nfields, *fields = blocks->fields;
ierr = PetscMalloc(nfields*nslots*sizeof(PetscInt), &ii);CHKERRQ(ierr);
for (j = 0; j < nslots; ++j) {
for (k = 0; k < nfields; ++k) {
ii[nfields*j + k] = rstart + bs*j + fields[k];
}
}
ierr = ISCreateGeneral(((PetscObject) snes)->comm, nslots*nfields, ii, PETSC_OWN_POINTER, &blocks->is);CHKERRQ(ierr);
} else {
ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+blocks->fields[0], bs, &blocks->is);CHKERRQ(ierr);
}
}
ierr = ISSorted(blocks->is, &sorted);CHKERRQ(ierr);
if (!sorted) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Fields must be sorted when creating split");
blocks = blocks->next;
}
}
#if 0
/* Create matrices */
ilink = jac->head;
if (!jac->pmat) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->pmat);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
}
if (jac->realdiagonal) {
ilink = jac->head;
if (!jac->mat) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->mat);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->mat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
if (jac->mat[i]) {ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->mat[i]);CHKERRQ(ierr);}
ilink = ilink->next;
}
}
} else {
jac->mat = jac->pmat;
}
#endif
#if 0
if (jac->type != PC_COMPOSITE_ADDITIVE && jac->type != PC_COMPOSITE_SCHUR) {
/* extract the rows of the matrix associated with each field: used for efficient computation of residual inside algorithm */
ilink = jac->head;
if (!jac->Afield) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->Afield);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_INITIAL_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_REUSE_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
}
}
#endif
if (mb->type == PC_COMPOSITE_SCHUR) {
#if 0
IS ccis;
PetscInt rstart,rend;
if (nsplit != 2) SETERRQ(((PetscObject)pc)->comm,PETSC_ERR_ARG_INCOMP,"To use Schur complement preconditioner you must have exactly 2 fields");
/* When extracting off-diagonal submatrices, we take complements from this range */
ierr = MatGetOwnershipRangeColumn(pc->mat,&rstart,&rend);CHKERRQ(ierr);
/* need to handle case when one is resetting up the preconditioner */
if (jac->schur) {
ilink = jac->head;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->B);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ilink = ilink->next;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->C);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ierr = MatSchurComplementUpdate(jac->schur,jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->pmat[1],pc->flag);CHKERRQ(ierr);
ierr = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),pc->flag);CHKERRQ(ierr);
} else {
KSP ksp;
char schurprefix[256];
/* extract the A01 and A10 matrices */
ilink = jac->head;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->B);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ilink = ilink->next;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->C);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
/* Use mat[0] (diagonal block of the real matrix) preconditioned by pmat[0] */
ierr = MatCreateSchurComplement(jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->mat[1],&jac->schur);CHKERRQ(ierr);
/* set tabbing and options prefix of KSP inside the MatSchur */
ierr = MatSchurComplementGetKSP(jac->schur,&ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ksp,(PetscObject)pc,2);CHKERRQ(ierr);
ierr = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",jac->head->splitname);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(ksp,schurprefix);CHKERRQ(ierr);
ierr = MatSetFromOptions(jac->schur);CHKERRQ(ierr);
ierr = KSPCreate(((PetscObject)pc)->comm,&jac->kspschur);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)jac->kspschur);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)jac->kspschur,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
if (jac->schurpre == PC_FIELDSPLIT_SCHUR_PRE_SELF) {
PC pc;
ierr = KSPGetPC(jac->kspschur,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr);
/* Note: This is bad if there exist preconditioners for MATSCHURCOMPLEMENT */
}
ierr = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",ilink->splitname);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(jac->kspschur,schurprefix);CHKERRQ(ierr);
/* really want setfromoptions called in PCSetFromOptions_FieldSplit(), but it is not ready yet */
ierr = KSPSetFromOptions(jac->kspschur);CHKERRQ(ierr);
ierr = PetscMalloc2(2,Vec,&jac->x,2,Vec,&jac->y);CHKERRQ(ierr);
ierr = MatGetVecs(jac->pmat[0],&jac->x[0],&jac->y[0]);CHKERRQ(ierr);
ierr = MatGetVecs(jac->pmat[1],&jac->x[1],&jac->y[1]);CHKERRQ(ierr);
ilink = jac->head;
ilink->x = jac->x[0]; ilink->y = jac->y[0];
ilink = ilink->next;
ilink->x = jac->x[1]; ilink->y = jac->y[1];
}
#endif
} else {
/* Set up the individual SNESs */
blocks = mb->blocks;
i = 0;
while (blocks) {
/*TODO: Set these correctly */
/*ierr = SNESSetFunction(blocks->snes, blocks->x, func);CHKERRQ(ierr);*/
/*ierr = SNESSetJacobian(blocks->snes, blocks->x, jac);CHKERRQ(ierr);*/
ierr = VecDuplicate(blocks->snes->vec_sol, &blocks->x);CHKERRQ(ierr);
/* really want setfromoptions called in SNESSetFromOptions_Multiblock(), but it is not ready yet */
ierr = SNESSetFromOptions(blocks->snes);CHKERRQ(ierr);
ierr = SNESSetUp(blocks->snes);CHKERRQ(ierr);
blocks = blocks->next;
i++;
}
}
/* Compute scatter contexts needed by multiplicative versions and non-default splits */
if (!mb->blocks->sctx) {
Vec xtmp;
blocks = mb->blocks;
ierr = MatGetVecs(snes->jacobian_pre, &xtmp, PETSC_NULL);CHKERRQ(ierr);
while(blocks) {
ierr = VecScatterCreate(xtmp, blocks->is, blocks->x, PETSC_NULL, &blocks->sctx);CHKERRQ(ierr);
blocks = blocks->next;
}
ierr = VecDestroy(&xtmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESMultiblockSetDefaults(SNES snes)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc blocks = mb->blocks;
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!blocks) {
if (snes->dm) {
PetscBool dmcomposite;
ierr = PetscObjectTypeCompare((PetscObject) snes->dm, DMCOMPOSITE, &dmcomposite);CHKERRQ(ierr);
if (dmcomposite) {
PetscInt nDM;
IS *fields;
ierr = PetscInfo(snes,"Setting up physics based multiblock solver using the embedded DM\n");CHKERRQ(ierr);
ierr = DMCompositeGetNumberDM(snes->dm, &nDM);CHKERRQ(ierr);
ierr = DMCompositeGetGlobalISs(snes->dm, &fields);CHKERRQ(ierr);
for (i = 0; i < nDM; ++i) {
char name[8];
ierr = PetscSNPrintf(name, sizeof(name), "%D", i);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, name, fields[i]);CHKERRQ(ierr);
ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
}
ierr = PetscFree(fields);CHKERRQ(ierr);
}
} else {
PetscBool flg = PETSC_FALSE;
PetscBool stokes = PETSC_FALSE;
if (mb->bs <= 0) {
if (snes->jacobian_pre) {
ierr = MatGetBlockSize(snes->jacobian_pre, &mb->bs);CHKERRQ(ierr);
} else {
mb->bs = 1;
}
}
ierr = PetscOptionsGetBool(((PetscObject) snes)->prefix, "-snes_multiblock_default", &flg, PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(((PetscObject) snes)->prefix, "-snes_multiblock_detect_saddle_point", &stokes, PETSC_NULL);CHKERRQ(ierr);
if (stokes) {
IS zerodiags, rest;
PetscInt nmin, nmax;
ierr = MatGetOwnershipRange(snes->jacobian_pre, &nmin, &nmax);CHKERRQ(ierr);
ierr = MatFindZeroDiagonals(snes->jacobian_pre, &zerodiags);CHKERRQ(ierr);
ierr = ISComplement(zerodiags, nmin, nmax, &rest);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, "0", rest);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, "1", zerodiags);CHKERRQ(ierr);
ierr = ISDestroy(&zerodiags);CHKERRQ(ierr);
ierr = ISDestroy(&rest);CHKERRQ(ierr);
} else {
if (!flg) {
/* Allow user to set fields from command line, if bs was known at the time of SNESSetFromOptions_Multiblock()
then it is set there. This is not ideal because we should only have options set in XXSetFromOptions(). */
ierr = SNESMultiblockSetFieldsRuntime_Private(snes);CHKERRQ(ierr);
if (mb->defined) {ierr = PetscInfo(snes, "Blocks defined using the options database\n");CHKERRQ(ierr);}
}
if (flg || !mb->defined) {
ierr = PetscInfo(snes, "Using default splitting of fields\n");CHKERRQ(ierr);
for (i = 0; i < mb->bs; ++i) {
char name[8];
ierr = PetscSNPrintf(name, sizeof(name), "%D", i);CHKERRQ(ierr);
ierr = SNESMultiblockSetFields(snes, name, 1, &i);CHKERRQ(ierr);
}
mb->defaultblocks = PETSC_TRUE;
}
}
}
} else if (mb->numBlocks == 1) {
if (blocks->is) {
IS is2;
PetscInt nmin, nmax;
ierr = MatGetOwnershipRange(snes->jacobian_pre, &nmin, &nmax);CHKERRQ(ierr);
ierr = ISComplement(blocks->is, nmin, nmax, &is2);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, "1", is2);CHKERRQ(ierr);
ierr = ISDestroy(&is2);CHKERRQ(ierr);
} else {
SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Must provide at least two sets of fields to SNES multiblock");
}
}
if (mb->numBlocks < 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unhandled case, must have at least two blocks");
PetscFunctionReturn(0);
}
