xref: /petsc/src/sys/objects/inherit.c (revision 76386721e3709eb5a31652ea1c49d335fd2963a2)
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 = 0;
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         if (stack) {
300           k = stack->currentsize-2;
301           if (!all) {
302             k = 0;
303             while (!stack->petscroutine[k]) k++;
304             ierr = PetscStrstr(stack->function[k],"Create",&create);CHKERRQ(ierr);
305             if (!create) {
306               ierr = PetscStrstr(stack->function[k],"Get",&create);CHKERRQ(ierr);
307             }
308             ierr = PetscStrstr(stack->function[k],h->class_name,&rclass);CHKERRQ(ierr);
309             if (!create) continue;
310             if (!rclass) continue;
311           }
312         }
313 #endif
314 
315         ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"[%d] %s %s %s\n",PetscGlobalRank,h->class_name,h->type_name,h->name);CHKERRQ(ierr);
316 
317 #if defined(PETSC_USE_DEBUG)
318         ierr = PetscMallocGetStack(h,&stack);CHKERRQ(ierr);
319         if (stack) {
320           for (j=k; j>=0; j--) {
321             fprintf(fd,"      [%d]  %s() in %s%s\n",PetscGlobalRank,stack->function[j],stack->directory[j],stack->file[j]);
322           }
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 object
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     if (obj->optiondestroy[i]) {
512       ierr = (*obj->optiondestroy[i])(obj,obj->optionctx[i]);CHKERRQ(ierr);
513     }
514   }
515   obj->noptionhandler = 0;
516   PetscFunctionReturn(0);
517 }
518 
519 
520 #undef __FUNCT__
521 #define __FUNCT__ "PetscObjectReference"
522 /*@
523    PetscObjectReference - Indicates to any PetscObject that it is being
524    referenced by another PetscObject. This increases the reference
525    count for that object by one.
526 
527    Logically Collective on PetscObject
528 
529    Input Parameter:
530 .  obj - the PETSc object. This must be cast with (PetscObject), for example,
531          PetscObjectReference((PetscObject)mat);
532 
533    Level: advanced
534 
535 .seealso: PetscObjectCompose(), PetscObjectDereference()
536 @*/
537 PetscErrorCode  PetscObjectReference(PetscObject obj)
538 {
539   PetscFunctionBegin;
540   if (!obj) PetscFunctionReturn(0);
541   PetscValidHeader(obj,1);
542   obj->refct++;
543   PetscFunctionReturn(0);
544 }
545 
546 #undef __FUNCT__
547 #define __FUNCT__ "PetscObjectGetReference"
548 /*@
549    PetscObjectGetReference - Gets the current reference count for
550    any PETSc object.
551 
552    Not Collective
553 
554    Input Parameter:
555 .  obj - the PETSc object; this must be cast with (PetscObject), for example,
556          PetscObjectGetReference((PetscObject)mat,&cnt);
557 
558    Output Parameter:
559 .  cnt - the reference count
560 
561    Level: advanced
562 
563 .seealso: PetscObjectCompose(), PetscObjectDereference(), PetscObjectReference()
564 @*/
565 PetscErrorCode  PetscObjectGetReference(PetscObject obj,PetscInt *cnt)
566 {
567   PetscFunctionBegin;
568   PetscValidHeader(obj,1);
569   PetscValidIntPointer(cnt,2);
570   *cnt = obj->refct;
571   PetscFunctionReturn(0);
572 }
573 
574 #undef __FUNCT__
575 #define __FUNCT__ "PetscObjectDereference"
576 /*@
577    PetscObjectDereference - Indicates to any PetscObject that it is being
578    referenced by one less PetscObject. This decreases the reference
579    count for that object by one.
580 
581    Collective on PetscObject if reference reaches 0 otherwise Logically Collective
582 
583    Input Parameter:
584 .  obj - the PETSc object; this must be cast with (PetscObject), for example,
585          PetscObjectDereference((PetscObject)mat);
586 
587    Notes: PetscObjectDestroy(PetscObject *obj)  sets the obj pointer to null after the call, this routine does not.
588 
589    Level: advanced
590 
591 .seealso: PetscObjectCompose(), PetscObjectReference()
592 @*/
593 PetscErrorCode  PetscObjectDereference(PetscObject obj)
594 {
595   PetscErrorCode ierr;
596 
597   PetscFunctionBegin;
598   PetscValidHeader(obj,1);
599   if (obj->bops->destroy) {
600     ierr = (*obj->bops->destroy)(&obj);CHKERRQ(ierr);
601   } else if (!--obj->refct) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"This PETSc object does not have a generic destroy routine");
602   PetscFunctionReturn(0);
603 }
604 
605 /* ----------------------------------------------------------------------- */
606 /*
607      The following routines are the versions private to the PETSc object
608      data structures.
609 */
610 #undef __FUNCT__
611 #define __FUNCT__ "PetscObjectGetComm_Petsc"
612 PetscErrorCode PetscObjectGetComm_Petsc(PetscObject obj,MPI_Comm *comm)
613 {
614   PetscFunctionBegin;
615   PetscValidHeader(obj,1);
616   *comm = obj->comm;
617   PetscFunctionReturn(0);
618 }
619 
620 #undef __FUNCT__
621 #define __FUNCT__ "PetscObjectRemoveReference"
622 PetscErrorCode PetscObjectRemoveReference(PetscObject obj,const char name[])
623 {
624   PetscErrorCode ierr;
625 
626   PetscFunctionBegin;
627   PetscValidHeader(obj,1);
628   ierr = PetscObjectListRemoveReference(&obj->olist,name);CHKERRQ(ierr);
629   PetscFunctionReturn(0);
630 }
631 
632 #undef __FUNCT__
633 #define __FUNCT__ "PetscObjectCompose_Petsc"
634 PetscErrorCode PetscObjectCompose_Petsc(PetscObject obj,const char name[],PetscObject ptr)
635 {
636   PetscErrorCode ierr;
637   char           *tname;
638   PetscBool      skipreference;
639 
640   PetscFunctionBegin;
641   if (ptr) {
642     ierr = PetscObjectListReverseFind(ptr->olist,obj,&tname,&skipreference);CHKERRQ(ierr);
643     if (tname && !skipreference) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"An object cannot be composed with an object that was composed with it");
644   }
645   ierr = PetscObjectListAdd(&obj->olist,name,ptr);CHKERRQ(ierr);
646   PetscFunctionReturn(0);
647 }
648 
649 #undef __FUNCT__
650 #define __FUNCT__ "PetscObjectQuery_Petsc"
651 PetscErrorCode PetscObjectQuery_Petsc(PetscObject obj,const char name[],PetscObject *ptr)
652 {
653   PetscErrorCode ierr;
654 
655   PetscFunctionBegin;
656   PetscValidHeader(obj,1);
657   ierr = PetscObjectListFind(obj->olist,name,ptr);CHKERRQ(ierr);
658   PetscFunctionReturn(0);
659 }
660 
661 #undef __FUNCT__
662 #define __FUNCT__ "PetscObjectComposeFunction_Petsc"
663 PetscErrorCode PetscObjectComposeFunction_Petsc(PetscObject obj,const char name[],void (*ptr)(void))
664 {
665   PetscErrorCode ierr;
666 
667   PetscFunctionBegin;
668   PetscValidHeader(obj,1);
669   ierr = PetscFunctionListAdd(&obj->qlist,name,ptr);CHKERRQ(ierr);
670   PetscFunctionReturn(0);
671 }
672 
673 #undef __FUNCT__
674 #define __FUNCT__ "PetscObjectQueryFunction_Petsc"
675 PetscErrorCode PetscObjectQueryFunction_Petsc(PetscObject obj,const char name[],void (**ptr)(void))
676 {
677   PetscErrorCode ierr;
678 
679   PetscFunctionBegin;
680   PetscValidHeader(obj,1);
681   ierr = PetscFunctionListFind(obj->qlist,name,ptr);CHKERRQ(ierr);
682   PetscFunctionReturn(0);
683 }
684 
685 #undef __FUNCT__
686 #define __FUNCT__ "PetscObjectCompose"
687 /*@C
688    PetscObjectCompose - Associates another PETSc object with a given PETSc object.
689 
690    Not Collective
691 
692    Input Parameters:
693 +  obj - the PETSc object; this must be cast with (PetscObject), for example,
694          PetscObjectCompose((PetscObject)mat,...);
695 .  name - name associated with the child object
696 -  ptr - the other PETSc object to associate with the PETSc object; this must also be
697          cast with (PetscObject)
698 
699    Level: advanced
700 
701    Notes:
702    The second objects reference count is automatically increased by one when it is
703    composed.
704 
705    Replaces any previous object that had the same name.
706 
707    If ptr is null and name has previously been composed using an object, then that
708    entry is removed from the obj.
709 
710    PetscObjectCompose() can be used with any PETSc object (such as
711    Mat, Vec, KSP, SNES, etc.) or any user-provided object.  See
712    PetscContainerCreate() for info on how to create an object from a
713    user-provided pointer that may then be composed with PETSc objects.
714 
715    Concepts: objects^composing
716    Concepts: composing objects
717 
718 .seealso: PetscObjectQuery(), PetscContainerCreate()
719 @*/
720 PetscErrorCode  PetscObjectCompose(PetscObject obj,const char name[],PetscObject ptr)
721 {
722   PetscErrorCode ierr;
723 
724   PetscFunctionBegin;
725   PetscValidHeader(obj,1);
726   PetscValidCharPointer(name,2);
727   if (ptr) PetscValidHeader(ptr,3);
728   ierr = (*obj->bops->compose)(obj,name,ptr);CHKERRQ(ierr);
729   PetscFunctionReturn(0);
730 }
731 
732 #undef __FUNCT__
733 #define __FUNCT__ "PetscObjectSetPrecision"
734 /*@C
735    PetscObjectSetPrecision - sets the precision used within a given object.
736 
737    Collective on the PetscObject
738 
739    Input Parameters:
740 +  obj - the PETSc object; this must be cast with (PetscObject), for example,
741          PetscObjectCompose((PetscObject)mat,...);
742 -  precision - the precision
743 
744    Level: advanced
745 
746 .seealso: PetscObjectQuery(), PetscContainerCreate()
747 @*/
748 PetscErrorCode  PetscObjectSetPrecision(PetscObject obj,PetscPrecision precision)
749 {
750   PetscFunctionBegin;
751   PetscValidHeader(obj,1);
752   obj->precision = precision;
753   PetscFunctionReturn(0);
754 }
755 
756 #undef __FUNCT__
757 #define __FUNCT__ "PetscObjectQuery"
758 /*@C
759    PetscObjectQuery  - Gets a PETSc object associated with a given object.
760 
761    Not Collective
762 
763    Input Parameters:
764 +  obj - the PETSc object
765          Thus must be cast with a (PetscObject), for example,
766          PetscObjectCompose((PetscObject)mat,...);
767 .  name - name associated with child object
768 -  ptr - the other PETSc object associated with the PETSc object, this must be
769          cast with (PetscObject*)
770 
771    Level: advanced
772 
773    The reference count of neither object is increased in this call
774 
775    Concepts: objects^composing
776    Concepts: composing objects
777    Concepts: objects^querying
778    Concepts: querying objects
779 
780 .seealso: PetscObjectCompose()
781 @*/
782 PetscErrorCode  PetscObjectQuery(PetscObject obj,const char name[],PetscObject *ptr)
783 {
784   PetscErrorCode ierr;
785 
786   PetscFunctionBegin;
787   PetscValidHeader(obj,1);
788   PetscValidCharPointer(name,2);
789   PetscValidPointer(ptr,3);
790   ierr = (*obj->bops->query)(obj,name,ptr);CHKERRQ(ierr);
791   PetscFunctionReturn(0);
792 }
793 
794 /*MC
795    PetscObjectComposeFunction - Associates a function with a given PETSc object.
796 
797     Synopsis:
798     #include "petscsys.h"
799     PetscErrorCode PetscObjectComposeFunction(PetscObject obj,const char name[],void (*fptr)(void))
800 
801    Logically Collective on PetscObject
802 
803    Input Parameters:
804 +  obj - the PETSc object; this must be cast with a (PetscObject), for example,
805          PetscObjectCompose((PetscObject)mat,...);
806 .  name - name associated with the child function
807 .  fname - name of the function
808 -  fptr - function pointer
809 
810    Level: advanced
811 
812    Notes:
813    To remove a registered routine, pass in NULL for fptr().
814 
815    PetscObjectComposeFunction() can be used with any PETSc object (such as
816    Mat, Vec, KSP, SNES, etc.) or any user-provided object.
817 
818    Concepts: objects^composing functions
819    Concepts: composing functions
820    Concepts: functions^querying
821    Concepts: objects^querying
822    Concepts: querying objects
823 
824 .seealso: PetscObjectQueryFunction(), PetscContainerCreate()
825 M*/
826 
827 #undef __FUNCT__
828 #define __FUNCT__ "PetscObjectComposeFunction_Private"
829 PetscErrorCode  PetscObjectComposeFunction_Private(PetscObject obj,const char name[],void (*fptr)(void))
830 {
831   PetscErrorCode ierr;
832 
833   PetscFunctionBegin;
834   PetscValidHeader(obj,1);
835   PetscValidCharPointer(name,2);
836   ierr = (*obj->bops->composefunction)(obj,name,fptr);CHKERRQ(ierr);
837   PetscFunctionReturn(0);
838 }
839 
840 /*MC
841    PetscObjectQueryFunction - Gets a function associated with a given object.
842 
843     Synopsis:
844     #include "petscsys.h"
845     PetscErrorCode PetscObjectQueryFunction(PetscObject obj,const char name[],void (**fptr)(void))
846 
847    Logically Collective on PetscObject
848 
849    Input Parameters:
850 +  obj - the PETSc object; this must be cast with (PetscObject), for example,
851          PetscObjectQueryFunction((PetscObject)ksp,...);
852 -  name - name associated with the child function
853 
854    Output Parameter:
855 .  fptr - function pointer
856 
857    Level: advanced
858 
859    Concepts: objects^composing functions
860    Concepts: composing functions
861    Concepts: functions^querying
862    Concepts: objects^querying
863    Concepts: querying objects
864 
865 .seealso: PetscObjectComposeFunction(), PetscFunctionListFind()
866 M*/
867 #undef __FUNCT__
868 #define __FUNCT__ "PetscObjectQueryFunction_Private"
869 PETSC_EXTERN PetscErrorCode PetscObjectQueryFunction_Private(PetscObject obj,const char name[],void (**ptr)(void))
870 {
871   PetscErrorCode ierr;
872 
873   PetscFunctionBegin;
874   PetscValidHeader(obj,1);
875   PetscValidCharPointer(name,2);
876   ierr = (*obj->bops->queryfunction)(obj,name,ptr);CHKERRQ(ierr);
877   PetscFunctionReturn(0);
878 }
879 
880 struct _p_PetscContainer {
881   PETSCHEADER(int);
882   void           *ptr;
883   PetscErrorCode (*userdestroy)(void*);
884 };
885 
886 #undef __FUNCT__
887 #define __FUNCT__ "PetscContainerGetPointer"
888 /*@C
889    PetscContainerGetPointer - Gets the pointer value contained in the container.
890 
891    Not Collective
892 
893    Input Parameter:
894 .  obj - the object created with PetscContainerCreate()
895 
896    Output Parameter:
897 .  ptr - the pointer value
898 
899    Level: advanced
900 
901 .seealso: PetscContainerCreate(), PetscContainerDestroy(),
902           PetscContainerSetPointer()
903 @*/
904 PetscErrorCode  PetscContainerGetPointer(PetscContainer obj,void **ptr)
905 {
906   PetscFunctionBegin;
907   PetscValidHeaderSpecific(obj,PETSC_CONTAINER_CLASSID,1);
908   PetscValidPointer(ptr,2);
909   *ptr = obj->ptr;
910   PetscFunctionReturn(0);
911 }
912 
913 
914 #undef __FUNCT__
915 #define __FUNCT__ "PetscContainerSetPointer"
916 /*@C
917    PetscContainerSetPointer - Sets the pointer value contained in the container.
918 
919    Logically Collective on PetscContainer
920 
921    Input Parameters:
922 +  obj - the object created with PetscContainerCreate()
923 -  ptr - the pointer value
924 
925    Level: advanced
926 
927 .seealso: PetscContainerCreate(), PetscContainerDestroy(),
928           PetscContainerGetPointer()
929 @*/
930 PetscErrorCode  PetscContainerSetPointer(PetscContainer obj,void *ptr)
931 {
932   PetscFunctionBegin;
933   PetscValidHeaderSpecific(obj,PETSC_CONTAINER_CLASSID,1);
934   if (ptr) PetscValidPointer(ptr,2);
935   obj->ptr = ptr;
936   PetscFunctionReturn(0);
937 }
938 
939 #undef __FUNCT__
940 #define __FUNCT__ "PetscContainerDestroy"
941 /*@C
942    PetscContainerDestroy - Destroys a PETSc container object.
943 
944    Collective on PetscContainer
945 
946    Input Parameter:
947 .  obj - an object that was created with PetscContainerCreate()
948 
949    Level: advanced
950 
951 .seealso: PetscContainerCreate(), PetscContainerSetUserDestroy()
952 @*/
953 PetscErrorCode  PetscContainerDestroy(PetscContainer *obj)
954 {
955   PetscErrorCode ierr;
956 
957   PetscFunctionBegin;
958   if (!*obj) PetscFunctionReturn(0);
959   PetscValidHeaderSpecific(*obj,PETSC_CONTAINER_CLASSID,1);
960   if (--((PetscObject)(*obj))->refct > 0) {*obj = 0; PetscFunctionReturn(0);}
961   if ((*obj)->userdestroy) (*(*obj)->userdestroy)((*obj)->ptr);
962   ierr = PetscHeaderDestroy(obj);CHKERRQ(ierr);
963   PetscFunctionReturn(0);
964 }
965 
966 #undef __FUNCT__
967 #define __FUNCT__ "PetscContainerSetUserDestroy"
968 /*@C
969    PetscContainerSetUserDestroy - Sets name of the user destroy function.
970 
971    Logically Collective on PetscContainer
972 
973    Input Parameter:
974 +  obj - an object that was created with PetscContainerCreate()
975 -  des - name of the user destroy function
976 
977    Level: advanced
978 
979 .seealso: PetscContainerDestroy()
980 @*/
981 PetscErrorCode  PetscContainerSetUserDestroy(PetscContainer obj, PetscErrorCode (*des)(void*))
982 {
983   PetscFunctionBegin;
984   PetscValidHeaderSpecific(obj,PETSC_CONTAINER_CLASSID,1);
985   obj->userdestroy = des;
986   PetscFunctionReturn(0);
987 }
988 
989 PetscClassId PETSC_CONTAINER_CLASSID;
990 
991 #undef __FUNCT__
992 #define __FUNCT__ "PetscContainerCreate"
993 /*@C
994    PetscContainerCreate - Creates a PETSc object that has room to hold
995    a single pointer. This allows one to attach any type of data (accessible
996    through a pointer) with the PetscObjectCompose() function to a PetscObject.
997    The data item itself is attached by a call to PetscContainerSetPointer().
998 
999    Collective on MPI_Comm
1000 
1001    Input Parameters:
1002 .  comm - MPI communicator that shares the object
1003 
1004    Output Parameters:
1005 .  container - the container created
1006 
1007    Level: advanced
1008 
1009 .seealso: PetscContainerDestroy(), PetscContainerSetPointer(), PetscContainerGetPointer()
1010 @*/
1011 PetscErrorCode  PetscContainerCreate(MPI_Comm comm,PetscContainer *container)
1012 {
1013   PetscErrorCode ierr;
1014   PetscContainer contain;
1015 
1016   PetscFunctionBegin;
1017   PetscValidPointer(container,2);
1018   ierr = PetscHeaderCreate(contain,_p_PetscContainer,PetscInt,PETSC_CONTAINER_CLASSID,"PetscContainer","Container","Sys",comm,PetscContainerDestroy,0);CHKERRQ(ierr);
1019   *container = contain;
1020   PetscFunctionReturn(0);
1021 }
1022 
1023 #undef __FUNCT__
1024 #define __FUNCT__ "PetscObjectSetFromOptions"
1025 /*@
1026    PetscObjectSetFromOptions - Sets generic parameters from user options.
1027 
1028    Collective on obj
1029 
1030    Input Parameter:
1031 .  obj - the PetscObjcet
1032 
1033    Options Database Keys:
1034 
1035    Notes:
1036    We have no generic options at present, so this does nothing
1037 
1038    Level: beginner
1039 
1040 .keywords: set, options, database
1041 .seealso: PetscObjectSetOptionsPrefix(), PetscObjectGetOptionsPrefix()
1042 @*/
1043 PetscErrorCode  PetscObjectSetFromOptions(PetscObject obj)
1044 {
1045   PetscFunctionBegin;
1046   PetscValidHeader(obj,1);
1047   PetscFunctionReturn(0);
1048 }
1049 
1050 #undef __FUNCT__
1051 #define __FUNCT__ "PetscObjectSetUp"
1052 /*@
1053    PetscObjectSetUp - Sets up the internal data structures for the later use.
1054 
1055    Collective on PetscObject
1056 
1057    Input Parameters:
1058 .  obj - the PetscObject
1059 
1060    Notes:
1061    This does nothing at present.
1062 
1063    Level: advanced
1064 
1065 .keywords: setup
1066 .seealso: PetscObjectDestroy()
1067 @*/
1068 PetscErrorCode  PetscObjectSetUp(PetscObject obj)
1069 {
1070   PetscFunctionBegin;
1071   PetscValidHeader(obj,1);
1072   PetscFunctionReturn(0);
1073 }
1074