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