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