xref: /petsc/src/sys/objects/pinit.c (revision dc4f8bb936e78c7d3f06fcc75c61ec3f64a2a286)
1 #define PETSC_DESIRE_FEATURE_TEST_MACROS
2 /*
3    This file defines the initialization of PETSc, including PetscInitialize()
4 */
5 #include <petsc/private/petscimpl.h> /*I  "petscsys.h"   I*/
6 #include <petscviewer.h>
7 #include <petsc/private/garbagecollector.h>
8 
9 #if !defined(PETSC_HAVE_WINDOWS_COMPILERS)
10   #include <petsc/private/valgrind/valgrind.h>
11 #endif
12 
13 #if defined(PETSC_HAVE_FORTRAN)
14   #include <petsc/private/fortranimpl.h>
15 #endif
16 
17 #if PetscDefined(USE_COVERAGE)
18 EXTERN_C_BEGIN
19   #if defined(PETSC_HAVE___GCOV_DUMP)
20     #define __gcov_flush(x) __gcov_dump(x)
21   #endif
22 void __gcov_flush(void);
23 EXTERN_C_END
24 #endif
25 
26 #if defined(PETSC_SERIALIZE_FUNCTIONS)
27 PETSC_INTERN PetscFPT PetscFPTData;
28 PetscFPT              PetscFPTData = 0;
29 #endif
30 
31 #if PetscDefined(HAVE_SAWS)
32   #include <petscviewersaws.h>
33 #endif
34 
35 /* -----------------------------------------------------------------------------------------*/
36 
37 PETSC_INTERN FILE *petsc_history;
38 
39 PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void);
40 PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void);
41 PETSC_INTERN PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm, int);
42 PETSC_INTERN PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm, int);
43 PETSC_INTERN PetscErrorCode PetscCloseHistoryFile(FILE **);
44 
45 /* user may set these BEFORE calling PetscInitialize() */
46 MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL;
47 #if PetscDefined(HAVE_MPI_INIT_THREAD)
48 PetscMPIInt PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_FUNNELED;
49 #else
50 PetscMPIInt PETSC_MPI_THREAD_REQUIRED = 0;
51 #endif
52 
53 PetscMPIInt Petsc_Counter_keyval      = MPI_KEYVAL_INVALID;
54 PetscMPIInt Petsc_InnerComm_keyval    = MPI_KEYVAL_INVALID;
55 PetscMPIInt Petsc_OuterComm_keyval    = MPI_KEYVAL_INVALID;
56 PetscMPIInt Petsc_ShmComm_keyval      = MPI_KEYVAL_INVALID;
57 PetscMPIInt Petsc_CreationIdx_keyval  = MPI_KEYVAL_INVALID;
58 PetscMPIInt Petsc_Garbage_HMap_keyval = MPI_KEYVAL_INVALID;
59 
60 PetscMPIInt Petsc_SharedWD_keyval  = MPI_KEYVAL_INVALID;
61 PetscMPIInt Petsc_SharedTmp_keyval = MPI_KEYVAL_INVALID;
62 
63 /*
64      Declare and set all the string names of the PETSc enums
65 */
66 const char *const PetscBools[]     = {"FALSE", "TRUE", "PetscBool", "PETSC_", NULL};
67 const char *const PetscCopyModes[] = {"COPY_VALUES", "OWN_POINTER", "USE_POINTER", "PetscCopyMode", "PETSC_", NULL};
68 
69 PetscBool PetscPreLoadingUsed = PETSC_FALSE;
70 PetscBool PetscPreLoadingOn   = PETSC_FALSE;
71 
72 PetscInt PetscHotRegionDepth;
73 
74 PetscBool PETSC_RUNNING_ON_VALGRIND = PETSC_FALSE;
75 
76 #if defined(PETSC_HAVE_THREADSAFETY)
77 PetscSpinlock PetscViewerASCIISpinLockOpen;
78 PetscSpinlock PetscViewerASCIISpinLockStdout;
79 PetscSpinlock PetscViewerASCIISpinLockStderr;
80 PetscSpinlock PetscCommSpinLock;
81 #endif
82 
83 /*
84       PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args
85 
86    Collective
87 
88    Level: advanced
89 
90     Notes:
91     this is called only by the PETSc Julia interface. Even though it might start MPI it sets the flag to
92      indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to
93      be called multiple times from Julia without the problem of trying to initialize MPI more than once.
94 
95      Developer Note: Turns off PETSc signal handling to allow Julia to manage signals
96 
97 .seealso: `PetscInitialize()`, `PetscInitializeFortran()`, `PetscInitializeNoArguments()`
98 */
99 PetscErrorCode PetscInitializeNoPointers(int argc, char **args, const char *filename, const char *help)
100 {
101   int    myargc = argc;
102   char **myargs = args;
103 
104   PetscFunctionBegin;
105   PetscCall(PetscInitialize(&myargc, &myargs, filename, help));
106   PetscCall(PetscPopSignalHandler());
107   PetscBeganMPI = PETSC_FALSE;
108   PetscFunctionReturn(PETSC_SUCCESS);
109 }
110 
111 /*
112       Used by Julia interface to get communicator
113 */
114 PetscErrorCode PetscGetPETSC_COMM_SELF(MPI_Comm *comm)
115 {
116   PetscFunctionBegin;
117   if (PetscInitializeCalled) PetscValidPointer(comm, 1);
118   *comm = PETSC_COMM_SELF;
119   PetscFunctionReturn(PETSC_SUCCESS);
120 }
121 
122 /*@C
123       PetscInitializeNoArguments - Calls `PetscInitialize()` from C/C++ without
124         the command line arguments.
125 
126    Collective
127 
128    Level: advanced
129 
130 .seealso: `PetscInitialize()`, `PetscInitializeFortran()`
131 @*/
132 PetscErrorCode PetscInitializeNoArguments(void)
133 {
134   int    argc = 0;
135   char **args = NULL;
136 
137   PetscFunctionBegin;
138   PetscCall(PetscInitialize(&argc, &args, NULL, NULL));
139   PetscFunctionReturn(PETSC_SUCCESS);
140 }
141 
142 /*@
143       PetscInitialized - Determine whether PETSc is initialized.
144 
145    Level: beginner
146 
147 .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
148 @*/
149 PetscErrorCode PetscInitialized(PetscBool *isInitialized)
150 {
151   PetscFunctionBegin;
152   if (PetscInitializeCalled) PetscValidBoolPointer(isInitialized, 1);
153   *isInitialized = PetscInitializeCalled;
154   PetscFunctionReturn(PETSC_SUCCESS);
155 }
156 
157 /*@
158       PetscFinalized - Determine whether `PetscFinalize()` has been called yet
159 
160    Level: developer
161 
162 .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
163 @*/
164 PetscErrorCode PetscFinalized(PetscBool *isFinalized)
165 {
166   PetscFunctionBegin;
167   if (!PetscFinalizeCalled) PetscValidBoolPointer(isFinalized, 1);
168   *isFinalized = PetscFinalizeCalled;
169   PetscFunctionReturn(PETSC_SUCCESS);
170 }
171 
172 PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Private(const char[]);
173 
174 /*
175        This function is the MPI reduction operation used to compute the sum of the
176    first half of the datatype and the max of the second half.
177 */
178 MPI_Op MPIU_MAXSUM_OP               = 0;
179 MPI_Op Petsc_Garbage_SetIntersectOp = 0;
180 
181 PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void *in, void *out, int *cnt, MPI_Datatype *datatype)
182 {
183   PetscInt *xin = (PetscInt *)in, *xout = (PetscInt *)out, i, count = *cnt;
184 
185   PetscFunctionBegin;
186   if (*datatype != MPIU_2INT) {
187     PetscErrorCode ierr = (*PetscErrorPrintf)("Can only handle MPIU_2INT data types");
188     (void)ierr;
189     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
190   }
191 
192   for (i = 0; i < count; i++) {
193     xout[2 * i] = PetscMax(xout[2 * i], xin[2 * i]);
194     xout[2 * i + 1] += xin[2 * i + 1];
195   }
196   PetscFunctionReturnVoid();
197 }
198 
199 /*
200     Returns the max of the first entry owned by this processor and the
201 sum of the second entry.
202 
203     The reason sizes[2*i] contains lengths sizes[2*i+1] contains flag of 1 if length is nonzero
204 is so that the MPIU_MAXSUM_OP() can set TWO values, if we passed in only sizes[i] with lengths
205 there would be no place to store the both needed results.
206 */
207 PetscErrorCode PetscMaxSum(MPI_Comm comm, const PetscInt sizes[], PetscInt *max, PetscInt *sum)
208 {
209   PetscFunctionBegin;
210 #if defined(PETSC_HAVE_MPI_REDUCE_SCATTER_BLOCK)
211   {
212     struct {
213       PetscInt max, sum;
214     } work;
215     PetscCallMPI(MPI_Reduce_scatter_block((void *)sizes, &work, 1, MPIU_2INT, MPIU_MAXSUM_OP, comm));
216     *max = work.max;
217     *sum = work.sum;
218   }
219 #else
220   {
221     PetscMPIInt size, rank;
222     struct {
223       PetscInt max, sum;
224     } *work;
225     PetscCallMPI(MPI_Comm_size(comm, &size));
226     PetscCallMPI(MPI_Comm_rank(comm, &rank));
227     PetscCall(PetscMalloc1(size, &work));
228     PetscCall(MPIU_Allreduce((void *)sizes, work, size, MPIU_2INT, MPIU_MAXSUM_OP, comm));
229     *max = work[rank].max;
230     *sum = work[rank].sum;
231     PetscCall(PetscFree(work));
232   }
233 #endif
234   PetscFunctionReturn(PETSC_SUCCESS);
235 }
236 
237 /* ----------------------------------------------------------------------------*/
238 
239 #if defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
240   #if defined(PETSC_HAVE_REAL___FLOAT128)
241     #include <quadmath.h>
242   #endif
243 MPI_Op MPIU_SUM___FP16___FLOAT128 = 0;
244   #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
245 MPI_Op MPIU_SUM = 0;
246   #endif
247 
248 PETSC_EXTERN void MPIAPI PetscSum_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
249 {
250   PetscInt i, count = *cnt;
251 
252   PetscFunctionBegin;
253   if (*datatype == MPIU_REAL) {
254     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
255     for (i = 0; i < count; i++) xout[i] += xin[i];
256   }
257   #if defined(PETSC_HAVE_COMPLEX)
258   else if (*datatype == MPIU_COMPLEX) {
259     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
260     for (i = 0; i < count; i++) xout[i] += xin[i];
261   }
262   #endif
263   #if defined(PETSC_HAVE_REAL___FLOAT128)
264   else if (*datatype == MPIU___FLOAT128) {
265     __float128 *xin = (__float128 *)in, *xout = (__float128 *)out;
266     for (i = 0; i < count; i++) xout[i] += xin[i];
267     #if defined(PETSC_HAVE_COMPLEX)
268   } else if (*datatype == MPIU___COMPLEX128) {
269     __complex128 *xin = (__complex128 *)in, *xout = (__complex128 *)out;
270     for (i = 0; i < count; i++) xout[i] += xin[i];
271     #endif
272   }
273   #endif
274   #if defined(PETSC_HAVE_REAL___FP16)
275   else if (*datatype == MPIU___FP16) {
276     __fp16 *xin = (__fp16 *)in, *xout = (__fp16 *)out;
277     for (i = 0; i < count; i++) xout[i] += xin[i];
278   }
279   #endif
280   else {
281   #if !defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_HAVE_REAL___FP16)
282     PetscCallAbort(MPI_COMM_SElF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
283   #elif !defined(PETSC_HAVE_REAL___FP16)
284     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, or MPIU___COMPLEX128 data types"));
285   #elif !defined(PETSC_HAVE_REAL___FLOAT128)
286     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, or MPIU___FP16 data types"));
287   #else
288     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, MPIU___COMPLEX128, or MPIU___FP16 data types"));
289   #endif
290     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
291   }
292   PetscFunctionReturnVoid();
293 }
294 #endif
295 
296 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
297 MPI_Op MPIU_MAX = 0;
298 MPI_Op MPIU_MIN = 0;
299 
300 PETSC_EXTERN void MPIAPI PetscMax_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
301 {
302   PetscInt i, count = *cnt;
303 
304   PetscFunctionBegin;
305   if (*datatype == MPIU_REAL) {
306     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
307     for (i = 0; i < count; i++) xout[i] = PetscMax(xout[i], xin[i]);
308   }
309   #if defined(PETSC_HAVE_COMPLEX)
310   else if (*datatype == MPIU_COMPLEX) {
311     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
312     for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) < PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
313   }
314   #endif
315   else {
316     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
317     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
318   }
319   PetscFunctionReturnVoid();
320 }
321 
322 PETSC_EXTERN void MPIAPI PetscMin_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
323 {
324   PetscInt i, count = *cnt;
325 
326   PetscFunctionBegin;
327   if (*datatype == MPIU_REAL) {
328     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
329     for (i = 0; i < count; i++) xout[i] = PetscMin(xout[i], xin[i]);
330   }
331   #if defined(PETSC_HAVE_COMPLEX)
332   else if (*datatype == MPIU_COMPLEX) {
333     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
334     for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) > PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
335   }
336   #endif
337   else {
338     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"));
339     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
340   }
341   PetscFunctionReturnVoid();
342 }
343 #endif
344 
345 /*
346    Private routine to delete internal tag/name counter storage when a communicator is freed.
347 
348    This is called by MPI, not by users. This is called by MPI_Comm_free() when the communicator that has this  data as an attribute is freed.
349 
350    Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()
351 
352 */
353 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_Counter_Attr_Delete_Fn(MPI_Comm comm, PetscMPIInt keyval, void *count_val, void *extra_state)
354 {
355   PetscCommCounter      *counter = (PetscCommCounter *)count_val;
356   struct PetscCommStash *comms   = counter->comms, *pcomm;
357 
358   PetscFunctionBegin;
359   PetscCallMPI(PetscInfo(NULL, "Deleting counter data in an MPI_Comm %ld\n", (long)comm));
360   PetscCallMPI(PetscFree(counter->iflags));
361   while (comms) {
362     PetscCallMPI(MPI_Comm_free(&comms->comm));
363     pcomm = comms;
364     comms = comms->next;
365     PetscCall(PetscFree(pcomm));
366   }
367   PetscCallMPI(PetscFree(counter));
368   PetscFunctionReturn(MPI_SUCCESS);
369 }
370 
371 /*
372   This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Comm_delete_attr) or when the user
373   calls MPI_Comm_free().
374 
375   This is the only entry point for breaking the links between inner and outer comms.
376 
377   This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator.
378 
379   Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()
380 
381 */
382 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_InnerComm_Attr_Delete_Fn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
383 {
384   union
385   {
386     MPI_Comm comm;
387     void    *ptr;
388   } icomm;
389 
390   PetscFunctionBegin;
391   if (keyval != Petsc_InnerComm_keyval) SETERRMPI(PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Unexpected keyval");
392   icomm.ptr = attr_val;
393   if (PetscDefined(USE_DEBUG)) {
394     /* Error out if the inner/outer comms are not correctly linked through their Outer/InnterComm attributes */
395     PetscMPIInt flg;
396     union
397     {
398       MPI_Comm comm;
399       void    *ptr;
400     } ocomm;
401     PetscCallMPI(MPI_Comm_get_attr(icomm.comm, Petsc_OuterComm_keyval, &ocomm, &flg));
402     if (!flg) SETERRMPI(PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm does not have OuterComm attribute");
403     if (ocomm.comm != comm) SETERRMPI(PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm's OuterComm attribute does not point to outer PETSc comm");
404   }
405   PetscCallMPI(MPI_Comm_delete_attr(icomm.comm, Petsc_OuterComm_keyval));
406   PetscCallMPI(PetscInfo(NULL, "User MPI_Comm %ld is being unlinked from inner PETSc comm %ld\n", (long)comm, (long)icomm.comm));
407   PetscFunctionReturn(MPI_SUCCESS);
408 }
409 
410 /*
411  * This is invoked on the inner comm when Petsc_InnerComm_Attr_Delete_Fn calls MPI_Comm_delete_attr().  It should not be reached any other way.
412  */
413 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_OuterComm_Attr_Delete_Fn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
414 {
415   PetscFunctionBegin;
416   PetscCallMPI(PetscInfo(NULL, "Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n", (long)comm));
417   PetscFunctionReturn(MPI_SUCCESS);
418 }
419 
420 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_ShmComm_Attr_Delete_Fn(MPI_Comm, PetscMPIInt, void *, void *);
421 
422 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
423 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype, MPI_Aint *, void *);
424 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
425 PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
426 #endif
427 
428 PetscMPIInt PETSC_MPI_ERROR_CLASS = MPI_ERR_LASTCODE, PETSC_MPI_ERROR_CODE;
429 
430 PETSC_INTERN int    PetscGlobalArgc;
431 PETSC_INTERN char **PetscGlobalArgs;
432 int                 PetscGlobalArgc = 0;
433 char              **PetscGlobalArgs = NULL;
434 PetscSegBuffer      PetscCitationsList;
435 
436 PetscErrorCode PetscCitationsInitialize(void)
437 {
438   PetscFunctionBegin;
439   PetscCall(PetscSegBufferCreate(1, 10000, &PetscCitationsList));
440 
441   PetscCall(PetscCitationsRegister("@TechReport{petsc-user-ref,\n\
442   Author = {Satish Balay and Shrirang Abhyankar and Mark~F. Adams and Steven Benson and Jed Brown\n\
443     and Peter Brune and Kris Buschelman and Emil Constantinescu and Lisandro Dalcin and Alp Dener\n\
444     and Victor Eijkhout and Jacob Faibussowitsch and William~D. Gropp and V\'{a}clav Hapla and Tobin Isaac and Pierre Jolivet\n\
445     and Dmitry Karpeev and Dinesh Kaushik and Matthew~G. Knepley and Fande Kong and Scott Kruger\n\
446     and Dave~A. May and Lois Curfman McInnes and Richard Tran Mills and Lawrence Mitchell and Todd Munson\n\
447     and Jose~E. Roman and Karl Rupp and Patrick Sanan and Jason Sarich and Barry~F. Smith\n\
448     and Stefano Zampini and Hong Zhang and Hong Zhang and Junchao Zhang},\n\
449   Title = {{PETSc/TAO} Users Manual},\n\
450   Number = {ANL-21/39 - Revision 3.19},\n\
451   Institution = {Argonne National Laboratory},\n\
452   Year = {2023}\n}\n",
453                                    NULL));
454 
455   PetscCall(PetscCitationsRegister("@InProceedings{petsc-efficient,\n\
456   Author = {Satish Balay and William D. Gropp and Lois Curfman McInnes and Barry F. Smith},\n\
457   Title = {Efficient Management of Parallelism in Object Oriented Numerical Software Libraries},\n\
458   Booktitle = {Modern Software Tools in Scientific Computing},\n\
459   Editor = {E. Arge and A. M. Bruaset and H. P. Langtangen},\n\
460   Pages = {163--202},\n\
461   Publisher = {Birkh{\\\"{a}}user Press},\n\
462   Year = {1997}\n}\n",
463                                    NULL));
464 
465   PetscFunctionReturn(PETSC_SUCCESS);
466 }
467 
468 static char programname[PETSC_MAX_PATH_LEN] = ""; /* HP includes entire path in name */
469 
470 PetscErrorCode PetscSetProgramName(const char name[])
471 {
472   PetscFunctionBegin;
473   PetscCall(PetscStrncpy(programname, name, sizeof(programname)));
474   PetscFunctionReturn(PETSC_SUCCESS);
475 }
476 
477 /*@C
478     PetscGetProgramName - Gets the name of the running program.
479 
480     Not Collective
481 
482     Input Parameter:
483 .   len - length of the string name
484 
485     Output Parameter:
486 .   name - the name of the running program, provide a string of length `PETSC_MAX_PATH_LEN`
487 
488    Level: advanced
489 
490 @*/
491 PetscErrorCode PetscGetProgramName(char name[], size_t len)
492 {
493   PetscFunctionBegin;
494   PetscCall(PetscStrncpy(name, programname, len));
495   PetscFunctionReturn(PETSC_SUCCESS);
496 }
497 
498 /*@C
499    PetscGetArgs - Allows you to access the raw command line arguments anywhere
500      after PetscInitialize() is called but before `PetscFinalize()`.
501 
502    Not Collective
503 
504    Output Parameters:
505 +  argc - count of number of command line arguments
506 -  args - the command line arguments
507 
508    Level: intermediate
509 
510    Notes:
511       This is usually used to pass the command line arguments into other libraries
512    that are called internally deep in PETSc or the application.
513 
514       The first argument contains the program name as is normal for C arguments.
515 
516 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArguments()`
517 @*/
518 PetscErrorCode PetscGetArgs(int *argc, char ***args)
519 {
520   PetscFunctionBegin;
521   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
522   *argc = PetscGlobalArgc;
523   *args = PetscGlobalArgs;
524   PetscFunctionReturn(PETSC_SUCCESS);
525 }
526 
527 /*@C
528    PetscGetArguments - Allows you to access the  command line arguments anywhere
529      after `PetscInitialize()` is called but before `PetscFinalize()`.
530 
531    Not Collective
532 
533    Output Parameter:
534 .  args - the command line arguments
535 
536    Level: intermediate
537 
538    Notes:
539       This does NOT start with the program name and IS null terminated (final arg is void)
540 
541 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscFreeArguments()`
542 @*/
543 PetscErrorCode PetscGetArguments(char ***args)
544 {
545   PetscInt i, argc = PetscGlobalArgc;
546 
547   PetscFunctionBegin;
548   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
549   if (!argc) {
550     *args = NULL;
551     PetscFunctionReturn(PETSC_SUCCESS);
552   }
553   PetscCall(PetscMalloc1(argc, args));
554   for (i = 0; i < argc - 1; i++) PetscCall(PetscStrallocpy(PetscGlobalArgs[i + 1], &(*args)[i]));
555   (*args)[argc - 1] = NULL;
556   PetscFunctionReturn(PETSC_SUCCESS);
557 }
558 
559 /*@C
560    PetscFreeArguments - Frees the memory obtained with `PetscGetArguments()`
561 
562    Not Collective
563 
564    Output Parameter:
565 .  args - the command line arguments
566 
567    Level: intermediate
568 
569 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscGetArguments()`
570 @*/
571 PetscErrorCode PetscFreeArguments(char **args)
572 {
573   PetscFunctionBegin;
574   if (args) {
575     PetscInt i = 0;
576 
577     while (args[i]) PetscCall(PetscFree(args[i++]));
578     PetscCall(PetscFree(args));
579   }
580   PetscFunctionReturn(PETSC_SUCCESS);
581 }
582 
583 #if PetscDefined(HAVE_SAWS)
584   #include <petscconfiginfo.h>
585 
586 PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char help[])
587 {
588   PetscFunctionBegin;
589   if (!PetscGlobalRank) {
590     char      cert[PETSC_MAX_PATH_LEN], root[PETSC_MAX_PATH_LEN], *intro, programname[64], *appline, *options, version[64];
591     int       port;
592     PetscBool flg, rootlocal = PETSC_FALSE, flg2, selectport = PETSC_FALSE;
593     size_t    applinelen, introlen;
594     char      sawsurl[256];
595 
596     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_log", &flg));
597     if (flg) {
598       char sawslog[PETSC_MAX_PATH_LEN];
599 
600       PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_log", sawslog, sizeof(sawslog), NULL));
601       if (sawslog[0]) {
602         PetscCallSAWs(SAWs_Set_Use_Logfile, (sawslog));
603       } else {
604         PetscCallSAWs(SAWs_Set_Use_Logfile, (NULL));
605       }
606     }
607     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_https", cert, sizeof(cert), &flg));
608     if (flg) PetscCallSAWs(SAWs_Set_Use_HTTPS, (cert));
609     PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select", &selectport, NULL));
610     if (selectport) {
611       PetscCallSAWs(SAWs_Get_Available_Port, (&port));
612       PetscCallSAWs(SAWs_Set_Port, (port));
613     } else {
614       PetscCall(PetscOptionsGetInt(NULL, NULL, "-saws_port", &port, &flg));
615       if (flg) PetscCallSAWs(SAWs_Set_Port, (port));
616     }
617     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_root", root, sizeof(root), &flg));
618     if (flg) {
619       PetscCallSAWs(SAWs_Set_Document_Root, (root));
620       PetscCall(PetscStrcmp(root, ".", &rootlocal));
621     } else {
622       PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_options", &flg));
623       if (flg) {
624         PetscCall(PetscStrreplace(PETSC_COMM_WORLD, "${PETSC_DIR}/share/petsc/saws", root, sizeof(root)));
625         PetscCallSAWs(SAWs_Set_Document_Root, (root));
626       }
627     }
628     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_local", &flg2));
629     if (flg2) {
630       char jsdir[PETSC_MAX_PATH_LEN];
631       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_SUP, "-saws_local option requires -saws_root option");
632       PetscCall(PetscSNPrintf(jsdir, sizeof(jsdir), "%s/js", root));
633       PetscCall(PetscTestDirectory(jsdir, 'r', &flg));
634       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "-saws_local option requires js directory in root directory");
635       PetscCallSAWs(SAWs_Push_Local_Header, ());
636     }
637     PetscCall(PetscGetProgramName(programname, sizeof(programname)));
638     PetscCall(PetscStrlen(help, &applinelen));
639     introlen = 4096 + applinelen;
640     applinelen += 1024;
641     PetscCall(PetscMalloc(applinelen, &appline));
642     PetscCall(PetscMalloc(introlen, &intro));
643 
644     if (rootlocal) {
645       PetscCall(PetscSNPrintf(appline, applinelen, "%s.c.html", programname));
646       PetscCall(PetscTestFile(appline, 'r', &rootlocal));
647     }
648     PetscCall(PetscOptionsGetAll(NULL, &options));
649     if (rootlocal && help) {
650       PetscCall(PetscSNPrintf(appline, applinelen, "<center> Running <a href=\"%s.c.html\">%s</a> %s</center><br><center><pre>%s</pre></center><br>\n", programname, programname, options, help));
651     } else if (help) {
652       PetscCall(PetscSNPrintf(appline, applinelen, "<center>Running %s %s</center><br><center><pre>%s</pre></center><br>", programname, options, help));
653     } else {
654       PetscCall(PetscSNPrintf(appline, applinelen, "<center> Running %s %s</center><br>\n", programname, options));
655     }
656     PetscCall(PetscFree(options));
657     PetscCall(PetscGetVersion(version, sizeof(version)));
658     PetscCall(PetscSNPrintf(intro, introlen,
659                             "<body>\n"
660                             "<center><h2> <a href=\"https://petsc.org/\">PETSc</a> Application Web server powered by <a href=\"https://bitbucket.org/saws/saws\">SAWs</a> </h2></center>\n"
661                             "<center>This is the default PETSc application dashboard, from it you can access any published PETSc objects or logging data</center><br><center>%s configured with %s</center><br>\n"
662                             "%s",
663                             version, petscconfigureoptions, appline));
664     PetscCallSAWs(SAWs_Push_Body, ("index.html", 0, intro));
665     PetscCall(PetscFree(intro));
666     PetscCall(PetscFree(appline));
667     if (selectport) {
668       PetscBool silent;
669 
670       /* another process may have grabbed the port so keep trying */
671       while (SAWs_Initialize()) {
672         PetscCallSAWs(SAWs_Get_Available_Port, (&port));
673         PetscCallSAWs(SAWs_Set_Port, (port));
674       }
675 
676       PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select_silent", &silent, NULL));
677       if (!silent) {
678         PetscCallSAWs(SAWs_Get_FullURL, (sizeof(sawsurl), sawsurl));
679         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Point your browser to %s for SAWs\n", sawsurl));
680       }
681     } else {
682       PetscCallSAWs(SAWs_Initialize, ());
683     }
684     PetscCall(PetscCitationsRegister("@TechReport{ saws,\n"
685                                      "  Author = {Matt Otten and Jed Brown and Barry Smith},\n"
686                                      "  Title  = {Scientific Application Web Server (SAWs) Users Manual},\n"
687                                      "  Institution = {Argonne National Laboratory},\n"
688                                      "  Year   = 2013\n}\n",
689                                      NULL));
690   }
691   PetscFunctionReturn(PETSC_SUCCESS);
692 }
693 #endif
694 
695 /* Things must be done before MPI_Init() when MPI is not yet initialized, and can be shared between C init and Fortran init */
696 PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(void)
697 {
698   PetscFunctionBegin;
699 #if defined(PETSC_HAVE_HWLOC_SOLARIS_BUG)
700   /* see MPI.py for details on this bug */
701   (void)setenv("HWLOC_COMPONENTS", "-x86", 1);
702 #endif
703   PetscFunctionReturn(PETSC_SUCCESS);
704 }
705 
706 #if PetscDefined(HAVE_ADIOS)
707   #include <adios.h>
708   #include <adios_read.h>
709 int64_t Petsc_adios_group;
710 #endif
711 #if PetscDefined(HAVE_OPENMP)
712   #include <omp.h>
713 PetscInt PetscNumOMPThreads;
714 #endif
715 
716 #include <petsc/private/deviceimpl.h>
717 #if PetscDefined(HAVE_CUDA)
718   #include <petscdevice_cuda.h>
719 // REMOVE ME
720 cudaStream_t PetscDefaultCudaStream = NULL;
721 #endif
722 #if PetscDefined(HAVE_HIP)
723   #include <petscdevice_hip.h>
724 // REMOVE ME
725 hipStream_t PetscDefaultHipStream = NULL;
726 #endif
727 
728 #if PetscDefined(HAVE_DLFCN_H)
729   #include <dlfcn.h>
730 #endif
731 #if PetscDefined(USE_LOG)
732 PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
733 #endif
734 #if PetscDefined(HAVE_VIENNACL)
735 PETSC_EXTERN PetscErrorCode PetscViennaCLInit(void);
736 PetscBool                   PetscViennaCLSynchronize = PETSC_FALSE;
737 #endif
738 
739 PetscBool PetscCIEnabled = PETSC_FALSE, PetscCIEnabledPortableErrorOutput = PETSC_FALSE;
740 
741 /*
742   PetscInitialize_Common  - shared code between C and Fortran initialization
743 
744   prog:     program name
745   file:     optional PETSc database file name. Might be in Fortran string format when 'ftn' is true
746   help:     program help message
747   ftn:      is it called from Fortran initialization (petscinitializef_)?
748   readarguments,len: used when fortran is true
749 */
750 PETSC_INTERN PetscErrorCode PetscInitialize_Common(const char *prog, const char *file, const char *help, PetscBool ftn, PetscBool readarguments, PetscInt len)
751 {
752   PetscMPIInt size;
753   PetscBool   flg = PETSC_TRUE;
754   char        hostname[256];
755 
756   PetscFunctionBegin;
757   if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
758   /* these must be initialized in a routine, not as a constant declaration */
759   PETSC_STDOUT = stdout;
760   PETSC_STDERR = stderr;
761 
762   /* PetscCall can be used from now */
763   PetscErrorHandlingInitialized = PETSC_TRUE;
764 
765   /*
766       The checking over compatible runtime libraries is complicated by the MPI ABI initiative
767       https://wiki.mpich.org/mpich/index.php/ABI_Compatibility_Initiative which started with
768         MPICH v3.1 (Released February 2014)
769         IBM MPI v2.1 (December 2014)
770         Intel MPI Library v5.0 (2014)
771         Cray MPT v7.0.0 (June 2014)
772       As of July 31, 2017 the ABI number still appears to be 12, that is all of the versions
773       listed above and since that time are compatible.
774 
775       Unfortunately the MPI ABI initiative has not defined a way to determine the ABI number
776       at compile time or runtime. Thus we will need to systematically track the allowed versions
777       and how they are represented in the mpi.h and MPI_Get_library_version() output in order
778       to perform the checking.
779 
780       Currently we only check for pre MPI ABI versions (and packages that do not follow the MPI ABI).
781 
782       Questions:
783 
784         Should the checks for ABI incompatibility be only on the major version number below?
785         Presumably the output to stderr will be removed before a release.
786   */
787 
788 #if defined(PETSC_HAVE_MPI_GET_LIBRARY_VERSION)
789   {
790     char        mpilibraryversion[MPI_MAX_LIBRARY_VERSION_STRING];
791     PetscMPIInt mpilibraryversionlength;
792 
793     PetscCallMPI(MPI_Get_library_version(mpilibraryversion, &mpilibraryversionlength));
794     /* check for MPICH versions before MPI ABI initiative */
795   #if defined(MPICH_VERSION)
796     #if MPICH_NUMVERSION < 30100000
797     {
798       char     *ver, *lf;
799       PetscBool flg = PETSC_FALSE;
800 
801       PetscCall(PetscStrstr(mpilibraryversion, "MPICH Version:", &ver));
802       if (ver) {
803         PetscCall(PetscStrchr(ver, '\n', &lf));
804         if (lf) {
805           *lf = 0;
806           PetscCall(PetscStrendswith(ver, MPICH_VERSION, &flg));
807         }
808       }
809       if (!flg) {
810         PetscCall(PetscInfo(NULL, "PETSc warning --- MPICH library version \n%s does not match what PETSc was compiled with %s.\n", mpilibraryversion, MPICH_VERSION));
811         flg = PETSC_TRUE;
812       }
813     }
814     #endif
815       /* check for OpenMPI version, it is not part of the MPI ABI initiative (is it part of another initiative that needs to be handled?) */
816   #elif defined(OMPI_MAJOR_VERSION)
817     {
818       char     *ver, bs[MPI_MAX_LIBRARY_VERSION_STRING], *bsf;
819       PetscBool flg                                              = PETSC_FALSE;
820     #define PSTRSZ 2
821       char      ompistr1[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"Open MPI", "FUJITSU MPI"};
822       char      ompistr2[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"v", "Library "};
823       int       i;
824       for (i = 0; i < PSTRSZ; i++) {
825         PetscCall(PetscStrstr(mpilibraryversion, ompistr1[i], &ver));
826         if (ver) {
827           PetscCall(PetscSNPrintf(bs, MPI_MAX_LIBRARY_VERSION_STRING, "%s%d.%d", ompistr2[i], OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION));
828           PetscCall(PetscStrstr(ver, bs, &bsf));
829           if (bsf) flg = PETSC_TRUE;
830           break;
831         }
832       }
833       if (!flg) {
834         PetscCall(PetscInfo(NULL, "PETSc warning --- Open MPI library version \n%s does not match what PETSc was compiled with %d.%d.\n", mpilibraryversion, OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION));
835         flg = PETSC_TRUE;
836       }
837     }
838   #endif
839   }
840 #endif
841 
842 #if defined(PETSC_HAVE_DLADDR) && !(defined(__cray__) && defined(__clang__))
843   /* These symbols are currently in the OpenMPI and MPICH libraries; they may not always be, in that case the test will simply not detect the problem */
844   PetscCheck(!dlsym(RTLD_DEFAULT, "ompi_mpi_init") || !dlsym(RTLD_DEFAULT, "MPID_Abort"), PETSC_COMM_SELF, PETSC_ERR_MPI_LIB_INCOMP, "Application was linked against both OpenMPI and MPICH based MPI libraries and will not run correctly");
845 #endif
846 
847   /* on Windows - set printf to default to printing 2 digit exponents */
848 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
849   _set_output_format(_TWO_DIGIT_EXPONENT);
850 #endif
851 
852   PetscCall(PetscOptionsCreateDefault());
853 
854   PetscFinalizeCalled = PETSC_FALSE;
855 
856   PetscCall(PetscSetProgramName(prog));
857   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen));
858   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout));
859   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr));
860   PetscCall(PetscSpinlockCreate(&PetscCommSpinLock));
861 
862   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
863   PetscCallMPI(MPI_Comm_set_errhandler(PETSC_COMM_WORLD, MPI_ERRORS_RETURN));
864 
865   if (PETSC_MPI_ERROR_CLASS == MPI_ERR_LASTCODE) {
866     PetscCallMPI(MPI_Add_error_class(&PETSC_MPI_ERROR_CLASS));
867     PetscCallMPI(MPI_Add_error_code(PETSC_MPI_ERROR_CLASS, &PETSC_MPI_ERROR_CODE));
868   }
869 
870   /* Done after init due to a bug in MPICH-GM? */
871   PetscCall(PetscErrorPrintfInitialize());
872 
873   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &PetscGlobalRank));
874   PetscCallMPI(MPI_Comm_size(MPI_COMM_WORLD, &PetscGlobalSize));
875 
876   MPIU_BOOL        = MPI_INT;
877   MPIU_ENUM        = MPI_INT;
878   MPIU_FORTRANADDR = (sizeof(void *) == sizeof(int)) ? MPI_INT : MPIU_INT64;
879   if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED;
880   else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG;
881 #if defined(PETSC_SIZEOF_LONG_LONG)
882   else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG;
883 #endif
884   else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_SUP_SYS, "Could not find MPI type for size_t");
885 
886     /*
887      Initialized the global complex variable; this is because with
888      shared libraries the constructors for global variables
889      are not called; at least on IRIX.
890   */
891 #if defined(PETSC_HAVE_COMPLEX)
892   {
893   #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128)
894     PetscComplex ic(0.0, 1.0);
895     PETSC_i = ic;
896   #else
897     PETSC_i = _Complex_I;
898   #endif
899   }
900 #endif /* PETSC_HAVE_COMPLEX */
901 
902   /*
903      Create the PETSc MPI reduction operator that sums of the first
904      half of the entries and maxes the second half.
905   */
906   PetscCallMPI(MPI_Op_create(MPIU_MaxSum_Local, 1, &MPIU_MAXSUM_OP));
907 
908 #if defined(PETSC_HAVE_REAL___FLOAT128)
909   PetscCallMPI(MPI_Type_contiguous(2, MPI_DOUBLE, &MPIU___FLOAT128));
910   PetscCallMPI(MPI_Type_commit(&MPIU___FLOAT128));
911   #if defined(PETSC_HAVE_COMPLEX)
912   PetscCallMPI(MPI_Type_contiguous(4, MPI_DOUBLE, &MPIU___COMPLEX128));
913   PetscCallMPI(MPI_Type_commit(&MPIU___COMPLEX128));
914   #endif
915 #endif
916 #if defined(PETSC_HAVE_REAL___FP16)
917   PetscCallMPI(MPI_Type_contiguous(2, MPI_CHAR, &MPIU___FP16));
918   PetscCallMPI(MPI_Type_commit(&MPIU___FP16));
919 #endif
920 
921 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
922   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM));
923   PetscCallMPI(MPI_Op_create(PetscMax_Local, 1, &MPIU_MAX));
924   PetscCallMPI(MPI_Op_create(PetscMin_Local, 1, &MPIU_MIN));
925 #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
926   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM___FP16___FLOAT128));
927 #endif
928 
929   PetscCallMPI(MPI_Type_contiguous(2, MPIU_SCALAR, &MPIU_2SCALAR));
930   PetscCallMPI(MPI_Op_create(PetscGarbageKeySortedIntersect, 1, &Petsc_Garbage_SetIntersectOp));
931   PetscCallMPI(MPI_Type_commit(&MPIU_2SCALAR));
932 
933   /* create datatypes used by MPIU_MAXLOC, MPIU_MINLOC and PetscSplitReduction_Op */
934 #if !defined(PETSC_HAVE_MPIUNI)
935   {
936     PetscMPIInt  blockSizes[2]   = {1, 1};
937     MPI_Aint     blockOffsets[2] = {offsetof(struct petsc_mpiu_real_int, v), offsetof(struct petsc_mpiu_real_int, i)};
938     MPI_Datatype blockTypes[2]   = {MPIU_REAL, MPIU_INT}, tmpStruct;
939 
940     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
941     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_real_int), &MPIU_REAL_INT));
942     PetscCallMPI(MPI_Type_free(&tmpStruct));
943     PetscCallMPI(MPI_Type_commit(&MPIU_REAL_INT));
944   }
945   {
946     PetscMPIInt  blockSizes[2]   = {1, 1};
947     MPI_Aint     blockOffsets[2] = {offsetof(struct petsc_mpiu_scalar_int, v), offsetof(struct petsc_mpiu_scalar_int, i)};
948     MPI_Datatype blockTypes[2]   = {MPIU_SCALAR, MPIU_INT}, tmpStruct;
949 
950     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
951     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_scalar_int), &MPIU_SCALAR_INT));
952     PetscCallMPI(MPI_Type_free(&tmpStruct));
953     PetscCallMPI(MPI_Type_commit(&MPIU_SCALAR_INT));
954   }
955 #endif
956 
957 #if defined(PETSC_USE_64BIT_INDICES)
958   PetscCallMPI(MPI_Type_contiguous(2, MPIU_INT, &MPIU_2INT));
959   PetscCallMPI(MPI_Type_commit(&MPIU_2INT));
960 #endif
961   PetscCallMPI(MPI_Type_contiguous(4, MPI_INT, &MPI_4INT));
962   PetscCallMPI(MPI_Type_commit(&MPI_4INT));
963   PetscCallMPI(MPI_Type_contiguous(4, MPIU_INT, &MPIU_4INT));
964   PetscCallMPI(MPI_Type_commit(&MPIU_4INT));
965 
966   /*
967      Attributes to be set on PETSc communicators
968   */
969   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_Counter_Attr_Delete_Fn, &Petsc_Counter_keyval, (void *)0));
970   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_InnerComm_Attr_Delete_Fn, &Petsc_InnerComm_keyval, (void *)0));
971   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_OuterComm_Attr_Delete_Fn, &Petsc_OuterComm_keyval, (void *)0));
972   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_ShmComm_Attr_Delete_Fn, &Petsc_ShmComm_keyval, (void *)0));
973   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_CreationIdx_keyval, (void *)0));
974   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_Garbage_HMap_keyval, (void *)0));
975 
976 #if defined(PETSC_HAVE_FORTRAN)
977   if (ftn) PetscCall(PetscInitFortran_Private(readarguments, file, len));
978   else
979 #endif
980     PetscCall(PetscOptionsInsert(NULL, &PetscGlobalArgc, &PetscGlobalArgs, file));
981 
982   /* call a second time so it can look in the options database */
983   PetscCall(PetscErrorPrintfInitialize());
984 
985   /*
986      Check system options and print help
987   */
988   PetscCall(PetscOptionsCheckInitial_Private(help));
989 
990   /*
991     Creates the logging data structures; this is enabled even if logging is not turned on
992     This is the last thing we do before returning to the user code to prevent having the
993     logging numbers contaminated by any startup time associated with MPI
994   */
995 #if defined(PETSC_USE_LOG)
996   PetscCall(PetscLogInitialize());
997 #endif
998 
999   /*
1000    Initialize PetscDevice and PetscDeviceContext
1001 
1002    Note to any future devs thinking of moving this, proper initialization requires:
1003    1. MPI initialized
1004    2. Options DB initialized
1005    3. Petsc error handling initialized, specifically signal handlers. This expects to set up
1006       its own SIGSEV handler via the push/pop interface.
1007    4. Logging initialized
1008   */
1009   PetscCall(PetscDeviceInitializeFromOptions_Internal(PETSC_COMM_WORLD));
1010 
1011 #if PetscDefined(HAVE_VIENNACL)
1012   flg = PETSC_FALSE;
1013   PetscCall(PetscOptionsHasName(NULL, NULL, "-log_summary", &flg));
1014   if (!flg) PetscCall(PetscOptionsHasName(NULL, NULL, "-log_view", &flg));
1015   if (!flg) PetscCall(PetscOptionsGetBool(NULL, NULL, "-viennacl_synchronize", &flg, NULL));
1016   PetscViennaCLSynchronize = flg;
1017   PetscCall(PetscViennaCLInit());
1018 #endif
1019 
1020   PetscCall(PetscCitationsInitialize());
1021 
1022 #if defined(PETSC_HAVE_SAWS)
1023   PetscCall(PetscInitializeSAWs(ftn ? NULL : help));
1024   flg = PETSC_FALSE;
1025   PetscCall(PetscOptionsHasName(NULL, NULL, "-stack_view", &flg));
1026   if (flg) PetscCall(PetscStackViewSAWs());
1027 #endif
1028 
1029   /*
1030      Load the dynamic libraries (on machines that support them), this registers all
1031      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
1032   */
1033   PetscCall(PetscInitialize_DynamicLibraries());
1034 
1035   PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));
1036   PetscCall(PetscInfo(NULL, "PETSc successfully started: number of processors = %d\n", size));
1037   PetscCall(PetscGetHostName(hostname, sizeof(hostname)));
1038   PetscCall(PetscInfo(NULL, "Running on machine: %s\n", hostname));
1039 #if defined(PETSC_HAVE_OPENMP)
1040   {
1041     PetscBool omp_view_flag;
1042     char     *threads = getenv("OMP_NUM_THREADS");
1043 
1044     if (threads) {
1045       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n", threads));
1046       (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumOMPThreads);
1047     } else {
1048       PetscNumOMPThreads = (PetscInt)omp_get_max_threads();
1049       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n", PetscNumOMPThreads));
1050     }
1051     PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "OpenMP options", "Sys");
1052     PetscCall(PetscOptionsInt("-omp_num_threads", "Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS", "None", PetscNumOMPThreads, &PetscNumOMPThreads, &flg));
1053     PetscCall(PetscOptionsName("-omp_view", "Display OpenMP number of threads", NULL, &omp_view_flag));
1054     PetscOptionsEnd();
1055     if (flg) {
1056       PetscCall(PetscInfo(NULL, "Number of OpenMP theads %" PetscInt_FMT " (given by -omp_num_threads)\n", PetscNumOMPThreads));
1057       omp_set_num_threads((int)PetscNumOMPThreads);
1058     }
1059     if (omp_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "OpenMP: number of threads %" PetscInt_FMT "\n", PetscNumOMPThreads));
1060   }
1061 #endif
1062 
1063 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
1064   /*
1065       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
1066 
1067       Currently not used because it is not supported by MPICH.
1068   */
1069   if (!PetscBinaryBigEndian()) PetscCallMPI(MPI_Register_datarep((char *)"petsc", PetscDataRep_read_conv_fn, PetscDataRep_write_conv_fn, PetscDataRep_extent_fn, NULL));
1070 #endif
1071 
1072 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1073   PetscCall(PetscFPTCreate(10000));
1074 #endif
1075 
1076 #if defined(PETSC_HAVE_HWLOC)
1077   {
1078     PetscViewer viewer;
1079     PetscCall(PetscOptionsGetViewer(PETSC_COMM_WORLD, NULL, NULL, "-process_view", &viewer, NULL, &flg));
1080     if (flg) {
1081       PetscCall(PetscProcessPlacementView(viewer));
1082       PetscCall(PetscViewerDestroy(&viewer));
1083     }
1084   }
1085 #endif
1086 
1087   flg = PETSC_TRUE;
1088   PetscCall(PetscOptionsGetBool(NULL, NULL, "-viewfromoptions", &flg, NULL));
1089   if (!flg) PetscCall(PetscOptionsPushGetViewerOff(PETSC_TRUE));
1090 
1091 #if defined(PETSC_HAVE_ADIOS)
1092   PetscCallExternal(adios_init_noxml, PETSC_COMM_WORLD);
1093   PetscCallExternal(adios_declare_group, &Petsc_adios_group, "PETSc", "", adios_stat_default);
1094   PetscCallExternal(adios_select_method, Petsc_adios_group, "MPI", "", "");
1095   PetscCallExternal(adios_read_init_method, ADIOS_READ_METHOD_BP, PETSC_COMM_WORLD, "");
1096 #endif
1097 
1098 #if defined(__VALGRIND_H)
1099   PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND ? PETSC_TRUE : PETSC_FALSE;
1100   #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE)
1101   if (PETSC_RUNNING_ON_VALGRIND) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING: Running valgrind with the MacOS native BLAS and LAPACK can fail. If it fails suggest configuring with --download-fblaslapack or --download-f2cblaslapack"));
1102   #endif
1103 #endif
1104   /*
1105       Set flag that we are completely initialized
1106   */
1107   PetscInitializeCalled = PETSC_TRUE;
1108 
1109   PetscCall(PetscOptionsHasName(NULL, NULL, "-python", &flg));
1110   if (flg) PetscCall(PetscPythonInitialize(NULL, NULL));
1111 
1112   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1113   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerBegin());
1114   else PetscCheck(!flg, PETSC_COMM_WORLD, PETSC_ERR_SUP, "PETSc configured using -with-single-library=0; -mpi_linear_solver_server not supported in that case");
1115   PetscFunctionReturn(PETSC_SUCCESS);
1116 }
1117 
1118 /*@C
1119    PetscInitialize - Initializes the PETSc database and MPI.
1120    `PetscInitialize()` calls MPI_Init() if that has yet to be called,
1121    so this routine should always be called near the beginning of
1122    your program -- usually the very first line!
1123 
1124    Collective on `MPI_COMM_WORLD` or `PETSC_COMM_WORLD` if it has been set
1125 
1126    Input Parameters:
1127 +  argc - count of number of command line arguments
1128 .  args - the command line arguments
1129 .  file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format.
1130           Use NULL or empty string to not check for code specific file.
1131           Also checks ~/.petscrc, .petscrc and petscrc.
1132           Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files.
1133 -  help - [optional] Help message to print, use NULL for no message
1134 
1135    If you wish PETSc code to run ONLY on a subcommunicator of `MPI_COMM_WORLD`, create that
1136    communicator first and assign it to `PETSC_COMM_WORLD` BEFORE calling `PetscInitialize()`. Thus if you are running a
1137    four process job and two processes will run PETSc and have `PetscInitialize()` and PetscFinalize() and two process will not,
1138    then do this. If ALL processes in the job are using `PetscInitialize()` and `PetscFinalize()` then you don't need to do this, even
1139    if different subcommunicators of the job are doing different things with PETSc.
1140 
1141    Options Database Keys:
1142 +  -help [intro] - prints help method for each option; if intro is given the program stops after printing the introductory help message
1143 .  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
1144 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
1145 .  -on_error_emacs <machinename> - causes emacsclient to jump to error file
1146 .  -on_error_abort - calls `abort()` when error detected (no traceback)
1147 .  -on_error_mpiabort - calls `MPI_abort()` when error detected
1148 .  -error_output_stdout - prints PETSc error messages to stdout instead of the default stderr
1149 .  -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called)
1150 .  -debugger_ranks [rank1,rank2,...] - Indicates ranks to start in debugger
1151 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
1152 .  -stop_for_debugger - Print message on how to attach debugger manually to
1153                         process and wait (-debugger_pause) seconds for attachment
1154 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) (deprecated, use -malloc_debug)
1155 .  -malloc no - Indicates not to use error-checking malloc (deprecated, use -malloc_debug no)
1156 .  -malloc_debug - check for memory corruption at EVERY malloc or free, see `PetscMallocSetDebug()`
1157 .  -malloc_dump - prints a list of all unfreed memory at the end of the run
1158 .  -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds, ignored in optimized build. May want to set in PETSC_OPTIONS environmental variable
1159 .  -malloc_view - show a list of all allocated memory during `PetscFinalize()`
1160 .  -malloc_view_threshold <t> - only list memory allocations of size greater than t with -malloc_view
1161 .  -malloc_requested_size - malloc logging will record the requested size rather than size after alignment
1162 .  -fp_trap - Stops on floating point exceptions
1163 .  -no_signal_handler - Indicates not to trap error signals
1164 .  -shared_tmp - indicates /tmp directory is shared by all processors
1165 .  -not_shared_tmp - each processor has own /tmp
1166 .  -tmp - alternative name of /tmp directory
1167 .  -get_total_flops - returns total flops done by all processors
1168 -  -memory_view - Print memory usage at end of run
1169 
1170    Options Database Keys for Option Database:
1171 +  -skip_petscrc - skip the default option files ~/.petscrc, .petscrc, petscrc
1172 .  -options_monitor - monitor all set options to standard output for the whole program run
1173 -  -options_monitor_cancel - cancel options monitoring hard-wired using `PetscOptionsMonitorSet()`
1174 
1175    Options -options_monitor_{all,cancel} are
1176    position-independent and apply to all options set since the PETSc start.
1177    They can be used also in option files.
1178 
1179    See `PetscOptionsMonitorSet()` to do monitoring programmatically.
1180 
1181    Options Database Keys for Profiling:
1182    See Users-Manual: ch_profiling for details.
1183 +  -info [filename][:[~]<list,of,classnames>[:[~]self]] - Prints verbose information. See `PetscInfo()`.
1184 .  -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event,
1185         however it slows things down and gives a distorted view of the overall runtime.
1186 .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
1187         hangs without running in the debugger).  See `PetscLogTraceBegin()`.
1188 .  -log_view [:filename:format] - Prints summary of flop and timing information to screen or file, see `PetscLogView()`.
1189 .  -log_view_memory - Includes in the summary from -log_view the memory used in each event, see `PetscLogView()`.
1190 .  -log_view_gpu_time - Includes in the summary from -log_view the time used in each GPU kernel, see `PetscLogView().
1191 .  -log_summary [filename] - (Deprecated, use -log_view) Prints summary of flop and timing information to screen. If the filename is specified the
1192         summary is written to the file.  See PetscLogView().
1193 .  -log_exclude: <vec,mat,pc,ksp,snes> - excludes subset of object classes from logging
1194 .  -log_all [filename] - Logs extensive profiling information  See `PetscLogDump()`.
1195 .  -log [filename] - Logs basic profiline information  See `PetscLogDump()`.
1196 .  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
1197 .  -viewfromoptions on,off - Enable or disable `XXXSetFromOptions()` calls, for applications with many small solves turn this off
1198 -  -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code
1199 
1200     Only one of -log_trace, -log_view, -log_all, -log, or -log_mpe may be used at a time
1201 
1202    Options Database Keys for SAWs:
1203 +  -saws_port <portnumber> - port number to publish SAWs data, default is 8080
1204 .  -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen
1205                             this is useful when you are running many jobs that utilize SAWs at the same time
1206 .  -saws_log <filename> - save a log of all SAWs communication
1207 .  -saws_https <certificate file> - have SAWs use HTTPS instead of HTTP
1208 -  -saws_root <directory> - allow SAWs to have access to the given directory to search for requested resources and files
1209 
1210    Environmental Variables:
1211 +   `PETSC_TMP` - alternative tmp directory
1212 .   `PETSC_SHARED_TMP` - tmp is shared by all processes
1213 .   `PETSC_NOT_SHARED_TMP` - each process has its own private tmp
1214 .   `PETSC_OPTIONS` - a string containing additional options for petsc in the form of command line "-key value" pairs
1215 .   `PETSC_OPTIONS_YAML` - (requires configuring PETSc to use libyaml) a string containing additional options for petsc in the form of a YAML document
1216 .   `PETSC_VIEWER_SOCKET_PORT` - socket number to use for socket viewer
1217 -   `PETSC_VIEWER_SOCKET_MACHINE` - machine to use for socket viewer to connect to
1218 
1219    Level: beginner
1220 
1221    Note:
1222    If for some reason you must call `MPI_Init()` separately, call
1223    it before `PetscInitialize()`.
1224 
1225    Fortran Notes:
1226    In Fortran this routine can be called with
1227 .vb
1228        call PetscInitialize(ierr)
1229        call PetscInitialize(file,ierr) or
1230        call PetscInitialize(file,help,ierr)
1231 .ve
1232 
1233    If your main program is C but you call Fortran code that also uses PETSc you need to call `PetscInitializeFortran()` soon after
1234    calling `PetscInitialize()`.
1235 
1236    Options Database Key for Developers:
1237 .  -checkfunctionlist - automatically checks that function lists associated with objects are correctly cleaned up. Produces messages of the form:
1238     "function name: MatInodeGetInodeSizes_C" if they are not cleaned up. This flag is always set for the test harness (in framework.py)
1239 
1240 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscInitializeNoArguments()`, `PetscLogGpuTime()`
1241 @*/
1242 PetscErrorCode PetscInitialize(int *argc, char ***args, const char file[], const char help[])
1243 {
1244   PetscMPIInt flag;
1245   const char *prog = "Unknown Name", *mpienv;
1246 
1247   PetscFunctionBegin;
1248   if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
1249   PetscCallMPI(MPI_Initialized(&flag));
1250   if (!flag) {
1251     PetscCheck(PETSC_COMM_WORLD == MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_SUP, "You cannot set PETSC_COMM_WORLD if you have not initialized MPI first");
1252     PetscCall(PetscPreMPIInit_Private());
1253 #if defined(PETSC_HAVE_MPI_INIT_THREAD)
1254     {
1255       PetscMPIInt PETSC_UNUSED provided;
1256       PetscCallMPI(MPI_Init_thread(argc, args, PETSC_MPI_THREAD_REQUIRED, &provided));
1257     }
1258 #else
1259     PetscCallMPI(MPI_Init(argc, args));
1260 #endif
1261     if (PetscDefined(HAVE_MPIUNI)) {
1262       mpienv = getenv("PMI_SIZE");
1263       if (!mpienv) mpienv = getenv("OMPI_COMM_WORLD_SIZE");
1264       if (mpienv) {
1265         PetscInt isize;
1266         PetscCall(PetscOptionsStringToInt(mpienv, &isize));
1267         if (isize != 1) printf("You are using an MPI-uni (sequential) install of PETSc but trying to launch parallel jobs; you need full MPI version of PETSc\n");
1268         PetscCheck(isize == 1, MPI_COMM_SELF, PETSC_ERR_MPI, "You are using an MPI-uni (sequential) install of PETSc but trying to launch parallel jobs; you need full MPI version of PETSc");
1269       }
1270     }
1271     PetscBeganMPI = PETSC_TRUE;
1272   }
1273 
1274   if (argc && *argc) prog = **args;
1275   if (argc && args) {
1276     PetscGlobalArgc = *argc;
1277     PetscGlobalArgs = *args;
1278   }
1279   PetscCall(PetscInitialize_Common(prog, file, help, PETSC_FALSE, PETSC_FALSE, 0));
1280   PetscFunctionReturn(PETSC_SUCCESS);
1281 }
1282 
1283 #if PetscDefined(USE_LOG)
1284 PETSC_INTERN PetscObject *PetscObjects;
1285 PETSC_INTERN PetscInt     PetscObjectsCounts;
1286 PETSC_INTERN PetscInt     PetscObjectsMaxCounts;
1287 PETSC_INTERN PetscBool    PetscObjectsLog;
1288 #endif
1289 
1290 /*
1291     Frees all the MPI types and operations that PETSc may have created
1292 */
1293 PetscErrorCode PetscFreeMPIResources(void)
1294 {
1295   PetscFunctionBegin;
1296 #if defined(PETSC_HAVE_REAL___FLOAT128)
1297   PetscCallMPI(MPI_Type_free(&MPIU___FLOAT128));
1298   #if defined(PETSC_HAVE_COMPLEX)
1299   PetscCallMPI(MPI_Type_free(&MPIU___COMPLEX128));
1300   #endif
1301 #endif
1302 #if defined(PETSC_HAVE_REAL___FP16)
1303   PetscCallMPI(MPI_Type_free(&MPIU___FP16));
1304 #endif
1305 
1306 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
1307   PetscCallMPI(MPI_Op_free(&MPIU_SUM));
1308   PetscCallMPI(MPI_Op_free(&MPIU_MAX));
1309   PetscCallMPI(MPI_Op_free(&MPIU_MIN));
1310 #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
1311   PetscCallMPI(MPI_Op_free(&MPIU_SUM___FP16___FLOAT128));
1312 #endif
1313 
1314   PetscCallMPI(MPI_Type_free(&MPIU_2SCALAR));
1315   PetscCallMPI(MPI_Type_free(&MPIU_REAL_INT));
1316   PetscCallMPI(MPI_Type_free(&MPIU_SCALAR_INT));
1317 #if defined(PETSC_USE_64BIT_INDICES)
1318   PetscCallMPI(MPI_Type_free(&MPIU_2INT));
1319 #endif
1320   PetscCallMPI(MPI_Type_free(&MPI_4INT));
1321   PetscCallMPI(MPI_Type_free(&MPIU_4INT));
1322   PetscCallMPI(MPI_Op_free(&MPIU_MAXSUM_OP));
1323   PetscCallMPI(MPI_Op_free(&Petsc_Garbage_SetIntersectOp));
1324   PetscFunctionReturn(PETSC_SUCCESS);
1325 }
1326 
1327 #if PetscDefined(USE_LOG)
1328 PETSC_INTERN PetscErrorCode PetscLogFinalize(void);
1329 #endif
1330 
1331 /*@C
1332    PetscFinalize - Checks for options to be called at the conclusion
1333    of the program. `MPI_Finalize()` is called only if the user had not
1334    called `MPI_Init()` before calling `PetscInitialize()`.
1335 
1336    Collective on `PETSC_COMM_WORLD`
1337 
1338    Options Database Keys:
1339 +  -options_view - Calls `PetscOptionsView()`
1340 .  -options_left - Prints unused options that remain in the database
1341 .  -objects_dump [all] - Prints list of objects allocated by the user that have not been freed, the option all cause all outstanding objects to be listed
1342 .  -mpidump - Calls PetscMPIDump()
1343 .  -malloc_dump <optional filename> - Calls `PetscMallocDump()`, displays all memory allocated that has not been freed
1344 .  -malloc_info - Prints total memory usage
1345 -  -malloc_view <optional filename> - Prints list of all memory allocated and where
1346 
1347    Level: beginner
1348 
1349    Note:
1350    See `PetscInitialize()` for other runtime options.
1351 
1352 .seealso: `PetscInitialize()`, `PetscOptionsView()`, `PetscMallocDump()`, `PetscMPIDump()`, `PetscEnd()`
1353 @*/
1354 PetscErrorCode PetscFinalize(void)
1355 {
1356   PetscMPIInt rank;
1357   PetscInt    nopt;
1358   PetscBool   flg1 = PETSC_FALSE, flg2 = PETSC_FALSE, flg3 = PETSC_FALSE;
1359   PetscBool   flg;
1360 #if defined(PETSC_USE_LOG)
1361   char mname[PETSC_MAX_PATH_LEN];
1362 #endif
1363 
1364   PetscFunctionBegin;
1365   PetscCheck(PetscInitializeCalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscInitialize() must be called before PetscFinalize()");
1366   PetscCall(PetscInfo(NULL, "PetscFinalize() called\n"));
1367 
1368   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1369   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerEnd());
1370 
1371   /* Clean up Garbage automatically on COMM_SELF and COMM_WORLD at finalize */
1372   {
1373     union
1374     {
1375       MPI_Comm comm;
1376       void    *ptr;
1377     } ucomm;
1378     PetscMPIInt flg;
1379     void       *tmp;
1380 
1381     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1382     if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1383     if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_SELF));
1384     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1385     if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1386     if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_WORLD));
1387   }
1388 
1389   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
1390 #if defined(PETSC_HAVE_ADIOS)
1391   PetscCallExternal(adios_read_finalize_method, ADIOS_READ_METHOD_BP_AGGREGATE);
1392   PetscCallExternal(adios_finalize, rank);
1393 #endif
1394   PetscCall(PetscOptionsHasName(NULL, NULL, "-citations", &flg));
1395   if (flg) {
1396     char *cits, filename[PETSC_MAX_PATH_LEN];
1397     FILE *fd = PETSC_STDOUT;
1398 
1399     PetscCall(PetscOptionsGetString(NULL, NULL, "-citations", filename, sizeof(filename), NULL));
1400     if (filename[0]) PetscCall(PetscFOpen(PETSC_COMM_WORLD, filename, "w", &fd));
1401     PetscCall(PetscSegBufferGet(PetscCitationsList, 1, &cits));
1402     cits[0] = 0;
1403     PetscCall(PetscSegBufferExtractAlloc(PetscCitationsList, &cits));
1404     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "If you publish results based on this computation please cite the following:\n"));
1405     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1406     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "%s", cits));
1407     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1408     PetscCall(PetscFClose(PETSC_COMM_WORLD, fd));
1409     PetscCall(PetscFree(cits));
1410   }
1411   PetscCall(PetscSegBufferDestroy(&PetscCitationsList));
1412 
1413 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER)
1414   /* TextBelt is run for testing purposes only, please do not use this feature often */
1415   {
1416     PetscInt nmax = 2;
1417     char   **buffs;
1418     PetscCall(PetscMalloc1(2, &buffs));
1419     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-textbelt", buffs, &nmax, &flg1));
1420     if (flg1) {
1421       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-textbelt requires either the phone number or number,\"message\"");
1422       if (nmax == 1) {
1423         size_t len = 128;
1424         PetscCall(PetscMalloc1(len, &buffs[1]));
1425         PetscCall(PetscGetProgramName(buffs[1], 32));
1426         PetscCall(PetscStrlcat(buffs[1], " has completed", len));
1427       }
1428       PetscCall(PetscTextBelt(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1429       PetscCall(PetscFree(buffs[0]));
1430       PetscCall(PetscFree(buffs[1]));
1431     }
1432     PetscCall(PetscFree(buffs));
1433   }
1434   {
1435     PetscInt nmax = 2;
1436     char   **buffs;
1437     PetscCall(PetscMalloc1(2, &buffs));
1438     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-tellmycell", buffs, &nmax, &flg1));
1439     if (flg1) {
1440       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-tellmycell requires either the phone number or number,\"message\"");
1441       if (nmax == 1) {
1442         size_t len = 128;
1443         PetscCall(PetscMalloc1(len, &buffs[1]));
1444         PetscCall(PetscGetProgramName(buffs[1], 32));
1445         PetscCall(PetscStrlcat(buffs[1], " has completed", len));
1446       }
1447       PetscCall(PetscTellMyCell(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1448       PetscCall(PetscFree(buffs[0]));
1449       PetscCall(PetscFree(buffs[1]));
1450     }
1451     PetscCall(PetscFree(buffs));
1452   }
1453 #endif
1454 
1455 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1456   PetscCall(PetscFPTDestroy());
1457 #endif
1458 
1459 #if defined(PETSC_HAVE_SAWS)
1460   flg = PETSC_FALSE;
1461   PetscCall(PetscOptionsGetBool(NULL, NULL, "-saw_options", &flg, NULL));
1462   if (flg) PetscCall(PetscOptionsSAWsDestroy());
1463 #endif
1464 
1465 #if defined(PETSC_HAVE_X)
1466   flg1 = PETSC_FALSE;
1467   PetscCall(PetscOptionsGetBool(NULL, NULL, "-x_virtual", &flg1, NULL));
1468   if (flg1) {
1469     /*  this is a crude hack, but better than nothing */
1470     PetscCall(PetscPOpen(PETSC_COMM_WORLD, NULL, "pkill -9 Xvfb", "r", NULL));
1471   }
1472 #endif
1473 
1474 #if !defined(PETSC_HAVE_THREADSAFETY)
1475   PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_info", &flg2, NULL));
1476   if (!flg2) {
1477     flg2 = PETSC_FALSE;
1478     PetscCall(PetscOptionsGetBool(NULL, NULL, "-memory_view", &flg2, NULL));
1479   }
1480   if (flg2) PetscCall(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD, "Summary of Memory Usage in PETSc\n"));
1481 #endif
1482 
1483 #if defined(PETSC_USE_LOG)
1484   flg1 = PETSC_FALSE;
1485   PetscCall(PetscOptionsGetBool(NULL, NULL, "-get_total_flops", &flg1, NULL));
1486   if (flg1) {
1487     PetscLogDouble flops = 0;
1488     PetscCallMPI(MPI_Reduce(&petsc_TotalFlops, &flops, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
1489     PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Total flops over all processors %g\n", flops));
1490   }
1491 #endif
1492 
1493 #if defined(PETSC_USE_LOG)
1494   #if defined(PETSC_HAVE_MPE)
1495   mname[0] = 0;
1496   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_mpe", mname, sizeof(mname), &flg1));
1497   if (flg1) {
1498     if (mname[0]) PetscCall(PetscLogMPEDump(mname));
1499     else PetscCall(PetscLogMPEDump(0));
1500   }
1501   #endif
1502 #endif
1503 
1504   /*
1505      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1506   */
1507   PetscCall(PetscObjectRegisterDestroyAll());
1508 
1509 #if defined(PETSC_USE_LOG)
1510   PetscCall(PetscOptionsPushGetViewerOff(PETSC_FALSE));
1511   PetscCall(PetscLogViewFromOptions());
1512   PetscCall(PetscOptionsPopGetViewerOff());
1513 
1514   mname[0] = 0;
1515   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_summary", mname, sizeof(mname), &flg1));
1516   if (flg1) {
1517     PetscViewer viewer;
1518     PetscCall((*PetscHelpPrintf)(PETSC_COMM_WORLD, "\n\n WARNING:   -log_summary is being deprecated; switch to -log_view\n\n\n"));
1519     if (mname[0]) {
1520       PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD, mname, &viewer));
1521       PetscCall(PetscLogView(viewer));
1522       PetscCall(PetscViewerDestroy(&viewer));
1523     } else {
1524       viewer = PETSC_VIEWER_STDOUT_WORLD;
1525       PetscCall(PetscViewerPushFormat(viewer, PETSC_VIEWER_DEFAULT));
1526       PetscCall(PetscLogView(viewer));
1527       PetscCall(PetscViewerPopFormat(viewer));
1528     }
1529   }
1530 
1531   /*
1532      Free any objects created by the last block of code.
1533   */
1534   PetscCall(PetscObjectRegisterDestroyAll());
1535 
1536   mname[0] = 0;
1537   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_all", mname, sizeof(mname), &flg1));
1538   PetscCall(PetscOptionsGetString(NULL, NULL, "-log", mname, sizeof(mname), &flg2));
1539   if (flg1 || flg2) PetscCall(PetscLogDump(mname));
1540 #endif
1541 
1542   flg1 = PETSC_FALSE;
1543   PetscCall(PetscOptionsGetBool(NULL, NULL, "-no_signal_handler", &flg1, NULL));
1544   if (!flg1) PetscCall(PetscPopSignalHandler());
1545   flg1 = PETSC_FALSE;
1546   PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpidump", &flg1, NULL));
1547   if (flg1) PetscCall(PetscMPIDump(stdout));
1548   flg1 = PETSC_FALSE;
1549   flg2 = PETSC_FALSE;
1550   /* preemptive call to avoid listing this option in options table as unused */
1551   PetscCall(PetscOptionsHasName(NULL, NULL, "-malloc_dump", &flg1));
1552   PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1553   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_view", &flg2, NULL));
1554 
1555   if (flg2) {
1556     PetscViewer viewer;
1557     PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer));
1558     PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII));
1559     PetscCall(PetscOptionsView(NULL, viewer));
1560     PetscCall(PetscViewerDestroy(&viewer));
1561   }
1562 
1563   /* to prevent PETSc -options_left from warning */
1564   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox", &flg1));
1565   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox_warning", &flg1));
1566 
1567   flg3 = PETSC_FALSE; /* default value is required */
1568   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_left", &flg3, &flg1));
1569   if (PetscUnlikelyDebug(!flg1)) flg3 = PETSC_TRUE;
1570   if (flg3) {
1571     if (!flg2 && flg1) { /* have not yet printed the options */
1572       PetscViewer viewer;
1573       PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer));
1574       PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII));
1575       PetscCall(PetscOptionsView(NULL, viewer));
1576       PetscCall(PetscViewerDestroy(&viewer));
1577     }
1578     PetscCall(PetscOptionsAllUsed(NULL, &nopt));
1579     if (nopt) {
1580       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! There are options you set that were not used!\n"));
1581       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! could be spelling mistake, etc!\n"));
1582       if (nopt == 1) {
1583         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There is one unused database option. It is:\n"));
1584       } else {
1585         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are %" PetscInt_FMT " unused database options. They are:\n", nopt));
1586       }
1587     } else if (flg3 && flg1) {
1588       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are no unused options.\n"));
1589     }
1590     PetscCall(PetscOptionsLeft(NULL));
1591   }
1592 
1593 #if defined(PETSC_HAVE_SAWS)
1594   if (!PetscGlobalRank) {
1595     PetscCall(PetscStackSAWsViewOff());
1596     PetscCallSAWs(SAWs_Finalize, ());
1597   }
1598 #endif
1599 
1600 #if defined(PETSC_USE_LOG)
1601   /*
1602        List all objects the user may have forgot to free
1603   */
1604   if (PetscObjectsLog) {
1605     PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1606     if (flg1) {
1607       MPI_Comm local_comm;
1608       char     string[64];
1609 
1610       PetscCall(PetscOptionsGetString(NULL, NULL, "-objects_dump", string, sizeof(string), NULL));
1611       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1612       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1613       PetscCall(PetscObjectsDump(stdout, (string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE));
1614       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1615       PetscCallMPI(MPI_Comm_free(&local_comm));
1616     }
1617   }
1618 #endif
1619 
1620 #if defined(PETSC_USE_LOG)
1621   PetscObjectsCounts    = 0;
1622   PetscObjectsMaxCounts = 0;
1623   PetscCall(PetscFree(PetscObjects));
1624 #endif
1625 
1626   /*
1627      Destroy any packages that registered a finalize
1628   */
1629   PetscCall(PetscRegisterFinalizeAll());
1630 
1631 #if defined(PETSC_USE_LOG)
1632   PetscCall(PetscLogFinalize());
1633 #endif
1634 
1635   /*
1636      Print PetscFunctionLists that have not been properly freed
1637   */
1638   if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintAll());
1639 
1640   if (petsc_history) {
1641     PetscCall(PetscCloseHistoryFile(&petsc_history));
1642     petsc_history = NULL;
1643   }
1644   PetscCall(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton));
1645   PetscCall(PetscInfoDestroy());
1646 
1647 #if !defined(PETSC_HAVE_THREADSAFETY)
1648   if (!(PETSC_RUNNING_ON_VALGRIND)) {
1649     char  fname[PETSC_MAX_PATH_LEN];
1650     char  sname[PETSC_MAX_PATH_LEN];
1651     FILE *fd;
1652     int   err;
1653 
1654     flg2 = PETSC_FALSE;
1655     flg3 = PETSC_FALSE;
1656     if (PetscDefined(USE_DEBUG)) PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_test", &flg2, NULL));
1657     PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_debug", &flg3, NULL));
1658     fname[0] = 0;
1659     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_dump", fname, sizeof(fname), &flg1));
1660     if (flg1 && fname[0]) {
1661       PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1662       fd = fopen(sname, "w");
1663       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1664       PetscCall(PetscMallocDump(fd));
1665       err = fclose(fd);
1666       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1667     } else if (flg1 || flg2 || flg3) {
1668       MPI_Comm local_comm;
1669 
1670       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1671       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1672       PetscCall(PetscMallocDump(stdout));
1673       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1674       PetscCallMPI(MPI_Comm_free(&local_comm));
1675     }
1676     fname[0] = 0;
1677     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_view", fname, sizeof(fname), &flg1));
1678     if (flg1 && fname[0]) {
1679       PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1680       fd = fopen(sname, "w");
1681       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1682       PetscCall(PetscMallocView(fd));
1683       err = fclose(fd);
1684       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1685     } else if (flg1) {
1686       MPI_Comm local_comm;
1687 
1688       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1689       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1690       PetscCall(PetscMallocView(stdout));
1691       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1692       PetscCallMPI(MPI_Comm_free(&local_comm));
1693     }
1694   }
1695 #endif
1696 
1697   /*
1698      Close any open dynamic libraries
1699   */
1700   PetscCall(PetscFinalize_DynamicLibraries());
1701 
1702   /* Can be destroyed only after all the options are used */
1703   PetscCall(PetscOptionsDestroyDefault());
1704 
1705   PetscGlobalArgc = 0;
1706   PetscGlobalArgs = NULL;
1707 
1708 #if defined(PETSC_HAVE_KOKKOS)
1709   if (PetscBeganKokkos) {
1710     PetscCall(PetscKokkosFinalize_Private());
1711     PetscBeganKokkos       = PETSC_FALSE;
1712     PetscKokkosInitialized = PETSC_FALSE;
1713   }
1714 #endif
1715 
1716 #if defined(PETSC_HAVE_NVSHMEM)
1717   if (PetscBeganNvshmem) {
1718     PetscCall(PetscNvshmemFinalize());
1719     PetscBeganNvshmem = PETSC_FALSE;
1720   }
1721 #endif
1722 
1723   PetscCall(PetscFreeMPIResources());
1724 
1725   /*
1726      Destroy any known inner MPI_Comm's and attributes pointing to them
1727      Note this will not destroy any new communicators the user has created.
1728 
1729      If all PETSc objects were not destroyed those left over objects will have hanging references to
1730      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1731  */
1732   {
1733     PetscCommCounter *counter;
1734     PetscMPIInt       flg;
1735     MPI_Comm          icomm;
1736     union
1737     {
1738       MPI_Comm comm;
1739       void    *ptr;
1740     } ucomm;
1741     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1742     if (flg) {
1743       icomm = ucomm.comm;
1744       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1745       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1746 
1747       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval));
1748       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1749       PetscCallMPI(MPI_Comm_free(&icomm));
1750     }
1751     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1752     if (flg) {
1753       icomm = ucomm.comm;
1754       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1755       PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1756 
1757       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval));
1758       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1759       PetscCallMPI(MPI_Comm_free(&icomm));
1760     }
1761   }
1762 
1763   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval));
1764   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval));
1765   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval));
1766   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval));
1767   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_CreationIdx_keyval));
1768   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Garbage_HMap_keyval));
1769 
1770   // Free keyvals which may be silently created by some routines
1771   if (Petsc_SharedWD_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedWD_keyval));
1772   if (Petsc_SharedTmp_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedTmp_keyval));
1773 
1774   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen));
1775   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout));
1776   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr));
1777   PetscCall(PetscSpinlockDestroy(&PetscCommSpinLock));
1778 
1779   if (PetscBeganMPI) {
1780     PetscMPIInt flag;
1781     PetscCallMPI(MPI_Finalized(&flag));
1782     PetscCheck(!flag, PETSC_COMM_SELF, PETSC_ERR_LIB, "MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1783     /* wait until the very last moment to disable error handling */
1784     PetscErrorHandlingInitialized = PETSC_FALSE;
1785     PetscCallMPI(MPI_Finalize());
1786   } else PetscErrorHandlingInitialized = PETSC_FALSE;
1787 
1788   /*
1789 
1790      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1791    the communicator has some outstanding requests on it. Specifically if the
1792    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1793    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1794    is never freed as it should be. Thus one may obtain messages of the form
1795    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1796    memory was not freed.
1797 
1798 */
1799   PetscCall(PetscMallocClear());
1800   PetscCall(PetscStackReset());
1801 
1802   PetscInitializeCalled = PETSC_FALSE;
1803   PetscFinalizeCalled   = PETSC_TRUE;
1804 #if defined(PETSC_USE_COVERAGE)
1805   /*
1806      flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the
1807      gcov files are still being added to the directories as git tries to remove the directories.
1808    */
1809   __gcov_flush();
1810 #endif
1811   /* To match PetscFunctionBegin() at the beginning of this function */
1812   PetscStackClearTop;
1813   return PETSC_SUCCESS;
1814 }
1815 
1816 #if defined(PETSC_MISSING_LAPACK_lsame_)
1817 PETSC_EXTERN int lsame_(char *a, char *b)
1818 {
1819   if (*a == *b) return 1;
1820   if (*a + 32 == *b) return 1;
1821   if (*a - 32 == *b) return 1;
1822   return 0;
1823 }
1824 #endif
1825 
1826 #if defined(PETSC_MISSING_LAPACK_lsame)
1827 PETSC_EXTERN int lsame(char *a, char *b)
1828 {
1829   if (*a == *b) return 1;
1830   if (*a + 32 == *b) return 1;
1831   if (*a - 32 == *b) return 1;
1832   return 0;
1833 }
1834 #endif
1835