1 #define PETSC_DESIRE_FEATURE_TEST_MACROS 2 /* 3 This file defines the initialization of PETSc, including PetscInitialize() 4 */ 5 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/ 6 #include <petscviewer.h> 7 8 #if !defined(PETSC_HAVE_WINDOWS_COMPILERS) 9 #include <petsc/private/valgrind/valgrind.h> 10 #endif 11 12 #if defined(PETSC_HAVE_FORTRAN) 13 #include <petsc/private/fortranimpl.h> 14 #endif 15 16 #if defined(PETSC_HAVE_CUDA) 17 #include <petsc/private/deviceimpl.h> 18 PETSC_EXTERN cudaEvent_t petsc_gputimer_begin; 19 PETSC_EXTERN cudaEvent_t petsc_gputimer_end; 20 #endif 21 22 #if defined(PETSC_HAVE_HIP) 23 #include <petsc/private/deviceimpl.h> 24 PETSC_EXTERN hipEvent_t petsc_gputimer_begin; 25 PETSC_EXTERN hipEvent_t petsc_gputimer_end; 26 #endif 27 28 #if defined(PETSC_USE_GCOV) 29 EXTERN_C_BEGIN 30 void __gcov_flush(void); 31 EXTERN_C_END 32 #endif 33 34 #if PetscDefined(USE_LOG) 35 PETSC_INTERN PetscErrorCode PetscLogFinalize(void); 36 #endif 37 38 #if defined(PETSC_SERIALIZE_FUNCTIONS) 39 PETSC_INTERN PetscFPT PetscFPTData; 40 PetscFPT PetscFPTData = 0; 41 #endif 42 43 #if PetscDefined(HAVE_SAWS) 44 #include <petscviewersaws.h> 45 #endif 46 47 /* -----------------------------------------------------------------------------------------*/ 48 49 PETSC_INTERN FILE *petsc_history; 50 51 PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void); 52 PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void); 53 PETSC_INTERN PetscErrorCode PetscFunctionListPrintAll(void); 54 PETSC_INTERN PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm,int); 55 PETSC_INTERN PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm,int); 56 PETSC_INTERN PetscErrorCode PetscCloseHistoryFile(FILE**); 57 58 /* user may set these BEFORE calling PetscInitialize() */ 59 MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL; 60 #if PetscDefined(HAVE_MPI_INIT_THREAD) 61 PetscMPIInt PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_FUNNELED; 62 #else 63 PetscMPIInt PETSC_MPI_THREAD_REQUIRED = 0; 64 #endif 65 66 PetscMPIInt Petsc_Counter_keyval = MPI_KEYVAL_INVALID; 67 PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID; 68 PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID; 69 PetscMPIInt Petsc_ShmComm_keyval = MPI_KEYVAL_INVALID; 70 71 /* 72 Declare and set all the string names of the PETSc enums 73 */ 74 const char *const PetscBools[] = {"FALSE","TRUE","PetscBool","PETSC_",NULL}; 75 const char *const PetscCopyModes[] = {"COPY_VALUES","OWN_POINTER","USE_POINTER","PetscCopyMode","PETSC_",NULL}; 76 77 PetscBool PetscPreLoadingUsed = PETSC_FALSE; 78 PetscBool PetscPreLoadingOn = PETSC_FALSE; 79 80 PetscInt PetscHotRegionDepth; 81 82 PetscBool PETSC_RUNNING_ON_VALGRIND = PETSC_FALSE; 83 84 #if defined(PETSC_HAVE_THREADSAFETY) 85 PetscSpinlock PetscViewerASCIISpinLockOpen; 86 PetscSpinlock PetscViewerASCIISpinLockStdout; 87 PetscSpinlock PetscViewerASCIISpinLockStderr; 88 PetscSpinlock PetscCommSpinLock; 89 #endif 90 91 /* 92 PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args 93 94 Collective 95 96 Level: advanced 97 98 Notes: 99 this is called only by the PETSc Julia interface. Even though it might start MPI it sets the flag to 100 indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to 101 be called multiple times from Julia without the problem of trying to initialize MPI more than once. 102 103 Developer Note: Turns off PETSc signal handling to allow Julia to manage signals 104 105 .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments() 106 */ 107 PetscErrorCode PetscInitializeNoPointers(int argc,char **args,const char *filename,const char *help) 108 { 109 PetscErrorCode ierr; 110 int myargc = argc; 111 char **myargs = args; 112 113 PetscFunctionBegin; 114 ierr = PetscInitialize(&myargc,&myargs,filename,help);if (ierr) PetscFunctionReturn(ierr); 115 ierr = PetscPopSignalHandler();CHKERRQ(ierr); 116 PetscBeganMPI = PETSC_FALSE; 117 PetscFunctionReturn(0); 118 } 119 120 /* 121 Used by Julia interface to get communicator 122 */ 123 PetscErrorCode PetscGetPETSC_COMM_SELF(MPI_Comm *comm) 124 { 125 PetscFunctionBegin; 126 if (PetscInitializeCalled) PetscValidPointer(comm,1); 127 *comm = PETSC_COMM_SELF; 128 PetscFunctionReturn(0); 129 } 130 131 /*@C 132 PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without 133 the command line arguments. 134 135 Collective 136 137 Level: advanced 138 139 .seealso: PetscInitialize(), PetscInitializeFortran() 140 @*/ 141 PetscErrorCode PetscInitializeNoArguments(void) 142 { 143 PetscErrorCode ierr; 144 int argc = 0; 145 char **args = NULL; 146 147 PetscFunctionBegin; 148 ierr = PetscInitialize(&argc,&args,NULL,NULL); 149 PetscFunctionReturn(ierr); 150 } 151 152 /*@ 153 PetscInitialized - Determine whether PETSc is initialized. 154 155 Level: beginner 156 157 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 158 @*/ 159 PetscErrorCode PetscInitialized(PetscBool *isInitialized) 160 { 161 PetscFunctionBegin; 162 if (PetscInitializeCalled) PetscValidBoolPointer(isInitialized,1); 163 *isInitialized = PetscInitializeCalled; 164 PetscFunctionReturn(0); 165 } 166 167 /*@ 168 PetscFinalized - Determine whether PetscFinalize() has been called yet 169 170 Level: developer 171 172 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran() 173 @*/ 174 PetscErrorCode PetscFinalized(PetscBool *isFinalized) 175 { 176 PetscFunctionBegin; 177 if (!PetscFinalizeCalled) PetscValidBoolPointer(isFinalized,1); 178 *isFinalized = PetscFinalizeCalled; 179 PetscFunctionReturn(0); 180 } 181 182 PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Private(const char []); 183 184 /* 185 This function is the MPI reduction operation used to compute the sum of the 186 first half of the datatype and the max of the second half. 187 */ 188 MPI_Op MPIU_MAXSUM_OP = 0; 189 190 PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype) 191 { 192 PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt; 193 194 PetscFunctionBegin; 195 if (*datatype != MPIU_2INT) { 196 (*PetscErrorPrintf)("Can only handle MPIU_2INT data types"); 197 PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG); 198 } 199 200 for (i=0; i<count; i++) { 201 xout[2*i] = PetscMax(xout[2*i],xin[2*i]); 202 xout[2*i+1] += xin[2*i+1]; 203 } 204 PetscFunctionReturnVoid(); 205 } 206 207 /* 208 Returns the max of the first entry owned by this processor and the 209 sum of the second entry. 210 211 The reason sizes[2*i] contains lengths sizes[2*i+1] contains flag of 1 if length is nonzero 212 is so that the MPIU_MAXSUM_OP() can set TWO values, if we passed in only sizes[i] with lengths 213 there would be no place to store the both needed results. 214 */ 215 PetscErrorCode PetscMaxSum(MPI_Comm comm,const PetscInt sizes[],PetscInt *max,PetscInt *sum) 216 { 217 PetscErrorCode ierr; 218 219 PetscFunctionBegin; 220 #if defined(PETSC_HAVE_MPI_REDUCE_SCATTER_BLOCK) 221 { 222 struct {PetscInt max,sum;} work; 223 ierr = MPI_Reduce_scatter_block((void*)sizes,&work,1,MPIU_2INT,MPIU_MAXSUM_OP,comm);CHKERRMPI(ierr); 224 *max = work.max; 225 *sum = work.sum; 226 } 227 #else 228 { 229 PetscMPIInt size,rank; 230 struct {PetscInt max,sum;} *work; 231 ierr = MPI_Comm_size(comm,&size);CHKERRMPI(ierr); 232 ierr = MPI_Comm_rank(comm,&rank);CHKERRMPI(ierr); 233 ierr = PetscMalloc1(size,&work);CHKERRQ(ierr); 234 ierr = MPIU_Allreduce((void*)sizes,work,size,MPIU_2INT,MPIU_MAXSUM_OP,comm);CHKERRMPI(ierr); 235 *max = work[rank].max; 236 *sum = work[rank].sum; 237 ierr = PetscFree(work);CHKERRQ(ierr); 238 } 239 #endif 240 PetscFunctionReturn(0); 241 } 242 243 /* ----------------------------------------------------------------------------*/ 244 245 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 246 MPI_Op MPIU_SUM = 0; 247 248 PETSC_EXTERN void MPIAPI PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 249 { 250 PetscInt i,count = *cnt; 251 252 PetscFunctionBegin; 253 if (*datatype == MPIU_REAL) { 254 PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out; 255 for (i=0; i<count; i++) xout[i] += xin[i]; 256 } 257 #if defined(PETSC_HAVE_COMPLEX) 258 else if (*datatype == MPIU_COMPLEX) { 259 PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out; 260 for (i=0; i<count; i++) xout[i] += xin[i]; 261 } 262 #endif 263 else { 264 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"); 265 PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG); 266 } 267 PetscFunctionReturnVoid(); 268 } 269 #endif 270 271 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 272 MPI_Op MPIU_MAX = 0; 273 MPI_Op MPIU_MIN = 0; 274 275 PETSC_EXTERN void MPIAPI PetscMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 276 { 277 PetscInt i,count = *cnt; 278 279 PetscFunctionBegin; 280 if (*datatype == MPIU_REAL) { 281 PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out; 282 for (i=0; i<count; i++) xout[i] = PetscMax(xout[i],xin[i]); 283 } 284 #if defined(PETSC_HAVE_COMPLEX) 285 else if (*datatype == MPIU_COMPLEX) { 286 PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out; 287 for (i=0; i<count; i++) { 288 xout[i] = PetscRealPartComplex(xout[i])<PetscRealPartComplex(xin[i]) ? xin[i] : xout[i]; 289 } 290 } 291 #endif 292 else { 293 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types"); 294 PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG); 295 } 296 PetscFunctionReturnVoid(); 297 } 298 299 PETSC_EXTERN void MPIAPI PetscMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype) 300 { 301 PetscInt i,count = *cnt; 302 303 PetscFunctionBegin; 304 if (*datatype == MPIU_REAL) { 305 PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out; 306 for (i=0; i<count; i++) xout[i] = PetscMin(xout[i],xin[i]); 307 } 308 #if defined(PETSC_HAVE_COMPLEX) 309 else if (*datatype == MPIU_COMPLEX) { 310 PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out; 311 for (i=0; i<count; i++) { 312 xout[i] = PetscRealPartComplex(xout[i])>PetscRealPartComplex(xin[i]) ? xin[i] : xout[i]; 313 } 314 } 315 #endif 316 else { 317 (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types"); 318 PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG); 319 } 320 PetscFunctionReturnVoid(); 321 } 322 #endif 323 324 /* 325 Private routine to delete internal tag/name counter storage when a communicator is freed. 326 327 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. 328 329 Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval() 330 331 */ 332 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_Counter_Attr_Delete_Fn(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state) 333 { 334 PetscErrorCode ierr; 335 PetscCommCounter *counter=(PetscCommCounter*)count_val; 336 337 PetscFunctionBegin; 338 ierr = PetscInfo1(NULL,"Deleting counter data in an MPI_Comm %ld\n",(long)comm);CHKERRMPI(ierr); 339 ierr = PetscFree(counter->iflags);CHKERRMPI(ierr); 340 ierr = PetscFree(counter);CHKERRMPI(ierr); 341 PetscFunctionReturn(MPI_SUCCESS); 342 } 343 344 /* 345 This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Comm_delete_attr) or when the user 346 calls MPI_Comm_free(). 347 348 This is the only entry point for breaking the links between inner and outer comms. 349 350 This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator. 351 352 Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval() 353 354 */ 355 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_InnerComm_Attr_Delete_Fn(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state) 356 { 357 PetscErrorCode ierr; 358 union {MPI_Comm comm; void *ptr;} icomm; 359 360 PetscFunctionBegin; 361 if (keyval != Petsc_InnerComm_keyval) SETERRMPI(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Unexpected keyval"); 362 icomm.ptr = attr_val; 363 if (PetscDefined(USE_DEBUG)) { 364 /* Error out if the inner/outer comms are not correctly linked through their Outer/InnterComm attributes */ 365 PetscMPIInt flg; 366 union {MPI_Comm comm; void *ptr;} ocomm; 367 ierr = MPI_Comm_get_attr(icomm.comm,Petsc_OuterComm_keyval,&ocomm,&flg);CHKERRMPI(ierr); 368 if (!flg) SETERRMPI(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner comm does not have OuterComm attribute"); 369 if (ocomm.comm != comm) SETERRMPI(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner comm's OuterComm attribute does not point to outer PETSc comm"); 370 } 371 ierr = MPI_Comm_delete_attr(icomm.comm,Petsc_OuterComm_keyval);CHKERRMPI(ierr); 372 ierr = PetscInfo2(NULL,"User MPI_Comm %ld is being unlinked from inner PETSc comm %ld\n",(long)comm,(long)icomm.comm);CHKERRMPI(ierr); 373 PetscFunctionReturn(MPI_SUCCESS); 374 } 375 376 /* 377 * This is invoked on the inner comm when Petsc_InnerComm_Attr_Delete_Fn calls MPI_Comm_delete_attr(). It should not be reached any other way. 378 */ 379 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_OuterComm_Attr_Delete_Fn(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state) 380 { 381 PetscErrorCode ierr; 382 383 PetscFunctionBegin; 384 ierr = PetscInfo1(NULL,"Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n",(long)comm);CHKERRMPI(ierr); 385 PetscFunctionReturn(MPI_SUCCESS); 386 } 387 388 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_ShmComm_Attr_Delete_Fn(MPI_Comm,PetscMPIInt,void *,void *); 389 390 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 391 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype,MPI_Aint*,void*); 392 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*); 393 PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*); 394 #endif 395 396 PetscMPIInt PETSC_MPI_ERROR_CLASS=MPI_ERR_LASTCODE,PETSC_MPI_ERROR_CODE; 397 398 PETSC_INTERN int PetscGlobalArgc; 399 PETSC_INTERN char **PetscGlobalArgs; 400 int PetscGlobalArgc = 0; 401 char **PetscGlobalArgs = NULL; 402 PetscSegBuffer PetscCitationsList; 403 404 PetscErrorCode PetscCitationsInitialize(void) 405 { 406 PetscErrorCode ierr; 407 408 PetscFunctionBegin; 409 ierr = PetscSegBufferCreate(1,10000,&PetscCitationsList);CHKERRQ(ierr); 410 ierr = PetscCitationsRegister("@TechReport{petsc-user-ref,\n Author = {Satish Balay and Shrirang Abhyankar and Mark F. Adams and Jed Brown \n and Peter Brune and Kris Buschelman and Lisandro Dalcin and\n Victor Eijkhout and William D. Gropp and Dmitry Karpeyev and\n 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.11},\n Institution = {Argonne National Laboratory},\n Year = {2019}\n}\n",NULL);CHKERRQ(ierr); 411 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); 412 PetscFunctionReturn(0); 413 } 414 415 static char programname[PETSC_MAX_PATH_LEN] = ""; /* HP includes entire path in name */ 416 417 PetscErrorCode PetscSetProgramName(const char name[]) 418 { 419 PetscErrorCode ierr; 420 421 PetscFunctionBegin; 422 ierr = PetscStrncpy(programname,name,sizeof(programname));CHKERRQ(ierr); 423 PetscFunctionReturn(0); 424 } 425 426 /*@C 427 PetscGetProgramName - Gets the name of the running program. 428 429 Not Collective 430 431 Input Parameter: 432 . len - length of the string name 433 434 Output Parameter: 435 . name - the name of the running program 436 437 Level: advanced 438 439 Notes: 440 The name of the program is copied into the user-provided character 441 array of length len. On some machines the program name includes 442 its entire path, so one should generally set len >= PETSC_MAX_PATH_LEN. 443 @*/ 444 PetscErrorCode PetscGetProgramName(char name[],size_t len) 445 { 446 PetscErrorCode ierr; 447 448 PetscFunctionBegin; 449 ierr = PetscStrncpy(name,programname,len);CHKERRQ(ierr); 450 PetscFunctionReturn(0); 451 } 452 453 /*@C 454 PetscGetArgs - Allows you to access the raw command line arguments anywhere 455 after PetscInitialize() is called but before PetscFinalize(). 456 457 Not Collective 458 459 Output Parameters: 460 + argc - count of number of command line arguments 461 - args - the command line arguments 462 463 Level: intermediate 464 465 Notes: 466 This is usually used to pass the command line arguments into other libraries 467 that are called internally deep in PETSc or the application. 468 469 The first argument contains the program name as is normal for C arguments. 470 471 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments() 472 473 @*/ 474 PetscErrorCode PetscGetArgs(int *argc,char ***args) 475 { 476 PetscFunctionBegin; 477 if (PetscUnlikely(!PetscInitializeCalled && PetscFinalizeCalled)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()"); 478 *argc = PetscGlobalArgc; 479 *args = PetscGlobalArgs; 480 PetscFunctionReturn(0); 481 } 482 483 /*@C 484 PetscGetArguments - Allows you to access the command line arguments anywhere 485 after PetscInitialize() is called but before PetscFinalize(). 486 487 Not Collective 488 489 Output Parameters: 490 . args - the command line arguments 491 492 Level: intermediate 493 494 Notes: 495 This does NOT start with the program name and IS null terminated (final arg is void) 496 497 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments() 498 499 @*/ 500 PetscErrorCode PetscGetArguments(char ***args) 501 { 502 PetscInt i,argc = PetscGlobalArgc; 503 PetscErrorCode ierr; 504 505 PetscFunctionBegin; 506 if (PetscUnlikely(!PetscInitializeCalled && PetscFinalizeCalled)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()"); 507 if (!argc) {*args = NULL; PetscFunctionReturn(0);} 508 ierr = PetscMalloc1(argc,args);CHKERRQ(ierr); 509 for (i=0; i<argc-1; i++) { 510 ierr = PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]);CHKERRQ(ierr); 511 } 512 (*args)[argc-1] = NULL; 513 PetscFunctionReturn(0); 514 } 515 516 /*@C 517 PetscFreeArguments - Frees the memory obtained with PetscGetArguments() 518 519 Not Collective 520 521 Output Parameters: 522 . args - the command line arguments 523 524 Level: intermediate 525 526 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments() 527 528 @*/ 529 PetscErrorCode PetscFreeArguments(char **args) 530 { 531 PetscInt i = 0; 532 PetscErrorCode ierr; 533 534 PetscFunctionBegin; 535 if (!args) PetscFunctionReturn(0); 536 while (args[i]) { 537 ierr = PetscFree(args[i]);CHKERRQ(ierr); 538 i++; 539 } 540 ierr = PetscFree(args);CHKERRQ(ierr); 541 PetscFunctionReturn(0); 542 } 543 544 #if PetscDefined(HAVE_SAWS) 545 #include <petscconfiginfo.h> 546 547 PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char help[]) 548 { 549 PetscFunctionBegin; 550 if (!PetscGlobalRank) { 551 char cert[PETSC_MAX_PATH_LEN],root[PETSC_MAX_PATH_LEN],*intro,programname[64],*appline,*options,version[64]; 552 int port; 553 PetscBool flg,rootlocal = PETSC_FALSE,flg2,selectport = PETSC_FALSE; 554 size_t applinelen,introlen; 555 PetscErrorCode ierr; 556 char sawsurl[256]; 557 558 ierr = PetscOptionsHasName(NULL,NULL,"-saws_log",&flg);CHKERRQ(ierr); 559 if (flg) { 560 char sawslog[PETSC_MAX_PATH_LEN]; 561 562 ierr = PetscOptionsGetString(NULL,NULL,"-saws_log",sawslog,sizeof(sawslog),NULL);CHKERRQ(ierr); 563 if (sawslog[0]) { 564 PetscStackCallSAWs(SAWs_Set_Use_Logfile,(sawslog)); 565 } else { 566 PetscStackCallSAWs(SAWs_Set_Use_Logfile,(NULL)); 567 } 568 } 569 ierr = PetscOptionsGetString(NULL,NULL,"-saws_https",cert,sizeof(cert),&flg);CHKERRQ(ierr); 570 if (flg) { 571 PetscStackCallSAWs(SAWs_Set_Use_HTTPS,(cert)); 572 } 573 ierr = PetscOptionsGetBool(NULL,NULL,"-saws_port_auto_select",&selectport,NULL);CHKERRQ(ierr); 574 if (selectport) { 575 PetscStackCallSAWs(SAWs_Get_Available_Port,(&port)); 576 PetscStackCallSAWs(SAWs_Set_Port,(port)); 577 } else { 578 ierr = PetscOptionsGetInt(NULL,NULL,"-saws_port",&port,&flg);CHKERRQ(ierr); 579 if (flg) { 580 PetscStackCallSAWs(SAWs_Set_Port,(port)); 581 } 582 } 583 ierr = PetscOptionsGetString(NULL,NULL,"-saws_root",root,sizeof(root),&flg);CHKERRQ(ierr); 584 if (flg) { 585 PetscStackCallSAWs(SAWs_Set_Document_Root,(root));CHKERRQ(ierr); 586 ierr = PetscStrcmp(root,".",&rootlocal);CHKERRQ(ierr); 587 } else { 588 ierr = PetscOptionsHasName(NULL,NULL,"-saws_options",&flg);CHKERRQ(ierr); 589 if (flg) { 590 ierr = PetscStrreplace(PETSC_COMM_WORLD,"${PETSC_DIR}/share/petsc/saws",root,sizeof(root));CHKERRQ(ierr); 591 PetscStackCallSAWs(SAWs_Set_Document_Root,(root));CHKERRQ(ierr); 592 } 593 } 594 ierr = PetscOptionsHasName(NULL,NULL,"-saws_local",&flg2);CHKERRQ(ierr); 595 if (flg2) { 596 char jsdir[PETSC_MAX_PATH_LEN]; 597 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"-saws_local option requires -saws_root option"); 598 ierr = PetscSNPrintf(jsdir,sizeof(jsdir),"%s/js",root);CHKERRQ(ierr); 599 ierr = PetscTestDirectory(jsdir,'r',&flg);CHKERRQ(ierr); 600 if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_READ,"-saws_local option requires js directory in root directory"); 601 PetscStackCallSAWs(SAWs_Push_Local_Header,());CHKERRQ(ierr); 602 } 603 ierr = PetscGetProgramName(programname,sizeof(programname));CHKERRQ(ierr); 604 ierr = PetscStrlen(help,&applinelen);CHKERRQ(ierr); 605 introlen = 4096 + applinelen; 606 applinelen += 1024; 607 ierr = PetscMalloc(applinelen,&appline);CHKERRQ(ierr); 608 ierr = PetscMalloc(introlen,&intro);CHKERRQ(ierr); 609 610 if (rootlocal) { 611 ierr = PetscSNPrintf(appline,applinelen,"%s.c.html",programname);CHKERRQ(ierr); 612 ierr = PetscTestFile(appline,'r',&rootlocal);CHKERRQ(ierr); 613 } 614 ierr = PetscOptionsGetAll(NULL,&options);CHKERRQ(ierr); 615 if (rootlocal && help) { 616 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);CHKERRQ(ierr); 617 } else if (help) { 618 ierr = PetscSNPrintf(appline,applinelen,"<center>Running %s %s</center><br><center><pre>%s</pre></center><br>",programname,options,help);CHKERRQ(ierr); 619 } else { 620 ierr = PetscSNPrintf(appline,applinelen,"<center> Running %s %s</center><br>\n",programname,options);CHKERRQ(ierr); 621 } 622 ierr = PetscFree(options);CHKERRQ(ierr); 623 ierr = PetscGetVersion(version,sizeof(version));CHKERRQ(ierr); 624 ierr = PetscSNPrintf(intro,introlen,"<body>\n" 625 "<center><h2> <a href=\"https://petsc.org/\">PETSc</a> Application Web server powered by <a href=\"https://bitbucket.org/saws/saws\">SAWs</a> </h2></center>\n" 626 "<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" 627 "%s",version,petscconfigureoptions,appline);CHKERRQ(ierr); 628 PetscStackCallSAWs(SAWs_Push_Body,("index.html",0,intro)); 629 ierr = PetscFree(intro);CHKERRQ(ierr); 630 ierr = PetscFree(appline);CHKERRQ(ierr); 631 if (selectport) { 632 PetscBool silent; 633 634 ierr = SAWs_Initialize(); 635 /* another process may have grabbed the port so keep trying */ 636 while (ierr) { 637 PetscStackCallSAWs(SAWs_Get_Available_Port,(&port)); 638 PetscStackCallSAWs(SAWs_Set_Port,(port)); 639 ierr = SAWs_Initialize(); 640 } 641 642 ierr = PetscOptionsGetBool(NULL,NULL,"-saws_port_auto_select_silent",&silent,NULL);CHKERRQ(ierr); 643 if (!silent) { 644 PetscStackCallSAWs(SAWs_Get_FullURL,(sizeof(sawsurl),sawsurl)); 645 ierr = PetscPrintf(PETSC_COMM_WORLD,"Point your browser to %s for SAWs\n",sawsurl);CHKERRQ(ierr); 646 } 647 } else { 648 PetscStackCallSAWs(SAWs_Initialize,()); 649 } 650 ierr = PetscCitationsRegister("@TechReport{ saws,\n" 651 " Author = {Matt Otten and Jed Brown and Barry Smith},\n" 652 " Title = {Scientific Application Web Server (SAWs) Users Manual},\n" 653 " Institution = {Argonne National Laboratory},\n" 654 " Year = 2013\n}\n",NULL);CHKERRQ(ierr); 655 } 656 PetscFunctionReturn(0); 657 } 658 #endif 659 660 /* Things must be done before MPI_Init() when MPI is not yet initialized, and can be shared between C init and Fortran init */ 661 PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(void) 662 { 663 PetscFunctionBegin; 664 #if defined(PETSC_HAVE_HWLOC_SOLARIS_BUG) 665 /* see MPI.py for details on this bug */ 666 (void) setenv("HWLOC_COMPONENTS","-x86",1); 667 #endif 668 PetscFunctionReturn(0); 669 } 670 671 #if defined(PETSC_HAVE_ADIOS) 672 #include <adios.h> 673 #include <adios_read.h> 674 int64_t Petsc_adios_group; 675 #endif 676 #if defined(PETSC_HAVE_OPENMP) 677 #include <omp.h> 678 PetscInt PetscNumOMPThreads; 679 #endif 680 681 #if PetscDefined(HAVE_DLFCN_H) 682 #include <dlfcn.h> 683 #endif 684 685 /* 686 PetscInitialize_Common - shared code between C and Fortran initialization 687 688 prog: program name 689 file: optional PETSc database file name. Might be in Fortran string format when 'ftn' is true 690 help: program help message 691 ftn: is it called from Fortran initilization (petscinitializef_)? 692 readarguments,len: used when fortran is true 693 */ 694 PETSC_INTERN PetscErrorCode PetscInitialize_Common(const char* prog,const char* file,const char *help,PetscBool ftn,PetscBool readarguments,PetscInt len) 695 { 696 PetscErrorCode ierr; 697 PetscMPIInt size; 698 PetscBool flg = PETSC_TRUE; 699 char hostname[256]; 700 701 PetscFunctionBegin; 702 if (PetscInitializeCalled) PetscFunctionReturn(0); 703 /* 704 The checking over compatible runtime libraries is complicated by the MPI ABI initiative 705 https://wiki.mpich.org/mpich/index.php/ABI_Compatibility_Initiative which started with 706 MPICH v3.1 (Released February 2014) 707 IBM MPI v2.1 (December 2014) 708 Intel MPI Library v5.0 (2014) 709 Cray MPT v7.0.0 (June 2014) 710 As of July 31, 2017 the ABI number still appears to be 12, that is all of the versions 711 listed above and since that time are compatible. 712 713 Unfortunately the MPI ABI initiative has not defined a way to determine the ABI number 714 at compile time or runtime. Thus we will need to systematically track the allowed versions 715 and how they are represented in the mpi.h and MPI_Get_library_version() output in order 716 to perform the checking. 717 718 Currently we only check for pre MPI ABI versions (and packages that do not follow the MPI ABI). 719 720 Questions: 721 722 Should the checks for ABI incompatibility be only on the major version number below? 723 Presumably the output to stderr will be removed before a release. 724 */ 725 726 #if defined(PETSC_HAVE_MPI_GET_LIBRARY_VERSION) 727 { 728 char mpilibraryversion[MPI_MAX_LIBRARY_VERSION_STRING]; 729 PetscMPIInt mpilibraryversionlength; 730 ierr = MPI_Get_library_version(mpilibraryversion,&mpilibraryversionlength); 731 if (ierr) PetscFunctionReturn(ierr); 732 /* check for MPICH versions before MPI ABI initiative */ 733 #if defined(MPICH_VERSION) 734 #if MPICH_NUMVERSION < 30100000 735 { 736 char *ver,*lf; 737 PetscBool flg = PETSC_FALSE; 738 ierr = PetscStrstr(mpilibraryversion,"MPICH Version:",&ver); 739 if (ierr) PetscFunctionReturn(ierr); 740 else if (ver) { 741 ierr = PetscStrchr(ver,'\n',&lf); 742 if (ierr) PetscFunctionReturn(ierr); 743 else if (lf) { 744 *lf = 0; 745 ierr = PetscStrendswith(ver,MPICH_VERSION,&flg);if (ierr) PetscFunctionReturn(ierr); 746 } 747 } 748 if (!flg) { 749 PetscInfo1(NULL,"PETSc warning --- MPICH library version \n%s does not match what PETSc was compiled with %.\n",mpilibraryversion,MPICH_VESION); 750 flg = PETSC_TRUE; 751 } 752 } 753 #endif 754 /* check for OpenMPI version, it is not part of the MPI ABI initiative (is it part of another initiative that needs to be handled?) */ 755 #elif defined(OMPI_MAJOR_VERSION) 756 { 757 char *ver,bs[MPI_MAX_LIBRARY_VERSION_STRING],*bsf; 758 PetscBool flg = PETSC_FALSE; 759 #define PSTRSZ 2 760 char ompistr1[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"Open MPI","FUJITSU MPI"}; 761 char ompistr2[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"v","Library "}; 762 int i; 763 for (i=0; i<PSTRSZ; i++) { 764 ierr = PetscStrstr(mpilibraryversion,ompistr1[i],&ver); 765 if (ierr) PetscFunctionReturn(ierr); 766 else if (ver) { 767 PetscSNPrintf(bs,MPI_MAX_LIBRARY_VERSION_STRING,"%s%d.%d",ompistr2[i],OMPI_MAJOR_VERSION,OMPI_MINOR_VERSION); 768 ierr = PetscStrstr(ver,bs,&bsf); 769 if (ierr) PetscFunctionReturn(ierr); 770 else if (bsf) flg = PETSC_TRUE; 771 break; 772 } 773 } 774 if (!flg) { 775 PetscInfo3(NULL,"PETSc warning --- Open MPI library version \n%s does not match what PETSc was compiled with %d.%d.\n",mpilibraryversion,OMPI_MAJOR_VERSION,OMPI_MINOR_VERSION); 776 flg = PETSC_TRUE; 777 } 778 } 779 #endif 780 } 781 #endif 782 783 #if defined(PETSC_HAVE_DLSYM) 784 /* These symbols are currently in the OpenMPI and MPICH libraries; they may not always be, in that case the test will simply not detect the problem */ 785 if (PetscUnlikely(dlsym(RTLD_DEFAULT,"ompi_mpi_init") && dlsym(RTLD_DEFAULT,"MPID_Abort"))) { 786 fprintf(stderr,"PETSc Error --- Application was linked against both OpenMPI and MPICH based MPI libraries and will not run correctly\n"); 787 ierr = PetscStackView(stderr);CHKERRQ(ierr); 788 PetscFunctionReturn(PETSC_ERR_MPI_LIB_INCOMP); 789 } 790 #endif 791 792 /* these must be initialized in a routine, not as a constant declaration*/ 793 PETSC_STDOUT = stdout; 794 PETSC_STDERR = stderr; 795 796 /*CHKERRQ can be used from now */ 797 PetscErrorHandlingInitialized = PETSC_TRUE; 798 799 /* on Windows - set printf to default to printing 2 digit exponents */ 800 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT) 801 _set_output_format(_TWO_DIGIT_EXPONENT); 802 #endif 803 804 ierr = PetscOptionsCreateDefault();CHKERRQ(ierr); 805 806 PetscFinalizeCalled = PETSC_FALSE; 807 808 ierr = PetscSetProgramName(prog);CHKERRQ(ierr); 809 ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen);CHKERRQ(ierr); 810 ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout);CHKERRQ(ierr); 811 ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr);CHKERRQ(ierr); 812 ierr = PetscSpinlockCreate(&PetscCommSpinLock);CHKERRQ(ierr); 813 814 if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD; 815 ierr = MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);CHKERRMPI(ierr); 816 817 if (PETSC_MPI_ERROR_CLASS == MPI_ERR_LASTCODE) { 818 ierr = MPI_Add_error_class(&PETSC_MPI_ERROR_CLASS);CHKERRMPI(ierr); 819 ierr = MPI_Add_error_code(PETSC_MPI_ERROR_CLASS,&PETSC_MPI_ERROR_CODE);CHKERRMPI(ierr); 820 } 821 822 /* Done after init due to a bug in MPICH-GM? */ 823 ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr); 824 825 ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRMPI(ierr); 826 ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRMPI(ierr); 827 828 MPIU_BOOL = MPI_INT; 829 MPIU_ENUM = MPI_INT; 830 MPIU_FORTRANADDR = (sizeof(void*) == sizeof(int)) ? MPI_INT : MPIU_INT64; 831 if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED; 832 else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG; 833 #if defined(PETSC_SIZEOF_LONG_LONG) 834 else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG; 835 #endif 836 else { 837 (*PetscErrorPrintf)("PetscInitialize_Common: Could not find MPI type for size_t\n"); 838 PetscFunctionReturn(PETSC_ERR_SUP_SYS); 839 } 840 841 /* 842 Initialized the global complex variable; this is because with 843 shared libraries the constructors for global variables 844 are not called; at least on IRIX. 845 */ 846 #if defined(PETSC_HAVE_COMPLEX) 847 { 848 #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128) 849 PetscComplex ic(0.0,1.0); 850 PETSC_i = ic; 851 #else 852 PETSC_i = _Complex_I; 853 #endif 854 } 855 #endif /* PETSC_HAVE_COMPLEX */ 856 857 /* 858 Create the PETSc MPI reduction operator that sums of the first 859 half of the entries and maxes the second half. 860 */ 861 ierr = MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP);CHKERRMPI(ierr); 862 863 #if defined(PETSC_USE_REAL___FLOAT128) 864 ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);CHKERRMPI(ierr); 865 ierr = MPI_Type_commit(&MPIU___FLOAT128);CHKERRMPI(ierr); 866 #if defined(PETSC_HAVE_COMPLEX) 867 ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);CHKERRMPI(ierr); 868 ierr = MPI_Type_commit(&MPIU___COMPLEX128);CHKERRMPI(ierr); 869 #endif 870 ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRMPI(ierr); 871 ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRMPI(ierr); 872 #elif defined(PETSC_USE_REAL___FP16) 873 ierr = MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16);CHKERRMPI(ierr); 874 ierr = MPI_Type_commit(&MPIU___FP16);CHKERRMPI(ierr); 875 ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRMPI(ierr); 876 ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRMPI(ierr); 877 #endif 878 879 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 880 ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRMPI(ierr); 881 #endif 882 883 ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRMPI(ierr); 884 ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRMPI(ierr); 885 886 /* create datatypes used by MPIU_MAXLOC, MPIU_MINLOC and PetscSplitReduction_Op */ 887 #if !defined(PETSC_HAVE_MPIUNI) 888 { 889 struct PetscRealInt { PetscReal v; PetscInt i; }; 890 PetscMPIInt blockSizes[2] = {1,1}; 891 MPI_Aint blockOffsets[2] = {offsetof(struct PetscRealInt,v),offsetof(struct PetscRealInt,i)}; 892 MPI_Datatype blockTypes[2] = {MPIU_REAL,MPIU_INT}, tmpStruct; 893 894 ierr = MPI_Type_create_struct(2,blockSizes,blockOffsets,blockTypes,&tmpStruct);CHKERRMPI(ierr); 895 ierr = MPI_Type_create_resized(tmpStruct,0,sizeof(struct PetscRealInt),&MPIU_REAL_INT);CHKERRMPI(ierr); 896 ierr = MPI_Type_free(&tmpStruct);CHKERRMPI(ierr); 897 ierr = MPI_Type_commit(&MPIU_REAL_INT);CHKERRMPI(ierr); 898 } 899 { 900 struct PetscScalarInt { PetscScalar v; PetscInt i; }; 901 PetscMPIInt blockSizes[2] = {1,1}; 902 MPI_Aint blockOffsets[2] = {offsetof(struct PetscScalarInt,v),offsetof(struct PetscScalarInt,i)}; 903 MPI_Datatype blockTypes[2] = {MPIU_SCALAR,MPIU_INT}, tmpStruct; 904 905 ierr = MPI_Type_create_struct(2,blockSizes,blockOffsets,blockTypes,&tmpStruct);CHKERRMPI(ierr); 906 ierr = MPI_Type_create_resized(tmpStruct,0,sizeof(struct PetscScalarInt),&MPIU_SCALAR_INT);CHKERRMPI(ierr); 907 ierr = MPI_Type_free(&tmpStruct);CHKERRMPI(ierr); 908 ierr = MPI_Type_commit(&MPIU_SCALAR_INT);CHKERRMPI(ierr); 909 } 910 #endif 911 912 #if defined(PETSC_USE_64BIT_INDICES) 913 ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRMPI(ierr); 914 ierr = MPI_Type_commit(&MPIU_2INT);CHKERRMPI(ierr); 915 #endif 916 ierr = MPI_Type_contiguous(4,MPI_INT,&MPI_4INT);CHKERRMPI(ierr); 917 ierr = MPI_Type_commit(&MPI_4INT);CHKERRMPI(ierr); 918 ierr = MPI_Type_contiguous(4,MPIU_INT,&MPIU_4INT);CHKERRMPI(ierr); 919 ierr = MPI_Type_commit(&MPIU_4INT);CHKERRMPI(ierr); 920 921 /* 922 Attributes to be set on PETSc communicators 923 */ 924 ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_Counter_Attr_Delete_Fn,&Petsc_Counter_keyval,(void*)0);CHKERRMPI(ierr); 925 ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_InnerComm_Attr_Delete_Fn,&Petsc_InnerComm_keyval,(void*)0);CHKERRMPI(ierr); 926 ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_OuterComm_Attr_Delete_Fn,&Petsc_OuterComm_keyval,(void*)0);CHKERRMPI(ierr); 927 ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_ShmComm_Attr_Delete_Fn,&Petsc_ShmComm_keyval,(void*)0);CHKERRMPI(ierr); 928 929 #if defined(PETSC_HAVE_FORTRAN) 930 if (ftn) {ierr = PetscInitFortran_Private(readarguments,file,len);CHKERRQ(ierr);} 931 else 932 #endif 933 {ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,file);CHKERRQ(ierr);} 934 935 /* call a second time so it can look in the options database */ 936 ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr); 937 938 /* 939 Check system options and print help 940 */ 941 ierr = PetscOptionsCheckInitial_Private(help);CHKERRQ(ierr); 942 943 ierr = PetscCitationsInitialize();CHKERRQ(ierr); 944 945 #if defined(PETSC_HAVE_SAWS) 946 ierr = PetscInitializeSAWs(ftn ? NULL : help);CHKERRQ(ierr); 947 flg = PETSC_FALSE; 948 ierr = PetscOptionsHasName(NULL,NULL,"-stack_view",&flg);CHKERRQ(ierr); 949 if (flg) PetscStackViewSAWs(); 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);CHKERRMPI(ierr); 959 ierr = PetscInfo1(NULL,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr); 960 ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr); 961 ierr = PetscInfo1(NULL,"Running on machine: %s\n",hostname);CHKERRQ(ierr); 962 #if defined(PETSC_HAVE_OPENMP) 963 { 964 PetscBool omp_view_flag; 965 char *threads = getenv("OMP_NUM_THREADS"); 966 967 if (threads) { 968 ierr = PetscInfo1(NULL,"Number of OpenMP threads %s (given by OMP_NUM_THREADS)\n",threads);CHKERRQ(ierr); 969 (void) sscanf(threads, "%" PetscInt_FMT,&PetscNumOMPThreads); 970 } else { 971 #pragma omp parallel 972 #pragma omp master 973 { 974 PetscNumOMPThreads = (PetscInt) omp_get_num_threads(); 975 } 976 ierr = PetscInfo1(NULL,"Number of OpenMP threads %D (number not set with OMP_NUM_THREADS, chosen by system)\n",PetscNumOMPThreads);CHKERRQ(ierr); 977 } 978 ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"OpenMP options","Sys");CHKERRQ(ierr); 979 ierr = PetscOptionsInt("-omp_num_threads","Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS","None",PetscNumOMPThreads,&PetscNumOMPThreads,&flg);CHKERRQ(ierr); 980 ierr = PetscOptionsName("-omp_view","Display OpenMP number of threads",NULL,&omp_view_flag);CHKERRQ(ierr); 981 ierr = PetscOptionsEnd();CHKERRQ(ierr); 982 if (flg) { 983 ierr = PetscInfo1(NULL,"Number of OpenMP theads %D (given by -omp_num_threads)\n",PetscNumOMPThreads);CHKERRQ(ierr); 984 omp_set_num_threads((int)PetscNumOMPThreads); 985 } 986 if (omp_view_flag) { 987 ierr = PetscPrintf(PETSC_COMM_WORLD,"OpenMP: number of threads %D\n",PetscNumOMPThreads);CHKERRQ(ierr); 988 } 989 } 990 #endif 991 992 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32) 993 /* 994 Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI 995 996 Currently not used because it is not supported by MPICH. 997 */ 998 if (!PetscBinaryBigEndian()) { 999 ierr = MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);CHKERRMPI(ierr); 1000 } 1001 #endif 1002 1003 #if defined(PETSC_SERIALIZE_FUNCTIONS) 1004 ierr = PetscFPTCreate(10000);CHKERRQ(ierr); 1005 #endif 1006 1007 #if defined(PETSC_HAVE_HWLOC) 1008 { 1009 PetscViewer viewer; 1010 ierr = PetscOptionsGetViewer(PETSC_COMM_WORLD,NULL,NULL,"-process_view",&viewer,NULL,&flg);CHKERRQ(ierr); 1011 if (flg) { 1012 ierr = PetscProcessPlacementView(viewer);CHKERRQ(ierr); 1013 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1014 } 1015 } 1016 #endif 1017 1018 flg = PETSC_TRUE; 1019 ierr = PetscOptionsGetBool(NULL,NULL,"-viewfromoptions",&flg,NULL);CHKERRQ(ierr); 1020 if (!flg) {ierr = PetscOptionsPushGetViewerOff(PETSC_TRUE);CHKERRQ(ierr);} 1021 1022 #if defined(PETSC_HAVE_ADIOS) 1023 ierr = adios_init_noxml(PETSC_COMM_WORLD);CHKERRQ(ierr); 1024 ierr = adios_declare_group(&Petsc_adios_group,"PETSc","",adios_stat_default);CHKERRQ(ierr); 1025 ierr = adios_select_method(Petsc_adios_group,"MPI","","");CHKERRQ(ierr); 1026 ierr = adios_read_init_method(ADIOS_READ_METHOD_BP,PETSC_COMM_WORLD,"");CHKERRQ(ierr); 1027 #endif 1028 1029 #if defined(__VALGRIND_H) 1030 PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND? PETSC_TRUE: PETSC_FALSE; 1031 #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE) 1032 if (PETSC_RUNNING_ON_VALGRIND) { 1033 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING: Running valgrind with the MacOS native BLAS and LAPACK can fail. If it fails suggest configuring with --download-fblaslapack or --download-f2cblaslapack");CHKERRQ(ierr); 1034 } 1035 #endif 1036 #endif 1037 1038 #if (defined(PETSC_HAVE_CUDA) || defined(PETSC_HAVE_HIP)) && defined(PETSC_EXPERIMENTAL) 1039 ierr = PetscDeviceInitializeDefaultDevices_Internal();CHKERRQ(ierr); 1040 ierr = PetscDeviceContextInitializeRootContext_Internal(PETSC_COMM_WORLD,NULL);CHKERRQ(ierr); 1041 #endif 1042 1043 /* 1044 Set flag that we are completely initialized 1045 */ 1046 PetscInitializeCalled = PETSC_TRUE; 1047 1048 ierr = PetscOptionsHasName(NULL,NULL,"-python",&flg);CHKERRQ(ierr); 1049 if (flg) {ierr = PetscPythonInitialize(NULL,NULL);CHKERRQ(ierr);} 1050 PetscFunctionReturn(0); 1051 } 1052 1053 /*@C 1054 PetscInitialize - Initializes the PETSc database and MPI. 1055 PetscInitialize() calls MPI_Init() if that has yet to be called, 1056 so this routine should always be called near the beginning of 1057 your program -- usually the very first line! 1058 1059 Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set 1060 1061 Input Parameters: 1062 + argc - count of number of command line arguments 1063 . args - the command line arguments 1064 . file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format. 1065 Use NULL or empty string to not check for code specific file. 1066 Also checks ~/.petscrc, .petscrc and petscrc. 1067 Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files. 1068 - help - [optional] Help message to print, use NULL for no message 1069 1070 If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that 1071 communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a 1072 four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not, 1073 then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even 1074 if different subcommunicators of the job are doing different things with PETSc. 1075 1076 Options Database Keys: 1077 + -help [intro] - prints help method for each option; if intro is given the program stops after printing the introductory help message 1078 . -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger 1079 . -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected 1080 . -on_error_emacs <machinename> - causes emacsclient to jump to error file 1081 . -on_error_abort - calls abort() when error detected (no traceback) 1082 . -on_error_mpiabort - calls MPI_abort() when error detected 1083 . -error_output_stderr - prints error messages to stderr instead of the default stdout 1084 . -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called) 1085 . -debugger_ranks [rank1,rank2,...] - Indicates ranks to start in debugger 1086 . -debugger_pause [sleeptime] (in seconds) - Pauses debugger 1087 . -stop_for_debugger - Print message on how to attach debugger manually to 1088 process and wait (-debugger_pause) seconds for attachment 1089 . -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) (deprecated, use -malloc_debug) 1090 . -malloc no - Indicates not to use error-checking malloc (deprecated, use -malloc_debug no) 1091 . -malloc_debug - check for memory corruption at EVERY malloc or free, see PetscMallocSetDebug() 1092 . -malloc_dump - prints a list of all unfreed memory at the end of the run 1093 . -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds, ignored in optimized build. May want to set in PETSC_OPTIONS environmental variable 1094 . -malloc_view - show a list of all allocated memory during PetscFinalize() 1095 . -malloc_view_threshold <t> - only list memory allocations of size greater than t with -malloc_view 1096 . -malloc_requested_size - malloc logging will record the requested size rather than size after alignment 1097 . -fp_trap - Stops on floating point exceptions 1098 . -no_signal_handler - Indicates not to trap error signals 1099 . -shared_tmp - indicates /tmp directory is shared by all processors 1100 . -not_shared_tmp - each processor has own /tmp 1101 . -tmp - alternative name of /tmp directory 1102 . -get_total_flops - returns total flops done by all processors 1103 - -memory_view - Print memory usage at end of run 1104 1105 Options Database Keys for Option Database: 1106 + -skip_petscrc - skip the default option files ~/.petscrc, .petscrc, petscrc 1107 . -options_monitor - monitor all set options to standard output for the whole program run 1108 - -options_monitor_cancel - cancel options monitoring hard-wired using PetscOptionsMonitorSet() 1109 1110 Options -options_monitor_{all,cancel} are 1111 position-independent and apply to all options set since the PETSc start. 1112 They can be used also in option files. 1113 1114 See PetscOptionsMonitorSet() to do monitoring programmatically. 1115 1116 Options Database Keys for Profiling: 1117 See Users-Manual: ch_profiling for details. 1118 + -info [filename][:[~]<list,of,classnames>[:[~]self]] - Prints verbose information. See PetscInfo(). 1119 . -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event, 1120 however it slows things down and gives a distorted view of the overall runtime. 1121 . -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program 1122 hangs without running in the debugger). See PetscLogTraceBegin(). 1123 . -log_view [:filename:format] - Prints summary of flop and timing information to screen or file, see PetscLogView(). 1124 . -log_view_memory - Includes in the summary from -log_view the memory used in each method, see PetscLogView(). 1125 . -log_summary [filename] - (Deprecated, use -log_view) Prints summary of flop and timing information to screen. If the filename is specified the 1126 summary is written to the file. See PetscLogView(). 1127 . -log_exclude: <vec,mat,pc,ksp,snes> - excludes subset of object classes from logging 1128 . -log_all [filename] - Logs extensive profiling information See PetscLogDump(). 1129 . -log [filename] - Logs basic profiline information See PetscLogDump(). 1130 . -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution) 1131 . -viewfromoptions on,off - Enable or disable XXXSetFromOptions() calls, for applications with many small solves turn this off 1132 - -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code 1133 1134 Only one of -log_trace, -log_view, -log_view, -log_all, -log, or -log_mpe may be used at a time 1135 1136 Options Database Keys for SAWs: 1137 + -saws_port <portnumber> - port number to publish SAWs data, default is 8080 1138 . -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen 1139 this is useful when you are running many jobs that utilize SAWs at the same time 1140 . -saws_log <filename> - save a log of all SAWs communication 1141 . -saws_https <certificate file> - have SAWs use HTTPS instead of HTTP 1142 - -saws_root <directory> - allow SAWs to have access to the given directory to search for requested resources and files 1143 1144 Environmental Variables: 1145 + PETSC_TMP - alternative tmp directory 1146 . PETSC_SHARED_TMP - tmp is shared by all processes 1147 . PETSC_NOT_SHARED_TMP - each process has its own private tmp 1148 . PETSC_OPTIONS - a string containing additional options for petsc in the form of command line "-key value" pairs 1149 . PETSC_OPTIONS_YAML - (requires configuring PETSc to use libyaml) a string containing additional options for petsc in the form of a YAML document 1150 . PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer 1151 - PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to 1152 1153 Level: beginner 1154 1155 Notes: 1156 If for some reason you must call MPI_Init() separately, call 1157 it before PetscInitialize(). 1158 1159 Fortran Version: 1160 In Fortran this routine has the format 1161 $ call PetscInitialize(file,ierr) 1162 1163 + ierr - error return code 1164 - file - [optional] PETSc database file, also checks ~/.petscrc, .petscrc and petscrc. 1165 Use PETSC_NULL_CHARACTER to not check for code specific file. 1166 Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files. 1167 1168 Important Fortran Note: 1169 In Fortran, you MUST use PETSC_NULL_CHARACTER to indicate a 1170 null character string; you CANNOT just use NULL as 1171 in the C version. See Users-Manual: ch_fortran for details. 1172 1173 If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after 1174 calling PetscInitialize(). 1175 1176 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments() 1177 1178 @*/ 1179 PetscErrorCode PetscInitialize(int *argc,char ***args,const char file[],const char help[]) 1180 { 1181 PetscErrorCode ierr; 1182 PetscMPIInt flag; 1183 const char *prog = "Unknown Name"; 1184 1185 PetscFunctionBegin; 1186 if (PetscInitializeCalled) PetscFunctionReturn(0); 1187 ierr = MPI_Initialized(&flag);CHKERRMPI(ierr); 1188 if (!flag) { 1189 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"); 1190 ierr = PetscPreMPIInit_Private();CHKERRQ(ierr); 1191 #if defined(PETSC_HAVE_MPI_INIT_THREAD) 1192 { 1193 PetscMPIInt provided; 1194 ierr = MPI_Init_thread(argc,args,PETSC_MPI_THREAD_REQUIRED,&provided);CHKERRMPI(ierr); 1195 } 1196 #else 1197 ierr = MPI_Init(argc,args);CHKERRMPI(ierr); 1198 #endif 1199 PetscBeganMPI = PETSC_TRUE; 1200 } 1201 1202 if (argc && *argc) prog = **args; 1203 if (argc && args) { 1204 PetscGlobalArgc = *argc; 1205 PetscGlobalArgs = *args; 1206 } 1207 ierr = PetscInitialize_Common(prog,file,help,PETSC_FALSE/*C*/,PETSC_FALSE,0);CHKERRQ(ierr); 1208 PetscFunctionReturn(0); 1209 } 1210 1211 #if defined(PETSC_USE_LOG) 1212 PETSC_INTERN PetscObject *PetscObjects; 1213 PETSC_INTERN PetscInt PetscObjectsCounts; 1214 PETSC_INTERN PetscInt PetscObjectsMaxCounts; 1215 PETSC_INTERN PetscBool PetscObjectsLog; 1216 #endif 1217 1218 /* 1219 Frees all the MPI types and operations that PETSc may have created 1220 */ 1221 PetscErrorCode PetscFreeMPIResources(void) 1222 { 1223 PetscErrorCode ierr; 1224 1225 PetscFunctionBegin; 1226 #if defined(PETSC_USE_REAL___FLOAT128) 1227 ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRMPI(ierr); 1228 #if defined(PETSC_HAVE_COMPLEX) 1229 ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRMPI(ierr); 1230 #endif 1231 ierr = MPI_Op_free(&MPIU_MAX);CHKERRMPI(ierr); 1232 ierr = MPI_Op_free(&MPIU_MIN);CHKERRMPI(ierr); 1233 #elif defined(PETSC_USE_REAL___FP16) 1234 ierr = MPI_Type_free(&MPIU___FP16);CHKERRMPI(ierr); 1235 ierr = MPI_Op_free(&MPIU_MAX);CHKERRMPI(ierr); 1236 ierr = MPI_Op_free(&MPIU_MIN);CHKERRMPI(ierr); 1237 #endif 1238 1239 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 1240 ierr = MPI_Op_free(&MPIU_SUM);CHKERRMPI(ierr); 1241 #endif 1242 1243 ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRMPI(ierr); 1244 ierr = MPI_Type_free(&MPIU_REAL_INT);CHKERRMPI(ierr); 1245 ierr = MPI_Type_free(&MPIU_SCALAR_INT);CHKERRMPI(ierr); 1246 #if defined(PETSC_USE_64BIT_INDICES) 1247 ierr = MPI_Type_free(&MPIU_2INT);CHKERRMPI(ierr); 1248 #endif 1249 ierr = MPI_Type_free(&MPI_4INT);CHKERRMPI(ierr); 1250 ierr = MPI_Type_free(&MPIU_4INT);CHKERRMPI(ierr); 1251 ierr = MPI_Op_free(&MPIU_MAXSUM_OP);CHKERRMPI(ierr); 1252 PetscFunctionReturn(0); 1253 } 1254 1255 /*@C 1256 PetscFinalize - Checks for options to be called at the conclusion 1257 of the program. MPI_Finalize() is called only if the user had not 1258 called MPI_Init() before calling PetscInitialize(). 1259 1260 Collective on PETSC_COMM_WORLD 1261 1262 Options Database Keys: 1263 + -options_view - Calls PetscOptionsView() 1264 . -options_left - Prints unused options that remain in the database 1265 . -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 1266 . -mpidump - Calls PetscMPIDump() 1267 . -malloc_dump <optional filename> - Calls PetscMallocDump(), displays all memory allocated that has not been freed 1268 . -malloc_info - Prints total memory usage 1269 - -malloc_view <optional filename> - Prints list of all memory allocated and where 1270 1271 Level: beginner 1272 1273 Note: 1274 See PetscInitialize() for more general runtime options. 1275 1276 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd() 1277 @*/ 1278 PetscErrorCode PetscFinalize(void) 1279 { 1280 PetscErrorCode ierr; 1281 PetscMPIInt rank; 1282 PetscInt nopt; 1283 PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE; 1284 PetscBool flg; 1285 #if defined(PETSC_USE_LOG) 1286 char mname[PETSC_MAX_PATH_LEN]; 1287 #endif 1288 1289 PetscFunctionBegin; 1290 if (PetscUnlikely(!PetscInitializeCalled)) { 1291 fprintf(PETSC_STDOUT,"PetscInitialize() must be called before PetscFinalize()\n"); 1292 ierr = PetscStackView(PETSC_STDOUT);CHKERRQ(ierr); 1293 PetscStackClearTop; 1294 return PETSC_ERR_ARG_WRONGSTATE; 1295 } 1296 ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr); 1297 1298 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRMPI(ierr); 1299 #if defined(PETSC_HAVE_ADIOS) 1300 ierr = adios_read_finalize_method(ADIOS_READ_METHOD_BP_AGGREGATE);CHKERRQ(ierr); 1301 ierr = adios_finalize(rank);CHKERRQ(ierr); 1302 #endif 1303 ierr = PetscOptionsHasName(NULL,NULL,"-citations",&flg);CHKERRQ(ierr); 1304 if (flg) { 1305 char *cits, filename[PETSC_MAX_PATH_LEN]; 1306 FILE *fd = PETSC_STDOUT; 1307 1308 ierr = PetscOptionsGetString(NULL,NULL,"-citations",filename,sizeof(filename),NULL);CHKERRQ(ierr); 1309 if (filename[0]) { 1310 ierr = PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd);CHKERRQ(ierr); 1311 } 1312 ierr = PetscSegBufferGet(PetscCitationsList,1,&cits);CHKERRQ(ierr); 1313 cits[0] = 0; 1314 ierr = PetscSegBufferExtractAlloc(PetscCitationsList,&cits);CHKERRQ(ierr); 1315 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n");CHKERRQ(ierr); 1316 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 1317 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits);CHKERRQ(ierr); 1318 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 1319 ierr = PetscFClose(PETSC_COMM_WORLD,fd);CHKERRQ(ierr); 1320 ierr = PetscFree(cits);CHKERRQ(ierr); 1321 } 1322 ierr = PetscSegBufferDestroy(&PetscCitationsList);CHKERRQ(ierr); 1323 1324 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER) 1325 /* TextBelt is run for testing purposes only, please do not use this feature often */ 1326 { 1327 PetscInt nmax = 2; 1328 char **buffs; 1329 ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr); 1330 ierr = PetscOptionsGetStringArray(NULL,NULL,"-textbelt",buffs,&nmax,&flg1);CHKERRQ(ierr); 1331 if (flg1) { 1332 if (PetscUnlikely(!nmax)) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-textbelt requires either the phone number or number,\"message\""); 1333 if (nmax == 1) { 1334 ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr); 1335 ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr); 1336 ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr); 1337 } 1338 ierr = PetscTextBelt(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr); 1339 ierr = PetscFree(buffs[0]);CHKERRQ(ierr); 1340 ierr = PetscFree(buffs[1]);CHKERRQ(ierr); 1341 } 1342 ierr = PetscFree(buffs);CHKERRQ(ierr); 1343 } 1344 { 1345 PetscInt nmax = 2; 1346 char **buffs; 1347 ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr); 1348 ierr = PetscOptionsGetStringArray(NULL,NULL,"-tellmycell",buffs,&nmax,&flg1);CHKERRQ(ierr); 1349 if (flg1) { 1350 if (!nmax) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-tellmycell requires either the phone number or number,\"message\""); 1351 if (nmax == 1) { 1352 ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr); 1353 ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr); 1354 ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr); 1355 } 1356 ierr = PetscTellMyCell(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr); 1357 ierr = PetscFree(buffs[0]);CHKERRQ(ierr); 1358 ierr = PetscFree(buffs[1]);CHKERRQ(ierr); 1359 } 1360 ierr = PetscFree(buffs);CHKERRQ(ierr); 1361 } 1362 #endif 1363 1364 #if defined(PETSC_SERIALIZE_FUNCTIONS) 1365 ierr = PetscFPTDestroy();CHKERRQ(ierr); 1366 #endif 1367 1368 #if defined(PETSC_HAVE_SAWS) 1369 flg = PETSC_FALSE; 1370 ierr = PetscOptionsGetBool(NULL,NULL,"-saw_options",&flg,NULL);CHKERRQ(ierr); 1371 if (flg) { 1372 ierr = PetscOptionsSAWsDestroy();CHKERRQ(ierr); 1373 } 1374 #endif 1375 1376 #if defined(PETSC_HAVE_X) 1377 flg1 = PETSC_FALSE; 1378 ierr = PetscOptionsGetBool(NULL,NULL,"-x_virtual",&flg1,NULL);CHKERRQ(ierr); 1379 if (flg1) { 1380 /* this is a crude hack, but better than nothing */ 1381 ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 Xvfb","r",NULL);CHKERRQ(ierr); 1382 } 1383 #endif 1384 1385 #if !defined(PETSC_HAVE_THREADSAFETY) 1386 ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr); 1387 if (!flg2) { 1388 flg2 = PETSC_FALSE; 1389 ierr = PetscOptionsGetBool(NULL,NULL,"-memory_view",&flg2,NULL);CHKERRQ(ierr); 1390 } 1391 if (flg2) { 1392 ierr = PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr); 1393 } 1394 #endif 1395 1396 #if defined(PETSC_USE_LOG) 1397 flg1 = PETSC_FALSE; 1398 ierr = PetscOptionsGetBool(NULL,NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr); 1399 if (flg1) { 1400 PetscLogDouble flops = 0; 1401 ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRMPI(ierr); 1402 ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr); 1403 } 1404 #endif 1405 1406 #if defined(PETSC_USE_LOG) 1407 #if defined(PETSC_HAVE_MPE) 1408 mname[0] = 0; 1409 ierr = PetscOptionsGetString(NULL,NULL,"-log_mpe",mname,sizeof(mname),&flg1);CHKERRQ(ierr); 1410 if (flg1) { 1411 if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);} 1412 else {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);} 1413 } 1414 #endif 1415 #endif 1416 1417 /* 1418 Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_(). 1419 */ 1420 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1421 1422 #if defined(PETSC_USE_LOG) 1423 ierr = PetscOptionsPushGetViewerOff(PETSC_FALSE);CHKERRQ(ierr); 1424 ierr = PetscLogViewFromOptions();CHKERRQ(ierr); 1425 ierr = PetscOptionsPopGetViewerOff();CHKERRQ(ierr); 1426 1427 mname[0] = 0; 1428 ierr = PetscOptionsGetString(NULL,NULL,"-log_summary",mname,sizeof(mname),&flg1);CHKERRQ(ierr); 1429 if (flg1) { 1430 PetscViewer viewer; 1431 ierr = (*PetscHelpPrintf)(PETSC_COMM_WORLD,"\n\n WARNING: -log_summary is being deprecated; switch to -log_view\n\n\n");CHKERRQ(ierr); 1432 if (mname[0]) { 1433 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 1434 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1435 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1436 } else { 1437 viewer = PETSC_VIEWER_STDOUT_WORLD; 1438 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_DEFAULT);CHKERRQ(ierr); 1439 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1440 ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr); 1441 } 1442 } 1443 1444 /* 1445 Free any objects created by the last block of code. 1446 */ 1447 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1448 1449 mname[0] = 0; 1450 ierr = PetscOptionsGetString(NULL,NULL,"-log_all",mname,sizeof(mname),&flg1);CHKERRQ(ierr); 1451 ierr = PetscOptionsGetString(NULL,NULL,"-log",mname,sizeof(mname),&flg2);CHKERRQ(ierr); 1452 if (flg1 || flg2) {ierr = PetscLogDump(mname);CHKERRQ(ierr);} 1453 #endif 1454 1455 flg1 = PETSC_FALSE; 1456 ierr = PetscOptionsGetBool(NULL,NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr); 1457 if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);} 1458 flg1 = PETSC_FALSE; 1459 ierr = PetscOptionsGetBool(NULL,NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr); 1460 if (flg1) { 1461 ierr = PetscMPIDump(stdout);CHKERRQ(ierr); 1462 } 1463 flg1 = PETSC_FALSE; 1464 flg2 = PETSC_FALSE; 1465 /* preemptive call to avoid listing this option in options table as unused */ 1466 ierr = PetscOptionsHasName(NULL,NULL,"-malloc_dump",&flg1);CHKERRQ(ierr); 1467 ierr = PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1468 ierr = PetscOptionsGetBool(NULL,NULL,"-options_view",&flg2,NULL);CHKERRQ(ierr); 1469 1470 if (flg2) { 1471 PetscViewer viewer; 1472 ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1473 ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr); 1474 ierr = PetscOptionsView(NULL,viewer);CHKERRQ(ierr); 1475 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1476 } 1477 1478 /* to prevent PETSc -options_left from warning */ 1479 ierr = PetscOptionsHasName(NULL,NULL,"-nox",&flg1);CHKERRQ(ierr); 1480 ierr = PetscOptionsHasName(NULL,NULL,"-nox_warning",&flg1);CHKERRQ(ierr); 1481 1482 flg3 = PETSC_FALSE; /* default value is required */ 1483 ierr = PetscOptionsGetBool(NULL,NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr); 1484 if (PetscUnlikelyDebug(!flg1)) flg3 = PETSC_TRUE; 1485 if (flg3) { 1486 if (!flg2 && flg1) { /* have not yet printed the options */ 1487 PetscViewer viewer; 1488 ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1489 ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr); 1490 ierr = PetscOptionsView(NULL,viewer);CHKERRQ(ierr); 1491 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1492 } 1493 ierr = PetscOptionsAllUsed(NULL,&nopt);CHKERRQ(ierr); 1494 if (nopt) { 1495 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr); 1496 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr); 1497 if (nopt == 1) { 1498 ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr); 1499 } else { 1500 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr); 1501 } 1502 } else if (flg3 && flg1) { 1503 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr); 1504 } 1505 ierr = PetscOptionsLeft(NULL);CHKERRQ(ierr); 1506 } 1507 1508 #if defined(PETSC_HAVE_SAWS) 1509 if (!PetscGlobalRank) { 1510 ierr = PetscStackSAWsViewOff();CHKERRQ(ierr); 1511 PetscStackCallSAWs(SAWs_Finalize,()); 1512 } 1513 #endif 1514 1515 #if defined(PETSC_USE_LOG) 1516 /* 1517 List all objects the user may have forgot to free 1518 */ 1519 if (PetscObjectsLog) { 1520 ierr = PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1521 if (flg1) { 1522 MPI_Comm local_comm; 1523 char string[64]; 1524 1525 ierr = PetscOptionsGetString(NULL,NULL,"-objects_dump",string,sizeof(string),NULL);CHKERRQ(ierr); 1526 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRMPI(ierr); 1527 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1528 ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr); 1529 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1530 ierr = MPI_Comm_free(&local_comm);CHKERRMPI(ierr); 1531 } 1532 } 1533 #endif 1534 1535 #if defined(PETSC_USE_LOG) 1536 PetscObjectsCounts = 0; 1537 PetscObjectsMaxCounts = 0; 1538 ierr = PetscFree(PetscObjects);CHKERRQ(ierr); 1539 #endif 1540 1541 /* 1542 Destroy any packages that registered a finalize 1543 */ 1544 ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr); 1545 1546 #if defined(PETSC_USE_LOG) 1547 ierr = PetscLogFinalize();CHKERRQ(ierr); 1548 #endif 1549 1550 /* 1551 Print PetscFunctionLists that have not been properly freed 1552 1553 ierr = PetscFunctionListPrintAll();CHKERRQ(ierr); 1554 */ 1555 1556 if (petsc_history) { 1557 ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr); 1558 petsc_history = NULL; 1559 } 1560 ierr = PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton);CHKERRQ(ierr); 1561 ierr = PetscInfoDestroy();CHKERRQ(ierr); 1562 1563 #if !defined(PETSC_HAVE_THREADSAFETY) 1564 if (!(PETSC_RUNNING_ON_VALGRIND)) { 1565 char fname[PETSC_MAX_PATH_LEN]; 1566 char sname[PETSC_MAX_PATH_LEN]; 1567 FILE *fd; 1568 int err; 1569 1570 flg2 = PETSC_FALSE; 1571 flg3 = PETSC_FALSE; 1572 if (PetscDefined(USE_DEBUG)) {ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr);} 1573 ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_debug",&flg3,NULL);CHKERRQ(ierr); 1574 fname[0] = 0; 1575 ierr = PetscOptionsGetString(NULL,NULL,"-malloc_dump",fname,sizeof(fname),&flg1);CHKERRQ(ierr); 1576 if (flg1 && fname[0]) { 1577 1578 PetscSNPrintf(sname,sizeof(sname),"%s_%d",fname,rank); 1579 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1580 ierr = PetscMallocDump(fd);CHKERRQ(ierr); 1581 err = fclose(fd); 1582 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1583 } else if (flg1 || flg2 || flg3) { 1584 MPI_Comm local_comm; 1585 1586 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRMPI(ierr); 1587 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1588 ierr = PetscMallocDump(stdout);CHKERRQ(ierr); 1589 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1590 ierr = MPI_Comm_free(&local_comm);CHKERRMPI(ierr); 1591 } 1592 fname[0] = 0; 1593 ierr = PetscOptionsGetString(NULL,NULL,"-malloc_view",fname,sizeof(fname),&flg1);CHKERRQ(ierr); 1594 if (flg1 && fname[0]) { 1595 1596 PetscSNPrintf(sname,sizeof(sname),"%s_%d",fname,rank); 1597 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1598 ierr = PetscMallocView(fd);CHKERRQ(ierr); 1599 err = fclose(fd); 1600 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1601 } else if (flg1) { 1602 MPI_Comm local_comm; 1603 1604 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRMPI(ierr); 1605 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1606 ierr = PetscMallocView(stdout);CHKERRQ(ierr); 1607 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1608 ierr = MPI_Comm_free(&local_comm);CHKERRMPI(ierr); 1609 } 1610 } 1611 #endif 1612 1613 /* 1614 Close any open dynamic libraries 1615 */ 1616 ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr); 1617 1618 /* Can be destroyed only after all the options are used */ 1619 ierr = PetscOptionsDestroyDefault();CHKERRQ(ierr); 1620 1621 PetscGlobalArgc = 0; 1622 PetscGlobalArgs = NULL; 1623 1624 #if defined(PETSC_HAVE_KOKKOS) 1625 if (PetscBeganKokkos) { 1626 ierr = PetscKokkosFinalize_Private();CHKERRQ(ierr); 1627 PetscBeganKokkos = PETSC_FALSE; 1628 PetscKokkosInitialized = PETSC_FALSE; 1629 } 1630 #endif 1631 1632 #if defined(PETSC_HAVE_NVSHMEM) 1633 if (PetscBeganNvshmem) { 1634 ierr = PetscNvshmemFinalize();CHKERRQ(ierr); 1635 PetscBeganNvshmem = PETSC_FALSE; 1636 } 1637 #endif 1638 1639 #if defined(PETSC_HAVE_CUDA) 1640 if (PetscDefaultCudaStream) {cudaError_t cerr = cudaStreamDestroy(PetscDefaultCudaStream);CHKERRCUDA(cerr);} 1641 if (petsc_gputimer_begin) { 1642 cudaError_t cerr = cudaEventDestroy(petsc_gputimer_begin);CHKERRCUDA(cerr); 1643 } 1644 if (petsc_gputimer_end) { 1645 cudaError_t cerr = cudaEventDestroy(petsc_gputimer_end);CHKERRCUDA(cerr); 1646 } 1647 #endif 1648 1649 #if defined(PETSC_HAVE_HIP) 1650 if (PetscDefaultHipStream) {hipError_t cerr = hipStreamDestroy(PetscDefaultHipStream);CHKERRHIP(cerr);} 1651 if (petsc_gputimer_begin) { 1652 hipError_t cerr = hipEventDestroy(petsc_gputimer_begin);CHKERRHIP(cerr); 1653 } 1654 if (petsc_gputimer_end) { 1655 hipError_t cerr = hipEventDestroy(petsc_gputimer_end);CHKERRHIP(cerr); 1656 } 1657 #endif 1658 1659 ierr = PetscFreeMPIResources();CHKERRQ(ierr); 1660 1661 /* 1662 Destroy any known inner MPI_Comm's and attributes pointing to them 1663 Note this will not destroy any new communicators the user has created. 1664 1665 If all PETSc objects were not destroyed those left over objects will have hanging references to 1666 the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again 1667 */ 1668 { 1669 PetscCommCounter *counter; 1670 PetscMPIInt flg; 1671 MPI_Comm icomm; 1672 union {MPI_Comm comm; void *ptr;} ucomm; 1673 ierr = MPI_Comm_get_attr(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRMPI(ierr); 1674 if (flg) { 1675 icomm = ucomm.comm; 1676 ierr = MPI_Comm_get_attr(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRMPI(ierr); 1677 if (PetscUnlikely(!flg)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1678 1679 ierr = MPI_Comm_delete_attr(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRMPI(ierr); 1680 ierr = MPI_Comm_delete_attr(icomm,Petsc_Counter_keyval);CHKERRMPI(ierr); 1681 ierr = MPI_Comm_free(&icomm);CHKERRMPI(ierr); 1682 } 1683 ierr = MPI_Comm_get_attr(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRMPI(ierr); 1684 if (flg) { 1685 icomm = ucomm.comm; 1686 ierr = MPI_Comm_get_attr(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRMPI(ierr); 1687 if (PetscUnlikely(!flg)) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory"); 1688 1689 ierr = MPI_Comm_delete_attr(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRMPI(ierr); 1690 ierr = MPI_Comm_delete_attr(icomm,Petsc_Counter_keyval);CHKERRMPI(ierr); 1691 ierr = MPI_Comm_free(&icomm);CHKERRMPI(ierr); 1692 } 1693 } 1694 1695 ierr = MPI_Comm_free_keyval(&Petsc_Counter_keyval);CHKERRMPI(ierr); 1696 ierr = MPI_Comm_free_keyval(&Petsc_InnerComm_keyval);CHKERRMPI(ierr); 1697 ierr = MPI_Comm_free_keyval(&Petsc_OuterComm_keyval);CHKERRMPI(ierr); 1698 ierr = MPI_Comm_free_keyval(&Petsc_ShmComm_keyval);CHKERRMPI(ierr); 1699 1700 ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen);CHKERRQ(ierr); 1701 ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout);CHKERRQ(ierr); 1702 ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr);CHKERRQ(ierr); 1703 ierr = PetscSpinlockDestroy(&PetscCommSpinLock);CHKERRQ(ierr); 1704 1705 if (PetscBeganMPI) { 1706 #if defined(PETSC_HAVE_MPI_FINALIZED) 1707 PetscMPIInt flag; 1708 ierr = MPI_Finalized(&flag);CHKERRMPI(ierr); 1709 if (PetscUnlikely(flag)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()"); 1710 #endif 1711 ierr = MPI_Finalize();CHKERRMPI(ierr); 1712 } 1713 /* 1714 1715 Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because 1716 the communicator has some outstanding requests on it. Specifically if the 1717 flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See 1718 src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate() 1719 is never freed as it should be. Thus one may obtain messages of the form 1720 [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the 1721 memory was not freed. 1722 1723 */ 1724 ierr = PetscMallocClear();CHKERRQ(ierr); 1725 ierr = PetscStackReset();CHKERRQ(ierr); 1726 1727 PetscErrorHandlingInitialized = PETSC_FALSE; 1728 PetscInitializeCalled = PETSC_FALSE; 1729 PetscFinalizeCalled = PETSC_TRUE; 1730 #if defined(PETSC_USE_GCOV) 1731 /* 1732 flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the 1733 gcov files are still being added to the directories as git tries to remove the directories. 1734 */ 1735 __gcov_flush(); 1736 #endif 1737 /* To match PetscFunctionBegin() at the beginning of this function */ 1738 PetscStackClearTop; 1739 return 0; 1740 } 1741 1742 #if defined(PETSC_MISSING_LAPACK_lsame_) 1743 PETSC_EXTERN int lsame_(char *a,char *b) 1744 { 1745 if (*a == *b) return 1; 1746 if (*a + 32 == *b) return 1; 1747 if (*a - 32 == *b) return 1; 1748 return 0; 1749 } 1750 #endif 1751 1752 #if defined(PETSC_MISSING_LAPACK_lsame) 1753 PETSC_EXTERN int lsame(char *a,char *b) 1754 { 1755 if (*a == *b) return 1; 1756 if (*a + 32 == *b) return 1; 1757 if (*a - 32 == *b) return 1; 1758 return 0; 1759 } 1760 #endif 1761