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