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