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