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