1 /*
2 Provides utility routines for manipulating any type of PETSc object.
3 */
4 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/
5 #include <petscviewer.h>
6
7 PETSC_INTERN PetscObject *PetscObjects;
8 PETSC_INTERN PetscInt PetscObjectsCounts;
9 PETSC_INTERN PetscInt PetscObjectsMaxCounts;
10 PETSC_INTERN PetscBool PetscObjectsLog;
11
12 PetscObject *PetscObjects = NULL;
13 PetscInt PetscObjectsCounts = 0, PetscObjectsMaxCounts = 0;
14 PetscBool PetscObjectsLog = PETSC_FALSE;
15
PetscObjectNewId_Internal(void)16 PetscObjectId PetscObjectNewId_Internal(void)
17 {
18 static PetscObjectId idcnt = 1;
19 return idcnt++;
20 }
21
PetscHeaderCreate_Function(PetscErrorCode ierr,PetscObject * h,PetscClassId classid,const char class_name[],const char descr[],const char mansec[],MPI_Comm comm,PetscObjectDestroyFn * destroy,PetscObjectViewFn * view)22 PetscErrorCode PetscHeaderCreate_Function(PetscErrorCode ierr, PetscObject *h, PetscClassId classid, const char class_name[], const char descr[], const char mansec[], MPI_Comm comm, PetscObjectDestroyFn *destroy, PetscObjectViewFn *view)
23 {
24 PetscFunctionBegin;
25 if (ierr) PetscFunctionReturn(ierr);
26 PetscCall(PetscHeaderCreate_Private(*h, classid, class_name, descr, mansec, comm, destroy, view));
27 PetscCall(PetscLogObjectCreate(*h));
28 PetscFunctionReturn(PETSC_SUCCESS);
29 }
30
31 /*
32 PetscHeaderCreate_Private - Fills in the default values.
33 */
PetscHeaderCreate_Private(PetscObject h,PetscClassId classid,const char class_name[],const char descr[],const char mansec[],MPI_Comm comm,PetscObjectDestroyFn * destroy,PetscObjectViewFn * view)34 PetscErrorCode PetscHeaderCreate_Private(PetscObject h, PetscClassId classid, const char class_name[], const char descr[], const char mansec[], MPI_Comm comm, PetscObjectDestroyFn *destroy, PetscObjectViewFn *view)
35 {
36 void *get_tmp;
37 PetscInt64 *cidx;
38 PetscMPIInt iflg;
39
40 PetscFunctionBegin;
41 h->classid = classid;
42 h->class_name = (char *)class_name;
43 h->description = (char *)descr;
44 h->mansec = (char *)mansec;
45 h->refct = 1;
46 h->non_cyclic_references = NULL;
47 h->id = PetscObjectNewId_Internal();
48 h->bops->destroy = destroy;
49 h->bops->view = view;
50
51 PetscCall(PetscCommDuplicate(comm, &h->comm, &h->tag));
52
53 /* Increment and store current object creation index */
54 PetscCallMPI(MPI_Comm_get_attr(h->comm, Petsc_CreationIdx_keyval, &get_tmp, &iflg));
55 PetscCheck(iflg, h->comm, PETSC_ERR_ARG_CORRUPT, "MPI_Comm does not have an object creation index");
56 cidx = (PetscInt64 *)get_tmp;
57 h->cidx = (*cidx)++;
58
59 /* Keep a record of object created */
60 if (PetscDefined(USE_LOG) && PetscObjectsLog) {
61 PetscObject *newPetscObjects;
62 PetscInt newPetscObjectsMaxCounts;
63
64 PetscObjectsCounts++;
65 for (PetscInt i = 0; i < PetscObjectsMaxCounts; ++i) {
66 if (!PetscObjects[i]) {
67 PetscObjects[i] = h;
68 PetscFunctionReturn(PETSC_SUCCESS);
69 }
70 }
71 /* Need to increase the space for storing PETSc objects */
72 if (!PetscObjectsMaxCounts) newPetscObjectsMaxCounts = 100;
73 else newPetscObjectsMaxCounts = 2 * PetscObjectsMaxCounts;
74 PetscCall(PetscCalloc1(newPetscObjectsMaxCounts, &newPetscObjects));
75 PetscCall(PetscArraycpy(newPetscObjects, PetscObjects, PetscObjectsMaxCounts));
76 PetscCall(PetscFree(PetscObjects));
77
78 PetscObjects = newPetscObjects;
79 PetscObjects[PetscObjectsMaxCounts] = h;
80 PetscObjectsMaxCounts = newPetscObjectsMaxCounts;
81 }
82 PetscFunctionReturn(PETSC_SUCCESS);
83 }
84
85 PETSC_INTERN PetscBool PetscMemoryCollectMaximumUsage;
86 PETSC_INTERN PetscLogDouble PetscMemoryMaximumUsage;
87
PetscHeaderDestroy_Function(PetscObject * h)88 PetscErrorCode PetscHeaderDestroy_Function(PetscObject *h)
89 {
90 PetscFunctionBegin;
91 PetscCall(PetscLogObjectDestroy(*h));
92 PetscCall(PetscHeaderDestroy_Private(*h, PETSC_FALSE));
93 PetscCall(PetscFree(*h));
94 PetscFunctionReturn(PETSC_SUCCESS);
95 }
96
97 /*
98 PetscHeaderDestroy_Private - Destroys a base PETSc object header. Called by
99 the macro PetscHeaderDestroy().
100 */
PetscHeaderDestroy_Private(PetscObject obj,PetscBool clear_for_reuse)101 PetscErrorCode PetscHeaderDestroy_Private(PetscObject obj, PetscBool clear_for_reuse)
102 {
103 PetscFunctionBegin;
104 PetscValidHeader(obj, 1);
105 PetscCall(PetscComposedQuantitiesDestroy(obj));
106 if (PetscMemoryCollectMaximumUsage) {
107 PetscLogDouble usage;
108
109 PetscCall(PetscMemoryGetCurrentUsage(&usage));
110 if (usage > PetscMemoryMaximumUsage) PetscMemoryMaximumUsage = usage;
111 }
112 /* first destroy things that could execute arbitrary code */
113 if (obj->python_destroy) {
114 void *python_context = obj->python_context;
115 PetscErrorCode (*python_destroy)(void *) = obj->python_destroy;
116
117 obj->python_context = NULL;
118 obj->python_destroy = NULL;
119 PetscCall((*python_destroy)(python_context));
120 }
121 PetscCall(PetscObjectDestroyOptionsHandlers(obj));
122 PetscCall(PetscObjectListDestroy(&obj->olist));
123
124 /* destroy allocated quantities */
125 if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintNonEmpty(obj->qlist));
126 PetscCheck(--obj->refct <= 0, obj->comm, PETSC_ERR_PLIB, "Destroying a PetscObject (%s) with reference count %" PetscInt_FMT " >= 1", obj->name ? obj->name : "unnamed", obj->refct);
127 PetscCall(PetscFree(obj->name));
128 PetscCall(PetscFree(obj->prefix));
129 PetscCall(PetscFree(obj->type_name));
130
131 if (clear_for_reuse) {
132 /* we will assume that obj->bops->view and destroy are safe to leave as-is */
133
134 /* reset quantities, in order of appearance in _p_PetscObject */
135 obj->id = PetscObjectNewId_Internal();
136 obj->refct = 1;
137 obj->tablevel = 0;
138 obj->state = 0;
139 /* don't deallocate, zero these out instead */
140 PetscCall(PetscFunctionListClear(obj->qlist));
141 PetscCall(PetscArrayzero(obj->fortran_func_pointers, obj->num_fortran_func_pointers));
142 PetscCall(PetscArrayzero(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS], obj->num_fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS]));
143 PetscCall(PetscArrayzero(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE], obj->num_fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE]));
144 obj->optionsprinted = PETSC_FALSE;
145 #if PetscDefined(HAVE_SAWS)
146 obj->amsmem = PETSC_FALSE;
147 obj->amspublishblock = PETSC_FALSE;
148 #endif
149 obj->options = NULL;
150 obj->donotPetscObjectPrintClassNamePrefixType = PETSC_FALSE;
151 } else {
152 PetscCall(PetscFunctionListDestroy(&obj->qlist));
153 PetscCall(PetscFree(obj->fortran_func_pointers));
154 PetscCall(PetscFree(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS]));
155 PetscCall(PetscFree(obj->fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE]));
156 PetscCall(PetscCommDestroy(&obj->comm));
157 obj->classid = PETSCFREEDHEADER;
158
159 if (PetscDefined(USE_LOG) && PetscObjectsLog) {
160 /* Record object removal from list of all objects */
161 for (PetscInt i = 0; i < PetscObjectsMaxCounts; ++i) {
162 if (PetscObjects[i] == obj) {
163 PetscObjects[i] = NULL;
164 --PetscObjectsCounts;
165 break;
166 }
167 }
168 if (!PetscObjectsCounts) {
169 PetscCall(PetscFree(PetscObjects));
170 PetscObjectsMaxCounts = 0;
171 }
172 }
173 }
174 PetscFunctionReturn(PETSC_SUCCESS);
175 }
176
177 /*
178 PetscHeaderReset_Internal - "Reset" a PetscObject header. This is tantamount to destroying
179 the object but does not free all resources. The object retains its:
180
181 - classid
182 - bops->view
183 - bops->destroy
184 - comm
185 - tag
186 - class_name
187 - description
188 - mansec
189 - cpp
190
191 Note that while subclass information is lost, superclass info remains. Thus this function is
192 intended to be used to reuse a PetscObject within the same class to avoid reallocating its
193 resources.
194 */
PetscHeaderReset_Internal(PetscObject obj)195 PetscErrorCode PetscHeaderReset_Internal(PetscObject obj)
196 {
197 PetscFunctionBegin;
198 PetscCall(PetscHeaderDestroy_Private(obj, PETSC_TRUE));
199 PetscFunctionReturn(PETSC_SUCCESS);
200 }
201
202 /*@
203 PetscObjectCopyFortranFunctionPointers - Copy function pointers to another object
204
205 Logically Collective
206
207 Input Parameters:
208 + src - source object
209 - dest - destination object
210
211 Level: developer
212
213 Note:
214 Both objects must have the same class.
215
216 This is used to help manage user callback functions that were provided in Fortran
217
218 .seealso: `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
219 @*/
PetscObjectCopyFortranFunctionPointers(PetscObject src,PetscObject dest)220 PetscErrorCode PetscObjectCopyFortranFunctionPointers(PetscObject src, PetscObject dest)
221 {
222 PetscFortranCallbackId cbtype, numcb[PETSC_FORTRAN_CALLBACK_MAXTYPE];
223
224 PetscFunctionBegin;
225 PetscValidHeader(src, 1);
226 PetscValidHeader(dest, 2);
227 PetscCheck(src->classid == dest->classid, src->comm, PETSC_ERR_ARG_INCOMP, "Objects must be of the same class");
228
229 PetscCall(PetscFree(dest->fortran_func_pointers));
230 PetscCall(PetscMalloc(src->num_fortran_func_pointers * sizeof(PetscFortranCallbackFn *), &dest->fortran_func_pointers));
231 PetscCall(PetscArraycpy(dest->fortran_func_pointers, src->fortran_func_pointers, src->num_fortran_func_pointers));
232
233 dest->num_fortran_func_pointers = src->num_fortran_func_pointers;
234
235 PetscCall(PetscFortranCallbackGetSizes(src->classid, &numcb[PETSC_FORTRAN_CALLBACK_CLASS], &numcb[PETSC_FORTRAN_CALLBACK_SUBTYPE]));
236 for (cbtype = PETSC_FORTRAN_CALLBACK_CLASS; cbtype < PETSC_FORTRAN_CALLBACK_MAXTYPE; cbtype++) {
237 PetscCall(PetscFree(dest->fortrancallback[cbtype]));
238 PetscCall(PetscCalloc1(numcb[cbtype], &dest->fortrancallback[cbtype]));
239 PetscCall(PetscArraycpy(dest->fortrancallback[cbtype], src->fortrancallback[cbtype], src->num_fortrancallback[cbtype]));
240 dest->num_fortrancallback[cbtype] = src->num_fortrancallback[cbtype];
241 }
242 PetscFunctionReturn(PETSC_SUCCESS);
243 }
244
245 /*@C
246 PetscObjectSetFortranCallback - set Fortran callback function pointer and context
247
248 Logically Collective, No Fortran Support
249
250 Input Parameters:
251 + obj - object on which to set callback
252 . cbtype - callback type (class or subtype)
253 . cid - address of callback Id, updated if not yet initialized (zero)
254 . func - Fortran function
255 - ctx - Fortran context
256
257 Level: developer
258
259 Note:
260 This is used to help manage user callback functions that were provided in Fortran
261
262 .seealso: `PetscObjectGetFortranCallback()`, `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
263 @*/
PetscObjectSetFortranCallback(PetscObject obj,PetscFortranCallbackType cbtype,PetscFortranCallbackId * cid,PetscFortranCallbackFn * func,PetscCtx ctx)264 PetscErrorCode PetscObjectSetFortranCallback(PetscObject obj, PetscFortranCallbackType cbtype, PetscFortranCallbackId *cid, PetscFortranCallbackFn *func, PetscCtx ctx)
265 {
266 const char *subtype = NULL;
267
268 PetscFunctionBegin;
269 PetscValidHeader(obj, 1);
270 if (cbtype == PETSC_FORTRAN_CALLBACK_SUBTYPE) subtype = obj->type_name;
271 if (!*cid) PetscCall(PetscFortranCallbackRegister(obj->classid, subtype, cid));
272 if (*cid >= PETSC_SMALLEST_FORTRAN_CALLBACK + obj->num_fortrancallback[cbtype]) {
273 PetscFortranCallbackId oldnum = obj->num_fortrancallback[cbtype];
274 PetscFortranCallbackId newnum = PetscMax(*cid - PETSC_SMALLEST_FORTRAN_CALLBACK + 1, 2 * oldnum);
275 PetscFortranCallback *callback;
276 PetscCall(PetscMalloc1(newnum, &callback));
277 PetscCall(PetscArraycpy(callback, obj->fortrancallback[cbtype], oldnum));
278 PetscCall(PetscFree(obj->fortrancallback[cbtype]));
279
280 obj->fortrancallback[cbtype] = callback;
281 obj->num_fortrancallback[cbtype] = newnum;
282 }
283 obj->fortrancallback[cbtype][*cid - PETSC_SMALLEST_FORTRAN_CALLBACK].func = func;
284 obj->fortrancallback[cbtype][*cid - PETSC_SMALLEST_FORTRAN_CALLBACK].ctx = ctx;
285 PetscFunctionReturn(PETSC_SUCCESS);
286 }
287
288 /*@C
289 PetscObjectGetFortranCallback - get Fortran callback function pointer and context
290
291 Logically Collective, No Fortran Support
292
293 Input Parameters:
294 + obj - object on which to get callback
295 . cbtype - callback type
296 - cid - address of callback Id
297
298 Output Parameters:
299 + func - Fortran function (or `NULL` if not needed)
300 - ctx - Fortran context (or `NULL` if not needed)
301
302 Level: developer
303
304 Note:
305 This is used to help manage user callback functions that were provided in Fortran
306
307 .seealso: `PetscObjectSetFortranCallback()`, `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
308 @*/
PetscObjectGetFortranCallback(PetscObject obj,PetscFortranCallbackType cbtype,PetscFortranCallbackId cid,PetscFortranCallbackFn ** func,void ** ctx)309 PetscErrorCode PetscObjectGetFortranCallback(PetscObject obj, PetscFortranCallbackType cbtype, PetscFortranCallbackId cid, PetscFortranCallbackFn **func, void **ctx)
310 {
311 PetscFortranCallback *cb;
312
313 PetscFunctionBegin;
314 PetscValidHeader(obj, 1);
315 PetscCheck(cid >= PETSC_SMALLEST_FORTRAN_CALLBACK, obj->comm, PETSC_ERR_ARG_CORRUPT, "Fortran callback Id invalid");
316 PetscCheck(cid < PETSC_SMALLEST_FORTRAN_CALLBACK + obj->num_fortrancallback[cbtype], obj->comm, PETSC_ERR_ARG_CORRUPT, "Fortran callback not set on this object");
317 cb = &obj->fortrancallback[cbtype][cid - PETSC_SMALLEST_FORTRAN_CALLBACK];
318 if (func) *func = cb->func;
319 if (ctx) *ctx = cb->ctx;
320 PetscFunctionReturn(PETSC_SUCCESS);
321 }
322
323 #if defined(PETSC_USE_LOG)
324 /*@C
325 PetscObjectsDump - Prints all the currently existing objects.
326
327 Input Parameters:
328 + fd - file pointer
329 - all - by default only tries to display objects created explicitly by the user, if all is `PETSC_TRUE` then lists all outstanding objects
330
331 Options Database Key:
332 . -objects_dump <all> - print information about all the objects that exist at the end of the programs run
333
334 Level: advanced
335
336 Note:
337 Only MPI rank 0 of `PETSC_COMM_WORLD` prints the values
338
339 .seealso: `PetscObject`
340 @*/
PetscObjectsDump(FILE * fd,PetscBool all)341 PetscErrorCode PetscObjectsDump(FILE *fd, PetscBool all)
342 {
343 PetscInt i, j, k = 0;
344 PetscObject h;
345
346 PetscFunctionBegin;
347 if (PetscObjectsCounts) {
348 PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "The following objects were never freed\n"));
349 PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "-----------------------------------------\n"));
350 for (i = 0; i < PetscObjectsMaxCounts; i++) {
351 if ((h = PetscObjects[i])) {
352 PetscCall(PetscObjectName(h));
353 {
354 PetscStack *stack = NULL;
355 char *create = NULL, *rclass = NULL;
356
357 /* if the PETSc function the user calls is not a create then this object was NOT directly created by them */
358 PetscCall(PetscMallocGetStack(h, &stack));
359 if (stack) {
360 k = stack->currentsize - 2;
361 if (!all) {
362 k = 0;
363 while (!stack->petscroutine[k]) k++;
364 PetscCall(PetscStrstr(stack->function[k], "Create", &create));
365 if (!create) PetscCall(PetscStrstr(stack->function[k], "Get", &create));
366 PetscCall(PetscStrstr(stack->function[k], h->class_name, &rclass));
367 if (!create) continue;
368 if (!rclass) continue;
369 }
370 }
371
372 PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "[%d] %s %s %s\n", PetscGlobalRank, h->class_name, h->type_name, h->name));
373
374 PetscCall(PetscMallocGetStack(h, &stack));
375 if (stack) {
376 for (j = k; j >= 0; j--) fprintf(fd, " [%d] %s() in %s\n", PetscGlobalRank, stack->function[j], stack->file[j]);
377 }
378 }
379 }
380 }
381 }
382 PetscFunctionReturn(PETSC_SUCCESS);
383 }
384
385 /*@
386 PetscObjectsView - Prints the currently existing objects.
387
388 Logically Collective
389
390 Input Parameter:
391 . viewer - must be an `PETSCVIEWERASCII` viewer
392
393 Level: advanced
394
395 .seealso: `PetscObject`
396 @*/
PetscObjectsView(PetscViewer viewer)397 PetscErrorCode PetscObjectsView(PetscViewer viewer)
398 {
399 PetscBool isascii;
400 FILE *fd;
401
402 PetscFunctionBegin;
403 if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
404 PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
405 PetscCheck(isascii, PetscObjectComm((PetscObject)viewer), PETSC_ERR_SUP, "Only supports ASCII viewer");
406 PetscCall(PetscViewerASCIIGetPointer(viewer, &fd));
407 PetscCall(PetscObjectsDump(fd, PETSC_TRUE));
408 PetscFunctionReturn(PETSC_SUCCESS);
409 }
410
411 /*@
412 PetscObjectsGetObject - Get a pointer to a named object
413
414 Not Collective
415
416 Input Parameter:
417 . name - the name of an object
418
419 Output Parameters:
420 + obj - the object or `NULL` if there is no object, optional, pass in `NULL` if not needed
421 - classname - the name of the class of the object, optional, pass in `NULL` if not needed
422
423 Level: advanced
424
425 .seealso: `PetscObject`
426 @*/
PetscObjectsGetObject(const char name[],PetscObject * obj,const char * classname[])427 PetscErrorCode PetscObjectsGetObject(const char name[], PetscObject *obj, const char *classname[])
428 {
429 PetscInt i;
430 PetscObject h;
431 PetscBool flg;
432
433 PetscFunctionBegin;
434 PetscAssertPointer(name, 1);
435 if (obj) *obj = NULL;
436 for (i = 0; i < PetscObjectsMaxCounts; i++) {
437 if ((h = PetscObjects[i])) {
438 PetscCall(PetscObjectName(h));
439 PetscCall(PetscStrcmp(h->name, name, &flg));
440 if (flg) {
441 if (obj) *obj = h;
442 if (classname) *classname = h->class_name;
443 PetscFunctionReturn(PETSC_SUCCESS);
444 }
445 }
446 }
447 PetscFunctionReturn(PETSC_SUCCESS);
448 }
449 #else
PetscObjectsView(PetscViewer viewer)450 PetscErrorCode PetscObjectsView(PetscViewer viewer)
451 {
452 PetscFunctionReturn(PETSC_SUCCESS);
453 }
454
PetscObjectsGetObject(const char name[],PetscObject * obj,const char * classname[])455 PetscErrorCode PetscObjectsGetObject(const char name[], PetscObject *obj, const char *classname[])
456 {
457 PetscFunctionReturn(PETSC_SUCCESS);
458 }
459 #endif
460
461 /*@
462 PetscObjectSetPrintedOptions - indicate to an object that it should behave as if it has already printed the help for its options so it will not display the help message
463
464 Input Parameter:
465 . obj - the `PetscObject`
466
467 Level: developer
468
469 Developer Notes:
470 This is used, for example to prevent sequential objects that are created from a parallel object; such as the `KSP` created by
471 `PCBJACOBI` from all printing the same help messages to the screen
472
473 .seealso: `PetscOptionsInsert()`, `PetscObject`
474 @*/
PetscObjectSetPrintedOptions(PetscObject obj)475 PetscErrorCode PetscObjectSetPrintedOptions(PetscObject obj)
476 {
477 PetscFunctionBegin;
478 PetscAssertPointer(obj, 1);
479 obj->optionsprinted = PETSC_TRUE;
480 PetscFunctionReturn(PETSC_SUCCESS);
481 }
482
483 /*@
484 PetscObjectInheritPrintedOptions - If the child object is not on the MPI rank 0 process of the parent object and the child is sequential then the child gets it set.
485
486 Input Parameters:
487 + pobj - the parent object
488 - obj - the `PetscObject`
489
490 Level: developer
491
492 Developer Notes:
493 This is used, for example to prevent sequential objects that are created from a parallel object; such as the `KSP` created by
494 `PCBJACOBI` from all printing the same help messages to the screen
495
496 This will not handle more complicated situations like with `PCGASM` where children may live on any subset of the parent's processes and overlap
497
498 .seealso: `PetscOptionsInsert()`, `PetscObjectSetPrintedOptions()`, `PetscObject`
499 @*/
PetscObjectInheritPrintedOptions(PetscObject pobj,PetscObject obj)500 PetscErrorCode PetscObjectInheritPrintedOptions(PetscObject pobj, PetscObject obj)
501 {
502 PetscMPIInt prank, size;
503
504 PetscFunctionBegin;
505 PetscValidHeader(pobj, 1);
506 PetscValidHeader(obj, 2);
507 PetscCallMPI(MPI_Comm_rank(pobj->comm, &prank));
508 PetscCallMPI(MPI_Comm_size(obj->comm, &size));
509 if (size == 1 && prank > 0) obj->optionsprinted = PETSC_TRUE;
510 PetscFunctionReturn(PETSC_SUCCESS);
511 }
512
513 /*@C
514 PetscObjectAddOptionsHandler - Adds an additional function to check for options when `XXXSetFromOptions()` is called.
515
516 Not Collective
517
518 Input Parameters:
519 + obj - the PETSc object
520 . handle - function that checks for options
521 . destroy - function to destroy `ctx` if provided
522 - ctx - optional context for check function
523
524 Calling sequence of `handle`:
525 + obj - the PETSc object
526 . PetscOptionsObject - the `PetscOptionItems` object
527 - ctx - optional context for `handle`
528
529 Calling sequence of `destroy`:
530 + obj - the PETSc object
531 - ctx - optional context for `handle`
532
533 Level: developer
534
535 .seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectProcessOptionsHandlers()`, `PetscObjectDestroyOptionsHandlers()`,
536 `PetscObject`
537 @*/
PetscObjectAddOptionsHandler(PetscObject obj,PetscErrorCode (* handle)(PetscObject obj,PetscOptionItems PetscOptionsObject,PetscCtx ctx),PetscErrorCode (* destroy)(PetscObject obj,PetscCtxRt ctx),PetscCtx ctx)538 PetscErrorCode PetscObjectAddOptionsHandler(PetscObject obj, PetscErrorCode (*handle)(PetscObject obj, PetscOptionItems PetscOptionsObject, PetscCtx ctx), PetscErrorCode (*destroy)(PetscObject obj, PetscCtxRt ctx), PetscCtx ctx)
539 {
540 PetscFunctionBegin;
541 PetscValidHeader(obj, 1);
542 for (PetscInt i = 0; i < obj->noptionhandler; i++) {
543 PetscBool identical = (PetscBool)(obj->optionhandler[i] == handle && obj->optiondestroy[i] == destroy && obj->optionctx[i] == ctx);
544 if (identical) PetscFunctionReturn(PETSC_SUCCESS);
545 }
546 PetscCheck(obj->noptionhandler < PETSC_MAX_OPTIONS_HANDLER, obj->comm, PETSC_ERR_ARG_OUTOFRANGE, "Too many options handlers added");
547 obj->optionhandler[obj->noptionhandler] = handle;
548 obj->optiondestroy[obj->noptionhandler] = destroy;
549 obj->optionctx[obj->noptionhandler++] = ctx;
550 PetscFunctionReturn(PETSC_SUCCESS);
551 }
552
553 /*@C
554 PetscObjectProcessOptionsHandlers - Calls all the options handlers attached to an object
555
556 Not Collective
557
558 Input Parameters:
559 + obj - the PETSc object
560 - PetscOptionsObject - the options context
561
562 Level: developer
563
564 .seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectAddOptionsHandler()`, `PetscObjectDestroyOptionsHandlers()`,
565 `PetscObject`
566 @*/
PetscObjectProcessOptionsHandlers(PetscObject obj,PetscOptionItems PetscOptionsObject)567 PetscErrorCode PetscObjectProcessOptionsHandlers(PetscObject obj, PetscOptionItems PetscOptionsObject)
568 {
569 PetscFunctionBegin;
570 PetscValidHeader(obj, 1);
571 for (PetscInt i = 0; i < obj->noptionhandler; i++) PetscCall((*obj->optionhandler[i])(obj, PetscOptionsObject, obj->optionctx[i]));
572 PetscFunctionReturn(PETSC_SUCCESS);
573 }
574
575 /*@
576 PetscObjectDestroyOptionsHandlers - Destroys all the option handlers attached to an object
577
578 Not Collective
579
580 Input Parameter:
581 . obj - the PETSc object
582
583 Level: developer
584
585 .seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectAddOptionsHandler()`, `PetscObjectProcessOptionsHandlers()`,
586 `PetscObject`
587 @*/
PetscObjectDestroyOptionsHandlers(PetscObject obj)588 PetscErrorCode PetscObjectDestroyOptionsHandlers(PetscObject obj)
589 {
590 PetscFunctionBegin;
591 PetscValidHeader(obj, 1);
592 for (PetscInt i = 0; i < obj->noptionhandler; i++) {
593 if (obj->optiondestroy[i]) PetscCall((*obj->optiondestroy[i])(obj, obj->optionctx[i]));
594 }
595 obj->noptionhandler = 0;
596 PetscFunctionReturn(PETSC_SUCCESS);
597 }
598
599 /*@
600 PetscObjectReference - Indicates to a `PetscObject` that it is being
601 referenced by another `PetscObject`. This increases the reference
602 count for that object by one.
603
604 Logically Collective
605
606 Input Parameter:
607 . obj - the PETSc object. This must be cast with (`PetscObject`), for example, `PetscObjectReference`((`PetscObject`)mat);
608
609 Level: advanced
610
611 Note:
612 If `obj` is `NULL` this function returns without doing anything.
613
614 .seealso: `PetscObjectCompose()`, `PetscObjectDereference()`, `PetscObject`
615 @*/
PetscObjectReference(PetscObject obj)616 PetscErrorCode PetscObjectReference(PetscObject obj)
617 {
618 PetscFunctionBegin;
619 if (!obj) PetscFunctionReturn(PETSC_SUCCESS);
620 PetscValidHeader(obj, 1);
621 obj->refct++;
622 PetscFunctionReturn(PETSC_SUCCESS);
623 }
624
625 /*@
626 PetscObjectGetReference - Gets the current reference count for a PETSc object.
627
628 Not Collective
629
630 Input Parameter:
631 . obj - the PETSc object; this must be cast with (`PetscObject`), for example,
632 `PetscObjectGetReference`((`PetscObject`)mat,&cnt); `obj` cannot be `NULL`
633
634 Output Parameter:
635 . cnt - the reference count
636
637 Level: advanced
638
639 .seealso: `PetscObjectCompose()`, `PetscObjectDereference()`, `PetscObjectReference()`, `PetscObject`
640 @*/
PetscObjectGetReference(PetscObject obj,PetscInt * cnt)641 PetscErrorCode PetscObjectGetReference(PetscObject obj, PetscInt *cnt)
642 {
643 PetscFunctionBegin;
644 PetscValidHeader(obj, 1);
645 PetscAssertPointer(cnt, 2);
646 *cnt = obj->refct;
647 PetscFunctionReturn(PETSC_SUCCESS);
648 }
649
650 /*@
651 PetscObjectDereference - Indicates to any `PetscObject` that it is being
652 referenced by one less `PetscObject`. This decreases the reference
653 count for that object by one.
654
655 Collective on `obj` if reference reaches 0 otherwise Logically Collective
656
657 Input Parameter:
658 . obj - the PETSc object; this must be cast with (`PetscObject`), for example,
659 `PetscObjectDereference`((`PetscObject`)mat);
660
661 Level: advanced
662
663 Notes:
664 `PetscObjectDestroy()` sets the `obj` pointer to `NULL` after the call, this routine does not.
665
666 If `obj` is `NULL` this function returns without doing anything.
667
668 .seealso: `PetscObjectCompose()`, `PetscObjectReference()`, `PetscObjectDestroy()`, `PetscObject`
669 @*/
PetscObjectDereference(PetscObject obj)670 PetscErrorCode PetscObjectDereference(PetscObject obj)
671 {
672 PetscFunctionBegin;
673 if (!obj) PetscFunctionReturn(PETSC_SUCCESS);
674 PetscValidHeader(obj, 1);
675 if (obj->bops->destroy) PetscCall((*obj->bops->destroy)(&obj));
676 else PetscCheck(--obj->refct, PETSC_COMM_SELF, PETSC_ERR_SUP, "This PETSc object does not have a generic destroy routine");
677 PetscFunctionReturn(PETSC_SUCCESS);
678 }
679
680 /*
681 The following routines are the versions private to the PETSc object
682 data structures.
683 */
PetscObjectRemoveReference(PetscObject obj,const char name[])684 PetscErrorCode PetscObjectRemoveReference(PetscObject obj, const char name[])
685 {
686 PetscFunctionBegin;
687 PetscValidHeader(obj, 1);
688 PetscCall(PetscObjectListRemoveReference(&obj->olist, name));
689 PetscFunctionReturn(PETSC_SUCCESS);
690 }
691
692 /*@
693 PetscObjectCompose - Associates another PETSc object with a given PETSc object.
694
695 Not Collective
696
697 Input Parameters:
698 + obj - the PETSc object; this must be cast with (`PetscObject`), for example,
699 `PetscObjectCompose`((`PetscObject`)mat,...);
700 . name - name associated with the child object
701 - ptr - the other PETSc object to associate with the PETSc object; this must also be
702 cast with (`PetscObject`)
703
704 Level: advanced
705
706 Notes:
707 The second objects reference count is automatically increased by one when it is
708 composed.
709
710 Replaces any previous object that had been composed with the same name.
711
712 If `ptr` is `NULL` and `name` has previously been composed using an object, then that
713 entry is removed from `obj`.
714
715 `PetscObjectCompose()` can be used with any PETSc object (such as
716 `Mat`, `Vec`, `KSP`, `SNES`, etc.) or any user-provided object.
717
718 `PetscContainerCreate()` or `PetscObjectContainerCompose()` can be used to create an object from a
719 user-provided pointer that may then be composed with PETSc objects using `PetscObjectCompose()`
720
721 Fortran Note:
722 Use
723 .vb
724 call PetscObjectCompose(obj, name, PetscObjectCast(ptr), ierr)
725 .ve
726
727 .seealso: `PetscObjectQuery()`, `PetscContainerCreate()`, `PetscObjectComposeFunction()`, `PetscObjectQueryFunction()`, `PetscContainer`,
728 `PetscContainerSetPointer()`, `PetscObject`, `PetscObjectContainerCompose()`
729 @*/
PetscObjectCompose(PetscObject obj,const char name[],PetscObject ptr)730 PetscErrorCode PetscObjectCompose(PetscObject obj, const char name[], PetscObject ptr)
731 {
732 PetscFunctionBegin;
733 PetscValidHeader(obj, 1);
734 PetscAssertPointer(name, 2);
735 if (ptr) PetscValidHeader(ptr, 3);
736 PetscCheck(obj != ptr, PetscObjectComm(obj), PETSC_ERR_SUP, "Cannot compose object with itself");
737 if (ptr) {
738 const char *tname;
739 PetscBool skipreference;
740
741 PetscCall(PetscObjectListReverseFind(ptr->olist, obj, &tname, &skipreference));
742 if (tname) PetscCheck(skipreference, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "An object cannot be composed with an object that was composed with it");
743 }
744 PetscCall(PetscObjectListAdd(&obj->olist, name, ptr));
745 PetscFunctionReturn(PETSC_SUCCESS);
746 }
747
748 /*@
749 PetscObjectQuery - Gets a PETSc object associated with a given object that was composed with `PetscObjectCompose()`
750
751 Not Collective
752
753 Input Parameters:
754 + obj - the PETSc object. It must be cast with a (`PetscObject`), for example,
755 `PetscObjectCompose`((`PetscObject`)mat,...);
756 . name - name associated with child object
757 - ptr - the other PETSc object associated with the PETSc object, this must be
758 cast with (`PetscObject`*)
759
760 Level: advanced
761
762 Note:
763 The reference count of neither object is increased in this call
764
765 Fortran Note:
766 Use
767 .vb
768 call PetscObjectQuery(PetscObjectCast(obj), name, ptr, ierr)
769 .ve
770
771 .seealso: `PetscObjectCompose()`, `PetscObjectComposeFunction()`, `PetscObjectQueryFunction()`, `PetscContainer`
772 `PetscContainerGetPointer()`, `PetscObject`
773 @*/
PetscObjectQuery(PetscObject obj,const char name[],PetscObject * ptr)774 PetscErrorCode PetscObjectQuery(PetscObject obj, const char name[], PetscObject *ptr)
775 {
776 PetscFunctionBegin;
777 PetscValidHeader(obj, 1);
778 PetscAssertPointer(name, 2);
779 PetscAssertPointer(ptr, 3);
780 PetscCall(PetscObjectListFind(obj->olist, name, ptr));
781 PetscFunctionReturn(PETSC_SUCCESS);
782 }
783
784 /*MC
785 PetscObjectComposeFunction - Associates a function with a given PETSc object.
786
787 Synopsis:
788 #include <petscsys.h>
789 PetscErrorCode PetscObjectComposeFunction(PetscObject obj, const char name[], PetscErrorCodeFn *fptr)
790
791 Logically Collective
792
793 Input Parameters:
794 + obj - the PETSc object; this must be cast with a (`PetscObject`), for example,
795 `PetscObjectCompose`((`PetscObject`)mat,...);
796 . name - name associated with the child function
797 - fptr - function pointer
798
799 Level: advanced
800
801 Notes:
802 When the first argument of `fptr` is (or is derived from) a `PetscObject` then `PetscTryMethod()` and `PetscUseMethod()`
803 can be used to call the function directly with error checking.
804
805 To remove a registered routine, pass in `NULL` for `fptr`.
806
807 `PetscObjectComposeFunction()` can be used with any PETSc object (such as
808 `Mat`, `Vec`, `KSP`, `SNES`, etc.) or any user-provided object.
809
810 `PetscUseTypeMethod()` and `PetscTryTypeMethod()` are used to call a function that is stored in the objects `obj->ops` table.
811
812 .seealso: `PetscObjectQueryFunction()`, `PetscContainerCreate()` `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscTryMethod()`, `PetscUseMethod()`,
813 `PetscUseTypeMethod()`, `PetscTryTypeMethod()`, `PetscObject`
814 M*/
PetscObjectComposeFunction_Private(PetscObject obj,const char name[],PetscErrorCodeFn * fptr)815 PetscErrorCode PetscObjectComposeFunction_Private(PetscObject obj, const char name[], PetscErrorCodeFn *fptr)
816 {
817 PetscFunctionBegin;
818 PetscValidHeader(obj, 1);
819 PetscAssertPointer(name, 2);
820 PetscCall(PetscFunctionListAdd_Private(&obj->qlist, name, fptr));
821 PetscFunctionReturn(PETSC_SUCCESS);
822 }
823
824 /*MC
825 PetscObjectQueryFunction - Gets a function associated with a given object.
826
827 Synopsis:
828 #include <petscsys.h>
829 PetscErrorCode PetscObjectQueryFunction(PetscObject obj, const char name[], PetscErrorCodeFn **fptr)
830
831 Logically Collective
832
833 Input Parameters:
834 + obj - the PETSc object; this must be cast with (`PetscObject`), for example,
835 `PetscObjectQueryFunction`((`PetscObject`)ksp,...);
836 - name - name associated with the child function
837
838 Output Parameter:
839 . fptr - function pointer
840
841 Level: advanced
842
843 .seealso: `PetscObjectComposeFunction()`, `PetscFunctionListFind()`, `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscObject`
844 M*/
PetscObjectQueryFunction_Private(PetscObject obj,const char name[],PetscErrorCodeFn ** fptr)845 PETSC_EXTERN PetscErrorCode PetscObjectQueryFunction_Private(PetscObject obj, const char name[], PetscErrorCodeFn **fptr)
846 {
847 PetscFunctionBegin;
848 PetscValidHeader(obj, 1);
849 PetscAssertPointer(name, 2);
850 PetscCall(PetscFunctionListFind_Private(obj->qlist, name, fptr));
851 PetscFunctionReturn(PETSC_SUCCESS);
852 }
853
854 /*@
855 PetscObjectHasFunction - Query if a function is associated with a given object.
856
857 Logically Collective
858
859 Input Parameters:
860 + obj - the PETSc object
861 - name - name associated with the child function
862
863 Output Parameter:
864 . has - the boolean value
865
866 Level: advanced
867
868 .seealso: `PetscObject`, `PetscObjectComposeFunction()`, `PetscObjectQueryFunction()`
869 @*/
PetscObjectHasFunction(PetscObject obj,const char name[],PetscBool * has)870 PetscErrorCode PetscObjectHasFunction(PetscObject obj, const char name[], PetscBool *has)
871 {
872 PetscErrorCodeFn *fptr = NULL;
873
874 PetscFunctionBegin;
875 PetscAssertPointer(has, 3);
876 PetscCall(PetscObjectQueryFunction(obj, name, &fptr));
877 *has = fptr ? PETSC_TRUE : PETSC_FALSE;
878 PetscFunctionReturn(PETSC_SUCCESS);
879 }
880
881 struct _p_PetscContainer {
882 PETSCHEADER(int);
883 void *ctx;
884 PetscCtxDestroyFn *ctxdestroy;
885 PetscErrorCode (*userdestroy_deprecated)(void *);
886 };
887
888 /*@C
889 PetscContainerGetPointer - Gets the pointer value contained in the container that was provided with `PetscContainerSetPointer()`
890
891 Not Collective, No Fortran Support
892
893 Input Parameter:
894 . obj - the object created with `PetscContainerCreate()`
895
896 Output Parameter:
897 . ptr - the pointer value
898
899 Level: advanced
900
901 .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscObject`,
902 `PetscContainerSetPointer()`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
903 @*/
PetscContainerGetPointer(PetscContainer obj,PetscCtxRt ptr)904 PetscErrorCode PetscContainerGetPointer(PetscContainer obj, PetscCtxRt ptr)
905 {
906 PetscFunctionBegin;
907 PetscValidHeaderSpecific(obj, PETSC_CONTAINER_CLASSID, 1);
908 PetscAssertPointer(ptr, 2);
909 *(void **)ptr = obj->ctx;
910 PetscFunctionReturn(PETSC_SUCCESS);
911 }
912
913 /*@C
914 PetscContainerSetPointer - Sets the pointer value contained in the container.
915
916 Logically Collective, No Fortran Support
917
918 Input Parameters:
919 + obj - the object created with `PetscContainerCreate()`
920 - ptr - the pointer value
921
922 Level: advanced
923
924 .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscObject`,
925 `PetscContainerGetPointer()`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
926 @*/
PetscContainerSetPointer(PetscContainer obj,void * ptr)927 PetscErrorCode PetscContainerSetPointer(PetscContainer obj, void *ptr)
928 {
929 PetscFunctionBegin;
930 PetscValidHeaderSpecific(obj, PETSC_CONTAINER_CLASSID, 1);
931 if (ptr) PetscAssertPointer(ptr, 2);
932 obj->ctx = ptr;
933 PetscFunctionReturn(PETSC_SUCCESS);
934 }
935
936 /*@C
937 PetscContainerDestroy - Destroys a PETSc container object.
938
939 Collective, No Fortran Support
940
941 Input Parameter:
942 . obj - an object that was created with `PetscContainerCreate()`
943
944 Level: advanced
945
946 Note:
947 If `PetscContainerSetCtxDestroy()` was used to provide a user destroy object for the data provided with `PetscContainerSetPointer()`
948 then that function is called to destroy the data.
949
950 .seealso: `PetscContainerCreate()`, `PetscContainerSetCtxDestroy()`, `PetscObject`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
951 @*/
PetscContainerDestroy(PetscContainer * obj)952 PetscErrorCode PetscContainerDestroy(PetscContainer *obj)
953 {
954 PetscFunctionBegin;
955 if (!*obj) PetscFunctionReturn(PETSC_SUCCESS);
956 PetscValidHeaderSpecific(*obj, PETSC_CONTAINER_CLASSID, 1);
957 if (--((PetscObject)*obj)->refct > 0) {
958 *obj = NULL;
959 PetscFunctionReturn(PETSC_SUCCESS);
960 }
961 if ((*obj)->ctxdestroy) PetscCall((*(*obj)->ctxdestroy)(&(*obj)->ctx));
962 else if ((*obj)->userdestroy_deprecated) PetscCall((*(*obj)->userdestroy_deprecated)((*obj)->ctx));
963 PetscCall(PetscHeaderDestroy(obj));
964 PetscFunctionReturn(PETSC_SUCCESS);
965 }
966
967 /*@C
968 PetscContainerSetCtxDestroy - Sets the destroy function for the data provided to the `PetscContainer` with `PetscContainerSetPointer()`
969
970 Logically Collective, No Fortran Support
971
972 Input Parameters:
973 + obj - an object that was created with `PetscContainerCreate()`
974 - des - name of the ctx destroy function, see `PetscCtxDestroyFn` for its calling sequence
975
976 Level: advanced
977
978 Note:
979 Use `PetscCtxDestroyDefault()` if the memory was obtained by calling `PetscMalloc()` or one of its variants for single memory allocation.
980
981 .seealso: `PetscContainerDestroy()`, `PetscContainerUserDestroyDefault()`, `PetscMalloc()`, `PetscMalloc1()`, `PetscCalloc()`, `PetscCalloc1()`, `PetscObject`,
982 `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
983 @*/
PetscContainerSetCtxDestroy(PetscContainer obj,PetscCtxDestroyFn * des)984 PetscErrorCode PetscContainerSetCtxDestroy(PetscContainer obj, PetscCtxDestroyFn *des)
985 {
986 PetscFunctionBegin;
987 PetscValidHeaderSpecific(obj, PETSC_CONTAINER_CLASSID, 1);
988 obj->ctxdestroy = des;
989 PetscFunctionReturn(PETSC_SUCCESS);
990 }
991
992 /*@C
993 PetscContainerSetUserDestroy - Sets the destroy function for the data provided to the `PetscContainer` with `PetscContainerSetPointer()`
994
995 Logically Collective, No Fortran Support
996
997 Input Parameters:
998 + obj - an object that was created with `PetscContainerCreate()`
999 - des - name of the ctx destroy function
1000
1001 Level: advanced
1002
1003 Notes:
1004 Deprecated, use `PetscContainerSetCtxDestroy()`
1005
1006 .seealso: `PetscContainerSetCtxDestroy()`, `PetscContainerDestroy()`, `PetscContainerUserDestroyDefault()`, `PetscMalloc()`, `PetscMalloc1()`, `PetscCalloc()`, `PetscCalloc1()`, `PetscObject`,
1007 `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
1008 @*/
PetscContainerSetUserDestroy(PetscContainer obj,PetscErrorCode (* des)(void *))1009 PetscErrorCode PetscContainerSetUserDestroy(PetscContainer obj, PetscErrorCode (*des)(void *))
1010 {
1011 PetscFunctionBegin;
1012 PetscValidHeaderSpecific(obj, PETSC_CONTAINER_CLASSID, 1);
1013 obj->userdestroy_deprecated = des;
1014 PetscFunctionReturn(PETSC_SUCCESS);
1015 }
1016
1017 PetscClassId PETSC_CONTAINER_CLASSID;
1018
1019 /*@C
1020 PetscContainerCreate - Creates a PETSc object that has room to hold a single pointer.
1021
1022 Collective, No Fortran Support
1023
1024 Input Parameter:
1025 . comm - MPI communicator that shares the object
1026
1027 Output Parameter:
1028 . container - the container created
1029
1030 Level: advanced
1031
1032 Notes:
1033 This allows one to attach any type of data (accessible through a pointer) with the
1034 `PetscObjectCompose()` function to a `PetscObject`. The data item itself is attached by a
1035 call to `PetscContainerSetPointer()`.
1036
1037 .seealso: `PetscContainerDestroy()`, `PetscContainerSetPointer()`, `PetscContainerGetPointer()`, `PetscObjectCompose()`, `PetscObjectQuery()`,
1038 `PetscContainerSetCtxDestroy()`, `PetscObject`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
1039 @*/
PetscContainerCreate(MPI_Comm comm,PetscContainer * container)1040 PetscErrorCode PetscContainerCreate(MPI_Comm comm, PetscContainer *container)
1041 {
1042 PetscFunctionBegin;
1043 PetscAssertPointer(container, 2);
1044 PetscCall(PetscSysInitializePackage());
1045 PetscCall(PetscHeaderCreate(*container, PETSC_CONTAINER_CLASSID, "PetscContainer", "Container", "Sys", comm, PetscContainerDestroy, NULL));
1046 PetscFunctionReturn(PETSC_SUCCESS);
1047 }
1048
1049 /*@C
1050 PetscObjectContainerCompose - Creates a `PetscContainer`, provides all of its values and composes it with a `PetscObject`
1051
1052 Collective
1053
1054 Input Parameters:
1055 + obj - the `PetscObject`
1056 . name - the name for the composed container
1057 . pointer - the pointer to the data
1058 - destroy - the routine to destroy the container's data, see `PetscCtxDestroyFn` for its calling sequence; use `PetscCtxDestroyDefault()` if a `PetscFree()` frees the data
1059
1060 Level: advanced
1061
1062 Notes:
1063 This allows one to attach any type of data (accessible through a pointer) with the
1064 `PetscObjectCompose()` function to a `PetscObject`. The data item itself is attached by a
1065 call to `PetscContainerSetPointer()`.
1066
1067 .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscContainerSetPointer()`, `PetscContainerGetPointer()`, `PetscObjectCompose()`, `PetscObjectQuery()`,
1068 `PetscContainerSetCtxDestroy()`, `PetscObject`, `PetscObjectContainerQuery()`
1069 @*/
PetscObjectContainerCompose(PetscObject obj,const char * name,void * pointer,PetscCtxDestroyFn * destroy)1070 PetscErrorCode PetscObjectContainerCompose(PetscObject obj, const char *name, void *pointer, PetscCtxDestroyFn *destroy)
1071 {
1072 PetscContainer container;
1073
1074 PetscFunctionBegin;
1075 PetscCall(PetscContainerCreate(PetscObjectComm(obj), &container));
1076 PetscCall(PetscContainerSetPointer(container, pointer));
1077 if (destroy) PetscCall(PetscContainerSetCtxDestroy(container, destroy));
1078 PetscCall(PetscObjectCompose(obj, name, (PetscObject)container));
1079 PetscCall(PetscContainerDestroy(&container));
1080 PetscFunctionReturn(PETSC_SUCCESS);
1081 }
1082
1083 /*@C
1084 PetscObjectContainerQuery - Accesses the pointer in a container composed to a `PetscObject` with `PetscObjectContainerCompose()`
1085
1086 Collective
1087
1088 Input Parameters:
1089 + obj - the `PetscObject`
1090 - name - the name for the composed container
1091
1092 Output Parameter:
1093 . ptr - the pointer to the data
1094
1095 Level: advanced
1096
1097 .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscContainerSetPointer()`, `PetscContainerGetPointer()`, `PetscObjectCompose()`, `PetscObjectQuery()`,
1098 `PetscContainerSetCtxDestroy()`, `PetscObject`, `PetscObjectContainerCompose()`
1099 @*/
PetscObjectContainerQuery(PetscObject obj,const char * name,PetscCtxRt ptr)1100 PetscErrorCode PetscObjectContainerQuery(PetscObject obj, const char *name, PetscCtxRt ptr)
1101 {
1102 PetscContainer container;
1103
1104 PetscFunctionBegin;
1105 PetscCall(PetscObjectQuery(obj, name, (PetscObject *)&container));
1106 if (container) PetscCall(PetscContainerGetPointer(container, ptr));
1107 else *(void **)ptr = NULL;
1108 PetscFunctionReturn(PETSC_SUCCESS);
1109 }
1110
1111 /*@
1112 PetscObjectSetFromOptions - Sets generic parameters from user options.
1113
1114 Collective
1115
1116 Input Parameter:
1117 . obj - the `PetscObject`
1118
1119 Level: beginner
1120
1121 Note:
1122 We have no generic options at present, so this does nothing.
1123
1124 .seealso: `PetscObjectSetOptionsPrefix()`, `PetscObjectGetOptionsPrefix()`, `PetscObject`
1125 @*/
PetscObjectSetFromOptions(PetscObject obj)1126 PetscErrorCode PetscObjectSetFromOptions(PetscObject obj)
1127 {
1128 PetscFunctionBegin;
1129 PetscValidHeader(obj, 1);
1130 PetscFunctionReturn(PETSC_SUCCESS);
1131 }
1132
1133 /*@
1134 PetscObjectSetUp - Sets up the internal data structures for later use of the object
1135
1136 Collective
1137
1138 Input Parameter:
1139 . obj - the `PetscObject`
1140
1141 Level: advanced
1142
1143 Note:
1144 This does nothing at present.
1145
1146 .seealso: `PetscObjectDestroy()`, `PetscObject`
1147 @*/
PetscObjectSetUp(PetscObject obj)1148 PetscErrorCode PetscObjectSetUp(PetscObject obj)
1149 {
1150 PetscFunctionBegin;
1151 PetscValidHeader(obj, 1);
1152 PetscFunctionReturn(PETSC_SUCCESS);
1153 }
1154
1155 /*MC
1156 PetscObjectIsNull - returns true if the given PETSc object is a null object
1157
1158 Fortran only
1159
1160 Synopsis:
1161 #include <petsc/finclude/petscsys.h>
1162 PetscBool PetscObjectIsNull(PetscObject obj)
1163
1164 Logically Collective
1165
1166 Input Parameter:
1167 . obj - the PETSc object
1168
1169 Level: beginner
1170
1171 Example Usage:
1172 .vb
1173 if (PetscObjectIsNull(dm)) then
1174 if (.not. PetscObjectIsNull(dm)) then
1175 .ve
1176
1177 Note:
1178 Code such as
1179 .vb
1180 if (dm == PETSC_NULL_DM) then
1181 .ve
1182 is not allowed.
1183
1184 .seealso: `PetscObject`, `PETSC_NULL_OBJECT`, `PETSC_NULL_VEC`, `PETSC_NULL_VEC_ARRAY`, `PetscObjectNullify()`
1185 M*/
1186
1187 /*MC
1188 PetscObjectNullify - sets a PETSc object, such as `Vec`, back to the state it had when it was declared, so it
1189 can be used in a creation routine, such as `VecCreate()`
1190
1191 Fortran only
1192
1193 Synopsis:
1194 #include <petsc/finclude/petscsys.h>
1195 PetscObjectNullify(PetscObject obj)
1196
1197 Logically Collective
1198
1199 Input Parameter:
1200 . obj - the PETSc object
1201
1202 Level: beginner
1203
1204 Example Usage:
1205 .vb
1206 Vec x, y
1207
1208 VecCreate(PETSC_COMM_WORLD, x, ierr)
1209 ...
1210 y = x
1211 ...
1212 PetscObjectNullify(y)
1213 .ve
1214 You should not call `VecDestroy()` on `y` because that will destroy `x` since the assignment `y = x` does
1215 not increase the reference count of `x`
1216
1217 Note:
1218 Code such as
1219 .vb
1220 y = PETSC_NULL_VEC
1221 .ve
1222 is not allowed.
1223
1224 .seealso: `PetscObject`, `PETSC_NULL_OBJECT`, `PETSC_NULL_VEC`, `PETSC_NULL_VEC_ARRAY`, `PetscObjectIsNull()`
1225 M*/
1226
1227 /*MC
1228 PetscObjectCast - Casts a `PetscObject` to the base `PetscObject` type in function calls
1229
1230 Fortran only
1231
1232 Synopsis:
1233 use petscsys
1234
1235 Level: beginner
1236
1237 Example Usage:
1238 PetscFE fe
1239 .vb
1240 PetscCallA(DMAddField(dm, 0, PetscObjectCast(fe),ierr)
1241 .ve
1242
1243 .seealso: `PetscObject`, `PetscObjectSpecificCast()`
1244 M*/
1245
1246 /*MC
1247 PetscObjectSpecificCast - Casts a `PetscObject` to any specific `PetscObject`
1248
1249 Fortran only
1250
1251 Synopsis:
1252 use petscsys
1253
1254 Level: beginner
1255
1256 Example Usage:
1257 PetscObject obj
1258 PetscFE fe
1259 .vb
1260 PetscCallA(PetscDSGetDiscretization(ds, 0, obj, ierr)
1261 PetscObjectSpecificCast(fe,obj)
1262 .ve
1263
1264 .seealso: `PetscObject`, `PetscObjectCast()`
1265 M*/
1266
1267 /*MC
1268 PetscEnumCase - `case()` statement for a PETSc enum variable or value
1269
1270 Fortran only
1271
1272 Synopsis:
1273 #include <petsc/finclude/petscsys.h>
1274 PetscEnumCase(PetscObject enm)
1275
1276 Input Parameters:
1277 . enum - the PETSc enum value or variable
1278
1279 Level: beginner
1280
1281 Example Usage:
1282 .vb
1283 DMPolytopeType cellType
1284 select PetscEnumCase(cellType)
1285 PetscEnumCase(DM_POLYTOPE_TRIANGLE)
1286 write(*,*) 'cell is a triangle'
1287 PetscEnumCase(DM_POLYTOPE_TETRAHEDRON)
1288 write(*,*) 'cell is a tetrahedron'
1289 case default
1290 write(*,*) 'cell is a something else'
1291 end select
1292 .ve
1293 is equivalent to
1294 .vb
1295 DMPolytopeType cellType
1296 select case(cellType%v)
1297 case(DM_POLYTOPE_TRIANGLE%v)
1298 write(*,*) 'cell is a triangle'
1299 case(DM_POLYTOPE_TETRAHEDRON%v)
1300 write(*,*) 'cell is a tetrahedron'
1301 case default
1302 write(*,*) 'cell is a something else'
1303 end select
1304 .ve
1305
1306 .seealso: `PetscObject`
1307 M*/
1308