int FormGradient(TAO_APPLICATION taoapp, Vec X, Vec G,void *userCtx){
int info;
double fcn;
TaoFunctionBegin;
info = FormFunctionGradient(taoapp,X,&fcn,G,userCtx);CHKERRQ(info);
TaoFunctionReturn(0);
}
PetscErrorCode EvaluateHessianFD(Tao tao, Vec p, Userctx* user)
{
PetscErrorCode ierr;
PetscReal f, expo, *eps_arr;
Vec G, G_eps;
int i,j;
PetscReal minusOne=-1., one=1.;
Vec p_eps;
PetscScalar test_eps;
FILE* fOut = fopen("Hessian.txt", "a+");
if(fOut==NULL)
PetscFunctionReturn(-1);
//alocate the vector for gradients: at current point and at perturbed point
ierr = VecDuplicate(p, &G);CHKERRQ(ierr);
ierr = VecDuplicate(p, &G_eps);CHKERRQ(ierr);
//gradient at current point
ierr = FormFunctionGradient(tao, p, &f, G, user);
//alocate the perturbed x
ierr = VecDuplicate(p, &p_eps);CHKERRQ(ierr);
/* testing flag: 0 means fix epsilon; 1 means try several epsilons*/
test_eps = 0;
for(i=0;i<3;i++) {
printf("column %d\n", i);
//test different expo to see what eps works better
for(expo=1e-2; expo>1e-8; expo/=3) {
if (test_eps == 0){
expo = 1.0e-4;
}
ierr = VecCopy(p, p_eps);
ierr = VecGetArray(p_eps, &eps_arr);CHKERRQ(ierr);
eps_arr[i] += expo;
ierr = VecRestoreArray(p_eps, &eps_arr);CHKERRQ(ierr);
//gradient at perturbed point
ierr = FormFunctionGradient(tao, p_eps, &f, G_eps, user);
//i-th column of the Hessian
//G_eps = G_eps-G
ierr = VecAXPBY(G_eps, minusOne, one, G);CHKERRQ(ierr);
//G_eps = G_eps/eps
ierr = VecScale(G_eps, 1/expo);CHKERRQ(ierr);
printf("eps=%7.4e ", expo);
ierr = VecGetArray(G_eps, &eps_arr);CHKERRQ(ierr);
for(j=0; j<3; j++){
if (test_eps == 1){
printf( "%18.12f ", eps_arr[j]);
}
else{
if (j==0){
fprintf(fOut, " %.12f %.12f %.12f %18.12f ", user->tfinal, user->data_noise, PD0_disturb[0], eps_arr[j]);
printf( " %.12f %.12f %.12f %18.12f ", user->tfinal, user->data_noise, PD0_disturb[0], eps_arr[j]);
}
else{
fprintf(fOut, " %18.12f ", eps_arr[j]);
printf( " %18.12f ", eps_arr[j]);
}
}
}
if (test_eps == 1){
printf("\n");
}
else{
fprintf(fOut, "\n");
printf("\n");
break;
}
ierr = VecRestoreArray(G_eps, &eps_arr);CHKERRQ(ierr);
}
}
fclose(fOut);
//destroy vectors
ierr = VecDestroy(&G);CHKERRQ(ierr);
ierr = VecDestroy(&G_eps);CHKERRQ(ierr);
ierr = VecDestroy(&p_eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
