Actual source code: mprint.c
1: /*
2: Utilites 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: Input Parameter:
28: . format - the PETSc format string
30: Output Parameter:
31: . size - the needed length of the new format
33: Level: developer
35: .seealso: PetscFormatConvert(), PetscVSNPrintf(), PetscVFPrintf()
37: @*/
38: PetscErrorCode PetscFormatConvertGetSize(const char *format,size_t *size)
39: {
40: PetscInt i = 0;
43: *size = 0;
44: while (format[i]) {
45: if (format[i] == '%' && format[i+1] == '%') {
46: i++; i++; *size += 2;
47: } else if (format[i] == '%') {
48: /* Find the letter */
49: for (; format[i] && format[i] <= '9'; i++,(*size += 1));
50: switch (format[i]) {
51: case 'D':
52: #if defined(PETSC_USE_64BIT_INDICES)
53: *size += 2;
54: #endif
55: break;
56: case 'g':
57: *size += 4;
58: break;
59: default:
60: break;
61: }
62: *size += 1;
63: i++;
64: } else {
65: i++;
66: *size += 1;
67: }
68: }
69: *size += 1; /* space for NULL character */
70: return(0);
71: }
73: /*@C
74: PetscFormatConvert - Takes a PETSc format string and converts the %D to %d for 32 bit PETSc indices and %lld for 64 bit PETSc indices. Also
75: converts %g to [|%g|] so that PetscVSNPrintf() can easily insure all %g formatted numbers have a decimal point when printed.
77: Input Parameters:
78: + format - the PETSc format string
79: . newformat - the location to put the new format
80: - size - the length of newformat, you can use PetscFormatConvertGetSize() to compute the needed size
82: Note: this exists so we can have the same code when PetscInt is either int or long long int
84: Level: developer
86: .seealso: PetscFormatConvertGetSize(), PetscVSNPrintf(), PetscVFPrintf()
88: @*/
89: PetscErrorCode PetscFormatConvert(const char *format,char *newformat)
90: {
91: PetscInt i = 0, j = 0;
94: while (format[i]) {
95: if (format[i] == '%' && format[i+1] == '%') {
96: newformat[j++] = format[i++];
97: newformat[j++] = format[i++];
98: } else if (format[i] == '%') {
99: if (format[i+1] == 'g') {
100: newformat[j++] = '[';
101: newformat[j++] = '|';
102: }
103: /* Find the letter */
104: for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
105: switch (format[i]) {
106: case 'D':
107: #if !defined(PETSC_USE_64BIT_INDICES)
108: newformat[j++] = 'd';
109: #else
110: newformat[j++] = 'l';
111: newformat[j++] = 'l';
112: newformat[j++] = 'd';
113: #endif
114: break;
115: case 'g':
116: newformat[j++] = format[i];
117: if (format[i-1] == '%') {
118: newformat[j++] = '|';
119: newformat[j++] = ']';
120: }
121: break;
122: case 'G':
123: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%G format is no longer supported, use %%g and cast the argument to double");
124: case 'F':
125: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
126: default:
127: newformat[j++] = format[i];
128: break;
129: }
130: i++;
131: } else newformat[j++] = format[i++];
132: }
133: newformat[j] = 0;
134: return(0);
135: }
137: #define PETSCDEFAULTBUFFERSIZE 8*1024
139: /*@C
140: PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
141: function arguments into a string using the format statement.
143: Input Parameters:
144: + str - location to put result
145: . len - the amount of space in str
146: + format - the PETSc format string
147: - fullLength - the amount of space in str actually used.
149: Developer Notes:
150: this function may be called from an error handler, if an error occurs when it is called by the error handler than likely
151: a recursion will occur and possible crash.
153: Level: developer
155: .seealso: PetscVSNPrintf(), PetscErrorPrintf(), PetscVPrintf()
157: @*/
158: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
159: {
160: char *newformat = NULL;
161: char formatbuf[PETSCDEFAULTBUFFERSIZE];
162: size_t newLength;
164: int flen;
167: PetscFormatConvertGetSize(format,&newLength);
168: if (newLength < PETSCDEFAULTBUFFERSIZE) {
169: newformat = formatbuf;
170: newLength = PETSCDEFAULTBUFFERSIZE-1;
171: } else {
172: PetscMalloc1(newLength, &newformat);
173: }
174: PetscFormatConvert(format,newformat);
175: #if defined(PETSC_HAVE_VSNPRINTF)
176: flen = vsnprintf(str,len,newformat,Argp);
177: #else
178: #error "vsnprintf not found"
179: #endif
180: if (newLength > PETSCDEFAULTBUFFERSIZE-1) {
181: PetscFree(newformat);
182: }
183: {
184: PetscBool foundedot;
185: size_t cnt = 0,ncnt = 0,leng;
186: PetscStrlen(str,&leng);
187: if (leng > 4) {
188: for (cnt=0; cnt<leng-4; cnt++) {
189: if (str[cnt] == '[' && str[cnt+1] == '|') {
190: flen -= 4;
191: cnt++; cnt++;
192: foundedot = PETSC_FALSE;
193: for (; cnt<leng-1; cnt++) {
194: if (str[cnt] == '|' && str[cnt+1] == ']') {
195: cnt++;
196: if (!foundedot) str[ncnt++] = '.';
197: ncnt--;
198: break;
199: } else {
200: if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
201: str[ncnt++] = str[cnt];
202: }
203: }
204: } else {
205: str[ncnt] = str[cnt];
206: }
207: ncnt++;
208: }
209: while (cnt < leng) {
210: str[ncnt] = str[cnt]; ncnt++; cnt++;
211: }
212: str[ncnt] = 0;
213: }
214: }
215: #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
216: /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
217: {
218: size_t cnt = 0,ncnt = 0,leng;
219: PetscStrlen(str,&leng);
220: if (leng > 5) {
221: for (cnt=0; cnt<leng-4; cnt++) {
222: 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') {
223: str[ncnt] = str[cnt]; ncnt++; cnt++;
224: str[ncnt] = str[cnt]; ncnt++; cnt++; cnt++;
225: str[ncnt] = str[cnt];
226: } else {
227: str[ncnt] = str[cnt];
228: }
229: ncnt++;
230: }
231: while (cnt < leng) {
232: str[ncnt] = str[cnt]; ncnt++; cnt++;
233: }
234: str[ncnt] = 0;
235: }
236: }
237: #endif
238: if (fullLength) *fullLength = 1 + (size_t) flen;
239: return(0);
240: }
242: /*@C
243: PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
244: can be replaced with something that does not simply write to a file.
246: To use, write your own function for example,
247: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
248: ${
250: $
252: $ if (fd != stdout && fd != stderr) { handle regular files
253: $ PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
254: $ } else {
255: $ char buff[BIG];
256: $ size_t length;
257: $ PetscVSNPrintf(buff,BIG,format,&length,Argp);
258: $ now send buff to whatever stream or whatever you want
259: $ }
260: $ return(0);
261: $}
262: then before the call to PetscInitialize() do the assignment
263: $ PetscVFPrintf = mypetscvfprintf;
265: Notes:
266: For error messages this may be called by any process, for regular standard out it is
267: called only by process 0 of a given communicator
269: Developer Notes:
270: this could be called by an error handler, if that happens then a recursion of the error handler may occur
271: and a crash
273: Level: developer
275: .seealso: PetscVSNPrintf(), PetscErrorPrintf()
277: @*/
278: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
279: {
280: char str[PETSCDEFAULTBUFFERSIZE];
281: char *buff = str;
282: size_t fullLength;
284: #if defined(PETSC_HAVE_VA_COPY)
285: va_list Argpcopy;
286: #endif
289: #if defined(PETSC_HAVE_VA_COPY)
290: va_copy(Argpcopy,Argp);
291: #endif
292: PetscVSNPrintf(str,sizeof(str),format,&fullLength,Argp);
293: if (fullLength > sizeof(str)) {
294: PetscMalloc1(fullLength,&buff);
295: #if defined(PETSC_HAVE_VA_COPY)
296: PetscVSNPrintf(buff,fullLength,format,NULL,Argpcopy);
297: #else
298: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
299: #endif
300: }
301: fprintf(fd,"%s",buff);
302: fflush(fd);
303: if (buff != str) {
304: PetscFree(buff);
305: }
306: return(0);
307: }
309: /*@C
310: PetscSNPrintf - Prints to a string of given length
312: Not Collective
314: Input Parameters:
315: + str - the string to print to
316: . len - the length of str
317: . format - the usual printf() format string
318: - ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument
320: Level: intermediate
322: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
323: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscVFPrintf()
324: @*/
325: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
326: {
328: size_t fullLength;
329: va_list Argp;
332: va_start(Argp,format);
333: PetscVSNPrintf(str,len,format,&fullLength,Argp);
334: return(0);
335: }
337: /*@C
338: PetscSNPrintfCount - Prints to a string of given length, returns count
340: Not Collective
342: Input Parameters:
343: + str - the string to print to
344: . len - the length of str
345: . format - the usual printf() format string
346: - ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument
348: Output Parameter:
349: . countused - number of characters used
351: Level: intermediate
353: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
354: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf(), PetscVFPrintf()
355: @*/
356: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
357: {
359: va_list Argp;
362: va_start(Argp,countused);
363: PetscVSNPrintf(str,len,format,countused,Argp);
364: return(0);
365: }
367: /* ----------------------------------------------------------------------- */
369: PrintfQueue petsc_printfqueue = NULL,petsc_printfqueuebase = NULL;
370: int petsc_printfqueuelength = 0;
372: /*@C
373: PetscSynchronizedPrintf - Prints synchronized output from several processors.
374: Output of the first processor is followed by that of the second, etc.
376: Not Collective
378: Input Parameters:
379: + comm - the communicator
380: - format - the usual printf() format string
382: Level: intermediate
384: Notes:
385: REQUIRES a call to PetscSynchronizedFlush() by all the processes after the completion of the calls to PetscSynchronizedPrintf() for the information
386: from all the processors to be printed.
388: Fortran Note:
389: The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
390: That is, you can only pass a single character string from Fortran.
392: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
393: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
394: @*/
395: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
396: {
398: PetscMPIInt rank;
401: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
402: MPI_Comm_rank(comm,&rank);
404: /* First processor prints immediately to stdout */
405: if (rank == 0) {
406: va_list Argp;
407: va_start(Argp,format);
408: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
409: if (petsc_history) {
410: va_start(Argp,format);
411: (*PetscVFPrintf)(petsc_history,format,Argp);
412: }
413: va_end(Argp);
414: } else { /* other processors add to local queue */
415: va_list Argp;
416: PrintfQueue next;
417: size_t fullLength = PETSCDEFAULTBUFFERSIZE;
419: PetscNew(&next);
420: if (petsc_printfqueue) {
421: petsc_printfqueue->next = next;
422: petsc_printfqueue = next;
423: petsc_printfqueue->next = NULL;
424: } else petsc_printfqueuebase = petsc_printfqueue = next;
425: petsc_printfqueuelength++;
426: next->size = -1;
427: next->string = NULL;
428: while ((PetscInt)fullLength >= next->size) {
429: next->size = fullLength+1;
430: PetscFree(next->string);
431: PetscMalloc1(next->size, &next->string);
432: va_start(Argp,format);
433: PetscArrayzero(next->string,next->size);
434: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
435: va_end(Argp);
436: }
437: }
438: return(0);
439: }
441: /*@C
442: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
443: several processors. Output of the first processor is followed by that of the
444: second, etc.
446: Not Collective
448: Input Parameters:
449: + comm - the communicator
450: . fd - the file pointer
451: - format - the usual printf() format string
453: Level: intermediate
455: Notes:
456: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
457: from all the processors to be printed.
459: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
460: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
462: @*/
463: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
464: {
466: PetscMPIInt rank;
469: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
470: MPI_Comm_rank(comm,&rank);
472: /* First processor prints immediately to fp */
473: if (rank == 0) {
474: va_list Argp;
475: va_start(Argp,format);
476: (*PetscVFPrintf)(fp,format,Argp);
477: if (petsc_history && (fp !=petsc_history)) {
478: va_start(Argp,format);
479: (*PetscVFPrintf)(petsc_history,format,Argp);
480: }
481: va_end(Argp);
482: } else { /* other processors add to local queue */
483: va_list Argp;
484: PrintfQueue next;
485: size_t fullLength = PETSCDEFAULTBUFFERSIZE;
487: PetscNew(&next);
488: if (petsc_printfqueue) {
489: petsc_printfqueue->next = next;
490: petsc_printfqueue = next;
491: petsc_printfqueue->next = NULL;
492: } else petsc_printfqueuebase = petsc_printfqueue = next;
493: petsc_printfqueuelength++;
494: next->size = -1;
495: next->string = NULL;
496: while ((PetscInt)fullLength >= next->size) {
497: next->size = fullLength+1;
498: PetscFree(next->string);
499: PetscMalloc1(next->size, &next->string);
500: va_start(Argp,format);
501: PetscArrayzero(next->string,next->size);
502: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
503: va_end(Argp);
504: }
505: }
506: return(0);
507: }
509: /*@C
510: PetscSynchronizedFlush - Flushes to the screen output from all processors
511: involved in previous PetscSynchronizedPrintf()/PetscSynchronizedFPrintf() calls.
513: Collective
515: Input Parameters:
516: + comm - the communicator
517: - fd - the file pointer (valid on process 0 of the communicator)
519: Level: intermediate
521: Notes:
522: If PetscSynchronizedPrintf() and/or PetscSynchronizedFPrintf() are called with
523: different MPI communicators there must be an intervening call to PetscSynchronizedFlush() between the calls with different MPI communicators.
525: From Fortran pass PETSC_STDOUT if the flush is for standard out; otherwise pass a value obtained from PetscFOpen()
527: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
528: PetscViewerASCIISynchronizedPrintf()
529: @*/
530: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
531: {
533: PetscMPIInt rank,size,tag,i,j,n = 0,dummy = 0;
534: char *message;
535: MPI_Status status;
538: PetscCommDuplicate(comm,&comm,&tag);
539: MPI_Comm_rank(comm,&rank);
540: MPI_Comm_size(comm,&size);
542: /* First processor waits for messages from all other processors */
543: if (rank == 0) {
544: if (!fd) fd = PETSC_STDOUT;
545: for (i=1; i<size; i++) {
546: /* to prevent a flood of messages to process zero, request each message separately */
547: MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
548: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
549: for (j=0; j<n; j++) {
550: PetscMPIInt size = 0;
552: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
553: PetscMalloc1(size, &message);
554: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
555: PetscFPrintf(comm,fd,"%s",message);
556: PetscFree(message);
557: }
558: }
559: } else { /* other processors send queue to processor 0 */
560: PrintfQueue next = petsc_printfqueuebase,previous;
562: MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
563: MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
564: for (i=0; i<petsc_printfqueuelength; i++) {
565: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
566: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
567: previous = next;
568: next = next->next;
569: PetscFree(previous->string);
570: PetscFree(previous);
571: }
572: petsc_printfqueue = NULL;
573: petsc_printfqueuelength = 0;
574: }
575: PetscCommDestroy(&comm);
576: return(0);
577: }
579: /* ---------------------------------------------------------------------------------------*/
581: /*@C
582: PetscFPrintf - Prints to a file, only from the first
583: processor in the communicator.
585: Not Collective
587: Input Parameters:
588: + comm - the communicator
589: . fd - the file pointer
590: - format - the usual printf() format string
592: Level: intermediate
594: Fortran Note:
595: This routine is not supported in Fortran.
597: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
598: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
599: @*/
600: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
601: {
603: PetscMPIInt rank;
606: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
607: MPI_Comm_rank(comm,&rank);
608: if (rank == 0) {
609: va_list Argp;
610: va_start(Argp,format);
611: (*PetscVFPrintf)(fd,format,Argp);
612: if (petsc_history && (fd !=petsc_history)) {
613: va_start(Argp,format);
614: (*PetscVFPrintf)(petsc_history,format,Argp);
615: }
616: va_end(Argp);
617: }
618: return(0);
619: }
621: /*@C
622: PetscPrintf - Prints to standard out, only from the first
623: processor in the communicator. Calls from other processes are ignored.
625: Not Collective
627: Input Parameters:
628: + comm - the communicator
629: - format - the usual printf() format string
631: Level: intermediate
633: Notes:
634: PetscPrintf() supports some format specifiers that are unique to PETSc.
635: See the manual page for PetscFormatConvert() for details.
637: Fortran Note:
638: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
639: That is, you can only pass a single character string from Fortran.
641: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscFormatConvert()
642: @*/
643: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
644: {
646: PetscMPIInt rank;
649: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
650: MPI_Comm_rank(comm,&rank);
651: if (rank == 0) {
652: va_list Argp;
653: va_start(Argp,format);
654: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
655: if (petsc_history) {
656: va_start(Argp,format);
657: (*PetscVFPrintf)(petsc_history,format,Argp);
658: }
659: va_end(Argp);
660: }
661: return(0);
662: }
664: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
665: {
667: PetscMPIInt rank;
670: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
671: MPI_Comm_rank(comm,&rank);
672: if (rank == 0) {
673: va_list Argp;
674: va_start(Argp,format);
675: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
676: if (petsc_history) {
677: va_start(Argp,format);
678: (*PetscVFPrintf)(petsc_history,format,Argp);
679: }
680: va_end(Argp);
681: }
682: return(0);
683: }
685: /* ---------------------------------------------------------------------------------------*/
687: /*@C
688: PetscSynchronizedFGets - Several processors all get the same line from a file.
690: Collective
692: Input Parameters:
693: + comm - the communicator
694: . fd - the file pointer
695: - len - the length of the output buffer
697: Output Parameter:
698: . string - the line read from the file, at end of file string[0] == 0
700: Level: intermediate
702: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
703: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
705: @*/
706: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
707: {
709: PetscMPIInt rank;
712: MPI_Comm_rank(comm,&rank);
714: if (rank == 0) {
715: char *ptr = fgets(string, len, fp);
717: if (!ptr) {
718: string[0] = 0;
719: if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
720: }
721: }
722: MPI_Bcast(string,len,MPI_BYTE,0,comm);
723: return(0);
724: }
726: #if defined(PETSC_HAVE_CLOSURE)
727: int (^SwiftClosure)(const char*) = 0;
729: PetscErrorCode PetscVFPrintfToString(FILE *fd,const char format[],va_list Argp)
730: {
734: if (fd != stdout && fd != stderr) { /* handle regular files */
735: PetscVFPrintfDefault(fd,format,Argp);
736: } else {
737: size_t length;
738: char buff[PETSCDEFAULTBUFFERSIZE];
740: PetscVSNPrintf(buff,sizeof(buff),format,&length,Argp);
741: SwiftClosure(buff);
742: }
743: return(0);
744: }
746: /*
747: Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
748: */
749: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
750: {
751: PetscVFPrintf = PetscVFPrintfToString;
752: SwiftClosure = closure;
753: return 0;
754: }
755: #endif
757: /*@C
758: PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations
760: Input Parameters:
761: . format - the PETSc format string
763: Level: developer
765: @*/
766: PetscErrorCode PetscFormatStrip(char *format)
767: {
768: size_t loc1 = 0, loc2 = 0;
771: while (format[loc2]) {
772: if (format[loc2] == '%') {
773: format[loc1++] = format[loc2++];
774: while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
775: }
776: format[loc1++] = format[loc2++];
777: }
778: return(0);
779: }
781: PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[])
782: {
784: PetscInt i;
785: size_t left,count;
786: char *p;
789: for (i=0,p=buf,left=len; i<n; i++) {
790: PetscSNPrintfCount(p,left,fmt,&count,(double)x[i]);
791: if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer");
792: left -= count;
793: p += count-1;
794: *p++ = ' ';
795: }
796: p[i ? 0 : -1] = 0;
797: return(0);
798: }