Actual source code: mprint.c
petsc-3.7.1 2016-05-15
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: }