Actual source code: mprint.c
petsc-3.13.6 2020-09-29
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: break;
125: case 'F':
126: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
127: break;
128: default:
129: newformat[j++] = format[i];
130: break;
131: }
132: i++;
133: } else newformat[j++] = format[i++];
134: }
135: newformat[j] = 0;
136: return(0);
137: }
139: #define PETSCDEFAULTBUFFERSIZE 8*1024
141: /*@C
142: PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
143: function arguments into a string using the format statement.
145: Input Parameters:
146: + str - location to put result
147: . len - the amount of space in str
148: + format - the PETSc format string
149: - fullLength - the amount of space in str actually used.
151: Developer Notes:
152: this function may be called from an error handler, if an error occurs when it is called by the error handler than likely
153: a recursion will occur and possible crash.
155: Level: developer
157: .seealso: PetscVSNPrintf(), PetscErrorPrintf(), PetscVPrintf()
159: @*/
160: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
161: {
162: char *newformat = NULL;
163: char formatbuf[PETSCDEFAULTBUFFERSIZE];
164: size_t newLength;
166: int flen;
169: PetscFormatConvertGetSize(format,&newLength);
170: if (newLength < PETSCDEFAULTBUFFERSIZE) {
171: newformat = formatbuf;
172: newLength = PETSCDEFAULTBUFFERSIZE-1;
173: } else {
174: PetscMalloc1(newLength, &newformat);
175: }
176: PetscFormatConvert(format,newformat);
177: #if defined(PETSC_HAVE_VSNPRINTF)
178: flen = vsnprintf(str,len,newformat,Argp);
179: #else
180: #error "vsnprintf not found"
181: #endif
182: if (newLength > PETSCDEFAULTBUFFERSIZE-1) {
183: PetscFree(newformat);
184: }
185: {
186: PetscBool foundedot;
187: size_t cnt = 0,ncnt = 0,leng;
188: PetscStrlen(str,&leng);
189: if (leng > 4) {
190: for (cnt=0; cnt<leng-4; cnt++) {
191: if (str[cnt] == '[' && str[cnt+1] == '|'){
192: flen -= 4;
193: cnt++; cnt++;
194: foundedot = PETSC_FALSE;
195: for (; cnt<leng-1; cnt++) {
196: if (str[cnt] == '|' && str[cnt+1] == ']'){
197: cnt++;
198: if (!foundedot) str[ncnt++] = '.';
199: ncnt--;
200: break;
201: } else {
202: if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
203: str[ncnt++] = str[cnt];
204: }
205: }
206: } else {
207: str[ncnt] = str[cnt];
208: }
209: ncnt++;
210: }
211: while (cnt < leng) {
212: str[ncnt] = str[cnt]; ncnt++; cnt++;
213: }
214: str[ncnt] = 0;
215: }
216: }
217: #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
218: /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
219: {
220: size_t cnt = 0,ncnt = 0,leng;
221: PetscStrlen(str,&leng);
222: if (leng > 5) {
223: for (cnt=0; cnt<leng-4; cnt++) {
224: 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') {
225: str[ncnt] = str[cnt]; ncnt++; cnt++;
226: str[ncnt] = str[cnt]; ncnt++; cnt++; cnt++;
227: str[ncnt] = str[cnt];
228: } else {
229: str[ncnt] = str[cnt];
230: }
231: ncnt++;
232: }
233: while (cnt < leng) {
234: str[ncnt] = str[cnt]; ncnt++; cnt++;
235: }
236: str[ncnt] = 0;
237: }
238: }
239: #endif
240: if (fullLength) *fullLength = 1 + (size_t) flen;
241: return(0);
242: }
244: /*@C
245: PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
246: can be replaced with something that does not simply write to a file.
248: To use, write your own function for example,
249: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
250: ${
252: $
254: $ if (fd != stdout && fd != stderr) { handle regular files
255: $ PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
256: $ } else {
257: $ char buff[BIG];
258: $ size_t length;
259: $ PetscVSNPrintf(buff,BIG,format,&length,Argp);
260: $ now send buff to whatever stream or whatever you want
261: $ }
262: $ return(0);
263: $}
264: then before the call to PetscInitialize() do the assignment
265: $ PetscVFPrintf = mypetscvfprintf;
267: Notes:
268: For error messages this may be called by any process, for regular standard out it is
269: called only by process 0 of a given communicator
271: Developer Notes:
272: this could be called by an error handler, if that happens then a recursion of the error handler may occur
273: and a crash
275: Level: developer
277: .seealso: PetscVSNPrintf(), PetscErrorPrintf()
279: @*/
280: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
281: {
282: char str[PETSCDEFAULTBUFFERSIZE];
283: char *buff = str;
284: size_t fullLength;
286: #if defined(PETSC_HAVE_VA_COPY)
287: va_list Argpcopy;
288: #endif
291: #if defined(PETSC_HAVE_VA_COPY)
292: va_copy(Argpcopy,Argp);
293: #endif
294: PetscVSNPrintf(str,sizeof(str),format,&fullLength,Argp);
295: if (fullLength > sizeof(str)) {
296: PetscMalloc1(fullLength,&buff);
297: #if defined(PETSC_HAVE_VA_COPY)
298: PetscVSNPrintf(buff,fullLength,format,NULL,Argpcopy);
299: #else
300: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
301: #endif
302: }
303: fprintf(fd,"%s",buff);
304: fflush(fd);
305: if (buff != str) {
306: PetscFree(buff);
307: }
308: return(0);
309: }
311: /*@C
312: PetscSNPrintf - Prints to a string of given length
314: Not Collective
316: Input Parameters:
317: + str - the string to print to
318: . len - the length of str
319: . format - the usual printf() format string
320: - any arguments
322: Level: intermediate
324: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
325: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscVFPrintf()
326: @*/
327: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
328: {
330: size_t fullLength;
331: va_list Argp;
334: va_start(Argp,format);
335: PetscVSNPrintf(str,len,format,&fullLength,Argp);
336: return(0);
337: }
339: /*@C
340: PetscSNPrintfCount - Prints to a string of given length, returns count
342: Not Collective
344: Input Parameters:
345: + str - the string to print to
346: . len - the length of str
347: . format - the usual printf() format string
348: - any arguments
350: Output Parameter:
351: . countused - number of characters used
353: Level: intermediate
355: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
356: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf(), PetscVFPrintf()
357: @*/
358: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
359: {
361: va_list Argp;
364: va_start(Argp,countused);
365: PetscVSNPrintf(str,len,format,countused,Argp);
366: return(0);
367: }
369: /* ----------------------------------------------------------------------- */
371: PrintfQueue petsc_printfqueue = NULL,petsc_printfqueuebase = NULL;
372: int petsc_printfqueuelength = 0;
374: /*@C
375: PetscSynchronizedPrintf - Prints synchronized output from several processors.
376: Output of the first processor is followed by that of the second, etc.
378: Not Collective
380: Input Parameters:
381: + comm - the communicator
382: - format - the usual printf() format string
384: Level: intermediate
386: Notes:
387: REQUIRES a call to PetscSynchronizedFlush() by all the processes after the completion of the calls to PetscSynchronizedPrintf() for the information
388: from all the processors to be printed.
390: Fortran Note:
391: The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
392: That is, you can only pass a single character string from Fortran.
394: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
395: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
396: @*/
397: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
398: {
400: PetscMPIInt rank;
403: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
404: MPI_Comm_rank(comm,&rank);
406: /* First processor prints immediately to stdout */
407: if (!rank) {
408: va_list Argp;
409: va_start(Argp,format);
410: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
411: if (petsc_history) {
412: va_start(Argp,format);
413: (*PetscVFPrintf)(petsc_history,format,Argp);
414: }
415: va_end(Argp);
416: } else { /* other processors add to local queue */
417: va_list Argp;
418: PrintfQueue next;
419: size_t fullLength = PETSCDEFAULTBUFFERSIZE;
421: PetscNew(&next);
422: if (petsc_printfqueue) {
423: petsc_printfqueue->next = next;
424: petsc_printfqueue = next;
425: petsc_printfqueue->next = NULL;
426: } else petsc_printfqueuebase = petsc_printfqueue = next;
427: petsc_printfqueuelength++;
428: next->size = -1;
429: next->string = NULL;
430: while ((PetscInt)fullLength >= next->size) {
431: next->size = fullLength+1;
432: PetscFree(next->string);
433: PetscMalloc1(next->size, &next->string);
434: va_start(Argp,format);
435: PetscArrayzero(next->string,next->size);
436: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
437: va_end(Argp);
438: }
439: }
440: return(0);
441: }
443: /*@C
444: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
445: several processors. Output of the first processor is followed by that of the
446: second, etc.
448: Not Collective
450: Input Parameters:
451: + comm - the communicator
452: . fd - the file pointer
453: - format - the usual printf() format string
455: Level: intermediate
457: Notes:
458: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
459: from all the processors to be printed.
461: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
462: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
464: @*/
465: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
466: {
468: PetscMPIInt rank;
471: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
472: MPI_Comm_rank(comm,&rank);
474: /* First processor prints immediately to fp */
475: if (!rank) {
476: va_list Argp;
477: va_start(Argp,format);
478: (*PetscVFPrintf)(fp,format,Argp);
479: if (petsc_history && (fp !=petsc_history)) {
480: va_start(Argp,format);
481: (*PetscVFPrintf)(petsc_history,format,Argp);
482: }
483: va_end(Argp);
484: } else { /* other processors add to local queue */
485: va_list Argp;
486: PrintfQueue next;
487: size_t fullLength = PETSCDEFAULTBUFFERSIZE;
489: PetscNew(&next);
490: if (petsc_printfqueue) {
491: petsc_printfqueue->next = next;
492: petsc_printfqueue = next;
493: petsc_printfqueue->next = NULL;
494: } else petsc_printfqueuebase = petsc_printfqueue = next;
495: petsc_printfqueuelength++;
496: next->size = -1;
497: next->string = NULL;
498: while ((PetscInt)fullLength >= next->size) {
499: next->size = fullLength+1;
500: PetscFree(next->string);
501: PetscMalloc1(next->size, &next->string);
502: va_start(Argp,format);
503: PetscArrayzero(next->string,next->size);
504: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
505: va_end(Argp);
506: }
507: }
508: return(0);
509: }
511: /*@C
512: PetscSynchronizedFlush - Flushes to the screen output from all processors
513: involved in previous PetscSynchronizedPrintf()/PetscSynchronizedFPrintf() calls.
515: Collective
517: Input Parameters:
518: + comm - the communicator
519: - fd - the file pointer (valid on process 0 of the communicator)
521: Level: intermediate
523: Notes:
524: If PetscSynchronizedPrintf() and/or PetscSynchronizedFPrintf() are called with
525: different MPI communicators there must be an intervening call to PetscSynchronizedFlush() between the calls with different MPI communicators.
527: From Fortran pass PETSC_STDOUT if the flush is for standard out; otherwise pass a value obtained from PetscFOpen()
529: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
530: PetscViewerASCIISynchronizedPrintf()
531: @*/
532: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
533: {
535: PetscMPIInt rank,size,tag,i,j,n = 0,dummy = 0;
536: char *message;
537: MPI_Status status;
540: PetscCommDuplicate(comm,&comm,&tag);
541: MPI_Comm_rank(comm,&rank);
542: MPI_Comm_size(comm,&size);
544: /* First processor waits for messages from all other processors */
545: if (!rank) {
546: if (!fd) fd = PETSC_STDOUT;
547: for (i=1; i<size; i++) {
548: /* to prevent a flood of messages to process zero, request each message separately */
549: MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
550: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
551: for (j=0; j<n; j++) {
552: PetscMPIInt size = 0;
554: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
555: PetscMalloc1(size, &message);
556: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
557: PetscFPrintf(comm,fd,"%s",message);
558: PetscFree(message);
559: }
560: }
561: } else { /* other processors send queue to processor 0 */
562: PrintfQueue next = petsc_printfqueuebase,previous;
564: MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
565: MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
566: for (i=0; i<petsc_printfqueuelength; i++) {
567: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
568: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
569: previous = next;
570: next = next->next;
571: PetscFree(previous->string);
572: PetscFree(previous);
573: }
574: petsc_printfqueue = NULL;
575: petsc_printfqueuelength = 0;
576: }
577: PetscCommDestroy(&comm);
578: return(0);
579: }
581: /* ---------------------------------------------------------------------------------------*/
583: /*@C
584: PetscFPrintf - Prints to a file, only from the first
585: processor in the communicator.
587: Not Collective
589: Input Parameters:
590: + comm - the communicator
591: . fd - the file pointer
592: - format - the usual printf() format string
594: Level: intermediate
596: Fortran Note:
597: This routine is not supported in Fortran.
600: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
601: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
602: @*/
603: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
604: {
606: PetscMPIInt rank;
609: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
610: MPI_Comm_rank(comm,&rank);
611: if (!rank) {
612: va_list Argp;
613: va_start(Argp,format);
614: (*PetscVFPrintf)(fd,format,Argp);
615: if (petsc_history && (fd !=petsc_history)) {
616: va_start(Argp,format);
617: (*PetscVFPrintf)(petsc_history,format,Argp);
618: }
619: va_end(Argp);
620: }
621: return(0);
622: }
624: /*@C
625: PetscPrintf - Prints to standard out, only from the first
626: processor in the communicator. Calls from other processes are ignored.
628: Not Collective
630: Input Parameters:
631: + comm - the communicator
632: - format - the usual printf() format string
634: Level: intermediate
636: Notes:
637: PetscPrintf() supports some format specifiers that are unique to PETSc.
638: See the manual page for PetscFormatConvert() for details.
640: Fortran Note:
641: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
642: That is, you can only pass a single character string from Fortran.
645: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscFormatConvert()
646: @*/
647: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
648: {
650: PetscMPIInt rank;
653: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
654: MPI_Comm_rank(comm,&rank);
655: if (!rank) {
656: va_list Argp;
657: va_start(Argp,format);
658: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
659: if (petsc_history) {
660: va_start(Argp,format);
661: (*PetscVFPrintf)(petsc_history,format,Argp);
662: }
663: va_end(Argp);
664: }
665: return(0);
666: }
668: /* ---------------------------------------------------------------------------------------*/
669: /*@C
670: PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by
671: replacinng it with something that does not simply write to a stdout.
673: To use, write your own function for example,
674: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
675: ${
676: $ return(0);
677: $}
678: then before the call to PetscInitialize() do the assignment
679: $ PetscHelpPrintf = mypetschelpprintf;
681: Note: the default routine used is called PetscHelpPrintfDefault().
683: Level: developer
685: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
686: @*/
687: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
688: {
690: PetscMPIInt rank;
693: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
694: MPI_Comm_rank(comm,&rank);
695: if (!rank) {
696: va_list Argp;
697: va_start(Argp,format);
698: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
699: if (petsc_history) {
700: va_start(Argp,format);
701: (*PetscVFPrintf)(petsc_history,format,Argp);
702: }
703: va_end(Argp);
704: }
705: return(0);
706: }
708: /* ---------------------------------------------------------------------------------------*/
711: /*@C
712: PetscSynchronizedFGets - Several processors all get the same line from a file.
714: Collective
716: Input Parameters:
717: + comm - the communicator
718: . fd - the file pointer
719: - len - the length of the output buffer
721: Output Parameter:
722: . string - the line read from the file, at end of file string[0] == 0
724: Level: intermediate
726: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
727: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
729: @*/
730: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
731: {
733: PetscMPIInt rank;
736: MPI_Comm_rank(comm,&rank);
738: if (!rank) {
739: char *ptr = fgets(string, len, fp);
741: if (!ptr) {
742: string[0] = 0;
743: if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
744: }
745: }
746: MPI_Bcast(string,len,MPI_BYTE,0,comm);
747: return(0);
748: }
750: #if defined(PETSC_HAVE_CLOSURE)
751: int (^SwiftClosure)(const char*) = 0;
753: PetscErrorCode PetscVFPrintfToString(FILE *fd,const char format[],va_list Argp)
754: {
758: if (fd != stdout && fd != stderr) { /* handle regular files */
759: PetscVFPrintfDefault(fd,format,Argp);
760: } else {
761: size_t length;
762: char buff[PETSCDEFAULTBUFFERSIZE];
764: PetscVSNPrintf(buff,sizeof(buff),format,&length,Argp);
765: SwiftClosure(buff);
766: }
767: return(0);
768: }
770: /*
771: Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
772: */
773: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
774: {
775: PetscVFPrintf = PetscVFPrintfToString;
776: SwiftClosure = closure;
777: return 0;
778: }
779: #endif
781: /*@C
782: PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations
784: Input Parameters:
785: . format - the PETSc format string
787: Level: developer
789: @*/
790: PetscErrorCode PetscFormatStrip(char *format)
791: {
792: size_t loc1 = 0, loc2 = 0;
795: while (format[loc2]) {
796: if (format[loc2] == '%') {
797: format[loc1++] = format[loc2++];
798: while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
799: }
800: format[loc1++] = format[loc2++];
801: }
802: return(0);
803: }
805: PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[])
806: {
808: PetscInt i;
809: size_t left,count;
810: char *p;
813: for (i=0,p=buf,left=len; i<n; i++) {
814: PetscSNPrintfCount(p,left,fmt,&count,(double)x[i]);
815: if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer");
816: left -= count;
817: p += count-1;
818: *p++ = ' ';
819: }
820: p[i ? 0 : -1] = 0;
821: return(0);
822: }