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