Date: 2025-03-29T05:58:43+00:00

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