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