Actual source code: pinit.c

  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>
  6: #include <petscviewer.h>
  7: #include <petsc/private/garbagecollector.h>

  9: #if !defined(PETSC_HAVE_WINDOWS_COMPILERS)
 10: #include <petsc/private/valgrind/valgrind.h>
 11: #endif

 13: #if defined(PETSC_HAVE_FORTRAN)
 14: #include <petsc/private/fortranimpl.h>
 15: #endif

 17: #if PetscDefined(USE_COVERAGE)
 18: EXTERN_C_BEGIN
 19:   #if defined(PETSC_HAVE___GCOV_DUMP)
 21:   #endif
 22: void __gcov_flush(void);
 23: EXTERN_C_END
 24: #endif

 26: #if defined(PETSC_SERIALIZE_FUNCTIONS)
 27: PETSC_INTERN PetscFPT PetscFPTData;
 28: PetscFPT              PetscFPTData = 0;
 29: #endif

 31: #if PetscDefined(HAVE_SAWS)
 32: #include <petscviewersaws.h>
 33: #endif

 35: /* -----------------------------------------------------------------------------------------*/

 37: PETSC_INTERN FILE *petsc_history;

 39: PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void);
 40: PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void);
 41: PETSC_INTERN PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm, int);
 42: PETSC_INTERN PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm, int);
 43: PETSC_INTERN PetscErrorCode PetscCloseHistoryFile(FILE **);

 45: /* user may set these BEFORE calling PetscInitialize() */
 46: MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL;
 47: #if PetscDefined(HAVE_MPI_INIT_THREAD)
 48: PetscMPIInt PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_FUNNELED;
 49: #else
 50: PetscMPIInt PETSC_MPI_THREAD_REQUIRED = 0;
 51: #endif

 53: PetscMPIInt Petsc_Counter_keyval      = MPI_KEYVAL_INVALID;
 54: PetscMPIInt Petsc_InnerComm_keyval    = MPI_KEYVAL_INVALID;
 55: PetscMPIInt Petsc_OuterComm_keyval    = MPI_KEYVAL_INVALID;
 56: PetscMPIInt Petsc_ShmComm_keyval      = MPI_KEYVAL_INVALID;
 57: PetscMPIInt Petsc_CreationIdx_keyval  = MPI_KEYVAL_INVALID;
 58: PetscMPIInt Petsc_Garbage_HMap_keyval = MPI_KEYVAL_INVALID;

 60: PetscMPIInt Petsc_SharedWD_keyval  = MPI_KEYVAL_INVALID;
 61: PetscMPIInt Petsc_SharedTmp_keyval = MPI_KEYVAL_INVALID;

 63: /*
 64:      Declare and set all the string names of the PETSc enums
 65: */
 66: const char *const PetscBools[]     = {"FALSE", "TRUE", "PetscBool", "PETSC_", NULL};
 67: const char *const PetscCopyModes[] = {"COPY_VALUES", "OWN_POINTER", "USE_POINTER", "PetscCopyMode", "PETSC_", NULL};

 69: PetscBool PetscPreLoadingUsed = PETSC_FALSE;
 70: PetscBool PetscPreLoadingOn   = PETSC_FALSE;

 72: PetscInt PetscHotRegionDepth;

 74: PetscBool PETSC_RUNNING_ON_VALGRIND = PETSC_FALSE;

 76: #if defined(PETSC_HAVE_THREADSAFETY)
 77: PetscSpinlock PetscViewerASCIISpinLockOpen;
 78: PetscSpinlock PetscViewerASCIISpinLockStdout;
 79: PetscSpinlock PetscViewerASCIISpinLockStderr;
 80: PetscSpinlock PetscCommSpinLock;
 81: #endif

 83: /*
 84:       PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args

 86:    Collective

 88:    Level: advanced

 90:     Notes:
 91:     this is called only by the PETSc Julia interface. Even though it might start MPI it sets the flag to
 92:      indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to
 93:      be called multiple times from Julia without the problem of trying to initialize MPI more than once.

 95:      Developer Note: Turns off PETSc signal handling to allow Julia to manage signals

 97: .seealso: `PetscInitialize()`, `PetscInitializeFortran()`, `PetscInitializeNoArguments()`
 98: */
 99: PetscErrorCode PetscInitializeNoPointers(int argc, char **args, const char *filename, const char *help)
100: {
101:   int    myargc = argc;
102:   char **myargs = args;

104:   PetscFunctionBegin;
105:   PetscCall(PetscInitialize(&myargc, &myargs, filename, help));
106:   PetscCall(PetscPopSignalHandler());
107:   PetscBeganMPI = PETSC_FALSE;
108:   PetscFunctionReturn(PETSC_SUCCESS);
109: }

111: /*
112:       Used by Julia interface to get communicator
113: */
114: PetscErrorCode PetscGetPETSC_COMM_SELF(MPI_Comm *comm)
115: {
116:   PetscFunctionBegin;
118:   *comm = PETSC_COMM_SELF;
119:   PetscFunctionReturn(PETSC_SUCCESS);
120: }

122: /*@C
123:       PetscInitializeNoArguments - Calls `PetscInitialize()` from C/C++ without
124:         the command line arguments.

126:    Collective

128:    Level: advanced

130: .seealso: `PetscInitialize()`, `PetscInitializeFortran()`
131: @*/
132: PetscErrorCode PetscInitializeNoArguments(void)
133: {
134:   int    argc = 0;
135:   char **args = NULL;

137:   PetscFunctionBegin;
138:   PetscCall(PetscInitialize(&argc, &args, NULL, NULL));
139:   PetscFunctionReturn(PETSC_SUCCESS);
140: }

142: /*@
143:       PetscInitialized - Determine whether PETSc is initialized.

145:    Level: beginner

147: .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
148: @*/
149: PetscErrorCode PetscInitialized(PetscBool *isInitialized)
150: {
151:   PetscFunctionBegin;
153:   *isInitialized = PetscInitializeCalled;
154:   PetscFunctionReturn(PETSC_SUCCESS);
155: }

157: /*@
158:       PetscFinalized - Determine whether `PetscFinalize()` has been called yet

160:    Level: developer

162: .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
163: @*/
164: PetscErrorCode PetscFinalized(PetscBool *isFinalized)
165: {
166:   PetscFunctionBegin;
168:   *isFinalized = PetscFinalizeCalled;
169:   PetscFunctionReturn(PETSC_SUCCESS);
170: }

172: PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Private(const char[]);

174: /*
175:        This function is the MPI reduction operation used to compute the sum of the
176:    first half of the datatype and the max of the second half.
177: */
178: MPI_Op MPIU_MAXSUM_OP               = 0;
179: MPI_Op Petsc_Garbage_SetIntersectOp = 0;

181: PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void *in, void *out, int *cnt, MPI_Datatype *datatype)
182: {
183:   PetscInt *xin = (PetscInt *)in, *xout = (PetscInt *)out, i, count = *cnt;

185:   PetscFunctionBegin;
186:   if (*datatype != MPIU_2INT) {
187:     PetscErrorCode ierr = (*PetscErrorPrintf)("Can only handle MPIU_2INT data types");
188:     (void)ierr;
189:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
190:   }

192:   for (i = 0; i < count; i++) {
193:     xout[2 * i] = PetscMax(xout[2 * i], xin[2 * i]);
194:     xout[2 * i + 1] += xin[2 * i + 1];
195:   }
196:   PetscFunctionReturnVoid();
197: }

199: /*
200:     Returns the max of the first entry owned by this processor and the
201: sum of the second entry.

203:     The reason sizes[2*i] contains lengths sizes[2*i+1] contains flag of 1 if length is nonzero
204: is so that the MPIU_MAXSUM_OP() can set TWO values, if we passed in only sizes[i] with lengths
205: there would be no place to store the both needed results.
206: */
207: PetscErrorCode PetscMaxSum(MPI_Comm comm, const PetscInt sizes[], PetscInt *max, PetscInt *sum)
208: {
209:   PetscFunctionBegin;
210: #if defined(PETSC_HAVE_MPI_REDUCE_SCATTER_BLOCK)
211:   {
212:     struct {
213:       PetscInt max, sum;
214:     } work;
215:     PetscCallMPI(MPI_Reduce_scatter_block((void *)sizes, &work, 1, MPIU_2INT, MPIU_MAXSUM_OP, comm));
216:     *max = work.max;
217:     *sum = work.sum;
218:   }
219: #else
220:   {
221:     PetscMPIInt size, rank;
222:     struct {
223:       PetscInt max, sum;
224:     } *work;
225:     PetscCallMPI(MPI_Comm_size(comm, &size));
226:     PetscCallMPI(MPI_Comm_rank(comm, &rank));
227:     PetscCall(PetscMalloc1(size, &work));
228:     PetscCall(MPIU_Allreduce((void *)sizes, work, size, MPIU_2INT, MPIU_MAXSUM_OP, comm));
229:     *max = work[rank].max;
230:     *sum = work[rank].sum;
231:     PetscCall(PetscFree(work));
232:   }
233: #endif
234:   PetscFunctionReturn(PETSC_SUCCESS);
235: }

237: /* ----------------------------------------------------------------------------*/

239: #if defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
240:   #if defined(PETSC_HAVE_REAL___FLOAT128)
241:     #include <quadmath.h>
242:   #endif
243: MPI_Op MPIU_SUM___FP16___FLOAT128 = 0;
244:   #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
245: MPI_Op MPIU_SUM = 0;
246:   #endif

248: PETSC_EXTERN void MPIAPI PetscSum_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
249: {
250:   PetscInt i, count = *cnt;

252:   PetscFunctionBegin;
253:   if (*datatype == MPIU_REAL) {
254:     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
255:     for (i = 0; i < count; i++) xout[i] += xin[i];
256:   }
257:   #if defined(PETSC_HAVE_COMPLEX)
258:   else if (*datatype == MPIU_COMPLEX) {
259:     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
260:     for (i = 0; i < count; i++) xout[i] += xin[i];
261:   }
262:   #endif
263:   #if defined(PETSC_HAVE_REAL___FLOAT128)
264:   else if (*datatype == MPIU___FLOAT128) {
265:     __float128 *xin = (__float128 *)in, *xout = (__float128 *)out;
266:     for (i = 0; i < count; i++) xout[i] += xin[i];
267:   } else if (*datatype == MPIU___COMPLEX128) {
268:     __complex128 *xin = (__complex128 *)in, *xout = (__complex128 *)out;
269:     for (i = 0; i < count; i++) xout[i] += xin[i];
270:   }
271:   #endif
272:   #if defined(PETSC_HAVE_REAL___FP16)
273:   else if (*datatype == MPIU___FP16) {
274:     __fp16 *xin = (__fp16 *)in, *xout = (__fp16 *)out;
275:     for (i = 0; i < count; i++) xout[i] += xin[i];
276:   }
277:   #endif
278:   else {
279:   #if !defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_HAVE_REAL___FP16)
280:     PetscCallAbort(MPI_COMM_SElF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
281:   #elif !defined(PETSC_HAVE_REAL___FP16)
282:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, or MPIU___COMPLEX128 data types"));
283:   #elif !defined(PETSC_HAVE_REAL___FLOAT128)
284:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, or MPIU___FP16 data types"));
285:   #else
286:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, MPIU___COMPLEX128, or MPIU___FP16 data types"));
287:   #endif
288:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
289:   }
290:   PetscFunctionReturnVoid();
291: }
292: #endif

294: #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
295: MPI_Op MPIU_MAX = 0;
296: MPI_Op MPIU_MIN = 0;

298: PETSC_EXTERN void MPIAPI PetscMax_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
299: {
300:   PetscInt i, count = *cnt;

302:   PetscFunctionBegin;
303:   if (*datatype == MPIU_REAL) {
304:     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
305:     for (i = 0; i < count; i++) xout[i] = PetscMax(xout[i], xin[i]);
306:   }
307:   #if defined(PETSC_HAVE_COMPLEX)
308:   else if (*datatype == MPIU_COMPLEX) {
309:     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
310:     for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) < PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
311:   }
312:   #endif
313:   else {
314:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
315:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
316:   }
317:   PetscFunctionReturnVoid();
318: }

320: PETSC_EXTERN void MPIAPI PetscMin_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
321: {
322:   PetscInt i, count = *cnt;

324:   PetscFunctionBegin;
325:   if (*datatype == MPIU_REAL) {
326:     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
327:     for (i = 0; i < count; i++) xout[i] = PetscMin(xout[i], xin[i]);
328:   }
329:   #if defined(PETSC_HAVE_COMPLEX)
330:   else if (*datatype == MPIU_COMPLEX) {
331:     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
332:     for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) > PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
333:   }
334:   #endif
335:   else {
336:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"));
337:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
338:   }
339:   PetscFunctionReturnVoid();
340: }
341: #endif

343: /*
344:    Private routine to delete internal tag/name counter storage when a communicator is freed.

346:    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.

348:    Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()

350: */
351: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_Counter_Attr_Delete_Fn(MPI_Comm comm, PetscMPIInt keyval, void *count_val, void *extra_state)
352: {
353:   PetscCommCounter      *counter = (PetscCommCounter *)count_val;
354:   struct PetscCommStash *comms   = counter->comms, *pcomm;

356:   PetscFunctionBegin;
357:   PetscCallMPI(PetscInfo(NULL, "Deleting counter data in an MPI_Comm %ld\n", (long)comm));
358:   PetscCallMPI(PetscFree(counter->iflags));
359:   while (comms) {
360:     PetscCallMPI(MPI_Comm_free(&comms->comm));
361:     pcomm = comms;
362:     comms = comms->next;
363:     PetscCall(PetscFree(pcomm));
364:   }
365:   PetscCallMPI(PetscFree(counter));
366:   PetscFunctionReturn(MPI_SUCCESS);
367: }

369: /*
370:   This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Comm_delete_attr) or when the user
371:   calls MPI_Comm_free().

373:   This is the only entry point for breaking the links between inner and outer comms.

375:   This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator.

377:   Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()

379: */
380: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_InnerComm_Attr_Delete_Fn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
381: {
382:   union
383:   {
384:     MPI_Comm comm;
385:     void    *ptr;
386:   } icomm;

388:   PetscFunctionBegin;
389:   if (keyval != Petsc_InnerComm_keyval) SETERRMPI(PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Unexpected keyval");
390:   icomm.ptr = attr_val;
391:   if (PetscDefined(USE_DEBUG)) {
392:     /* Error out if the inner/outer comms are not correctly linked through their Outer/InnterComm attributes */
393:     PetscMPIInt flg;
394:     union
395:     {
396:       MPI_Comm comm;
397:       void    *ptr;
398:     } ocomm;
399:     PetscCallMPI(MPI_Comm_get_attr(icomm.comm, Petsc_OuterComm_keyval, &ocomm, &flg));
400:     if (!flg) SETERRMPI(PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm does not have OuterComm attribute");
401:     if (ocomm.comm != comm) SETERRMPI(PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm's OuterComm attribute does not point to outer PETSc comm");
402:   }
403:   PetscCallMPI(MPI_Comm_delete_attr(icomm.comm, Petsc_OuterComm_keyval));
404:   PetscCallMPI(PetscInfo(NULL, "User MPI_Comm %ld is being unlinked from inner PETSc comm %ld\n", (long)comm, (long)icomm.comm));
405:   PetscFunctionReturn(MPI_SUCCESS);
406: }

408: /*
409:  * 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.
410:  */
411: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_OuterComm_Attr_Delete_Fn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
412: {
413:   PetscFunctionBegin;
414:   PetscCallMPI(PetscInfo(NULL, "Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n", (long)comm));
415:   PetscFunctionReturn(MPI_SUCCESS);
416: }

418: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_ShmComm_Attr_Delete_Fn(MPI_Comm, PetscMPIInt, void *, void *);

420: #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
421: PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype, MPI_Aint *, void *);
422: PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
423: PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
424: #endif

426: PetscMPIInt PETSC_MPI_ERROR_CLASS = MPI_ERR_LASTCODE, PETSC_MPI_ERROR_CODE;

428: PETSC_INTERN int    PetscGlobalArgc;
429: PETSC_INTERN char **PetscGlobalArgs;
430: int                 PetscGlobalArgc = 0;
431: char              **PetscGlobalArgs = NULL;
432: PetscSegBuffer      PetscCitationsList;

434: PetscErrorCode PetscCitationsInitialize(void)
435: {
436:   PetscFunctionBegin;
437:   PetscCall(PetscSegBufferCreate(1, 10000, &PetscCitationsList));

439:   PetscCall(PetscCitationsRegister("@TechReport{petsc-user-ref,\n\
440:   Author = {Satish Balay and Shrirang Abhyankar and Mark~F. Adams and Steven Benson and Jed Brown\n\
441:     and Peter Brune and Kris Buschelman and Emil Constantinescu and Lisandro Dalcin and Alp Dener\n\
442:     and Victor Eijkhout and Jacob Faibussowitsch and William~D. Gropp and V\'{a}clav Hapla and Tobin Isaac and Pierre Jolivet\n\
443:     and Dmitry Karpeev and Dinesh Kaushik and Matthew~G. Knepley and Fande Kong and Scott Kruger\n\
444:     and Dave~A. May and Lois Curfman McInnes and Richard Tran Mills and Lawrence Mitchell and Todd Munson\n\
445:     and Jose~E. Roman and Karl Rupp and Patrick Sanan and Jason Sarich and Barry~F. Smith\n\
446:     and Stefano Zampini and Hong Zhang and Hong Zhang and Junchao Zhang},\n\
447:   Title = {{PETSc/TAO} Users Manual},\n\
448:   Number = {ANL-21/39 - Revision 3.19},\n\
449:   Institution = {Argonne National Laboratory},\n\
450:   Year = {2023}\n}\n",
451:                                    NULL));

453:   PetscCall(PetscCitationsRegister("@InProceedings{petsc-efficient,\n\
454:   Author = {Satish Balay and William D. Gropp and Lois Curfman McInnes and Barry F. Smith},\n\
455:   Title = {Efficient Management of Parallelism in Object Oriented Numerical Software Libraries},\n\
456:   Booktitle = {Modern Software Tools in Scientific Computing},\n\
457:   Editor = {E. Arge and A. M. Bruaset and H. P. Langtangen},\n\
458:   Pages = {163--202},\n\
459:   Publisher = {Birkh{\\\"{a}}user Press},\n\
460:   Year = {1997}\n}\n",
461:                                    NULL));

463:   PetscFunctionReturn(PETSC_SUCCESS);
464: }

466: static char programname[PETSC_MAX_PATH_LEN] = ""; /* HP includes entire path in name */

468: PetscErrorCode PetscSetProgramName(const char name[])
469: {
470:   PetscFunctionBegin;
471:   PetscCall(PetscStrncpy(programname, name, sizeof(programname)));
472:   PetscFunctionReturn(PETSC_SUCCESS);
473: }

475: /*@C
476:     PetscGetProgramName - Gets the name of the running program.

478:     Not Collective

480:     Input Parameter:
481: .   len - length of the string name

483:     Output Parameter:
484: .   name - the name of the running program, provide a string of length `PETSC_MAX_PATH_LEN`

486:    Level: advanced

488: @*/
489: PetscErrorCode PetscGetProgramName(char name[], size_t len)
490: {
491:   PetscFunctionBegin;
492:   PetscCall(PetscStrncpy(name, programname, len));
493:   PetscFunctionReturn(PETSC_SUCCESS);
494: }

496: /*@C
497:    PetscGetArgs - Allows you to access the raw command line arguments anywhere
498:      after PetscInitialize() is called but before `PetscFinalize()`.

500:    Not Collective

502:    Output Parameters:
503: +  argc - count of number of command line arguments
504: -  args - the command line arguments

506:    Level: intermediate

508:    Notes:
509:       This is usually used to pass the command line arguments into other libraries
510:    that are called internally deep in PETSc or the application.

512:       The first argument contains the program name as is normal for C arguments.

514: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArguments()`
515: @*/
516: PetscErrorCode PetscGetArgs(int *argc, char ***args)
517: {
518:   PetscFunctionBegin;
519:   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
520:   *argc = PetscGlobalArgc;
521:   *args = PetscGlobalArgs;
522:   PetscFunctionReturn(PETSC_SUCCESS);
523: }

525: /*@C
526:    PetscGetArguments - Allows you to access the  command line arguments anywhere
527:      after `PetscInitialize()` is called but before `PetscFinalize()`.

529:    Not Collective

531:    Output Parameter:
532: .  args - the command line arguments

534:    Level: intermediate

536:    Notes:
537:       This does NOT start with the program name and IS null terminated (final arg is void)

539: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscFreeArguments()`
540: @*/
541: PetscErrorCode PetscGetArguments(char ***args)
542: {
543:   PetscInt i, argc = PetscGlobalArgc;

545:   PetscFunctionBegin;
546:   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
547:   if (!argc) {
548:     *args = NULL;
549:     PetscFunctionReturn(PETSC_SUCCESS);
550:   }
551:   PetscCall(PetscMalloc1(argc, args));
552:   for (i = 0; i < argc - 1; i++) PetscCall(PetscStrallocpy(PetscGlobalArgs[i + 1], &(*args)[i]));
553:   (*args)[argc - 1] = NULL;
554:   PetscFunctionReturn(PETSC_SUCCESS);
555: }

557: /*@C
558:    PetscFreeArguments - Frees the memory obtained with `PetscGetArguments()`

560:    Not Collective

562:    Output Parameter:
563: .  args - the command line arguments

565:    Level: intermediate

567: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscGetArguments()`
568: @*/
569: PetscErrorCode PetscFreeArguments(char **args)
570: {
571:   PetscFunctionBegin;
572:   if (args) {
573:     PetscInt i = 0;

575:     while (args[i]) PetscCall(PetscFree(args[i++]));
576:     PetscCall(PetscFree(args));
577:   }
578:   PetscFunctionReturn(PETSC_SUCCESS);
579: }

581: #if PetscDefined(HAVE_SAWS)
582:   #include <petscconfiginfo.h>

584: PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char help[])
585: {
586:   PetscFunctionBegin;
587:   if (!PetscGlobalRank) {
588:     char      cert[PETSC_MAX_PATH_LEN], root[PETSC_MAX_PATH_LEN], *intro, programname[64], *appline, *options, version[64];
589:     int       port;
590:     PetscBool flg, rootlocal = PETSC_FALSE, flg2, selectport = PETSC_FALSE;
591:     size_t    applinelen, introlen;
592:     char      sawsurl[256];

594:     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_log", &flg));
595:     if (flg) {
596:       char sawslog[PETSC_MAX_PATH_LEN];

598:       PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_log", sawslog, sizeof(sawslog), NULL));
599:       if (sawslog[0]) {
600:         PetscCallSAWs(SAWs_Set_Use_Logfile, (sawslog));
601:       } else {
602:         PetscCallSAWs(SAWs_Set_Use_Logfile, (NULL));
603:       }
604:     }
605:     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_https", cert, sizeof(cert), &flg));
606:     if (flg) PetscCallSAWs(SAWs_Set_Use_HTTPS, (cert));
607:     PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select", &selectport, NULL));
608:     if (selectport) {
609:       PetscCallSAWs(SAWs_Get_Available_Port, (&port));
610:       PetscCallSAWs(SAWs_Set_Port, (port));
611:     } else {
612:       PetscCall(PetscOptionsGetInt(NULL, NULL, "-saws_port", &port, &flg));
613:       if (flg) PetscCallSAWs(SAWs_Set_Port, (port));
614:     }
615:     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_root", root, sizeof(root), &flg));
616:     if (flg) {
617:       PetscCallSAWs(SAWs_Set_Document_Root, (root));
618:       PetscCall(PetscStrcmp(root, ".", &rootlocal));
619:     } else {
620:       PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_options", &flg));
621:       if (flg) {
622:         PetscCall(PetscStrreplace(PETSC_COMM_WORLD, "${PETSC_DIR}/share/petsc/saws", root, sizeof(root)));
623:         PetscCallSAWs(SAWs_Set_Document_Root, (root));
624:       }
625:     }
626:     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_local", &flg2));
627:     if (flg2) {
628:       char jsdir[PETSC_MAX_PATH_LEN];
629:       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_SUP, "-saws_local option requires -saws_root option");
630:       PetscCall(PetscSNPrintf(jsdir, sizeof(jsdir), "%s/js", root));
631:       PetscCall(PetscTestDirectory(jsdir, 'r', &flg));
632:       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "-saws_local option requires js directory in root directory");
633:       PetscCallSAWs(SAWs_Push_Local_Header, ());
634:     }
635:     PetscCall(PetscGetProgramName(programname, sizeof(programname)));
636:     PetscCall(PetscStrlen(help, &applinelen));
637:     introlen = 4096 + applinelen;
638:     applinelen += 1024;
639:     PetscCall(PetscMalloc(applinelen, &appline));
640:     PetscCall(PetscMalloc(introlen, &intro));

642:     if (rootlocal) {
643:       PetscCall(PetscSNPrintf(appline, applinelen, "%s.c.html", programname));
644:       PetscCall(PetscTestFile(appline, 'r', &rootlocal));
645:     }
646:     PetscCall(PetscOptionsGetAll(NULL, &options));
647:     if (rootlocal && help) {
648:       PetscCall(PetscSNPrintf(appline, applinelen, "<center> Running <a href=\"%s.c.html\">%s</a> %s</center><br><center><pre>%s</pre></center><br>\n", programname, programname, options, help));
649:     } else if (help) {
650:       PetscCall(PetscSNPrintf(appline, applinelen, "<center>Running %s %s</center><br><center><pre>%s</pre></center><br>", programname, options, help));
651:     } else {
652:       PetscCall(PetscSNPrintf(appline, applinelen, "<center> Running %s %s</center><br>\n", programname, options));
653:     }
654:     PetscCall(PetscFree(options));
655:     PetscCall(PetscGetVersion(version, sizeof(version)));
656:     PetscCall(PetscSNPrintf(intro, introlen,
657:                             "<body>\n"
658:                             "<center><h2> <a href=\"https://petsc.org/\">PETSc</a> Application Web server powered by <a href=\"https://bitbucket.org/saws/saws\">SAWs</a> </h2></center>\n"
659:                             "<center>This is the default PETSc application dashboard, from it you can access any published PETSc objects or logging data</center><br><center>%s configured with %s</center><br>\n"
660:                             "%s",
661:                             version, petscconfigureoptions, appline));
662:     PetscCallSAWs(SAWs_Push_Body, ("index.html", 0, intro));
663:     PetscCall(PetscFree(intro));
664:     PetscCall(PetscFree(appline));
665:     if (selectport) {
666:       PetscBool silent;

668:       /* another process may have grabbed the port so keep trying */
669:       while (SAWs_Initialize()) {
670:         PetscCallSAWs(SAWs_Get_Available_Port, (&port));
671:         PetscCallSAWs(SAWs_Set_Port, (port));
672:       }

674:       PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select_silent", &silent, NULL));
675:       if (!silent) {
676:         PetscCallSAWs(SAWs_Get_FullURL, (sizeof(sawsurl), sawsurl));
677:         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Point your browser to %s for SAWs\n", sawsurl));
678:       }
679:     } else {
680:       PetscCallSAWs(SAWs_Initialize, ());
681:     }
682:     PetscCall(PetscCitationsRegister("@TechReport{ saws,\n"
683:                                      "  Author = {Matt Otten and Jed Brown and Barry Smith},\n"
684:                                      "  Title  = {Scientific Application Web Server (SAWs) Users Manual},\n"
685:                                      "  Institution = {Argonne National Laboratory},\n"
686:                                      "  Year   = 2013\n}\n",
687:                                      NULL));
688:   }
689:   PetscFunctionReturn(PETSC_SUCCESS);
690: }
691: #endif

693: /* Things must be done before MPI_Init() when MPI is not yet initialized, and can be shared between C init and Fortran init */
694: PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(void)
695: {
696:   PetscFunctionBegin;
697: #if defined(PETSC_HAVE_HWLOC_SOLARIS_BUG)
698:   /* see MPI.py for details on this bug */
699:   (void)setenv("HWLOC_COMPONENTS", "-x86", 1);
700: #endif
701:   PetscFunctionReturn(PETSC_SUCCESS);
702: }

704: #if PetscDefined(HAVE_ADIOS)
705:   #include <adios.h>
706:   #include <adios_read.h>
707: int64_t Petsc_adios_group;
708: #endif
709: #if PetscDefined(HAVE_OPENMP)
710:   #include <omp.h>
711: PetscInt PetscNumOMPThreads;
712: #endif

714: #include <petsc/private/deviceimpl.h>
715: #if PetscDefined(HAVE_CUDA)
716: #include <petscdevice_cuda.h>
717: // REMOVE ME
718: cudaStream_t PetscDefaultCudaStream = NULL;
719: #endif
720: #if PetscDefined(HAVE_HIP)
721: #include <petscdevice_hip.h>
722: // REMOVE ME
723: hipStream_t PetscDefaultHipStream = NULL;
724: #endif

726: #if PetscDefined(HAVE_DLFCN_H)
727:   #include <dlfcn.h>
728: #endif
729: #if PetscDefined(USE_LOG)
730: PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
731: #endif
732: #if PetscDefined(HAVE_VIENNACL)
733: PETSC_EXTERN PetscErrorCode PetscViennaCLInit(void);
734: PetscBool                   PetscViennaCLSynchronize = PETSC_FALSE;
735: #endif

737: PetscBool PetscCIEnabled = PETSC_FALSE, PetscCIEnabledPortableErrorOutput = PETSC_FALSE;

739: /*
740:   PetscInitialize_Common  - shared code between C and Fortran initialization

742:   prog:     program name
743:   file:     optional PETSc database file name. Might be in Fortran string format when 'ftn' is true
744:   help:     program help message
745:   ftn:      is it called from Fortran initialization (petscinitializef_)?
746:   readarguments,len: used when fortran is true
747: */
748: PETSC_INTERN PetscErrorCode PetscInitialize_Common(const char *prog, const char *file, const char *help, PetscBool ftn, PetscBool readarguments, PetscInt len)
749: {
750:   PetscMPIInt size;
751:   PetscBool   flg = PETSC_TRUE;
752:   char        hostname[256];

754:   PetscFunctionBegin;
755:   if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
756:   /* these must be initialized in a routine, not as a constant declaration */
757:   PETSC_STDOUT = stdout;
758:   PETSC_STDERR = stderr;

760:   /* PetscCall can be used from now */
761:   PetscErrorHandlingInitialized = PETSC_TRUE;

763:   /*
764:       The checking over compatible runtime libraries is complicated by the MPI ABI initiative
765:       https://wiki.mpich.org/mpich/index.php/ABI_Compatibility_Initiative which started with
766:         MPICH v3.1 (Released February 2014)
767:         IBM MPI v2.1 (December 2014)
768:         Intel MPI Library v5.0 (2014)
769:         Cray MPT v7.0.0 (June 2014)
770:       As of July 31, 2017 the ABI number still appears to be 12, that is all of the versions
771:       listed above and since that time are compatible.

773:       Unfortunately the MPI ABI initiative has not defined a way to determine the ABI number
774:       at compile time or runtime. Thus we will need to systematically track the allowed versions
775:       and how they are represented in the mpi.h and MPI_Get_library_version() output in order
776:       to perform the checking.

778:       Currently we only check for pre MPI ABI versions (and packages that do not follow the MPI ABI).

780:       Questions:

782:         Should the checks for ABI incompatibility be only on the major version number below?
783:         Presumably the output to stderr will be removed before a release.
784:   */

786: #if defined(PETSC_HAVE_MPI_GET_LIBRARY_VERSION)
787:   {
788:     char        mpilibraryversion[MPI_MAX_LIBRARY_VERSION_STRING];
789:     PetscMPIInt mpilibraryversionlength;

791:     PetscCallMPI(MPI_Get_library_version(mpilibraryversion, &mpilibraryversionlength));
792:     /* check for MPICH versions before MPI ABI initiative */
793:   #if defined(MPICH_VERSION)
794:     #if MPICH_NUMVERSION < 30100000
795:     {
796:       char     *ver, *lf;
797:       PetscBool flg = PETSC_FALSE;

799:       PetscCall(PetscStrstr(mpilibraryversion, "MPICH Version:", &ver));
800:       if (ver) {
801:         PetscCall(PetscStrchr(ver, '\n', &lf));
802:         if (lf) {
803:           *lf = 0;
804:           PetscCall(PetscStrendswith(ver, MPICH_VERSION, &flg));
805:         }
806:       }
807:       if (!flg) {
808:         PetscCall(PetscInfo(NULL, "PETSc warning --- MPICH library version \n%s does not match what PETSc was compiled with %s.\n", mpilibraryversion, MPICH_VERSION));
809:         flg = PETSC_TRUE;
810:       }
811:     }
812:     #endif
813:       /* check for OpenMPI version, it is not part of the MPI ABI initiative (is it part of another initiative that needs to be handled?) */
814:   #elif defined(OMPI_MAJOR_VERSION)
815:     {
816:       char     *ver, bs[MPI_MAX_LIBRARY_VERSION_STRING], *bsf;
817:       PetscBool flg                                              = PETSC_FALSE;
818:     #define PSTRSZ 2
819:       char      ompistr1[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"Open MPI", "FUJITSU MPI"};
820:       char      ompistr2[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"v", "Library "};
821:       int       i;
822:       for (i = 0; i < PSTRSZ; i++) {
823:         PetscCall(PetscStrstr(mpilibraryversion, ompistr1[i], &ver));
824:         if (ver) {
825:           PetscCall(PetscSNPrintf(bs, MPI_MAX_LIBRARY_VERSION_STRING, "%s%d.%d", ompistr2[i], OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION));
826:           PetscCall(PetscStrstr(ver, bs, &bsf));
827:           if (bsf) flg = PETSC_TRUE;
828:           break;
829:         }
830:       }
831:       if (!flg) {
832:         PetscCall(PetscInfo(NULL, "PETSc warning --- Open MPI library version \n%s does not match what PETSc was compiled with %d.%d.\n", mpilibraryversion, OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION));
833:         flg = PETSC_TRUE;
834:       }
835:     }
836:   #endif
837:   }
838: #endif

840: #if defined(PETSC_HAVE_DLADDR) && !(defined(__cray__) && defined(__clang__))
841:   /* These symbols are currently in the OpenMPI and MPICH libraries; they may not always be, in that case the test will simply not detect the problem */
842:   PetscCheck(!dlsym(RTLD_DEFAULT, "ompi_mpi_init") || !dlsym(RTLD_DEFAULT, "MPID_Abort"), PETSC_COMM_SELF, PETSC_ERR_MPI_LIB_INCOMP, "Application was linked against both OpenMPI and MPICH based MPI libraries and will not run correctly");
843: #endif

845:   /* on Windows - set printf to default to printing 2 digit exponents */
846: #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
847:   _set_output_format(_TWO_DIGIT_EXPONENT);
848: #endif

850:   PetscCall(PetscOptionsCreateDefault());

852:   PetscFinalizeCalled = PETSC_FALSE;

854:   PetscCall(PetscSetProgramName(prog));
855:   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen));
856:   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout));
857:   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr));
858:   PetscCall(PetscSpinlockCreate(&PetscCommSpinLock));

860:   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
861:   PetscCallMPI(MPI_Comm_set_errhandler(PETSC_COMM_WORLD, MPI_ERRORS_RETURN));

863:   if (PETSC_MPI_ERROR_CLASS == MPI_ERR_LASTCODE) {
864:     PetscCallMPI(MPI_Add_error_class(&PETSC_MPI_ERROR_CLASS));
865:     PetscCallMPI(MPI_Add_error_code(PETSC_MPI_ERROR_CLASS, &PETSC_MPI_ERROR_CODE));
866:   }

868:   /* Done after init due to a bug in MPICH-GM? */
869:   PetscCall(PetscErrorPrintfInitialize());

871:   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &PetscGlobalRank));
872:   PetscCallMPI(MPI_Comm_size(MPI_COMM_WORLD, &PetscGlobalSize));

874:   MPIU_BOOL        = MPI_INT;
875:   MPIU_ENUM        = MPI_INT;
876:   MPIU_FORTRANADDR = (sizeof(void *) == sizeof(int)) ? MPI_INT : MPIU_INT64;
877:   if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED;
878:   else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG;
879: #if defined(PETSC_SIZEOF_LONG_LONG)
880:   else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG;
881: #endif
882:   else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_SUP_SYS, "Could not find MPI type for size_t");

884:     /*
885:      Initialized the global complex variable; this is because with
886:      shared libraries the constructors for global variables
887:      are not called; at least on IRIX.
888:   */
889: #if defined(PETSC_HAVE_COMPLEX)
890:   {
891:   #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128)
892:     PetscComplex ic(0.0, 1.0);
893:     PETSC_i = ic;
894:   #else
895:     PETSC_i = _Complex_I;
896:   #endif
897:   }
898: #endif /* PETSC_HAVE_COMPLEX */

900:   /*
901:      Create the PETSc MPI reduction operator that sums of the first
902:      half of the entries and maxes the second half.
903:   */
904:   PetscCallMPI(MPI_Op_create(MPIU_MaxSum_Local, 1, &MPIU_MAXSUM_OP));

906: #if defined(PETSC_HAVE_REAL___FLOAT128)
907:   PetscCallMPI(MPI_Type_contiguous(2, MPI_DOUBLE, &MPIU___FLOAT128));
908:   PetscCallMPI(MPI_Type_commit(&MPIU___FLOAT128));
909:   PetscCallMPI(MPI_Type_contiguous(4, MPI_DOUBLE, &MPIU___COMPLEX128));
910:   PetscCallMPI(MPI_Type_commit(&MPIU___COMPLEX128));
911: #endif
912: #if defined(PETSC_HAVE_REAL___FP16)
913:   PetscCallMPI(MPI_Type_contiguous(2, MPI_CHAR, &MPIU___FP16));
914:   PetscCallMPI(MPI_Type_commit(&MPIU___FP16));
915: #endif

917: #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
918:   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM));
919:   PetscCallMPI(MPI_Op_create(PetscMax_Local, 1, &MPIU_MAX));
920:   PetscCallMPI(MPI_Op_create(PetscMin_Local, 1, &MPIU_MIN));
921: #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
922:   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM___FP16___FLOAT128));
923: #endif

925:   PetscCallMPI(MPI_Type_contiguous(2, MPIU_SCALAR, &MPIU_2SCALAR));
926:   PetscCallMPI(MPI_Op_create(PetscGarbageKeySortedIntersect, 1, &Petsc_Garbage_SetIntersectOp));
927:   PetscCallMPI(MPI_Type_commit(&MPIU_2SCALAR));

929:   /* create datatypes used by MPIU_MAXLOC, MPIU_MINLOC and PetscSplitReduction_Op */
930: #if !defined(PETSC_HAVE_MPIUNI)
931:   {
932:     PetscMPIInt  blockSizes[2]   = {1, 1};
933:     MPI_Aint     blockOffsets[2] = {offsetof(struct petsc_mpiu_real_int, v), offsetof(struct petsc_mpiu_real_int, i)};
934:     MPI_Datatype blockTypes[2]   = {MPIU_REAL, MPIU_INT}, tmpStruct;

936:     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
937:     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_real_int), &MPIU_REAL_INT));
938:     PetscCallMPI(MPI_Type_free(&tmpStruct));
939:     PetscCallMPI(MPI_Type_commit(&MPIU_REAL_INT));
940:   }
941:   {
942:     PetscMPIInt  blockSizes[2]   = {1, 1};
943:     MPI_Aint     blockOffsets[2] = {offsetof(struct petsc_mpiu_scalar_int, v), offsetof(struct petsc_mpiu_scalar_int, i)};
944:     MPI_Datatype blockTypes[2]   = {MPIU_SCALAR, MPIU_INT}, tmpStruct;

946:     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
947:     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_scalar_int), &MPIU_SCALAR_INT));
948:     PetscCallMPI(MPI_Type_free(&tmpStruct));
949:     PetscCallMPI(MPI_Type_commit(&MPIU_SCALAR_INT));
950:   }
951: #endif

953: #if defined(PETSC_USE_64BIT_INDICES)
954:   PetscCallMPI(MPI_Type_contiguous(2, MPIU_INT, &MPIU_2INT));
955:   PetscCallMPI(MPI_Type_commit(&MPIU_2INT));
956: #endif
957:   PetscCallMPI(MPI_Type_contiguous(4, MPI_INT, &MPI_4INT));
958:   PetscCallMPI(MPI_Type_commit(&MPI_4INT));
959:   PetscCallMPI(MPI_Type_contiguous(4, MPIU_INT, &MPIU_4INT));
960:   PetscCallMPI(MPI_Type_commit(&MPIU_4INT));

962:   /*
963:      Attributes to be set on PETSc communicators
964:   */
965:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_Counter_Attr_Delete_Fn, &Petsc_Counter_keyval, (void *)0));
966:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_InnerComm_Attr_Delete_Fn, &Petsc_InnerComm_keyval, (void *)0));
967:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_OuterComm_Attr_Delete_Fn, &Petsc_OuterComm_keyval, (void *)0));
968:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_ShmComm_Attr_Delete_Fn, &Petsc_ShmComm_keyval, (void *)0));
969:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_CreationIdx_keyval, (void *)0));
970:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_Garbage_HMap_keyval, (void *)0));

972: #if defined(PETSC_HAVE_FORTRAN)
973:   if (ftn) PetscCall(PetscInitFortran_Private(readarguments, file, len));
974:   else
975: #endif
976:     PetscCall(PetscOptionsInsert(NULL, &PetscGlobalArgc, &PetscGlobalArgs, file));

978:   /* call a second time so it can look in the options database */
979:   PetscCall(PetscErrorPrintfInitialize());

981:   /*
982:      Check system options and print help
983:   */
984:   PetscCall(PetscOptionsCheckInitial_Private(help));

986:   /*
987:     Creates the logging data structures; this is enabled even if logging is not turned on
988:     This is the last thing we do before returning to the user code to prevent having the
989:     logging numbers contaminated by any startup time associated with MPI
990:   */
991: #if defined(PETSC_USE_LOG)
992:   PetscCall(PetscLogInitialize());
993: #endif

995:   /*
996:    Initialize PetscDevice and PetscDeviceContext

998:    Note to any future devs thinking of moving this, proper initialization requires:
999:    1. MPI initialized
1000:    2. Options DB initialized
1001:    3. Petsc error handling initialized, specifically signal handlers. This expects to set up
1002:       its own SIGSEV handler via the push/pop interface.
1003:    4. Logging initialized
1004:   */
1005:   PetscCall(PetscDeviceInitializeFromOptions_Internal(PETSC_COMM_WORLD));

1007: #if PetscDefined(HAVE_VIENNACL)
1008:   flg = PETSC_FALSE;
1009:   PetscCall(PetscOptionsHasName(NULL, NULL, "-log_summary", &flg));
1010:   if (!flg) PetscCall(PetscOptionsHasName(NULL, NULL, "-log_view", &flg));
1011:   if (!flg) PetscCall(PetscOptionsGetBool(NULL, NULL, "-viennacl_synchronize", &flg, NULL));
1012:   PetscViennaCLSynchronize = flg;
1013:   PetscCall(PetscViennaCLInit());
1014: #endif

1016:   PetscCall(PetscCitationsInitialize());

1018: #if defined(PETSC_HAVE_SAWS)
1019:   PetscCall(PetscInitializeSAWs(ftn ? NULL : help));
1020:   flg = PETSC_FALSE;
1021:   PetscCall(PetscOptionsHasName(NULL, NULL, "-stack_view", &flg));
1022:   if (flg) PetscCall(PetscStackViewSAWs());
1023: #endif

1025:   /*
1026:      Load the dynamic libraries (on machines that support them), this registers all
1027:      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
1028:   */
1029:   PetscCall(PetscInitialize_DynamicLibraries());

1031:   PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));
1032:   PetscCall(PetscInfo(NULL, "PETSc successfully started: number of processors = %d\n", size));
1033:   PetscCall(PetscGetHostName(hostname, sizeof(hostname)));
1034:   PetscCall(PetscInfo(NULL, "Running on machine: %s\n", hostname));
1035: #if defined(PETSC_HAVE_OPENMP)
1036:   {
1037:     PetscBool omp_view_flag;
1038:     char     *threads = getenv("OMP_NUM_THREADS");

1040:     if (threads) {
1041:       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n", threads));
1042:       (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumOMPThreads);
1043:     } else {
1044:       PetscNumOMPThreads = (PetscInt)omp_get_max_threads();
1045:       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n", PetscNumOMPThreads));
1046:     }
1047:     PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "OpenMP options", "Sys");
1048:     PetscCall(PetscOptionsInt("-omp_num_threads", "Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS", "None", PetscNumOMPThreads, &PetscNumOMPThreads, &flg));
1049:     PetscCall(PetscOptionsName("-omp_view", "Display OpenMP number of threads", NULL, &omp_view_flag));
1050:     PetscOptionsEnd();
1051:     if (flg) {
1052:       PetscCall(PetscInfo(NULL, "Number of OpenMP theads %" PetscInt_FMT " (given by -omp_num_threads)\n", PetscNumOMPThreads));
1053:       omp_set_num_threads((int)PetscNumOMPThreads);
1054:     }
1055:     if (omp_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "OpenMP: number of threads %" PetscInt_FMT "\n", PetscNumOMPThreads));
1056:   }
1057: #endif

1059: #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
1060:   /*
1061:       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI

1063:       Currently not used because it is not supported by MPICH.
1064:   */
1065:   if (!PetscBinaryBigEndian()) PetscCallMPI(MPI_Register_datarep((char *)"petsc", PetscDataRep_read_conv_fn, PetscDataRep_write_conv_fn, PetscDataRep_extent_fn, NULL));
1066: #endif

1068: #if defined(PETSC_SERIALIZE_FUNCTIONS)
1069:   PetscCall(PetscFPTCreate(10000));
1070: #endif

1072: #if defined(PETSC_HAVE_HWLOC)
1073:   {
1074:     PetscViewer viewer;
1075:     PetscCall(PetscOptionsGetViewer(PETSC_COMM_WORLD, NULL, NULL, "-process_view", &viewer, NULL, &flg));
1076:     if (flg) {
1077:       PetscCall(PetscProcessPlacementView(viewer));
1078:       PetscCall(PetscViewerDestroy(&viewer));
1079:     }
1080:   }
1081: #endif

1083:   flg = PETSC_TRUE;
1084:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-viewfromoptions", &flg, NULL));
1085:   if (!flg) PetscCall(PetscOptionsPushGetViewerOff(PETSC_TRUE));

1087: #if defined(PETSC_HAVE_ADIOS)
1088:   PetscCallExternal(adios_init_noxml, PETSC_COMM_WORLD);
1089:   PetscCallExternal(adios_declare_group, &Petsc_adios_group, "PETSc", "", adios_stat_default);
1090:   PetscCallExternal(adios_select_method, Petsc_adios_group, "MPI", "", "");
1091:   PetscCallExternal(adios_read_init_method, ADIOS_READ_METHOD_BP, PETSC_COMM_WORLD, "");
1092: #endif

1094: #if defined(__VALGRIND_H)
1095:   PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND ? PETSC_TRUE : PETSC_FALSE;
1096:   #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE)
1097:   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"));
1098:   #endif
1099: #endif
1100:   /*
1101:       Set flag that we are completely initialized
1102:   */
1103:   PetscInitializeCalled = PETSC_TRUE;

1105:   PetscCall(PetscOptionsHasName(NULL, NULL, "-python", &flg));
1106:   if (flg) PetscCall(PetscPythonInitialize(NULL, NULL));

1108:   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1109:   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerBegin());
1110:   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");
1111:   PetscFunctionReturn(PETSC_SUCCESS);
1112: }

1114: /*@C
1115:    PetscInitialize - Initializes the PETSc database and MPI.
1116:    `PetscInitialize()` calls MPI_Init() if that has yet to be called,
1117:    so this routine should always be called near the beginning of
1118:    your program -- usually the very first line!

1120:    Collective on `MPI_COMM_WORLD` or `PETSC_COMM_WORLD` if it has been set

1122:    Input Parameters:
1123: +  argc - count of number of command line arguments
1124: .  args - the command line arguments
1125: .  file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format.
1126:           Use NULL or empty string to not check for code specific file.
1127:           Also checks ~/.petscrc, .petscrc and petscrc.
1128:           Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files.
1129: -  help - [optional] Help message to print, use NULL for no message

1131:    If you wish PETSc code to run ONLY on a subcommunicator of `MPI_COMM_WORLD`, create that
1132:    communicator first and assign it to `PETSC_COMM_WORLD` BEFORE calling `PetscInitialize()`. Thus if you are running a
1133:    four process job and two processes will run PETSc and have `PetscInitialize()` and PetscFinalize() and two process will not,
1134:    then do this. If ALL processes in the job are using `PetscInitialize()` and `PetscFinalize()` then you don't need to do this, even
1135:    if different subcommunicators of the job are doing different things with PETSc.

1137:    Options Database Keys:
1138: +  -help [intro] - prints help method for each option; if intro is given the program stops after printing the introductory help message
1139: .  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
1140: .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
1141: .  -on_error_emacs <machinename> - causes emacsclient to jump to error file
1142: .  -on_error_abort - calls `abort()` when error detected (no traceback)
1143: .  -on_error_mpiabort - calls `MPI_abort()` when error detected
1144: .  -error_output_stdout - prints PETSc error messages to stdout instead of the default stderr
1145: .  -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called)
1146: .  -debugger_ranks [rank1,rank2,...] - Indicates ranks to start in debugger
1147: .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
1148: .  -stop_for_debugger - Print message on how to attach debugger manually to
1149:                         process and wait (-debugger_pause) seconds for attachment
1150: .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) (deprecated, use -malloc_debug)
1151: .  -malloc no - Indicates not to use error-checking malloc (deprecated, use -malloc_debug no)
1152: .  -malloc_debug - check for memory corruption at EVERY malloc or free, see `PetscMallocSetDebug()`
1153: .  -malloc_dump - prints a list of all unfreed memory at the end of the run
1154: .  -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
1155: .  -malloc_view - show a list of all allocated memory during `PetscFinalize()`
1156: .  -malloc_view_threshold <t> - only list memory allocations of size greater than t with -malloc_view
1157: .  -malloc_requested_size - malloc logging will record the requested size rather than size after alignment
1158: .  -fp_trap - Stops on floating point exceptions
1159: .  -no_signal_handler - Indicates not to trap error signals
1160: .  -shared_tmp - indicates /tmp directory is shared by all processors
1161: .  -not_shared_tmp - each processor has own /tmp
1162: .  -tmp - alternative name of /tmp directory
1163: .  -get_total_flops - returns total flops done by all processors
1164: -  -memory_view - Print memory usage at end of run

1166:    Options Database Keys for Option Database:
1167: +  -skip_petscrc - skip the default option files ~/.petscrc, .petscrc, petscrc
1168: .  -options_monitor - monitor all set options to standard output for the whole program run
1169: -  -options_monitor_cancel - cancel options monitoring hard-wired using `PetscOptionsMonitorSet()`

1171:    Options -options_monitor_{all,cancel} are
1172:    position-independent and apply to all options set since the PETSc start.
1173:    They can be used also in option files.

1175:    See `PetscOptionsMonitorSet()` to do monitoring programmatically.

1177:    Options Database Keys for Profiling:
1178:    See Users-Manual: ch_profiling for details.
1179: +  -info [filename][:[~]<list,of,classnames>[:[~]self]] - Prints verbose information. See `PetscInfo()`.
1180: .  -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event,
1181:         however it slows things down and gives a distorted view of the overall runtime.
1182: .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
1183:         hangs without running in the debugger).  See `PetscLogTraceBegin()`.
1184: .  -log_view [:filename:format] - Prints summary of flop and timing information to screen or file, see `PetscLogView()`.
1185: .  -log_view_memory - Includes in the summary from -log_view the memory used in each event, see `PetscLogView()`.
1186: .  -log_view_gpu_time - Includes in the summary from -log_view the time used in each GPU kernel, see `PetscLogView().
1187: .  -log_summary [filename] - (Deprecated, use -log_view) Prints summary of flop and timing information to screen. If the filename is specified the
1188:         summary is written to the file.  See PetscLogView().
1189: .  -log_exclude: <vec,mat,pc,ksp,snes> - excludes subset of object classes from logging
1190: .  -log_all [filename] - Logs extensive profiling information  See `PetscLogDump()`.
1191: .  -log [filename] - Logs basic profiline information  See `PetscLogDump()`.
1192: .  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
1193: .  -viewfromoptions on,off - Enable or disable `XXXSetFromOptions()` calls, for applications with many small solves turn this off
1194: -  -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code

1196:     Only one of -log_trace, -log_view, -log_all, -log, or -log_mpe may be used at a time

1198:    Options Database Keys for SAWs:
1199: +  -saws_port <portnumber> - port number to publish SAWs data, default is 8080
1200: .  -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen
1201:                             this is useful when you are running many jobs that utilize SAWs at the same time
1202: .  -saws_log <filename> - save a log of all SAWs communication
1203: .  -saws_https <certificate file> - have SAWs use HTTPS instead of HTTP
1204: -  -saws_root <directory> - allow SAWs to have access to the given directory to search for requested resources and files

1206:    Environmental Variables:
1207: +   `PETSC_TMP` - alternative tmp directory
1208: .   `PETSC_SHARED_TMP` - tmp is shared by all processes
1209: .   `PETSC_NOT_SHARED_TMP` - each process has its own private tmp
1210: .   `PETSC_OPTIONS` - a string containing additional options for petsc in the form of command line "-key value" pairs
1211: .   `PETSC_OPTIONS_YAML` - (requires configuring PETSc to use libyaml) a string containing additional options for petsc in the form of a YAML document
1212: .   `PETSC_VIEWER_SOCKET_PORT` - socket number to use for socket viewer
1213: -   `PETSC_VIEWER_SOCKET_MACHINE` - machine to use for socket viewer to connect to

1215:    Level: beginner

1217:    Note:
1218:    If for some reason you must call `MPI_Init()` separately, call
1219:    it before `PetscInitialize()`.

1221:    Fortran Notes:
1222:    In Fortran this routine can be called with
1223: .vb
1224:        call PetscInitialize(ierr)
1225:        call PetscInitialize(file,ierr) or
1226:        call PetscInitialize(file,help,ierr)
1227: .ve

1229:    If your main program is C but you call Fortran code that also uses PETSc you need to call `PetscInitializeFortran()` soon after
1230:    calling `PetscInitialize()`.

1232:    Options Database Key for Developers:
1233: .  -checkfunctionlist - automatically checks that function lists associated with objects are correctly cleaned up. Produces messages of the form:
1234:     "function name: MatInodeGetInodeSizes_C" if they are not cleaned up. This flag is always set for the test harness (in framework.py)

1236: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscInitializeNoArguments()`, `PetscLogGpuTime()`
1237: @*/
1238: PetscErrorCode PetscInitialize(int *argc, char ***args, const char file[], const char help[])
1239: {
1240:   PetscMPIInt flag;
1241:   const char *prog = "Unknown Name", *mpienv;

1243:   PetscFunctionBegin;
1244:   if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
1245:   PetscCallMPI(MPI_Initialized(&flag));
1246:   if (!flag) {
1247:     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");
1248:     PetscCall(PetscPreMPIInit_Private());
1249: #if defined(PETSC_HAVE_MPI_INIT_THREAD)
1250:     {
1251:       PetscMPIInt PETSC_UNUSED provided;
1252:       PetscCallMPI(MPI_Init_thread(argc, args, PETSC_MPI_THREAD_REQUIRED, &provided));
1253:     }
1254: #else
1255:     PetscCallMPI(MPI_Init(argc, args));
1256: #endif
1257:     if (PetscDefined(HAVE_MPIUNI)) {
1258:       mpienv = getenv("PMI_SIZE");
1259:       if (!mpienv) mpienv = getenv("OMPI_COMM_WORLD_SIZE");
1260:       if (mpienv) {
1261:         PetscInt isize;
1262:         PetscCall(PetscOptionsStringToInt(mpienv, &isize));
1263:         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");
1264:         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");
1265:       }
1266:     }
1267:     PetscBeganMPI = PETSC_TRUE;
1268:   }

1270:   if (argc && *argc) prog = **args;
1271:   if (argc && args) {
1272:     PetscGlobalArgc = *argc;
1273:     PetscGlobalArgs = *args;
1274:   }
1275:   PetscCall(PetscInitialize_Common(prog, file, help, PETSC_FALSE, PETSC_FALSE, 0));
1276:   PetscFunctionReturn(PETSC_SUCCESS);
1277: }

1279: #if PetscDefined(USE_LOG)
1280: PETSC_INTERN PetscObject *PetscObjects;
1281: PETSC_INTERN PetscInt     PetscObjectsCounts;
1282: PETSC_INTERN PetscInt     PetscObjectsMaxCounts;
1283: PETSC_INTERN PetscBool    PetscObjectsLog;
1284: #endif

1286: /*
1287:     Frees all the MPI types and operations that PETSc may have created
1288: */
1289: PetscErrorCode PetscFreeMPIResources(void)
1290: {
1291:   PetscFunctionBegin;
1292: #if defined(PETSC_HAVE_REAL___FLOAT128)
1293:   PetscCallMPI(MPI_Type_free(&MPIU___FLOAT128));
1294:   PetscCallMPI(MPI_Type_free(&MPIU___COMPLEX128));
1295: #endif
1296: #if defined(PETSC_HAVE_REAL___FP16)
1297:   PetscCallMPI(MPI_Type_free(&MPIU___FP16));
1298: #endif

1300: #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
1301:   PetscCallMPI(MPI_Op_free(&MPIU_SUM));
1302:   PetscCallMPI(MPI_Op_free(&MPIU_MAX));
1303:   PetscCallMPI(MPI_Op_free(&MPIU_MIN));
1304: #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16)
1305:   PetscCallMPI(MPI_Op_free(&MPIU_SUM___FP16___FLOAT128));
1306: #endif

1308:   PetscCallMPI(MPI_Type_free(&MPIU_2SCALAR));
1309:   PetscCallMPI(MPI_Type_free(&MPIU_REAL_INT));
1310:   PetscCallMPI(MPI_Type_free(&MPIU_SCALAR_INT));
1311: #if defined(PETSC_USE_64BIT_INDICES)
1312:   PetscCallMPI(MPI_Type_free(&MPIU_2INT));
1313: #endif
1314:   PetscCallMPI(MPI_Type_free(&MPI_4INT));
1315:   PetscCallMPI(MPI_Type_free(&MPIU_4INT));
1316:   PetscCallMPI(MPI_Op_free(&MPIU_MAXSUM_OP));
1317:   PetscCallMPI(MPI_Op_free(&Petsc_Garbage_SetIntersectOp));
1318:   PetscFunctionReturn(PETSC_SUCCESS);
1319: }

1321: #if PetscDefined(USE_LOG)
1322: PETSC_INTERN PetscErrorCode PetscLogFinalize(void);
1323: #endif

1325: /*@C
1326:    PetscFinalize - Checks for options to be called at the conclusion
1327:    of the program. `MPI_Finalize()` is called only if the user had not
1328:    called `MPI_Init()` before calling `PetscInitialize()`.

1330:    Collective on `PETSC_COMM_WORLD`

1332:    Options Database Keys:
1333: +  -options_view - Calls `PetscOptionsView()`
1334: .  -options_left - Prints unused options that remain in the database
1335: .  -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
1336: .  -mpidump - Calls PetscMPIDump()
1337: .  -malloc_dump <optional filename> - Calls `PetscMallocDump()`, displays all memory allocated that has not been freed
1338: .  -malloc_info - Prints total memory usage
1339: -  -malloc_view <optional filename> - Prints list of all memory allocated and where

1341:    Level: beginner

1343:    Note:
1344:    See `PetscInitialize()` for other runtime options.

1346: .seealso: `PetscInitialize()`, `PetscOptionsView()`, `PetscMallocDump()`, `PetscMPIDump()`, `PetscEnd()`
1347: @*/
1348: PetscErrorCode PetscFinalize(void)
1349: {
1350:   PetscMPIInt rank;
1351:   PetscInt    nopt;
1352:   PetscBool   flg1 = PETSC_FALSE, flg2 = PETSC_FALSE, flg3 = PETSC_FALSE;
1353:   PetscBool   flg;
1354: #if defined(PETSC_USE_LOG)
1355:   char mname[PETSC_MAX_PATH_LEN];
1356: #endif

1358:   PetscFunctionBegin;
1359:   PetscCheck(PetscInitializeCalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscInitialize() must be called before PetscFinalize()");
1360:   PetscCall(PetscInfo(NULL, "PetscFinalize() called\n"));

1362:   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1363:   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerEnd());

1365:   /* Clean up Garbage automatically on COMM_SELF and COMM_WORLD at finalize */
1366:   {
1367:     union
1368:     {
1369:       MPI_Comm comm;
1370:       void    *ptr;
1371:     } ucomm;
1372:     PetscMPIInt flg;
1373:     void       *tmp;

1375:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1376:     if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1377:     if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_SELF));
1378:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1379:     if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1380:     if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_WORLD));
1381:   }

1383:   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
1384: #if defined(PETSC_HAVE_ADIOS)
1385:   PetscCallExternal(adios_read_finalize_method, ADIOS_READ_METHOD_BP_AGGREGATE);
1386:   PetscCallExternal(adios_finalize, rank);
1387: #endif
1388:   PetscCall(PetscOptionsHasName(NULL, NULL, "-citations", &flg));
1389:   if (flg) {
1390:     char *cits, filename[PETSC_MAX_PATH_LEN];
1391:     FILE *fd = PETSC_STDOUT;

1393:     PetscCall(PetscOptionsGetString(NULL, NULL, "-citations", filename, sizeof(filename), NULL));
1394:     if (filename[0]) PetscCall(PetscFOpen(PETSC_COMM_WORLD, filename, "w", &fd));
1395:     PetscCall(PetscSegBufferGet(PetscCitationsList, 1, &cits));
1396:     cits[0] = 0;
1397:     PetscCall(PetscSegBufferExtractAlloc(PetscCitationsList, &cits));
1398:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "If you publish results based on this computation please cite the following:\n"));
1399:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1400:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "%s", cits));
1401:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1402:     PetscCall(PetscFClose(PETSC_COMM_WORLD, fd));
1403:     PetscCall(PetscFree(cits));
1404:   }
1405:   PetscCall(PetscSegBufferDestroy(&PetscCitationsList));

1407: #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER)
1408:   /* TextBelt is run for testing purposes only, please do not use this feature often */
1409:   {
1410:     PetscInt nmax = 2;
1411:     char   **buffs;
1412:     PetscCall(PetscMalloc1(2, &buffs));
1413:     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-textbelt", buffs, &nmax, &flg1));
1414:     if (flg1) {
1415:       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-textbelt requires either the phone number or number,\"message\"");
1416:       if (nmax == 1) {
1417:         size_t len = 128;
1418:         PetscCall(PetscMalloc1(len, &buffs[1]));
1419:         PetscCall(PetscGetProgramName(buffs[1], 32));
1420:         PetscCall(PetscStrlcat(buffs[1], " has completed", len));
1421:       }
1422:       PetscCall(PetscTextBelt(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1423:       PetscCall(PetscFree(buffs[0]));
1424:       PetscCall(PetscFree(buffs[1]));
1425:     }
1426:     PetscCall(PetscFree(buffs));
1427:   }
1428:   {
1429:     PetscInt nmax = 2;
1430:     char   **buffs;
1431:     PetscCall(PetscMalloc1(2, &buffs));
1432:     PetscCall(PetscOptionsGetStringArray(NULL, NULL, "-tellmycell", buffs, &nmax, &flg1));
1433:     if (flg1) {
1434:       PetscCheck(nmax, PETSC_COMM_WORLD, PETSC_ERR_USER, "-tellmycell requires either the phone number or number,\"message\"");
1435:       if (nmax == 1) {
1436:         size_t len = 128;
1437:         PetscCall(PetscMalloc1(len, &buffs[1]));
1438:         PetscCall(PetscGetProgramName(buffs[1], 32));
1439:         PetscCall(PetscStrlcat(buffs[1], " has completed", len));
1440:       }
1441:       PetscCall(PetscTellMyCell(PETSC_COMM_WORLD, buffs[0], buffs[1], NULL));
1442:       PetscCall(PetscFree(buffs[0]));
1443:       PetscCall(PetscFree(buffs[1]));
1444:     }
1445:     PetscCall(PetscFree(buffs));
1446:   }
1447: #endif

1449: #if defined(PETSC_SERIALIZE_FUNCTIONS)
1450:   PetscCall(PetscFPTDestroy());
1451: #endif

1453: #if defined(PETSC_HAVE_SAWS)
1454:   flg = PETSC_FALSE;
1455:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-saw_options", &flg, NULL));
1456:   if (flg) PetscCall(PetscOptionsSAWsDestroy());
1457: #endif

1459: #if defined(PETSC_HAVE_X)
1460:   flg1 = PETSC_FALSE;
1461:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-x_virtual", &flg1, NULL));
1462:   if (flg1) {
1463:     /*  this is a crude hack, but better than nothing */
1464:     PetscCall(PetscPOpen(PETSC_COMM_WORLD, NULL, "pkill -9 Xvfb", "r", NULL));
1465:   }
1466: #endif

1468: #if !defined(PETSC_HAVE_THREADSAFETY)
1469:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_info", &flg2, NULL));
1470:   if (!flg2) {
1471:     flg2 = PETSC_FALSE;
1472:     PetscCall(PetscOptionsGetBool(NULL, NULL, "-memory_view", &flg2, NULL));
1473:   }
1474:   if (flg2) PetscCall(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD, "Summary of Memory Usage in PETSc\n"));
1475: #endif

1477: #if defined(PETSC_USE_LOG)
1478:   flg1 = PETSC_FALSE;
1479:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-get_total_flops", &flg1, NULL));
1480:   if (flg1) {
1481:     PetscLogDouble flops = 0;
1482:     PetscCallMPI(MPI_Reduce(&petsc_TotalFlops, &flops, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
1483:     PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Total flops over all processors %g\n", flops));
1484:   }
1485: #endif

1487: #if defined(PETSC_USE_LOG)
1488:   #if defined(PETSC_HAVE_MPE)
1489:   mname[0] = 0;
1490:   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_mpe", mname, sizeof(mname), &flg1));
1491:   if (flg1) {
1492:     if (mname[0]) PetscCall(PetscLogMPEDump(mname));
1493:     else PetscCall(PetscLogMPEDump(0));
1494:   }
1495:   #endif
1496: #endif

1498:   /*
1499:      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1500:   */
1501:   PetscCall(PetscObjectRegisterDestroyAll());

1503: #if defined(PETSC_USE_LOG)
1504:   PetscCall(PetscOptionsPushGetViewerOff(PETSC_FALSE));
1505:   PetscCall(PetscLogViewFromOptions());
1506:   PetscCall(PetscOptionsPopGetViewerOff());

1508:   mname[0] = 0;
1509:   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_summary", mname, sizeof(mname), &flg1));
1510:   if (flg1) {
1511:     PetscViewer viewer;
1512:     PetscCall((*PetscHelpPrintf)(PETSC_COMM_WORLD, "\n\n WARNING:   -log_summary is being deprecated; switch to -log_view\n\n\n"));
1513:     if (mname[0]) {
1514:       PetscCall(PetscViewerASCIIOpen(PETSC_COMM_WORLD, mname, &viewer));
1515:       PetscCall(PetscLogView(viewer));
1516:       PetscCall(PetscViewerDestroy(&viewer));
1517:     } else {
1518:       viewer = PETSC_VIEWER_STDOUT_WORLD;
1519:       PetscCall(PetscViewerPushFormat(viewer, PETSC_VIEWER_DEFAULT));
1520:       PetscCall(PetscLogView(viewer));
1521:       PetscCall(PetscViewerPopFormat(viewer));
1522:     }
1523:   }

1525:   /*
1526:      Free any objects created by the last block of code.
1527:   */
1528:   PetscCall(PetscObjectRegisterDestroyAll());

1530:   mname[0] = 0;
1531:   PetscCall(PetscOptionsGetString(NULL, NULL, "-log_all", mname, sizeof(mname), &flg1));
1532:   PetscCall(PetscOptionsGetString(NULL, NULL, "-log", mname, sizeof(mname), &flg2));
1533:   if (flg1 || flg2) PetscCall(PetscLogDump(mname));
1534: #endif

1536:   flg1 = PETSC_FALSE;
1537:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-no_signal_handler", &flg1, NULL));
1538:   if (!flg1) PetscCall(PetscPopSignalHandler());
1539:   flg1 = PETSC_FALSE;
1540:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpidump", &flg1, NULL));
1541:   if (flg1) PetscCall(PetscMPIDump(stdout));
1542:   flg1 = PETSC_FALSE;
1543:   flg2 = PETSC_FALSE;
1544:   /* preemptive call to avoid listing this option in options table as unused */
1545:   PetscCall(PetscOptionsHasName(NULL, NULL, "-malloc_dump", &flg1));
1546:   PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1547:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_view", &flg2, NULL));

1549:   if (flg2) {
1550:     PetscViewer viewer;
1551:     PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer));
1552:     PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII));
1553:     PetscCall(PetscOptionsView(NULL, viewer));
1554:     PetscCall(PetscViewerDestroy(&viewer));
1555:   }

1557:   /* to prevent PETSc -options_left from warning */
1558:   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox", &flg1));
1559:   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox_warning", &flg1));

1561:   flg3 = PETSC_FALSE; /* default value is required */
1562:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_left", &flg3, &flg1));
1563:   if (PetscUnlikelyDebug(!flg1)) flg3 = PETSC_TRUE;
1564:   if (flg3) {
1565:     if (!flg2 && flg1) { /* have not yet printed the options */
1566:       PetscViewer viewer;
1567:       PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer));
1568:       PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII));
1569:       PetscCall(PetscOptionsView(NULL, viewer));
1570:       PetscCall(PetscViewerDestroy(&viewer));
1571:     }
1572:     PetscCall(PetscOptionsAllUsed(NULL, &nopt));
1573:     if (nopt) {
1574:       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! There are options you set that were not used!\n"));
1575:       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! could be spelling mistake, etc!\n"));
1576:       if (nopt == 1) {
1577:         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There is one unused database option. It is:\n"));
1578:       } else {
1579:         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are %" PetscInt_FMT " unused database options. They are:\n", nopt));
1580:       }
1581:     } else if (flg3 && flg1) {
1582:       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are no unused options.\n"));
1583:     }
1584:     PetscCall(PetscOptionsLeft(NULL));
1585:   }

1587: #if defined(PETSC_HAVE_SAWS)
1588:   if (!PetscGlobalRank) {
1589:     PetscCall(PetscStackSAWsViewOff());
1590:     PetscCallSAWs(SAWs_Finalize, ());
1591:   }
1592: #endif

1594: #if defined(PETSC_USE_LOG)
1595:   /*
1596:        List all objects the user may have forgot to free
1597:   */
1598:   if (PetscObjectsLog) {
1599:     PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1600:     if (flg1) {
1601:       MPI_Comm local_comm;
1602:       char     string[64];

1604:       PetscCall(PetscOptionsGetString(NULL, NULL, "-objects_dump", string, sizeof(string), NULL));
1605:       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1606:       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1607:       PetscCall(PetscObjectsDump(stdout, (string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE));
1608:       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1609:       PetscCallMPI(MPI_Comm_free(&local_comm));
1610:     }
1611:   }
1612: #endif

1614: #if defined(PETSC_USE_LOG)
1615:   PetscObjectsCounts    = 0;
1616:   PetscObjectsMaxCounts = 0;
1617:   PetscCall(PetscFree(PetscObjects));
1618: #endif

1620:   /*
1621:      Destroy any packages that registered a finalize
1622:   */
1623:   PetscCall(PetscRegisterFinalizeAll());

1625: #if defined(PETSC_USE_LOG)
1626:   PetscCall(PetscLogFinalize());
1627: #endif

1629:   /*
1630:      Print PetscFunctionLists that have not been properly freed
1631:   */
1632:   if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintAll());

1634:   if (petsc_history) {
1635:     PetscCall(PetscCloseHistoryFile(&petsc_history));
1636:     petsc_history = NULL;
1637:   }
1638:   PetscCall(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton));
1639:   PetscCall(PetscInfoDestroy());

1641: #if !defined(PETSC_HAVE_THREADSAFETY)
1642:   if (!(PETSC_RUNNING_ON_VALGRIND)) {
1643:     char  fname[PETSC_MAX_PATH_LEN];
1644:     char  sname[PETSC_MAX_PATH_LEN];
1645:     FILE *fd;
1646:     int   err;

1648:     flg2 = PETSC_FALSE;
1649:     flg3 = PETSC_FALSE;
1650:     if (PetscDefined(USE_DEBUG)) PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_test", &flg2, NULL));
1651:     PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_debug", &flg3, NULL));
1652:     fname[0] = 0;
1653:     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_dump", fname, sizeof(fname), &flg1));
1654:     if (flg1 && fname[0]) {
1655:       PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1656:       fd = fopen(sname, "w");
1657:       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1658:       PetscCall(PetscMallocDump(fd));
1659:       err = fclose(fd);
1660:       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1661:     } else if (flg1 || flg2 || flg3) {
1662:       MPI_Comm local_comm;

1664:       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1665:       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1666:       PetscCall(PetscMallocDump(stdout));
1667:       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1668:       PetscCallMPI(MPI_Comm_free(&local_comm));
1669:     }
1670:     fname[0] = 0;
1671:     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_view", fname, sizeof(fname), &flg1));
1672:     if (flg1 && fname[0]) {
1673:       PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1674:       fd = fopen(sname, "w");
1675:       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1676:       PetscCall(PetscMallocView(fd));
1677:       err = fclose(fd);
1678:       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1679:     } else if (flg1) {
1680:       MPI_Comm local_comm;

1682:       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1683:       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1684:       PetscCall(PetscMallocView(stdout));
1685:       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1686:       PetscCallMPI(MPI_Comm_free(&local_comm));
1687:     }
1688:   }
1689: #endif

1691:   /*
1692:      Close any open dynamic libraries
1693:   */
1694:   PetscCall(PetscFinalize_DynamicLibraries());

1696:   /* Can be destroyed only after all the options are used */
1697:   PetscCall(PetscOptionsDestroyDefault());

1699:   PetscGlobalArgc = 0;
1700:   PetscGlobalArgs = NULL;

1702: #if defined(PETSC_HAVE_KOKKOS)
1703:   if (PetscBeganKokkos) {
1704:     PetscCall(PetscKokkosFinalize_Private());
1705:     PetscBeganKokkos       = PETSC_FALSE;
1706:     PetscKokkosInitialized = PETSC_FALSE;
1707:   }
1708: #endif

1710: #if defined(PETSC_HAVE_NVSHMEM)
1711:   if (PetscBeganNvshmem) {
1712:     PetscCall(PetscNvshmemFinalize());
1713:     PetscBeganNvshmem = PETSC_FALSE;
1714:   }
1715: #endif

1717:   PetscCall(PetscFreeMPIResources());

1719:   /*
1720:      Destroy any known inner MPI_Comm's and attributes pointing to them
1721:      Note this will not destroy any new communicators the user has created.

1723:      If all PETSc objects were not destroyed those left over objects will have hanging references to
1724:      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1725:  */
1726:   {
1727:     PetscCommCounter *counter;
1728:     PetscMPIInt       flg;
1729:     MPI_Comm          icomm;
1730:     union
1731:     {
1732:       MPI_Comm comm;
1733:       void    *ptr;
1734:     } ucomm;
1735:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1736:     if (flg) {
1737:       icomm = ucomm.comm;
1738:       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1739:       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");

1741:       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval));
1742:       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1743:       PetscCallMPI(MPI_Comm_free(&icomm));
1744:     }
1745:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1746:     if (flg) {
1747:       icomm = ucomm.comm;
1748:       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1749:       PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");

1751:       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval));
1752:       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1753:       PetscCallMPI(MPI_Comm_free(&icomm));
1754:     }
1755:   }

1757:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval));
1758:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval));
1759:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval));
1760:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval));
1761:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_CreationIdx_keyval));
1762:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Garbage_HMap_keyval));

1764:   // Free keyvals which may be silently created by some routines
1765:   if (Petsc_SharedWD_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedWD_keyval));
1766:   if (Petsc_SharedTmp_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedTmp_keyval));

1768:   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen));
1769:   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout));
1770:   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr));
1771:   PetscCall(PetscSpinlockDestroy(&PetscCommSpinLock));

1773:   if (PetscBeganMPI) {
1774:     PetscMPIInt flag;
1775:     PetscCallMPI(MPI_Finalized(&flag));
1776:     PetscCheck(!flag, PETSC_COMM_SELF, PETSC_ERR_LIB, "MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1777:     /* wait until the very last moment to disable error handling */
1778:     PetscErrorHandlingInitialized = PETSC_FALSE;
1779:     PetscCallMPI(MPI_Finalize());
1780:   } else PetscErrorHandlingInitialized = PETSC_FALSE;

1782:   /*

1784:      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1785:    the communicator has some outstanding requests on it. Specifically if the
1786:    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1787:    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1788:    is never freed as it should be. Thus one may obtain messages of the form
1789:    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1790:    memory was not freed.

1792: */
1793:   PetscCall(PetscMallocClear());
1794:   PetscCall(PetscStackReset());

1796:   PetscInitializeCalled = PETSC_FALSE;
1797:   PetscFinalizeCalled   = PETSC_TRUE;
1798: #if defined(PETSC_USE_COVERAGE)
1799:   /*
1800:      flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the
1801:      gcov files are still being added to the directories as git tries to remove the directories.
1802:    */
1803:   __gcov_flush();
1804: #endif
1805:   /* To match PetscFunctionBegin() at the beginning of this function */
1806:   PetscStackClearTop;
1807:   return PETSC_SUCCESS;
1808: }

1810: #if defined(PETSC_MISSING_LAPACK_lsame_)
1811: PETSC_EXTERN int lsame_(char *a, char *b)
1812: {
1813:   if (*a == *b) return 1;
1814:   if (*a + 32 == *b) return 1;
1815:   if (*a - 32 == *b) return 1;
1816:   return 0;
1817: }
1818: #endif

1820: #if defined(PETSC_MISSING_LAPACK_lsame)
1821: PETSC_EXTERN int lsame(char *a, char *b)
1822: {
1823:   if (*a == *b) return 1;
1824:   if (*a + 32 == *b) return 1;
1825:   if (*a - 32 == *b) return 1;
1826:   return 0;
1827: }
1828: #endif