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