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