xref: /petsc/src/mat/matfd/fdmatrix.c (revision a68bbae58a07f2fb515cab24a67de1159d72e8a2)
1 
2 /*
3    This is where the abstract matrix operations are defined that are
4   used for finite difference computations of Jacobians using coloring.
5 */
6 
7 #include <petsc/private/matimpl.h> /*I "petscmat.h" I*/
8 #include <petsc/private/isimpl.h>
9 
10 PetscErrorCode MatFDColoringSetF(MatFDColoring fd, Vec F)
11 {
12   PetscFunctionBegin;
13   if (F) {
14     PetscCall(VecCopy(F, fd->w1));
15     fd->fset = PETSC_TRUE;
16   } else {
17     fd->fset = PETSC_FALSE;
18   }
19   PetscFunctionReturn(PETSC_SUCCESS);
20 }
21 
22 #include <petscdraw.h>
23 static PetscErrorCode MatFDColoringView_Draw_Zoom(PetscDraw draw, void *Aa)
24 {
25   MatFDColoring fd = (MatFDColoring)Aa;
26   PetscInt      i, j, nz, row;
27   PetscReal     x, y;
28   MatEntry     *Jentry = fd->matentry;
29 
30   PetscFunctionBegin;
31   /* loop over colors  */
32   nz = 0;
33   for (i = 0; i < fd->ncolors; i++) {
34     for (j = 0; j < fd->nrows[i]; j++) {
35       row = Jentry[nz].row;
36       y   = fd->M - row - fd->rstart;
37       x   = (PetscReal)Jentry[nz++].col;
38       PetscCall(PetscDrawRectangle(draw, x, y, x + 1, y + 1, i + 1, i + 1, i + 1, i + 1));
39     }
40   }
41   PetscFunctionReturn(PETSC_SUCCESS);
42 }
43 
44 static PetscErrorCode MatFDColoringView_Draw(MatFDColoring fd, PetscViewer viewer)
45 {
46   PetscBool isnull;
47   PetscDraw draw;
48   PetscReal xr, yr, xl, yl, h, w;
49 
50   PetscFunctionBegin;
51   PetscCall(PetscViewerDrawGetDraw(viewer, 0, &draw));
52   PetscCall(PetscDrawIsNull(draw, &isnull));
53   if (isnull) PetscFunctionReturn(PETSC_SUCCESS);
54 
55   xr = fd->N;
56   yr = fd->M;
57   h  = yr / 10.0;
58   w  = xr / 10.0;
59   xr += w;
60   yr += h;
61   xl = -w;
62   yl = -h;
63   PetscCall(PetscDrawSetCoordinates(draw, xl, yl, xr, yr));
64   PetscCall(PetscObjectCompose((PetscObject)fd, "Zoomviewer", (PetscObject)viewer));
65   PetscCall(PetscDrawZoom(draw, MatFDColoringView_Draw_Zoom, fd));
66   PetscCall(PetscObjectCompose((PetscObject)fd, "Zoomviewer", NULL));
67   PetscCall(PetscDrawSave(draw));
68   PetscFunctionReturn(PETSC_SUCCESS);
69 }
70 
71 /*@C
72    MatFDColoringView - Views a finite difference coloring context.
73 
74    Collective
75 
76    Input Parameters:
77 +  c - the coloring context
78 -  viewer - visualization context
79 
80    Level: intermediate
81 
82    Notes:
83    The available visualization contexts include
84 +     `PETSC_VIEWER_STDOUT_SELF` - standard output (default)
85 .     `PETSC_VIEWER_STDOUT_WORLD` - synchronized standard
86         output where only the first processor opens
87         the file.  All other processors send their
88         data to the first processor to print.
89 -     `PETSC_VIEWER_DRAW_WORLD` - graphical display of nonzero structure
90 
91      Since PETSc uses only a small number of basic colors (currently 33), if the coloring
92    involves more than 33 then some seemingly identical colors are displayed making it look
93    like an illegal coloring. This is just a graphical artifact.
94 
95 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`
96 @*/
97 PetscErrorCode MatFDColoringView(MatFDColoring c, PetscViewer viewer)
98 {
99   PetscInt          i, j;
100   PetscBool         isdraw, iascii;
101   PetscViewerFormat format;
102 
103   PetscFunctionBegin;
104   PetscValidHeaderSpecific(c, MAT_FDCOLORING_CLASSID, 1);
105   if (!viewer) PetscCall(PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)c), &viewer));
106   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
107   PetscCheckSameComm(c, 1, viewer, 2);
108 
109   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERDRAW, &isdraw));
110   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii));
111   if (isdraw) {
112     PetscCall(MatFDColoringView_Draw(c, viewer));
113   } else if (iascii) {
114     PetscCall(PetscObjectPrintClassNamePrefixType((PetscObject)c, viewer));
115     PetscCall(PetscViewerASCIIPrintf(viewer, "  Error tolerance=%g\n", (double)c->error_rel));
116     PetscCall(PetscViewerASCIIPrintf(viewer, "  Umin=%g\n", (double)c->umin));
117     PetscCall(PetscViewerASCIIPrintf(viewer, "  Number of colors=%" PetscInt_FMT "\n", c->ncolors));
118 
119     PetscCall(PetscViewerGetFormat(viewer, &format));
120     if (format != PETSC_VIEWER_ASCII_INFO) {
121       PetscInt row, col, nz;
122       nz = 0;
123       for (i = 0; i < c->ncolors; i++) {
124         PetscCall(PetscViewerASCIIPrintf(viewer, "  Information for color %" PetscInt_FMT "\n", i));
125         PetscCall(PetscViewerASCIIPrintf(viewer, "    Number of columns %" PetscInt_FMT "\n", c->ncolumns[i]));
126         for (j = 0; j < c->ncolumns[i]; j++) PetscCall(PetscViewerASCIIPrintf(viewer, "      %" PetscInt_FMT "\n", c->columns[i][j]));
127         PetscCall(PetscViewerASCIIPrintf(viewer, "    Number of rows %" PetscInt_FMT "\n", c->nrows[i]));
128         if (c->matentry) {
129           for (j = 0; j < c->nrows[i]; j++) {
130             row = c->matentry[nz].row;
131             col = c->matentry[nz++].col;
132             PetscCall(PetscViewerASCIIPrintf(viewer, "      %" PetscInt_FMT " %" PetscInt_FMT " \n", row, col));
133           }
134         }
135       }
136     }
137     PetscCall(PetscViewerFlush(viewer));
138   }
139   PetscFunctionReturn(PETSC_SUCCESS);
140 }
141 
142 /*@
143    MatFDColoringSetParameters - Sets the parameters for the sparse approximation of
144    a Jacobian matrix using finite differences.
145 
146    Logically Collective
147 
148    Input Parameters:
149 +  matfd - the coloring context
150 .  error - relative error
151 -  umin - minimum allowable u-value magnitude
152 
153    Level: advanced
154 
155    Note:
156      The Jacobian is estimated with the differencing approximation
157 .vb
158        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
159        htype = 'ds':
160          h = error_rel*u[i]                 if  abs(u[i]) > umin
161            = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
162          dx_{i} = (0, ... 1, .... 0)
163 
164        htype = 'wp':
165          h = error_rel * sqrt(1 + ||u||)
166 .ve
167 
168 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringSetFromOptions()`
169 @*/
170 PetscErrorCode MatFDColoringSetParameters(MatFDColoring matfd, PetscReal error, PetscReal umin)
171 {
172   PetscFunctionBegin;
173   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
174   PetscValidLogicalCollectiveReal(matfd, error, 2);
175   PetscValidLogicalCollectiveReal(matfd, umin, 3);
176   if (error != (PetscReal)PETSC_DEFAULT) matfd->error_rel = error;
177   if (umin != (PetscReal)PETSC_DEFAULT) matfd->umin = umin;
178   PetscFunctionReturn(PETSC_SUCCESS);
179 }
180 
181 /*@
182    MatFDColoringSetBlockSize - Sets block size for efficient inserting entries of Jacobian matrix.
183 
184    Logically Collective
185 
186    Input Parameters:
187 +  coloring - the coloring context
188 .  brows - number of rows in the block
189 -  bcols - number of columns in the block
190 
191    Level: intermediate
192 
193 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringSetFromOptions()`
194 @*/
195 PetscErrorCode MatFDColoringSetBlockSize(MatFDColoring matfd, PetscInt brows, PetscInt bcols)
196 {
197   PetscFunctionBegin;
198   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
199   PetscValidLogicalCollectiveInt(matfd, brows, 2);
200   PetscValidLogicalCollectiveInt(matfd, bcols, 3);
201   if (brows != PETSC_DEFAULT) matfd->brows = brows;
202   if (bcols != PETSC_DEFAULT) matfd->bcols = bcols;
203   PetscFunctionReturn(PETSC_SUCCESS);
204 }
205 
206 /*@
207    MatFDColoringSetUp - Sets up the internal data structures of matrix coloring context for the later use.
208 
209    Collective
210 
211    Input Parameters:
212 +  mat - the matrix containing the nonzero structure of the Jacobian
213 .  iscoloring - the coloring of the matrix; usually obtained with `MatGetColoring()` or `DMCreateColoring()`
214 -  color - the matrix coloring context
215 
216    Level: beginner
217 
218    Notes:
219    When the coloring type is `IS_COLORING_LOCAL` the coloring is in the local ordering of the unknowns.
220 
221 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringDestroy()`
222 @*/
223 PetscErrorCode MatFDColoringSetUp(Mat mat, ISColoring iscoloring, MatFDColoring color)
224 {
225   PetscBool eq;
226 
227   PetscFunctionBegin;
228   PetscValidHeaderSpecific(mat, MAT_CLASSID, 1);
229   PetscValidHeaderSpecific(color, MAT_FDCOLORING_CLASSID, 3);
230   if (color->setupcalled) PetscFunctionReturn(PETSC_SUCCESS);
231   PetscCall(PetscObjectCompareId((PetscObject)mat, color->matid, &eq));
232   PetscCheck(eq, PetscObjectComm((PetscObject)mat), PETSC_ERR_ARG_WRONG, "Matrix used with MatFDColoringSetUp() must be that used with MatFDColoringCreate()");
233 
234   PetscCall(PetscLogEventBegin(MAT_FDColoringSetUp, mat, 0, 0, 0));
235   PetscUseTypeMethod(mat, fdcoloringsetup, iscoloring, color);
236 
237   color->setupcalled = PETSC_TRUE;
238   PetscCall(PetscLogEventEnd(MAT_FDColoringSetUp, mat, 0, 0, 0));
239   PetscFunctionReturn(PETSC_SUCCESS);
240 }
241 
242 /*@C
243    MatFDColoringGetFunction - Gets the function to use for computing the Jacobian.
244 
245    Not Collective
246 
247    Input Parameter:
248 .  coloring - the coloring context
249 
250    Output Parameters:
251 +  f - the function
252 -  fctx - the optional user-defined function context
253 
254    Level: intermediate
255 
256 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringSetFunction()`, `MatFDColoringSetFromOptions()`
257 @*/
258 PetscErrorCode MatFDColoringGetFunction(MatFDColoring matfd, PetscErrorCode (**f)(void), void **fctx)
259 {
260   PetscFunctionBegin;
261   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
262   if (f) *f = matfd->f;
263   if (fctx) *fctx = matfd->fctx;
264   PetscFunctionReturn(PETSC_SUCCESS);
265 }
266 
267 /*@C
268    MatFDColoringSetFunction - Sets the function to use for computing the Jacobian.
269 
270    Logically Collective
271 
272    Input Parameters:
273 +  coloring - the coloring context
274 .  f - the function
275 -  fctx - the optional user-defined function context
276 
277    Calling sequence with `SNES` of `f`:
278 $   PetscErrorCode f(SNES, Vec in, Vec out, void *fctx)
279 
280    Calling sequence without `SNES` of `f`:
281 $   PetscErrorCode f(void *dummy, Vec in, Vec out, void *fctx)
282 
283    Level: advanced
284 
285    Note:
286     This function is usually used automatically by `SNES` (when one uses `SNESSetJacobian()` with the argument
287      `SNESComputeJacobianDefaultColor()`) and only needs to be used by someone computing a matrix via coloring directly by
288      calling `MatFDColoringApply()`
289 
290    Fortran Note:
291     In Fortran you must call `MatFDColoringSetFunction()` for a coloring object to
292   be used without `SNES` or within the `SNES` solvers.
293 
294 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringGetFunction()`, `MatFDColoringSetFromOptions()`
295 @*/
296 PetscErrorCode MatFDColoringSetFunction(MatFDColoring matfd, PetscErrorCode (*f)(void), void *fctx)
297 {
298   PetscFunctionBegin;
299   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
300   matfd->f    = f;
301   matfd->fctx = fctx;
302   PetscFunctionReturn(PETSC_SUCCESS);
303 }
304 
305 /*@
306    MatFDColoringSetFromOptions - Sets coloring finite difference parameters from
307    the options database.
308 
309    Collective
310 
311    The Jacobian, F'(u), is estimated with the differencing approximation
312 .vb
313        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
314        h = error_rel*u[i]                 if  abs(u[i]) > umin
315          = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
316        dx_{i} = (0, ... 1, .... 0)
317 .ve
318 
319    Input Parameter:
320 .  coloring - the coloring context
321 
322    Options Database Keys:
323 +  -mat_fd_coloring_err <err> - Sets <err> (square root of relative error in the function)
324 .  -mat_fd_coloring_umin <umin> - Sets umin, the minimum allowable u-value magnitude
325 .  -mat_fd_type - "wp" or "ds" (see MATMFFD_WP or MATMFFD_DS)
326 .  -mat_fd_coloring_view - Activates basic viewing
327 .  -mat_fd_coloring_view ::ascii_info - Activates viewing info
328 -  -mat_fd_coloring_view draw - Activates drawing
329 
330     Level: intermediate
331 
332 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringView()`, `MatFDColoringSetParameters()`
333 @*/
334 PetscErrorCode MatFDColoringSetFromOptions(MatFDColoring matfd)
335 {
336   PetscBool flg;
337   char      value[3];
338 
339   PetscFunctionBegin;
340   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
341 
342   PetscObjectOptionsBegin((PetscObject)matfd);
343   PetscCall(PetscOptionsReal("-mat_fd_coloring_err", "Square root of relative error in function", "MatFDColoringSetParameters", matfd->error_rel, &matfd->error_rel, NULL));
344   PetscCall(PetscOptionsReal("-mat_fd_coloring_umin", "Minimum allowable u magnitude", "MatFDColoringSetParameters", matfd->umin, &matfd->umin, NULL));
345   PetscCall(PetscOptionsString("-mat_fd_type", "Algorithm to compute h, wp or ds", "MatFDColoringCreate", matfd->htype, value, sizeof(value), &flg));
346   if (flg) {
347     if (value[0] == 'w' && value[1] == 'p') matfd->htype = "wp";
348     else if (value[0] == 'd' && value[1] == 's') matfd->htype = "ds";
349     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown finite differencing type %s", value);
350   }
351   PetscCall(PetscOptionsInt("-mat_fd_coloring_brows", "Number of block rows", "MatFDColoringSetBlockSize", matfd->brows, &matfd->brows, NULL));
352   PetscCall(PetscOptionsInt("-mat_fd_coloring_bcols", "Number of block columns", "MatFDColoringSetBlockSize", matfd->bcols, &matfd->bcols, &flg));
353   if (flg && matfd->bcols > matfd->ncolors) {
354     /* input bcols cannot be > matfd->ncolors, thus set it as ncolors */
355     matfd->bcols = matfd->ncolors;
356   }
357 
358   /* process any options handlers added with PetscObjectAddOptionsHandler() */
359   PetscCall(PetscObjectProcessOptionsHandlers((PetscObject)matfd, PetscOptionsObject));
360   PetscOptionsEnd();
361   PetscFunctionReturn(PETSC_SUCCESS);
362 }
363 
364 /*@C
365    MatFDColoringSetType - Sets the approach for computing the finite difference parameter
366 
367    Collective
368 
369    Input Parameters:
370 +  coloring - the coloring context
371 -  type - either `MATMFFD_WP` or `MATMFFD_DS`
372 
373    Options Database Key:
374 .  -mat_fd_type - "wp" or "ds"
375 
376    Level: intermediate
377 
378    Note:
379    It is goofy that the argument type is `MatMFFDType` since the `MatFDColoring` actually computes the matrix entries
380          but the process of computing the entries is the same as as with the `MATMFFD` operation so we should reuse the names instead of
381          introducing another one.
382 
383 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringView()`, `MatFDColoringSetParameters()`
384 @*/
385 PetscErrorCode MatFDColoringSetType(MatFDColoring matfd, MatMFFDType type)
386 {
387   PetscFunctionBegin;
388   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
389   /*
390      It is goofy to handle the strings this way but currently there is no code to free a dynamically created matfd->htype
391      and this function is being provided as patch for a release so it shouldn't change the implementation
392   */
393   if (type[0] == 'w' && type[1] == 'p') matfd->htype = "wp";
394   else if (type[0] == 'd' && type[1] == 's') matfd->htype = "ds";
395   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown finite differencing type %s", type);
396   PetscFunctionReturn(PETSC_SUCCESS);
397 }
398 
399 PetscErrorCode MatFDColoringViewFromOptions(MatFDColoring fd, const char prefix[], const char optionname[])
400 {
401   PetscBool         flg;
402   PetscViewer       viewer;
403   PetscViewerFormat format;
404 
405   PetscFunctionBegin;
406   if (prefix) {
407     PetscCall(PetscOptionsGetViewer(PetscObjectComm((PetscObject)fd), ((PetscObject)fd)->options, prefix, optionname, &viewer, &format, &flg));
408   } else {
409     PetscCall(PetscOptionsGetViewer(PetscObjectComm((PetscObject)fd), ((PetscObject)fd)->options, ((PetscObject)fd)->prefix, optionname, &viewer, &format, &flg));
410   }
411   if (flg) {
412     PetscCall(PetscViewerPushFormat(viewer, format));
413     PetscCall(MatFDColoringView(fd, viewer));
414     PetscCall(PetscViewerPopFormat(viewer));
415     PetscCall(PetscViewerDestroy(&viewer));
416   }
417   PetscFunctionReturn(PETSC_SUCCESS);
418 }
419 
420 /*@
421    MatFDColoringCreate - Creates a matrix coloring context for finite difference
422    computation of Jacobians.
423 
424    Collective
425 
426    Input Parameters:
427 +  mat - the matrix containing the nonzero structure of the Jacobian
428 -  iscoloring - the coloring of the matrix; usually obtained with `MatColoringCreate()` or `DMCreateColoring()`
429 
430     Output Parameter:
431 .   color - the new coloring context
432 
433     Level: intermediate
434 
435 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringDestroy()`, `SNESComputeJacobianDefaultColor()`, `ISColoringCreate()`,
436           `MatFDColoringSetFunction()`, `MatFDColoringSetFromOptions()`, `MatFDColoringApply()`,
437           `MatFDColoringView()`, `MatFDColoringSetParameters()`, `MatColoringCreate()`, `DMCreateColoring()`, `MatFDColoringSetValues()`
438 @*/
439 PetscErrorCode MatFDColoringCreate(Mat mat, ISColoring iscoloring, MatFDColoring *color)
440 {
441   MatFDColoring c;
442   MPI_Comm      comm;
443   PetscInt      M, N;
444 
445   PetscFunctionBegin;
446   PetscValidHeaderSpecific(mat, MAT_CLASSID, 1);
447   PetscCheck(mat->assembled, PetscObjectComm((PetscObject)mat), PETSC_ERR_ARG_WRONGSTATE, "Matrix must be assembled by calls to MatAssemblyBegin/End();");
448   PetscCall(PetscLogEventBegin(MAT_FDColoringCreate, mat, 0, 0, 0));
449   PetscCall(MatGetSize(mat, &M, &N));
450   PetscCheck(M == N, PetscObjectComm((PetscObject)mat), PETSC_ERR_SUP, "Only for square matrices");
451   PetscCall(PetscObjectGetComm((PetscObject)mat, &comm));
452   PetscCall(PetscHeaderCreate(c, MAT_FDCOLORING_CLASSID, "MatFDColoring", "Jacobian computation via finite differences with coloring", "Mat", comm, MatFDColoringDestroy, MatFDColoringView));
453 
454   c->ctype = iscoloring->ctype;
455   PetscCall(PetscObjectGetId((PetscObject)mat, &c->matid));
456 
457   PetscUseTypeMethod(mat, fdcoloringcreate, iscoloring, c);
458 
459   PetscCall(MatCreateVecs(mat, NULL, &c->w1));
460   /* Vec is used intensively in particular piece of scalar CPU code; won't benefit from bouncing back and forth to the GPU */
461   PetscCall(VecBindToCPU(c->w1, PETSC_TRUE));
462   PetscCall(VecDuplicate(c->w1, &c->w2));
463   /* Vec is used intensively in particular piece of scalar CPU code; won't benefit from bouncing back and forth to the GPU */
464   PetscCall(VecBindToCPU(c->w2, PETSC_TRUE));
465 
466   c->error_rel    = PETSC_SQRT_MACHINE_EPSILON;
467   c->umin         = 100.0 * PETSC_SQRT_MACHINE_EPSILON;
468   c->currentcolor = -1;
469   c->htype        = "wp";
470   c->fset         = PETSC_FALSE;
471   c->setupcalled  = PETSC_FALSE;
472 
473   *color = c;
474   PetscCall(PetscObjectCompose((PetscObject)mat, "SNESMatFDColoring", (PetscObject)c));
475   PetscCall(PetscLogEventEnd(MAT_FDColoringCreate, mat, 0, 0, 0));
476   PetscFunctionReturn(PETSC_SUCCESS);
477 }
478 
479 /*@
480     MatFDColoringDestroy - Destroys a matrix coloring context that was created
481     via `MatFDColoringCreate()`.
482 
483     Collective
484 
485     Input Parameter:
486 .   c - coloring context
487 
488     Level: intermediate
489 
490 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`
491 @*/
492 PetscErrorCode MatFDColoringDestroy(MatFDColoring *c)
493 {
494   PetscInt      i;
495   MatFDColoring color = *c;
496 
497   PetscFunctionBegin;
498   if (!*c) PetscFunctionReturn(PETSC_SUCCESS);
499   if (--((PetscObject)color)->refct > 0) {
500     *c = NULL;
501     PetscFunctionReturn(PETSC_SUCCESS);
502   }
503 
504   /* we do not free the column arrays since their entries are owned by the ISs in color->isa */
505   for (i = 0; i < color->ncolors; i++) PetscCall(ISDestroy(&color->isa[i]));
506   PetscCall(PetscFree(color->isa));
507   PetscCall(PetscFree2(color->ncolumns, color->columns));
508   PetscCall(PetscFree(color->nrows));
509   if (color->htype[0] == 'w') {
510     PetscCall(PetscFree(color->matentry2));
511   } else {
512     PetscCall(PetscFree(color->matentry));
513   }
514   PetscCall(PetscFree(color->dy));
515   if (color->vscale) PetscCall(VecDestroy(&color->vscale));
516   PetscCall(VecDestroy(&color->w1));
517   PetscCall(VecDestroy(&color->w2));
518   PetscCall(VecDestroy(&color->w3));
519   PetscCall(PetscHeaderDestroy(c));
520   PetscFunctionReturn(PETSC_SUCCESS);
521 }
522 
523 /*@C
524     MatFDColoringGetPerturbedColumns - Returns the indices of the columns that
525       that are currently being perturbed.
526 
527     Not Collective
528 
529     Input Parameter:
530 .   coloring - coloring context created with `MatFDColoringCreate()`
531 
532     Output Parameters:
533 +   n - the number of local columns being perturbed
534 -   cols - the column indices, in global numbering
535 
536    Level: advanced
537 
538    Note:
539    IF the matrix type is `MATBAIJ`, then the block column indices are returned
540 
541    Fortran Note:
542    This routine has a different interface for Fortran
543 .vb
544      #include <petsc/finclude/petscmat.h>
545           use petscmat
546           PetscInt, pointer :: array(:)
547           PetscErrorCode  ierr
548           MatFDColoring   i
549           call MatFDColoringGetPerturbedColumnsF90(i,array,ierr)
550       use the entries of array ...
551           call MatFDColoringRestorePerturbedColumnsF90(i,array,ierr)
552 .ve
553 
554 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringDestroy()`, `MatFDColoringView()`, `MatFDColoringApply()`
555 @*/
556 PetscErrorCode MatFDColoringGetPerturbedColumns(MatFDColoring coloring, PetscInt *n, const PetscInt *cols[])
557 {
558   PetscFunctionBegin;
559   if (coloring->currentcolor >= 0) {
560     *n    = coloring->ncolumns[coloring->currentcolor];
561     *cols = coloring->columns[coloring->currentcolor];
562   } else {
563     *n = 0;
564   }
565   PetscFunctionReturn(PETSC_SUCCESS);
566 }
567 
568 /*@
569     MatFDColoringApply - Given a matrix for which a `MatFDColoring` context
570     has been created, computes the Jacobian for a function via finite differences.
571 
572     Collective
573 
574     Input Parameters:
575 +   mat - location to store Jacobian
576 .   coloring - coloring context created with `MatFDColoringCreate()`
577 .   x1 - location at which Jacobian is to be computed
578 -   sctx - context required by function, if this is being used with the SNES solver then it is `SNES` object, otherwise it is null
579 
580     Options Database Keys:
581 +    -mat_fd_type - "wp" or "ds"  (see `MATMFFD_WP` or `MATMFFD_DS`)
582 .    -mat_fd_coloring_view - Activates basic viewing or coloring
583 .    -mat_fd_coloring_view draw - Activates drawing of coloring
584 -    -mat_fd_coloring_view ::ascii_info - Activates viewing of coloring info
585 
586     Level: intermediate
587 
588 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringDestroy()`, `MatFDColoringView()`, `MatFDColoringSetFunction()`, `MatFDColoringSetValues()`
589 @*/
590 PetscErrorCode MatFDColoringApply(Mat J, MatFDColoring coloring, Vec x1, void *sctx)
591 {
592   PetscBool eq;
593 
594   PetscFunctionBegin;
595   PetscValidHeaderSpecific(J, MAT_CLASSID, 1);
596   PetscValidHeaderSpecific(coloring, MAT_FDCOLORING_CLASSID, 2);
597   PetscValidHeaderSpecific(x1, VEC_CLASSID, 3);
598   PetscCall(PetscObjectCompareId((PetscObject)J, coloring->matid, &eq));
599   PetscCheck(eq, PetscObjectComm((PetscObject)J), PETSC_ERR_ARG_WRONG, "Matrix used with MatFDColoringApply() must be that used with MatFDColoringCreate()");
600   PetscCheck(coloring->f, PetscObjectComm((PetscObject)J), PETSC_ERR_ARG_WRONGSTATE, "Must call MatFDColoringSetFunction()");
601   PetscCheck(coloring->setupcalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Must call MatFDColoringSetUp()");
602 
603   PetscCall(MatSetUnfactored(J));
604   PetscCall(PetscLogEventBegin(MAT_FDColoringApply, coloring, J, x1, 0));
605   PetscUseTypeMethod(J, fdcoloringapply, coloring, x1, sctx);
606   PetscCall(PetscLogEventEnd(MAT_FDColoringApply, coloring, J, x1, 0));
607   if (!coloring->viewed) {
608     PetscCall(MatFDColoringViewFromOptions(coloring, NULL, "-mat_fd_coloring_view"));
609     coloring->viewed = PETSC_TRUE;
610   }
611   PetscFunctionReturn(PETSC_SUCCESS);
612 }
613