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