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