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