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;
23
24 /*@C
25 PetscFormatConvertGetSize - Gets the length of a string needed to hold data converted with `PetscFormatConvert()` based on the format
26
27 No Fortran Support
28
29 Input Parameter:
30 . format - the PETSc format string
31
32 Output Parameter:
33 . size - the needed length of the new format
34
35 Level: developer
36
37 .seealso: `PetscFormatConvert()`, `PetscVSNPrintf()`, `PetscVFPrintf()`
38 @*/
PetscFormatConvertGetSize(const char format[],size_t * size)39 PetscErrorCode PetscFormatConvertGetSize(const char format[], size_t *size)
40 {
41 size_t sz = 0;
42 PetscInt i = 0;
43
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 }
77
78 /*@C
79 PetscFormatConvert - converts %g to [|%g|] so that `PetscVSNPrintf()` can ensure all %g formatted numbers have a decimal point when printed.
80
81 No Fortran Support
82
83 Input Parameter:
84 . format - the PETSc format string
85
86 Output Parameter:
87 . newformat - the formatted string, must be long enough to hold result
88
89 Level: developer
90
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.
94
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.
98
99 .seealso: `PetscFormatConvertGetSize()`, `PetscVSNPrintf()`, `PetscVFPrintf()`
100 @*/
PetscFormatConvert(const char format[],char newformat[])101 PetscErrorCode PetscFormatConvert(const char format[], char newformat[])
102 {
103 PetscInt i = 0, j = 0;
104
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 }
148
149 #define PETSCDEFAULTBUFFERSIZE 8 * 1024
150
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)
153
154 No Fortran Support
155
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
161
162 Output Parameter:
163 . fullLength - the amount of space in `str` actually used.
164
165 Level: developer
166
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.
170
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()`
172
173 .seealso: `PetscFormatConvert()`, `PetscFormatConvertGetSize()`, `PetscErrorPrintf()`, `PetscVPrintf()`
174 @*/
PetscVSNPrintf(char str[],size_t len,const char format[],size_t * fullLength,va_list Argp)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;
181
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 (fullLength) *fullLength = 1 + (size_t)flen;
233 PetscFunctionReturn(PETSC_SUCCESS);
234 }
235
236 /*@C
237 PetscFFlush - Flush a file stream
238
239 Input Parameter:
240 . fd - The file stream handle
241
242 Level: intermediate
243
244 Notes:
245 For output streams (and for update streams on which the last operation was output), writes
246 any unwritten data from the stream's buffer to the associated output device.
247
248 For input streams (and for update streams on which the last operation was input), the
249 behavior is undefined.
250
251 If `fd` is `NULL`, all open output streams are flushed, including ones not directly
252 accessible to the program.
253
254 Fortran Note:
255 Use `PetscFlush()`
256
257 .seealso: `PetscPrintf()`, `PetscFPrintf()`, `PetscVFPrintf()`, `PetscVSNPrintf()`
258 @*/
PetscFFlush(FILE * fd)259 PetscErrorCode PetscFFlush(FILE *fd)
260 {
261 int err;
262
263 PetscFunctionBegin;
264 if (fd) PetscAssertPointer(fd, 1);
265 err = fflush(fd);
266 #if !defined(PETSC_MISSING_SIGPIPE) && defined(EPIPE) && defined(ECONNRESET)
267 if (fd && err && (errno == EPIPE || errno == ECONNRESET)) err = 0; /* ignore error, rely on SIGPIPE */
268 #endif
269 // could also use PetscCallExternal() here, but since we can get additional error explanation
270 // from strerror() we opted for a manual check
271 PetscCheck(0 == err, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error in fflush() due to \"%s\"", strerror(errno));
272 PetscFunctionReturn(PETSC_SUCCESS);
273 }
274
275 /*@C
276 PetscVFPrintfDefault - All PETSc standard out and error messages are sent through this function; so, in theory, this can
277 can be replaced with something that does not simply write to a file.
278
279 No Fortran Support
280
281 Input Parameters:
282 + fd - the file descriptor to write to
283 . format - the format string to write with
284 - Argp - the variable argument list of items to format and write
285
286 Level: developer
287
288 Note:
289 For error messages this may be called by any MPI process, for regular standard out it is
290 called only by MPI rank 0 of a given communicator
291
292 Example Usage:
293 To use, write your own function for example,
294 .vb
295 PetscErrorCode mypetscvfprintf(FILE *fd, const char format[], va_list Argp)
296 {
297
298 PetscFunctionBegin;
299 if (fd != stdout && fd != stderr) { handle regular files
300 CHKERR(PetscVFPrintfDefault(fd,format,Argp));
301 } else {
302 char buff[BIG];
303 size_t length;
304 PetscCall(PetscVSNPrintf(buff,BIG,format,&length,Argp));
305 now send buff to whatever stream or whatever you want
306 }
307 PetscFunctionReturn(PETSC_SUCCESS);
308 }
309 .ve
310 then before the call to `PetscInitialize()` do the assignment `PetscVFPrintf = mypetscvfprintf`;
311
312 Developer Notes:
313 This could be called by an error handler, if that happens then a recursion of the error handler may occur
314 and a resulting crash
315
316 .seealso: `PetscVSNPrintf()`, `PetscErrorPrintf()`, `PetscFFlush()`
317 @*/
PetscVFPrintfDefault(FILE * fd,const char format[],va_list Argp)318 PetscErrorCode PetscVFPrintfDefault(FILE *fd, const char format[], va_list Argp)
319 {
320 char str[PETSCDEFAULTBUFFERSIZE];
321 char *buff = str;
322 size_t fullLength;
323 #if defined(PETSC_HAVE_VA_COPY)
324 va_list Argpcopy;
325 #endif
326
327 PetscFunctionBegin;
328 #if defined(PETSC_HAVE_VA_COPY)
329 va_copy(Argpcopy, Argp);
330 #endif
331 PetscCall(PetscVSNPrintf(str, sizeof(str), format, &fullLength, Argp));
332 if (fullLength > sizeof(str)) {
333 PetscCall(PetscMalloc1(fullLength, &buff));
334 #if defined(PETSC_HAVE_VA_COPY)
335 PetscCall(PetscVSNPrintf(buff, fullLength, format, NULL, Argpcopy));
336 #else
337 SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
338 #endif
339 }
340 #if defined(PETSC_HAVE_VA_COPY)
341 va_end(Argpcopy);
342 #endif
343 {
344 int err;
345
346 // POSIX C sets errno but otherwise it may not be set for *printf() system calls
347 // https://pubs.opengroup.org/onlinepubs/9699919799/functions/fprintf.html
348 errno = 0;
349 err = fprintf(fd, "%s", buff);
350 // cannot use PetscCallExternal() for fprintf since the return value is "number of
351 // characters transmitted to the output stream" on success
352 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)");
353 }
354 PetscCall(PetscFFlush(fd));
355 if (buff != str) PetscCall(PetscFree(buff));
356 PetscFunctionReturn(PETSC_SUCCESS);
357 }
358
359 /*@C
360 PetscSNPrintf - Prints to a string of given length
361
362 Not Collective, No Fortran Support
363
364 Input Parameters:
365 + len - the length of `str`
366 - format - the usual `printf()` format string
367
368 Output Parameter:
369 . str - the resulting string
370
371 Level: intermediate
372
373 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
374 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
375 `PetscVFPrintf()`, `PetscFFlush()`
376 @*/
PetscSNPrintf(char str[],size_t len,const char format[],...)377 PetscErrorCode PetscSNPrintf(char str[], size_t len, const char format[], ...)
378 {
379 size_t fullLength;
380 va_list Argp;
381
382 PetscFunctionBegin;
383 va_start(Argp, format);
384 PetscCall(PetscVSNPrintf(str, len, format, &fullLength, Argp));
385 va_end(Argp);
386 PetscFunctionReturn(PETSC_SUCCESS);
387 }
388
389 /*@C
390 PetscSNPrintfCount - Prints to a string of given length, returns count of characters printed
391
392 Not Collective, No Fortran Support
393
394 Input Parameters:
395 + len - the length of `str`
396 . format - the usual `printf()` format string
397 - ... - args to format
398
399 Output Parameters:
400 + str - the resulting string
401 - countused - number of characters printed
402
403 Level: intermediate
404
405 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`, `PetscVSNPrintf()`,
406 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscSNPrintf()`, `PetscVFPrintf()`
407 @*/
PetscSNPrintfCount(char str[],size_t len,const char format[],size_t * countused,...)408 PetscErrorCode PetscSNPrintfCount(char str[], size_t len, const char format[], size_t *countused, ...)
409 {
410 va_list Argp;
411
412 PetscFunctionBegin;
413 va_start(Argp, countused);
414 PetscCall(PetscVSNPrintf(str, len, format, countused, Argp));
415 va_end(Argp);
416 PetscFunctionReturn(PETSC_SUCCESS);
417 }
418
419 PrintfQueue petsc_printfqueue = NULL, petsc_printfqueuebase = NULL;
420 int petsc_printfqueuelength = 0;
421
PetscVFPrintf_Private(FILE * fd,const char format[],va_list Argp)422 static inline PetscErrorCode PetscVFPrintf_Private(FILE *fd, const char format[], va_list Argp)
423 {
424 const PetscBool tee = (PetscBool)(petsc_history && (fd != petsc_history));
425 va_list cpy;
426
427 PetscFunctionBegin;
428 // must do this before we possibly consume Argp
429 if (tee) va_copy(cpy, Argp);
430 PetscCall((*PetscVFPrintf)(fd, format, Argp));
431 if (tee) {
432 PetscCall((*PetscVFPrintf)(petsc_history, format, cpy));
433 va_end(cpy);
434 }
435 PetscFunctionReturn(PETSC_SUCCESS);
436 }
437
PetscVFPrintf_Internal(FILE * fd,const char format[],...)438 PETSC_INTERN PetscErrorCode PetscVFPrintf_Internal(FILE *fd, const char format[], ...)
439 {
440 va_list Argp;
441
442 PetscFunctionBegin;
443 va_start(Argp, format);
444 PetscCall(PetscVFPrintf_Private(fd, format, Argp));
445 va_end(Argp);
446 PetscFunctionReturn(PETSC_SUCCESS);
447 }
448
PetscSynchronizedFPrintf_Private(MPI_Comm comm,FILE * fp,const char format[],va_list Argp)449 static inline PetscErrorCode PetscSynchronizedFPrintf_Private(MPI_Comm comm, FILE *fp, const char format[], va_list Argp)
450 {
451 PetscMPIInt rank;
452 va_list cpy;
453
454 PetscFunctionBegin;
455 PetscCallMPI(MPI_Comm_rank(comm, &rank));
456 /* First processor prints immediately to fp */
457 if (rank == 0) {
458 va_copy(cpy, Argp);
459 PetscCall(PetscVFPrintf_Private(fp, format, cpy));
460 va_end(cpy);
461 } else { /* other processors add to local queue */
462 PrintfQueue next;
463 size_t fullLength = PETSCDEFAULTBUFFERSIZE;
464
465 PetscCall(PetscNew(&next));
466 if (petsc_printfqueue) {
467 petsc_printfqueue->next = next;
468 petsc_printfqueue = next;
469 petsc_printfqueue->next = NULL;
470 } else petsc_printfqueuebase = petsc_printfqueue = next;
471 petsc_printfqueuelength++;
472 next->size = 0;
473 next->string = NULL;
474 while (fullLength >= next->size) {
475 next->size = fullLength + 1;
476 PetscCall(PetscFree(next->string));
477 PetscCall(PetscMalloc1(next->size, &next->string));
478 PetscCall(PetscArrayzero(next->string, next->size));
479 va_copy(cpy, Argp);
480 PetscCall(PetscVSNPrintf(next->string, next->size, format, &fullLength, cpy));
481 va_end(cpy);
482 }
483 }
484 PetscFunctionReturn(PETSC_SUCCESS);
485 }
486
487 /*@C
488 PetscSynchronizedPrintf - Prints synchronized output from multiple MPI processes.
489 Output of the first processor is followed by that of the second, etc.
490
491 Not Collective
492
493 Input Parameters:
494 + comm - the MPI communicator
495 - format - the usual `printf()` format string
496
497 Level: intermediate
498
499 Note:
500 REQUIRES a call to `PetscSynchronizedFlush()` by all the processes after the completion of the calls to `PetscSynchronizedPrintf()` for the information
501 from all the processors to be printed.
502
503 Fortran Note:
504 The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, `character`(*), `PetscErrorCode` ierr).
505 That is, you can only pass a single character string from Fortran.
506
507 .seealso: `PetscSynchronizedFlush()`, `PetscSynchronizedFPrintf()`, `PetscFPrintf()`,
508 `PetscPrintf()`, `PetscViewerASCIIPrintf()`, `PetscViewerASCIISynchronizedPrintf()`,
509 `PetscFFlush()`
510 @*/
PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)511 PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm, const char format[], ...)
512 {
513 va_list Argp;
514
515 PetscFunctionBegin;
516 va_start(Argp, format);
517 PetscCall(PetscSynchronizedFPrintf_Private(comm, PETSC_STDOUT, format, Argp));
518 va_end(Argp);
519 PetscFunctionReturn(PETSC_SUCCESS);
520 }
521
522 /*@C
523 PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
524 several MPI processes. Output of the first process is followed by that of the
525 second, etc.
526
527 Not Collective
528
529 Input Parameters:
530 + comm - the MPI communicator
531 . fp - the file pointer, `PETSC_STDOUT` or value obtained from `PetscFOpen()`
532 - format - the usual `printf()` format string
533
534 Level: intermediate
535
536 Note:
537 REQUIRES a intervening call to `PetscSynchronizedFlush()` for the information
538 from all the processors to be printed.
539
540 Fortran Note:
541 The call sequence is `PetscSynchronizedPrintf`(`MPI_Comm`, fp, `character`(*), `PetscErrorCode` ierr).
542 That is, you can only pass a single character string from Fortran.
543
544 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFPrintf()`,
545 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
546 `PetscFFlush()`
547 @*/
PetscSynchronizedFPrintf(MPI_Comm comm,FILE * fp,const char format[],...)548 PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm, FILE *fp, const char format[], ...)
549 {
550 va_list Argp;
551
552 PetscFunctionBegin;
553 va_start(Argp, format);
554 PetscCall(PetscSynchronizedFPrintf_Private(comm, fp, format, Argp));
555 va_end(Argp);
556 PetscFunctionReturn(PETSC_SUCCESS);
557 }
558
559 /*@C
560 PetscSynchronizedFlush - Flushes to the screen output from all processors
561 involved in previous `PetscSynchronizedPrintf()`/`PetscSynchronizedFPrintf()` calls.
562
563 Collective
564
565 Input Parameters:
566 + comm - the MPI communicator
567 - fd - the file pointer (valid on MPI rank 0 of the communicator), `PETSC_STDOUT` or value obtained from `PetscFOpen()`
568
569 Level: intermediate
570
571 Note:
572 If `PetscSynchronizedPrintf()` and/or `PetscSynchronizedFPrintf()` are called with
573 different MPI communicators there must be an intervening call to `PetscSynchronizedFlush()` between the calls with different MPI communicators.
574
575 .seealso: `PetscSynchronizedPrintf()`, `PetscFPrintf()`, `PetscPrintf()`, `PetscViewerASCIIPrintf()`,
576 `PetscViewerASCIISynchronizedPrintf()`
577 @*/
PetscSynchronizedFlush(MPI_Comm comm,FILE * fd)578 PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm, FILE *fd)
579 {
580 PetscMPIInt rank, size, tag, i, j, n = 0, dummy = 0;
581 char *message;
582 MPI_Status status;
583
584 PetscFunctionBegin;
585 PetscCall(PetscCommDuplicate(comm, &comm, &tag));
586 PetscCallMPI(MPI_Comm_rank(comm, &rank));
587 PetscCallMPI(MPI_Comm_size(comm, &size));
588
589 /* First processor waits for messages from all other processors */
590 if (rank == 0) {
591 if (!fd) fd = PETSC_STDOUT;
592 for (i = 1; i < size; i++) {
593 /* to prevent a flood of messages to process zero, request each message separately */
594 PetscCallMPI(MPI_Send(&dummy, 1, MPI_INT, i, tag, comm));
595 PetscCallMPI(MPI_Recv(&n, 1, MPI_INT, i, tag, comm, &status));
596 for (j = 0; j < n; j++) {
597 PetscMPIInt size = 0;
598
599 PetscCallMPI(MPI_Recv(&size, 1, MPI_INT, i, tag, comm, &status));
600 PetscCall(PetscMalloc1(size, &message));
601 PetscCallMPI(MPI_Recv(message, size, MPI_CHAR, i, tag, comm, &status));
602 PetscCall(PetscFPrintf(comm, fd, "%s", message));
603 PetscCall(PetscFree(message));
604 }
605 }
606 } else { /* other processors send queue to processor 0 */
607 PrintfQueue next = petsc_printfqueuebase, previous;
608
609 PetscCallMPI(MPI_Recv(&dummy, 1, MPI_INT, 0, tag, comm, &status));
610 PetscCallMPI(MPI_Send(&petsc_printfqueuelength, 1, MPI_INT, 0, tag, comm));
611 for (i = 0; i < petsc_printfqueuelength; i++) {
612 PetscCallMPI(MPI_Send(&next->size, 1, MPI_INT, 0, tag, comm));
613 PetscCallMPI(MPI_Send(next->string, (PetscMPIInt)next->size, MPI_CHAR, 0, tag, comm));
614 previous = next;
615 next = next->next;
616 PetscCall(PetscFree(previous->string));
617 PetscCall(PetscFree(previous));
618 }
619 petsc_printfqueue = NULL;
620 petsc_printfqueuelength = 0;
621 }
622 PetscCall(PetscCommDestroy(&comm));
623 PetscFunctionReturn(PETSC_SUCCESS);
624 }
625
626 /*@C
627 PetscFPrintf - Prints to a file, only from the first
628 MPI process in the communicator.
629
630 Not Collective
631
632 Input Parameters:
633 + comm - the MPI communicator
634 . fd - the file pointer, `PETSC_STDOUT` or value obtained from `PetscFOpen()`
635 - format - the usual `printf()` format string
636
637 Level: intermediate
638
639 Fortran Note:
640 The call sequence is `PetscFPrintf`(`MPI_Comm`, fp, `character`(*), `PetscErrorCode` ierr).
641 That is, you can only pass a single character string from Fortran.
642
643 Developer Notes:
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.
646
647 .seealso: `PetscPrintf()`, `PetscSynchronizedPrintf()`, `PetscViewerASCIIPrintf()`,
648 `PetscViewerASCIISynchronizedPrintf()`, `PetscSynchronizedFlush()`, `PetscFFlush()`
649 @*/
PetscFPrintf(MPI_Comm comm,FILE * fd,const char format[],...)650 PetscErrorCode PetscFPrintf(MPI_Comm comm, FILE *fd, const char format[], ...)
651 {
652 PetscMPIInt rank;
653 va_list Argp;
654
655 PetscFunctionBegin;
656 PetscCallMPI(MPI_Comm_rank(comm, &rank));
657 if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
658 va_start(Argp, format);
659 PetscCall(PetscVFPrintf_Private(fd, format, Argp));
660 va_end(Argp);
661 PetscFunctionReturn(PETSC_SUCCESS);
662 }
663
664 /*@C
665 PetscPrintf - Prints to standard out, only from the first
666 MPI process in the communicator. Calls from other processes are ignored.
667
668 Not Collective
669
670 Input Parameters:
671 + comm - the communicator
672 - format - the usual `printf()` format string
673
674 Level: intermediate
675
676 Note:
677 Deprecated information: `PetscPrintf()` supports some format specifiers that are unique to PETSc.
678 See the manual page for `PetscFormatConvert()` for details.
679
680 Fortran Notes:
681 The call sequence is `PetscPrintf`(`MPI_Comm`, `character(*)`, `PetscErrorCode` ierr).
682 That is, you can only pass a single character string from Fortran.
683
684 .seealso: `PetscFPrintf()`, `PetscSynchronizedPrintf()`, `PetscFormatConvert()`, `PetscFFlush()`
685 @*/
PetscPrintf(MPI_Comm comm,const char format[],...)686 PetscErrorCode PetscPrintf(MPI_Comm comm, const char format[], ...)
687 {
688 PetscMPIInt rank;
689 va_list Argp;
690
691 PetscFunctionBegin;
692 PetscCallMPI(MPI_Comm_rank(comm, &rank));
693 if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
694 va_start(Argp, format);
695 PetscCall(PetscVFPrintf_Private(PETSC_STDOUT, format, Argp));
696 va_end(Argp);
697 PetscFunctionReturn(PETSC_SUCCESS);
698 }
699
PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)700 PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm, const char format[], ...)
701 {
702 PetscMPIInt rank;
703 va_list Argp;
704
705 PetscFunctionBegin;
706 PetscCallMPI(MPI_Comm_rank(comm, &rank));
707 if (PetscLikely(rank != 0)) PetscFunctionReturn(PETSC_SUCCESS);
708 va_start(Argp, format);
709 PetscCall(PetscVFPrintf_Private(PETSC_STDOUT, format, Argp));
710 va_end(Argp);
711 PetscFunctionReturn(PETSC_SUCCESS);
712 }
713
714 /*@C
715 PetscSynchronizedFGets - Multiple MPI processes all get the same line from a file.
716
717 Collective
718
719 Input Parameters:
720 + comm - the MPI communicator
721 . fp - the file pointer
722 - len - the length of `string`
723
724 Output Parameter:
725 . string - the line read from the file, at end of file `string`[0] == 0
726
727 Level: intermediate
728
729 .seealso: `PetscSynchronizedPrintf()`, `PetscSynchronizedFlush()`,
730 `PetscFOpen()`, `PetscViewerASCIISynchronizedPrintf()`, `PetscViewerASCIIPrintf()`
731 @*/
PetscSynchronizedFGets(MPI_Comm comm,FILE * fp,size_t len,char string[])732 PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm, FILE *fp, size_t len, char string[])
733 {
734 PetscMPIInt rank;
735
736 PetscFunctionBegin;
737 PetscCallMPI(MPI_Comm_rank(comm, &rank));
738 if (rank == 0) {
739 if (!fgets(string, (int)len, fp)) {
740 string[0] = 0;
741 PetscCheck(feof(fp), PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file due to \"%s\"", strerror(errno));
742 }
743 }
744 PetscCallMPI(MPI_Bcast(string, (PetscMPIInt)len, MPI_BYTE, 0, comm));
745 PetscFunctionReturn(PETSC_SUCCESS);
746 }
747
PetscFormatRealArray(char buf[],size_t len,const char * fmt,PetscInt n,const PetscReal x[])748 PetscErrorCode PetscFormatRealArray(char buf[], size_t len, const char *fmt, PetscInt n, const PetscReal x[])
749 {
750 PetscInt i;
751 size_t left, count;
752 char *p;
753
754 PetscFunctionBegin;
755 for (i = 0, p = buf, left = len; i < n; i++) {
756 PetscCall(PetscSNPrintfCount(p, left, fmt, &count, (double)x[i]));
757 PetscCheck(count < left, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Insufficient space in buffer");
758 left -= count;
759 p += count - 1;
760 *p++ = ' ';
761 }
762 p[i ? 0 : -1] = 0;
763 PetscFunctionReturn(PETSC_SUCCESS);
764 }
765