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