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