Actual source code: mprint.c
petsc-3.10.5 2019-03-28
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: 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 = 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: /*@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:         break;
    125:       case 'F':
    126:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
    127:         break;
    128:       default:
    129:         newformat[j++] = format[i];
    130:         break;
    131:       }
    132:       i++;
    133:     } else newformat[j++] = format[i++];
    134:   }
    135:   newformat[j] = 0;
    136:   return(0);
    137: }

    139: #define PETSCDEFAULTBUFFERSIZE 8*1024

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

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

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

    155:  Level: developer

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

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

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

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

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

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

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

    275:   Level:  developer

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

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

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

    311: /*@C
    312:     PetscSNPrintf - Prints to a string of given length

    314:     Not Collective

    316:     Input Parameters:
    317: +   str - the string to print to
    318: .   len - the length of str
    319: .   format - the usual printf() format string
    320: -   any arguments

    322:    Level: intermediate

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

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

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

    342:     Not Collective

    344:     Input Parameters:
    345: +   str - the string to print to
    346: .   len - the length of str
    347: .   format - the usual printf() format string
    348: -   any arguments

    350:     Output Parameter:
    351: .   countused - number of characters used

    353:    Level: intermediate

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

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

    369: /* ----------------------------------------------------------------------- */

    371: PrintfQueue petsc_printfqueue       = 0,petsc_printfqueuebase = 0;
    372: int         petsc_printfqueuelength = 0;

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

    378:     Not Collective

    380:     Input Parameters:
    381: +   comm - the communicator
    382: -   format - the usual printf() format string

    384:    Level: intermediate

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

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

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

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

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

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

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

    448:     Not Collective

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

    455:     Level: intermediate

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

    461: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
    462:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

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

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

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

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

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

    515:     Collective on MPI_Comm

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

    521:     Level: intermediate

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

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

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

    540:   PetscCommDuplicate(comm,&comm,&tag);
    541:   MPI_Comm_rank(comm,&rank);
    542:   MPI_Comm_size(comm,&size);

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

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

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

    581: /* ---------------------------------------------------------------------------------------*/

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

    587:     Not Collective

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

    594:     Level: intermediate

    596:     Fortran Note:
    597:     This routine is not supported in Fortran.

    599:    Concepts: printing^in parallel
    600:    Concepts: printf^in parallel

    602: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
    603:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
    604: @*/
    605: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
    606: {
    608:   PetscMPIInt    rank;

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

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

    630:     Not Collective

    632:     Input Parameters:
    633: +   comm - the communicator
    634: -   format - the usual printf() format string

    636:    Level: intermediate

    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.

    642:    Concepts: printing^in parallel
    643:    Concepts: printf^in parallel

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

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

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

    673:       To use, write your own function for example,
    674: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
    675: ${
    676: $ return(0);
    677: $}
    678: then before the call to PetscInitialize() do the assignment
    679: $    PetscHelpPrintf = mypetschelpprintf;

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

    683:   Level:  developer

    685: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
    686: @*/
    687: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
    688: {
    690:   PetscMPIInt    rank;

    693:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
    694:   MPI_Comm_rank(comm,&rank);
    695:   if (!rank) {
    696:     va_list Argp;
    697:     va_start(Argp,format);
    698:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
    699:     if (petsc_history) {
    700:       va_start(Argp,format);
    701:       (*PetscVFPrintf)(petsc_history,format,Argp);
    702:     }
    703:     va_end(Argp);
    704:   }
    705:   return(0);
    706: }

    708: /* ---------------------------------------------------------------------------------------*/

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

    714:     Collective on MPI_Comm

    716:     Input Parameters:
    717: +   comm - the communicator
    718: .   fd - the file pointer
    719: -   len - the length of the output buffer

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

    724:     Level: intermediate

    726: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
    727:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    729: @*/
    730: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
    731: {
    733:   PetscMPIInt    rank;

    736:   MPI_Comm_rank(comm,&rank);

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

    741:     if (!ptr) {
    742:       string[0] = 0;
    743:       if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
    744:     }
    745:   }
    746:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
    747:   return(0);
    748: }

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

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

    758:   if (fd != stdout && fd != stderr) { /* handle regular files */
    759:     PetscVFPrintfDefault(fd,format,Argp);
    760:   } else {
    761:     size_t length;
    762:     char   buff[PETSCDEFAULTBUFFERSIZE];

    764:     PetscVSNPrintf(buf,size(buff),format,&length,Argp);
    765:     SwiftClosure(buff);
    766:   }
    767:   return(0);
    768: }

    770: /*
    771:    Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
    772: */
    773: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
    774: {
    775:   PetscVFPrintf = PetscVFPrintfToString;
    776:   SwiftClosure  = closure;
    777:   return 0;
    778: }
    779: #endif

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

    784:    Input Parameters:
    785: .   format - the PETSc format string

    787:  Level: developer

    789: @*/
    790: PetscErrorCode PetscFormatStrip(char *format)
    791: {
    792:   size_t loc1 = 0, loc2 = 0;

    795:   while (format[loc2]) {
    796:     if (format[loc2] == '%') {
    797:       format[loc1++] = format[loc2++];
    798:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
    799:     }
    800:     format[loc1++] = format[loc2++];
    801:   }
    802:   return(0);
    803: }

    805: PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[])
    806: {
    808:   PetscInt       i;
    809:   size_t         left,count;
    810:   char           *p;

    813:   for (i=0,p=buf,left=len; i<n; i++) {
    814:     PetscSNPrintfCount(p,left,fmt,&count,(double)x[i]);
    815:     if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer");
    816:     left -= count;
    817:     p    += count-1;
    818:     *p++  = ' ';
    819:   }
    820:   p[i ? 0 : -1] = 0;
    821:   return(0);
    822: }