xref: /petsc/src/sys/fileio/mprint.c (revision 2981ebdba252c1ab1bebf9afd5693bb0df49865f)
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 extern 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 = 0;
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 = 0;
23 /*
24 
25 /*
26      Return the maximum expected new size of the format
27 */
28 #define PETSC_MAX_LENGTH_FORMAT(l) (l+l/8)
29 
30 #undef __FUNCT__
31 #define __FUNCT__ "PetscFormatConvert"
32 /*@C
33      PetscFormatConvert - Takes a PETSc format string and converts it to a reqular C format string
34 
35    Input Parameters:
36 +   format - the PETSc format string
37 .   newformat - the location to put the standard C format string values
38 -   size - the length of newformat
39 
40     Note: this exists so we can have the same code when PetscInt is either int or long long and PetscScalar is either __float128, double, or float
41 
42  Level: developer
43 
44 @*/
45 PetscErrorCode  PetscFormatConvert(const char *format,char *newformat,size_t size)
46 {
47   PetscInt i = 0,j = 0;
48 
49   PetscFunctionBegin;
50   while (format[i] && j < (PetscInt)size-1) {
51     if (format[i] == '%' && format[i+1] != '%') {
52       /* Find the letter */
53       for ( ; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
54       switch (format[i]) {
55       case 'D':
56 #if !defined(PETSC_USE_64BIT_INDICES)
57         newformat[j++] = 'd';
58 #else
59         newformat[j++] = 'l';
60         newformat[j++] = 'l';
61         newformat[j++] = 'd';
62 #endif
63         break;
64       case 'G':
65 #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
66         newformat[j++] = 'g';
67 #elif defined(PETSC_USE_REAL___FLOAT128)
68         newformat[j++] = 'Q';
69         newformat[j++] = 'g';
70 #endif
71         break;
72       case 'F':
73 #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
74         newformat[j++] = 'f';
75 #elif defined(PETSC_USE_REAL_LONG_DOUBLE)
76         newformat[j++] = 'L';
77         newformat[j++] = 'f';
78 #elif defined(PETSC_USE_REAL___FLOAT128)
79         newformat[j++] = 'Q';
80         newformat[j++] = 'f';
81 #endif
82         break;
83       default:
84         newformat[j++] = format[i];
85         break;
86       }
87       i++;
88     } else {
89       newformat[j++] = format[i++];
90     }
91   }
92   newformat[j] = 0;
93   PetscFunctionReturn(0);
94 }
95 
96 #undef __FUNCT__
97 #define __FUNCT__ "PetscVSNPrintf"
98 /*@C
99      PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
100        function arguments into a string using the format statement.
101 
102    Input Parameters:
103 +   str - location to put result
104 .   len - the amount of space in str
105 +   format - the PETSc format string
106 -   fullLength - the amount of space in str actually used.
107 
108     Developer Notes: this function may be called from an error handler, if an error occurs when it is called by the error handler than likely
109       a recursion will occur and possible crash.
110 
111  Level: developer
112 
113 @*/
114 PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
115 {
116   char          *newformat;
117   char           formatbuf[8*1024];
118   size_t         oldLength,length;
119   int            fullLengthInt;
120   PetscErrorCode ierr;
121 
122   PetscFunctionBegin;
123   ierr = PetscStrlen(format, &oldLength);CHKERRQ(ierr);
124   if (oldLength < 8*1024) {
125     newformat = formatbuf;
126     oldLength = 8*1024-1;
127   } else {
128     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
129     ierr = PetscMalloc(oldLength * sizeof(char), &newformat);CHKERRQ(ierr);
130   }
131   PetscFormatConvert(format,newformat,oldLength);
132   ierr = PetscStrlen(newformat, &length);CHKERRQ(ierr);
133 #if 0
134   if (length > len) {
135     newformat[len] = '\0';
136   }
137 #endif
138 #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
139   fullLengthInt = vsnprintf(str,len,newformat,(char *)Argp);
140 #elif defined(PETSC_HAVE_VSNPRINTF)
141   fullLengthInt = vsnprintf(str,len,newformat,Argp);
142 #elif defined(PETSC_HAVE__VSNPRINTF)
143   fullLengthInt = _vsnprintf(str,len,newformat,Argp);
144 #else
145 #error "vsnprintf not found"
146 #endif
147   if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
148   if (fullLength) *fullLength = (size_t)fullLengthInt;
149   if (oldLength >= 8*1024) {
150     ierr = PetscFree(newformat);CHKERRQ(ierr);
151   }
152   PetscFunctionReturn(0);
153 }
154 
155 #undef __FUNCT__
156 #define __FUNCT__ "PetscVFPrintfDefault"
157 /*@C
158      PetscVFPrintf -  All PETSc standard out and error messages are sent through this function; so, in theory, this can
159         can be replaced with something that does not simply write to a file.
160 
161       To use, write your own function for example,
162 $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
163 ${
164 $  PetscErrorCode ierr;
165 $
166 $  PetscFunctionBegin;
167 $   if (fd != stdout && fd != stderr) {  handle regular files
168 $      ierr = PetscVFPrintfDefault(fd,format,Argp); CHKERR(ierr);
169 $  } else {
170 $     char   buff[BIG];
171 $     size_t length;
172 $     ierr = PetscVSNPrintf(buff,BIG,format,&length,Argp);CHKERRQ(ierr);
173 $     now send buff to whatever stream or whatever you want
174 $ }
175 $ PetscFunctionReturn(0);
176 $}
177 then before the call to PetscInitialize() do the assignment
178 $    PetscVFPrintf = mypetscvfprintf;
179 
180       Notes: For error messages this may be called by any process, for regular standard out it is
181           called only by process 0 of a given communicator
182 
183       Developer Notes: this could be called by an error handler, if that happens then a recursion of the error handler may occur
184                        and a crash
185 
186   Level:  developer
187 
188 .seealso: PetscVSNPrintf(), PetscErrorPrintf()
189 
190 @*/
191 PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
192 {
193   char           *newformat;
194   char           formatbuf[8*1024];
195   size_t         oldLength;
196   PetscErrorCode ierr;
197 
198   PetscFunctionBegin;
199   ierr = PetscStrlen(format, &oldLength);CHKERRQ(ierr);
200   if (oldLength < 8*1024) {
201     newformat = formatbuf;
202     oldLength = 8*1024-1;
203   } else {
204     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
205     ierr = PetscMalloc(oldLength * sizeof(char), &newformat);CHKERRQ(ierr);
206   }
207   ierr = PetscFormatConvert(format,newformat,oldLength);CHKERRQ(ierr);
208 
209 #if defined(PETSC_HAVE_VFPRINTF_CHAR)
210   vfprintf(fd,newformat,(char *)Argp);
211 #else
212   vfprintf(fd,newformat,Argp);
213 #endif
214   fflush(fd);
215   if (oldLength >= 8*1024) {
216     ierr = PetscFree(newformat);CHKERRQ(ierr);
217   }
218   PetscFunctionReturn(0);
219 }
220 
221 #undef __FUNCT__
222 #define __FUNCT__ "PetscSNPrintf"
223 /*@C
224     PetscSNPrintf - Prints to a string of given length
225 
226     Not Collective
227 
228     Input Parameters:
229 +   str - the string to print to
230 .   len - the length of str
231 .   format - the usual printf() format string
232 -   any arguments
233 
234    Level: intermediate
235 
236 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
237           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
238 @*/
239 PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
240 {
241   PetscErrorCode ierr;
242   size_t         fullLength;
243   va_list        Argp;
244 
245   PetscFunctionBegin;
246   va_start(Argp,format);
247   ierr = PetscVSNPrintf(str,len,format,&fullLength,Argp);CHKERRQ(ierr);
248   PetscFunctionReturn(0);
249 }
250 
251 #undef __FUNCT__
252 #define __FUNCT__ "PetscSNPrintfCount"
253 /*@C
254     PetscSNPrintfCount - Prints to a string of given length, returns count
255 
256     Not Collective
257 
258     Input Parameters:
259 +   str - the string to print to
260 .   len - the length of str
261 .   format - the usual printf() format string
262 .   countused - number of characters used
263 -   any arguments
264 
265    Level: intermediate
266 
267 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
268           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
269 @*/
270 PetscErrorCode  PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
271 {
272   PetscErrorCode ierr;
273   va_list        Argp;
274 
275   PetscFunctionBegin;
276   va_start(Argp,countused);
277   ierr = PetscVSNPrintf(str,len,format,countused,Argp);CHKERRQ(ierr);
278   PetscFunctionReturn(0);
279 }
280 
281 /* ----------------------------------------------------------------------- */
282 
283 PrintfQueue petsc_printfqueue = 0,petsc_printfqueuebase = 0;
284 int         petsc_printfqueuelength = 0;
285 FILE        *petsc_printfqueuefile  = PETSC_NULL;
286 
287 #undef __FUNCT__
288 #define __FUNCT__ "PetscSynchronizedPrintf"
289 /*@C
290     PetscSynchronizedPrintf - Prints synchronized output from several processors.
291     Output of the first processor is followed by that of the second, etc.
292 
293     Not Collective
294 
295     Input Parameters:
296 +   comm - the communicator
297 -   format - the usual printf() format string
298 
299    Level: intermediate
300 
301     Notes:
302     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
303     from all the processors to be printed.
304 
305     Fortran Note:
306     The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
307     That is, you can only pass a single character string from Fortran.
308 
309 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
310           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
311 @*/
312 PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
313 {
314   PetscErrorCode ierr;
315   PetscMPIInt    rank;
316 
317   PetscFunctionBegin;
318   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
319 
320   /* First processor prints immediately to stdout */
321   if (!rank) {
322     va_list Argp;
323     va_start(Argp,format);
324     ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr);
325     if (petsc_history) {
326       va_start(Argp,format);
327       ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
328     }
329     va_end(Argp);
330   } else { /* other processors add to local queue */
331     va_list     Argp;
332     PrintfQueue next;
333     size_t      fullLength = 8191;
334 
335     ierr = PetscNew(struct _PrintfQueue,&next);CHKERRQ(ierr);
336     if (petsc_printfqueue) {petsc_printfqueue->next = next; petsc_printfqueue = next; petsc_printfqueue->next = 0;}
337     else                   {petsc_printfqueuebase   = petsc_printfqueue = next;}
338     petsc_printfqueuelength++;
339     next->size = -1;
340     while((PetscInt)fullLength >= next->size) {
341       next->size = fullLength+1;
342       ierr = PetscMalloc(next->size * sizeof(char), &next->string);CHKERRQ(ierr);
343       va_start(Argp,format);
344       ierr = PetscMemzero(next->string,next->size);CHKERRQ(ierr);
345       ierr = PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);CHKERRQ(ierr);
346       va_end(Argp);
347     }
348   }
349 
350   PetscFunctionReturn(0);
351 }
352 
353 #undef __FUNCT__
354 #define __FUNCT__ "PetscSynchronizedFPrintf"
355 /*@C
356     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
357     several processors.  Output of the first processor is followed by that of the
358     second, etc.
359 
360     Not Collective
361 
362     Input Parameters:
363 +   comm - the communicator
364 .   fd - the file pointer
365 -   format - the usual printf() format string
366 
367     Level: intermediate
368 
369     Notes:
370     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
371     from all the processors to be printed.
372 
373 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
374           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
375 
376 @*/
377 PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
378 {
379   PetscErrorCode ierr;
380   PetscMPIInt    rank;
381 
382   PetscFunctionBegin;
383   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
384 
385   /* First processor prints immediately to fp */
386   if (!rank) {
387     va_list Argp;
388     va_start(Argp,format);
389     ierr = (*PetscVFPrintf)(fp,format,Argp);CHKERRQ(ierr);
390     petsc_printfqueuefile = fp;
391     if (petsc_history && (fp !=petsc_history)) {
392       va_start(Argp,format);
393       ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
394     }
395     va_end(Argp);
396   } else { /* other processors add to local queue */
397     va_list     Argp;
398     PrintfQueue next;
399     size_t      fullLength = 8191;
400     ierr = PetscNew(struct _PrintfQueue,&next);CHKERRQ(ierr);
401     if (petsc_printfqueue) {petsc_printfqueue->next = next; petsc_printfqueue = next; petsc_printfqueue->next = 0;}
402     else                   {petsc_printfqueuebase   = petsc_printfqueue = next;}
403     petsc_printfqueuelength++;
404     next->size = -1;
405     while((PetscInt)fullLength >= next->size) {
406       next->size = fullLength+1;
407       ierr = PetscMalloc(next->size * sizeof(char), &next->string);CHKERRQ(ierr);
408       va_start(Argp,format);
409       ierr = PetscMemzero(next->string,next->size);CHKERRQ(ierr);
410       ierr = PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);CHKERRQ(ierr);
411       va_end(Argp);
412     }
413   }
414   PetscFunctionReturn(0);
415 }
416 
417 #undef __FUNCT__
418 #define __FUNCT__ "PetscSynchronizedFlush"
419 /*@
420     PetscSynchronizedFlush - Flushes to the screen output from all processors
421     involved in previous PetscSynchronizedPrintf() calls.
422 
423     Collective on MPI_Comm
424 
425     Input Parameters:
426 .   comm - the communicator
427 
428     Level: intermediate
429 
430     Notes:
431     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
432     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
433 
434 .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
435           PetscViewerASCIISynchronizedPrintf()
436 @*/
437 PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm)
438 {
439   PetscErrorCode ierr;
440   PetscMPIInt    rank,size,tag,i,j,n,dummy = 0;
441   char          *message;
442   MPI_Status     status;
443   FILE           *fd;
444 
445   PetscFunctionBegin;
446   ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
447   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
448   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
449 
450   /* First processor waits for messages from all other processors */
451   if (!rank) {
452     if (petsc_printfqueuefile) {
453       fd = petsc_printfqueuefile;
454     } else {
455       fd = PETSC_STDOUT;
456     }
457     for (i=1; i<size; i++) {
458       /* to prevent a flood of messages to process zero, request each message separately */
459       ierr = MPI_Send(&dummy,1,MPI_INT,i,tag,comm);CHKERRQ(ierr);
460       ierr = MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
461       for (j=0; j<n; j++) {
462         PetscMPIInt size;
463 
464         ierr = MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
465         ierr = PetscMalloc(size * sizeof(char), &message);CHKERRQ(ierr);
466         ierr = MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);CHKERRQ(ierr);
467         ierr = PetscFPrintf(comm,fd,"%s",message);
468         ierr = PetscFree(message);CHKERRQ(ierr);
469       }
470     }
471     petsc_printfqueuefile = PETSC_NULL;
472   } else { /* other processors send queue to processor 0 */
473     PrintfQueue next = petsc_printfqueuebase,previous;
474 
475     ierr = MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);CHKERRQ(ierr);
476     ierr = MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
477     for (i=0; i<petsc_printfqueuelength; i++) {
478       ierr     = MPI_Send(&next->size,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
479       ierr     = MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);CHKERRQ(ierr);
480       previous = next;
481       next     = next->next;
482       ierr     = PetscFree(previous->string);CHKERRQ(ierr);
483       ierr     = PetscFree(previous);CHKERRQ(ierr);
484     }
485     petsc_printfqueue       = 0;
486     petsc_printfqueuelength = 0;
487   }
488   ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
489   PetscFunctionReturn(0);
490 }
491 
492 /* ---------------------------------------------------------------------------------------*/
493 
494 #undef __FUNCT__
495 #define __FUNCT__ "PetscFPrintf"
496 /*@C
497     PetscFPrintf - Prints to a file, only from the first
498     processor in the communicator.
499 
500     Not Collective
501 
502     Input Parameters:
503 +   comm - the communicator
504 .   fd - the file pointer
505 -   format - the usual printf() format string
506 
507     Level: intermediate
508 
509     Fortran Note:
510     This routine is not supported in Fortran.
511 
512    Concepts: printing^in parallel
513    Concepts: printf^in parallel
514 
515 .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
516           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
517 @*/
518 PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
519 {
520   PetscErrorCode ierr;
521   PetscMPIInt    rank;
522 
523   PetscFunctionBegin;
524   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
525   if (!rank) {
526     va_list Argp;
527     va_start(Argp,format);
528     ierr = (*PetscVFPrintf)(fd,format,Argp);CHKERRQ(ierr);
529     if (petsc_history && (fd !=petsc_history)) {
530       va_start(Argp,format);
531       ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
532       }
533     va_end(Argp);
534   }
535   PetscFunctionReturn(0);
536 }
537 
538 #undef __FUNCT__
539 #define __FUNCT__ "PetscPrintf"
540 /*@C
541     PetscPrintf - Prints to standard out, only from the first
542     processor in the communicator. Calls from other processes are ignored.
543 
544     Not Collective
545 
546     Input Parameters:
547 +   comm - the communicator
548 -   format - the usual printf() format string
549 
550    Level: intermediate
551 
552     Fortran Note:
553     The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
554     That is, you can only pass a single character string from Fortran.
555 
556    Concepts: printing^in parallel
557    Concepts: printf^in parallel
558 
559 .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
560 @*/
561 PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
562 {
563   PetscErrorCode ierr;
564   PetscMPIInt    rank;
565 
566   PetscFunctionBegin;
567   if (!comm) comm = PETSC_COMM_WORLD;
568   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
569   if (!rank) {
570     va_list Argp;
571     va_start(Argp,format);
572     ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr);
573     if (petsc_history) {
574       va_start(Argp,format);
575       ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
576     }
577     va_end(Argp);
578   }
579   PetscFunctionReturn(0);
580 }
581 
582 /* ---------------------------------------------------------------------------------------*/
583 #undef __FUNCT__
584 #define __FUNCT__ "PetscHelpPrintfDefault"
585 /*@C
586      PetscHelpPrintf -  All PETSc help messages are passing through this function. You can change how help messages are printed by
587         replacinng it  with something that does not simply write to a stdout.
588 
589       To use, write your own function for example,
590 $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
591 ${
592 $ PetscFunctionReturn(0);
593 $}
594 then before the call to PetscInitialize() do the assignment
595 $    PetscHelpPrintf = mypetschelpprintf;
596 
597   Note: the default routine used is called PetscHelpPrintfDefault().
598 
599   Level:  developer
600 
601 .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
602 @*/
603 PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
604 {
605   PetscErrorCode ierr;
606   PetscMPIInt    rank;
607 
608   PetscFunctionBegin;
609   if (!comm) comm = PETSC_COMM_WORLD;
610   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
611   if (!rank) {
612     va_list Argp;
613     va_start(Argp,format);
614     ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr);
615     if (petsc_history) {
616       va_start(Argp,format);
617       ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
618     }
619     va_end(Argp);
620   }
621   PetscFunctionReturn(0);
622 }
623 
624 /* ---------------------------------------------------------------------------------------*/
625 
626 
627 #undef __FUNCT__
628 #define __FUNCT__ "PetscSynchronizedFGets"
629 /*@C
630     PetscSynchronizedFGets - Several processors all get the same line from a file.
631 
632     Collective on MPI_Comm
633 
634     Input Parameters:
635 +   comm - the communicator
636 .   fd - the file pointer
637 -   len - the length of the output buffer
638 
639     Output Parameter:
640 .   string - the line read from the file
641 
642     Level: intermediate
643 
644 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
645           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
646 
647 @*/
648 PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
649 {
650   PetscErrorCode ierr;
651   PetscMPIInt    rank;
652 
653   PetscFunctionBegin;
654   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
655 
656   if (!rank) {
657     char *ptr = fgets(string, len, fp);
658 
659     if (!ptr) {
660       if (feof(fp)) {
661         len = 0;
662       } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
663     }
664   }
665   ierr = MPI_Bcast(string,len,MPI_BYTE,0,comm);CHKERRQ(ierr);
666   PetscFunctionReturn(0);
667 }
668 
669 #if defined(PETSC_HAVE_MATLAB_ENGINE)
670 #include <mex.h>
671 #undef __FUNCT__
672 #define __FUNCT__ "PetscVFPrintf_Matlab"
673 PetscErrorCode  PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
674 {
675   PetscErrorCode ierr;
676 
677   PetscFunctionBegin;
678   if (fd != stdout && fd != stderr) { /* handle regular files */
679     ierr = PetscVFPrintfDefault(fd,format,Argp); CHKERRQ(ierr);
680   } else {
681     size_t len=8*1024,length;
682     char   buf[len];
683 
684     ierr = PetscVSNPrintf(buf,len,format,&length,Argp);CHKERRQ(ierr);
685     mexPrintf("%s",buf);
686  }
687  PetscFunctionReturn(0);
688 }
689 #endif
690 
691 #undef __FUNCT__
692 #define __FUNCT__ "PetscFormatStrip"
693 /*@C
694      PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations
695 
696    Input Parameters:
697 .   format - the PETSc format string
698 
699  Level: developer
700 
701 @*/
702 PetscErrorCode  PetscFormatStrip(char *format)
703 {
704   size_t   loc1 = 0, loc2 = 0;
705 
706   PetscFunctionBegin;
707   while (format[loc2]){
708     if (format[loc2] == '%') {
709       format[loc1++] = format[loc2++];
710       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
711     }
712     format[loc1++] = format[loc2++];
713   }
714   PetscFunctionReturn(0);
715 }
716 
717