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 format converted with `PetscFormatConvert()` 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 /* ----------------------------------------------------------------------- */ 423 424 PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL; 425 int petsc_printfqueuelength = 0; 426 427 static inline PetscErrorCode PetscVFPrintf_Private(MPI_Comm comm, FILE *fd, const char format[], va_list Argp) 428 { 429 const PetscBool tee = (PetscBool)(petsc_history && (fd != petsc_history)); 430 PetscMPIInt rank; 431 va_list cpy; 432 433 PetscFunctionBegin; 434 PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 435 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 436 if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS); 437 // must do this before we possibly consume Argp 438 if (tee) va_copy(cpy, Argp); 439 PetscCall((*PetscVFPrintf)(fd, format, Argp)); 440 if (tee) { 441 PetscCall((*PetscVFPrintf)(petsc_history, format, cpy)); 442 va_end(cpy); 443 } 444 PetscFunctionReturn(PETSC_SUCCESS); 445 } 446 447 static inline PetscErrorCode PetscSynchronizedFPrintf_Private(MPI_Comm comm, FILE *fp, const char format[], va_list Argp) 448 { 449 PetscMPIInt rank; 450 va_list cpy; 451 452 PetscFunctionBegin; 453 PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 454 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 455 /* First processor prints immediately to fp */ 456 if (rank == 0) { 457 va_copy(cpy, Argp); 458 PetscCall(PetscVFPrintf_Private(comm, fp, format, cpy)); 459 va_end(cpy); 460 } else { /* other processors add to local queue */ 461 PrintfQueue next; 462 size_t fullLength = PETSCDEFAULTBUFFERSIZE; 463 464 PetscCall(PetscNew(&next)); 465 if (petsc_printfqueue) { 466 petsc_printfqueue->next = next; 467 petsc_printfqueue = next; 468 petsc_printfqueue->next = NULL; 469 } else petsc_printfqueuebase = petsc_printfqueue = next; 470 petsc_printfqueuelength++; 471 next->size = 0; 472 next->string = NULL; 473 while (fullLength >= next->size) { 474 next->size = fullLength + 1; 475 PetscCall(PetscFree(next->string)); 476 PetscCall(PetscMalloc1(next->size, &next->string)); 477 PetscCall(PetscArrayzero(next->string, next->size)); 478 va_copy(cpy, Argp); 479 PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, cpy)); 480 va_end(cpy); 481 } 482 } 483 PetscFunctionReturn(PETSC_SUCCESS); 484 } 485 486 /*@C 487 PetscSynchronizedPrintf - Prints synchronized output from several processors. 488 Output of the first processor is followed by that of the second, etc. 489 490 Not Collective 491 492 Input Parameters: 493 + comm - the MPI communicator 494 - format - the usual `printf()` format string 495 496 Level: intermediate 497 498 Note: 499 REQUIRES a call to `PetscSynchronizedFlush()` by all the processes after the completion of the calls to `PetscSynchronizedPrintf()` for the information 500 from all the processors to be printed. 501 502 Fortran Note: 503 The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, `character`(*), `PetscErrorCode` ierr). 504 That is, you can only pass a single character string from Fortran. 505 506 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, 507 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, 508 `PetscFFlush()` 509 @*/ 510 PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...) 511 { 512 va_list Argp; 513 514 PetscFunctionBegin; 515 va_start(Argp, format); 516 PetscCall(PetscSynchronizedFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 517 va_end(Argp); 518 PetscFunctionReturn(PETSC_SUCCESS); 519 } 520 521 /*@C 522 PetscSynchronizedFPrintf - Prints synchronized output to the specified file from 523 several processors. Output of the first processor is followed by that of the 524 second, etc. 525 526 Not Collective 527 528 Input Parameters: 529 + comm - the MPI communicator 530 . fd - the file pointer 531 - format - the usual `printf()` format string 532 533 Level: intermediate 534 535 Note: 536 REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information 537 from all the processors to be printed. 538 539 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`, 540 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 541 `PetscFFlush()` 542 @*/ 543 PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...) 544 { 545 va_list Argp; 546 547 PetscFunctionBegin; 548 va_start(Argp, format); 549 PetscCall(PetscSynchronizedFPrintf_Private(comm, fp, format, Argp)); 550 va_end(Argp); 551 PetscFunctionReturn(PETSC_SUCCESS); 552 } 553 554 /*@C 555 PetscSynchronizedFlush - Flushes to the screen output from all processors 556 involved in previous `PetscSynchronizedPrintf()`/`PetscSynchronizedFPrintf()` calls. 557 558 Collective 559 560 Input Parameters: 561 + comm - the MPI communicator 562 - fd - the file pointer (valid on process 0 of the communicator) 563 564 Level: intermediate 565 566 Note: 567 If `PetscSynchronizedPrintf()` and/or `PetscSynchronizedFPrintf()` are called with 568 different MPI communicators there must be an intervening call to `PetscSynchronizedFlush()` between the calls with different MPI communicators. 569 570 Fortran Note: 571 Pass `PETSC_STDOUT` if the flush is for standard out; otherwise pass a value obtained from `PetscFOpen()` 572 573 .seealso: `PetscSynchronizedPrintf()`, `PetscFPrintf()`, `PetscPrintf()`, `PetscViewerASCIIPrintf()`, 574 `PetscViewerASCIISynchronizedPrintf()` 575 @*/ 576 PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm, FILE *fd) 577 { 578 PetscMPIInt rank, size, tag, i, j, n = 0, dummy = 0; 579 char *message; 580 MPI_Status status; 581 582 PetscFunctionBegin; 583 PetscCall(PetscCommDuplicate(comm, &comm, &tag)); 584 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 585 PetscCallMPI(MPI_Comm_size(comm, &size)); 586 587 /* First processor waits for messages from all other processors */ 588 if (rank == 0) { 589 if (!fd) fd = PETSC_STDOUT; 590 for (i = 1; i < size; i++) { 591 /* to prevent a flood of messages to process zero, request each message separately */ 592 PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm)); 593 PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status)); 594 for (j = 0; j < n; j++) { 595 PetscMPIInt size = 0; 596 597 PetscCallMPI(MPI_Recv(&size, 1, MPI_INT, i, tag, comm, &status)); 598 PetscCall(PetscMalloc1(size, &message)); 599 PetscCallMPI(MPI_Recv(message, size, MPI_CHAR, i, tag, comm, &status)); 600 PetscCall(PetscFPrintf(comm, fd, "%s", message)); 601 PetscCall(PetscFree(message)); 602 } 603 } 604 } else { /* other processors send queue to processor 0 */ 605 PrintfQueue next = petsc_printfqueuebase, previous; 606 607 PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status)); 608 PetscCallMPI(MPI_Send(&petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm)); 609 for (i = 0; i < petsc_printfqueuelength; i++) { 610 PetscCallMPI(MPI_Send(&next->size, 1, MPI_INT, 0, tag, comm)); 611 PetscCallMPI(MPI_Send(next->string, next->size, MPI_CHAR, 0, tag, comm)); 612 previous = next; 613 next = next->next; 614 PetscCall(PetscFree(previous->string)); 615 PetscCall(PetscFree(previous)); 616 } 617 petsc_printfqueue = NULL; 618 petsc_printfqueuelength = 0; 619 } 620 PetscCall(PetscCommDestroy(&comm)); 621 PetscFunctionReturn(PETSC_SUCCESS); 622 } 623 624 /* ---------------------------------------------------------------------------------------*/ 625 626 /*@C 627 PetscFPrintf - Prints to a file, only from the first 628 processor in the communicator. 629 630 Not Collective; No Fortran Support 631 632 Input Parameters: 633 + comm - the MPI communicator 634 . fd - the file pointer 635 - format - the usual `printf()` format string 636 637 Level: intermediate 638 639 Developer Note: 640 This maybe, and is, called from PETSc error handlers and `PetscMallocValidate()` hence it does not use `PetscCallMPI()` which 641 could recursively restart the malloc validation. 642 643 .seealso: `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 644 `PetscViewerASCIISynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFFlush()` 645 @*/ 646 PetscErrorCode PetscFPrintf(MPI_Comm comm, FILE *fd, const char format[], ...) 647 { 648 va_list Argp; 649 650 PetscFunctionBegin; 651 va_start(Argp, format); 652 PetscCall(PetscVFPrintf_Private(comm, fd, format, Argp)); 653 va_end(Argp); 654 PetscFunctionReturn(PETSC_SUCCESS); 655 } 656 657 /*@C 658 PetscPrintf - Prints to standard out, only from the first 659 processor in the communicator. Calls from other processes are ignored. 660 661 Not Collective 662 663 Input Parameters: 664 + comm - the communicator 665 - format - the usual printf() format string 666 667 Level: intermediate 668 669 Note: 670 Deprecated information: `PetscPrintf()` supports some format specifiers that are unique to PETSc. 671 See the manual page for `PetscFormatConvert()` for details. 672 673 Fortran Note: 674 The call sequence is `PetscPrintf`(MPI_Comm, character(*), `PetscErrorCode` ierr) from Fortran. 675 That is, you can only pass a single character string from Fortran. 676 677 .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()` 678 @*/ 679 PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...) 680 { 681 va_list Argp; 682 683 PetscFunctionBegin; 684 va_start(Argp, format); 685 PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 686 va_end(Argp); 687 PetscFunctionReturn(PETSC_SUCCESS); 688 } 689 690 PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...) 691 { 692 va_list Argp; 693 694 PetscFunctionBegin; 695 va_start(Argp, format); 696 PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 697 va_end(Argp); 698 PetscFunctionReturn(PETSC_SUCCESS); 699 } 700 701 /* ---------------------------------------------------------------------------------------*/ 702 703 /*@C 704 PetscSynchronizedFGets - Several processors all get the same line from a file. 705 706 Collective 707 708 Input Parameters: 709 + comm - the communicator 710 . fd - the file pointer 711 - len - the length of the output buffer 712 713 Output Parameter: 714 . string - the line read from the file, at end of file string[0] == 0 715 716 Level: intermediate 717 718 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, 719 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()` 720 @*/ 721 PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[]) 722 { 723 PetscMPIInt rank; 724 725 PetscFunctionBegin; 726 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 727 if (rank != 0) PetscFunctionReturn(PETSC_SUCCESS); 728 if (!fgets(string, len, fp)) { 729 string[0] = 0; 730 PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno); 731 } 732 PetscCallMPI(MPI_Bcast(string, len, MPI_BYTE, 0, comm)); 733 PetscFunctionReturn(PETSC_SUCCESS); 734 } 735 736 /*@C 737 PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations 738 739 Input Parameters: 740 . format - the PETSc format string 741 742 Level: developer 743 744 @*/ 745 PetscErrorCode PetscFormatStrip(char *format) 746 { 747 size_t loc1 = 0, loc2 = 0; 748 749 PetscFunctionBegin; 750 while (format[loc2]) { 751 if (format[loc2] == '%') { 752 format[loc1++] = format[loc2++]; 753 while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++; 754 } 755 format[loc1++] = format[loc2++]; 756 } 757 PetscFunctionReturn(PETSC_SUCCESS); 758 } 759 760 PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[]) 761 { 762 PetscInt i; 763 size_t left, count; 764 char *p; 765 766 PetscFunctionBegin; 767 for (i = 0, p = buf, left = len; i < n; i++) { 768 PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i])); 769 PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer"); 770 left -= count; 771 p += count - 1; 772 *p++ = ' '; 773 } 774 p[i ? 0 : -1] = 0; 775 PetscFunctionReturn(PETSC_SUCCESS); 776 } 777