xref: /petsc/src/tao/unconstrained/tutorials/eptorsion1.c (revision a0254a939f1187a8a30e788ec1e80a5d3aab8d9e)
1c4762a1bSJed Brown /* Program usage: mpiexec -n 1 eptorsion1 [-help] [all TAO options] */
2c4762a1bSJed Brown 
3c4762a1bSJed Brown /* ----------------------------------------------------------------------
4c4762a1bSJed Brown 
5c4762a1bSJed Brown   Elastic-plastic torsion problem.
6c4762a1bSJed Brown 
7c4762a1bSJed Brown   The elastic plastic torsion problem arises from the determination
8c4762a1bSJed Brown   of the stress field on an infinitely long cylindrical bar, which is
9c4762a1bSJed Brown   equivalent to the solution of the following problem:
10c4762a1bSJed Brown 
11c4762a1bSJed Brown   min{ .5 * integral(||gradient(v(x))||^2 dx) - C * integral(v(x) dx)}
12c4762a1bSJed Brown 
13c4762a1bSJed Brown   where C is the torsion angle per unit length.
14c4762a1bSJed Brown 
15c4762a1bSJed Brown   The multiprocessor version of this code is eptorsion2.c.
16c4762a1bSJed Brown 
17c4762a1bSJed Brown ---------------------------------------------------------------------- */
18c4762a1bSJed Brown 
19c4762a1bSJed Brown /*
20c4762a1bSJed Brown   Include "petsctao.h" so that we can use TAO solvers.  Note that this
21c4762a1bSJed Brown   file automatically includes files for lower-level support, such as those
22c4762a1bSJed Brown   provided by the PETSc library:
23c4762a1bSJed Brown      petsc.h       - base PETSc routines   petscvec.h - vectors
24a5b23f4aSJose E. Roman      petscsys.h    - system routines        petscmat.h - matrices
25c4762a1bSJed Brown      petscis.h     - index sets            petscksp.h - Krylov subspace methods
26c4762a1bSJed Brown      petscviewer.h - viewers               petscpc.h  - preconditioners
27c4762a1bSJed Brown */
28c4762a1bSJed Brown 
29c4762a1bSJed Brown #include <petsctao.h>
30c4762a1bSJed Brown 
319371c9d4SSatish Balay static char help[] = "Demonstrates use of the TAO package to solve \n\
32c4762a1bSJed Brown unconstrained minimization problems on a single processor.  This example \n\
33c4762a1bSJed Brown is based on the Elastic-Plastic Torsion (dept) problem from the MINPACK-2 \n\
34c4762a1bSJed Brown test suite.\n\
35c4762a1bSJed Brown The command line options are:\n\
36c4762a1bSJed Brown   -mx <xg>, where <xg> = number of grid points in the 1st coordinate direction\n\
37c4762a1bSJed Brown   -my <yg>, where <yg> = number of grid points in the 2nd coordinate direction\n\
38c4762a1bSJed Brown   -par <param>, where <param> = angle of twist per unit length\n\n";
39c4762a1bSJed Brown 
40c4762a1bSJed Brown /*
41c4762a1bSJed Brown    User-defined application context - contains data needed by the
42c4762a1bSJed Brown    application-provided call-back routines, FormFunction(),
43c4762a1bSJed Brown    FormGradient(), and FormHessian().
44c4762a1bSJed Brown */
45c4762a1bSJed Brown 
46c4762a1bSJed Brown typedef struct {
47c4762a1bSJed Brown   PetscReal param;      /* nonlinearity parameter */
48c4762a1bSJed Brown   PetscInt  mx, my;     /* discretization in x- and y-directions */
49c4762a1bSJed Brown   PetscInt  ndim;       /* problem dimension */
50c4762a1bSJed Brown   Vec       s, y, xvec; /* work space for computing Hessian */
51c4762a1bSJed Brown   PetscReal hx, hy;     /* mesh spacing in x- and y-directions */
52c4762a1bSJed Brown } AppCtx;
53c4762a1bSJed Brown 
54c4762a1bSJed Brown /* -------- User-defined Routines --------- */
55c4762a1bSJed Brown 
56c4762a1bSJed Brown PetscErrorCode FormInitialGuess(AppCtx *, Vec);
57c4762a1bSJed Brown PetscErrorCode FormFunction(Tao, Vec, PetscReal *, void *);
58c4762a1bSJed Brown PetscErrorCode FormGradient(Tao, Vec, Vec, void *);
59c4762a1bSJed Brown PetscErrorCode FormHessian(Tao, Vec, Mat, Mat, void *);
60c4762a1bSJed Brown PetscErrorCode HessianProductMat(Mat, Vec, Vec);
61c4762a1bSJed Brown PetscErrorCode HessianProduct(void *, Vec, Vec);
62c4762a1bSJed Brown PetscErrorCode MatrixFreeHessian(Tao, Vec, Mat, Mat, void *);
63c4762a1bSJed Brown PetscErrorCode FormFunctionGradient(Tao, Vec, PetscReal *, Vec, void *);
64c4762a1bSJed Brown 
653ba16761SJacob Faibussowitsch int main(int argc, char **argv)
66d71ae5a4SJacob Faibussowitsch {
67c4762a1bSJed Brown   PetscInt    mx = 10; /* discretization in x-direction */
68c4762a1bSJed Brown   PetscInt    my = 10; /* discretization in y-direction */
69c4762a1bSJed Brown   Vec         x;       /* solution, gradient vectors */
70c4762a1bSJed Brown   PetscBool   flg;     /* A return value when checking for use options */
71c4762a1bSJed Brown   Tao         tao;     /* Tao solver context */
72c4762a1bSJed Brown   Mat         H;       /* Hessian matrix */
73c4762a1bSJed Brown   AppCtx      user;    /* application context */
74c4762a1bSJed Brown   PetscMPIInt size;    /* number of processes */
75c4762a1bSJed Brown   PetscReal   one = 1.0;
76c4762a1bSJed Brown 
77c4762a1bSJed Brown   PetscBool test_lmvm = PETSC_FALSE;
78c4762a1bSJed Brown   KSP       ksp;
79c4762a1bSJed Brown   PC        pc;
80c4762a1bSJed Brown   Mat       M;
81c4762a1bSJed Brown   Vec       in, out, out2;
82c4762a1bSJed Brown   PetscReal mult_solve_dist;
83c4762a1bSJed Brown 
84c4762a1bSJed Brown   /* Initialize TAO,PETSc */
85327415f7SBarry Smith   PetscFunctionBeginUser;
869566063dSJacob Faibussowitsch   PetscCall(PetscInitialize(&argc, &argv, (char *)0, help));
879566063dSJacob Faibussowitsch   PetscCallMPI(MPI_Comm_size(MPI_COMM_WORLD, &size));
883c859ba3SBarry Smith   PetscCheck(size == 1, PETSC_COMM_WORLD, PETSC_ERR_WRONG_MPI_SIZE, "Incorrect number of processors");
89c4762a1bSJed Brown 
90c4762a1bSJed Brown   /* Specify default parameters for the problem, check for command-line overrides */
91c4762a1bSJed Brown   user.param = 5.0;
929566063dSJacob Faibussowitsch   PetscCall(PetscOptionsGetInt(NULL, NULL, "-my", &my, &flg));
939566063dSJacob Faibussowitsch   PetscCall(PetscOptionsGetInt(NULL, NULL, "-mx", &mx, &flg));
949566063dSJacob Faibussowitsch   PetscCall(PetscOptionsGetReal(NULL, NULL, "-par", &user.param, &flg));
959566063dSJacob Faibussowitsch   PetscCall(PetscOptionsGetBool(NULL, NULL, "-test_lmvm", &test_lmvm, &flg));
96c4762a1bSJed Brown 
979566063dSJacob Faibussowitsch   PetscCall(PetscPrintf(PETSC_COMM_SELF, "\n---- Elastic-Plastic Torsion Problem -----\n"));
9863a3b9bcSJacob Faibussowitsch   PetscCall(PetscPrintf(PETSC_COMM_SELF, "mx: %" PetscInt_FMT "     my: %" PetscInt_FMT "   \n\n", mx, my));
999371c9d4SSatish Balay   user.ndim = mx * my;
1009371c9d4SSatish Balay   user.mx   = mx;
1019371c9d4SSatish Balay   user.my   = my;
1029371c9d4SSatish Balay   user.hx   = one / (mx + 1);
1039371c9d4SSatish Balay   user.hy   = one / (my + 1);
104c4762a1bSJed Brown 
105c4762a1bSJed Brown   /* Allocate vectors */
1069566063dSJacob Faibussowitsch   PetscCall(VecCreateSeq(PETSC_COMM_SELF, user.ndim, &user.y));
1079566063dSJacob Faibussowitsch   PetscCall(VecDuplicate(user.y, &user.s));
1089566063dSJacob Faibussowitsch   PetscCall(VecDuplicate(user.y, &x));
109c4762a1bSJed Brown 
110c4762a1bSJed Brown   /* Create TAO solver and set desired solution method */
1119566063dSJacob Faibussowitsch   PetscCall(TaoCreate(PETSC_COMM_SELF, &tao));
1129566063dSJacob Faibussowitsch   PetscCall(TaoSetType(tao, TAOLMVM));
113c4762a1bSJed Brown 
114c4762a1bSJed Brown   /* Set solution vector with an initial guess */
1159566063dSJacob Faibussowitsch   PetscCall(FormInitialGuess(&user, x));
1169566063dSJacob Faibussowitsch   PetscCall(TaoSetSolution(tao, x));
117c4762a1bSJed Brown 
118c4762a1bSJed Brown   /* Set routine for function and gradient evaluation */
1199566063dSJacob Faibussowitsch   PetscCall(TaoSetObjectiveAndGradient(tao, NULL, FormFunctionGradient, (void *)&user));
120c4762a1bSJed Brown 
121c4762a1bSJed Brown   /* From command line options, determine if using matrix-free hessian */
1229566063dSJacob Faibussowitsch   PetscCall(PetscOptionsHasName(NULL, NULL, "-my_tao_mf", &flg));
123c4762a1bSJed Brown   if (flg) {
1249566063dSJacob Faibussowitsch     PetscCall(MatCreateShell(PETSC_COMM_SELF, user.ndim, user.ndim, user.ndim, user.ndim, (void *)&user, &H));
1259566063dSJacob Faibussowitsch     PetscCall(MatShellSetOperation(H, MATOP_MULT, (void (*)(void))HessianProductMat));
1269566063dSJacob Faibussowitsch     PetscCall(MatSetOption(H, MAT_SYMMETRIC, PETSC_TRUE));
127c4762a1bSJed Brown 
1289566063dSJacob Faibussowitsch     PetscCall(TaoSetHessian(tao, H, H, MatrixFreeHessian, (void *)&user));
129c4762a1bSJed Brown   } else {
1309566063dSJacob Faibussowitsch     PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, user.ndim, user.ndim, 5, NULL, &H));
1319566063dSJacob Faibussowitsch     PetscCall(MatSetOption(H, MAT_SYMMETRIC, PETSC_TRUE));
1329566063dSJacob Faibussowitsch     PetscCall(TaoSetHessian(tao, H, H, FormHessian, (void *)&user));
133c4762a1bSJed Brown   }
134c4762a1bSJed Brown 
135c4762a1bSJed Brown   /* Test the LMVM matrix */
136c4762a1bSJed Brown   if (test_lmvm) {
1379566063dSJacob Faibussowitsch     PetscCall(PetscOptionsSetValue(NULL, "-tao_type", "bntr"));
1389566063dSJacob Faibussowitsch     PetscCall(PetscOptionsSetValue(NULL, "-tao_bnk_pc_type", "lmvm"));
139c4762a1bSJed Brown   }
140c4762a1bSJed Brown 
141c4762a1bSJed Brown   /* Check for any TAO command line options */
1429566063dSJacob Faibussowitsch   PetscCall(TaoSetFromOptions(tao));
143c4762a1bSJed Brown 
144c4762a1bSJed Brown   /* SOLVE THE APPLICATION */
1459566063dSJacob Faibussowitsch   PetscCall(TaoSolve(tao));
146c4762a1bSJed Brown 
147c4762a1bSJed Brown   /* Test the LMVM matrix */
148c4762a1bSJed Brown   if (test_lmvm) {
1499566063dSJacob Faibussowitsch     PetscCall(TaoGetKSP(tao, &ksp));
1509566063dSJacob Faibussowitsch     PetscCall(KSPGetPC(ksp, &pc));
1519566063dSJacob Faibussowitsch     PetscCall(PCLMVMGetMatLMVM(pc, &M));
1529566063dSJacob Faibussowitsch     PetscCall(VecDuplicate(x, &in));
1539566063dSJacob Faibussowitsch     PetscCall(VecDuplicate(x, &out));
1549566063dSJacob Faibussowitsch     PetscCall(VecDuplicate(x, &out2));
1559566063dSJacob Faibussowitsch     PetscCall(VecSet(in, 5.0));
1569566063dSJacob Faibussowitsch     PetscCall(MatMult(M, in, out));
1579566063dSJacob Faibussowitsch     PetscCall(MatSolve(M, out, out2));
1589566063dSJacob Faibussowitsch     PetscCall(VecAXPY(out2, -1.0, in));
1599566063dSJacob Faibussowitsch     PetscCall(VecNorm(out2, NORM_2, &mult_solve_dist));
16063a3b9bcSJacob Faibussowitsch     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)tao), "error between MatMult and MatSolve: %e\n", (double)mult_solve_dist));
1619566063dSJacob Faibussowitsch     PetscCall(VecDestroy(&in));
1629566063dSJacob Faibussowitsch     PetscCall(VecDestroy(&out));
1639566063dSJacob Faibussowitsch     PetscCall(VecDestroy(&out2));
164c4762a1bSJed Brown   }
165c4762a1bSJed Brown 
1669566063dSJacob Faibussowitsch   PetscCall(TaoDestroy(&tao));
1679566063dSJacob Faibussowitsch   PetscCall(VecDestroy(&user.s));
1689566063dSJacob Faibussowitsch   PetscCall(VecDestroy(&user.y));
1699566063dSJacob Faibussowitsch   PetscCall(VecDestroy(&x));
1709566063dSJacob Faibussowitsch   PetscCall(MatDestroy(&H));
171c4762a1bSJed Brown 
1729566063dSJacob Faibussowitsch   PetscCall(PetscFinalize());
173b122ec5aSJacob Faibussowitsch   return 0;
174c4762a1bSJed Brown }
175c4762a1bSJed Brown 
176c4762a1bSJed Brown /* ------------------------------------------------------------------- */
177c4762a1bSJed Brown /*
178c4762a1bSJed Brown     FormInitialGuess - Computes an initial approximation to the solution.
179c4762a1bSJed Brown 
180c4762a1bSJed Brown     Input Parameters:
181c4762a1bSJed Brown .   user - user-defined application context
182c4762a1bSJed Brown .   X    - vector
183c4762a1bSJed Brown 
184c4762a1bSJed Brown     Output Parameters:
185c4762a1bSJed Brown .   X    - vector
186c4762a1bSJed Brown */
187d71ae5a4SJacob Faibussowitsch PetscErrorCode FormInitialGuess(AppCtx *user, Vec X)
188d71ae5a4SJacob Faibussowitsch {
189c4762a1bSJed Brown   PetscReal hx = user->hx, hy = user->hy, temp;
190c4762a1bSJed Brown   PetscReal val;
191c4762a1bSJed Brown   PetscInt  i, j, k, nx = user->mx, ny = user->my;
192c4762a1bSJed Brown 
193c4762a1bSJed Brown   /* Compute initial guess */
194c4762a1bSJed Brown   PetscFunctionBeginUser;
195c4762a1bSJed Brown   for (j = 0; j < ny; j++) {
196c4762a1bSJed Brown     temp = PetscMin(j + 1, ny - j) * hy;
197c4762a1bSJed Brown     for (i = 0; i < nx; i++) {
198c4762a1bSJed Brown       k   = nx * j + i;
199c4762a1bSJed Brown       val = PetscMin((PetscMin(i + 1, nx - i)) * hx, temp);
2009566063dSJacob Faibussowitsch       PetscCall(VecSetValues(X, 1, &k, &val, ADD_VALUES));
201c4762a1bSJed Brown     }
202c4762a1bSJed Brown   }
2039566063dSJacob Faibussowitsch   PetscCall(VecAssemblyBegin(X));
2049566063dSJacob Faibussowitsch   PetscCall(VecAssemblyEnd(X));
2053ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
206c4762a1bSJed Brown }
207c4762a1bSJed Brown 
208c4762a1bSJed Brown /* ------------------------------------------------------------------- */
209c4762a1bSJed Brown /*
210c4762a1bSJed Brown    FormFunctionGradient - Evaluates the function and corresponding gradient.
211c4762a1bSJed Brown 
212c4762a1bSJed Brown    Input Parameters:
213c4762a1bSJed Brown    tao - the Tao context
214c4762a1bSJed Brown    X   - the input vector
215c4762a1bSJed Brown    ptr - optional user-defined context, as set by TaoSetFunction()
216c4762a1bSJed Brown 
217c4762a1bSJed Brown    Output Parameters:
218c4762a1bSJed Brown    f   - the newly evaluated function
219c4762a1bSJed Brown    G   - the newly evaluated gradient
220c4762a1bSJed Brown */
221d71ae5a4SJacob Faibussowitsch PetscErrorCode FormFunctionGradient(Tao tao, Vec X, PetscReal *f, Vec G, void *ptr)
222d71ae5a4SJacob Faibussowitsch {
223c4762a1bSJed Brown   PetscFunctionBeginUser;
2249566063dSJacob Faibussowitsch   PetscCall(FormFunction(tao, X, f, ptr));
2259566063dSJacob Faibussowitsch   PetscCall(FormGradient(tao, X, G, ptr));
2263ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
227c4762a1bSJed Brown }
228c4762a1bSJed Brown 
229c4762a1bSJed Brown /* ------------------------------------------------------------------- */
230c4762a1bSJed Brown /*
231c4762a1bSJed Brown    FormFunction - Evaluates the function, f(X).
232c4762a1bSJed Brown 
233c4762a1bSJed Brown    Input Parameters:
234c4762a1bSJed Brown .  tao - the Tao context
235c4762a1bSJed Brown .  X   - the input vector
236c4762a1bSJed Brown .  ptr - optional user-defined context, as set by TaoSetFunction()
237c4762a1bSJed Brown 
238c4762a1bSJed Brown    Output Parameters:
239c4762a1bSJed Brown .  f    - the newly evaluated function
240c4762a1bSJed Brown */
241d71ae5a4SJacob Faibussowitsch PetscErrorCode FormFunction(Tao tao, Vec X, PetscReal *f, void *ptr)
242d71ae5a4SJacob Faibussowitsch {
243c4762a1bSJed Brown   AppCtx            *user = (AppCtx *)ptr;
244c4762a1bSJed Brown   PetscReal          hx = user->hx, hy = user->hy, area, three = 3.0, p5 = 0.5;
245c4762a1bSJed Brown   PetscReal          zero = 0.0, vb, vl, vr, vt, dvdx, dvdy, flin = 0.0, fquad = 0.0;
246c4762a1bSJed Brown   PetscReal          v, cdiv3 = user->param / three;
247c4762a1bSJed Brown   const PetscScalar *x;
248c4762a1bSJed Brown   PetscInt           nx = user->mx, ny = user->my, i, j, k;
249c4762a1bSJed Brown 
250c4762a1bSJed Brown   PetscFunctionBeginUser;
251c4762a1bSJed Brown   /* Get pointer to vector data */
2529566063dSJacob Faibussowitsch   PetscCall(VecGetArrayRead(X, &x));
253c4762a1bSJed Brown 
254c4762a1bSJed Brown   /* Compute function contributions over the lower triangular elements */
255c4762a1bSJed Brown   for (j = -1; j < ny; j++) {
256c4762a1bSJed Brown     for (i = -1; i < nx; i++) {
257c4762a1bSJed Brown       k  = nx * j + i;
258c4762a1bSJed Brown       v  = zero;
259c4762a1bSJed Brown       vr = zero;
260c4762a1bSJed Brown       vt = zero;
261c4762a1bSJed Brown       if (i >= 0 && j >= 0) v = x[k];
262c4762a1bSJed Brown       if (i < nx - 1 && j > -1) vr = x[k + 1];
263c4762a1bSJed Brown       if (i > -1 && j < ny - 1) vt = x[k + nx];
264c4762a1bSJed Brown       dvdx = (vr - v) / hx;
265c4762a1bSJed Brown       dvdy = (vt - v) / hy;
266c4762a1bSJed Brown       fquad += dvdx * dvdx + dvdy * dvdy;
267c4762a1bSJed Brown       flin -= cdiv3 * (v + vr + vt);
268c4762a1bSJed Brown     }
269c4762a1bSJed Brown   }
270c4762a1bSJed Brown 
271c4762a1bSJed Brown   /* Compute function contributions over the upper triangular elements */
272c4762a1bSJed Brown   for (j = 0; j <= ny; j++) {
273c4762a1bSJed Brown     for (i = 0; i <= nx; i++) {
274c4762a1bSJed Brown       k  = nx * j + i;
275c4762a1bSJed Brown       vb = zero;
276c4762a1bSJed Brown       vl = zero;
277c4762a1bSJed Brown       v  = zero;
278c4762a1bSJed Brown       if (i < nx && j > 0) vb = x[k - nx];
279c4762a1bSJed Brown       if (i > 0 && j < ny) vl = x[k - 1];
280c4762a1bSJed Brown       if (i < nx && j < ny) v = x[k];
281c4762a1bSJed Brown       dvdx  = (v - vl) / hx;
282c4762a1bSJed Brown       dvdy  = (v - vb) / hy;
283c4762a1bSJed Brown       fquad = fquad + dvdx * dvdx + dvdy * dvdy;
284c4762a1bSJed Brown       flin  = flin - cdiv3 * (vb + vl + v);
285c4762a1bSJed Brown     }
286c4762a1bSJed Brown   }
287c4762a1bSJed Brown 
288c4762a1bSJed Brown   /* Restore vector */
2899566063dSJacob Faibussowitsch   PetscCall(VecRestoreArrayRead(X, &x));
290c4762a1bSJed Brown 
291c4762a1bSJed Brown   /* Scale the function */
292c4762a1bSJed Brown   area = p5 * hx * hy;
293c4762a1bSJed Brown   *f   = area * (p5 * fquad + flin);
294c4762a1bSJed Brown 
2959566063dSJacob Faibussowitsch   PetscCall(PetscLogFlops(24.0 * nx * ny));
2963ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
297c4762a1bSJed Brown }
298c4762a1bSJed Brown 
299c4762a1bSJed Brown /* ------------------------------------------------------------------- */
300c4762a1bSJed Brown /*
301c4762a1bSJed Brown     FormGradient - Evaluates the gradient, G(X).
302c4762a1bSJed Brown 
303c4762a1bSJed Brown     Input Parameters:
304c4762a1bSJed Brown .   tao  - the Tao context
305c4762a1bSJed Brown .   X    - input vector
306c4762a1bSJed Brown .   ptr  - optional user-defined context
307c4762a1bSJed Brown 
308c4762a1bSJed Brown     Output Parameters:
309c4762a1bSJed Brown .   G - vector containing the newly evaluated gradient
310c4762a1bSJed Brown */
311d71ae5a4SJacob Faibussowitsch PetscErrorCode FormGradient(Tao tao, Vec X, Vec G, void *ptr)
312d71ae5a4SJacob Faibussowitsch {
313c4762a1bSJed Brown   AppCtx            *user = (AppCtx *)ptr;
314c4762a1bSJed Brown   PetscReal          zero = 0.0, p5 = 0.5, three = 3.0, area, val;
315c4762a1bSJed Brown   PetscInt           nx = user->mx, ny = user->my, ind, i, j, k;
316c4762a1bSJed Brown   PetscReal          hx = user->hx, hy = user->hy;
317c4762a1bSJed Brown   PetscReal          vb, vl, vr, vt, dvdx, dvdy;
318c4762a1bSJed Brown   PetscReal          v, cdiv3 = user->param / three;
319c4762a1bSJed Brown   const PetscScalar *x;
320c4762a1bSJed Brown 
321c4762a1bSJed Brown   PetscFunctionBeginUser;
322c4762a1bSJed Brown   /* Initialize gradient to zero */
3239566063dSJacob Faibussowitsch   PetscCall(VecSet(G, zero));
324c4762a1bSJed Brown 
325c4762a1bSJed Brown   /* Get pointer to vector data */
3269566063dSJacob Faibussowitsch   PetscCall(VecGetArrayRead(X, &x));
327c4762a1bSJed Brown 
328c4762a1bSJed Brown   /* Compute gradient contributions over the lower triangular elements */
329c4762a1bSJed Brown   for (j = -1; j < ny; j++) {
330c4762a1bSJed Brown     for (i = -1; i < nx; i++) {
331c4762a1bSJed Brown       k  = nx * j + i;
332c4762a1bSJed Brown       v  = zero;
333c4762a1bSJed Brown       vr = zero;
334c4762a1bSJed Brown       vt = zero;
335c4762a1bSJed Brown       if (i >= 0 && j >= 0) v = x[k];
336c4762a1bSJed Brown       if (i < nx - 1 && j > -1) vr = x[k + 1];
337c4762a1bSJed Brown       if (i > -1 && j < ny - 1) vt = x[k + nx];
338c4762a1bSJed Brown       dvdx = (vr - v) / hx;
339c4762a1bSJed Brown       dvdy = (vt - v) / hy;
340c4762a1bSJed Brown       if (i != -1 && j != -1) {
3419371c9d4SSatish Balay         ind = k;
3429371c9d4SSatish Balay         val = -dvdx / hx - dvdy / hy - cdiv3;
3439566063dSJacob Faibussowitsch         PetscCall(VecSetValues(G, 1, &ind, &val, ADD_VALUES));
344c4762a1bSJed Brown       }
345c4762a1bSJed Brown       if (i != nx - 1 && j != -1) {
3469371c9d4SSatish Balay         ind = k + 1;
3479371c9d4SSatish Balay         val = dvdx / hx - cdiv3;
3489566063dSJacob Faibussowitsch         PetscCall(VecSetValues(G, 1, &ind, &val, ADD_VALUES));
349c4762a1bSJed Brown       }
350c4762a1bSJed Brown       if (i != -1 && j != ny - 1) {
3519371c9d4SSatish Balay         ind = k + nx;
3529371c9d4SSatish Balay         val = dvdy / hy - cdiv3;
3539566063dSJacob Faibussowitsch         PetscCall(VecSetValues(G, 1, &ind, &val, ADD_VALUES));
354c4762a1bSJed Brown       }
355c4762a1bSJed Brown     }
356c4762a1bSJed Brown   }
357c4762a1bSJed Brown 
358c4762a1bSJed Brown   /* Compute gradient contributions over the upper triangular elements */
359c4762a1bSJed Brown   for (j = 0; j <= ny; j++) {
360c4762a1bSJed Brown     for (i = 0; i <= nx; i++) {
361c4762a1bSJed Brown       k  = nx * j + i;
362c4762a1bSJed Brown       vb = zero;
363c4762a1bSJed Brown       vl = zero;
364c4762a1bSJed Brown       v  = zero;
365c4762a1bSJed Brown       if (i < nx && j > 0) vb = x[k - nx];
366c4762a1bSJed Brown       if (i > 0 && j < ny) vl = x[k - 1];
367c4762a1bSJed Brown       if (i < nx && j < ny) v = x[k];
368c4762a1bSJed Brown       dvdx = (v - vl) / hx;
369c4762a1bSJed Brown       dvdy = (v - vb) / hy;
370c4762a1bSJed Brown       if (i != nx && j != 0) {
3719371c9d4SSatish Balay         ind = k - nx;
3729371c9d4SSatish Balay         val = -dvdy / hy - cdiv3;
3739566063dSJacob Faibussowitsch         PetscCall(VecSetValues(G, 1, &ind, &val, ADD_VALUES));
374c4762a1bSJed Brown       }
375c4762a1bSJed Brown       if (i != 0 && j != ny) {
3769371c9d4SSatish Balay         ind = k - 1;
3779371c9d4SSatish Balay         val = -dvdx / hx - cdiv3;
3789566063dSJacob Faibussowitsch         PetscCall(VecSetValues(G, 1, &ind, &val, ADD_VALUES));
379c4762a1bSJed Brown       }
380c4762a1bSJed Brown       if (i != nx && j != ny) {
3819371c9d4SSatish Balay         ind = k;
3829371c9d4SSatish Balay         val = dvdx / hx + dvdy / hy - cdiv3;
3839566063dSJacob Faibussowitsch         PetscCall(VecSetValues(G, 1, &ind, &val, ADD_VALUES));
384c4762a1bSJed Brown       }
385c4762a1bSJed Brown     }
386c4762a1bSJed Brown   }
3879566063dSJacob Faibussowitsch   PetscCall(VecRestoreArrayRead(X, &x));
388c4762a1bSJed Brown 
389c4762a1bSJed Brown   /* Assemble gradient vector */
3909566063dSJacob Faibussowitsch   PetscCall(VecAssemblyBegin(G));
3919566063dSJacob Faibussowitsch   PetscCall(VecAssemblyEnd(G));
392c4762a1bSJed Brown 
393c4762a1bSJed Brown   /* Scale the gradient */
394c4762a1bSJed Brown   area = p5 * hx * hy;
3959566063dSJacob Faibussowitsch   PetscCall(VecScale(G, area));
3969566063dSJacob Faibussowitsch   PetscCall(PetscLogFlops(24.0 * nx * ny));
3973ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
398c4762a1bSJed Brown }
399c4762a1bSJed Brown 
400c4762a1bSJed Brown /* ------------------------------------------------------------------- */
401c4762a1bSJed Brown /*
402c4762a1bSJed Brown    FormHessian - Forms the Hessian matrix.
403c4762a1bSJed Brown 
404c4762a1bSJed Brown    Input Parameters:
405c4762a1bSJed Brown .  tao - the Tao context
406c4762a1bSJed Brown .  X    - the input vector
407c4762a1bSJed Brown .  ptr  - optional user-defined context, as set by TaoSetHessian()
408c4762a1bSJed Brown 
409c4762a1bSJed Brown    Output Parameters:
410c4762a1bSJed Brown .  H     - Hessian matrix
411c4762a1bSJed Brown .  PrecH - optionally different preconditioning Hessian
412c4762a1bSJed Brown .  flag  - flag indicating matrix structure
413c4762a1bSJed Brown 
414c4762a1bSJed Brown    Notes:
415c4762a1bSJed Brown    This routine is intended simply as an example of the interface
416c4762a1bSJed Brown    to a Hessian evaluation routine.  Since this example compute the
417c4762a1bSJed Brown    Hessian a column at a time, it is not particularly efficient and
418c4762a1bSJed Brown    is not recommended.
419c4762a1bSJed Brown */
420d71ae5a4SJacob Faibussowitsch PetscErrorCode FormHessian(Tao tao, Vec X, Mat H, Mat Hpre, void *ptr)
421d71ae5a4SJacob Faibussowitsch {
422c4762a1bSJed Brown   AppCtx    *user = (AppCtx *)ptr;
423c4762a1bSJed Brown   PetscInt   i, j, ndim = user->ndim;
424c4762a1bSJed Brown   PetscReal *y, zero = 0.0, one = 1.0;
425c4762a1bSJed Brown   PetscBool  assembled;
426c4762a1bSJed Brown 
427c4762a1bSJed Brown   PetscFunctionBeginUser;
428c4762a1bSJed Brown   user->xvec = X;
429c4762a1bSJed Brown 
430c4762a1bSJed Brown   /* Initialize Hessian entries and work vector to zero */
4319566063dSJacob Faibussowitsch   PetscCall(MatAssembled(H, &assembled));
4329566063dSJacob Faibussowitsch   if (assembled) PetscCall(MatZeroEntries(H));
433c4762a1bSJed Brown 
4349566063dSJacob Faibussowitsch   PetscCall(VecSet(user->s, zero));
435c4762a1bSJed Brown 
436c4762a1bSJed Brown   /* Loop over matrix columns to compute entries of the Hessian */
437c4762a1bSJed Brown   for (j = 0; j < ndim; j++) {
4389566063dSJacob Faibussowitsch     PetscCall(VecSetValues(user->s, 1, &j, &one, INSERT_VALUES));
4399566063dSJacob Faibussowitsch     PetscCall(VecAssemblyBegin(user->s));
4409566063dSJacob Faibussowitsch     PetscCall(VecAssemblyEnd(user->s));
441c4762a1bSJed Brown 
4429566063dSJacob Faibussowitsch     PetscCall(HessianProduct(ptr, user->s, user->y));
443c4762a1bSJed Brown 
4449566063dSJacob Faibussowitsch     PetscCall(VecSetValues(user->s, 1, &j, &zero, INSERT_VALUES));
4459566063dSJacob Faibussowitsch     PetscCall(VecAssemblyBegin(user->s));
4469566063dSJacob Faibussowitsch     PetscCall(VecAssemblyEnd(user->s));
447c4762a1bSJed Brown 
4489566063dSJacob Faibussowitsch     PetscCall(VecGetArray(user->y, &y));
449c4762a1bSJed Brown     for (i = 0; i < ndim; i++) {
45048a46eb9SPierre Jolivet       if (y[i] != zero) PetscCall(MatSetValues(H, 1, &i, 1, &j, &y[i], ADD_VALUES));
451c4762a1bSJed Brown     }
4529566063dSJacob Faibussowitsch     PetscCall(VecRestoreArray(user->y, &y));
453c4762a1bSJed Brown   }
4549566063dSJacob Faibussowitsch   PetscCall(MatAssemblyBegin(H, MAT_FINAL_ASSEMBLY));
4559566063dSJacob Faibussowitsch   PetscCall(MatAssemblyEnd(H, MAT_FINAL_ASSEMBLY));
4563ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
457c4762a1bSJed Brown }
458c4762a1bSJed Brown 
459c4762a1bSJed Brown /* ------------------------------------------------------------------- */
460c4762a1bSJed Brown /*
461c4762a1bSJed Brown    MatrixFreeHessian - Sets a pointer for use in computing Hessian-vector
462c4762a1bSJed Brown    products.
463c4762a1bSJed Brown 
464c4762a1bSJed Brown    Input Parameters:
465c4762a1bSJed Brown .  tao - the Tao context
466c4762a1bSJed Brown .  X    - the input vector
467c4762a1bSJed Brown .  ptr  - optional user-defined context, as set by TaoSetHessian()
468c4762a1bSJed Brown 
469c4762a1bSJed Brown    Output Parameters:
470c4762a1bSJed Brown .  H     - Hessian matrix
471c4762a1bSJed Brown .  PrecH - optionally different preconditioning Hessian
472c4762a1bSJed Brown .  flag  - flag indicating matrix structure
473c4762a1bSJed Brown */
474d71ae5a4SJacob Faibussowitsch PetscErrorCode MatrixFreeHessian(Tao tao, Vec X, Mat H, Mat PrecH, void *ptr)
475d71ae5a4SJacob Faibussowitsch {
476c4762a1bSJed Brown   AppCtx *user = (AppCtx *)ptr;
477c4762a1bSJed Brown 
478c4762a1bSJed Brown   /* Sets location of vector for use in computing matrix-vector products  of the form H(X)*y  */
479362febeeSStefano Zampini   PetscFunctionBeginUser;
480c4762a1bSJed Brown   user->xvec = X;
4813ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
482c4762a1bSJed Brown }
483c4762a1bSJed Brown 
484c4762a1bSJed Brown /* ------------------------------------------------------------------- */
485c4762a1bSJed Brown /*
486c4762a1bSJed Brown    HessianProductMat - Computes the matrix-vector product
487c4762a1bSJed Brown    y = mat*svec.
488c4762a1bSJed Brown 
489c4762a1bSJed Brown    Input Parameters:
490c4762a1bSJed Brown .  mat  - input matrix
491c4762a1bSJed Brown .  svec - input vector
492c4762a1bSJed Brown 
493c4762a1bSJed Brown    Output Parameters:
494c4762a1bSJed Brown .  y    - solution vector
495c4762a1bSJed Brown */
496d71ae5a4SJacob Faibussowitsch PetscErrorCode HessianProductMat(Mat mat, Vec svec, Vec y)
497d71ae5a4SJacob Faibussowitsch {
498c4762a1bSJed Brown   void *ptr;
499c4762a1bSJed Brown 
500c4762a1bSJed Brown   PetscFunctionBeginUser;
5019566063dSJacob Faibussowitsch   PetscCall(MatShellGetContext(mat, &ptr));
5029566063dSJacob Faibussowitsch   PetscCall(HessianProduct(ptr, svec, y));
5033ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
504c4762a1bSJed Brown }
505c4762a1bSJed Brown 
506c4762a1bSJed Brown /* ------------------------------------------------------------------- */
507c4762a1bSJed Brown /*
508c4762a1bSJed Brown    Hessian Product - Computes the matrix-vector product:
509c4762a1bSJed Brown    y = f''(x)*svec.
510c4762a1bSJed Brown 
5117a7aea1fSJed Brown    Input Parameters:
512c4762a1bSJed Brown .  ptr  - pointer to the user-defined context
513c4762a1bSJed Brown .  svec - input vector
514c4762a1bSJed Brown 
515c4762a1bSJed Brown    Output Parameters:
516c4762a1bSJed Brown .  y    - product vector
517c4762a1bSJed Brown */
518d71ae5a4SJacob Faibussowitsch PetscErrorCode HessianProduct(void *ptr, Vec svec, Vec y)
519d71ae5a4SJacob Faibussowitsch {
520c4762a1bSJed Brown   AppCtx            *user = (AppCtx *)ptr;
521c4762a1bSJed Brown   PetscReal          p5 = 0.5, zero = 0.0, one = 1.0, hx, hy, val, area;
522c4762a1bSJed Brown   const PetscScalar *x, *s;
523c4762a1bSJed Brown   PetscReal          v, vb, vl, vr, vt, hxhx, hyhy;
524c4762a1bSJed Brown   PetscInt           nx, ny, i, j, k, ind;
525c4762a1bSJed Brown 
526c4762a1bSJed Brown   PetscFunctionBeginUser;
527c4762a1bSJed Brown   nx   = user->mx;
528c4762a1bSJed Brown   ny   = user->my;
529c4762a1bSJed Brown   hx   = user->hx;
530c4762a1bSJed Brown   hy   = user->hy;
531c4762a1bSJed Brown   hxhx = one / (hx * hx);
532c4762a1bSJed Brown   hyhy = one / (hy * hy);
533c4762a1bSJed Brown 
534c4762a1bSJed Brown   /* Get pointers to vector data */
5359566063dSJacob Faibussowitsch   PetscCall(VecGetArrayRead(user->xvec, &x));
5369566063dSJacob Faibussowitsch   PetscCall(VecGetArrayRead(svec, &s));
537c4762a1bSJed Brown 
538c4762a1bSJed Brown   /* Initialize product vector to zero */
5399566063dSJacob Faibussowitsch   PetscCall(VecSet(y, zero));
540c4762a1bSJed Brown 
541c4762a1bSJed Brown   /* Compute f''(x)*s over the lower triangular elements */
542c4762a1bSJed Brown   for (j = -1; j < ny; j++) {
543c4762a1bSJed Brown     for (i = -1; i < nx; i++) {
544c4762a1bSJed Brown       k  = nx * j + i;
545c4762a1bSJed Brown       v  = zero;
546c4762a1bSJed Brown       vr = zero;
547c4762a1bSJed Brown       vt = zero;
548c4762a1bSJed Brown       if (i != -1 && j != -1) v = s[k];
549c4762a1bSJed Brown       if (i != nx - 1 && j != -1) {
550c4762a1bSJed Brown         vr  = s[k + 1];
5519371c9d4SSatish Balay         ind = k + 1;
5529371c9d4SSatish Balay         val = hxhx * (vr - v);
5539566063dSJacob Faibussowitsch         PetscCall(VecSetValues(y, 1, &ind, &val, ADD_VALUES));
554c4762a1bSJed Brown       }
555c4762a1bSJed Brown       if (i != -1 && j != ny - 1) {
556c4762a1bSJed Brown         vt  = s[k + nx];
5579371c9d4SSatish Balay         ind = k + nx;
5589371c9d4SSatish Balay         val = hyhy * (vt - v);
5599566063dSJacob Faibussowitsch         PetscCall(VecSetValues(y, 1, &ind, &val, ADD_VALUES));
560c4762a1bSJed Brown       }
561c4762a1bSJed Brown       if (i != -1 && j != -1) {
5629371c9d4SSatish Balay         ind = k;
5639371c9d4SSatish Balay         val = hxhx * (v - vr) + hyhy * (v - vt);
5649566063dSJacob Faibussowitsch         PetscCall(VecSetValues(y, 1, &ind, &val, ADD_VALUES));
565c4762a1bSJed Brown       }
566c4762a1bSJed Brown     }
567c4762a1bSJed Brown   }
568c4762a1bSJed Brown 
569c4762a1bSJed Brown   /* Compute f''(x)*s over the upper triangular elements */
570c4762a1bSJed Brown   for (j = 0; j <= ny; j++) {
571c4762a1bSJed Brown     for (i = 0; i <= nx; i++) {
572c4762a1bSJed Brown       k  = nx * j + i;
573c4762a1bSJed Brown       v  = zero;
574c4762a1bSJed Brown       vl = zero;
575c4762a1bSJed Brown       vb = zero;
576c4762a1bSJed Brown       if (i != nx && j != ny) v = s[k];
577c4762a1bSJed Brown       if (i != nx && j != 0) {
578c4762a1bSJed Brown         vb  = s[k - nx];
5799371c9d4SSatish Balay         ind = k - nx;
5809371c9d4SSatish Balay         val = hyhy * (vb - v);
5819566063dSJacob Faibussowitsch         PetscCall(VecSetValues(y, 1, &ind, &val, ADD_VALUES));
582c4762a1bSJed Brown       }
583c4762a1bSJed Brown       if (i != 0 && j != ny) {
584c4762a1bSJed Brown         vl  = s[k - 1];
5859371c9d4SSatish Balay         ind = k - 1;
5869371c9d4SSatish Balay         val = hxhx * (vl - v);
5879566063dSJacob Faibussowitsch         PetscCall(VecSetValues(y, 1, &ind, &val, ADD_VALUES));
588c4762a1bSJed Brown       }
589c4762a1bSJed Brown       if (i != nx && j != ny) {
5909371c9d4SSatish Balay         ind = k;
5919371c9d4SSatish Balay         val = hxhx * (v - vl) + hyhy * (v - vb);
5929566063dSJacob Faibussowitsch         PetscCall(VecSetValues(y, 1, &ind, &val, ADD_VALUES));
593c4762a1bSJed Brown       }
594c4762a1bSJed Brown     }
595c4762a1bSJed Brown   }
596c4762a1bSJed Brown   /* Restore vector data */
5979566063dSJacob Faibussowitsch   PetscCall(VecRestoreArrayRead(svec, &s));
5989566063dSJacob Faibussowitsch   PetscCall(VecRestoreArrayRead(user->xvec, &x));
599c4762a1bSJed Brown 
600c4762a1bSJed Brown   /* Assemble vector */
6019566063dSJacob Faibussowitsch   PetscCall(VecAssemblyBegin(y));
6029566063dSJacob Faibussowitsch   PetscCall(VecAssemblyEnd(y));
603c4762a1bSJed Brown 
604c4762a1bSJed Brown   /* Scale resulting vector by area */
605c4762a1bSJed Brown   area = p5 * hx * hy;
6069566063dSJacob Faibussowitsch   PetscCall(VecScale(y, area));
6079566063dSJacob Faibussowitsch   PetscCall(PetscLogFlops(18.0 * nx * ny));
6083ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
609c4762a1bSJed Brown }
610c4762a1bSJed Brown 
611c4762a1bSJed Brown /*TEST
612c4762a1bSJed Brown 
613c4762a1bSJed Brown    build:
614c4762a1bSJed Brown       requires: !complex
615c4762a1bSJed Brown 
616c4762a1bSJed Brown    test:
617c4762a1bSJed Brown       suffix: 1
618c4762a1bSJed Brown       args: -tao_smonitor -tao_type ntl -tao_gatol 1.e-4
619c4762a1bSJed Brown 
620c4762a1bSJed Brown    test:
621c4762a1bSJed Brown       suffix: 2
622c4762a1bSJed Brown       args: -tao_smonitor -tao_type ntr -tao_gatol 1.e-4
623c4762a1bSJed Brown 
624c4762a1bSJed Brown    test:
625c4762a1bSJed Brown       suffix: 3
626c4762a1bSJed Brown       args: -tao_smonitor -tao_type bntr -tao_gatol 1.e-4 -my_tao_mf -tao_test_hessian
627c4762a1bSJed Brown 
628c4762a1bSJed Brown    test:
629c4762a1bSJed Brown      suffix: 4
630c4762a1bSJed Brown      args: -tao_smonitor -tao_gatol 1e-3 -tao_type bqnls
631c4762a1bSJed Brown 
632c4762a1bSJed Brown    test:
633c4762a1bSJed Brown      suffix: 5
634c4762a1bSJed Brown      args: -tao_smonitor -tao_gatol 1e-3 -tao_type blmvm
635c4762a1bSJed Brown 
636c4762a1bSJed Brown    test:
637c4762a1bSJed Brown      suffix: 6
638c4762a1bSJed Brown      args: -tao_smonitor -tao_gatol 1e-3 -tao_type bqnktr -tao_bqnk_mat_type lmvmsr1
639c4762a1bSJed Brown 
640f4f59681SStefano Zampini    test:
641f4f59681SStefano Zampini      suffix: snes
642f4f59681SStefano Zampini      args: -snes_monitor ::ascii_info_detail -tao_type snes -snes_type newtontr -ksp_type cg  -snes_atol 1.e-4 -tao_mf_hessian {{0 1}} -pc_type none
643f4f59681SStefano Zampini 
644f4f59681SStefano Zampini    test:
645f4f59681SStefano Zampini      suffix: snes_2
646f4f59681SStefano Zampini      args: -snes_monitor ::ascii_info_detail -tao_type snes -snes_type newtontr -snes_atol 5.e-4 -tao_mf_hessian -pc_type none -snes_tr_fallback_type cauchy
647f4f59681SStefano Zampini 
648*a0254a93SStefano Zampini    test:
649*a0254a93SStefano Zampini      suffix: snes_3
650*a0254a93SStefano Zampini      args: -snes_monitor ::ascii_info_detail -tao_type snes -snes_type newtontr -snes_atol 5.e-4 -tao_mf_hessian -pc_type lmvm -snes_tr_fallback_type cauchy
651*a0254a93SStefano Zampini 
652c4762a1bSJed Brown TEST*/
653