1 2 /* 3 This file defines the initialization of PETSc, including PetscInitialize() 4 */ 5 #define PETSC_DESIRE_COMPLEX 6 #include <petsc-private/petscimpl.h> /*I "petscsys.h" I*/ 7 #include <petscviewer.h> 8 9 #if defined(PETSC_HAVE_CUDA) 10 #include <cublas.h> 11 #endif 12 13 #include <petscthreadcomm.h> 14 15 #if defined(PETSC_USE_LOG) 16 extern PetscErrorCode PetscLogBegin_Private(void); 17 #endif 18 19 #if defined(PETSC_SERIALIZE_FUNCTIONS) 20 PetscFPT PetscFPTData = 0; 21 #endif 22 23 #if defined(PETSC_HAVE_SAWS) 24 #include <petscviewersaws.h> 25 #endif 26 /* -----------------------------------------------------------------------------------------*/ 27 28 extern FILE *petsc_history; 29 30 extern PetscErrorCode PetscInitialize_DynamicLibraries(void); 31 extern PetscErrorCode PetscFinalize_DynamicLibraries(void); 32 extern PetscErrorCode PetscFunctionListPrintAll(void); 33 extern PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm,int); 34 extern PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm,int); 35 extern PetscErrorCode PetscCloseHistoryFile(FILE**); 36 37 /* user may set this BEFORE calling PetscInitialize() */ 38 MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL; 39 40 PetscMPIInt Petsc_Counter_keyval = MPI_KEYVAL_INVALID; 41 PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID; 42 PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID; 43 44 /* 45 Declare and set all the string names of the PETSc enums 46 */ 47 const char *const PetscBools[] = {"FALSE","TRUE","PetscBool","PETSC_",0}; 48 const char *const PetscCopyModes[] = {"COPY_VALUES","OWN_POINTER","USE_POINTER","PetscCopyMode","PETSC_",0}; 49 const char *const PetscDataTypes[] = {"INT","DOUBLE","COMPLEX","LONG","SHORT","FLOAT", 50 "CHAR","LOGICAL","ENUM","BOOL","LONGDOUBLE","OBJECT","FUNCTION","PetscDataType","PETSC_",0}; 51 52 PetscBool PetscPreLoadingUsed = PETSC_FALSE; 53 PetscBool PetscPreLoadingOn = PETSC_FALSE; 54 55 PetscInt PetscHotRegionDepth; 56 57 /* 58 Checks the options database for initializations related to the 59 PETSc components 60 */ 61 #undef __FUNCT__ 62 #define __FUNCT__ "PetscOptionsCheckInitial_Components" 63 PetscErrorCode PetscOptionsCheckInitial_Components(void) 64 { 65 PetscBool flg1; 66 PetscErrorCode ierr; 67 68 PetscFunctionBegin; 69 ierr = PetscOptionsHasName(NULL,"-help",&flg1);CHKERRQ(ierr); 70 if (flg1) { 71 #if defined(PETSC_USE_LOG) 72 MPI_Comm comm = PETSC_COMM_WORLD; 73 ierr = (*PetscHelpPrintf)(comm,"------Additional PETSc component options--------\n");CHKERRQ(ierr); 74 ierr = (*PetscHelpPrintf)(comm," -log_summary_exclude: <vec,mat,pc.ksp,snes>\n");CHKERRQ(ierr); 75 ierr = (*PetscHelpPrintf)(comm," -info_exclude: <null,vec,mat,pc,ksp,snes,ts>\n");CHKERRQ(ierr); 76 ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr); 77 #endif 78 } 79 PetscFunctionReturn(0); 80 } 81 82 #undef __FUNCT__ 83 #define __FUNCT__ "PetscInitializeNoPointers" 84 /* 85 PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args 86 87 Collective 88 89 Level: advanced 90 91 Notes: this is called only by the PETSc MATLAB and Julia interface. Even though it might start MPI it sets the flag to 92 indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to 93 be called multiple times from MATLAB and Julia without the problem of trying to initialize MPI more than once. 94 95 Turns off PETSc signal handling because that can interact with MATLAB's signal handling causing random crashes. 96 97 .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments() 98 */ 99 PetscErrorCode PetscInitializeNoPointers(int argc,char **args,const char *filename,const char *help) 100 { 101 PetscErrorCode ierr; 102 int myargc = argc; 103 char **myargs = args; 104 105 PetscFunctionBegin; 106 ierr = PetscInitialize(&myargc,&myargs,filename,help);CHKERRQ(ierr); 107 ierr = PetscPopSignalHandler();CHKERRQ(ierr); 108 PetscBeganMPI = PETSC_FALSE; 109 PetscFunctionReturn(ierr); 110 } 111 112 #undef __FUNCT__ 113 #define __FUNCT__ "PetscGetPETSC_COMM_SELF" 114 /* 115 Used by MATLAB and Julia interface to get communicator 116 */ 117 PetscErrorCode PetscGetPETSC_COMM_SELF(MPI_Comm *comm) 118 { 119 PetscFunctionBegin; 120 *comm = PETSC_COMM_SELF; 121 PetscFunctionReturn(0); 122 } 123 124 #undef __FUNCT__ 125 #define __FUNCT__ "PetscInitializeNoArguments" 126 /*@C 127 PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without 128 the command line arguments. 129 130 Collective 131 132 Level: advanced 133 134 .seealso: PetscInitialize(), PetscInitializeFortran() 135 @*/ 136 PetscErrorCode PetscInitializeNoArguments(void) 137 { 138 PetscErrorCode ierr; 139 int argc = 0; 140 char **args = 0; 141 142 PetscFunctionBegin; 143 ierr = PetscInitialize(&argc,&args,NULL,NULL); 144 PetscFunctionReturn(ierr); 145 } 146 147 #undef __FUNCT__ 148 #define __FUNCT__ "PetscInitialized" 149 /*@ 150 PetscInitialized - Determine whether PETSc is initialized. 151 152 Level: beginner 153 154 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 155 @*/ 156 PetscErrorCode PetscInitialized(PetscBool *isInitialized) 157 { 158 *isInitialized = PetscInitializeCalled; 159 return 0; 160 } 161 162 #undef __FUNCT__ 163 #define __FUNCT__ "PetscFinalized" 164 /*@ 165 PetscFinalized - Determine whether PetscFinalize() has been called yet 166 167 Level: developer 168 169 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 170 @*/ 171 PetscErrorCode PetscFinalized(PetscBool *isFinalized) 172 { 173 *isFinalized = PetscFinalizeCalled; 174 return 0; 175 } 176 177 extern PetscErrorCode PetscOptionsCheckInitial_Private(void); 178 179 /* 180 This function is the MPI reduction operation used to compute the sum of the 181 first half of the datatype and the max of the second half. 182 */ 183 MPI_Op PetscMaxSum_Op = 0; 184 185 #undef __FUNCT__ 186 #define __FUNCT__ "PetscMaxSum_Local" 187 PETSC_EXTERN void MPIAPI PetscMaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype) 188 { 189 PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt; 190 191 PetscFunctionBegin; 192 if (*datatype != MPIU_2INT) { 193 (*PetscErrorPrintf)("Can only handle MPIU_2INT data types"); 194 MPI_Abort(MPI_COMM_WORLD,1); 195 } 196 197 for (i=0; i<count; i++) { 198 xout[2*i] = PetscMax(xout[2*i],xin[2*i]); 199 xout[2*i+1] += xin[2*i+1]; 200 } 201 PetscFunctionReturnVoid(); 202 } 203 204 /* 205 Returns the max of the first entry owned by this processor and the 206 sum of the second entry. 207 208 The reason sizes[2*i] contains lengths sizes[2*i+1] contains flag of 1 if length is nonzero 209 is so that the PetscMaxSum_Op() can set TWO values, if we passed in only sizes[i] with lengths 210 there would be no place to store the both needed results. 211 */ 212 #undef __FUNCT__ 213 #define __FUNCT__ "PetscMaxSum" 214 PetscErrorCode PetscMaxSum(MPI_Comm comm,const PetscInt sizes[],PetscInt *max,PetscInt *sum) 215 { 216 PetscErrorCode ierr; 217 218 PetscFunctionBegin; 219 #if defined(PETSC_HAVE_MPI_REDUCE_SCATTER_BLOCK) 220 { 221 struct {PetscInt max,sum;} work; 222 ierr = MPI_Reduce_scatter_block((void*)sizes,&work,1,MPIU_2INT,PetscMaxSum_Op,comm);CHKERRQ(ierr); 223 *max = work.max; 224 *sum = work.sum; 225 } 226 #else 227 { 228 PetscMPIInt size,rank; 229 struct {PetscInt max,sum;} *work; 230 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 231 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 232 ierr = PetscMalloc1(size,&work);CHKERRQ(ierr); 233 ierr = MPI_Allreduce((void*)sizes,work,size,MPIU_2INT,PetscMaxSum_Op,comm);CHKERRQ(ierr); 234 *max = work[rank].max; 235 *sum = work[rank].sum; 236 ierr = PetscFree(work);CHKERRQ(ierr); 237 } 238 #endif 239 PetscFunctionReturn(0); 240 } 241 242 /* ----------------------------------------------------------------------------*/ 243 MPI_Op PetscADMax_Op = 0; 244 245 #undef __FUNCT__ 246 #define __FUNCT__ "PetscADMax_Local" 247 PETSC_EXTERN void MPIAPI PetscADMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 248 { 249 PetscScalar *xin = (PetscScalar*)in,*xout = (PetscScalar*)out; 250 PetscInt i,count = *cnt; 251 252 PetscFunctionBegin; 253 if (*datatype != MPIU_2SCALAR) { 254 (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types"); 255 MPI_Abort(MPI_COMM_WORLD,1); 256 } 257 258 for (i=0; i<count; i++) { 259 if (PetscRealPart(xout[2*i]) < PetscRealPart(xin[2*i])) { 260 xout[2*i] = xin[2*i]; 261 xout[2*i+1] = xin[2*i+1]; 262 } 263 } 264 PetscFunctionReturnVoid(); 265 } 266 267 MPI_Op PetscADMin_Op = 0; 268 269 #undef __FUNCT__ 270 #define __FUNCT__ "PetscADMin_Local" 271 PETSC_EXTERN void MPIAPI PetscADMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 272 { 273 PetscScalar *xin = (PetscScalar*)in,*xout = (PetscScalar*)out; 274 PetscInt i,count = *cnt; 275 276 PetscFunctionBegin; 277 if (*datatype != MPIU_2SCALAR) { 278 (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types"); 279 MPI_Abort(MPI_COMM_WORLD,1); 280 } 281 282 for (i=0; i<count; i++) { 283 if (PetscRealPart(xout[2*i]) > PetscRealPart(xin[2*i])) { 284 xout[2*i] = xin[2*i]; 285 xout[2*i+1] = xin[2*i+1]; 286 } 287 } 288 PetscFunctionReturnVoid(); 289 } 290 /* ---------------------------------------------------------------------------------------*/ 291 292 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 293 MPI_Op MPIU_SUM = 0; 294 295 #undef __FUNCT__ 296 #define __FUNCT__ "PetscSum_Local" 297 PETSC_EXTERN void PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 298 { 299 PetscInt i,count = *cnt; 300 301 PetscFunctionBegin; 302 if (*datatype == MPIU_REAL) { 303 PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out; 304 for (i=0; i<count; i++) xout[i] += xin[i]; 305 } 306 #if defined(PETSC_HAVE_COMPLEX) 307 else if (*datatype == MPIU_COMPLEX) { 308 PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out; 309 for (i=0; i<count; i++) xout[i] += xin[i]; 310 } 311 #endif 312 else { 313 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"); 314 MPI_Abort(MPI_COMM_WORLD,1); 315 } 316 PetscFunctionReturnVoid(); 317 } 318 #endif 319 320 #if defined(PETSC_USE_REAL___FLOAT128) 321 MPI_Op MPIU_MAX = 0; 322 MPI_Op MPIU_MIN = 0; 323 324 #undef __FUNCT__ 325 #define __FUNCT__ "PetscMax_Local" 326 PETSC_EXTERN void PetscMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 327 { 328 PetscInt i,count = *cnt; 329 330 PetscFunctionBegin; 331 if (*datatype == MPIU_REAL) { 332 PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out; 333 for (i=0; i<count; i++) xout[i] = PetscMax(xout[i],xin[i]); 334 } 335 #if defined(PETSC_HAVE_COMPLEX) 336 else if (*datatype == MPIU_COMPLEX) { 337 PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out; 338 for (i=0; i<count; i++) { 339 xout[i] = PetscRealPartComplex(xout[i])<PetscRealPartComplex(xin[i]) ? xin[i] : xout[i]; 340 } 341 } 342 #endif 343 else { 344 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"); 345 MPI_Abort(MPI_COMM_WORLD,1); 346 } 347 PetscFunctionReturnVoid(); 348 } 349 350 #undef __FUNCT__ 351 #define __FUNCT__ "PetscMin_Local" 352 PETSC_EXTERN void PetscMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 353 { 354 PetscInt i,count = *cnt; 355 356 PetscFunctionBegin; 357 if (*datatype == MPIU_REAL) { 358 PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out; 359 for (i=0; i<count; i++) xout[i] = PetscMin(xout[i],xin[i]); 360 } 361 #if defined(PETSC_HAVE_COMPLEX) 362 else if (*datatype == MPIU_COMPLEX) { 363 PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out; 364 for (i=0; i<count; i++) { 365 xout[i] = PetscRealPartComplex(xout[i])>PetscRealPartComplex(xin[i]) ? xin[i] : xout[i]; 366 } 367 } 368 #endif 369 else { 370 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"); 371 MPI_Abort(MPI_COMM_WORLD,1); 372 } 373 PetscFunctionReturnVoid(); 374 } 375 #endif 376 377 #undef __FUNCT__ 378 #define __FUNCT__ "Petsc_DelCounter" 379 /* 380 Private routine to delete internal tag/name counter storage when a communicator is freed. 381 382 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. 383 384 Note: this is declared extern "C" because it is passed to MPI_Keyval_create() 385 386 */ 387 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state) 388 { 389 PetscErrorCode ierr; 390 391 PetscFunctionBegin; 392 ierr = PetscInfo1(0,"Deleting counter data in an MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 393 ierr = PetscFree(count_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 394 PetscFunctionReturn(MPI_SUCCESS); 395 } 396 397 #undef __FUNCT__ 398 #define __FUNCT__ "Petsc_DelComm_Outer" 399 /* 400 This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Attr_delete) or when the user 401 calls MPI_Comm_free(). 402 403 This is the only entry point for breaking the links between inner and outer comms. 404 405 This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator. 406 407 Note: this is declared extern "C" because it is passed to MPI_Keyval_create() 408 409 */ 410 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state) 411 { 412 PetscErrorCode ierr; 413 PetscMPIInt flg; 414 union {MPI_Comm comm; void *ptr;} icomm,ocomm; 415 416 PetscFunctionBegin; 417 if (keyval != Petsc_InnerComm_keyval) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Unexpected keyval"); 418 icomm.ptr = attr_val; 419 420 ierr = MPI_Attr_get(icomm.comm,Petsc_OuterComm_keyval,&ocomm,&flg);CHKERRQ(ierr); 421 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected reference to outer comm"); 422 if (ocomm.comm != comm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm has reference to non-matching outer comm"); 423 ierr = MPI_Attr_delete(icomm.comm,Petsc_OuterComm_keyval);CHKERRQ(ierr); /* Calls Petsc_DelComm_Inner */ 424 ierr = PetscInfo1(0,"User MPI_Comm %ld is being freed after removing reference from inner PETSc comm to this outer comm\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 425 PetscFunctionReturn(MPI_SUCCESS); 426 } 427 428 #undef __FUNCT__ 429 #define __FUNCT__ "Petsc_DelComm_Inner" 430 /* 431 * This is invoked on the inner comm when Petsc_DelComm_Outer calls MPI_Attr_delete. It should not be reached any other way. 432 */ 433 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state) 434 { 435 PetscErrorCode ierr; 436 437 PetscFunctionBegin; 438 ierr = PetscInfo1(0,"Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr); 439 PetscFunctionReturn(MPI_SUCCESS); 440 } 441 442 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 443 #if !defined(PETSC_WORDS_BIGENDIAN) 444 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype,MPI_Aint*,void*); 445 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*); 446 PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*); 447 #endif 448 #endif 449 450 int PetscGlobalArgc = 0; 451 char **PetscGlobalArgs = 0; 452 PetscSegBuffer PetscCitationsList; 453 454 #undef __FUNCT__ 455 #define __FUNCT__ "PetscCitationsInitialize" 456 PetscErrorCode PetscCitationsInitialize() 457 { 458 PetscErrorCode ierr; 459 460 PetscFunctionBegin; 461 ierr = PetscSegBufferCreate(1,10000,&PetscCitationsList);CHKERRQ(ierr); 462 ierr = PetscCitationsRegister("@TechReport{petsc-user-ref,\n Author = {Satish Balay and Shrirang Abhyankar and Mark F. Adams and Jed Brown and Peter Brune\n and Kris Buschelman and Victor Eijkhout and William D. Gropp\n and Dinesh Kaushik and Matthew G. Knepley\n and Lois Curfman McInnes and Karl Rupp and Barry F. Smith\n and Hong Zhang},\n Title = {{PETS}c Users Manual},\n Number = {ANL-95/11 - Revision 3.5},\n Institution = {Argonne National Laboratory},\n Year = {2014}\n}\n",NULL);CHKERRQ(ierr); 463 ierr = PetscCitationsRegister("@InProceedings{petsc-efficient,\n Author = {Satish Balay and William D. Gropp and Lois Curfman McInnes and Barry F. Smith},\n Title = {Efficient Management of Parallelism in Object Oriented Numerical Software Libraries},\n Booktitle = {Modern Software Tools in Scientific Computing},\n Editor = {E. Arge and A. M. Bruaset and H. P. Langtangen},\n Pages = {163--202},\n Publisher = {Birkh{\\\"{a}}user Press},\n Year = {1997}\n}\n",NULL);CHKERRQ(ierr); 464 PetscFunctionReturn(0); 465 } 466 467 #undef __FUNCT__ 468 #define __FUNCT__ "PetscGetArgs" 469 /*@C 470 PetscGetArgs - Allows you to access the raw command line arguments anywhere 471 after PetscInitialize() is called but before PetscFinalize(). 472 473 Not Collective 474 475 Output Parameters: 476 + argc - count of number of command line arguments 477 - args - the command line arguments 478 479 Level: intermediate 480 481 Notes: 482 This is usually used to pass the command line arguments into other libraries 483 that are called internally deep in PETSc or the application. 484 485 The first argument contains the program name as is normal for C arguments. 486 487 Concepts: command line arguments 488 489 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments() 490 491 @*/ 492 PetscErrorCode PetscGetArgs(int *argc,char ***args) 493 { 494 PetscFunctionBegin; 495 if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()"); 496 *argc = PetscGlobalArgc; 497 *args = PetscGlobalArgs; 498 PetscFunctionReturn(0); 499 } 500 501 #undef __FUNCT__ 502 #define __FUNCT__ "PetscGetArguments" 503 /*@C 504 PetscGetArguments - Allows you to access the command line arguments anywhere 505 after PetscInitialize() is called but before PetscFinalize(). 506 507 Not Collective 508 509 Output Parameters: 510 . args - the command line arguments 511 512 Level: intermediate 513 514 Notes: 515 This does NOT start with the program name and IS null terminated (final arg is void) 516 517 Concepts: command line arguments 518 519 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments() 520 521 @*/ 522 PetscErrorCode PetscGetArguments(char ***args) 523 { 524 PetscInt i,argc = PetscGlobalArgc; 525 PetscErrorCode ierr; 526 527 PetscFunctionBegin; 528 if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()"); 529 if (!argc) {*args = 0; PetscFunctionReturn(0);} 530 ierr = PetscMalloc1(argc,args);CHKERRQ(ierr); 531 for (i=0; i<argc-1; i++) { 532 ierr = PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]);CHKERRQ(ierr); 533 } 534 (*args)[argc-1] = 0; 535 PetscFunctionReturn(0); 536 } 537 538 #undef __FUNCT__ 539 #define __FUNCT__ "PetscFreeArguments" 540 /*@C 541 PetscFreeArguments - Frees the memory obtained with PetscGetArguments() 542 543 Not Collective 544 545 Output Parameters: 546 . args - the command line arguments 547 548 Level: intermediate 549 550 Concepts: command line arguments 551 552 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments() 553 554 @*/ 555 PetscErrorCode PetscFreeArguments(char **args) 556 { 557 PetscInt i = 0; 558 PetscErrorCode ierr; 559 560 PetscFunctionBegin; 561 if (!args) PetscFunctionReturn(0); 562 while (args[i]) { 563 ierr = PetscFree(args[i]);CHKERRQ(ierr); 564 i++; 565 } 566 ierr = PetscFree(args);CHKERRQ(ierr); 567 PetscFunctionReturn(0); 568 } 569 570 #if defined(PETSC_HAVE_SAWS) 571 #include <petscconfiginfo.h> 572 573 #undef __FUNCT__ 574 #define __FUNCT__ "PetscInitializeSAWs" 575 PetscErrorCode PetscInitializeSAWs(const char help[]) 576 { 577 if (!PetscGlobalRank) { 578 char cert[PETSC_MAX_PATH_LEN],root[PETSC_MAX_PATH_LEN],*intro,programname[64],*appline,*options,version[64]; 579 int port; 580 PetscBool flg,rootlocal = PETSC_FALSE,flg2; 581 size_t applinelen,introlen; 582 PetscErrorCode ierr; 583 584 ierr = PetscOptionsHasName(NULL,"-saws_log",&flg);CHKERRQ(ierr); 585 if (flg) { 586 char sawslog[PETSC_MAX_PATH_LEN]; 587 588 ierr = PetscOptionsGetString(NULL,"-saws_log",sawslog,PETSC_MAX_PATH_LEN,NULL);CHKERRQ(ierr); 589 if (sawslog[0]) { 590 PetscStackCallSAWs(SAWs_Set_Use_Logfile,(sawslog)); 591 } else { 592 PetscStackCallSAWs(SAWs_Set_Use_Logfile,(NULL)); 593 } 594 } 595 ierr = PetscOptionsGetString(NULL,"-saws_https",cert,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr); 596 if (flg) { 597 PetscStackCallSAWs(SAWs_Set_Use_HTTPS,(cert)); 598 } 599 ierr = PetscOptionsGetInt(NULL,"-saws_port",&port,&flg);CHKERRQ(ierr); 600 if (flg) { 601 PetscStackCallSAWs(SAWs_Set_Port,(port)); 602 } 603 ierr = PetscOptionsGetString(NULL,"-saws_root",root,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr); 604 if (flg) { 605 PetscStackCallSAWs(SAWs_Set_Document_Root,(root));CHKERRQ(ierr); 606 ierr = PetscStrcmp(root,".",&rootlocal);CHKERRQ(ierr); 607 } 608 ierr = PetscOptionsHasName(NULL,"-saws_local",&flg2);CHKERRQ(ierr); 609 if (flg2) { 610 char jsdir[PETSC_MAX_PATH_LEN]; 611 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"-saws_local option requires -saws_root option"); 612 ierr = PetscSNPrintf(jsdir,PETSC_MAX_PATH_LEN,"%s/js",root);CHKERRQ(ierr); 613 ierr = PetscTestDirectory(jsdir,'r',&flg);CHKERRQ(ierr); 614 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_READ,"-saws_local option requires js directory in root directory"); 615 PetscStackCallSAWs(SAWs_Push_Local_Header,());CHKERRQ(ierr); 616 } 617 ierr = PetscGetProgramName(programname,64);CHKERRQ(ierr); 618 ierr = PetscStrlen(help,&applinelen);CHKERRQ(ierr); 619 introlen = 4096 + applinelen; 620 applinelen += 256; 621 ierr = PetscMalloc(applinelen,&appline);CHKERRQ(ierr); 622 ierr = PetscMalloc(introlen,&intro);CHKERRQ(ierr); 623 624 if (rootlocal) { 625 ierr = PetscSNPrintf(appline,applinelen,"%s.c.html",programname);CHKERRQ(ierr); 626 ierr = PetscTestFile(appline,'r',&rootlocal);CHKERRQ(ierr); 627 } 628 ierr = PetscOptionsGetAll(&options);CHKERRQ(ierr); 629 if (rootlocal && help) { 630 ierr = PetscSNPrintf(appline,applinelen,"<center> Running <a href=\"%s.c.html\">%s</a> %s</center><br><center><pre>%s</pre></center><br>\n",programname,programname,options,help); 631 } else if (help) { 632 ierr = PetscSNPrintf(appline,applinelen,"<center>Running %s %s</center><br><center><pre>%s</pre></center><br>\n",programname,options,help); 633 } else { 634 ierr = PetscSNPrintf(appline,applinelen,"<center> Running %s %s</center><br>\n",programname,options); 635 } 636 ierr = PetscFree(options);CHKERRQ(ierr); 637 ierr = PetscGetVersion(version,sizeof(version));CHKERRQ(ierr); 638 ierr = PetscSNPrintf(intro,introlen,"<body>\n" 639 "<center><h2> <a href=\"http://www.mcs.anl.gov/petsc\">PETSc</a> Application Web server powered by <a href=\"https://bitbucket.org/saws/saws\">SAWs</a> </h2></center>\n" 640 "<center>This is the default PETSc application dashboard, from it you can access any published PETSc objects or logging data</center><br><center>%s configured with %s</center><br>\n" 641 "%s",version,petscconfigureoptions,appline); 642 PetscStackCallSAWs(SAWs_Push_Body,("index.html",0,intro)); 643 ierr = PetscFree(intro);CHKERRQ(ierr); 644 ierr = PetscFree(appline);CHKERRQ(ierr); 645 PetscStackCallSAWs(SAWs_Initialize,()); 646 ierr = PetscCitationsRegister("@TechReport{ saws," 647 "Author = {Matt Otten and Jed Brown and Barry Smith}," 648 "Title = {Scientific Application Web Server (SAWs) Users Manual}," 649 "Institution = {Argonne National Laboratory}," 650 "Year = 2013}",NULL);CHKERRQ(ierr); 651 } 652 PetscFunctionReturn(0); 653 } 654 #endif 655 656 #undef __FUNCT__ 657 #define __FUNCT__ "PetscInitialize" 658 /*@C 659 PetscInitialize - Initializes the PETSc database and MPI. 660 PetscInitialize() calls MPI_Init() if that has yet to be called, 661 so this routine should always be called near the beginning of 662 your program -- usually the very first line! 663 664 Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set 665 666 Input Parameters: 667 + argc - count of number of command line arguments 668 . args - the command line arguments 669 . file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL to not check for 670 code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files 671 - help - [optional] Help message to print, use NULL for no message 672 673 If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that 674 communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a 675 four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not, 676 then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even 677 if different subcommunicators of the job are doing different things with PETSc. 678 679 Options Database Keys: 680 + -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger 681 . -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected 682 . -on_error_emacs <machinename> causes emacsclient to jump to error file 683 . -on_error_abort calls abort() when error detected (no traceback) 684 . -on_error_mpiabort calls MPI_abort() when error detected 685 . -error_output_stderr prints error messages to stderr instead of the default stdout 686 . -error_output_none does not print the error messages (but handles errors in the same way as if this was not called) 687 . -debugger_nodes [node1,node2,...] - Indicates nodes to start in debugger 688 . -debugger_pause [sleeptime] (in seconds) - Pauses debugger 689 . -stop_for_debugger - Print message on how to attach debugger manually to 690 process and wait (-debugger_pause) seconds for attachment 691 . -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) 692 . -malloc no - Indicates not to use error-checking malloc 693 . -malloc_debug - check for memory corruption at EVERY malloc or free 694 . -malloc_dump - prints a list of all unfreed memory at the end of the run 695 . -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds 696 . -fp_trap - Stops on floating point exceptions (Note that on the 697 IBM RS6000 this slows code by at least a factor of 10.) 698 . -no_signal_handler - Indicates not to trap error signals 699 . -shared_tmp - indicates /tmp directory is shared by all processors 700 . -not_shared_tmp - each processor has own /tmp 701 . -tmp - alternative name of /tmp directory 702 . -get_total_flops - returns total flops done by all processors 703 - -memory_info - Print memory usage at end of run 704 705 Options Database Keys for Profiling: 706 See Users-Manual: ch_profiling for details. 707 + -info <optional filename> - Prints verbose information to the screen 708 . -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages 709 . -log_sync - Log the synchronization in scatters, inner products and norms 710 . -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program 711 hangs without running in the debugger). See PetscLogTraceBegin(). 712 . -log_summary [filename] - Prints summary of flop and timing information to screen. If the filename is specified the 713 summary is written to the file. See PetscLogView(). 714 . -log_all [filename] - Logs extensive profiling information See PetscLogDump(). 715 . -log [filename] - Logs basic profiline information See PetscLogDump(). 716 - -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution) 717 718 Only one of -log_trace, -log_summary, -log_all, -log, or -log_mpe may be used at a time 719 720 Environmental Variables: 721 + PETSC_TMP - alternative tmp directory 722 . PETSC_SHARED_TMP - tmp is shared by all processes 723 . PETSC_NOT_SHARED_TMP - each process has its own private tmp 724 . PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer 725 - PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to 726 727 728 Level: beginner 729 730 Notes: 731 If for some reason you must call MPI_Init() separately, call 732 it before PetscInitialize(). 733 734 Fortran Version: 735 In Fortran this routine has the format 736 $ call PetscInitialize(file,ierr) 737 738 + ierr - error return code 739 - file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL_CHARACTER to not check for 740 code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files 741 742 Important Fortran Note: 743 In Fortran, you MUST use NULL_CHARACTER to indicate a 744 null character string; you CANNOT just use NULL as 745 in the C version. See Users-Manual: ch_fortran for details. 746 747 If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after 748 calling PetscInitialize(). 749 750 Concepts: initializing PETSc 751 752 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments() 753 754 @*/ 755 PetscErrorCode PetscInitialize(int *argc,char ***args,const char file[],const char help[]) 756 { 757 PetscErrorCode ierr; 758 PetscMPIInt flag, size; 759 PetscBool flg; 760 char hostname[256]; 761 762 PetscFunctionBegin; 763 if (PetscInitializeCalled) PetscFunctionReturn(0); 764 765 /* these must be initialized in a routine, not as a constant declaration*/ 766 PETSC_STDOUT = stdout; 767 PETSC_STDERR = stderr; 768 769 /* on Windows - set printf to default to printing 2 digit exponents */ 770 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT) 771 _set_output_format(_TWO_DIGIT_EXPONENT); 772 #endif 773 774 ierr = PetscOptionsCreate();CHKERRQ(ierr); 775 776 /* 777 We initialize the program name here (before MPI_Init()) because MPICH has a bug in 778 it that it sets args[0] on all processors to be args[0] on the first processor. 779 */ 780 if (argc && *argc) { 781 ierr = PetscSetProgramName(**args);CHKERRQ(ierr); 782 } else { 783 ierr = PetscSetProgramName("Unknown Name");CHKERRQ(ierr); 784 } 785 786 ierr = MPI_Initialized(&flag);CHKERRQ(ierr); 787 if (!flag) { 788 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"); 789 #if defined(PETSC_HAVE_MPI_INIT_THREAD) 790 { 791 PetscMPIInt provided; 792 ierr = MPI_Init_thread(argc,args,MPI_THREAD_FUNNELED,&provided);CHKERRQ(ierr); 793 } 794 #else 795 ierr = MPI_Init(argc,args);CHKERRQ(ierr); 796 #endif 797 PetscBeganMPI = PETSC_TRUE; 798 } 799 if (argc && args) { 800 PetscGlobalArgc = *argc; 801 PetscGlobalArgs = *args; 802 } 803 PetscFinalizeCalled = PETSC_FALSE; 804 805 if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD; 806 ierr = MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);CHKERRQ(ierr); 807 808 /* Done after init due to a bug in MPICH-GM? */ 809 ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr); 810 811 ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRQ(ierr); 812 ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRQ(ierr); 813 814 MPIU_BOOL = MPI_INT; 815 MPIU_ENUM = MPI_INT; 816 817 /* 818 Initialized the global complex variable; this is because with 819 shared libraries the constructors for global variables 820 are not called; at least on IRIX. 821 */ 822 #if defined(PETSC_HAVE_COMPLEX) 823 { 824 #if defined(PETSC_CLANGUAGE_CXX) 825 PetscComplex ic(0.0,1.0); 826 PETSC_i = ic; 827 #elif defined(PETSC_CLANGUAGE_C) 828 PETSC_i = _Complex_I; 829 #endif 830 } 831 832 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 833 ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 834 ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 835 ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);CHKERRQ(ierr); 836 ierr = MPI_Type_commit(&MPIU_C_COMPLEX);CHKERRQ(ierr); 837 #endif 838 #endif /* PETSC_HAVE_COMPLEX */ 839 840 /* 841 Create the PETSc MPI reduction operator that sums of the first 842 half of the entries and maxes the second half. 843 */ 844 ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);CHKERRQ(ierr); 845 846 #if defined(PETSC_USE_REAL___FLOAT128) 847 ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);CHKERRQ(ierr); 848 ierr = MPI_Type_commit(&MPIU___FLOAT128);CHKERRQ(ierr); 849 #if defined(PETSC_HAVE_COMPLEX) 850 ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);CHKERRQ(ierr); 851 ierr = MPI_Type_commit(&MPIU___COMPLEX128);CHKERRQ(ierr); 852 #endif 853 ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRQ(ierr); 854 ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRQ(ierr); 855 #endif 856 857 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 858 ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr); 859 #endif 860 861 ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr); 862 ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr); 863 ierr = MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);CHKERRQ(ierr); 864 ierr = MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);CHKERRQ(ierr); 865 866 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT) 867 ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr); 868 ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr); 869 #endif 870 871 872 /* 873 Attributes to be set on PETSc communicators 874 */ 875 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);CHKERRQ(ierr); 876 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);CHKERRQ(ierr); 877 ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);CHKERRQ(ierr); 878 879 /* 880 Build the options database 881 */ 882 ierr = PetscOptionsInsert(argc,args,file);CHKERRQ(ierr); 883 884 885 /* 886 Print main application help message 887 */ 888 ierr = PetscOptionsHasName(NULL,"-help",&flg);CHKERRQ(ierr); 889 if (help && flg) { 890 ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr); 891 } 892 ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr); 893 894 ierr = PetscCitationsInitialize();CHKERRQ(ierr); 895 896 #if defined(PETSC_HAVE_SAWS) 897 ierr = PetscInitializeSAWs(help);CHKERRQ(ierr); 898 #endif 899 900 /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */ 901 #if defined(PETSC_USE_LOG) 902 ierr = PetscLogBegin_Private();CHKERRQ(ierr); 903 #endif 904 905 /* 906 Load the dynamic libraries (on machines that support them), this registers all 907 the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes) 908 */ 909 ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr); 910 911 ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); 912 ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr); 913 ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr); 914 ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr); 915 916 /* Ensure that threadcomm-related keyval exists, so that PetscOptionsSetFromOptions can use PetscCommDuplicate. */ 917 ierr = PetscThreadCommInitializePackage();CHKERRQ(ierr); 918 919 ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr); 920 /* Check the options database for options related to the options database itself */ 921 ierr = PetscOptionsSetFromOptions();CHKERRQ(ierr); 922 923 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 924 /* 925 Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI 926 927 Currently not used because it is not supported by MPICH. 928 */ 929 #if !defined(PETSC_WORDS_BIGENDIAN) 930 ierr = MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);CHKERRQ(ierr); 931 #endif 932 #endif 933 934 #if defined(PETSC_HAVE_CUDA) 935 flg = PETSC_TRUE; 936 ierr = PetscOptionsGetBool(NULL,"-cublas",&flg,NULL);CHKERRQ(ierr); 937 if (flg) { 938 PetscMPIInt p; 939 for (p = 0; p < PetscGlobalSize; ++p) { 940 if (p == PetscGlobalRank) cublasInit(); 941 ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr); 942 } 943 } 944 #endif 945 946 ierr = PetscOptionsHasName(NULL,"-python",&flg);CHKERRQ(ierr); 947 if (flg) { 948 PetscInitializeCalled = PETSC_TRUE; 949 ierr = PetscPythonInitialize(NULL,NULL);CHKERRQ(ierr); 950 } 951 952 /* 953 Setup building of stack frames for all function calls 954 */ 955 PetscThreadLocalRegister((PetscThreadKey*)&petscstack); /* Creates pthread_key */ 956 #if defined(PETSC_USE_DEBUG) 957 ierr = PetscStackCreate();CHKERRQ(ierr); 958 #endif 959 960 #if defined(PETSC_SERIALIZE_FUNCTIONS) 961 ierr = PetscFPTCreate(10000);CHKERRQ(ierr); 962 #endif 963 964 965 /* 966 Once we are completedly initialized then we can set this variables 967 */ 968 PetscInitializeCalled = PETSC_TRUE; 969 PetscFunctionReturn(0); 970 } 971 972 #if defined(PETSC_USE_LOG) 973 extern PetscObject *PetscObjects; 974 extern PetscInt PetscObjectsCounts, PetscObjectsMaxCounts; 975 #endif 976 977 #undef __FUNCT__ 978 #define __FUNCT__ "PetscFinalize" 979 /*@C 980 PetscFinalize - Checks for options to be called at the conclusion 981 of the program. MPI_Finalize() is called only if the user had not 982 called MPI_Init() before calling PetscInitialize(). 983 984 Collective on PETSC_COMM_WORLD 985 986 Options Database Keys: 987 + -options_table - Calls PetscOptionsView() 988 . -options_left - Prints unused options that remain in the database 989 . -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 990 . -mpidump - Calls PetscMPIDump() 991 . -malloc_dump - Calls PetscMallocDump() 992 . -malloc_info - Prints total memory usage 993 - -malloc_log - Prints summary of memory usage 994 995 Level: beginner 996 997 Note: 998 See PetscInitialize() for more general runtime options. 999 1000 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd() 1001 @*/ 1002 PetscErrorCode PetscFinalize(void) 1003 { 1004 PetscErrorCode ierr; 1005 PetscMPIInt rank; 1006 PetscInt nopt; 1007 PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE; 1008 PetscBool flg; 1009 #if defined(PETSC_USE_LOG) 1010 char mname[PETSC_MAX_PATH_LEN]; 1011 #endif 1012 1013 PetscFunctionBegin; 1014 if (!PetscInitializeCalled) { 1015 printf("PetscInitialize() must be called before PetscFinalize()\n"); 1016 PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE); 1017 } 1018 ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr); 1019 1020 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 1021 1022 ierr = PetscOptionsHasName(NULL,"-citations",&flg);CHKERRQ(ierr); 1023 if (flg) { 1024 char *cits, filename[PETSC_MAX_PATH_LEN]; 1025 FILE *fd = PETSC_STDOUT; 1026 1027 ierr = PetscOptionsGetString(NULL,"-citations",filename,PETSC_MAX_PATH_LEN,NULL);CHKERRQ(ierr); 1028 if (filename[0]) { 1029 ierr = PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd);CHKERRQ(ierr); 1030 } 1031 ierr = PetscSegBufferGet(PetscCitationsList,1,&cits);CHKERRQ(ierr); 1032 cits[0] = 0; 1033 ierr = PetscSegBufferExtractAlloc(PetscCitationsList,&cits);CHKERRQ(ierr); 1034 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n");CHKERRQ(ierr); 1035 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 1036 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits);CHKERRQ(ierr); 1037 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 1038 ierr = PetscFClose(PETSC_COMM_WORLD,fd);CHKERRQ(ierr); 1039 ierr = PetscFree(cits);CHKERRQ(ierr); 1040 } 1041 ierr = PetscSegBufferDestroy(&PetscCitationsList);CHKERRQ(ierr); 1042 1043 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER) 1044 /* TextBelt is run for testing purposes only, please do not use this feature often */ 1045 { 1046 PetscInt nmax = 2; 1047 char **buffs; 1048 ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr); 1049 ierr = PetscOptionsGetStringArray(NULL,"-textbelt",buffs,&nmax,&flg1);CHKERRQ(ierr); 1050 if (flg1) { 1051 if (!nmax) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-textbelt requires either the phone number or number,\"message\""); 1052 if (nmax == 1) { 1053 ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr); 1054 ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr); 1055 ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr); 1056 } 1057 ierr = PetscTextBelt(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr); 1058 ierr = PetscFree(buffs[0]);CHKERRQ(ierr); 1059 ierr = PetscFree(buffs[1]);CHKERRQ(ierr); 1060 } 1061 ierr = PetscFree(buffs);CHKERRQ(ierr); 1062 } 1063 #endif 1064 /* 1065 It should be safe to cancel the options monitors, since we don't expect to be setting options 1066 here (at least that are worth monitoring). Monitors ought to be released so that they release 1067 whatever memory was allocated there before -malloc_dump reports unfreed memory. 1068 */ 1069 ierr = PetscOptionsMonitorCancel();CHKERRQ(ierr); 1070 1071 #if defined(PETSC_SERIALIZE_FUNCTIONS) 1072 ierr = PetscFPTDestroy();CHKERRQ(ierr); 1073 #endif 1074 1075 1076 #if defined(PETSC_HAVE_SAWS) 1077 flg = PETSC_FALSE; 1078 ierr = PetscOptionsGetBool(NULL,"-saw_options",&flg,NULL);CHKERRQ(ierr); 1079 if (flg) { 1080 ierr = PetscOptionsSAWsDestroy();CHKERRQ(ierr); 1081 } 1082 #endif 1083 1084 #if defined(PETSC_HAVE_X) 1085 flg1 = PETSC_FALSE; 1086 ierr = PetscOptionsGetBool(NULL,"-x_virtual",&flg1,NULL);CHKERRQ(ierr); 1087 if (flg1) { 1088 /* this is a crude hack, but better than nothing */ 1089 ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 Xvfb","r",NULL);CHKERRQ(ierr); 1090 } 1091 #endif 1092 1093 ierr = PetscOptionsGetBool(NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr); 1094 if (!flg2) { 1095 flg2 = PETSC_FALSE; 1096 ierr = PetscOptionsGetBool(NULL,"-memory_info",&flg2,NULL);CHKERRQ(ierr); 1097 } 1098 if (flg2) { 1099 ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr); 1100 } 1101 1102 #if defined(PETSC_USE_LOG) 1103 flg1 = PETSC_FALSE; 1104 ierr = PetscOptionsGetBool(NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr); 1105 if (flg1) { 1106 PetscLogDouble flops = 0; 1107 ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 1108 ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr); 1109 } 1110 #endif 1111 1112 1113 #if defined(PETSC_USE_LOG) 1114 #if defined(PETSC_HAVE_MPE) 1115 mname[0] = 0; 1116 1117 ierr = PetscOptionsGetString(NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1118 if (flg1) { 1119 if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);} 1120 else {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);} 1121 } 1122 #endif 1123 mname[0] = 0; 1124 1125 ierr = PetscLogViewFromOptions();CHKERRQ(ierr); 1126 ierr = PetscOptionsGetString(NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1127 if (flg1) { 1128 PetscViewer viewer; 1129 if (mname[0]) { 1130 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 1131 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1132 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1133 } else { 1134 viewer = PETSC_VIEWER_STDOUT_WORLD; 1135 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1136 } 1137 } 1138 mname[0] = 0; 1139 1140 ierr = PetscOptionsGetString(NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1141 ierr = PetscOptionsGetString(NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr); 1142 if (flg1 || flg2) { 1143 if (mname[0]) PetscLogDump(mname); 1144 else PetscLogDump(0); 1145 } 1146 #endif 1147 1148 /* 1149 Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_(). 1150 */ 1151 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1152 1153 ierr = PetscStackDestroy();CHKERRQ(ierr); 1154 PetscThreadLocalDestroy((PetscThreadKey)petscstack); /* Deletes pthread_key */ 1155 1156 flg1 = PETSC_FALSE; 1157 ierr = PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr); 1158 if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);} 1159 flg1 = PETSC_FALSE; 1160 ierr = PetscOptionsGetBool(NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr); 1161 if (flg1) { 1162 ierr = PetscMPIDump(stdout);CHKERRQ(ierr); 1163 } 1164 flg1 = PETSC_FALSE; 1165 flg2 = PETSC_FALSE; 1166 /* preemptive call to avoid listing this option in options table as unused */ 1167 ierr = PetscOptionsHasName(NULL,"-malloc_dump",&flg1);CHKERRQ(ierr); 1168 ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1169 ierr = PetscOptionsGetBool(NULL,"-options_view",&flg2,NULL);CHKERRQ(ierr); 1170 1171 if (flg2) { 1172 PetscViewer viewer; 1173 ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1174 ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr); 1175 ierr = PetscOptionsView(viewer);CHKERRQ(ierr); 1176 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1177 } 1178 1179 /* to prevent PETSc -options_left from warning */ 1180 ierr = PetscOptionsHasName(NULL,"-nox",&flg1);CHKERRQ(ierr); 1181 ierr = PetscOptionsHasName(NULL,"-nox_warning",&flg1);CHKERRQ(ierr); 1182 1183 flg3 = PETSC_FALSE; /* default value is required */ 1184 ierr = PetscOptionsGetBool(NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr); 1185 ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr); 1186 if (flg3) { 1187 if (!flg2) { /* have not yet printed the options */ 1188 PetscViewer viewer; 1189 ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1190 ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr); 1191 ierr = PetscOptionsView(viewer);CHKERRQ(ierr); 1192 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1193 } 1194 if (!nopt) { 1195 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr); 1196 } else if (nopt == 1) { 1197 ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr); 1198 } else { 1199 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr); 1200 } 1201 } 1202 #if defined(PETSC_USE_DEBUG) 1203 if (nopt && !flg3 && !flg1) { 1204 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr); 1205 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr); 1206 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1207 } else if (nopt && flg3) { 1208 #else 1209 if (nopt && flg3) { 1210 #endif 1211 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1212 } 1213 1214 #if defined(PETSC_HAVE_SAWS) 1215 if (!PetscGlobalRank) { 1216 ierr = PetscStackSAWsViewOff();CHKERRQ(ierr); 1217 PetscStackCallSAWs(SAWs_Finalize,()); 1218 } 1219 #endif 1220 1221 { 1222 PetscThreadComm tcomm_world; 1223 ierr = PetscGetThreadCommWorld(&tcomm_world);CHKERRQ(ierr); 1224 /* Free global thread communicator */ 1225 ierr = PetscThreadCommDestroy(&tcomm_world);CHKERRQ(ierr); 1226 } 1227 1228 #if defined(PETSC_USE_LOG) 1229 /* 1230 List all objects the user may have forgot to free 1231 */ 1232 ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1233 if (flg1) { 1234 MPI_Comm local_comm; 1235 char string[64]; 1236 1237 ierr = PetscOptionsGetString(NULL,"-objects_dump",string,64,NULL);CHKERRQ(ierr); 1238 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr); 1239 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1240 ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr); 1241 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1242 ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr); 1243 } 1244 #endif 1245 1246 #if defined(PETSC_USE_LOG) 1247 PetscObjectsCounts = 0; 1248 PetscObjectsMaxCounts = 0; 1249 ierr = PetscFree(PetscObjects);CHKERRQ(ierr); 1250 #endif 1251 1252 #if defined(PETSC_USE_LOG) 1253 ierr = PetscLogDestroy();CHKERRQ(ierr); 1254 #endif 1255 1256 /* 1257 Destroy any packages that registered a finalize 1258 */ 1259 ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr); 1260 1261 /* 1262 Destroy all the function registration lists created 1263 */ 1264 ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr); 1265 1266 /* 1267 Print PetscFunctionLists that have not been properly freed 1268 1269 ierr = PetscFunctionListPrintAll();CHKERRQ(ierr); 1270 */ 1271 1272 if (petsc_history) { 1273 ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr); 1274 petsc_history = 0; 1275 } 1276 1277 ierr = PetscInfoAllow(PETSC_FALSE,NULL);CHKERRQ(ierr); 1278 1279 { 1280 char fname[PETSC_MAX_PATH_LEN]; 1281 FILE *fd; 1282 int err; 1283 1284 fname[0] = 0; 1285 1286 ierr = PetscOptionsGetString(NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr); 1287 flg2 = PETSC_FALSE; 1288 ierr = PetscOptionsGetBool(NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr); 1289 #if defined(PETSC_USE_DEBUG) 1290 if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE; 1291 #else 1292 flg2 = PETSC_FALSE; /* Skip reporting for optimized builds regardless of -malloc_test */ 1293 #endif 1294 if (flg1 && fname[0]) { 1295 char sname[PETSC_MAX_PATH_LEN]; 1296 1297 sprintf(sname,"%s_%d",fname,rank); 1298 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1299 ierr = PetscMallocDump(fd);CHKERRQ(ierr); 1300 err = fclose(fd); 1301 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1302 } else if (flg1 || flg2) { 1303 MPI_Comm local_comm; 1304 1305 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr); 1306 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1307 ierr = PetscMallocDump(stdout);CHKERRQ(ierr); 1308 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1309 ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr); 1310 } 1311 } 1312 1313 { 1314 char fname[PETSC_MAX_PATH_LEN]; 1315 FILE *fd = NULL; 1316 1317 fname[0] = 0; 1318 1319 ierr = PetscOptionsGetString(NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr); 1320 ierr = PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr); 1321 if (flg1 && fname[0]) { 1322 int err; 1323 1324 if (!rank) { 1325 fd = fopen(fname,"w"); 1326 if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname); 1327 } 1328 ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr); 1329 if (fd) { 1330 err = fclose(fd); 1331 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1332 } 1333 } else if (flg1 || flg2) { 1334 ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr); 1335 } 1336 } 1337 1338 #if defined(PETSC_HAVE_CUDA) 1339 flg = PETSC_TRUE; 1340 ierr = PetscOptionsGetBool(NULL,"-cublas",&flg,NULL);CHKERRQ(ierr); 1341 if (flg) { 1342 PetscInt p; 1343 for (p = 0; p < PetscGlobalSize; ++p) { 1344 if (p == PetscGlobalRank) cublasShutdown(); 1345 ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr); 1346 } 1347 } 1348 #endif 1349 1350 /* Can be destroyed only after all the options are used */ 1351 ierr = PetscOptionsDestroy();CHKERRQ(ierr); 1352 1353 PetscGlobalArgc = 0; 1354 PetscGlobalArgs = 0; 1355 1356 #if defined(PETSC_USE_REAL___FLOAT128) 1357 ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr); 1358 #if defined(PETSC_HAVE_COMPLEX) 1359 ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr); 1360 #endif 1361 ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr); 1362 ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr); 1363 #endif 1364 1365 #if defined(PETSC_HAVE_COMPLEX) 1366 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 1367 ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 1368 ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr); 1369 #endif 1370 #endif 1371 1372 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 1373 ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr); 1374 #endif 1375 1376 ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr); 1377 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT) 1378 ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr); 1379 #endif 1380 ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr); 1381 ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr); 1382 ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr); 1383 1384 /* 1385 Destroy any known inner MPI_Comm's and attributes pointing to them 1386 Note this will not destroy any new communicators the user has created. 1387 1388 If all PETSc objects were not destroyed those left over objects will have hanging references to 1389 the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again 1390 */ 1391 { 1392 PetscCommCounter *counter; 1393 PetscMPIInt flg; 1394 MPI_Comm icomm; 1395 union {MPI_Comm comm; void *ptr;} ucomm; 1396 ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr); 1397 if (flg) { 1398 icomm = ucomm.comm; 1399 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1400 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1401 1402 ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1403 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1404 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1405 } 1406 ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr); 1407 if (flg) { 1408 icomm = ucomm.comm; 1409 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1410 if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1411 1412 ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1413 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1414 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1415 } 1416 } 1417 1418 ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr); 1419 ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr); 1420 ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr); 1421 1422 if (PetscBeganMPI) { 1423 #if defined(PETSC_HAVE_MPI_FINALIZED) 1424 PetscMPIInt flag; 1425 ierr = MPI_Finalized(&flag);CHKERRQ(ierr); 1426 if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()"); 1427 #endif 1428 ierr = MPI_Finalize();CHKERRQ(ierr); 1429 } 1430 /* 1431 1432 Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because 1433 the communicator has some outstanding requests on it. Specifically if the 1434 flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See 1435 src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate() 1436 is never freed as it should be. Thus one may obtain messages of the form 1437 [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the 1438 memory was not freed. 1439 1440 */ 1441 ierr = PetscMallocClear();CHKERRQ(ierr); 1442 1443 PetscInitializeCalled = PETSC_FALSE; 1444 PetscFinalizeCalled = PETSC_TRUE; 1445 PetscFunctionReturn(ierr); 1446 } 1447 1448 #if defined(PETSC_MISSING_LAPACK_lsame_) 1449 PETSC_EXTERN int lsame_(char *a,char *b) 1450 { 1451 if (*a == *b) return 1; 1452 if (*a + 32 == *b) return 1; 1453 if (*a - 32 == *b) return 1; 1454 return 0; 1455 } 1456 #endif 1457 1458 #if defined(PETSC_MISSING_LAPACK_lsame) 1459 PETSC_EXTERN int lsame(char *a,char *b) 1460 { 1461 if (*a == *b) return 1; 1462 if (*a + 32 == *b) return 1; 1463 if (*a - 32 == *b) return 1; 1464 return 0; 1465 } 1466 #endif 1467