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 (fullLength) *fullLength = 1 + (size_t)flen;
    233:   PetscFunctionReturn(PETSC_SUCCESS);
    234: }

    236: /*@C
    237:   PetscFFlush - Flush a file stream

    239:   Input Parameter:
    240: . fd - The file stream handle

    242:   Level: intermediate

    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.

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

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

    254:   Fortran Note:
    255:   Use `PetscFlush()`

    257: .seealso: `PetscPrintf()`, `PetscFPrintf()`, `PetscVFPrintf()`, `PetscVSNPrintf()`
    258: @*/
    259: PetscErrorCode PetscFFlush(FILE *fd)
    260: {
    261:   int err;

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

    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.

    279:   No Fortran Support

    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

    286:   Level: developer

    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

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

    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`;

    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

    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

    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;

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

    359: /*@C
    360:   PetscSNPrintf - Prints to a string of given length

    362:   Not Collective, No Fortran Support

    364:   Input Parameters:
    365: + len    - the length of `str`
    366: - format - the usual `printf()` format string

    368:   Output Parameter:
    369: . str - the resulting string

    371:   Level: intermediate

    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;

    382:   PetscFunctionBegin;
    383:   va_start(Argp, format);
    384:   PetscCall(PetscVSNPrintf(str, len, format, &fullLength, Argp));
    385:   va_end(Argp);
    386:   PetscFunctionReturn(PETSC_SUCCESS);
    387: }

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

    392:   Not Collective, No Fortran Support

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

    399:   Output Parameters:
    400: + str       - the resulting string
    401: - countused - number of characters printed

    403:   Level: intermediate

    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;

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

    419: PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL;
    420: int         petsc_printfqueuelength = 0;

    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;

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

    438: PETSC_INTERN PetscErrorCode PetscVFPrintf_Internal(FILE *fd, const char format[], ...)
    439: {
    440:   va_list Argp;

    442:   PetscFunctionBegin;
    443:   va_start(Argp, format);
    444:   PetscCall(PetscVFPrintf_Private(fd, format, Argp));
    445:   va_end(Argp);
    446:   PetscFunctionReturn(PETSC_SUCCESS);
    447: }

    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;

    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;

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

    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.

    491:   Not Collective

    493:   Input Parameters:
    494: + comm   - the MPI communicator
    495: - format - the usual `printf()` format string

    497:   Level: intermediate

    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.

    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.

    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;

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

    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.

    527:   Not Collective

    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

    534:   Level: intermediate

    536:   Note:
    537:   REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information
    538:   from all the processors to be printed.

    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.

    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;

    552:   PetscFunctionBegin;
    553:   va_start(Argp, format);
    554:   PetscCall(PetscSynchronizedFPrintf_Private(comm, fp, format, Argp));
    555:   va_end(Argp);
    556:   PetscFunctionReturn(PETSC_SUCCESS);
    557: }

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

    563:   Collective

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

    569:   Level: intermediate

    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.

    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;

    584:   PetscFunctionBegin;
    585:   PetscCall(PetscCommDuplicate(comm, &comm, &tag));
    586:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
    587:   PetscCallMPI(MPI_Comm_size(comm, &size));

    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;

    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;

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

    626: /*@C
    627:   PetscFPrintf - Prints to a file, only from the first
    628:   MPI process in the communicator.

    630:   Not Collective

    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

    637:   Level: intermediate

    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.

    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.

    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;

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

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

    668:   Not Collective

    670:   Input Parameters:
    671: + comm   - the communicator
    672: - format - the usual `printf()` format string

    674:   Level: intermediate

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

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

    684: .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()`
    685: @*/
    686: PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...)
    687: {
    688:   PetscMPIInt rank;
    689:   va_list     Argp;

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

    700: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...)
    701: {
    702:   PetscMPIInt rank;
    703:   va_list     Argp;

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

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

    717:   Collective

    719:   Input Parameters:
    720: + comm - the MPI communicator
    721: . fp   - the file pointer
    722: - len  - the length of `string`

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

    727:   Level: intermediate

    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;

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

    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;

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