Actual source code: mprint.c

petsc-3.7.3 2016-08-01
Report Typos and Errors
  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;

 24: /*
 25:      Return the maximum expected new size of the format
 26: */
 27: #define PETSC_MAX_LENGTH_FORMAT(l) (l+l/8)

 31: /*@C
 32:      PetscFormatConvert - Takes a PETSc format string and converts it to a reqular C format string

 34:    Input Parameters:
 35: +   format - the PETSc format string
 36: .   newformat - the location to put the standard C format string values
 37: -   size - the length of newformat

 39:     Note: this exists so we can have the same code when PetscInt is either int or long long and PetscScalar is either __float128, double, or float

 41:  Level: developer

 43: @*/
 44: PetscErrorCode  PetscFormatConvert(const char *format,char *newformat,size_t size)
 45: {
 46:   PetscInt i = 0,j = 0;

 49:   while (format[i] && j < (PetscInt)size-1) {
 50:     if (format[i] == '%' && format[i+1] == '%') {
 51:       newformat[j++] = format[i++];
 52:       newformat[j++] = format[i++];
 53:     } else if (format[i] == '%') {
 54:       if (format[i+1] == 'g') {
 55:         newformat[j++] = '[';
 56:         newformat[j++] = '|';
 57:       }
 58:       /* Find the letter */
 59:       for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
 60:       switch (format[i]) {
 61:       case 'D':
 62: #if !defined(PETSC_USE_64BIT_INDICES)
 63:         newformat[j++] = 'd';
 64: #else
 65:         newformat[j++] = 'l';
 66:         newformat[j++] = 'l';
 67:         newformat[j++] = 'd';
 68: #endif
 69:         break;
 70:       case 'g':
 71:         newformat[j++] = format[i];
 72:         if (format[i-1] == '%') {
 73:           newformat[j++] = '|';
 74:           newformat[j++] = ']';
 75:         }
 76:         break;
 77:       case 'G':
 78:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%G format is no longer supported, use %%g and cast the argument to double");
 79:         break;
 80:       case 'F':
 81:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
 82:         break;
 83:       default:
 84:         newformat[j++] = format[i];
 85:         break;
 86:       }
 87:       i++;
 88:     } else newformat[j++] = format[i++];
 89:   }
 90:   newformat[j] = 0;
 91:   return(0);
 92: }

 96: /*@C
 97:      PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
 98:        function arguments into a string using the format statement.

100:    Input Parameters:
101: +   str - location to put result
102: .   len - the amount of space in str
103: +   format - the PETSc format string
104: -   fullLength - the amount of space in str actually used.

106:     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
107:       a recursion will occur and possible crash.

109:  Level: developer

111: @*/
112: PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
113: {
114:   char           *newformat;
115:   char           formatbuf[8*1024];
116:   size_t         oldLength,length;

120:   PetscStrlen(format, &oldLength);
121:   if (oldLength < 8*1024) {
122:     newformat = formatbuf;
123:     oldLength = 8*1024-1;
124:   } else {
125:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
126:     PetscMalloc1(oldLength, &newformat);
127:   }
128:   PetscFormatConvert(format,newformat,oldLength);
129:   PetscStrlen(newformat, &length);
130: #if 0
131:   if (length > len) newformat[len] = '\0';
132: #endif
133: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
134:   (void) vsnprintf(str,len,newformat,(char*)Argp);
135: #elif defined(PETSC_HAVE_VSNPRINTF)
136:   (void) vsnprintf(str,len,newformat,Argp);
137: #elif defined(PETSC_HAVE__VSNPRINTF)
138:   (void) _vsnprintf(str,len,newformat,Argp);
139: #else
140: #error "vsnprintf not found"
141: #endif
142:   if (oldLength >= 8*1024) {
143:     PetscFree(newformat);
144:   }
145:   {
146:     PetscBool foundedot;
147:     size_t cnt = 0,ncnt = 0,leng;
148:     PetscStrlen(str,&leng);
149:     if (leng > 4) {
150:       for (cnt=0; cnt<leng-4; cnt++) {
151:         if (str[cnt] == '[' && str[cnt+1] == '|'){
152:            cnt++; cnt++;
153:            foundedot = PETSC_FALSE;
154:            for (; cnt<leng-1; cnt++) {
155:              if (str[cnt] == '|' && str[cnt+1] == ']'){
156:                cnt++;
157:                if (!foundedot) str[ncnt++] = '.';
158:                ncnt--;
159:                break;
160:              } else {
161:                if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
162:                str[ncnt++] = str[cnt];
163:              }
164:            }
165:         } else {
166:           str[ncnt] = str[cnt];
167:         }
168:         ncnt++;
169:       }
170:       while (cnt < leng) {
171:         str[ncnt] = str[cnt]; ncnt++; cnt++;
172:       }
173:       str[ncnt] = 0;
174:     }
175:   }
176: #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
177:   /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
178:   {
179:     size_t cnt = 0,ncnt = 0,leng;
180:     PetscStrlen(str,&leng);
181:     if (leng > 5) {
182:       for (cnt=0; cnt<leng-4; cnt++) {
183:         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') {
184:           str[ncnt] = str[cnt]; ncnt++; cnt++;
185:           str[ncnt] = str[cnt]; ncnt++; cnt++; cnt++;
186:           str[ncnt] = str[cnt];
187:         } else {
188:           str[ncnt] = str[cnt];
189:         }
190:         ncnt++;
191:       }
192:       while (cnt < leng) {
193:         str[ncnt] = str[cnt]; ncnt++; cnt++;
194:       }
195:       str[ncnt] = 0;
196:     }
197:   }
198: #endif
199:   if (fullLength) {
200:     PetscStrlen(str,fullLength);
201:   }
202:   return(0);
203: }

207: /*@C
208:      PetscVFPrintf -  All PETSc standard out and error messages are sent through this function; so, in theory, this can
209:         can be replaced with something that does not simply write to a file.

211:       To use, write your own function for example,
212: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
213: ${
215: $
217: $   if (fd != stdout && fd != stderr) {  handle regular files
218: $      PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
219: $  } else {
220: $     char   buff[BIG];
221: $     size_t length;
222: $     PetscVSNPrintf(buff,BIG,format,&length,Argp);
223: $     now send buff to whatever stream or whatever you want
224: $ }
225: $ return(0);
226: $}
227: then before the call to PetscInitialize() do the assignment
228: $    PetscVFPrintf = mypetscvfprintf;

230:       Notes: For error messages this may be called by any process, for regular standard out it is
231:           called only by process 0 of a given communicator

233:       Developer Notes: this could be called by an error handler, if that happens then a recursion of the error handler may occur
234:                        and a crash

236:   Level:  developer

238: .seealso: PetscVSNPrintf(), PetscErrorPrintf()

240: @*/
241: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
242: {
243:   char           str[8*1024];

247:   PetscVSNPrintf(str,sizeof(str),format,NULL,Argp);
248:   fprintf(fd,"%s",str);
249:   fflush(fd);
250:   return(0);
251: }

255: /*@C
256:     PetscSNPrintf - Prints to a string of given length

258:     Not Collective

260:     Input Parameters:
261: +   str - the string to print to
262: .   len - the length of str
263: .   format - the usual printf() format string
264: -   any arguments

266:    Level: intermediate

268: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
269:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
270: @*/
271: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
272: {
274:   size_t         fullLength;
275:   va_list        Argp;

278:   va_start(Argp,format);
279:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
280:   return(0);
281: }

285: /*@C
286:     PetscSNPrintfCount - Prints to a string of given length, returns count

288:     Not Collective

290:     Input Parameters:
291: +   str - the string to print to
292: .   len - the length of str
293: .   format - the usual printf() format string
294: .   countused - number of characters used
295: -   any arguments

297:    Level: intermediate

299: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
300:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
301: @*/
302: PetscErrorCode  PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
303: {
305:   va_list        Argp;

308:   va_start(Argp,countused);
309:   PetscVSNPrintf(str,len,format,countused,Argp);
310:   return(0);
311: }

313: /* ----------------------------------------------------------------------- */

315: PrintfQueue petsc_printfqueue       = 0,petsc_printfqueuebase = 0;
316: int         petsc_printfqueuelength = 0;

320: /*@C
321:     PetscSynchronizedPrintf - Prints synchronized output from several processors.
322:     Output of the first processor is followed by that of the second, etc.

324:     Not Collective

326:     Input Parameters:
327: +   comm - the communicator
328: -   format - the usual printf() format string

330:    Level: intermediate

332:     Notes:
333:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
334:     from all the processors to be printed.

336:     Fortran Note:
337:     The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
338:     That is, you can only pass a single character string from Fortran.

340: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
341:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
342: @*/
343: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
344: {
346:   PetscMPIInt    rank;

349:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
350:   MPI_Comm_rank(comm,&rank);

352:   /* First processor prints immediately to stdout */
353:   if (!rank) {
354:     va_list Argp;
355:     va_start(Argp,format);
356:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
357:     if (petsc_history) {
358:       va_start(Argp,format);
359:       (*PetscVFPrintf)(petsc_history,format,Argp);
360:     }
361:     va_end(Argp);
362:   } else { /* other processors add to local queue */
363:     va_list     Argp;
364:     PrintfQueue next;
365:     size_t      fullLength = 8191;

367:     PetscNew(&next);
368:     if (petsc_printfqueue) {
369:       petsc_printfqueue->next = next;
370:       petsc_printfqueue       = next;
371:       petsc_printfqueue->next = 0;
372:     } else petsc_printfqueuebase = petsc_printfqueue = next;
373:     petsc_printfqueuelength++;
374:     next->size = -1;
375:     while ((PetscInt)fullLength >= next->size) {
376:       next->size = fullLength+1;

378:       PetscMalloc1(next->size, &next->string);
379:       va_start(Argp,format);
380:       PetscMemzero(next->string,next->size);
381:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
382:       va_end(Argp);
383:     }
384:   }
385:   return(0);
386: }

390: /*@C
391:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
392:     several processors.  Output of the first processor is followed by that of the
393:     second, etc.

395:     Not Collective

397:     Input Parameters:
398: +   comm - the communicator
399: .   fd - the file pointer
400: -   format - the usual printf() format string

402:     Level: intermediate

404:     Notes:
405:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
406:     from all the processors to be printed.

408: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
409:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

411: @*/
412: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
413: {
415:   PetscMPIInt    rank;

418:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
419:   MPI_Comm_rank(comm,&rank);

421:   /* First processor prints immediately to fp */
422:   if (!rank) {
423:     va_list Argp;
424:     va_start(Argp,format);
425:     (*PetscVFPrintf)(fp,format,Argp);
426:     if (petsc_history && (fp !=petsc_history)) {
427:       va_start(Argp,format);
428:       (*PetscVFPrintf)(petsc_history,format,Argp);
429:     }
430:     va_end(Argp);
431:   } else { /* other processors add to local queue */
432:     va_list     Argp;
433:     PrintfQueue next;
434:     size_t      fullLength = 8191;
435:     PetscNew(&next);
436:     if (petsc_printfqueue) {
437:       petsc_printfqueue->next = next;
438:       petsc_printfqueue       = next;
439:       petsc_printfqueue->next = 0;
440:     } else petsc_printfqueuebase = petsc_printfqueue = next;
441:     petsc_printfqueuelength++;
442:     next->size = -1;
443:     while ((PetscInt)fullLength >= next->size) {
444:       next->size = fullLength+1;
445:       PetscMalloc1(next->size, &next->string);
446:       va_start(Argp,format);
447:       PetscMemzero(next->string,next->size);
448:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
449:       va_end(Argp);
450:     }
451:   }
452:   return(0);
453: }

457: /*@C
458:     PetscSynchronizedFlush - Flushes to the screen output from all processors
459:     involved in previous PetscSynchronizedPrintf() calls.

461:     Collective on MPI_Comm

463:     Input Parameters:
464: +   comm - the communicator
465: -   fd - the file pointer (valid on process 0 of the communicator)

467:     Level: intermediate

469:     Notes:
470:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
471:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

473: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
474:           PetscViewerASCIISynchronizedPrintf()
475: @*/
476: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
477: {
479:   PetscMPIInt    rank,size,tag,i,j,n = 0,dummy = 0;
480:   char          *message;
481:   MPI_Status     status;

484:   PetscCommDuplicate(comm,&comm,&tag);
485:   MPI_Comm_rank(comm,&rank);
486:   MPI_Comm_size(comm,&size);

488:   /* First processor waits for messages from all other processors */
489:   if (!rank) {
490:     if (!fd) fd = PETSC_STDOUT;
491:     for (i=1; i<size; i++) {
492:       /* to prevent a flood of messages to process zero, request each message separately */
493:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
494:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
495:       for (j=0; j<n; j++) {
496:         PetscMPIInt size = 0;

498:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
499:         PetscMalloc1(size, &message);
500:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
501:         PetscFPrintf(comm,fd,"%s",message);
502:         PetscFree(message);
503:       }
504:     }
505:   } else { /* other processors send queue to processor 0 */
506:     PrintfQueue next = petsc_printfqueuebase,previous;

508:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
509:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
510:     for (i=0; i<petsc_printfqueuelength; i++) {
511:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
512:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
513:       previous = next;
514:       next     = next->next;
515:       PetscFree(previous->string);
516:       PetscFree(previous);
517:     }
518:     petsc_printfqueue       = 0;
519:     petsc_printfqueuelength = 0;
520:   }
521:   PetscCommDestroy(&comm);
522:   return(0);
523: }

525: /* ---------------------------------------------------------------------------------------*/

529: /*@C
530:     PetscFPrintf - Prints to a file, only from the first
531:     processor in the communicator.

533:     Not Collective

535:     Input Parameters:
536: +   comm - the communicator
537: .   fd - the file pointer
538: -   format - the usual printf() format string

540:     Level: intermediate

542:     Fortran Note:
543:     This routine is not supported in Fortran.

545:    Concepts: printing^in parallel
546:    Concepts: printf^in parallel

548: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
549:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
550: @*/
551: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
552: {
554:   PetscMPIInt    rank;

557:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
558:   MPI_Comm_rank(comm,&rank);
559:   if (!rank) {
560:     va_list Argp;
561:     va_start(Argp,format);
562:     (*PetscVFPrintf)(fd,format,Argp);
563:     if (petsc_history && (fd !=petsc_history)) {
564:       va_start(Argp,format);
565:       (*PetscVFPrintf)(petsc_history,format,Argp);
566:     }
567:     va_end(Argp);
568:   }
569:   return(0);
570: }

574: /*@C
575:     PetscPrintf - Prints to standard out, only from the first
576:     processor in the communicator. Calls from other processes are ignored.

578:     Not Collective

580:     Input Parameters:
581: +   comm - the communicator
582: -   format - the usual printf() format string

584:    Level: intermediate

586:     Fortran Note:
587:     The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
588:     That is, you can only pass a single character string from Fortran.

590:    Concepts: printing^in parallel
591:    Concepts: printf^in parallel

593: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
594: @*/
595: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
596: {
598:   PetscMPIInt    rank;

601:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
602:   MPI_Comm_rank(comm,&rank);
603:   if (!rank) {
604:     va_list Argp;
605:     va_start(Argp,format);
606:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
607:     if (petsc_history) {
608:       va_start(Argp,format);
609:       (*PetscVFPrintf)(petsc_history,format,Argp);
610:     }
611:     va_end(Argp);
612:   }
613:   return(0);
614: }

616: /* ---------------------------------------------------------------------------------------*/
619: /*@C
620:      PetscHelpPrintf -  All PETSc help messages are passing through this function. You can change how help messages are printed by
621:         replacinng it  with something that does not simply write to a stdout.

623:       To use, write your own function for example,
624: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
625: ${
626: $ return(0);
627: $}
628: then before the call to PetscInitialize() do the assignment
629: $    PetscHelpPrintf = mypetschelpprintf;

631:   Note: the default routine used is called PetscHelpPrintfDefault().

633:   Level:  developer

635: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
636: @*/
637: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
638: {
640:   PetscMPIInt    rank;

643:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
644:   MPI_Comm_rank(comm,&rank);
645:   if (!rank) {
646:     va_list Argp;
647:     va_start(Argp,format);
648:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
649:     if (petsc_history) {
650:       va_start(Argp,format);
651:       (*PetscVFPrintf)(petsc_history,format,Argp);
652:     }
653:     va_end(Argp);
654:   }
655:   return(0);
656: }

658: /* ---------------------------------------------------------------------------------------*/


663: /*@C
664:     PetscSynchronizedFGets - Several processors all get the same line from a file.

666:     Collective on MPI_Comm

668:     Input Parameters:
669: +   comm - the communicator
670: .   fd - the file pointer
671: -   len - the length of the output buffer

673:     Output Parameter:
674: .   string - the line read from the file, at end of file string[0] == 0

676:     Level: intermediate

678: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
679:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

681: @*/
682: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
683: {
685:   PetscMPIInt    rank;

688:   MPI_Comm_rank(comm,&rank);

690:   if (!rank) {
691:     char *ptr = fgets(string, len, fp);

693:     if (!ptr) {
694:       string[0] = 0;
695:       if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
696:     }
697:   }
698:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
699:   return(0);
700: }

702: #if defined(PETSC_HAVE_CLOSURES)
703: int (^SwiftClosure)(const char*) = 0;

707: PetscErrorCode  PetscVFPrintfToString(FILE *fd,const char format[],va_list Argp)
708: {

712:   if (fd != stdout && fd != stderr) { /* handle regular files */
713:     PetscVFPrintfDefault(fd,format,Argp);
714:   } else {
715:     size_t len=8*1024,length;
716:     char   buf[len];

718:     PetscVSNPrintf(buf,len,format,&length,Argp);
719:     SwiftClosure(buf);
720:   }
721:   return(0);
722: }

724: /*
725:    Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
726: */
727: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
728: {
729:   PetscVFPrintf = PetscVFPrintfToString;
730:   SwiftClosure  = closure;
731:   return 0;
732: }
733: #endif

735: #if defined(PETSC_HAVE_MATLAB_ENGINE)
736: #include <mex.h>
739: PetscErrorCode  PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
740: {

744:   if (fd != stdout && fd != stderr) { /* handle regular files */
745:     PetscVFPrintfDefault(fd,format,Argp);
746:   } else {
747:     size_t len=8*1024,length;
748:     char   buf[len];

750:     PetscVSNPrintf(buf,len,format,&length,Argp);
751:     mexPrintf("%s",buf);
752:   }
753:   return(0);
754: }
755: #endif

759: /*@C
760:      PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations

762:    Input Parameters:
763: .   format - the PETSc format string

765:  Level: developer

767: @*/
768: PetscErrorCode  PetscFormatStrip(char *format)
769: {
770:   size_t loc1 = 0, loc2 = 0;

773:   while (format[loc2]) {
774:     if (format[loc2] == '%') {
775:       format[loc1++] = format[loc2++];
776:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
777:     }
778:     format[loc1++] = format[loc2++];
779:   }
780:   return(0);
781: }