xref: /petsc/src/sys/fileio/mprint.c (revision ab4ee011827fbbb77f789779c813f6db6bb0cbfa)
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