xref: /petsc/src/sys/objects/pinit.c (revision 83c9f7f220f3448cfcd2a76a64462ac242b37309)
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, provide a string of length `PETSC_MAX_PATH_LEN`
462 
463    Level: advanced
464 
465 @*/
466 PetscErrorCode PetscGetProgramName(char name[], size_t len) {
467   PetscFunctionBegin;
468   PetscCall(PetscStrncpy(name, programname, len));
469   PetscFunctionReturn(0);
470 }
471 
472 /*@C
473    PetscGetArgs - Allows you to access the raw command line arguments anywhere
474      after PetscInitialize() is called but before `PetscFinalize()`.
475 
476    Not Collective
477 
478    Output Parameters:
479 +  argc - count of number of command line arguments
480 -  args - the command line arguments
481 
482    Level: intermediate
483 
484    Notes:
485       This is usually used to pass the command line arguments into other libraries
486    that are called internally deep in PETSc or the application.
487 
488       The first argument contains the program name as is normal for C arguments.
489 
490 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArguments()`
491 @*/
492 PetscErrorCode PetscGetArgs(int *argc, char ***args) {
493   PetscFunctionBegin;
494   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
495   *argc = PetscGlobalArgc;
496   *args = PetscGlobalArgs;
497   PetscFunctionReturn(0);
498 }
499 
500 /*@C
501    PetscGetArguments - Allows you to access the  command line arguments anywhere
502      after `PetscInitialize()` is called but before `PetscFinalize()`.
503 
504    Not Collective
505 
506    Output Parameters:
507 .  args - the command line arguments
508 
509    Level: intermediate
510 
511    Notes:
512       This does NOT start with the program name and IS null terminated (final arg is void)
513 
514 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscFreeArguments()`
515 @*/
516 PetscErrorCode PetscGetArguments(char ***args) {
517   PetscInt i, argc = PetscGlobalArgc;
518 
519   PetscFunctionBegin;
520   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
521   if (!argc) {
522     *args = NULL;
523     PetscFunctionReturn(0);
524   }
525   PetscCall(PetscMalloc1(argc, args));
526   for (i = 0; i < argc - 1; i++) PetscCall(PetscStrallocpy(PetscGlobalArgs[i + 1], &(*args)[i]));
527   (*args)[argc - 1] = NULL;
528   PetscFunctionReturn(0);
529 }
530 
531 /*@C
532    PetscFreeArguments - Frees the memory obtained with `PetscGetArguments()`
533 
534    Not Collective
535 
536    Output Parameters:
537 .  args - the command line arguments
538 
539    Level: intermediate
540 
541 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscGetArguments()`
542 @*/
543 PetscErrorCode PetscFreeArguments(char **args) {
544   PetscFunctionBegin;
545   if (args) {
546     PetscInt i = 0;
547 
548     while (args[i]) PetscCall(PetscFree(args[i++]));
549     PetscCall(PetscFree(args));
550   }
551   PetscFunctionReturn(0);
552 }
553 
554 #if PetscDefined(HAVE_SAWS)
555 #include <petscconfiginfo.h>
556 
557 PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char help[]) {
558   PetscFunctionBegin;
559   if (!PetscGlobalRank) {
560     char      cert[PETSC_MAX_PATH_LEN], root[PETSC_MAX_PATH_LEN], *intro, programname[64], *appline, *options, version[64];
561     int       port;
562     PetscBool flg, rootlocal = PETSC_FALSE, flg2, selectport = PETSC_FALSE;
563     size_t    applinelen, introlen;
564     char      sawsurl[256];
565 
566     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_log", &flg));
567     if (flg) {
568       char sawslog[PETSC_MAX_PATH_LEN];
569 
570       PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_log", sawslog, sizeof(sawslog), NULL));
571       if (sawslog[0]) {
572         PetscCallSAWs(SAWs_Set_Use_Logfile, (sawslog));
573       } else {
574         PetscCallSAWs(SAWs_Set_Use_Logfile, (NULL));
575       }
576     }
577     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_https", cert, sizeof(cert), &flg));
578     if (flg) PetscCallSAWs(SAWs_Set_Use_HTTPS, (cert));
579     PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select", &selectport, NULL));
580     if (selectport) {
581       PetscCallSAWs(SAWs_Get_Available_Port, (&port));
582       PetscCallSAWs(SAWs_Set_Port, (port));
583     } else {
584       PetscCall(PetscOptionsGetInt(NULL, NULL, "-saws_port", &port, &flg));
585       if (flg) PetscCallSAWs(SAWs_Set_Port, (port));
586     }
587     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_root", root, sizeof(root), &flg));
588     if (flg) {
589       PetscCallSAWs(SAWs_Set_Document_Root, (root));
590       PetscCall(PetscStrcmp(root, ".", &rootlocal));
591     } else {
592       PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_options", &flg));
593       if (flg) {
594         PetscCall(PetscStrreplace(PETSC_COMM_WORLD, "${PETSC_DIR}/share/petsc/saws", root, sizeof(root)));
595         PetscCallSAWs(SAWs_Set_Document_Root, (root));
596       }
597     }
598     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_local", &flg2));
599     if (flg2) {
600       char jsdir[PETSC_MAX_PATH_LEN];
601       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_SUP, "-saws_local option requires -saws_root option");
602       PetscCall(PetscSNPrintf(jsdir, sizeof(jsdir), "%s/js", root));
603       PetscCall(PetscTestDirectory(jsdir, 'r', &flg));
604       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "-saws_local option requires js directory in root directory");
605       PetscCallSAWs(SAWs_Push_Local_Header, ());
606     }
607     PetscCall(PetscGetProgramName(programname, sizeof(programname)));
608     PetscCall(PetscStrlen(help, &applinelen));
609     introlen = 4096 + applinelen;
610     applinelen += 1024;
611     PetscCall(PetscMalloc(applinelen, &appline));
612     PetscCall(PetscMalloc(introlen, &intro));
613 
614     if (rootlocal) {
615       PetscCall(PetscSNPrintf(appline, applinelen, "%s.c.html", programname));
616       PetscCall(PetscTestFile(appline, 'r', &rootlocal));
617     }
618     PetscCall(PetscOptionsGetAll(NULL, &options));
619     if (rootlocal && help) {
620       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));
621     } else if (help) {
622       PetscCall(PetscSNPrintf(appline, applinelen, "<center>Running %s %s</center><br><center><pre>%s</pre></center><br>", programname, options, help));
623     } else {
624       PetscCall(PetscSNPrintf(appline, applinelen, "<center> Running %s %s</center><br>\n", programname, options));
625     }
626     PetscCall(PetscFree(options));
627     PetscCall(PetscGetVersion(version, sizeof(version)));
628     PetscCall(PetscSNPrintf(intro, introlen,
629                             "<body>\n"
630                             "<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"
631                             "<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"
632                             "%s",
633                             version, petscconfigureoptions, appline));
634     PetscCallSAWs(SAWs_Push_Body, ("index.html", 0, intro));
635     PetscCall(PetscFree(intro));
636     PetscCall(PetscFree(appline));
637     if (selectport) {
638       PetscBool silent;
639 
640       /* another process may have grabbed the port so keep trying */
641       while (SAWs_Initialize()) {
642         PetscCallSAWs(SAWs_Get_Available_Port, (&port));
643         PetscCallSAWs(SAWs_Set_Port, (port));
644       }
645 
646       PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select_silent", &silent, NULL));
647       if (!silent) {
648         PetscCallSAWs(SAWs_Get_FullURL, (sizeof(sawsurl), sawsurl));
649         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Point your browser to %s for SAWs\n", sawsurl));
650       }
651     } else {
652       PetscCallSAWs(SAWs_Initialize, ());
653     }
654     PetscCall(PetscCitationsRegister("@TechReport{ saws,\n"
655                                      "  Author = {Matt Otten and Jed Brown and Barry Smith},\n"
656                                      "  Title  = {Scientific Application Web Server (SAWs) Users Manual},\n"
657                                      "  Institution = {Argonne National Laboratory},\n"
658                                      "  Year   = 2013\n}\n",
659                                      NULL));
660   }
661   PetscFunctionReturn(0);
662 }
663 #endif
664 
665 /* Things must be done before MPI_Init() when MPI is not yet initialized, and can be shared between C init and Fortran init */
666 PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(void) {
667   PetscFunctionBegin;
668 #if defined(PETSC_HAVE_HWLOC_SOLARIS_BUG)
669   /* see MPI.py for details on this bug */
670   (void)setenv("HWLOC_COMPONENTS", "-x86", 1);
671 #endif
672   PetscFunctionReturn(0);
673 }
674 
675 #if PetscDefined(HAVE_ADIOS)
676 #include <adios.h>
677 #include <adios_read.h>
678 int64_t Petsc_adios_group;
679 #endif
680 #if PetscDefined(HAVE_OPENMP)
681 #include <omp.h>
682 PetscInt PetscNumOMPThreads;
683 #endif
684 
685 #if PetscDefined(HAVE_DEVICE)
686 #include <petsc/private/deviceimpl.h>
687 #if PetscDefined(HAVE_CUDA)
688 // REMOVE ME
689 cudaStream_t PetscDefaultCudaStream = NULL;
690 #endif
691 #if PetscDefined(HAVE_HIP)
692 // REMOVE ME
693 hipStream_t PetscDefaultHipStream = NULL;
694 #endif
695 #endif
696 
697 #if PetscDefined(HAVE_DLFCN_H)
698 #include <dlfcn.h>
699 #endif
700 #if PetscDefined(USE_LOG)
701 PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
702 #endif
703 #if PetscDefined(HAVE_VIENNACL)
704 PETSC_EXTERN PetscErrorCode PetscViennaCLInit();
705 PetscBool                   PetscViennaCLSynchronize = PETSC_FALSE;
706 #endif
707 
708 PetscBool PetscCIEnabled = PETSC_FALSE, PetscCIEnabledPortableErrorOutput = PETSC_FALSE;
709 
710 /*
711   PetscInitialize_Common  - shared code between C and Fortran initialization
712 
713   prog:     program name
714   file:     optional PETSc database file name. Might be in Fortran string format when 'ftn' is true
715   help:     program help message
716   ftn:      is it called from Fortran initilization (petscinitializef_)?
717   readarguments,len: used when fortran is true
718 */
719 PETSC_INTERN PetscErrorCode PetscInitialize_Common(const char *prog, const char *file, const char *help, PetscBool ftn, PetscBool readarguments, PetscInt len) {
720   PetscMPIInt size;
721   PetscBool   flg = PETSC_TRUE;
722   char        hostname[256];
723 
724   PetscFunctionBegin;
725   if (PetscInitializeCalled) PetscFunctionReturn(0);
726   /* these must be initialized in a routine, not as a constant declaration */
727   PETSC_STDOUT = stdout;
728   PETSC_STDERR = stderr;
729 
730   /* PetscCall can be used from now */
731   PetscErrorHandlingInitialized = PETSC_TRUE;
732 
733   /*
734       The checking over compatible runtime libraries is complicated by the MPI ABI initiative
735       https://wiki.mpich.org/mpich/index.php/ABI_Compatibility_Initiative which started with
736         MPICH v3.1 (Released February 2014)
737         IBM MPI v2.1 (December 2014)
738         Intel MPI Library v5.0 (2014)
739         Cray MPT v7.0.0 (June 2014)
740       As of July 31, 2017 the ABI number still appears to be 12, that is all of the versions
741       listed above and since that time are compatible.
742 
743       Unfortunately the MPI ABI initiative has not defined a way to determine the ABI number
744       at compile time or runtime. Thus we will need to systematically track the allowed versions
745       and how they are represented in the mpi.h and MPI_Get_library_version() output in order
746       to perform the checking.
747 
748       Currently we only check for pre MPI ABI versions (and packages that do not follow the MPI ABI).
749 
750       Questions:
751 
752         Should the checks for ABI incompatibility be only on the major version number below?
753         Presumably the output to stderr will be removed before a release.
754   */
755 
756 #if defined(PETSC_HAVE_MPI_GET_LIBRARY_VERSION)
757   {
758     char        mpilibraryversion[MPI_MAX_LIBRARY_VERSION_STRING];
759     PetscMPIInt mpilibraryversionlength;
760 
761     PetscCallMPI(MPI_Get_library_version(mpilibraryversion, &mpilibraryversionlength));
762     /* check for MPICH versions before MPI ABI initiative */
763 #if defined(MPICH_VERSION)
764 #if MPICH_NUMVERSION < 30100000
765     {
766       char     *ver, *lf;
767       PetscBool flg = PETSC_FALSE;
768 
769       PetscCall(PetscStrstr(mpilibraryversion, "MPICH Version:", &ver));
770       if (ver) {
771         PetscCall(PetscStrchr(ver, '\n', &lf));
772         if (lf) {
773           *lf = 0;
774           PetscCall(PetscStrendswith(ver, MPICH_VERSION, &flg));
775         }
776       }
777       if (!flg) {
778         PetscCall(PetscInfo(NULL, "PETSc warning --- MPICH library version \n%s does not match what PETSc was compiled with %s.\n", mpilibraryversion, MPICH_VERSION));
779         flg = PETSC_TRUE;
780       }
781     }
782 #endif
783     /* check for OpenMPI version, it is not part of the MPI ABI initiative (is it part of another initiative that needs to be handled?) */
784 #elif defined(OMPI_MAJOR_VERSION)
785     {
786       char     *ver, bs[MPI_MAX_LIBRARY_VERSION_STRING], *bsf;
787       PetscBool flg                                              = PETSC_FALSE;
788 #define PSTRSZ 2
789       char      ompistr1[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"Open MPI", "FUJITSU MPI"};
790       char      ompistr2[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"v", "Library "};
791       int       i;
792       for (i = 0; i < PSTRSZ; i++) {
793         PetscCall(PetscStrstr(mpilibraryversion, ompistr1[i], &ver));
794         if (ver) {
795           PetscCall(PetscSNPrintf(bs, MPI_MAX_LIBRARY_VERSION_STRING, "%s%d.%d", ompistr2[i], OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION));
796           PetscCall(PetscStrstr(ver, bs, &bsf));
797           if (bsf) flg = PETSC_TRUE;
798           break;
799         }
800       }
801       if (!flg) {
802         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);
803         flg = PETSC_TRUE;
804       }
805     }
806 #endif
807   }
808 #endif
809 
810 #if PetscDefined(HAVE_DLSYM) && defined(__USE_GNU)
811   /* 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 */
812   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");
813 #endif
814 
815   /* on Windows - set printf to default to printing 2 digit exponents */
816 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
817   _set_output_format(_TWO_DIGIT_EXPONENT);
818 #endif
819 
820   PetscCall(PetscOptionsCreateDefault());
821 
822   PetscFinalizeCalled = PETSC_FALSE;
823 
824   PetscCall(PetscSetProgramName(prog));
825   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen));
826   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout));
827   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr));
828   PetscCall(PetscSpinlockCreate(&PetscCommSpinLock));
829 
830   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
831   PetscCallMPI(MPI_Comm_set_errhandler(PETSC_COMM_WORLD, MPI_ERRORS_RETURN));
832 
833   if (PETSC_MPI_ERROR_CLASS == MPI_ERR_LASTCODE) {
834     PetscCallMPI(MPI_Add_error_class(&PETSC_MPI_ERROR_CLASS));
835     PetscCallMPI(MPI_Add_error_code(PETSC_MPI_ERROR_CLASS, &PETSC_MPI_ERROR_CODE));
836   }
837 
838   /* Done after init due to a bug in MPICH-GM? */
839   PetscCall(PetscErrorPrintfInitialize());
840 
841   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &PetscGlobalRank));
842   PetscCallMPI(MPI_Comm_size(MPI_COMM_WORLD, &PetscGlobalSize));
843 
844   MPIU_BOOL        = MPI_INT;
845   MPIU_ENUM        = MPI_INT;
846   MPIU_FORTRANADDR = (sizeof(void *) == sizeof(int)) ? MPI_INT : MPIU_INT64;
847   if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED;
848   else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG;
849 #if defined(PETSC_SIZEOF_LONG_LONG)
850   else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG;
851 #endif
852   else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_SUP_SYS, "Could not find MPI type for size_t");
853 
854     /*
855      Initialized the global complex variable; this is because with
856      shared libraries the constructors for global variables
857      are not called; at least on IRIX.
858   */
859 #if defined(PETSC_HAVE_COMPLEX)
860   {
861 #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128)
862     PetscComplex ic(0.0, 1.0);
863     PETSC_i = ic;
864 #else
865     PETSC_i = _Complex_I;
866 #endif
867   }
868 #endif /* PETSC_HAVE_COMPLEX */
869 
870   /*
871      Create the PETSc MPI reduction operator that sums of the first
872      half of the entries and maxes the second half.
873   */
874   PetscCallMPI(MPI_Op_create(MPIU_MaxSum_Local, 1, &MPIU_MAXSUM_OP));
875 
876 #if defined(PETSC_HAVE_REAL___FLOAT128)
877   PetscCallMPI(MPI_Type_contiguous(2, MPI_DOUBLE, &MPIU___FLOAT128));
878   PetscCallMPI(MPI_Type_commit(&MPIU___FLOAT128));
879   PetscCallMPI(MPI_Type_contiguous(4, MPI_DOUBLE, &MPIU___COMPLEX128));
880   PetscCallMPI(MPI_Type_commit(&MPIU___COMPLEX128));
881 #endif
882 #if defined(PETSC_HAVE_REAL___FP16)
883   PetscCallMPI(MPI_Type_contiguous(2, MPI_CHAR, &MPIU___FP16));
884   PetscCallMPI(MPI_Type_commit(&MPIU___FP16));
885 #endif
886 
887 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
888   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM));
889   PetscCallMPI(MPI_Op_create(PetscMax_Local, 1, &MPIU_MAX));
890   PetscCallMPI(MPI_Op_create(PetscMin_Local, 1, &MPIU_MIN));
891 #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
892   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM___FP16___FLOAT128));
893 #endif
894 
895   PetscCallMPI(MPI_Type_contiguous(2, MPIU_SCALAR, &MPIU_2SCALAR));
896   PetscCallMPI(MPI_Type_commit(&MPIU_2SCALAR));
897 
898   /* create datatypes used by MPIU_MAXLOC, MPIU_MINLOC and PetscSplitReduction_Op */
899 #if !defined(PETSC_HAVE_MPIUNI)
900   {
901     struct PetscRealInt {
902       PetscReal v;
903       PetscInt  i;
904     };
905     PetscMPIInt  blockSizes[2]   = {1, 1};
906     MPI_Aint     blockOffsets[2] = {offsetof(struct PetscRealInt, v), offsetof(struct PetscRealInt, i)};
907     MPI_Datatype blockTypes[2]   = {MPIU_REAL, MPIU_INT}, tmpStruct;
908 
909     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
910     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct PetscRealInt), &MPIU_REAL_INT));
911     PetscCallMPI(MPI_Type_free(&tmpStruct));
912     PetscCallMPI(MPI_Type_commit(&MPIU_REAL_INT));
913   }
914   {
915     struct PetscScalarInt {
916       PetscScalar v;
917       PetscInt    i;
918     };
919     PetscMPIInt  blockSizes[2]   = {1, 1};
920     MPI_Aint     blockOffsets[2] = {offsetof(struct PetscScalarInt, v), offsetof(struct PetscScalarInt, i)};
921     MPI_Datatype blockTypes[2]   = {MPIU_SCALAR, MPIU_INT}, tmpStruct;
922 
923     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
924     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct PetscScalarInt), &MPIU_SCALAR_INT));
925     PetscCallMPI(MPI_Type_free(&tmpStruct));
926     PetscCallMPI(MPI_Type_commit(&MPIU_SCALAR_INT));
927   }
928 #endif
929 
930 #if defined(PETSC_USE_64BIT_INDICES)
931   PetscCallMPI(MPI_Type_contiguous(2, MPIU_INT, &MPIU_2INT));
932   PetscCallMPI(MPI_Type_commit(&MPIU_2INT));
933 #endif
934   PetscCallMPI(MPI_Type_contiguous(4, MPI_INT, &MPI_4INT));
935   PetscCallMPI(MPI_Type_commit(&MPI_4INT));
936   PetscCallMPI(MPI_Type_contiguous(4, MPIU_INT, &MPIU_4INT));
937   PetscCallMPI(MPI_Type_commit(&MPIU_4INT));
938 
939   /*
940      Attributes to be set on PETSc communicators
941   */
942   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_Counter_Attr_Delete_Fn, &Petsc_Counter_keyval, (void *)0));
943   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_InnerComm_Attr_Delete_Fn, &Petsc_InnerComm_keyval, (void *)0));
944   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_OuterComm_Attr_Delete_Fn, &Petsc_OuterComm_keyval, (void *)0));
945   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_ShmComm_Attr_Delete_Fn, &Petsc_ShmComm_keyval, (void *)0));
946 
947 #if defined(PETSC_HAVE_FORTRAN)
948   if (ftn) PetscCall(PetscInitFortran_Private(readarguments, file, len));
949   else
950 #endif
951     PetscCall(PetscOptionsInsert(NULL, &PetscGlobalArgc, &PetscGlobalArgs, file));
952 
953   /* call a second time so it can look in the options database */
954   PetscCall(PetscErrorPrintfInitialize());
955 
956   /*
957      Check system options and print help
958   */
959   PetscCall(PetscOptionsCheckInitial_Private(help));
960 
961   /*
962    Initialize PetscDevice and PetscDeviceContext
963 
964    Note to any future devs thinking of moving this, proper initialization requires:
965    1. MPI initialized
966    2. Options DB initialized
967    3. Petsc error handling initialized, specifically signal handlers. This expects to set up its own SIGSEV handler via
968       the push/pop interface.
969   */
970 #if (PetscDefined(HAVE_CUDA) || PetscDefined(HAVE_HIP) || PetscDefined(HAVE_SYCL))
971   PetscCall(PetscDeviceInitializeFromOptions_Internal(PETSC_COMM_WORLD));
972 #endif
973 
974 #if PetscDefined(HAVE_VIENNACL)
975   flg = PETSC_FALSE;
976   PetscCall(PetscOptionsHasName(NULL, NULL, "-log_summary", &flg));
977   if (!flg) PetscCall(PetscOptionsHasName(NULL, NULL, "-log_view", &flg));
978   if (!flg) PetscCall(PetscOptionsGetBool(NULL, NULL, "-viennacl_synchronize", &flg, NULL));
979   PetscViennaCLSynchronize = flg;
980   PetscCall(PetscViennaCLInit());
981 #endif
982 
983   /*
984      Creates the logging data structures; this is enabled even if logging is not turned on
985      This is the last thing we do before returning to the user code to prevent having the
986      logging numbers contaminated by any startup time associated with MPI
987   */
988 #if defined(PETSC_USE_LOG)
989   PetscCall(PetscLogInitialize());
990 #endif
991 
992   PetscCall(PetscCitationsInitialize());
993 
994 #if defined(PETSC_HAVE_SAWS)
995   PetscCall(PetscInitializeSAWs(ftn ? NULL : help));
996   flg = PETSC_FALSE;
997   PetscCall(PetscOptionsHasName(NULL, NULL, "-stack_view", &flg));
998   if (flg) PetscCall(PetscStackViewSAWs());
999 #endif
1000 
1001   /*
1002      Load the dynamic libraries (on machines that support them), this registers all
1003      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
1004   */
1005   PetscCall(PetscInitialize_DynamicLibraries());
1006 
1007   PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));
1008   PetscCall(PetscInfo(NULL, "PETSc successfully started: number of processors = %d\n", size));
1009   PetscCall(PetscGetHostName(hostname, 256));
1010   PetscCall(PetscInfo(NULL, "Running on machine: %s\n", hostname));
1011 #if defined(PETSC_HAVE_OPENMP)
1012   {
1013     PetscBool omp_view_flag;
1014     char     *threads = getenv("OMP_NUM_THREADS");
1015 
1016     if (threads) {
1017       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n", threads));
1018       (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumOMPThreads);
1019     } else {
1020       PetscNumOMPThreads = (PetscInt)omp_get_max_threads();
1021       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n", PetscNumOMPThreads));
1022     }
1023     PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "OpenMP options", "Sys");
1024     PetscCall(PetscOptionsInt("-omp_num_threads", "Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS", "None", PetscNumOMPThreads, &PetscNumOMPThreads, &flg));
1025     PetscCall(PetscOptionsName("-omp_view", "Display OpenMP number of threads", NULL, &omp_view_flag));
1026     PetscOptionsEnd();
1027     if (flg) {
1028       PetscCall(PetscInfo(NULL, "Number of OpenMP theads %" PetscInt_FMT " (given by -omp_num_threads)\n", PetscNumOMPThreads));
1029       omp_set_num_threads((int)PetscNumOMPThreads);
1030     }
1031     if (omp_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "OpenMP: number of threads %" PetscInt_FMT "\n", PetscNumOMPThreads));
1032   }
1033 #endif
1034 
1035 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
1036   /*
1037       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
1038 
1039       Currently not used because it is not supported by MPICH.
1040   */
1041   if (!PetscBinaryBigEndian()) PetscCallMPI(MPI_Register_datarep((char *)"petsc", PetscDataRep_read_conv_fn, PetscDataRep_write_conv_fn, PetscDataRep_extent_fn, NULL));
1042 #endif
1043 
1044 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1045   PetscCall(PetscFPTCreate(10000));
1046 #endif
1047 
1048 #if defined(PETSC_HAVE_HWLOC)
1049   {
1050     PetscViewer viewer;
1051     PetscCall(PetscOptionsGetViewer(PETSC_COMM_WORLD, NULL, NULL, "-process_view", &viewer, NULL, &flg));
1052     if (flg) {
1053       PetscCall(PetscProcessPlacementView(viewer));
1054       PetscCall(PetscViewerDestroy(&viewer));
1055     }
1056   }
1057 #endif
1058 
1059   flg = PETSC_TRUE;
1060   PetscCall(PetscOptionsGetBool(NULL, NULL, "-viewfromoptions", &flg, NULL));
1061   if (!flg) PetscCall(PetscOptionsPushGetViewerOff(PETSC_TRUE));
1062 
1063 #if defined(PETSC_HAVE_ADIOS)
1064   PetscCall(adios_init_noxml(PETSC_COMM_WORLD));
1065   PetscCall(adios_declare_group(&Petsc_adios_group, "PETSc", "", adios_stat_default));
1066   PetscCall(adios_select_method(Petsc_adios_group, "MPI", "", ""));
1067   PetscCall(adios_read_init_method(ADIOS_READ_METHOD_BP, PETSC_COMM_WORLD, ""));
1068 #endif
1069 
1070 #if defined(__VALGRIND_H)
1071   PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND ? PETSC_TRUE : PETSC_FALSE;
1072 #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE)
1073   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"));
1074 #endif
1075 #endif
1076   /*
1077       Set flag that we are completely initialized
1078   */
1079   PetscInitializeCalled = PETSC_TRUE;
1080 
1081   PetscCall(PetscOptionsHasName(NULL, NULL, "-python", &flg));
1082   if (flg) PetscCall(PetscPythonInitialize(NULL, NULL));
1083 
1084   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1085   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerBegin());
1086   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");
1087   PetscFunctionReturn(0);
1088 }
1089 
1090 /*@C
1091    PetscInitialize - Initializes the PETSc database and MPI.
1092    `PetscInitialize()` calls MPI_Init() if that has yet to be called,
1093    so this routine should always be called near the beginning of
1094    your program -- usually the very first line!
1095 
1096    Collective on `MPI_COMM_WORLD` or `PETSC_COMM_WORLD` if it has been set
1097 
1098    Input Parameters:
1099 +  argc - count of number of command line arguments
1100 .  args - the command line arguments
1101 .  file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format.
1102           Use NULL or empty string to not check for code specific file.
1103           Also checks ~/.petscrc, .petscrc and petscrc.
1104           Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files.
1105 -  help - [optional] Help message to print, use NULL for no message
1106 
1107    If you wish PETSc code to run ONLY on a subcommunicator of `MPI_COMM_WORLD`, create that
1108    communicator first and assign it to `PETSC_COMM_WORLD` BEFORE calling `PetscInitialize()`. Thus if you are running a
1109    four process job and two processes will run PETSc and have `PetscInitialize()` and PetscFinalize() and two process will not,
1110    then do this. If ALL processes in the job are using `PetscInitialize()` and `PetscFinalize()` then you don't need to do this, even
1111    if different subcommunicators of the job are doing different things with PETSc.
1112 
1113    Options Database Keys:
1114 +  -help [intro] - prints help method for each option; if intro is given the program stops after printing the introductory help message
1115 .  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
1116 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
1117 .  -on_error_emacs <machinename> - causes emacsclient to jump to error file
1118 .  -on_error_abort - calls `abort()` when error detected (no traceback)
1119 .  -on_error_mpiabort - calls `MPI_abort()` when error detected
1120 .  -error_output_stdout - prints PETSc error messages to stdout instead of the default stderr
1121 .  -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called)
1122 .  -debugger_ranks [rank1,rank2,...] - Indicates ranks to start in debugger
1123 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
1124 .  -stop_for_debugger - Print message on how to attach debugger manually to
1125                         process and wait (-debugger_pause) seconds for attachment
1126 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) (deprecated, use -malloc_debug)
1127 .  -malloc no - Indicates not to use error-checking malloc (deprecated, use -malloc_debug no)
1128 .  -malloc_debug - check for memory corruption at EVERY malloc or free, see `PetscMallocSetDebug()`
1129 .  -malloc_dump - prints a list of all unfreed memory at the end of the run
1130 .  -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
1131 .  -malloc_view - show a list of all allocated memory during `PetscFinalize()`
1132 .  -malloc_view_threshold <t> - only list memory allocations of size greater than t with -malloc_view
1133 .  -malloc_requested_size - malloc logging will record the requested size rather than size after alignment
1134 .  -fp_trap - Stops on floating point exceptions
1135 .  -no_signal_handler - Indicates not to trap error signals
1136 .  -shared_tmp - indicates /tmp directory is shared by all processors
1137 .  -not_shared_tmp - each processor has own /tmp
1138 .  -tmp - alternative name of /tmp directory
1139 .  -get_total_flops - returns total flops done by all processors
1140 -  -memory_view - Print memory usage at end of run
1141 
1142    Options Database Keys for Option Database:
1143 +  -skip_petscrc - skip the default option files ~/.petscrc, .petscrc, petscrc
1144 .  -options_monitor - monitor all set options to standard output for the whole program run
1145 -  -options_monitor_cancel - cancel options monitoring hard-wired using `PetscOptionsMonitorSet()`
1146 
1147    Options -options_monitor_{all,cancel} are
1148    position-independent and apply to all options set since the PETSc start.
1149    They can be used also in option files.
1150 
1151    See `PetscOptionsMonitorSet()` to do monitoring programmatically.
1152 
1153    Options Database Keys for Profiling:
1154    See Users-Manual: ch_profiling for details.
1155 +  -info [filename][:[~]<list,of,classnames>[:[~]self]] - Prints verbose information. See `PetscInfo()`.
1156 .  -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event,
1157         however it slows things down and gives a distorted view of the overall runtime.
1158 .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
1159         hangs without running in the debugger).  See `PetscLogTraceBegin()`.
1160 .  -log_view [:filename:format] - Prints summary of flop and timing information to screen or file, see `PetscLogView()`.
1161 .  -log_view_memory - Includes in the summary from -log_view the memory used in each event, see `PetscLogView()`.
1162 .  -log_view_gpu_time - Includes in the summary from -log_view the time used in each GPU kernel, see `PetscLogView().
1163 .  -log_summary [filename] - (Deprecated, use -log_view) Prints summary of flop and timing information to screen. If the filename is specified the
1164         summary is written to the file.  See PetscLogView().
1165 .  -log_exclude: <vec,mat,pc,ksp,snes> - excludes subset of object classes from logging
1166 .  -log_all [filename] - Logs extensive profiling information  See `PetscLogDump()`.
1167 .  -log [filename] - Logs basic profiline information  See `PetscLogDump()`.
1168 .  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
1169 .  -viewfromoptions on,off - Enable or disable `XXXSetFromOptions()` calls, for applications with many small solves turn this off
1170 -  -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code
1171 
1172     Only one of -log_trace, -log_view, -log_all, -log, or -log_mpe may be used at a time
1173 
1174    Options Database Keys for SAWs:
1175 +  -saws_port <portnumber> - port number to publish SAWs data, default is 8080
1176 .  -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen
1177                             this is useful when you are running many jobs that utilize SAWs at the same time
1178 .  -saws_log <filename> - save a log of all SAWs communication
1179 .  -saws_https <certificate file> - have SAWs use HTTPS instead of HTTP
1180 -  -saws_root <directory> - allow SAWs to have access to the given directory to search for requested resources and files
1181 
1182    Environmental Variables:
1183 +   `PETSC_TMP` - alternative tmp directory
1184 .   `PETSC_SHARED_TMP` - tmp is shared by all processes
1185 .   `PETSC_NOT_SHARED_TMP` - each process has its own private tmp
1186 .   `PETSC_OPTIONS` - a string containing additional options for petsc in the form of command line "-key value" pairs
1187 .   `PETSC_OPTIONS_YAML` - (requires configuring PETSc to use libyaml) a string containing additional options for petsc in the form of a YAML document
1188 .   `PETSC_VIEWER_SOCKET_PORT` - socket number to use for socket viewer
1189 -   `PETSC_VIEWER_SOCKET_MACHINE` - machine to use for socket viewer to connect to
1190 
1191    Level: beginner
1192 
1193    Note:
1194    If for some reason you must call `MPI_Init()` separately, call
1195    it before `PetscInitialize()`.
1196 
1197    Fortran Notes:
1198    In Fortran this routine can be called with
1199 .vb
1200        call PetscInitialize(ierr)
1201        call PetscInitialize(file,ierr) or
1202        call PetscInitialize(file,help,ierr)
1203 .ve
1204 
1205    If your main program is C but you call Fortran code that also uses PETSc you need to call `PetscInitializeFortran()` soon after
1206    calling `PetscInitialize()`.
1207 
1208 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscInitializeNoArguments()`, `PetscLogGpuTime()`
1209 @*/
1210 PetscErrorCode PetscInitialize(int *argc, char ***args, const char file[], const char help[]) {
1211   PetscMPIInt flag;
1212   const char *prog = "Unknown Name", *mpienv;
1213 
1214   PetscFunctionBegin;
1215   if (PetscInitializeCalled) PetscFunctionReturn(0);
1216   PetscCallMPI(MPI_Initialized(&flag));
1217   if (!flag) {
1218     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");
1219     PetscCall(PetscPreMPIInit_Private());
1220 #if defined(PETSC_HAVE_MPI_INIT_THREAD)
1221     {
1222       PetscMPIInt PETSC_UNUSED provided;
1223       PetscCallMPI(MPI_Init_thread(argc, args, PETSC_MPI_THREAD_REQUIRED, &provided));
1224     }
1225 #else
1226     PetscCallMPI(MPI_Init(argc, args));
1227 #endif
1228     if (PetscDefined(HAVE_MPIUNI)) {
1229       mpienv = getenv("PMI_SIZE");
1230       if (!mpienv) mpienv = getenv("OMPI_COMM_WORLD_SIZE");
1231       if (mpienv) {
1232         PetscInt isize;
1233         PetscCall(PetscOptionsStringToInt(mpienv, &isize));
1234         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");
1235         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");
1236       }
1237     }
1238     PetscBeganMPI = PETSC_TRUE;
1239   }
1240 
1241   if (argc && *argc) prog = **args;
1242   if (argc && args) {
1243     PetscGlobalArgc = *argc;
1244     PetscGlobalArgs = *args;
1245   }
1246   PetscCall(PetscInitialize_Common(prog, file, help, PETSC_FALSE, PETSC_FALSE, 0));
1247   PetscFunctionReturn(0);
1248 }
1249 
1250 #if PetscDefined(USE_LOG)
1251 PETSC_INTERN PetscObject *PetscObjects;
1252 PETSC_INTERN PetscInt     PetscObjectsCounts;
1253 PETSC_INTERN PetscInt     PetscObjectsMaxCounts;
1254 PETSC_INTERN PetscBool    PetscObjectsLog;
1255 #endif
1256 
1257 /*
1258     Frees all the MPI types and operations that PETSc may have created
1259 */
1260 PetscErrorCode PetscFreeMPIResources(void) {
1261   PetscFunctionBegin;
1262 #if defined(PETSC_HAVE_REAL___FLOAT128)
1263   PetscCallMPI(MPI_Type_free(&MPIU___FLOAT128));
1264   PetscCallMPI(MPI_Type_free(&MPIU___COMPLEX128));
1265 #endif
1266 #if defined(PETSC_HAVE_REAL___FP16)
1267   PetscCallMPI(MPI_Type_free(&MPIU___FP16));
1268 #endif
1269 
1270 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
1271   PetscCallMPI(MPI_Op_free(&MPIU_SUM));
1272   PetscCallMPI(MPI_Op_free(&MPIU_MAX));
1273   PetscCallMPI(MPI_Op_free(&MPIU_MIN));
1274 #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
1275   PetscCallMPI(MPI_Op_free(&MPIU_SUM___FP16___FLOAT128));
1276 #endif
1277 
1278   PetscCallMPI(MPI_Type_free(&MPIU_2SCALAR));
1279   PetscCallMPI(MPI_Type_free(&MPIU_REAL_INT));
1280   PetscCallMPI(MPI_Type_free(&MPIU_SCALAR_INT));
1281 #if defined(PETSC_USE_64BIT_INDICES)
1282   PetscCallMPI(MPI_Type_free(&MPIU_2INT));
1283 #endif
1284   PetscCallMPI(MPI_Type_free(&MPI_4INT));
1285   PetscCallMPI(MPI_Type_free(&MPIU_4INT));
1286   PetscCallMPI(MPI_Op_free(&MPIU_MAXSUM_OP));
1287   PetscFunctionReturn(0);
1288 }
1289 
1290 #if PetscDefined(USE_LOG)
1291 PETSC_INTERN PetscErrorCode PetscLogFinalize(void);
1292 #endif
1293 
1294 /*@C
1295    PetscFinalize - Checks for options to be called at the conclusion
1296    of the program. `MPI_Finalize()` is called only if the user had not
1297    called `MPI_Init()` before calling `PetscInitialize()`.
1298 
1299    Collective on `PETSC_COMM_WORLD`
1300 
1301    Options Database Keys:
1302 +  -options_view - Calls `PetscOptionsView()`
1303 .  -options_left - Prints unused options that remain in the database
1304 .  -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
1305 .  -mpidump - Calls PetscMPIDump()
1306 .  -malloc_dump <optional filename> - Calls `PetscMallocDump()`, displays all memory allocated that has not been freed
1307 .  -malloc_info - Prints total memory usage
1308 -  -malloc_view <optional filename> - Prints list of all memory allocated and where
1309 
1310    Level: beginner
1311 
1312    Note:
1313    See `PetscInitialize()` for other runtime options.
1314 
1315 .seealso: `PetscInitialize()`, `PetscOptionsView()`, `PetscMallocDump()`, `PetscMPIDump()`, `PetscEnd()`
1316 @*/
1317 PetscErrorCode PetscFinalize(void) {
1318   PetscMPIInt rank;
1319   PetscInt    nopt;
1320   PetscBool   flg1 = PETSC_FALSE, flg2 = PETSC_FALSE, flg3 = PETSC_FALSE;
1321   PetscBool   flg;
1322 #if defined(PETSC_USE_LOG)
1323   char mname[PETSC_MAX_PATH_LEN];
1324 #endif
1325 
1326   PetscFunctionBegin;
1327   PetscCheck(PetscInitializeCalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscInitialize() must be called before PetscFinalize()");
1328   PetscCall(PetscInfo(NULL, "PetscFinalize() called\n"));
1329 
1330   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1331   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerEnd());
1332 
1333   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
1334 #if defined(PETSC_HAVE_ADIOS)
1335   PetscCall(adios_read_finalize_method(ADIOS_READ_METHOD_BP_AGGREGATE));
1336   PetscCall(adios_finalize(rank));
1337 #endif
1338   PetscCall(PetscOptionsHasName(NULL, NULL, "-citations", &flg));
1339   if (flg) {
1340     char *cits, filename[PETSC_MAX_PATH_LEN];
1341     FILE *fd = PETSC_STDOUT;
1342 
1343     PetscCall(PetscOptionsGetString(NULL, NULL, "-citations", filename, sizeof(filename), NULL));
1344     if (filename[0]) PetscCall(PetscFOpen(PETSC_COMM_WORLD, filename, "w", &fd));
1345     PetscCall(PetscSegBufferGet(PetscCitationsList, 1, &cits));
1346     cits[0] = 0;
1347     PetscCall(PetscSegBufferExtractAlloc(PetscCitationsList, &cits));
1348     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "If you publish results based on this computation please cite the following:\n"));
1349     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1350     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "%s", cits));
1351     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1352     PetscCall(PetscFClose(PETSC_COMM_WORLD, fd));
1353     PetscCall(PetscFree(cits));
1354   }
1355   PetscCall(PetscSegBufferDestroy(&PetscCitationsList));
1356 
1357 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER)
1358   /* TextBelt is run for testing purposes only, please do not use this feature often */
1359   {
1360     PetscInt nmax = 2;
1361     char   **buffs;
1362     PetscCall(PetscMalloc1(2, &buffs));
1363     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-textbelt", buffs, &nmax, &flg1));
1364     if (flg1) {
1365       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-textbelt requires either the phone number or number,\"message\"");
1366       if (nmax == 1) {
1367         PetscCall(PetscMalloc1(128, &buffs[1]));
1368         PetscCall(PetscGetProgramName(buffs[1], 32));
1369         PetscCall(PetscStrcat(buffs[1], " has completed"));
1370       }
1371       PetscCall(PetscTextBelt(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1372       PetscCall(PetscFree(buffs[0]));
1373       PetscCall(PetscFree(buffs[1]));
1374     }
1375     PetscCall(PetscFree(buffs));
1376   }
1377   {
1378     PetscInt nmax = 2;
1379     char   **buffs;
1380     PetscCall(PetscMalloc1(2, &buffs));
1381     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-tellmycell", buffs, &nmax, &flg1));
1382     if (flg1) {
1383       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-tellmycell requires either the phone number or number,\"message\"");
1384       if (nmax == 1) {
1385         PetscCall(PetscMalloc1(128, &buffs[1]));
1386         PetscCall(PetscGetProgramName(buffs[1], 32));
1387         PetscCall(PetscStrcat(buffs[1], " has completed"));
1388       }
1389       PetscCall(PetscTellMyCell(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1390       PetscCall(PetscFree(buffs[0]));
1391       PetscCall(PetscFree(buffs[1]));
1392     }
1393     PetscCall(PetscFree(buffs));
1394   }
1395 #endif
1396 
1397 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1398   PetscCall(PetscFPTDestroy());
1399 #endif
1400 
1401 #if defined(PETSC_HAVE_SAWS)
1402   flg = PETSC_FALSE;
1403   PetscCall(PetscOptionsGetBool(NULL, NULL, "-saw_options", &flg, NULL));
1404   if (flg) PetscCall(PetscOptionsSAWsDestroy());
1405 #endif
1406 
1407 #if defined(PETSC_HAVE_X)
1408   flg1 = PETSC_FALSE;
1409   PetscCall(PetscOptionsGetBool(NULL, NULL, "-x_virtual", &flg1, NULL));
1410   if (flg1) {
1411     /*  this is a crude hack, but better than nothing */
1412     PetscCall(PetscPOpen(PETSC_COMM_WORLD, NULL, "pkill -9 Xvfb", "r", NULL));
1413   }
1414 #endif
1415 
1416 #if !defined(PETSC_HAVE_THREADSAFETY)
1417   PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_info", &flg2, NULL));
1418   if (!flg2) {
1419     flg2 = PETSC_FALSE;
1420     PetscCall(PetscOptionsGetBool(NULL, NULL, "-memory_view", &flg2, NULL));
1421   }
1422   if (flg2) PetscCall(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD, "Summary of Memory Usage in PETSc\n"));
1423 #endif
1424 
1425 #if defined(PETSC_USE_LOG)
1426   flg1 = PETSC_FALSE;
1427   PetscCall(PetscOptionsGetBool(NULL, NULL, "-get_total_flops", &flg1, NULL));
1428   if (flg1) {
1429     PetscLogDouble flops = 0;
1430     PetscCallMPI(MPI_Reduce(&petsc_TotalFlops, &flops, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
1431     PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Total flops over all processors %g\n", flops));
1432   }
1433 #endif
1434 
1435 #if defined(PETSC_USE_LOG)
1436 #if defined(PETSC_HAVE_MPE)
1437   mname[0] = 0;
1438   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_mpe", mname, sizeof(mname), &flg1));
1439   if (flg1) {
1440     if (mname[0]) PetscCall(PetscLogMPEDump(mname));
1441     else PetscCall(PetscLogMPEDump(0));
1442   }
1443 #endif
1444 #endif
1445 
1446   /*
1447      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1448   */
1449   PetscCall(PetscObjectRegisterDestroyAll());
1450 
1451 #if defined(PETSC_USE_LOG)
1452   PetscCall(PetscOptionsPushGetViewerOff(PETSC_FALSE));
1453   PetscCall(PetscLogViewFromOptions());
1454   PetscCall(PetscOptionsPopGetViewerOff());
1455 
1456   mname[0] = 0;
1457   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_summary", mname, sizeof(mname), &flg1));
1458   if (flg1) {
1459     PetscViewer viewer;
1460     PetscCall((*PetscHelpPrintf)(PETSC_COMM_WORLD, "\n\n WARNING:   -log_summary is being deprecated; switch to -log_view\n\n\n"));
1461     if (mname[0]) {
1462       PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD, mname, &viewer));
1463       PetscCall(PetscLogView(viewer));
1464       PetscCall(PetscViewerDestroy(&viewer));
1465     } else {
1466       viewer = PETSC_VIEWER_STDOUT_WORLD;
1467       PetscCall(PetscViewerPushFormat(viewer, PETSC_VIEWER_DEFAULT));
1468       PetscCall(PetscLogView(viewer));
1469       PetscCall(PetscViewerPopFormat(viewer));
1470     }
1471   }
1472 
1473   /*
1474      Free any objects created by the last block of code.
1475   */
1476   PetscCall(PetscObjectRegisterDestroyAll());
1477 
1478   mname[0] = 0;
1479   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_all", mname, sizeof(mname), &flg1));
1480   PetscCall(PetscOptionsGetString(NULL, NULL, "-log", mname, sizeof(mname), &flg2));
1481   if (flg1 || flg2) PetscCall(PetscLogDump(mname));
1482 #endif
1483 
1484   flg1 = PETSC_FALSE;
1485   PetscCall(PetscOptionsGetBool(NULL, NULL, "-no_signal_handler", &flg1, NULL));
1486   if (!flg1) PetscCall(PetscPopSignalHandler());
1487   flg1 = PETSC_FALSE;
1488   PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpidump", &flg1, NULL));
1489   if (flg1) PetscCall(PetscMPIDump(stdout));
1490   flg1 = PETSC_FALSE;
1491   flg2 = PETSC_FALSE;
1492   /* preemptive call to avoid listing this option in options table as unused */
1493   PetscCall(PetscOptionsHasName(NULL, NULL, "-malloc_dump", &flg1));
1494   PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1495   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_view", &flg2, NULL));
1496 
1497   if (flg2) {
1498     PetscViewer viewer;
1499     PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer));
1500     PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII));
1501     PetscCall(PetscOptionsView(NULL, viewer));
1502     PetscCall(PetscViewerDestroy(&viewer));
1503   }
1504 
1505   /* to prevent PETSc -options_left from warning */
1506   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox", &flg1));
1507   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox_warning", &flg1));
1508 
1509   flg3 = PETSC_FALSE; /* default value is required */
1510   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_left", &flg3, &flg1));
1511   if (PetscUnlikelyDebug(!flg1)) flg3 = PETSC_TRUE;
1512   if (flg3) {
1513     if (!flg2 && flg1) { /* have not yet printed the options */
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     PetscCall(PetscOptionsAllUsed(NULL, &nopt));
1521     if (nopt) {
1522       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! There are options you set that were not used!\n"));
1523       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! could be spelling mistake, etc!\n"));
1524       if (nopt == 1) {
1525         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There is one unused database option. It is:\n"));
1526       } else {
1527         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are %" PetscInt_FMT " unused database options. They are:\n", nopt));
1528       }
1529     } else if (flg3 && flg1) {
1530       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are no unused options.\n"));
1531     }
1532     PetscCall(PetscOptionsLeft(NULL));
1533   }
1534 
1535 #if defined(PETSC_HAVE_SAWS)
1536   if (!PetscGlobalRank) {
1537     PetscCall(PetscStackSAWsViewOff());
1538     PetscCallSAWs(SAWs_Finalize, ());
1539   }
1540 #endif
1541 
1542 #if defined(PETSC_USE_LOG)
1543   /*
1544        List all objects the user may have forgot to free
1545   */
1546   if (PetscObjectsLog) {
1547     PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1548     if (flg1) {
1549       MPI_Comm local_comm;
1550       char     string[64];
1551 
1552       PetscCall(PetscOptionsGetString(NULL, NULL, "-objects_dump", string, sizeof(string), NULL));
1553       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1554       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1555       PetscCall(PetscObjectsDump(stdout, (string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE));
1556       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1557       PetscCallMPI(MPI_Comm_free(&local_comm));
1558     }
1559   }
1560 #endif
1561 
1562 #if defined(PETSC_USE_LOG)
1563   PetscObjectsCounts    = 0;
1564   PetscObjectsMaxCounts = 0;
1565   PetscCall(PetscFree(PetscObjects));
1566 #endif
1567 
1568   /*
1569      Destroy any packages that registered a finalize
1570   */
1571   PetscCall(PetscRegisterFinalizeAll());
1572 
1573 #if defined(PETSC_USE_LOG)
1574   PetscCall(PetscLogFinalize());
1575 #endif
1576 
1577   /*
1578      Print PetscFunctionLists that have not been properly freed
1579   */
1580   if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintAll());
1581 
1582   if (petsc_history) {
1583     PetscCall(PetscCloseHistoryFile(&petsc_history));
1584     petsc_history = NULL;
1585   }
1586   PetscCall(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton));
1587   PetscCall(PetscInfoDestroy());
1588 
1589 #if !defined(PETSC_HAVE_THREADSAFETY)
1590   if (!(PETSC_RUNNING_ON_VALGRIND)) {
1591     char  fname[PETSC_MAX_PATH_LEN];
1592     char  sname[PETSC_MAX_PATH_LEN];
1593     FILE *fd;
1594     int   err;
1595 
1596     flg2 = PETSC_FALSE;
1597     flg3 = PETSC_FALSE;
1598     if (PetscDefined(USE_DEBUG)) PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_test", &flg2, NULL));
1599     PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_debug", &flg3, NULL));
1600     fname[0] = 0;
1601     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_dump", fname, sizeof(fname), &flg1));
1602     if (flg1 && fname[0]) {
1603       PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank);
1604       fd = fopen(sname, "w");
1605       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1606       PetscCall(PetscMallocDump(fd));
1607       err = fclose(fd);
1608       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1609     } else if (flg1 || flg2 || flg3) {
1610       MPI_Comm local_comm;
1611 
1612       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1613       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1614       PetscCall(PetscMallocDump(stdout));
1615       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1616       PetscCallMPI(MPI_Comm_free(&local_comm));
1617     }
1618     fname[0] = 0;
1619     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_view", fname, sizeof(fname), &flg1));
1620     if (flg1 && fname[0]) {
1621       PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank);
1622       fd = fopen(sname, "w");
1623       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1624       PetscCall(PetscMallocView(fd));
1625       err = fclose(fd);
1626       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1627     } else if (flg1) {
1628       MPI_Comm local_comm;
1629 
1630       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1631       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1632       PetscCall(PetscMallocView(stdout));
1633       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1634       PetscCallMPI(MPI_Comm_free(&local_comm));
1635     }
1636   }
1637 #endif
1638 
1639   /*
1640      Close any open dynamic libraries
1641   */
1642   PetscCall(PetscFinalize_DynamicLibraries());
1643 
1644   /* Can be destroyed only after all the options are used */
1645   PetscCall(PetscOptionsDestroyDefault());
1646 
1647   PetscGlobalArgc = 0;
1648   PetscGlobalArgs = NULL;
1649 
1650 #if defined(PETSC_HAVE_KOKKOS)
1651   if (PetscBeganKokkos) {
1652     PetscCall(PetscKokkosFinalize_Private());
1653     PetscBeganKokkos       = PETSC_FALSE;
1654     PetscKokkosInitialized = PETSC_FALSE;
1655   }
1656 #endif
1657 
1658 #if defined(PETSC_HAVE_NVSHMEM)
1659   if (PetscBeganNvshmem) {
1660     PetscCall(PetscNvshmemFinalize());
1661     PetscBeganNvshmem = PETSC_FALSE;
1662   }
1663 #endif
1664 
1665   PetscCall(PetscFreeMPIResources());
1666 
1667   /*
1668      Destroy any known inner MPI_Comm's and attributes pointing to them
1669      Note this will not destroy any new communicators the user has created.
1670 
1671      If all PETSc objects were not destroyed those left over objects will have hanging references to
1672      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1673  */
1674   {
1675     PetscCommCounter *counter;
1676     PetscMPIInt       flg;
1677     MPI_Comm          icomm;
1678     union
1679     {
1680       MPI_Comm comm;
1681       void    *ptr;
1682     } ucomm;
1683     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1684     if (flg) {
1685       icomm = ucomm.comm;
1686       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1687       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1688 
1689       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval));
1690       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1691       PetscCallMPI(MPI_Comm_free(&icomm));
1692     }
1693     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1694     if (flg) {
1695       icomm = ucomm.comm;
1696       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1697       PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1698 
1699       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval));
1700       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1701       PetscCallMPI(MPI_Comm_free(&icomm));
1702     }
1703   }
1704 
1705   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval));
1706   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval));
1707   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval));
1708   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval));
1709 
1710   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen));
1711   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout));
1712   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr));
1713   PetscCall(PetscSpinlockDestroy(&PetscCommSpinLock));
1714 
1715   if (PetscBeganMPI) {
1716     PetscMPIInt flag;
1717     PetscCallMPI(MPI_Finalized(&flag));
1718     PetscCheck(!flag, PETSC_COMM_SELF, PETSC_ERR_LIB, "MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1719     /* wait until the very last moment to disable error handling */
1720     PetscErrorHandlingInitialized = PETSC_FALSE;
1721     PetscCallMPI(MPI_Finalize());
1722   } else PetscErrorHandlingInitialized = PETSC_FALSE;
1723 
1724   /*
1725 
1726      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1727    the communicator has some outstanding requests on it. Specifically if the
1728    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1729    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1730    is never freed as it should be. Thus one may obtain messages of the form
1731    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1732    memory was not freed.
1733 
1734 */
1735   PetscCall(PetscMallocClear());
1736   PetscCall(PetscStackReset());
1737 
1738   PetscInitializeCalled = PETSC_FALSE;
1739   PetscFinalizeCalled   = PETSC_TRUE;
1740 #if defined(PETSC_USE_GCOV)
1741   /*
1742      flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the
1743      gcov files are still being added to the directories as git tries to remove the directories.
1744    */
1745   __gcov_flush();
1746 #endif
1747   /* To match PetscFunctionBegin() at the beginning of this function */
1748   PetscStackClearTop;
1749   return 0;
1750 }
1751 
1752 #if defined(PETSC_MISSING_LAPACK_lsame_)
1753 PETSC_EXTERN int lsame_(char *a, char *b) {
1754   if (*a == *b) return 1;
1755   if (*a + 32 == *b) return 1;
1756   if (*a - 32 == *b) return 1;
1757   return 0;
1758 }
1759 #endif
1760 
1761 #if defined(PETSC_MISSING_LAPACK_lsame)
1762 PETSC_EXTERN int lsame(char *a, char *b) {
1763   if (*a == *b) return 1;
1764   if (*a + 32 == *b) return 1;
1765   if (*a - 32 == *b) return 1;
1766   return 0;
1767 }
1768 #endif
1769