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