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