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 791 /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */ 792 #if defined(PETSC_USE_LOG) 793 ierr = PetscLogBegin_Private();CHKERRQ(ierr); 794 #endif 795 796 /* 797 Load the dynamic libraries (on machines that support them), this registers all 798 the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes) 799 */ 800 ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr); 801 802 ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); 803 ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr); 804 ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr); 805 ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr); 806 807 ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr); 808 /* Check the options database for options related to the options database itself */ 809 ierr = PetscOptionsSetFromOptions();CHKERRQ(ierr); 810 811 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 812 /* 813 Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI 814 815 Currently not used because it is not supported by MPICH. 816 */ 817 #if !defined(PETSC_WORDS_BIGENDIAN) 818 ierr = MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);CHKERRQ(ierr); 819 #endif 820 #endif 821 822 ierr = PetscOptionsGetInt(NULL,"-hmpi_spawn_size",&nodesize,&flg);CHKERRQ(ierr); 823 if (flg) { 824 #if defined(PETSC_HAVE_MPI_COMM_SPAWN) 825 ierr = PetscHMPISpawn((PetscMPIInt) nodesize);CHKERRQ(ierr); /* worker nodes never return from here; they go directly to PetscEnd() */ 826 #else 827 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"PETSc built without MPI 2 (MPI_Comm_spawn) support, use -hmpi_merge_size instead"); 828 #endif 829 } else { 830 ierr = PetscOptionsGetInt(NULL,"-hmpi_merge_size",&nodesize,&flg);CHKERRQ(ierr); 831 if (flg) { 832 ierr = PetscHMPIMerge((PetscMPIInt) nodesize,NULL,NULL);CHKERRQ(ierr); 833 if (PetscHMPIWorker) { /* if worker then never enter user code */ 834 PetscInitializeCalled = PETSC_TRUE; 835 PetscEnd(); 836 } 837 } 838 } 839 840 #if defined(PETSC_HAVE_CUDA) 841 flg = PETSC_TRUE; 842 ierr = PetscOptionsGetBool(NULL,"-cublas",&flg,NULL);CHKERRQ(ierr); 843 if (flg) { 844 PetscMPIInt p; 845 for (p = 0; p < PetscGlobalSize; ++p) { 846 if (p == PetscGlobalRank) cublasInit(); 847 ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr); 848 } 849 } 850 #endif 851 852 ierr = PetscOptionsHasName(NULL,"-python",&flg);CHKERRQ(ierr); 853 if (flg) { 854 PetscInitializeCalled = PETSC_TRUE; 855 ierr = PetscPythonInitialize(NULL,NULL);CHKERRQ(ierr); 856 } 857 858 ierr = PetscThreadCommInitializePackage();CHKERRQ(ierr); 859 860 /* 861 Setup building of stack frames for all function calls 862 */ 863 PetscThreadLocalRegister((PetscThreadKey*)&petscstack); /* Creates pthread_key */ 864 #if defined(PETSC_USE_DEBUG) 865 ierr = PetscStackCreate();CHKERRQ(ierr); 866 #endif 867 868 #if defined(PETSC_SERIALIZE_FUNCTIONS) 869 ierr = PetscFPTCreate(10000);CHKERRQ(ierr); 870 #endif 871 872 ierr = PetscCitationsInitialize();CHKERRQ(ierr); 873 874 /* 875 Once we are completedly initialized then we can set this variables 876 */ 877 PetscInitializeCalled = PETSC_TRUE; 878 PetscFunctionReturn(0); 879 } 880 881 extern PetscObject *PetscObjects; 882 extern PetscInt PetscObjectsCounts, PetscObjectsMaxCounts; 883 884 #undef __FUNCT__ 885 #define __FUNCT__ "PetscFinalize" 886 /*@C 887 PetscFinalize - Checks for options to be called at the conclusion 888 of the program. MPI_Finalize() is called only if the user had not 889 called MPI_Init() before calling PetscInitialize(). 890 891 Collective on PETSC_COMM_WORLD 892 893 Options Database Keys: 894 + -options_table - Calls PetscOptionsView() 895 . -options_left - Prints unused options that remain in the database 896 . -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 897 . -mpidump - Calls PetscMPIDump() 898 . -malloc_dump - Calls PetscMallocDump() 899 . -malloc_info - Prints total memory usage 900 - -malloc_log - Prints summary of memory usage 901 902 Level: beginner 903 904 Note: 905 See PetscInitialize() for more general runtime options. 906 907 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd() 908 @*/ 909 PetscErrorCode PetscFinalize(void) 910 { 911 PetscErrorCode ierr; 912 PetscMPIInt rank; 913 PetscInt nopt; 914 PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE; 915 PetscBool flg; 916 #if defined(PETSC_USE_LOG) 917 char mname[PETSC_MAX_PATH_LEN]; 918 #endif 919 920 PetscFunctionBegin; 921 if (!PetscInitializeCalled) { 922 printf("PetscInitialize() must be called before PetscFinalize()\n"); 923 PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE); 924 } 925 ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr); 926 927 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 928 929 ierr = PetscOptionsHasName(NULL,"-citations",&flg);CHKERRQ(ierr); 930 if (flg) { 931 char *cits, filename[PETSC_MAX_PATH_LEN]; 932 FILE *fd = PETSC_STDOUT; 933 934 ierr = PetscOptionsGetString(NULL,"-citations",filename,PETSC_MAX_PATH_LEN,NULL);CHKERRQ(ierr); 935 if (filename[0]) { 936 ierr = PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd);CHKERRQ(ierr); 937 } 938 ierr = PetscSegBufferGet(PetscCitationsList,1,&cits);CHKERRQ(ierr); 939 cits[0] = 0; 940 ierr = PetscSegBufferExtractAlloc(PetscCitationsList,&cits);CHKERRQ(ierr); 941 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n");CHKERRQ(ierr); 942 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 943 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits);CHKERRQ(ierr); 944 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 945 ierr = PetscFClose(PETSC_COMM_WORLD,fd);CHKERRQ(ierr); 946 ierr = PetscFree(cits);CHKERRQ(ierr); 947 } 948 ierr = PetscSegBufferDestroy(&PetscCitationsList);CHKERRQ(ierr); 949 950 #if defined(PETSC_SERIALIZE_FUNCTIONS) 951 ierr = PetscFPTDestroy();CHKERRQ(ierr); 952 #endif 953 954 955 #if defined(PETSC_HAVE_AMS) 956 flg = PETSC_FALSE; 957 ierr = PetscOptionsGetBool(NULL,"-options_gui",&flg,NULL);CHKERRQ(ierr); 958 if (flg) { 959 ierr = PetscOptionsAMSDestroy();CHKERRQ(ierr); 960 } 961 #endif 962 963 #if defined(PETSC_USE_SERVER) 964 flg1 = PETSC_FALSE; 965 ierr = PetscOptionsGetBool(NULL,"-server",&flg1,NULL);CHKERRQ(ierr); 966 if (flg1) { 967 /* this is a crude hack, but better than nothing */ 968 ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 petscwebserver","r",NULL);CHKERRQ(ierr); 969 } 970 #endif 971 972 ierr = PetscHMPIFinalize();CHKERRQ(ierr); 973 974 ierr = PetscOptionsGetBool(NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr); 975 if (!flg2) { 976 flg2 = PETSC_FALSE; 977 ierr = PetscOptionsGetBool(NULL,"-memory_info",&flg2,NULL);CHKERRQ(ierr); 978 } 979 if (flg2) { 980 ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr); 981 } 982 983 #if defined(PETSC_USE_LOG) 984 flg1 = PETSC_FALSE; 985 ierr = PetscOptionsGetBool(NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr); 986 if (flg1) { 987 PetscLogDouble flops = 0; 988 ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 989 ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr); 990 } 991 #endif 992 993 994 #if defined(PETSC_USE_LOG) 995 #if defined(PETSC_HAVE_MPE) 996 mname[0] = 0; 997 998 ierr = PetscOptionsGetString(NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 999 if (flg1) { 1000 if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);} 1001 else {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);} 1002 } 1003 #endif 1004 mname[0] = 0; 1005 1006 ierr = PetscOptionsGetString(NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1007 if (flg1) { 1008 PetscViewer viewer; 1009 if (mname[0]) { 1010 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 1011 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1012 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1013 } else { 1014 viewer = PETSC_VIEWER_STDOUT_WORLD; 1015 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1016 } 1017 } 1018 1019 mname[0] = 0; 1020 1021 ierr = PetscOptionsGetString(NULL,"-log_summary_python",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1022 if (flg1) { 1023 PetscViewer viewer; 1024 if (mname[0]) { 1025 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 1026 ierr = PetscLogViewPython(viewer);CHKERRQ(ierr); 1027 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1028 } else { 1029 viewer = PETSC_VIEWER_STDOUT_WORLD; 1030 ierr = PetscLogViewPython(viewer);CHKERRQ(ierr); 1031 } 1032 } 1033 1034 ierr = PetscOptionsGetString(NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1035 if (flg1) { 1036 if (mname[0]) {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);} 1037 else {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,0);CHKERRQ(ierr);} 1038 } 1039 1040 mname[0] = 0; 1041 1042 ierr = PetscOptionsGetString(NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr); 1043 ierr = PetscOptionsGetString(NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr); 1044 if (flg1 || flg2) { 1045 if (mname[0]) PetscLogDump(mname); 1046 else PetscLogDump(0); 1047 } 1048 #endif 1049 1050 /* 1051 Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_(). 1052 */ 1053 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1054 1055 ierr = PetscStackDestroy();CHKERRQ(ierr); 1056 PetscThreadLocalDestroy((PetscThreadKey)petscstack); /* Deletes pthread_key */ 1057 1058 flg1 = PETSC_FALSE; 1059 ierr = PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr); 1060 if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);} 1061 flg1 = PETSC_FALSE; 1062 ierr = PetscOptionsGetBool(NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr); 1063 if (flg1) { 1064 ierr = PetscMPIDump(stdout);CHKERRQ(ierr); 1065 } 1066 flg1 = PETSC_FALSE; 1067 flg2 = PETSC_FALSE; 1068 /* preemptive call to avoid listing this option in options table as unused */ 1069 ierr = PetscOptionsHasName(NULL,"-malloc_dump",&flg1);CHKERRQ(ierr); 1070 ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1071 ierr = PetscOptionsGetBool(NULL,"-options_table",&flg2,NULL);CHKERRQ(ierr); 1072 1073 if (flg2) { 1074 PetscViewer viewer; 1075 ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1076 ierr = PetscOptionsView(viewer);CHKERRQ(ierr); 1077 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1078 } 1079 1080 /* to prevent PETSc -options_left from warning */ 1081 ierr = PetscOptionsHasName(NULL,"-nox",&flg1);CHKERRQ(ierr); 1082 ierr = PetscOptionsHasName(NULL,"-nox_warning",&flg1);CHKERRQ(ierr); 1083 1084 if (!PetscHMPIWorker) { /* worker processes skip this because they do not usually process options */ 1085 flg3 = PETSC_FALSE; /* default value is required */ 1086 ierr = PetscOptionsGetBool(NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr); 1087 ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr); 1088 if (flg3) { 1089 if (!flg2) { /* have not yet printed the options */ 1090 PetscViewer viewer; 1091 ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1092 ierr = PetscOptionsView(viewer);CHKERRQ(ierr); 1093 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1094 } 1095 if (!nopt) { 1096 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr); 1097 } else if (nopt == 1) { 1098 ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr); 1099 } else { 1100 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr); 1101 } 1102 } 1103 #if defined(PETSC_USE_DEBUG) 1104 if (nopt && !flg3 && !flg1) { 1105 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr); 1106 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr); 1107 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1108 } else if (nopt && flg3) { 1109 #else 1110 if (nopt && flg3) { 1111 #endif 1112 ierr = PetscOptionsLeft();CHKERRQ(ierr); 1113 } 1114 } 1115 1116 { 1117 PetscThreadComm tcomm_world; 1118 ierr = PetscGetThreadCommWorld(&tcomm_world);CHKERRQ(ierr); 1119 /* Free global thread communicator */ 1120 ierr = PetscThreadCommDestroy(&tcomm_world);CHKERRQ(ierr); 1121 } 1122 1123 /* 1124 List all objects the user may have forgot to free 1125 */ 1126 ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1127 if (flg1) { 1128 MPI_Comm local_comm; 1129 char string[64]; 1130 1131 ierr = PetscOptionsGetString(NULL,"-objects_dump",string,64,NULL);CHKERRQ(ierr); 1132 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr); 1133 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1134 ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr); 1135 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1136 ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr); 1137 } 1138 PetscObjectsCounts = 0; 1139 PetscObjectsMaxCounts = 0; 1140 1141 ierr = PetscFree(PetscObjects);CHKERRQ(ierr); 1142 1143 #if defined(PETSC_USE_LOG) 1144 ierr = PetscLogDestroy();CHKERRQ(ierr); 1145 #endif 1146 1147 /* 1148 Destroy any packages that registered a finalize 1149 */ 1150 ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr); 1151 1152 /* 1153 Destroy all the function registration lists created 1154 */ 1155 ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr); 1156 1157 /* 1158 Print PetscFunctionLists that have not been properly freed 1159 1160 ierr = PetscFunctionListPrintAll();CHKERRQ(ierr); 1161 */ 1162 1163 if (petsc_history) { 1164 ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr); 1165 petsc_history = 0; 1166 } 1167 1168 ierr = PetscInfoAllow(PETSC_FALSE,NULL);CHKERRQ(ierr); 1169 1170 { 1171 char fname[PETSC_MAX_PATH_LEN]; 1172 FILE *fd; 1173 int err; 1174 1175 fname[0] = 0; 1176 1177 ierr = PetscOptionsGetString(NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr); 1178 flg2 = PETSC_FALSE; 1179 ierr = PetscOptionsGetBool(NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr); 1180 #if defined(PETSC_USE_DEBUG) 1181 if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE; 1182 #else 1183 flg2 = PETSC_FALSE; /* Skip reporting for optimized builds regardless of -malloc_test */ 1184 #endif 1185 if (flg1 && fname[0]) { 1186 char sname[PETSC_MAX_PATH_LEN]; 1187 1188 sprintf(sname,"%s_%d",fname,rank); 1189 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1190 ierr = PetscMallocDump(fd);CHKERRQ(ierr); 1191 err = fclose(fd); 1192 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1193 } else if (flg1 || flg2) { 1194 MPI_Comm local_comm; 1195 1196 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr); 1197 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1198 ierr = PetscMallocDump(stdout);CHKERRQ(ierr); 1199 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1200 ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr); 1201 } 1202 } 1203 1204 { 1205 char fname[PETSC_MAX_PATH_LEN]; 1206 FILE *fd = NULL; 1207 1208 fname[0] = 0; 1209 1210 ierr = PetscOptionsGetString(NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr); 1211 ierr = PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr); 1212 if (flg1 && fname[0]) { 1213 int err; 1214 1215 if (!rank) { 1216 fd = fopen(fname,"w"); 1217 if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname); 1218 } 1219 ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr); 1220 if (fd) { 1221 err = fclose(fd); 1222 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1223 } 1224 } else if (flg1 || flg2) { 1225 ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr); 1226 } 1227 } 1228 1229 #if defined(PETSC_HAVE_CUDA) 1230 flg = PETSC_TRUE; 1231 ierr = PetscOptionsGetBool(NULL,"-cublas",&flg,NULL);CHKERRQ(ierr); 1232 if (flg) { 1233 PetscInt p; 1234 for (p = 0; p < PetscGlobalSize; ++p) { 1235 if (p == PetscGlobalRank) cublasShutdown(); 1236 ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr); 1237 } 1238 } 1239 #endif 1240 1241 /* Can be destroyed only after all the options are used */ 1242 ierr = PetscOptionsDestroy();CHKERRQ(ierr); 1243 1244 PetscGlobalArgc = 0; 1245 PetscGlobalArgs = 0; 1246 1247 #if defined(PETSC_USE_REAL___FLOAT128) 1248 ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr); 1249 #if defined(PETSC_HAVE_COMPLEX) 1250 ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr); 1251 #endif 1252 ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr); 1253 ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr); 1254 #endif 1255 1256 #if defined(PETSC_HAVE_COMPLEX) 1257 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 1258 ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr); 1259 ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr); 1260 #endif 1261 #endif 1262 1263 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) 1264 ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr); 1265 #endif 1266 1267 ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr); 1268 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT) 1269 ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr); 1270 #endif 1271 ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr); 1272 ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr); 1273 ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr); 1274 1275 /* 1276 Destroy any known inner MPI_Comm's and attributes pointing to them 1277 Note this will not destroy any new communicators the user has created. 1278 1279 If all PETSc objects were not destroyed those left over objects will have hanging references to 1280 the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again 1281 */ 1282 { 1283 PetscCommCounter *counter; 1284 PetscMPIInt flg; 1285 MPI_Comm icomm; 1286 union {MPI_Comm comm; void *ptr;} ucomm; 1287 ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr); 1288 if (flg) { 1289 icomm = ucomm.comm; 1290 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1291 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1292 1293 ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1294 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1295 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1296 } 1297 ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr); 1298 if (flg) { 1299 icomm = ucomm.comm; 1300 ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr); 1301 if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1302 1303 ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr); 1304 ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr); 1305 ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr); 1306 } 1307 } 1308 1309 ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr); 1310 ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr); 1311 ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr); 1312 1313 if (PetscBeganMPI) { 1314 #if defined(PETSC_HAVE_MPI_FINALIZED) 1315 PetscMPIInt flag; 1316 ierr = MPI_Finalized(&flag);CHKERRQ(ierr); 1317 if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()"); 1318 #endif 1319 ierr = MPI_Finalize();CHKERRQ(ierr); 1320 } 1321 /* 1322 1323 Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because 1324 the communicator has some outstanding requests on it. Specifically if the 1325 flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See 1326 src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate() 1327 is never freed as it should be. Thus one may obtain messages of the form 1328 [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the 1329 memory was not freed. 1330 1331 */ 1332 ierr = PetscMallocClear();CHKERRQ(ierr); 1333 1334 PetscInitializeCalled = PETSC_FALSE; 1335 PetscFinalizeCalled = PETSC_TRUE; 1336 PetscFunctionReturn(ierr); 1337 } 1338 1339 #if defined(PETSC_MISSING_LAPACK_lsame_) 1340 PETSC_EXTERN int lsame_(char *a,char *b) 1341 { 1342 if (*a == *b) return 1; 1343 if (*a + 32 == *b) return 1; 1344 if (*a - 32 == *b) return 1; 1345 return 0; 1346 } 1347 #endif 1348 1349 #if defined(PETSC_MISSING_LAPACK_lsame) 1350 PETSC_EXTERN int lsame(char *a,char *b) 1351 { 1352 if (*a == *b) return 1; 1353 if (*a + 32 == *b) return 1; 1354 if (*a - 32 == *b) return 1; 1355 return 0; 1356 } 1357 #endif 1358