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 #if defined(PETSC_USE_LOG)
8 PETSC_INTERN PetscObject *PetscObjects;
9 PETSC_INTERN PetscInt PetscObjectsCounts;
10 PETSC_INTERN PetscInt PetscObjectsMaxCounts;
11 PETSC_INTERN PetscBool PetscObjectsLog;
12 #endif
13
14 #if defined(PETSC_USE_LOG)
15 PetscObject *PetscObjects = NULL;
16 PetscInt PetscObjectsCounts = 0, PetscObjectsMaxCounts = 0;
17 PetscBool PetscObjectsLog = PETSC_FALSE;
18 #endif
19
20 PETSC_EXTERN PetscErrorCode PetscObjectGetComm_Petsc(PetscObject,MPI_Comm*);
21 PETSC_EXTERN PetscErrorCode PetscObjectCompose_Petsc(PetscObject,const char[],PetscObject);
22 PETSC_EXTERN PetscErrorCode PetscObjectQuery_Petsc(PetscObject,const char[],PetscObject*);
23 PETSC_EXTERN PetscErrorCode PetscObjectComposeFunction_Petsc(PetscObject,const char[],void (*)(void));
24 PETSC_EXTERN PetscErrorCode PetscObjectQueryFunction_Petsc(PetscObject,const char[],void (**)(void));
25
26 /*
27 PetscHeaderCreate_Private - Creates a base PETSc object header and fills
28 in the default values. Called by the macro PetscHeaderCreate().
29 */
PetscHeaderCreate_Private(PetscObject h,PetscClassId classid,const char class_name[],const char descr[],const char mansec[],MPI_Comm comm,PetscObjectDestroyFunction destroy,PetscObjectViewFunction view)30 PetscErrorCode PetscHeaderCreate_Private(PetscObject h,PetscClassId classid,const char class_name[],const char descr[],const char mansec[],
31 MPI_Comm comm,PetscObjectDestroyFunction destroy,PetscObjectViewFunction view)
32 {
33 static PetscInt idcnt = 1;
34 PetscErrorCode ierr;
35 #if defined(PETSC_USE_LOG)
36 PetscObject *newPetscObjects;
37 PetscInt newPetscObjectsMaxCounts,i;
38 #endif
39
40 PetscFunctionBegin;
41 h->classid = classid;
42 h->type = 0;
43 h->class_name = (char*)class_name;
44 h->description = (char*)descr;
45 h->mansec = (char*)mansec;
46 h->prefix = NULL;
47 h->refct = 1;
48 #if defined(PETSC_HAVE_SAWS)
49 h->amsmem = PETSC_FALSE;
50 #endif
51 h->id = idcnt++;
52 h->parentid = 0;
53 h->qlist = NULL;
54 h->olist = NULL;
55 h->bops->destroy = destroy;
56 h->bops->view = view;
57 h->bops->getcomm = PetscObjectGetComm_Petsc;
58 h->bops->compose = PetscObjectCompose_Petsc;
59 h->bops->query = PetscObjectQuery_Petsc;
60 h->bops->composefunction = PetscObjectComposeFunction_Petsc;
61 h->bops->queryfunction = PetscObjectQueryFunction_Petsc;
62
63 ierr = PetscCommDuplicate(comm,&h->comm,&h->tag);CHKERRQ(ierr);
64
65 #if defined(PETSC_USE_LOG)
66 /* Keep a record of object created */
67 if (PetscObjectsLog) {
68 PetscObjectsCounts++;
69 for (i=0; i<PetscObjectsMaxCounts; i++) {
70 if (!PetscObjects[i]) {
71 PetscObjects[i] = h;
72 PetscFunctionReturn(0);
73 }
74 }
75 /* Need to increase the space for storing PETSc objects */
76 if (!PetscObjectsMaxCounts) newPetscObjectsMaxCounts = 100;
77 else newPetscObjectsMaxCounts = 2*PetscObjectsMaxCounts;
78 ierr = PetscCalloc1(newPetscObjectsMaxCounts,&newPetscObjects);CHKERRQ(ierr);
79 ierr = PetscArraycpy(newPetscObjects,PetscObjects,PetscObjectsMaxCounts);CHKERRQ(ierr);
80 ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
81
82 PetscObjects = newPetscObjects;
83 PetscObjects[PetscObjectsMaxCounts] = h;
84 PetscObjectsMaxCounts = newPetscObjectsMaxCounts;
85 }
86 #endif
87 PetscFunctionReturn(0);
88 }
89
90 PETSC_INTERN PetscBool PetscMemoryCollectMaximumUsage;
91 PETSC_INTERN PetscLogDouble PetscMemoryMaximumUsage;
92
93 /*
94 PetscHeaderDestroy_Private - Destroys a base PETSc object header. Called by
95 the macro PetscHeaderDestroy().
96 */
PetscHeaderDestroy_Private(PetscObject h)97 PetscErrorCode PetscHeaderDestroy_Private(PetscObject h)
98 {
99 PetscErrorCode ierr;
100
101 PetscFunctionBegin;
102 PetscValidHeader(h,1);
103 ierr = PetscLogObjectDestroy(h);CHKERRQ(ierr);
104 ierr = PetscComposedQuantitiesDestroy(h);CHKERRQ(ierr);
105 if (PetscMemoryCollectMaximumUsage) {
106 PetscLogDouble usage;
107 ierr = PetscMemoryGetCurrentUsage(&usage);CHKERRQ(ierr);
108 if (usage > PetscMemoryMaximumUsage) PetscMemoryMaximumUsage = usage;
109 }
110 /* first destroy things that could execute arbitrary code */
111 if (h->python_destroy) {
112 void *python_context = h->python_context;
113 PetscErrorCode (*python_destroy)(void*) = h->python_destroy;
114 h->python_context = NULL;
115 h->python_destroy = NULL;
116
117 ierr = (*python_destroy)(python_context);CHKERRQ(ierr);
118 }
119 ierr = PetscObjectDestroyOptionsHandlers(h);CHKERRQ(ierr);
120 ierr = PetscObjectListDestroy(&h->olist);CHKERRQ(ierr);
121 ierr = PetscCommDestroy(&h->comm);CHKERRQ(ierr);
122 /* next destroy other things */
123 h->classid = PETSCFREEDHEADER;
124
125 ierr = PetscFunctionListDestroy(&h->qlist);CHKERRQ(ierr);
126 ierr = PetscFree(h->type_name);CHKERRQ(ierr);
127 ierr = PetscFree(h->name);CHKERRQ(ierr);
128 ierr = PetscFree(h->prefix);CHKERRQ(ierr);
129 ierr = PetscFree(h->fortran_func_pointers);CHKERRQ(ierr);
130 ierr = PetscFree(h->fortrancallback[PETSC_FORTRAN_CALLBACK_CLASS]);CHKERRQ(ierr);
131 ierr = PetscFree(h->fortrancallback[PETSC_FORTRAN_CALLBACK_SUBTYPE]);CHKERRQ(ierr);
132
133 #if defined(PETSC_USE_LOG)
134 if (PetscObjectsLog) {
135 PetscInt i;
136 /* Record object removal from list of all objects */
137 for (i=0; i<PetscObjectsMaxCounts; i++) {
138 if (PetscObjects[i] == h) {
139 PetscObjects[i] = NULL;
140 PetscObjectsCounts--;
141 break;
142 }
143 }
144 if (!PetscObjectsCounts) {
145 ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
146 PetscObjectsMaxCounts = 0;
147 }
148 }
149 #endif
150 PetscFunctionReturn(0);
151 }
152
153 /*@C
154 PetscObjectCopyFortranFunctionPointers - Copy function pointers to another object
155
156 Logically Collective on PetscObject
157
158 Input Parameter:
159 + src - source object
160 - dest - destination object
161
162 Level: developer
163
164 Note:
165 Both objects must have the same class.
166 @*/
PetscObjectCopyFortranFunctionPointers(PetscObject src,PetscObject dest)167 PetscErrorCode PetscObjectCopyFortranFunctionPointers(PetscObject src,PetscObject dest)
168 {
169 PetscErrorCode ierr;
170 PetscInt cbtype,numcb[PETSC_FORTRAN_CALLBACK_MAXTYPE];
171
172 PetscFunctionBegin;
173 PetscValidHeader(src,1);
174 PetscValidHeader(dest,2);
175 if (src->classid != dest->classid) SETERRQ(src->comm,PETSC_ERR_ARG_INCOMP,"Objects must be of the same class");
176
177 ierr = PetscFree(dest->fortran_func_pointers);CHKERRQ(ierr);
178 ierr = PetscMalloc(src->num_fortran_func_pointers*sizeof(void(*)(void)),&dest->fortran_func_pointers);CHKERRQ(ierr);
179 ierr = PetscMemcpy(dest->fortran_func_pointers,src->fortran_func_pointers,src->num_fortran_func_pointers*sizeof(void(*)(void)));CHKERRQ(ierr);
180
181 dest->num_fortran_func_pointers = src->num_fortran_func_pointers;
182
183 ierr = PetscFortranCallbackGetSizes(src->classid,&numcb[PETSC_FORTRAN_CALLBACK_CLASS],&numcb[PETSC_FORTRAN_CALLBACK_SUBTYPE]);CHKERRQ(ierr);
184 for (cbtype=PETSC_FORTRAN_CALLBACK_CLASS; cbtype<PETSC_FORTRAN_CALLBACK_MAXTYPE; cbtype++) {
185 ierr = PetscFree(dest->fortrancallback[cbtype]);CHKERRQ(ierr);
186 ierr = PetscCalloc1(numcb[cbtype],&dest->fortrancallback[cbtype]);CHKERRQ(ierr);
187 ierr = PetscMemcpy(dest->fortrancallback[cbtype],src->fortrancallback[cbtype],src->num_fortrancallback[cbtype]*sizeof(PetscFortranCallback));CHKERRQ(ierr);
188 dest->num_fortrancallback[cbtype] = src->num_fortrancallback[cbtype];
189 }
190 PetscFunctionReturn(0);
191 }
192
193 /*@C
194 PetscObjectSetFortranCallback - set fortran callback function pointer and context
195
196 Logically Collective
197
198 Input Arguments:
199 + obj - object on which to set callback
200 . cbtype - callback type (class or subtype)
201 . cid - address of callback Id, updated if not yet initialized (zero)
202 . func - Fortran function
203 - ctx - Fortran context
204
205 Level: developer
206
207 .seealso: PetscObjectGetFortranCallback()
208 @*/
PetscObjectSetFortranCallback(PetscObject obj,PetscFortranCallbackType cbtype,PetscFortranCallbackId * cid,void (* func)(void),void * ctx)209 PetscErrorCode PetscObjectSetFortranCallback(PetscObject obj,PetscFortranCallbackType cbtype,PetscFortranCallbackId *cid,void (*func)(void),void *ctx)
210 {
211 PetscErrorCode ierr;
212 const char *subtype = NULL;
213
214 PetscFunctionBegin;
215 PetscValidHeader(obj,1);
216 if (cbtype == PETSC_FORTRAN_CALLBACK_SUBTYPE) subtype = obj->type_name;
217 if (!*cid) {ierr = PetscFortranCallbackRegister(obj->classid,subtype,cid);CHKERRQ(ierr);}
218 if (*cid >= PETSC_SMALLEST_FORTRAN_CALLBACK+obj->num_fortrancallback[cbtype]) {
219 PetscInt oldnum = obj->num_fortrancallback[cbtype],newnum = PetscMax(1,2*oldnum);
220 PetscFortranCallback *callback;
221 ierr = PetscMalloc1(newnum,&callback);CHKERRQ(ierr);
222 ierr = PetscMemcpy(callback,obj->fortrancallback[cbtype],oldnum*sizeof(*obj->fortrancallback[cbtype]));CHKERRQ(ierr);
223 ierr = PetscFree(obj->fortrancallback[cbtype]);CHKERRQ(ierr);
224
225 obj->fortrancallback[cbtype] = callback;
226 obj->num_fortrancallback[cbtype] = newnum;
227 }
228 obj->fortrancallback[cbtype][*cid-PETSC_SMALLEST_FORTRAN_CALLBACK].func = func;
229 obj->fortrancallback[cbtype][*cid-PETSC_SMALLEST_FORTRAN_CALLBACK].ctx = ctx;
230 PetscFunctionReturn(0);
231 }
232
233 /*@C
234 PetscObjectGetFortranCallback - get fortran callback function pointer and context
235
236 Logically Collective
237
238 Input Arguments:
239 + obj - object on which to get callback
240 . cbtype - callback type
241 - cid - address of callback Id
242
243 Output Arguments:
244 + func - Fortran function (or NULL if not needed)
245 - ctx - Fortran context (or NULL if not needed)
246
247 Level: developer
248
249 .seealso: PetscObjectSetFortranCallback()
250 @*/
PetscObjectGetFortranCallback(PetscObject obj,PetscFortranCallbackType cbtype,PetscFortranCallbackId cid,void (** func)(void),void ** ctx)251 PetscErrorCode PetscObjectGetFortranCallback(PetscObject obj,PetscFortranCallbackType cbtype,PetscFortranCallbackId cid,void (**func)(void),void **ctx)
252 {
253 PetscFortranCallback *cb;
254
255 PetscFunctionBegin;
256 PetscValidHeader(obj,1);
257 if (PetscUnlikely(cid < PETSC_SMALLEST_FORTRAN_CALLBACK)) SETERRQ(obj->comm,PETSC_ERR_ARG_CORRUPT,"Fortran callback Id invalid");
258 if (PetscUnlikely(cid >= PETSC_SMALLEST_FORTRAN_CALLBACK+obj->num_fortrancallback[cbtype])) SETERRQ(obj->comm,PETSC_ERR_ARG_CORRUPT,"Fortran callback not set on this object");
259 cb = &obj->fortrancallback[cbtype][cid-PETSC_SMALLEST_FORTRAN_CALLBACK];
260 if (func) *func = cb->func;
261 if (ctx) *ctx = cb->ctx;
262 PetscFunctionReturn(0);
263 }
264
265 #if defined(PETSC_USE_LOG)
266 /*@C
267 PetscObjectsDump - Prints the currently existing objects.
268
269 Logically Collective on PetscViewer
270
271 Input Parameter:
272 + fd - file pointer
273 - all - by default only tries to display objects created explicitly by the user, if all is PETSC_TRUE then lists all outstanding objects
274
275 Options Database:
276 . -objects_dump <all>
277
278 Level: advanced
279
280 @*/
PetscObjectsDump(FILE * fd,PetscBool all)281 PetscErrorCode PetscObjectsDump(FILE *fd,PetscBool all)
282 {
283 PetscErrorCode ierr;
284 PetscInt i;
285 #if defined(PETSC_USE_DEBUG)
286 PetscInt j,k=0;
287 #endif
288 PetscObject h;
289
290 PetscFunctionBegin;
291 if (PetscObjectsCounts) {
292 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"The following objects were never freed\n");CHKERRQ(ierr);
293 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"-----------------------------------------\n");CHKERRQ(ierr);
294 for (i=0; i<PetscObjectsMaxCounts; i++) {
295 if ((h = PetscObjects[i])) {
296 ierr = PetscObjectName(h);CHKERRQ(ierr);
297 {
298 #if defined(PETSC_USE_DEBUG)
299 PetscStack *stack = NULL;
300 char *create,*rclass;
301
302 /* if the PETSc function the user calls is not a create then this object was NOT directly created by them */
303 ierr = PetscMallocGetStack(h,&stack);CHKERRQ(ierr);
304 if (stack) {
305 k = stack->currentsize-2;
306 if (!all) {
307 k = 0;
308 while (!stack->petscroutine[k]) k++;
309 ierr = PetscStrstr(stack->function[k],"Create",&create);CHKERRQ(ierr);
310 if (!create) {
311 ierr = PetscStrstr(stack->function[k],"Get",&create);CHKERRQ(ierr);
312 }
313 ierr = PetscStrstr(stack->function[k],h->class_name,&rclass);CHKERRQ(ierr);
314 if (!create) continue;
315 if (!rclass) continue;
316 }
317 }
318 #endif
319
320 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"[%d] %s %s %s\n",PetscGlobalRank,h->class_name,h->type_name,h->name);CHKERRQ(ierr);
321
322 #if defined(PETSC_USE_DEBUG)
323 ierr = PetscMallocGetStack(h,&stack);CHKERRQ(ierr);
324 if (stack) {
325 for (j=k; j>=0; j--) {
326 fprintf(fd," [%d] %s() in %s\n",PetscGlobalRank,stack->function[j],stack->file[j]);
327 }
328 }
329 #endif
330 }
331 }
332 }
333 }
334 PetscFunctionReturn(0);
335 }
336 #endif
337
338 #if defined(PETSC_USE_LOG)
339
340 /*@C
341 PetscObjectsView - Prints the currently existing objects.
342
343 Logically Collective on PetscViewer
344
345 Input Parameter:
346 . viewer - must be an PETSCVIEWERASCII viewer
347
348 Level: advanced
349
350 @*/
PetscObjectsView(PetscViewer viewer)351 PetscErrorCode PetscObjectsView(PetscViewer viewer)
352 {
353 PetscErrorCode ierr;
354 PetscBool isascii;
355 FILE *fd;
356
357 PetscFunctionBegin;
358 if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
359 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&isascii);CHKERRQ(ierr);
360 if (!isascii) SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"Only supports ASCII viewer");
361 ierr = PetscViewerASCIIGetPointer(viewer,&fd);CHKERRQ(ierr);
362 ierr = PetscObjectsDump(fd,PETSC_TRUE);CHKERRQ(ierr);
363 PetscFunctionReturn(0);
364 }
365
366 /*@C
367 PetscObjectsGetObject - Get a pointer to a named object
368
369 Not collective
370
371 Input Parameter:
372 . name - the name of an object
373
374 Output Parameter:
375 . obj - the object or null if there is no object
376
377 Level: advanced
378
379 @*/
PetscObjectsGetObject(const char * name,PetscObject * obj,char ** classname)380 PetscErrorCode PetscObjectsGetObject(const char *name,PetscObject *obj,char **classname)
381 {
382 PetscErrorCode ierr;
383 PetscInt i;
384 PetscObject h;
385 PetscBool flg;
386
387 PetscFunctionBegin;
388 *obj = NULL;
389 for (i=0; i<PetscObjectsMaxCounts; i++) {
390 if ((h = PetscObjects[i])) {
391 ierr = PetscObjectName(h);CHKERRQ(ierr);
392 ierr = PetscStrcmp(h->name,name,&flg);CHKERRQ(ierr);
393 if (flg) {
394 *obj = h;
395 if (classname) *classname = h->class_name;
396 PetscFunctionReturn(0);
397 }
398 }
399 }
400 PetscFunctionReturn(0);
401 }
402 #endif
403
404 /*@
405 PetscObjectSetPrintedOptions - indicate to an object that it should behave as if it has already printed the help for its options
406
407 Input Parameters:
408 . obj - the PetscObject
409
410 Level: developer
411
412 Developer Notes:
413 This is used, for example to prevent sequential objects that are created from a parallel object; such as the KSP created by
414 PCBJACOBI from all printing the same help messages to the screen
415
416 .seealso: PetscOptionsInsert()
417 @*/
PetscObjectSetPrintedOptions(PetscObject obj)418 PetscErrorCode PetscObjectSetPrintedOptions(PetscObject obj)
419 {
420 PetscFunctionBegin;
421 obj->optionsprinted = PETSC_TRUE;
422 PetscFunctionReturn(0);
423 }
424
425 /*@
426 PetscObjectInheritPrintedOptions - If the child object is not on the rank 0 process of the parent object and the child is sequential then the child gets it set.
427
428 Input Parameters:
429 + pobj - the parent object
430 - obj - the PetscObject
431
432 Level: developer
433
434 Developer Notes:
435 This is used, for example to prevent sequential objects that are created from a parallel object; such as the KSP created by
436 PCBJACOBI from all printing the same help messages to the screen
437
438 This will not handle more complicated situations like with GASM where children may live on any subset of the parent's processes and overlap
439
440 .seealso: PetscOptionsInsert(), PetscObjectSetPrintedOptions()
441 @*/
PetscObjectInheritPrintedOptions(PetscObject pobj,PetscObject obj)442 PetscErrorCode PetscObjectInheritPrintedOptions(PetscObject pobj,PetscObject obj)
443 {
444 PetscErrorCode ierr;
445 PetscMPIInt prank,size;
446
447 PetscFunctionBegin;
448 ierr = MPI_Comm_rank(pobj->comm,&prank);CHKERRQ(ierr);
449 ierr = MPI_Comm_size(obj->comm,&size);CHKERRQ(ierr);
450 if (size == 1 && prank > 0) obj->optionsprinted = PETSC_TRUE;
451 PetscFunctionReturn(0);
452 }
453
454 /*@C
455 PetscObjectAddOptionsHandler - Adds an additional function to check for options when XXXSetFromOptions() is called.
456
457 Not Collective
458
459 Input Parameter:
460 + obj - the PETSc object
461 . handle - function that checks for options
462 . destroy - function to destroy context if provided
463 - ctx - optional context for check function
464
465 Level: developer
466
467
468 .seealso: KSPSetFromOptions(), PCSetFromOptions(), SNESSetFromOptions(), PetscObjectProcessOptionsHandlers(), PetscObjectDestroyOptionsHandlers()
469
470 @*/
PetscObjectAddOptionsHandler(PetscObject obj,PetscErrorCode (* handle)(PetscOptionItems *,PetscObject,void *),PetscErrorCode (* destroy)(PetscObject,void *),void * ctx)471 PetscErrorCode PetscObjectAddOptionsHandler(PetscObject obj,PetscErrorCode (*handle)(PetscOptionItems*,PetscObject,void*),PetscErrorCode (*destroy)(PetscObject,void*),void *ctx)
472 {
473 PetscFunctionBegin;
474 PetscValidHeader(obj,1);
475 if (obj->noptionhandler >= PETSC_MAX_OPTIONS_HANDLER) SETERRQ(obj->comm,PETSC_ERR_ARG_OUTOFRANGE,"To many options handlers added");
476 obj->optionhandler[obj->noptionhandler] = handle;
477 obj->optiondestroy[obj->noptionhandler] = destroy;
478 obj->optionctx[obj->noptionhandler++] = ctx;
479 PetscFunctionReturn(0);
480 }
481
482 /*@C
483 PetscObjectProcessOptionsHandlers - Calls all the options handlers attached to an object
484
485 Not Collective
486
487 Input Parameter:
488 . obj - the PETSc object
489
490 Level: developer
491
492
493 .seealso: KSPSetFromOptions(), PCSetFromOptions(), SNESSetFromOptions(), PetscObjectAddOptionsHandler(), PetscObjectDestroyOptionsHandlers()
494
495 @*/
PetscObjectProcessOptionsHandlers(PetscOptionItems * PetscOptionsObject,PetscObject obj)496 PetscErrorCode PetscObjectProcessOptionsHandlers(PetscOptionItems *PetscOptionsObject,PetscObject obj)
497 {
498 PetscInt i;
499 PetscErrorCode ierr;
500
501 PetscFunctionBegin;
502 PetscValidHeader(obj,1);
503 for (i=0; i<obj->noptionhandler; i++) {
504 ierr = (*obj->optionhandler[i])(PetscOptionsObject,obj,obj->optionctx[i]);CHKERRQ(ierr);
505 }
506 PetscFunctionReturn(0);
507 }
508
509 /*@C
510 PetscObjectDestroyOptionsHandlers - Destroys all the option handlers attached to an object
511
512 Not Collective
513
514 Input Parameter:
515 . obj - the PETSc object
516
517 Level: developer
518
519
520 .seealso: KSPSetFromOptions(), PCSetFromOptions(), SNESSetFromOptions(), PetscObjectAddOptionsHandler(), PetscObjectProcessOptionsHandlers()
521
522 @*/
PetscObjectDestroyOptionsHandlers(PetscObject obj)523 PetscErrorCode PetscObjectDestroyOptionsHandlers(PetscObject obj)
524 {
525 PetscInt i;
526 PetscErrorCode ierr;
527
528 PetscFunctionBegin;
529 PetscValidHeader(obj,1);
530 for (i=0; i<obj->noptionhandler; i++) {
531 if (obj->optiondestroy[i]) {
532 ierr = (*obj->optiondestroy[i])(obj,obj->optionctx[i]);CHKERRQ(ierr);
533 }
534 }
535 obj->noptionhandler = 0;
536 PetscFunctionReturn(0);
537 }
538
539
540 /*@C
541 PetscObjectReference - Indicates to any PetscObject that it is being
542 referenced by another PetscObject. This increases the reference
543 count for that object by one.
544
545 Logically Collective on PetscObject
546
547 Input Parameter:
548 . obj - the PETSc object. This must be cast with (PetscObject), for example,
549 PetscObjectReference((PetscObject)mat);
550
551 Level: advanced
552
553 .seealso: PetscObjectCompose(), PetscObjectDereference()
554 @*/
PetscObjectReference(PetscObject obj)555 PetscErrorCode PetscObjectReference(PetscObject obj)
556 {
557 PetscFunctionBegin;
558 if (!obj) PetscFunctionReturn(0);
559 PetscValidHeader(obj,1);
560 obj->refct++;
561 PetscFunctionReturn(0);
562 }
563
564 /*@C
565 PetscObjectGetReference - Gets the current reference count for
566 any PETSc object.
567
568 Not Collective
569
570 Input Parameter:
571 . obj - the PETSc object; this must be cast with (PetscObject), for example,
572 PetscObjectGetReference((PetscObject)mat,&cnt);
573
574 Output Parameter:
575 . cnt - the reference count
576
577 Level: advanced
578
579 .seealso: PetscObjectCompose(), PetscObjectDereference(), PetscObjectReference()
580 @*/
PetscObjectGetReference(PetscObject obj,PetscInt * cnt)581 PetscErrorCode PetscObjectGetReference(PetscObject obj,PetscInt *cnt)
582 {
583 PetscFunctionBegin;
584 PetscValidHeader(obj,1);
585 PetscValidIntPointer(cnt,2);
586 *cnt = obj->refct;
587 PetscFunctionReturn(0);
588 }
589
590 /*@C
591 PetscObjectDereference - Indicates to any PetscObject that it is being
592 referenced by one less PetscObject. This decreases the reference
593 count for that object by one.
594
595 Collective on PetscObject if reference reaches 0 otherwise Logically Collective
596
597 Input Parameter:
598 . obj - the PETSc object; this must be cast with (PetscObject), for example,
599 PetscObjectDereference((PetscObject)mat);
600
601 Notes:
602 PetscObjectDestroy(PetscObject *obj) sets the obj pointer to null after the call, this routine does not.
603
604 Level: advanced
605
606 .seealso: PetscObjectCompose(), PetscObjectReference()
607 @*/
PetscObjectDereference(PetscObject obj)608 PetscErrorCode PetscObjectDereference(PetscObject obj)
609 {
610 PetscErrorCode ierr;
611
612 PetscFunctionBegin;
613 if (!obj) PetscFunctionReturn(0);
614 PetscValidHeader(obj,1);
615 if (obj->bops->destroy) {
616 ierr = (*obj->bops->destroy)(&obj);CHKERRQ(ierr);
617 } else if (!--obj->refct) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"This PETSc object does not have a generic destroy routine");
618 PetscFunctionReturn(0);
619 }
620
621 /* ----------------------------------------------------------------------- */
622 /*
623 The following routines are the versions private to the PETSc object
624 data structures.
625 */
PetscObjectGetComm_Petsc(PetscObject obj,MPI_Comm * comm)626 PetscErrorCode PetscObjectGetComm_Petsc(PetscObject obj,MPI_Comm *comm)
627 {
628 PetscFunctionBegin;
629 PetscValidHeader(obj,1);
630 *comm = obj->comm;
631 PetscFunctionReturn(0);
632 }
633
PetscObjectRemoveReference(PetscObject obj,const char name[])634 PetscErrorCode PetscObjectRemoveReference(PetscObject obj,const char name[])
635 {
636 PetscErrorCode ierr;
637
638 PetscFunctionBegin;
639 PetscValidHeader(obj,1);
640 ierr = PetscObjectListRemoveReference(&obj->olist,name);CHKERRQ(ierr);
641 PetscFunctionReturn(0);
642 }
643
PetscObjectCompose_Petsc(PetscObject obj,const char name[],PetscObject ptr)644 PetscErrorCode PetscObjectCompose_Petsc(PetscObject obj,const char name[],PetscObject ptr)
645 {
646 PetscErrorCode ierr;
647 char *tname;
648 PetscBool skipreference;
649
650 PetscFunctionBegin;
651 if (ptr) {
652 ierr = PetscObjectListReverseFind(ptr->olist,obj,&tname,&skipreference);CHKERRQ(ierr);
653 if (tname && !skipreference) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"An object cannot be composed with an object that was composed with it");
654 }
655 ierr = PetscObjectListAdd(&obj->olist,name,ptr);CHKERRQ(ierr);
656 PetscFunctionReturn(0);
657 }
658
PetscObjectQuery_Petsc(PetscObject obj,const char name[],PetscObject * ptr)659 PetscErrorCode PetscObjectQuery_Petsc(PetscObject obj,const char name[],PetscObject *ptr)
660 {
661 PetscErrorCode ierr;
662
663 PetscFunctionBegin;
664 PetscValidHeader(obj,1);
665 ierr = PetscObjectListFind(obj->olist,name,ptr);CHKERRQ(ierr);
666 PetscFunctionReturn(0);
667 }
668
PetscObjectComposeFunction_Petsc(PetscObject obj,const char name[],void (* ptr)(void))669 PetscErrorCode PetscObjectComposeFunction_Petsc(PetscObject obj,const char name[],void (*ptr)(void))
670 {
671 PetscErrorCode ierr;
672
673 PetscFunctionBegin;
674 PetscValidHeader(obj,1);
675 ierr = PetscFunctionListAdd(&obj->qlist,name,ptr);CHKERRQ(ierr);
676 PetscFunctionReturn(0);
677 }
678
PetscObjectQueryFunction_Petsc(PetscObject obj,const char name[],void (** ptr)(void))679 PetscErrorCode PetscObjectQueryFunction_Petsc(PetscObject obj,const char name[],void (**ptr)(void))
680 {
681 PetscErrorCode ierr;
682
683 PetscFunctionBegin;
684 PetscValidHeader(obj,1);
685 ierr = PetscFunctionListFind(obj->qlist,name,ptr);CHKERRQ(ierr);
686 PetscFunctionReturn(0);
687 }
688
689 /*@C
690 PetscObjectCompose - Associates another PETSc object with a given PETSc object.
691
692 Not Collective
693
694 Input Parameters:
695 + obj - the PETSc object; this must be cast with (PetscObject), for example,
696 PetscObjectCompose((PetscObject)mat,...);
697 . name - name associated with the child object
698 - ptr - the other PETSc object to associate with the PETSc object; this must also be
699 cast with (PetscObject)
700
701 Level: advanced
702
703 Notes:
704 The second objects reference count is automatically increased by one when it is
705 composed.
706
707 Replaces any previous object that had the same name.
708
709 If ptr is null and name has previously been composed using an object, then that
710 entry is removed from the obj.
711
712 PetscObjectCompose() can be used with any PETSc object (such as
713 Mat, Vec, KSP, SNES, etc.) or any user-provided object. See
714 PetscContainerCreate() for info on how to create an object from a
715 user-provided pointer that may then be composed with PETSc objects.
716
717
718 .seealso: PetscObjectQuery(), PetscContainerCreate(), PetscObjectComposeFunction(), PetscObjectQueryFunction()
719 @*/
PetscObjectCompose(PetscObject obj,const char name[],PetscObject ptr)720 PetscErrorCode PetscObjectCompose(PetscObject obj,const char name[],PetscObject ptr)
721 {
722 PetscErrorCode ierr;
723
724 PetscFunctionBegin;
725 PetscValidHeader(obj,1);
726 PetscValidCharPointer(name,2);
727 if (ptr) PetscValidHeader(ptr,3);
728 if (obj == ptr) SETERRQ(PetscObjectComm((PetscObject)obj),PETSC_ERR_SUP,"Cannot compose object with itself");
729 ierr = (*obj->bops->compose)(obj,name,ptr);CHKERRQ(ierr);
730 PetscFunctionReturn(0);
731 }
732
733 /*@C
734 PetscObjectQuery - Gets a PETSc object associated with a given object.
735
736 Not Collective
737
738 Input Parameters:
739 + obj - the PETSc object
740 Thus must be cast with a (PetscObject), for example,
741 PetscObjectCompose((PetscObject)mat,...);
742 . name - name associated with child object
743 - ptr - the other PETSc object associated with the PETSc object, this must be
744 cast with (PetscObject*)
745
746 Level: advanced
747
748 The reference count of neither object is increased in this call
749
750
751 .seealso: PetscObjectCompose(), PetscObjectComposeFunction(), PetscObjectQueryFunction()
752 @*/
PetscObjectQuery(PetscObject obj,const char name[],PetscObject * ptr)753 PetscErrorCode PetscObjectQuery(PetscObject obj,const char name[],PetscObject *ptr)
754 {
755 PetscErrorCode ierr;
756
757 PetscFunctionBegin;
758 PetscValidHeader(obj,1);
759 PetscValidCharPointer(name,2);
760 PetscValidPointer(ptr,3);
761 ierr = (*obj->bops->query)(obj,name,ptr);CHKERRQ(ierr);
762 PetscFunctionReturn(0);
763 }
764
765 /*MC
766 PetscObjectComposeFunction - Associates a function with a given PETSc object.
767
768 Synopsis:
769 #include <petscsys.h>
770 PetscErrorCode PetscObjectComposeFunction(PetscObject obj,const char name[],void (*fptr)(void))
771
772 Logically Collective on PetscObject
773
774 Input Parameters:
775 + obj - the PETSc object; this must be cast with a (PetscObject), for example,
776 PetscObjectCompose((PetscObject)mat,...);
777 . name - name associated with the child function
778 . fname - name of the function
779 - fptr - function pointer
780
781 Level: advanced
782
783 Notes:
784 To remove a registered routine, pass in NULL for fptr().
785
786 PetscObjectComposeFunction() can be used with any PETSc object (such as
787 Mat, Vec, KSP, SNES, etc.) or any user-provided object.
788
789 .seealso: PetscObjectQueryFunction(), PetscContainerCreate() PetscObjectCompose(), PetscObjectQuery()
790 M*/
791
PetscObjectComposeFunction_Private(PetscObject obj,const char name[],void (* fptr)(void))792 PetscErrorCode PetscObjectComposeFunction_Private(PetscObject obj,const char name[],void (*fptr)(void))
793 {
794 PetscErrorCode ierr;
795
796 PetscFunctionBegin;
797 PetscValidHeader(obj,1);
798 PetscValidCharPointer(name,2);
799 ierr = (*obj->bops->composefunction)(obj,name,fptr);CHKERRQ(ierr);
800 PetscFunctionReturn(0);
801 }
802
803 /*MC
804 PetscObjectQueryFunction - Gets a function associated with a given object.
805
806 Synopsis:
807 #include <petscsys.h>
808 PetscErrorCode PetscObjectQueryFunction(PetscObject obj,const char name[],void (**fptr)(void))
809
810 Logically Collective on PetscObject
811
812 Input Parameters:
813 + obj - the PETSc object; this must be cast with (PetscObject), for example,
814 PetscObjectQueryFunction((PetscObject)ksp,...);
815 - name - name associated with the child function
816
817 Output Parameter:
818 . fptr - function pointer
819
820 Level: advanced
821
822 .seealso: PetscObjectComposeFunction(), PetscFunctionListFind(), PetscObjectCompose(), PetscObjectQuery()
823 M*/
PetscObjectQueryFunction_Private(PetscObject obj,const char name[],void (** ptr)(void))824 PETSC_EXTERN PetscErrorCode PetscObjectQueryFunction_Private(PetscObject obj,const char name[],void (**ptr)(void))
825 {
826 PetscErrorCode ierr;
827
828 PetscFunctionBegin;
829 PetscValidHeader(obj,1);
830 PetscValidCharPointer(name,2);
831 ierr = (*obj->bops->queryfunction)(obj,name,ptr);CHKERRQ(ierr);
832 PetscFunctionReturn(0);
833 }
834
835 struct _p_PetscContainer {
836 PETSCHEADER(int);
837 void *ptr;
838 PetscErrorCode (*userdestroy)(void*);
839 };
840
841 /*@C
842 PetscContainerUserDestroyDefault - Default destroy routine for user-provided data that simply calls PetscFree().
843
844 Logically Collective on PetscContainer
845
846 Input Parameter:
847 . ctx - pointer to user-provided data
848
849 Level: advanced
850
851 .seealso: PetscContainerDestroy(), PetscContainterSetUserDestroy()
852 @*/
PetscContainerUserDestroyDefault(void * ctx)853 PetscErrorCode PetscContainerUserDestroyDefault(void* ctx)
854 {
855 PetscErrorCode ierr;
856
857 PetscFunctionBegin;
858 ierr = PetscFree(ctx);CHKERRQ(ierr);
859 PetscFunctionReturn(0);
860 }
861
862 /*@C
863 PetscContainerGetPointer - Gets the pointer value contained in the container.
864
865 Not Collective
866
867 Input Parameter:
868 . obj - the object created with PetscContainerCreate()
869
870 Output Parameter:
871 . ptr - the pointer value
872
873 Level: advanced
874
875 .seealso: PetscContainerCreate(), PetscContainerDestroy(),
876 PetscContainerSetPointer()
877 @*/
PetscContainerGetPointer(PetscContainer obj,void ** ptr)878 PetscErrorCode PetscContainerGetPointer(PetscContainer obj,void **ptr)
879 {
880 PetscFunctionBegin;
881 PetscValidHeaderSpecific(obj,PETSC_CONTAINER_CLASSID,1);
882 PetscValidPointer(ptr,2);
883 *ptr = obj->ptr;
884 PetscFunctionReturn(0);
885 }
886
887
888 /*@C
889 PetscContainerSetPointer - Sets the pointer value contained in the container.
890
891 Logically Collective on PetscContainer
892
893 Input Parameters:
894 + obj - the object created with PetscContainerCreate()
895 - ptr - the pointer value
896
897 Level: advanced
898
899 .seealso: PetscContainerCreate(), PetscContainerDestroy(),
900 PetscContainerGetPointer()
901 @*/
PetscContainerSetPointer(PetscContainer obj,void * ptr)902 PetscErrorCode PetscContainerSetPointer(PetscContainer obj,void *ptr)
903 {
904 PetscFunctionBegin;
905 PetscValidHeaderSpecific(obj,PETSC_CONTAINER_CLASSID,1);
906 if (ptr) PetscValidPointer(ptr,2);
907 obj->ptr = ptr;
908 PetscFunctionReturn(0);
909 }
910
911 /*@C
912 PetscContainerDestroy - Destroys a PETSc container object.
913
914 Collective on PetscContainer
915
916 Input Parameter:
917 . obj - an object that was created with PetscContainerCreate()
918
919 Level: advanced
920
921 .seealso: PetscContainerCreate(), PetscContainerSetUserDestroy()
922 @*/
PetscContainerDestroy(PetscContainer * obj)923 PetscErrorCode PetscContainerDestroy(PetscContainer *obj)
924 {
925 PetscErrorCode ierr;
926
927 PetscFunctionBegin;
928 if (!*obj) PetscFunctionReturn(0);
929 PetscValidHeaderSpecific(*obj,PETSC_CONTAINER_CLASSID,1);
930 if (--((PetscObject)(*obj))->refct > 0) {*obj = NULL; PetscFunctionReturn(0);}
931 if ((*obj)->userdestroy) { ierr = (*(*obj)->userdestroy)((*obj)->ptr);CHKERRQ(ierr); }
932 ierr = PetscHeaderDestroy(obj);CHKERRQ(ierr);
933 PetscFunctionReturn(0);
934 }
935
936 /*@C
937 PetscContainerSetUserDestroy - Sets name of the user destroy function.
938
939 Logically Collective on PetscContainer
940
941 Input Parameter:
942 + obj - an object that was created with PetscContainerCreate()
943 - des - name of the user destroy function
944
945 Notes:
946 Use PetscContainerUserDestroyDefault() if the memory was obtained by calling PetscMalloc or one of its variants for single memory allocation.
947
948 Level: advanced
949
950 .seealso: PetscContainerDestroy(), PetscContainerUserDestroyDefault(), PetscMalloc(), PetscMalloc1(), PetscCalloc(), PetscCalloc1()
951 @*/
PetscContainerSetUserDestroy(PetscContainer obj,PetscErrorCode (* des)(void *))952 PetscErrorCode PetscContainerSetUserDestroy(PetscContainer obj, PetscErrorCode (*des)(void*))
953 {
954 PetscFunctionBegin;
955 PetscValidHeaderSpecific(obj,PETSC_CONTAINER_CLASSID,1);
956 obj->userdestroy = des;
957 PetscFunctionReturn(0);
958 }
959
960 PetscClassId PETSC_CONTAINER_CLASSID;
961
962 /*@C
963 PetscContainerCreate - Creates a PETSc object that has room to hold
964 a single pointer. This allows one to attach any type of data (accessible
965 through a pointer) with the PetscObjectCompose() function to a PetscObject.
966 The data item itself is attached by a call to PetscContainerSetPointer().
967
968 Collective
969
970 Input Parameters:
971 . comm - MPI communicator that shares the object
972
973 Output Parameters:
974 . container - the container created
975
976 Level: advanced
977
978 .seealso: PetscContainerDestroy(), PetscContainerSetPointer(), PetscContainerGetPointer(), PetscObjectCompose(), PetscObjectQuery()
979 @*/
PetscContainerCreate(MPI_Comm comm,PetscContainer * container)980 PetscErrorCode PetscContainerCreate(MPI_Comm comm,PetscContainer *container)
981 {
982 PetscErrorCode ierr;
983 PetscContainer contain;
984
985 PetscFunctionBegin;
986 PetscValidPointer(container,2);
987 ierr = PetscSysInitializePackage();CHKERRQ(ierr);
988 ierr = PetscHeaderCreate(contain,PETSC_CONTAINER_CLASSID,"PetscContainer","Container","Sys",comm,PetscContainerDestroy,NULL);CHKERRQ(ierr);
989 *container = contain;
990 PetscFunctionReturn(0);
991 }
992
993 /*@
994 PetscObjectSetFromOptions - Sets generic parameters from user options.
995
996 Collective on obj
997
998 Input Parameter:
999 . obj - the PetscObjcet
1000
1001 Options Database Keys:
1002
1003 Notes:
1004 We have no generic options at present, so this does nothing
1005
1006 Level: beginner
1007
1008 .seealso: PetscObjectSetOptionsPrefix(), PetscObjectGetOptionsPrefix()
1009 @*/
PetscObjectSetFromOptions(PetscObject obj)1010 PetscErrorCode PetscObjectSetFromOptions(PetscObject obj)
1011 {
1012 PetscFunctionBegin;
1013 PetscValidHeader(obj,1);
1014 PetscFunctionReturn(0);
1015 }
1016
1017 /*@
1018 PetscObjectSetUp - Sets up the internal data structures for the later use.
1019
1020 Collective on PetscObject
1021
1022 Input Parameters:
1023 . obj - the PetscObject
1024
1025 Notes:
1026 This does nothing at present.
1027
1028 Level: advanced
1029
1030 .seealso: PetscObjectDestroy()
1031 @*/
PetscObjectSetUp(PetscObject obj)1032 PetscErrorCode PetscObjectSetUp(PetscObject obj)
1033 {
1034 PetscFunctionBegin;
1035 PetscValidHeader(obj,1);
1036 PetscFunctionReturn(0);
1037 }
1038