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
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: Input Parameters:
155: + str - location to put result
156: . len - the length of `str`
157: . format - the PETSc format string
158: - Argp - the variable argument list to format
160: Output Parameter:
161: . fullLength - the amount of space in `str` actually used.
163: Level: developer
165: Developer Notes:
166: This function may be called from an error handler, if an error occurs when it is called by the error handler than likely
167: a recursion will occur resulting in a crash of the program.
169: If the length of the format string `format` is on the order of `PETSCDEFAULTBUFFERSIZE` (8 * 1024 bytes) or larger, this function will call `PetscMalloc()`
171: .seealso: `PetscFormatConvert()`, `PetscFormatConvertGetSize()`, `PetscErrorPrintf()`, `PetscVPrintf()`
172: @*/
173: PetscErrorCode PetscVSNPrintf(char *str, size_t len, const char *format, size_t *fullLength, va_list Argp)
174: {
175: char *newformat = NULL;
176: char formatbuf[PETSCDEFAULTBUFFERSIZE];
177: size_t newLength;
178: int flen;
180: PetscFunctionBegin;
181: PetscCall(PetscFormatConvertGetSize(format, &newLength));
182: if (newLength < sizeof(formatbuf)) {
183: newformat = formatbuf;
184: newLength = sizeof(formatbuf) - 1;
185: } else {
186: PetscCall(PetscMalloc1(newLength, &newformat));
187: }
188: PetscCall(PetscFormatConvert(format, newformat));
189: #if defined(PETSC_HAVE_VSNPRINTF)
190: flen = vsnprintf(str, len, newformat, Argp);
191: #else
192: #error "vsnprintf not found"
193: #endif
194: if (newLength > sizeof(formatbuf) - 1) PetscCall(PetscFree(newformat));
195: {
196: PetscBool foundedot;
197: size_t cnt = 0, ncnt = 0, leng;
198: PetscCall(PetscStrlen(str, &leng));
199: if (leng > 4) {
200: for (cnt = 0; cnt < leng - 4; cnt++) {
201: if (str[cnt] == '[' && str[cnt + 1] == '|') {
202: flen -= 4;
203: cnt++;
204: cnt++;
205: foundedot = PETSC_FALSE;
206: for (; cnt < leng - 1; cnt++) {
207: if (str[cnt] == '|' && str[cnt + 1] == ']') {
208: cnt++;
209: if (!foundedot) str[ncnt++] = '.';
210: ncnt--;
211: break;
212: } else {
213: if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
214: str[ncnt++] = str[cnt];
215: }
216: }
217: } else {
218: str[ncnt] = str[cnt];
219: }
220: ncnt++;
221: }
222: while (cnt < leng) {
223: str[ncnt] = str[cnt];
224: ncnt++;
225: cnt++;
226: }
227: str[ncnt] = 0;
228: }
229: }
230: #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
231: /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
232: {
233: size_t cnt = 0, ncnt = 0, leng;
234: PetscCall(PetscStrlen(str, &leng));
235: if (leng > 5) {
236: for (cnt = 0; cnt < leng - 4; cnt++) {
237: 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') {
238: str[ncnt] = str[cnt];
239: ncnt++;
240: cnt++;
241: str[ncnt] = str[cnt];
242: ncnt++;
243: cnt++;
244: cnt++;
245: str[ncnt] = str[cnt];
246: } else {
247: str[ncnt] = str[cnt];
248: }
249: ncnt++;
250: }
251: while (cnt < leng) {
252: str[ncnt] = str[cnt];
253: ncnt++;
254: cnt++;
255: }
256: str[ncnt] = 0;
257: }
258: }
259: #endif
260: if (fullLength) *fullLength = 1 + (size_t)flen;
261: PetscFunctionReturn(PETSC_SUCCESS);
262: }
264: /*@C
265: PetscFFlush - Flush a file stream
267: Input Parameter:
268: . fd - The file stream handle
270: Level: intermediate
272: Notes:
273: For output streams (and for update streams on which the last operation was output), writes
274: any unwritten data from the stream's buffer to the associated output device.
276: For input streams (and for update streams on which the last operation was input), the
277: behavior is undefined.
279: If `fd` is `NULL`, all open output streams are flushed, including ones not directly
280: accessible to the program.
282: .seealso: `PetscPrintf()`, `PetscFPrintf()`, `PetscVFPrintf()`, `PetscVSNPrintf()`
283: @*/
284: PetscErrorCode PetscFFlush(FILE *fd)
285: {
286: PetscFunctionBegin;
287: if (fd) PetscAssertPointer(fd, 1);
288: // could also use PetscCallExternal() here, but since we can get additional error explanation
289: // from strerror() we opted for a manual check
290: PetscCheck(0 == fflush(fd), PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error in fflush() due to \"%s\"", strerror(errno));
291: PetscFunctionReturn(PETSC_SUCCESS);
292: }
294: /*@C
295: PetscVFPrintfDefault - All PETSc standard out and error messages are sent through this function; so, in theory, this can
296: can be replaced with something that does not simply write to a file.
298: Input Parameters:
299: + fd - the file descriptor to write to
300: . format - the format string to write with
301: - Argp - the variable argument list of items to format and write
303: Level: developer
305: Note:
306: For error messages this may be called by any MPI process, for regular standard out it is
307: called only by MPI rank 0 of a given communicator
309: Example Usage:
310: To use, write your own function for example,
311: .vb
312: PetscErrorCode mypetscvfprintf(FILE *fd, const char format[], va_list Argp)
313: {
314: PetscErrorCode ierr;
316: PetscFunctionBegin;
317: if (fd != stdout && fd != stderr) { handle regular files
318: CHKERR(PetscVFPrintfDefault(fd,format,Argp));
319: } else {
320: char buff[BIG];
321: size_t length;
322: PetscCall(PetscVSNPrintf(buff,BIG,format,&length,Argp));
323: now send buff to whatever stream or whatever you want
324: }
325: PetscFunctionReturn(PETSC_SUCCESS);
326: }
327: .ve
328: then before the call to `PetscInitialize()` do the assignment `PetscVFPrintf = mypetscvfprintf`;
330: Developer Notes:
331: This could be called by an error handler, if that happens then a recursion of the error handler may occur
332: and a resulting crash
334: .seealso: `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscFFlush()`
335: @*/
336: PetscErrorCode PetscVFPrintfDefault(FILE *fd, const char *format, va_list Argp)
337: {
338: char str[PETSCDEFAULTBUFFERSIZE];
339: char *buff = str;
340: size_t fullLength;
341: #if defined(PETSC_HAVE_VA_COPY)
342: va_list Argpcopy;
343: #endif
345: PetscFunctionBegin;
346: #if defined(PETSC_HAVE_VA_COPY)
347: va_copy(Argpcopy, Argp);
348: #endif
349: PetscCall(PetscVSNPrintf(str, sizeof(str), format, &fullLength, Argp));
350: if (fullLength > sizeof(str)) {
351: PetscCall(PetscMalloc1(fullLength, &buff));
352: #if defined(PETSC_HAVE_VA_COPY)
353: PetscCall(PetscVSNPrintf(buff, fullLength, format, NULL, Argpcopy));
354: #else
355: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
356: #endif
357: }
358: #if defined(PETSC_HAVE_VA_COPY)
359: va_end(Argpcopy);
360: #endif
361: {
362: int err;
364: // POSIX C sets errno but otherwise it may not be set for *printf() system calls
365: // https://pubs.opengroup.org/onlinepubs/9699919799/functions/fprintf.html
366: errno = 0;
367: err = fprintf(fd, "%s", buff);
368: // cannot use PetscCallExternal() for fprintf since the return value is "number of
369: // characters transmitted to the output stream" on success
370: 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)");
371: }
372: PetscCall(PetscFFlush(fd));
373: if (buff != str) PetscCall(PetscFree(buff));
374: PetscFunctionReturn(PETSC_SUCCESS);
375: }
377: /*@C
378: PetscSNPrintf - Prints to a string of given length
380: Not Collective
382: Input Parameters:
383: + len - the length of `str`
384: - format - the usual `printf()` format string
386: Output Parameter:
387: . str - the resulting string
389: Level: intermediate
391: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
392: `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
393: `PetscVFPrintf()`, `PetscFFlush()`
394: @*/
395: PetscErrorCode PetscSNPrintf(char *str, size_t len, const char format[], ...)
396: {
397: size_t fullLength;
398: va_list Argp;
400: PetscFunctionBegin;
401: va_start(Argp, format);
402: PetscCall(PetscVSNPrintf(str, len, format, &fullLength, Argp));
403: va_end(Argp);
404: PetscFunctionReturn(PETSC_SUCCESS);
405: }
407: /*@C
408: PetscSNPrintfCount - Prints to a string of given length, returns count of characters printed
410: Not Collective
412: Input Parameters:
413: + len - the length of `str`
414: . format - the usual `printf()` format string
415: - ... - args to format
417: Output Parameters:
418: + str - the resulting string
419: - countused - number of characters printed
421: Level: intermediate
423: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
424: `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscSNPrintf()`, `PetscVFPrintf()`
425: @*/
426: PetscErrorCode PetscSNPrintfCount(char *str, size_t len, const char format[], size_t *countused, ...)
427: {
428: va_list Argp;
430: PetscFunctionBegin;
431: va_start(Argp, countused);
432: PetscCall(PetscVSNPrintf(str, len, format, countused, Argp));
433: va_end(Argp);
434: PetscFunctionReturn(PETSC_SUCCESS);
435: }
437: PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL;
438: int petsc_printfqueuelength = 0;
440: static inline PetscErrorCode PetscVFPrintf_Private(FILE *fd, const char format[], va_list Argp)
441: {
442: const PetscBool tee = (PetscBool)(petsc_history && (fd != petsc_history));
443: va_list cpy;
445: PetscFunctionBegin;
446: // must do this before we possibly consume Argp
447: if (tee) va_copy(cpy, Argp);
448: PetscCall((*PetscVFPrintf)(fd, format, Argp));
449: if (tee) {
450: PetscCall((*PetscVFPrintf)(petsc_history, format, cpy));
451: va_end(cpy);
452: }
453: PetscFunctionReturn(PETSC_SUCCESS);
454: }
456: PETSC_INTERN PetscErrorCode PetscVFPrintf_Internal(FILE *fd, const char format[], ...)
457: {
458: va_list Argp;
460: PetscFunctionBegin;
461: va_start(Argp, format);
462: PetscCall(PetscVFPrintf_Private(fd, format, Argp));
463: va_end(Argp);
464: PetscFunctionReturn(PETSC_SUCCESS);
465: }
467: static inline PetscErrorCode PetscSynchronizedFPrintf_Private(MPI_Comm comm, FILE *fp, const char format[], va_list Argp)
468: {
469: PetscMPIInt rank;
470: va_list cpy;
472: PetscFunctionBegin;
473: PetscCallMPI(MPI_Comm_rank(comm, &rank));
474: /* First processor prints immediately to fp */
475: if (rank == 0) {
476: va_copy(cpy, Argp);
477: PetscCall(PetscVFPrintf_Private(fp, format, cpy));
478: va_end(cpy);
479: } else { /* other processors add to local queue */
480: PrintfQueue next;
481: size_t fullLength = PETSCDEFAULTBUFFERSIZE;
483: PetscCall(PetscNew(&next));
484: if (petsc_printfqueue) {
485: petsc_printfqueue->next = next;
486: petsc_printfqueue = next;
487: petsc_printfqueue->next = NULL;
488: } else petsc_printfqueuebase = petsc_printfqueue = next;
489: petsc_printfqueuelength++;
490: next->size = 0;
491: next->string = NULL;
492: while (fullLength >= next->size) {
493: next->size = fullLength + 1;
494: PetscCall(PetscFree(next->string));
495: PetscCall(PetscMalloc1(next->size, &next->string));
496: PetscCall(PetscArrayzero(next->string, next->size));
497: va_copy(cpy, Argp);
498: PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, cpy));
499: va_end(cpy);
500: }
501: }
502: PetscFunctionReturn(PETSC_SUCCESS);
503: }
505: /*@C
506: PetscSynchronizedPrintf - Prints synchronized output from multiple MPI processes.
507: Output of the first processor is followed by that of the second, etc.
509: Not Collective
511: Input Parameters:
512: + comm - the MPI communicator
513: - format - the usual `printf()` format string
515: Level: intermediate
517: Note:
518: REQUIRES a call to `PetscSynchronizedFlush()` by all the processes after the completion of the calls to `PetscSynchronizedPrintf()` for the information
519: from all the processors to be printed.
521: Fortran Notes:
522: The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, `character`(*), `PetscErrorCode` ierr).
523: That is, you can only pass a single character string from Fortran.
525: .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`,
526: `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
527: `PetscFFlush()`
528: @*/
529: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...)
530: {
531: va_list Argp;
533: PetscFunctionBegin;
534: va_start(Argp, format);
535: PetscCall(PetscSynchronizedFPrintf_Private(comm, PETSC_STDOUT, format, Argp));
536: va_end(Argp);
537: PetscFunctionReturn(PETSC_SUCCESS);
538: }
540: /*@C
541: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
542: several MPI processes. Output of the first process is followed by that of the
543: second, etc.
545: Not Collective
547: Input Parameters:
548: + comm - the MPI communicator
549: . fp - the file pointer
550: - format - the usual `printf()` format string
552: Level: intermediate
554: Note:
555: REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information
556: from all the processors to be printed.
558: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`,
559: `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
560: `PetscFFlush()`
561: @*/
562: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...)
563: {
564: va_list Argp;
566: PetscFunctionBegin;
567: va_start(Argp, format);
568: PetscCall(PetscSynchronizedFPrintf_Private(comm, fp, format, Argp));
569: va_end(Argp);
570: PetscFunctionReturn(PETSC_SUCCESS);
571: }
573: /*@C
574: PetscSynchronizedFlush - Flushes to the screen output from all processors
575: involved in previous `PetscSynchronizedPrintf()`/`PetscSynchronizedFPrintf()` calls.
577: Collective
579: Input Parameters:
580: + comm - the MPI communicator
581: - fd - the file pointer (valid on MPI rank 0 of the communicator)
583: Level: intermediate
585: Note:
586: If `PetscSynchronizedPrintf()` and/or `PetscSynchronizedFPrintf()` are called with
587: different MPI communicators there must be an intervening call to `PetscSynchronizedFlush()` between the calls with different MPI communicators.
589: Fortran Notes:
590: Pass `PETSC_STDOUT` if the flush is for standard out; otherwise pass a value obtained from `PetscFOpen()`
592: .seealso: `PetscSynchronizedPrintf()`, `PetscFPrintf()`, `PetscPrintf()`, `PetscViewerASCIIPrintf()`,
593: `PetscViewerASCIISynchronizedPrintf()`
594: @*/
595: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm, FILE *fd)
596: {
597: PetscMPIInt rank, size, tag, i, j, n = 0, dummy = 0;
598: char *message;
599: MPI_Status status;
601: PetscFunctionBegin;
602: PetscCall(PetscCommDuplicate(comm, &comm, &tag));
603: PetscCallMPI(MPI_Comm_rank(comm, &rank));
604: PetscCallMPI(MPI_Comm_size(comm, &size));
606: /* First processor waits for messages from all other processors */
607: if (rank == 0) {
608: if (!fd) fd = PETSC_STDOUT;
609: for (i = 1; i < size; i++) {
610: /* to prevent a flood of messages to process zero, request each message separately */
611: PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm));
612: PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status));
613: for (j = 0; j < n; j++) {
614: PetscMPIInt size = 0;
616: PetscCallMPI(MPI_Recv(&size, 1, MPI_INT, i, tag, comm, &status));
617: PetscCall(PetscMalloc1(size, &message));
618: PetscCallMPI(MPI_Recv(message, size, MPI_CHAR, i, tag, comm, &status));
619: PetscCall(PetscFPrintf(comm, fd, "%s", message));
620: PetscCall(PetscFree(message));
621: }
622: }
623: } else { /* other processors send queue to processor 0 */
624: PrintfQueue next = petsc_printfqueuebase, previous;
626: PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status));
627: PetscCallMPI(MPI_Send(&petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm));
628: for (i = 0; i < petsc_printfqueuelength; i++) {
629: PetscCallMPI(MPI_Send(&next->size, 1, MPI_INT, 0, tag, comm));
630: PetscCallMPI(MPI_Send(next->string, next->size, MPI_CHAR, 0, tag, comm));
631: previous = next;
632: next = next->next;
633: PetscCall(PetscFree(previous->string));
634: PetscCall(PetscFree(previous));
635: }
636: petsc_printfqueue = NULL;
637: petsc_printfqueuelength = 0;
638: }
639: PetscCall(PetscCommDestroy(&comm));
640: PetscFunctionReturn(PETSC_SUCCESS);
641: }
643: /*@C
644: PetscFPrintf - Prints to a file, only from the first
645: MPI process in the communicator.
647: Not Collective; No Fortran Support
649: Input Parameters:
650: + comm - the MPI communicator
651: . fd - the file pointer
652: - format - the usual `printf()` format string
654: Level: intermediate
656: Developer Notes:
657: This maybe, and is, called from PETSc error handlers and `PetscMallocValidate()` hence it does not use `PetscCallMPI()` which
658: could recursively restart the malloc validation.
660: .seealso: `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
661: `PetscViewerASCIISynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFFlush()`
662: @*/
663: PetscErrorCode PetscFPrintf(MPI_Comm comm, FILE *fd, const char format[], ...)
664: {
665: PetscMPIInt rank;
666: va_list Argp;
668: PetscFunctionBegin;
669: PetscCallMPI(MPI_Comm_rank(comm, &rank));
670: if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
671: va_start(Argp, format);
672: PetscCall(PetscVFPrintf_Private(fd, format, Argp));
673: va_end(Argp);
674: PetscFunctionReturn(PETSC_SUCCESS);
675: }
677: /*@C
678: PetscPrintf - Prints to standard out, only from the first
679: MPI process in the communicator. Calls from other processes are ignored.
681: Not Collective
683: Input Parameters:
684: + comm - the communicator
685: - format - the usual `printf()` format string
687: Level: intermediate
689: Note:
690: Deprecated information: `PetscPrintf()` supports some format specifiers that are unique to PETSc.
691: See the manual page for `PetscFormatConvert()` for details.
693: Fortran Notes:
694: The call sequence is `PetscPrintf`(MPI_Comm, character(*), `PetscErrorCode` ierr) from Fortran.
695: That is, you can only pass a single character string from Fortran.
697: .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()`
698: @*/
699: PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...)
700: {
701: PetscMPIInt rank;
702: va_list Argp;
704: PetscFunctionBegin;
705: PetscCallMPI(MPI_Comm_rank(comm, &rank));
706: if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
707: va_start(Argp, format);
708: PetscCall(PetscVFPrintf_Private(PETSC_STDOUT, format, Argp));
709: va_end(Argp);
710: PetscFunctionReturn(PETSC_SUCCESS);
711: }
713: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...)
714: {
715: PetscMPIInt rank;
716: va_list Argp;
718: PetscFunctionBegin;
719: PetscCallMPI(MPI_Comm_rank(comm, &rank));
720: if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
721: va_start(Argp, format);
722: PetscCall(PetscVFPrintf_Private(PETSC_STDOUT, format, Argp));
723: va_end(Argp);
724: PetscFunctionReturn(PETSC_SUCCESS);
725: }
727: /*@C
728: PetscSynchronizedFGets - Multiple MPI processes all get the same line from a file.
730: Collective
732: Input Parameters:
733: + comm - the MPI communicator
734: . fp - the file pointer
735: - len - the length of `string`
737: Output Parameter:
738: . string - the line read from the file, at end of file `string`[0] == 0
740: Level: intermediate
742: .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`,
743: `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`
744: @*/
745: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[])
746: {
747: PetscMPIInt rank;
749: PetscFunctionBegin;
750: PetscCallMPI(MPI_Comm_rank(comm, &rank));
751: if (rank == 0) {
752: if (!fgets(string, len, fp)) {
753: string[0] = 0;
754: PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file due to \"%s\"", strerror(errno));
755: }
756: }
757: PetscCallMPI(MPI_Bcast(string, len, MPI_BYTE, 0, comm));
758: PetscFunctionReturn(PETSC_SUCCESS);
759: }
761: PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[])
762: {
763: PetscInt i;
764: size_t left, count;
765: char *p;
767: PetscFunctionBegin;
768: for (i = 0, p = buf, left = len; i < n; i++) {
769: PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i]));
770: PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer");
771: left -= count;
772: p += count - 1;
773: *p++ = ' ';
774: }
775: p[i ? 0 : -1] = 0;
776: PetscFunctionReturn(PETSC_SUCCESS);
777: }