1 2 /* 3 This file defines the initialization of PETSc, including PetscInitialize() 4 */ 5 #define PETSC_DESIRE_COMPLEX 6 #include <petscsys.h> /*I "petscsys.h" I*/ 7 8 #if defined(PETSC_HAVE_CUDA) 9 #include <cublas.h> 10 #endif 11 12 #include <petscthreadcomm.h> 13 14 #if defined(PETSC_USE_LOG) 15 extern PetscErrorCode PetscLogBegin_Private(void); 16 #endif 17 extern PetscBool PetscHMPIWorker; 18 19 20 #if defined(PETSC_SERIALIZE_FUNCTIONS) 21 PetscFPT PetscFPTData = 0; 22 #endif 23 24 /* -----------------------------------------------------------------------------------------*/ 25 26 extern FILE *petsc_history; 27 28 extern PetscErrorCode PetscInitialize_DynamicLibraries(void); 29 extern PetscErrorCode PetscFinalize_DynamicLibraries(void); 30 extern PetscErrorCode PetscFListDestroyAll(void); 31 extern PetscErrorCode PetscOpFListDestroyAll(void); 32 extern PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm,int); 33 extern PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm,int); 34 extern PetscErrorCode PetscCloseHistoryFile(FILE **); 35 36 /* user may set this BEFORE calling PetscInitialize() */ 37 MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL; 38 39 PetscMPIInt Petsc_Counter_keyval = MPI_KEYVAL_INVALID; 40 PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID; 41 PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID; 42 43 /* 44 Declare and set all the string names of the PETSc enums 45 */ 46 const char *const PetscBools[] = {"FALSE","TRUE","PetscBool","PETSC_",0}; 47 const char *const PetscCopyModes[] = {"COPY_VALUES","OWN_POINTER","USE_POINTER","PetscCopyMode","PETSC_",0}; 48 const char *const PetscDataTypes[] = {"INT","DOUBLE","COMPLEX","LONG","SHORT","FLOAT", 49 "CHAR","LOGICAL","ENUM","BOOL","LONGDOUBLE","OBJECT","FUNCTION","PetscDataType","PETSC_",0}; 50 51 PetscBool PetscPreLoadingUsed = PETSC_FALSE; 52 PetscBool PetscPreLoadingOn = PETSC_FALSE; 53 54 /* pthread_key for PetscStack */ 55 #if defined(PETSC_HAVE_PTHREADCLASSES) && !defined(PETSC_PTHREAD_LOCAL) 56 pthread_key_t petscstack; 57 #endif 58 59 /* 60 Checks the options database for initializations related to the 61 PETSc components 62 */ 63 #undef __FUNCT__ 64 #define __FUNCT__ "PetscOptionsCheckInitial_Components" 65 PetscErrorCode PetscOptionsCheckInitial_Components(void) 66 { 67 PetscBool flg1; 68 PetscErrorCode ierr; 69 70 PetscFunctionBegin; 71 ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg1);CHKERRQ(ierr); 72 if (flg1) { 73 #if defined (PETSC_USE_LOG) 74 MPI_Comm comm = PETSC_COMM_WORLD; 75 ierr = (*PetscHelpPrintf)(comm,"------Additional PETSc component options--------\n");CHKERRQ(ierr); 76 ierr = (*PetscHelpPrintf)(comm," -log_summary_exclude: <vec,mat,pc.ksp,snes>\n");CHKERRQ(ierr); 77 ierr = (*PetscHelpPrintf)(comm," -info_exclude: <null,vec,mat,pc,ksp,snes,ts>\n");CHKERRQ(ierr); 78 ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr); 79 #endif 80 } 81 PetscFunctionReturn(0); 82 } 83 84 extern PetscBool PetscBeganMPI; 85 86 #undef __FUNCT__ 87 #define __FUNCT__ "PetscInitializeNoPointers" 88 /* 89 PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args 90 91 Collective 92 93 Level: advanced 94 95 Notes: this is called only by the PETSc MATLAB and Julia interface. Even though it might start MPI it sets the flag to 96 indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to 97 be called multiple times from MATLAB and Julia without the problem of trying to initialize MPI more than once. 98 99 Turns off PETSc signal handling because that can interact with MATLAB's signal handling causing random crashes. 100 101 .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments() 102 */ 103 PetscErrorCode PetscInitializeNoPointers(int argc,char **args,const char *filename,const char *help) 104 { 105 PetscErrorCode ierr; 106 int myargc = argc; 107 char **myargs = args; 108 109 PetscFunctionBegin; 110 ierr = PetscInitialize(&myargc,&myargs,filename,help); 111 ierr = PetscPopSignalHandler();CHKERRQ(ierr); 112 PetscBeganMPI = PETSC_FALSE; 113 PetscFunctionReturn(ierr); 114 } 115 116 #undef __FUNCT__ 117 #define __FUNCT__ "PetscGetPETSC_COMM_SELF" 118 /* 119 Used by MATLAB and Julia interface to get communicator 120 */ 121 PetscErrorCode PetscGetPETSC_COMM_SELF(MPI_Comm *comm) 122 { 123 PetscFunctionBegin; 124 *comm = PETSC_COMM_SELF; 125 PetscFunctionReturn(0); 126 } 127 128 #undef __FUNCT__ 129 #define __FUNCT__ "PetscInitializeNoArguments" 130 /*@C 131 PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without 132 the command line arguments. 133 134 Collective 135 136 Level: advanced 137 138 .seealso: PetscInitialize(), PetscInitializeFortran() 139 @*/ 140 PetscErrorCode PetscInitializeNoArguments(void) 141 { 142 PetscErrorCode ierr; 143 int argc = 0; 144 char **args = 0; 145 146 PetscFunctionBegin; 147 ierr = PetscInitialize(&argc,&args,PETSC_NULL,PETSC_NULL); 148 PetscFunctionReturn(ierr); 149 } 150 151 #undef __FUNCT__ 152 #define __FUNCT__ "PetscInitialized" 153 /*@ 154 PetscInitialized - Determine whether PETSc is initialized. 155 156 7 Level: beginner 157 158 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 159 @*/ 160 PetscErrorCode PetscInitialized(PetscBool *isInitialized) 161 { 162 PetscFunctionBegin; 163 PetscValidPointer(isInitialized, 1); 164 *isInitialized = PetscInitializeCalled; 165 PetscFunctionReturn(0); 166 } 167 168 #undef __FUNCT__ 169 #define __FUNCT__ "PetscFinalized" 170 /*@ 171 PetscFinalized - Determine whether PetscFinalize() has been called yet 172 173 Level: developer 174 175 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 176 @*/ 177 PetscErrorCode PetscFinalized(PetscBool *isFinalized) 178 { 179 PetscFunctionBegin; 180 PetscValidPointer(isFinalized, 1); 181 *isFinalized = PetscFinalizeCalled; 182 PetscFunctionReturn(0); 183 } 184 185 extern PetscErrorCode PetscOptionsCheckInitial_Private(void); 186 extern PetscBool PetscBeganMPI; 187 188 /* 189 This function is the MPI reduction operation used to compute the sum of the 190 first half of the datatype and the max of the second half. 191 */ 192 MPI_Op PetscMaxSum_Op = 0; 193 194 EXTERN_C_BEGIN 195 #undef __FUNCT__ 196 #define __FUNCT__ "PetscMaxSum_Local" 197 void MPIAPI PetscMaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype) 198 { 199 PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt; 200 201 PetscFunctionBegin; 202 if (*datatype != MPIU_2INT) { 203 (*PetscErrorPrintf)("Can only handle MPIU_2INT data types"); 204 MPI_Abort(MPI_COMM_WORLD,1); 205 } 206 207 for (i=0; i<count; i++) { 208 xout[2*i] = PetscMax(xout[2*i],xin[2*i]); 209 xout[2*i+1] += xin[2*i+1]; 210 } 211 PetscFunctionReturnVoid(); 212 } 213 EXTERN_C_END 214 215 /* 216 Returns the max of the first entry owned by this processor and the 217 sum of the second entry. 218 219 The reason nprocs[2*i] contains lengths nprocs[2*i+1] contains flag of 1 if length is nonzero 220 is so that the PetscMaxSum_Op() can set TWO values, if we passed in only nprocs[i] with lengths 221 there would be no place to store the both needed results. 222 */ 223 #undef __FUNCT__ 224 #define __FUNCT__ "PetscMaxSum" 225 PetscErrorCode PetscMaxSum(MPI_Comm comm,const PetscInt nprocs[],PetscInt *max,PetscInt *sum) 226 { 227 PetscMPIInt size,rank; 228 struct {PetscInt max,sum;} *work; 229 PetscErrorCode ierr; 230 231 PetscFunctionBegin; 232 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 233 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 234 ierr = PetscMalloc(size*sizeof(*work),&work);CHKERRQ(ierr); 235 ierr = MPI_Allreduce((void*)nprocs,work,size,MPIU_2INT,PetscMaxSum_Op,comm);CHKERRQ(ierr); 236 *max = work[rank].max; 237 *sum = work[rank].sum; 238 ierr = PetscFree(work);CHKERRQ(ierr); 239 PetscFunctionReturn(0); 240 } 241 242 /* ----------------------------------------------------------------------------*/ 243 MPI_Op PetscADMax_Op = 0; 244 245 EXTERN_C_BEGIN 246 #undef __FUNCT__ 247 #define __FUNCT__ "PetscADMax_Local" 248 void MPIAPI PetscADMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 249 { 250 PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out; 251 PetscInt i,count = *cnt; 252 253 PetscFunctionBegin; 254 if (*datatype != MPIU_2SCALAR) { 255 (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types"); 256 MPI_Abort(MPI_COMM_WORLD,1); 257 } 258 259 for (i=0; i<count; i++) { 260 if (PetscRealPart(xout[2*i]) < PetscRealPart(xin[2*i])) { 261 xout[2*i] = xin[2*i]; 262 xout[2*i+1] = xin[2*i+1]; 263 } 264 } 265 PetscFunctionReturnVoid(); 266 } 267 EXTERN_C_END 268 269 MPI_Op PetscADMin_Op = 0; 270 271 EXTERN_C_BEGIN 272 #undef __FUNCT__ 273 #define __FUNCT__ "PetscADMin_Local" 274 void MPIAPI PetscADMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 275 { 276 PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out; 277 PetscInt i,count = *cnt; 278 279 PetscFunctionBegin; 280 if (*datatype != MPIU_2SCALAR) { 281 (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types"); 282 MPI_Abort(MPI_COMM_WORLD,1); 283 } 284 285 for (i=0; i<count; i++) { 286 if (PetscRealPart(xout[2*i]) > PetscRealPart(xin[2*i])) { 287 xout[2*i] = xin[2*i]; 288 xout[2*i+1] = xin[2*i+1]; 289 } 290 } 291 PetscFunctionReturnVoid(); 292 } 293 EXTERN_C_END 294 /* ---------------------------------------------------------------------------------------*/ 295 296 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 297 MPI_Op MPIU_SUM = 0; 298 299 #undef __FUNCT__ 300 #define __FUNCT__ "PetscSum_Local" 301 PETSC_EXTERN_C void PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 302 { 303 PetscInt i,count = *cnt; 304 305 PetscFunctionBegin; 306 if (*datatype == MPIU_REAL) { 307 PetscReal *xin = (PetscReal *)in,*xout = (PetscReal*)out; 308 for (i=0; i<count; i++) { 309 xout[i] += xin[i]; 310 } 311 } 312 #if defined(PETSC_HAVE_COMPLEX) 313 else if (*datatype == MPIU_COMPLEX) { 314 PetscComplex *xin = (PetscComplex *)in,*xout = (PetscComplex*)out; 315 for (i=0; i<count; i++) { 316 xout[i] += xin[i]; 317 } 318 } 319 #endif 320 else { 321 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"); 322 MPI_Abort(MPI_COMM_WORLD,1); 323 } 324 PetscFunctionReturnVoid(); 325 } 326 #endif 327 328 #if defined(PETSC_USE_REAL___FLOAT128) 329 MPI_Op MPIU_MAX = 0; 330 MPI_Op MPIU_MIN = 0; 331 332 #undef __FUNCT__ 333 #define __FUNCT__ "PetscMax_Local" 334 PETSC_EXTERN_C void PetscMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 335 { 336 PetscInt i,count = *cnt; 337 338 PetscFunctionBegin; 339 if (*datatype == MPIU_REAL) { 340 PetscReal *xin = (PetscReal *)in,*xout = (PetscReal*)out; 341 for (i=0; i<count; i++) { 342 xout[i] = PetscMax(xout[i],xin[i]); 343 } 344 } 345 #if defined(PETSC_HAVE_COMPLEX) 346 else if (*datatype == MPIU_COMPLEX) { 347 PetscComplex *xin = (PetscComplex *)in,*xout = (PetscComplex*)out; 348 for (i=0; i<count; i++) { 349 xout[i] = PetscRealPartComplex(xout[i])<PetscRealPartComplex(xin[i])? xin[i]: xout[i]; 350 } 351 } 352 #endif 353 else { 354 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"); 355 MPI_Abort(MPI_COMM_WORLD,1); 356 } 357 PetscFunctionReturnVoid(); 358 } 359 360 #undef __FUNCT__ 361 #define __FUNCT__ "PetscMin_Local" 362 PETSC_EXTERN_C void PetscMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 363 { 364 PetscInt i,count = *cnt; 365 366 PetscFunctionBegin; 367 if (*datatype == MPIU_REAL) { 368 PetscReal *xin = (PetscReal *)in,*xout = (PetscReal*)out; 369 for (i=0; i<count; i++) { 370 xout[i] = PetscMin(xout[i],xin[i]); 371 } 372 } 373 #if defined(PETSC_HAVE_COMPLEX) 374 else if (*datatype == MPIU_COMPLEX) { 375 PetscComplex *xin = (PetscComplex *)in,*xout = (PetscComplex*)out; 376 for (i=0; i<count; i++) { 377 xout[i] = PetscRealPartComplex(xout[i])>PetscRealPartComplex(xin[i])? xin[i]: xout[i]; 378 } 379 } 380 #endif 381 else { 382 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"); 383 MPI_Abort(MPI_COMM_WORLD,1); 384 } 385 PetscFunctionReturnVoid(); 386 } 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 . -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds 601 . -fp_trap - Stops on floating point exceptions (Note that on the 602 IBM RS6000 this slows code by at least a factor of 10.) 603 . -no_signal_handler - Indicates not to trap error signals 604 . -shared_tmp - indicates /tmp directory is shared by all processors 605 . -not_shared_tmp - each processor has own /tmp 606 . -tmp - alternative name of /tmp directory 607 . -get_total_flops - returns total flops done by all processors 608 . -memory_info - Print memory usage at end of run 609 - -server <port> - start PETSc webserver (default port is 8080) 610 611 Options Database Keys for Profiling: 612 See the <a href="../../docs/manual.pdf#nameddest=ch_profiling">profiling chapter of the users manual</a> for details. 613 + -log_trace [filename] - Print traces of all PETSc calls 614 to the screen (useful to determine where a program 615 hangs without running in the debugger). See PetscLogTraceBegin(). 616 . -info <optional filename> - Prints verbose information to the screen 617 - -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages 618 619 Environmental Variables: 620 + PETSC_TMP - alternative tmp directory 621 . PETSC_SHARED_TMP - tmp is shared by all processes 622 . PETSC_NOT_SHARED_TMP - each process has its own private tmp 623 . PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer 624 - PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to 625 626 627 Level: beginner 628 629 Notes: 630 If for some reason you must call MPI_Init() separately, call 631 it before PetscInitialize(). 632 633 Fortran Version: 634 In Fortran this routine has the format 635 $ call PetscInitialize(file,ierr) 636 637 + ierr - error return code 638 - file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use PETSC_NULL_CHARACTER to not check for 639 code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files 640 641 Important Fortran Note: 642 In Fortran, you MUST use PETSC_NULL_CHARACTER to indicate a 643 null character string; you CANNOT just use PETSC_NULL as 644 in the C version. See the <a href="../../docs/manual.pdf">users manual</a> for details. 645 646 If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after 647 calling PetscInitialize(). 648 649 Concepts: initializing PETSc 650 651 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments() 652 653 @*/ 654 PetscErrorCode PetscInitialize(int *argc,char ***args,const char file[],const char help[]) 655 { 656 PetscErrorCode ierr; 657 PetscMPIInt flag, size; 658 PetscInt nodesize; 659 PetscBool flg; 660 char hostname[256]; 661 662 PetscFunctionBegin; 663 if (PetscInitializeCalled) PetscFunctionReturn(0); 664 665 /* these must be initialized in a routine, not as a constant declaration*/ 666 PETSC_STDOUT = stdout; 667 PETSC_STDERR = stderr; 668 669 ierr = PetscOptionsCreate();CHKERRQ(ierr); 670 671 /* 672 We initialize the program name here (before MPI_Init()) because MPICH has a bug in 673 it that it sets args[0] on all processors to be args[0] on the first processor. 674 */ 675 if (argc && *argc) { 676 ierr = PetscSetProgramName(**args);CHKERRQ(ierr); 677 } else { 678 ierr = PetscSetProgramName("Unknown Name");CHKERRQ(ierr); 679 } 680 681 ierr = MPI_Initialized(&flag);CHKERRQ(ierr); 682 if (!flag) { 683 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"); 684 #if defined(PETSC_HAVE_MPI_INIT_THREAD) 685 { 686 PetscMPIInt provided; 687 ierr = MPI_Init_thread(argc,args,MPI_THREAD_FUNNELED,&provided);CHKERRQ(ierr); 688 } 689 #else 690 ierr = MPI_Init(argc,args);CHKERRQ(ierr); 691 #endif 692 PetscBeganMPI = PETSC_TRUE; 693 } 694 if (argc && args) { 695 PetscGlobalArgc = *argc; 696 PetscGlobalArgs = *args; 697 } 698 PetscFinalizeCalled = PETSC_FALSE; 699 700 if (PETSC_COMM_WORLD == MPI_COMM_NULL) { 701 PETSC_COMM_WORLD = MPI_COMM_WORLD; 702 } 703 ierr = MPI_Errhandler_set(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);CHKERRQ(ierr); 704 705 /* Done after init due to a bug in MPICH-GM? */ 706 ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr); 707 708 ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRQ(ierr); 709 ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRQ(ierr); 710 711 MPIU_BOOL = MPI_INT; 712 MPIU_ENUM = MPI_INT; 713 714 /* 715 Initialized the global complex variable; this is because with 716 shared libraries the constructors for global variables 717 are not called; at least on IRIX. 718 */ 719 #if defined(PETSC_HAVE_COMPLEX) 720 { 721 #if defined(PETSC_CLANGUAGE_CXX) 722 PetscComplex ic(0.0,1.0); 723 PETSC_i = ic; 724 #elif defined(PETSC_CLANGUAGE_C) 725 PETSC_i = _Complex_I; 726 #endif 727 } 728 729 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 730 ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 731 ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 732 ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);CHKERRQ(ierr); 733 ierr = MPI_Type_commit(&MPIU_C_COMPLEX);CHKERRQ(ierr); 734 #endif 735 #endif /* PETSC_HAVE_COMPLEX */ 736 737 /* 738 Create the PETSc MPI reduction operator that sums of the first 739 half of the entries and maxes the second half. 740 */ 741 ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);CHKERRQ(ierr); 742 743 #if defined(PETSC_USE_REAL___FLOAT128) 744 ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);CHKERRQ(ierr); 745 ierr = MPI_Type_commit(&MPIU___FLOAT128);CHKERRQ(ierr); 746 #if defined(PETSC_HAVE_COMPLEX) 747 ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);CHKERRQ(ierr); 748 ierr = MPI_Type_commit(&MPIU___COMPLEX128);CHKERRQ(ierr); 749 #endif 750 ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRQ(ierr); 751 ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRQ(ierr); 752 #endif 753 754 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 755 ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr); 756 #endif 757 758 ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr); 759 ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr); 760 ierr = MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);CHKERRQ(ierr); 761 ierr = MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);CHKERRQ(ierr); 762 763 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT) 764 ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr); 765 ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr); 766 #endif 767 768 /* 769 Attributes to be set on PETSc communicators 770 */ 771 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);CHKERRQ(ierr); 772 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_InnerComm_keyval,(void*)0);CHKERRQ(ierr); 773 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_OuterComm_keyval,(void*)0);CHKERRQ(ierr); 774 775 /* 776 Build the options database 777 */ 778 ierr = PetscOptionsInsert(argc,args,file);CHKERRQ(ierr); 779 780 781 /* 782 Print main application help message 783 */ 784 ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg);CHKERRQ(ierr); 785 if (help && flg) { 786 ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr); 787 } 788 ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr); 789 790 /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */ 791 #if defined(PETSC_USE_LOG) 792 ierr = PetscLogBegin_Private();CHKERRQ(ierr); 793 #endif 794 795 /* 796 Load the dynamic libraries (on machines that support them), this registers all 797 the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes) 798 */ 799 ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr); 800 801 ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); 802 ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr); 803 ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr); 804 ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr); 805 806 ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr); 807 /* Check the options database for options related to the options database itself */ 808 ierr = PetscOptionsSetFromOptions();CHKERRQ(ierr); 809 810 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 811 /* 812 Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI 813 814 Currently not used because it is not supported by MPICH. 815 */ 816 #if !defined(PETSC_WORDS_BIGENDIAN) 817 ierr = MPI_Register_datarep((char *)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,PETSC_NULL);CHKERRQ(ierr); 818 #endif 819 #endif 820 821 ierr = PetscOptionsGetInt(PETSC_NULL,"-hmpi_spawn_size",&nodesize,&flg);CHKERRQ(ierr); 822 if (flg) { 823 #if defined(PETSC_HAVE_MPI_COMM_SPAWN) 824 ierr = PetscHMPISpawn((PetscMPIInt) nodesize);CHKERRQ(ierr); /* worker nodes never return from here; they go directly to PetscEnd() */ 825 #else 826 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"PETSc built without MPI 2 (MPI_Comm_spawn) support, use -hmpi_merge_size instead"); 827 #endif 828 } else { 829 ierr = PetscOptionsGetInt(PETSC_NULL,"-hmpi_merge_size",&nodesize,&flg);CHKERRQ(ierr); 830 if (flg) { 831 ierr = PetscHMPIMerge((PetscMPIInt) nodesize,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 832 if (PetscHMPIWorker) { /* if worker then never enter user code */ 833 PetscInitializeCalled = PETSC_TRUE; 834 ierr = PetscEnd(); 835 } 836 } 837 } 838 839 #if defined(PETSC_HAVE_CUDA) 840 { 841 PetscMPIInt p; 842 for (p = 0; p < PetscGlobalSize; ++p) { 843 if (p == PetscGlobalRank) {cublasInit();} 844 ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr); 845 } 846 } 847 #endif 848 849 #if defined(PETSC_HAVE_AMS) 850 ierr = PetscOptionsHasName(PETSC_NULL,"-ams_publish_objects",&flg);CHKERRQ(ierr); 851 if (flg) { 852 PetscAMSPublishAll = PETSC_TRUE; 853 } 854 #endif 855 856 ierr = PetscOptionsHasName(PETSC_NULL,"-python",&flg);CHKERRQ(ierr); 857 if (flg) { 858 PetscInitializeCalled = PETSC_TRUE; 859 ierr = PetscPythonInitialize(PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 860 } 861 862 ierr = PetscThreadCommInitializePackage(PETSC_NULL);CHKERRQ(ierr); 863 864 #if defined(PETSC_USE_DEBUG) 865 PetscThreadLocalRegister(&petscstack); /* Creates petscstack_key if needed */ 866 ierr = PetscStackCreate();CHKERRQ(ierr); 867 #endif 868 869 #if defined(PETSC_SERIALIZE_FUNCTIONS) 870 ierr = PetscFPTCreate(10000);CHKERRQ(ierr); 871 #endif 872 873 /* 874 Once we are completedly initialized then we can set this variables 875 */ 876 PetscInitializeCalled = PETSC_TRUE; 877 PetscFunctionReturn(0); 878 } 879 880 extern PetscObject *PetscObjects; 881 extern PetscInt PetscObjectsCounts, PetscObjectsMaxCounts; 882 883 #undef __FUNCT__ 884 #define __FUNCT__ "PetscFinalize" 885 /*@C 886 PetscFinalize - Checks for options to be called at the conclusion 887 of the program. MPI_Finalize() is called only if the user had not 888 called MPI_Init() before calling PetscInitialize(). 889 890 Collective on PETSC_COMM_WORLD 891 892 Options Database Keys: 893 + -options_table - Calls PetscOptionsView() 894 . -options_left - Prints unused options that remain in the database 895 . -objects_dump [all] - Prints list of objects allocated by the user that have not been freed, the option all cause all outstanding objects to be listed 896 . -mpidump - Calls PetscMPIDump() 897 . -malloc_dump - Calls PetscMallocDump() 898 . -malloc_info - Prints total memory usage 899 - -malloc_log - Prints summary of memory usage 900 901 Options Database Keys for Profiling: 902 See the <a href="../../docs/manual.pdf#nameddest=ch_profiling">profiling chapter of the users manual</a> for details. 903 + -log_summary [filename] - Prints summary of flop and timing 904 information to screen. If the filename is specified the 905 summary is written to the file. See PetscLogView(). 906 . -log_summary_python [filename] - Prints data on of flop and timing usage to a file or screen. 907 See PetscLogPrintSViewPython(). 908 . -log_all [filename] - Logs extensive profiling information 909 See PetscLogDump(). 910 . -log [filename] - Logs basic profiline information See PetscLogDump(). 911 . -log_sync - Log the synchronization in scatters, inner products 912 and norms 913 - -log_mpe [filename] - Creates a logfile viewable by the 914 utility Upshot/Nupshot (in MPICH distribution) 915 916 Level: beginner 917 918 Note: 919 See PetscInitialize() for more general runtime options. 920 921 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd() 922 @*/ 923 PetscErrorCode PetscFinalize(void) 924 { 925 PetscErrorCode ierr; 926 PetscMPIInt rank; 927 PetscInt nopt; 928 PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE; 929 #if defined(PETSC_HAVE_AMS) 930 PetscBool flg = PETSC_FALSE; 931 #endif 932 #if defined(PETSC_USE_LOG) 933 char mname[PETSC_MAX_PATH_LEN]; 934 #endif 935 936 PetscFunctionBegin; 937 938 if (!PetscInitializeCalled) { 939 printf("PetscInitialize() must be called before PetscFinalize()\n"); 940 PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE); 941 } 942 ierr = PetscInfo(PETSC_NULL,"PetscFinalize() called\n");CHKERRQ(ierr); 943 944 #if defined(PETSC_SERIALIZE_FUNCTIONS) 945 ierr = PetscFPTDestroy();CHKERRQ(ierr); 946 #endif 947 948 949 #if defined(PETSC_HAVE_AMS) 950 ierr = PetscOptionsGetBool(PETSC_NULL,"-options_gui",&flg,PETSC_NULL);CHKERRQ(ierr); 951 if (flg) { 952 ierr = PetscOptionsAMSDestroy();CHKERRQ(ierr); 953 } 954 #endif 955 956 ierr = PetscHMPIFinalize();CHKERRQ(ierr); 957 958 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 959 ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc_info",&flg2,PETSC_NULL);CHKERRQ(ierr); 960 if (!flg2) { 961 flg2 = PETSC_FALSE; 962 ierr = PetscOptionsGetBool(PETSC_NULL,"-memory_info",&flg2,PETSC_NULL);CHKERRQ(ierr); 963 } 964 if (flg2) { 965 ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr); 966 } 967 968 #if defined(PETSC_USE_LOG) 969 flg1 = PETSC_FALSE; 970 ierr = PetscOptionsGetBool(PETSC_NULL,"-get_total_flops",&flg1,PETSC_NULL);CHKERRQ(ierr); 971 if (flg1) { 972 PetscLogDouble flops = 0; 973 ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 974 ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr); 975 } 976 #endif 977 978 979 #if defined(PETSC_USE_LOG) 980 #if defined(PETSC_HAVE_MPE) 981 mname[0] = 0; 982 ierr = PetscOptionsGetString(PETSC_NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 983 if (flg1){ 984 if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);} 985 else {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);} 986 } 987 #endif 988 mname[0] = 0; 989 ierr = PetscOptionsGetString(PETSC_NULL,"-log_summary",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 = PetscLogView(viewer);CHKERRQ(ierr); 995 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 996 } else { 997 viewer = PETSC_VIEWER_STDOUT_WORLD; 998 ierr = PetscLogView(viewer);CHKERRQ(ierr); 999 } 1000 } 1001 1002 mname[0] = 0; 1003 ierr = PetscOptionsGetString(PETSC_NULL,"-log_summary_python",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1004 if (flg1) { 1005 PetscViewer viewer; 1006 if (mname[0]) { 1007 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 1008 ierr = PetscLogViewPython(viewer);CHKERRQ(ierr); 1009 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1010 } else { 1011 viewer = PETSC_VIEWER_STDOUT_WORLD; 1012 ierr = PetscLogViewPython(viewer);CHKERRQ(ierr); 1013 } 1014 } 1015 1016 ierr = PetscOptionsGetString(PETSC_NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1017 if (flg1) { 1018 if (mname[0]) {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);} 1019 else {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,0);CHKERRQ(ierr);} 1020 } 1021 1022 mname[0] = 0; 1023 ierr = PetscOptionsGetString(PETSC_NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1024 ierr = PetscOptionsGetString(PETSC_NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr); 1025 if (flg1 || flg2){ 1026 if (mname[0]) PetscLogDump(mname); 1027 else PetscLogDump(0); 1028 } 1029 #endif 1030 1031 /* 1032 Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_(). 1033 */ 1034 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1035 1036 #if defined(PETSC_USE_DEBUG) 1037 ierr = PetscStackDestroy();CHKERRQ(ierr); 1038 #endif 1039 1040 flg1 = PETSC_FALSE; 1041 ierr = PetscOptionsGetBool(PETSC_NULL,"-no_signal_handler",&flg1,PETSC_NULL);CHKERRQ(ierr); 1042 if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);} 1043 flg1 = PETSC_FALSE; 1044 ierr = PetscOptionsGetBool(PETSC_NULL,"-mpidump",&flg1,PETSC_NULL);CHKERRQ(ierr); 1045 if (flg1) { 1046 ierr = PetscMPIDump(stdout);CHKERRQ(ierr); 1047 } 1048 flg1 = PETSC_FALSE; 1049 flg2 = PETSC_FALSE; 1050 /* preemptive call to avoid listing this option in options table as unused */ 1051 ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_dump",&flg1);CHKERRQ(ierr); 1052 ierr = PetscOptionsHasName(PETSC_NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1053 ierr = PetscOptionsGetBool(PETSC_NULL,"-options_table",&flg2,PETSC_NULL);CHKERRQ(ierr); 1054 1055 if (flg2) { 1056 ierr = PetscOptionsView(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); 1057 } 1058 1059 /* to prevent PETSc -options_left from warning */ 1060 ierr = PetscOptionsHasName(PETSC_NULL,"-nox",&flg1);CHKERRQ(ierr); 1061 ierr = PetscOptionsHasName(PETSC_NULL,"-nox_warning",&flg1);CHKERRQ(ierr); 1062 1063 if (!PetscHMPIWorker) { /* worker processes skip this because they do not usually process options */ 1064 flg3 = PETSC_FALSE; /* default value is required */ 1065 ierr = PetscOptionsGetBool(PETSC_NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr); 1066 ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr); 1067 if (flg3) { 1068 if (!flg2) { /* have not yet printed the options */ 1069 ierr = PetscOptionsView(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); 1070 } 1071 if (!nopt) { 1072 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr); 1073 } else if (nopt == 1) { 1074 ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr); 1075 } else { 1076 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr); 1077 } 1078 } 1079 #if defined(PETSC_USE_DEBUG) 1080 if (nopt && !flg3 && !flg1) { 1081 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr); 1082 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr); 1083 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1084 } else if (nopt && flg3) { 1085 #else 1086 if (nopt && flg3) { 1087 #endif 1088 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1089 } 1090 } 1091 1092 /* 1093 List all objects the user may have forgot to free 1094 */ 1095 ierr = PetscOptionsHasName(PETSC_NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1096 if (flg1) { 1097 MPI_Comm local_comm; 1098 char string[64]; 1099 1100 ierr = PetscOptionsGetString(PETSC_NULL,"-objects_dump",string,64,PETSC_NULL);CHKERRQ(ierr); 1101 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr); 1102 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1103 ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr); 1104 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1105 ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr); 1106 } 1107 PetscObjectsCounts = 0; 1108 PetscObjectsMaxCounts = 0; 1109 ierr = PetscFree(PetscObjects);CHKERRQ(ierr); 1110 1111 1112 #if defined(PETSC_USE_LOG) 1113 ierr = PetscLogDestroy();CHKERRQ(ierr); 1114 #endif 1115 1116 /* 1117 Free all the registered create functions, such as KSPList, VecList, SNESList, etc 1118 */ 1119 ierr = PetscFListDestroyAll();CHKERRQ(ierr); 1120 1121 /* 1122 Free all the registered op functions, such as MatOpList, etc 1123 */ 1124 ierr = PetscOpFListDestroyAll();CHKERRQ(ierr); 1125 1126 /* 1127 Destroy any packages that registered a finalize 1128 */ 1129 ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr); 1130 1131 /* 1132 Destroy all the function registration lists created 1133 */ 1134 ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr); 1135 1136 if (petsc_history) { 1137 ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr); 1138 petsc_history = 0; 1139 } 1140 1141 ierr = PetscInfoAllow(PETSC_FALSE,PETSC_NULL);CHKERRQ(ierr); 1142 1143 { 1144 char fname[PETSC_MAX_PATH_LEN]; 1145 FILE *fd; 1146 int err; 1147 1148 fname[0] = 0; 1149 ierr = PetscOptionsGetString(PETSC_NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr); 1150 flg2 = PETSC_FALSE; 1151 ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc_test",&flg2,PETSC_NULL);CHKERRQ(ierr); 1152 #if defined(PETSC_USE_DEBUG) 1153 if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE; 1154 #else 1155 flg2 = PETSC_FALSE; /* Skip reporting for optimized builds regardless of -malloc_test */ 1156 #endif 1157 if (flg1 && fname[0]) { 1158 char sname[PETSC_MAX_PATH_LEN]; 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 = PetscMallocDump(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 || flg2) { 1166 MPI_Comm local_comm; 1167 1168 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr); 1169 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1170 ierr = PetscMallocDump(stdout);CHKERRQ(ierr); 1171 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1172 ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr); 1173 } 1174 } 1175 1176 { 1177 char fname[PETSC_MAX_PATH_LEN]; 1178 FILE *fd = PETSC_NULL; 1179 1180 fname[0] = 0; 1181 ierr = PetscOptionsGetString(PETSC_NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr); 1182 ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr); 1183 if (flg1 && fname[0]) { 1184 int err; 1185 1186 if (!rank) { 1187 fd = fopen(fname,"w"); 1188 if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname); 1189 } 1190 ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr); 1191 if (fd) { 1192 err = fclose(fd); 1193 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1194 } 1195 } else if (flg1 || flg2) { 1196 ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr); 1197 } 1198 } 1199 /* Can be destroyed only after all the options are used */ 1200 ierr = PetscOptionsDestroy();CHKERRQ(ierr); 1201 1202 PetscGlobalArgc = 0; 1203 PetscGlobalArgs = 0; 1204 1205 #if defined(PETSC_USE_REAL___FLOAT128) 1206 ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr); 1207 #if defined(PETSC_HAVE_COMPLEX) 1208 ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr); 1209 #endif 1210 ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr); 1211 ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr); 1212 #endif 1213 1214 #if defined(PETSC_HAVE_COMPLEX) 1215 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 1216 ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 1217 ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr); 1218 #endif 1219 #endif 1220 1221 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 1222 ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr); 1223 #endif 1224 1225 ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr); 1226 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT) 1227 ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr); 1228 #endif 1229 ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr); 1230 ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr); 1231 ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr); 1232 1233 /* 1234 Destroy any known inner MPI_Comm's and attributes pointing to them 1235 Note this will not destroy any new communicators the user has created. 1236 1237 If all PETSc objects were not destroyed those left over objects will have hanging references to 1238 the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again 1239 */ 1240 { 1241 PetscCommCounter *counter; 1242 PetscMPIInt flg; 1243 MPI_Comm icomm; 1244 void *ptr; 1245 ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr); 1246 if (flg) { 1247 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 1248 ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 1249 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1250 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1251 1252 ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1253 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1254 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1255 } 1256 ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr); 1257 if (flg) { 1258 /* Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers */ 1259 ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr); 1260 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1261 if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1262 1263 ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1264 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1265 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1266 } 1267 } 1268 1269 ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr); 1270 ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr); 1271 ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr); 1272 1273 #if defined(PETSC_HAVE_CUDA) 1274 { 1275 PetscInt p; 1276 for (p = 0; p < PetscGlobalSize; ++p) { 1277 if (p == PetscGlobalRank) {cublasShutdown();} 1278 ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr); 1279 } 1280 } 1281 #endif 1282 1283 if (PetscBeganMPI) { 1284 #if defined(PETSC_HAVE_MPI_FINALIZED) 1285 PetscMPIInt flag; 1286 ierr = MPI_Finalized(&flag);CHKERRQ(ierr); 1287 if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()"); 1288 #endif 1289 ierr = MPI_Finalize();CHKERRQ(ierr); 1290 } 1291 /* 1292 1293 Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because 1294 the communicator has some outstanding requests on it. Specifically if the 1295 flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See 1296 src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate() 1297 is never freed as it should be. Thus one may obtain messages of the form 1298 [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the 1299 memory was not freed. 1300 1301 */ 1302 ierr = PetscMallocClear();CHKERRQ(ierr); 1303 PetscInitializeCalled = PETSC_FALSE; 1304 PetscFinalizeCalled = PETSC_TRUE; 1305 PetscFunctionReturn(ierr); 1306 } 1307 1308 #if defined(PETSC_MISSING_LAPACK_lsame_) 1309 EXTERN_C_BEGIN 1310 int lsame_(char *a,char *b) 1311 { 1312 if (*a == *b) return 1; 1313 if (*a + 32 == *b) return 1; 1314 if (*a - 32 == *b) return 1; 1315 return 0; 1316 } 1317 EXTERN_C_END 1318 #endif 1319 1320 #if defined(PETSC_MISSING_LAPACK_lsame) 1321 EXTERN_C_BEGIN 1322 int lsame(char *a,char *b) 1323 { 1324 if (*a == *b) return 1; 1325 if (*a + 32 == *b) return 1; 1326 if (*a - 32 == *b) return 1; 1327 return 0; 1328 } 1329 EXTERN_C_END 1330 #endif 1331