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