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