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 'fortran' is true 690 help: program help message 691 fortran: 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 fortran,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 (fortran) {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(fortran ? 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(stderr,"PetscInitialize() must be called before PetscFinalize()\n"); 1292 ierr = PetscStackView(stderr);CHKERRQ(ierr); 1293 return PETSC_ERR_ARG_WRONGSTATE; 1294 } 1295 ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr); 1296 1297 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRMPI(ierr); 1298 #if defined(PETSC_HAVE_ADIOS) 1299 ierr = adios_read_finalize_method(ADIOS_READ_METHOD_BP_AGGREGATE);CHKERRQ(ierr); 1300 ierr = adios_finalize(rank);CHKERRQ(ierr); 1301 #endif 1302 ierr = PetscOptionsHasName(NULL,NULL,"-citations",&flg);CHKERRQ(ierr); 1303 if (flg) { 1304 char *cits, filename[PETSC_MAX_PATH_LEN]; 1305 FILE *fd = PETSC_STDOUT; 1306 1307 ierr = PetscOptionsGetString(NULL,NULL,"-citations",filename,sizeof(filename),NULL);CHKERRQ(ierr); 1308 if (filename[0]) { 1309 ierr = PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd);CHKERRQ(ierr); 1310 } 1311 ierr = PetscSegBufferGet(PetscCitationsList,1,&cits);CHKERRQ(ierr); 1312 cits[0] = 0; 1313 ierr = PetscSegBufferExtractAlloc(PetscCitationsList,&cits);CHKERRQ(ierr); 1314 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n");CHKERRQ(ierr); 1315 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 1316 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits);CHKERRQ(ierr); 1317 ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr); 1318 ierr = PetscFClose(PETSC_COMM_WORLD,fd);CHKERRQ(ierr); 1319 ierr = PetscFree(cits);CHKERRQ(ierr); 1320 } 1321 ierr = PetscSegBufferDestroy(&PetscCitationsList);CHKERRQ(ierr); 1322 1323 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER) 1324 /* TextBelt is run for testing purposes only, please do not use this feature often */ 1325 { 1326 PetscInt nmax = 2; 1327 char **buffs; 1328 ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr); 1329 ierr = PetscOptionsGetStringArray(NULL,NULL,"-textbelt",buffs,&nmax,&flg1);CHKERRQ(ierr); 1330 if (flg1) { 1331 if (PetscUnlikely(!nmax)) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-textbelt requires either the phone number or number,\"message\""); 1332 if (nmax == 1) { 1333 ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr); 1334 ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr); 1335 ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr); 1336 } 1337 ierr = PetscTextBelt(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr); 1338 ierr = PetscFree(buffs[0]);CHKERRQ(ierr); 1339 ierr = PetscFree(buffs[1]);CHKERRQ(ierr); 1340 } 1341 ierr = PetscFree(buffs);CHKERRQ(ierr); 1342 } 1343 { 1344 PetscInt nmax = 2; 1345 char **buffs; 1346 ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr); 1347 ierr = PetscOptionsGetStringArray(NULL,NULL,"-tellmycell",buffs,&nmax,&flg1);CHKERRQ(ierr); 1348 if (flg1) { 1349 if (!nmax) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-tellmycell requires either the phone number or number,\"message\""); 1350 if (nmax == 1) { 1351 ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr); 1352 ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr); 1353 ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr); 1354 } 1355 ierr = PetscTellMyCell(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr); 1356 ierr = PetscFree(buffs[0]);CHKERRQ(ierr); 1357 ierr = PetscFree(buffs[1]);CHKERRQ(ierr); 1358 } 1359 ierr = PetscFree(buffs);CHKERRQ(ierr); 1360 } 1361 #endif 1362 1363 #if defined(PETSC_SERIALIZE_FUNCTIONS) 1364 ierr = PetscFPTDestroy();CHKERRQ(ierr); 1365 #endif 1366 1367 #if defined(PETSC_HAVE_SAWS) 1368 flg = PETSC_FALSE; 1369 ierr = PetscOptionsGetBool(NULL,NULL,"-saw_options",&flg,NULL);CHKERRQ(ierr); 1370 if (flg) { 1371 ierr = PetscOptionsSAWsDestroy();CHKERRQ(ierr); 1372 } 1373 #endif 1374 1375 #if defined(PETSC_HAVE_X) 1376 flg1 = PETSC_FALSE; 1377 ierr = PetscOptionsGetBool(NULL,NULL,"-x_virtual",&flg1,NULL);CHKERRQ(ierr); 1378 if (flg1) { 1379 /* this is a crude hack, but better than nothing */ 1380 ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 Xvfb","r",NULL);CHKERRQ(ierr); 1381 } 1382 #endif 1383 1384 #if !defined(PETSC_HAVE_THREADSAFETY) 1385 ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr); 1386 if (!flg2) { 1387 flg2 = PETSC_FALSE; 1388 ierr = PetscOptionsGetBool(NULL,NULL,"-memory_view",&flg2,NULL);CHKERRQ(ierr); 1389 } 1390 if (flg2) { 1391 ierr = PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr); 1392 } 1393 #endif 1394 1395 #if defined(PETSC_USE_LOG) 1396 flg1 = PETSC_FALSE; 1397 ierr = PetscOptionsGetBool(NULL,NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr); 1398 if (flg1) { 1399 PetscLogDouble flops = 0; 1400 ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRMPI(ierr); 1401 ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr); 1402 } 1403 #endif 1404 1405 #if defined(PETSC_USE_LOG) 1406 #if defined(PETSC_HAVE_MPE) 1407 mname[0] = 0; 1408 ierr = PetscOptionsGetString(NULL,NULL,"-log_mpe",mname,sizeof(mname),&flg1);CHKERRQ(ierr); 1409 if (flg1) { 1410 if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);} 1411 else {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);} 1412 } 1413 #endif 1414 #endif 1415 1416 /* 1417 Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_(). 1418 */ 1419 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1420 1421 #if defined(PETSC_USE_LOG) 1422 ierr = PetscOptionsPushGetViewerOff(PETSC_FALSE);CHKERRQ(ierr); 1423 ierr = PetscLogViewFromOptions();CHKERRQ(ierr); 1424 ierr = PetscOptionsPopGetViewerOff();CHKERRQ(ierr); 1425 1426 mname[0] = 0; 1427 ierr = PetscOptionsGetString(NULL,NULL,"-log_summary",mname,sizeof(mname),&flg1);CHKERRQ(ierr); 1428 if (flg1) { 1429 PetscViewer viewer; 1430 ierr = (*PetscHelpPrintf)(PETSC_COMM_WORLD,"\n\n WARNING: -log_summary is being deprecated; switch to -log_view\n\n\n");CHKERRQ(ierr); 1431 if (mname[0]) { 1432 ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr); 1433 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1434 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1435 } else { 1436 viewer = PETSC_VIEWER_STDOUT_WORLD; 1437 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_DEFAULT);CHKERRQ(ierr); 1438 ierr = PetscLogView(viewer);CHKERRQ(ierr); 1439 ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr); 1440 } 1441 } 1442 1443 /* 1444 Free any objects created by the last block of code. 1445 */ 1446 ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr); 1447 1448 mname[0] = 0; 1449 ierr = PetscOptionsGetString(NULL,NULL,"-log_all",mname,sizeof(mname),&flg1);CHKERRQ(ierr); 1450 ierr = PetscOptionsGetString(NULL,NULL,"-log",mname,sizeof(mname),&flg2);CHKERRQ(ierr); 1451 if (flg1 || flg2) {ierr = PetscLogDump(mname);CHKERRQ(ierr);} 1452 #endif 1453 1454 flg1 = PETSC_FALSE; 1455 ierr = PetscOptionsGetBool(NULL,NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr); 1456 if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);} 1457 flg1 = PETSC_FALSE; 1458 ierr = PetscOptionsGetBool(NULL,NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr); 1459 if (flg1) { 1460 ierr = PetscMPIDump(stdout);CHKERRQ(ierr); 1461 } 1462 flg1 = PETSC_FALSE; 1463 flg2 = PETSC_FALSE; 1464 /* preemptive call to avoid listing this option in options table as unused */ 1465 ierr = PetscOptionsHasName(NULL,NULL,"-malloc_dump",&flg1);CHKERRQ(ierr); 1466 ierr = PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1467 ierr = PetscOptionsGetBool(NULL,NULL,"-options_view",&flg2,NULL);CHKERRQ(ierr); 1468 1469 if (flg2) { 1470 PetscViewer viewer; 1471 ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1472 ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr); 1473 ierr = PetscOptionsView(NULL,viewer);CHKERRQ(ierr); 1474 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1475 } 1476 1477 /* to prevent PETSc -options_left from warning */ 1478 ierr = PetscOptionsHasName(NULL,NULL,"-nox",&flg1);CHKERRQ(ierr); 1479 ierr = PetscOptionsHasName(NULL,NULL,"-nox_warning",&flg1);CHKERRQ(ierr); 1480 1481 flg3 = PETSC_FALSE; /* default value is required */ 1482 ierr = PetscOptionsGetBool(NULL,NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr); 1483 if (PetscUnlikelyDebug(!flg1)) flg3 = PETSC_TRUE; 1484 if (flg3) { 1485 if (!flg2 && flg1) { /* have not yet printed the options */ 1486 PetscViewer viewer; 1487 ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr); 1488 ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr); 1489 ierr = PetscOptionsView(NULL,viewer);CHKERRQ(ierr); 1490 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 1491 } 1492 ierr = PetscOptionsAllUsed(NULL,&nopt);CHKERRQ(ierr); 1493 if (nopt) { 1494 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr); 1495 ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr); 1496 if (nopt == 1) { 1497 ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr); 1498 } else { 1499 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr); 1500 } 1501 } else if (flg3 && flg1) { 1502 ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr); 1503 } 1504 ierr = PetscOptionsLeft(NULL);CHKERRQ(ierr); 1505 } 1506 1507 #if defined(PETSC_HAVE_SAWS) 1508 if (!PetscGlobalRank) { 1509 ierr = PetscStackSAWsViewOff();CHKERRQ(ierr); 1510 PetscStackCallSAWs(SAWs_Finalize,()); 1511 } 1512 #endif 1513 1514 #if defined(PETSC_USE_LOG) 1515 /* 1516 List all objects the user may have forgot to free 1517 */ 1518 if (PetscObjectsLog) { 1519 ierr = PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1);CHKERRQ(ierr); 1520 if (flg1) { 1521 MPI_Comm local_comm; 1522 char string[64]; 1523 1524 ierr = PetscOptionsGetString(NULL,NULL,"-objects_dump",string,sizeof(string),NULL);CHKERRQ(ierr); 1525 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRMPI(ierr); 1526 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1527 ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr); 1528 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1529 ierr = MPI_Comm_free(&local_comm);CHKERRMPI(ierr); 1530 } 1531 } 1532 #endif 1533 1534 #if defined(PETSC_USE_LOG) 1535 PetscObjectsCounts = 0; 1536 PetscObjectsMaxCounts = 0; 1537 ierr = PetscFree(PetscObjects);CHKERRQ(ierr); 1538 #endif 1539 1540 /* 1541 Destroy any packages that registered a finalize 1542 */ 1543 ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr); 1544 1545 #if defined(PETSC_USE_LOG) 1546 ierr = PetscLogFinalize();CHKERRQ(ierr); 1547 #endif 1548 1549 /* 1550 Print PetscFunctionLists that have not been properly freed 1551 1552 ierr = PetscFunctionListPrintAll();CHKERRQ(ierr); 1553 */ 1554 1555 if (petsc_history) { 1556 ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr); 1557 petsc_history = NULL; 1558 } 1559 ierr = PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton);CHKERRQ(ierr); 1560 ierr = PetscInfoDestroy();CHKERRQ(ierr); 1561 1562 #if !defined(PETSC_HAVE_THREADSAFETY) 1563 if (!(PETSC_RUNNING_ON_VALGRIND)) { 1564 char fname[PETSC_MAX_PATH_LEN]; 1565 char sname[PETSC_MAX_PATH_LEN]; 1566 FILE *fd; 1567 int err; 1568 1569 flg2 = PETSC_FALSE; 1570 flg3 = PETSC_FALSE; 1571 if (PetscDefined(USE_DEBUG)) {ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr);} 1572 ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_debug",&flg3,NULL);CHKERRQ(ierr); 1573 fname[0] = 0; 1574 ierr = PetscOptionsGetString(NULL,NULL,"-malloc_dump",fname,sizeof(fname),&flg1);CHKERRQ(ierr); 1575 if (flg1 && fname[0]) { 1576 1577 PetscSNPrintf(sname,sizeof(sname),"%s_%d",fname,rank); 1578 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1579 ierr = PetscMallocDump(fd);CHKERRQ(ierr); 1580 err = fclose(fd); 1581 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1582 } else if (flg1 || flg2 || flg3) { 1583 MPI_Comm local_comm; 1584 1585 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRMPI(ierr); 1586 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1587 ierr = PetscMallocDump(stdout);CHKERRQ(ierr); 1588 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1589 ierr = MPI_Comm_free(&local_comm);CHKERRMPI(ierr); 1590 } 1591 fname[0] = 0; 1592 ierr = PetscOptionsGetString(NULL,NULL,"-malloc_view",fname,sizeof(fname),&flg1);CHKERRQ(ierr); 1593 if (flg1 && fname[0]) { 1594 1595 PetscSNPrintf(sname,sizeof(sname),"%s_%d",fname,rank); 1596 fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname); 1597 ierr = PetscMallocView(fd);CHKERRQ(ierr); 1598 err = fclose(fd); 1599 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file"); 1600 } else if (flg1) { 1601 MPI_Comm local_comm; 1602 1603 ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRMPI(ierr); 1604 ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr); 1605 ierr = PetscMallocView(stdout);CHKERRQ(ierr); 1606 ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr); 1607 ierr = MPI_Comm_free(&local_comm);CHKERRMPI(ierr); 1608 } 1609 } 1610 #endif 1611 1612 /* 1613 Close any open dynamic libraries 1614 */ 1615 ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr); 1616 1617 /* Can be destroyed only after all the options are used */ 1618 ierr = PetscOptionsDestroyDefault();CHKERRQ(ierr); 1619 1620 PetscGlobalArgc = 0; 1621 PetscGlobalArgs = NULL; 1622 1623 #if defined(PETSC_HAVE_KOKKOS) 1624 if (PetscBeganKokkos) { 1625 ierr = PetscKokkosFinalize_Private();CHKERRQ(ierr); 1626 PetscBeganKokkos = PETSC_FALSE; 1627 PetscKokkosInitialized = PETSC_FALSE; 1628 } 1629 #endif 1630 1631 #if defined(PETSC_HAVE_NVSHMEM) 1632 if (PetscBeganNvshmem) { 1633 ierr = PetscNvshmemFinalize();CHKERRQ(ierr); 1634 PetscBeganNvshmem = PETSC_FALSE; 1635 } 1636 #endif 1637 1638 #if defined(PETSC_HAVE_CUDA) 1639 if (PetscDefaultCudaStream) {cudaError_t cerr = cudaStreamDestroy(PetscDefaultCudaStream);CHKERRCUDA(cerr);} 1640 if (petsc_gputimer_begin) { 1641 cudaError_t cerr = cudaEventDestroy(petsc_gputimer_begin);CHKERRCUDA(cerr); 1642 } 1643 if (petsc_gputimer_end) { 1644 cudaError_t cerr = cudaEventDestroy(petsc_gputimer_end);CHKERRCUDA(cerr); 1645 } 1646 #endif 1647 1648 #if defined(PETSC_HAVE_HIP) 1649 if (PetscDefaultHipStream) {hipError_t cerr = hipStreamDestroy(PetscDefaultHipStream);CHKERRHIP(cerr);} 1650 if (petsc_gputimer_begin) { 1651 hipError_t cerr = hipEventDestroy(petsc_gputimer_begin);CHKERRHIP(cerr); 1652 } 1653 if (petsc_gputimer_end) { 1654 hipError_t cerr = hipEventDestroy(petsc_gputimer_end);CHKERRHIP(cerr); 1655 } 1656 #endif 1657 1658 ierr = PetscFreeMPIResources();CHKERRQ(ierr); 1659 1660 /* 1661 Destroy any known inner MPI_Comm's and attributes pointing to them 1662 Note this will not destroy any new communicators the user has created. 1663 1664 If all PETSc objects were not destroyed those left over objects will have hanging references to 1665 the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again 1666 */ 1667 { 1668 PetscCommCounter *counter; 1669 PetscMPIInt flg; 1670 MPI_Comm icomm; 1671 union {MPI_Comm comm; void *ptr;} ucomm; 1672 ierr = MPI_Comm_get_attr(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRMPI(ierr); 1673 if (flg) { 1674 icomm = ucomm.comm; 1675 ierr = MPI_Comm_get_attr(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRMPI(ierr); 1676 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"); 1677 1678 ierr = MPI_Comm_delete_attr(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRMPI(ierr); 1679 ierr = MPI_Comm_delete_attr(icomm,Petsc_Counter_keyval);CHKERRMPI(ierr); 1680 ierr = MPI_Comm_free(&icomm);CHKERRMPI(ierr); 1681 } 1682 ierr = MPI_Comm_get_attr(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRMPI(ierr); 1683 if (flg) { 1684 icomm = ucomm.comm; 1685 ierr = MPI_Comm_get_attr(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRMPI(ierr); 1686 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"); 1687 1688 ierr = MPI_Comm_delete_attr(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRMPI(ierr); 1689 ierr = MPI_Comm_delete_attr(icomm,Petsc_Counter_keyval);CHKERRMPI(ierr); 1690 ierr = MPI_Comm_free(&icomm);CHKERRMPI(ierr); 1691 } 1692 } 1693 1694 ierr = MPI_Comm_free_keyval(&Petsc_Counter_keyval);CHKERRMPI(ierr); 1695 ierr = MPI_Comm_free_keyval(&Petsc_InnerComm_keyval);CHKERRMPI(ierr); 1696 ierr = MPI_Comm_free_keyval(&Petsc_OuterComm_keyval);CHKERRMPI(ierr); 1697 ierr = MPI_Comm_free_keyval(&Petsc_ShmComm_keyval);CHKERRMPI(ierr); 1698 1699 ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen);CHKERRQ(ierr); 1700 ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout);CHKERRQ(ierr); 1701 ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr);CHKERRQ(ierr); 1702 ierr = PetscSpinlockDestroy(&PetscCommSpinLock);CHKERRQ(ierr); 1703 1704 if (PetscBeganMPI) { 1705 #if defined(PETSC_HAVE_MPI_FINALIZED) 1706 PetscMPIInt flag; 1707 ierr = MPI_Finalized(&flag);CHKERRMPI(ierr); 1708 if (PetscUnlikely(flag)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()"); 1709 #endif 1710 ierr = MPI_Finalize();CHKERRMPI(ierr); 1711 } 1712 /* 1713 1714 Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because 1715 the communicator has some outstanding requests on it. Specifically if the 1716 flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See 1717 src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate() 1718 is never freed as it should be. Thus one may obtain messages of the form 1719 [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the 1720 memory was not freed. 1721 1722 */ 1723 ierr = PetscMallocClear();CHKERRQ(ierr); 1724 ierr = PetscStackReset();CHKERRQ(ierr); 1725 1726 PetscErrorHandlingInitialized = PETSC_FALSE; 1727 PetscInitializeCalled = PETSC_FALSE; 1728 PetscFinalizeCalled = PETSC_TRUE; 1729 #if defined(PETSC_USE_GCOV) 1730 /* 1731 flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the 1732 gcov files are still being added to the directories as git tries to remove the directories. 1733 */ 1734 __gcov_flush(); 1735 #endif 1736 return 0; 1737 } 1738 1739 #if defined(PETSC_MISSING_LAPACK_lsame_) 1740 PETSC_EXTERN int lsame_(char *a,char *b) 1741 { 1742 if (*a == *b) return 1; 1743 if (*a + 32 == *b) return 1; 1744 if (*a - 32 == *b) return 1; 1745 return 0; 1746 } 1747 #endif 1748 1749 #if defined(PETSC_MISSING_LAPACK_lsame) 1750 PETSC_EXTERN int lsame(char *a,char *b) 1751 { 1752 if (*a == *b) return 1; 1753 if (*a + 32 == *b) return 1; 1754 if (*a - 32 == *b) return 1; 1755 return 0; 1756 } 1757 #endif 1758