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