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