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