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