/*
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 TaoSetFunction()
Output Parameters:
f - the newly evaluated function
G - the newly evaluated gradient
*/
PetscErrorCode FormFunctionGradient(Tao tao,Vec X,PetscReal *f,Vec G,void *ptr)
{
PetscErrorCode ierr;
ierr = FormFunction(tao,X,f,ptr);CHKERRQ(ierr);
ierr = FormGradient(tao,X,G,ptr);CHKERRQ(ierr);
return 0;
}
// Matrix and Residual Fills
bool FiniteDifference::evaluate(FillType f,
const Vec* soln,
Vec* tmp_rhs,
Mat* tmp_matrix)
{
flag = f;
int ierr = 0;
// Set the incoming linear objects
if (flag == RHS_ONLY) {
rhs = tmp_rhs;
}
else if (flag == MATRIX_ONLY) {
A = tmp_matrix;
}
else if (flag == ALL) {
rhs = tmp_rhs;
A = tmp_matrix;
}
else {
std::cout << "ERROR: FiniteDifference::fillMatrix() - No such flag as "
<< flag << std::endl;
throw;
}
// Begin RHS fill
if((flag == RHS_ONLY) || (flag == ALL)) {
ierr = FormFunction(*snes, *soln, *rhs, ctx);CHKERRQ(ierr);
PetscScalar minusOne = 1.0;
ierr = VecScale( *rhs, minusOne );CHKERRQ(ierr);
}
// Begin Jacobian fill
if((flag == MATRIX_ONLY) || (flag == ALL)) {
ierr = FormJacobian(*snes, *soln, A, A, &matStruct, ctx);CHKERRQ(ierr);
}
return true;
}
/*
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);
}