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