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 /*@C 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 Notes: 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_view", &flg)); 1012 if (!flg) PetscCall(PetscOptionsGetBool(NULL, NULL, "-viennacl_synchronize", &flg, NULL)); 1013 PetscViennaCLSynchronize = flg; 1014 PetscCall(PetscViennaCLInit()); 1015 #endif 1016 1017 PetscCall(PetscCitationsInitialize()); 1018 1019 #if defined(PETSC_HAVE_SAWS) 1020 PetscCall(PetscInitializeSAWs(ftn ? NULL : help)); 1021 flg = PETSC_FALSE; 1022 PetscCall(PetscOptionsHasName(NULL, NULL, "-stack_view", &flg)); 1023 if (flg) PetscCall(PetscStackViewSAWs()); 1024 #endif 1025 1026 /* 1027 Load the dynamic libraries (on machines that support them), this registers all 1028 the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes) 1029 */ 1030 PetscCall(PetscInitialize_DynamicLibraries()); 1031 1032 PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD, &size)); 1033 PetscCall(PetscInfo(NULL, "PETSc successfully started: number of processors = %d\n", size)); 1034 PetscCall(PetscGetHostName(hostname, sizeof(hostname))); 1035 PetscCall(PetscInfo(NULL, "Running on machine: %s\n", hostname)); 1036 #if defined(PETSC_HAVE_OPENMP) 1037 { 1038 PetscBool omp_view_flag; 1039 char *threads = getenv("OMP_NUM_THREADS"); 1040 1041 if (threads) { 1042 PetscCall(PetscInfo(NULL, "Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n", threads)); 1043 (void)sscanf(threads, "%" PetscInt_FMT, &PetscNumOMPThreads); 1044 } else { 1045 PetscNumOMPThreads = (PetscInt)omp_get_max_threads(); 1046 PetscCall(PetscInfo(NULL, "Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n", PetscNumOMPThreads)); 1047 } 1048 PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "OpenMP options", "Sys"); 1049 PetscCall(PetscOptionsInt("-omp_num_threads", "Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS", "None", PetscNumOMPThreads, &PetscNumOMPThreads, &flg)); 1050 PetscCall(PetscOptionsName("-omp_view", "Display OpenMP number of threads", NULL, &omp_view_flag)); 1051 PetscOptionsEnd(); 1052 if (flg) { 1053 PetscCall(PetscInfo(NULL, "Number of OpenMP theads %" PetscInt_FMT " (given by -omp_num_threads)\n", PetscNumOMPThreads)); 1054 omp_set_num_threads((int)PetscNumOMPThreads); 1055 } 1056 if (omp_view_flag) PetscCall(PetscPrintf(PETSC_COMM_WORLD, "OpenMP: number of threads %" PetscInt_FMT "\n", PetscNumOMPThreads)); 1057 } 1058 #endif 1059 1060 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 1061 /* 1062 Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI 1063 1064 Currently not used because it is not supported by MPICH. 1065 */ 1066 if (!PetscBinaryBigEndian()) PetscCallMPI(MPI_Register_datarep((char *)"petsc", PetscDataRep_read_conv_fn, PetscDataRep_write_conv_fn, PetscDataRep_extent_fn, NULL)); 1067 #endif 1068 1069 #if defined(PETSC_SERIALIZE_FUNCTIONS) 1070 PetscCall(PetscFPTCreate(10000)); 1071 #endif 1072 1073 #if defined(PETSC_HAVE_HWLOC) 1074 { 1075 PetscViewer viewer; 1076 PetscCall(PetscOptionsGetViewer(PETSC_COMM_WORLD, NULL, NULL, "-process_view", &viewer, NULL, &flg)); 1077 if (flg) { 1078 PetscCall(PetscProcessPlacementView(viewer)); 1079 PetscCall(PetscViewerDestroy(&viewer)); 1080 } 1081 } 1082 #endif 1083 1084 flg = PETSC_TRUE; 1085 PetscCall(PetscOptionsGetBool(NULL, NULL, "-viewfromoptions", &flg, NULL)); 1086 if (!flg) PetscCall(PetscOptionsPushGetViewerOff(PETSC_TRUE)); 1087 1088 #if defined(PETSC_HAVE_ADIOS) 1089 PetscCallExternal(adios_init_noxml, PETSC_COMM_WORLD); 1090 PetscCallExternal(adios_declare_group, &Petsc_adios_group, "PETSc", "", adios_stat_default); 1091 PetscCallExternal(adios_select_method, Petsc_adios_group, "MPI", "", ""); 1092 PetscCallExternal(adios_read_init_method, ADIOS_READ_METHOD_BP, PETSC_COMM_WORLD, ""); 1093 #endif 1094 1095 #if defined(__VALGRIND_H) 1096 PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND ? PETSC_TRUE : PETSC_FALSE; 1097 #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE) 1098 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")); 1099 #endif 1100 #endif 1101 /* 1102 Set flag that we are completely initialized 1103 */ 1104 PetscInitializeCalled = PETSC_TRUE; 1105 1106 PetscCall(PetscOptionsHasName(NULL, NULL, "-python", &flg)); 1107 if (flg) PetscCall(PetscPythonInitialize(NULL, NULL)); 1108 1109 PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg)); 1110 if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerBegin()); 1111 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"); 1112 PetscFunctionReturn(PETSC_SUCCESS); 1113 } 1114 1115 /*@C 1116 PetscInitialize - Initializes the PETSc database and MPI. 1117 `PetscInitialize()` calls MPI_Init() if that has yet to be called, 1118 so this routine should always be called near the beginning of 1119 your program -- usually the very first line! 1120 1121 Collective on `MPI_COMM_WORLD` or `PETSC_COMM_WORLD` if it has been set 1122 1123 Input Parameters: 1124 + argc - count of number of command line arguments 1125 . args - the command line arguments 1126 . file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format. 1127 Use NULL or empty string to not check for code specific file. 1128 Also checks ~/.petscrc, .petscrc and petscrc. 1129 Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files. 1130 - help - [optional] Help message to print, use NULL for no message 1131 1132 If you wish PETSc code to run ONLY on a subcommunicator of `MPI_COMM_WORLD`, create that 1133 communicator first and assign it to `PETSC_COMM_WORLD` BEFORE calling `PetscInitialize()`. Thus if you are running a 1134 four process job and two processes will run PETSc and have `PetscInitialize()` and PetscFinalize() and two process will not, 1135 then do this. If ALL processes in the job are using `PetscInitialize()` and `PetscFinalize()` then you don't need to do this, even 1136 if different subcommunicators of the job are doing different things with PETSc. 1137 1138 Options Database Keys: 1139 + -help [intro] - prints help method for each option; if intro is given the program stops after printing the introductory help message 1140 . -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger 1141 . -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected 1142 . -on_error_emacs <machinename> - causes emacsclient to jump to error file 1143 . -on_error_abort - calls `abort()` when error detected (no traceback) 1144 . -on_error_mpiabort - calls `MPI_abort()` when error detected 1145 . -error_output_stdout - prints PETSc error messages to stdout instead of the default stderr 1146 . -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called) 1147 . -debugger_ranks [rank1,rank2,...] - Indicates ranks to start in debugger 1148 . -debugger_pause [sleeptime] (in seconds) - Pauses debugger 1149 . -stop_for_debugger - Print message on how to attach debugger manually to 1150 process and wait (-debugger_pause) seconds for attachment 1151 . -malloc_dump - prints a list of all unfreed memory at the end of the run 1152 . -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 1153 . -malloc_view - show a list of all allocated memory during `PetscFinalize()` 1154 . -malloc_view_threshold <t> - only list memory allocations of size greater than t with -malloc_view 1155 . -malloc_requested_size - malloc logging will record the requested size rather than size after alignment 1156 . -fp_trap - Stops on floating point exceptions 1157 . -no_signal_handler - Indicates not to trap error signals 1158 . -shared_tmp - indicates /tmp directory is shared by all processors 1159 . -not_shared_tmp - each processor has own /tmp 1160 . -tmp - alternative name of /tmp directory 1161 . -get_total_flops - returns total flops done by all processors 1162 - -memory_view - Print memory usage at end of run 1163 1164 Options Database Keys for Option Database: 1165 + -skip_petscrc - skip the default option files ~/.petscrc, .petscrc, petscrc 1166 . -options_monitor - monitor all set options to standard output for the whole program run 1167 - -options_monitor_cancel - cancel options monitoring hard-wired using `PetscOptionsMonitorSet()` 1168 1169 Options -options_monitor_{all,cancel} are 1170 position-independent and apply to all options set since the PETSc start. 1171 They can be used also in option files. 1172 1173 See `PetscOptionsMonitorSet()` to do monitoring programmatically. 1174 1175 Options Database Keys for Profiling: 1176 See Users-Manual: ch_profiling for details. 1177 + -info [filename][:[~]<list,of,classnames>[:[~]self]] - Prints verbose information. See `PetscInfo()`. 1178 . -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event, 1179 however it slows things down and gives a distorted view of the overall runtime. 1180 . -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program 1181 hangs without running in the debugger). See `PetscLogTraceBegin()`. 1182 . -log_view [:filename:format] - Prints summary of flop and timing information to screen or file, see `PetscLogView()`. 1183 . -log_view_memory - Includes in the summary from -log_view the memory used in each event, see `PetscLogView()`. 1184 . -log_view_gpu_time - Includes in the summary from -log_view the time used in each GPU kernel, see `PetscLogView(). 1185 . -log_exclude: <vec,mat,pc,ksp,snes> - excludes subset of object classes from logging 1186 . -log_all [filename] - Logs extensive profiling information See `PetscLogDump()`. 1187 . -log [filename] - Logs basic profiline information See `PetscLogDump()`. 1188 . -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution) 1189 . -viewfromoptions on,off - Enable or disable `XXXSetFromOptions()` calls, for applications with many small solves turn this off 1190 - -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code 1191 1192 Only one of -log_trace, -log_view, -log_all, -log, or -log_mpe may be used at a time 1193 1194 Options Database Keys for SAWs: 1195 + -saws_port <portnumber> - port number to publish SAWs data, default is 8080 1196 . -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen 1197 this is useful when you are running many jobs that utilize SAWs at the same time 1198 . -saws_log <filename> - save a log of all SAWs communication 1199 . -saws_https <certificate file> - have SAWs use HTTPS instead of HTTP 1200 - -saws_root <directory> - allow SAWs to have access to the given directory to search for requested resources and files 1201 1202 Environmental Variables: 1203 + `PETSC_TMP` - alternative tmp directory 1204 . `PETSC_SHARED_TMP` - tmp is shared by all processes 1205 . `PETSC_NOT_SHARED_TMP` - each process has its own private tmp 1206 . `PETSC_OPTIONS` - a string containing additional options for petsc in the form of command line "-key value" pairs 1207 . `PETSC_OPTIONS_YAML` - (requires configuring PETSc to use libyaml) a string containing additional options for petsc in the form of a YAML document 1208 . `PETSC_VIEWER_SOCKET_PORT` - socket number to use for socket viewer 1209 - `PETSC_VIEWER_SOCKET_MACHINE` - machine to use for socket viewer to connect to 1210 1211 Level: beginner 1212 1213 Note: 1214 If for some reason you must call `MPI_Init()` separately, call 1215 it before `PetscInitialize()`. 1216 1217 Fortran Notes: 1218 In Fortran this routine can be called with 1219 .vb 1220 call PetscInitialize(ierr) 1221 call PetscInitialize(file,ierr) or 1222 call PetscInitialize(file,help,ierr) 1223 .ve 1224 1225 If your main program is C but you call Fortran code that also uses PETSc you need to call `PetscInitializeFortran()` soon after 1226 calling `PetscInitialize()`. 1227 1228 Options Database Key for Developers: 1229 . -checkfunctionlist - automatically checks that function lists associated with objects are correctly cleaned up. Produces messages of the form: 1230 "function name: MatInodeGetInodeSizes_C" if they are not cleaned up. This flag is always set for the test harness (in framework.py) 1231 1232 .seealso: `PetscFinalize()`, `PetscInitializeFortran()`, `PetscGetArgs()`, `PetscInitializeNoArguments()`, `PetscLogGpuTime()` 1233 @*/ 1234 PetscErrorCode PetscInitialize(int *argc, char ***args, const char file[], const char help[]) 1235 { 1236 PetscMPIInt flag; 1237 const char *prog = "Unknown Name", *mpienv; 1238 1239 PetscFunctionBegin; 1240 if (PetscInitializeCalled) PetscFunctionReturn(PETSC_SUCCESS); 1241 PetscCallMPI(MPI_Initialized(&flag)); 1242 if (!flag) { 1243 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"); 1244 PetscCall(PetscPreMPIInit_Private()); 1245 #if defined(PETSC_HAVE_MPI_INIT_THREAD) 1246 { 1247 PetscMPIInt PETSC_UNUSED provided; 1248 PetscCallMPI(MPI_Init_thread(argc, args, PETSC_MPI_THREAD_REQUIRED, &provided)); 1249 } 1250 #else 1251 PetscCallMPI(MPI_Init(argc, args)); 1252 #endif 1253 if (PetscDefined(HAVE_MPIUNI)) { 1254 mpienv = getenv("PMI_SIZE"); 1255 if (!mpienv) mpienv = getenv("OMPI_COMM_WORLD_SIZE"); 1256 if (mpienv) { 1257 PetscInt isize; 1258 PetscCall(PetscOptionsStringToInt(mpienv, &isize)); 1259 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"); 1260 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"); 1261 } 1262 } 1263 PetscBeganMPI = PETSC_TRUE; 1264 } 1265 1266 if (argc && *argc) prog = **args; 1267 if (argc && args) { 1268 PetscGlobalArgc = *argc; 1269 PetscGlobalArgs = *args; 1270 } 1271 PetscCall(PetscInitialize_Common(prog, file, help, PETSC_FALSE, PETSC_FALSE, 0)); 1272 PetscFunctionReturn(PETSC_SUCCESS); 1273 } 1274 1275 #if PetscDefined(USE_LOG) 1276 PETSC_INTERN PetscObject *PetscObjects; 1277 PETSC_INTERN PetscInt PetscObjectsCounts; 1278 PETSC_INTERN PetscInt PetscObjectsMaxCounts; 1279 PETSC_INTERN PetscBool PetscObjectsLog; 1280 #endif 1281 1282 /* 1283 Frees all the MPI types and operations that PETSc may have created 1284 */ 1285 PetscErrorCode PetscFreeMPIResources(void) 1286 { 1287 PetscFunctionBegin; 1288 #if defined(PETSC_HAVE_REAL___FLOAT128) 1289 PetscCallMPI(MPI_Type_free(&MPIU___FLOAT128)); 1290 #if defined(PETSC_HAVE_COMPLEX) 1291 PetscCallMPI(MPI_Type_free(&MPIU___COMPLEX128)); 1292 #endif 1293 #endif 1294 #if defined(PETSC_HAVE_REAL___FP16) 1295 PetscCallMPI(MPI_Type_free(&MPIU___FP16)); 1296 #endif 1297 1298 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 1299 PetscCallMPI(MPI_Op_free(&MPIU_SUM)); 1300 PetscCallMPI(MPI_Op_free(&MPIU_MAX)); 1301 PetscCallMPI(MPI_Op_free(&MPIU_MIN)); 1302 #elif defined(PETSC_HAVE_REAL___FLOAT128) || defined(PETSC_HAVE_REAL___FP16) 1303 PetscCallMPI(MPI_Op_free(&MPIU_SUM___FP16___FLOAT128)); 1304 #endif 1305 1306 PetscCallMPI(MPI_Type_free(&MPIU_2SCALAR)); 1307 PetscCallMPI(MPI_Type_free(&MPIU_REAL_INT)); 1308 PetscCallMPI(MPI_Type_free(&MPIU_SCALAR_INT)); 1309 #if defined(PETSC_USE_64BIT_INDICES) 1310 PetscCallMPI(MPI_Type_free(&MPIU_2INT)); 1311 #endif 1312 PetscCallMPI(MPI_Type_free(&MPI_4INT)); 1313 PetscCallMPI(MPI_Type_free(&MPIU_4INT)); 1314 PetscCallMPI(MPI_Op_free(&MPIU_MAXSUM_OP)); 1315 PetscCallMPI(MPI_Op_free(&Petsc_Garbage_SetIntersectOp)); 1316 PetscFunctionReturn(PETSC_SUCCESS); 1317 } 1318 1319 #if PetscDefined(USE_LOG) 1320 PETSC_INTERN PetscErrorCode PetscLogFinalize(void); 1321 #endif 1322 1323 /*@C 1324 PetscFinalize - Checks for options to be called at the conclusion 1325 of the program. `MPI_Finalize()` is called only if the user had not 1326 called `MPI_Init()` before calling `PetscInitialize()`. 1327 1328 Collective on `PETSC_COMM_WORLD` 1329 1330 Options Database Keys: 1331 + -options_view - Calls `PetscOptionsView()` 1332 . -options_left - Prints unused options that remain in the database 1333 . -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 1334 . -mpidump - Calls PetscMPIDump() 1335 . -malloc_dump <optional filename> - Calls `PetscMallocDump()`, displays all memory allocated that has not been freed 1336 . -memory_view - Prints total memory usage 1337 - -malloc_view <optional filename> - Prints list of all memory allocated and in what functions 1338 1339 Level: beginner 1340 1341 Note: 1342 See `PetscInitialize()` for other runtime options. 1343 1344 .seealso: `PetscInitialize()`, `PetscOptionsView()`, `PetscMallocDump()`, `PetscMPIDump()`, `PetscEnd()` 1345 @*/ 1346 PetscErrorCode PetscFinalize(void) 1347 { 1348 PetscMPIInt rank; 1349 PetscInt nopt; 1350 PetscBool flg1 = PETSC_FALSE, flg2 = PETSC_FALSE, flg3 = PETSC_FALSE; 1351 PetscBool flg; 1352 #if defined(PETSC_USE_LOG) 1353 char mname[PETSC_MAX_PATH_LEN]; 1354 #endif 1355 1356 PetscFunctionBegin; 1357 PetscCheck(PetscInitializeCalled, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscInitialize() must be called before PetscFinalize()"); 1358 PetscCall(PetscInfo(NULL, "PetscFinalize() called\n")); 1359 1360 PetscCall(PetscOptionsHasName(NULL, NULL, "-mpi_linear_solver_server", &flg)); 1361 if (PetscDefined(USE_SINGLE_LIBRARY) && flg) PetscCall(PCMPIServerEnd()); 1362 1363 /* Clean up Garbage automatically on COMM_SELF and COMM_WORLD at finalize */ 1364 { 1365 union 1366 { 1367 MPI_Comm comm; 1368 void *ptr; 1369 } ucomm; 1370 PetscMPIInt flg; 1371 void *tmp; 1372 1373 PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg)); 1374 if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg)); 1375 if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_SELF)); 1376 PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg)); 1377 if (flg) PetscCallMPI(MPI_Comm_get_attr(ucomm.comm, Petsc_Garbage_HMap_keyval, &tmp, &flg)); 1378 if (flg) PetscCall(PetscGarbageCleanup(PETSC_COMM_WORLD)); 1379 } 1380 1381 PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank)); 1382 #if defined(PETSC_HAVE_ADIOS) 1383 PetscCallExternal(adios_read_finalize_method, ADIOS_READ_METHOD_BP_AGGREGATE); 1384 PetscCallExternal(adios_finalize, rank); 1385 #endif 1386 PetscCall(PetscOptionsHasName(NULL, NULL, "-citations", &flg)); 1387 if (flg) { 1388 char *cits, filename[PETSC_MAX_PATH_LEN]; 1389 FILE *fd = PETSC_STDOUT; 1390 1391 PetscCall(PetscOptionsGetString(NULL, NULL, "-citations", filename, sizeof(filename), NULL)); 1392 if (filename[0]) PetscCall(PetscFOpen(PETSC_COMM_WORLD, filename, "w", &fd)); 1393 PetscCall(PetscSegBufferGet(PetscCitationsList, 1, &cits)); 1394 cits[0] = 0; 1395 PetscCall(PetscSegBufferExtractAlloc(PetscCitationsList, &cits)); 1396 PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "If you publish results based on this computation please cite the following:\n")); 1397 PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n")); 1398 PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "%s", cits)); 1399 PetscCall(PetscFPrintf(PETSC_COMM_WORLD, fd, "===========================================================================\n")); 1400 PetscCall(PetscFClose(PETSC_COMM_WORLD, fd)); 1401 PetscCall(PetscFree(cits)); 1402 } 1403 PetscCall(PetscSegBufferDestroy(&PetscCitationsList)); 1404 1405 #if defined(PETSC_SERIALIZE_FUNCTIONS) 1406 PetscCall(PetscFPTDestroy()); 1407 #endif 1408 1409 #if defined(PETSC_HAVE_SAWS) 1410 flg = PETSC_FALSE; 1411 PetscCall(PetscOptionsGetBool(NULL, NULL, "-saw_options", &flg, NULL)); 1412 if (flg) PetscCall(PetscOptionsSAWsDestroy()); 1413 #endif 1414 1415 #if defined(PETSC_HAVE_X) 1416 flg1 = PETSC_FALSE; 1417 PetscCall(PetscOptionsGetBool(NULL, NULL, "-x_virtual", &flg1, NULL)); 1418 if (flg1) { 1419 /* this is a crude hack, but better than nothing */ 1420 PetscCall(PetscPOpen(PETSC_COMM_WORLD, NULL, "pkill -9 Xvfb", "r", NULL)); 1421 } 1422 #endif 1423 1424 #if !defined(PETSC_HAVE_THREADSAFETY) 1425 PetscCall(PetscOptionsGetBool(NULL, NULL, "-memory_view", &flg2, NULL)); 1426 if (flg2) PetscCall(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD, "Summary of Memory Usage in PETSc\n")); 1427 #endif 1428 1429 #if defined(PETSC_USE_LOG) 1430 flg1 = PETSC_FALSE; 1431 PetscCall(PetscOptionsGetBool(NULL, NULL, "-get_total_flops", &flg1, NULL)); 1432 if (flg1) { 1433 PetscLogDouble flops = 0; 1434 PetscCallMPI(MPI_Reduce(&petsc_TotalFlops, &flops, 1, MPI_DOUBLE, MPI_SUM, 0, PETSC_COMM_WORLD)); 1435 PetscCall(PetscPrintf(PETSC_COMM_WORLD, "Total flops over all processors %g\n", flops)); 1436 } 1437 #endif 1438 1439 #if defined(PETSC_USE_LOG) 1440 #if defined(PETSC_HAVE_MPE) 1441 mname[0] = 0; 1442 PetscCall(PetscOptionsGetString(NULL, NULL, "-log_mpe", mname, sizeof(mname), &flg1)); 1443 if (flg1) { 1444 if (mname[0]) PetscCall(PetscLogMPEDump(mname)); 1445 else PetscCall(PetscLogMPEDump(0)); 1446 } 1447 #endif 1448 #endif 1449 1450 /* 1451 Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_(). 1452 */ 1453 PetscCall(PetscObjectRegisterDestroyAll()); 1454 1455 #if defined(PETSC_USE_LOG) 1456 PetscCall(PetscOptionsPushGetViewerOff(PETSC_FALSE)); 1457 PetscCall(PetscLogViewFromOptions()); 1458 PetscCall(PetscOptionsPopGetViewerOff()); 1459 1460 /* 1461 Free any objects created by the last block of code. 1462 */ 1463 PetscCall(PetscObjectRegisterDestroyAll()); 1464 1465 mname[0] = 0; 1466 PetscCall(PetscOptionsGetString(NULL, NULL, "-log_all", mname, sizeof(mname), &flg1)); 1467 PetscCall(PetscOptionsGetString(NULL, NULL, "-log", mname, sizeof(mname), &flg2)); 1468 if (flg1 || flg2) PetscCall(PetscLogDump(mname)); 1469 #endif 1470 1471 flg1 = PETSC_FALSE; 1472 PetscCall(PetscOptionsGetBool(NULL, NULL, "-no_signal_handler", &flg1, NULL)); 1473 if (!flg1) PetscCall(PetscPopSignalHandler()); 1474 flg1 = PETSC_FALSE; 1475 PetscCall(PetscOptionsGetBool(NULL, NULL, "-mpidump", &flg1, NULL)); 1476 if (flg1) PetscCall(PetscMPIDump(stdout)); 1477 flg1 = PETSC_FALSE; 1478 flg2 = PETSC_FALSE; 1479 /* preemptive call to avoid listing this option in options table as unused */ 1480 PetscCall(PetscOptionsHasName(NULL, NULL, "-malloc_dump", &flg1)); 1481 PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1)); 1482 PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_view", &flg2, NULL)); 1483 1484 if (flg2) { 1485 PetscViewer viewer; 1486 PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer)); 1487 PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII)); 1488 PetscCall(PetscOptionsView(NULL, viewer)); 1489 PetscCall(PetscViewerDestroy(&viewer)); 1490 } 1491 1492 /* to prevent PETSc -options_left from warning */ 1493 PetscCall(PetscOptionsHasName(NULL, NULL, "-nox", &flg1)); 1494 PetscCall(PetscOptionsHasName(NULL, NULL, "-nox_warning", &flg1)); 1495 1496 flg3 = PETSC_FALSE; /* default value is required */ 1497 PetscCall(PetscOptionsGetBool(NULL, NULL, "-options_left", &flg3, &flg1)); 1498 if (!flg1) flg3 = PETSC_TRUE; 1499 if (flg3) { 1500 if (!flg2 && flg1) { /* have not yet printed the options */ 1501 PetscViewer viewer; 1502 PetscCall(PetscViewerCreate(PETSC_COMM_WORLD, &viewer)); 1503 PetscCall(PetscViewerSetType(viewer, PETSCVIEWERASCII)); 1504 PetscCall(PetscOptionsView(NULL, viewer)); 1505 PetscCall(PetscViewerDestroy(&viewer)); 1506 } 1507 PetscCall(PetscOptionsAllUsed(NULL, &nopt)); 1508 if (nopt) { 1509 PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! There are options you set that were not used!\n")); 1510 PetscCall(PetscPrintf(PETSC_COMM_WORLD, "WARNING! could be spelling mistake, etc!\n")); 1511 if (nopt == 1) { 1512 PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There is one unused database option. It is:\n")); 1513 } else { 1514 PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are %" PetscInt_FMT " unused database options. They are:\n", nopt)); 1515 } 1516 } else if (flg3 && flg1) { 1517 PetscCall(PetscPrintf(PETSC_COMM_WORLD, "There are no unused options.\n")); 1518 } 1519 PetscCall(PetscOptionsLeft(NULL)); 1520 } 1521 1522 #if defined(PETSC_HAVE_SAWS) 1523 if (!PetscGlobalRank) { 1524 PetscCall(PetscStackSAWsViewOff()); 1525 PetscCallSAWs(SAWs_Finalize, ()); 1526 } 1527 #endif 1528 1529 #if defined(PETSC_USE_LOG) 1530 /* 1531 List all objects the user may have forgot to free 1532 */ 1533 if (PetscObjectsLog) { 1534 PetscCall(PetscOptionsHasName(NULL, NULL, "-objects_dump", &flg1)); 1535 if (flg1) { 1536 MPI_Comm local_comm; 1537 char string[64]; 1538 1539 PetscCall(PetscOptionsGetString(NULL, NULL, "-objects_dump", string, sizeof(string), NULL)); 1540 PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm)); 1541 PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1)); 1542 PetscCall(PetscObjectsDump(stdout, (string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE)); 1543 PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1)); 1544 PetscCallMPI(MPI_Comm_free(&local_comm)); 1545 } 1546 } 1547 #endif 1548 1549 #if defined(PETSC_USE_LOG) 1550 PetscObjectsCounts = 0; 1551 PetscObjectsMaxCounts = 0; 1552 PetscCall(PetscFree(PetscObjects)); 1553 #endif 1554 1555 /* 1556 Destroy any packages that registered a finalize 1557 */ 1558 PetscCall(PetscRegisterFinalizeAll()); 1559 1560 #if defined(PETSC_USE_LOG) 1561 PetscCall(PetscLogFinalize()); 1562 #endif 1563 1564 /* 1565 Print PetscFunctionLists that have not been properly freed 1566 */ 1567 if (PetscPrintFunctionList) PetscCall(PetscFunctionListPrintAll()); 1568 1569 if (petsc_history) { 1570 PetscCall(PetscCloseHistoryFile(&petsc_history)); 1571 petsc_history = NULL; 1572 } 1573 PetscCall(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton)); 1574 PetscCall(PetscInfoDestroy()); 1575 1576 #if !defined(PETSC_HAVE_THREADSAFETY) 1577 if (!(PETSC_RUNNING_ON_VALGRIND)) { 1578 char fname[PETSC_MAX_PATH_LEN]; 1579 char sname[PETSC_MAX_PATH_LEN]; 1580 FILE *fd; 1581 int err; 1582 1583 flg2 = PETSC_FALSE; 1584 flg3 = PETSC_FALSE; 1585 if (PetscDefined(USE_DEBUG)) PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_test", &flg2, NULL)); 1586 PetscCall(PetscOptionsGetBool(NULL, NULL, "-malloc_debug", &flg3, NULL)); 1587 fname[0] = 0; 1588 PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_dump", fname, sizeof(fname), &flg1)); 1589 if (flg1 && fname[0]) { 1590 PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank)); 1591 fd = fopen(sname, "w"); 1592 PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname); 1593 PetscCall(PetscMallocDump(fd)); 1594 err = fclose(fd); 1595 PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file"); 1596 } else if (flg1 || flg2 || flg3) { 1597 MPI_Comm local_comm; 1598 1599 PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm)); 1600 PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1)); 1601 PetscCall(PetscMallocDump(stdout)); 1602 PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1)); 1603 PetscCallMPI(MPI_Comm_free(&local_comm)); 1604 } 1605 fname[0] = 0; 1606 PetscCall(PetscOptionsGetString(NULL, NULL, "-malloc_view", fname, sizeof(fname), &flg1)); 1607 if (flg1 && fname[0]) { 1608 PetscCall(PetscSNPrintf(sname, sizeof(sname), "%s_%d", fname, rank)); 1609 fd = fopen(sname, "w"); 1610 PetscCheck(fd, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open log file: %s", sname); 1611 PetscCall(PetscMallocView(fd)); 1612 err = fclose(fd); 1613 PetscCheck(!err, PETSC_COMM_SELF, PETSC_ERR_SYS, "fclose() failed on file"); 1614 } else if (flg1) { 1615 MPI_Comm local_comm; 1616 1617 PetscCallMPI(MPI_Comm_dup(PETSC_COMM_WORLD, &local_comm)); 1618 PetscCall(PetscSequentialPhaseBegin_Private(local_comm, 1)); 1619 PetscCall(PetscMallocView(stdout)); 1620 PetscCall(PetscSequentialPhaseEnd_Private(local_comm, 1)); 1621 PetscCallMPI(MPI_Comm_free(&local_comm)); 1622 } 1623 } 1624 #endif 1625 1626 /* 1627 Close any open dynamic libraries 1628 */ 1629 PetscCall(PetscFinalize_DynamicLibraries()); 1630 1631 /* Can be destroyed only after all the options are used */ 1632 PetscCall(PetscOptionsDestroyDefault()); 1633 1634 PetscGlobalArgc = 0; 1635 PetscGlobalArgs = NULL; 1636 1637 #if defined(PETSC_HAVE_KOKKOS) 1638 if (PetscBeganKokkos) { 1639 PetscCall(PetscKokkosFinalize_Private()); 1640 PetscBeganKokkos = PETSC_FALSE; 1641 PetscKokkosInitialized = PETSC_FALSE; 1642 } 1643 #endif 1644 1645 #if defined(PETSC_HAVE_NVSHMEM) 1646 if (PetscBeganNvshmem) { 1647 PetscCall(PetscNvshmemFinalize()); 1648 PetscBeganNvshmem = PETSC_FALSE; 1649 } 1650 #endif 1651 1652 PetscCall(PetscFreeMPIResources()); 1653 1654 /* 1655 Destroy any known inner MPI_Comm's and attributes pointing to them 1656 Note this will not destroy any new communicators the user has created. 1657 1658 If all PETSc objects were not destroyed those left over objects will have hanging references to 1659 the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again 1660 */ 1661 { 1662 PetscCommCounter *counter; 1663 PetscMPIInt flg; 1664 MPI_Comm icomm; 1665 union 1666 { 1667 MPI_Comm comm; 1668 void *ptr; 1669 } ucomm; 1670 PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval, &ucomm, &flg)); 1671 if (flg) { 1672 icomm = ucomm.comm; 1673 PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg)); 1674 PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1675 1676 PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF, Petsc_InnerComm_keyval)); 1677 PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval)); 1678 PetscCallMPI(MPI_Comm_free(&icomm)); 1679 } 1680 PetscCallMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval, &ucomm, &flg)); 1681 if (flg) { 1682 icomm = ucomm.comm; 1683 PetscCallMPI(MPI_Comm_get_attr(icomm, Petsc_Counter_keyval, &counter, &flg)); 1684 PetscCheck(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_CORRUPT, "Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1685 1686 PetscCallMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD, Petsc_InnerComm_keyval)); 1687 PetscCallMPI(MPI_Comm_delete_attr(icomm, Petsc_Counter_keyval)); 1688 PetscCallMPI(MPI_Comm_free(&icomm)); 1689 } 1690 } 1691 1692 PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval)); 1693 PetscCallMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval)); 1694 PetscCallMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval)); 1695 PetscCallMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval)); 1696 PetscCallMPI(MPI_Comm_free_keyval(&Petsc_CreationIdx_keyval)); 1697 PetscCallMPI(MPI_Comm_free_keyval(&Petsc_Garbage_HMap_keyval)); 1698 1699 // Free keyvals which may be silently created by some routines 1700 if (Petsc_SharedWD_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedWD_keyval)); 1701 if (Petsc_SharedTmp_keyval != MPI_KEYVAL_INVALID) PetscCallMPI(MPI_Comm_free_keyval(&Petsc_SharedTmp_keyval)); 1702 1703 PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen)); 1704 PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout)); 1705 PetscCall(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr)); 1706 PetscCall(PetscSpinlockDestroy(&PetscCommSpinLock)); 1707 1708 if (PetscBeganMPI) { 1709 PetscMPIInt flag; 1710 PetscCallMPI(MPI_Finalized(&flag)); 1711 PetscCheck(!flag, PETSC_COMM_SELF, PETSC_ERR_LIB, "MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()"); 1712 /* wait until the very last moment to disable error handling */ 1713 PetscErrorHandlingInitialized = PETSC_FALSE; 1714 PetscCallMPI(MPI_Finalize()); 1715 } else PetscErrorHandlingInitialized = PETSC_FALSE; 1716 1717 /* 1718 1719 Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because 1720 the communicator has some outstanding requests on it. Specifically if the 1721 flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See 1722 src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate() 1723 is never freed as it should be. Thus one may obtain messages of the form 1724 [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the 1725 memory was not freed. 1726 1727 */ 1728 PetscCall(PetscMallocClear()); 1729 PetscCall(PetscStackReset()); 1730 1731 PetscInitializeCalled = PETSC_FALSE; 1732 PetscFinalizeCalled = PETSC_TRUE; 1733 #if defined(PETSC_USE_COVERAGE) 1734 /* 1735 flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the 1736 gcov files are still being added to the directories as git tries to remove the directories. 1737 */ 1738 __gcov_flush(); 1739 #endif 1740 /* To match PetscFunctionBegin() at the beginning of this function */ 1741 PetscStackClearTop; 1742 return PETSC_SUCCESS; 1743 } 1744 1745 #if defined(PETSC_MISSING_LAPACK_lsame_) 1746 PETSC_EXTERN int lsame_(char *a, char *b) 1747 { 1748 if (*a == *b) return 1; 1749 if (*a + 32 == *b) return 1; 1750 if (*a - 32 == *b) return 1; 1751 return 0; 1752 } 1753 #endif 1754 1755 #if defined(PETSC_MISSING_LAPACK_lsame) 1756 PETSC_EXTERN int lsame(char *a, char *b) 1757 { 1758 if (*a == *b) return 1; 1759 if (*a + 32 == *b) return 1; 1760 if (*a - 32 == *b) return 1; 1761 return 0; 1762 } 1763 #endif 1764