EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "SNESMultiblockSetFields_Default"
PetscErrorCode SNESMultiblockSetFields_Default(SNES snes, const char name[], PetscInt n, const PetscInt fields[])
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc newblock, next = mb->blocks;
char prefix[128];
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
if (mb->defined) {
ierr = PetscInfo1(snes, "Ignoring new block \"%s\" because the blocks have already been defined\n", name);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
for (i = 0; i < n; ++i) {
if (fields[i] >= mb->bs) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Field %D requested but only %D exist", fields[i], mb->bs);
if (fields[i] < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Negative field %D requested", fields[i]);
}
ierr = PetscNew(struct _BlockDesc, &newblock);CHKERRQ(ierr);
if (name) {
ierr = PetscStrallocpy(name, &newblock->name);CHKERRQ(ierr);
} else {
PetscInt len = floor(log10(mb->numBlocks))+1;
ierr = PetscMalloc((len+1)*sizeof(char), &newblock->name);CHKERRQ(ierr);
ierr = PetscSNPrintf(newblock->name, len, "%s", mb->numBlocks);CHKERRQ(ierr);
}
newblock->nfields = n;
ierr = PetscMalloc(n*sizeof(PetscInt), &newblock->fields);CHKERRQ(ierr);
ierr = PetscMemcpy(newblock->fields, fields, n*sizeof(PetscInt));CHKERRQ(ierr);
newblock->next = PETSC_NULL;
ierr = SNESCreate(((PetscObject) snes)->comm, &newblock->snes);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject) newblock->snes, (PetscObject) snes, 1);CHKERRQ(ierr);
ierr = SNESSetType(newblock->snes, SNESNRICHARDSON);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject) snes, (PetscObject) newblock->snes);CHKERRQ(ierr);
ierr = PetscSNPrintf(prefix, sizeof(prefix), "%smultiblock_%s_", ((PetscObject) snes)->prefix ? ((PetscObject) snes)->prefix : "", newblock->name);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(newblock->snes, prefix);CHKERRQ(ierr);
if (!next) {
mb->blocks = newblock;
newblock->previous = PETSC_NULL;
} else {
while (next->next) {
next = next->next;
}
next->next = newblock;
newblock->previous = next;
}
mb->numBlocks++;
PetscFunctionReturn(0);
}
EXTERN_C_END
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "SNESMultiblockSetIS_Default"
PetscErrorCode SNESMultiblockSetIS_Default(SNES snes, const char name[], IS is)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc newblock, next = mb->blocks;
char prefix[128];
PetscErrorCode ierr;
PetscFunctionBegin;
if (mb->defined) {
ierr = PetscInfo1(snes, "Ignoring new block \"%s\" because the blocks have already been defined\n", name);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = PetscNew(struct _BlockDesc, &newblock);CHKERRQ(ierr);
if (name) {
ierr = PetscStrallocpy(name, &newblock->name);CHKERRQ(ierr);
} else {
PetscInt len = floor(log10(mb->numBlocks))+1;
ierr = PetscMalloc((len+1)*sizeof(char), &newblock->name);CHKERRQ(ierr);
ierr = PetscSNPrintf(newblock->name, len, "%s", mb->numBlocks);CHKERRQ(ierr);
}
newblock->is = is;
ierr = PetscObjectReference((PetscObject) is);CHKERRQ(ierr);
newblock->next = PETSC_NULL;
ierr = SNESCreate(((PetscObject) snes)->comm, &newblock->snes);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject) newblock->snes, (PetscObject) snes, 1);CHKERRQ(ierr);
ierr = SNESSetType(newblock->snes, SNESNRICHARDSON);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject) snes, (PetscObject) newblock->snes);CHKERRQ(ierr);
ierr = PetscSNPrintf(prefix, sizeof(prefix), "%smultiblock_%s_", ((PetscObject) snes)->prefix ? ((PetscObject) snes)->prefix : "", newblock->name);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(newblock->snes, prefix);CHKERRQ(ierr);
if (!next) {
mb->blocks = newblock;
newblock->previous = PETSC_NULL;
} else {
while (next->next) {
next = next->next;
}
next->next = newblock;
newblock->previous = next;
}
mb->numBlocks++;
PetscFunctionReturn(0);
}
// -------------------------------------------------------------
// PetscNonlinearSolverImplementation::p_build
// -------------------------------------------------------------
void
PetscNonlinearSolverImplementation::p_build(const std::string& option_prefix)
{
PetscErrorCode ierr(0);
try {
ierr = SNESCreate(this->communicator(), &p_snes); CHKERRXX(ierr);
p_petsc_F = PETScVector(*p_F);
if (!p_function.empty()) {
ierr = SNESSetFunction(p_snes, *p_petsc_F, FormFunction,
static_cast<void *>(this)); CHKERRXX(ierr);
}
p_petsc_J = PETScMatrix(*p_J);
if (!p_jacobian.empty()) {
ierr = SNESSetJacobian(p_snes, *p_petsc_J, *p_petsc_J, FormJacobian,
static_cast<void *>(this)); CHKERRXX(ierr);
}
// set the
ierr = SNESSetOptionsPrefix(p_snes, option_prefix.c_str()); CHKERRXX(ierr);
KSP ksp;
ierr = SNESGetKSP(p_snes, &ksp); CHKERRXX(ierr);
ierr = KSPSetOptionsPrefix(ksp, option_prefix.c_str()); CHKERRXX(ierr);
PC pc;
ierr = KSPGetPC(ksp, &pc); CHKERRXX(ierr);
ierr = PCSetOptionsPrefix(pc, option_prefix.c_str()); CHKERRXX(ierr);
ierr = SNESMonitorSet(p_snes, MonitorNorms, PETSC_NULL, PETSC_NULL); CHKERRXX(ierr);
ierr = SNESSetTolerances(p_snes,
p_functionTolerance,
PETSC_DEFAULT,
p_solutionTolerance,
p_maxIterations,
PETSC_DEFAULT);
ierr = SNESSetFromOptions(p_snes); CHKERRXX(ierr);
} catch (const PETSC_EXCEPTION_TYPE& e) {
throw PETScException(ierr, e);
}
}
static PetscErrorCode SNESCompositeAddSNES_Composite(SNES snes,SNESType type)
{
SNES_Composite *jac;
SNES_CompositeLink next,ilink;
PetscErrorCode ierr;
PetscInt cnt = 0;
const char *prefix;
char newprefix[20];
DM dm;
PetscFunctionBegin;
ierr = PetscNewLog(snes,&ilink);CHKERRQ(ierr);
ilink->next = 0;
ierr = SNESCreate(PetscObjectComm((PetscObject)snes),&ilink->snes);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)snes,(PetscObject)ilink->snes);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = SNESSetDM(ilink->snes,dm);CHKERRQ(ierr);
ierr = SNESSetTolerances(ilink->snes,ilink->snes->abstol,ilink->snes->rtol,ilink->snes->stol,1,ilink->snes->max_funcs);CHKERRQ(ierr);
ierr = PetscObjectCopyFortranFunctionPointers((PetscObject)snes,(PetscObject)ilink->snes);CHKERRQ(ierr);
jac = (SNES_Composite*)snes->data;
next = jac->head;
if (!next) {
jac->head = ilink;
ilink->previous = NULL;
} else {
cnt++;
while (next->next) {
next = next->next;
cnt++;
}
next->next = ilink;
ilink->previous = next;
}
ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(ilink->snes,prefix);CHKERRQ(ierr);
sprintf(newprefix,"sub_%d_",(int)cnt);
ierr = SNESAppendOptionsPrefix(ilink->snes,newprefix);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ilink->snes,(PetscObject)snes,1);CHKERRQ(ierr);
ierr = SNESSetType(ilink->snes,type);CHKERRQ(ierr);
ierr = SNESSetNormSchedule(ilink->snes, SNES_NORM_FINAL_ONLY);CHKERRQ(ierr);
ilink->dmp = 1.0;
jac->nsnes++;
PetscFunctionReturn(0);
}
/*@
SNESFASSetContinuation - Sets the FAS cycle to default to exact Newton solves on the upsweep
Logically Collective on SNES
Input Parameters:
+ snes - the multigrid context
- n - the number of smoothing steps
Options Database Key:
. -snes_fas_continuation - sets continuation to true
Level: advanced
Notes: This sets the prefix on the upsweep smoothers to -fas_continuation
.keywords: FAS, MG, smoother, continuation
.seealso: SNESFAS
@*/
PetscErrorCode SNESFASSetContinuation(SNES snes,PetscBool continuation)
{
const char *optionsprefix;
char tprefix[128];
SNES_FAS *fas = (SNES_FAS*)snes->data;
PetscErrorCode ierr = 0;
PetscFunctionBegin;
ierr = SNESGetOptionsPrefix(fas->fine, &optionsprefix);CHKERRQ(ierr);
if (!fas->smoothu) {
ierr = SNESFASCycleCreateSmoother_Private(snes, &fas->smoothu);CHKERRQ(ierr);
}
sprintf(tprefix,"fas_levels_continuation_");
ierr = SNESSetOptionsPrefix(fas->smoothu, optionsprefix);CHKERRQ(ierr);
ierr = SNESAppendOptionsPrefix(fas->smoothu, tprefix);CHKERRQ(ierr);
ierr = SNESSetType(fas->smoothu,SNESNEWTONLS);CHKERRQ(ierr);
ierr = SNESSetTolerances(fas->smoothu,fas->fine->abstol,fas->fine->rtol,fas->fine->stol,50,100);CHKERRQ(ierr);
fas->continuation = continuation;
if (fas->next) {
ierr = SNESFASSetContinuation(fas->next,continuation);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
void PETScNewtonKrylovSolver::initializeSolverState(const SAMRAIVectorReal<NDIM, double>& x,
const SAMRAIVectorReal<NDIM, double>& b)
{
IBTK_TIMER_START(t_initialize_solver_state);
int ierr;
// Rudimentary error checking.
#if !defined(NDEBUG)
if (x.getNumberOfComponents() != b.getNumberOfComponents())
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " vectors must have the same number of components"
<< std::endl);
}
const Pointer<PatchHierarchy<NDIM> >& patch_hierarchy = x.getPatchHierarchy();
if (patch_hierarchy != b.getPatchHierarchy())
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " vectors must have the same hierarchy" << std::endl);
}
const int coarsest_ln = x.getCoarsestLevelNumber();
if (coarsest_ln < 0)
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " coarsest level number must not be negative"
<< std::endl);
}
if (coarsest_ln != b.getCoarsestLevelNumber())
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " vectors must have same coarsest level number"
<< std::endl);
}
const int finest_ln = x.getFinestLevelNumber();
if (finest_ln < coarsest_ln)
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " finest level number must be >= coarsest level number"
<< std::endl);
}
if (finest_ln != b.getFinestLevelNumber())
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " vectors must have same finest level number"
<< std::endl);
}
for (int ln = coarsest_ln; ln <= finest_ln; ++ln)
{
if (!patch_hierarchy->getPatchLevel(ln))
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " hierarchy level " << ln << " does not exist"
<< std::endl);
}
}
#endif
// Deallocate the solver state if the solver is already initialized.
if (d_is_initialized)
{
d_reinitializing_solver = true;
deallocateSolverState();
}
// Create the SNES solver.
if (d_managing_petsc_snes)
{
ierr = SNESCreate(d_petsc_comm, &d_petsc_snes);
IBTK_CHKERRQ(ierr);
resetSNESOptions();
}
else if (!d_petsc_snes)
{
TBOX_ERROR(d_object_name << "::initializeSolverState()\n"
<< " cannot initialize solver state for wrapped PETSc SNES "
"object if the wrapped object is NULL" << std::endl);
}
// Setup solution and rhs vectors.
d_x = x.cloneVector(x.getName());
d_petsc_x = PETScSAMRAIVectorReal::createPETScVector(d_x, d_petsc_comm);
d_b = b.cloneVector(b.getName());
d_petsc_b = PETScSAMRAIVectorReal::createPETScVector(d_b, d_petsc_comm);
d_r = b.cloneVector(b.getName());
d_petsc_r = PETScSAMRAIVectorReal::createPETScVector(d_r, d_petsc_comm);
// Setup the nonlinear operator.
if (d_F) d_F->initializeOperatorState(*d_x, *d_b);
if (d_managing_petsc_snes || d_user_provided_function) resetSNESFunction();
// Setup the Jacobian.
if (d_J) d_J->initializeOperatorState(*d_x, *d_b);
if (d_managing_petsc_snes || d_user_provided_jacobian) resetSNESJacobian();
// Set the SNES options from the PETSc options database.
if (d_options_prefix != "")
{
ierr = SNESSetOptionsPrefix(d_petsc_snes, d_options_prefix.c_str());
IBTK_CHKERRQ(ierr);
}
ierr = SNESSetFromOptions(d_petsc_snes);
IBTK_CHKERRQ(ierr);
// Reset the member state variables to correspond to the values used by the
// SNES object. (Command-line options always take precedence.)
ierr = SNESGetTolerances(d_petsc_snes,
&d_abs_residual_tol,
&d_rel_residual_tol,
&d_solution_tol,
&d_max_iterations,
&d_max_evaluations);
IBTK_CHKERRQ(ierr);
// Setup the KrylovLinearSolver wrapper to correspond to the KSP employed by
// the SNES solver.
KSP petsc_ksp;
ierr = SNESGetKSP(d_petsc_snes, &petsc_ksp);
IBTK_CHKERRQ(ierr);
Pointer<PETScKrylovLinearSolver> p_krylov_solver = d_krylov_solver;
if (p_krylov_solver) p_krylov_solver->resetWrappedKSP(petsc_ksp);
// Setup the Krylov solver.
if (d_krylov_solver) d_krylov_solver->initializeSolverState(*d_x, *d_b);
// Indicate that the solver is initialized.
d_reinitializing_solver = false;
d_is_initialized = true;
IBTK_TIMER_STOP(t_initialize_solver_state);
return;
} // initializeSolverState
/*
FormFunction - Evaluates the function and corresponding gradient.
Input Parameters:
tao - the Tao context
X - the input vector
ptr - optional user-defined context, as set by TaoSetObjectiveAndGradientRoutine()
Output Parameters:
f - the newly evaluated function
*/
PetscErrorCode FormFunction(Tao tao,Vec P,PetscReal *f,void *ctx0)
{
TS ts;
SNES snes_alg;
PetscErrorCode ierr;
Userctx *ctx = (Userctx*)ctx0;
Vec X;
Mat J;
/* sensitivity context */
PetscScalar *x_ptr;
PetscViewer Xview,Ybusview;
Vec F_alg;
Vec Xdot;
PetscInt row_loc,col_loc;
PetscScalar val;
ierr = VecGetArray(P,&x_ptr);CHKERRQ(ierr);
PG[0] = x_ptr[0];
PG[1] = x_ptr[1];
PG[2] = x_ptr[2];
ierr = VecRestoreArray(P,&x_ptr);CHKERRQ(ierr);
ctx->stepnum = 0;
ierr = VecZeroEntries(ctx->vec_q);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,&ctx->V0);CHKERRQ(ierr);
ierr = VecSetSizes(ctx->V0,PETSC_DECIDE,ctx->neqs_net);CHKERRQ(ierr);
ierr = VecLoad(ctx->V0,Xview);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&ctx->Ybus);CHKERRQ(ierr);
ierr = MatSetSizes(ctx->Ybus,PETSC_DECIDE,PETSC_DECIDE,ctx->neqs_net,ctx->neqs_net);CHKERRQ(ierr);
ierr = MatSetType(ctx->Ybus,MATBAIJ);CHKERRQ(ierr);
/* ierr = MatSetBlockSize(ctx->Ybus,2);CHKERRQ(ierr); */
ierr = MatLoad(ctx->Ybus,Ybusview);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&Xview);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&Ybusview);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(ctx->dmpgrid,&X);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,ctx->neqs_pgrid,ctx->neqs_pgrid);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = PreallocateJacobian(J,ctx);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,ctx);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr);
ierr = TSSetApplicationContext(ts,ctx);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,MonitorUpdateQ,ctx,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SetInitialGuess(X,ctx);CHKERRQ(ierr);
ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,ctx);CHKERRQ(ierr);
ierr = MatZeroEntries(J);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,ctx);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
ctx->alg_flg = PETSC_TRUE;
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);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,ctx);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
ctx->stepnum++;
ierr = TSSetDuration(ts,1000,ctx->tfaulton);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,0.01);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr); */
ctx->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 = MatZeroEntries(J);CHKERRQ(ierr);
/* Apply disturbance - resistive fault at ctx->faultbus */
/* This is done by adding shunt conductance to the diagonal location
in the Ybus matrix */
row_loc = 2*ctx->faultbus; col_loc = 2*ctx->faultbus+1; /* Location for G */
val = 1/ctx->Rfault;
ierr = MatSetValues(ctx->Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
row_loc = 2*ctx->faultbus+1; col_loc = 2*ctx->faultbus; /* Location for G */
val = 1/ctx->Rfault;
ierr = MatSetValues(ctx->Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ctx->alg_flg = PETSC_TRUE;
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
ctx->stepnum++;
/* Disturbance period */
ierr = TSSetDuration(ts,1000,ctx->tfaultoff);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ctx->tfaulton,.01);CHKERRQ(ierr);
ctx->alg_flg = PETSC_FALSE;
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* Remove the fault */
row_loc = 2*ctx->faultbus; col_loc = 2*ctx->faultbus+1;
val = -1/ctx->Rfault;
ierr = MatSetValues(ctx->Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
row_loc = 2*ctx->faultbus+1; col_loc = 2*ctx->faultbus;
val = -1/ctx->Rfault;
ierr = MatSetValues(ctx->Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatZeroEntries(J);CHKERRQ(ierr);
ctx->alg_flg = PETSC_TRUE;
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
ctx->stepnum++;
/* Post-disturbance period */
ierr = TSSetDuration(ts,1000,ctx->tmax);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ctx->tfaultoff,.01);CHKERRQ(ierr);
ctx->alg_flg = PETSC_TRUE;
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = VecGetArray(ctx->vec_q,&x_ptr);CHKERRQ(ierr);
*f = x_ptr[0];
ierr = VecRestoreArray(ctx->vec_q,&x_ptr);CHKERRQ(ierr);
ierr = MatDestroy(&ctx->Ybus);CHKERRQ(ierr);
ierr = VecDestroy(&ctx->V0);CHKERRQ(ierr);
ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
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)
{
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);
}
PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Hex_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
{
DM dmCoord;
SNES snes;
KSP ksp;
PC pc;
Vec coordsLocal, r, ref, real;
Mat J;
PetscScalar *a, *coords;
PetscInt p;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(dm, &dmCoord);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_SELF, &snes);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes, "hex_interp_");CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF, &r);CHKERRQ(ierr);
ierr = VecSetSizes(r, 3, 3);CHKERRQ(ierr);
ierr = VecSetType(r,dm->vectype);CHKERRQ(ierr);
ierr = VecDuplicate(r, &ref);CHKERRQ(ierr);
ierr = VecDuplicate(r, &real);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_SELF, &J);CHKERRQ(ierr);
ierr = MatSetSizes(J, 3, 3, 3, 3);CHKERRQ(ierr);
ierr = MatSetType(J, MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSetUp(J);CHKERRQ(ierr);
ierr = SNESSetFunction(snes, r, HexMap_Private, NULL);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, J, J, HexJacobian_Private, NULL);CHKERRQ(ierr);
ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = PCSetType(pc, PCLU);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = VecGetArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = VecGetArray(v, &a);CHKERRQ(ierr);
for (p = 0; p < ctx->n; ++p) {
PetscScalar *x = NULL, *vertices = NULL;
PetscScalar *xi;
PetscReal xir[3];
PetscInt c = ctx->cells[p], comp, coordSize, xSize;
/* Can make this do all points at once */
ierr = DMPlexVecGetClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
if (8*3 != coordSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", coordSize, 8*3);
ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
if (8*ctx->dof != xSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", xSize, 8*ctx->dof);
ierr = SNESSetFunction(snes, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, NULL, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
ierr = VecGetArray(real, &xi);CHKERRQ(ierr);
xi[0] = coords[p*ctx->dim+0];
xi[1] = coords[p*ctx->dim+1];
xi[2] = coords[p*ctx->dim+2];
ierr = VecRestoreArray(real, &xi);CHKERRQ(ierr);
ierr = SNESSolve(snes, real, ref);CHKERRQ(ierr);
ierr = VecGetArray(ref, &xi);CHKERRQ(ierr);
xir[0] = PetscRealPart(xi[0]);
xir[1] = PetscRealPart(xi[1]);
xir[2] = PetscRealPart(xi[2]);
for (comp = 0; comp < ctx->dof; ++comp) {
a[p*ctx->dof+comp] =
x[0*ctx->dof+comp]*(1-xir[0])*(1-xir[1])*(1-xir[2]) +
x[3*ctx->dof+comp]* xir[0]*(1-xir[1])*(1-xir[2]) +
x[2*ctx->dof+comp]* xir[0]* xir[1]*(1-xir[2]) +
x[1*ctx->dof+comp]*(1-xir[0])* xir[1]*(1-xir[2]) +
x[4*ctx->dof+comp]*(1-xir[0])*(1-xir[1])* xir[2] +
x[5*ctx->dof+comp]* xir[0]*(1-xir[1])* xir[2] +
x[6*ctx->dof+comp]* xir[0]* xir[1]* xir[2] +
x[7*ctx->dof+comp]*(1-xir[0])* xir[1]* xir[2];
}
ierr = VecRestoreArray(ref, &xi);CHKERRQ(ierr);
ierr = DMPlexVecRestoreClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
}
ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
ierr = VecRestoreArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = VecDestroy(&ref);CHKERRQ(ierr);
ierr = VecDestroy(&real);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void IBImplicitStaggeredHierarchyIntegrator::integrateHierarchy(const double current_time,
const double new_time,
const int cycle_num)
{
IBHierarchyIntegrator::integrateHierarchy(current_time, new_time, cycle_num);
Pointer<INSStaggeredHierarchyIntegrator> ins_hier_integrator = d_ins_hier_integrator;
TBOX_ASSERT(ins_hier_integrator);
PetscErrorCode ierr;
int n_local;
const int coarsest_ln = 0;
const int finest_ln = d_hierarchy->getFinestLevelNumber();
// const double half_time = current_time+0.5*(new_time-current_time);
VariableDatabase<NDIM>* var_db = VariableDatabase<NDIM>::getDatabase();
Pointer<VariableContext> current_ctx = ins_hier_integrator->getCurrentContext();
Pointer<VariableContext> scratch_ctx = ins_hier_integrator->getScratchContext();
Pointer<VariableContext> new_ctx = ins_hier_integrator->getNewContext();
const int wgt_cc_idx = d_hier_math_ops->getCellWeightPatchDescriptorIndex();
const int wgt_sc_idx = d_hier_math_ops->getSideWeightPatchDescriptorIndex();
Pointer<Variable<NDIM> > u_var = ins_hier_integrator->getVelocityVariable();
// const int u_current_idx = var_db->mapVariableAndContextToIndex(u_var, current_ctx);
const int u_scratch_idx = var_db->mapVariableAndContextToIndex(u_var, scratch_ctx);
// const int u_new_idx = var_db->mapVariableAndContextToIndex(u_var, new_ctx);
Pointer<Variable<NDIM> > p_var = ins_hier_integrator->getPressureVariable();
// const int p_current_idx = var_db->mapVariableAndContextToIndex(p_var, current_ctx);
const int p_scratch_idx = var_db->mapVariableAndContextToIndex(p_var, scratch_ctx);
// const int p_new_idx = var_db->mapVariableAndContextToIndex(p_var, new_ctx);
// Skip all cycles in the INS solver --- we advance the state data here.
ins_hier_integrator->skipCycle(current_time, new_time, cycle_num);
// Setup Eulerian vectors used in solving the implicit IB equations.
Pointer<SAMRAIVectorReal<NDIM, double> > eul_sol_vec = new SAMRAIVectorReal<NDIM, double>(
d_object_name + "::eulerian_sol_vec", d_hierarchy, coarsest_ln, finest_ln);
eul_sol_vec->addComponent(u_var, u_scratch_idx, wgt_sc_idx, d_hier_velocity_data_ops);
eul_sol_vec->addComponent(p_var, p_scratch_idx, wgt_cc_idx, d_hier_pressure_data_ops);
Pointer<SAMRAIVectorReal<NDIM, double> > eul_rhs_vec =
eul_sol_vec->cloneVector(d_object_name + "::eulerian_rhs_vec");
eul_rhs_vec->allocateVectorData(current_time);
d_u_scratch_vec = eul_sol_vec->cloneVector(d_object_name + "::u_scratch_vec");
d_f_scratch_vec = eul_rhs_vec->cloneVector(d_object_name + "::f_scratch_vec");
d_u_scratch_vec->allocateVectorData(current_time);
d_f_scratch_vec->allocateVectorData(current_time);
ins_hier_integrator->setupSolverVectors(
eul_sol_vec, eul_rhs_vec, current_time, new_time, cycle_num);
d_stokes_solver = ins_hier_integrator->getStokesSolver();
Pointer<KrylovLinearSolver> p_stokes_solver = d_stokes_solver;
TBOX_ASSERT(p_stokes_solver);
d_stokes_op = p_stokes_solver->getOperator();
TBOX_ASSERT(d_stokes_op);
// Setup Lagrangian vectors used in solving the implicit IB equations.
Vec lag_sol_petsc_vec, lag_rhs_petsc_vec;
d_ib_implicit_ops->createSolverVecs(lag_sol_petsc_vec, lag_rhs_petsc_vec);
d_ib_implicit_ops->setupSolverVecs(lag_sol_petsc_vec, lag_rhs_petsc_vec);
// Indicate that the current approximation to position of the structure
// should be used for Lagrangian-Eulerian coupling.
d_ib_implicit_ops->updateFixedLEOperators();
// Setup multi-vec objects to store the composite solution and
// right-hand-side vectors.
Vec eul_sol_petsc_vec =
PETScSAMRAIVectorReal::createPETScVector(eul_sol_vec, PETSC_COMM_WORLD);
Vec eul_rhs_petsc_vec =
PETScSAMRAIVectorReal::createPETScVector(eul_rhs_vec, PETSC_COMM_WORLD);
Vec sol_petsc_vecs[] = { eul_sol_petsc_vec, lag_sol_petsc_vec };
Vec rhs_petsc_vecs[] = { eul_rhs_petsc_vec, lag_rhs_petsc_vec };
Vec composite_sol_petsc_vec, composite_rhs_petsc_vec, composite_res_petsc_vec;
ierr = VecCreateMultiVec(PETSC_COMM_WORLD, 2, sol_petsc_vecs, &composite_sol_petsc_vec);
IBTK_CHKERRQ(ierr);
ierr = VecCreateMultiVec(PETSC_COMM_WORLD, 2, rhs_petsc_vecs, &composite_rhs_petsc_vec);
IBTK_CHKERRQ(ierr);
ierr = VecDuplicate(composite_rhs_petsc_vec, &composite_res_petsc_vec);
IBTK_CHKERRQ(ierr);
// Solve the implicit IB equations.
d_ib_implicit_ops->preprocessSolveFluidEquations(current_time, new_time, cycle_num);
SNES snes;
ierr = SNESCreate(PETSC_COMM_WORLD, &snes);
IBTK_CHKERRQ(ierr);
ierr = SNESSetFunction(snes, composite_res_petsc_vec, compositeIBFunction_SAMRAI, this);
IBTK_CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes, "ib_");
IBTK_CHKERRQ(ierr);
Mat jac;
ierr = VecGetLocalSize(composite_sol_petsc_vec, &n_local);
IBTK_CHKERRQ(ierr);
ierr = MatCreateShell(
PETSC_COMM_WORLD, n_local, n_local, PETSC_DETERMINE, PETSC_DETERMINE, this, &jac);
IBTK_CHKERRQ(ierr);
ierr = MatShellSetOperation(
jac, MATOP_MULT, reinterpret_cast<void (*)(void)>(compositeIBJacobianApply_SAMRAI));
IBTK_CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, jac, jac, compositeIBJacobianSetup_SAMRAI, this);
IBTK_CHKERRQ(ierr);
Mat schur;
ierr = VecGetLocalSize(lag_sol_petsc_vec, &n_local);
IBTK_CHKERRQ(ierr);
ierr = MatCreateShell(
PETSC_COMM_WORLD, n_local, n_local, PETSC_DETERMINE, PETSC_DETERMINE, this, &schur);
IBTK_CHKERRQ(ierr);
ierr = MatShellSetOperation(
schur, MATOP_MULT, reinterpret_cast<void (*)(void)>(lagrangianSchurApply_SAMRAI));
IBTK_CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD, &d_schur_solver);
IBTK_CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(d_schur_solver, "ib_schur_");
IBTK_CHKERRQ(ierr);
ierr = KSPSetOperators(d_schur_solver, schur, schur, SAME_PRECONDITIONER);
IBTK_CHKERRQ(ierr);
PC schur_pc;
ierr = KSPGetPC(d_schur_solver, &schur_pc);
IBTK_CHKERRQ(ierr);
ierr = PCSetType(schur_pc, PCNONE);
IBTK_CHKERRQ(ierr);
ierr = KSPSetFromOptions(d_schur_solver);
IBTK_CHKERRQ(ierr);
KSP snes_ksp;
ierr = SNESGetKSP(snes, &snes_ksp);
IBTK_CHKERRQ(ierr);
ierr = KSPSetType(snes_ksp, KSPFGMRES);
IBTK_CHKERRQ(ierr);
PC snes_pc;
ierr = KSPGetPC(snes_ksp, &snes_pc);
IBTK_CHKERRQ(ierr);
ierr = PCSetType(snes_pc, PCSHELL);
IBTK_CHKERRQ(ierr);
ierr = PCShellSetContext(snes_pc, this);
IBTK_CHKERRQ(ierr);
ierr = PCShellSetApply(snes_pc, compositeIBPCApply_SAMRAI);
IBTK_CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);
IBTK_CHKERRQ(ierr);
ierr = SNESSolve(snes, composite_rhs_petsc_vec, composite_sol_petsc_vec);
IBTK_CHKERRQ(ierr);
ierr = SNESDestroy(&snes);
IBTK_CHKERRQ(ierr);
ierr = MatDestroy(&jac);
IBTK_CHKERRQ(ierr);
ierr = MatDestroy(&schur);
IBTK_CHKERRQ(ierr);
ierr = KSPDestroy(&d_schur_solver);
IBTK_CHKERRQ(ierr);
d_ib_implicit_ops->postprocessSolveFluidEquations(current_time, new_time, cycle_num);
// Reset Eulerian solver vectors and Eulerian state data.
ins_hier_integrator->resetSolverVectors(
eul_sol_vec, eul_rhs_vec, current_time, new_time, cycle_num);
// Interpolate the Eulerian velocity to the curvilinear mesh.
d_ib_implicit_ops->setUpdatedPosition(lag_sol_petsc_vec);
#if 0
d_hier_velocity_data_ops->linearSum(d_u_idx, 0.5, u_current_idx, 0.5, u_new_idx);
if (d_enable_logging) plog << d_object_name << "::integrateHierarchy(): interpolating Eulerian velocity to the Lagrangian mesh\n";
d_ib_implicit_ops->interpolateVelocity(d_u_idx, getCoarsenSchedules(d_object_name+"::u::CONSERVATIVE_COARSEN"), getGhostfillRefineSchedules(d_object_name+"::u"), half_time);
// Compute the final value of the updated positions of the Lagrangian
// structure.
d_ib_implicit_ops->midpointStep(current_time, new_time);
#endif
// Deallocate temporary data.
ierr = VecDestroy(&composite_sol_petsc_vec);
IBTK_CHKERRQ(ierr);
ierr = VecDestroy(&composite_rhs_petsc_vec);
IBTK_CHKERRQ(ierr);
ierr = VecDestroy(&composite_res_petsc_vec);
IBTK_CHKERRQ(ierr);
PETScSAMRAIVectorReal::destroyPETScVector(eul_sol_petsc_vec);
PETScSAMRAIVectorReal::destroyPETScVector(eul_rhs_petsc_vec);
eul_rhs_vec->freeVectorComponents();
d_u_scratch_vec->freeVectorComponents();
d_f_scratch_vec->freeVectorComponents();
ierr = VecDestroy(&lag_sol_petsc_vec);
IBTK_CHKERRQ(ierr);
ierr = VecDestroy(&lag_rhs_petsc_vec);
IBTK_CHKERRQ(ierr);
// Execute any registered callbacks.
executeIntegrateHierarchyCallbackFcns(current_time, new_time, cycle_num);
return;
} // integrateHierarchy
PetscErrorCode InitializeData(const PetscScalar* P, void *ctx0, double noise, PetscScalar data_dt)
{
TS ts;
SNES snes_alg;
PetscErrorCode ierr;
Userctx *ctx = (Userctx*)ctx0;
Vec X;
Mat J;
Vec F_alg;
Vec Xdot;
PetscInt i,j,m,n;
PetscReal *mat;
//PetscReal temp;
PetscViewer obsView;
PetscFunctionBegin;
H[0] = P[0];
H[1] = P[1];
H[2] = P[2];
printf("InitializeData: x=[%.14f, %.14f, %.14f], obs_noise=%5.3f Nt = %4.2f, Nobs=%4.2f\n", H[0], H[1], H[2], noise, ((ctx->tfinal-ctx->t0)/ctx->dt)+1, ((ctx->tfinal-ctx->trestore)/ctx->data_dt)+1);
if(ctx->t0 > ctx->tdisturb) {
printf("t0 cannot be greater than tdisturb\n");
PetscFunctionReturn(-1);
}
if( (ctx->tdisturb >= ctx->trestore-1.0e-8) || (ctx->tdisturb >= ctx->tfinal-1.0e-8) ) {
printf("tdisturb should be less than trestore and tfinal\n");
PetscFunctionReturn(-1);
}
//use the reference PD0 from t0 to t_disturb to ensure steady state
for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
ctx->stepnum = 0;
ierr = DMCreateGlobalVector(ctx->dmpgrid,&X);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,ctx->neqs_pgrid,ctx->neqs_pgrid);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = PreallocateJacobian(J,ctx);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,ctx);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr);
ierr = TSSetApplicationContext(ts,ctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SetInitialGuess(X,ctx);CHKERRQ(ierr);
ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,ctx);CHKERRQ(ierr);
ierr = MatZeroEntries(J);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,ctx);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
ierr = SetSolution(ctx, ctx->t0, X); CHKERRQ(ierr);
ierr = SetObservation(ctx, ctx->t0, X); CHKERRQ(ierr);
/* Just to set up the Jacobian structure */
ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
ierr = IJacobian(ts,ctx->t0,X,Xdot,0.0,J,J,ctx);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve from on [t0,tdisturb] (steady state)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,1000000,ctx->tdisturb);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ctx->t0,ctx->dt);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetPostStep(ts,SaveObservation);CHKERRQ(ierr);
/* Solve (from t0 to tdisturb) */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* set X at tdisturb as IC for the optimization/estimation */
/*ierr = VecDuplicate(X, &ctx->X0_disturb);CHKERRQ(ierr);*/
/*ierr = VecCopy(X, ctx->X0_disturb);CHKERRQ(ierr);*/
/* Continue integrating the DAE only if observations file is not specified */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve from on [tdisturb, trestore] (disturbance part of the transient)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Induce a load perturbation at t=tdisturb */
for(i=0; i<3; i++) PD0[i] = PD0_disturb[i];
printf("Generate data - initiated a bump in load: new PD0[0]=%g\n", PD0[0]);
printf("Running with: tfinal=%.12f dt=%.12f data_dt=%.12f data_noise=%.12f prior_noise=%.12f load_disturb=%.12f\n",
ctx->tfinal, ctx->dt, ctx->data_dt,
ctx->data_noise, ctx->prior_noise, PD0[0]);
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
ierr = TSSetDuration(ts,100000,fmin(ctx->trestore,ctx->tfinal));CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ctx->tdisturb,ctx->dt);CHKERRQ(ierr);
/* Solve (from tdisturb to trestore) */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
/* set X at trestore as IC for the optimization/estimation */
ierr = VecDuplicate(X, &ctx->X0_disturb);CHKERRQ(ierr);
ierr = VecCopy(X, ctx->X0_disturb);CHKERRQ(ierr);
if(0==strlen(ctx->loadObsFile)) {
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve from on [trestore, tfinal] (post-disturbance transient)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if(ctx->tfinal>=ctx->trestore+1.0e-8) {
//restore load at trestore
for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
printf("In generate data: Restore load to PD0[0]=%g\n", PD0[0]);
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
ierr = TSSetDuration(ts,100000,ctx->tfinal);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr);
/* Solve (from trestore to tfinal) */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
} else {
printf("Ignoring trestore since tfinal is less than it.\n");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Generate noise at level 'noise' percent
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatGetSize(ctx->obs, &m, &n);CHKERRQ(ierr);
/* allocate std dev for data */
ierr = PetscMalloc(m*sizeof(PetscReal),&ctx->data_stddev);CHKERRQ(ierr);
ierr = MatDenseGetArray(ctx->obs,&mat);CHKERRQ(ierr);
for(i=0;i<m;i++)
ctx->data_stddev[i] = ctx->data_noise;
/* for(i=0; i<m; i++) {
temp = 0.0;
for(j=0; j<n; j++) {
temp += mat[i*n+j]*mat[i*n+j];
}
ctx->data_stddev[i] = ctx->data_noise*sqrt(temp);
}
*/
for(i=0; i<m; i++) {
for(j=0; j<n; j++) {
mat[i*n+j] += ctx->data_stddev[i]*nrand();
}
}
ierr = MatDenseRestoreArray(ctx->obs,&mat);CHKERRQ(ierr);
} else {
/* observations are in an external file */
printf("Loading observations from %s.\n", ctx->loadObsFile);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,ctx->loadObsFile,FILE_MODE_READ, &obsView);CHKERRQ(ierr);
ierr = MatLoad(ctx->obs, obsView);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&obsView);CHKERRQ(ierr);
ierr = MatGetSize(ctx->obs, &m, &n);CHKERRQ(ierr);
ierr = PetscMalloc(m*sizeof(PetscReal),&ctx->data_stddev);CHKERRQ(ierr);
for(i=0;i<m;i++)
ctx->data_stddev[i] = ctx->data_noise;
}
ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormFunction - Evaluates the function and corresponding gradient.
Input Parameters:
tao - the Tao context
X - the input vector
ptr - optional user-defined context, as set by TaoSetObjectiveAndGradientRoutine()
Output Parameters:
f - the newly evaluated function
G - the newly evaluated gradient
*/
PetscErrorCode FormFunctionGradient(Tao tao,Vec P,PetscReal *f,Vec G,void *ctx0)
{
TS ts;
PetscErrorCode ierr;
Userctx *ctx = (Userctx*)ctx0;
Vec X, F_alg;
SNES snes_alg;
PetscScalar *x_ptr;
Vec lambda[1];
//Vec q;
Vec mu[1];
PetscInt steps,steps3;
PetscReal t,t2;
Vec Xdot;
/* FD check */
PetscReal f1,f2,expo;
Vec Pvec_eps;
PetscReal* P_eps;
PetscInt i;
PetscBool fd;
Vec Xdist_final;
printf("aaa\n");
ierr = VecGetArray(P,&x_ptr);CHKERRQ(ierr);
H[0] = x_ptr[0];
H[1] = x_ptr[1];
H[2] = x_ptr[2];
//printf("FormFunctionGradient: x=[%.14f, %.14f, %.14f]\n", x_ptr[0], x_ptr[1], x_ptr[2]);
//printf("FormFunctionGradient - PD0[0]=%g\n", PD0[0]);
ierr = VecRestoreArray(P,&x_ptr);CHKERRQ(ierr);
if(ctx->t0 > ctx->tdisturb) {
printf("t0 cannot be greater than tdisturb\n");
PetscFunctionReturn(-1);
}
if( (ctx->tdisturb >= ctx->trestore-1.0e-8) || (ctx->tdisturb >= ctx->tfinal-1.0e-8) ) {
printf("tdisturb should be less than trestore and tfinal\n");
PetscFunctionReturn(-1);
}
ctx->misfit=0.0;
ctx->stepnum = 0;
ierr = VecZeroEntries(ctx->vec_q);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(ctx->dmpgrid,&X);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,ctx);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,ctx->J,ctx->J,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr);
ierr = TSSetApplicationContext(ts,ctx);CHKERRQ(ierr);
/* Set initial conditions */
ierr = VecCopy(ctx->X0_disturb, X);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve from on [tdisturb, trestore] (disturbance part of the transient)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Induce a load perturbation at t=tdisturb */
//!for(i=0; i<3; i++) PD0[i] = PD0_disturb[i];
/* Induce a load perturbation at t=trestore*/
for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
//!printf("In FormFunctionGradien: Induce a load perturbance to PD0[0]=%g\n", PD0[0]);
/* Solve for algebraic variables with Xgen given by X0_disturb */
ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,ctx);CHKERRQ(ierr);
ierr = MatZeroEntries(ctx->J);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes_alg,ctx->J,ctx->J,AlgJacobian,ctx);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
/* Just to set up the Jacobian structure */
ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
//! ierr = IJacobian(ts,ctx->tdisturb,X,Xdot,0.0,ctx->J,ctx->J,ctx);CHKERRQ(ierr);
ierr = IJacobian(ts,ctx->trestore,X,Xdot,0.0,ctx->J,ctx->J,ctx);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
/* Save trajectory of solution so that TSAdjointSolve() may be used */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* Hook up the function evaluation */
ierr = TSSetPostStep(ts,EvalMisfit);CHKERRQ(ierr);
//!ierr = TSSetDuration(ts,10000,fmin(ctx->trestore,ctx->tfinal));CHKERRQ(ierr);
ierr = TSSetDuration(ts,10000,ctx->tfinal);CHKERRQ(ierr);
//!ierr = TSSetInitialTimeStep(ts,ctx->tdisturb,ctx->dt);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* Solve the forward problem */
//printf("Forward solve...\n");
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = VecDuplicate(X, &Xdist_final);CHKERRQ(ierr);
ierr = VecCopy(X, Xdist_final);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve from on [trestore, tfinal] (post-disturbance transient)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* if(ctx->tfinal>=ctx->trestore+1.0e-8) { */
/* //restore load at trestore */
/* for(i=0; i<3; i++) PD0[i] = PD0_ref[i]; */
/* printf("In FormFunctionGradien: Restore load to PD0[0]=%g\n", PD0[0]); */
/* /\* Solve the algebraic equations *\/ */
/* ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr); */
/* ierr = TSSetDuration(ts,100000,ctx->tfinal);CHKERRQ(ierr); */
/* ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr); */
/* /\* Solve (from trestore to tfinal) *\/ */
/* ierr = TSSolve(ts,X);CHKERRQ(ierr); */
/* } else { */
/* printf("Ignoring trestore since tfinal is less than it.\n"); */
/* } */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSGetTimeStepNumber(ts,&steps3);CHKERRQ(ierr);
ierr = TSSetPostStep(ts,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(ctx->J,&lambda[0],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecZeroEntries(lambda[0]);CHKERRQ(ierr);
ierr = MatCreateVecs(ctx->Jacp,&mu[0],NULL);CHKERRQ(ierr);
ierr = VecZeroEntries(mu[0]);CHKERRQ(ierr);
/* Sets the initial value of the gradients of the cost w.r.t. x_0 and p */
/* Notes: the entries in these vectors must be correctly initialized */
/* with the values lambda_i = df/dy|finaltime mu_i = df/dp|finaltime */
ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr);
/* Sets the function that computes the Jacobian of f w.r.t. p where x_t = f(x,y,p,t) */
ierr = TSAdjointSetRHSJacobian(ts,ctx->Jacp,RHSJacobianP,ctx);CHKERRQ(ierr);
/* Sets the routine for evaluating the integral term in the cost */
/*ierr = TSSetCostIntegrand(ts,1,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec,void*))CostIntegrand,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,ctx);
*/
ierr = TSSetCostIntegrand(ts,1,
NULL,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,ctx);
CHKERRQ(ierr);
t = ctx->tfinal;
steps = (PetscInt)round(ctx->data_dt/ctx->dt);
while(fabs(t-ctx->trestore)>1e-8)
{
ierr = TSGetTime(ts, &t2);CHKERRQ(ierr);
/* Induce the perturbation in load accordingly corresponding to this time */
if(t2-ctx->trestore>=-1e-8)
for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
/* else if(t2-ctx->tdisturb>=0) */
/* for(i=0; i<3; i++) PD0[i] = PD0_disturb[i]; */
else {printf("Panic: should not get here\n"); PetscFunctionReturn(-1);}
/* Initial conditions for the adjoint */
/* lambda += dr/dy */
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
ierr = AddDRDY(t2,X,&lambda[0],ctx);CHKERRQ(ierr);
//printf("Manual adjoint backward integration steps=%d t=%g t2=%g \n", steps, t, t2);
/* Sets # steps the adjoint solver should take backward in time*/
ierr = TSAdjointSetSteps(ts,steps);CHKERRQ(ierr);
/* Solves the discrete adjoint problem for an ODE/DAE */
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
t -= steps * ctx->dt;
}
//printf("mu-FunctionGradient after Adjoint (t=%g)\n",t);
//ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_SELF);
//ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_SELF);
/* return gradient */
ierr = VecCopy(mu[0],G);CHKERRQ(ierr);
ierr = AddRegGradient(ctx,P,G);
//ierr = VecView(G,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
/* return fcn eval */
*f = ctx->misfit;
EvalReg(ctx, P);
*f += ctx->prior;
//printf("objective=%.12f\n", *f);
/* Finalize: destroy */
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
//printf("Adjoint ends\n");
fd=0;
if(fd) {
/* FD check */
ierr = FormFunction(tao,P,&f1,ctx); CHKERRQ(ierr);
printf("cost=%.12f \n",f1);
ierr = VecDuplicate(P, &Pvec_eps); CHKERRQ(ierr);
for(i=0; i<3; i++) {
for(expo=1e-2; expo>1e-8; expo/=3) {
ierr = VecCopy(P, Pvec_eps); CHKERRQ(ierr);
ierr = VecGetArray(Pvec_eps, &P_eps); CHKERRQ(ierr);
P_eps[i] += expo;
ierr = VecRestoreArray(Pvec_eps, &P_eps); CHKERRQ(ierr);
//ierr = VecView(Pvec_eps,PETSC_VIEWER_STDOUT_SELF);
ierr = FormFunction(tao,Pvec_eps,&f2,ctx); CHKERRQ(ierr);
printf("fd[%d]=%12.6e f1=%.7e f2=%.7e expo=%g\n", i+1, (f2-f1)/expo, f1, f2, expo);
}
}
ierr = VecDestroy(&Pvec_eps); CHKERRQ(ierr);
/* ~end of FD */
}
//PetscFunctionReturn(-1);
PetscFunctionReturn(0);
}
