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