Actual source code: inherit.c

  1: /*
  2:      Provides utility routines for manipulating any type of PETSc object.
  3: */
  4: #include <petsc/private/petscimpl.h>
  5: #include <petscviewer.h>

  7: PETSC_INTERN PetscObject *PetscObjects;
  8: PETSC_INTERN PetscInt     PetscObjectsCounts;
  9: PETSC_INTERN PetscInt     PetscObjectsMaxCounts;
 10: PETSC_INTERN PetscBool    PetscObjectsLog;

 12: PetscObject *PetscObjects       = NULL;
 13: PetscInt     PetscObjectsCounts = 0, PetscObjectsMaxCounts = 0;
 14: PetscBool    PetscObjectsLog = PETSC_FALSE;

 16: PetscObjectId PetscObjectNewId_Internal(void)
 17: {
 18:   static PetscObjectId idcnt = 1;
 19:   return idcnt++;
 20: }

 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: }

 31: /*
 32:    PetscHeaderCreate_Private - Fills in the default values.
 33: */
 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 flg;

 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;

 51:   PetscCall(PetscCommDuplicate(comm, &h->comm, &h->tag));

 53:   /* Increment and store current object creation index */
 54:   PetscCallMPI(MPI_Comm_get_attr(h->comm, Petsc_CreationIdx_keyval, &get_tmp, &flg));
 55:   PetscCheck(flg, h->comm, PETSC_ERR_ARG_CORRUPT, "MPI_Comm does not have an object creation index");
 56:   cidx    = (PetscInt64 *)get_tmp;
 57:   h->cidx = (*cidx)++;

 59:   /* Keep a record of object created */
 60:   if (PetscDefined(USE_LOG) && PetscObjectsLog) {
 61:     PetscObject *newPetscObjects;
 62:     PetscInt     newPetscObjectsMaxCounts;

 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));

 78:     PetscObjects                        = newPetscObjects;
 79:     PetscObjects[PetscObjectsMaxCounts] = h;
 80:     PetscObjectsMaxCounts               = newPetscObjectsMaxCounts;
 81:   }
 82:   PetscFunctionReturn(PETSC_SUCCESS);
 83: }

 85: PETSC_INTERN PetscBool      PetscMemoryCollectMaximumUsage;
 86: PETSC_INTERN PetscLogDouble PetscMemoryMaximumUsage;

 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: }

 97: /*
 98:     PetscHeaderDestroy_Private - Destroys a base PETSc object header. Called by
 99:     the macro PetscHeaderDestroy().
100: */
101: PetscErrorCode PetscHeaderDestroy_Private(PetscObject obj, PetscBool clear_for_reuse)
102: {
103:   PetscFunctionBegin;
105:   PetscCall(PetscComposedQuantitiesDestroy(obj));
106:   if (PetscMemoryCollectMaximumUsage) {
107:     PetscLogDouble usage;

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;

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));

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));

131:   if (clear_for_reuse) {
132:     /* we will assume that obj->bops->view and destroy are safe to leave as-is */

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;

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: }

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:

181:   - classid
182:   - bops->view
183:   - bops->destroy
184:   - comm
185:   - tag
186:   - class_name
187:   - description
188:   - mansec
189:   - cpp

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: */
195: PetscErrorCode PetscHeaderReset_Internal(PetscObject obj)
196: {
197:   PetscFunctionBegin;
198:   PetscCall(PetscHeaderDestroy_Private(obj, PETSC_TRUE));
199:   PetscFunctionReturn(PETSC_SUCCESS);
200: }

202: /*@
203:   PetscObjectCopyFortranFunctionPointers - Copy function pointers to another object

205:   Logically Collective

207:   Input Parameters:
208: + src  - source object
209: - dest - destination object

211:   Level: developer

213:   Note:
214:   Both objects must have the same class.

216:   This is used to help manage user callback functions that were provided in Fortran

218: .seealso: `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
219: @*/
220: PetscErrorCode PetscObjectCopyFortranFunctionPointers(PetscObject src, PetscObject dest)
221: {
222:   PetscFortranCallbackId cbtype, numcb[PETSC_FORTRAN_CALLBACK_MAXTYPE];

224:   PetscFunctionBegin;
227:   PetscCheck(src->classid == dest->classid, src->comm, PETSC_ERR_ARG_INCOMP, "Objects must be of the same class");

229:   PetscCall(PetscFree(dest->fortran_func_pointers));
230:   PetscCall(PetscMalloc(src->num_fortran_func_pointers * sizeof(void (*)(void)), &dest->fortran_func_pointers));
231:   PetscCall(PetscMemcpy(dest->fortran_func_pointers, src->fortran_func_pointers, src->num_fortran_func_pointers * sizeof(void (*)(void))));

233:   dest->num_fortran_func_pointers = src->num_fortran_func_pointers;

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(PetscMemcpy(dest->fortrancallback[cbtype], src->fortrancallback[cbtype], src->num_fortrancallback[cbtype] * sizeof(PetscFortranCallback)));
240:     dest->num_fortrancallback[cbtype] = src->num_fortrancallback[cbtype];
241:   }
242:   PetscFunctionReturn(PETSC_SUCCESS);
243: }

245: /*@C
246:   PetscObjectSetFortranCallback - set Fortran callback function pointer and context

248:   Logically Collective, No Fortran Support

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

257:   Level: developer

259:   Note:
260:   This is used to help manage user callback functions that were provided in Fortran

262: .seealso: `PetscObjectGetFortranCallback()`, `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
263: @*/
264: PetscErrorCode PetscObjectSetFortranCallback(PetscObject obj, PetscFortranCallbackType cbtype, PetscFortranCallbackId *cid, void (*func)(void), void *ctx)
265: {
266:   const char *subtype = NULL;

268:   PetscFunctionBegin;
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(PetscMemcpy(callback, obj->fortrancallback[cbtype], oldnum * sizeof(*obj->fortrancallback[cbtype])));
278:     PetscCall(PetscFree(obj->fortrancallback[cbtype]));

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: }

288: /*@C
289:   PetscObjectGetFortranCallback - get Fortran callback function pointer and context

291:   Logically Collective, No Fortran Support

293:   Input Parameters:
294: + obj    - object on which to get callback
295: . cbtype - callback type
296: - cid    - address of callback Id

298:   Output Parameters:
299: + func - Fortran function (or `NULL` if not needed)
300: - ctx  - Fortran context (or `NULL` if not needed)

302:   Level: developer

304:   Note:
305:   This is used to help manage user callback functions that were provided in Fortran

307: .seealso: `PetscObjectSetFortranCallback()`, `PetscFortranCallbackRegister()`, `PetscFortranCallbackGetSizes()`
308: @*/
309: PetscErrorCode PetscObjectGetFortranCallback(PetscObject obj, PetscFortranCallbackType cbtype, PetscFortranCallbackId cid, void (**func)(void), void **ctx)
310: {
311:   PetscFortranCallback *cb;

313:   PetscFunctionBegin;
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: }

323: #if defined(PETSC_USE_LOG)
324: /*@C
325:   PetscObjectsDump - Prints all the currently existing objects.

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

331:   Options Database Key:
332: . -objects_dump <all> - print information about all the objects that exist at the end of the programs run

334:   Level: advanced

336:   Note:
337:   Only MPI rank 0 of `PETSC_COMM_WORLD` prints the values

339: .seealso: `PetscObject`
340: @*/
341: PetscErrorCode PetscObjectsDump(FILE *fd, PetscBool all)
342: {
343:   PetscInt    i, j, k = 0;
344:   PetscObject h;

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;

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:           }

372:           PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "[%d] %s %s %s\n", PetscGlobalRank, h->class_name, h->type_name, h->name));

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: }

385: /*@
386:   PetscObjectsView - Prints the currently existing objects.

388:   Logically Collective

390:   Input Parameter:
391: . viewer - must be an `PETSCVIEWERASCII` viewer

393:   Level: advanced

395: .seealso: `PetscObject`
396: @*/
397: PetscErrorCode PetscObjectsView(PetscViewer viewer)
398: {
399:   PetscBool isascii;
400:   FILE     *fd;

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: }

411: /*@
412:   PetscObjectsGetObject - Get a pointer to a named object

414:   Not Collective

416:   Input Parameter:
417: . name - the name of an object

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

423:   Level: advanced

425: .seealso: `PetscObject`
426: @*/
427: PetscErrorCode PetscObjectsGetObject(const char name[], PetscObject *obj, const char *classname[])
428: {
429:   PetscInt    i;
430:   PetscObject h;
431:   PetscBool   flg;

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
450: PetscErrorCode PetscObjectsView(PetscViewer viewer)
451: {
452:   PetscFunctionReturn(PETSC_SUCCESS);
453: }

455: PetscErrorCode PetscObjectsGetObject(const char name[], PetscObject *obj, const char *classname[])
456: {
457:   PetscFunctionReturn(PETSC_SUCCESS);
458: }
459: #endif

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

464:   Input Parameter:
465: . obj - the `PetscObject`

467:   Level: developer

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

473: .seealso: `PetscOptionsInsert()`, `PetscObject`
474: @*/
475: PetscErrorCode PetscObjectSetPrintedOptions(PetscObject obj)
476: {
477:   PetscFunctionBegin;
478:   PetscAssertPointer(obj, 1);
479:   obj->optionsprinted = PETSC_TRUE;
480:   PetscFunctionReturn(PETSC_SUCCESS);
481: }

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.

486:   Input Parameters:
487: + pobj - the parent object
488: - obj  - the `PetscObject`

490:   Level: developer

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

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

498: .seealso: `PetscOptionsInsert()`, `PetscObjectSetPrintedOptions()`, `PetscObject`
499: @*/
500: PetscErrorCode PetscObjectInheritPrintedOptions(PetscObject pobj, PetscObject obj)
501: {
502:   PetscMPIInt prank, size;

504:   PetscFunctionBegin;
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: }

513: /*@C
514:   PetscObjectAddOptionsHandler - Adds an additional function to check for options when `XXXSetFromOptions()` is called.

516:   Not Collective

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

524:   Calling sequence of `handle`:
525: + obj                - the PETSc object
526: . PetscOptionsObject - the `PetscOptionItems` object
527: - ctx                - optional context for `handle`

529:   Calling sequence of `destroy`:
530: + obj - the PETSc object
531: - ctx - optional context for `handle`

533:   Level: developer

535: .seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectProcessOptionsHandlers()`, `PetscObjectDestroyOptionsHandlers()`,
536:           `PetscObject`
537: @*/
538: PetscErrorCode PetscObjectAddOptionsHandler(PetscObject obj, PetscErrorCode (*handle)(PetscObject obj, PetscOptionItems *PetscOptionsObject, void *ctx), PetscErrorCode (*destroy)(PetscObject obj, void *ctx), void *ctx)
539: {
540:   PetscFunctionBegin;
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: }

553: /*@C
554:   PetscObjectProcessOptionsHandlers - Calls all the options handlers attached to an object

556:   Not Collective

558:   Input Parameters:
559: + obj                - the PETSc object
560: - PetscOptionsObject - the options context

562:   Level: developer

564: .seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectAddOptionsHandler()`, `PetscObjectDestroyOptionsHandlers()`,
565:           `PetscObject`
566: @*/
567: PetscErrorCode PetscObjectProcessOptionsHandlers(PetscObject obj, PetscOptionItems *PetscOptionsObject)
568: {
569:   PetscFunctionBegin;
571:   for (PetscInt i = 0; i < obj->noptionhandler; i++) PetscCall((*obj->optionhandler[i])(obj, PetscOptionsObject, obj->optionctx[i]));
572:   PetscFunctionReturn(PETSC_SUCCESS);
573: }

575: /*@
576:   PetscObjectDestroyOptionsHandlers - Destroys all the option handlers attached to an object

578:   Not Collective

580:   Input Parameter:
581: . obj - the PETSc object

583:   Level: developer

585: .seealso: `KSPSetFromOptions()`, `PCSetFromOptions()`, `SNESSetFromOptions()`, `PetscObjectAddOptionsHandler()`, `PetscObjectProcessOptionsHandlers()`,
586:           `PetscObject`
587: @*/
588: PetscErrorCode PetscObjectDestroyOptionsHandlers(PetscObject obj)
589: {
590:   PetscFunctionBegin;
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: }

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.

604:   Logically Collective

606:   Input Parameter:
607: . obj - the PETSc object. This must be cast with (`PetscObject`), for example, `PetscObjectReference`((`PetscObject`)mat);

609:   Level: advanced

611:   Note:
612:   If `obj` is `NULL` this function returns without doing anything.

614: .seealso: `PetscObjectCompose()`, `PetscObjectDereference()`, `PetscObject`
615: @*/
616: PetscErrorCode PetscObjectReference(PetscObject obj)
617: {
618:   PetscFunctionBegin;
619:   if (!obj) PetscFunctionReturn(PETSC_SUCCESS);
621:   obj->refct++;
622:   PetscFunctionReturn(PETSC_SUCCESS);
623: }

625: /*@
626:   PetscObjectGetReference - Gets the current reference count for a PETSc object.

628:   Not Collective

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`

634:   Output Parameter:
635: . cnt - the reference count

637:   Level: advanced

639: .seealso: `PetscObjectCompose()`, `PetscObjectDereference()`, `PetscObjectReference()`, `PetscObject`
640: @*/
641: PetscErrorCode PetscObjectGetReference(PetscObject obj, PetscInt *cnt)
642: {
643:   PetscFunctionBegin;
645:   PetscAssertPointer(cnt, 2);
646:   *cnt = obj->refct;
647:   PetscFunctionReturn(PETSC_SUCCESS);
648: }

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.

655:   Collective on `obj` if reference reaches 0 otherwise Logically Collective

657:   Input Parameter:
658: . obj - the PETSc object; this must be cast with (`PetscObject`), for example,
659:         `PetscObjectDereference`((`PetscObject`)mat);

661:   Level: advanced

663:   Notes:
664:   `PetscObjectDestroy()` sets the `obj` pointer to `NULL` after the call, this routine does not.

666:   If `obj` is `NULL` this function returns without doing anything.

668: .seealso: `PetscObjectCompose()`, `PetscObjectReference()`, `PetscObjectDestroy()`, `PetscObject`
669: @*/
670: PetscErrorCode PetscObjectDereference(PetscObject obj)
671: {
672:   PetscFunctionBegin;
673:   if (!obj) PetscFunctionReturn(PETSC_SUCCESS);
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: }

680: /*
681:      The following routines are the versions private to the PETSc object
682:      data structures.
683: */
684: PetscErrorCode PetscObjectRemoveReference(PetscObject obj, const char name[])
685: {
686:   PetscFunctionBegin;
688:   PetscCall(PetscObjectListRemoveReference(&obj->olist, name));
689:   PetscFunctionReturn(PETSC_SUCCESS);
690: }

692: /*@
693:   PetscObjectCompose - Associates another PETSc object with a given PETSc object.

695:   Not Collective

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`)

704:   Level: advanced

706:   Notes:
707:   The second objects reference count is automatically increased by one when it is
708:   composed.

710:   Replaces any previous object that had been composed with the same name.

712:   If `ptr` is `NULL` and `name` has previously been composed using an object, then that
713:   entry is removed from `obj`.

715:   `PetscObjectCompose()` can be used with any PETSc object (such as
716:   `Mat`, `Vec`, `KSP`, `SNES`, etc.) or any user-provided object.

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()`

721: .seealso: `PetscObjectQuery()`, `PetscContainerCreate()`, `PetscObjectComposeFunction()`, `PetscObjectQueryFunction()`, `PetscContainer`,
722:           `PetscContainerSetPointer()`, `PetscObject`, `PetscObjectContainerCompose()`
723: @*/
724: PetscErrorCode PetscObjectCompose(PetscObject obj, const char name[], PetscObject ptr)
725: {
726:   PetscFunctionBegin;
728:   PetscAssertPointer(name, 2);
730:   PetscCheck(obj != ptr, PetscObjectComm((PetscObject)obj), PETSC_ERR_SUP, "Cannot compose object with itself");
731:   if (ptr) {
732:     char     *tname;
733:     PetscBool skipreference;

735:     PetscCall(PetscObjectListReverseFind(ptr->olist, obj, &tname, &skipreference));
736:     if (tname) PetscCheck(skipreference, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "An object cannot be composed with an object that was composed with it");
737:   }
738:   PetscCall(PetscObjectListAdd(&obj->olist, name, ptr));
739:   PetscFunctionReturn(PETSC_SUCCESS);
740: }

742: /*@
743:   PetscObjectQuery  - Gets a PETSc object associated with a given object that was composed with `PetscObjectCompose()`

745:   Not Collective

747:   Input Parameters:
748: + obj  - the PETSc object. It must be cast with a (`PetscObject`), for example,
749:          `PetscObjectCompose`((`PetscObject`)mat,...);
750: . name - name associated with child object
751: - ptr  - the other PETSc object associated with the PETSc object, this must be
752:          cast with (`PetscObject`*)

754:   Level: advanced

756:   Note:
757:   The reference count of neither object is increased in this call

759: .seealso: `PetscObjectCompose()`, `PetscObjectComposeFunction()`, `PetscObjectQueryFunction()`, `PetscContainer`
760:           `PetscContainerGetPointer()`, `PetscObject`
761: @*/
762: PetscErrorCode PetscObjectQuery(PetscObject obj, const char name[], PetscObject *ptr)
763: {
764:   PetscFunctionBegin;
766:   PetscAssertPointer(name, 2);
767:   PetscAssertPointer(ptr, 3);
768:   PetscCall(PetscObjectListFind(obj->olist, name, ptr));
769:   PetscFunctionReturn(PETSC_SUCCESS);
770: }

772: /*MC
773:   PetscObjectComposeFunction - Associates a function with a given PETSc object.

775:   Synopsis:
776: #include <petscsys.h>
777:   PetscErrorCode PetscObjectComposeFunction(PetscObject obj, const char name[], void (*fptr)(void))

779:   Logically Collective

781:   Input Parameters:
782: + obj  - the PETSc object; this must be cast with a (`PetscObject`), for example,
783:          `PetscObjectCompose`((`PetscObject`)mat,...);
784: . name - name associated with the child function
785: - fptr - function pointer

787:   Level: advanced

789:   Notes:
790:   When the first argument of `fptr` is (or is derived from) a `PetscObject` then `PetscTryMethod()` and `PetscUseMethod()`
791:   can be used to call the function directly with error checking.

793:   To remove a registered routine, pass in `NULL` for `fptr`.

795:   `PetscObjectComposeFunction()` can be used with any PETSc object (such as
796:   `Mat`, `Vec`, `KSP`, `SNES`, etc.) or any user-provided object.

798:   `PetscUseTypeMethod()` and `PetscTryTypeMethod()` are used to call a function that is stored in the objects `obj->ops` table.

800: .seealso: `PetscObjectQueryFunction()`, `PetscContainerCreate()` `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscTryMethod()`, `PetscUseMethod()`,
801:           `PetscUseTypeMethod()`, `PetscTryTypeMethod()`, `PetscObject`
802: M*/
803: PetscErrorCode PetscObjectComposeFunction_Private(PetscObject obj, const char name[], void (*fptr)(void))
804: {
805:   PetscFunctionBegin;
807:   PetscAssertPointer(name, 2);
808:   PetscCall(PetscFunctionListAdd(&obj->qlist, name, fptr));
809:   PetscFunctionReturn(PETSC_SUCCESS);
810: }

812: /*MC
813:   PetscObjectQueryFunction - Gets a function associated with a given object.

815:   Synopsis:
816: #include <petscsys.h>
817:   PetscErrorCode PetscObjectQueryFunction(PetscObject obj, const char name[], void (**fptr)(void))

819:   Logically Collective

821:   Input Parameters:
822: + obj  - the PETSc object; this must be cast with (`PetscObject`), for example,
823:          `PetscObjectQueryFunction`((`PetscObject`)ksp,...);
824: - name - name associated with the child function

826:   Output Parameter:
827: . fptr - function pointer

829:   Level: advanced

831: .seealso: `PetscObjectComposeFunction()`, `PetscFunctionListFind()`, `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscObject`
832: M*/
833: PETSC_EXTERN PetscErrorCode PetscObjectQueryFunction_Private(PetscObject obj, const char name[], void (**fptr)(void))
834: {
835:   PetscFunctionBegin;
837:   PetscAssertPointer(name, 2);
838:   PetscCall(PetscFunctionListFind(obj->qlist, name, fptr));
839:   PetscFunctionReturn(PETSC_SUCCESS);
840: }

842: struct _p_PetscContainer {
843:   PETSCHEADER(int);
844:   void *ptr;
845:   PetscErrorCode (*userdestroy)(void *);
846: };

848: /*@C
849:   PetscContainerUserDestroyDefault - Default destroy routine for user-provided data that simply calls `PetscFree()` in the data
850:   provided with `PetscContainerSetPointer()`

852:   Logically Collective on the `PetscContainer` containing the user data, No Fortran Support

854:   Input Parameter:
855: . ctx - pointer to user-provided data

857:   Level: advanced

859: .seealso: `PetscContainerDestroy()`, `PetscContainerSetUserDestroy()`, `PetscObject`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
860: @*/
861: PetscErrorCode PetscContainerUserDestroyDefault(void *ctx)
862: {
863:   PetscFunctionBegin;
864:   PetscCall(PetscFree(ctx));
865:   PetscFunctionReturn(PETSC_SUCCESS);
866: }

868: /*@C
869:   PetscContainerGetPointer - Gets the pointer value contained in the container that was provided with `PetscContainerSetPointer()`

871:   Not Collective, No Fortran Support

873:   Input Parameter:
874: . obj - the object created with `PetscContainerCreate()`

876:   Output Parameter:
877: . ptr - the pointer value

879:   Level: advanced

881: .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscObject`,
882:           `PetscContainerSetPointer()`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
883: @*/
884: PetscErrorCode PetscContainerGetPointer(PetscContainer obj, void **ptr)
885: {
886:   PetscFunctionBegin;
888:   PetscAssertPointer(ptr, 2);
889:   *ptr = obj->ptr;
890:   PetscFunctionReturn(PETSC_SUCCESS);
891: }

893: /*@C
894:   PetscContainerSetPointer - Sets the pointer value contained in the container.

896:   Logically Collective, No Fortran Support

898:   Input Parameters:
899: + obj - the object created with `PetscContainerCreate()`
900: - ptr - the pointer value

902:   Level: advanced

904: .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscObjectCompose()`, `PetscObjectQuery()`, `PetscObject`,
905:           `PetscContainerGetPointer()`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
906: @*/
907: PetscErrorCode PetscContainerSetPointer(PetscContainer obj, void *ptr)
908: {
909:   PetscFunctionBegin;
911:   if (ptr) PetscAssertPointer(ptr, 2);
912:   obj->ptr = ptr;
913:   PetscFunctionReturn(PETSC_SUCCESS);
914: }

916: /*@C
917:   PetscContainerDestroy - Destroys a PETSc container object.

919:   Collective, No Fortran Support

921:   Input Parameter:
922: . obj - an object that was created with `PetscContainerCreate()`

924:   Level: advanced

926:   Note:
927:   If `PetscContainerSetUserDestroy()` was used to provide a user destroy object for the data provided with `PetscContainerSetPointer()`
928:   then that function is called to destroy the data.

930: .seealso: `PetscContainerCreate()`, `PetscContainerSetUserDestroy()`, `PetscObject`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
931: @*/
932: PetscErrorCode PetscContainerDestroy(PetscContainer *obj)
933: {
934:   PetscFunctionBegin;
935:   if (!*obj) PetscFunctionReturn(PETSC_SUCCESS);
937:   if (--((PetscObject)*obj)->refct > 0) {
938:     *obj = NULL;
939:     PetscFunctionReturn(PETSC_SUCCESS);
940:   }
941:   if ((*obj)->userdestroy) PetscCall((*(*obj)->userdestroy)((*obj)->ptr));
942:   PetscCall(PetscHeaderDestroy(obj));
943:   PetscFunctionReturn(PETSC_SUCCESS);
944: }

946: /*@C
947:   PetscContainerSetUserDestroy - Sets name of the user destroy function for the data provided to the `PetscContainer` with `PetscContainerSetPointer()`

949:   Logically Collective, No Fortran Support

951:   Input Parameters:
952: + obj - an object that was created with `PetscContainerCreate()`
953: - des - name of the user destroy function

955:   Level: advanced

957:   Note:
958:   Use `PetscContainerUserDestroyDefault()` if the memory was obtained by calling `PetscMalloc()` or one of its variants for single memory allocation.

960: .seealso: `PetscContainerDestroy()`, `PetscContainerUserDestroyDefault()`, `PetscMalloc()`, `PetscMalloc1()`, `PetscCalloc()`, `PetscCalloc1()`, `PetscObject`,
961:           `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
962: @*/
963: PetscErrorCode PetscContainerSetUserDestroy(PetscContainer obj, PetscErrorCode (*des)(void *))
964: {
965:   PetscFunctionBegin;
967:   obj->userdestroy = des;
968:   PetscFunctionReturn(PETSC_SUCCESS);
969: }

971: PetscClassId PETSC_CONTAINER_CLASSID;

973: /*@C
974:   PetscContainerCreate - Creates a PETSc object that has room to hold a single pointer.

976:   Collective, No Fortran Support

978:   Input Parameter:
979: . comm - MPI communicator that shares the object

981:   Output Parameter:
982: . container - the container created

984:   Level: advanced

986:   Notes:
987:   This allows one to attach any type of data (accessible through a pointer) with the
988:   `PetscObjectCompose()` function to a `PetscObject`. The data item itself is attached by a
989:   call to `PetscContainerSetPointer()`.

991: .seealso: `PetscContainerDestroy()`, `PetscContainerSetPointer()`, `PetscContainerGetPointer()`, `PetscObjectCompose()`, `PetscObjectQuery()`,
992:           `PetscContainerSetUserDestroy()`, `PetscObject`, `PetscObjectContainerCompose()`, `PetscObjectContainerQuery()`
993: @*/
994: PetscErrorCode PetscContainerCreate(MPI_Comm comm, PetscContainer *container)
995: {
996:   PetscFunctionBegin;
997:   PetscAssertPointer(container, 2);
998:   PetscCall(PetscSysInitializePackage());
999:   PetscCall(PetscHeaderCreate(*container, PETSC_CONTAINER_CLASSID, "PetscContainer", "Container", "Sys", comm, PetscContainerDestroy, NULL));
1000:   PetscFunctionReturn(PETSC_SUCCESS);
1001: }

1003: /*@C
1004:   PetscObjectContainerCompose - Creates a `PetscContainer`, provides all of its values and composes it with a `PetscObject`

1006:   Collective

1008:   Input Parameters:
1009: + obj     - the `PetscObject`
1010: . name    - the name for the composed container
1011: . pointer - the pointer to the data
1012: - destroy - the routine to destroy the container's data; use `PetscContainerUserDestroyDefault()` if a `PetscFree()` frees the data

1014:   Level: advanced

1016:   Notes:
1017:   This allows one to attach any type of data (accessible through a pointer) with the
1018:   `PetscObjectCompose()` function to a `PetscObject`. The data item itself is attached by a
1019:   call to `PetscContainerSetPointer()`.

1021: .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscContainerSetPointer()`, `PetscContainerGetPointer()`, `PetscObjectCompose()`, `PetscObjectQuery()`,
1022:           `PetscContainerSetUserDestroy()`, `PetscObject`, `PetscObjectContainerQuery()`
1023: @*/
1024: PetscErrorCode PetscObjectContainerCompose(PetscObject obj, const char *name, void *pointer, PetscErrorCode (*destroy)(void *))
1025: {
1026:   PetscContainer container;

1028:   PetscFunctionBegin;
1029:   PetscCall(PetscContainerCreate(PetscObjectComm((PetscObject)obj), &container));
1030:   PetscCall(PetscContainerSetPointer(container, pointer));
1031:   if (destroy) PetscCall(PetscContainerSetUserDestroy(container, destroy));
1032:   PetscCall(PetscObjectCompose(obj, name, (PetscObject)container));
1033:   PetscCall(PetscContainerDestroy(&container));
1034:   PetscFunctionReturn(PETSC_SUCCESS);
1035: }

1037: /*@C
1038:   PetscObjectContainerQuery - Accesses the pointer in a container composed to a `PetscObject` with `PetscObjectContainerCompose()`

1040:   Collective

1042:   Input Parameters:
1043: + obj  - the `PetscObject`
1044: - name - the name for the composed container

1046:   Output Parameter:
1047: . pointer - the pointer to the data

1049:   Level: advanced

1051: .seealso: `PetscContainerCreate()`, `PetscContainerDestroy()`, `PetscContainerSetPointer()`, `PetscContainerGetPointer()`, `PetscObjectCompose()`, `PetscObjectQuery()`,
1052:           `PetscContainerSetUserDestroy()`, `PetscObject`, `PetscObjectContainerCompose()`
1053: @*/
1054: PetscErrorCode PetscObjectContainerQuery(PetscObject obj, const char *name, void **pointer)
1055: {
1056:   PetscContainer container;

1058:   PetscFunctionBegin;
1059:   PetscCall(PetscObjectQuery((PetscObject)obj, name, (PetscObject *)&container));
1060:   if (container) PetscCall(PetscContainerGetPointer(container, pointer));
1061:   else *pointer = NULL;
1062:   PetscFunctionReturn(PETSC_SUCCESS);
1063: }

1065: /*@
1066:   PetscObjectSetFromOptions - Sets generic parameters from user options.

1068:   Collective

1070:   Input Parameter:
1071: . obj - the `PetscObject`

1073:   Level: beginner

1075:   Note:
1076:   We have no generic options at present, so this does nothing.

1078: .seealso: `PetscObjectSetOptionsPrefix()`, `PetscObjectGetOptionsPrefix()`, `PetscObject`
1079: @*/
1080: PetscErrorCode PetscObjectSetFromOptions(PetscObject obj)
1081: {
1082:   PetscFunctionBegin;
1084:   PetscFunctionReturn(PETSC_SUCCESS);
1085: }

1087: /*@
1088:   PetscObjectSetUp - Sets up the internal data structures for later use of the object

1090:   Collective

1092:   Input Parameter:
1093: . obj - the `PetscObject`

1095:   Level: advanced

1097:   Note:
1098:   This does nothing at present.

1100: .seealso: `PetscObjectDestroy()`, `PetscObject`
1101: @*/
1102: PetscErrorCode PetscObjectSetUp(PetscObject obj)
1103: {
1104:   PetscFunctionBegin;
1106:   PetscFunctionReturn(PETSC_SUCCESS);
1107: }

1109: /*MC
1110:   PetscObjectIsNull - returns true if the given PETSc object is a null object

1112:   Fortran only

1114:   Synopsis:
1115: #include <petsc/finclude/petscsys.h>
1116:   PetscBool PetscObjectIsNull(PetscObject obj)

1118:   Logically Collective

1120:   Input Parameters:
1121: . obj  - the PETSc object

1123:   Level: beginner

1125:   Example Usage:
1126: .vb
1127:   if (PetscObjectIsNull(dm)) then
1128:   if (.not. PetscObjectIsNull(dm)) then
1129: .ve

1131:   Note:
1132:   Code such as
1133: .vb
1134:   if (dm == PETSC_NULL_DM) then
1135: .ve
1136:   is not allowed.

1138: .seealso: `PetscObject`, `PETSC_NULL_OBJECT`, `PETSC_NULL_VEC`, `PETSC_NULL_VEC_ARRAY`
1139: M*/