Actual source code: mprint.c

  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;

 24: /*@C
 25:   PetscFormatConvertGetSize - Gets the length of a string needed to hold data converted with `PetscFormatConvert()` based on the format

 27:   No Fortran Support

 29:   Input Parameter:
 30: . format - the PETSc format string

 32:   Output Parameter:
 33: . size - the needed length of the new format

 35:   Level: developer

 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;

 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: }

 78: /*@C
 79:   PetscFormatConvert - converts %g to [|%g|] so that `PetscVSNPrintf()` can ensure all %g formatted numbers have a decimal point when printed.

 81:   No Fortran Support

 83:   Input Parameter:
 84: . format - the PETSc format string

 86:   Output Parameter:
 87: . newformat - the formatted string, must be long enough to hold result

 89:   Level: developer

 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.

 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.

 99: .seealso: `PetscFormatConvertGetSize()`, `PetscVSNPrintf()`, `PetscVFPrintf()`
100: @*/
101: PetscErrorCode PetscFormatConvert(const char format[], char newformat[])
102: {
103:   PetscInt i = 0, j = 0;

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: }

149: #define PETSCDEFAULTBUFFERSIZE 8 * 1024

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)

154:   No Fortran Support

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

162:   Output Parameter:
163: . fullLength - the amount of space in `str` actually used.

165:   Level: developer

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.

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()`

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;

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 defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
233:   /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
234:   {
235:     size_t cnt = 0, ncnt = 0, leng;
236:     PetscCall(PetscStrlen(str, &leng));
237:     if (leng > 5) {
238:       for (cnt = 0; cnt < leng - 4; cnt++) {
239:         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') {
240:           str[ncnt] = str[cnt];
241:           ncnt++;
242:           cnt++;
243:           str[ncnt] = str[cnt];
244:           ncnt++;
245:           cnt++;
246:           cnt++;
247:           str[ncnt] = str[cnt];
248:         } else {
249:           str[ncnt] = str[cnt];
250:         }
251:         ncnt++;
252:       }
253:       while (cnt < leng) {
254:         str[ncnt] = str[cnt];
255:         ncnt++;
256:         cnt++;
257:       }
258:       str[ncnt] = 0;
259:     }
260:   }
261: #endif
262:   if (fullLength) *fullLength = 1 + (size_t)flen;
263:   PetscFunctionReturn(PETSC_SUCCESS);
264: }

266: /*@C
267:   PetscFFlush - Flush a file stream

269:   Input Parameter:
270: . fd - The file stream handle

272:   Level: intermediate

274:   Notes:
275:   For output streams (and for update streams on which the last operation was output), writes
276:   any unwritten data from the stream's buffer to the associated output device.

278:   For input streams (and for update streams on which the last operation was input), the
279:   behavior is undefined.

281:   If `fd` is `NULL`, all open output streams are flushed, including ones not directly
282:   accessible to the program.

284:   Fortran Note:
285:   Use `PetscFlush()`

287: .seealso: `PetscPrintf()`, `PetscFPrintf()`, `PetscVFPrintf()`, `PetscVSNPrintf()`
288: @*/
289: PetscErrorCode PetscFFlush(FILE *fd)
290: {
291:   int err;

293:   PetscFunctionBegin;
294:   if (fd) PetscAssertPointer(fd, 1);
295:   err = fflush(fd);
296: #if !defined(PETSC_MISSING_SIGPIPE) && defined(EPIPE) && defined(ECONNRESET)
297:   if (fd && err && (errno == EPIPE || errno == ECONNRESET)) err = 0; /* ignore error, rely on SIGPIPE */
298: #endif
299:   // could also use PetscCallExternal() here, but since we can get additional error explanation
300:   // from strerror() we opted for a manual check
301:   PetscCheck(0 == err, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error in fflush() due to \"%s\"", strerror(errno));
302:   PetscFunctionReturn(PETSC_SUCCESS);
303: }

305: /*@C
306:   PetscVFPrintfDefault -  All PETSc standard out and error messages are sent through this function; so, in theory, this can
307:   can be replaced with something that does not simply write to a file.

309:   No Fortran Support

311:   Input Parameters:
312: + fd     - the file descriptor to write to
313: . format - the format string to write with
314: - Argp   - the variable argument list of items to format and write

316:   Level: developer

318:   Note:
319:   For error messages this may be called by any MPI process, for regular standard out it is
320:   called only by MPI rank 0 of a given communicator

322:   Example Usage:
323:   To use, write your own function for example,
324: .vb
325:    PetscErrorCode mypetscvfprintf(FILE *fd, const char format[], va_list Argp)
326:    {
327:      PetscErrorCode ierr;

329:      PetscFunctionBegin;
330:       if (fd != stdout && fd != stderr) {  handle regular files
331:          CHKERR(PetscVFPrintfDefault(fd,format,Argp));
332:      } else {
333:         char   buff[BIG];
334:         size_t length;
335:         PetscCall(PetscVSNPrintf(buff,BIG,format,&length,Argp));
336:         now send buff to whatever stream or whatever you want
337:     }
338:     PetscFunctionReturn(PETSC_SUCCESS);
339:    }
340: .ve
341:   then before the call to `PetscInitialize()` do the assignment `PetscVFPrintf = mypetscvfprintf`;

343:   Developer Notes:
344:   This could be called by an error handler, if that happens then a recursion of the error handler may occur
345:   and a resulting crash

347: .seealso: `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscFFlush()`
348: @*/
349: PetscErrorCode PetscVFPrintfDefault(FILE *fd, const char format[], va_list Argp)
350: {
351:   char   str[PETSCDEFAULTBUFFERSIZE];
352:   char  *buff = str;
353:   size_t fullLength;
354: #if defined(PETSC_HAVE_VA_COPY)
355:   va_list Argpcopy;
356: #endif

358:   PetscFunctionBegin;
359: #if defined(PETSC_HAVE_VA_COPY)
360:   va_copy(Argpcopy, Argp);
361: #endif
362:   PetscCall(PetscVSNPrintf(str, sizeof(str), format, &fullLength, Argp));
363:   if (fullLength > sizeof(str)) {
364:     PetscCall(PetscMalloc1(fullLength, &buff));
365: #if defined(PETSC_HAVE_VA_COPY)
366:     PetscCall(PetscVSNPrintf(buff, fullLength, format, NULL, Argpcopy));
367: #else
368:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
369: #endif
370:   }
371: #if defined(PETSC_HAVE_VA_COPY)
372:   va_end(Argpcopy);
373: #endif
374:   {
375:     int err;

377:     // POSIX C sets errno but otherwise it may not be set for *printf() system calls
378:     // https://pubs.opengroup.org/onlinepubs/9699919799/functions/fprintf.html
379:     errno = 0;
380:     err   = fprintf(fd, "%s", buff);
381:     // cannot use PetscCallExternal() for fprintf since the return value is "number of
382:     // characters transmitted to the output stream" on success
383:     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)");
384:   }
385:   PetscCall(PetscFFlush(fd));
386:   if (buff != str) PetscCall(PetscFree(buff));
387:   PetscFunctionReturn(PETSC_SUCCESS);
388: }

390: /*@C
391:   PetscSNPrintf - Prints to a string of given length

393:   Not Collective, No Fortran Support

395:   Input Parameters:
396: + len    - the length of `str`
397: - format - the usual `printf()` format string

399:   Output Parameter:
400: . str - the resulting string

402:   Level: intermediate

404: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
405:           `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
406:           `PetscVFPrintf()`, `PetscFFlush()`
407: @*/
408: PetscErrorCode PetscSNPrintf(char str[], size_t len, const char format[], ...)
409: {
410:   size_t  fullLength;
411:   va_list Argp;

413:   PetscFunctionBegin;
414:   va_start(Argp, format);
415:   PetscCall(PetscVSNPrintf(str, len, format, &fullLength, Argp));
416:   va_end(Argp);
417:   PetscFunctionReturn(PETSC_SUCCESS);
418: }

420: /*@C
421:   PetscSNPrintfCount - Prints to a string of given length, returns count of characters printed

423:   Not Collective, No Fortran Support

425:   Input Parameters:
426: + len    - the length of `str`
427: . format - the usual `printf()` format string
428: - ...    - args to format

430:   Output Parameters:
431: + str       - the resulting string
432: - countused - number of characters printed

434:   Level: intermediate

436: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
437:           `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscSNPrintf()`, `PetscVFPrintf()`
438: @*/
439: PetscErrorCode PetscSNPrintfCount(char str[], size_t len, const char format[], size_t *countused, ...)
440: {
441:   va_list Argp;

443:   PetscFunctionBegin;
444:   va_start(Argp, countused);
445:   PetscCall(PetscVSNPrintf(str, len, format, countused, Argp));
446:   va_end(Argp);
447:   PetscFunctionReturn(PETSC_SUCCESS);
448: }

450: PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL;
451: int         petsc_printfqueuelength = 0;

453: static inline PetscErrorCode PetscVFPrintf_Private(FILE *fd, const char format[], va_list Argp)
454: {
455:   const PetscBool tee = (PetscBool)(petsc_history && (fd != petsc_history));
456:   va_list         cpy;

458:   PetscFunctionBegin;
459:   // must do this before we possibly consume Argp
460:   if (tee) va_copy(cpy, Argp);
461:   PetscCall((*PetscVFPrintf)(fd, format, Argp));
462:   if (tee) {
463:     PetscCall((*PetscVFPrintf)(petsc_history, format, cpy));
464:     va_end(cpy);
465:   }
466:   PetscFunctionReturn(PETSC_SUCCESS);
467: }

469: PETSC_INTERN PetscErrorCode PetscVFPrintf_Internal(FILE *fd, const char format[], ...)
470: {
471:   va_list Argp;

473:   PetscFunctionBegin;
474:   va_start(Argp, format);
475:   PetscCall(PetscVFPrintf_Private(fd, format, Argp));
476:   va_end(Argp);
477:   PetscFunctionReturn(PETSC_SUCCESS);
478: }

480: static inline PetscErrorCode PetscSynchronizedFPrintf_Private(MPI_Comm comm, FILE *fp, const char format[], va_list Argp)
481: {
482:   PetscMPIInt rank;
483:   va_list     cpy;

485:   PetscFunctionBegin;
486:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
487:   /* First processor prints immediately to fp */
488:   if (rank == 0) {
489:     va_copy(cpy, Argp);
490:     PetscCall(PetscVFPrintf_Private(fp, format, cpy));
491:     va_end(cpy);
492:   } else { /* other processors add to local queue */
493:     PrintfQueue next;
494:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

496:     PetscCall(PetscNew(&next));
497:     if (petsc_printfqueue) {
498:       petsc_printfqueue->next = next;
499:       petsc_printfqueue       = next;
500:       petsc_printfqueue->next = NULL;
501:     } else petsc_printfqueuebase = petsc_printfqueue = next;
502:     petsc_printfqueuelength++;
503:     next->size   = 0;
504:     next->string = NULL;
505:     while (fullLength >= next->size) {
506:       next->size = fullLength + 1;
507:       PetscCall(PetscFree(next->string));
508:       PetscCall(PetscMalloc1(next->size, &next->string));
509:       PetscCall(PetscArrayzero(next->string, next->size));
510:       va_copy(cpy, Argp);
511:       PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, cpy));
512:       va_end(cpy);
513:     }
514:   }
515:   PetscFunctionReturn(PETSC_SUCCESS);
516: }

518: /*@C
519:   PetscSynchronizedPrintf - Prints synchronized output from multiple MPI processes.
520:   Output of the first processor is followed by that of the second, etc.

522:   Not Collective

524:   Input Parameters:
525: + comm   - the MPI communicator
526: - format - the usual `printf()` format string

528:   Level: intermediate

530:   Note:
531:   REQUIRES a call to `PetscSynchronizedFlush()` by all the processes after the completion of the calls to `PetscSynchronizedPrintf()` for the information
532:   from all the processors to be printed.

534:   Fortran Note:
535:   The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, `character`(*), `PetscErrorCode` ierr).
536:   That is, you can only pass a single character string from Fortran.

538: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`,
539:           `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
540:           `PetscFFlush()`
541: @*/
542: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...)
543: {
544:   va_list Argp;

546:   PetscFunctionBegin;
547:   va_start(Argp, format);
548:   PetscCall(PetscSynchronizedFPrintf_Private(comm, PETSC_STDOUT, format, Argp));
549:   va_end(Argp);
550:   PetscFunctionReturn(PETSC_SUCCESS);
551: }

553: /*@C
554:   PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
555:   several MPI processes.  Output of the first process is followed by that of the
556:   second, etc.

558:   Not Collective

560:   Input Parameters:
561: + comm   - the MPI communicator
562: . fp     - the file pointer, `PETSC_STDOUT` or value obtained from `PetscFOpen()`
563: - format - the usual `printf()` format string

565:   Level: intermediate

567:   Note:
568:   REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information
569:   from all the processors to be printed.

571:   Fortran Note:
572:   The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, fp, `character`(*), `PetscErrorCode` ierr).
573:   That is, you can only pass a single character string from Fortran.

575: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`,
576:           `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
577:           `PetscFFlush()`
578: @*/
579: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...)
580: {
581:   va_list Argp;

583:   PetscFunctionBegin;
584:   va_start(Argp, format);
585:   PetscCall(PetscSynchronizedFPrintf_Private(comm, fp, format, Argp));
586:   va_end(Argp);
587:   PetscFunctionReturn(PETSC_SUCCESS);
588: }

590: /*@C
591:   PetscSynchronizedFlush - Flushes to the screen output from all processors
592:   involved in previous `PetscSynchronizedPrintf()`/`PetscSynchronizedFPrintf()` calls.

594:   Collective

596:   Input Parameters:
597: + comm - the MPI communicator
598: - fd   - the file pointer (valid on MPI rank 0 of the communicator), `PETSC_STDOUT` or value obtained from `PetscFOpen()`

600:   Level: intermediate

602:   Note:
603:   If `PetscSynchronizedPrintf()` and/or `PetscSynchronizedFPrintf()` are called with
604:   different MPI communicators there must be an intervening call to `PetscSynchronizedFlush()` between the calls with different MPI communicators.

606: .seealso: `PetscSynchronizedPrintf()`, `PetscFPrintf()`, `PetscPrintf()`, `PetscViewerASCIIPrintf()`,
607:           `PetscViewerASCIISynchronizedPrintf()`
608: @*/
609: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm, FILE *fd)
610: {
611:   PetscMPIInt rank, size, tag, i, j, n = 0, dummy = 0;
612:   char       *message;
613:   MPI_Status  status;

615:   PetscFunctionBegin;
616:   PetscCall(PetscCommDuplicate(comm, &comm, &tag));
617:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
618:   PetscCallMPI(MPI_Comm_size(comm, &size));

620:   /* First processor waits for messages from all other processors */
621:   if (rank == 0) {
622:     if (!fd) fd = PETSC_STDOUT;
623:     for (i = 1; i < size; i++) {
624:       /* to prevent a flood of messages to process zero, request each message separately */
625:       PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm));
626:       PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status));
627:       for (j = 0; j < n; j++) {
628:         PetscMPIInt size = 0;

630:         PetscCallMPI(MPI_Recv(&size, 1, MPI_INT, i, tag, comm, &status));
631:         PetscCall(PetscMalloc1(size, &message));
632:         PetscCallMPI(MPI_Recv(message, size, MPI_CHAR, i, tag, comm, &status));
633:         PetscCall(PetscFPrintf(comm, fd, "%s", message));
634:         PetscCall(PetscFree(message));
635:       }
636:     }
637:   } else { /* other processors send queue to processor 0 */
638:     PrintfQueue next = petsc_printfqueuebase, previous;

640:     PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status));
641:     PetscCallMPI(MPI_Send(&petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm));
642:     for (i = 0; i < petsc_printfqueuelength; i++) {
643:       PetscCallMPI(MPI_Send(&next->size, 1, MPI_INT, 0, tag, comm));
644:       PetscCallMPI(MPI_Send(next->string, (PetscMPIInt)next->size, MPI_CHAR, 0, tag, comm));
645:       previous = next;
646:       next     = next->next;
647:       PetscCall(PetscFree(previous->string));
648:       PetscCall(PetscFree(previous));
649:     }
650:     petsc_printfqueue       = NULL;
651:     petsc_printfqueuelength = 0;
652:   }
653:   PetscCall(PetscCommDestroy(&comm));
654:   PetscFunctionReturn(PETSC_SUCCESS);
655: }

657: /*@C
658:   PetscFPrintf - Prints to a file, only from the first
659:   MPI process in the communicator.

661:   Not Collective

663:   Input Parameters:
664: + comm   - the MPI communicator
665: . fd     - the file pointer, `PETSC_STDOUT` or value obtained from `PetscFOpen()`
666: - format - the usual `printf()` format string

668:   Level: intermediate

670:   Fortran Note:
671:   The call sequence is `PetscFPrintf`(`MPI_Comm`, fp, `character`(*), `PetscErrorCode` ierr).
672:   That is, you can only pass a single character string from Fortran.

674:   Developer Notes:
675:   This maybe, and is, called from PETSc error handlers and `PetscMallocValidate()` hence it does not use `PetscCallMPI()` which
676:   could recursively restart the malloc validation.

678: .seealso: `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
679:           `PetscViewerASCIISynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFFlush()`
680: @*/
681: PetscErrorCode PetscFPrintf(MPI_Comm comm, FILE *fd, const char format[], ...)
682: {
683:   PetscMPIInt rank;
684:   va_list     Argp;

686:   PetscFunctionBegin;
687:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
688:   if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
689:   va_start(Argp, format);
690:   PetscCall(PetscVFPrintf_Private(fd, format, Argp));
691:   va_end(Argp);
692:   PetscFunctionReturn(PETSC_SUCCESS);
693: }

695: /*@C
696:   PetscPrintf - Prints to standard out, only from the first
697:   MPI process in the communicator. Calls from other processes are ignored.

699:   Not Collective

701:   Input Parameters:
702: + comm   - the communicator
703: - format - the usual `printf()` format string

705:   Level: intermediate

707:   Note:
708:   Deprecated information: `PetscPrintf()` supports some format specifiers that are unique to PETSc.
709:   See the manual page for `PetscFormatConvert()` for details.

711:   Fortran Notes:
712:   The call sequence is `PetscPrintf`(MPI_Comm, character(*), `PetscErrorCode` ierr) from Fortran.
713:   That is, you can only pass a single character string from Fortran.

715: .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()`
716: @*/
717: PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...)
718: {
719:   PetscMPIInt rank;
720:   va_list     Argp;

722:   PetscFunctionBegin;
723:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
724:   if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
725:   va_start(Argp, format);
726:   PetscCall(PetscVFPrintf_Private(PETSC_STDOUT, format, Argp));
727:   va_end(Argp);
728:   PetscFunctionReturn(PETSC_SUCCESS);
729: }

731: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...)
732: {
733:   PetscMPIInt rank;
734:   va_list     Argp;

736:   PetscFunctionBegin;
737:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
738:   if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
739:   va_start(Argp, format);
740:   PetscCall(PetscVFPrintf_Private(PETSC_STDOUT, format, Argp));
741:   va_end(Argp);
742:   PetscFunctionReturn(PETSC_SUCCESS);
743: }

745: /*@C
746:   PetscSynchronizedFGets - Multiple MPI processes all get the same line from a file.

748:   Collective

750:   Input Parameters:
751: + comm - the MPI communicator
752: . fp   - the file pointer
753: - len  - the length of `string`

755:   Output Parameter:
756: . string - the line read from the file, at end of file `string`[0] == 0

758:   Level: intermediate

760: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`,
761:           `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`
762: @*/
763: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[])
764: {
765:   PetscMPIInt rank;

767:   PetscFunctionBegin;
768:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
769:   if (rank == 0) {
770:     if (!fgets(string, (int)len, fp)) {
771:       string[0] = 0;
772:       PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file due to \"%s\"", strerror(errno));
773:     }
774:   }
775:   PetscCallMPI(MPI_Bcast(string, (PetscMPIInt)len, MPI_BYTE, 0, comm));
776:   PetscFunctionReturn(PETSC_SUCCESS);
777: }

779: PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[])
780: {
781:   PetscInt i;
782:   size_t   left, count;
783:   char    *p;

785:   PetscFunctionBegin;
786:   for (i = 0, p = buf, left = len; i < n; i++) {
787:     PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i]));
788:     PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer");
789:     left -= count;
790:     p += count - 1;
791:     *p++ = ' ';
792:   }
793:   p[i ? 0 : -1] = 0;
794:   PetscFunctionReturn(PETSC_SUCCESS);
795: }