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 format converted with `PetscFormatConvert()`

 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: .   newformat - the location to put the new format
 87: -   size - the length of newformat, you can use `PetscFormatConvertGetSize()` to compute the needed size

 89:    Level: developer

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

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

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

145: #define PETSCDEFAULTBUFFERSIZE 8 * 1024

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

151:    Input Parameters:
152: +   str - location to put result
153: .   len - the amount of space in str
154: +   format - the PETSc format string
155: -   fullLength - the amount of space in str actually used.

157:    Level: developer

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

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

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

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

258: /*@C
259:   PetscFFlush - Flush a file stream

261:   Input Parameter:
262: . fd - The file stream handle

264:   Level: intermediate

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

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

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

276: .seealso: `PetscPrintf()`, `PetscFPrintf()`, `PetscVFPrintf()`, `PetscVSNPrintf()`
277: @*/
278: PetscErrorCode PetscFFlush(FILE *fd)
279: {
280:   int ret;

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

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

295:       To use, write your own function for example,
296: .vb
297:    PetscErrorCode mypetscvfprintf(FILE *fd, const char format[], va_list Argp)
298:    {
299:      PetscErrorCode ierr;

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

315:   Level:  developer

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

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

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

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

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

363:     Not Collective

365:     Input Parameters:
366: +   str - the string to print to
367: .   len - the length of `str`
368: .   format - the usual `printf()` format string
369: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

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:   PetscFunctionReturn(PETSC_SUCCESS);
386: }

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

391:     Not Collective

393:     Input Parameters:
394: +   str - the string to print to
395: .   len - the length of `str`
396: .   format - the usual `printf()` format string
397: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

399:     Output Parameter:
400: .   countused - number of characters printed

402:    Level: intermediate

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

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

417: /* ----------------------------------------------------------------------- */

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

422: /*@C
423:     PetscSynchronizedPrintf - Prints synchronized output from several processors.
424:     Output of the first processor is followed by that of the second, etc.

426:     Not Collective

428:     Input Parameters:
429: +   comm - the MPI communicator
430: -   format - the usual `printf()` format string

432:    Level: intermediate

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

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

442: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`,
443:           `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
444:           `PetscFFlush()`
445: @*/
446: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...)
447: {
448:   PetscMPIInt rank;

450:   PetscFunctionBegin;
451:   PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
452:   PetscCallMPI(MPI_Comm_rank(comm, &rank));

454:   /* First processor prints immediately to stdout */
455:   if (rank == 0) {
456:     va_list Argp;
457:     va_start(Argp, format);
458:     PetscCall((*PetscVFPrintf)(PETSC_STDOUT, format, Argp));
459:     if (petsc_history) {
460:       va_start(Argp, format);
461:       PetscCall((*PetscVFPrintf)(petsc_history, format, Argp));
462:     }
463:     va_end(Argp);
464:   } else { /* other processors add to local queue */
465:     va_list     Argp;
466:     PrintfQueue next;
467:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

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

491: /*@C
492:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
493:     several processors.  Output of the first processor is followed by that of the
494:     second, etc.

496:     Not Collective

498:     Input Parameters:
499: +   comm - the MPI communicator
500: .   fd - the file pointer
501: -   format - the usual `printf()` format string

503:     Level: intermediate

505:     Note:
506:     REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information
507:     from all the processors to be printed.

509: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`,
510:           `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
511:           `PetscFFlush()`
512: @*/
513: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...)
514: {
515:   PetscMPIInt rank;

517:   PetscFunctionBegin;
518:   PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
519:   PetscCallMPI(MPI_Comm_rank(comm, &rank));

521:   /* First processor prints immediately to fp */
522:   if (rank == 0) {
523:     va_list Argp;
524:     va_start(Argp, format);
525:     PetscCall((*PetscVFPrintf)(fp, format, Argp));
526:     if (petsc_history && (fp != petsc_history)) {
527:       va_start(Argp, format);
528:       PetscCall((*PetscVFPrintf)(petsc_history, format, Argp));
529:     }
530:     va_end(Argp);
531:   } else { /* other processors add to local queue */
532:     va_list     Argp;
533:     PrintfQueue next;
534:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

536:     PetscCall(PetscNew(&next));
537:     if (petsc_printfqueue) {
538:       petsc_printfqueue->next = next;
539:       petsc_printfqueue       = next;
540:       petsc_printfqueue->next = NULL;
541:     } else petsc_printfqueuebase = petsc_printfqueue = next;
542:     petsc_printfqueuelength++;
543:     next->size   = 0;
544:     next->string = NULL;
545:     while (fullLength >= next->size) {
546:       next->size = fullLength + 1;
547:       PetscCall(PetscFree(next->string));
548:       PetscCall(PetscMalloc1(next->size, &next->string));
549:       va_start(Argp, format);
550:       PetscCall(PetscArrayzero(next->string, next->size));
551:       PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, Argp));
552:       va_end(Argp);
553:     }
554:   }
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 process 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: /* ---------------------------------------------------------------------------------------*/

630: /*@C
631:     PetscFPrintf - Prints to a file, only from the first
632:     processor in the communicator.

634:     Not Collective; No Fortran Support

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

641:     Level: intermediate

643:     Developer Note:
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;

654:   PetscFunctionBegin;
655:   PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
656:   PetscCheck(MPI_SUCCESS == MPI_Comm_rank(comm, &rank), comm, PETSC_ERR_MPI, "Error inside MPI_Comm_rank() in PetscFPrintf");
657:   if (rank == 0) {
658:     va_list Argp;
659:     va_start(Argp, format);
660:     PetscCall((*PetscVFPrintf)(fd, format, Argp));
661:     if (petsc_history && (fd != petsc_history)) {
662:       va_start(Argp, format);
663:       PetscCall((*PetscVFPrintf)(petsc_history, format, Argp));
664:     }
665:     va_end(Argp);
666:   }
667:   PetscFunctionReturn(PETSC_SUCCESS);
668: }

670: /*@C
671:     PetscPrintf - Prints to standard out, only from the first
672:     processor in the communicator. Calls from other processes are ignored.

674:     Not Collective

676:     Input Parameters:
677: +   comm - the communicator
678: -   format - the usual printf() format string

680:     Level: intermediate

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

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

690: .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()`
691: @*/
692: PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...)
693: {
694:   PetscMPIInt rank;

696:   PetscFunctionBegin;
697:   PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
698:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
699:   if (rank == 0) {
700:     va_list Argp;
701:     va_start(Argp, format);
702:     PetscCall((*PetscVFPrintf)(PETSC_STDOUT, format, Argp));
703:     if (petsc_history) {
704:       va_start(Argp, format);
705:       PetscCall((*PetscVFPrintf)(petsc_history, format, Argp));
706:     }
707:     va_end(Argp);
708:   }
709:   PetscFunctionReturn(PETSC_SUCCESS);
710: }

712: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...)
713: {
714:   PetscMPIInt rank;

716:   PetscFunctionBegin;
717:   PetscCheck(comm != MPI_COMM_NULL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
718:   PetscCallMPI(MPI_Comm_rank(comm, &rank));
719:   if (rank == 0) {
720:     va_list Argp;
721:     va_start(Argp, format);
722:     PetscCall((*PetscVFPrintf)(PETSC_STDOUT, format, Argp));
723:     if (petsc_history) {
724:       va_start(Argp, format);
725:       PetscCall((*PetscVFPrintf)(petsc_history, format, Argp));
726:     }
727:     va_end(Argp);
728:   }
729:   PetscFunctionReturn(PETSC_SUCCESS);
730: }

732: /* ---------------------------------------------------------------------------------------*/

734: /*@C
735:     PetscSynchronizedFGets - Several processors all get the same line from a file.

737:     Collective

739:     Input Parameters:
740: +   comm - the communicator
741: .   fd - the file pointer
742: -   len - the length of the output buffer

744:     Output Parameter:
745: .   string - the line read from the file, at end of file string[0] == 0

747:     Level: intermediate

749: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`,
750:           `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`
751: @*/
752: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[])
753: {
754:   PetscMPIInt rank;

756:   PetscFunctionBegin;
757:   PetscCallMPI(MPI_Comm_rank(comm, &rank));

759:   if (rank == 0) {
760:     char *ptr = fgets(string, len, fp);

762:     if (!ptr) {
763:       string[0] = 0;
764:       PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
765:     }
766:   }
767:   PetscCallMPI(MPI_Bcast(string, len, MPI_BYTE, 0, comm));
768:   PetscFunctionReturn(PETSC_SUCCESS);
769: }

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

774:    Input Parameters:
775: .   format - the PETSc format string

777:  Level: developer

779: @*/
780: PetscErrorCode PetscFormatStrip(char *format)
781: {
782:   size_t loc1 = 0, loc2 = 0;

784:   PetscFunctionBegin;
785:   while (format[loc2]) {
786:     if (format[loc2] == '%') {
787:       format[loc1++] = format[loc2++];
788:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
789:     }
790:     format[loc1++] = format[loc2++];
791:   }
792:   PetscFunctionReturn(PETSC_SUCCESS);
793: }

795: PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[])
796: {
797:   PetscInt i;
798:   size_t   left, count;
799:   char    *p;

801:   PetscFunctionBegin;
802:   for (i = 0, p = buf, left = len; i < n; i++) {
803:     PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i]));
804:     PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer");
805:     left -= count;
806:     p += count - 1;
807:     *p++ = ' ';
808:   }
809:   p[i ? 0 : -1] = 0;
810:   PetscFunctionReturn(PETSC_SUCCESS);
811: }