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