/*
FormFunctionGradient - 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 IC,PetscReal *f,Vec G,void *ctx)
{
User user_ptr = (User)ctx;
TS ts;
PetscScalar *x_ptr,*y_ptr;
PetscErrorCode ierr;
ierr = VecCopy(IC,user_ptr->x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,IFunction,user_ptr);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,user_ptr->A,user_ptr->A,IJacobian,user_ptr);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set time
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetTime(ts,0.0);CHKERRQ(ierr);
ierr = TSSetDuration(ts,PETSC_DEFAULT,0.5);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSolve(ts,user_ptr->x);CHKERRQ(ierr);
ierr = VecGetArray(user_ptr->x,&x_ptr);CHKERRQ(ierr);
*f = (x_ptr[0]-user_ptr->x_ob[0])*(x_ptr[0]-user_ptr->x_ob[0])+(x_ptr[1]-user_ptr->x_ob[1])*(x_ptr[1]-user_ptr->x_ob[1]);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Observed value y_ob=[%f; %f], ODE solution y=[%f;%f], Cost function f=%f\n",(double)user_ptr->x_ob[0],(double)user_ptr->x_ob[1],(double)x_ptr[0],(double)x_ptr[1],(double)(*f));CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Redet initial conditions for the adjoint integration */
ierr = VecGetArray(user_ptr->lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 2.*(x_ptr[0]-user_ptr->x_ob[0]);
y_ptr[1] = 2.*(x_ptr[1]-user_ptr->x_ob[1]);
ierr = VecRestoreArray(user_ptr->lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,user_ptr->lambda,NULL);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = VecCopy(user_ptr->lambda[0],G);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
AppCtx appctx; /* user-defined application context */
PetscErrorCode ierr;
PetscInt i, xs, xm, ind, j, lenglob;
PetscReal x, *wrk_ptr1, *wrk_ptr2;
MatNullSpace nsp;
PetscMPIInt size;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program and set problem parameters
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscFunctionBegin;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
/*initialize parameters */
appctx.param.N = 10; /* order of the spectral element */
appctx.param.E = 10; /* number of elements */
appctx.param.L = 4.0; /* length of the domain */
appctx.param.mu = 0.01; /* diffusion coefficient */
appctx.initial_dt = 5e-3;
appctx.param.steps = PETSC_MAX_INT;
appctx.param.Tend = 4;
ierr = PetscOptionsGetInt(NULL,NULL,"-N",&appctx.param.N,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-E",&appctx.param.E,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,NULL,"-Tend",&appctx.param.Tend,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,NULL,"-mu",&appctx.param.mu,NULL);CHKERRQ(ierr);
appctx.param.Le = appctx.param.L/appctx.param.E;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (appctx.param.E % size) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_WRONG,"Number of elements must be divisible by number of processes");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create GLL data structures
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscGLLCreate(appctx.param.N,PETSCGLL_VIA_LINEARALGEBRA,&appctx.SEMop.gll);CHKERRQ(ierr);
lenglob = appctx.param.E*(appctx.param.N-1);
/*
Create distributed array (DMDA) to manage parallel grid and vectors
and to set up the ghost point communication pattern. There are E*(Nl-1)+1
total grid values spread equally among all the processors, except first and last
*/
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,lenglob,1,1,NULL,&appctx.da);CHKERRQ(ierr);
ierr = DMSetFromOptions(appctx.da);CHKERRQ(ierr);
ierr = DMSetUp(appctx.da);CHKERRQ(ierr);
/*
Extract global and local vectors from DMDA; we use these to store the
approximate solution. Then duplicate these for remaining vectors that
have the same types.
*/
ierr = DMCreateGlobalVector(appctx.da,&appctx.dat.curr_sol);CHKERRQ(ierr);
ierr = VecDuplicate(appctx.dat.curr_sol,&appctx.SEMop.grid);CHKERRQ(ierr);
ierr = VecDuplicate(appctx.dat.curr_sol,&appctx.SEMop.mass);CHKERRQ(ierr);
ierr = DMDAGetCorners(appctx.da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
ierr = DMDAVecGetArray(appctx.da,appctx.SEMop.grid,&wrk_ptr1);CHKERRQ(ierr);
ierr = DMDAVecGetArray(appctx.da,appctx.SEMop.mass,&wrk_ptr2);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
xs=xs/(appctx.param.N-1);
xm=xm/(appctx.param.N-1);
/*
Build total grid and mass over entire mesh (multi-elemental)
*/
for (i=xs; i<xs+xm; i++) {
for (j=0; j<appctx.param.N-1; j++) {
x = (appctx.param.Le/2.0)*(appctx.SEMop.gll.nodes[j]+1.0)+appctx.param.Le*i;
ind=i*(appctx.param.N-1)+j;
wrk_ptr1[ind]=x;
wrk_ptr2[ind]=.5*appctx.param.Le*appctx.SEMop.gll.weights[j];
if (j==0) wrk_ptr2[ind]+=.5*appctx.param.Le*appctx.SEMop.gll.weights[j];
}
}
ierr = DMDAVecRestoreArray(appctx.da,appctx.SEMop.grid,&wrk_ptr1);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(appctx.da,appctx.SEMop.mass,&wrk_ptr2);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create matrix data structure; set matrix evaluation routine.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMSetMatrixPreallocateOnly(appctx.da, PETSC_TRUE);CHKERRQ(ierr);
ierr = DMCreateMatrix(appctx.da,&appctx.SEMop.stiff);CHKERRQ(ierr);
ierr = DMCreateMatrix(appctx.da,&appctx.SEMop.grad);CHKERRQ(ierr);
/*
For linear problems with a time-dependent f(u,t) in the equation
u_t = f(u,t), the user provides the discretized right-hand-side
as a time-dependent matrix.
*/
ierr = RHSMatrixLaplaciangllDM(appctx.ts,0.0,appctx.dat.curr_sol,appctx.SEMop.stiff,appctx.SEMop.stiff,&appctx);CHKERRQ(ierr);
ierr = RHSMatrixAdvectiongllDM(appctx.ts,0.0,appctx.dat.curr_sol,appctx.SEMop.grad,appctx.SEMop.grad,&appctx);CHKERRQ(ierr);
/*
For linear problems with a time-dependent f(u,t) in the equation
u_t = f(u,t), the user provides the discretized right-hand-side
as a time-dependent matrix.
*/
ierr = MatDuplicate(appctx.SEMop.stiff,MAT_COPY_VALUES,&appctx.SEMop.keptstiff);CHKERRQ(ierr);
/* attach the null space to the matrix, this probably is not needed but does no harm */
ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nsp);CHKERRQ(ierr);
ierr = MatSetNullSpace(appctx.SEMop.stiff,nsp);CHKERRQ(ierr);
ierr = MatSetNullSpace(appctx.SEMop.keptstiff,nsp);CHKERRQ(ierr);
ierr = MatNullSpaceTest(nsp,appctx.SEMop.stiff,NULL);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nsp);CHKERRQ(ierr);
/* attach the null space to the matrix, this probably is not needed but does no harm */
ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nsp);CHKERRQ(ierr);
ierr = MatSetNullSpace(appctx.SEMop.grad,nsp);CHKERRQ(ierr);
ierr = MatNullSpaceTest(nsp,appctx.SEMop.grad,NULL);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nsp);CHKERRQ(ierr);
/* Create the TS solver that solves the ODE and its adjoint; set its options */
ierr = TSCreate(PETSC_COMM_WORLD,&appctx.ts);CHKERRQ(ierr);
ierr = TSSetProblemType(appctx.ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(appctx.ts,TSRK);CHKERRQ(ierr);
ierr = TSSetDM(appctx.ts,appctx.da);CHKERRQ(ierr);
ierr = TSSetTime(appctx.ts,0.0);CHKERRQ(ierr);
ierr = TSSetTimeStep(appctx.ts,appctx.initial_dt);CHKERRQ(ierr);
ierr = TSSetMaxSteps(appctx.ts,appctx.param.steps);CHKERRQ(ierr);
ierr = TSSetMaxTime(appctx.ts,appctx.param.Tend);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(appctx.ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetTolerances(appctx.ts,1e-7,NULL,1e-7,NULL);CHKERRQ(ierr);
ierr = TSSetSaveTrajectory(appctx.ts);CHKERRQ(ierr);
ierr = TSSetFromOptions(appctx.ts);CHKERRQ(ierr);
ierr = TSSetRHSFunction(appctx.ts,NULL,RHSFunction,&appctx);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(appctx.ts,appctx.SEMop.stiff,appctx.SEMop.stiff,RHSJacobian,&appctx);CHKERRQ(ierr);
/* Set Initial conditions for the problem */
ierr = TrueSolution(appctx.ts,0,appctx.dat.curr_sol,&appctx);CHKERRQ(ierr);
ierr = TSSetSolutionFunction(appctx.ts,(PetscErrorCode (*)(TS,PetscReal,Vec,void *))TrueSolution,&appctx);CHKERRQ(ierr);
ierr = TSSetTime(appctx.ts,0.0);CHKERRQ(ierr);
ierr = TSSetStepNumber(appctx.ts,0);CHKERRQ(ierr);
ierr = TSSolve(appctx.ts,appctx.dat.curr_sol);CHKERRQ(ierr);
ierr = MatDestroy(&appctx.SEMop.stiff);CHKERRQ(ierr);
ierr = MatDestroy(&appctx.SEMop.keptstiff);CHKERRQ(ierr);
ierr = MatDestroy(&appctx.SEMop.grad);CHKERRQ(ierr);
ierr = VecDestroy(&appctx.SEMop.grid);CHKERRQ(ierr);
ierr = VecDestroy(&appctx.SEMop.mass);CHKERRQ(ierr);
ierr = VecDestroy(&appctx.dat.curr_sol);CHKERRQ(ierr);
ierr = PetscGLLDestroy(&appctx.SEMop.gll);CHKERRQ(ierr);
ierr = DMDestroy(&appctx.da);CHKERRQ(ierr);
ierr = TSDestroy(&appctx.ts);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
PetscErrorCode ierr;
PetscMPIInt rank;
PetscInt n = 2;
PetscScalar *u;
PetscInt direction=-1;
PetscBool terminate=PETSC_FALSE;
TSAdapt adapt;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 1.0*rank;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,NULL);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,1000,30.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,0.1);CHKERRQ(ierr);
ierr = TSSetEventHandler(ts,1,&direction,&terminate,EventFunction,PostEventFunction,NULL);CHKERRQ(ierr);
/* The adapative time step controller could take very large timesteps resulting in
the same event occuring multiple times in the same interval. A maximum step size
limit is enforced here to avoid this issue.
*/
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Run timestepping solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
Mat Ap; /* dfdp */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
PetscScalar *u,*v;
AppCtx app;
PetscInt direction[1];
PetscBool terminate[1];
Vec lambda[2],mu[2];
PetscReal tend;
FILE *f;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return 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");
app.mode = 1;
app.lambda1 = 2.75;
app.lambda2 = 0.36;
tend = 0.125;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ex1adj options","");CHKERRQ(ierr);
{
ierr = PetscOptionsReal("-lambda1","","",app.lambda1,&app.lambda1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-lambda2","","",app.lambda2,&app.lambda2,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tend","","",tend,&tend,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&Ap);CHKERRQ(ierr);
ierr = MatSetSizes(Ap,n,1,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(Ap,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(Ap);CHKERRQ(ierr);
ierr = MatSetUp(Ap);CHKERRQ(ierr);
ierr = MatZeroEntries(Ap);CHKERRQ(ierr); /* initialize to zeros */
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0;
u[1] = 1;
ierr = VecRestoreArray(U,&u);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,&app);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,&app);CHKERRQ(ierr);
ierr = TSSetRHSJacobianP(ts,Ap,RHSJacobianP,&app);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetMaxTime(ts,tend);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,1./256.);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* Set directions and terminate flags for the two events */
direction[0] = 0;
terminate[0] = PETSC_FALSE;
ierr = TSSetEventHandler(ts,1,direction,terminate,EventFunction,PostEventFunction,(void*)&app);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Run timestepping solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&lambda[1],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecZeroEntries(lambda[0]);CHKERRQ(ierr);
ierr = VecZeroEntries(lambda[1]);CHKERRQ(ierr);
ierr = VecGetArray(lambda[0],&u);CHKERRQ(ierr);
u[0] = 1.;
ierr = VecRestoreArray(lambda[0],&u);CHKERRQ(ierr);
ierr = VecGetArray(lambda[1],&u);CHKERRQ(ierr);
u[1] = 1.;
ierr = VecRestoreArray(lambda[1],&u);CHKERRQ(ierr);
ierr = MatCreateVecs(Ap,&mu[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(Ap,&mu[1],NULL);CHKERRQ(ierr);
ierr = VecZeroEntries(mu[0]);CHKERRQ(ierr);
ierr = VecZeroEntries(mu[1]);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,2,lambda,mu);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
/*
ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(lambda[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
*/
ierr = VecGetArray(mu[0],&u);CHKERRQ(ierr);
ierr = VecGetArray(mu[1],&v);CHKERRQ(ierr);
f = fopen("adj_mu.out", "a");
ierr = PetscFPrintf(PETSC_COMM_WORLD,f,"%20.15lf %20.15lf %20.15lf\n",tend,u[0],v[0]);CHKERRQ(ierr);
ierr = VecRestoreArray(mu[0],&u);CHKERRQ(ierr);
ierr = VecRestoreArray(mu[1],&v);CHKERRQ(ierr);
fclose(f);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = MatDestroy(&Ap);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[1]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[1]);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
Mat Jacp; /* Jacobian matrix */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
AppCtx ctx;
PetscScalar *u;
PetscReal du[2] = {0.0,0.0};
PetscBool ensemble = PETSC_FALSE,flg1,flg2;
PetscReal ftime;
PetscInt steps;
PetscScalar *x_ptr,*y_ptr;
Vec lambda[1],q,mu[1];
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,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");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr);
ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr);
ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr);
ierr = MatSetUp(Jacp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Swing equation options","");CHKERRQ(ierr);
{
ctx.beta = 2;
ctx.c = 10000.0;
ctx.u_s = 1.0;
ctx.omega_s = 1.0;
ctx.omega_b = 120.0*PETSC_PI;
ctx.H = 5.0;
ierr = PetscOptionsScalar("-Inertia","","",ctx.H,&ctx.H,NULL);CHKERRQ(ierr);
ctx.D = 5.0;
ierr = PetscOptionsScalar("-D","","",ctx.D,&ctx.D,NULL);CHKERRQ(ierr);
ctx.E = 1.1378;
ctx.V = 1.0;
ctx.X = 0.545;
ctx.Pmax = ctx.E*ctx.V/ctx.X;;
ierr = PetscOptionsScalar("-Pmax","","",ctx.Pmax,&ctx.Pmax,NULL);CHKERRQ(ierr);
ctx.Pm = 1.1;
ierr = PetscOptionsScalar("-Pm","","",ctx.Pm,&ctx.Pm,NULL);CHKERRQ(ierr);
ctx.tf = 0.1;
ctx.tcl = 0.2;
ierr = PetscOptionsReal("-tf","Time to start fault","",ctx.tf,&ctx.tf,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tcl","Time to end fault","",ctx.tcl,&ctx.tcl,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-ensemble","Run ensemble of different initial conditions","",ensemble,&ensemble,NULL);CHKERRQ(ierr);
if (ensemble) {
ctx.tf = -1;
ctx.tcl = -1;
}
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax);
u[1] = 1.0;
ierr = PetscOptionsRealArray("-u","Initial solution","",u,&n,&flg1);CHKERRQ(ierr);
n = 2;
ierr = PetscOptionsRealArray("-du","Perturbation in initial solution","",du,&n,&flg2);CHKERRQ(ierr);
u[0] += du[0];
u[1] += du[1];
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
if (flg1 || flg2) {
ctx.tf = -1;
ctx.tcl = -1;
}
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSRK);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,(TSRHSFunction)RHSFunction,&ctx);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,A,A,(TSRHSJacobian)RHSJacobian,&ctx);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 0.0; y_ptr[1] = 0.0;
ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr);
ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = -1.0;
ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr);
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,PETSC_TRUE,&ctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,PETSC_DEFAULT,10.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (ensemble) {
for (du[1] = -2.5; du[1] <= .01; du[1] += .1) {
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax);
u[1] = ctx.omega_s;
u[0] += du[0];
u[1] += du[1];
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr);
ierr = TSSolve(ts,U);CHKERRQ(ierr);
}
} else {
ierr = TSSolve(ts,U);CHKERRQ(ierr);
}
ierr = VecView(U,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Set initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 0.0; y_ptr[1] = 0.0;
ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = -1.0;
ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr);
/* Set RHS JacobianP */
ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,&ctx);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[Psi(tf)]/d[phi0] d[Psi(tf)]/d[omega0]\n");CHKERRQ(ierr);
ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = TSGetCostIntegral(ts,&q);CHKERRQ(ierr);
ierr = VecView(q,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecGetArray(q,&x_ptr);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n cost function=%g\n",(double)(x_ptr[0]-ctx.Pm));CHKERRQ(ierr);
ierr = VecRestoreArray(q,&x_ptr);CHKERRQ(ierr);
ierr = ComputeSensiP(lambda[0],mu[0],&ctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&Jacp);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return(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
*/
PetscErrorCode FormFunction(Tao tao,Vec P,PetscReal *f,void *ctx0)
{
AppCtx *ctx = (AppCtx*)ctx0;
TS ts;
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
Mat Jacp; /* Jacobian matrix */
PetscErrorCode ierr;
PetscInt n = 2;
PetscReal ftime;
PetscInt steps;
PetscScalar *u;
PetscScalar *x_ptr,*y_ptr;
Vec lambda[1],q,mu[1];
ierr = VecGetArray(P,&x_ptr);CHKERRQ(ierr);
ctx->Pm = x_ptr[0];
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr);
ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr);
ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr);
ierr = MatSetUp(Jacp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,ctx);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = PetscAsinScalar(ctx->Pm/ctx->Pmax);
u[1] = 1.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,PETSC_DEFAULT,10.0);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 0.0; y_ptr[1] = 0.0;
ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr);
ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = -1.0;
ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr);
ierr = TSAdjointSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr);
ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,ctx);CHKERRQ(ierr);
ierr = TSAdjointSetCostIntegrand(ts,1,(PetscErrorCode (*)(TS,PetscReal,Vec,Vec,void*))CostIntegrand,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,ctx);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = TSAdjointGetCostIntegral(ts,&q);CHKERRQ(ierr);
ierr = ComputeSensiP(lambda[0],mu[0],ctx);CHKERRQ(ierr);
ierr = VecGetArray(q,&x_ptr);CHKERRQ(ierr);
*f = -ctx->Pm + x_ptr[0];
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&Jacp);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec x; /* solution */
PetscErrorCode ierr;
DM da;
AppCtx appctx;
Vec lambda[1];
PetscScalar *x_ptr;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
PetscFunctionBeginUser;
appctx.D1 = 8.0e-5;
appctx.D2 = 4.0e-5;
appctx.gamma = .024;
appctx.kappa = .06;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,DM_BOUNDARY_PERIODIC,DMDA_STENCIL_STAR,65,65,PETSC_DECIDE,PETSC_DECIDE,2,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMSetFromOptions(da);CHKERRQ(ierr);
ierr = DMSetUp(da);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,0,"u");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"v");CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA; then duplicate for remaining
vectors that are the same types
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&appctx);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,&appctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = InitialConditions(da,x);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
/*
Have the TS save its trajectory so that TSAdjointSolve() may be used
*/
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,PETSC_DEFAULT,2000.0);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.0001);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve ODE system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Start the Adjoint model
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDuplicate(x,&lambda[0]);CHKERRQ(ierr);
/* Reset initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&x_ptr);CHKERRQ(ierr);
ierr = InitializeLambda(da,lambda[0],0.5,0.5);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,lambda,NULL);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec ic;
PetscBool monitor = PETSC_FALSE;
PetscScalar *x_ptr;
PetscMPIInt size;
struct _n_User user;
PetscErrorCode ierr;
Tao tao;
TaoConvergedReason reason;
KSP ksp;
PC pc;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscInitialize(&argc,&argv,NULL,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
user.mu = 1.0;
user.next_output = 0.0;
user.steps = 0;
user.ftime = 0.5;
ierr = PetscOptionsGetReal(NULL,"-mu",&user.mu,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&user.A);CHKERRQ(ierr);
ierr = MatSetSizes(user.A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(user.A);CHKERRQ(ierr);
ierr = MatSetUp(user.A);CHKERRQ(ierr);
ierr = MatCreateVecs(user.A,&user.x,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSRK);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetDuration(ts,PETSC_DEFAULT,user.ftime);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
if (monitor) {
ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(user.x,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2.0; x_ptr[1] = 0.66666654321;
ierr = VecRestoreArray(user.x,&x_ptr);CHKERRQ(ierr);
ierr = TSSetTime(ts,0.0);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"mu %g, steps %D, ftime %g\n",(double)user.mu,user.steps,(double)(user.ftime));CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,user.x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&(user.ftime));CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&user.steps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"mu %g, steps %D, ftime %g\n",(double)user.mu,user.steps,(double)user.ftime);CHKERRQ(ierr);
ierr = VecGetArray(user.x,&x_ptr);CHKERRQ(ierr);
user.x_ob[0] = x_ptr[0];
user.x_ob[1] = x_ptr[1];
ierr = MatCreateVecs(user.A,&user.lambda[0],NULL);CHKERRQ(ierr);
/* Create TAO solver and set desired solution method */
ierr = TaoCreate(PETSC_COMM_WORLD,&tao);CHKERRQ(ierr);
ierr = TaoSetType(tao,TAOCG);CHKERRQ(ierr);
/* Set initial solution guess */
ierr = MatCreateVecs(user.A,&ic,NULL);CHKERRQ(ierr);
ierr = VecGetArray(ic,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2.1;
x_ptr[1] = 0.7;
ierr = VecRestoreArray(ic,&x_ptr);CHKERRQ(ierr);
ierr = TaoSetInitialVector(tao,ic);CHKERRQ(ierr);
/* Set routine for function and gradient evaluation */
ierr = TaoSetObjectiveAndGradientRoutine(tao,FormFunctionGradient,(void *)&user);CHKERRQ(ierr);
/* 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);
}
ierr = TaoSetTolerances(tao,1e-10,1e-10,1e-10,PETSC_DEFAULT,PETSC_DEFAULT);
/* 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);
}
/* Free TAO data structures */
ierr = TaoDestroy(&tao);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&user.A);CHKERRQ(ierr);
ierr = VecDestroy(&user.x);CHKERRQ(ierr);
ierr = VecDestroy(&user.lambda[0]);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = VecDestroy(&ic);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec x; /* solution, residual vectors */
Mat A; /* Jacobian matrix */
Mat Jacp; /* JacobianP matrix */
PetscInt steps;
PetscReal ftime =0.5;
PetscBool monitor = PETSC_FALSE;
PetscScalar *x_ptr;
PetscMPIInt size;
struct _n_User user;
PetscErrorCode ierr;
Vec lambda[2],mu[2];
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscInitialize(&argc,&argv,NULL,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
user.mu = 1;
user.next_output = 0.0;
ierr = PetscOptionsGetReal(NULL,NULL,"-mu",&user.mu,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&x,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr);
ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr);
ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr);
ierr = MatSetUp(Jacp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSRK);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetDuration(ts,PETSC_DEFAULT,ftime);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
if (monitor) {
ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2; x_ptr[1] = 0.66666654321;
ierr = VecRestoreArray(x,&x_ptr);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.001);CHKERRQ(ierr);
/*
Have the TS save its trajectory so that TSAdjointSolve() may be used
*/
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"mu %g, steps %D, ftime %g\n",(double)user.mu,steps,(double)ftime);CHKERRQ(ierr);
ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Start the Adjoint model
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&lambda[1],NULL);CHKERRQ(ierr);
/* Reset initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 1.0; x_ptr[1] = 0.0;
ierr = VecRestoreArray(lambda[0],&x_ptr);CHKERRQ(ierr);
ierr = VecGetArray(lambda[1],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0; x_ptr[1] = 1.0;
ierr = VecRestoreArray(lambda[1],&x_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(Jacp,&mu[1],NULL);CHKERRQ(ierr);
ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0;
ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr);
ierr = VecGetArray(mu[1],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0;
ierr = VecRestoreArray(mu[1],&x_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,2,lambda,mu);CHKERRQ(ierr);
/* Set RHS Jacobian for the adjoint integration */
ierr = TSSetRHSJacobian(ts,A,A,RHSJacobian,&user);CHKERRQ(ierr);
/* Set RHS JacobianP */
ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,&user);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(lambda[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&Jacp);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[1]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[1]);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
PetscBool monitor = PETSC_FALSE;
PetscScalar *x_ptr,*y_ptr;
PetscMPIInt size;
struct _n_User user;
PetscErrorCode ierr;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
user.next_output = 0.0;
user.mu = 1.0e6;
user.steps = 0;
user.ftime = 0.5;
ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,NULL,"-mu",&user.mu,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&user.A);CHKERRQ(ierr);
ierr = MatSetSizes(user.A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(user.A);CHKERRQ(ierr);
ierr = MatSetUp(user.A);CHKERRQ(ierr);
ierr = MatCreateVecs(user.A,&user.x,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&user.Jacp);CHKERRQ(ierr);
ierr = MatSetSizes(user.Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr);
ierr = MatSetFromOptions(user.Jacp);CHKERRQ(ierr);
ierr = MatSetUp(user.Jacp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,user.A,user.A,IJacobian,&user);CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,user.ftime);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
if (monitor) {
ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(user.x,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2.0; x_ptr[1] = -0.66666654321;
ierr = VecRestoreArray(user.x,&x_ptr);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,.0001);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSolve(ts,user.x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&user.ftime);CHKERRQ(ierr);
ierr = TSGetStepNumber(ts,&user.steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreateVecs(user.A,&user.lambda[0],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecGetArray(user.lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 1.0; y_ptr[1] = 0.0;
ierr = VecRestoreArray(user.lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(user.A,&user.lambda[1],NULL);CHKERRQ(ierr);
ierr = VecGetArray(user.lambda[1],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 0.0; y_ptr[1] = 1.0;
ierr = VecRestoreArray(user.lambda[1],&y_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(user.Jacp,&user.mup[0],NULL);CHKERRQ(ierr);
ierr = VecGetArray(user.mup[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0;
ierr = VecRestoreArray(user.mup[0],&x_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(user.Jacp,&user.mup[1],NULL);CHKERRQ(ierr);
ierr = VecGetArray(user.mup[1],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0;
ierr = VecRestoreArray(user.mup[1],&x_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,2,user.lambda,user.mup);CHKERRQ(ierr);
/* Set RHS JacobianP */
ierr = TSSetRHSJacobianP(ts,user.Jacp,RHSJacobianP,&user);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[y(tf)]/d[y0] d[y(tf)]/d[z0]\n");CHKERRQ(ierr);
ierr = VecView(user.lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[z(tf)]/d[y0] d[z(tf)]/d[z0]\n");CHKERRQ(ierr);
ierr = VecView(user.lambda[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt parameters: d[y(tf)]/d[mu]\n");CHKERRQ(ierr);
ierr = VecView(user.mup[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensivitity wrt parameters: d[z(tf)]/d[mu]\n");CHKERRQ(ierr);
ierr = VecView(user.mup[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&user.A);CHKERRQ(ierr);
ierr = MatDestroy(&user.Jacp);CHKERRQ(ierr);
ierr = VecDestroy(&user.x);CHKERRQ(ierr);
ierr = VecDestroy(&user.lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&user.lambda[1]);CHKERRQ(ierr);
ierr = VecDestroy(&user.mup[0]);CHKERRQ(ierr);
ierr = VecDestroy(&user.mup[1]);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;
/* 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;
}
/*
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);
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
PetscScalar *u;
AppCtx app;
PetscInt direction[2];
PetscBool terminate[2];
PetscBool rhs_form=PETSC_FALSE,hist=PETSC_TRUE;
TSAdapt adapt;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return 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");
app.nbounces = 0;
app.maxbounces = 10;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ex40 options","");CHKERRQ(ierr);
ierr = PetscOptionsInt("-maxbounces","","",app.maxbounces,&app.maxbounces,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-test_adapthistory","","",hist,&hist,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set ODE routines
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
/* Users are advised against the following branching and code duplication.
For problems without a mass matrix like the one at hand, the RHSFunction
(and companion RHSJacobian) interface is enough to support both explicit
and implicit timesteppers. This tutorial example also deals with the
IFunction/IJacobian interface for demonstration and testing purposes. */
ierr = PetscOptionsGetBool(NULL,NULL,"-rhs-form",&rhs_form,NULL);CHKERRQ(ierr);
if (rhs_form) {
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,NULL);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,NULL);CHKERRQ(ierr);
} else {
Mat A; /* Jacobian matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,IFunction,NULL);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,IJacobian,NULL);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecCreate(PETSC_COMM_WORLD,&U);CHKERRQ(ierr);
ierr = VecSetSizes(U,n,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetUp(U);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0.0;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,30.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,0.1);CHKERRQ(ierr);
/* The adapative time step controller could take very large timesteps resulting in
the same event occuring multiple times in the same interval. A maximum step size
limit is enforced here to avoid this issue. */
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
/* Set directions and terminate flags for the two events */
direction[0] = -1; direction[1] = -1;
terminate[0] = PETSC_FALSE; terminate[1] = PETSC_TRUE;
ierr = TSSetEventHandler(ts,2,direction,terminate,EventFunction,PostEventFunction,(void*)&app);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Run timestepping solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
if (hist) { /* replay following history */
TSTrajectory tj;
PetscReal tf,t0,dt;
app.nbounces = 0;
ierr = TSGetTime(ts,&tf);CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,tf);CHKERRQ(ierr);
ierr = TSSetStepNumber(ts,0);CHKERRQ(ierr);
ierr = TSRestartStep(ts);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetType(adapt,TSADAPTHISTORY);CHKERRQ(ierr);
ierr = TSGetTrajectory(ts,&tj);CHKERRQ(ierr);
ierr = TSAdaptHistorySetTrajectory(adapt,tj,PETSC_FALSE);CHKERRQ(ierr);
ierr = TSAdaptHistoryGetStep(adapt,0,&t0,&dt);CHKERRQ(ierr);
/* this example fails with single (or smaller) precision */
#if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL__FP16)
ierr = TSAdaptSetType(adapt,TSADAPTBASIC);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
#endif
ierr = TSSetTime(ts,t0);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
ierr = TSResetTrajectory(ts);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0.0;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSolve(ts,U);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}