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