xref: /petsc/src/mat/matfd/fdmatrix.c (revision df4cd43f92eaa320656440c40edb1046daee8f75)
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    The Jacobian is estimated with the differencing approximation
149 .vb
150        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
151        htype = 'ds':
152          h = error_rel*u[i]                 if  abs(u[i]) > umin
153            = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
154          dx_{i} = (0, ... 1, .... 0)
155 
156        htype = 'wp':
157          h = error_rel * sqrt(1 + ||u||)
158 .ve
159 
160    Input Parameters:
161 +  matfd - the coloring context
162 .  error - relative error
163 -  umin - minimum allowable u-value magnitude
164 
165    Level: advanced
166 
167 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringSetFromOptions()`
168 @*/
169 PetscErrorCode MatFDColoringSetParameters(MatFDColoring matfd, PetscReal error, PetscReal umin)
170 {
171   PetscFunctionBegin;
172   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
173   PetscValidLogicalCollectiveReal(matfd, error, 2);
174   PetscValidLogicalCollectiveReal(matfd, umin, 3);
175   if (error != (PetscReal)PETSC_DEFAULT) matfd->error_rel = error;
176   if (umin != (PetscReal)PETSC_DEFAULT) matfd->umin = umin;
177   PetscFunctionReturn(PETSC_SUCCESS);
178 }
179 
180 /*@
181    MatFDColoringSetBlockSize - Sets block size for efficient inserting entries of Jacobian matrix.
182 
183    Logically Collective
184 
185    Input Parameters:
186 +  coloring - the coloring context
187 .  brows - number of rows in the block
188 -  bcols - number of columns in the block
189 
190    Level: intermediate
191 
192 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringSetFromOptions()`
193 @*/
194 PetscErrorCode MatFDColoringSetBlockSize(MatFDColoring matfd, PetscInt brows, PetscInt bcols)
195 {
196   PetscFunctionBegin;
197   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
198   PetscValidLogicalCollectiveInt(matfd, brows, 2);
199   PetscValidLogicalCollectiveInt(matfd, bcols, 3);
200   if (brows != PETSC_DEFAULT) matfd->brows = brows;
201   if (bcols != PETSC_DEFAULT) matfd->bcols = bcols;
202   PetscFunctionReturn(PETSC_SUCCESS);
203 }
204 
205 /*@
206    MatFDColoringSetUp - Sets up the internal data structures of matrix coloring context for the later use.
207 
208    Collective
209 
210    Input Parameters:
211 +  mat - the matrix containing the nonzero structure of the Jacobian
212 .  iscoloring - the coloring of the matrix; usually obtained with `MatGetColoring()` or `DMCreateColoring()`
213 -  color - the matrix coloring context
214 
215    Level: beginner
216 
217    Notes:
218    When the coloring type is `IS_COLORING_LOCAL` the coloring is in the local ordering of the unknowns.
219 
220 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringDestroy()`
221 @*/
222 PetscErrorCode MatFDColoringSetUp(Mat mat, ISColoring iscoloring, MatFDColoring color)
223 {
224   PetscBool eq;
225 
226   PetscFunctionBegin;
227   PetscValidHeaderSpecific(mat, MAT_CLASSID, 1);
228   PetscValidHeaderSpecific(color, MAT_FDCOLORING_CLASSID, 3);
229   if (color->setupcalled) PetscFunctionReturn(PETSC_SUCCESS);
230   PetscCall(PetscObjectCompareId((PetscObject)mat, color->matid, &eq));
231   PetscCheck(eq, PetscObjectComm((PetscObject)mat), PETSC_ERR_ARG_WRONG, "Matrix used with MatFDColoringSetUp() must be that used with MatFDColoringCreate()");
232 
233   PetscCall(PetscLogEventBegin(MAT_FDColoringSetUp, mat, 0, 0, 0));
234   PetscUseTypeMethod(mat, fdcoloringsetup, iscoloring, color);
235 
236   color->setupcalled = PETSC_TRUE;
237   PetscCall(PetscLogEventEnd(MAT_FDColoringSetUp, mat, 0, 0, 0));
238   PetscFunctionReturn(PETSC_SUCCESS);
239 }
240 
241 /*@C
242    MatFDColoringGetFunction - Gets the function to use for computing the Jacobian.
243 
244    Not Collective
245 
246    Input Parameter:
247 .  coloring - the coloring context
248 
249    Output Parameters:
250 +  f - the function
251 -  fctx - the optional user-defined function context
252 
253    Level: intermediate
254 
255 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringSetFunction()`, `MatFDColoringSetFromOptions()`
256 @*/
257 PetscErrorCode MatFDColoringGetFunction(MatFDColoring matfd, PetscErrorCode (**f)(void), void **fctx)
258 {
259   PetscFunctionBegin;
260   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
261   if (f) *f = matfd->f;
262   if (fctx) *fctx = matfd->fctx;
263   PetscFunctionReturn(PETSC_SUCCESS);
264 }
265 
266 /*@C
267    MatFDColoringSetFunction - Sets the function to use for computing the Jacobian.
268 
269    Logically Collective
270 
271    Input Parameters:
272 +  coloring - the coloring context
273 .  f - the function
274 -  fctx - the optional user-defined function context
275 
276    Calling sequence of (*f) function:
277     For `SNES` use   PetscErrorCode (*f)(SNES,Vec,Vec,void*)
278     If not using `SNES` use PetscErrorCode (*f)(void *dummy,Vec,Vec,void*) and dummy is ignored
279 
280    Level: advanced
281 
282    Note:
283     This function is usually used automatically by `SNES` (when one uses `SNESSetJacobian()` with the argument
284      `SNESComputeJacobianDefaultColor()`) and only needs to be used by someone computing a matrix via coloring directly by
285      calling `MatFDColoringApply()`
286 
287    Fortran Note:
288     In Fortran you must call `MatFDColoringSetFunction()` for a coloring object to
289   be used without `SNES` or within the `SNES` solvers.
290 
291 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringGetFunction()`, `MatFDColoringSetFromOptions()`
292 @*/
293 PetscErrorCode MatFDColoringSetFunction(MatFDColoring matfd, PetscErrorCode (*f)(void), void *fctx)
294 {
295   PetscFunctionBegin;
296   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
297   matfd->f    = f;
298   matfd->fctx = fctx;
299   PetscFunctionReturn(PETSC_SUCCESS);
300 }
301 
302 /*@
303    MatFDColoringSetFromOptions - Sets coloring finite difference parameters from
304    the options database.
305 
306    Collective
307 
308    The Jacobian, F'(u), is estimated with the differencing approximation
309 .vb
310        F'(u)_{:,i} = [F(u+h*dx_{i}) - F(u)]/h where
311        h = error_rel*u[i]                 if  abs(u[i]) > umin
312          = +/- error_rel*umin             otherwise, with +/- determined by the sign of u[i]
313        dx_{i} = (0, ... 1, .... 0)
314 .ve
315 
316    Input Parameter:
317 .  coloring - the coloring context
318 
319    Options Database Keys:
320 +  -mat_fd_coloring_err <err> - Sets <err> (square root of relative error in the function)
321 .  -mat_fd_coloring_umin <umin> - Sets umin, the minimum allowable u-value magnitude
322 .  -mat_fd_type - "wp" or "ds" (see MATMFFD_WP or MATMFFD_DS)
323 .  -mat_fd_coloring_view - Activates basic viewing
324 .  -mat_fd_coloring_view ::ascii_info - Activates viewing info
325 -  -mat_fd_coloring_view draw - Activates drawing
326 
327     Level: intermediate
328 
329 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringView()`, `MatFDColoringSetParameters()`
330 @*/
331 PetscErrorCode MatFDColoringSetFromOptions(MatFDColoring matfd)
332 {
333   PetscBool flg;
334   char      value[3];
335 
336   PetscFunctionBegin;
337   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
338 
339   PetscObjectOptionsBegin((PetscObject)matfd);
340   PetscCall(PetscOptionsReal("-mat_fd_coloring_err", "Square root of relative error in function", "MatFDColoringSetParameters", matfd->error_rel, &matfd->error_rel, NULL));
341   PetscCall(PetscOptionsReal("-mat_fd_coloring_umin", "Minimum allowable u magnitude", "MatFDColoringSetParameters", matfd->umin, &matfd->umin, NULL));
342   PetscCall(PetscOptionsString("-mat_fd_type", "Algorithm to compute h, wp or ds", "MatFDColoringCreate", matfd->htype, value, sizeof(value), &flg));
343   if (flg) {
344     if (value[0] == 'w' && value[1] == 'p') matfd->htype = "wp";
345     else if (value[0] == 'd' && value[1] == 's') matfd->htype = "ds";
346     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown finite differencing type %s", value);
347   }
348   PetscCall(PetscOptionsInt("-mat_fd_coloring_brows", "Number of block rows", "MatFDColoringSetBlockSize", matfd->brows, &matfd->brows, NULL));
349   PetscCall(PetscOptionsInt("-mat_fd_coloring_bcols", "Number of block columns", "MatFDColoringSetBlockSize", matfd->bcols, &matfd->bcols, &flg));
350   if (flg && matfd->bcols > matfd->ncolors) {
351     /* input bcols cannot be > matfd->ncolors, thus set it as ncolors */
352     matfd->bcols = matfd->ncolors;
353   }
354 
355   /* process any options handlers added with PetscObjectAddOptionsHandler() */
356   PetscCall(PetscObjectProcessOptionsHandlers((PetscObject)matfd, PetscOptionsObject));
357   PetscOptionsEnd();
358   PetscFunctionReturn(PETSC_SUCCESS);
359 }
360 
361 /*@C
362    MatFDColoringSetType - Sets the approach for computing the finite difference parameter
363 
364    Collective
365 
366    Input Parameters:
367 +  coloring - the coloring context
368 -  type - either `MATMFFD_WP` or `MATMFFD_DS`
369 
370    Options Database Keys:
371 .  -mat_fd_type - "wp" or "ds"
372 
373    Level: intermediate
374 
375    Note:
376    It is goofy that the argument type is `MatMFFDType` since the `MatFDColoring` actually computes the matrix entries
377          but the process of computing the entries is the same as as with the `MATMFFD` operation so we should reuse the names instead of
378          introducing another one.
379 
380 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringView()`, `MatFDColoringSetParameters()`
381 @*/
382 PetscErrorCode MatFDColoringSetType(MatFDColoring matfd, MatMFFDType type)
383 {
384   PetscFunctionBegin;
385   PetscValidHeaderSpecific(matfd, MAT_FDCOLORING_CLASSID, 1);
386   /*
387      It is goofy to handle the strings this way but currently there is no code to free a dynamically created matfd->htype
388      and this function is being provided as patch for a release so it shouldn't change the implementation
389   */
390   if (type[0] == 'w' && type[1] == 'p') matfd->htype = "wp";
391   else if (type[0] == 'd' && type[1] == 's') matfd->htype = "ds";
392   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown finite differencing type %s", type);
393   PetscFunctionReturn(PETSC_SUCCESS);
394 }
395 
396 PetscErrorCode MatFDColoringViewFromOptions(MatFDColoring fd, const char prefix[], const char optionname[])
397 {
398   PetscBool         flg;
399   PetscViewer       viewer;
400   PetscViewerFormat format;
401 
402   PetscFunctionBegin;
403   if (prefix) {
404     PetscCall(PetscOptionsGetViewer(PetscObjectComm((PetscObject)fd), ((PetscObject)fd)->options, prefix, optionname, &viewer, &format, &flg));
405   } else {
406     PetscCall(PetscOptionsGetViewer(PetscObjectComm((PetscObject)fd), ((PetscObject)fd)->options, ((PetscObject)fd)->prefix, optionname, &viewer, &format, &flg));
407   }
408   if (flg) {
409     PetscCall(PetscViewerPushFormat(viewer, format));
410     PetscCall(MatFDColoringView(fd, viewer));
411     PetscCall(PetscViewerPopFormat(viewer));
412     PetscCall(PetscViewerDestroy(&viewer));
413   }
414   PetscFunctionReturn(PETSC_SUCCESS);
415 }
416 
417 /*@
418    MatFDColoringCreate - Creates a matrix coloring context for finite difference
419    computation of Jacobians.
420 
421    Collective
422 
423    Input Parameters:
424 +  mat - the matrix containing the nonzero structure of the Jacobian
425 -  iscoloring - the coloring of the matrix; usually obtained with `MatColoringCreate()` or `DMCreateColoring()`
426 
427     Output Parameter:
428 .   color - the new coloring context
429 
430     Level: intermediate
431 
432 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringDestroy()`, `SNESComputeJacobianDefaultColor()`, `ISColoringCreate()`,
433           `MatFDColoringSetFunction()`, `MatFDColoringSetFromOptions()`, `MatFDColoringApply()`,
434           `MatFDColoringView()`, `MatFDColoringSetParameters()`, `MatColoringCreate()`, `DMCreateColoring()`, `MatFDColoringSetValues()`
435 @*/
436 PetscErrorCode MatFDColoringCreate(Mat mat, ISColoring iscoloring, MatFDColoring *color)
437 {
438   MatFDColoring c;
439   MPI_Comm      comm;
440   PetscInt      M, N;
441 
442   PetscFunctionBegin;
443   PetscValidHeaderSpecific(mat, MAT_CLASSID, 1);
444   PetscCheck(mat->assembled, PetscObjectComm((PetscObject)mat), PETSC_ERR_ARG_WRONGSTATE, "Matrix must be assembled by calls to MatAssemblyBegin/End();");
445   PetscCall(PetscLogEventBegin(MAT_FDColoringCreate, mat, 0, 0, 0));
446   PetscCall(MatGetSize(mat, &M, &N));
447   PetscCheck(M == N, PetscObjectComm((PetscObject)mat), PETSC_ERR_SUP, "Only for square matrices");
448   PetscCall(PetscObjectGetComm((PetscObject)mat, &comm));
449   PetscCall(PetscHeaderCreate(c, MAT_FDCOLORING_CLASSID, "MatFDColoring", "Jacobian computation via finite differences with coloring", "Mat", comm, MatFDColoringDestroy, MatFDColoringView));
450 
451   c->ctype = iscoloring->ctype;
452   PetscCall(PetscObjectGetId((PetscObject)mat, &c->matid));
453 
454   PetscUseTypeMethod(mat, fdcoloringcreate, iscoloring, c);
455 
456   PetscCall(MatCreateVecs(mat, NULL, &c->w1));
457   /* Vec is used intensively in particular piece of scalar CPU code; won't benefit from bouncing back and forth to the GPU */
458   PetscCall(VecBindToCPU(c->w1, PETSC_TRUE));
459   PetscCall(VecDuplicate(c->w1, &c->w2));
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->w2, PETSC_TRUE));
462 
463   c->error_rel    = PETSC_SQRT_MACHINE_EPSILON;
464   c->umin         = 100.0 * PETSC_SQRT_MACHINE_EPSILON;
465   c->currentcolor = -1;
466   c->htype        = "wp";
467   c->fset         = PETSC_FALSE;
468   c->setupcalled  = PETSC_FALSE;
469 
470   *color = c;
471   PetscCall(PetscObjectCompose((PetscObject)mat, "SNESMatFDColoring", (PetscObject)c));
472   PetscCall(PetscLogEventEnd(MAT_FDColoringCreate, mat, 0, 0, 0));
473   PetscFunctionReturn(PETSC_SUCCESS);
474 }
475 
476 /*@
477     MatFDColoringDestroy - Destroys a matrix coloring context that was created
478     via `MatFDColoringCreate()`.
479 
480     Collective
481 
482     Input Parameter:
483 .   c - coloring context
484 
485     Level: intermediate
486 
487 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`
488 @*/
489 PetscErrorCode MatFDColoringDestroy(MatFDColoring *c)
490 {
491   PetscInt      i;
492   MatFDColoring color = *c;
493 
494   PetscFunctionBegin;
495   if (!*c) PetscFunctionReturn(PETSC_SUCCESS);
496   if (--((PetscObject)color)->refct > 0) {
497     *c = NULL;
498     PetscFunctionReturn(PETSC_SUCCESS);
499   }
500 
501   /* we do not free the column arrays since their entries are owned by the ISs in color->isa */
502   for (i = 0; i < color->ncolors; i++) PetscCall(ISDestroy(&color->isa[i]));
503   PetscCall(PetscFree(color->isa));
504   PetscCall(PetscFree2(color->ncolumns, color->columns));
505   PetscCall(PetscFree(color->nrows));
506   if (color->htype[0] == 'w') {
507     PetscCall(PetscFree(color->matentry2));
508   } else {
509     PetscCall(PetscFree(color->matentry));
510   }
511   PetscCall(PetscFree(color->dy));
512   if (color->vscale) PetscCall(VecDestroy(&color->vscale));
513   PetscCall(VecDestroy(&color->w1));
514   PetscCall(VecDestroy(&color->w2));
515   PetscCall(VecDestroy(&color->w3));
516   PetscCall(PetscHeaderDestroy(c));
517   PetscFunctionReturn(PETSC_SUCCESS);
518 }
519 
520 /*@C
521     MatFDColoringGetPerturbedColumns - Returns the indices of the columns that
522       that are currently being perturbed.
523 
524     Not Collective
525 
526     Input Parameter:
527 .   coloring - coloring context created with `MatFDColoringCreate()`
528 
529     Output Parameters:
530 +   n - the number of local columns being perturbed
531 -   cols - the column indices, in global numbering
532 
533    Level: advanced
534 
535    Note:
536    IF the matrix type is `MATBAIJ`, then the block column indices are returned
537 
538    Fortran Note:
539    This routine has a different interface for Fortran
540 .vb
541      #include <petsc/finclude/petscmat.h>
542           use petscmat
543           PetscInt, pointer :: array(:)
544           PetscErrorCode  ierr
545           MatFDColoring   i
546           call MatFDColoringGetPerturbedColumnsF90(i,array,ierr)
547       use the entries of array ...
548           call MatFDColoringRestorePerturbedColumnsF90(i,array,ierr)
549 .ve
550 
551 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringDestroy()`, `MatFDColoringView()`, `MatFDColoringApply()`
552 @*/
553 PetscErrorCode MatFDColoringGetPerturbedColumns(MatFDColoring coloring, PetscInt *n, const PetscInt *cols[])
554 {
555   PetscFunctionBegin;
556   if (coloring->currentcolor >= 0) {
557     *n    = coloring->ncolumns[coloring->currentcolor];
558     *cols = coloring->columns[coloring->currentcolor];
559   } else {
560     *n = 0;
561   }
562   PetscFunctionReturn(PETSC_SUCCESS);
563 }
564 
565 /*@
566     MatFDColoringApply - Given a matrix for which a `MatFDColoring` context
567     has been created, computes the Jacobian for a function via finite differences.
568 
569     Collective
570 
571     Input Parameters:
572 +   mat - location to store Jacobian
573 .   coloring - coloring context created with `MatFDColoringCreate()`
574 .   x1 - location at which Jacobian is to be computed
575 -   sctx - context required by function, if this is being used with the SNES solver then it is `SNES` object, otherwise it is null
576 
577     Options Database Keys:
578 +    -mat_fd_type - "wp" or "ds"  (see `MATMFFD_WP` or `MATMFFD_DS`)
579 .    -mat_fd_coloring_view - Activates basic viewing or coloring
580 .    -mat_fd_coloring_view draw - Activates drawing of coloring
581 -    -mat_fd_coloring_view ::ascii_info - Activates viewing of coloring info
582 
583     Level: intermediate
584 
585 .seealso: `Mat`, `MatFDColoring`, `MatFDColoringCreate()`, `MatFDColoringDestroy()`, `MatFDColoringView()`, `MatFDColoringSetFunction()`, `MatFDColoringSetValues()`
586 @*/
587 PetscErrorCode MatFDColoringApply(Mat J, MatFDColoring coloring, Vec x1, void *sctx)
588 {
589   PetscBool eq;
590 
591   PetscFunctionBegin;
592   PetscValidHeaderSpecific(J, MAT_CLASSID, 1);
593   PetscValidHeaderSpecific(coloring, MAT_FDCOLORING_CLASSID, 2);
594   PetscValidHeaderSpecific(x1, VEC_CLASSID, 3);
595   PetscCall(PetscObjectCompareId((PetscObject)J, coloring->matid, &eq));
596   PetscCheck(eq, PetscObjectComm((PetscObject)J), PETSC_ERR_ARG_WRONG, "Matrix used with MatFDColoringApply() must be that used with MatFDColoringCreate()");
597   PetscCheck(coloring->f, PetscObjectComm((PetscObject)J), PETSC_ERR_ARG_WRONGSTATE, "Must call MatFDColoringSetFunction()");
598   PetscCheck(coloring->setupcalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Must call MatFDColoringSetUp()");
599 
600   PetscCall(MatSetUnfactored(J));
601   PetscCall(PetscLogEventBegin(MAT_FDColoringApply, coloring, J, x1, 0));
602   PetscUseTypeMethod(J, fdcoloringapply, coloring, x1, sctx);
603   PetscCall(PetscLogEventEnd(MAT_FDColoringApply, coloring, J, x1, 0));
604   if (!coloring->viewed) {
605     PetscCall(MatFDColoringViewFromOptions(coloring, NULL, "-mat_fd_coloring_view"));
606     coloring->viewed = PETSC_TRUE;
607   }
608   PetscFunctionReturn(PETSC_SUCCESS);
609 }
610