Actual source code: mprint.c

      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: PETSC_INTERN 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 = NULL;
     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 = NULL;

     24: /*@C
     25:      PetscFormatConvertGetSize - Gets the length of a string needed to hold format converted with PetscFormatConvert()

     27:    Input Parameter:
     28: .   format - the PETSc format string

     30:    Output Parameter:
     31: .   size - the needed length of the new format

     33:  Level: developer

     35: .seealso: PetscFormatConvert(), PetscVSNPrintf(), PetscVFPrintf()

     37: @*/
     38: PetscErrorCode PetscFormatConvertGetSize(const char *format,size_t *size)
     39: {
     40:   PetscInt i = 0;

     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:   return(0);
     71: }

     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.

     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

     82:     Note: this exists so we can have the same code when PetscInt is either int or long long int

     84:  Level: developer

     86: .seealso: PetscFormatConvertGetSize(), PetscVSNPrintf(), PetscVFPrintf()

     88: @*/
     89: PetscErrorCode PetscFormatConvert(const char *format,char *newformat)
     90: {
     91:   PetscInt i = 0, j = 0;

     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:       case 'F':
    125:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
    126:       default:
    127:         newformat[j++] = format[i];
    128:         break;
    129:       }
    130:       i++;
    131:     } else newformat[j++] = format[i++];
    132:   }
    133:   newformat[j] = 0;
    134:   return(0);
    135: }

    137: #define PETSCDEFAULTBUFFERSIZE 8*1024

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

    143:    Input Parameters:
    144: +   str - location to put result
    145: .   len - the amount of space in str
    146: +   format - the PETSc format string
    147: -   fullLength - the amount of space in str actually used.

    149:     Developer Notes:
    150:     this function may be called from an error handler, if an error occurs when it is called by the error handler than likely
    151:       a recursion will occur and possible crash.

    153:  Level: developer

    155: .seealso: PetscVSNPrintf(), PetscErrorPrintf(), PetscVPrintf()

    157: @*/
    158: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
    159: {
    160:   char           *newformat = NULL;
    161:   char           formatbuf[PETSCDEFAULTBUFFERSIZE];
    162:   size_t         newLength;
    164:   int            flen;

    167:   PetscFormatConvertGetSize(format,&newLength);
    168:   if (newLength < PETSCDEFAULTBUFFERSIZE) {
    169:     newformat = formatbuf;
    170:     newLength = PETSCDEFAULTBUFFERSIZE-1;
    171:   } else {
    172:     PetscMalloc1(newLength, &newformat);
    173:   }
    174:   PetscFormatConvert(format,newformat);
    175: #if defined(PETSC_HAVE_VSNPRINTF)
    176:   flen = vsnprintf(str,len,newformat,Argp);
    177: #else
    178: #error "vsnprintf not found"
    179: #endif
    180:   if (newLength > PETSCDEFAULTBUFFERSIZE-1) {
    181:     PetscFree(newformat);
    182:   }
    183:   {
    184:     PetscBool foundedot;
    185:     size_t cnt = 0,ncnt = 0,leng;
    186:     PetscStrlen(str,&leng);
    187:     if (leng > 4) {
    188:       for (cnt=0; cnt<leng-4; cnt++) {
    189:         if (str[cnt] == '[' && str[cnt+1] == '|'){
    190:           flen -= 4;
    191:           cnt++; cnt++;
    192:           foundedot = PETSC_FALSE;
    193:           for (; cnt<leng-1; cnt++) {
    194:             if (str[cnt] == '|' && str[cnt+1] == ']'){
    195:               cnt++;
    196:               if (!foundedot) str[ncnt++] = '.';
    197:               ncnt--;
    198:               break;
    199:             } else {
    200:               if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
    201:               str[ncnt++] = str[cnt];
    202:             }
    203:           }
    204:         } else {
    205:           str[ncnt] = str[cnt];
    206:         }
    207:         ncnt++;
    208:       }
    209:       while (cnt < leng) {
    210:         str[ncnt] = str[cnt]; ncnt++; cnt++;
    211:       }
    212:       str[ncnt] = 0;
    213:     }
    214:   }
    215: #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
    216:   /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
    217:   {
    218:     size_t cnt = 0,ncnt = 0,leng;
    219:     PetscStrlen(str,&leng);
    220:     if (leng > 5) {
    221:       for (cnt=0; cnt<leng-4; cnt++) {
    222:         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') {
    223:           str[ncnt] = str[cnt]; ncnt++; cnt++;
    224:           str[ncnt] = str[cnt]; ncnt++; cnt++; cnt++;
    225:           str[ncnt] = str[cnt];
    226:         } else {
    227:           str[ncnt] = str[cnt];
    228:         }
    229:         ncnt++;
    230:       }
    231:       while (cnt < leng) {
    232:         str[ncnt] = str[cnt]; ncnt++; cnt++;
    233:       }
    234:       str[ncnt] = 0;
    235:     }
    236:   }
    237: #endif
    238:   if (fullLength) *fullLength = 1 + (size_t) flen;
    239:   return(0);
    240: }

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

    246:       To use, write your own function for example,
    247: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
    248: ${
    250: $
    252: $   if (fd != stdout && fd != stderr) {  handle regular files
    253: $      PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
    254: $  } else {
    255: $     char   buff[BIG];
    256: $     size_t length;
    257: $     PetscVSNPrintf(buff,BIG,format,&length,Argp);
    258: $     now send buff to whatever stream or whatever you want
    259: $ }
    260: $ return(0);
    261: $}
    262: then before the call to PetscInitialize() do the assignment
    263: $    PetscVFPrintf = mypetscvfprintf;

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

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

    273:   Level:  developer

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

    277: @*/
    278: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
    279: {
    280:   char           str[PETSCDEFAULTBUFFERSIZE];
    281:   char           *buff = str;
    282:   size_t         fullLength;
    284: #if defined(PETSC_HAVE_VA_COPY)
    285:   va_list        Argpcopy;
    286: #endif

    289: #if defined(PETSC_HAVE_VA_COPY)
    290:   va_copy(Argpcopy,Argp);
    291: #endif
    292:   PetscVSNPrintf(str,sizeof(str),format,&fullLength,Argp);
    293:   if (fullLength > sizeof(str)) {
    294:     PetscMalloc1(fullLength,&buff);
    295: #if defined(PETSC_HAVE_VA_COPY)
    296:     PetscVSNPrintf(buff,fullLength,format,NULL,Argpcopy);
    297: #else
    298:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
    299: #endif
    300:   }
    301:   fprintf(fd,"%s",buff);
    302:   fflush(fd);
    303:   if (buff != str) {
    304:     PetscFree(buff);
    305:   }
    306:   return(0);
    307: }

    309: /*@C
    310:     PetscSNPrintf - Prints to a string of given length

    312:     Not Collective

    314:     Input Parameters:
    315: +   str - the string to print to
    316: .   len - the length of str
    317: .   format - the usual printf() format string
    318: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

    320:    Level: intermediate

    322: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
    323:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscVFPrintf()
    324: @*/
    325: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
    326: {
    328:   size_t         fullLength;
    329:   va_list        Argp;

    332:   va_start(Argp,format);
    333:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
    334:   return(0);
    335: }

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

    340:     Not Collective

    342:     Input Parameters:
    343: +   str - the string to print to
    344: .   len - the length of str
    345: .   format - the usual printf() format string
    346: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

    348:     Output Parameter:
    349: .   countused - number of characters used

    351:    Level: intermediate

    353: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
    354:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf(), PetscVFPrintf()
    355: @*/
    356: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
    357: {
    359:   va_list        Argp;

    362:   va_start(Argp,countused);
    363:   PetscVSNPrintf(str,len,format,countused,Argp);
    364:   return(0);
    365: }

    367: /* ----------------------------------------------------------------------- */

    369: PrintfQueue petsc_printfqueue       = NULL,petsc_printfqueuebase = NULL;
    370: int         petsc_printfqueuelength = 0;

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

    376:     Not Collective

    378:     Input Parameters:
    379: +   comm - the communicator
    380: -   format - the usual printf() format string

    382:    Level: intermediate

    384:     Notes:
    385:     REQUIRES a call to PetscSynchronizedFlush() by all the processes after the completion of the calls to PetscSynchronizedPrintf() for the information
    386:     from all the processors to be printed.

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

    392: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
    393:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
    394: @*/
    395: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
    396: {
    398:   PetscMPIInt    rank;

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

    404:   /* First processor prints immediately to stdout */
    405:   if (!rank) {
    406:     va_list Argp;
    407:     va_start(Argp,format);
    408:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    409:     if (petsc_history) {
    410:       va_start(Argp,format);
    411:       (*PetscVFPrintf)(petsc_history,format,Argp);
    412:     }
    413:     va_end(Argp);
    414:   } else { /* other processors add to local queue */
    415:     va_list     Argp;
    416:     PrintfQueue next;
    417:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

    419:     PetscNew(&next);
    420:     if (petsc_printfqueue) {
    421:       petsc_printfqueue->next = next;
    422:       petsc_printfqueue       = next;
    423:       petsc_printfqueue->next = NULL;
    424:     } else petsc_printfqueuebase = petsc_printfqueue = next;
    425:     petsc_printfqueuelength++;
    426:     next->size   = -1;
    427:     next->string = NULL;
    428:     while ((PetscInt)fullLength >= next->size) {
    429:       next->size = fullLength+1;
    430:       PetscFree(next->string);
    431:       PetscMalloc1(next->size, &next->string);
    432:       va_start(Argp,format);
    433:       PetscArrayzero(next->string,next->size);
    434:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
    435:       va_end(Argp);
    436:     }
    437:   }
    438:   return(0);
    439: }

    441: /*@C
    442:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
    443:     several processors.  Output of the first processor is followed by that of the
    444:     second, etc.

    446:     Not Collective

    448:     Input Parameters:
    449: +   comm - the communicator
    450: .   fd - the file pointer
    451: -   format - the usual printf() format string

    453:     Level: intermediate

    455:     Notes:
    456:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
    457:     from all the processors to be printed.

    459: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
    460:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    462: @*/
    463: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
    464: {
    466:   PetscMPIInt    rank;

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

    472:   /* First processor prints immediately to fp */
    473:   if (!rank) {
    474:     va_list Argp;
    475:     va_start(Argp,format);
    476:     (*PetscVFPrintf)(fp,format,Argp);
    477:     if (petsc_history && (fp !=petsc_history)) {
    478:       va_start(Argp,format);
    479:       (*PetscVFPrintf)(petsc_history,format,Argp);
    480:     }
    481:     va_end(Argp);
    482:   } else { /* other processors add to local queue */
    483:     va_list     Argp;
    484:     PrintfQueue next;
    485:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

    487:     PetscNew(&next);
    488:     if (petsc_printfqueue) {
    489:       petsc_printfqueue->next = next;
    490:       petsc_printfqueue       = next;
    491:       petsc_printfqueue->next = NULL;
    492:     } else petsc_printfqueuebase = petsc_printfqueue = next;
    493:     petsc_printfqueuelength++;
    494:     next->size   = -1;
    495:     next->string = NULL;
    496:     while ((PetscInt)fullLength >= next->size) {
    497:       next->size = fullLength+1;
    498:       PetscFree(next->string);
    499:       PetscMalloc1(next->size, &next->string);
    500:       va_start(Argp,format);
    501:       PetscArrayzero(next->string,next->size);
    502:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
    503:       va_end(Argp);
    504:     }
    505:   }
    506:   return(0);
    507: }

    509: /*@C
    510:     PetscSynchronizedFlush - Flushes to the screen output from all processors
    511:     involved in previous PetscSynchronizedPrintf()/PetscSynchronizedFPrintf() calls.

    513:     Collective

    515:     Input Parameters:
    516: +   comm - the communicator
    517: -   fd - the file pointer (valid on process 0 of the communicator)

    519:     Level: intermediate

    521:     Notes:
    522:     If PetscSynchronizedPrintf() and/or PetscSynchronizedFPrintf() are called with
    523:     different MPI communicators there must be an intervening call to PetscSynchronizedFlush() between the calls with different MPI communicators.

    525:     From Fortran pass PETSC_STDOUT if the flush is for standard out; otherwise pass a value obtained from PetscFOpen()

    527: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
    528:           PetscViewerASCIISynchronizedPrintf()
    529: @*/
    530: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
    531: {
    533:   PetscMPIInt    rank,size,tag,i,j,n = 0,dummy = 0;
    534:   char          *message;
    535:   MPI_Status     status;

    538:   PetscCommDuplicate(comm,&comm,&tag);
    539:   MPI_Comm_rank(comm,&rank);
    540:   MPI_Comm_size(comm,&size);

    542:   /* First processor waits for messages from all other processors */
    543:   if (!rank) {
    544:     if (!fd) fd = PETSC_STDOUT;
    545:     for (i=1; i<size; i++) {
    546:       /* to prevent a flood of messages to process zero, request each message separately */
    547:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
    548:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
    549:       for (j=0; j<n; j++) {
    550:         PetscMPIInt size = 0;

    552:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
    553:         PetscMalloc1(size, &message);
    554:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
    555:         PetscFPrintf(comm,fd,"%s",message);
    556:         PetscFree(message);
    557:       }
    558:     }
    559:   } else { /* other processors send queue to processor 0 */
    560:     PrintfQueue next = petsc_printfqueuebase,previous;

    562:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
    563:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
    564:     for (i=0; i<petsc_printfqueuelength; i++) {
    565:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
    566:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
    567:       previous = next;
    568:       next     = next->next;
    569:       PetscFree(previous->string);
    570:       PetscFree(previous);
    571:     }
    572:     petsc_printfqueue       = NULL;
    573:     petsc_printfqueuelength = 0;
    574:   }
    575:   PetscCommDestroy(&comm);
    576:   return(0);
    577: }

    579: /* ---------------------------------------------------------------------------------------*/

    581: /*@C
    582:     PetscFPrintf - Prints to a file, only from the first
    583:     processor in the communicator.

    585:     Not Collective

    587:     Input Parameters:
    588: +   comm - the communicator
    589: .   fd - the file pointer
    590: -   format - the usual printf() format string

    592:     Level: intermediate

    594:     Fortran Note:
    595:     This routine is not supported in Fortran.

    598: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
    599:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
    600: @*/
    601: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
    602: {
    604:   PetscMPIInt    rank;

    607:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
    608:   MPI_Comm_rank(comm,&rank);
    609:   if (!rank) {
    610:     va_list Argp;
    611:     va_start(Argp,format);
    612:     (*PetscVFPrintf)(fd,format,Argp);
    613:     if (petsc_history && (fd !=petsc_history)) {
    614:       va_start(Argp,format);
    615:       (*PetscVFPrintf)(petsc_history,format,Argp);
    616:     }
    617:     va_end(Argp);
    618:   }
    619:   return(0);
    620: }

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

    626:     Not Collective

    628:     Input Parameters:
    629: +   comm - the communicator
    630: -   format - the usual printf() format string

    632:     Level: intermediate

    634:     Notes:
    635:     PetscPrintf() supports some format specifiers that are unique to PETSc.
    636:     See the manual page for PetscFormatConvert() for details.

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

    643: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscFormatConvert()
    644: @*/
    645: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
    646: {
    648:   PetscMPIInt    rank;

    651:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
    652:   MPI_Comm_rank(comm,&rank);
    653:   if (!rank) {
    654:     va_list Argp;
    655:     va_start(Argp,format);
    656:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    657:     if (petsc_history) {
    658:       va_start(Argp,format);
    659:       (*PetscVFPrintf)(petsc_history,format,Argp);
    660:     }
    661:     va_end(Argp);
    662:   }
    663:   return(0);
    664: }

    666: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
    667: {
    669:   PetscMPIInt    rank;

    672:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
    673:   MPI_Comm_rank(comm,&rank);
    674:   if (!rank) {
    675:     va_list Argp;
    676:     va_start(Argp,format);
    677:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    678:     if (petsc_history) {
    679:       va_start(Argp,format);
    680:       (*PetscVFPrintf)(petsc_history,format,Argp);
    681:     }
    682:     va_end(Argp);
    683:   }
    684:   return(0);
    685: }

    687: /* ---------------------------------------------------------------------------------------*/

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

    693:     Collective

    695:     Input Parameters:
    696: +   comm - the communicator
    697: .   fd - the file pointer
    698: -   len - the length of the output buffer

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

    703:     Level: intermediate

    705: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
    706:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    708: @*/
    709: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
    710: {
    712:   PetscMPIInt    rank;

    715:   MPI_Comm_rank(comm,&rank);

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

    720:     if (!ptr) {
    721:       string[0] = 0;
    722:       if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
    723:     }
    724:   }
    725:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
    726:   return(0);
    727: }

    729: #if defined(PETSC_HAVE_CLOSURE)
    730: int (^SwiftClosure)(const char*) = 0;

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

    737:   if (fd != stdout && fd != stderr) { /* handle regular files */
    738:     PetscVFPrintfDefault(fd,format,Argp);
    739:   } else {
    740:     size_t length;
    741:     char   buff[PETSCDEFAULTBUFFERSIZE];

    743:     PetscVSNPrintf(buff,sizeof(buff),format,&length,Argp);
    744:     SwiftClosure(buff);
    745:   }
    746:   return(0);
    747: }

    749: /*
    750:    Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
    751: */
    752: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
    753: {
    754:   PetscVFPrintf = PetscVFPrintfToString;
    755:   SwiftClosure  = closure;
    756:   return 0;
    757: }
    758: #endif

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

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

    766:  Level: developer

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

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

    784: PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[])
    785: {
    787:   PetscInt       i;
    788:   size_t         left,count;
    789:   char           *p;

    792:   for (i=0,p=buf,left=len; i<n; i++) {
    793:     PetscSNPrintfCount(p,left,fmt,&count,(double)x[i]);
    794:     if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer");
    795:     left -= count;
    796:     p    += count-1;
    797:     *p++  = ' ';
    798:   }
    799:   p[i ? 0 : -1] = 0;
    800:   return(0);
    801: }