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;
 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. The
 80:      decimal point is then used by the `petscdiff` script so that differences in floating point number output is ignored in the test harness.

 82:    No Fortran Support

 84:    Input Parameters:
 85: +   format - the PETSc format string
 86: -   size - the length of newformat, you can use `PetscFormatConvertGetSize()` to compute the needed size

 88:    Output Parameter:
 89: .   newformat - the new format

 91:    Level: developer

 93:     Note:
 94:     Deprecated usage also converts the `%D` to `%d` for 32-bit PETSc indices and to `%lld` for 64-bit PETSc indices. This feature is no
 95:     longer used in PETSc code instead use %" PetscInt_FMT " in the format string

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

103:   PetscFunctionBegin;
104:   while (format[i]) {
105:     if (format[i] == '%' && format[i + 1] == '%') {
106:       newformat[j++] = format[i++];
107:       newformat[j++] = format[i++];
108:     } else if (format[i] == '%') {
109:       if (format[i + 1] == 'g') {
110:         newformat[j++] = '[';
111:         newformat[j++] = '|';
112:       }
113:       /* Find the letter */
114:       for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
115:       switch (format[i]) {
116:       case 'D':
117: #if !defined(PETSC_USE_64BIT_INDICES)
118:         newformat[j++] = 'd';
119: #else
120:         newformat[j++] = 'l';
121:         newformat[j++] = 'l';
122:         newformat[j++] = 'd';
123: #endif
124:         break;
125:       case 'g':
126:         newformat[j++] = format[i];
127:         if (format[i - 1] == '%') {
128:           newformat[j++] = '|';
129:           newformat[j++] = ']';
130:         }
131:         break;
132:       case 'G':
133:         SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "%%G format is no longer supported, use %%g and cast the argument to double");
134:       case 'F':
135:         SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "%%F format is no longer supported, use %%f and cast the argument to double");
136:       default:
137:         newformat[j++] = format[i];
138:         break;
139:       }
140:       i++;
141:     } else newformat[j++] = format[i++];
142:   }
143:   newformat[j] = 0;
144:   PetscFunctionReturn(PETSC_SUCCESS);
145: }

147: #define PETSCDEFAULTBUFFERSIZE 8 * 1024

149: /*@C
150:      PetscVSNPrintf - The PETSc version of `vsnprintf()`. Ensures that all `%g` formatted arguments' output contains the decimal point (which
151:      is used by the test harness)

153:    Input Parameters:
154: +   str - location to put result
155: .   len - the length of `str`
156: -   format - the PETSc format string

158:     Output Parameter:
159: .   fullLength - the amount of space in `str` actually used.

161:    Level: developer

163:    Developer Note:
164:    This function may be called from an error handler, if an error occurs when it is called by the error handler than likely
165:    a recursion will occur resulting in a crash of the program.

167:    If the length of the format string `format` is on the order of `PETSCDEFAULTBUFFERSIZE` (8 * 1024 bytes) or larger, this function will call `PetscMalloc()`

169: .seealso: `PetscFormatConvert()`, `PetscFormatConvertGetSize()`, `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscVPrintf()`
170: @*/
171: PetscErrorCode PetscVSNPrintf(char *str, size_t len, const char *format, size_t *fullLength, va_list Argp)
172: {
173:   char  *newformat = NULL;
174:   char   formatbuf[PETSCDEFAULTBUFFERSIZE];
175:   size_t newLength;
176:   int    flen;

178:   PetscFunctionBegin;
179:   PetscCall(PetscFormatConvertGetSize(format, &newLength));
180:   if (newLength < sizeof(formatbuf)) {
181:     newformat = formatbuf;
182:     newLength = sizeof(formatbuf) - 1;
183:   } else {
184:     PetscCall(PetscMalloc1(newLength, &newformat));
185:   }
186:   PetscCall(PetscFormatConvert(format, newformat));
187: #if defined(PETSC_HAVE_VSNPRINTF)
188:   flen = vsnprintf(str, len, newformat, Argp);
189: #else
190:   #error "vsnprintf not found"
191: #endif
192:   if (newLength > sizeof(formatbuf) - 1) PetscCall(PetscFree(newformat));
193:   {
194:     PetscBool foundedot;
195:     size_t    cnt = 0, ncnt = 0, leng;
196:     PetscCall(PetscStrlen(str, &leng));
197:     if (leng > 4) {
198:       for (cnt = 0; cnt < leng - 4; cnt++) {
199:         if (str[cnt] == '[' && str[cnt + 1] == '|') {
200:           flen -= 4;
201:           cnt++;
202:           cnt++;
203:           foundedot = PETSC_FALSE;
204:           for (; cnt < leng - 1; cnt++) {
205:             if (str[cnt] == '|' && str[cnt + 1] == ']') {
206:               cnt++;
207:               if (!foundedot) str[ncnt++] = '.';
208:               ncnt--;
209:               break;
210:             } else {
211:               if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
212:               str[ncnt++] = str[cnt];
213:             }
214:           }
215:         } else {
216:           str[ncnt] = str[cnt];
217:         }
218:         ncnt++;
219:       }
220:       while (cnt < leng) {
221:         str[ncnt] = str[cnt];
222:         ncnt++;
223:         cnt++;
224:       }
225:       str[ncnt] = 0;
226:     }
227:   }
228: #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
229:   /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
230:   {
231:     size_t cnt = 0, ncnt = 0, leng;
232:     PetscCall(PetscStrlen(str, &leng));
233:     if (leng > 5) {
234:       for (cnt = 0; cnt < leng - 4; cnt++) {
235:         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') {
236:           str[ncnt] = str[cnt];
237:           ncnt++;
238:           cnt++;
239:           str[ncnt] = str[cnt];
240:           ncnt++;
241:           cnt++;
242:           cnt++;
243:           str[ncnt] = str[cnt];
244:         } else {
245:           str[ncnt] = str[cnt];
246:         }
247:         ncnt++;
248:       }
249:       while (cnt < leng) {
250:         str[ncnt] = str[cnt];
251:         ncnt++;
252:         cnt++;
253:       }
254:       str[ncnt] = 0;
255:     }
256:   }
257: #endif
258:   if (fullLength) *fullLength = 1 + (size_t)flen;
259:   PetscFunctionReturn(PETSC_SUCCESS);
260: }

262: /*@C
263:   PetscFFlush - Flush a file stream

265:   Input Parameter:
266: . fd - The file stream handle

268:   Level: intermediate

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

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

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

280: .seealso: `PetscPrintf()`, `PetscFPrintf()`, `PetscVFPrintf()`, `PetscVSNPrintf()`
281: @*/
282: PetscErrorCode PetscFFlush(FILE *fd)
283: {
284:   int ret;

286:   PetscFunctionBegin;
288:   ret = fflush(fd);
289:   // could also use PetscCallExternal() here, but since we can get additional error explanation
290:   // from strerror() we opted for a manual check
291:   PetscCheck(ret == 0, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error in fflush(): error code %d (%s)", ret, strerror(errno));
292:   PetscFunctionReturn(PETSC_SUCCESS);
293: }

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

299:       To use, write your own function for example,
300: .vb
301:    PetscErrorCode mypetscvfprintf(FILE *fd, const char format[], va_list Argp)
302:    {
303:      PetscErrorCode ierr;

305:      PetscFunctionBegin;
306:       if (fd != stdout && fd != stderr) {  handle regular files
307:          CHKERR(PetscVFPrintfDefault(fd,format,Argp));
308:      } else {
309:         char   buff[BIG];
310:         size_t length;
311:         PetscCall(PetscVSNPrintf(buff,BIG,format,&length,Argp));
312:         now send buff to whatever stream or whatever you want
313:     }
314:     PetscFunctionReturn(PETSC_SUCCESS);
315:    }
316: .ve
317:    then before the call to `PetscInitialize()` do the assignment `PetscVFPrintf = mypetscvfprintf`;

319:   Level:  developer

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

325:    Developer Note:
326:    This could be called by an error handler, if that happens then a recursion of the error handler may occur
327:    and a resulting crash

329: .seealso: `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscFFlush()`
330: @*/
331: PetscErrorCode PetscVFPrintfDefault(FILE *fd, const char *format, va_list Argp)
332: {
333:   char   str[PETSCDEFAULTBUFFERSIZE];
334:   char  *buff = str;
335:   size_t fullLength;
336: #if defined(PETSC_HAVE_VA_COPY)
337:   va_list Argpcopy;
338: #endif

340:   PetscFunctionBegin;
341: #if defined(PETSC_HAVE_VA_COPY)
342:   va_copy(Argpcopy, Argp);
343: #endif
344:   PetscCall(PetscVSNPrintf(str, sizeof(str), format, &fullLength, Argp));
345:   if (fullLength > sizeof(str)) {
346:     PetscCall(PetscMalloc1(fullLength, &buff));
347: #if defined(PETSC_HAVE_VA_COPY)
348:     PetscCall(PetscVSNPrintf(buff, fullLength, format, NULL, Argpcopy));
349: #else
350:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
351: #endif
352:   }
353: #if defined(PETSC_HAVE_VA_COPY)
354:   va_end(Argpcopy);
355: #endif
356:   {
357:     const int err = fprintf(fd, "%s", buff);
358:     // cannot use PetscCallExternal() for fprintf since the return value is "number of
359:     // characters transmitted to the output stream" on success
360:     PetscCheck(err >= 0, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "fprintf() returned error code %d", err);
361:   }
362:   PetscCall(PetscFFlush(fd));
363:   if (buff != str) PetscCall(PetscFree(buff));
364:   PetscFunctionReturn(PETSC_SUCCESS);
365: }

367: /*@C
368:     PetscSNPrintf - Prints to a string of given length

370:     Not Collective

372:     Input Parameters:
373: +   len - the length of `str`
374: .   format - the usual `printf()` format string
375: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

377:     Output Parameter:
378: .   str - the resulting string

380:    Level: intermediate

382: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
383:           `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
384:           `PetscVFPrintf()`, `PetscFFlush()`
385: @*/
386: PetscErrorCode PetscSNPrintf(char *str, size_t len, const char format[], ...)
387: {
388:   size_t  fullLength;
389:   va_list Argp;

391:   PetscFunctionBegin;
392:   va_start(Argp, format);
393:   PetscCall(PetscVSNPrintf(str, len, format, &fullLength, Argp));
394:   va_end(Argp);
395:   PetscFunctionReturn(PETSC_SUCCESS);
396: }

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

401:     Not Collective

403:     Input Parameters:
404: +   len - the length of `str`
405: .   format - the usual `printf()` format string
406: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

408:     Output Parameters:
409: +   str - the resulting string
410: -   countused - number of characters printed

412:    Level: intermediate

414: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
415:           `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscSNPrintf()`, `PetscVFPrintf()`
416: @*/
417: PetscErrorCode PetscSNPrintfCount(char *str, size_t len, const char format[], size_t *countused, ...)
418: {
419:   va_list Argp;

421:   PetscFunctionBegin;
422:   va_start(Argp, countused);
423:   PetscCall(PetscVSNPrintf(str, len, format, countused, Argp));
424:   va_end(Argp);
425:   PetscFunctionReturn(PETSC_SUCCESS);
426: }

428: PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL;
429: int         petsc_printfqueuelength = 0;

431: static inline PetscErrorCode PetscVFPrintf_Private(MPI_Comm comm, FILE *fd, const char format[], va_list Argp)
432: {
433:   const PetscBool tee = (PetscBool)(petsc_history && (fd != petsc_history));
434:   PetscMPIInt     rank;
435:   va_list         cpy;

437:   PetscFunctionBegin;
438:   PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
439:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
440:   if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
441:   // must do this before we possibly consume Argp
442:   if (tee) va_copy(cpy, Argp);
443:   PetscCall((*PetscVFPrintf)(fd, format, Argp));
444:   if (tee) {
445:     PetscCall((*PetscVFPrintf)(petsc_history, format, cpy));
446:     va_end(cpy);
447:   }
448:   PetscFunctionReturn(PETSC_SUCCESS);
449: }

451: static inline PetscErrorCode PetscSynchronizedFPrintf_Private(MPI_Comm comm, FILE *fp, const char format[], va_list Argp)
452: {
453:   PetscMPIInt rank;
454:   va_list     cpy;

456:   PetscFunctionBegin;
457:   PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
458:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
459:   /* First processor prints immediately to fp */
460:   if (rank == 0) {
461:     va_copy(cpy, Argp);
462:     PetscCall(PetscVFPrintf_Private(comm, fp, format, cpy));
463:     va_end(cpy);
464:   } else { /* other processors add to local queue */
465:     PrintfQueue next;
466:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

468:     PetscCall(PetscNew(&next));
469:     if (petsc_printfqueue) {
470:       petsc_printfqueue->next = next;
471:       petsc_printfqueue       = next;
472:       petsc_printfqueue->next = NULL;
473:     } else petsc_printfqueuebase = petsc_printfqueue = next;
474:     petsc_printfqueuelength++;
475:     next->size   = 0;
476:     next->string = NULL;
477:     while (fullLength >= next->size) {
478:       next->size = fullLength + 1;
479:       PetscCall(PetscFree(next->string));
480:       PetscCall(PetscMalloc1(next->size, &next->string));
481:       PetscCall(PetscArrayzero(next->string, next->size));
482:       va_copy(cpy, Argp);
483:       PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, cpy));
484:       va_end(cpy);
485:     }
486:   }
487:   PetscFunctionReturn(PETSC_SUCCESS);
488: }

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

494:     Not Collective

496:     Input Parameters:
497: +   comm - the MPI communicator
498: -   format - the usual `printf()` format string

500:    Level: intermediate

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

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

510: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`,
511:           `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
512:           `PetscFFlush()`
513: @*/
514: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...)
515: {
516:   va_list Argp;

518:   PetscFunctionBegin;
519:   va_start(Argp, format);
520:   PetscCall(PetscSynchronizedFPrintf_Private(comm, PETSC_STDOUT, format, Argp));
521:   va_end(Argp);
522:   PetscFunctionReturn(PETSC_SUCCESS);
523: }

525: /*@C
526:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
527:     several MPI processes.  Output of the first process is followed by that of the
528:     second, etc.

530:     Not Collective

532:     Input Parameters:
533: +   comm - the MPI communicator
534: .   fd - the file pointer
535: -   format - the usual `printf()` format string

537:     Level: intermediate

539:     Note:
540:     REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information
541:     from all the processors to be printed.

543: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`,
544:           `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
545:           `PetscFFlush()`
546: @*/
547: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...)
548: {
549:   va_list Argp;

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

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

562:     Collective

564:     Input Parameters:
565: +   comm - the MPI communicator
566: -   fd - the file pointer (valid on MPI rank 0 of the communicator)

568:     Level: intermediate

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

574:     Fortran Note:
575:     Pass `PETSC_STDOUT` if the flush is for standard out; otherwise pass a value obtained from `PetscFOpen()`

577: .seealso: `PetscSynchronizedPrintf()`, `PetscFPrintf()`, `PetscPrintf()`, `PetscViewerASCIIPrintf()`,
578:           `PetscViewerASCIISynchronizedPrintf()`
579: @*/
580: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm, FILE *fd)
581: {
582:   PetscMPIInt rank, size, tag, i, j, n = 0, dummy = 0;
583:   char       *message;
584:   MPI_Status  status;

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

591:   /* First processor waits for messages from all other processors */
592:   if (rank == 0) {
593:     if (!fd) fd = PETSC_STDOUT;
594:     for (i = 1; i < size; i++) {
595:       /* to prevent a flood of messages to process zero, request each message separately */
596:       PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm));
597:       PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status));
598:       for (j = 0; j < n; j++) {
599:         PetscMPIInt size = 0;

601:         PetscCallMPI(MPI_Recv(&size, 1, MPI_INT, i, tag, comm, &status));
602:         PetscCall(PetscMalloc1(size, &message));
603:         PetscCallMPI(MPI_Recv(message, size, MPI_CHAR, i, tag, comm, &status));
604:         PetscCall(PetscFPrintf(comm, fd, "%s", message));
605:         PetscCall(PetscFree(message));
606:       }
607:     }
608:   } else { /* other processors send queue to processor 0 */
609:     PrintfQueue next = petsc_printfqueuebase, previous;

611:     PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status));
612:     PetscCallMPI(MPI_Send(&petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm));
613:     for (i = 0; i < petsc_printfqueuelength; i++) {
614:       PetscCallMPI(MPI_Send(&next->size, 1, MPI_INT, 0, tag, comm));
615:       PetscCallMPI(MPI_Send(next->string, next->size, MPI_CHAR, 0, tag, comm));
616:       previous = next;
617:       next     = next->next;
618:       PetscCall(PetscFree(previous->string));
619:       PetscCall(PetscFree(previous));
620:     }
621:     petsc_printfqueue       = NULL;
622:     petsc_printfqueuelength = 0;
623:   }
624:   PetscCall(PetscCommDestroy(&comm));
625:   PetscFunctionReturn(PETSC_SUCCESS);
626: }

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

632:     Not Collective; No Fortran Support

634:     Input Parameters:
635: +   comm - the MPI communicator
636: .   fd - the file pointer
637: -   format - the usual `printf()` format string

639:     Level: intermediate

641:     Developer Note:
642:     This maybe, and is, called from PETSc error handlers and `PetscMallocValidate()` hence it does not use `PetscCallMPI()` which
643:     could recursively restart the malloc validation.

645: .seealso: `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
646:           `PetscViewerASCIISynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFFlush()`
647: @*/
648: PetscErrorCode PetscFPrintf(MPI_Comm comm, FILE *fd, const char format[], ...)
649: {
650:   va_list Argp;

652:   PetscFunctionBegin;
653:   va_start(Argp, format);
654:   PetscCall(PetscVFPrintf_Private(comm, fd, format, Argp));
655:   va_end(Argp);
656:   PetscFunctionReturn(PETSC_SUCCESS);
657: }

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

663:     Not Collective

665:     Input Parameters:
666: +   comm - the communicator
667: -   format - the usual `printf()` format string

669:     Level: intermediate

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

675:     Fortran Note:
676:     The call sequence is `PetscPrintf`(MPI_Comm, character(*), `PetscErrorCode` ierr) from Fortran.
677:     That is, you can only pass a single character string from Fortran.

679: .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()`
680: @*/
681: PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...)
682: {
683:   va_list Argp;

685:   PetscFunctionBegin;
686:   va_start(Argp, format);
687:   PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp));
688:   va_end(Argp);
689:   PetscFunctionReturn(PETSC_SUCCESS);
690: }

692: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...)
693: {
694:   va_list Argp;

696:   PetscFunctionBegin;
697:   va_start(Argp, format);
698:   PetscCall(PetscVFPrintf_Private(comm, PETSC_STDOUT, format, Argp));
699:   va_end(Argp);
700:   PetscFunctionReturn(PETSC_SUCCESS);
701: }

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

706:     Collective

708:     Input Parameters:
709: +   comm - the MPI communicator
710: .   fd - the file pointer
711: -   len - the length of `string`

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

716:     Level: intermediate

718: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`,
719:           `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`
720: @*/
721: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[])
722: {
723:   PetscMPIInt rank;

725:   PetscFunctionBegin;
726:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
727:   if (rank == 0) {
728:     if (!fgets(string, len, fp)) {
729:       string[0] = 0;
730:       PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file due to \"%s\"", strerror(errno));
731:     }
732:   }
733:   PetscCallMPI(MPI_Bcast(string, len, MPI_BYTE, 0, comm));
734:   PetscFunctionReturn(PETSC_SUCCESS);
735: }

737: /*@C
738:      PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to `%` operations

740:    Input Parameter:
741: .   format - the PETSc format string

743:    Level: developer
744: @*/
745: PetscErrorCode PetscFormatStrip(char *format)
746: {
747:   size_t loc1 = 0, loc2 = 0;

749:   PetscFunctionBegin;
750:   while (format[loc2]) {
751:     if (format[loc2] == '%') {
752:       format[loc1++] = format[loc2++];
753:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
754:     }
755:     format[loc1++] = format[loc2++];
756:   }
757:   PetscFunctionReturn(PETSC_SUCCESS);
758: }

760: PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[])
761: {
762:   PetscInt i;
763:   size_t   left, count;
764:   char    *p;

766:   PetscFunctionBegin;
767:   for (i = 0, p = buf, left = len; i < n; i++) {
768:     PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i]));
769:     PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer");
770:     left -= count;
771:     p += count - 1;
772:     *p++ = ' ';
773:   }
774:   p[i ? 0 : -1] = 0;
775:   PetscFunctionReturn(PETSC_SUCCESS);
776: }