xref: /petsc/src/snes/tests/ex17.c (revision 6a4a1270853b5b1995c94de98f44d28bec57470a)
1 static const char help[] = "Newton's method to solve a two-variable system, sequentially.\n"
2                            "The same problem is solved twice - i) fully assembled system + ii) block system\n\n";
3 
4 /*
5 Include "petscsnes.h" so that we can use SNES solvers.  Note that this
6 file automatically includes:
7 petscsys.h       - base PETSc routines   petscvec.h - vectors
8 petscsys.h    - system routines       petscmat.h - matrices
9 petscis.h     - index sets            petscksp.h - Krylov subspace methods
10 petscviewer.h - viewers               petscpc.h  - preconditioners
11 petscksp.h   - linear solvers
12 */
13 #include <petscsnes.h>
14 
15 /*
16 This example is block version of the test found at
17   ${PETSC_DIR}/src/snes/tutorials/ex1.c
18 In this test we replace the Jacobian systems
19   [J]{x} = {F}
20 where
21 
22 [J] = (j_00, j_01),  {x} = (x_0, x_1)^T,   {F} = (f_0, f_1)^T
23       (j_10, j_11)
24 where [J] \in \mathbb^{2 \times 2}, {x},{F} \in \mathbb^{2 \times 1},
25 
26 with a block system in which each block is of length 1.
27 i.e. The block system is thus
28 
29 [J] = ([j00], [j01]),  {x} = ({x0}, {x1})^T, {F} = ({f0}, {f1})^T
30       ([j10], [j11])
31 where
32 [j00], [j01], [j10], [j11] \in \mathbb^{1 \times 1}
33 {x0}, {x1}, {f0}, {f1} \in \mathbb^{1 \times 1}
34 
35 In practice we would not bother defing blocks of size one, and would instead assemble the
36 full system. This is just a simple test to illustrate how to manipulate the blocks and
37 to confirm the implementation is correct.
38 */
39 
40 /*
41 User-defined routines
42 */
43 static PetscErrorCode FormJacobian1(SNES, Vec, Mat, Mat, void *);
44 static PetscErrorCode FormFunction1(SNES, Vec, Vec, void *);
45 static PetscErrorCode FormJacobian2(SNES, Vec, Mat, Mat, void *);
46 static PetscErrorCode FormFunction2(SNES, Vec, Vec, void *);
47 static PetscErrorCode FormJacobian1_block(SNES, Vec, Mat, Mat, void *);
48 static PetscErrorCode FormFunction1_block(SNES, Vec, Vec, void *);
49 static PetscErrorCode FormJacobian2_block(SNES, Vec, Mat, Mat, void *);
50 static PetscErrorCode FormFunction2_block(SNES, Vec, Vec, void *);
51 
52 static PetscErrorCode assembled_system(void) {
53   SNES        snes; /* nonlinear solver context */
54   KSP         ksp;  /* linear solver context */
55   PC          pc;   /* preconditioner context */
56   Vec         x, r; /* solution, residual vectors */
57   Mat         J;    /* Jacobian matrix */
58   PetscInt    its;
59   PetscScalar pfive = .5, *xx;
60   PetscBool   flg;
61 
62   PetscFunctionBeginUser;
63   PetscCall(PetscPrintf(PETSC_COMM_WORLD, "\n\n========================= Assembled system =========================\n\n"));
64 
65   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
66   Create nonlinear solver context
67   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
68 
69   PetscCall(SNESCreate(PETSC_COMM_WORLD, &snes));
70 
71   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
72   Create matrix and vector data structures; set corresponding routines
73   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
74 
75   /*
76   Create vectors for solution and nonlinear function
77   */
78   PetscCall(VecCreateSeq(PETSC_COMM_SELF, 2, &x));
79   PetscCall(VecDuplicate(x, &r));
80 
81   /*
82   Create Jacobian matrix data structure
83   */
84   PetscCall(MatCreate(PETSC_COMM_SELF, &J));
85   PetscCall(MatSetSizes(J, PETSC_DECIDE, PETSC_DECIDE, 2, 2));
86   PetscCall(MatSetFromOptions(J));
87   PetscCall(MatSetUp(J));
88 
89   PetscCall(PetscOptionsHasName(NULL, NULL, "-hard", &flg));
90   if (!flg) {
91     /*
92     Set function evaluation routine and vector.
93     */
94     PetscCall(SNESSetFunction(snes, r, FormFunction1, NULL));
95 
96     /*
97     Set Jacobian matrix data structure and Jacobian evaluation routine
98     */
99     PetscCall(SNESSetJacobian(snes, J, J, FormJacobian1, NULL));
100   } else {
101     PetscCall(SNESSetFunction(snes, r, FormFunction2, NULL));
102     PetscCall(SNESSetJacobian(snes, J, J, FormJacobian2, NULL));
103   }
104 
105   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
106   Customize nonlinear solver; set runtime options
107   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
108 
109   /*
110   Set linear solver defaults for this problem. By extracting the
111   KSP, KSP, and PC contexts from the SNES context, we can then
112   directly call any KSP, KSP, and PC routines to set various options.
113   */
114   PetscCall(SNESGetKSP(snes, &ksp));
115   PetscCall(KSPGetPC(ksp, &pc));
116   PetscCall(PCSetType(pc, PCNONE));
117   PetscCall(KSPSetTolerances(ksp, 1.e-4, PETSC_DEFAULT, PETSC_DEFAULT, 20));
118 
119   /*
120   Set SNES/KSP/KSP/PC runtime options, e.g.,
121   -snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc>
122   These options will override those specified above as long as
123   SNESSetFromOptions() is called _after_ any other customization
124   routines.
125   */
126   PetscCall(SNESSetFromOptions(snes));
127 
128   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
129   Evaluate initial guess; then solve nonlinear system
130   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
131   if (!flg) {
132     PetscCall(VecSet(x, pfive));
133   } else {
134     PetscCall(VecGetArray(x, &xx));
135     xx[0] = 2.0;
136     xx[1] = 3.0;
137     PetscCall(VecRestoreArray(x, &xx));
138   }
139   /*
140   Note: The user should initialize the vector, x, with the initial guess
141   for the nonlinear solver prior to calling SNESSolve().  In particular,
142   to employ an initial guess of zero, the user should explicitly set
143   this vector to zero by calling VecSet().
144   */
145 
146   PetscCall(SNESSolve(snes, NULL, x));
147   PetscCall(SNESGetIterationNumber(snes, &its));
148   if (flg) {
149     Vec f;
150     PetscCall(VecView(x, PETSC_VIEWER_STDOUT_WORLD));
151     PetscCall(SNESGetFunction(snes, &f, 0, 0));
152     PetscCall(VecView(r, PETSC_VIEWER_STDOUT_WORLD));
153   }
154   PetscCall(PetscPrintf(PETSC_COMM_SELF, "number of SNES iterations = %" PetscInt_FMT "\n\n", its));
155 
156   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
157   Free work space.  All PETSc objects should be destroyed when they
158   are no longer needed.
159   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
160 
161   PetscCall(VecDestroy(&x));
162   PetscCall(VecDestroy(&r));
163   PetscCall(MatDestroy(&J));
164   PetscCall(SNESDestroy(&snes));
165   PetscFunctionReturn(0);
166 }
167 
168 /*
169 FormFunction1 - Evaluates nonlinear function, F(x).
170 
171 Input Parameters:
172 .  snes - the SNES context
173 .  x - input vector
174 .  dummy - optional user-defined context (not used here)
175 
176 Output Parameter:
177 .  f - function vector
178 */
179 static PetscErrorCode FormFunction1(SNES snes, Vec x, Vec f, void *dummy) {
180   const PetscScalar *xx;
181   PetscScalar       *ff;
182 
183   PetscFunctionBeginUser;
184   /*
185   Get pointers to vector data.
186   - For default PETSc vectors, VecGetArray() returns a pointer to
187   the data array.  Otherwise, the routine is implementation dependent.
188   - You MUST call VecRestoreArray() when you no longer need access to
189   the array.
190   */
191   PetscCall(VecGetArrayRead(x, &xx));
192   PetscCall(VecGetArray(f, &ff));
193 
194   /*
195   Compute function
196   */
197   ff[0] = xx[0] * xx[0] + xx[0] * xx[1] - 3.0;
198   ff[1] = xx[0] * xx[1] + xx[1] * xx[1] - 6.0;
199 
200   /*
201   Restore vectors
202   */
203   PetscCall(VecRestoreArrayRead(x, &xx));
204   PetscCall(VecRestoreArray(f, &ff));
205   PetscFunctionReturn(0);
206 }
207 
208 /*
209 FormJacobian1 - Evaluates Jacobian matrix.
210 
211 Input Parameters:
212 .  snes - the SNES context
213 .  x - input vector
214 .  dummy - optional user-defined context (not used here)
215 
216 Output Parameters:
217 .  jac - Jacobian matrix
218 .  B - optionally different preconditioning matrix
219 .  flag - flag indicating matrix structure
220 */
221 static PetscErrorCode FormJacobian1(SNES snes, Vec x, Mat jac, Mat B, void *dummy) {
222   const PetscScalar *xx;
223   PetscScalar        A[4];
224   PetscInt           idx[2] = {0, 1};
225 
226   PetscFunctionBeginUser;
227   /*
228   Get pointer to vector data
229   */
230   PetscCall(VecGetArrayRead(x, &xx));
231 
232   /*
233   Compute Jacobian entries and insert into matrix.
234   - Since this is such a small problem, we set all entries for
235   the matrix at once.
236   */
237   A[0] = 2.0 * xx[0] + xx[1];
238   A[1] = xx[0];
239   A[2] = xx[1];
240   A[3] = xx[0] + 2.0 * xx[1];
241   PetscCall(MatSetValues(jac, 2, idx, 2, idx, A, INSERT_VALUES));
242 
243   /*
244   Restore vector
245   */
246   PetscCall(VecRestoreArrayRead(x, &xx));
247 
248   /*
249   Assemble matrix
250   */
251   PetscCall(MatAssemblyBegin(jac, MAT_FINAL_ASSEMBLY));
252   PetscCall(MatAssemblyEnd(jac, MAT_FINAL_ASSEMBLY));
253   PetscFunctionReturn(0);
254 }
255 
256 static PetscErrorCode FormFunction2(SNES snes, Vec x, Vec f, void *dummy) {
257   const PetscScalar *xx;
258   PetscScalar       *ff;
259 
260   PetscFunctionBeginUser;
261   /*
262   Get pointers to vector data.
263   - For default PETSc vectors, VecGetArray() returns a pointer to
264   the data array.  Otherwise, the routine is implementation dependent.
265   - You MUST call VecRestoreArray() when you no longer need access to
266   the array.
267   */
268   PetscCall(VecGetArrayRead(x, &xx));
269   PetscCall(VecGetArray(f, &ff));
270 
271   /*
272   Compute function
273   */
274   ff[0] = PetscSinScalar(3.0 * xx[0]) + xx[0];
275   ff[1] = xx[1];
276 
277   /*
278   Restore vectors
279   */
280   PetscCall(VecRestoreArrayRead(x, &xx));
281   PetscCall(VecRestoreArray(f, &ff));
282   PetscFunctionReturn(0);
283 }
284 
285 static PetscErrorCode FormJacobian2(SNES snes, Vec x, Mat jac, Mat B, void *dummy) {
286   const PetscScalar *xx;
287   PetscScalar        A[4];
288   PetscInt           idx[2] = {0, 1};
289 
290   PetscFunctionBeginUser;
291   /*
292   Get pointer to vector data
293   */
294   PetscCall(VecGetArrayRead(x, &xx));
295 
296   /*
297   Compute Jacobian entries and insert into matrix.
298   - Since this is such a small problem, we set all entries for
299   the matrix at once.
300   */
301   A[0] = 3.0 * PetscCosScalar(3.0 * xx[0]) + 1.0;
302   A[1] = 0.0;
303   A[2] = 0.0;
304   A[3] = 1.0;
305   PetscCall(MatSetValues(jac, 2, idx, 2, idx, A, INSERT_VALUES));
306 
307   /*
308   Restore vector
309   */
310   PetscCall(VecRestoreArrayRead(x, &xx));
311 
312   /*
313   Assemble matrix
314   */
315   PetscCall(MatAssemblyBegin(jac, MAT_FINAL_ASSEMBLY));
316   PetscCall(MatAssemblyEnd(jac, MAT_FINAL_ASSEMBLY));
317   PetscFunctionReturn(0);
318 }
319 
320 static PetscErrorCode block_system(void) {
321   SNES        snes; /* nonlinear solver context */
322   KSP         ksp;  /* linear solver context */
323   PC          pc;   /* preconditioner context */
324   Vec         x, r; /* solution, residual vectors */
325   Mat         J;    /* Jacobian matrix */
326   PetscInt    its;
327   PetscScalar pfive = .5;
328   PetscBool   flg;
329 
330   Mat j11, j12, j21, j22;
331   Vec x1, x2, r1, r2;
332   Vec bv;
333   Vec bx[2];
334   Mat bA[2][2];
335 
336   PetscFunctionBeginUser;
337   PetscCall(PetscPrintf(PETSC_COMM_WORLD, "\n\n========================= Block system =========================\n\n"));
338 
339   PetscCall(SNESCreate(PETSC_COMM_WORLD, &snes));
340 
341   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
342   Create matrix and vector data structures; set corresponding routines
343   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
344 
345   /*
346   Create sub vectors for solution and nonlinear function
347   */
348   PetscCall(VecCreateSeq(PETSC_COMM_SELF, 1, &x1));
349   PetscCall(VecDuplicate(x1, &r1));
350 
351   PetscCall(VecCreateSeq(PETSC_COMM_SELF, 1, &x2));
352   PetscCall(VecDuplicate(x2, &r2));
353 
354   /*
355   Create the block vectors
356   */
357   bx[0] = x1;
358   bx[1] = x2;
359   PetscCall(VecCreateNest(PETSC_COMM_WORLD, 2, NULL, bx, &x));
360   PetscCall(VecAssemblyBegin(x));
361   PetscCall(VecAssemblyEnd(x));
362   PetscCall(VecDestroy(&x1));
363   PetscCall(VecDestroy(&x2));
364 
365   bx[0] = r1;
366   bx[1] = r2;
367   PetscCall(VecCreateNest(PETSC_COMM_WORLD, 2, NULL, bx, &r));
368   PetscCall(VecDestroy(&r1));
369   PetscCall(VecDestroy(&r2));
370   PetscCall(VecAssemblyBegin(r));
371   PetscCall(VecAssemblyEnd(r));
372 
373   /*
374   Create sub Jacobian matrix data structure
375   */
376   PetscCall(MatCreate(PETSC_COMM_WORLD, &j11));
377   PetscCall(MatSetSizes(j11, 1, 1, 1, 1));
378   PetscCall(MatSetType(j11, MATSEQAIJ));
379   PetscCall(MatSetUp(j11));
380 
381   PetscCall(MatCreate(PETSC_COMM_WORLD, &j12));
382   PetscCall(MatSetSizes(j12, 1, 1, 1, 1));
383   PetscCall(MatSetType(j12, MATSEQAIJ));
384   PetscCall(MatSetUp(j12));
385 
386   PetscCall(MatCreate(PETSC_COMM_WORLD, &j21));
387   PetscCall(MatSetSizes(j21, 1, 1, 1, 1));
388   PetscCall(MatSetType(j21, MATSEQAIJ));
389   PetscCall(MatSetUp(j21));
390 
391   PetscCall(MatCreate(PETSC_COMM_WORLD, &j22));
392   PetscCall(MatSetSizes(j22, PETSC_DECIDE, PETSC_DECIDE, 1, 1));
393   PetscCall(MatSetType(j22, MATSEQAIJ));
394   PetscCall(MatSetUp(j22));
395   /*
396   Create block Jacobian matrix data structure
397   */
398   bA[0][0] = j11;
399   bA[0][1] = j12;
400   bA[1][0] = j21;
401   bA[1][1] = j22;
402 
403   PetscCall(MatCreateNest(PETSC_COMM_WORLD, 2, NULL, 2, NULL, &bA[0][0], &J));
404   PetscCall(MatSetUp(J));
405   PetscCall(MatNestSetVecType(J, VECNEST));
406   PetscCall(MatDestroy(&j11));
407   PetscCall(MatDestroy(&j12));
408   PetscCall(MatDestroy(&j21));
409   PetscCall(MatDestroy(&j22));
410 
411   PetscCall(MatAssemblyBegin(J, MAT_FINAL_ASSEMBLY));
412   PetscCall(MatAssemblyEnd(J, MAT_FINAL_ASSEMBLY));
413 
414   PetscCall(PetscOptionsHasName(NULL, NULL, "-hard", &flg));
415   if (!flg) {
416     /*
417     Set function evaluation routine and vector.
418     */
419     PetscCall(SNESSetFunction(snes, r, FormFunction1_block, NULL));
420 
421     /*
422     Set Jacobian matrix data structure and Jacobian evaluation routine
423     */
424     PetscCall(SNESSetJacobian(snes, J, J, FormJacobian1_block, NULL));
425   } else {
426     PetscCall(SNESSetFunction(snes, r, FormFunction2_block, NULL));
427     PetscCall(SNESSetJacobian(snes, J, J, FormJacobian2_block, NULL));
428   }
429 
430   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
431   Customize nonlinear solver; set runtime options
432   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
433 
434   /*
435   Set linear solver defaults for this problem. By extracting the
436   KSP, KSP, and PC contexts from the SNES context, we can then
437   directly call any KSP, KSP, and PC routines to set various options.
438   */
439   PetscCall(SNESGetKSP(snes, &ksp));
440   PetscCall(KSPGetPC(ksp, &pc));
441   PetscCall(PCSetType(pc, PCNONE));
442   PetscCall(KSPSetTolerances(ksp, 1.e-4, PETSC_DEFAULT, PETSC_DEFAULT, 20));
443 
444   /*
445   Set SNES/KSP/KSP/PC runtime options, e.g.,
446   -snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc>
447   These options will override those specified above as long as
448   SNESSetFromOptions() is called _after_ any other customization
449   routines.
450   */
451   PetscCall(SNESSetFromOptions(snes));
452 
453   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
454   Evaluate initial guess; then solve nonlinear system
455   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
456   if (!flg) {
457     PetscCall(VecSet(x, pfive));
458   } else {
459     Vec *vecs;
460     PetscCall(VecNestGetSubVecs(x, NULL, &vecs));
461     bv = vecs[0];
462     /*    PetscCall(VecBlockGetSubVec(x, 0, &bv)); */
463     PetscCall(VecSetValue(bv, 0, 2.0, INSERT_VALUES)); /* xx[0] = 2.0; */
464     PetscCall(VecAssemblyBegin(bv));
465     PetscCall(VecAssemblyEnd(bv));
466 
467     /*    PetscCall(VecBlockGetSubVec(x, 1, &bv)); */
468     bv = vecs[1];
469     PetscCall(VecSetValue(bv, 0, 3.0, INSERT_VALUES)); /* xx[1] = 3.0; */
470     PetscCall(VecAssemblyBegin(bv));
471     PetscCall(VecAssemblyEnd(bv));
472   }
473   /*
474   Note: The user should initialize the vector, x, with the initial guess
475   for the nonlinear solver prior to calling SNESSolve().  In particular,
476   to employ an initial guess of zero, the user should explicitly set
477   this vector to zero by calling VecSet().
478   */
479   PetscCall(SNESSolve(snes, NULL, x));
480   PetscCall(SNESGetIterationNumber(snes, &its));
481   if (flg) {
482     Vec f;
483     PetscCall(VecView(x, PETSC_VIEWER_STDOUT_WORLD));
484     PetscCall(SNESGetFunction(snes, &f, 0, 0));
485     PetscCall(VecView(r, PETSC_VIEWER_STDOUT_WORLD));
486   }
487 
488   PetscCall(PetscPrintf(PETSC_COMM_SELF, "number of SNES iterations = %" PetscInt_FMT "\n\n", its));
489 
490   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
491   Free work space.  All PETSc objects should be destroyed when they
492   are no longer needed.
493   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
494   PetscCall(VecDestroy(&x));
495   PetscCall(VecDestroy(&r));
496   PetscCall(MatDestroy(&J));
497   PetscCall(SNESDestroy(&snes));
498   PetscFunctionReturn(0);
499 }
500 
501 static PetscErrorCode FormFunction1_block(SNES snes, Vec x, Vec f, void *dummy) {
502   Vec        *xx, *ff, x1, x2, f1, f2;
503   PetscScalar ff_0, ff_1;
504   PetscScalar xx_0, xx_1;
505   PetscInt    index, nb;
506 
507   PetscFunctionBeginUser;
508   /* get blocks for function */
509   PetscCall(VecNestGetSubVecs(f, &nb, &ff));
510   f1 = ff[0];
511   f2 = ff[1];
512 
513   /* get blocks for solution */
514   PetscCall(VecNestGetSubVecs(x, &nb, &xx));
515   x1 = xx[0];
516   x2 = xx[1];
517 
518   /* get solution values */
519   index = 0;
520   PetscCall(VecGetValues(x1, 1, &index, &xx_0));
521   PetscCall(VecGetValues(x2, 1, &index, &xx_1));
522 
523   /* Compute function */
524   ff_0 = xx_0 * xx_0 + xx_0 * xx_1 - 3.0;
525   ff_1 = xx_0 * xx_1 + xx_1 * xx_1 - 6.0;
526 
527   /* set function values */
528   PetscCall(VecSetValue(f1, index, ff_0, INSERT_VALUES));
529 
530   PetscCall(VecSetValue(f2, index, ff_1, INSERT_VALUES));
531 
532   PetscCall(VecAssemblyBegin(f));
533   PetscCall(VecAssemblyEnd(f));
534   PetscFunctionReturn(0);
535 }
536 
537 static PetscErrorCode FormJacobian1_block(SNES snes, Vec x, Mat jac, Mat B, void *dummy) {
538   Vec        *xx, x1, x2;
539   PetscScalar xx_0, xx_1;
540   PetscInt    index, nb;
541   PetscScalar A_00, A_01, A_10, A_11;
542   Mat         j11, j12, j21, j22;
543   Mat       **mats;
544 
545   PetscFunctionBeginUser;
546   /* get blocks for solution */
547   PetscCall(VecNestGetSubVecs(x, &nb, &xx));
548   x1 = xx[0];
549   x2 = xx[1];
550 
551   /* get solution values */
552   index = 0;
553   PetscCall(VecGetValues(x1, 1, &index, &xx_0));
554   PetscCall(VecGetValues(x2, 1, &index, &xx_1));
555 
556   /* get block matrices */
557   PetscCall(MatNestGetSubMats(jac, NULL, NULL, &mats));
558   j11 = mats[0][0];
559   j12 = mats[0][1];
560   j21 = mats[1][0];
561   j22 = mats[1][1];
562 
563   /* compute jacobian entries */
564   A_00 = 2.0 * xx_0 + xx_1;
565   A_01 = xx_0;
566   A_10 = xx_1;
567   A_11 = xx_0 + 2.0 * xx_1;
568 
569   /* set jacobian values */
570   PetscCall(MatSetValue(j11, 0, 0, A_00, INSERT_VALUES));
571   PetscCall(MatSetValue(j12, 0, 0, A_01, INSERT_VALUES));
572   PetscCall(MatSetValue(j21, 0, 0, A_10, INSERT_VALUES));
573   PetscCall(MatSetValue(j22, 0, 0, A_11, INSERT_VALUES));
574 
575   /* Assemble sub matrix */
576   PetscCall(MatAssemblyBegin(jac, MAT_FINAL_ASSEMBLY));
577   PetscCall(MatAssemblyEnd(jac, MAT_FINAL_ASSEMBLY));
578   PetscFunctionReturn(0);
579 }
580 
581 static PetscErrorCode FormFunction2_block(SNES snes, Vec x, Vec f, void *dummy) {
582   PetscScalar       *ff;
583   const PetscScalar *xx;
584 
585   PetscFunctionBeginUser;
586   /*
587   Get pointers to vector data.
588   - For default PETSc vectors, VecGetArray() returns a pointer to
589   the data array.  Otherwise, the routine is implementation dependent.
590   - You MUST call VecRestoreArray() when you no longer need access to
591   the array.
592   */
593   PetscCall(VecGetArrayRead(x, &xx));
594   PetscCall(VecGetArray(f, &ff));
595 
596   /*
597   Compute function
598   */
599   ff[0] = PetscSinScalar(3.0 * xx[0]) + xx[0];
600   ff[1] = xx[1];
601 
602   /*
603   Restore vectors
604   */
605   PetscCall(VecRestoreArrayRead(x, &xx));
606   PetscCall(VecRestoreArray(f, &ff));
607   PetscFunctionReturn(0);
608 }
609 
610 static PetscErrorCode FormJacobian2_block(SNES snes, Vec x, Mat jac, Mat B, void *dummy) {
611   const PetscScalar *xx;
612   PetscScalar        A[4];
613   PetscInt           idx[2] = {0, 1};
614 
615   PetscFunctionBeginUser;
616   /*
617   Get pointer to vector data
618   */
619   PetscCall(VecGetArrayRead(x, &xx));
620 
621   /*
622   Compute Jacobian entries and insert into matrix.
623   - Since this is such a small problem, we set all entries for
624   the matrix at once.
625   */
626   A[0] = 3.0 * PetscCosScalar(3.0 * xx[0]) + 1.0;
627   A[1] = 0.0;
628   A[2] = 0.0;
629   A[3] = 1.0;
630   PetscCall(MatSetValues(jac, 2, idx, 2, idx, A, INSERT_VALUES));
631 
632   /*
633   Restore vector
634   */
635   PetscCall(VecRestoreArrayRead(x, &xx));
636 
637   /*
638   Assemble matrix
639   */
640   PetscCall(MatAssemblyBegin(jac, MAT_FINAL_ASSEMBLY));
641   PetscCall(MatAssemblyEnd(jac, MAT_FINAL_ASSEMBLY));
642   PetscFunctionReturn(0);
643 }
644 
645 int main(int argc, char **argv) {
646   PetscMPIInt size;
647 
648   PetscFunctionBeginUser;
649   PetscCall(PetscInitialize(&argc, &argv, (char *)0, help));
650   PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));
651   PetscCheck(size == 1, PETSC_COMM_WORLD, PETSC_ERR_WRONG_MPI_SIZE, "This is a uniprocessor example only!");
652   PetscCall(assembled_system());
653   PetscCall(block_system());
654   PetscCall(PetscFinalize());
655   return 0;
656 }
657 
658 /*TEST
659 
660    test:
661       args: -snes_monitor_short
662       requires: !single
663 
664 TEST*/
665