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