1 
2 /*
3      Provides utility routines for manulating any type of PETSc object.
4 */
5 #include <petsc/private/petscimpl.h>  /*I   "petscsys.h"    I*/
6 #include <petscviewer.h>
7 
PetscComposedQuantitiesDestroy(PetscObject obj)8 PetscErrorCode PetscComposedQuantitiesDestroy(PetscObject obj)
9 {
10   PetscErrorCode ierr;
11   PetscInt       i;
12 
13   PetscFunctionBegin;
14   if (obj->intstar_idmax>0) {
15     for (i=0; i<obj->intstar_idmax; i++) {
16       ierr = PetscFree(obj->intstarcomposeddata[i]);CHKERRQ(ierr);
17     }
18     ierr = PetscFree2(obj->intstarcomposeddata,obj->intstarcomposedstate);CHKERRQ(ierr);
19   }
20   if (obj->realstar_idmax>0) {
21     for (i=0; i<obj->realstar_idmax; i++) {
22       ierr = PetscFree(obj->realstarcomposeddata[i]);CHKERRQ(ierr);
23     }
24     ierr = PetscFree2(obj->realstarcomposeddata,obj->realstarcomposedstate);CHKERRQ(ierr);
25   }
26   if (obj->scalarstar_idmax>0) {
27     for (i=0; i<obj->scalarstar_idmax; i++) {
28       ierr = PetscFree(obj->scalarstarcomposeddata[i]);CHKERRQ(ierr);
29     }
30     ierr = PetscFree2(obj->scalarstarcomposeddata,obj->scalarstarcomposedstate);CHKERRQ(ierr);
31   }
32   ierr = PetscFree2(obj->intcomposeddata,obj->intcomposedstate);CHKERRQ(ierr);
33   ierr = PetscFree2(obj->realcomposeddata,obj->realcomposedstate);CHKERRQ(ierr);
34   ierr = PetscFree2(obj->scalarcomposeddata,obj->scalarcomposedstate);CHKERRQ(ierr);
35   PetscFunctionReturn(0);
36 }
37 
38 /*@
39    PetscObjectDestroy - Destroys any PetscObject, regardless of the type.
40 
41    Collective on PetscObject
42 
43    Input Parameter:
44 .  obj - any PETSc object, for example a Vec, Mat or KSP.
45          This must be cast with a (PetscObject*), for example,
46          PetscObjectDestroy((PetscObject*)&mat);
47 
48    Level: beginner
49 
50 @*/
PetscObjectDestroy(PetscObject * obj)51 PetscErrorCode  PetscObjectDestroy(PetscObject *obj)
52 {
53   PetscErrorCode ierr;
54 
55   PetscFunctionBegin;
56   if (!*obj) PetscFunctionReturn(0);
57   PetscValidHeader(*obj,1);
58   if (*obj && (*obj)->bops->destroy) {
59     ierr = (*(*obj)->bops->destroy)(obj);CHKERRQ(ierr);
60   } else if (*obj) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This PETSc object of class %s does not have a generic destroy routine",(*obj)->class_name);
61   PetscFunctionReturn(0);
62 }
63 
64 /*@C
65    PetscObjectView - Views any PetscObject, regardless of the type.
66 
67    Collective on PetscObject
68 
69    Input Parameters:
70 +  obj - any PETSc object, for example a Vec, Mat or KSP.
71          This must be cast with a (PetscObject), for example,
72          PetscObjectView((PetscObject)mat,viewer);
73 -  viewer - any PETSc viewer
74 
75    Level: intermediate
76 
77 @*/
PetscObjectView(PetscObject obj,PetscViewer viewer)78 PetscErrorCode  PetscObjectView(PetscObject obj,PetscViewer viewer)
79 {
80   PetscErrorCode ierr;
81 
82   PetscFunctionBegin;
83   PetscValidHeader(obj,1);
84   if (!viewer) {
85     ierr = PetscViewerASCIIGetStdout(obj->comm,&viewer);CHKERRQ(ierr);
86   }
87   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
88 
89   if (obj->bops->view) {
90     ierr = (*obj->bops->view)(obj,viewer);CHKERRQ(ierr);
91   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"This PETSc object does not have a generic viewer routine");
92   PetscFunctionReturn(0);
93 }
94 
95 /*@C
96   PetscObjectViewFromOptions - Processes command line options to determine if/how a PetscObject is to be viewed.
97 
98   Collective on PetscObject
99 
100   Input Parameters:
101 + obj   - the object
102 . bobj  - optional other object that provides prefix (if NULL then the prefix in obj is used)
103 - optionname - option to activate viewing
104 
105   Level: intermediate
106 
107 @*/
PetscObjectViewFromOptions(PetscObject obj,PetscObject bobj,const char optionname[])108 PetscErrorCode PetscObjectViewFromOptions(PetscObject obj,PetscObject bobj,const char optionname[])
109 {
110   PetscErrorCode    ierr;
111   PetscViewer       viewer;
112   PetscBool         flg;
113   static PetscBool  incall = PETSC_FALSE;
114   PetscViewerFormat format;
115   const char        *prefix;
116 
117   PetscFunctionBegin;
118   if (incall) PetscFunctionReturn(0);
119   incall = PETSC_TRUE;
120   prefix = bobj ? bobj->prefix : obj->prefix;
121   ierr   = PetscOptionsGetViewer(PetscObjectComm((PetscObject)obj),obj->options,prefix,optionname,&viewer,&format,&flg);CHKERRQ(ierr);
122   if (flg) {
123     ierr = PetscViewerPushFormat(viewer,format);CHKERRQ(ierr);
124     ierr = PetscObjectView(obj,viewer);CHKERRQ(ierr);
125     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
126     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
127     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
128   }
129   incall = PETSC_FALSE;
130   PetscFunctionReturn(0);
131 }
132 
133 /*@C
134    PetscObjectTypeCompare - Determines whether a PETSc object is of a particular type.
135 
136    Not Collective
137 
138    Input Parameters:
139 +  obj - any PETSc object, for example a Vec, Mat or KSP.
140          This must be cast with a (PetscObject), for example,
141          PetscObjectTypeCompare((PetscObject)mat);
142 -  type_name - string containing a type name
143 
144    Output Parameter:
145 .  same - PETSC_TRUE if they are the same, else PETSC_FALSE
146 
147    Level: intermediate
148 
149 .seealso: VecGetType(), KSPGetType(), PCGetType(), SNESGetType(), PetscObjectBaseTypeCompare(), PetscObjectTypeCompareAny(), PetscObjectBaseTypeCompareAny()
150 
151 @*/
PetscObjectTypeCompare(PetscObject obj,const char type_name[],PetscBool * same)152 PetscErrorCode  PetscObjectTypeCompare(PetscObject obj,const char type_name[],PetscBool  *same)
153 {
154   PetscErrorCode ierr;
155 
156   PetscFunctionBegin;
157   PetscValidPointer(same,3);
158   if (!obj) *same = PETSC_FALSE;
159   else if (!type_name && !obj->type_name) *same = PETSC_TRUE;
160   else if (!type_name || !obj->type_name) *same = PETSC_FALSE;
161   else {
162     PetscValidHeader(obj,1);
163     PetscValidCharPointer(type_name,2);
164     ierr = PetscStrcmp((char*)(obj->type_name),type_name,same);CHKERRQ(ierr);
165   }
166   PetscFunctionReturn(0);
167 }
168 
169 /*@C
170    PetscObjectBaseTypeCompare - Determines whether a PetscObject is of a given base type. For example the base type of MATSEQAIJPERM is MATSEQAIJ
171 
172    Not Collective
173 
174    Input Parameters:
175 +  mat - the matrix
176 -  type_name - string containing a type name
177 
178    Output Parameter:
179 .  same - PETSC_TRUE if it is of the same base type
180 
181    Level: intermediate
182 
183 .seealso: PetscObjectTypeCompare(), PetscObjectTypeCompareAny(), PetscObjectBaseTypeCompareAny()
184 
185 @*/
PetscObjectBaseTypeCompare(PetscObject obj,const char type_name[],PetscBool * same)186 PetscErrorCode  PetscObjectBaseTypeCompare(PetscObject obj,const char type_name[],PetscBool  *same)
187 {
188   PetscErrorCode ierr;
189 
190   PetscFunctionBegin;
191   PetscValidPointer(same,3);
192   if (!obj) *same = PETSC_FALSE;
193   else if (!type_name && !obj->type_name) *same = PETSC_TRUE;
194   else if (!type_name || !obj->type_name) *same = PETSC_FALSE;
195   else {
196     PetscValidHeader(obj,1);
197     PetscValidCharPointer(type_name,2);
198     ierr = PetscStrbeginswith((char*)(obj->type_name),type_name,same);CHKERRQ(ierr);
199   }
200   PetscFunctionReturn(0);
201 }
202 
203 /*@C
204    PetscObjectTypeCompareAny - Determines whether a PETSc object is of any of a list of types.
205 
206    Not Collective
207 
208    Input Parameters:
209 +  obj - any PETSc object, for example a Vec, Mat or KSP.
210          This must be cast with a (PetscObject), for example, PetscObjectTypeCompareAny((PetscObject)mat,...);
211 -  type_name - string containing a type name, pass the empty string "" to terminate the list
212 
213    Output Parameter:
214 .  match - PETSC_TRUE if the type of obj matches any in the list, else PETSC_FALSE
215 
216    Level: intermediate
217 
218 .seealso: VecGetType(), KSPGetType(), PCGetType(), SNESGetType(), PetscObjectTypeCompare(), PetscObjectBaseTypeCompare(), PetscObjectTypeCompareAny()
219 
220 @*/
PetscObjectTypeCompareAny(PetscObject obj,PetscBool * match,const char type_name[],...)221 PetscErrorCode PetscObjectTypeCompareAny(PetscObject obj,PetscBool *match,const char type_name[],...)
222 {
223   PetscErrorCode ierr;
224   va_list        Argp;
225 
226   PetscFunctionBegin;
227   PetscValidPointer(match,2);
228   *match = PETSC_FALSE;
229   if (!obj) PetscFunctionReturn(0);
230   va_start(Argp,type_name);
231   while (type_name && type_name[0]) {
232     PetscBool found;
233     ierr = PetscObjectTypeCompare(obj,type_name,&found);CHKERRQ(ierr);
234     if (found) {
235       *match = PETSC_TRUE;
236       break;
237     }
238     type_name = va_arg(Argp,const char*);
239   }
240   va_end(Argp);
241   PetscFunctionReturn(0);
242 }
243 
244 
245 /*@C
246    PetscObjectBaseTypeCompareAny - Determines whether a PETSc object has the base type of any of a list of types.
247 
248    Not Collective
249 
250    Input Parameters:
251 +  obj - any PETSc object, for example a Vec, Mat or KSP.
252          This must be cast with a (PetscObject), for example, PetscObjectBaseTypeCompareAny((PetscObject)mat,...);
253 -  type_name - string containing a type name, pass the empty string "" to terminate the list
254 
255    Output Parameter:
256 .  match - PETSC_TRUE if the type of obj matches any in the list, else PETSC_FALSE
257 
258    Level: intermediate
259 
260 .seealso: VecGetType(), KSPGetType(), PCGetType(), SNESGetType(), PetscObjectTypeCompare(), PetscObjectBaseTypeCompare(), PetscObjectTypeCompareAny()
261 
262 @*/
PetscObjectBaseTypeCompareAny(PetscObject obj,PetscBool * match,const char type_name[],...)263 PetscErrorCode PetscObjectBaseTypeCompareAny(PetscObject obj,PetscBool *match,const char type_name[],...)
264 {
265   PetscErrorCode ierr;
266   va_list        Argp;
267 
268   PetscFunctionBegin;
269   PetscValidPointer(match,3);
270   *match = PETSC_FALSE;
271   va_start(Argp,type_name);
272   while (type_name && type_name[0]) {
273     PetscBool found;
274     ierr = PetscObjectBaseTypeCompare(obj,type_name,&found);CHKERRQ(ierr);
275     if (found) {
276       *match = PETSC_TRUE;
277       break;
278     }
279     type_name = va_arg(Argp,const char*);
280   }
281   va_end(Argp);
282   PetscFunctionReturn(0);
283 }
284 
285 #define MAXREGDESOBJS 256
286 static int         PetscObjectRegisterDestroy_Count = 0;
287 static PetscObject PetscObjectRegisterDestroy_Objects[MAXREGDESOBJS];
288 
289 /*@C
290    PetscObjectRegisterDestroy - Registers a PETSc object to be destroyed when
291      PetscFinalize() is called.
292 
293    Logically Collective on PetscObject
294 
295    Input Parameter:
296 .  obj - any PETSc object, for example a Vec, Mat or KSP.
297          This must be cast with a (PetscObject), for example,
298          PetscObjectRegisterDestroy((PetscObject)mat);
299 
300    Level: developer
301 
302    Notes:
303       This is used by, for example, PETSC_VIEWER_XXX_() routines to free the viewer
304     when PETSc ends.
305 
306 .seealso: PetscObjectRegisterDestroyAll()
307 @*/
PetscObjectRegisterDestroy(PetscObject obj)308 PetscErrorCode  PetscObjectRegisterDestroy(PetscObject obj)
309 {
310   PetscFunctionBegin;
311   PetscValidHeader(obj,1);
312   if (PetscObjectRegisterDestroy_Count < MAXREGDESOBJS) PetscObjectRegisterDestroy_Objects[PetscObjectRegisterDestroy_Count++] = obj;
313   else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"No more room in array, limit %d \n recompile src/sys/objects/destroy.c with larger value for MAXREGDESOBJS\n",MAXREGDESOBJS);
314   PetscFunctionReturn(0);
315 }
316 
317 /*@C
318    PetscObjectRegisterDestroyAll - Frees all the PETSc objects that have been registered
319      with PetscObjectRegisterDestroy(). Called by PetscFinalize()
320 
321    Logically Collective on individual PetscObjects
322 
323    Level: developer
324 
325 .seealso: PetscObjectRegisterDestroy()
326 @*/
PetscObjectRegisterDestroyAll(void)327 PetscErrorCode  PetscObjectRegisterDestroyAll(void)
328 {
329   PetscErrorCode ierr;
330   PetscInt       i;
331 
332   PetscFunctionBegin;
333   for (i=0; i<PetscObjectRegisterDestroy_Count; i++) {
334     ierr = PetscObjectDestroy(&PetscObjectRegisterDestroy_Objects[i]);CHKERRQ(ierr);
335   }
336   PetscObjectRegisterDestroy_Count = 0;
337   PetscFunctionReturn(0);
338 }
339 
340 
341 #define MAXREGFIN 256
342 static int PetscRegisterFinalize_Count = 0;
343 static PetscErrorCode (*PetscRegisterFinalize_Functions[MAXREGFIN])(void);
344 
345 /*@C
346    PetscRegisterFinalize - Registers a function that is to be called in PetscFinalize()
347 
348    Not Collective
349 
350    Input Parameter:
351 .  PetscErrorCode (*fun)(void) -
352 
353    Level: developer
354 
355    Notes:
356       This is used by, for example, DMInitializePackage() to have DMFinalizePackage() called
357 
358 .seealso: PetscRegisterFinalizeAll()
359 @*/
PetscRegisterFinalize(PetscErrorCode (* f)(void))360 PetscErrorCode  PetscRegisterFinalize(PetscErrorCode (*f)(void))
361 {
362   PetscInt i;
363 
364   PetscFunctionBegin;
365   for (i=0; i<PetscRegisterFinalize_Count; i++) {
366     if (f == PetscRegisterFinalize_Functions[i]) PetscFunctionReturn(0);
367   }
368   if (PetscRegisterFinalize_Count < MAXREGFIN) PetscRegisterFinalize_Functions[PetscRegisterFinalize_Count++] = f;
369   else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"No more room in array, limit %d \n recompile src/sys/objects/destroy.c with larger value for MAXREGFIN\n",MAXREGFIN);
370   PetscFunctionReturn(0);
371 }
372 
373 /*@C
374    PetscRegisterFinalizeAll - Runs all the finalize functions set with PetscRegisterFinalize()
375 
376    Not Collective unless registered functions are collective
377 
378    Level: developer
379 
380 .seealso: PetscRegisterFinalize()
381 @*/
PetscRegisterFinalizeAll(void)382 PetscErrorCode  PetscRegisterFinalizeAll(void)
383 {
384   PetscErrorCode ierr;
385   PetscInt       i;
386 
387   PetscFunctionBegin;
388   for (i=0; i<PetscRegisterFinalize_Count; i++) {
389     ierr = (*PetscRegisterFinalize_Functions[i])();CHKERRQ(ierr);
390   }
391   PetscRegisterFinalize_Count = 0;
392   PetscFunctionReturn(0);
393 }
394