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 <petsc/private/logimpl.h>
  7: #include <petsc/private/garbagecollector.h>
  8: #include <petscpkg_version.h>

 10: #if !PetscDefined(HAVE_WINDOWS_COMPILERS)
 11: #include <petsc/private/valgrind/valgrind.h>
 12: #endif

 14: #if PetscDefined(USE_FORTRAN_BINDINGS)
 15: #include <petsc/private/ftnimpl.h>
 16: #endif

 18: #if PetscDefined(USE_COVERAGE)
 19: EXTERN_C_BEGIN
 20:   #if PetscDefined(HAVE___GCOV_DUMP)
 22:   #endif
 23: void __gcov_flush(void);
 24: EXTERN_C_END
 25: #endif

 27: #if PetscDefined(HAVE_SAWS)
 28: #include <petscviewersaws.h>
 29: #endif

 31: /*
 32:    Perform various sanity checks that the correct mpi.h is being included at compile time.
 33:    This usually happens because
 34:       * either an unexpected mpi.h is in the default compiler path (i.e. in /usr/include) or
 35:       * an extra include path -I/something (which contains the unexpected mpi.h) is being passed to the compiler
 36:    Note: with MPICH and OpenMPI, accept versions [x.y.z, x+1.0.0) as compatible
 37: */
 38: #if PetscDefined(HAVE_MPIUNI)
 39:   #if !defined(MPIUNI_H)
 40:     #error "PETSc was configured with --with-mpi=0 but now appears to be compiling using a different mpi.h"
 41:   #endif
 42: #elif PetscDefined(HAVE_I_MPI)
 43:   #if !defined(I_MPI_NUMVERSION)
 44:     #error "PETSc was configured with I_MPI but now appears to be compiling using a non-I_MPI mpi.h"
 45:   #elif I_MPI_NUMVERSION != PETSC_PKG_I_MPI_NUMVERSION
 46:     #error "PETSc was configured with one I_MPI mpi.h version but now appears to be compiling using a different I_MPI mpi.h version"
 47:   #endif
 48: #elif PetscDefined(HAVE_MVAPICH2)
 49:   #if !defined(MVAPICH2_NUMVERSION)
 50:     #error "PETSc was configured with MVAPICH2 but now appears to be compiling using a non-MVAPICH2 mpi.h"
 51:   #elif MVAPICH2_NUMVERSION != PETSC_PKG_MVAPICH2_NUMVERSION
 52:     #error "PETSc was configured with one MVAPICH2 mpi.h version but now appears to be compiling using a different MVAPICH2 mpi.h version"
 53:   #endif
 54: #elif PetscDefined(HAVE_MPICH)
 55:   #if !defined(MPICH_NUMVERSION) || defined(MVAPICH2_NUMVERSION) || defined(I_MPI_NUMVERSION)
 56:     #error "PETSc was configured with MPICH but now appears to be compiling using a non-MPICH mpi.h"
 57:   #elif PETSC_PKG_MPICH_VERSION_GT(MPICH_NUMVERSION / 10000000, MPICH_NUMVERSION / 100000 % 100, MPICH_NUMVERSION / 1000 % 100)
 58:     #error "PETSc was configured with one MPICH mpi.h version but now appears to be compiling using an older MPICH mpi.h version"
 59:   #elif PETSC_PKG_MPICH_VERSION_LT(MPICH_NUMVERSION / 10000000, 0, 0)
 60:     #error "PETSc was configured with one MPICH mpi.h version but now appears to be compiling using a newer major MPICH mpi.h version"
 61:   #endif
 62: #elif PetscDefined(HAVE_OPENMPI)
 63:   #if !defined(OMPI_MAJOR_VERSION)
 64:     #error "PETSc was configured with Open MPI but now appears to be compiling using a non-Open MPI mpi.h"
 65:   #elif PETSC_PKG_OPENMPI_VERSION_GT(OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION, OMPI_RELEASE_VERSION)
 66:     #error "PETSc was configured with one Open MPI mpi.h version but now appears to be compiling using an older Open MPI mpi.h version"
 67:   #elif PETSC_PKG_OPENMPI_VERSION_LT(OMPI_MAJOR_VERSION, 0, 0)
 68:     #error "PETSc was configured with one Open MPI mpi.h version but now appears to be compiling using a newer major Open MPI mpi.h version"
 69:   #endif
 70: #elif defined(PETSC_HAVE_MSMPI_VERSION)
 71:   #if !defined(MSMPI_VER)
 72:     #error "PETSc was configured with MSMPI but now appears to be compiling using a non-MSMPI mpi.h"
 73:   #elif (MSMPI_VER != PETSC_HAVE_MSMPI_VERSION)
 74:     #error "PETSc was configured with one MSMPI mpi.h version but now appears to be compiling using a different MSMPI mpi.h version"
 75:   #endif
 76: #elif defined(OMPI_MAJOR_VERSION) || defined(MPICH_NUMVERSION) || defined(MSMPI_VER)
 77:   #error "PETSc was configured with undetermined MPI - but now appears to be compiling using any of Open MPI, MS-MPI or a MPICH variant"
 78: #endif

 80: PETSC_INTERN FILE *petsc_history;

 82: PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void);
 83: PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void);
 84: PETSC_INTERN PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm, int);
 85: PETSC_INTERN PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm, int);
 86: PETSC_INTERN PetscErrorCode PetscCloseHistoryFile(FILE **);

 88: /* user may set these BEFORE calling PetscInitialize() */
 89: MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL;
 90: #if PetscDefined(HAVE_MPI_INIT_THREAD)
 91: PetscMPIInt PETSC_MPI_THREAD_REQUIRED = PETSC_DECIDE;
 92: #else
 93: PetscMPIInt PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_SINGLE;
 94: #endif

 96: PetscMPIInt Petsc_Counter_keyval      = MPI_KEYVAL_INVALID;
 97: PetscMPIInt Petsc_InnerComm_keyval    = MPI_KEYVAL_INVALID;
 98: PetscMPIInt Petsc_OuterComm_keyval    = MPI_KEYVAL_INVALID;
 99: PetscMPIInt Petsc_ShmComm_keyval      = MPI_KEYVAL_INVALID;
100: PetscMPIInt Petsc_CreationIdx_keyval  = MPI_KEYVAL_INVALID;
101: PetscMPIInt Petsc_Garbage_HMap_keyval = MPI_KEYVAL_INVALID;

103: PetscMPIInt Petsc_SharedWD_keyval  = MPI_KEYVAL_INVALID;
104: PetscMPIInt Petsc_SharedTmp_keyval = MPI_KEYVAL_INVALID;

106: /*
107:      Declare and set all the string names of the PETSc enums
108: */
109: const char *const PetscBools[]     = {"FALSE", "TRUE", "PetscBool", "PETSC_", NULL};
110: const char *const PetscBool3s[]    = {"FALSE", "TRUE", "UNKNOWN", "PetscBool3", "PETSC_", NULL};
111: const char *const PetscCopyModes[] = {"COPY_VALUES", "OWN_POINTER", "USE_POINTER", "PetscCopyMode", "PETSC_", NULL};

113: #include <petscpreload.h>
114: PetscBool PetscPreLoadingUsed = PETSC_FALSE;
115: PetscBool PetscPreLoadingOn   = PETSC_FALSE;

117: PetscInt PetscHotRegionDepth;

119: PetscBool PETSC_RUNNING_ON_VALGRIND = PETSC_FALSE;

121: #if PetscDefined(HAVE_THREADSAFETY)
122: PetscSpinlock PetscViewerASCIISpinLockOpen;
123: PetscSpinlock PetscViewerASCIISpinLockStdout;
124: PetscSpinlock PetscViewerASCIISpinLockStderr;
125: PetscSpinlock PetscCommSpinLock;
126: #endif

128: extern PetscInt PetscNumBLASThreads;

130: /*@
131:   PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args

133:   Collective, No Fortran Support

135:   Input Parameters:
136: + argc     - number of args
137: . args     - array of command line arguments
138: . filename - optional name of the program file, pass `NULL` to ignore
139: - help     - optional help, pass `NULL` to ignore

141:   Level: advanced

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

148:   Developer Notes:
149:   Turns off PETSc signal handling to allow Julia to manage signals

151: .seealso: `PetscInitialize()`, `PetscInitializeFortran()`, `PetscInitializeNoArguments()`
152: @*/
153: PetscErrorCode PetscInitializeNoPointers(int argc, char **args, const char *filename, const char *help)
154: {
155:   int    myargc = argc;
156:   char **myargs = args;

158:   PetscFunctionBegin;
159:   PetscCall(PetscInitialize(&myargc, &myargs, filename, help));
160:   PetscCall(PetscPopSignalHandler());
161:   PetscBeganMPI = PETSC_FALSE;
162:   PetscFunctionReturn(PETSC_SUCCESS);
163: }

165: /*@
166:   PetscInitializeNoArguments - Calls `PetscInitialize()` from C/C++ without
167:   the command line arguments.

169:   Collective

171:   Level: advanced

173: .seealso: `PetscInitialize()`, `PetscInitializeFortran()`
174: @*/
175: PetscErrorCode PetscInitializeNoArguments(void) PeNS
176: {
177:   int    argc = 0;
178:   char **args = NULL;

180:   PetscFunctionBegin;
181:   PetscCall(PetscInitialize(&argc, &args, NULL, NULL));
182:   PetscFunctionReturn(PETSC_SUCCESS);
183: }

185: /*@
186:   PetscInitialized - Determine whether PETSc is initialized.

188:   Output Parameter:
189: . isInitialized - `PETSC_TRUE` if PETSc is initialized, `PETSC_FALSE` otherwise

191:   Level: beginner

193: .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
194: @*/
195: PetscErrorCode PetscInitialized(PetscBool *isInitialized)
196: {
197:   PetscFunctionBegin;
198:   if (PetscInitializeCalled) PetscAssertPointer(isInitialized, 1);
199:   *isInitialized = PetscInitializeCalled;
200:   PetscFunctionReturn(PETSC_SUCCESS);
201: }

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

206:   Output Parameter:
207: . isFinalized - `PETSC_TRUE` if PETSc is finalized, `PETSC_FALSE` otherwise

209:   Level: developer

211: .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
212: @*/
213: PetscErrorCode PetscFinalized(PetscBool *isFinalized)
214: {
215:   PetscFunctionBegin;
216:   if (!PetscFinalizeCalled) PetscAssertPointer(isFinalized, 1);
217:   *isFinalized = PetscFinalizeCalled;
218:   PetscFunctionReturn(PETSC_SUCCESS);
219: }

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

223: /*
224:        This function is the MPI reduction operation used to compute the sum of the
225:    first half of the datatype and the max of the second half.
226: */
227: MPI_Op MPIU_MAXSUM_OP               = 0;
228: MPI_Op Petsc_Garbage_SetIntersectOp = 0;

230: PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
231: {
232:   PetscFunctionBegin;
233:   if (*datatype == MPIU_INT_MPIINT && PetscDefined(USE_64BIT_INDICES)) {
234: #if PetscDefined(USE_64BIT_INDICES)
235:     struct petsc_mpiu_int_mpiint *xin = (struct petsc_mpiu_int_mpiint *)in, *xout = (struct petsc_mpiu_int_mpiint *)out;
236:     PetscMPIInt                   count = *cnt;

238:     for (PetscMPIInt i = 0; i < count; i++) {
239:       xout[i].a = PetscMax(xout[i].a, xin[i].a);
240:       xout[i].b += xin[i].b;
241:     }
242: #endif
243:   } else if (*datatype == MPIU_2INT || *datatype == MPIU_INT_MPIINT) {
244:     PetscInt   *xin = (PetscInt *)in, *xout = (PetscInt *)out;
245:     PetscMPIInt count = *cnt;

247:     for (PetscMPIInt i = 0; i < count; i++) {
248:       xout[2 * i] = PetscMax(xout[2 * i], xin[2 * i]);
249:       xout[2 * i + 1] += xin[2 * i + 1];
250:     }
251:   } else {
252:     PetscErrorCode ierr = (*PetscErrorPrintf)("Can only handle MPIU_2INT and MPIU_INT_MPIINT data types");
253:     (void)ierr;
254:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
255:   }
256:   PetscFunctionReturnVoid();
257: }

259: /*@
260:   PetscMaxSum - Returns the max of the first entry over all MPI processes and the sum of the second entry.

262:   Collective

264:   Input Parameters:
265: + comm  - the communicator
266: - array - an arry of length 2 times `size`, the number of MPI processes

268:   Output Parameters:
269: + max - the maximum of `array[2*rank]` over all MPI processes
270: - sum - the sum of the `array[2*rank + 1]` over all MPI processes

272:   Level: developer

274: .seealso: `PetscInitialize()`
275: @*/
276: PetscErrorCode PetscMaxSum(MPI_Comm comm, const PetscInt array[], PetscInt *max, PetscInt *sum)
277: {
278:   PetscFunctionBegin;
279: #if PetscDefined(HAVE_MPI_REDUCE_SCATTER_BLOCK)
280:   {
281:     struct {
282:       PetscInt max, sum;
283:     } work;
284:     PetscCallMPI(MPI_Reduce_scatter_block((void *)array, &work, 1, MPIU_2INT, MPIU_MAXSUM_OP, comm));
285:     *max = work.max;
286:     *sum = work.sum;
287:   }
288: #else
289:   {
290:     PetscMPIInt size, rank;
291:     struct {
292:       PetscInt max, sum;
293:     } *work;
294:     PetscCallMPI(MPI_Comm_size(comm, &size));
295:     PetscCallMPI(MPI_Comm_rank(comm, &rank));
296:     PetscCall(PetscMalloc1(size, &work));
297:     PetscCallMPI(MPIU_Allreduce((void *)array, work, size, MPIU_2INT, MPIU_MAXSUM_OP, comm));
298:     *max = work[rank].max;
299:     *sum = work[rank].sum;
300:     PetscCall(PetscFree(work));
301:   }
302: #endif
303:   PetscFunctionReturn(PETSC_SUCCESS);
304: }

306: #if (PetscDefined(HAVE_REAL___FLOAT128) && !PetscDefined(SKIP_REAL___FLOAT128)) || (PetscDefined(HAVE_REAL___FP16) && !PetscDefined(SKIP_REAL___FP16))
307:   #if PetscDefined(HAVE_REAL___FLOAT128) && !PetscDefined(SKIP_REAL___FLOAT128)
308:     #include <quadmath.h>
309:   #endif
310: MPI_Op MPIU_SUM___FP16___FLOAT128 = 0;
311:   #if PetscDefined(USE_REAL___FLOAT128) || PetscDefined(USE_REAL___FP16)
312: MPI_Op MPIU_SUM = 0;
313:   #endif

315: PETSC_EXTERN void MPIAPI PetscSum_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
316: {
317:   PetscMPIInt i, count = *cnt;

319:   PetscFunctionBegin;
320:   if (*datatype == MPIU_REAL) {
321:     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
322:     for (i = 0; i < count; i++) xout[i] += xin[i];
323:   }
324:   #if PetscDefined(HAVE_COMPLEX)
325:   else if (*datatype == MPIU_COMPLEX) {
326:     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
327:     for (i = 0; i < count; i++) xout[i] += xin[i];
328:   }
329:   #endif
330:   #if PetscDefined(HAVE_REAL___FLOAT128) && !PetscDefined(SKIP_REAL___FLOAT128)
331:   else if (*datatype == MPIU___FLOAT128) {
332:     __float128 *xin = (__float128 *)in, *xout = (__float128 *)out;
333:     for (i = 0; i < count; i++) xout[i] += xin[i];
334:     #if PetscDefined(HAVE_COMPLEX)
335:   } else if (*datatype == MPIU___COMPLEX128) {
336:     __complex128 *xin = (__complex128 *)in, *xout = (__complex128 *)out;
337:     for (i = 0; i < count; i++) xout[i] += xin[i];
338:     #endif
339:   }
340:   #endif
341:   #if PetscDefined(HAVE_REAL___FP16) && !PetscDefined(SKIP_REAL___FP16)
342:   else if (*datatype == MPIU___FP16) {
343:     __fp16 *xin = (__fp16 *)in, *xout = (__fp16 *)out;
344:     for (i = 0; i < count; i++) xout[i] = (__fp16)(xin[i] + xout[i]);
345:   }
346:   #endif
347:   else {
348:   #if (!PetscDefined(HAVE_REAL___FLOAT128) || PetscDefined(SKIP_REAL___FLOAT128)) && (!PetscDefined(HAVE_REAL___FP16) || PetscDefined(SKIP_REAL___FP16))
349:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
350:   #elif !PetscDefined(HAVE_REAL___FP16) || PetscDefined(SKIP_REAL___FP16)
351:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, or MPIU___COMPLEX128 data types"));
352:   #elif !PetscDefined(HAVE_REAL___FLOAT128) || PetscDefined(SKIP_REAL___FLOAT128)
353:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, or MPIU___FP16 data types"));
354:   #else
355:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, MPIU___COMPLEX128, or MPIU___FP16 data types"));
356:   #endif
357:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
358:   }
359:   PetscFunctionReturnVoid();
360: }
361: #endif

363: #if PetscDefined(USE_REAL___FLOAT128) || PetscDefined(USE_REAL___FP16)
364: MPI_Op MPIU_MAX = 0;
365: MPI_Op MPIU_MIN = 0;

367: PETSC_EXTERN void MPIAPI PetscMax_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
368: {
369:   PetscInt i, count = *cnt;

371:   PetscFunctionBegin;
372:   if (*datatype == MPIU_REAL) {
373:     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
374:     for (i = 0; i < count; i++) xout[i] = PetscMax(xout[i], xin[i]);
375:   }
376:   #if PetscDefined(HAVE_COMPLEX)
377:   else if (*datatype == MPIU_COMPLEX) {
378:     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
379:     for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) < PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
380:   }
381:   #endif
382:   else {
383:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
384:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
385:   }
386:   PetscFunctionReturnVoid();
387: }

389: PETSC_EXTERN void MPIAPI PetscMin_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
390: {
391:   PetscInt i, count = *cnt;

393:   PetscFunctionBegin;
394:   if (*datatype == MPIU_REAL) {
395:     PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
396:     for (i = 0; i < count; i++) xout[i] = PetscMin(xout[i], xin[i]);
397:   }
398:   #if PetscDefined(HAVE_COMPLEX)
399:   else if (*datatype == MPIU_COMPLEX) {
400:     PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
401:     for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) > PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
402:   }
403:   #endif
404:   else {
405:     PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"));
406:     PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
407:   }
408:   PetscFunctionReturnVoid();
409: }
410: #endif

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

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

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

419: */
420: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_Counter_Attr_DeleteFn(MPI_Comm comm, PetscMPIInt keyval, void *count_val, void *extra_state)
421: {
422:   PetscCommCounter      *counter = (PetscCommCounter *)count_val;
423:   struct PetscCommStash *comms   = counter->comms, *pcomm;

425:   PetscFunctionBegin;
426:   PetscCallReturnMPI(PetscInfo(NULL, "Deleting counter data in an MPI_Comm %ld\n", (long)comm));
427:   PetscCallReturnMPI(PetscFree(counter->iflags));
428:   while (comms) {
429:     PetscCallMPIReturnMPI(MPI_Comm_free(&comms->comm));
430:     pcomm = comms;
431:     comms = comms->next;
432:     PetscCallReturnMPI(PetscFree(pcomm));
433:   }
434:   PetscCallReturnMPI(PetscFree(counter));
435:   PetscFunctionReturn(MPI_SUCCESS);
436: }

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

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

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

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

448: */
449: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_InnerComm_Attr_DeleteFn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
450: {
451:   union
452:   {
453:     MPI_Comm comm;
454:     void    *ptr;
455:   } icomm;

457:   PetscFunctionBegin;
458:   PetscCheckReturnMPI(keyval == Petsc_InnerComm_keyval, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Unexpected keyval");
459:   icomm.ptr = attr_val;
460:   if (PetscDefined(USE_DEBUG)) {
461:     /* Error out if the inner/outer comms are not correctly linked through their Outer/InnterComm attributes */
462:     PetscMPIInt flg;
463:     union
464:     {
465:       MPI_Comm comm;
466:       void    *ptr;
467:     } ocomm;
468:     PetscCallMPIReturnMPI(MPI_Comm_get_attr(icomm.comm, Petsc_OuterComm_keyval, &ocomm, &flg));
469:     PetscCheckReturnMPI(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm does not have OuterComm attribute");
470:     PetscCheckReturnMPI(ocomm.comm == comm, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm's OuterComm attribute does not point to outer PETSc comm");
471:   }
472:   PetscCallMPIReturnMPI(MPI_Comm_delete_attr(icomm.comm, Petsc_OuterComm_keyval));
473:   PetscCallReturnMPI(PetscInfo(NULL, "User MPI_Comm %ld is being unlinked from inner PETSc comm %ld\n", (long)comm, (long)icomm.comm));
474:   PetscFunctionReturn(MPI_SUCCESS);
475: }

477: /*
478:  * This is invoked on the inner comm when Petsc_InnerComm_Attr_DeleteFn calls MPI_Comm_delete_attr().  It should not be reached any other way.
479:  */
480: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_OuterComm_Attr_DeleteFn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
481: {
482:   PetscFunctionBegin;
483:   PetscCallReturnMPI(PetscInfo(NULL, "Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n", (long)comm));
484:   PetscFunctionReturn(MPI_SUCCESS);
485: }

487: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_ShmComm_Attr_DeleteFn(MPI_Comm, PetscMPIInt, void *, void *);

489: #if PetscDefined(USE_PETSC_MPI_EXTERNAL32)
490: PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype, MPI_Aint *, void *);
491: PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
492: PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
493: #endif

495: PetscMPIInt PETSC_MPI_ERROR_CLASS = MPI_ERR_LASTCODE, PETSC_MPI_ERROR_CODE;

497: PETSC_INTERN int    PetscGlobalArgc;
498: PETSC_INTERN char **PetscGlobalArgs, **PetscGlobalArgsFortran;
499: int                 PetscGlobalArgc        = 0;
500: char              **PetscGlobalArgs        = NULL;
501: char              **PetscGlobalArgsFortran = NULL;

503: static PetscSegBuffer PetscCitationsList;

505: /*@
506:   PetscCitationsRegister - Register a bibtex item to obtain credit for an implemented algorithm used in the code.

508:   Not Collective; No Fortran Support

510:   Input Parameters:
511: + cite - the bibtex item, formatted to displayed on multiple lines nicely
512: - set  - a boolean variable initially set to `PETSC_FALSE`; this is used to insure only a single registration of the citation

514:   Options Database Key:
515: . -citations [filename] - print out the bibtex entries for the given computation

517:   Level: intermediate

519: .seealso: `PetscFinalize()`
520: @*/
521: PetscErrorCode PetscCitationsRegister(const char cite[], PetscBool *set)
522: {
523:   size_t len;
524:   char  *vstring;

526:   PetscFunctionBegin;
527:   if (set && *set) PetscFunctionReturn(PETSC_SUCCESS);
528:   PetscCall(PetscStrlen(cite, &len));
529:   PetscCall(PetscSegBufferGet(PetscCitationsList, (PetscCount)len, &vstring));
530:   PetscCall(PetscArraycpy(vstring, cite, len));
531:   if (set) *set = PETSC_TRUE;
532:   PetscFunctionReturn(PETSC_SUCCESS);
533: }

535: PetscErrorCode PetscCitationsInitialize(void)
536: {
537:   PetscFunctionBegin;
538:   PetscCall(PetscSegBufferCreate(1, 10000, &PetscCitationsList));

540:   PetscCall(PetscCitationsRegister("@TechReport{petsc-user-ref,\n\
541:   Author = {Satish Balay and Shrirang Abhyankar and Mark~F. Adams and Steven Benson and Jed Brown\n\
542:     and Peter Brune and Kris Buschelman and Emil~M. Constantinescu and Lisandro Dalcin and Alp Dener\n\
543:     and Victor Eijkhout and Jacob Faibussowitsch and William~D. Gropp and V\'{a}clav Hapla and Tobin Isaac and Pierre Jolivet\n\
544:     and Dmitry Karpeev and Dinesh Kaushik and Matthew~G. Knepley and Fande Kong and Scott Kruger\n\
545:     and Dave~A. May and Lois Curfman McInnes and Richard Tran Mills and Lawrence Mitchell and Todd Munson\n\
546:     and Jose~E. Roman and Karl Rupp and Patrick Sanan and Jason Sarich and Barry~F. Smith and Hansol Suh\n\
547:     and Stefano Zampini and Hong Zhang and Hong Zhang and Junchao Zhang},\n\
548:   Title = {{PETSc/TAO} Users Manual},\n\
549:   Number = {ANL-21/39 - Revision 3.26},\n\
550:   Doi = {10.2172/17154913},\n\
551:   Institution = {Argonne National Laboratory},\n\
552:   Year = {2026}\n}\n",
553:                                    NULL));

555:   PetscCall(PetscCitationsRegister("@InProceedings{petsc-efficient,\n\
556:   Author = {Satish Balay and William D. Gropp and Lois Curfman McInnes and Barry F. Smith},\n\
557:   Title = {Efficient Management of Parallelism in Object Oriented Numerical Software Libraries},\n\
558:   Booktitle = {Modern Software Tools in Scientific Computing},\n\
559:   Editor = {E. Arge and A. M. Bruaset and H. P. Langtangen},\n\
560:   Pages = {163--202},\n\
561:   Publisher = {Birkh{\\\"{a}}user Press},\n\
562:   Year = {1997}\n}\n",
563:                                    NULL));
564:   PetscFunctionReturn(PETSC_SUCCESS);
565: }

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

569: /*@
570:   PetscSetProgramName - Set the program name reported by `PetscGetProgramName()`

572:   Not Collective

574:   Input Parameter:
575: . name - the program name to record

577:   Level: developer

579:   Note:
580:   The program name is normally set automatically by `PetscInitialize()` from `argv[0]`; only call this directly when the
581:   detected name is incorrect (for example when PETSc is embedded in a host application).

583: .seealso: `PetscGetProgramName()`, `PetscInitialize()`
584: @*/
585: PetscErrorCode PetscSetProgramName(const char name[])
586: {
587:   PetscFunctionBegin;
588:   PetscCall(PetscStrncpy(programname, name, sizeof(programname)));
589:   PetscFunctionReturn(PETSC_SUCCESS);
590: }

592: /*@
593:   PetscGetProgramName - Gets the name of the running program.

595:   Not Collective

597:   Input Parameter:
598: . len - length of the string name

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

603:   Level: advanced

605: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArguments()`, `PetscInitialize()`
606: @*/
607: PetscErrorCode PetscGetProgramName(char name[], size_t len)
608: {
609:   PetscFunctionBegin;
610:   PetscCall(PetscStrncpy(name, programname, len));
611:   PetscFunctionReturn(PETSC_SUCCESS);
612: }

614: /*@
615:   PetscGetArgs - Allows you to access the raw command line arguments anywhere
616:   after `PetscInitialize()` is called but before `PetscFinalize()`.

618:   Not Collective, No Fortran Support

620:   Output Parameters:
621: + argc - count of the number of command line arguments
622: - args - the command line arguments

624:   Level: intermediate

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

630:   The first argument contains the program name as is normal for C programs.

632:   See `PetscGetArguments()` for a variant of this routine.

634: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArguments()`, `PetscInitialize()`
635: @*/
636: PetscErrorCode PetscGetArgs(int *argc, char ***args)
637: {
638:   PetscFunctionBegin;
639:   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
640:   *argc = PetscGlobalArgc;
641:   *args = PetscGlobalArgs;
642:   PetscFunctionReturn(PETSC_SUCCESS);
643: }

645: /*@
646:   PetscGetArguments - Allows you to access the command line arguments anywhere
647:   after `PetscInitialize()` is called but before `PetscFinalize()`.

649:   Not Collective, No Fortran Support

651:   Output Parameter:
652: . args - the command line arguments

654:   Level: intermediate

656:   Note:
657:   This does NOT start with the program name and IS `NULL` terminated (the final argument is `void`)

659:   Use `PetscFreeArguments()` to return the memory used by the arguments.

661:   This makes a copy of the arguments and the array of arguments, while `PetscGetArgs()` does not make a copy,
662:   it returns the array of arguments that was passed into the main program.

664: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscFreeArguments()`, `PetscInitialize()`
665: @*/
666: PetscErrorCode PetscGetArguments(char ***args)
667: {
668:   PetscInt i, argc = PetscGlobalArgc;

670:   PetscFunctionBegin;
671:   PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
672:   if (!argc) {
673:     *args = NULL;
674:     PetscFunctionReturn(PETSC_SUCCESS);
675:   }
676:   PetscCall(PetscMalloc1(argc, args));
677:   for (i = 0; i < argc - 1; i++) PetscCall(PetscStrallocpy(PetscGlobalArgs[i + 1], &(*args)[i]));
678:   (*args)[argc - 1] = NULL;
679:   PetscFunctionReturn(PETSC_SUCCESS);
680: }

682: /*@
683:   PetscFreeArguments - Frees the memory obtained with `PetscGetArguments()`

685:   Not Collective, No Fortran Support

687:   Output Parameter:
688: . args - the command line arguments

690:   Level: intermediate

692:   Developer Note:
693:   This should be PetscRestoreArguments()

695: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscGetArguments()`
696: @*/
697: PetscErrorCode PetscFreeArguments(char **args)
698: {
699:   PetscFunctionBegin;
700:   if (args) {
701:     PetscInt i = 0;

703:     while (args[i]) PetscCall(PetscFree(args[i++]));
704:     PetscCall(PetscFree(args));
705:   }
706:   PetscFunctionReturn(PETSC_SUCCESS);
707: }

709: #if PetscDefined(HAVE_SAWS)
710:   #include <petscconfiginfo.h>

712: PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char help[])
713: {
714:   PetscFunctionBegin;
715:   if (!PetscGlobalRank) {
716:     char      cert[PETSC_MAX_PATH_LEN], root[PETSC_MAX_PATH_LEN], *intro, programname[64], *appline, *options, version[64];
717:     int       port;
718:     PetscBool flg, rootlocal = PETSC_FALSE, flg2, selectport = PETSC_FALSE;
719:     size_t    applinelen, introlen;
720:     char      sawsurl[256];

722:     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_log", &flg));
723:     if (flg) {
724:       char sawslog[PETSC_MAX_PATH_LEN];

726:       PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_log", sawslog, sizeof(sawslog), NULL));
727:       if (sawslog[0]) PetscCallSAWs(SAWs_Set_Use_Logfile, sawslog);
728:       else PetscCallSAWs(SAWs_Set_Use_Logfile, NULL);
729:     }
730:     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_https", cert, sizeof(cert), &flg));
731:     if (flg) PetscCallSAWs(SAWs_Set_Use_HTTPS, cert);
732:     PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select", &selectport, NULL));
733:     if (selectport) {
734:       PetscCallSAWs(SAWs_Get_Available_Port, &port);
735:       PetscCallSAWs(SAWs_Set_Port, port);
736:     } else {
737:       PetscCall(PetscOptionsGetInt(NULL, NULL, "-saws_port", &port, &flg));
738:       if (flg) PetscCallSAWs(SAWs_Set_Port, port);
739:     }
740:     PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_root", root, sizeof(root), &flg));
741:     if (flg) {
742:       PetscCallSAWs(SAWs_Set_Document_Root, root);
743:       PetscCall(PetscStrcmp(root, ".", &rootlocal));
744:     } else {
745:       PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_options", &flg));
746:       if (flg) {
747:         PetscCall(PetscStrreplace(PETSC_COMM_WORLD, "${PETSC_DIR}/share/petsc/saws", root, sizeof(root)));
748:         PetscCallSAWs(SAWs_Set_Document_Root, root);
749:       }
750:     }
751:     PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_local", &flg2));
752:     if (flg2) {
753:       char jsdir[PETSC_MAX_PATH_LEN];
754:       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_SUP, "-saws_local option requires -saws_root option");
755:       PetscCall(PetscSNPrintf(jsdir, sizeof(jsdir), "%s/js", root));
756:       PetscCall(PetscTestDirectory(jsdir, 'r', &flg));
757:       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "-saws_local option requires js directory in root directory");
758:       PetscCallSAWs(SAWs_Push_Local_Header, );
759:     }
760:     PetscCall(PetscGetProgramName(programname, sizeof(programname)));
761:     PetscCall(PetscStrlen(help, &applinelen));
762:     introlen = 4096 + applinelen;
763:     applinelen += 1024;
764:     PetscCall(PetscMalloc(applinelen, &appline));
765:     PetscCall(PetscMalloc(introlen, &intro));

767:     if (rootlocal) {
768:       PetscCall(PetscSNPrintf(appline, applinelen, "%s.c.html", programname));
769:       PetscCall(PetscTestFile(appline, 'r', &rootlocal));
770:     }
771:     PetscCall(PetscOptionsGetAll(NULL, &options));
772:     if (rootlocal && help) {
773:       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));
774:     } else if (help) {
775:       PetscCall(PetscSNPrintf(appline, applinelen, "<center>Running %s %s</center><br><center><pre>%s</pre></center><br>", programname, options, help));
776:     } else {
777:       PetscCall(PetscSNPrintf(appline, applinelen, "<center> Running %s %s</center><br>\n", programname, options));
778:     }
779:     PetscCall(PetscFree(options));
780:     PetscCall(PetscGetVersion(version, sizeof(version)));
781:     PetscCall(PetscSNPrintf(intro, introlen,
782:                             "<body>\n"
783:                             "<center><h2> <a href=\"https://petsc.org/\">PETSc</a> Application Web server powered by <a href=\"https://gitlab.com/petsc/saws\">SAWs</a> </h2></center>\n"
784:                             "<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"
785:                             "%s",
786:                             version, petscconfigureoptions, appline));
787:     PetscCallSAWs(SAWs_Push_Body, "index.html", 0, intro);
788:     PetscCall(PetscFree(intro));
789:     PetscCall(PetscFree(appline));
790:     if (selectport) {
791:       PetscBool silent;

793:       /* another process may have grabbed the port so keep trying */
794:       while (SAWs_Initialize()) {
795:         PetscCallSAWs(SAWs_Get_Available_Port, &port);
796:         PetscCallSAWs(SAWs_Set_Port, port);
797:       }

799:       PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select_silent", &silent, NULL));
800:       if (!silent) {
801:         PetscCallSAWs(SAWs_Get_FullURL, sizeof(sawsurl), sawsurl);
802:         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Point your browser to %s for SAWs\n", sawsurl));
803:       }
804:     } else {
805:       PetscCallSAWs(SAWs_Initialize, );
806:     }
807:     PetscCall(PetscCitationsRegister("@TechReport{ saws,\n"
808:                                      "  Author = {Matt Otten and Jed Brown and Barry Smith},\n"
809:                                      "  Title  = {Scientific Application Web Server (SAWs) Users Manual},\n"
810:                                      "  Institution = {Argonne National Laboratory},\n"
811:                                      "  Year   = 2013\n}\n",
812:                                      NULL));
813:   }
814:   PetscFunctionReturn(PETSC_SUCCESS);
815: }
816: #endif

818: /* Things must be done before MPI_Init() when MPI is not yet initialized, and can be shared between C init and Fortran init */
819: PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(void)
820: {
821:   PetscFunctionBegin;
822: #if PetscDefined(HAVE_HWLOC_SOLARIS_BUG)
823:   /* see MPI.py for details on this bug */
824:   (void)setenv("HWLOC_COMPONENTS", "-x86", 1);
825: #endif
826:   PetscFunctionReturn(PETSC_SUCCESS);
827: }

829: #if PetscDefined(HAVE_ADIOS)
830:   #include <adios.h>
831:   #include <adios_read.h>
832: int64_t Petsc_adios_group;
833: #endif
834: #if PetscDefined(HAVE_OPENMP)
835:   #include <omp.h>
836: PetscInt PetscNumOMPThreads;
837: #endif

839: #include <petsc/private/deviceimpl.h>
840: #if PetscDefined(HAVE_CUDA)
841: #include <petscdevice_cuda.h>
842: // REMOVE ME
843: cudaStream_t PetscDefaultCudaStream = NULL;
844: #endif
845: #if PetscDefined(HAVE_HIP)
846: #include <petscdevice_hip.h>
847: // REMOVE ME
848: hipStream_t PetscDefaultHipStream = NULL;
849: #endif

851: #if PetscDefined(HAVE_DLFCN_H)
852:   #include <dlfcn.h>
853: #endif
854: PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
855: #if PetscDefined(HAVE_VIENNACL)
856: PETSC_EXTERN PetscErrorCode PetscViennaCLInit(void);
857: PetscBool                   PetscViennaCLSynchronize = PETSC_FALSE;
858: #endif

860: PetscBool PetscCIEnabled = PETSC_FALSE, PetscCIEnabledPortableErrorOutput = PETSC_FALSE;

862: /*
863:   PetscInitialize_Common  - shared code between C and Fortran initialization

865:   prog:     program name
866:   file:     optional PETSc database file name. Might be in Fortran string format when 'ftn' is true
867:   help:     program help message
868:   ftn:      is it called from Fortran initialization (petscinitializef_)?
869:   len:      length of file string, used when Fortran is true
870: */
871: PETSC_INTERN PetscErrorCode PetscInitialize_Common(const char *prog, const char *file, const char *help, PetscBool ftn, PetscInt len)
872: {
873:   PetscMPIInt size;
874:   PetscBool   flg = PETSC_TRUE;
875:   char        hostname[256];
876:   PetscBool   blas_view_flag = PETSC_FALSE;

878:   PetscFunctionBegin;
879:   if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
880:   /* these must be initialized in a routine, not as a constant declaration */
881:   PETSC_STDOUT = stdout;
882:   PETSC_STDERR = stderr;

884:   /* PetscCall can be used from now */
885:   PetscErrorHandlingInitialized = PETSC_TRUE;

887:   /*
888:       The checking over compatible runtime libraries is complicated by the MPI ABI initiative
889:       https://wiki.mpich.org/mpich/index.php/ABI_Compatibility_Initiative which started with
890:         MPICH v3.1 (Released February 2014)
891:         IBM MPI v2.1 (December 2014)
892:         Intel MPI Library v5.0 (2014)
893:         Cray MPT v7.0.0 (June 2014)
894:       As of July 31, 2017 the ABI number still appears to be 12, that is all of the versions
895:       listed above and since that time are compatible.

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

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

904:       Questions:

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

910: #if PetscDefined(HAVE_MPI_GET_LIBRARY_VERSION)
911:   {
912:     char        mpilibraryversion[MPI_MAX_LIBRARY_VERSION_STRING];
913:     PetscMPIInt mpilibraryversionlength;

915:     PetscCallMPI(MPI_Get_library_version(mpilibraryversion, &mpilibraryversionlength));
916:     /* check for MPICH versions before MPI ABI initiative */
917:   #if defined(MPICH_VERSION)
918:     #if MPICH_NUMVERSION < 30100000
919:     {
920:       char     *ver, *lf;
921:       PetscBool flg = PETSC_FALSE;

923:       PetscCall(PetscStrstr(mpilibraryversion, "MPICH Version:", &ver));
924:       if (ver) {
925:         PetscCall(PetscStrchr(ver, '\n', &lf));
926:         if (lf) {
927:           *lf = 0;
928:           PetscCall(PetscStrendswith(ver, MPICH_VERSION, &flg));
929:         }
930:       }
931:       if (!flg) {
932:         PetscCall(PetscInfo(NULL, "PETSc warning --- MPICH library version \n%s does not match what PETSc was compiled with %s.\n", mpilibraryversion, MPICH_VERSION));
933:         flg = PETSC_TRUE;
934:       }
935:     }
936:     #endif
937:       /* check for Open MPI version, it is not part of the MPI ABI initiative (is it part of another initiative that needs to be handled?) */
938:   #elif PetscDefined(HAVE_OPENMPI)
939:     {
940:       char     *ver, bs[MPI_MAX_LIBRARY_VERSION_STRING], *bsf;
941:       PetscBool flg                                              = PETSC_FALSE;
942:     #define PSTRSZ 2
943:       char      ompistr1[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"Open MPI", "FUJITSU MPI"};
944:       char      ompistr2[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"v", "Library "};
945:       int       i;
946:       for (i = 0; i < PSTRSZ; i++) {
947:         PetscCall(PetscStrstr(mpilibraryversion, ompistr1[i], &ver));
948:         if (ver) {
949:           PetscCall(PetscSNPrintf(bs, MPI_MAX_LIBRARY_VERSION_STRING, "%s%d.%d", ompistr2[i], PETSC_PKG_OPENMPI_VERSION_MAJOR, PETSC_PKG_OPENMPI_VERSION_MINOR));
950:           PetscCall(PetscStrstr(ver, bs, &bsf));
951:           if (bsf) flg = PETSC_TRUE;
952:           break;
953:         }
954:       }
955:       if (!flg) {
956:         PetscCall(PetscInfo(NULL, "PETSc warning --- Open MPI library version \n%s does not match what PETSc was compiled with %d.%d.\n", mpilibraryversion, PETSC_PKG_OPENMPI_VERSION_MAJOR, PETSC_PKG_OPENMPI_VERSION_MINOR));
957:         flg = PETSC_TRUE;
958:       }
959:     }
960:   #endif
961:   }
962: #endif

964: #if PetscDefined(HAVE_DLADDR) && !(defined(__cray__) && defined(__clang__))
965:   /* These symbols are currently in the Open MPI and MPICH libraries; they may not always be, in that case the test will simply not detect the problem */
966:   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 Open MPI and MPICH based MPI libraries and will not run correctly");
967: #endif

969:   PetscCall(PetscOptionsCreateDefault());

971:   PetscFinalizeCalled = PETSC_FALSE;

973:   PetscCall(PetscSetProgramName(prog));
974:   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen));
975:   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout));
976:   PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr));
977:   PetscCall(PetscSpinlockCreate(&PetscCommSpinLock));

979:   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
980:   PetscCallMPI(MPI_Comm_set_errhandler(PETSC_COMM_WORLD, MPI_ERRORS_RETURN));

982:   if (PETSC_MPI_ERROR_CLASS == MPI_ERR_LASTCODE) {
983:     PetscCallMPI(MPI_Add_error_class(&PETSC_MPI_ERROR_CLASS));
984:     PetscCallMPI(MPI_Add_error_code(PETSC_MPI_ERROR_CLASS, &PETSC_MPI_ERROR_CODE));
985:   }

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

990:   PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &PetscGlobalRank));
991:   PetscCallMPI(MPI_Comm_size(MPI_COMM_WORLD, &PetscGlobalSize));

993:   MPIU_ENUM        = MPI_INT;
994:   MPIU_FORTRANADDR = (sizeof(void *) == sizeof(int)) ? MPI_INT : MPIU_INT64;
995:   if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED;
996:   else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG;
997: #if defined(PETSC_SIZEOF_LONG_LONG)
998:   else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG;
999: #endif
1000:   else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_SUP_SYS, "Could not find MPI type for size_t");

1002:   /*
1003:      Initialized the global complex variable; this is because with
1004:      shared libraries the constructors for global variables
1005:      are not called; at least on IRIX.
1006:   */
1007: #if PetscDefined(HAVE_COMPLEX)
1008:   {
1009:   #if PetscDefined(CLANGUAGE_CXX) && !PetscDefined(USE_REAL___FLOAT128)
1010:     PetscComplex ic(0.0, 1.0);
1011:     PETSC_i = ic;
1012:   #else
1013:     PETSC_i = _Complex_I;
1014:   #endif
1015:   }
1016: #endif /* PETSC_HAVE_COMPLEX */

1018:   /*
1019:      Create the PETSc MPI reduction operator that sums of the first
1020:      half of the entries and maxes the second half.
1021:   */
1022:   PetscCallMPI(MPI_Op_create(MPIU_MaxSum_Local, 1, &MPIU_MAXSUM_OP));

1024: #if PetscDefined(HAVE_REAL___FLOAT128) && !PetscDefined(SKIP_REAL___FLOAT128)
1025:   PetscCallMPI(MPI_Type_contiguous(2, MPI_DOUBLE, &MPIU___FLOAT128));
1026:   PetscCallMPI(MPI_Type_commit(&MPIU___FLOAT128));
1027:   #if PetscDefined(HAVE_COMPLEX)
1028:   PetscCallMPI(MPI_Type_contiguous(4, MPI_DOUBLE, &MPIU___COMPLEX128));
1029:   PetscCallMPI(MPI_Type_commit(&MPIU___COMPLEX128));
1030:   #endif
1031: #endif
1032: #if PetscDefined(HAVE_REAL___FP16) && !PetscDefined(SKIP_REAL___FP16)
1033:   PetscCallMPI(MPI_Type_contiguous(2, MPI_CHAR, &MPIU___FP16));
1034:   PetscCallMPI(MPI_Type_commit(&MPIU___FP16));
1035: #endif

1037: #if PetscDefined(USE_REAL___FLOAT128) || PetscDefined(USE_REAL___FP16)
1038:   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM));
1039:   PetscCallMPI(MPI_Op_create(PetscMax_Local, 1, &MPIU_MAX));
1040:   PetscCallMPI(MPI_Op_create(PetscMin_Local, 1, &MPIU_MIN));
1041: #elif (PetscDefined(HAVE_REAL___FLOAT128) && !PetscDefined(SKIP_REAL___FLOAT128)) || (PetscDefined(HAVE_REAL___FP16) && !PetscDefined(SKIP_REAL___FP16))
1042:   PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM___FP16___FLOAT128));
1043: #endif

1045:   PetscCallMPI(MPI_Type_contiguous(2, MPIU_SCALAR, &MPIU_2SCALAR));
1046:   PetscCallMPI(MPI_Op_create(PetscGarbageKeySortedIntersect, 1, &Petsc_Garbage_SetIntersectOp));
1047:   PetscCallMPI(MPI_Type_commit(&MPIU_2SCALAR));

1049:   /* create datatypes used by MPIU_MAXLOC, MPIU_MINLOC and PetscSplitReduction_Op */
1050: #if !PetscDefined(HAVE_MPIUNI)
1051:   {
1052:     PetscMPIInt  blockSizes[2]   = {1, 1};
1053:     MPI_Aint     blockOffsets[2] = {offsetof(struct petsc_mpiu_real_int, v), offsetof(struct petsc_mpiu_real_int, i)};
1054:     MPI_Datatype blockTypes[2]   = {MPIU_REAL, MPIU_INT}, tmpStruct;

1056:     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
1057:     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_real_int), &MPIU_REAL_INT));
1058:     PetscCallMPI(MPI_Type_free(&tmpStruct));
1059:     PetscCallMPI(MPI_Type_commit(&MPIU_REAL_INT));
1060:   }
1061:   {
1062:     PetscMPIInt  blockSizes[2]   = {1, 1};
1063:     MPI_Aint     blockOffsets[2] = {offsetof(struct petsc_mpiu_scalar_int, v), offsetof(struct petsc_mpiu_scalar_int, i)};
1064:     MPI_Datatype blockTypes[2]   = {MPIU_SCALAR, MPIU_INT}, tmpStruct;

1066:     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
1067:     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_scalar_int), &MPIU_SCALAR_INT));
1068:     PetscCallMPI(MPI_Type_free(&tmpStruct));
1069:     PetscCallMPI(MPI_Type_commit(&MPIU_SCALAR_INT));
1070:   }
1071: #endif

1073: #if PetscDefined(USE_64BIT_INDICES)
1074:   PetscCallMPI(MPI_Type_contiguous(2, MPIU_INT, &MPIU_2INT));
1075:   PetscCallMPI(MPI_Type_commit(&MPIU_2INT));

1077:   #if !PetscDefined(HAVE_MPIUNI)
1078:   {
1079:     int          blockSizes[]   = {1, 1};
1080:     MPI_Aint     blockOffsets[] = {offsetof(struct petsc_mpiu_int_mpiint, a), offsetof(struct petsc_mpiu_int_mpiint, b)};
1081:     MPI_Datatype blockTypes[]   = {MPIU_INT, MPI_INT}, tmpStruct;

1083:     PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
1084:     PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_int_mpiint), &MPIU_INT_MPIINT));
1085:     PetscCallMPI(MPI_Type_free(&tmpStruct));
1086:     PetscCallMPI(MPI_Type_commit(&MPIU_INT_MPIINT));
1087:   }
1088:   #endif
1089: #endif
1090:   PetscCallMPI(MPI_Type_contiguous(4, MPI_INT, &MPI_4INT));
1091:   PetscCallMPI(MPI_Type_commit(&MPI_4INT));
1092:   PetscCallMPI(MPI_Type_contiguous(4, MPIU_INT, &MPIU_4INT));
1093:   PetscCallMPI(MPI_Type_commit(&MPIU_4INT));

1095:   /*
1096:      Attributes to be set on PETSc communicators
1097:   */
1098:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_Counter_Attr_DeleteFn, &Petsc_Counter_keyval, NULL));
1099:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_InnerComm_Attr_DeleteFn, &Petsc_InnerComm_keyval, NULL));
1100:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_OuterComm_Attr_DeleteFn, &Petsc_OuterComm_keyval, NULL));
1101:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_ShmComm_Attr_DeleteFn, &Petsc_ShmComm_keyval, NULL));
1102:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_CreationIdx_keyval, NULL));
1103:   PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_Garbage_HMap_keyval, NULL));

1105: #if PetscDefined(USE_FORTRAN_BINDINGS)
1106:   if (ftn) PetscCall(PetscInitFortran_Private(file, len));
1107:   else
1108: #endif
1109:     PetscCall(PetscOptionsInsert(NULL, &PetscGlobalArgc, &PetscGlobalArgs, file));

1111:   if (PetscDefined(HAVE_MPIUNI)) {
1112:     const char *mpienv = getenv("PMI_SIZE");
1113:     if (!mpienv) mpienv = getenv("OMPI_COMM_WORLD_SIZE");
1114:     if (mpienv) {
1115:       PetscInt  isize;
1116:       PetscBool mflag = PETSC_FALSE;

1118:       PetscCall(PetscOptionsStringToInt(mpienv, &isize));
1119:       PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpiuni-allow-multiprocess-launch", &mflag, NULL));
1120:       PetscCheck(isize == 1 || mflag, 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. Or run with -mpiuni-allow-multiprocess-launch to allow multiple independent MPI-uni jobs.");
1121:     }
1122:   }

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

1127:   /*
1128:      Check system options and print help
1129:   */
1130:   PetscCall(PetscOptionsCheckInitial_Private(help));

1132:   /*
1133:     Creates the logging data structures; this is enabled even if logging is not turned on
1134:     This is the last thing we do before returning to the user code to prevent having the
1135:     logging numbers contaminated by any startup time associated with MPI
1136:   */
1137:   PetscCall(PetscLogInitialize());

1139:   /*
1140:    Initialize PetscDevice and PetscDeviceContext

1142:    Note to any future devs thinking of moving this, proper initialization requires:
1143:    1. MPI initialized
1144:    2. Options DB initialized
1145:    3. PETSc error handling initialized, specifically signal handlers. This expects to set up
1146:       its own SIGSEV handler via the push/pop interface.
1147:    4. Logging initialized
1148:   */
1149:   PetscCall(PetscDeviceInitializeFromOptions_Internal(PETSC_COMM_WORLD));

1151: #if PetscDefined(HAVE_VIENNACL)
1152:   flg = PETSC_FALSE;
1153:   PetscCall(PetscOptionsHasName(NULL, NULL, "-log_view", &flg));
1154:   if (!flg) PetscCall(PetscOptionsGetBool(NULL, NULL, "-viennacl_synchronize", &flg, NULL));
1155:   PetscViennaCLSynchronize = flg;
1156:   PetscCall(PetscViennaCLInit());
1157: #endif

1159:   PetscCall(PetscCitationsInitialize());

1161: #if PetscDefined(HAVE_SAWS)
1162:   PetscCall(PetscInitializeSAWs(ftn ? NULL : help));
1163:   flg = PETSC_FALSE;
1164:   PetscCall(PetscOptionsHasName(NULL, NULL, "-stack_view", &flg));
1165:   if (flg) PetscCall(PetscStackViewSAWs());
1166: #endif

1168:   /*
1169:      Load the dynamic libraries (on machines that support them), this registers all
1170:      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
1171:   */
1172:   PetscCall(PetscInitialize_DynamicLibraries());

1174:   PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));
1175:   PetscCall(PetscInfo(NULL, "PETSc successfully started: number of processors = %d\n", size));
1176:   PetscCall(PetscGetHostName(hostname, sizeof(hostname)));
1177:   PetscCall(PetscInfo(NULL, "Running on machine: %s\n", hostname));
1178: #if PetscDefined(HAVE_OPENMP)
1179:   {
1180:     PetscBool omp_view_flag;
1181:     char     *threads = getenv("OMP_NUM_THREADS");

1183:     if (threads) {
1184:       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n", threads));
1185:       (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumOMPThreads);
1186:     } else {
1187:       PetscNumOMPThreads = (PetscInt)omp_get_max_threads();
1188:       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n", PetscNumOMPThreads));
1189:     }
1190:     PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "OpenMP options", "Sys");
1191:     PetscCall(PetscOptionsInt("-omp_num_threads", "Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS", "None", PetscNumOMPThreads, &PetscNumOMPThreads, &flg));
1192:     PetscCall(PetscOptionsName("-omp_view", "Display OpenMP number of threads", NULL, &omp_view_flag));
1193:     PetscOptionsEnd();
1194:     if (flg) {
1195:       PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (given by -omp_num_threads)\n", PetscNumOMPThreads));
1196:       omp_set_num_threads((int)PetscNumOMPThreads);
1197:     }
1198:     if (omp_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "OpenMP: number of threads %" PetscInt_FMT "\n", PetscNumOMPThreads));
1199:   }
1200: #endif

1202:   PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "BLAS options", "Sys");
1203:   PetscCall(PetscOptionsName("-blas_view", "Display number of threads to use for BLAS operations", NULL, &blas_view_flag));
1204: #if PetscDefined(HAVE_BLI_THREAD_SET_NUM_THREADS) || PetscDefined(HAVE_MKL_SET_NUM_THREADS) || PetscDefined(HAVE_OPENBLAS_SET_NUM_THREADS)
1205:   {
1206:     char *threads = NULL;

1208:     /* determine any default number of threads requested in the environment; TODO: Apple libraries? */
1209:   #if PetscDefined(HAVE_BLI_THREAD_SET_NUM_THREADS)
1210:     threads = getenv("BLIS_NUM_THREADS");
1211:     if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of BLIS threads %s given by BLIS_NUM_THREADS\n", threads));
1212:     if (!threads) {
1213:       threads = getenv("OMP_NUM_THREADS");
1214:       if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of BLIS threads %s given by OMP_NUM_THREADS\n", threads));
1215:     }
1216:   #elif PetscDefined(HAVE_MKL_SET_NUM_THREADS)
1217:     threads = getenv("MKL_NUM_THREADS");
1218:     if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of MKL threads %s given by MKL_NUM_THREADS\n", threads));
1219:     if (!threads) {
1220:       threads = getenv("OMP_NUM_THREADS");
1221:       if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of MKL threads %s given by OMP_NUM_THREADS\n", threads));
1222:     }
1223:   #elif PetscDefined(HAVE_OPENBLAS_SET_NUM_THREADS)
1224:     threads = getenv("OPENBLAS_NUM_THREADS");
1225:     if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of OpenBLAS threads %s given by OPENBLAS_NUM_THREADS\n", threads));
1226:     if (!threads) {
1227:       threads = getenv("OMP_NUM_THREADS");
1228:       if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of OpenBLAS threads %s given by OMP_NUM_THREADS\n", threads));
1229:     }
1230:   #endif
1231:     if (threads) (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumBLASThreads);
1232:     PetscCall(PetscOptionsInt("-blas_num_threads", "Number of threads to use for BLAS operations", "None", PetscNumBLASThreads, &PetscNumBLASThreads, &flg));
1233:     if (flg) PetscCall(PetscInfo(NULL, "BLAS: Command line number of BLAS thread %" PetscInt_FMT "given by -blas_num_threads\n", PetscNumBLASThreads));
1234:     if (flg || threads) {
1235:       PetscCall(PetscBLASSetNumThreads(PetscNumBLASThreads));
1236:       if (blas_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "BLAS: number of threads %" PetscInt_FMT "\n", PetscNumBLASThreads));
1237:     }
1238:   }
1239: #elif PetscDefined(HAVE_APPLE_ACCELERATE)
1240:   PetscCall(PetscInfo(NULL, "BLAS: Apple Accelerate library, thread support with no user control\n"));
1241:   if (blas_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "BLAS: Apple Accelerate library, thread support with no user control\n"));
1242: #else
1243:   if (blas_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "BLAS: no thread support\n"));
1244: #endif
1245:   PetscOptionsEnd();

1247: #if PetscDefined(USE_PETSC_MPI_EXTERNAL32)
1248:   /*
1249:       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI

1251:       Currently not used because it is not supported by MPICH.
1252:   */
1253:   if (!PetscBinaryBigEndian()) PetscCallMPI(MPI_Register_datarep((char *)"petsc", PetscDataRep_read_conv_fn, PetscDataRep_write_conv_fn, PetscDataRep_extent_fn, NULL));
1254: #endif

1256: #if PetscDefined(HAVE_HWLOC)
1257:   {
1258:     PetscViewer viewer;
1259:     PetscCall(PetscOptionsCreateViewer(PETSC_COMM_WORLD, NULL, NULL, "-process_view", &viewer, NULL, &flg));
1260:     if (flg) {
1261:       PetscCall(PetscProcessPlacementView(viewer));
1262:       PetscCall(PetscViewerDestroy(&viewer));
1263:     }
1264:   }
1265: #endif

1267:   flg = PETSC_TRUE;
1268:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-viewfromoptions", &flg, NULL));
1269:   if (!flg) PetscCall(PetscOptionsPushCreateViewerOff(PETSC_TRUE));

1271: #if PetscDefined(HAVE_ADIOS)
1272:   PetscCallExternal(adios_init_noxml, PETSC_COMM_WORLD);
1273:   PetscCallExternal(adios_declare_group, &Petsc_adios_group, "PETSc", "", adios_stat_default);
1274:   PetscCallExternal(adios_select_method, Petsc_adios_group, "MPI", "", "");
1275:   PetscCallExternal(adios_read_init_method, ADIOS_READ_METHOD_BP, PETSC_COMM_WORLD, "");
1276: #endif

1278: #if defined(__VALGRIND_H)
1279:   PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND ? PETSC_TRUE : PETSC_FALSE;
1280:   #if PetscDefined(USING_DARWIN) && PetscDefined(BLASLAPACK_SDOT_RETURNS_DOUBLE)
1281:   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, try configuring with --download-fblaslapack or --download-f2cblaslapack"));
1282:   #endif
1283: #endif
1284:   /*
1285:       Set flag that we are completely initialized
1286:   */
1287:   PetscInitializeCalled = PETSC_TRUE;

1289:   PetscCall(PetscOptionsHasName(NULL, NULL, "-python", &flg));
1290:   if (flg) PetscCall(PetscPythonInitialize(NULL, NULL));

1292:   PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1293:   if (flg) PetscCall(PetscInfo(NULL, "Running MPI Linear Solver Server\n"));
1294:   if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerBegin());
1295:   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");
1296:   PetscFunctionReturn(PETSC_SUCCESS);
1297: }

1299: /*@
1300:   PetscSetMPIThreadRequiredType - Set the MPI required thread level for when `PetscInitialize()` initializes MPI.

1302:   Logically Collective

1304:   Input Parameter:
1305: . required - the desired thread support, one of `MPI_THREAD_SINGLE`, `MPI_THREAD_FUNNELED`, `MPI_THREAD_SERIALIZED`, or `MPI_THREAD_MULTIPLE`.

1307:   Level: intermediate

1309:   Notes:
1310:   This must be called before `PetscInitialize()`.

1312:   Defaults to `MPI_THREAD_FUNNELED` when the MPI implementation provides `MPI_Init_thread()`, otherwise `MPI_THREAD_SINGLE`.

1314:   This argument is used in the call to `MPI_Init_thread()` made by `PetscInitialize()`.

1316:   Packages such as SLATE may require `MPI_THREAD_MULTIPLE`.

1318:   The same value must be set on all MPI processes.

1320: .seealso: `PetscInitialize()`
1321: @*/
1322: PetscErrorCode PetscSetMPIThreadRequiredType(PetscMPIInt required)
1323: {
1324:   PetscFunctionBegin;
1325:   PETSC_MPI_THREAD_REQUIRED = required;
1326:   PetscFunctionReturn(PETSC_SUCCESS);
1327: }

1329: // "Unknown section 'Environmental Variables'"
1330: // PetscClangLinter pragma disable: -fdoc-section-header-unknown
1331: /*@
1332:   PetscInitialize - Initializes the PETSc database and MPI.
1333:   `PetscInitialize()` calls MPI_Init() if that has yet to be called,
1334:   so this routine should always be called near the beginning of
1335:   your program -- usually the very first line!

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

1339:   Input Parameters:
1340: + argc - count of number of command line arguments
1341: . args - the command line arguments
1342: . file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format.
1343:           Use `NULL` or empty string to not check for code specific file.
1344:           Also checks `~/.petscrc`, `.petscrc` and `petscrc`.
1345:           Use `-skip_petscrc` in the code specific file (or command line) to skip `~/.petscrc`, `.petscrc` and `petscrc` files.
1346: - help - [optional] Help message to print, use `NULL` for no message

1348:    If you wish PETSc code to run ONLY on a subcommunicator of `MPI_COMM_WORLD`, create that
1349:    communicator first and assign it to `PETSC_COMM_WORLD` BEFORE calling `PetscInitialize()`.
1350:    then do this. If ALL processes in the job are using `PetscInitialize()` and `PetscFinalize()` then you don't need to do this, even
1351:    if different subcommunicators of the job are doing different things with PETSc.

1353:   Options Database Keys:
1354: + -help [(intro|mansec1,mansec2,...)]                    - prints help method for each option; if `intro` is given the program stops after printing the introductory help message; if manual sections are given only the options blocks in those sections are printed
1355: . -start_in_debugger [(noxterm)],[(gdb|lldb|...)]        - Starts program in debugger
1356: . -on_error_attach_debugger [(noxterm)],[(gdb|lldb|...)] - Starts debugger when error detected
1357: . -on_error_emacs machinename                            - causes `emacsclient` to jump to error file if an error is detected
1358: . -on_error_abort                                        - calls `abort()` when error detected (no traceback)
1359: . -on_error_mpiabort                                     - calls `MPI_abort()` when error detected
1360: . -error_output_stdout                                   - prints PETSc error messages to `stdout` instead of the default `stderr`
1361: . -error_output_none                                     - does not print the error messages (but handles errors in the same way as if this was not called)
1362: . -debugger_ranks rank1,rank2,...                        - Indicates MPI ranks to start in debugger
1363: . -debugger_pause secs                                   - Pauses debugger, use if it takes a long time for the debugger to start up on your system, `sleeptime` is number of seconds to sleep
1364: . -stop_for_debugger                                     - Print message on how to attach debugger manually to
1365:                                                            process and wait (`-debugger_pause`) seconds for attachment
1366: . -malloc_dump                                           - prints a list of all unfreed memory at the end of the run
1367: . -malloc_test                                           - like `-malloc_dump` `-malloc_debug`, only active for debugging build, ignored in optimized build. Often set in `PETSC_OPTIONS` environmental variable
1368: . -malloc_view [filename]                                - show a list of all allocated memory during `PetscFinalize()`
1369: . -malloc_view_threshold logmin                          - only list memory allocations of size greater than `logmin` with `-malloc_view`
1370: . -malloc_requested_size (true|false)                    - malloc logging will record the requested size rather than (possibly large) size after alignment
1371: . -fp_trap (true|false)                                  - Stops on floating point exceptions
1372: . -no_signal_handler (true|false)                        - Indicates not to trap error signals
1373: . -python exe                                            - Initializes Python, and optionally takes a Python executable name
1374: - -mpiuni-allow-multiprocess-launch                      - allow `mpiexec` to launch multiple independent MPI-Uni jobs, otherwise a sanity check error is invoked to prevent misuse of MPI-Uni

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

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

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

1387:   Options Database Keys for Profiling:
1388:    See Users-Manual: ch_profiling for details.
1389: + -info [filename][:[~]c1,c2,...[:[~]self]]           - Prints verbose information for classes c1, c2, etc. See `PetscInfo()`.
1390: . -log_sync                                           - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event,
1391:                                                          however it slows things down and gives a distorted view of the overall runtime.
1392: . -log_trace [filename]                               - Print traces of all PETSc calls to the screen (useful to determine where a program
1393:                                                          hangs without running in the debugger).  See `PetscLogTraceBegin()`.
1394: . -log_view viewer_specification,viewer_specification - Prints summary of flop and timing information to up to four viewers, see `PetscLogView()`
1395: . -log_view_memory (true|false)                       - Includes in the summary from `-log_view` the memory used in each event, see `PetscLogView()`.
1396: . -log_view_gpu_time                                  - Includes in the summary from `-log_view` the time used in each GPU kernel, see `PetscLogView()`.
1397: . -log_view_gpu_energy                                - Includes in the summary from `-log_view` the energy (estimated with power*gtime) consumed in each GPU kernel, see `PetscLogView()`.
1398: . -log_view_gpu_energy_meter                          - Includes in the summary from `-log_view` the energy (readings from meters) consumed in each GPU kernel, see `PetscLogView()`.
1399: . -log_exclude c1,c2,...                              - excludes subset of object classes from logging, for example `vec,ksp` would exclude the `Vec` and `KSP` classes
1400: . -log [filename]                                     - Logs profiling information in a dump file, see `PetscLogDump()`.
1401: . -log_all [filename]                                 - Same as `-log`.
1402: . -log_mpe [filename]                                 - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
1403: . -log_perfstubs                                      - Starts a log handler with the perfstubs interface (which is used by TAU)
1404: . -log_nvtx                                           - Starts an nvtx log handler for use with Nsight
1405: . -log_roctx                                          - Starts an roctx log handler for use with rocprof on AMD GPUs
1406: . -viewfromoptions (on|off)                           - Enable or disable `XXXViewFromOptions()` calls, for applications with many small solves turn this off
1407: . -get_total_flops (true|false)                       - Returns total flops done by all processors
1408: . -memory_view (true|false)                           - Print memory usage at end of run
1409: - -check_pointer_intensity 0,1,2                      - if pointers are checked for validity (debug version only), using 0 will result in faster code

1411:   Options Database Keys for SAWs:
1412: + -saws_port portnumber        - port number to publish SAWs data, default is 8080
1413: . -saws_port_auto_select       - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen
1414:                                  this is useful when you are running many jobs that utilize SAWs at the same time
1415: . -saws_log filename           - save a log of all SAWs communication
1416: . -saws_https certificate_file - have SAWs use HTTPS instead of HTTP
1417: - -saws_root directory         - allow SAWs to have access to the given directory to search for requested resources and files

1419:   Environmental Variables:
1420: +   `PETSC_TMP`                   - alternative directory to use instead of `/tmp`
1421: .   `PETSC_SHARED_TMP`            - `/tmp` is shared by all processes
1422: .   `PETSC_NOT_SHARED_TMP`        - each process has its own private `/tmp`
1423: .   `PETSC_OPTIONS`               - a string containing additional options for PETSc in the form of command line "-key value" pairs
1424: .   `PETSC_OPTIONS_YAML`          - (requires configuring PETSc to use libyaml with `--download-yaml`) a string containing additional options for PETSc in the form of a YAML document
1425: .   `PETSC_VIEWER_SOCKET_PORT`    - socket number to use for socket viewer
1426: -   `PETSC_VIEWER_SOCKET_MACHINE` - machine to use for socket viewer to connect to

1428:   Level: beginner

1430:   Notes:
1431:   If for some reason you must call `MPI_Init()` separately from `PetscInitialize()`, call
1432:   it before `PetscInitialize()`.

1434:   If your program requires a particular level of thread support for MPI, see `MPI_Init_thread()`, you may call `PetscSetMPIThreadRequiredType()`
1435:   before `PetscInitialize()` to indicate this.

1437:   Fortran Notes:
1438:   In Fortran this routine can be called with
1439: .vb
1440:        call PetscInitialize(ierr)
1441:        call PetscInitialize(file,ierr) or
1442:        call PetscInitialize(file,help,ierr)
1443: .ve

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

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

1452: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscInitializeNoArguments()`, `PetscLogGpuTime()`,
1453:           `PetscSetMPIThreadRequiredType()`
1454: @*/
1455: PetscErrorCode PetscInitialize(int *argc, char ***args, const char file[], const char help[])
1456: {
1457:   PetscMPIInt flag;
1458:   const char *prog = "Unknown Name";

1460:   PetscFunctionBegin;
1461:   if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
1462:   PetscCallMPI(MPI_Initialized(&flag));
1463:   if (!flag) {
1464:     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");
1465:     PetscCall(PetscPreMPIInit_Private());
1466: #if PetscDefined(HAVE_MPI_INIT_THREAD)
1467:     {
1468:       PetscMPIInt provided;
1469:       PetscCallMPI(MPI_Init_thread(argc, args, PETSC_MPI_THREAD_REQUIRED == PETSC_DECIDE ? MPI_THREAD_FUNNELED : PETSC_MPI_THREAD_REQUIRED, &provided));
1470:       PetscCheck(PETSC_MPI_THREAD_REQUIRED == PETSC_DECIDE || provided >= PETSC_MPI_THREAD_REQUIRED, PETSC_COMM_SELF, PETSC_ERR_MPI, "The MPI implementation's provided thread level is less than what you required");
1471:       if (PETSC_MPI_THREAD_REQUIRED == PETSC_DECIDE) PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_FUNNELED; // assign it a valid value after check-up
1472:     }
1473: #else
1474:     PetscCallMPI(MPI_Init(argc, args));
1475: #endif
1476:     PetscBeganMPI = PETSC_TRUE;
1477:   }

1479:   if (argc && *argc) prog = **args;
1480:   if (argc && args) {
1481:     PetscGlobalArgc = *argc;
1482:     PetscGlobalArgs = *args;
1483:   }
1484:   PetscCall(PetscInitialize_Common(prog, file, help, PETSC_FALSE, 0));
1485:   PetscFunctionReturn(PETSC_SUCCESS);
1486: }

1488: PETSC_INTERN PetscObject *PetscObjects;
1489: PETSC_INTERN PetscInt     PetscObjectsCounts;
1490: PETSC_INTERN PetscInt     PetscObjectsMaxCounts;
1491: PETSC_INTERN PetscBool    PetscObjectsLog;

1493: /*
1494:     Frees all the MPI types and operations that PETSc may have created
1495: */
1496: PetscErrorCode PetscFreeMPIResources(void)
1497: {
1498:   PetscFunctionBegin;
1499: #if PetscDefined(HAVE_REAL___FLOAT128) && !PetscDefined(SKIP_REAL___FLOAT128)
1500:   PetscCallMPI(MPI_Type_free(&MPIU___FLOAT128));
1501:   #if PetscDefined(HAVE_COMPLEX)
1502:   PetscCallMPI(MPI_Type_free(&MPIU___COMPLEX128));
1503:   #endif
1504: #endif
1505: #if PetscDefined(HAVE_REAL___FP16) && !PetscDefined(SKIP_REAL___FP16)
1506:   PetscCallMPI(MPI_Type_free(&MPIU___FP16));
1507: #endif

1509: #if PetscDefined(USE_REAL___FLOAT128) || PetscDefined(USE_REAL___FP16)
1510:   PetscCallMPI(MPI_Op_free(&MPIU_SUM));
1511:   PetscCallMPI(MPI_Op_free(&MPIU_MAX));
1512:   PetscCallMPI(MPI_Op_free(&MPIU_MIN));
1513: #elif (PetscDefined(HAVE_REAL___FLOAT128) && !PetscDefined(SKIP_REAL___FLOAT128)) || (PetscDefined(HAVE_REAL___FP16) && !PetscDefined(SKIP_REAL___FP16))
1514:   PetscCallMPI(MPI_Op_free(&MPIU_SUM___FP16___FLOAT128));
1515: #endif

1517:   PetscCallMPI(MPI_Type_free(&MPIU_2SCALAR));
1518:   PetscCallMPI(MPI_Type_free(&MPIU_REAL_INT));
1519:   PetscCallMPI(MPI_Type_free(&MPIU_SCALAR_INT));
1520: #if PetscDefined(USE_64BIT_INDICES)
1521:   PetscCallMPI(MPI_Type_free(&MPIU_2INT));
1522:   PetscCallMPI(MPI_Type_free(&MPIU_INT_MPIINT));
1523: #endif
1524:   PetscCallMPI(MPI_Type_free(&MPI_4INT));
1525:   PetscCallMPI(MPI_Type_free(&MPIU_4INT));
1526:   PetscCallMPI(MPI_Op_free(&MPIU_MAXSUM_OP));
1527:   PetscCallMPI(MPI_Op_free(&Petsc_Garbage_SetIntersectOp));
1528:   PetscFunctionReturn(PETSC_SUCCESS);
1529: }

1531: PETSC_INTERN PetscErrorCode PetscLogFinalize(void);
1532: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void *, int, const char[], const char[]);

1534: /*@
1535:   PetscFinalize - Checks for options to be called at the conclusion of a PETSc program and frees any remaining PETSc objects and data structures.
1536:   of the program. Automatically calls `MPI_Finalize()` if the user had not called `MPI_Init()` before calling `PetscInitialize()`.

1538:   Collective on `PETSC_COMM_WORLD`

1540:   Options Database Keys:
1541: + -options_view (true|false) - Calls `PetscOptionsView()` to display all options in the database to `PETSC_VIEWER_STDOUT_WORLD`
1542: . -options_left (true|false) - Prints unused options that remain in the database to `stdout` (default value is `true`)
1543: . -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
1544: . -mpidump (true|false)      - Calls PetscMPIDump() and prints to `stdout`
1545: . -malloc_dump [filename]    - Calls `PetscMallocDump()`, displays all memory allocated that has not been freed
1546: . -memory_view (true|false)  - Prints total memory usage to `PETSC_VIEWER_STDOUT_WORLD`
1547: - -malloc_view [filename]    - Prints list of all memory allocated and in what functions

1549:   Level: beginner

1551:   Note:
1552:   See `PetscInitialize()` for other runtime options.

1554:   You can call `PetscInitialize()` after `PetscFinalize()` but only with MPI-Uni or if you called `MPI_Init()` before ever calling `PetscInitialize()`.

1556: .seealso: `PetscInitialize()`, `PetscOptionsView()`, `PetscMallocDump()`, `PetscMPIDump()`, `PetscEnd()`
1557: @*/
1558: PetscErrorCode PetscFinalize(void)
1559: {
1560:   PetscMPIInt rank;
1561:   PetscInt    nopt;
1562:   PetscBool   flg1 = PETSC_FALSE, flg2 = PETSC_FALSE, flg3 = PETSC_FALSE;
1563:   PetscBool   flg;
1564:   char        mname[PETSC_MAX_PATH_LEN];

1566:   PetscFunctionBegin;
1567:   PetscCheck(PetscInitializeCalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscInitialize() must be called before PetscFinalize()");
1568:   PetscCall(PetscInfo(NULL, "PetscFinalize() called\n"));

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

1573:   PetscCall(PetscFreeAlign(PetscGlobalArgsFortran, 0, NULL, NULL));
1574:   PetscGlobalArgc = 0;
1575:   PetscGlobalArgs = NULL;

1577:   /* Clean up Garbage automatically on COMM_SELF and COMM_WORLD at finalize */
1578:   {
1579:     union
1580:     {
1581:       MPI_Comm comm;
1582:       void    *ptr;
1583:     } ucomm;
1584:     PetscMPIInt flg;
1585:     void       *tmp;

1587:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1588:     if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1589:     if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_SELF));
1590:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1591:     if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1592:     if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_WORLD));
1593:   }

1595:   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
1596: #if PetscDefined(HAVE_ADIOS)
1597:   PetscCallExternal(adios_read_finalize_method, ADIOS_READ_METHOD_BP_AGGREGATE);
1598:   PetscCallExternal(adios_finalize, rank);
1599: #endif
1600:   PetscCall(PetscOptionsHasName(NULL, NULL, "-citations", &flg));
1601:   if (flg) {
1602:     char *cits, filename[PETSC_MAX_PATH_LEN];
1603:     FILE *fd = PETSC_STDOUT;

1605:     PetscCall(PetscOptionsGetString(NULL, NULL, "-citations", filename, sizeof(filename), NULL));
1606:     if (filename[0]) PetscCall(PetscFOpen(PETSC_COMM_WORLD, filename, "w", &fd));
1607:     PetscCall(PetscSegBufferGet(PetscCitationsList, 1, &cits));
1608:     cits[0] = 0;
1609:     PetscCall(PetscSegBufferExtractAlloc(PetscCitationsList, &cits));
1610:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "If you publish results based on this computation please cite the following:\n"));
1611:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1612:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "%s", cits));
1613:     PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1614:     PetscCall(PetscFClose(PETSC_COMM_WORLD, fd));
1615:     PetscCall(PetscFree(cits));
1616:   }
1617:   PetscCall(PetscSegBufferDestroy(&PetscCitationsList));

1619: #if PetscDefined(HAVE_X)
1620:   flg1 = PETSC_FALSE;
1621:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-x_virtual", &flg1, NULL));
1622:   if (flg1) {
1623:     /*  this is a crude hack, but better than nothing */
1624:     PetscCall(PetscPOpen(PETSC_COMM_WORLD, NULL, "pkill -15 Xvfb", "r", NULL));
1625:   }
1626: #endif

1628: #if !PetscDefined(HAVE_THREADSAFETY)
1629:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-memory_view", &flg2, NULL));
1630:   if (flg2) PetscCall(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD, "Summary of Memory Usage in PETSc\n"));
1631: #endif

1633:   if (PetscDefined(USE_LOG)) {
1634:     flg1 = PETSC_FALSE;
1635:     PetscCall(PetscOptionsGetBool(NULL, NULL, "-get_total_flops", &flg1, NULL));
1636:     if (flg1) {
1637:       PetscLogDouble flops = 0;
1638:       PetscCallMPI(MPI_Reduce(&petsc_TotalFlops, &flops, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
1639:       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Total flops over all processors %g\n", flops));
1640:     }
1641:   }

1643:   if (PetscDefined(USE_LOG) && PetscDefined(HAVE_MPE)) {
1644:     mname[0] = 0;
1645:     PetscCall(PetscOptionsGetString(NULL, NULL, "-log_mpe", mname, sizeof(mname), &flg1));
1646:     if (flg1) PetscCall(PetscLogMPEDump(mname[0] ? mname : NULL));
1647:   }

1649: #if PetscDefined(HAVE_KOKKOS)
1650:   // Free PETSc/kokkos stuff before the potentially non-null PETSc default gpu stream is destroyed by PetscObjectRegisterDestroyAll
1651:   if (PetscKokkosInitialized) {
1652:     PetscCall(PetscKokkosFinalize_Private());
1653:     PetscKokkosInitialized = PETSC_FALSE;
1654:   }
1655: #endif

1657:   // Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1658:   PetscCall(PetscObjectRegisterDestroyAll());

1660:   if (PetscDefined(USE_LOG)) {
1661:     PetscCall(PetscOptionsPushCreateViewerOff(PETSC_FALSE));
1662:     PetscCall(PetscLogViewFromOptions());
1663:     PetscCall(PetscOptionsPopCreateViewerOff());
1664:     //  It should be turned on with PetscLogGpuTime() and never turned off except in this place
1665:     PetscLogGpuTimeFlag = PETSC_FALSE;

1667:     // Free any objects created by the last block of code.
1668:     PetscCall(PetscObjectRegisterDestroyAll());

1670:     mname[0] = 0;
1671:     PetscCall(PetscOptionsGetString(NULL, NULL, "-log_all", mname, sizeof(mname), &flg1));
1672:     PetscCall(PetscOptionsGetString(NULL, NULL, "-log", mname, sizeof(mname), &flg2));
1673:     if (flg1 || flg2) PetscCall(PetscLogDump(mname));
1674:   }

1676:   flg1 = PETSC_FALSE;
1677:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-no_signal_handler", &flg1, NULL));
1678:   if (!flg1) PetscCall(PetscPopSignalHandler());
1679:   flg1 = PETSC_FALSE;
1680:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpidump", &flg1, NULL));
1681:   if (flg1) PetscCall(PetscMPIDump(stdout));
1682:   flg1 = PETSC_FALSE;
1683:   flg2 = PETSC_FALSE;
1684:   /* preemptive call to avoid listing this option in options table as unused */
1685:   PetscCall(PetscOptionsHasName(NULL, NULL, "-malloc_dump", &flg1));
1686:   PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1687:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_view", &flg2, NULL));

1689:   if (flg2) PetscCall(PetscOptionsView(NULL, PETSC_VIEWER_STDOUT_WORLD));

1691:   /* to prevent PETSc -options_left from warning */
1692:   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox", &flg1));
1693:   PetscCall(PetscOptionsHasName(NULL, NULL, "-nox_warning", &flg1));

1695:   flg3 = PETSC_FALSE; /* default value is required */
1696:   PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_left", &flg3, &flg1));
1697:   if (!flg1) flg3 = PETSC_TRUE;
1698:   if (flg3) {
1699:     PetscCall(PetscOptionsAllUsed(NULL, &nopt));
1700:     if (nopt) {
1701:       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! There are options you set that were not used!\n"));
1702:       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! could be spelling mistake, etc!\n"));
1703:       if (nopt == 1) {
1704:         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There is one unused database option. It is:\n"));
1705:       } else {
1706:         PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are %" PetscInt_FMT " unused database options. They are:\n", nopt));
1707:       }
1708:     } else if (flg3 && flg1) {
1709:       PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are no unused options.\n"));
1710:     }
1711:     PetscCall(PetscOptionsLeft(NULL));
1712:   }

1714: #if PetscDefined(HAVE_SAWS)
1715:   if (!PetscGlobalRank) {
1716:     PetscCall(PetscStackSAWsViewOff());
1717:     PetscCallSAWs(SAWs_Finalize, );
1718:   }
1719: #endif

1721:   /*
1722:        List all objects the user may have forgot to free
1723:   */
1724:   if (PetscDefined(USE_LOG) && PetscObjectsLog) {
1725:     PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1726:     if (flg1) {
1727:       MPI_Comm local_comm;
1728:       char     string[64];

1730:       PetscCall(PetscOptionsGetString(NULL, NULL, "-objects_dump", string, sizeof(string), NULL));
1731:       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1732:       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1733:       PetscCall(PetscObjectsDump(stdout, (string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE));
1734:       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1735:       PetscCallMPI(MPI_Comm_free(&local_comm));
1736:     }
1737:   }

1739:   PetscObjectsCounts    = 0;
1740:   PetscObjectsMaxCounts = 0;
1741:   PetscCall(PetscFree(PetscObjects));

1743:   /*
1744:      Destroy any packages that registered a finalize
1745:   */
1746:   PetscCall(PetscRegisterFinalizeAll());

1748:   PetscCall(PetscLogFinalize());

1750:   /*
1751:      Print PetscFunctionLists that have not been properly freed
1752:   */
1753:   if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintAll());

1755:   if (petsc_history) {
1756:     PetscCall(PetscCloseHistoryFile(&petsc_history));
1757:     petsc_history = NULL;
1758:   }
1759:   PetscCall(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton));
1760:   PetscCall(PetscInfoDestroy());

1762: #if !PetscDefined(HAVE_THREADSAFETY)
1763:   if (!PETSC_RUNNING_ON_VALGRIND) {
1764:     char  fname[PETSC_MAX_PATH_LEN];
1765:     char  sname[PETSC_MAX_PATH_LEN];
1766:     FILE *fd;
1767:     int   err;

1769:     flg2 = PETSC_FALSE;
1770:     flg3 = PETSC_FALSE;
1771:     if (PetscDefined(USE_DEBUG)) PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_test", &flg2, NULL));
1772:     PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_debug", &flg3, NULL));
1773:     fname[0] = 0;
1774:     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_dump", fname, sizeof(fname), &flg1));
1775:     if (flg1 && fname[0]) {
1776:       PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1777:       fd = fopen(sname, "w");
1778:       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1779:       PetscCall(PetscMallocDump(fd));
1780:       err = fclose(fd);
1781:       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1782:     } else if (flg1 || flg2 || flg3) {
1783:       MPI_Comm local_comm;

1785:       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1786:       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1787:       PetscCall(PetscMallocDump(stdout));
1788:       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1789:       PetscCallMPI(MPI_Comm_free(&local_comm));
1790:     }
1791:     fname[0] = 0;
1792:     PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_view", fname, sizeof(fname), &flg1));
1793:     if (flg1 && fname[0]) {
1794:       PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1795:       fd = fopen(sname, "w");
1796:       PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1797:       PetscCall(PetscMallocView(fd));
1798:       err = fclose(fd);
1799:       PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1800:     } else if (flg1) {
1801:       MPI_Comm local_comm;

1803:       PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1804:       PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1805:       PetscCall(PetscMallocView(stdout));
1806:       PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1807:       PetscCallMPI(MPI_Comm_free(&local_comm));
1808:     }
1809:   }
1810: #endif

1812:   /*
1813:      Close any open dynamic libraries
1814:   */
1815:   PetscCall(PetscFinalize_DynamicLibraries());

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

1820: #if PetscDefined(HAVE_NVSHMEM)
1821:   if (PetscBeganNvshmem) {
1822:     PetscCall(PetscNvshmemFinalize());
1823:     PetscBeganNvshmem = PETSC_FALSE;
1824:   }
1825: #endif

1827:   PetscCall(PetscFreeMPIResources());

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

1833:      If all PETSc objects were not destroyed those left over objects will have hanging references to
1834:      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1835:  */
1836:   {
1837:     PetscCommCounter *counter;
1838:     PetscMPIInt       flg;
1839:     MPI_Comm          icomm;
1840:     union
1841:     {
1842:       MPI_Comm comm;
1843:       void    *ptr;
1844:     } ucomm;
1845:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1846:     if (flg) {
1847:       icomm = ucomm.comm;
1848:       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1849:       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");

1851:       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval));
1852:       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1853:       PetscCallMPI(MPI_Comm_free(&icomm));
1854:     }
1855:     PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1856:     if (flg) {
1857:       icomm = ucomm.comm;
1858:       PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1859:       PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");

1861:       PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval));
1862:       PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1863:       PetscCallMPI(MPI_Comm_free(&icomm));
1864:     }
1865:   }

1867:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval));
1868:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval));
1869:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval));
1870:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval));
1871:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_CreationIdx_keyval));
1872:   PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Garbage_HMap_keyval));

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

1878:   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen));
1879:   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout));
1880:   PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr));
1881:   PetscCall(PetscSpinlockDestroy(&PetscCommSpinLock));

1883:   if (PetscBeganMPI) {
1884:     PetscMPIInt flag;
1885:     PetscCallMPI(MPI_Finalized(&flag));
1886:     PetscCheck(!flag, PETSC_COMM_SELF, PETSC_ERR_LIB, "MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1887:     /* wait until the very last moment to disable error handling */
1888:     PetscErrorHandlingInitialized = PETSC_FALSE;
1889:     PetscCallMPI(MPI_Finalize());
1890:   } else PetscErrorHandlingInitialized = PETSC_FALSE;

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

1901: */
1902:   PetscCall(PetscMallocClear());
1903:   PetscCall(PetscStackReset());

1905:   PetscInitializeCalled = PETSC_FALSE;
1906:   PetscFinalizeCalled   = PETSC_TRUE;
1907: #if PetscDefined(USE_COVERAGE)
1908:   /*
1909:      flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the
1910:      gcov files are still being added to the directories as git tries to remove the directories.
1911:    */
1912:   __gcov_flush();
1913: #endif
1914:   /* To match PetscFunctionBegin() at the beginning of this function */
1915:   PetscStackClearTop;
1916:   return PETSC_SUCCESS;
1917: }

1919: #if PetscDefined(MISSING_LAPACK_lsame_)
1920: PETSC_EXTERN int lsame_(char *a, char *b)
1921: {
1922:   if (*a == *b) return 1;
1923:   if (*a + 32 == *b) return 1;
1924:   if (*a - 32 == *b) return 1;
1925:   return 0;
1926: }
1927: #endif

1929: #if PetscDefined(MISSING_LAPACK_lsame)
1930: PETSC_EXTERN int lsame(char *a, char *b)
1931: {
1932:   if (*a == *b) return 1;
1933:   if (*a + 32 == *b) return 1;
1934:   if (*a - 32 == *b) return 1;
1935:   return 0;
1936: }
1937: #endif

1939: static inline PetscMPIInt MPIU_Allreduce_Count(const void *inbuf, void *outbuf, MPIU_Count count, MPI_Datatype dtype, MPI_Op op, MPI_Comm comm)
1940: {
1941:   PetscMPIInt err;
1942: #if !PetscDefined(HAVE_MPI_LARGE_COUNT)
1943:   PetscMPIInt count2;

1945:   PetscMPIIntCast_Internal(count, &count2);
1946:   err = MPI_Allreduce((void *)inbuf, outbuf, count2, dtype, op, comm);
1947: #else
1948:   err = MPI_Allreduce_c((void *)inbuf, outbuf, count, dtype, op, comm);
1949: #endif
1950:   return err;
1951: }

1953: /*
1954:      When count is 1 and dtype == MPIU_INT performs the reduction in PetscInt64 to check for integer overflow
1955: */
1956: PetscMPIInt MPIU_Allreduce_Private(const void *inbuf, void *outbuf, MPIU_Count count, MPI_Datatype dtype, MPI_Op op, MPI_Comm comm)
1957: {
1958:   PetscMPIInt err;
1959:   if (!PetscDefined(USE_64BIT_INDICES) && count == 1 && dtype == MPIU_INT && (op == MPI_SUM || op == MPI_PROD)) {
1960:     PetscInt64 incnt, outcnt;
1961:     void      *inbufd, *outbufd;

1963:     if (inbuf != MPI_IN_PLACE) {
1964:       incnt   = *(PetscInt32 *)inbuf;
1965:       inbufd  = &incnt;
1966:       outbufd = &outcnt;
1967:       err     = MPIU_Allreduce_Count(inbufd, outbufd, count, MPIU_INT64, op, comm);
1968:     } else {
1969:       outcnt  = *(PetscInt32 *)outbuf;
1970:       outbufd = &outcnt;
1971:       err     = MPIU_Allreduce_Count(MPI_IN_PLACE, outbufd, count, MPIU_INT64, op, comm);
1972:     }
1973:     if (!err && outcnt > PETSC_INT_MAX) err = MPI_ERR_OTHER;
1974:     *(PetscInt32 *)outbuf = (PetscInt32)outcnt;
1975:   } else {
1976:     err = MPIU_Allreduce_Count(inbuf, outbuf, count, dtype, op, comm);
1977:   }
1978:   return err;
1979: }

1981: // Check if MPIU_Allreduce() is called on the same filename:lineno and with the same data count across all processes. Error out if otherwise.
1982: PetscErrorCode PetscCheckAllreduceSameLineAndCount_Private(MPI_Comm comm, const char *filename, PetscMPIInt lineno, PetscMPIInt count)
1983: {
1984:   PetscMPIInt rbuf[4];

1986:   PetscFunctionBegin;
1987:   rbuf[0] = lineno;
1988:   rbuf[1] = -rbuf[0];
1989:   rbuf[2] = count;
1990:   rbuf[3] = -rbuf[2];
1991:   PetscCallMPI(MPI_Allreduce(MPI_IN_PLACE, rbuf, 4, MPI_INT, MPI_MAX, comm));

1993:   if (rbuf[0] != -rbuf[1]) {
1994:     size_t      len;
1995:     PetscMPIInt size, rank, ilen, *recvcounts = NULL, *displs = NULL;
1996:     char       *str = NULL, *str0 = NULL;

1998:     PetscCallMPI(MPI_Comm_size(comm, &size));
1999:     PetscCallMPI(MPI_Comm_rank(comm, &rank));
2000:     PetscCall(PetscStrlen(filename, &len));
2001:     len += 128; /* add enough space for the leading and trailing chars in PetscSNPrintf around __FILE__ */
2002:     PetscCall(PetscMalloc1(len, &str));
2003:     PetscCall(PetscSNPrintf(str, len, "                On process %d, %s:%d\n", rank, filename, lineno));
2004:     PetscCall(PetscStrlen(str, &len)); /* string length exclusive of the NULL terminator */
2005:     ilen = (PetscMPIInt)len;
2006:     if (rank == 0) PetscCall(PetscMalloc2(size, &recvcounts, size + 1, &displs));
2007:     PetscCallMPI(MPI_Gather(&ilen, 1, MPI_INT, recvcounts, 1, MPI_INT, 0, comm));
2008:     if (rank == 0) {
2009:       displs[0] = 0;
2010:       for (PetscMPIInt i = 0; i < size; i++) displs[i + 1] = displs[i] + recvcounts[i];
2011:       PetscCall(PetscMalloc1(displs[size], &str0));
2012:     }
2013:     PetscCallMPI(MPI_Gatherv(str, ilen, MPI_CHAR, str0, recvcounts, displs, MPI_CHAR, 0, comm));
2014:     if (rank == 0) str0[displs[size] - 1] = 0; /* replace the ending \n with NULL */
2015:     PetscCall(PetscFree(str));
2016:     if (rank == 0) PetscCall(PetscFree2(recvcounts, displs));
2017:     SETERRQ(comm, PETSC_ERR_PLIB, "MPIU_Allreduce() called in different locations on different processes:\n%s", str0);
2018:   }
2019:   PetscCheck(rbuf[2] == -rbuf[3], comm, PETSC_ERR_PLIB, "MPIU_Allreduce() called with different counts %d on different processes", count);
2020:   PetscFunctionReturn(PETSC_SUCCESS);
2021: }

2023: /*@
2024:   PetscCtxDestroyDefault - An implementation of a `PetscCtxDestroyFn` that uses `PetscFree()` to free the context

2026:   Input Parameter:
2027: . ctx - the context to be destroyed

2029:   Level: intermediate

2031:   Note:
2032:   This is not called directly, rather it is passed to `DMSetApplicationContextDestroy()`, `PetscContainerSetDestroy()`,
2033:   `PetscObjectContainterCreate()` and similar routines and then called by the destructor of the associated object.

2035: .seealso: `PetscObject`, `PetscCtxDestroyFn`, `PetscObjectDestroy()`, `DMSetApplicationContextDestroy()`,  `PetscContainerSetDestroy()`,
2036:            `PetscObjectContainterCreate()`
2037: @*/
2038: PETSC_EXTERN PetscErrorCode PetscCtxDestroyDefault(PetscCtxRt ctx)
2039: {
2040:   PetscFunctionBegin;
2041:   PetscCall(PetscFree(*(void **)ctx));
2042:   PetscFunctionReturn(PETSC_SUCCESS);
2043: }