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