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