xref: /petsc/src/sys/objects/pinit.c (revision cf906205f1df435953e2a75894dc7795d3ff0aed) !
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 #include <petsc/private/deviceimpl.h>
686 #if PetscDefined(HAVE_CUDA)
687 #include <petscdevice_cuda.h>
688 // REMOVE ME
689 cudaStream_t PetscDefaultCudaStream = NULL;
690 #endif
691 #if PetscDefined(HAVE_HIP)
692 #include <petscdevice_hip.h>
693 // REMOVE ME
694 hipStream_t PetscDefaultHipStream = NULL;
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     Creates the logging data structures; this is enabled even if logging is not turned on
963     This is the last thing we do before returning to the user code to prevent having the
964     logging numbers contaminated by any startup time associated with MPI
965   */
966 #if defined(PETSC_USE_LOG)
967   PetscCall(PetscLogInitialize());
968 #endif
969 
970   /*
971    Initialize PetscDevice and PetscDeviceContext
972 
973    Note to any future devs thinking of moving this, proper initialization requires:
974    1. MPI initialized
975    2. Options DB initialized
976    3. Petsc error handling initialized, specifically signal handlers. This expects to set up
977       its own SIGSEV handler via the push/pop interface.
978    4. Logging initialized
979   */
980   PetscCall(PetscDeviceInitializeFromOptions_Internal(PETSC_COMM_WORLD));
981 
982 #if PetscDefined(HAVE_VIENNACL)
983   flg = PETSC_FALSE;
984   PetscCall(PetscOptionsHasName(NULL, NULL, "-log_summary", &flg));
985   if (!flg) PetscCall(PetscOptionsHasName(NULL, NULL, "-log_view", &flg));
986   if (!flg) PetscCall(PetscOptionsGetBool(NULL, NULL, "-viennacl_synchronize", &flg, NULL));
987   PetscViennaCLSynchronize = flg;
988   PetscCall(PetscViennaCLInit());
989 #endif
990 
991   PetscCall(PetscCitationsInitialize());
992 
993 #if defined(PETSC_HAVE_SAWS)
994   PetscCall(PetscInitializeSAWs(ftn ? NULL : help));
995   flg = PETSC_FALSE;
996   PetscCall(PetscOptionsHasName(NULL, NULL, "-stack_view", &flg));
997   if (flg) PetscCall(PetscStackViewSAWs());
998 #endif
999 
1000   /*
1001      Load the dynamic libraries (on machines that support them), this registers all
1002      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
1003   */
1004   PetscCall(PetscInitialize_DynamicLibraries());
1005 
1006   PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));
1007   PetscCall(PetscInfo(NULL, "PETSc successfully started: number of processors = %d\n", size));
1008   PetscCall(PetscGetHostName(hostname, 256));
1009   PetscCall(PetscInfo(NULL, "Running on machine: %s\n", hostname));
1010 #if defined(PETSC_HAVE_OPENMP)
1011   {
1012     PetscBool omp_view_flag;
1013     char     *threads = getenv("OMP_NUM_THREADS");
1014 
1015     if (threads) {
1016       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n", threads));
1017       (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumOMPThreads);
1018     } else {
1019       PetscNumOMPThreads = (PetscInt)omp_get_max_threads();
1020       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n", PetscNumOMPThreads));
1021     }
1022     PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "OpenMP options", "Sys");
1023     PetscCall(PetscOptionsInt("-omp_num_threads", "Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS", "None", PetscNumOMPThreads, &PetscNumOMPThreads, &flg));
1024     PetscCall(PetscOptionsName("-omp_view", "Display OpenMP number of threads", NULL, &omp_view_flag));
1025     PetscOptionsEnd();
1026     if (flg) {
1027       PetscCall(PetscInfo(NULL, "Number of OpenMP theads %" PetscInt_FMT " (given by -omp_num_threads)\n", PetscNumOMPThreads));
1028       omp_set_num_threads((int)PetscNumOMPThreads);
1029     }
1030     if (omp_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "OpenMP: number of threads %" PetscInt_FMT "\n", PetscNumOMPThreads));
1031   }
1032 #endif
1033 
1034 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
1035   /*
1036       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
1037 
1038       Currently not used because it is not supported by MPICH.
1039   */
1040   if (!PetscBinaryBigEndian()) PetscCallMPI(MPI_Register_datarep((char *)"petsc", PetscDataRep_read_conv_fn, PetscDataRep_write_conv_fn, PetscDataRep_extent_fn, NULL));
1041 #endif
1042 
1043 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1044   PetscCall(PetscFPTCreate(10000));
1045 #endif
1046 
1047 #if defined(PETSC_HAVE_HWLOC)
1048   {
1049     PetscViewer viewer;
1050     PetscCall(PetscOptionsGetViewer(PETSC_COMM_WORLD, NULL, NULL, "-process_view", &viewer, NULL, &flg));
1051     if (flg) {
1052       PetscCall(PetscProcessPlacementView(viewer));
1053       PetscCall(PetscViewerDestroy(&viewer));
1054     }
1055   }
1056 #endif
1057 
1058   flg = PETSC_TRUE;
1059   PetscCall(PetscOptionsGetBool(NULL, NULL, "-viewfromoptions", &flg, NULL));
1060   if (!flg) PetscCall(PetscOptionsPushGetViewerOff(PETSC_TRUE));
1061 
1062 #if defined(PETSC_HAVE_ADIOS)
1063   PetscCall(adios_init_noxml(PETSC_COMM_WORLD));
1064   PetscCall(adios_declare_group(&Petsc_adios_group, "PETSc", "", adios_stat_default));
1065   PetscCall(adios_select_method(Petsc_adios_group, "MPI", "", ""));
1066   PetscCall(adios_read_init_method(ADIOS_READ_METHOD_BP, PETSC_COMM_WORLD, ""));
1067 #endif
1068 
1069 #if defined(__VALGRIND_H)
1070   PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND ? PETSC_TRUE : PETSC_FALSE;
1071 #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE)
1072   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"));
1073 #endif
1074 #endif
1075   /*
1076       Set flag that we are completely initialized
1077   */
1078   PetscInitializeCalled = PETSC_TRUE;
1079 
1080   PetscCall(PetscOptionsHasName(NULL, NULL, "-python", &flg));
1081   if (flg) PetscCall(PetscPythonInitialize(NULL, NULL));
1082 
1083   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1084   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerBegin());
1085   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");
1086   PetscFunctionReturn(0);
1087 }
1088 
1089 /*@C
1090    PetscInitialize - Initializes the PETSc database and MPI.
1091    `PetscInitialize()` calls MPI_Init() if that has yet to be called,
1092    so this routine should always be called near the beginning of
1093    your program -- usually the very first line!
1094 
1095    Collective on `MPI_COMM_WORLD` or `PETSC_COMM_WORLD` if it has been set
1096 
1097    Input Parameters:
1098 +  argc - count of number of command line arguments
1099 .  args - the command line arguments
1100 .  file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format.
1101           Use NULL or empty string to not check for code specific file.
1102           Also checks ~/.petscrc, .petscrc and petscrc.
1103           Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files.
1104 -  help - [optional] Help message to print, use NULL for no message
1105 
1106    If you wish PETSc code to run ONLY on a subcommunicator of `MPI_COMM_WORLD`, create that
1107    communicator first and assign it to `PETSC_COMM_WORLD` BEFORE calling `PetscInitialize()`. Thus if you are running a
1108    four process job and two processes will run PETSc and have `PetscInitialize()` and PetscFinalize() and two process will not,
1109    then do this. If ALL processes in the job are using `PetscInitialize()` and `PetscFinalize()` then you don't need to do this, even
1110    if different subcommunicators of the job are doing different things with PETSc.
1111 
1112    Options Database Keys:
1113 +  -help [intro] - prints help method for each option; if intro is given the program stops after printing the introductory help message
1114 .  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
1115 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
1116 .  -on_error_emacs <machinename> - causes emacsclient to jump to error file
1117 .  -on_error_abort - calls `abort()` when error detected (no traceback)
1118 .  -on_error_mpiabort - calls `MPI_abort()` when error detected
1119 .  -error_output_stdout - prints PETSc error messages to stdout instead of the default stderr
1120 .  -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called)
1121 .  -debugger_ranks [rank1,rank2,...] - Indicates ranks to start in debugger
1122 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
1123 .  -stop_for_debugger - Print message on how to attach debugger manually to
1124                         process and wait (-debugger_pause) seconds for attachment
1125 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) (deprecated, use -malloc_debug)
1126 .  -malloc no - Indicates not to use error-checking malloc (deprecated, use -malloc_debug no)
1127 .  -malloc_debug - check for memory corruption at EVERY malloc or free, see `PetscMallocSetDebug()`
1128 .  -malloc_dump - prints a list of all unfreed memory at the end of the run
1129 .  -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
1130 .  -malloc_view - show a list of all allocated memory during `PetscFinalize()`
1131 .  -malloc_view_threshold <t> - only list memory allocations of size greater than t with -malloc_view
1132 .  -malloc_requested_size - malloc logging will record the requested size rather than size after alignment
1133 .  -fp_trap - Stops on floating point exceptions
1134 .  -no_signal_handler - Indicates not to trap error signals
1135 .  -shared_tmp - indicates /tmp directory is shared by all processors
1136 .  -not_shared_tmp - each processor has own /tmp
1137 .  -tmp - alternative name of /tmp directory
1138 .  -get_total_flops - returns total flops done by all processors
1139 -  -memory_view - Print memory usage at end of run
1140 
1141    Options Database Keys for Option Database:
1142 +  -skip_petscrc - skip the default option files ~/.petscrc, .petscrc, petscrc
1143 .  -options_monitor - monitor all set options to standard output for the whole program run
1144 -  -options_monitor_cancel - cancel options monitoring hard-wired using `PetscOptionsMonitorSet()`
1145 
1146    Options -options_monitor_{all,cancel} are
1147    position-independent and apply to all options set since the PETSc start.
1148    They can be used also in option files.
1149 
1150    See `PetscOptionsMonitorSet()` to do monitoring programmatically.
1151 
1152    Options Database Keys for Profiling:
1153    See Users-Manual: ch_profiling for details.
1154 +  -info [filename][:[~]<list,of,classnames>[:[~]self]] - Prints verbose information. See `PetscInfo()`.
1155 .  -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event,
1156         however it slows things down and gives a distorted view of the overall runtime.
1157 .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
1158         hangs without running in the debugger).  See `PetscLogTraceBegin()`.
1159 .  -log_view [:filename:format] - Prints summary of flop and timing information to screen or file, see `PetscLogView()`.
1160 .  -log_view_memory - Includes in the summary from -log_view the memory used in each event, see `PetscLogView()`.
1161 .  -log_view_gpu_time - Includes in the summary from -log_view the time used in each GPU kernel, see `PetscLogView().
1162 .  -log_summary [filename] - (Deprecated, use -log_view) Prints summary of flop and timing information to screen. If the filename is specified the
1163         summary is written to the file.  See PetscLogView().
1164 .  -log_exclude: <vec,mat,pc,ksp,snes> - excludes subset of object classes from logging
1165 .  -log_all [filename] - Logs extensive profiling information  See `PetscLogDump()`.
1166 .  -log [filename] - Logs basic profiline information  See `PetscLogDump()`.
1167 .  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
1168 .  -viewfromoptions on,off - Enable or disable `XXXSetFromOptions()` calls, for applications with many small solves turn this off
1169 -  -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code
1170 
1171     Only one of -log_trace, -log_view, -log_all, -log, or -log_mpe may be used at a time
1172 
1173    Options Database Keys for SAWs:
1174 +  -saws_port <portnumber> - port number to publish SAWs data, default is 8080
1175 .  -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen
1176                             this is useful when you are running many jobs that utilize SAWs at the same time
1177 .  -saws_log <filename> - save a log of all SAWs communication
1178 .  -saws_https <certificate file> - have SAWs use HTTPS instead of HTTP
1179 -  -saws_root <directory> - allow SAWs to have access to the given directory to search for requested resources and files
1180 
1181    Environmental Variables:
1182 +   `PETSC_TMP` - alternative tmp directory
1183 .   `PETSC_SHARED_TMP` - tmp is shared by all processes
1184 .   `PETSC_NOT_SHARED_TMP` - each process has its own private tmp
1185 .   `PETSC_OPTIONS` - a string containing additional options for petsc in the form of command line "-key value" pairs
1186 .   `PETSC_OPTIONS_YAML` - (requires configuring PETSc to use libyaml) a string containing additional options for petsc in the form of a YAML document
1187 .   `PETSC_VIEWER_SOCKET_PORT` - socket number to use for socket viewer
1188 -   `PETSC_VIEWER_SOCKET_MACHINE` - machine to use for socket viewer to connect to
1189 
1190    Level: beginner
1191 
1192    Note:
1193    If for some reason you must call `MPI_Init()` separately, call
1194    it before `PetscInitialize()`.
1195 
1196    Fortran Notes:
1197    In Fortran this routine can be called with
1198 .vb
1199        call PetscInitialize(ierr)
1200        call PetscInitialize(file,ierr) or
1201        call PetscInitialize(file,help,ierr)
1202 .ve
1203 
1204    If your main program is C but you call Fortran code that also uses PETSc you need to call `PetscInitializeFortran()` soon after
1205    calling `PetscInitialize()`.
1206 
1207 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscInitializeNoArguments()`, `PetscLogGpuTime()`
1208 @*/
1209 PetscErrorCode PetscInitialize(int *argc, char ***args, const char file[], const char help[]) {
1210   PetscMPIInt flag;
1211   const char *prog = "Unknown Name", *mpienv;
1212 
1213   PetscFunctionBegin;
1214   if (PetscInitializeCalled) PetscFunctionReturn(0);
1215   PetscCallMPI(MPI_Initialized(&flag));
1216   if (!flag) {
1217     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");
1218     PetscCall(PetscPreMPIInit_Private());
1219 #if defined(PETSC_HAVE_MPI_INIT_THREAD)
1220     {
1221       PetscMPIInt PETSC_UNUSED provided;
1222       PetscCallMPI(MPI_Init_thread(argc, args, PETSC_MPI_THREAD_REQUIRED, &provided));
1223     }
1224 #else
1225     PetscCallMPI(MPI_Init(argc, args));
1226 #endif
1227     if (PetscDefined(HAVE_MPIUNI)) {
1228       mpienv = getenv("PMI_SIZE");
1229       if (!mpienv) mpienv = getenv("OMPI_COMM_WORLD_SIZE");
1230       if (mpienv) {
1231         PetscInt isize;
1232         PetscCall(PetscOptionsStringToInt(mpienv, &isize));
1233         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");
1234         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");
1235       }
1236     }
1237     PetscBeganMPI = PETSC_TRUE;
1238   }
1239 
1240   if (argc && *argc) prog = **args;
1241   if (argc && args) {
1242     PetscGlobalArgc = *argc;
1243     PetscGlobalArgs = *args;
1244   }
1245   PetscCall(PetscInitialize_Common(prog, file, help, PETSC_FALSE, PETSC_FALSE, 0));
1246   PetscFunctionReturn(0);
1247 }
1248 
1249 #if PetscDefined(USE_LOG)
1250 PETSC_INTERN PetscObject *PetscObjects;
1251 PETSC_INTERN PetscInt     PetscObjectsCounts;
1252 PETSC_INTERN PetscInt     PetscObjectsMaxCounts;
1253 PETSC_INTERN PetscBool    PetscObjectsLog;
1254 #endif
1255 
1256 /*
1257     Frees all the MPI types and operations that PETSc may have created
1258 */
1259 PetscErrorCode PetscFreeMPIResources(void) {
1260   PetscFunctionBegin;
1261 #if defined(PETSC_HAVE_REAL___FLOAT128)
1262   PetscCallMPI(MPI_Type_free(&MPIU___FLOAT128));
1263   PetscCallMPI(MPI_Type_free(&MPIU___COMPLEX128));
1264 #endif
1265 #if defined(PETSC_HAVE_REAL___FP16)
1266   PetscCallMPI(MPI_Type_free(&MPIU___FP16));
1267 #endif
1268 
1269 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
1270   PetscCallMPI(MPI_Op_free(&MPIU_SUM));
1271   PetscCallMPI(MPI_Op_free(&MPIU_MAX));
1272   PetscCallMPI(MPI_Op_free(&MPIU_MIN));
1273 #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
1274   PetscCallMPI(MPI_Op_free(&MPIU_SUM___FP16___FLOAT128));
1275 #endif
1276 
1277   PetscCallMPI(MPI_Type_free(&MPIU_2SCALAR));
1278   PetscCallMPI(MPI_Type_free(&MPIU_REAL_INT));
1279   PetscCallMPI(MPI_Type_free(&MPIU_SCALAR_INT));
1280 #if defined(PETSC_USE_64BIT_INDICES)
1281   PetscCallMPI(MPI_Type_free(&MPIU_2INT));
1282 #endif
1283   PetscCallMPI(MPI_Type_free(&MPI_4INT));
1284   PetscCallMPI(MPI_Type_free(&MPIU_4INT));
1285   PetscCallMPI(MPI_Op_free(&MPIU_MAXSUM_OP));
1286   PetscFunctionReturn(0);
1287 }
1288 
1289 #if PetscDefined(USE_LOG)
1290 PETSC_INTERN PetscErrorCode PetscLogFinalize(void);
1291 #endif
1292 
1293 /*@C
1294    PetscFinalize - Checks for options to be called at the conclusion
1295    of the program. `MPI_Finalize()` is called only if the user had not
1296    called `MPI_Init()` before calling `PetscInitialize()`.
1297 
1298    Collective on `PETSC_COMM_WORLD`
1299 
1300    Options Database Keys:
1301 +  -options_view - Calls `PetscOptionsView()`
1302 .  -options_left - Prints unused options that remain in the database
1303 .  -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
1304 .  -mpidump - Calls PetscMPIDump()
1305 .  -malloc_dump <optional filename> - Calls `PetscMallocDump()`, displays all memory allocated that has not been freed
1306 .  -malloc_info - Prints total memory usage
1307 -  -malloc_view <optional filename> - Prints list of all memory allocated and where
1308 
1309    Level: beginner
1310 
1311    Note:
1312    See `PetscInitialize()` for other runtime options.
1313 
1314 .seealso: `PetscInitialize()`, `PetscOptionsView()`, `PetscMallocDump()`, `PetscMPIDump()`, `PetscEnd()`
1315 @*/
1316 PetscErrorCode PetscFinalize(void) {
1317   PetscMPIInt rank;
1318   PetscInt    nopt;
1319   PetscBool   flg1 = PETSC_FALSE, flg2 = PETSC_FALSE, flg3 = PETSC_FALSE;
1320   PetscBool   flg;
1321 #if defined(PETSC_USE_LOG)
1322   char mname[PETSC_MAX_PATH_LEN];
1323 #endif
1324 
1325   PetscFunctionBegin;
1326   PetscCheck(PetscInitializeCalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscInitialize() must be called before PetscFinalize()");
1327   PetscCall(PetscInfo(NULL, "PetscFinalize() called\n"));
1328 
1329   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1330   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerEnd());
1331 
1332   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
1333 #if defined(PETSC_HAVE_ADIOS)
1334   PetscCall(adios_read_finalize_method(ADIOS_READ_METHOD_BP_AGGREGATE));
1335   PetscCall(adios_finalize(rank));
1336 #endif
1337   PetscCall(PetscOptionsHasName(NULL, NULL, "-citations", &flg));
1338   if (flg) {
1339     char *cits, filename[PETSC_MAX_PATH_LEN];
1340     FILE *fd = PETSC_STDOUT;
1341 
1342     PetscCall(PetscOptionsGetString(NULL, NULL, "-citations", filename, sizeof(filename), NULL));
1343     if (filename[0]) PetscCall(PetscFOpen(PETSC_COMM_WORLD, filename, "w", &fd));
1344     PetscCall(PetscSegBufferGet(PetscCitationsList, 1, &cits));
1345     cits[0] = 0;
1346     PetscCall(PetscSegBufferExtractAlloc(PetscCitationsList, &cits));
1347     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "If you publish results based on this computation please cite the following:\n"));
1348     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1349     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "%s", cits));
1350     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1351     PetscCall(PetscFClose(PETSC_COMM_WORLD, fd));
1352     PetscCall(PetscFree(cits));
1353   }
1354   PetscCall(PetscSegBufferDestroy(&PetscCitationsList));
1355 
1356 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER)
1357   /* TextBelt is run for testing purposes only, please do not use this feature often */
1358   {
1359     PetscInt nmax = 2;
1360     char   **buffs;
1361     PetscCall(PetscMalloc1(2, &buffs));
1362     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-textbelt", buffs, &nmax, &flg1));
1363     if (flg1) {
1364       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-textbelt requires either the phone number or number,\"message\"");
1365       if (nmax == 1) {
1366         PetscCall(PetscMalloc1(128, &buffs[1]));
1367         PetscCall(PetscGetProgramName(buffs[1], 32));
1368         PetscCall(PetscStrcat(buffs[1], " has completed"));
1369       }
1370       PetscCall(PetscTextBelt(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1371       PetscCall(PetscFree(buffs[0]));
1372       PetscCall(PetscFree(buffs[1]));
1373     }
1374     PetscCall(PetscFree(buffs));
1375   }
1376   {
1377     PetscInt nmax = 2;
1378     char   **buffs;
1379     PetscCall(PetscMalloc1(2, &buffs));
1380     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-tellmycell", buffs, &nmax, &flg1));
1381     if (flg1) {
1382       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-tellmycell requires either the phone number or number,\"message\"");
1383       if (nmax == 1) {
1384         PetscCall(PetscMalloc1(128, &buffs[1]));
1385         PetscCall(PetscGetProgramName(buffs[1], 32));
1386         PetscCall(PetscStrcat(buffs[1], " has completed"));
1387       }
1388       PetscCall(PetscTellMyCell(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1389       PetscCall(PetscFree(buffs[0]));
1390       PetscCall(PetscFree(buffs[1]));
1391     }
1392     PetscCall(PetscFree(buffs));
1393   }
1394 #endif
1395 
1396 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1397   PetscCall(PetscFPTDestroy());
1398 #endif
1399 
1400 #if defined(PETSC_HAVE_SAWS)
1401   flg = PETSC_FALSE;
1402   PetscCall(PetscOptionsGetBool(NULL, NULL, "-saw_options", &flg, NULL));
1403   if (flg) PetscCall(PetscOptionsSAWsDestroy());
1404 #endif
1405 
1406 #if defined(PETSC_HAVE_X)
1407   flg1 = PETSC_FALSE;
1408   PetscCall(PetscOptionsGetBool(NULL, NULL, "-x_virtual", &flg1, NULL));
1409   if (flg1) {
1410     /*  this is a crude hack, but better than nothing */
1411     PetscCall(PetscPOpen(PETSC_COMM_WORLD, NULL, "pkill -9 Xvfb", "r", NULL));
1412   }
1413 #endif
1414 
1415 #if !defined(PETSC_HAVE_THREADSAFETY)
1416   PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_info", &flg2, NULL));
1417   if (!flg2) {
1418     flg2 = PETSC_FALSE;
1419     PetscCall(PetscOptionsGetBool(NULL, NULL, "-memory_view", &flg2, NULL));
1420   }
1421   if (flg2) PetscCall(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD, "Summary of Memory Usage in PETSc\n"));
1422 #endif
1423 
1424 #if defined(PETSC_USE_LOG)
1425   flg1 = PETSC_FALSE;
1426   PetscCall(PetscOptionsGetBool(NULL, NULL, "-get_total_flops", &flg1, NULL));
1427   if (flg1) {
1428     PetscLogDouble flops = 0;
1429     PetscCallMPI(MPI_Reduce(&petsc_TotalFlops, &flops, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
1430     PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Total flops over all processors %g\n", flops));
1431   }
1432 #endif
1433 
1434 #if defined(PETSC_USE_LOG)
1435 #if defined(PETSC_HAVE_MPE)
1436   mname[0] = 0;
1437   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_mpe", mname, sizeof(mname), &flg1));
1438   if (flg1) {
1439     if (mname[0]) PetscCall(PetscLogMPEDump(mname));
1440     else PetscCall(PetscLogMPEDump(0));
1441   }
1442 #endif
1443 #endif
1444 
1445   /*
1446      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1447   */
1448   PetscCall(PetscObjectRegisterDestroyAll());
1449 
1450 #if defined(PETSC_USE_LOG)
1451   PetscCall(PetscOptionsPushGetViewerOff(PETSC_FALSE));
1452   PetscCall(PetscLogViewFromOptions());
1453   PetscCall(PetscOptionsPopGetViewerOff());
1454 
1455   mname[0] = 0;
1456   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_summary", mname, sizeof(mname), &flg1));
1457   if (flg1) {
1458     PetscViewer viewer;
1459     PetscCall((*PetscHelpPrintf)(PETSC_COMM_WORLD, "\n\n WARNING:   -log_summary is being deprecated; switch to -log_view\n\n\n"));
1460     if (mname[0]) {
1461       PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD, mname, &viewer));
1462       PetscCall(PetscLogView(viewer));
1463       PetscCall(PetscViewerDestroy(&viewer));
1464     } else {
1465       viewer = PETSC_VIEWER_STDOUT_WORLD;
1466       PetscCall(PetscViewerPushFormat(viewer, PETSC_VIEWER_DEFAULT));
1467       PetscCall(PetscLogView(viewer));
1468       PetscCall(PetscViewerPopFormat(viewer));
1469     }
1470   }
1471 
1472   /*
1473      Free any objects created by the last block of code.
1474   */
1475   PetscCall(PetscObjectRegisterDestroyAll());
1476 
1477   mname[0] = 0;
1478   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_all", mname, sizeof(mname), &flg1));
1479   PetscCall(PetscOptionsGetString(NULL, NULL, "-log", mname, sizeof(mname), &flg2));
1480   if (flg1 || flg2) PetscCall(PetscLogDump(mname));
1481 #endif
1482 
1483   flg1 = PETSC_FALSE;
1484   PetscCall(PetscOptionsGetBool(NULL, NULL, "-no_signal_handler", &flg1, NULL));
1485   if (!flg1) PetscCall(PetscPopSignalHandler());
1486   flg1 = PETSC_FALSE;
1487   PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpidump", &flg1, NULL));
1488   if (flg1) PetscCall(PetscMPIDump(stdout));
1489   flg1 = PETSC_FALSE;
1490   flg2 = PETSC_FALSE;
1491   /* preemptive call to avoid listing this option in options table as unused */
1492   PetscCall(PetscOptionsHasName(NULL, NULL, "-malloc_dump", &flg1));
1493   PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1494   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_view", &flg2, NULL));
1495 
1496   if (flg2) {
1497     PetscViewer viewer;
1498     PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer));
1499     PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII));
1500     PetscCall(PetscOptionsView(NULL, viewer));
1501     PetscCall(PetscViewerDestroy(&viewer));
1502   }
1503 
1504   /* to prevent PETSc -options_left from warning */
1505   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox", &flg1));
1506   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox_warning", &flg1));
1507 
1508   flg3 = PETSC_FALSE; /* default value is required */
1509   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_left", &flg3, &flg1));
1510   if (PetscUnlikelyDebug(!flg1)) flg3 = PETSC_TRUE;
1511   if (flg3) {
1512     if (!flg2 && flg1) { /* have not yet printed the options */
1513       PetscViewer viewer;
1514       PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer));
1515       PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII));
1516       PetscCall(PetscOptionsView(NULL, viewer));
1517       PetscCall(PetscViewerDestroy(&viewer));
1518     }
1519     PetscCall(PetscOptionsAllUsed(NULL, &nopt));
1520     if (nopt) {
1521       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! There are options you set that were not used!\n"));
1522       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! could be spelling mistake, etc!\n"));
1523       if (nopt == 1) {
1524         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There is one unused database option. It is:\n"));
1525       } else {
1526         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are %" PetscInt_FMT " unused database options. They are:\n", nopt));
1527       }
1528     } else if (flg3 && flg1) {
1529       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are no unused options.\n"));
1530     }
1531     PetscCall(PetscOptionsLeft(NULL));
1532   }
1533 
1534 #if defined(PETSC_HAVE_SAWS)
1535   if (!PetscGlobalRank) {
1536     PetscCall(PetscStackSAWsViewOff());
1537     PetscCallSAWs(SAWs_Finalize, ());
1538   }
1539 #endif
1540 
1541 #if defined(PETSC_USE_LOG)
1542   /*
1543        List all objects the user may have forgot to free
1544   */
1545   if (PetscObjectsLog) {
1546     PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1547     if (flg1) {
1548       MPI_Comm local_comm;
1549       char     string[64];
1550 
1551       PetscCall(PetscOptionsGetString(NULL, NULL, "-objects_dump", string, sizeof(string), NULL));
1552       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1553       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1554       PetscCall(PetscObjectsDump(stdout, (string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE));
1555       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1556       PetscCallMPI(MPI_Comm_free(&local_comm));
1557     }
1558   }
1559 #endif
1560 
1561 #if defined(PETSC_USE_LOG)
1562   PetscObjectsCounts    = 0;
1563   PetscObjectsMaxCounts = 0;
1564   PetscCall(PetscFree(PetscObjects));
1565 #endif
1566 
1567   /*
1568      Destroy any packages that registered a finalize
1569   */
1570   PetscCall(PetscRegisterFinalizeAll());
1571 
1572 #if defined(PETSC_USE_LOG)
1573   PetscCall(PetscLogFinalize());
1574 #endif
1575 
1576   /*
1577      Print PetscFunctionLists that have not been properly freed
1578   */
1579   if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintAll());
1580 
1581   if (petsc_history) {
1582     PetscCall(PetscCloseHistoryFile(&petsc_history));
1583     petsc_history = NULL;
1584   }
1585   PetscCall(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton));
1586   PetscCall(PetscInfoDestroy());
1587 
1588 #if !defined(PETSC_HAVE_THREADSAFETY)
1589   if (!(PETSC_RUNNING_ON_VALGRIND)) {
1590     char  fname[PETSC_MAX_PATH_LEN];
1591     char  sname[PETSC_MAX_PATH_LEN];
1592     FILE *fd;
1593     int   err;
1594 
1595     flg2 = PETSC_FALSE;
1596     flg3 = PETSC_FALSE;
1597     if (PetscDefined(USE_DEBUG)) PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_test", &flg2, NULL));
1598     PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_debug", &flg3, NULL));
1599     fname[0] = 0;
1600     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_dump", fname, sizeof(fname), &flg1));
1601     if (flg1 && fname[0]) {
1602       PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank);
1603       fd = fopen(sname, "w");
1604       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1605       PetscCall(PetscMallocDump(fd));
1606       err = fclose(fd);
1607       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1608     } else if (flg1 || flg2 || flg3) {
1609       MPI_Comm local_comm;
1610 
1611       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1612       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1613       PetscCall(PetscMallocDump(stdout));
1614       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1615       PetscCallMPI(MPI_Comm_free(&local_comm));
1616     }
1617     fname[0] = 0;
1618     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_view", fname, sizeof(fname), &flg1));
1619     if (flg1 && fname[0]) {
1620       PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank);
1621       fd = fopen(sname, "w");
1622       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1623       PetscCall(PetscMallocView(fd));
1624       err = fclose(fd);
1625       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1626     } else if (flg1) {
1627       MPI_Comm local_comm;
1628 
1629       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1630       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1631       PetscCall(PetscMallocView(stdout));
1632       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1633       PetscCallMPI(MPI_Comm_free(&local_comm));
1634     }
1635   }
1636 #endif
1637 
1638   /*
1639      Close any open dynamic libraries
1640   */
1641   PetscCall(PetscFinalize_DynamicLibraries());
1642 
1643   /* Can be destroyed only after all the options are used */
1644   PetscCall(PetscOptionsDestroyDefault());
1645 
1646   PetscGlobalArgc = 0;
1647   PetscGlobalArgs = NULL;
1648 
1649 #if defined(PETSC_HAVE_KOKKOS)
1650   if (PetscBeganKokkos) {
1651     PetscCall(PetscKokkosFinalize_Private());
1652     PetscBeganKokkos       = PETSC_FALSE;
1653     PetscKokkosInitialized = PETSC_FALSE;
1654   }
1655 #endif
1656 
1657 #if defined(PETSC_HAVE_NVSHMEM)
1658   if (PetscBeganNvshmem) {
1659     PetscCall(PetscNvshmemFinalize());
1660     PetscBeganNvshmem = PETSC_FALSE;
1661   }
1662 #endif
1663 
1664   PetscCall(PetscFreeMPIResources());
1665 
1666   /*
1667      Destroy any known inner MPI_Comm's and attributes pointing to them
1668      Note this will not destroy any new communicators the user has created.
1669 
1670      If all PETSc objects were not destroyed those left over objects will have hanging references to
1671      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1672  */
1673   {
1674     PetscCommCounter *counter;
1675     PetscMPIInt       flg;
1676     MPI_Comm          icomm;
1677     union
1678     {
1679       MPI_Comm comm;
1680       void    *ptr;
1681     } ucomm;
1682     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1683     if (flg) {
1684       icomm = ucomm.comm;
1685       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1686       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1687 
1688       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval));
1689       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1690       PetscCallMPI(MPI_Comm_free(&icomm));
1691     }
1692     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1693     if (flg) {
1694       icomm = ucomm.comm;
1695       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1696       PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1697 
1698       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval));
1699       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1700       PetscCallMPI(MPI_Comm_free(&icomm));
1701     }
1702   }
1703 
1704   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval));
1705   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval));
1706   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval));
1707   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval));
1708 
1709   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen));
1710   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout));
1711   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr));
1712   PetscCall(PetscSpinlockDestroy(&PetscCommSpinLock));
1713 
1714   if (PetscBeganMPI) {
1715     PetscMPIInt flag;
1716     PetscCallMPI(MPI_Finalized(&flag));
1717     PetscCheck(!flag, PETSC_COMM_SELF, PETSC_ERR_LIB, "MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1718     /* wait until the very last moment to disable error handling */
1719     PetscErrorHandlingInitialized = PETSC_FALSE;
1720     PetscCallMPI(MPI_Finalize());
1721   } else PetscErrorHandlingInitialized = PETSC_FALSE;
1722 
1723   /*
1724 
1725      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1726    the communicator has some outstanding requests on it. Specifically if the
1727    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1728    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1729    is never freed as it should be. Thus one may obtain messages of the form
1730    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1731    memory was not freed.
1732 
1733 */
1734   PetscCall(PetscMallocClear());
1735   PetscCall(PetscStackReset());
1736 
1737   PetscInitializeCalled = PETSC_FALSE;
1738   PetscFinalizeCalled   = PETSC_TRUE;
1739 #if defined(PETSC_USE_GCOV)
1740   /*
1741      flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the
1742      gcov files are still being added to the directories as git tries to remove the directories.
1743    */
1744   __gcov_flush();
1745 #endif
1746   /* To match PetscFunctionBegin() at the beginning of this function */
1747   PetscStackClearTop;
1748   return 0;
1749 }
1750 
1751 #if defined(PETSC_MISSING_LAPACK_lsame_)
1752 PETSC_EXTERN int lsame_(char *a, char *b) {
1753   if (*a == *b) return 1;
1754   if (*a + 32 == *b) return 1;
1755   if (*a - 32 == *b) return 1;
1756   return 0;
1757 }
1758 #endif
1759 
1760 #if defined(PETSC_MISSING_LAPACK_lsame)
1761 PETSC_EXTERN int lsame(char *a, char *b) {
1762   if (*a == *b) return 1;
1763   if (*a + 32 == *b) return 1;
1764   if (*a - 32 == *b) return 1;
1765   return 0;
1766 }
1767 #endif
1768