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