1 2 /* 3 This file defines the initialization of PETSc, including PetscInitialize() 4 */ 5 6 #include <petscsys.h> /*I "petscsys.h" I*/ 7 8 #if defined(PETSC_HAVE_CUSP) 9 #include <cublas.h> 10 #endif 11 12 #if defined(PETSC_USE_LOG) 13 extern PetscErrorCode PetscLogBegin_Private(void); 14 #endif 15 extern PetscBool PetscHMPIWorker; 16 17 /* -----------------------------------------------------------------------------------------*/ 18 19 extern FILE *petsc_history; 20 21 extern PetscErrorCode PetscInitialize_DynamicLibraries(void); 22 extern PetscErrorCode PetscFinalize_DynamicLibraries(void); 23 extern PetscErrorCode PetscFListDestroyAll(void); 24 extern PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm,int); 25 extern PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm,int); 26 extern PetscErrorCode PetscCloseHistoryFile(FILE **); 27 extern PetscBool PetscUseThreadPool; 28 extern int* ThreadCoreAffinity; 29 extern PetscErrorCode (*PetscThreadFinalize)(void); 30 /* this is used by the _, __, and ___ macros (see include/petscerror.h) */ 31 PetscErrorCode __gierr = 0; 32 33 /* user may set this BEFORE calling PetscInitialize() */ 34 MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL; 35 36 PetscMPIInt Petsc_Counter_keyval = MPI_KEYVAL_INVALID; 37 PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID; 38 PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID; 39 40 /* 41 Declare and set all the string names of the PETSc enums 42 */ 43 const char *PetscBools[] = {"FALSE","TRUE","PetscBool","PETSC_",0}; 44 const char *PetscCopyModes[] = {"COPY_VALUES","OWN_POINTER","USE_POINTER","PetscCopyMode","PETSC_",0}; 45 const char *PetscDataTypes[] = {"INT","DOUBLE","COMPLEX","LONG","SHORT","FLOAT", 46 "CHAR","LOGICAL","ENUM","BOOL","LONGDOUBLE","PetscDataType","PETSC_",0}; 47 48 PetscBool PetscPreLoadingUsed = PETSC_FALSE; 49 PetscBool PetscPreLoadingOn = PETSC_FALSE; 50 51 /* 52 Checks the options database for initializations related to the 53 PETSc components 54 */ 55 #undef __FUNCT__ 56 #define __FUNCT__ "PetscOptionsCheckInitial_Components" 57 PetscErrorCode PetscOptionsCheckInitial_Components(void) 58 { 59 PetscBool flg1; 60 PetscErrorCode ierr; 61 62 PetscFunctionBegin; 63 ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg1);CHKERRQ(ierr); 64 if (flg1) { 65 #if defined (PETSC_USE_LOG) 66 MPI_Comm comm = PETSC_COMM_WORLD; 67 ierr = (*PetscHelpPrintf)(comm,"------Additional PETSc component options--------\n");CHKERRQ(ierr); 68 ierr = (*PetscHelpPrintf)(comm," -log_summary_exclude: <vec,mat,pc.ksp,snes>\n");CHKERRQ(ierr); 69 ierr = (*PetscHelpPrintf)(comm," -info_exclude: <null,vec,mat,pc,ksp,snes,ts>\n");CHKERRQ(ierr); 70 ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr); 71 #endif 72 } 73 PetscFunctionReturn(0); 74 } 75 76 #if defined(PETSC_HAVE_MATLAB_ENGINE) 77 extern PetscBool PetscBeganMPI; 78 79 #undef __FUNCT__ 80 #define __FUNCT__ "PetscInitializeMatlab" 81 /* 82 PetscInitializeMatlab - Calls PetscInitialize() from C/C++ without the pointers to argc and args 83 84 Collective 85 86 Level: advanced 87 88 Notes: this is called only by the PETSc MATLAB interface. Even though it might start MPI it sets the flag to 89 indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to 90 be called multiple times from MATLAB without the problem of trying to initialize MPI more than once. 91 92 Turns off PETSc signal handling because that can interact with MATLAB's signal handling causing random crashes. 93 94 .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments() 95 */ 96 PetscErrorCode PetscInitializeMatlab(int argc,char **args,const char *filename,const char *help) 97 { 98 PetscErrorCode ierr; 99 int myargc = argc; 100 char **myargs = args; 101 102 PetscFunctionBegin; 103 ierr = PetscInitialize(&myargc,&myargs,filename,help); 104 ierr = PetscPopSignalHandler();CHKERRQ(ierr); 105 PetscBeganMPI = PETSC_FALSE; 106 PetscFunctionReturn(ierr); 107 } 108 109 #undef __FUNCT__ 110 #define __FUNCT__ "PetscInitializedMatlab" 111 /* 112 PetscInitializedMatlab - Has PETSc been initialized already? 113 114 Not Collective 115 116 Level: advanced 117 118 Notes: this is called only by the PETSc MATLAB interface. 119 120 .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments() 121 */ 122 int PetscInitializedMatlab(void) 123 { 124 PetscBool flg; 125 126 PetscInitialized(&flg); 127 if (flg) return 1; 128 else return 0; 129 } 130 131 #undef __FUNCT__ 132 #define __FUNCT__ "PetscGetPETSC_COMM_SELFMatlab" 133 /* 134 Used by MATLAB interface to get communicator 135 */ 136 PetscErrorCode PetscGetPETSC_COMM_SELFMatlab(MPI_Comm *comm) 137 { 138 PetscFunctionBegin; 139 *comm = PETSC_COMM_SELF; 140 PetscFunctionReturn(0); 141 } 142 #endif 143 144 #undef __FUNCT__ 145 #define __FUNCT__ "PetscInitializeNoArguments" 146 /*@C 147 PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without 148 the command line arguments. 149 150 Collective 151 152 Level: advanced 153 154 .seealso: PetscInitialize(), PetscInitializeFortran() 155 @*/ 156 PetscErrorCode PetscInitializeNoArguments(void) 157 { 158 PetscErrorCode ierr; 159 int argc = 0; 160 char **args = 0; 161 162 PetscFunctionBegin; 163 ierr = PetscInitialize(&argc,&args,PETSC_NULL,PETSC_NULL); 164 PetscFunctionReturn(ierr); 165 } 166 167 #undef __FUNCT__ 168 #define __FUNCT__ "PetscInitialized" 169 /*@ 170 PetscInitialized - Determine whether PETSc is initialized. 171 172 7 Level: beginner 173 174 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 175 @*/ 176 PetscErrorCode PetscInitialized(PetscBool *isInitialized) 177 { 178 PetscFunctionBegin; 179 PetscValidPointer(isInitialized, 1); 180 *isInitialized = PetscInitializeCalled; 181 PetscFunctionReturn(0); 182 } 183 184 #undef __FUNCT__ 185 #define __FUNCT__ "PetscFinalized" 186 /*@ 187 PetscFinalized - Determine whether PetscFinalize() has been called yet 188 189 Level: developer 190 191 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 192 @*/ 193 PetscErrorCode PetscFinalized(PetscBool *isFinalized) 194 { 195 PetscFunctionBegin; 196 PetscValidPointer(isFinalized, 1); 197 *isFinalized = PetscFinalizeCalled; 198 PetscFunctionReturn(0); 199 } 200 201 extern PetscErrorCode PetscOptionsCheckInitial_Private(void); 202 extern PetscBool PetscBeganMPI; 203 204 /* 205 This function is the MPI reduction operation used to compute the sum of the 206 first half of the datatype and the max of the second half. 207 */ 208 MPI_Op PetscMaxSum_Op = 0; 209 210 EXTERN_C_BEGIN 211 #undef __FUNCT__ 212 #define __FUNCT__ "PetscMaxSum_Local" 213 void MPIAPI PetscMaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype) 214 { 215 PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt; 216 217 PetscFunctionBegin; 218 if (*datatype != MPIU_2INT) { 219 (*PetscErrorPrintf)("Can only handle MPIU_2INT data types"); 220 MPI_Abort(MPI_COMM_WORLD,1); 221 } 222 223 for (i=0; i<count; i++) { 224 xout[2*i] = PetscMax(xout[2*i],xin[2*i]); 225 xout[2*i+1] += xin[2*i+1]; 226 } 227 PetscFunctionReturnVoid(); 228 } 229 EXTERN_C_END 230 231 /* 232 Returns the max of the first entry owned by this processor and the 233 sum of the second entry. 234 235 The reason nprocs[2*i] contains lengths nprocs[2*i+1] contains flag of 1 if length is nonzero 236 is so that the PetscMaxSum_Op() can set TWO values, if we passed in only nprocs[i] with lengths 237 there would be no place to store the both needed results. 238 */ 239 #undef __FUNCT__ 240 #define __FUNCT__ "PetscMaxSum" 241 PetscErrorCode PetscMaxSum(MPI_Comm comm,const PetscInt nprocs[],PetscInt *max,PetscInt *sum) 242 { 243 PetscMPIInt size,rank; 244 PetscInt *work; 245 PetscErrorCode ierr; 246 247 PetscFunctionBegin; 248 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 249 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 250 ierr = PetscMalloc(2*size*sizeof(PetscInt),&work);CHKERRQ(ierr); 251 ierr = MPI_Allreduce((void*)nprocs,work,size,MPIU_2INT,PetscMaxSum_Op,comm);CHKERRQ(ierr); 252 *max = work[2*rank]; 253 *sum = work[2*rank+1]; 254 ierr = PetscFree(work);CHKERRQ(ierr); 255 PetscFunctionReturn(0); 256 } 257 258 /* ----------------------------------------------------------------------------*/ 259 MPI_Op PetscADMax_Op = 0; 260 261 EXTERN_C_BEGIN 262 #undef __FUNCT__ 263 #define __FUNCT__ "PetscADMax_Local" 264 void MPIAPI PetscADMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 265 { 266 PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out; 267 PetscInt i,count = *cnt; 268 269 PetscFunctionBegin; 270 if (*datatype != MPIU_2SCALAR) { 271 (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types"); 272 MPI_Abort(MPI_COMM_WORLD,1); 273 } 274 275 for (i=0; i<count; i++) { 276 if (PetscRealPart(xout[2*i]) < PetscRealPart(xin[2*i])) { 277 xout[2*i] = xin[2*i]; 278 xout[2*i+1] = xin[2*i+1]; 279 } 280 } 281 PetscFunctionReturnVoid(); 282 } 283 EXTERN_C_END 284 285 MPI_Op PetscADMin_Op = 0; 286 287 EXTERN_C_BEGIN 288 #undef __FUNCT__ 289 #define __FUNCT__ "PetscADMin_Local" 290 void MPIAPI PetscADMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 291 { 292 PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out; 293 PetscInt i,count = *cnt; 294 295 PetscFunctionBegin; 296 if (*datatype != MPIU_2SCALAR) { 297 (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types"); 298 MPI_Abort(MPI_COMM_WORLD,1); 299 } 300 301 for (i=0; i<count; i++) { 302 if (PetscRealPart(xout[2*i]) > PetscRealPart(xin[2*i])) { 303 xout[2*i] = xin[2*i]; 304 xout[2*i+1] = xin[2*i+1]; 305 } 306 } 307 PetscFunctionReturnVoid(); 308 } 309 EXTERN_C_END 310 /* ---------------------------------------------------------------------------------------*/ 311 312 #if (defined(PETSC_USE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 313 MPI_Op MPIU_SUM = 0; 314 315 EXTERN_C_BEGIN 316 #undef __FUNCT__ 317 #define __FUNCT__ "PetscSum_Local" 318 void PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 319 { 320 PetscInt i,count = *cnt; 321 322 PetscFunctionBegin; 323 if (*datatype == MPIU_SCALAR) { 324 PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out; 325 for (i=0; i<count; i++) { 326 xout[i] += xin[i]; 327 } 328 } else if (*datatype == MPIU_REAL) { 329 PetscReal *xin = (PetscReal *)in,*xout = (PetscReal*)out; 330 for (i=0; i<count; i++) { 331 xout[i] += xin[i]; 332 } 333 } else { 334 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"); 335 MPI_Abort(MPI_COMM_WORLD,1); 336 } 337 PetscFunctionReturnVoid(); 338 } 339 EXTERN_C_END 340 #endif 341 342 #if defined(PETSC_USE_REAL___FLOAT128) 343 MPI_Op MPIU_MAX = 0; 344 MPI_Op MPIU_MIN = 0; 345 346 EXTERN_C_BEGIN 347 #undef __FUNCT__ 348 #define __FUNCT__ "PetscMax_Local" 349 void PetscMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 350 { 351 PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out; 352 PetscInt i,count = *cnt; 353 354 PetscFunctionBegin; 355 if (*datatype != MPIU_SCALAR) { 356 (*PetscErrorPrintf)("Can only handle MPIU_SCALAR data (i.e. double or complex) types"); 357 MPI_Abort(MPI_COMM_WORLD,1); 358 } 359 360 for (i=0; i<count; i++) { 361 xout[i] = PetscMax(xout[i],xin[i]); 362 } 363 PetscFunctionReturnVoid(); 364 } 365 EXTERN_C_END 366 367 EXTERN_C_BEGIN 368 #undef __FUNCT__ 369 #define __FUNCT__ "PetscMin_Local" 370 void PetscMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 371 { 372 PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out; 373 PetscInt i,count = *cnt; 374 375 PetscFunctionBegin; 376 if (*datatype != MPIU_SCALAR) { 377 (*PetscErrorPrintf)("Can only handle MPIU_SCALAR data (i.e. double or complex) types"); 378 MPI_Abort(MPI_COMM_WORLD,1); 379 } 380 381 for (i=0; i<count; i++) { 382 xout[i] = PetscMin(xout[i],xin[i]); 383 } 384 PetscFunctionReturnVoid(); 385 } 386 EXTERN_C_END 387 #endif 388 389 EXTERN_C_BEGIN 390 #undef __FUNCT__ 391 #define __FUNCT__ "Petsc_DelCounter" 392 /* 393 Private routine to delete internal tag/name counter storage when a communicator is freed. 394 395 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. 396 397 Note: this is declared extern "C" because it is passed to MPI_Keyval_create() 398 399 */ 400 PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state) 401 { 402 PetscErrorCode ierr; 403 404 PetscFunctionBegin; 405 ierr = PetscInfo1(0,"Deleting counter data in an MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 406 ierr = PetscFree(count_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 407 PetscFunctionReturn(MPI_SUCCESS); 408 } 409 EXTERN_C_END 410 411 EXTERN_C_BEGIN 412 #undef __FUNCT__ 413 #define __FUNCT__ "Petsc_DelComm" 414 /* 415 This does not actually free anything, it simply marks when a reference count to an internal or external MPI_Comm reaches zero and the 416 the external MPI_Comm drops its reference to the internal or external MPI_Comm 417 418 This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator. 419 420 Note: this is declared extern "C" because it is passed to MPI_Keyval_create() 421 422 */ 423 PetscMPIInt MPIAPI Petsc_DelComm(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state) 424 { 425 PetscErrorCode ierr; 426 PetscMPIInt flg; 427 MPI_Comm icomm; 428 void *ptr; 429 430 PetscFunctionBegin; 431 ierr = MPI_Attr_get(comm,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr); 432 if (flg) { 433 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 434 ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 435 ierr = MPI_Attr_get(icomm,Petsc_OuterComm_keyval,&ptr,&flg);CHKERRQ(ierr); 436 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected reference to outer comm"); 437 ierr = MPI_Attr_delete(icomm,Petsc_OuterComm_keyval);CHKERRQ(ierr); 438 ierr = PetscInfo1(0,"User MPI_Comm m %ld is being freed, removing reference from inner PETSc comm to this outer comm\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 439 } else { 440 ierr = PetscInfo1(0,"Removing reference to PETSc communicator imbedded in a user MPI_Comm m %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 441 } 442 PetscFunctionReturn(MPI_SUCCESS); 443 } 444 EXTERN_C_END 445 446 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 447 #if !defined(PETSC_WORDS_BIGENDIAN) 448 EXTERN_C_BEGIN 449 extern PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype,MPI_Aint*,void*); 450 extern PetscMPIInt PetscDataRep_read_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*); 451 extern PetscMPIInt PetscDataRep_write_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*); 452 EXTERN_C_END 453 #endif 454 #endif 455 456 int PetscGlobalArgc = 0; 457 char **PetscGlobalArgs = 0; 458 459 #undef __FUNCT__ 460 #define __FUNCT__ "PetscGetArgs" 461 /*@C 462 PetscGetArgs - Allows you to access the raw command line arguments anywhere 463 after PetscInitialize() is called but before PetscFinalize(). 464 465 Not Collective 466 467 Output Parameters: 468 + argc - count of number of command line arguments 469 - args - the command line arguments 470 471 Level: intermediate 472 473 Notes: 474 This is usually used to pass the command line arguments into other libraries 475 that are called internally deep in PETSc or the application. 476 477 The first argument contains the program name as is normal for C arguments. 478 479 Concepts: command line arguments 480 481 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments() 482 483 @*/ 484 PetscErrorCode PetscGetArgs(int *argc,char ***args) 485 { 486 PetscFunctionBegin; 487 if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()"); 488 *argc = PetscGlobalArgc; 489 *args = PetscGlobalArgs; 490 PetscFunctionReturn(0); 491 } 492 493 #undef __FUNCT__ 494 #define __FUNCT__ "PetscGetArguments" 495 /*@C 496 PetscGetArguments - Allows you to access the command line arguments anywhere 497 after PetscInitialize() is called but before PetscFinalize(). 498 499 Not Collective 500 501 Output Parameters: 502 . args - the command line arguments 503 504 Level: intermediate 505 506 Notes: 507 This does NOT start with the program name and IS null terminated (final arg is void) 508 509 Concepts: command line arguments 510 511 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments() 512 513 @*/ 514 PetscErrorCode PetscGetArguments(char ***args) 515 { 516 PetscInt i,argc = PetscGlobalArgc; 517 PetscErrorCode ierr; 518 519 PetscFunctionBegin; 520 if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()"); 521 if (!argc) {*args = 0; PetscFunctionReturn(0);} 522 ierr = PetscMalloc(argc*sizeof(char*),args);CHKERRQ(ierr); 523 for (i=0; i<argc-1; i++) { 524 ierr = PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]);CHKERRQ(ierr); 525 } 526 (*args)[argc-1] = 0; 527 PetscFunctionReturn(0); 528 } 529 530 #undef __FUNCT__ 531 #define __FUNCT__ "PetscFreeArguments" 532 /*@C 533 PetscFreeArguments - Frees the memory obtained with PetscGetArguments() 534 535 Not Collective 536 537 Output Parameters: 538 . args - the command line arguments 539 540 Level: intermediate 541 542 Concepts: command line arguments 543 544 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments() 545 546 @*/ 547 PetscErrorCode PetscFreeArguments(char **args) 548 { 549 PetscInt i = 0; 550 PetscErrorCode ierr; 551 552 PetscFunctionBegin; 553 if (!args) {PetscFunctionReturn(0);} 554 while (args[i]) { 555 ierr = PetscFree(args[i]);CHKERRQ(ierr); 556 i++; 557 } 558 ierr = PetscFree(args);CHKERRQ(ierr); 559 PetscFunctionReturn(0); 560 } 561 562 #undef __FUNCT__ 563 #define __FUNCT__ "PetscInitialize" 564 /*@C 565 PetscInitialize - Initializes the PETSc database and MPI. 566 PetscInitialize() calls MPI_Init() if that has yet to be called, 567 so this routine should always be called near the beginning of 568 your program -- usually the very first line! 569 570 Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set 571 572 Input Parameters: 573 + argc - count of number of command line arguments 574 . args - the command line arguments 575 . file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use PETSC_NULL to not check for 576 code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files 577 - help - [optional] Help message to print, use PETSC_NULL for no message 578 579 If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that 580 communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a 581 four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not, 582 then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even 583 if different subcommunicators of the job are doing different things with PETSc. 584 585 Options Database Keys: 586 + -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger 587 . -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected 588 . -on_error_emacs <machinename> causes emacsclient to jump to error file 589 . -on_error_abort calls abort() when error detected (no traceback) 590 . -on_error_mpiabort calls MPI_abort() when error detected 591 . -error_output_stderr prints error messages to stderr instead of the default stdout 592 . -error_output_none does not print the error messages (but handles errors in the same way as if this was not called) 593 . -debugger_nodes [node1,node2,...] - Indicates nodes to start in debugger 594 . -debugger_pause [sleeptime] (in seconds) - Pauses debugger 595 . -stop_for_debugger - Print message on how to attach debugger manually to 596 process and wait (-debugger_pause) seconds for attachment 597 . -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) 598 . -malloc no - Indicates not to use error-checking malloc 599 . -malloc_debug - check for memory corruption at EVERY malloc or free 600 . -fp_trap - Stops on floating point exceptions (Note that on the 601 IBM RS6000 this slows code by at least a factor of 10.) 602 . -no_signal_handler - Indicates not to trap error signals 603 . -shared_tmp - indicates /tmp directory is shared by all processors 604 . -not_shared_tmp - each processor has own /tmp 605 . -tmp - alternative name of /tmp directory 606 . -get_total_flops - returns total flops done by all processors 607 . -memory_info - Print memory usage at end of run 608 - -server <port> - start PETSc webserver (default port is 8080) 609 610 Options Database Keys for Profiling: 611 See the <a href="../../docs/manual.pdf#nameddest=ch_profiling">profiling chapter of the users manual</a> for details. 612 + -log_trace [filename] - Print traces of all PETSc calls 613 to the screen (useful to determine where a program 614 hangs without running in the debugger). See PetscLogTraceBegin(). 615 . -info <optional filename> - Prints verbose information to the screen 616 - -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages 617 618 Environmental Variables: 619 + PETSC_TMP - alternative tmp directory 620 . PETSC_SHARED_TMP - tmp is shared by all processes 621 . PETSC_NOT_SHARED_TMP - each process has its own private tmp 622 . PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer 623 - PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to 624 625 626 Level: beginner 627 628 Notes: 629 If for some reason you must call MPI_Init() separately, call 630 it before PetscInitialize(). 631 632 Fortran Version: 633 In Fortran this routine has the format 634 $ call PetscInitialize(file,ierr) 635 636 + ierr - error return code 637 - file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use PETSC_NULL_CHARACTER to not check for 638 code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files 639 640 Important Fortran Note: 641 In Fortran, you MUST use PETSC_NULL_CHARACTER to indicate a 642 null character string; you CANNOT just use PETSC_NULL as 643 in the C version. See the <a href="../../docs/manual.pdf">users manual</a> for details. 644 645 If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after 646 calling PetscInitialize(). 647 648 Concepts: initializing PETSc 649 650 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments() 651 652 @*/ 653 PetscErrorCode PetscInitialize(int *argc,char ***args,const char file[],const char help[]) 654 { 655 PetscErrorCode ierr; 656 PetscMPIInt flag, size; 657 PetscInt nodesize; 658 PetscBool flg; 659 char hostname[256]; 660 661 PetscFunctionBegin; 662 if (PetscInitializeCalled) PetscFunctionReturn(0); 663 664 /* these must be initialized in a routine, not as a constant declaration*/ 665 PETSC_STDOUT = stdout; 666 PETSC_STDERR = stderr; 667 668 ierr = PetscOptionsCreate();CHKERRQ(ierr); 669 670 /* 671 We initialize the program name here (before MPI_Init()) because MPICH has a bug in 672 it that it sets args[0] on all processors to be args[0] on the first processor. 673 */ 674 if (argc && *argc) { 675 ierr = PetscSetProgramName(**args);CHKERRQ(ierr); 676 } else { 677 ierr = PetscSetProgramName("Unknown Name");CHKERRQ(ierr); 678 } 679 680 ierr = MPI_Initialized(&flag);CHKERRQ(ierr); 681 if (!flag) { 682 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"); 683 ierr = MPI_Init(argc,args);CHKERRQ(ierr); 684 PetscBeganMPI = PETSC_TRUE; 685 } 686 if (argc && args) { 687 PetscGlobalArgc = *argc; 688 PetscGlobalArgs = *args; 689 } 690 PetscFinalizeCalled = PETSC_FALSE; 691 692 if (PETSC_COMM_WORLD == MPI_COMM_NULL) { 693 PETSC_COMM_WORLD = MPI_COMM_WORLD; 694 } 695 ierr = MPI_Errhandler_set(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);CHKERRQ(ierr); 696 697 /* Done after init due to a bug in MPICH-GM? */ 698 ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr); 699 700 ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRQ(ierr); 701 ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRQ(ierr); 702 703 #if defined(PETSC_USE_COMPLEX) 704 /* 705 Initialized the global complex variable; this is because with 706 shared libraries the constructors for global variables 707 are not called; at least on IRIX. 708 */ 709 { 710 #if defined(PETSC_CLANGUAGE_CXX) 711 PetscScalar ic(0.0,1.0); 712 PETSC_i = ic; 713 #else 714 PETSC_i = I; 715 #endif 716 } 717 718 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 719 ierr = MPI_Type_contiguous(2,MPIU_REAL,&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 720 ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 721 ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);CHKERRQ(ierr); 722 ierr = MPI_Type_commit(&MPIU_C_COMPLEX);CHKERRQ(ierr); 723 ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr); 724 #endif 725 #endif 726 727 /* 728 Create the PETSc MPI reduction operator that sums of the first 729 half of the entries and maxes the second half. 730 */ 731 ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);CHKERRQ(ierr); 732 733 #if defined(PETSC_USE_REAL___FLOAT128) 734 ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);CHKERRQ(ierr); 735 ierr = MPI_Type_commit(&MPIU___FLOAT128);CHKERRQ(ierr); 736 ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr); 737 ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRQ(ierr); 738 ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRQ(ierr); 739 #endif 740 741 ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr); 742 ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr); 743 ierr = MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);CHKERRQ(ierr); 744 ierr = MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);CHKERRQ(ierr); 745 746 ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr); 747 ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr); 748 749 /* 750 Attributes to be set on PETSc communicators 751 */ 752 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);CHKERRQ(ierr); 753 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_InnerComm_keyval,(void*)0);CHKERRQ(ierr); 754 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_OuterComm_keyval,(void*)0);CHKERRQ(ierr); 755 756 /* 757 Build the options database 758 */ 759 ierr = PetscOptionsInsert(argc,args,file);CHKERRQ(ierr); 760 761 762 /* 763 Print main application help message 764 */ 765 ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg);CHKERRQ(ierr); 766 if (help && flg) { 767 ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr); 768 } 769 ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr); 770 771 /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */ 772 #if defined(PETSC_USE_LOG) 773 ierr = PetscLogBegin_Private();CHKERRQ(ierr); 774 #endif 775 776 /* 777 Load the dynamic libraries (on machines that support them), this registers all 778 the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes) 779 */ 780 ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr); 781 782 ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); 783 ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr); 784 ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr); 785 ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr); 786 787 ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr); 788 /* Check the options database for options related to the options database itself */ 789 ierr = PetscOptionsSetFromOptions();CHKERRQ(ierr); 790 791 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 792 /* 793 Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI 794 795 Currently not used because it is not supported by MPICH. 796 */ 797 #if !defined(PETSC_WORDS_BIGENDIAN) 798 ierr = MPI_Register_datarep((char *)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,PETSC_NULL);CHKERRQ(ierr); 799 #endif 800 #endif 801 802 ierr = PetscOptionsGetInt(PETSC_NULL,"-hmpi_spawn_size",&nodesize,&flg);CHKERRQ(ierr); 803 if (flg) { 804 #if defined(PETSC_HAVE_MPI_COMM_SPAWN) 805 ierr = PetscHMPISpawn((PetscMPIInt) nodesize);CHKERRQ(ierr); /* worker nodes never return from here; they go directly to PetscEnd() */ 806 #else 807 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"PETSc built without MPI 2 (MPI_Comm_spawn) support, use -hmpi_merge_size instead"); 808 #endif 809 } else { 810 ierr = PetscOptionsGetInt(PETSC_NULL,"-hmpi_merge_size",&nodesize,&flg);CHKERRQ(ierr); 811 if (flg) { 812 ierr = PetscHMPIMerge((PetscMPIInt) nodesize,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 813 if (PetscHMPIWorker) { /* if worker then never enter user code */ 814 PetscInitializeCalled = PETSC_TRUE; 815 ierr = PetscEnd(); 816 } 817 } 818 } 819 820 #if defined(PETSC_HAVE_CUDA) 821 cublasInit(); 822 823 ierr = PetscOptionsHasName(PETSC_NULL,"-cuda_show_devices",&flg);CHKERRQ(ierr); 824 if (flg) { 825 struct cudaDeviceProp prop; 826 int devCount; 827 int device; 828 829 ierr = cudaGetDeviceCount(&devCount);CHKERRQ(ierr); 830 for(device = 0; device < devCount; ++device) { 831 ierr = cudaGetDeviceProperties(&prop, device);CHKERRQ(ierr); 832 ierr = PetscPrintf(PETSC_COMM_WORLD, "CUDA device %d: %s\n", device, prop.name);CHKERRQ(ierr); 833 } 834 } 835 { 836 int device; 837 838 ierr = PetscOptionsGetInt(PETSC_NULL,"-cuda_set_device", &device, &flg);CHKERRQ(ierr); 839 if (flg) { 840 ierr = cudaSetDevice(device);CHKERRQ(ierr); 841 } 842 } 843 #endif 844 845 #if defined(PETSC_HAVE_AMS) 846 ierr = PetscOptionsHasName(PETSC_NULL,"-ams_publish_objects",&flg);CHKERRQ(ierr); 847 if (flg) { 848 PetscAMSPublishAll = PETSC_TRUE; 849 } 850 #endif 851 852 ierr = PetscOptionsHasName(PETSC_NULL,"-python",&flg);CHKERRQ(ierr); 853 if (flg) { 854 PetscInitializeCalled = PETSC_TRUE; 855 ierr = PetscPythonInitialize(PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 856 } 857 858 /* 859 Once we are completedly initialized then we can set this variables 860 */ 861 PetscInitializeCalled = PETSC_TRUE; 862 PetscFunctionReturn(0); 863 } 864 865 extern PetscObject *PetscObjects; 866 extern PetscInt PetscObjectsCounts, PetscObjectsMaxCounts; 867 868 #undef __FUNCT__ 869 #define __FUNCT__ "PetscFinalize" 870 /*@C 871 PetscFinalize - Checks for options to be called at the conclusion 872 of the program. MPI_Finalize() is called only if the user had not 873 called MPI_Init() before calling PetscInitialize(). 874 875 Collective on PETSC_COMM_WORLD 876 877 Options Database Keys: 878 + -options_table - Calls PetscOptionsView() 879 . -options_left - Prints unused options that remain in the database 880 . -objects_left - Prints list of all objects that have not been freed 881 . -mpidump - Calls PetscMPIDump() 882 . -malloc_dump - Calls PetscMallocDump() 883 . -malloc_info - Prints total memory usage 884 - -malloc_log - Prints summary of memory usage 885 886 Options Database Keys for Profiling: 887 See the <a href="../../docs/manual.pdf#nameddest=ch_profiling">profiling chapter of the users manual</a> for details. 888 + -log_summary [filename] - Prints summary of flop and timing 889 information to screen. If the filename is specified the 890 summary is written to the file. See PetscLogView(). 891 . -log_summary_python [filename] - Prints data on of flop and timing usage to a file or screen. 892 See PetscLogPrintSViewPython(). 893 . -log_all [filename] - Logs extensive profiling information 894 See PetscLogDump(). 895 . -log [filename] - Logs basic profiline information See PetscLogDump(). 896 . -log_sync - Log the synchronization in scatters, inner products 897 and norms 898 - -log_mpe [filename] - Creates a logfile viewable by the 899 utility Upshot/Nupshot (in MPICH distribution) 900 901 Level: beginner 902 903 Note: 904 See PetscInitialize() for more general runtime options. 905 906 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd() 907 @*/ 908 PetscErrorCode PetscFinalize(void) 909 { 910 PetscErrorCode ierr; 911 PetscMPIInt rank; 912 PetscInt i,nopt; 913 PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE,objects_left = PETSC_FALSE; 914 #if defined(PETSC_HAVE_AMS) 915 PetscBool flg = PETSC_FALSE; 916 #endif 917 #if defined(PETSC_USE_LOG) 918 char mname[PETSC_MAX_PATH_LEN]; 919 #endif 920 921 PetscFunctionBegin; 922 923 if (!PetscInitializeCalled) { 924 printf("PetscInitialize() must be called before PetscFinalize()\n"); 925 PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE); 926 } 927 ierr = PetscInfo(PETSC_NULL,"PetscFinalize() called\n"); 928 929 #if defined(PETSC_HAVE_AMS) 930 ierr = PetscOptionsGetBool(PETSC_NULL,"-options_gui",&flg,PETSC_NULL);CHKERRQ(ierr); 931 if (flg) { 932 ierr = PetscOptionsAMSDestroy();CHKERRQ(ierr); 933 } 934 #endif 935 936 ierr = PetscHMPIFinalize();CHKERRQ(ierr); 937 #if defined(PETSC_HAVE_PTHREADCLASSES) 938 if (PetscThreadFinalize) { 939 /* thread pool case */ 940 ierr = (*PetscThreadFinalize)();CHKERRQ(ierr); 941 } 942 free(ThreadCoreAffinity); 943 #endif 944 945 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 946 ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc_info",&flg2,PETSC_NULL);CHKERRQ(ierr); 947 if (!flg2) { 948 flg2 = PETSC_FALSE; 949 ierr = PetscOptionsGetBool(PETSC_NULL,"-memory_info",&flg2,PETSC_NULL);CHKERRQ(ierr); 950 } 951 if (flg2) { 952 ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr); 953 } 954 955 #if defined(PETSC_USE_LOG) 956 flg1 = PETSC_FALSE; 957 ierr = PetscOptionsGetBool(PETSC_NULL,"-get_total_flops",&flg1,PETSC_NULL);CHKERRQ(ierr); 958 if (flg1) { 959 PetscLogDouble flops = 0; 960 ierr = MPI_Reduce(&_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 961 ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr); 962 } 963 #endif 964 965 966 #if defined(PETSC_USE_LOG) 967 #if defined(PETSC_HAVE_MPE) 968 mname[0] = 0; 969 ierr = PetscOptionsGetString(PETSC_NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 970 if (flg1){ 971 if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);} 972 else {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);} 973 } 974 #endif 975 mname[0] = 0; 976 ierr = PetscOptionsGetString(PETSC_NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 977 if (flg1) { 978 PetscViewer viewer; 979 if (mname[0]) { 980 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 981 ierr = PetscLogView(viewer);CHKERRQ(ierr); 982 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 983 } else { 984 viewer = PETSC_VIEWER_STDOUT_WORLD; 985 ierr = PetscLogView(viewer);CHKERRQ(ierr); 986 } 987 } 988 989 mname[0] = 0; 990 ierr = PetscOptionsGetString(PETSC_NULL,"-log_summary_python",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 991 if (flg1) { 992 PetscViewer viewer; 993 if (mname[0]) { 994 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 995 ierr = PetscLogViewPython(viewer);CHKERRQ(ierr); 996 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 997 } else { 998 viewer = PETSC_VIEWER_STDOUT_WORLD; 999 ierr = PetscLogViewPython(viewer);CHKERRQ(ierr); 1000 } 1001 } 1002 1003 ierr = PetscOptionsGetString(PETSC_NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1004 if (flg1) { 1005 if (mname[0]) {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);} 1006 else {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,0);CHKERRQ(ierr);} 1007 } 1008 1009 mname[0] = 0; 1010 ierr = PetscOptionsGetString(PETSC_NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1011 ierr = PetscOptionsGetString(PETSC_NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr); 1012 if (flg1 || flg2){ 1013 if (mname[0]) PetscLogDump(mname); 1014 else PetscLogDump(0); 1015 } 1016 #endif 1017 1018 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_USE_PTHREAD) 1019 if (PetscStackActive) { 1020 ierr = PetscStackDestroy();CHKERRQ(ierr); 1021 } 1022 #endif 1023 1024 flg1 = PETSC_FALSE; 1025 ierr = PetscOptionsGetBool(PETSC_NULL,"-no_signal_handler",&flg1,PETSC_NULL);CHKERRQ(ierr); 1026 if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);} 1027 flg1 = PETSC_FALSE; 1028 ierr = PetscOptionsGetBool(PETSC_NULL,"-mpidump",&flg1,PETSC_NULL);CHKERRQ(ierr); 1029 if (flg1) { 1030 ierr = PetscMPIDump(stdout);CHKERRQ(ierr); 1031 } 1032 flg1 = PETSC_FALSE; 1033 flg2 = PETSC_FALSE; 1034 /* preemptive call to avoid listing this option in options table as unused */ 1035 ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_dump",&flg1);CHKERRQ(ierr); 1036 ierr = PetscOptionsGetBool(PETSC_NULL,"-options_table",&flg2,PETSC_NULL);CHKERRQ(ierr); 1037 1038 if (flg2) { 1039 ierr = PetscOptionsView(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); 1040 } 1041 1042 /* to prevent PETSc -options_left from warning */ 1043 ierr = PetscOptionsHasName(PETSC_NULL,"-nox",&flg1);CHKERRQ(ierr); 1044 ierr = PetscOptionsHasName(PETSC_NULL,"-nox_warning",&flg1);CHKERRQ(ierr); 1045 ierr = PetscOptionsGetBool(PETSC_NULL,"-objects_left",&objects_left,PETSC_NULL);CHKERRQ(ierr); 1046 1047 if (!PetscHMPIWorker) { /* worker processes skip this because they do not usually process options */ 1048 flg3 = PETSC_FALSE; /* default value is required */ 1049 ierr = PetscOptionsGetBool(PETSC_NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr); 1050 ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr); 1051 if (flg3) { 1052 if (!flg2) { /* have not yet printed the options */ 1053 ierr = PetscOptionsView(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); 1054 } 1055 if (!nopt) { 1056 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr); 1057 } else if (nopt == 1) { 1058 ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr); 1059 } else { 1060 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr); 1061 } 1062 } 1063 #if defined(PETSC_USE_DEBUG) 1064 if (nopt && !flg3 && !flg1) { 1065 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr); 1066 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr); 1067 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1068 } else if (nopt && flg3) { 1069 #else 1070 if (nopt && flg3) { 1071 #endif 1072 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1073 } 1074 } 1075 1076 /* 1077 Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_(). 1078 */ 1079 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1080 1081 /* 1082 List all objects the user may have forgot to free 1083 */ 1084 if (objects_left && PetscObjectsCounts) { 1085 ierr = PetscPrintf(PETSC_COMM_WORLD,"The following objects %D were never freed\n",PetscObjectsCounts); 1086 } 1087 for (i=0; i<PetscObjectsMaxCounts; i++) { 1088 if (PetscObjects[i]) { 1089 if (objects_left) { 1090 ierr = PetscPrintf(PETSC_COMM_WORLD," %s %s %s\n",PetscObjects[i]->class_name,PetscObjects[i]->type_name,PetscObjects[i]->name);CHKERRQ(ierr); 1091 } 1092 } 1093 } 1094 /* cannot actually destroy the left over objects, but destroy the list */ 1095 PetscObjectsCounts = 0; 1096 PetscObjectsMaxCounts = 0; 1097 ierr = PetscFree(PetscObjects);CHKERRQ(ierr); 1098 1099 1100 #if defined(PETSC_USE_LOG) 1101 ierr = PetscLogDestroy();CHKERRQ(ierr); 1102 #endif 1103 1104 /* 1105 Free all the registered create functions, such as KSPList, VecList, SNESList, etc 1106 */ 1107 ierr = PetscFListDestroyAll();CHKERRQ(ierr); 1108 1109 /* 1110 Destroy any packages that registered a finalize 1111 */ 1112 ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr); 1113 1114 /* 1115 Destroy all the function registration lists created 1116 */ 1117 ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr); 1118 1119 if (petsc_history) { 1120 ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr); 1121 petsc_history = 0; 1122 } 1123 1124 ierr = PetscInfoAllow(PETSC_FALSE,PETSC_NULL);CHKERRQ(ierr); 1125 1126 { 1127 char fname[PETSC_MAX_PATH_LEN]; 1128 FILE *fd; 1129 int err; 1130 1131 fname[0] = 0; 1132 ierr = PetscOptionsGetString(PETSC_NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr); 1133 if (flg1 && fname[0]) { 1134 char sname[PETSC_MAX_PATH_LEN]; 1135 1136 sprintf(sname,"%s_%d",fname,rank); 1137 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1138 ierr = PetscMallocDump(fd);CHKERRQ(ierr); 1139 err = fclose(fd); 1140 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1141 } else if (flg1) { 1142 MPI_Comm local_comm; 1143 1144 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr); 1145 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1146 ierr = PetscMallocDump(stdout);CHKERRQ(ierr); 1147 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1148 ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr); 1149 } 1150 } 1151 { 1152 char fname[PETSC_MAX_PATH_LEN]; 1153 FILE *fd; 1154 1155 fname[0] = 0; 1156 ierr = PetscOptionsGetString(PETSC_NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr); 1157 if (flg1 && fname[0]) { 1158 char sname[PETSC_MAX_PATH_LEN]; 1159 int err; 1160 1161 sprintf(sname,"%s_%d",fname,rank); 1162 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1163 ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr); 1164 err = fclose(fd); 1165 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1166 } else if (flg1) { 1167 ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr); 1168 } 1169 } 1170 /* Can be destroyed only after all the options are used */ 1171 ierr = PetscOptionsDestroy();CHKERRQ(ierr); 1172 1173 PetscGlobalArgc = 0; 1174 PetscGlobalArgs = 0; 1175 1176 #if defined(PETSC_USE_REAL___FLOAT128) 1177 ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr); 1178 ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr); 1179 ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr); 1180 ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr); 1181 #endif 1182 1183 #if defined(PETSC_USE_COMPLEX) 1184 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 1185 ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr); 1186 ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 1187 ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr); 1188 #endif 1189 #endif 1190 ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr); 1191 ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr); 1192 ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr); 1193 ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr); 1194 ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr); 1195 1196 /* 1197 Destroy any known inner MPI_Comm's and attributes pointing to them 1198 Note this will not destroy any new communicators the user has created. 1199 1200 If all PETSc objects were not destroyed those left over objects will have hanging references to 1201 the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again 1202 */ 1203 { 1204 PetscCommCounter *counter; 1205 PetscMPIInt flg; 1206 MPI_Comm icomm; 1207 void *ptr; 1208 ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr); 1209 if (flg) { 1210 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 1211 ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 1212 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1213 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1214 1215 ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1216 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1217 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1218 } 1219 ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr); 1220 if (flg) { 1221 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 1222 ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 1223 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1224 if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1225 1226 ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1227 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1228 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1229 } 1230 } 1231 1232 ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr); 1233 ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr); 1234 ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr); 1235 1236 ierr = PetscInfo(0,"PETSc successfully ended!\n");CHKERRQ(ierr); 1237 if (PetscBeganMPI) { 1238 #if defined(PETSC_HAVE_MPI_FINALIZED) 1239 PetscMPIInt flag; 1240 ierr = MPI_Finalized(&flag);CHKERRQ(ierr); 1241 if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()"); 1242 #endif 1243 ierr = MPI_Finalize();CHKERRQ(ierr); 1244 } 1245 1246 if (PETSC_ZOPEFD){ 1247 if (PETSC_ZOPEFD != PETSC_STDOUT) fprintf(PETSC_ZOPEFD, "<<<end>>>"); 1248 else fprintf(PETSC_STDOUT, "<<<end>>>"); 1249 } 1250 1251 #if defined(PETSC_HAVE_CUDA) 1252 cublasShutdown(); 1253 #endif 1254 /* 1255 1256 Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because 1257 the communicator has some outstanding requests on it. Specifically if the 1258 flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See 1259 src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate() 1260 is never freed as it should be. Thus one may obtain messages of the form 1261 [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the 1262 memory was not freed. 1263 1264 */ 1265 ierr = PetscMallocClear();CHKERRQ(ierr); 1266 PetscInitializeCalled = PETSC_FALSE; 1267 PetscFinalizeCalled = PETSC_TRUE; 1268 PetscFunctionReturn(ierr); 1269 } 1270 1271