Date: 2015-10-02T21:59:52+00:00

Actual source code: mprint.c
petsc-3.6.2 2015-10-02
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:       /* Find the letter */
     55:       for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
     56:       switch (format[i]) {
     57:       case 'D':
     58: #if !defined(PETSC_USE_64BIT_INDICES)
     59:         newformat[j++] = 'd';
     60: #else
     61:         newformat[j++] = 'l';
     62:         newformat[j++] = 'l';
     63:         newformat[j++] = 'd';
     64: #endif
     65:         break;
     66:       case 'G':
     67:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%G format is no longer supported, use %%g and cast the argument to double");
     68:         break;
     69:       case 'F':
     70:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
     71:         break;
     72:       default:
     73:         newformat[j++] = format[i];
     74:         break;
     75:       }
     76:       i++;
     77:     } else newformat[j++] = format[i++];
     78:   }
     79:   newformat[j] = 0;
     80:   return(0);
     81: }

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

     89:    Input Parameters:
     90: +   str - location to put result
     91: .   len - the amount of space in str
     92: +   format - the PETSc format string
     93: -   fullLength - the amount of space in str actually used.

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

     98:  Level: developer

    100: @*/
    101: PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
    102: {
    103:   char           *newformat;
    104:   char           formatbuf[8*1024];
    105:   size_t         oldLength,length;
    106:   int            fullLengthInt;

    110:   PetscStrlen(format, &oldLength);
    111:   if (oldLength < 8*1024) {
    112:     newformat = formatbuf;
    113:     oldLength = 8*1024-1;
    114:   } else {
    115:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
    116:     PetscMalloc1(oldLength, &newformat);
    117:   }
    118:   PetscFormatConvert(format,newformat,oldLength);
    119:   PetscStrlen(newformat, &length);
    120: #if 0
    121:   if (length > len) newformat[len] = '\0';
    122: #endif
    123: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
    124:   fullLengthInt = vsnprintf(str,len,newformat,(char*)Argp);
    125: #elif defined(PETSC_HAVE_VSNPRINTF)
    126:   fullLengthInt = vsnprintf(str,len,newformat,Argp);
    127: #elif defined(PETSC_HAVE__VSNPRINTF)
    128:   fullLengthInt = _vsnprintf(str,len,newformat,Argp);
    129: #else
    130: #error "vsnprintf not found"
    131: #endif
    132:   if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
    133:   if (fullLength) *fullLength = (size_t)fullLengthInt;
    134:   if (oldLength >= 8*1024) {
    135:     PetscFree(newformat);
    136:   }
    137:   return(0);
    138: }

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

    146:       To use, write your own function for example,
    147: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
    148: ${
    150: $
    152: $   if (fd != stdout && fd != stderr) {  handle regular files
    153: $      PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
    154: $  } else {
    155: $     char   buff[BIG];
    156: $     size_t length;
    157: $     PetscVSNPrintf(buff,BIG,format,&length,Argp);
    158: $     now send buff to whatever stream or whatever you want
    159: $ }
    160: $ return(0);
    161: $}
    162: then before the call to PetscInitialize() do the assignment
    163: $    PetscVFPrintf = mypetscvfprintf;

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

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

    171:   Level:  developer

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

    175: @*/
    176: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
    177: {
    178:   char           *newformat;
    179:   char           formatbuf[8*1024];
    180:   size_t         oldLength;

    184:   PetscStrlen(format, &oldLength);
    185:   if (oldLength < 8*1024) {
    186:     newformat = formatbuf;
    187:     oldLength = 8*1024-1;
    188:   } else {
    189:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
    190:     PetscMalloc1(oldLength, &newformat);
    191:   }
    192:   PetscFormatConvert(format,newformat,oldLength);

    194: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
    195:   vfprintf(fd,newformat,(char*)Argp);
    196: #else
    197:   vfprintf(fd,newformat,Argp);
    198: #endif
    199:   fflush(fd);
    200:   if (oldLength >= 8*1024) {
    201:     PetscFree(newformat);
    202:   }
    203:   return(0);
    204: }

    208: /*@C
    209:     PetscSNPrintf - Prints to a string of given length

    211:     Not Collective

    213:     Input Parameters:
    214: +   str - the string to print to
    215: .   len - the length of str
    216: .   format - the usual printf() format string
    217: -   any arguments

    219:    Level: intermediate

    221: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
    222:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
    223: @*/
    224: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
    225: {
    227:   size_t         fullLength;
    228:   va_list        Argp;

    231:   va_start(Argp,format);
    232:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
    233:   return(0);
    234: }

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

    241:     Not Collective

    243:     Input Parameters:
    244: +   str - the string to print to
    245: .   len - the length of str
    246: .   format - the usual printf() format string
    247: .   countused - number of characters used
    248: -   any arguments

    250:    Level: intermediate

    252: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
    253:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
    254: @*/
    255: PetscErrorCode  PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
    256: {
    258:   va_list        Argp;

    261:   va_start(Argp,countused);
    262:   PetscVSNPrintf(str,len,format,countused,Argp);
    263:   return(0);
    264: }

    266: /* ----------------------------------------------------------------------- */

    268: PrintfQueue petsc_printfqueue       = 0,petsc_printfqueuebase = 0;
    269: int         petsc_printfqueuelength = 0;

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

    277:     Not Collective

    279:     Input Parameters:
    280: +   comm - the communicator
    281: -   format - the usual printf() format string

    283:    Level: intermediate

    285:     Notes:
    286:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
    287:     from all the processors to be printed.

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

    293: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
    294:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
    295: @*/
    296: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
    297: {
    299:   PetscMPIInt    rank;

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

    305:   /* First processor prints immediately to stdout */
    306:   if (!rank) {
    307:     va_list Argp;
    308:     va_start(Argp,format);
    309:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    310:     if (petsc_history) {
    311:       va_start(Argp,format);
    312:       (*PetscVFPrintf)(petsc_history,format,Argp);
    313:     }
    314:     va_end(Argp);
    315:   } else { /* other processors add to local queue */
    316:     va_list     Argp;
    317:     PrintfQueue next;
    318:     size_t      fullLength = 8191;

    320:     PetscNew(&next);
    321:     if (petsc_printfqueue) {
    322:       petsc_printfqueue->next = next;
    323:       petsc_printfqueue       = next;
    324:       petsc_printfqueue->next = 0;
    325:     } else petsc_printfqueuebase = petsc_printfqueue = next;
    326:     petsc_printfqueuelength++;
    327:     next->size = -1;
    328:     while ((PetscInt)fullLength >= next->size) {
    329:       next->size = fullLength+1;

    331:       PetscMalloc1(next->size, &next->string);
    332:       va_start(Argp,format);
    333:       PetscMemzero(next->string,next->size);
    334:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
    335:       va_end(Argp);
    336:     }
    337:   }
    338:   return(0);
    339: }

    343: /*@C
    344:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
    345:     several processors.  Output of the first processor is followed by that of the
    346:     second, etc.

    348:     Not Collective

    350:     Input Parameters:
    351: +   comm - the communicator
    352: .   fd - the file pointer
    353: -   format - the usual printf() format string

    355:     Level: intermediate

    357:     Notes:
    358:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
    359:     from all the processors to be printed.

    361: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
    362:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    364: @*/
    365: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
    366: {
    368:   PetscMPIInt    rank;

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

    374:   /* First processor prints immediately to fp */
    375:   if (!rank) {
    376:     va_list Argp;
    377:     va_start(Argp,format);
    378:     (*PetscVFPrintf)(fp,format,Argp);
    379:     if (petsc_history && (fp !=petsc_history)) {
    380:       va_start(Argp,format);
    381:       (*PetscVFPrintf)(petsc_history,format,Argp);
    382:     }
    383:     va_end(Argp);
    384:   } else { /* other processors add to local queue */
    385:     va_list     Argp;
    386:     PrintfQueue next;
    387:     size_t      fullLength = 8191;
    388:     PetscNew(&next);
    389:     if (petsc_printfqueue) {
    390:       petsc_printfqueue->next = next;
    391:       petsc_printfqueue       = next;
    392:       petsc_printfqueue->next = 0;
    393:     } else petsc_printfqueuebase = petsc_printfqueue = next;
    394:     petsc_printfqueuelength++;
    395:     next->size = -1;
    396:     while ((PetscInt)fullLength >= next->size) {
    397:       next->size = fullLength+1;
    398:       PetscMalloc1(next->size, &next->string);
    399:       va_start(Argp,format);
    400:       PetscMemzero(next->string,next->size);
    401:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
    402:       va_end(Argp);
    403:     }
    404:   }
    405:   return(0);
    406: }

    410: /*@C
    411:     PetscSynchronizedFlush - Flushes to the screen output from all processors
    412:     involved in previous PetscSynchronizedPrintf() calls.

    414:     Collective on MPI_Comm

    416:     Input Parameters:
    417: +   comm - the communicator
    418: -   fd - the file pointer (valid on process 0 of the communicator)

    420:     Level: intermediate

    422:     Notes:
    423:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
    424:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

    426: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
    427:           PetscViewerASCIISynchronizedPrintf()
    428: @*/
    429: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
    430: {
    432:   PetscMPIInt    rank,size,tag,i,j,n = 0,dummy = 0;
    433:   char          *message;
    434:   MPI_Status     status;

    437:   PetscCommDuplicate(comm,&comm,&tag);
    438:   MPI_Comm_rank(comm,&rank);
    439:   MPI_Comm_size(comm,&size);

    441:   /* First processor waits for messages from all other processors */
    442:   if (!rank) {
    443:     if (!fd) fd = PETSC_STDOUT;
    444:     for (i=1; i<size; i++) {
    445:       /* to prevent a flood of messages to process zero, request each message separately */
    446:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
    447:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
    448:       for (j=0; j<n; j++) {
    449:         PetscMPIInt size = 0;

    451:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
    452:         PetscMalloc1(size, &message);
    453:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
    454:         PetscFPrintf(comm,fd,"%s",message);
    455:         PetscFree(message);
    456:       }
    457:     }
    458:   } else { /* other processors send queue to processor 0 */
    459:     PrintfQueue next = petsc_printfqueuebase,previous;

    461:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
    462:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
    463:     for (i=0; i<petsc_printfqueuelength; i++) {
    464:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
    465:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
    466:       previous = next;
    467:       next     = next->next;
    468:       PetscFree(previous->string);
    469:       PetscFree(previous);
    470:     }
    471:     petsc_printfqueue       = 0;
    472:     petsc_printfqueuelength = 0;
    473:   }
    474:   PetscCommDestroy(&comm);
    475:   return(0);
    476: }

    478: /* ---------------------------------------------------------------------------------------*/

    482: /*@C
    483:     PetscFPrintf - Prints to a file, only from the first
    484:     processor in the communicator.

    486:     Not Collective

    488:     Input Parameters:
    489: +   comm - the communicator
    490: .   fd - the file pointer
    491: -   format - the usual printf() format string

    493:     Level: intermediate

    495:     Fortran Note:
    496:     This routine is not supported in Fortran.

    498:    Concepts: printing^in parallel
    499:    Concepts: printf^in parallel

    501: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
    502:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
    503: @*/
    504: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
    505: {
    507:   PetscMPIInt    rank;

    510:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
    511:   MPI_Comm_rank(comm,&rank);
    512:   if (!rank) {
    513:     va_list Argp;
    514:     va_start(Argp,format);
    515:     (*PetscVFPrintf)(fd,format,Argp);
    516:     if (petsc_history && (fd !=petsc_history)) {
    517:       va_start(Argp,format);
    518:       (*PetscVFPrintf)(petsc_history,format,Argp);
    519:     }
    520:     va_end(Argp);
    521:   }
    522:   return(0);
    523: }

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

    531:     Not Collective

    533:     Input Parameters:
    534: +   comm - the communicator
    535: -   format - the usual printf() format string

    537:    Level: intermediate

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

    543:    Concepts: printing^in parallel
    544:    Concepts: printf^in parallel

    546: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
    547: @*/
    548: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
    549: {
    551:   PetscMPIInt    rank;

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

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

    576:       To use, write your own function for example,
    577: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
    578: ${
    579: $ return(0);
    580: $}
    581: then before the call to PetscInitialize() do the assignment
    582: $    PetscHelpPrintf = mypetschelpprintf;

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

    586:   Level:  developer

    588: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
    589: @*/
    590: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
    591: {
    593:   PetscMPIInt    rank;

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

    611: /* ---------------------------------------------------------------------------------------*/

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

    619:     Collective on MPI_Comm

    621:     Input Parameters:
    622: +   comm - the communicator
    623: .   fd - the file pointer
    624: -   len - the length of the output buffer

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

    629:     Level: intermediate

    631: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
    632:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    634: @*/
    635: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
    636: {
    638:   PetscMPIInt    rank;

    641:   MPI_Comm_rank(comm,&rank);

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

    646:     if (!ptr) {
    647:       string[0] = 0;
    648:       if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
    649:     }
    650:   }
    651:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
    652:   return(0);
    653: }

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

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

    665:   if (fd != stdout && fd != stderr) { /* handle regular files */
    666:     PetscVFPrintfDefault(fd,format,Argp);
    667:   } else {
    668:     size_t len=8*1024,length;
    669:     char   buf[len];

    671:     PetscVSNPrintf(buf,len,format,&length,Argp);
    672:     SwiftClosure(buf);
    673:   }
    674:   return(0);
    675: }

    677: /*
    678:    Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
    679: */
    680: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
    681: {
    682:   PetscVFPrintf = PetscVFPrintfToString;
    683:   SwiftClosure  = closure;
    684:   return 0;
    685: }
    686: #endif

    688: #if defined(PETSC_HAVE_MATLAB_ENGINE)
    689: #include <mex.h>
    692: PetscErrorCode  PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
    693: {

    697:   if (fd != stdout && fd != stderr) { /* handle regular files */
    698:     PetscVFPrintfDefault(fd,format,Argp);
    699:   } else {
    700:     size_t len=8*1024,length;
    701:     char   buf[len];

    703:     PetscVSNPrintf(buf,len,format,&length,Argp);
    704:     mexPrintf("%s",buf);
    705:   }
    706:   return(0);
    707: }
    708: #endif

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

    715:    Input Parameters:
    716: .   format - the PETSc format string

    718:  Level: developer

    720: @*/
    721: PetscErrorCode  PetscFormatStrip(char *format)
    722: {
    723:   size_t loc1 = 0, loc2 = 0;

    726:   while (format[loc2]) {
    727:     if (format[loc2] == '%') {
    728:       format[loc1++] = format[loc2++];
    729:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
    730:     }
    731:     format[loc1++] = format[loc2++];
    732:   }
    733:   return(0);
    734: }