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 <petscviewer.h>
8: #include <petsc/private/garbagecollector.h>
10: #if !defined(PETSC_HAVE_WINDOWS_COMPILERS)
11: #include <petsc/private/valgrind/valgrind.h>
12: #endif
14: #if defined(PETSC_USE_FORTRAN_BINDINGS)
15: #include <petsc/private/ftnimpl.h>
16: #endif
18: #if PetscDefined(USE_COVERAGE)
19: EXTERN_C_BEGIN
20: #if defined(PETSC_HAVE___GCOV_DUMP)
22: #endif
23: void __gcov_flush(void);
24: EXTERN_C_END
25: #endif
27: #if defined(PETSC_SERIALIZE_FUNCTIONS)
28: PETSC_INTERN PetscFPT PetscFPTData;
29: PetscFPT PetscFPTData = 0;
30: #endif
32: #if PetscDefined(HAVE_SAWS)
33: #include <petscviewersaws.h>
34: #endif
36: PETSC_INTERN FILE *petsc_history;
38: PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void);
39: PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void);
40: PETSC_INTERN PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm, int);
41: PETSC_INTERN PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm, int);
42: PETSC_INTERN PetscErrorCode PetscCloseHistoryFile(FILE **);
44: /* user may set these BEFORE calling PetscInitialize() */
45: MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL;
46: #if PetscDefined(HAVE_MPI_INIT_THREAD)
47: PetscMPIInt PETSC_MPI_THREAD_REQUIRED = PETSC_DECIDE;
48: #else
49: PetscMPIInt PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_SINGLE;
50: #endif
52: PetscMPIInt Petsc_Counter_keyval = MPI_KEYVAL_INVALID;
53: PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID;
54: PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID;
55: PetscMPIInt Petsc_ShmComm_keyval = MPI_KEYVAL_INVALID;
56: PetscMPIInt Petsc_CreationIdx_keyval = MPI_KEYVAL_INVALID;
57: PetscMPIInt Petsc_Garbage_HMap_keyval = MPI_KEYVAL_INVALID;
59: PetscMPIInt Petsc_SharedWD_keyval = MPI_KEYVAL_INVALID;
60: PetscMPIInt Petsc_SharedTmp_keyval = MPI_KEYVAL_INVALID;
62: /*
63: Declare and set all the string names of the PETSc enums
64: */
65: const char *const PetscBools[] = {"FALSE", "TRUE", "PetscBool", "PETSC_", NULL};
66: const char *const PetscBool3s[] = {"FALSE", "TRUE", "UNKNOWN", "PetscBool3", "PETSC_", NULL};
67: const char *const PetscCopyModes[] = {"COPY_VALUES", "OWN_POINTER", "USE_POINTER", "PetscCopyMode", "PETSC_", NULL};
69: PetscBool PetscPreLoadingUsed = PETSC_FALSE;
70: PetscBool PetscPreLoadingOn = PETSC_FALSE;
72: PetscInt PetscHotRegionDepth;
74: PetscBool PETSC_RUNNING_ON_VALGRIND = PETSC_FALSE;
76: #if defined(PETSC_HAVE_THREADSAFETY)
77: PetscSpinlock PetscViewerASCIISpinLockOpen;
78: PetscSpinlock PetscViewerASCIISpinLockStdout;
79: PetscSpinlock PetscViewerASCIISpinLockStderr;
80: PetscSpinlock PetscCommSpinLock;
81: #endif
83: extern PetscInt PetscNumBLASThreads;
85: /*@C
86: PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args
88: Collective, No Fortran Support
90: Input Parameters:
91: + argc - number of args
92: . args - array of command line arguments
93: . filename - optional name of the program file, pass `NULL` to ignore
94: - help - optional help, pass `NULL` to ignore
96: Level: advanced
98: Notes:
99: this is called only by the PETSc Julia interface. Even though it might start MPI it sets the flag to
100: indicate that it did NOT start MPI so that the `PetscFinalize()` does not end MPI, thus allowing `PetscInitialize()` to
101: be called multiple times from Julia without the problem of trying to initialize MPI more than once.
103: Developer Notes:
104: Turns off PETSc signal handling to allow Julia to manage signals
106: .seealso: `PetscInitialize()`, `PetscInitializeFortran()`, `PetscInitializeNoArguments()`
107: @*/
108: PetscErrorCode PetscInitializeNoPointers(int argc, char **args, const char *filename, const char *help)
109: {
110: int myargc = argc;
111: char **myargs = args;
113: PetscFunctionBegin;
114: PetscCall(PetscInitialize(&myargc, &myargs, filename, help));
115: PetscCall(PetscPopSignalHandler());
116: PetscBeganMPI = PETSC_FALSE;
117: PetscFunctionReturn(PETSC_SUCCESS);
118: }
120: /*@C
121: PetscInitializeNoArguments - Calls `PetscInitialize()` from C/C++ without
122: the command line arguments.
124: Collective
126: Level: advanced
128: .seealso: `PetscInitialize()`, `PetscInitializeFortran()`
129: @*/
130: PetscErrorCode PetscInitializeNoArguments(void) PeNS
131: {
132: int argc = 0;
133: char **args = NULL;
135: PetscFunctionBegin;
136: PetscCall(PetscInitialize(&argc, &args, NULL, NULL));
137: PetscFunctionReturn(PETSC_SUCCESS);
138: }
140: /*@
141: PetscInitialized - Determine whether PETSc is initialized.
143: Output Parameter:
144: . isInitialized - `PETSC_TRUE` if PETSc is initialized, `PETSC_FALSE` otherwise
146: Level: beginner
148: .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
149: @*/
150: PetscErrorCode PetscInitialized(PetscBool *isInitialized)
151: {
152: PetscFunctionBegin;
153: if (PetscInitializeCalled) PetscAssertPointer(isInitialized, 1);
154: *isInitialized = PetscInitializeCalled;
155: PetscFunctionReturn(PETSC_SUCCESS);
156: }
158: /*@
159: PetscFinalized - Determine whether `PetscFinalize()` has been called yet
161: Output Parameter:
162: . isFinalized - `PETSC_TRUE` if PETSc is finalized, `PETSC_FALSE` otherwise
164: Level: developer
166: .seealso: `PetscInitialize()`, `PetscInitializeNoArguments()`, `PetscInitializeFortran()`
167: @*/
168: PetscErrorCode PetscFinalized(PetscBool *isFinalized)
169: {
170: PetscFunctionBegin;
171: if (!PetscFinalizeCalled) PetscAssertPointer(isFinalized, 1);
172: *isFinalized = PetscFinalizeCalled;
173: PetscFunctionReturn(PETSC_SUCCESS);
174: }
176: PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Private(const char[]);
178: /*
179: This function is the MPI reduction operation used to compute the sum of the
180: first half of the datatype and the max of the second half.
181: */
182: MPI_Op MPIU_MAXSUM_OP = 0;
183: MPI_Op Petsc_Garbage_SetIntersectOp = 0;
185: PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
186: {
187: PetscFunctionBegin;
188: if (*datatype == MPIU_INT_MPIINT && PetscDefined(USE_64BIT_INDICES)) {
189: #if defined(PETSC_USE_64BIT_INDICES)
190: struct petsc_mpiu_int_mpiint *xin = (struct petsc_mpiu_int_mpiint *)in, *xout = (struct petsc_mpiu_int_mpiint *)out;
191: PetscMPIInt count = *cnt;
193: for (PetscMPIInt i = 0; i < count; i++) {
194: xout[i].a = PetscMax(xout[i].a, xin[i].a);
195: xout[i].b += xin[i].b;
196: }
197: #endif
198: } else if (*datatype == MPIU_2INT || *datatype == MPIU_INT_MPIINT) {
199: PetscInt *xin = (PetscInt *)in, *xout = (PetscInt *)out;
200: PetscMPIInt count = *cnt;
202: for (PetscMPIInt i = 0; i < count; i++) {
203: xout[2 * i] = PetscMax(xout[2 * i], xin[2 * i]);
204: xout[2 * i + 1] += xin[2 * i + 1];
205: }
206: } else {
207: PetscErrorCode ierr = (*PetscErrorPrintf)("Can only handle MPIU_2INT and MPIU_INT_MPIINT data types");
208: (void)ierr;
209: PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
210: }
211: PetscFunctionReturnVoid();
212: }
214: /*@
215: PetscMaxSum - Returns the max of the first entry over all MPI processes and the sum of the second entry.
217: Collective
219: Input Parameters:
220: + comm - the communicator
221: - array - an arry of length 2 times `size`, the number of MPI processes
223: Output Parameters:
224: + max - the maximum of `array[2*rank]` over all MPI processes
225: - sum - the sum of the `array[2*rank + 1]` over all MPI processes
227: Level: developer
229: .seealso: `PetscInitialize()`
230: @*/
231: PetscErrorCode PetscMaxSum(MPI_Comm comm, const PetscInt array[], PetscInt *max, PetscInt *sum)
232: {
233: PetscFunctionBegin;
234: #if defined(PETSC_HAVE_MPI_REDUCE_SCATTER_BLOCK)
235: {
236: struct {
237: PetscInt max, sum;
238: } work;
239: PetscCallMPI(MPI_Reduce_scatter_block((void *)array, &work, 1, MPIU_2INT, MPIU_MAXSUM_OP, comm));
240: *max = work.max;
241: *sum = work.sum;
242: }
243: #else
244: {
245: PetscMPIInt size, rank;
246: struct {
247: PetscInt max, sum;
248: } *work;
249: PetscCallMPI(MPI_Comm_size(comm, &size));
250: PetscCallMPI(MPI_Comm_rank(comm, &rank));
251: PetscCall(PetscMalloc1(size, &work));
252: PetscCallMPI(MPIU_Allreduce((void *)array, work, size, MPIU_2INT, MPIU_MAXSUM_OP, comm));
253: *max = work[rank].max;
254: *sum = work[rank].sum;
255: PetscCall(PetscFree(work));
256: }
257: #endif
258: PetscFunctionReturn(PETSC_SUCCESS);
259: }
261: #if (defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_SKIP_REAL___FLOAT128)) || (defined(PETSC_HAVE_REAL___FP16) && !defined(PETSC_SKIP_REAL___FP16))
262: #if defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_SKIP_REAL___FLOAT128)
263: #include <quadmath.h>
264: #endif
265: MPI_Op MPIU_SUM___FP16___FLOAT128 = 0;
266: #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
267: MPI_Op MPIU_SUM = 0;
268: #endif
270: PETSC_EXTERN void MPIAPI PetscSum_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
271: {
272: PetscMPIInt i, count = *cnt;
274: PetscFunctionBegin;
275: if (*datatype == MPIU_REAL) {
276: PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
277: for (i = 0; i < count; i++) xout[i] += xin[i];
278: }
279: #if defined(PETSC_HAVE_COMPLEX)
280: else if (*datatype == MPIU_COMPLEX) {
281: PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
282: for (i = 0; i < count; i++) xout[i] += xin[i];
283: }
284: #endif
285: #if defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_SKIP_REAL___FLOAT128)
286: else if (*datatype == MPIU___FLOAT128) {
287: __float128 *xin = (__float128 *)in, *xout = (__float128 *)out;
288: for (i = 0; i < count; i++) xout[i] += xin[i];
289: #if defined(PETSC_HAVE_COMPLEX)
290: } else if (*datatype == MPIU___COMPLEX128) {
291: __complex128 *xin = (__complex128 *)in, *xout = (__complex128 *)out;
292: for (i = 0; i < count; i++) xout[i] += xin[i];
293: #endif
294: }
295: #endif
296: #if defined(PETSC_HAVE_REAL___FP16) && !defined(PETSC_SKIP_REAL___FP16)
297: else if (*datatype == MPIU___FP16) {
298: __fp16 *xin = (__fp16 *)in, *xout = (__fp16 *)out;
299: for (i = 0; i < count; i++) xout[i] = (__fp16)(xin[i] + xout[i]);
300: }
301: #endif
302: else {
303: #if (!defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_SKIP_REAL___FLOAT128)) && (!defined(PETSC_HAVE_REAL___FP16) || defined(PETSC_SKIP_REAL___FP16))
304: PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
305: #elif !defined(PETSC_HAVE_REAL___FP16) || defined(PETSC_SKIP_REAL___FP16)
306: PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, or MPIU___COMPLEX128 data types"));
307: #elif !defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_SKIP_REAL___FLOAT128)
308: PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, or MPIU___FP16 data types"));
309: #else
310: PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL, MPIU_COMPLEX, MPIU___FLOAT128, MPIU___COMPLEX128, or MPIU___FP16 data types"));
311: #endif
312: PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
313: }
314: PetscFunctionReturnVoid();
315: }
316: #endif
318: #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
319: MPI_Op MPIU_MAX = 0;
320: MPI_Op MPIU_MIN = 0;
322: PETSC_EXTERN void MPIAPI PetscMax_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
323: {
324: PetscInt i, count = *cnt;
326: PetscFunctionBegin;
327: if (*datatype == MPIU_REAL) {
328: PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
329: for (i = 0; i < count; i++) xout[i] = PetscMax(xout[i], xin[i]);
330: }
331: #if defined(PETSC_HAVE_COMPLEX)
332: else if (*datatype == MPIU_COMPLEX) {
333: PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
334: for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) < PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
335: }
336: #endif
337: else {
338: PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"));
339: PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
340: }
341: PetscFunctionReturnVoid();
342: }
344: PETSC_EXTERN void MPIAPI PetscMin_Local(void *in, void *out, PetscMPIInt *cnt, MPI_Datatype *datatype)
345: {
346: PetscInt i, count = *cnt;
348: PetscFunctionBegin;
349: if (*datatype == MPIU_REAL) {
350: PetscReal *xin = (PetscReal *)in, *xout = (PetscReal *)out;
351: for (i = 0; i < count; i++) xout[i] = PetscMin(xout[i], xin[i]);
352: }
353: #if defined(PETSC_HAVE_COMPLEX)
354: else if (*datatype == MPIU_COMPLEX) {
355: PetscComplex *xin = (PetscComplex *)in, *xout = (PetscComplex *)out;
356: for (i = 0; i < count; i++) xout[i] = PetscRealPartComplex(xout[i]) > PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
357: }
358: #endif
359: else {
360: PetscCallAbort(MPI_COMM_SELF, (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"));
361: PETSCABORT(MPI_COMM_SELF, PETSC_ERR_ARG_WRONG);
362: }
363: PetscFunctionReturnVoid();
364: }
365: #endif
367: /*
368: Private routine to delete internal tag/name counter storage when a communicator is freed.
370: 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.
372: Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()
374: */
375: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_Counter_Attr_DeleteFn(MPI_Comm comm, PetscMPIInt keyval, void *count_val, void *extra_state)
376: {
377: PetscCommCounter *counter = (PetscCommCounter *)count_val;
378: struct PetscCommStash *comms = counter->comms, *pcomm;
380: PetscFunctionBegin;
381: PetscCallReturnMPI(PetscInfo(NULL, "Deleting counter data in an MPI_Comm %ld\n", (long)comm));
382: PetscCallReturnMPI(PetscFree(counter->iflags));
383: while (comms) {
384: PetscCallMPIReturnMPI(MPI_Comm_free(&comms->comm));
385: pcomm = comms;
386: comms = comms->next;
387: PetscCallReturnMPI(PetscFree(pcomm));
388: }
389: PetscCallReturnMPI(PetscFree(counter));
390: PetscFunctionReturn(MPI_SUCCESS);
391: }
393: /*
394: This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Comm_delete_attr) or when the user
395: calls MPI_Comm_free().
397: This is the only entry point for breaking the links between inner and outer comms.
399: This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator.
401: Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()
403: */
404: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_InnerComm_Attr_DeleteFn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
405: {
406: union
407: {
408: MPI_Comm comm;
409: void *ptr;
410: } icomm;
412: PetscFunctionBegin;
413: PetscCheckReturnMPI(keyval == Petsc_InnerComm_keyval, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Unexpected keyval");
414: icomm.ptr = attr_val;
415: if (PetscDefined(USE_DEBUG)) {
416: /* Error out if the inner/outer comms are not correctly linked through their Outer/InnterComm attributes */
417: PetscMPIInt flg;
418: union
419: {
420: MPI_Comm comm;
421: void *ptr;
422: } ocomm;
423: PetscCallMPIReturnMPI(MPI_Comm_get_attr(icomm.comm, Petsc_OuterComm_keyval, &ocomm, &flg));
424: PetscCheckReturnMPI(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm does not have OuterComm attribute");
425: PetscCheckReturnMPI(ocomm.comm == comm, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner comm's OuterComm attribute does not point to outer PETSc comm");
426: }
427: PetscCallMPIReturnMPI(MPI_Comm_delete_attr(icomm.comm, Petsc_OuterComm_keyval));
428: PetscCallReturnMPI(PetscInfo(NULL, "User MPI_Comm %ld is being unlinked from inner PETSc comm %ld\n", (long)comm, (long)icomm.comm));
429: PetscFunctionReturn(MPI_SUCCESS);
430: }
432: /*
433: * 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.
434: */
435: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_OuterComm_Attr_DeleteFn(MPI_Comm comm, PetscMPIInt keyval, void *attr_val, void *extra_state)
436: {
437: PetscFunctionBegin;
438: PetscCallReturnMPI(PetscInfo(NULL, "Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n", (long)comm));
439: PetscFunctionReturn(MPI_SUCCESS);
440: }
442: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_ShmComm_Attr_DeleteFn(MPI_Comm, PetscMPIInt, void *, void *);
444: #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
445: PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype, MPI_Aint *, void *);
446: PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
447: PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void *, MPI_Datatype, PetscMPIInt, void *, MPI_Offset, void *);
448: #endif
450: PetscMPIInt PETSC_MPI_ERROR_CLASS = MPI_ERR_LASTCODE, PETSC_MPI_ERROR_CODE;
452: PETSC_INTERN int PetscGlobalArgc;
453: PETSC_INTERN char **PetscGlobalArgs, **PetscGlobalArgsFortran;
454: int PetscGlobalArgc = 0;
455: char **PetscGlobalArgs = NULL;
456: char **PetscGlobalArgsFortran = NULL;
457: PetscSegBuffer PetscCitationsList;
459: PetscErrorCode PetscCitationsInitialize(void)
460: {
461: PetscFunctionBegin;
462: PetscCall(PetscSegBufferCreate(1, 10000, &PetscCitationsList));
464: PetscCall(PetscCitationsRegister("@TechReport{petsc-user-ref,\n\
465: Author = {Satish Balay and Shrirang Abhyankar and Mark~F. Adams and Steven Benson and Jed Brown\n\
466: and Peter Brune and Kris Buschelman and Emil Constantinescu and Lisandro Dalcin and Alp Dener\n\
467: and Victor Eijkhout and Jacob Faibussowitsch and William~D. Gropp and V\'{a}clav Hapla and Tobin Isaac and Pierre Jolivet\n\
468: and Dmitry Karpeev and Dinesh Kaushik and Matthew~G. Knepley and Fande Kong and Scott Kruger\n\
469: and Dave~A. May and Lois Curfman McInnes and Richard Tran Mills and Lawrence Mitchell and Todd Munson\n\
470: and Jose~E. Roman and Karl Rupp and Patrick Sanan and Jason Sarich and Barry~F. Smith and Hansol Suh\n\
471: and Stefano Zampini and Hong Zhang and Hong Zhang and Junchao Zhang},\n\
472: Title = {{PETSc/TAO} Users Manual},\n\
473: Number = {ANL-21/39 - Revision 3.25},\n\
474: Doi = {10.2172/2998643},\n\
475: Institution = {Argonne National Laboratory},\n\
476: Year = {2026}\n}\n",
477: NULL));
479: PetscCall(PetscCitationsRegister("@InProceedings{petsc-efficient,\n\
480: Author = {Satish Balay and William D. Gropp and Lois Curfman McInnes and Barry F. Smith},\n\
481: Title = {Efficient Management of Parallelism in Object Oriented Numerical Software Libraries},\n\
482: Booktitle = {Modern Software Tools in Scientific Computing},\n\
483: Editor = {E. Arge and A. M. Bruaset and H. P. Langtangen},\n\
484: Pages = {163--202},\n\
485: Publisher = {Birkh{\\\"{a}}user Press},\n\
486: Year = {1997}\n}\n",
487: NULL));
488: PetscFunctionReturn(PETSC_SUCCESS);
489: }
491: static char programname[PETSC_MAX_PATH_LEN] = ""; /* HP includes entire path in name */
493: /*@C
494: PetscSetProgramName - Set the program name reported by `PetscGetProgramName()`
496: Not Collective
498: Input Parameter:
499: . name - the program name to record
501: Level: developer
503: Note:
504: The program name is normally set automatically by `PetscInitialize()` from `argv[0]`; only call this directly when the
505: detected name is incorrect (for example when PETSc is embedded in a host application).
507: .seealso: `PetscGetProgramName()`, `PetscInitialize()`
508: @*/
509: PetscErrorCode PetscSetProgramName(const char name[])
510: {
511: PetscFunctionBegin;
512: PetscCall(PetscStrncpy(programname, name, sizeof(programname)));
513: PetscFunctionReturn(PETSC_SUCCESS);
514: }
516: /*@C
517: PetscGetProgramName - Gets the name of the running program.
519: Not Collective
521: Input Parameter:
522: . len - length of the string name
524: Output Parameter:
525: . name - the name of the running program, provide a string of length `PETSC_MAX_PATH_LEN`
527: Level: advanced
529: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArguments()`, `PetscInitialize()`
530: @*/
531: PetscErrorCode PetscGetProgramName(char name[], size_t len)
532: {
533: PetscFunctionBegin;
534: PetscCall(PetscStrncpy(name, programname, len));
535: PetscFunctionReturn(PETSC_SUCCESS);
536: }
538: /*@C
539: PetscGetArgs - Allows you to access the raw command line arguments anywhere
540: after `PetscInitialize()` is called but before `PetscFinalize()`.
542: Not Collective, No Fortran Support
544: Output Parameters:
545: + argc - count of the number of command line arguments
546: - args - the command line arguments
548: Level: intermediate
550: Notes:
551: This is usually used to pass the command line arguments into other libraries
552: that are called internally deep in PETSc or the application.
554: The first argument contains the program name as is normal for C programs.
556: See `PetscGetArguments()` for a variant of this routine.
558: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArguments()`, `PetscInitialize()`
559: @*/
560: PetscErrorCode PetscGetArgs(int *argc, char ***args)
561: {
562: PetscFunctionBegin;
563: PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
564: *argc = PetscGlobalArgc;
565: *args = PetscGlobalArgs;
566: PetscFunctionReturn(PETSC_SUCCESS);
567: }
569: /*@C
570: PetscGetArguments - Allows you to access the command line arguments anywhere
571: after `PetscInitialize()` is called but before `PetscFinalize()`.
573: Not Collective, No Fortran Support
575: Output Parameter:
576: . args - the command line arguments
578: Level: intermediate
580: Note:
581: This does NOT start with the program name and IS `NULL` terminated (the final argument is void)
583: Use `PetscFreeArguments()` to return the memory used by the arguments.
585: This makes a copy of the arguments and the array of arguments, while `PetscGetArgs()` does not make a copy,
586: it returns the array of arguments that was passed into the main program.
588: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscFreeArguments()`, `PetscInitialize()`
589: @*/
590: PetscErrorCode PetscGetArguments(char ***args)
591: {
592: PetscInt i, argc = PetscGlobalArgc;
594: PetscFunctionBegin;
595: PetscCheck(PetscInitializeCalled || !PetscFinalizeCalled, PETSC_COMM_SELF, PETSC_ERR_ORDER, "You must call after PetscInitialize() but before PetscFinalize()");
596: if (!argc) {
597: *args = NULL;
598: PetscFunctionReturn(PETSC_SUCCESS);
599: }
600: PetscCall(PetscMalloc1(argc, args));
601: for (i = 0; i < argc - 1; i++) PetscCall(PetscStrallocpy(PetscGlobalArgs[i + 1], &(*args)[i]));
602: (*args)[argc - 1] = NULL;
603: PetscFunctionReturn(PETSC_SUCCESS);
604: }
606: /*@C
607: PetscFreeArguments - Frees the memory obtained with `PetscGetArguments()`
609: Not Collective, No Fortran Support
611: Output Parameter:
612: . args - the command line arguments
614: Level: intermediate
616: Developer Note:
617: This should be PetscRestoreArguments()
619: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscGetArguments()`
620: @*/
621: PetscErrorCode PetscFreeArguments(char **args)
622: {
623: PetscFunctionBegin;
624: if (args) {
625: PetscInt i = 0;
627: while (args[i]) PetscCall(PetscFree(args[i++]));
628: PetscCall(PetscFree(args));
629: }
630: PetscFunctionReturn(PETSC_SUCCESS);
631: }
633: #if PetscDefined(HAVE_SAWS)
634: #include <petscconfiginfo.h>
636: PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char help[])
637: {
638: PetscFunctionBegin;
639: if (!PetscGlobalRank) {
640: char cert[PETSC_MAX_PATH_LEN], root[PETSC_MAX_PATH_LEN], *intro, programname[64], *appline, *options, version[64];
641: int port;
642: PetscBool flg, rootlocal = PETSC_FALSE, flg2, selectport = PETSC_FALSE;
643: size_t applinelen, introlen;
644: char sawsurl[256];
646: PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_log", &flg));
647: if (flg) {
648: char sawslog[PETSC_MAX_PATH_LEN];
650: PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_log", sawslog, sizeof(sawslog), NULL));
651: if (sawslog[0]) PetscCallSAWs(SAWs_Set_Use_Logfile, (sawslog));
652: else PetscCallSAWs(SAWs_Set_Use_Logfile, (NULL));
653: }
654: PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_https", cert, sizeof(cert), &flg));
655: if (flg) PetscCallSAWs(SAWs_Set_Use_HTTPS, (cert));
656: PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select", &selectport, NULL));
657: if (selectport) {
658: PetscCallSAWs(SAWs_Get_Available_Port, (&port));
659: PetscCallSAWs(SAWs_Set_Port, (port));
660: } else {
661: PetscCall(PetscOptionsGetInt(NULL, NULL, "-saws_port", &port, &flg));
662: if (flg) PetscCallSAWs(SAWs_Set_Port, (port));
663: }
664: PetscCall(PetscOptionsGetString(NULL, NULL, "-saws_root", root, sizeof(root), &flg));
665: if (flg) {
666: PetscCallSAWs(SAWs_Set_Document_Root, (root));
667: PetscCall(PetscStrcmp(root, ".", &rootlocal));
668: } else {
669: PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_options", &flg));
670: if (flg) {
671: PetscCall(PetscStrreplace(PETSC_COMM_WORLD, "${PETSC_DIR}/share/petsc/saws", root, sizeof(root)));
672: PetscCallSAWs(SAWs_Set_Document_Root, (root));
673: }
674: }
675: PetscCall(PetscOptionsHasName(NULL, NULL, "-saws_local", &flg2));
676: if (flg2) {
677: char jsdir[PETSC_MAX_PATH_LEN];
678: PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_SUP, "-saws_local option requires -saws_root option");
679: PetscCall(PetscSNPrintf(jsdir, sizeof(jsdir), "%s/js", root));
680: PetscCall(PetscTestDirectory(jsdir, 'r', &flg));
681: PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "-saws_local option requires js directory in root directory");
682: PetscCallSAWs(SAWs_Push_Local_Header, ());
683: }
684: PetscCall(PetscGetProgramName(programname, sizeof(programname)));
685: PetscCall(PetscStrlen(help, &applinelen));
686: introlen = 4096 + applinelen;
687: applinelen += 1024;
688: PetscCall(PetscMalloc(applinelen, &appline));
689: PetscCall(PetscMalloc(introlen, &intro));
691: if (rootlocal) {
692: PetscCall(PetscSNPrintf(appline, applinelen, "%s.c.html", programname));
693: PetscCall(PetscTestFile(appline, 'r', &rootlocal));
694: }
695: PetscCall(PetscOptionsGetAll(NULL, &options));
696: if (rootlocal && help) {
697: 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));
698: } else if (help) {
699: PetscCall(PetscSNPrintf(appline, applinelen, "<center>Running %s %s</center><br><center><pre>%s</pre></center><br>", programname, options, help));
700: } else {
701: PetscCall(PetscSNPrintf(appline, applinelen, "<center> Running %s %s</center><br>\n", programname, options));
702: }
703: PetscCall(PetscFree(options));
704: PetscCall(PetscGetVersion(version, sizeof(version)));
705: PetscCall(PetscSNPrintf(intro, introlen,
706: "<body>\n"
707: "<center><h2> <a href=\"https://petsc.org/\">PETSc</a> Application Web server powered by <a href=\"https://bitbucket.org/saws/saws\">SAWs</a> </h2></center>\n"
708: "<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"
709: "%s",
710: version, petscconfigureoptions, appline));
711: PetscCallSAWs(SAWs_Push_Body, ("index.html", 0, intro));
712: PetscCall(PetscFree(intro));
713: PetscCall(PetscFree(appline));
714: if (selectport) {
715: PetscBool silent;
717: /* another process may have grabbed the port so keep trying */
718: while (SAWs_Initialize()) {
719: PetscCallSAWs(SAWs_Get_Available_Port, (&port));
720: PetscCallSAWs(SAWs_Set_Port, (port));
721: }
723: PetscCall(PetscOptionsGetBool(NULL, NULL, "-saws_port_auto_select_silent", &silent, NULL));
724: if (!silent) {
725: PetscCallSAWs(SAWs_Get_FullURL, (sizeof(sawsurl), sawsurl));
726: PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Point your browser to %s for SAWs\n", sawsurl));
727: }
728: } else {
729: PetscCallSAWs(SAWs_Initialize, ());
730: }
731: PetscCall(PetscCitationsRegister("@TechReport{ saws,\n"
732: " Author = {Matt Otten and Jed Brown and Barry Smith},\n"
733: " Title = {Scientific Application Web Server (SAWs) Users Manual},\n"
734: " Institution = {Argonne National Laboratory},\n"
735: " Year = 2013\n}\n",
736: NULL));
737: }
738: PetscFunctionReturn(PETSC_SUCCESS);
739: }
740: #endif
742: /* Things must be done before MPI_Init() when MPI is not yet initialized, and can be shared between C init and Fortran init */
743: PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(void)
744: {
745: PetscFunctionBegin;
746: #if defined(PETSC_HAVE_HWLOC_SOLARIS_BUG)
747: /* see MPI.py for details on this bug */
748: (void)setenv("HWLOC_COMPONENTS", "-x86", 1);
749: #endif
750: PetscFunctionReturn(PETSC_SUCCESS);
751: }
753: #if PetscDefined(HAVE_ADIOS)
754: #include <adios.h>
755: #include <adios_read.h>
756: int64_t Petsc_adios_group;
757: #endif
758: #if PetscDefined(HAVE_OPENMP)
759: #include <omp.h>
760: PetscInt PetscNumOMPThreads;
761: #endif
763: #include <petsc/private/deviceimpl.h>
764: #if PetscDefined(HAVE_CUDA)
765: #include <petscdevice_cuda.h>
766: // REMOVE ME
767: cudaStream_t PetscDefaultCudaStream = NULL;
768: #endif
769: #if PetscDefined(HAVE_HIP)
770: #include <petscdevice_hip.h>
771: // REMOVE ME
772: hipStream_t PetscDefaultHipStream = NULL;
773: #endif
775: #if PetscDefined(HAVE_DLFCN_H)
776: #include <dlfcn.h>
777: #endif
778: PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
779: #if PetscDefined(HAVE_VIENNACL)
780: PETSC_EXTERN PetscErrorCode PetscViennaCLInit(void);
781: PetscBool PetscViennaCLSynchronize = PETSC_FALSE;
782: #endif
784: PetscBool PetscCIEnabled = PETSC_FALSE, PetscCIEnabledPortableErrorOutput = PETSC_FALSE;
786: /*
787: PetscInitialize_Common - shared code between C and Fortran initialization
789: prog: program name
790: file: optional PETSc database file name. Might be in Fortran string format when 'ftn' is true
791: help: program help message
792: ftn: is it called from Fortran initialization (petscinitializef_)?
793: len: length of file string, used when Fortran is true
794: */
795: PETSC_INTERN PetscErrorCode PetscInitialize_Common(const char *prog, const char *file, const char *help, PetscBool ftn, PetscInt len)
796: {
797: PetscMPIInt size;
798: PetscBool flg = PETSC_TRUE;
799: char hostname[256];
800: PetscBool blas_view_flag = PETSC_FALSE;
802: PetscFunctionBegin;
803: if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
804: /* these must be initialized in a routine, not as a constant declaration */
805: PETSC_STDOUT = stdout;
806: PETSC_STDERR = stderr;
808: /* PetscCall can be used from now */
809: PetscErrorHandlingInitialized = PETSC_TRUE;
811: /*
812: The checking over compatible runtime libraries is complicated by the MPI ABI initiative
813: https://wiki.mpich.org/mpich/index.php/ABI_Compatibility_Initiative which started with
814: MPICH v3.1 (Released February 2014)
815: IBM MPI v2.1 (December 2014)
816: Intel MPI Library v5.0 (2014)
817: Cray MPT v7.0.0 (June 2014)
818: As of July 31, 2017 the ABI number still appears to be 12, that is all of the versions
819: listed above and since that time are compatible.
821: Unfortunately the MPI ABI initiative has not defined a way to determine the ABI number
822: at compile time or runtime. Thus we will need to systematically track the allowed versions
823: and how they are represented in the mpi.h and MPI_Get_library_version() output in order
824: to perform the checking.
826: Currently we only check for pre MPI ABI versions (and packages that do not follow the MPI ABI).
828: Questions:
830: Should the checks for ABI incompatibility be only on the major version number below?
831: Presumably the output to stderr will be removed before a release.
832: */
834: #if defined(PETSC_HAVE_MPI_GET_LIBRARY_VERSION)
835: {
836: char mpilibraryversion[MPI_MAX_LIBRARY_VERSION_STRING];
837: PetscMPIInt mpilibraryversionlength;
839: PetscCallMPI(MPI_Get_library_version(mpilibraryversion, &mpilibraryversionlength));
840: /* check for MPICH versions before MPI ABI initiative */
841: #if defined(MPICH_VERSION)
842: #if MPICH_NUMVERSION < 30100000
843: {
844: char *ver, *lf;
845: PetscBool flg = PETSC_FALSE;
847: PetscCall(PetscStrstr(mpilibraryversion, "MPICH Version:", &ver));
848: if (ver) {
849: PetscCall(PetscStrchr(ver, '\n', &lf));
850: if (lf) {
851: *lf = 0;
852: PetscCall(PetscStrendswith(ver, MPICH_VERSION, &flg));
853: }
854: }
855: if (!flg) {
856: PetscCall(PetscInfo(NULL, "PETSc warning --- MPICH library version \n%s does not match what PETSc was compiled with %s.\n", mpilibraryversion, MPICH_VERSION));
857: flg = PETSC_TRUE;
858: }
859: }
860: #endif
861: /* 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?) */
862: #elif defined(PETSC_HAVE_OPENMPI)
863: {
864: char *ver, bs[MPI_MAX_LIBRARY_VERSION_STRING], *bsf;
865: PetscBool flg = PETSC_FALSE;
866: #define PSTRSZ 2
867: char ompistr1[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"Open MPI", "FUJITSU MPI"};
868: char ompistr2[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"v", "Library "};
869: int i;
870: for (i = 0; i < PSTRSZ; i++) {
871: PetscCall(PetscStrstr(mpilibraryversion, ompistr1[i], &ver));
872: if (ver) {
873: PetscCall(PetscSNPrintf(bs, MPI_MAX_LIBRARY_VERSION_STRING, "%s%d.%d", ompistr2[i], PETSC_PKG_OPENMPI_VERSION_MAJOR, PETSC_PKG_OPENMPI_VERSION_MINOR));
874: PetscCall(PetscStrstr(ver, bs, &bsf));
875: if (bsf) flg = PETSC_TRUE;
876: break;
877: }
878: }
879: if (!flg) {
880: 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));
881: flg = PETSC_TRUE;
882: }
883: }
884: #endif
885: }
886: #endif
888: #if defined(PETSC_HAVE_DLADDR) && !(defined(__cray__) && defined(__clang__))
889: /* 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 */
890: 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");
891: #endif
893: PetscCall(PetscOptionsCreateDefault());
895: PetscFinalizeCalled = PETSC_FALSE;
897: PetscCall(PetscSetProgramName(prog));
898: PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen));
899: PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout));
900: PetscCall(PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr));
901: PetscCall(PetscSpinlockCreate(&PetscCommSpinLock));
903: if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
904: PetscCallMPI(MPI_Comm_set_errhandler(PETSC_COMM_WORLD, MPI_ERRORS_RETURN));
906: if (PETSC_MPI_ERROR_CLASS == MPI_ERR_LASTCODE) {
907: PetscCallMPI(MPI_Add_error_class(&PETSC_MPI_ERROR_CLASS));
908: PetscCallMPI(MPI_Add_error_code(PETSC_MPI_ERROR_CLASS, &PETSC_MPI_ERROR_CODE));
909: }
911: /* Done after init due to a bug in MPICH-GM? */
912: PetscCall(PetscErrorPrintfInitialize());
914: PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &PetscGlobalRank));
915: PetscCallMPI(MPI_Comm_size(MPI_COMM_WORLD, &PetscGlobalSize));
917: MPIU_ENUM = MPI_INT;
918: MPIU_FORTRANADDR = (sizeof(void *) == sizeof(int)) ? MPI_INT : MPIU_INT64;
919: if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED;
920: else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG;
921: #if defined(PETSC_SIZEOF_LONG_LONG)
922: else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG;
923: #endif
924: else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_SUP_SYS, "Could not find MPI type for size_t");
926: /*
927: Initialized the global complex variable; this is because with
928: shared libraries the constructors for global variables
929: are not called; at least on IRIX.
930: */
931: #if defined(PETSC_HAVE_COMPLEX)
932: {
933: #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128)
934: PetscComplex ic(0.0, 1.0);
935: PETSC_i = ic;
936: #else
937: PETSC_i = _Complex_I;
938: #endif
939: }
940: #endif /* PETSC_HAVE_COMPLEX */
942: /*
943: Create the PETSc MPI reduction operator that sums of the first
944: half of the entries and maxes the second half.
945: */
946: PetscCallMPI(MPI_Op_create(MPIU_MaxSum_Local, 1, &MPIU_MAXSUM_OP));
948: #if defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_SKIP_REAL___FLOAT128)
949: PetscCallMPI(MPI_Type_contiguous(2, MPI_DOUBLE, &MPIU___FLOAT128));
950: PetscCallMPI(MPI_Type_commit(&MPIU___FLOAT128));
951: #if defined(PETSC_HAVE_COMPLEX)
952: PetscCallMPI(MPI_Type_contiguous(4, MPI_DOUBLE, &MPIU___COMPLEX128));
953: PetscCallMPI(MPI_Type_commit(&MPIU___COMPLEX128));
954: #endif
955: #endif
956: #if defined(PETSC_HAVE_REAL___FP16) && !defined(PETSC_SKIP_REAL___FP16)
957: PetscCallMPI(MPI_Type_contiguous(2, MPI_CHAR, &MPIU___FP16));
958: PetscCallMPI(MPI_Type_commit(&MPIU___FP16));
959: #endif
961: #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
962: PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM));
963: PetscCallMPI(MPI_Op_create(PetscMax_Local, 1, &MPIU_MAX));
964: PetscCallMPI(MPI_Op_create(PetscMin_Local, 1, &MPIU_MIN));
965: #elif (defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_SKIP_REAL___FLOAT128)) || (defined(PETSC_HAVE_REAL___FP16) && !defined(PETSC_SKIP_REAL___FP16))
966: PetscCallMPI(MPI_Op_create(PetscSum_Local, 1, &MPIU_SUM___FP16___FLOAT128));
967: #endif
969: PetscCallMPI(MPI_Type_contiguous(2, MPIU_SCALAR, &MPIU_2SCALAR));
970: PetscCallMPI(MPI_Op_create(PetscGarbageKeySortedIntersect, 1, &Petsc_Garbage_SetIntersectOp));
971: PetscCallMPI(MPI_Type_commit(&MPIU_2SCALAR));
973: /* create datatypes used by MPIU_MAXLOC, MPIU_MINLOC and PetscSplitReduction_Op */
974: #if !defined(PETSC_HAVE_MPIUNI)
975: {
976: PetscMPIInt blockSizes[2] = {1, 1};
977: MPI_Aint blockOffsets[2] = {offsetof(struct petsc_mpiu_real_int, v), offsetof(struct petsc_mpiu_real_int, i)};
978: MPI_Datatype blockTypes[2] = {MPIU_REAL, MPIU_INT}, tmpStruct;
980: PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
981: PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_real_int), &MPIU_REAL_INT));
982: PetscCallMPI(MPI_Type_free(&tmpStruct));
983: PetscCallMPI(MPI_Type_commit(&MPIU_REAL_INT));
984: }
985: {
986: PetscMPIInt blockSizes[2] = {1, 1};
987: MPI_Aint blockOffsets[2] = {offsetof(struct petsc_mpiu_scalar_int, v), offsetof(struct petsc_mpiu_scalar_int, i)};
988: MPI_Datatype blockTypes[2] = {MPIU_SCALAR, MPIU_INT}, tmpStruct;
990: PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
991: PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_scalar_int), &MPIU_SCALAR_INT));
992: PetscCallMPI(MPI_Type_free(&tmpStruct));
993: PetscCallMPI(MPI_Type_commit(&MPIU_SCALAR_INT));
994: }
995: #endif
997: #if defined(PETSC_USE_64BIT_INDICES)
998: PetscCallMPI(MPI_Type_contiguous(2, MPIU_INT, &MPIU_2INT));
999: PetscCallMPI(MPI_Type_commit(&MPIU_2INT));
1001: #if !defined(PETSC_HAVE_MPIUNI)
1002: {
1003: int blockSizes[] = {1, 1};
1004: MPI_Aint blockOffsets[] = {offsetof(struct petsc_mpiu_int_mpiint, a), offsetof(struct petsc_mpiu_int_mpiint, b)};
1005: MPI_Datatype blockTypes[] = {MPIU_INT, MPI_INT}, tmpStruct;
1007: PetscCallMPI(MPI_Type_create_struct(2, blockSizes, blockOffsets, blockTypes, &tmpStruct));
1008: PetscCallMPI(MPI_Type_create_resized(tmpStruct, 0, sizeof(struct petsc_mpiu_int_mpiint), &MPIU_INT_MPIINT));
1009: PetscCallMPI(MPI_Type_free(&tmpStruct));
1010: PetscCallMPI(MPI_Type_commit(&MPIU_INT_MPIINT));
1011: }
1012: #endif
1013: #endif
1014: PetscCallMPI(MPI_Type_contiguous(4, MPI_INT, &MPI_4INT));
1015: PetscCallMPI(MPI_Type_commit(&MPI_4INT));
1016: PetscCallMPI(MPI_Type_contiguous(4, MPIU_INT, &MPIU_4INT));
1017: PetscCallMPI(MPI_Type_commit(&MPIU_4INT));
1019: /*
1020: Attributes to be set on PETSc communicators
1021: */
1022: PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_Counter_Attr_DeleteFn, &Petsc_Counter_keyval, NULL));
1023: PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_InnerComm_Attr_DeleteFn, &Petsc_InnerComm_keyval, NULL));
1024: PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_OuterComm_Attr_DeleteFn, &Petsc_OuterComm_keyval, NULL));
1025: PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, Petsc_ShmComm_Attr_DeleteFn, &Petsc_ShmComm_keyval, NULL));
1026: PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_CreationIdx_keyval, NULL));
1027: PetscCallMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &Petsc_Garbage_HMap_keyval, NULL));
1029: #if defined(PETSC_USE_FORTRAN_BINDINGS)
1030: if (ftn) PetscCall(PetscInitFortran_Private(file, len));
1031: else
1032: #endif
1033: PetscCall(PetscOptionsInsert(NULL, &PetscGlobalArgc, &PetscGlobalArgs, file));
1035: if (PetscDefined(HAVE_MPIUNI)) {
1036: const char *mpienv = getenv("PMI_SIZE");
1037: if (!mpienv) mpienv = getenv("OMPI_COMM_WORLD_SIZE");
1038: if (mpienv) {
1039: PetscInt isize;
1040: PetscBool mflag = PETSC_FALSE;
1042: PetscCall(PetscOptionsStringToInt(mpienv, &isize));
1043: PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpiuni-allow-multiprocess-launch", &mflag, NULL));
1044: 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.");
1045: }
1046: }
1048: /* call a second time so it can look in the options database */
1049: PetscCall(PetscErrorPrintfInitialize());
1051: /*
1052: Check system options and print help
1053: */
1054: PetscCall(PetscOptionsCheckInitial_Private(help));
1056: /*
1057: Creates the logging data structures; this is enabled even if logging is not turned on
1058: This is the last thing we do before returning to the user code to prevent having the
1059: logging numbers contaminated by any startup time associated with MPI
1060: */
1061: PetscCall(PetscLogInitialize());
1063: /*
1064: Initialize PetscDevice and PetscDeviceContext
1066: Note to any future devs thinking of moving this, proper initialization requires:
1067: 1. MPI initialized
1068: 2. Options DB initialized
1069: 3. PETSc error handling initialized, specifically signal handlers. This expects to set up
1070: its own SIGSEV handler via the push/pop interface.
1071: 4. Logging initialized
1072: */
1073: PetscCall(PetscDeviceInitializeFromOptions_Internal(PETSC_COMM_WORLD));
1075: #if PetscDefined(HAVE_VIENNACL)
1076: flg = PETSC_FALSE;
1077: PetscCall(PetscOptionsHasName(NULL, NULL, "-log_view", &flg));
1078: if (!flg) PetscCall(PetscOptionsGetBool(NULL, NULL, "-viennacl_synchronize", &flg, NULL));
1079: PetscViennaCLSynchronize = flg;
1080: PetscCall(PetscViennaCLInit());
1081: #endif
1083: PetscCall(PetscCitationsInitialize());
1085: #if defined(PETSC_HAVE_SAWS)
1086: PetscCall(PetscInitializeSAWs(ftn ? NULL : help));
1087: flg = PETSC_FALSE;
1088: PetscCall(PetscOptionsHasName(NULL, NULL, "-stack_view", &flg));
1089: if (flg) PetscCall(PetscStackViewSAWs());
1090: #endif
1092: /*
1093: Load the dynamic libraries (on machines that support them), this registers all
1094: the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
1095: */
1096: PetscCall(PetscInitialize_DynamicLibraries());
1098: PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size));
1099: PetscCall(PetscInfo(NULL, "PETSc successfully started: number of processors = %d\n", size));
1100: PetscCall(PetscGetHostName(hostname, sizeof(hostname)));
1101: PetscCall(PetscInfo(NULL, "Running on machine: %s\n", hostname));
1102: #if defined(PETSC_HAVE_OPENMP)
1103: {
1104: PetscBool omp_view_flag;
1105: char *threads = getenv("OMP_NUM_THREADS");
1107: if (threads) {
1108: PetscCall(PetscInfo(NULL, "Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n", threads));
1109: (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumOMPThreads);
1110: } else {
1111: PetscNumOMPThreads = (PetscInt)omp_get_max_threads();
1112: PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n", PetscNumOMPThreads));
1113: }
1114: PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "OpenMP options", "Sys");
1115: PetscCall(PetscOptionsInt("-omp_num_threads", "Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS", "None", PetscNumOMPThreads, &PetscNumOMPThreads, &flg));
1116: PetscCall(PetscOptionsName("-omp_view", "Display OpenMP number of threads", NULL, &omp_view_flag));
1117: PetscOptionsEnd();
1118: if (flg) {
1119: PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (given by -omp_num_threads)\n", PetscNumOMPThreads));
1120: omp_set_num_threads((int)PetscNumOMPThreads);
1121: }
1122: if (omp_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "OpenMP: number of threads %" PetscInt_FMT "\n", PetscNumOMPThreads));
1123: }
1124: #endif
1126: PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "BLAS options", "Sys");
1127: PetscCall(PetscOptionsName("-blas_view", "Display number of threads to use for BLAS operations", NULL, &blas_view_flag));
1128: #if defined(PETSC_HAVE_BLI_THREAD_SET_NUM_THREADS) || defined(PETSC_HAVE_MKL_SET_NUM_THREADS) || defined(PETSC_HAVE_OPENBLAS_SET_NUM_THREADS)
1129: {
1130: char *threads = NULL;
1132: /* determine any default number of threads requested in the environment; TODO: Apple libraries? */
1133: #if defined(PETSC_HAVE_BLI_THREAD_SET_NUM_THREADS)
1134: threads = getenv("BLIS_NUM_THREADS");
1135: if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of BLIS threads %s given by BLIS_NUM_THREADS\n", threads));
1136: if (!threads) {
1137: threads = getenv("OMP_NUM_THREADS");
1138: if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of BLIS threads %s given by OMP_NUM_THREADS\n", threads));
1139: }
1140: #elif defined(PETSC_HAVE_MKL_SET_NUM_THREADS)
1141: threads = getenv("MKL_NUM_THREADS");
1142: if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of MKL threads %s given by MKL_NUM_THREADS\n", threads));
1143: if (!threads) {
1144: threads = getenv("OMP_NUM_THREADS");
1145: if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of MKL threads %s given by OMP_NUM_THREADS\n", threads));
1146: }
1147: #elif defined(PETSC_HAVE_OPENBLAS_SET_NUM_THREADS)
1148: threads = getenv("OPENBLAS_NUM_THREADS");
1149: if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of OpenBLAS threads %s given by OPENBLAS_NUM_THREADS\n", threads));
1150: if (!threads) {
1151: threads = getenv("OMP_NUM_THREADS");
1152: if (threads) PetscCall(PetscInfo(NULL, "BLAS: Environment number of OpenBLAS threads %s given by OMP_NUM_THREADS\n", threads));
1153: }
1154: #endif
1155: if (threads) (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumBLASThreads);
1156: PetscCall(PetscOptionsInt("-blas_num_threads", "Number of threads to use for BLAS operations", "None", PetscNumBLASThreads, &PetscNumBLASThreads, &flg));
1157: if (flg) PetscCall(PetscInfo(NULL, "BLAS: Command line number of BLAS thread %" PetscInt_FMT "given by -blas_num_threads\n", PetscNumBLASThreads));
1158: if (flg || threads) {
1159: PetscCall(PetscBLASSetNumThreads(PetscNumBLASThreads));
1160: if (blas_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "BLAS: number of threads %" PetscInt_FMT "\n", PetscNumBLASThreads));
1161: }
1162: }
1163: #elif defined(PETSC_HAVE_APPLE_ACCELERATE)
1164: PetscCall(PetscInfo(NULL, "BLAS: Apple Accelerate library, thread support with no user control\n"));
1165: if (blas_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "BLAS: Apple Accelerate library, thread support with no user control\n"));
1166: #else
1167: if (blas_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "BLAS: no thread support\n"));
1168: #endif
1169: PetscOptionsEnd();
1171: #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
1172: /*
1173: Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
1175: Currently not used because it is not supported by MPICH.
1176: */
1177: if (!PetscBinaryBigEndian()) PetscCallMPI(MPI_Register_datarep((char *)"petsc", PetscDataRep_read_conv_fn, PetscDataRep_write_conv_fn, PetscDataRep_extent_fn, NULL));
1178: #endif
1180: #if defined(PETSC_SERIALIZE_FUNCTIONS)
1181: PetscCall(PetscFPTCreate(10000));
1182: #endif
1184: #if defined(PETSC_HAVE_HWLOC)
1185: {
1186: PetscViewer viewer;
1187: PetscCall(PetscOptionsCreateViewer(PETSC_COMM_WORLD, NULL, NULL, "-process_view", &viewer, NULL, &flg));
1188: if (flg) {
1189: PetscCall(PetscProcessPlacementView(viewer));
1190: PetscCall(PetscViewerDestroy(&viewer));
1191: }
1192: }
1193: #endif
1195: flg = PETSC_TRUE;
1196: PetscCall(PetscOptionsGetBool(NULL, NULL, "-viewfromoptions", &flg, NULL));
1197: if (!flg) PetscCall(PetscOptionsPushCreateViewerOff(PETSC_TRUE));
1199: #if defined(PETSC_HAVE_ADIOS)
1200: PetscCallExternal(adios_init_noxml, PETSC_COMM_WORLD);
1201: PetscCallExternal(adios_declare_group, &Petsc_adios_group, "PETSc", "", adios_stat_default);
1202: PetscCallExternal(adios_select_method, Petsc_adios_group, "MPI", "", "");
1203: PetscCallExternal(adios_read_init_method, ADIOS_READ_METHOD_BP, PETSC_COMM_WORLD, "");
1204: #endif
1206: #if defined(__VALGRIND_H)
1207: PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND ? PETSC_TRUE : PETSC_FALSE;
1208: #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE)
1209: 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"));
1210: #endif
1211: #endif
1212: /*
1213: Set flag that we are completely initialized
1214: */
1215: PetscInitializeCalled = PETSC_TRUE;
1217: PetscCall(PetscOptionsHasName(NULL, NULL, "-python", &flg));
1218: if (flg) PetscCall(PetscPythonInitialize(NULL, NULL));
1220: PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1221: if (flg) PetscCall(PetscInfo(NULL, "Running MPI Linear Solver Server\n"));
1222: if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerBegin());
1223: 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");
1224: PetscFunctionReturn(PETSC_SUCCESS);
1225: }
1227: /*@
1228: PetscSetMPIThreadRequiredType - Set the MPI required thread level for when `PetscInitialize()` initializes MPI.
1230: Logically Collective
1232: Input Parameter:
1233: . required - the desired thread support, one of `MPI_THREAD_SINGLE`, `MPI_THREAD_FUNNELED`, `MPI_THREAD_SERIALIZED`, or `MPI_THREAD_MULTIPLE`.
1235: Level: intermediate
1237: Notes:
1238: This must be called before `PetscInitialize()`.
1240: Defaults to `MPI_THREAD_FUNNELED` when the MPI implementation provides `MPI_Init_thread()`, otherwise `MPI_THREAD_SINGLE`.
1242: This argument is used in the call to `MPI_Init_thread()` made by `PetscInitialize()`.
1244: Packages such as SLATE may require `MPI_THREAD_MULTIPLE`.
1246: The same value must be set on all MPI processes.
1248: .seealso: `PetscInitialize()`
1249: @*/
1250: PetscErrorCode PetscSetMPIThreadRequiredType(PetscMPIInt required)
1251: {
1252: PetscFunctionBegin;
1253: PETSC_MPI_THREAD_REQUIRED = required;
1254: PetscFunctionReturn(PETSC_SUCCESS);
1255: }
1257: // "Unknown section 'Environmental Variables'"
1258: // PetscClangLinter pragma disable: -fdoc-section-header-unknown
1259: /*@C
1260: PetscInitialize - Initializes the PETSc database and MPI.
1261: `PetscInitialize()` calls MPI_Init() if that has yet to be called,
1262: so this routine should always be called near the beginning of
1263: your program -- usually the very first line!
1265: Collective on `MPI_COMM_WORLD` or `PETSC_COMM_WORLD` if it has been set
1267: Input Parameters:
1268: + argc - count of number of command line arguments
1269: . args - the command line arguments
1270: . file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format.
1271: Use `NULL` or empty string to not check for code specific file.
1272: Also checks `~/.petscrc`, `.petscrc` and `petscrc`.
1273: Use `-skip_petscrc` in the code specific file (or command line) to skip `~/.petscrc`, `.petscrc` and `petscrc` files.
1274: - help - [optional] Help message to print, use `NULL` for no message
1276: If you wish PETSc code to run ONLY on a subcommunicator of `MPI_COMM_WORLD`, create that
1277: communicator first and assign it to `PETSC_COMM_WORLD` BEFORE calling `PetscInitialize()`.
1278: then do this. If ALL processes in the job are using `PetscInitialize()` and `PetscFinalize()` then you don't need to do this, even
1279: if different subcommunicators of the job are doing different things with PETSc.
1281: Options Database Keys:
1282: + -help [intro] - prints help method for each option; if `intro` is given the program stops after printing the introductory help message
1283: . -start_in_debugger [(noxterm)],[(gdb|lldb|...)] - Starts program in debugger
1284: . -on_error_attach_debugger [(noxterm)],[(gdb|lldb|...)] - Starts debugger when error detected
1285: . -on_error_emacs machinename - causes `emacsclient` to jump to error file if an error is detected
1286: . -on_error_abort - calls `abort()` when error detected (no traceback)
1287: . -on_error_mpiabort - calls `MPI_abort()` when error detected
1288: . -error_output_stdout - prints PETSc error messages to `stdout` instead of the default `stderr`
1289: . -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called)
1290: . -debugger_ranks rank1,rank2,... - Indicates MPI ranks to start in debugger
1291: . -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
1292: . -stop_for_debugger - Print message on how to attach debugger manually to
1293: process and wait (`-debugger_pause`) seconds for attachment
1294: . -malloc_dump - prints a list of all unfreed memory at the end of the run
1295: . -malloc_test - like `-malloc_dump` `-malloc_debug`, only active for debugging build, ignored in optimized build. Often set in `PETSC_OPTIONS` environmental variable
1296: . -malloc_view [filename] - show a list of all allocated memory during `PetscFinalize()`
1297: . -malloc_view_threshold t - only list memory allocations of size greater than t with `-malloc_view`
1298: . -malloc_requested_size - malloc logging will record the requested size rather than (possibly large) size after alignment
1299: . -fp_trap - Stops on floating point exceptions
1300: . -no_signal_handler - Indicates not to trap error signals
1301: . -python exe - Initializes Python, and optionally takes a Python executable name
1302: - -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
1304: Options Database Keys for Option Database:
1305: + -skip_petscrc - skip the default option files `~/.petscrc`, `.petscrc`, `petscrc`
1306: . -options_monitor - monitor all set options to standard output for the whole program run
1307: - -options_monitor_cancel - cancel options monitoring hard-wired using `PetscOptionsMonitorSet()`
1309: Options -options_monitor_{all,cancel} are
1310: position-independent and apply to all options set since the PETSc start.
1311: They can be used also in option files.
1313: See `PetscOptionsMonitorSet()` to do monitoring programmatically.
1315: Options Database Keys for Profiling:
1316: See Users-Manual: ch_profiling for details.
1317: + -info [filename][:[~]c1,c2,...[:[~]self]] - Prints verbose information for classes c1, c2, etc. See `PetscInfo()`.
1318: . -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event,
1319: however it slows things down and gives a distorted view of the overall runtime.
1320: . -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
1321: hangs without running in the debugger). See `PetscLogTraceBegin()`.
1322: . -log_view [:filename:format][,[:filename:format]...] - Prints summary of flop and timing information to screen or file, see `PetscLogView()` (up to 4 viewers)
1323: . -log_view_memory - Includes in the summary from -log_view the memory used in each event, see `PetscLogView()`.
1324: . -log_view_gpu_time - Includes in the summary from -log_view the time used in each GPU kernel, see `PetscLogView().
1325: . -log_view_gpu_energy - Includes in the summary from -log_view the energy (estimated with power*gtime) consumed in each GPU kernel, see `PetscLogView()`.
1326: . -log_view_gpu_energy_meter - Includes in the summary from -log_view the energy (readings from meters) consumed in each GPU kernel, see `PetscLogView()`.
1327: . -log_exclude: c1,c2,... - excludes subset of object classes from logging, for example vec,ksp would exclude the `Vec` and `KSP` classes
1328: . -log [filename] - Logs profiling information in a dump file, see `PetscLogDump()`.
1329: . -log_all [filename] - Same as `-log`.
1330: . -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
1331: . -log_perfstubs - Starts a log handler with the perfstubs interface (which is used by TAU)
1332: . -log_nvtx - Starts an nvtx log handler for use with Nsight
1333: . -log_roctx - Starts an roctx log handler for use with rocprof on AMD GPUs
1334: . -viewfromoptions on,off - Enable or disable `XXXSetFromOptions()` calls, for applications with many small solves turn this off
1335: . -get_total_flops - Returns total flops done by all processors
1336: . -memory_view - Print memory usage at end of run
1337: - -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code
1339: Options Database Keys for SAWs:
1340: + -saws_port portnumber - port number to publish SAWs data, default is 8080
1341: . -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen
1342: this is useful when you are running many jobs that utilize SAWs at the same time
1343: . -saws_log filename - save a log of all SAWs communication
1344: . -saws_https certificate_file - have SAWs use HTTPS instead of HTTP
1345: - -saws_root directory - allow SAWs to have access to the given directory to search for requested resources and files
1347: Environmental Variables:
1348: + `PETSC_TMP` - alternative directory to use instead of `/tmp`
1349: . `PETSC_SHARED_TMP` - `/tmp` is shared by all processes
1350: . `PETSC_NOT_SHARED_TMP` - each process has its own private `/tmp`
1351: . `PETSC_OPTIONS` - a string containing additional options for PETSc in the form of command line "-key value" pairs
1352: . `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
1353: . `PETSC_VIEWER_SOCKET_PORT` - socket number to use for socket viewer
1354: - `PETSC_VIEWER_SOCKET_MACHINE` - machine to use for socket viewer to connect to
1356: Level: beginner
1358: Notes:
1359: If for some reason you must call `MPI_Init()` separately from `PetscInitialize()`, call
1360: it before `PetscInitialize()`.
1362: If your program requires a particular level of thread support for MPI, see `MPI_Init_thread()`, you may call `PetscSetMPIThreadRequiredType()`
1363: before `PetscInitialize()` to indicate this.
1365: Fortran Notes:
1366: In Fortran this routine can be called with
1367: .vb
1368: call PetscInitialize(ierr)
1369: call PetscInitialize(file,ierr) or
1370: call PetscInitialize(file,help,ierr)
1371: .ve
1373: If your main program is C but you call Fortran code that also uses PETSc you need to call `PetscInitializeFortran()` soon after
1374: calling `PetscInitialize()`.
1376: Options Database Key for Developers:
1377: . -checkfunctionlist - automatically checks that function lists associated with objects are correctly cleaned up. Produces messages of the form:
1378: "function name: MatInodeGetInodeSizes_C" if they are not cleaned up. This flag is always set for the test harness (in framework.py)
1380: .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscInitializeNoArguments()`, `PetscLogGpuTime()`,
1381: `PetscSetMPIThreadRequiredType()`
1382: @*/
1383: PetscErrorCode PetscInitialize(int *argc, char ***args, const char file[], const char help[])
1384: {
1385: PetscMPIInt flag;
1386: const char *prog = "Unknown Name";
1388: PetscFunctionBegin;
1389: if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS);
1390: PetscCallMPI(MPI_Initialized(&flag));
1391: if (!flag) {
1392: 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");
1393: PetscCall(PetscPreMPIInit_Private());
1394: #if defined(PETSC_HAVE_MPI_INIT_THREAD)
1395: {
1396: PetscMPIInt provided;
1397: PetscCallMPI(MPI_Init_thread(argc, args, PETSC_MPI_THREAD_REQUIRED == PETSC_DECIDE ? MPI_THREAD_FUNNELED : PETSC_MPI_THREAD_REQUIRED, &provided));
1398: 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");
1399: if (PETSC_MPI_THREAD_REQUIRED == PETSC_DECIDE) PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_FUNNELED; // assign it a valid value after check-up
1400: }
1401: #else
1402: PetscCallMPI(MPI_Init(argc, args));
1403: #endif
1404: PetscBeganMPI = PETSC_TRUE;
1405: }
1407: if (argc && *argc) prog = **args;
1408: if (argc && args) {
1409: PetscGlobalArgc = *argc;
1410: PetscGlobalArgs = *args;
1411: }
1412: PetscCall(PetscInitialize_Common(prog, file, help, PETSC_FALSE, 0));
1413: PetscFunctionReturn(PETSC_SUCCESS);
1414: }
1416: PETSC_INTERN PetscObject *PetscObjects;
1417: PETSC_INTERN PetscInt PetscObjectsCounts;
1418: PETSC_INTERN PetscInt PetscObjectsMaxCounts;
1419: PETSC_INTERN PetscBool PetscObjectsLog;
1421: /*
1422: Frees all the MPI types and operations that PETSc may have created
1423: */
1424: PetscErrorCode PetscFreeMPIResources(void)
1425: {
1426: PetscFunctionBegin;
1427: #if defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_SKIP_REAL___FLOAT128)
1428: PetscCallMPI(MPI_Type_free(&MPIU___FLOAT128));
1429: #if defined(PETSC_HAVE_COMPLEX)
1430: PetscCallMPI(MPI_Type_free(&MPIU___COMPLEX128));
1431: #endif
1432: #endif
1433: #if defined(PETSC_HAVE_REAL___FP16) && !defined(PETSC_SKIP_REAL___FP16)
1434: PetscCallMPI(MPI_Type_free(&MPIU___FP16));
1435: #endif
1437: #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
1438: PetscCallMPI(MPI_Op_free(&MPIU_SUM));
1439: PetscCallMPI(MPI_Op_free(&MPIU_MAX));
1440: PetscCallMPI(MPI_Op_free(&MPIU_MIN));
1441: #elif (defined(PETSC_HAVE_REAL___FLOAT128) && !defined(PETSC_SKIP_REAL___FLOAT128)) || (defined(PETSC_HAVE_REAL___FP16) && !defined(PETSC_SKIP_REAL___FP16))
1442: PetscCallMPI(MPI_Op_free(&MPIU_SUM___FP16___FLOAT128));
1443: #endif
1445: PetscCallMPI(MPI_Type_free(&MPIU_2SCALAR));
1446: PetscCallMPI(MPI_Type_free(&MPIU_REAL_INT));
1447: PetscCallMPI(MPI_Type_free(&MPIU_SCALAR_INT));
1448: #if defined(PETSC_USE_64BIT_INDICES)
1449: PetscCallMPI(MPI_Type_free(&MPIU_2INT));
1450: PetscCallMPI(MPI_Type_free(&MPIU_INT_MPIINT));
1451: #endif
1452: PetscCallMPI(MPI_Type_free(&MPI_4INT));
1453: PetscCallMPI(MPI_Type_free(&MPIU_4INT));
1454: PetscCallMPI(MPI_Op_free(&MPIU_MAXSUM_OP));
1455: PetscCallMPI(MPI_Op_free(&Petsc_Garbage_SetIntersectOp));
1456: PetscFunctionReturn(PETSC_SUCCESS);
1457: }
1459: PETSC_INTERN PetscErrorCode PetscLogFinalize(void);
1460: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void *, int, const char[], const char[]);
1462: /*@
1463: PetscFinalize - Checks for options to be called at the conclusion of a PETSc program and frees any remaining PETSc objects and data structures.
1464: of the program. Automatically calls `MPI_Finalize()` if the user had not called `MPI_Init()` before calling `PetscInitialize()`.
1466: Collective on `PETSC_COMM_WORLD`
1468: Options Database Keys:
1469: + -options_view - Calls `PetscOptionsView()` to display all options in the database
1470: . -options_left - Prints unused options that remain in the database (default value is `true`)
1471: . -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
1472: . -mpidump - Calls PetscMPIDump()
1473: . -malloc_dump [filename] - Calls `PetscMallocDump()`, displays all memory allocated that has not been freed
1474: . -memory_view - Prints total memory usage
1475: - -malloc_view [filename] - Prints list of all memory allocated and in what functions
1477: Level: beginner
1479: Note:
1480: See `PetscInitialize()` for other runtime options.
1482: You can call `PetscInitialize()` after `PetscFinalize()` but only with MPI-Uni or if you called `MPI_Init()` before ever calling `PetscInitialize()`.
1484: .seealso: `PetscInitialize()`, `PetscOptionsView()`, `PetscMallocDump()`, `PetscMPIDump()`, `PetscEnd()`
1485: @*/
1486: PetscErrorCode PetscFinalize(void)
1487: {
1488: PetscMPIInt rank;
1489: PetscInt nopt;
1490: PetscBool flg1 = PETSC_FALSE, flg2 = PETSC_FALSE, flg3 = PETSC_FALSE;
1491: PetscBool flg;
1492: char mname[PETSC_MAX_PATH_LEN];
1494: PetscFunctionBegin;
1495: PetscCheck(PetscInitializeCalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscInitialize() must be called before PetscFinalize()");
1496: PetscCall(PetscInfo(NULL, "PetscFinalize() called\n"));
1498: PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg));
1499: if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerEnd());
1501: PetscCall(PetscFreeAlign(PetscGlobalArgsFortran, 0, NULL, NULL));
1502: PetscGlobalArgc = 0;
1503: PetscGlobalArgs = NULL;
1505: /* Clean up Garbage automatically on COMM_SELF and COMM_WORLD at finalize */
1506: {
1507: union
1508: {
1509: MPI_Comm comm;
1510: void *ptr;
1511: } ucomm;
1512: PetscMPIInt flg;
1513: void *tmp;
1515: PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1516: if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1517: if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_SELF));
1518: PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1519: if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg));
1520: if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_WORLD));
1521: }
1523: PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
1524: #if defined(PETSC_HAVE_ADIOS)
1525: PetscCallExternal(adios_read_finalize_method, ADIOS_READ_METHOD_BP_AGGREGATE);
1526: PetscCallExternal(adios_finalize, rank);
1527: #endif
1528: PetscCall(PetscOptionsHasName(NULL, NULL, "-citations", &flg));
1529: if (flg) {
1530: char *cits, filename[PETSC_MAX_PATH_LEN];
1531: FILE *fd = PETSC_STDOUT;
1533: PetscCall(PetscOptionsGetString(NULL, NULL, "-citations", filename, sizeof(filename), NULL));
1534: if (filename[0]) PetscCall(PetscFOpen(PETSC_COMM_WORLD, filename, "w", &fd));
1535: PetscCall(PetscSegBufferGet(PetscCitationsList, 1, &cits));
1536: cits[0] = 0;
1537: PetscCall(PetscSegBufferExtractAlloc(PetscCitationsList, &cits));
1538: PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "If you publish results based on this computation please cite the following:\n"));
1539: PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1540: PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "%s", cits));
1541: PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n"));
1542: PetscCall(PetscFClose(PETSC_COMM_WORLD, fd));
1543: PetscCall(PetscFree(cits));
1544: }
1545: PetscCall(PetscSegBufferDestroy(&PetscCitationsList));
1547: #if defined(PETSC_SERIALIZE_FUNCTIONS)
1548: PetscCall(PetscFPTDestroy());
1549: #endif
1551: #if defined(PETSC_HAVE_X)
1552: flg1 = PETSC_FALSE;
1553: PetscCall(PetscOptionsGetBool(NULL, NULL, "-x_virtual", &flg1, NULL));
1554: if (flg1) {
1555: /* this is a crude hack, but better than nothing */
1556: PetscCall(PetscPOpen(PETSC_COMM_WORLD, NULL, "pkill -15 Xvfb", "r", NULL));
1557: }
1558: #endif
1560: #if !defined(PETSC_HAVE_THREADSAFETY)
1561: PetscCall(PetscOptionsGetBool(NULL, NULL, "-memory_view", &flg2, NULL));
1562: if (flg2) PetscCall(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD, "Summary of Memory Usage in PETSc\n"));
1563: #endif
1565: if (PetscDefined(USE_LOG)) {
1566: flg1 = PETSC_FALSE;
1567: PetscCall(PetscOptionsGetBool(NULL, NULL, "-get_total_flops", &flg1, NULL));
1568: if (flg1) {
1569: PetscLogDouble flops = 0;
1570: PetscCallMPI(MPI_Reduce(&petsc_TotalFlops, &flops, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD));
1571: PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Total flops over all processors %g\n", flops));
1572: }
1573: }
1575: if (PetscDefined(USE_LOG) && PetscDefined(HAVE_MPE)) {
1576: mname[0] = 0;
1577: PetscCall(PetscOptionsGetString(NULL, NULL, "-log_mpe", mname, sizeof(mname), &flg1));
1578: if (flg1) PetscCall(PetscLogMPEDump(mname[0] ? mname : NULL));
1579: }
1581: #if defined(PETSC_HAVE_KOKKOS)
1582: // Free PETSc/kokkos stuff before the potentially non-null PETSc default gpu stream is destroyed by PetscObjectRegisterDestroyAll
1583: if (PetscKokkosInitialized) {
1584: PetscCall(PetscKokkosFinalize_Private());
1585: PetscKokkosInitialized = PETSC_FALSE;
1586: }
1587: #endif
1589: // Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1590: PetscCall(PetscObjectRegisterDestroyAll());
1592: if (PetscDefined(USE_LOG)) {
1593: PetscCall(PetscOptionsPushCreateViewerOff(PETSC_FALSE));
1594: PetscCall(PetscLogViewFromOptions());
1595: PetscCall(PetscOptionsPopCreateViewerOff());
1596: // It should be turned on with PetscLogGpuTime() and never turned off except in this place
1597: PetscLogGpuTimeFlag = PETSC_FALSE;
1599: // Free any objects created by the last block of code.
1600: PetscCall(PetscObjectRegisterDestroyAll());
1602: mname[0] = 0;
1603: PetscCall(PetscOptionsGetString(NULL, NULL, "-log_all", mname, sizeof(mname), &flg1));
1604: PetscCall(PetscOptionsGetString(NULL, NULL, "-log", mname, sizeof(mname), &flg2));
1605: if (flg1 || flg2) PetscCall(PetscLogDump(mname));
1606: }
1608: flg1 = PETSC_FALSE;
1609: PetscCall(PetscOptionsGetBool(NULL, NULL, "-no_signal_handler", &flg1, NULL));
1610: if (!flg1) PetscCall(PetscPopSignalHandler());
1611: flg1 = PETSC_FALSE;
1612: PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpidump", &flg1, NULL));
1613: if (flg1) PetscCall(PetscMPIDump(stdout));
1614: flg1 = PETSC_FALSE;
1615: flg2 = PETSC_FALSE;
1616: /* preemptive call to avoid listing this option in options table as unused */
1617: PetscCall(PetscOptionsHasName(NULL, NULL, "-malloc_dump", &flg1));
1618: PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1619: PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_view", &flg2, NULL));
1621: if (flg2) PetscCall(PetscOptionsView(NULL, PETSC_VIEWER_STDOUT_WORLD));
1623: /* to prevent PETSc -options_left from warning */
1624: PetscCall(PetscOptionsHasName(NULL, NULL, "-nox", &flg1));
1625: PetscCall(PetscOptionsHasName(NULL, NULL, "-nox_warning", &flg1));
1627: flg3 = PETSC_FALSE; /* default value is required */
1628: PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_left", &flg3, &flg1));
1629: if (!flg1) flg3 = PETSC_TRUE;
1630: if (flg3) {
1631: PetscCall(PetscOptionsAllUsed(NULL, &nopt));
1632: if (nopt) {
1633: PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! There are options you set that were not used!\n"));
1634: PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! could be spelling mistake, etc!\n"));
1635: if (nopt == 1) {
1636: PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There is one unused database option. It is:\n"));
1637: } else {
1638: PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are %" PetscInt_FMT " unused database options. They are:\n", nopt));
1639: }
1640: } else if (flg3 && flg1) {
1641: PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are no unused options.\n"));
1642: }
1643: PetscCall(PetscOptionsLeft(NULL));
1644: }
1646: #if defined(PETSC_HAVE_SAWS)
1647: if (!PetscGlobalRank) {
1648: PetscCall(PetscStackSAWsViewOff());
1649: PetscCallSAWs(SAWs_Finalize, ());
1650: }
1651: #endif
1653: /*
1654: List all objects the user may have forgot to free
1655: */
1656: if (PetscDefined(USE_LOG) && PetscObjectsLog) {
1657: PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1));
1658: if (flg1) {
1659: MPI_Comm local_comm;
1660: char string[64];
1662: PetscCall(PetscOptionsGetString(NULL, NULL, "-objects_dump", string, sizeof(string), NULL));
1663: PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1664: PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1665: PetscCall(PetscObjectsDump(stdout, (string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE));
1666: PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1667: PetscCallMPI(MPI_Comm_free(&local_comm));
1668: }
1669: }
1671: PetscObjectsCounts = 0;
1672: PetscObjectsMaxCounts = 0;
1673: PetscCall(PetscFree(PetscObjects));
1675: /*
1676: Destroy any packages that registered a finalize
1677: */
1678: PetscCall(PetscRegisterFinalizeAll());
1680: PetscCall(PetscLogFinalize());
1682: /*
1683: Print PetscFunctionLists that have not been properly freed
1684: */
1685: if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintAll());
1687: if (petsc_history) {
1688: PetscCall(PetscCloseHistoryFile(&petsc_history));
1689: petsc_history = NULL;
1690: }
1691: PetscCall(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton));
1692: PetscCall(PetscInfoDestroy());
1694: #if !defined(PETSC_HAVE_THREADSAFETY)
1695: if (!(PETSC_RUNNING_ON_VALGRIND)) {
1696: char fname[PETSC_MAX_PATH_LEN];
1697: char sname[PETSC_MAX_PATH_LEN];
1698: FILE *fd;
1699: int err;
1701: flg2 = PETSC_FALSE;
1702: flg3 = PETSC_FALSE;
1703: if (PetscDefined(USE_DEBUG)) PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_test", &flg2, NULL));
1704: PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_debug", &flg3, NULL));
1705: fname[0] = 0;
1706: PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_dump", fname, sizeof(fname), &flg1));
1707: if (flg1 && fname[0]) {
1708: PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1709: fd = fopen(sname, "w");
1710: PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1711: PetscCall(PetscMallocDump(fd));
1712: err = fclose(fd);
1713: PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1714: } else if (flg1 || flg2 || flg3) {
1715: MPI_Comm local_comm;
1717: PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1718: PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1719: PetscCall(PetscMallocDump(stdout));
1720: PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1721: PetscCallMPI(MPI_Comm_free(&local_comm));
1722: }
1723: fname[0] = 0;
1724: PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_view", fname, sizeof(fname), &flg1));
1725: if (flg1 && fname[0]) {
1726: PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank));
1727: fd = fopen(sname, "w");
1728: PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname);
1729: PetscCall(PetscMallocView(fd));
1730: err = fclose(fd);
1731: PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file");
1732: } else if (flg1) {
1733: MPI_Comm local_comm;
1735: PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm));
1736: PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1));
1737: PetscCall(PetscMallocView(stdout));
1738: PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1));
1739: PetscCallMPI(MPI_Comm_free(&local_comm));
1740: }
1741: }
1742: #endif
1744: /*
1745: Close any open dynamic libraries
1746: */
1747: PetscCall(PetscFinalize_DynamicLibraries());
1749: /* Can be destroyed only after all the options are used */
1750: PetscCall(PetscOptionsDestroyDefault());
1752: #if defined(PETSC_HAVE_NVSHMEM)
1753: if (PetscBeganNvshmem) {
1754: PetscCall(PetscNvshmemFinalize());
1755: PetscBeganNvshmem = PETSC_FALSE;
1756: }
1757: #endif
1759: PetscCall(PetscFreeMPIResources());
1761: /*
1762: Destroy any known inner MPI_Comm's and attributes pointing to them
1763: Note this will not destroy any new communicators the user has created.
1765: If all PETSc objects were not destroyed those left over objects will have hanging references to
1766: the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1767: */
1768: {
1769: PetscCommCounter *counter;
1770: PetscMPIInt flg;
1771: MPI_Comm icomm;
1772: union
1773: {
1774: MPI_Comm comm;
1775: void *ptr;
1776: } ucomm;
1777: PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg));
1778: if (flg) {
1779: icomm = ucomm.comm;
1780: PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1781: PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1783: PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval));
1784: PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1785: PetscCallMPI(MPI_Comm_free(&icomm));
1786: }
1787: PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg));
1788: if (flg) {
1789: icomm = ucomm.comm;
1790: PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg));
1791: PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1793: PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval));
1794: PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval));
1795: PetscCallMPI(MPI_Comm_free(&icomm));
1796: }
1797: }
1799: PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval));
1800: PetscCallMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval));
1801: PetscCallMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval));
1802: PetscCallMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval));
1803: PetscCallMPI(MPI_Comm_free_keyval(&Petsc_CreationIdx_keyval));
1804: PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Garbage_HMap_keyval));
1806: // Free keyvals which may be silently created by some routines
1807: if (Petsc_SharedWD_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedWD_keyval));
1808: if (Petsc_SharedTmp_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedTmp_keyval));
1810: PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen));
1811: PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout));
1812: PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr));
1813: PetscCall(PetscSpinlockDestroy(&PetscCommSpinLock));
1815: if (PetscBeganMPI) {
1816: PetscMPIInt flag;
1817: PetscCallMPI(MPI_Finalized(&flag));
1818: PetscCheck(!flag, PETSC_COMM_SELF, PETSC_ERR_LIB, "MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1819: /* wait until the very last moment to disable error handling */
1820: PetscErrorHandlingInitialized = PETSC_FALSE;
1821: PetscCallMPI(MPI_Finalize());
1822: } else PetscErrorHandlingInitialized = PETSC_FALSE;
1824: /*
1825: Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1826: the communicator has some outstanding requests on it. Specifically if the
1827: flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1828: src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1829: is never freed as it should be. Thus one may obtain messages of the form
1830: [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1831: memory was not freed.
1833: */
1834: PetscCall(PetscMallocClear());
1835: PetscCall(PetscStackReset());
1837: PetscInitializeCalled = PETSC_FALSE;
1838: PetscFinalizeCalled = PETSC_TRUE;
1839: #if defined(PETSC_USE_COVERAGE)
1840: /*
1841: flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the
1842: gcov files are still being added to the directories as git tries to remove the directories.
1843: */
1844: __gcov_flush();
1845: #endif
1846: /* To match PetscFunctionBegin() at the beginning of this function */
1847: PetscStackClearTop;
1848: return PETSC_SUCCESS;
1849: }
1851: #if defined(PETSC_MISSING_LAPACK_lsame_)
1852: PETSC_EXTERN int lsame_(char *a, char *b)
1853: {
1854: if (*a == *b) return 1;
1855: if (*a + 32 == *b) return 1;
1856: if (*a - 32 == *b) return 1;
1857: return 0;
1858: }
1859: #endif
1861: #if defined(PETSC_MISSING_LAPACK_lsame)
1862: PETSC_EXTERN int lsame(char *a, char *b)
1863: {
1864: if (*a == *b) return 1;
1865: if (*a + 32 == *b) return 1;
1866: if (*a - 32 == *b) return 1;
1867: return 0;
1868: }
1869: #endif
1871: static inline PetscMPIInt MPIU_Allreduce_Count(const void *inbuf, void *outbuf, MPIU_Count count, MPI_Datatype dtype, MPI_Op op, MPI_Comm comm)
1872: {
1873: PetscMPIInt err;
1874: #if !defined(PETSC_HAVE_MPI_LARGE_COUNT)
1875: PetscMPIInt count2;
1877: PetscMPIIntCast_Internal(count, &count2);
1878: err = MPI_Allreduce((void *)inbuf, outbuf, count2, dtype, op, comm);
1879: #else
1880: err = MPI_Allreduce_c((void *)inbuf, outbuf, count, dtype, op, comm);
1881: #endif
1882: return err;
1883: }
1885: /*
1886: When count is 1 and dtype == MPIU_INT performs the reduction in PetscInt64 to check for integer overflow
1887: */
1888: PetscMPIInt MPIU_Allreduce_Private(const void *inbuf, void *outbuf, MPIU_Count count, MPI_Datatype dtype, MPI_Op op, MPI_Comm comm)
1889: {
1890: PetscMPIInt err;
1891: if (!PetscDefined(USE_64BIT_INDICES) && count == 1 && dtype == MPIU_INT && (op == MPI_SUM || op == MPI_PROD)) {
1892: PetscInt64 incnt, outcnt;
1893: void *inbufd, *outbufd;
1895: if (inbuf != MPI_IN_PLACE) {
1896: incnt = *(PetscInt32 *)inbuf;
1897: inbufd = &incnt;
1898: outbufd = &outcnt;
1899: err = MPIU_Allreduce_Count(inbufd, outbufd, count, MPIU_INT64, op, comm);
1900: } else {
1901: outcnt = *(PetscInt32 *)outbuf;
1902: outbufd = &outcnt;
1903: err = MPIU_Allreduce_Count(MPI_IN_PLACE, outbufd, count, MPIU_INT64, op, comm);
1904: }
1905: if (!err && outcnt > PETSC_INT_MAX) err = MPI_ERR_OTHER;
1906: *(PetscInt32 *)outbuf = (PetscInt32)outcnt;
1907: } else {
1908: err = MPIU_Allreduce_Count(inbuf, outbuf, count, dtype, op, comm);
1909: }
1910: return err;
1911: }
1913: // Check if MPIU_Allreduce() is called on the same filename:lineno and with the same data count across all processes. Error out if otherwise.
1914: PetscErrorCode PetscCheckAllreduceSameLineAndCount_Private(MPI_Comm comm, const char *filename, PetscMPIInt lineno, PetscMPIInt count)
1915: {
1916: PetscMPIInt rbuf[4];
1918: PetscFunctionBegin;
1919: rbuf[0] = lineno;
1920: rbuf[1] = -rbuf[0];
1921: rbuf[2] = count;
1922: rbuf[3] = -rbuf[2];
1923: PetscCallMPI(MPI_Allreduce(MPI_IN_PLACE, rbuf, 4, MPI_INT, MPI_MAX, comm));
1925: if (rbuf[0] != -rbuf[1]) {
1926: size_t len;
1927: PetscMPIInt size, rank, ilen, *recvcounts = NULL, *displs = NULL;
1928: char *str = NULL, *str0 = NULL;
1930: PetscCallMPI(MPI_Comm_size(comm, &size));
1931: PetscCallMPI(MPI_Comm_rank(comm, &rank));
1932: PetscCall(PetscStrlen(filename, &len));
1933: len += 128; /* add enough space for the leading and trailing chars in PetscSNPrintf around __FILE__ */
1934: PetscCall(PetscMalloc1(len, &str));
1935: PetscCall(PetscSNPrintf(str, len, " On process %d, %s:%d\n", rank, filename, lineno));
1936: PetscCall(PetscStrlen(str, &len)); /* string length exclusive of the NULL terminator */
1937: ilen = (PetscMPIInt)len;
1938: if (rank == 0) PetscCall(PetscMalloc2(size, &recvcounts, size + 1, &displs));
1939: PetscCallMPI(MPI_Gather(&ilen, 1, MPI_INT, recvcounts, 1, MPI_INT, 0, comm));
1940: if (rank == 0) {
1941: displs[0] = 0;
1942: for (PetscMPIInt i = 0; i < size; i++) displs[i + 1] = displs[i] + recvcounts[i];
1943: PetscCall(PetscMalloc1(displs[size], &str0));
1944: }
1945: PetscCallMPI(MPI_Gatherv(str, ilen, MPI_CHAR, str0, recvcounts, displs, MPI_CHAR, 0, comm));
1946: if (rank == 0) str0[displs[size] - 1] = 0; /* replace the ending \n with NULL */
1947: PetscCall(PetscFree(str));
1948: if (rank == 0) PetscCall(PetscFree2(recvcounts, displs));
1949: SETERRQ(comm, PETSC_ERR_PLIB, "MPIU_Allreduce() called in different locations on different processes:\n%s", str0);
1950: }
1951: PetscCheck(rbuf[2] == -rbuf[3], comm, PETSC_ERR_PLIB, "MPIU_Allreduce() called with different counts %d on different processes", count);
1952: PetscFunctionReturn(PETSC_SUCCESS);
1953: }
1955: /*@C
1956: PetscCtxDestroyDefault - An implementation of a `PetscCtxDestroyFn` that uses `PetscFree()` to free the context
1958: Input Parameter:
1959: . ctx - the context to be destroyed
1961: Level: intermediate
1963: Note:
1964: This is not called directly, rather it is passed to `DMSetApplicationContextDestroy()`, `PetscContainerSetDestroy()`,
1965: `PetscObjectContainterCreate()` and similar routines and then called by the destructor of the associated object.
1967: .seealso: `PetscObject`, `PetscCtxDestroyFn`, `PetscObjectDestroy()`, `DMSetApplicationContextDestroy()`, `PetscContainerSetDestroy()`,
1968: `PetscObjectContainterCreate()`
1969: @*/
1970: PETSC_EXTERN PetscErrorCode PetscCtxDestroyDefault(PetscCtxRt ctx)
1971: {
1972: PetscFunctionBegin;
1973: PetscCall(PetscFree(*(void **)ctx));
1974: PetscFunctionReturn(PETSC_SUCCESS);
1975: }