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 PetscFunctionBegin; 281 if (fd) PetscValidPointer(fd, 1); 282 // could also use PetscCallExternal() here, but since we can get additional error explanation 283 // from strerror() we opted for a manual check 284 PetscCheck(0 == fflush(fd), PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error in fflush() due to \"%s\"", strerror(errno)); 285 PetscFunctionReturn(PETSC_SUCCESS); 286 } 287 288 /*@C 289 PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can 290 can be replaced with something that does not simply write to a file. 291 292 To use, write your own function for example, 293 .vb 294 PetscErrorCode mypetscvfprintf(FILE *fd, const char format[], va_list Argp) 295 { 296 PetscErrorCode ierr; 297 298 PetscFunctionBegin; 299 if (fd != stdout && fd != stderr) { handle regular files 300 CHKERR(PetscVFPrintfDefault(fd,format,Argp)); 301 } else { 302 char buff[BIG]; 303 size_t length; 304 PetscCall(PetscVSNPrintf(buff,BIG,format,&length,Argp)); 305 now send buff to whatever stream or whatever you want 306 } 307 PetscFunctionReturn(PETSC_SUCCESS); 308 } 309 .ve 310 then before the call to `PetscInitialize()` do the assignment `PetscVFPrintf = mypetscvfprintf`; 311 312 Level: developer 313 314 Note: 315 For error messages this may be called by any process, for regular standard out it is 316 called only by process 0 of a given communicator 317 318 Developer Note: 319 This could be called by an error handler, if that happens then a recursion of the error handler may occur 320 and a resulting crash 321 322 .seealso: `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscFFlush()` 323 @*/ 324 PetscErrorCode PetscVFPrintfDefault(FILE *fd, const char *format, va_list Argp) 325 { 326 char str[PETSCDEFAULTBUFFERSIZE]; 327 char *buff = str; 328 size_t fullLength; 329 #if defined(PETSC_HAVE_VA_COPY) 330 va_list Argpcopy; 331 #endif 332 333 PetscFunctionBegin; 334 #if defined(PETSC_HAVE_VA_COPY) 335 va_copy(Argpcopy, Argp); 336 #endif 337 PetscCall(PetscVSNPrintf(str, sizeof(str), format, &fullLength, Argp)); 338 if (fullLength > sizeof(str)) { 339 PetscCall(PetscMalloc1(fullLength, &buff)); 340 #if defined(PETSC_HAVE_VA_COPY) 341 PetscCall(PetscVSNPrintf(buff, fullLength, format, NULL, Argpcopy)); 342 #else 343 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "C89 does not support va_copy() hence cannot print long strings with PETSc printing routines"); 344 #endif 345 } 346 #if defined(PETSC_HAVE_VA_COPY) 347 va_end(Argpcopy); 348 #endif 349 { 350 const int err = fprintf(fd, "%s", buff); 351 // cannot use PetscCallExternal() for fprintf since the return value is "number of 352 // characters transmitted to the output stream" on success 353 PetscCheck(err >= 0, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "fprintf() returned error code %d", err); 354 } 355 PetscCall(PetscFFlush(fd)); 356 if (buff != str) PetscCall(PetscFree(buff)); 357 PetscFunctionReturn(PETSC_SUCCESS); 358 } 359 360 /*@C 361 PetscSNPrintf - Prints to a string of given length 362 363 Not Collective 364 365 Input Parameters: 366 + str - the string to print to 367 . len - the length of `str` 368 . format - the usual `printf()` format string 369 - ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument 370 371 Level: intermediate 372 373 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`, 374 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, 375 `PetscVFPrintf()`, `PetscFFlush()` 376 @*/ 377 PetscErrorCode PetscSNPrintf(char *str, size_t len, const char format[], ...) 378 { 379 size_t fullLength; 380 va_list Argp; 381 382 PetscFunctionBegin; 383 va_start(Argp, format); 384 PetscCall(PetscVSNPrintf(str, len, format, &fullLength, Argp)); 385 va_end(Argp); 386 PetscFunctionReturn(PETSC_SUCCESS); 387 } 388 389 /*@C 390 PetscSNPrintfCount - Prints to a string of given length, returns count of characters printed 391 392 Not Collective 393 394 Input Parameters: 395 + str - the string to print to 396 . len - the length of `str` 397 . format - the usual `printf()` format string 398 - ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument 399 400 Output Parameter: 401 . countused - number of characters printed 402 403 Level: intermediate 404 405 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`, 406 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscSNPrintf()`, `PetscVFPrintf()` 407 @*/ 408 PetscErrorCode PetscSNPrintfCount(char *str, size_t len, const char format[], size_t *countused, ...) 409 { 410 va_list Argp; 411 412 PetscFunctionBegin; 413 va_start(Argp, countused); 414 PetscCall(PetscVSNPrintf(str, len, format, countused, Argp)); 415 va_end(Argp); 416 PetscFunctionReturn(PETSC_SUCCESS); 417 } 418 419 PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL; 420 int petsc_printfqueuelength = 0; 421 422 static inline PetscErrorCode PetscVFPrintf_Private(MPI_Comm comm, FILE *fd, const char format[], va_list Argp) 423 { 424 const PetscBool tee = (PetscBool)(petsc_history && (fd != petsc_history)); 425 PetscMPIInt rank; 426 va_list cpy; 427 428 PetscFunctionBegin; 429 PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 430 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 431 if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS); 432 // must do this before we possibly consume Argp 433 if (tee) va_copy(cpy, Argp); 434 PetscCall((*PetscVFPrintf)(fd, format, Argp)); 435 if (tee) { 436 PetscCall((*PetscVFPrintf)(petsc_history, format, cpy)); 437 va_end(cpy); 438 } 439 PetscFunctionReturn(PETSC_SUCCESS); 440 } 441 442 static inline PetscErrorCode PetscSynchronizedFPrintf_Private(MPI_Comm comm, FILE *fp, const char format[], va_list Argp) 443 { 444 PetscMPIInt rank; 445 va_list cpy; 446 447 PetscFunctionBegin; 448 PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 449 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 450 /* First processor prints immediately to fp */ 451 if (rank == 0) { 452 va_copy(cpy, Argp); 453 PetscCall(PetscVFPrintf_Private(comm, fp, format, cpy)); 454 va_end(cpy); 455 } else { /* other processors add to local queue */ 456 PrintfQueue next; 457 size_t fullLength = PETSCDEFAULTBUFFERSIZE; 458 459 PetscCall(PetscNew(&next)); 460 if (petsc_printfqueue) { 461 petsc_printfqueue->next = next; 462 petsc_printfqueue = next; 463 petsc_printfqueue->next = NULL; 464 } else petsc_printfqueuebase = petsc_printfqueue = next; 465 petsc_printfqueuelength++; 466 next->size = 0; 467 next->string = NULL; 468 while (fullLength >= next->size) { 469 next->size = fullLength + 1; 470 PetscCall(PetscFree(next->string)); 471 PetscCall(PetscMalloc1(next->size, &next->string)); 472 PetscCall(PetscArrayzero(next->string, next->size)); 473 va_copy(cpy, Argp); 474 PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, cpy)); 475 va_end(cpy); 476 } 477 } 478 PetscFunctionReturn(PETSC_SUCCESS); 479 } 480 481 /*@C 482 PetscSynchronizedPrintf - Prints synchronized output from several processors. 483 Output of the first processor is followed by that of the second, etc. 484 485 Not Collective 486 487 Input Parameters: 488 + comm - the MPI communicator 489 - format - the usual `printf()` format string 490 491 Level: intermediate 492 493 Note: 494 REQUIRES a call to `PetscSynchronizedFlush()` by all the processes after the completion of the calls to `PetscSynchronizedPrintf()` for the information 495 from all the processors to be printed. 496 497 Fortran Note: 498 The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, `character`(*), `PetscErrorCode` ierr). 499 That is, you can only pass a single character string from Fortran. 500 501 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, 502 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, 503 `PetscFFlush()` 504 @*/ 505 PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...) 506 { 507 va_list Argp; 508 509 PetscFunctionBegin; 510 va_start(Argp, format); 511 PetscCall(PetscSynchronizedFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 512 va_end(Argp); 513 PetscFunctionReturn(PETSC_SUCCESS); 514 } 515 516 /*@C 517 PetscSynchronizedFPrintf - Prints synchronized output to the specified file from 518 several processors. Output of the first processor is followed by that of the 519 second, etc. 520 521 Not Collective 522 523 Input Parameters: 524 + comm - the MPI communicator 525 . fd - the file pointer 526 - format - the usual `printf()` format string 527 528 Level: intermediate 529 530 Note: 531 REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information 532 from all the processors to be printed. 533 534 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`, 535 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 536 `PetscFFlush()` 537 @*/ 538 PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...) 539 { 540 va_list Argp; 541 542 PetscFunctionBegin; 543 va_start(Argp, format); 544 PetscCall(PetscSynchronizedFPrintf_Private(comm, fp, format, Argp)); 545 va_end(Argp); 546 PetscFunctionReturn(PETSC_SUCCESS); 547 } 548 549 /*@C 550 PetscSynchronizedFlush - Flushes to the screen output from all processors 551 involved in previous `PetscSynchronizedPrintf()`/`PetscSynchronizedFPrintf()` calls. 552 553 Collective 554 555 Input Parameters: 556 + comm - the MPI communicator 557 - fd - the file pointer (valid on process 0 of the communicator) 558 559 Level: intermediate 560 561 Note: 562 If `PetscSynchronizedPrintf()` and/or `PetscSynchronizedFPrintf()` are called with 563 different MPI communicators there must be an intervening call to `PetscSynchronizedFlush()` between the calls with different MPI communicators. 564 565 Fortran Note: 566 Pass `PETSC_STDOUT` if the flush is for standard out; otherwise pass a value obtained from `PetscFOpen()` 567 568 .seealso: `PetscSynchronizedPrintf()`, `PetscFPrintf()`, `PetscPrintf()`, `PetscViewerASCIIPrintf()`, 569 `PetscViewerASCIISynchronizedPrintf()` 570 @*/ 571 PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm, FILE *fd) 572 { 573 PetscMPIInt rank, size, tag, i, j, n = 0, dummy = 0; 574 char *message; 575 MPI_Status status; 576 577 PetscFunctionBegin; 578 PetscCall(PetscCommDuplicate(comm, &comm, &tag)); 579 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 580 PetscCallMPI(MPI_Comm_size(comm, &size)); 581 582 /* First processor waits for messages from all other processors */ 583 if (rank == 0) { 584 if (!fd) fd = PETSC_STDOUT; 585 for (i = 1; i < size; i++) { 586 /* to prevent a flood of messages to process zero, request each message separately */ 587 PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm)); 588 PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status)); 589 for (j = 0; j < n; j++) { 590 PetscMPIInt size = 0; 591 592 PetscCallMPI(MPI_Recv(&size, 1, MPI_INT, i, tag, comm, &status)); 593 PetscCall(PetscMalloc1(size, &message)); 594 PetscCallMPI(MPI_Recv(message, size, MPI_CHAR, i, tag, comm, &status)); 595 PetscCall(PetscFPrintf(comm, fd, "%s", message)); 596 PetscCall(PetscFree(message)); 597 } 598 } 599 } else { /* other processors send queue to processor 0 */ 600 PrintfQueue next = petsc_printfqueuebase, previous; 601 602 PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status)); 603 PetscCallMPI(MPI_Send(&petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm)); 604 for (i = 0; i < petsc_printfqueuelength; i++) { 605 PetscCallMPI(MPI_Send(&next->size, 1, MPI_INT, 0, tag, comm)); 606 PetscCallMPI(MPI_Send(next->string, next->size, MPI_CHAR, 0, tag, comm)); 607 previous = next; 608 next = next->next; 609 PetscCall(PetscFree(previous->string)); 610 PetscCall(PetscFree(previous)); 611 } 612 petsc_printfqueue = NULL; 613 petsc_printfqueuelength = 0; 614 } 615 PetscCall(PetscCommDestroy(&comm)); 616 PetscFunctionReturn(PETSC_SUCCESS); 617 } 618 619 /*@C 620 PetscFPrintf - Prints to a file, only from the first 621 processor in the communicator. 622 623 Not Collective; No Fortran Support 624 625 Input Parameters: 626 + comm - the MPI communicator 627 . fd - the file pointer 628 - format - the usual `printf()` format string 629 630 Level: intermediate 631 632 Developer Note: 633 This maybe, and is, called from PETSc error handlers and `PetscMallocValidate()` hence it does not use `PetscCallMPI()` which 634 could recursively restart the malloc validation. 635 636 .seealso: `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`, 637 `PetscViewerASCIISynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFFlush()` 638 @*/ 639 PetscErrorCode PetscFPrintf(MPI_Comm comm, FILE *fd, const char format[], ...) 640 { 641 va_list Argp; 642 643 PetscFunctionBegin; 644 va_start(Argp, format); 645 PetscCall(PetscVFPrintf_Private(comm, fd, format, Argp)); 646 va_end(Argp); 647 PetscFunctionReturn(PETSC_SUCCESS); 648 } 649 650 /*@C 651 PetscPrintf - Prints to standard out, only from the first 652 processor in the communicator. Calls from other processes are ignored. 653 654 Not Collective 655 656 Input Parameters: 657 + comm - the communicator 658 - format - the usual `printf()` format string 659 660 Level: intermediate 661 662 Note: 663 Deprecated information: `PetscPrintf()` supports some format specifiers that are unique to PETSc. 664 See the manual page for `PetscFormatConvert()` for details. 665 666 Fortran Note: 667 The call sequence is `PetscPrintf`(MPI_Comm, character(*), `PetscErrorCode` ierr) from Fortran. 668 That is, you can only pass a single character string from Fortran. 669 670 .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()` 671 @*/ 672 PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...) 673 { 674 va_list Argp; 675 676 PetscFunctionBegin; 677 va_start(Argp, format); 678 PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 679 va_end(Argp); 680 PetscFunctionReturn(PETSC_SUCCESS); 681 } 682 683 PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...) 684 { 685 va_list Argp; 686 687 PetscFunctionBegin; 688 va_start(Argp, format); 689 PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp)); 690 va_end(Argp); 691 PetscFunctionReturn(PETSC_SUCCESS); 692 } 693 694 /*@C 695 PetscSynchronizedFGets - Several processors all get the same line from a file. 696 697 Collective 698 699 Input Parameters: 700 + comm - the communicator 701 . fd - the file pointer 702 - len - the length of the output buffer 703 704 Output Parameter: 705 . string - the line read from the file, at end of file string[0] == 0 706 707 Level: intermediate 708 709 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, 710 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()` 711 @*/ 712 PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[]) 713 { 714 PetscMPIInt rank; 715 716 PetscFunctionBegin; 717 PetscCallMPI(MPI_Comm_rank(comm, &rank)); 718 if (rank != 0) PetscFunctionReturn(PETSC_SUCCESS); 719 if (!fgets(string, len, fp)) { 720 string[0] = 0; 721 PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file due to \"%s\"", strerror(errno)); 722 } 723 PetscCallMPI(MPI_Bcast(string, len, MPI_BYTE, 0, comm)); 724 PetscFunctionReturn(PETSC_SUCCESS); 725 } 726 727 /*@C 728 PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations 729 730 Input Parameter: 731 . format - the PETSc format string 732 733 Level: developer 734 735 @*/ 736 PetscErrorCode PetscFormatStrip(char *format) 737 { 738 size_t loc1 = 0, loc2 = 0; 739 740 PetscFunctionBegin; 741 while (format[loc2]) { 742 if (format[loc2] == '%') { 743 format[loc1++] = format[loc2++]; 744 while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++; 745 } 746 format[loc1++] = format[loc2++]; 747 } 748 PetscFunctionReturn(PETSC_SUCCESS); 749 } 750 751 PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[]) 752 { 753 PetscInt i; 754 size_t left, count; 755 char *p; 756 757 PetscFunctionBegin; 758 for (i = 0, p = buf, left = len; i < n; i++) { 759 PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i])); 760 PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer"); 761 left -= count; 762 p += count - 1; 763 *p++ = ' '; 764 } 765 p[i ? 0 : -1] = 0; 766 PetscFunctionReturn(PETSC_SUCCESS); 767 } 768