1 /* 2 Utilities routines to add simple ASCII IO capability. 3 */ 4 #include <../src/sys/fileio/mprint.h> 5 #include <errno.h> 6 /* 7 If petsc_history is on, then all Petsc*Printf() results are saved 8 if the appropriate (usually .petschistory) file. 9 */ 10 PETSC_INTERN FILE *petsc_history; 11 /* 12 Allows one to overwrite where standard out is sent. For example 13 PETSC_STDOUT = fopen("/dev/ttyXX","w") will cause all standard out 14 writes to go to terminal XX; assuming you have write permission there 15 */ 16 FILE *PETSC_STDOUT = NULL; 17 /* 18 Allows one to overwrite where standard error is sent. For example 19 PETSC_STDERR = fopen("/dev/ttyXX","w") will cause all standard error 20 writes to go to terminal XX; assuming you have write permission there 21 */ 22 FILE *PETSC_STDERR = NULL; 23 24 /*@C 25 PetscFormatConvertGetSize - Gets the length of a string needed to hold data converted with `PetscFormatConvert()` based on format 26 27 No Fortran Support 28 29 Input Parameter: 30 . format - the PETSc format string 31 32 Output Parameter: 33 . size - the needed length of the new format 34 35 Level: developer 36 37 .seealso: `PetscFormatConvert()`, `PetscVSNPrintf()`, `PetscVFPrintf()` 38 @*/ 39 PetscErrorCode PetscFormatConvertGetSize(const char *format, size_t *size) 40 { 41 size_t sz = 0; 42 PetscInt i = 0; 43 44 PetscFunctionBegin; 45 PetscValidCharPointer(format, 1); 46 PetscValidPointer(size, 2); 47 while (format[i]) { 48 if (format[i] == '%') { 49 if (format[i + 1] == '%') { 50 i += 2; 51 sz += 2; 52 continue; 53 } 54 /* Find the letter */ 55 while (format[i] && (format[i] <= '9')) { 56 ++i; 57 ++sz; 58 } 59 switch (format[i]) { 60 #if PetscDefined(USE_64BIT_INDICES) 61 case 'D': 62 sz += 2; 63 break; 64 #endif 65 case 'g': 66 sz += 4; 67 default: 68 break; 69 } 70 } 71 ++i; 72 ++sz; 73 } 74 *size = sz + 1; /* space for NULL character */ 75 PetscFunctionReturn(PETSC_SUCCESS); 76 } 77 78 /*@C 79 PetscFormatConvert - converts %g to [|%g|] so that `PetscVSNPrintf()` can ensure all %g formatted numbers have a decimal point when printed. The 80 decimal point is then used by the `petscdiff` script so that differences in floating point number output is ignored in the test harness. 81 82 No Fortran Support 83 84 Input Parameters: 85 + format - the PETSc format string 86 . newformat - the location to put the new format 87 - size - the length of newformat, you can use `PetscFormatConvertGetSize()` to compute the needed size 88 89 Level: developer 90 91 Note: 92 Deprecated usage also converts the %D to %d for 32 bit PETSc indices and %lld for 64 bit PETSc indices. This feature is no 93 longer used in PETSc code instead use %" PetscInt_FMT " in the format string 94 95 .seealso: `PetscFormatConvertGetSize()`, `PetscVSNPrintf()`, `PetscVFPrintf()` 96 @*/ 97 PetscErrorCode PetscFormatConvert(const char *format, char *newformat) 98 { 99 PetscInt i = 0, j = 0; 100 101 PetscFunctionBegin; 102 while (format[i]) { 103 if (format[i] == '%' && format[i + 1] == '%') { 104 newformat[j++] = format[i++]; 105 newformat[j++] = format[i++]; 106 } else if (format[i] == '%') { 107 if (format[i + 1] == 'g') { 108 newformat[j++] = '['; 109 newformat[j++] = '|'; 110 } 111 /* Find the letter */ 112 for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i]; 113 switch (format[i]) { 114 case 'D': 115 #if !defined(PETSC_USE_64BIT_INDICES) 116 newformat[j++] = 'd'; 117 #else 118 newformat[j++] = 'l'; 119 newformat[j++] = 'l'; 120 newformat[j++] = 'd'; 121 #endif 122 break; 123 case 'g': 124 newformat[j++] = format[i]; 125 if (format[i - 1] == '%') { 126 newformat[j++] = '|'; 127 newformat[j++] = ']'; 128 } 129 break; 130 case 'G': 131 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "%%G format is no longer supported, use %%g and cast the argument to double"); 132 case 'F': 133 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "%%F format is no longer supported, use %%f and cast the argument to double"); 134 default: 135 newformat[j++] = format[i]; 136 break; 137 } 138 i++; 139 } else newformat[j++] = format[i++]; 140 } 141 newformat[j] = 0; 142 PetscFunctionReturn(PETSC_SUCCESS); 143 } 144 145 #define PETSCDEFAULTBUFFERSIZE 8 * 1024 146 147 /*@C 148 PetscVSNPrintf - The PETSc version of `vsnprintf()`. Ensures that all `%g` formatted arguments' output contains the decimal point (which 149 is used by the test harness) 150 151 Input Parameters: 152 + str - location to put result 153 . len - the amount of space in str 154 + format - the PETSc format string 155 - fullLength - the amount of space in str actually used. 156 157 Level: developer 158 159 Developer Note: 160 This function may be called from an error handler, if an error occurs when it is called by the error handler than likely 161 a recursion will occur resulting in a crash of the program. 162 163 If the length of the format string `format` is on the order of `PETSCDEFAULTBUFFERSIZE` (8 * 1024 bytes), this function will call `PetscMalloc()` 164 165 .seealso: `PetscFormatConvert()`, `PetscFormatConvertGetSize()`, `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscVPrintf()` 166 @*/ 167 PetscErrorCode PetscVSNPrintf(char *str, size_t len, const char *format, size_t *fullLength, va_list Argp) 168 { 169 char *newformat = NULL; 170 char formatbuf[PETSCDEFAULTBUFFERSIZE]; 171 size_t newLength; 172 int flen; 173 174 PetscFunctionBegin; 175 PetscCall(PetscFormatConvertGetSize(format, &newLength)); 176 if (newLength < sizeof(formatbuf)) { 177 newformat = formatbuf; 178 newLength = sizeof(formatbuf) - 1; 179 } else { 180 PetscCall(PetscMalloc1(newLength, &newformat)); 181 } 182 PetscCall(PetscFormatConvert(format, newformat)); 183 #if defined(PETSC_HAVE_VSNPRINTF) 184 flen = vsnprintf(str, len, newformat, Argp); 185 #else 186 #error "vsnprintf not found" 187 #endif 188 if (newLength > sizeof(formatbuf) - 1) PetscCall(PetscFree(newformat)); 189 { 190 PetscBool foundedot; 191 size_t cnt = 0, ncnt = 0, leng; 192 PetscCall(PetscStrlen(str, &leng)); 193 if (leng > 4) { 194 for (cnt = 0; cnt < leng - 4; cnt++) { 195 if (str[cnt] == '[' && str[cnt + 1] == '|') { 196 flen -= 4; 197 cnt++; 198 cnt++; 199 foundedot = PETSC_FALSE; 200 for (; cnt < leng - 1; cnt++) { 201 if (str[cnt] == '|' && str[cnt + 1] == ']') { 202 cnt++; 203 if (!foundedot) str[ncnt++] = '.'; 204 ncnt--; 205 break; 206 } else { 207 if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE; 208 str[ncnt++] = str[cnt]; 209 } 210 } 211 } else { 212 str[ncnt] = str[cnt]; 213 } 214 ncnt++; 215 } 216 while (cnt < leng) { 217 str[ncnt] = str[cnt]; 218 ncnt++; 219 cnt++; 220 } 221 str[ncnt] = 0; 222 } 223 } 224 #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT) 225 /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */ 226 { 227 size_t cnt = 0, ncnt = 0, leng; 228 PetscCall(PetscStrlen(str, &leng)); 229 if (leng > 5) { 230 for (cnt = 0; cnt < leng - 4; cnt++) { 231 if (str[cnt] == 'e' && (str[cnt + 1] == '-' || str[cnt + 1] == '+') && str[cnt + 2] == '0' && str[cnt + 3] >= '0' && str[cnt + 3] <= '9' && str[cnt + 4] >= '0' && str[cnt + 4] <= '9') { 232 str[ncnt] = str[cnt]; 233 ncnt++; 234 cnt++; 235 str[ncnt] = str[cnt]; 236 ncnt++; 237 cnt++; 238 cnt++; 239 str[ncnt] = str[cnt]; 240 } else { 241 str[ncnt] = str[cnt]; 242 } 243 ncnt++; 244 } 245 while (cnt < leng) { 246 str[ncnt] = str[cnt]; 247 ncnt++; 248 cnt++; 249 } 250 str[ncnt] = 0; 251 } 252 } 253 #endif 254 if (fullLength) *fullLength = 1 + (size_t)flen; 255 PetscFunctionReturn(PETSC_SUCCESS); 256 } 257 258 /*@C 259 PetscFFlush - Flush a file stream 260 261 Input Parameter: 262 . fd - The file stream handle 263 264 Level: intermediate 265 266 Notes: 267 For output streams (and for update streams on which the last operation was output), writes 268 any unwritten data from the stream's buffer to the associated output device. 269 270 For input streams (and for update streams on which the last operation was input), the 271 behavior is undefined. 272 273 If `fd` is `NULL`, all open output streams are flushed, including ones not directly 274 accessible to the program. 275 276 .seealso: `PetscPrintf()`, `PetscFPrintf()`, `PetscVFPrintf()`, `PetscVSNPrintf()` 277 @*/ 278 PetscErrorCode PetscFFlush(FILE *fd) 279 { 280 int ret; 281 282 PetscFunctionBegin; 283 if (fd) PetscValidPointer(fd, 1); 284 ret = fflush(fd); 285 // could also use PetscCallExternal() here, but since we can get additional error explanation 286 // from strerror() we opted for a manual check 287 PetscCheck(ret == 0, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error in fflush(): error code %d (%s)", ret, strerror(errno)); 288 PetscFunctionReturn(PETSC_SUCCESS); 289 } 290 291 /*@C 292 PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can 293 can be replaced with something that does not simply write to a file. 294 295 To use, write your own function for example, 296 .vb 297 PetscErrorCode mypetscvfprintf(FILE *fd, const char format[], va_list Argp) 298 { 299 PetscErrorCode ierr; 300 301 PetscFunctionBegin; 302 if (fd != stdout && fd != stderr) { handle regular files 303 CHKERR(PetscVFPrintfDefault(fd,format,Argp)); 304 } else { 305 char buff[BIG]; 306 size_t length; 307 PetscCall(PetscVSNPrintf(buff,BIG,format,&length,Argp)); 308 now send buff to whatever stream or whatever you want 309 } 310 PetscFunctionReturn(PETSC_SUCCESS); 311 } 312 .ve 313 then before the call to `PetscInitialize()` do the assignment `PetscVFPrintf = mypetscvfprintf`; 314 315 Level: developer 316 317 Note: 318 For error messages this may be called by any process, for regular standard out it is 319 called only by process 0 of a given communicator 320 321 Developer Note: 322 This could be called by an error handler, if that happens then a recursion of the error handler may occur 323 and a resulting crash 324 325 .seealso: `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscFFlush()` 326 @*/ 327 PetscErrorCode PetscVFPrintfDefault(FILE *fd, const char *format, va_list Argp) 328 { 329 char str[PETSCDEFAULTBUFFERSIZE]; 330 char *buff = str; 331 size_t fullLength; 332 #if defined(PETSC_HAVE_VA_COPY) 333 va_list Argpcopy; 334 #endif 335 336 PetscFunctionBegin; 337 #if defined(PETSC_HAVE_VA_COPY) 338 va_copy(Argpcopy, Argp); 339 #endif 340 PetscCall(PetscVSNPrintf(str, sizeof(str), format, &fullLength, Argp)); 341 if (fullLength > sizeof(str)) { 342 PetscCall(PetscMalloc1(fullLength, &buff)); 343 #if defined(PETSC_HAVE_VA_COPY) 344 PetscCall(PetscVSNPrintf(buff, fullLength, format, NULL, Argpcopy)); 345 #else 346 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "C89 does not support va_copy() hence cannot print long strings with PETSc printing routines"); 347 #endif 348 } 349 #if defined(PETSC_HAVE_VA_COPY) 350 va_end(Argpcopy); 351 #endif 352 { 353 const int err = fprintf(fd, "%s", buff); 354 // cannot use PetscCallExternal() for fprintf since the return value is "number of 355 // characters transmitted to the output stream" on success 356 PetscCheck(err >= 0, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "fprintf() returned error code %d", err); 357 } 358 PetscCall(PetscFFlush(fd)); 359 if (buff != str) PetscCall(PetscFree(buff)); 360 PetscFunctionReturn(PETSC_SUCCESS); 361 } 362 363 /*@C 364 PetscSNPrintf - Prints to a string of given length 365 366 Not Collective 367 368 Input Parameters: 369 + str - the string to print to 370 . len - the length of `str` 371 . format - the usual `printf()` format string 372 - ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument 373 374 Level: intermediate 375 376 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`, 377 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, 378 `PetscVFPrintf()`, `PetscFFlush()` 379 @*/ 380 PetscErrorCode PetscSNPrintf(char *str, size_t len, const char format[], ...) 381 { 382 size_t fullLength; 383 va_list Argp; 384 385 PetscFunctionBegin; 386 va_start(Argp, format); 387 PetscCall(PetscVSNPrintf(str, len, format, &fullLength, Argp)); 388 va_end(Argp); 389 PetscFunctionReturn(PETSC_SUCCESS); 390 } 391 392 /*@C 393 PetscSNPrintfCount - Prints to a string of given length, returns count of characters printed 394 395 Not Collective 396 397 Input Parameters: 398 + str - the string to print to 399 . len - the length of `str` 400 . format - the usual `printf()` format string 401 - ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument 402 403 Output Parameter: 404 . countused - number of characters printed 405 406 Level: intermediate 407 408 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`, 409 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscSNPrintf()`, `PetscVFPrintf()` 410 @*/ 411 PetscErrorCode PetscSNPrintfCount(char *str, size_t len, const char format[], size_t *countused, ...) 412 { 413 va_list Argp; 414 415 PetscFunctionBegin; 416 va_start(Argp, countused); 417 PetscCall(PetscVSNPrintf(str, len, format, countused, Argp)); 418 va_end(Argp); 419 PetscFunctionReturn(PETSC_SUCCESS); 420 } 421 422 PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL; 423 int petsc_printfqueuelength = 0; 424 425 static inline PetscErrorCode PetscVFPrintf_Private(MPI_Comm comm, FILE *fd, const char format[], va_list Argp) 426 { 427 const PetscBool tee = (PetscBool)(petsc_history && (fd != petsc_history)); 428 PetscMPIInt rank; 429 va_list cpy; 430 431 PetscFunctionBegin; 432 PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 433 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 434 if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS); 435 // must do this before we possibly consume Argp 436 if (tee) va_copy(cpy, Argp); 437 PetscCall((*PetscVFPrintf)(fd, format, Argp)); 438 if (tee) { 439 PetscCall((*PetscVFPrintf)(petsc_history, format, cpy)); 440 va_end(cpy); 441 } 442 PetscFunctionReturn(PETSC_SUCCESS); 443 } 444 445 static inline PetscErrorCode PetscSynchronizedFPrintf_Private(MPI_Comm comm, FILE *fp, const char format[], va_list Argp) 446 { 447 PetscMPIInt rank; 448 va_list cpy; 449 450 PetscFunctionBegin; 451 PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 452 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 453 /* First processor prints immediately to fp */ 454 if (rank == 0) { 455 va_copy(cpy, Argp); 456 PetscCall(PetscVFPrintf_Private(comm, fp, format, cpy)); 457 va_end(cpy); 458 } else { /* other processors add to local queue */ 459 PrintfQueue next; 460 size_t fullLength = PETSCDEFAULTBUFFERSIZE; 461 462 PetscCall(PetscNew(&next)); 463 if (petsc_printfqueue) { 464 petsc_printfqueue->next = next; 465 petsc_printfqueue = next; 466 petsc_printfqueue->next = NULL; 467 } else petsc_printfqueuebase = petsc_printfqueue = next; 468 petsc_printfqueuelength++; 469 next->size = 0; 470 next->string = NULL; 471 while (fullLength >= next->size) { 472 next->size = fullLength + 1; 473 PetscCall(PetscFree(next->string)); 474 PetscCall(PetscMalloc1(next->size, &next->string)); 475 PetscCall(PetscArrayzero(next->string, next->size)); 476 va_copy(cpy, Argp); 477 PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, cpy)); 478 va_end(cpy); 479 } 480 } 481 PetscFunctionReturn(PETSC_SUCCESS); 482 } 483 484 /*@C 485 PetscSynchronizedPrintf - Prints synchronized output from several processors. 486 Output of the first processor is followed by that of the second, etc. 487 488 Not Collective 489 490 Input Parameters: 491 + comm - the MPI communicator 492 - format - the usual `printf()` format string 493 494 Level: intermediate 495 496 Note: 497 REQUIRES a call to `PetscSynchronizedFlush()` by all the processes after the completion of the calls to `PetscSynchronizedPrintf()` for the information 498 from all the processors to be printed. 499 500 Fortran Note: 501 The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, `character`(*), `PetscErrorCode` ierr). 502 That is, you can only pass a single character string from Fortran. 503 504 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, 505 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, 506 `PetscFFlush()` 507 @*/ 508 PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...) 509 { 510 va_list Argp; 511 512 PetscFunctionBegin; 513 va_start(Argp, format); 514 PetscCall(PetscSynchronizedFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 515 va_end(Argp); 516 PetscFunctionReturn(PETSC_SUCCESS); 517 } 518 519 /*@C 520 PetscSynchronizedFPrintf - Prints synchronized output to the specified file from 521 several processors. Output of the first processor is followed by that of the 522 second, etc. 523 524 Not Collective 525 526 Input Parameters: 527 + comm - the MPI communicator 528 . fd - the file pointer 529 - format - the usual `printf()` format string 530 531 Level: intermediate 532 533 Note: 534 REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information 535 from all the processors to be printed. 536 537 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`, 538 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 539 `PetscFFlush()` 540 @*/ 541 PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...) 542 { 543 va_list Argp; 544 545 PetscFunctionBegin; 546 va_start(Argp, format); 547 PetscCall(PetscSynchronizedFPrintf_Private(comm, fp, format, Argp)); 548 va_end(Argp); 549 PetscFunctionReturn(PETSC_SUCCESS); 550 } 551 552 /*@C 553 PetscSynchronizedFlush - Flushes to the screen output from all processors 554 involved in previous `PetscSynchronizedPrintf()`/`PetscSynchronizedFPrintf()` calls. 555 556 Collective 557 558 Input Parameters: 559 + comm - the MPI communicator 560 - fd - the file pointer (valid on process 0 of the communicator) 561 562 Level: intermediate 563 564 Note: 565 If `PetscSynchronizedPrintf()` and/or `PetscSynchronizedFPrintf()` are called with 566 different MPI communicators there must be an intervening call to `PetscSynchronizedFlush()` between the calls with different MPI communicators. 567 568 Fortran Note: 569 Pass `PETSC_STDOUT` if the flush is for standard out; otherwise pass a value obtained from `PetscFOpen()` 570 571 .seealso: `PetscSynchronizedPrintf()`, `PetscFPrintf()`, `PetscPrintf()`, `PetscViewerASCIIPrintf()`, 572 `PetscViewerASCIISynchronizedPrintf()` 573 @*/ 574 PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm, FILE *fd) 575 { 576 PetscMPIInt rank, size, tag, i, j, n = 0, dummy = 0; 577 char *message; 578 MPI_Status status; 579 580 PetscFunctionBegin; 581 PetscCall(PetscCommDuplicate(comm, &comm, &tag)); 582 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 583 PetscCallMPI(MPI_Comm_size(comm, &size)); 584 585 /* First processor waits for messages from all other processors */ 586 if (rank == 0) { 587 if (!fd) fd = PETSC_STDOUT; 588 for (i = 1; i < size; i++) { 589 /* to prevent a flood of messages to process zero, request each message separately */ 590 PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm)); 591 PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status)); 592 for (j = 0; j < n; j++) { 593 PetscMPIInt size = 0; 594 595 PetscCallMPI(MPI_Recv(&size, 1, MPI_INT, i, tag, comm, &status)); 596 PetscCall(PetscMalloc1(size, &message)); 597 PetscCallMPI(MPI_Recv(message, size, MPI_CHAR, i, tag, comm, &status)); 598 PetscCall(PetscFPrintf(comm, fd, "%s", message)); 599 PetscCall(PetscFree(message)); 600 } 601 } 602 } else { /* other processors send queue to processor 0 */ 603 PrintfQueue next = petsc_printfqueuebase, previous; 604 605 PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status)); 606 PetscCallMPI(MPI_Send(&petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm)); 607 for (i = 0; i < petsc_printfqueuelength; i++) { 608 PetscCallMPI(MPI_Send(&next->size, 1, MPI_INT, 0, tag, comm)); 609 PetscCallMPI(MPI_Send(next->string, next->size, MPI_CHAR, 0, tag, comm)); 610 previous = next; 611 next = next->next; 612 PetscCall(PetscFree(previous->string)); 613 PetscCall(PetscFree(previous)); 614 } 615 petsc_printfqueue = NULL; 616 petsc_printfqueuelength = 0; 617 } 618 PetscCall(PetscCommDestroy(&comm)); 619 PetscFunctionReturn(PETSC_SUCCESS); 620 } 621 622 /*@C 623 PetscFPrintf - Prints to a file, only from the first 624 processor in the communicator. 625 626 Not Collective; No Fortran Support 627 628 Input Parameters: 629 + comm - the MPI communicator 630 . fd - the file pointer 631 - format - the usual `printf()` format string 632 633 Level: intermediate 634 635 Developer Note: 636 This maybe, and is, called from PETSc error handlers and `PetscMallocValidate()` hence it does not use `PetscCallMPI()` which 637 could recursively restart the malloc validation. 638 639 .seealso: `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 640 `PetscViewerASCIISynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFFlush()` 641 @*/ 642 PetscErrorCode PetscFPrintf(MPI_Comm comm, FILE *fd, const char format[], ...) 643 { 644 va_list Argp; 645 646 PetscFunctionBegin; 647 va_start(Argp, format); 648 PetscCall(PetscVFPrintf_Private(comm, fd, format, Argp)); 649 va_end(Argp); 650 PetscFunctionReturn(PETSC_SUCCESS); 651 } 652 653 /*@C 654 PetscPrintf - Prints to standard out, only from the first 655 processor in the communicator. Calls from other processes are ignored. 656 657 Not Collective 658 659 Input Parameters: 660 + comm - the communicator 661 - format - the usual `printf()` format string 662 663 Level: intermediate 664 665 Note: 666 Deprecated information: `PetscPrintf()` supports some format specifiers that are unique to PETSc. 667 See the manual page for `PetscFormatConvert()` for details. 668 669 Fortran Note: 670 The call sequence is `PetscPrintf`(MPI_Comm, character(*), `PetscErrorCode` ierr) from Fortran. 671 That is, you can only pass a single character string from Fortran. 672 673 .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()` 674 @*/ 675 PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...) 676 { 677 va_list Argp; 678 679 PetscFunctionBegin; 680 va_start(Argp, format); 681 PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 682 va_end(Argp); 683 PetscFunctionReturn(PETSC_SUCCESS); 684 } 685 686 PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...) 687 { 688 va_list Argp; 689 690 PetscFunctionBegin; 691 va_start(Argp, format); 692 PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 693 va_end(Argp); 694 PetscFunctionReturn(PETSC_SUCCESS); 695 } 696 697 /*@C 698 PetscSynchronizedFGets - Several processors all get the same line from a file. 699 700 Collective 701 702 Input Parameters: 703 + comm - the communicator 704 . fd - the file pointer 705 - len - the length of the output buffer 706 707 Output Parameter: 708 . string - the line read from the file, at end of file string[0] == 0 709 710 Level: intermediate 711 712 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, 713 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()` 714 @*/ 715 PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[]) 716 { 717 PetscMPIInt rank; 718 719 PetscFunctionBegin; 720 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 721 if (rank != 0) PetscFunctionReturn(PETSC_SUCCESS); 722 if (!fgets(string, len, fp)) { 723 string[0] = 0; 724 PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno); 725 } 726 PetscCallMPI(MPI_Bcast(string, len, MPI_BYTE, 0, comm)); 727 PetscFunctionReturn(PETSC_SUCCESS); 728 } 729 730 /*@C 731 PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations 732 733 Input Parameter: 734 . format - the PETSc format string 735 736 Level: developer 737 738 @*/ 739 PetscErrorCode PetscFormatStrip(char *format) 740 { 741 size_t loc1 = 0, loc2 = 0; 742 743 PetscFunctionBegin; 744 while (format[loc2]) { 745 if (format[loc2] == '%') { 746 format[loc1++] = format[loc2++]; 747 while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++; 748 } 749 format[loc1++] = format[loc2++]; 750 } 751 PetscFunctionReturn(PETSC_SUCCESS); 752 } 753 754 PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[]) 755 { 756 PetscInt i; 757 size_t left, count; 758 char *p; 759 760 PetscFunctionBegin; 761 for (i = 0, p = buf, left = len; i < n; i++) { 762 PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i])); 763 PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer"); 764 left -= count; 765 p += count - 1; 766 *p++ = ' '; 767 } 768 p[i ? 0 : -1] = 0; 769 PetscFunctionReturn(PETSC_SUCCESS); 770 } 771