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