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