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