1 /*
2 Provides utility routines for manulating any type of PETSc object.
3 */
4 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/
5 #include <petscviewer.h>
6
DestroyComposedData(void *** composed_star,PetscObjectState ** state_star,PetscInt * count_star,void ** composed,PetscObjectState ** state)7 static PetscErrorCode DestroyComposedData(void ***composed_star, PetscObjectState **state_star, PetscInt *count_star, void **composed, PetscObjectState **state)
8 {
9 void **tmp_star = *composed_star;
10
11 PetscFunctionBegin;
12 for (PetscInt i = 0, imax = *count_star; i < imax; ++i) PetscCall(PetscFree(tmp_star[i]));
13 PetscCall(PetscFree2(*composed_star, *state_star));
14 PetscCall(PetscFree2(*composed, *state));
15 *count_star = 0;
16 PetscFunctionReturn(PETSC_SUCCESS);
17 }
18
PetscComposedQuantitiesDestroy(PetscObject obj)19 PetscErrorCode PetscComposedQuantitiesDestroy(PetscObject obj)
20 {
21 PetscFunctionBegin;
22 PetscValidHeader(obj, 1);
23 PetscCall(DestroyComposedData((void ***)&obj->intstarcomposeddata, &obj->intstarcomposedstate, &obj->intstar_idmax, (void **)&obj->intcomposeddata, &obj->intcomposedstate));
24 PetscCall(DestroyComposedData((void ***)&obj->realstarcomposeddata, &obj->realstarcomposedstate, &obj->realstar_idmax, (void **)&obj->realcomposeddata, &obj->realcomposedstate));
25 #if PetscDefined(USE_COMPLEX)
26 PetscCall(DestroyComposedData((void ***)&obj->scalarstarcomposeddata, &obj->scalarstarcomposedstate, &obj->scalarstar_idmax, (void **)&obj->scalarcomposeddata, &obj->scalarcomposedstate));
27 #endif
28 PetscFunctionReturn(PETSC_SUCCESS);
29 }
30
31 /*@
32 PetscObjectDestroy - Destroys a `PetscObject`, regardless of the type.
33
34 Collective
35
36 Input Parameter:
37 . obj - any PETSc object, for example a `Vec`, `Mat` or `KSP`. It must be cast with a (`PetscObject`\*), for example,
38 `PetscObjectDestroy`((`PetscObject`\*)&mat);
39
40 Level: beginner
41
42 .seealso: `PetscObject`
43 @*/
PetscObjectDestroy(PetscObject * obj)44 PetscErrorCode PetscObjectDestroy(PetscObject *obj)
45 {
46 PetscFunctionBegin;
47 if (!obj || !*obj) PetscFunctionReturn(PETSC_SUCCESS);
48 PetscValidHeader(*obj, 1);
49 PetscCheck((*obj)->bops->destroy, PETSC_COMM_SELF, PETSC_ERR_PLIB, "This PETSc object of class %s does not have a generic destroy routine", (*obj)->class_name);
50 PetscCall((*(*obj)->bops->destroy)(obj));
51 PetscFunctionReturn(PETSC_SUCCESS);
52 }
53
54 /*@
55 PetscObjectView - Views a `PetscObject` regardless of the type.
56
57 Collective
58
59 Input Parameters:
60 + obj - any PETSc object, for example a `Vec`, `Mat` or `KSP`. It must be cast with a (`PetscObject`), for example,
61 `PetscObjectView`((`PetscObject`)mat,`viewer`);
62 - viewer - any PETSc viewer
63
64 Level: intermediate
65
66 .seealso: `PetscObject`, `PetscObjectViewFromOptions()`, `PetscViewer`
67 @*/
PetscObjectView(PetscObject obj,PetscViewer viewer)68 PetscErrorCode PetscObjectView(PetscObject obj, PetscViewer viewer)
69 {
70 PetscFunctionBegin;
71 PetscValidHeader(obj, 1);
72 PetscCheck(obj->bops->view, PETSC_COMM_SELF, PETSC_ERR_SUP, "This PETSc object does not have a generic viewer routine");
73 if (!viewer) PetscCall(PetscViewerASCIIGetStdout(obj->comm, &viewer));
74 PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
75
76 PetscCall((*obj->bops->view)(obj, viewer));
77 PetscFunctionReturn(PETSC_SUCCESS);
78 }
79
80 /*@
81 PetscObjectViewFromOptions - Processes command line options to determine if/how a `PetscObject` is to be viewed.
82
83 Collective
84
85 Input Parameters:
86 + obj - the object
87 . bobj - optional other object that provides prefix (if `NULL` then the prefix in `obj` is used)
88 - optionname - option string that is used to activate viewing
89
90 Options Database Key:
91 . -optionname_view [viewertype]:... - option name and values. In actual usage this would be something like `-mat_coarse_view`
92
93 Level: developer
94
95 Notes:
96 The argument has the following form
97 .vb
98 type:filename:format:filemode
99 .ve
100 where all parts are optional, but you need to include the colon to access the next part. For example, to read from an HDF5 file, use
101 .vb
102 hdf5:sol.h5::read
103 .ve
104
105 .vb
106 If no value is provided ascii:stdout is used
107 ascii[:[filename][:[format][:append]]] defaults to stdout - format can be one of ascii_info, ascii_info_detail, or ascii_matlab,
108 for example ascii::ascii_info prints just the information about the object not all details
109 unless :append is given filename opens in write mode, overwriting what was already there
110 binary[:[filename][:[format][:append]]] defaults to the file binaryoutput
111 draw[:drawtype[:filename]] for example, draw:tikz, draw:tikz:figure.tex or draw:x
112 socket[:port] defaults to the standard output port
113 saws[:communicatorname] publishes object to the Scientific Application Webserver (SAWs)
114 .ve
115
116 This is not called directly but is called by, for example, `MatViewFromOptions()`
117
118 .seealso: `PetscObject`, `PetscObjectView()`, `PetscOptionsCreateViewer()`
119 @*/
PetscObjectViewFromOptions(PetscObject obj,PetscObject bobj,const char optionname[])120 PetscErrorCode PetscObjectViewFromOptions(PetscObject obj, PetscObject bobj, const char optionname[])
121 {
122 PetscViewer viewer;
123 PetscBool flg;
124 static PetscBool incall = PETSC_FALSE;
125 PetscViewerFormat format;
126 const char *prefix;
127
128 PetscFunctionBegin;
129 PetscValidHeader(obj, 1);
130 if (bobj) PetscValidHeader(bobj, 2);
131 if (incall) PetscFunctionReturn(PETSC_SUCCESS);
132 incall = PETSC_TRUE;
133 prefix = bobj ? bobj->prefix : obj->prefix;
134 PetscCall(PetscOptionsCreateViewer(PetscObjectComm(obj), obj->options, prefix, optionname, &viewer, &format, &flg));
135 if (flg) {
136 PetscCall(PetscViewerPushFormat(viewer, format));
137 PetscCall(PetscObjectView(obj, viewer));
138 PetscCall(PetscViewerFlush(viewer));
139 PetscCall(PetscViewerPopFormat(viewer));
140 PetscCall(PetscViewerDestroy(&viewer));
141 }
142 incall = PETSC_FALSE;
143 PetscFunctionReturn(PETSC_SUCCESS);
144 }
145
146 /*@
147 PetscObjectTypeCompare - Determines whether a PETSc object is of a particular type.
148
149 Not Collective
150
151 Input Parameters:
152 + obj - a PETSc object, for example a `Vec`, `Mat` or `KSP`. It must be cast with a (`PetscObject`), for example,
153 `PetscObjectTypeCompare`((`PetscObject`)mat);
154 - type_name - string containing a type name
155
156 Output Parameter:
157 . same - `PETSC_TRUE` if the type of `obj` and `type_name` are the same or both `NULL`, else `PETSC_FALSE`
158
159 Level: intermediate
160
161 .seealso: `PetscObject`, `VecGetType()`, `KSPGetType()`, `PCGetType()`, `SNESGetType()`, `PetscObjectBaseTypeCompare()`, `PetscObjectTypeCompareAny()`, `PetscObjectBaseTypeCompareAny()`, `PetscObjectObjectTypeCompare()`
162 @*/
PetscObjectTypeCompare(PetscObject obj,const char type_name[],PetscBool * same)163 PetscErrorCode PetscObjectTypeCompare(PetscObject obj, const char type_name[], PetscBool *same)
164 {
165 PetscFunctionBegin;
166 PetscAssertPointer(same, 3);
167 if (!obj) *same = (PetscBool)!type_name;
168 else {
169 PetscValidHeader(obj, 1);
170 if (!type_name || !obj->type_name) *same = (PetscBool)(!obj->type_name == !type_name);
171 else {
172 PetscAssertPointer(type_name, 2);
173 PetscCall(PetscStrcmp(obj->type_name, type_name, same));
174 }
175 }
176 PetscFunctionReturn(PETSC_SUCCESS);
177 }
178
179 /*@
180 PetscObjectObjectTypeCompare - Determines whether two PETSc objects are of the same type
181
182 Logically Collective
183
184 Input Parameters:
185 + obj1 - any PETSc object, for example a `Vec`, `Mat` or `KSP`.
186 - obj2 - another PETSc object
187
188 Output Parameter:
189 . same - `PETSC_TRUE` if they are the same or both unset, else `PETSC_FALSE`
190
191 Level: intermediate
192
193 .seealso: `PetscObjectTypeCompare()`, `VecGetType()`, `KSPGetType()`, `PCGetType()`, `SNESGetType()`, `PetscObjectBaseTypeCompare()`, `PetscObjectTypeCompareAny()`, `PetscObjectBaseTypeCompareAny()`
194
195 @*/
PetscObjectObjectTypeCompare(PetscObject obj1,PetscObject obj2,PetscBool * same)196 PetscErrorCode PetscObjectObjectTypeCompare(PetscObject obj1, PetscObject obj2, PetscBool *same)
197 {
198 PetscFunctionBegin;
199 PetscValidHeader(obj1, 1);
200 PetscValidHeader(obj2, 2);
201 PetscAssertPointer(same, 3);
202 PetscCall(PetscStrcmp(obj1->type_name, obj2->type_name, same));
203 PetscFunctionReturn(PETSC_SUCCESS);
204 }
205
206 /*@
207 PetscObjectBaseTypeCompare - Determines whether a `PetscObject` is of a given base type. For example the base type of `MATSEQAIJPERM` is `MATSEQAIJ`
208
209 Not Collective
210
211 Input Parameters:
212 + obj - the object
213 - type_name - string containing a type name
214
215 Output Parameter:
216 . same - `PETSC_TRUE` if the object is of the same base type identified by `type_name` or both `NULL`, `PETSC_FALSE` otherwise
217
218 Level: intermediate
219
220 .seealso: `PetscObject`, `PetscObjectTypeCompare()`, `PetscObjectTypeCompareAny()`, `PetscObjectBaseTypeCompareAny()`
221 @*/
PetscObjectBaseTypeCompare(PetscObject obj,const char type_name[],PetscBool * same)222 PetscErrorCode PetscObjectBaseTypeCompare(PetscObject obj, const char type_name[], PetscBool *same)
223 {
224 PetscFunctionBegin;
225 PetscAssertPointer(same, 3);
226 if (!obj) *same = (PetscBool)!type_name;
227 else {
228 PetscValidHeader(obj, 1);
229 if (!type_name || !obj->type_name) *same = (PetscBool)(!obj->type_name == !type_name);
230 else {
231 PetscAssertPointer(type_name, 2);
232 PetscCall(PetscStrbeginswith(obj->type_name, type_name, same));
233 }
234 }
235 PetscFunctionReturn(PETSC_SUCCESS);
236 }
237
238 /*@C
239 PetscObjectTypeCompareAny - Determines whether a PETSc object is of any of a list of types.
240
241 Not Collective
242
243 Input Parameters:
244 + obj - a PETSc object, for example a `Vec`, `Mat` or `KSP`. It must be cast with a (`PetscObject`),
245 for example, `PetscObjectTypeCompareAny`((`PetscObject`)mat,...);
246 - type_name - one or more string arguments containing type names, pass the empty string "" as the last argument
247
248 Output Parameter:
249 . match - `PETSC_TRUE` if the type of `obj` matches any in the list, else `PETSC_FALSE`
250
251 Level: intermediate
252
253 .seealso: `VecGetType()`, `KSPGetType()`, `PCGetType()`, `SNESGetType()`, `PetscObjectTypeCompare()`, `PetscObjectBaseTypeCompare()`
254 @*/
PetscObjectTypeCompareAny(PetscObject obj,PetscBool * match,const char type_name[],...)255 PetscErrorCode PetscObjectTypeCompareAny(PetscObject obj, PetscBool *match, const char type_name[], ...)
256 {
257 va_list Argp;
258
259 PetscFunctionBegin;
260 PetscAssertPointer(match, 2);
261 *match = PETSC_FALSE;
262 if (!obj) PetscFunctionReturn(PETSC_SUCCESS);
263 va_start(Argp, type_name);
264 while (type_name && type_name[0]) {
265 PetscBool found;
266 PetscCall(PetscObjectTypeCompare(obj, type_name, &found));
267 if (found) {
268 *match = PETSC_TRUE;
269 break;
270 }
271 type_name = va_arg(Argp, const char *);
272 }
273 va_end(Argp);
274 PetscFunctionReturn(PETSC_SUCCESS);
275 }
276
277 /*@C
278 PetscObjectBaseTypeCompareAny - Determines whether a PETSc object has the base type of any of a list of types.
279
280 Not Collective
281
282 Input Parameters:
283 + obj - a PETSc object, for example a `Vec`, `Mat` or `KSP`. It must be cast with a (`PetscObject`),
284 for example, `PetscObjectBaseTypeCompareAny`((`PetscObject`)mat,...);
285 - type_name - one or more string arguments containing type names, pass the empty string "" as the last argument
286
287 Output Parameter:
288 . match - `PETSC_TRUE` if the type of `obj` matches any in the list, else `PETSC_FALSE`
289
290 Level: intermediate
291
292 .seealso: `VecGetType()`, `KSPGetType()`, `PCGetType()`, `SNESGetType()`, `PetscObjectTypeCompare()`, `PetscObjectBaseTypeCompare()`, `PetscObjectTypeCompareAny()`
293 @*/
PetscObjectBaseTypeCompareAny(PetscObject obj,PetscBool * match,const char type_name[],...)294 PetscErrorCode PetscObjectBaseTypeCompareAny(PetscObject obj, PetscBool *match, const char type_name[], ...)
295 {
296 va_list Argp;
297
298 PetscFunctionBegin;
299 PetscAssertPointer(match, 2);
300 *match = PETSC_FALSE;
301 va_start(Argp, type_name);
302 while (type_name && type_name[0]) {
303 PetscBool found;
304 PetscCall(PetscObjectBaseTypeCompare(obj, type_name, &found));
305 if (found) {
306 *match = PETSC_TRUE;
307 break;
308 }
309 type_name = va_arg(Argp, const char *);
310 }
311 va_end(Argp);
312 PetscFunctionReturn(PETSC_SUCCESS);
313 }
314
315 typedef struct {
316 PetscErrorCode (*func)(void);
317 } PetscFinalizeFunction;
318
319 typedef struct {
320 PetscErrorCode (*func)(void *);
321 PetscCtx ctx;
322 } PetscFinalizeFunctionWithCtx;
323
324 typedef enum {
325 PETSC_FINALIZE_EMPTY,
326 PETSC_FINALIZE_OBJECT,
327 PETSC_FINALIZE_FUNC,
328 PETSC_FINALIZE_FUNC_WITH_CTX
329 } PetscFinalizeType;
330
331 static const char *const PetscFinalizeTypes[] = {"PETSC_FINALIZE_EMPTY", "PETSC_FINALIZE_OBJECT", "PETSC_FINALIZE_FUNC", "PETSC_FINALIZE_FUNC_WITH_CTX", PETSC_NULLPTR};
332
333 typedef struct {
334 union ThunkUnion
335 {
336 PetscObject obj;
337 PetscFinalizeFunction fn;
338 PetscFinalizeFunctionWithCtx fnctx;
339 } thunk;
340 PetscFinalizeType type;
341 } PetscFinalizerContainer;
342
343 #define PETSC_MAX_REGISTERED_FINALIZERS 256
344 static int reg_count = 0;
345 static PetscFinalizerContainer regfin[PETSC_MAX_REGISTERED_FINALIZERS];
346
PetscRunRegisteredFinalizers(void)347 static PetscErrorCode PetscRunRegisteredFinalizers(void)
348 {
349 PetscFunctionBegin;
350 while (reg_count) {
351 PetscFinalizerContainer top = regfin[--reg_count];
352
353 regfin[reg_count].type = PETSC_FINALIZE_EMPTY;
354 PetscCall(PetscArrayzero(®fin[reg_count].thunk, 1));
355 switch (top.type) {
356 case PETSC_FINALIZE_OBJECT:
357 PetscCall(PetscObjectDestroy(&top.thunk.obj));
358 break;
359 case PETSC_FINALIZE_FUNC:
360 PetscCall((*top.thunk.fn.func)());
361 break;
362 case PETSC_FINALIZE_FUNC_WITH_CTX:
363 PetscCall((*top.thunk.fnctx.func)(top.thunk.fnctx.ctx));
364 break;
365 case PETSC_FINALIZE_EMPTY:
366 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Finalizer at position %d is empty, yet registration count %d != 0", reg_count, reg_count);
367 break;
368 }
369 }
370 PetscFunctionReturn(PETSC_SUCCESS);
371 }
372
PetscFinalizerContainerEqual(const PetscFinalizerContainer * a,const PetscFinalizerContainer * b)373 static int PetscFinalizerContainerEqual(const PetscFinalizerContainer *a, const PetscFinalizerContainer *b)
374 {
375 if (a->type != b->type) return 0;
376 switch (a->type) {
377 case PETSC_FINALIZE_EMPTY:
378 break;
379 case PETSC_FINALIZE_OBJECT:
380 return a->thunk.obj == b->thunk.obj;
381 case PETSC_FINALIZE_FUNC:
382 return a->thunk.fn.func == b->thunk.fn.func;
383 case PETSC_FINALIZE_FUNC_WITH_CTX:
384 return a->thunk.fnctx.func == b->thunk.fnctx.func && a->thunk.fnctx.ctx == b->thunk.fnctx.ctx;
385 }
386 return 1;
387 }
388
RegisterFinalizer(PetscFinalizerContainer container)389 static PetscErrorCode RegisterFinalizer(PetscFinalizerContainer container)
390 {
391 PetscFunctionBegin;
392 PetscAssert(reg_count < (int)PETSC_STATIC_ARRAY_LENGTH(regfin), PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "No more room in array, limit %zu, recompile %s with larger value for " PetscStringize(regfin), PETSC_STATIC_ARRAY_LENGTH(regfin), __FILE__);
393 PetscAssert(regfin[reg_count].type == PETSC_FINALIZE_EMPTY, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Finalizer type (%s) at position %d is not PETSC_FINALIZE_EMPTY!", PetscFinalizeTypes[regfin[reg_count].type], reg_count);
394 if (PetscDefined(USE_DEBUG)) {
395 for (int i = 0; i < reg_count; ++i) PetscCheck(!PetscFinalizerContainerEqual(regfin + i, &container), PETSC_COMM_SELF, PETSC_ERR_ORDER, "Finalizer (of type %s) already registered!", PetscFinalizeTypes[container.type]);
396 }
397 regfin[reg_count++] = container;
398 PetscFunctionReturn(PETSC_SUCCESS);
399 }
400
401 /*@
402 PetscObjectRegisterDestroy - Registers a PETSc object to be destroyed when
403 `PetscFinalize()` is called.
404
405 Logically Collective
406
407 Input Parameter:
408 . obj - a PETSc object, for example a `Vec`, `Mat` or `KSP`. It must be cast with a (`PetscObject`), for example,
409 `PetscObjectRegisterDestroy`((`PetscObject`)mat);
410
411 Level: developer
412
413 Note:
414 This is used by, for example, `PETSC_VIEWER_XXX_()` routines to free the viewer
415 when PETSc ends.
416
417 .seealso: `PetscObjectRegisterDestroyAll()`
418 @*/
PetscObjectRegisterDestroy(PetscObject obj)419 PetscErrorCode PetscObjectRegisterDestroy(PetscObject obj)
420 {
421 PetscFinalizerContainer container;
422
423 PetscFunctionBegin;
424 PetscValidHeader(obj, 1);
425 container.thunk.obj = obj;
426 container.type = PETSC_FINALIZE_OBJECT;
427 PetscCall(RegisterFinalizer(container));
428 PetscFunctionReturn(PETSC_SUCCESS);
429 }
430
431 /*@C
432 PetscObjectRegisterDestroyAll - Frees all the PETSc objects that have been registered
433 with `PetscObjectRegisterDestroy()`. Called by `PetscFinalize()`
434
435 Logically Collective on the individual `PetscObject`s that are being processed
436
437 Level: developer
438
439 .seealso: `PetscObjectRegisterDestroy()`
440 @*/
PetscObjectRegisterDestroyAll(void)441 PetscErrorCode PetscObjectRegisterDestroyAll(void)
442 {
443 PetscFunctionBegin;
444 PetscCall(PetscRunRegisteredFinalizers());
445 PetscFunctionReturn(PETSC_SUCCESS);
446 }
447
448 /*@C
449 PetscRegisterFinalize - Registers a function that is to be called in `PetscFinalize()`
450
451 Not Collective
452
453 Input Parameter:
454 . f - function to be called
455
456 Level: developer
457
458 Notes:
459 This is used by, for example, `DMInitializePackage()` to have `DMFinalizePackage()` called
460
461 Use `PetscObjectRegisterDestroy()` to register the destruction of an object in `PetscFinalize()`
462
463 .seealso: `PetscRegisterFinalizeAll()`, `PetscObjectRegisterDestroy()`
464 @*/
PetscRegisterFinalize(PetscErrorCode (* f)(void))465 PetscErrorCode PetscRegisterFinalize(PetscErrorCode (*f)(void))
466 {
467 PetscFinalizerContainer container;
468
469 PetscFunctionBegin;
470 PetscValidFunction(f, 1);
471 container.thunk.fn.func = f;
472 container.type = PETSC_FINALIZE_FUNC;
473 PetscCall(RegisterFinalizer(container));
474 PetscFunctionReturn(PETSC_SUCCESS);
475 }
476
477 /*@C
478 PetscRegisterFinalizeAll - Runs all the finalize functions set with `PetscRegisterFinalize()`
479
480 Not Collective unless registered functions are collective
481
482 Level: developer
483
484 .seealso: `PetscRegisterFinalize()`, `PetscObjectRegisterDestroyAll()`
485 @*/
PetscRegisterFinalizeAll(void)486 PetscErrorCode PetscRegisterFinalizeAll(void)
487 {
488 PetscFunctionBegin;
489 PetscCall(PetscRunRegisteredFinalizers());
490 PetscFunctionReturn(PETSC_SUCCESS);
491 }
492