Date: 2022-03-31T04:46:06+00:00

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:   size_t   sz = 0;
     41:   PetscInt i  = 0;

     45:   while (format[i]) {
     46:     if (format[i] == '%') {
     47:       if (format[i+1] == '%') {
     48:         i  += 2;
     49:         sz += 2;
     50:         continue;
     51:       }
     52:       /* Find the letter */
     53:       while (format[i] && (format[i] <= '9')) {++i;++sz;}
     54:       switch (format[i]) {
     55: #if PetscDefined(USE_64BIT_INDICES)
     56:       case 'D':
     57:         sz += 2;
     58:         break;
     59: #endif
     60:       case 'g':
     61:         sz += 4;
     62:       default:
     63:         break;
     64:       }
     65:     }
     66:     ++i;
     67:     ++sz;
     68:   }
     69:   *size = sz+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;

     93:   while (format[i]) {
     94:     if (format[i] == '%' && format[i+1] == '%') {
     95:       newformat[j++] = format[i++];
     96:       newformat[j++] = format[i++];
     97:     } else if (format[i] == '%') {
     98:       if (format[i+1] == 'g') {
     99:         newformat[j++] = '[';
    100:         newformat[j++] = '|';
    101:       }
    102:       /* Find the letter */
    103:       for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
    104:       switch (format[i]) {
    105:       case 'D':
    106: #if !defined(PETSC_USE_64BIT_INDICES)
    107:         newformat[j++] = 'd';
    108: #else
    109:         newformat[j++] = 'l';
    110:         newformat[j++] = 'l';
    111:         newformat[j++] = 'd';
    112: #endif
    113:         break;
    114:       case 'g':
    115:         newformat[j++] = format[i];
    116:         if (format[i-1] == '%') {
    117:           newformat[j++] = '|';
    118:           newformat[j++] = ']';
    119:         }
    120:         break;
    121:       case 'G':
    122:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%G format is no longer supported, use %%g and cast the argument to double");
    123:       case 'F':
    124:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
    125:       default:
    126:         newformat[j++] = format[i];
    127:         break;
    128:       }
    129:       i++;
    130:     } else newformat[j++] = format[i++];
    131:   }
    132:   newformat[j] = 0;
    133:   return 0;
    134: }

    136: #define PETSCDEFAULTBUFFERSIZE 8*1024

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

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

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

    152:  Level: developer

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

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

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

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

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

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

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

    269:   Level:  developer

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

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

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

    303: /*@C
    304:     PetscSNPrintf - Prints to a string of given length

    306:     Not Collective

    308:     Input Parameters:
    309: +   str - the string to print to
    310: .   len - the length of str
    311: .   format - the usual printf() format string
    312: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

    314:    Level: intermediate

    316: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
    317:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscVFPrintf()
    318: @*/
    319: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
    320: {
    321:   size_t         fullLength;
    322:   va_list        Argp;

    324:   va_start(Argp,format);
    325:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
    326:   return 0;
    327: }

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

    332:     Not Collective

    334:     Input Parameters:
    335: +   str - the string to print to
    336: .   len - the length of str
    337: .   format - the usual printf() format string
    338: -   ... - any arguments that are to be printed, each much have an appropriate symbol in the format argument

    340:     Output Parameter:
    341: .   countused - number of characters used

    343:    Level: intermediate

    345: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
    346:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf(), PetscVFPrintf()
    347: @*/
    348: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
    349: {
    350:   va_list        Argp;

    352:   va_start(Argp,countused);
    353:   PetscVSNPrintf(str,len,format,countused,Argp);
    354:   return 0;
    355: }

    357: /* ----------------------------------------------------------------------- */

    359: PrintfQueue petsc_printfqueue       = NULL,petsc_printfqueuebase = NULL;
    360: int         petsc_printfqueuelength = 0;

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

    366:     Not Collective

    368:     Input Parameters:
    369: +   comm - the communicator
    370: -   format - the usual printf() format string

    372:    Level: intermediate

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

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

    382: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
    383:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
    384: @*/
    385: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
    386: {
    387:   PetscMPIInt    rank;

    390:   MPI_Comm_rank(comm,&rank);

    392:   /* First processor prints immediately to stdout */
    393:   if (rank == 0) {
    394:     va_list Argp;
    395:     va_start(Argp,format);
    396:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    397:     if (petsc_history) {
    398:       va_start(Argp,format);
    399:       (*PetscVFPrintf)(petsc_history,format,Argp);
    400:     }
    401:     va_end(Argp);
    402:   } else { /* other processors add to local queue */
    403:     va_list     Argp;
    404:     PrintfQueue next;
    405:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

    407:     PetscNew(&next);
    408:     if (petsc_printfqueue) {
    409:       petsc_printfqueue->next = next;
    410:       petsc_printfqueue       = next;
    411:       petsc_printfqueue->next = NULL;
    412:     } else petsc_printfqueuebase = petsc_printfqueue = next;
    413:     petsc_printfqueuelength++;
    414:     next->size   = 0;
    415:     next->string = NULL;
    416:     while (fullLength >= next->size) {
    417:       next->size = fullLength+1;
    418:       PetscFree(next->string);
    419:       PetscMalloc1(next->size, &next->string);
    420:       va_start(Argp,format);
    421:       PetscArrayzero(next->string,next->size);
    422:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
    423:       va_end(Argp);
    424:     }
    425:   }
    426:   return 0;
    427: }

    429: /*@C
    430:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
    431:     several processors.  Output of the first processor is followed by that of the
    432:     second, etc.

    434:     Not Collective

    436:     Input Parameters:
    437: +   comm - the communicator
    438: .   fd - the file pointer
    439: -   format - the usual printf() format string

    441:     Level: intermediate

    443:     Notes:
    444:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
    445:     from all the processors to be printed.

    447: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
    448:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    450: @*/
    451: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
    452: {
    453:   PetscMPIInt    rank;

    456:   MPI_Comm_rank(comm,&rank);

    458:   /* First processor prints immediately to fp */
    459:   if (rank == 0) {
    460:     va_list Argp;
    461:     va_start(Argp,format);
    462:     (*PetscVFPrintf)(fp,format,Argp);
    463:     if (petsc_history && (fp !=petsc_history)) {
    464:       va_start(Argp,format);
    465:       (*PetscVFPrintf)(petsc_history,format,Argp);
    466:     }
    467:     va_end(Argp);
    468:   } else { /* other processors add to local queue */
    469:     va_list     Argp;
    470:     PrintfQueue next;
    471:     size_t      fullLength = PETSCDEFAULTBUFFERSIZE;

    473:     PetscNew(&next);
    474:     if (petsc_printfqueue) {
    475:       petsc_printfqueue->next = next;
    476:       petsc_printfqueue       = next;
    477:       petsc_printfqueue->next = NULL;
    478:     } else petsc_printfqueuebase = petsc_printfqueue = next;
    479:     petsc_printfqueuelength++;
    480:     next->size   = 0;
    481:     next->string = NULL;
    482:     while (fullLength >= next->size) {
    483:       next->size = fullLength+1;
    484:       PetscFree(next->string);
    485:       PetscMalloc1(next->size, &next->string);
    486:       va_start(Argp,format);
    487:       PetscArrayzero(next->string,next->size);
    488:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
    489:       va_end(Argp);
    490:     }
    491:   }
    492:   return 0;
    493: }

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

    499:     Collective

    501:     Input Parameters:
    502: +   comm - the communicator
    503: -   fd - the file pointer (valid on process 0 of the communicator)

    505:     Level: intermediate

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

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

    513: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
    514:           PetscViewerASCIISynchronizedPrintf()
    515: @*/
    516: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
    517: {
    518:   PetscMPIInt    rank,size,tag,i,j,n = 0,dummy = 0;
    519:   char          *message;
    520:   MPI_Status     status;

    522:   PetscCommDuplicate(comm,&comm,&tag);
    523:   MPI_Comm_rank(comm,&rank);
    524:   MPI_Comm_size(comm,&size);

    526:   /* First processor waits for messages from all other processors */
    527:   if (rank == 0) {
    528:     if (!fd) fd = PETSC_STDOUT;
    529:     for (i=1; i<size; i++) {
    530:       /* to prevent a flood of messages to process zero, request each message separately */
    531:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
    532:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
    533:       for (j=0; j<n; j++) {
    534:         PetscMPIInt size = 0;

    536:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
    537:         PetscMalloc1(size, &message);
    538:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
    539:         PetscFPrintf(comm,fd,"%s",message);
    540:         PetscFree(message);
    541:       }
    542:     }
    543:   } else { /* other processors send queue to processor 0 */
    544:     PrintfQueue next = petsc_printfqueuebase,previous;

    546:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
    547:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
    548:     for (i=0; i<petsc_printfqueuelength; i++) {
    549:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
    550:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
    551:       previous = next;
    552:       next     = next->next;
    553:       PetscFree(previous->string);
    554:       PetscFree(previous);
    555:     }
    556:     petsc_printfqueue       = NULL;
    557:     petsc_printfqueuelength = 0;
    558:   }
    559:   PetscCommDestroy(&comm);
    560:   return 0;
    561: }

    563: /* ---------------------------------------------------------------------------------------*/

    565: /*@C
    566:     PetscFPrintf - Prints to a file, only from the first
    567:     processor in the communicator.

    569:     Not Collective

    571:     Input Parameters:
    572: +   comm - the communicator
    573: .   fd - the file pointer
    574: -   format - the usual printf() format string

    576:     Level: intermediate

    578:     Fortran Note:
    579:     This routine is not supported in Fortran.

    581: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
    582:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
    583: @*/
    584: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
    585: {
    586:   PetscMPIInt    rank;

    589:   MPI_Comm_rank(comm,&rank);
    590:   if (rank == 0) {
    591:     va_list Argp;
    592:     va_start(Argp,format);
    593:     (*PetscVFPrintf)(fd,format,Argp);
    594:     if (petsc_history && (fd !=petsc_history)) {
    595:       va_start(Argp,format);
    596:       (*PetscVFPrintf)(petsc_history,format,Argp);
    597:     }
    598:     va_end(Argp);
    599:   }
    600:   return 0;
    601: }

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

    607:     Not Collective

    609:     Input Parameters:
    610: +   comm - the communicator
    611: -   format - the usual printf() format string

    613:     Level: intermediate

    615:     Notes:
    616:     PetscPrintf() supports some format specifiers that are unique to PETSc.
    617:     See the manual page for PetscFormatConvert() for details.

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

    623: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscFormatConvert()
    624: @*/
    625: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
    626: {
    627:   PetscMPIInt    rank;

    630:   MPI_Comm_rank(comm,&rank);
    631:   if (rank == 0) {
    632:     va_list Argp;
    633:     va_start(Argp,format);
    634:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    635:     if (petsc_history) {
    636:       va_start(Argp,format);
    637:       (*PetscVFPrintf)(petsc_history,format,Argp);
    638:     }
    639:     va_end(Argp);
    640:   }
    641:   return 0;
    642: }

    644: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
    645: {
    646:   PetscMPIInt    rank;

    649:   MPI_Comm_rank(comm,&rank);
    650:   if (rank == 0) {
    651:     va_list Argp;
    652:     va_start(Argp,format);
    653:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    654:     if (petsc_history) {
    655:       va_start(Argp,format);
    656:       (*PetscVFPrintf)(petsc_history,format,Argp);
    657:     }
    658:     va_end(Argp);
    659:   }
    660:   return 0;
    661: }

    663: /* ---------------------------------------------------------------------------------------*/

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

    668:     Collective

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

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

    678:     Level: intermediate

    680: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
    681:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

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

    688:   MPI_Comm_rank(comm,&rank);

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

    693:     if (!ptr) {
    694:       string[0] = 0;
    696:     }
    697:   }
    698:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
    699:   return 0;
    700: }

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

    705: PetscErrorCode PetscVFPrintfToString(FILE *fd,const char format[],va_list Argp)
    706: {
    707:   if (fd != stdout && fd != stderr) { /* handle regular files */
    708:     PetscVFPrintfDefault(fd,format,Argp);
    709:   } else {
    710:     size_t length;
    711:     char   buff[PETSCDEFAULTBUFFERSIZE];

    713:     PetscVSNPrintf(buff,sizeof(buff),format,&length,Argp);
    714:     SwiftClosure(buff);
    715:   }
    716:   return 0;
    717: }

    719: /*
    720:    Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
    721: */
    722: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
    723: {
    724:   PetscVFPrintf = PetscVFPrintfToString;
    725:   SwiftClosure  = closure;
    726:   return 0;
    727: }
    728: #endif

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

    733:    Input Parameters:
    734: .   format - the PETSc format string

    736:  Level: developer

    738: @*/
    739: PetscErrorCode PetscFormatStrip(char *format)
    740: {
    741:   size_t loc1 = 0, loc2 = 0;

    743:   while (format[loc2]) {
    744:     if (format[loc2] == '%') {
    745:       format[loc1++] = format[loc2++];
    746:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
    747:     }
    748:     format[loc1++] = format[loc2++];
    749:   }
    750:   return 0;
    751: }

    753: PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[])
    754: {
    755:   PetscInt       i;
    756:   size_t         left,count;
    757:   char           *p;

    759:   for (i=0,p=buf,left=len; i<n; i++) {
    760:     PetscSNPrintfCount(p,left,fmt,&count,(double)x[i]);
    762:     left -= count;
    763:     p    += count-1;
    764:     *p++  = ' ';
    765:   }
    766:   p[i ? 0 : -1] = 0;
    767:   return 0;
    768: }