Actual source code: mprint.c

petsc-3.9.4 2018-09-11
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)

 29: /*@C
 30:      PetscFormatConvert - Takes a PETSc format string and converts it to a reqular C format string

 32:    Input Parameters:
 33: +   format - the PETSc format string
 34: .   newformat - the location to put the standard C format string values
 35: -   size - the length of newformat

 37:     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

 39:  Level: developer

 41: @*/
 42: PetscErrorCode  PetscFormatConvert(const char *format,char *newformat,size_t size)
 43: {
 44:   PetscInt i = 0,j = 0;

 47:   while (format[i] && j < (PetscInt)size-1) {
 48:     if (format[i] == '%' && format[i+1] == '%') {
 49:       newformat[j++] = format[i++];
 50:       newformat[j++] = format[i++];
 51:     } else if (format[i] == '%') {
 52:       if (format[i+1] == 'g') {
 53:         newformat[j++] = '[';
 54:         newformat[j++] = '|';
 55:       }
 56:       /* Find the letter */
 57:       for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
 58:       switch (format[i]) {
 59:       case 'D':
 60: #if !defined(PETSC_USE_64BIT_INDICES)
 61:         newformat[j++] = 'd';
 62: #else
 63:         newformat[j++] = 'l';
 64:         newformat[j++] = 'l';
 65:         newformat[j++] = 'd';
 66: #endif
 67:         break;
 68:       case 'g':
 69:         newformat[j++] = format[i];
 70:         if (format[i-1] == '%') {
 71:           newformat[j++] = '|';
 72:           newformat[j++] = ']';
 73:         }
 74:         break;
 75:       case 'G':
 76:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%G format is no longer supported, use %%g and cast the argument to double");
 77:         break;
 78:       case 'F':
 79:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
 80:         break;
 81:       default:
 82:         newformat[j++] = format[i];
 83:         break;
 84:       }
 85:       i++;
 86:     } else newformat[j++] = format[i++];
 87:   }
 88:   newformat[j] = 0;
 89:   return(0);
 90: }

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

 96:    Input Parameters:
 97: +   str - location to put result
 98: .   len - the amount of space in str
 99: +   format - the PETSc format string
100: -   fullLength - the amount of space in str actually used.

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

105:  Level: developer

107: @*/
108: PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
109: {
110:   char           *newformat;
111:   char           formatbuf[8*1024];
112:   size_t         oldLength,length;

116:   PetscStrlen(format, &oldLength);
117:   if (oldLength < 8*1024) {
118:     newformat = formatbuf;
119:     oldLength = 8*1024-1;
120:   } else {
121:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
122:     PetscMalloc1(oldLength, &newformat);
123:   }
124:   PetscFormatConvert(format,newformat,oldLength);
125:   PetscStrlen(newformat, &length);
126: #if 0
127:   if (length > len) newformat[len] = '\0';
128: #endif
129: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
130:   (void) vsnprintf(str,len,newformat,(char*)Argp);
131: #elif defined(PETSC_HAVE_VSNPRINTF)
132:   (void) vsnprintf(str,len,newformat,Argp);
133: #elif defined(PETSC_HAVE__VSNPRINTF)
134:   (void) _vsnprintf(str,len,newformat,Argp);
135: #else
136: #error "vsnprintf not found"
137: #endif
138:   if (oldLength >= 8*1024) {
139:     PetscFree(newformat);
140:   }
141:   {
142:     PetscBool foundedot;
143:     size_t cnt = 0,ncnt = 0,leng;
144:     PetscStrlen(str,&leng);
145:     if (leng > 4) {
146:       for (cnt=0; cnt<leng-4; cnt++) {
147:         if (str[cnt] == '[' && str[cnt+1] == '|'){
148:            cnt++; cnt++;
149:            foundedot = PETSC_FALSE;
150:            for (; cnt<leng-1; cnt++) {
151:              if (str[cnt] == '|' && str[cnt+1] == ']'){
152:                cnt++;
153:                if (!foundedot) str[ncnt++] = '.';
154:                ncnt--;
155:                break;
156:              } else {
157:                if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
158:                str[ncnt++] = str[cnt];
159:              }
160:            }
161:         } else {
162:           str[ncnt] = str[cnt];
163:         }
164:         ncnt++;
165:       }
166:       while (cnt < leng) {
167:         str[ncnt] = str[cnt]; ncnt++; cnt++;
168:       }
169:       str[ncnt] = 0;
170:     }
171:   }
172: #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
173:   /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
174:   {
175:     size_t cnt = 0,ncnt = 0,leng;
176:     PetscStrlen(str,&leng);
177:     if (leng > 5) {
178:       for (cnt=0; cnt<leng-4; cnt++) {
179:         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') {
180:           str[ncnt] = str[cnt]; ncnt++; cnt++;
181:           str[ncnt] = str[cnt]; ncnt++; cnt++; cnt++;
182:           str[ncnt] = str[cnt];
183:         } else {
184:           str[ncnt] = str[cnt];
185:         }
186:         ncnt++;
187:       }
188:       while (cnt < leng) {
189:         str[ncnt] = str[cnt]; ncnt++; cnt++;
190:       }
191:       str[ncnt] = 0;
192:     }
193:   }
194: #endif
195:   if (fullLength) {
196:     PetscStrlen(str,fullLength);
197:   }
198:   return(0);
199: }

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

205:       To use, write your own function for example,
206: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
207: ${
209: $
211: $   if (fd != stdout && fd != stderr) {  handle regular files
212: $      PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
213: $  } else {
214: $     char   buff[BIG];
215: $     size_t length;
216: $     PetscVSNPrintf(buff,BIG,format,&length,Argp);
217: $     now send buff to whatever stream or whatever you want
218: $ }
219: $ return(0);
220: $}
221: then before the call to PetscInitialize() do the assignment
222: $    PetscVFPrintf = mypetscvfprintf;

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

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

230:   Level:  developer

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

234: @*/
235: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
236: {
237:   char           str[8*1024];

241:   PetscVSNPrintf(str,sizeof(str),format,NULL,Argp);
242:   fprintf(fd,"%s",str);
243:   fflush(fd);
244:   return(0);
245: }

247: /*@C
248:     PetscSNPrintf - Prints to a string of given length

250:     Not Collective

252:     Input Parameters:
253: +   str - the string to print to
254: .   len - the length of str
255: .   format - the usual printf() format string
256: -   any arguments

258:    Level: intermediate

260: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
261:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
262: @*/
263: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
264: {
266:   size_t         fullLength;
267:   va_list        Argp;

270:   va_start(Argp,format);
271:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
272:   return(0);
273: }

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

278:     Not Collective

280:     Input Parameters:
281: +   str - the string to print to
282: .   len - the length of str
283: .   format - the usual printf() format string
284: .   countused - number of characters used
285: -   any arguments

287:    Level: intermediate

289: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
290:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
291: @*/
292: PetscErrorCode  PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
293: {
295:   va_list        Argp;

298:   va_start(Argp,countused);
299:   PetscVSNPrintf(str,len,format,countused,Argp);
300:   return(0);
301: }

303: /* ----------------------------------------------------------------------- */

305: PrintfQueue petsc_printfqueue       = 0,petsc_printfqueuebase = 0;
306: int         petsc_printfqueuelength = 0;

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

312:     Not Collective

314:     Input Parameters:
315: +   comm - the communicator
316: -   format - the usual printf() format string

318:    Level: intermediate

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

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

328: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
329:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
330: @*/
331: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
332: {
334:   PetscMPIInt    rank;

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

340:   /* First processor prints immediately to stdout */
341:   if (!rank) {
342:     va_list Argp;
343:     va_start(Argp,format);
344:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
345:     if (petsc_history) {
346:       va_start(Argp,format);
347:       (*PetscVFPrintf)(petsc_history,format,Argp);
348:     }
349:     va_end(Argp);
350:   } else { /* other processors add to local queue */
351:     va_list     Argp;
352:     PrintfQueue next;
353:     size_t      fullLength = 8191;

355:     PetscNew(&next);
356:     if (petsc_printfqueue) {
357:       petsc_printfqueue->next = next;
358:       petsc_printfqueue       = next;
359:       petsc_printfqueue->next = 0;
360:     } else petsc_printfqueuebase = petsc_printfqueue = next;
361:     petsc_printfqueuelength++;
362:     next->size = -1;
363:     while ((PetscInt)fullLength >= next->size) {
364:       next->size = fullLength+1;

366:       PetscMalloc1(next->size, &next->string);
367:       va_start(Argp,format);
368:       PetscMemzero(next->string,next->size);
369:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
370:       va_end(Argp);
371:     }
372:   }
373:   return(0);
374: }

376: /*@C
377:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
378:     several processors.  Output of the first processor is followed by that of the
379:     second, etc.

381:     Not Collective

383:     Input Parameters:
384: +   comm - the communicator
385: .   fd - the file pointer
386: -   format - the usual printf() format string

388:     Level: intermediate

390:     Notes:
391:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
392:     from all the processors to be printed.

394: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
395:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

397: @*/
398: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
399: {
401:   PetscMPIInt    rank;

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

407:   /* First processor prints immediately to fp */
408:   if (!rank) {
409:     va_list Argp;
410:     va_start(Argp,format);
411:     (*PetscVFPrintf)(fp,format,Argp);
412:     if (petsc_history && (fp !=petsc_history)) {
413:       va_start(Argp,format);
414:       (*PetscVFPrintf)(petsc_history,format,Argp);
415:     }
416:     va_end(Argp);
417:   } else { /* other processors add to local queue */
418:     va_list     Argp;
419:     PrintfQueue next;
420:     size_t      fullLength = 8191;
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:     while ((PetscInt)fullLength >= next->size) {
430:       next->size = fullLength+1;
431:       PetscMalloc1(next->size, &next->string);
432:       va_start(Argp,format);
433:       PetscMemzero(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:     PetscSynchronizedFlush - Flushes to the screen output from all processors
443:     involved in previous PetscSynchronizedPrintf()/PetscSynchronizedFPrintf() calls.

445:     Collective on MPI_Comm

447:     Input Parameters:
448: +   comm - the communicator
449: -   fd - the file pointer (valid on process 0 of the communicator)

451:     Level: intermediate

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

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

459: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
460:           PetscViewerASCIISynchronizedPrintf()
461: @*/
462: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
463: {
465:   PetscMPIInt    rank,size,tag,i,j,n = 0,dummy = 0;
466:   char          *message;
467:   MPI_Status     status;

470:   PetscCommDuplicate(comm,&comm,&tag);
471:   MPI_Comm_rank(comm,&rank);
472:   MPI_Comm_size(comm,&size);

474:   /* First processor waits for messages from all other processors */
475:   if (!rank) {
476:     if (!fd) fd = PETSC_STDOUT;
477:     for (i=1; i<size; i++) {
478:       /* to prevent a flood of messages to process zero, request each message separately */
479:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
480:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
481:       for (j=0; j<n; j++) {
482:         PetscMPIInt size = 0;

484:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
485:         PetscMalloc1(size, &message);
486:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
487:         PetscFPrintf(comm,fd,"%s",message);
488:         PetscFree(message);
489:       }
490:     }
491:   } else { /* other processors send queue to processor 0 */
492:     PrintfQueue next = petsc_printfqueuebase,previous;

494:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
495:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
496:     for (i=0; i<petsc_printfqueuelength; i++) {
497:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
498:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
499:       previous = next;
500:       next     = next->next;
501:       PetscFree(previous->string);
502:       PetscFree(previous);
503:     }
504:     petsc_printfqueue       = 0;
505:     petsc_printfqueuelength = 0;
506:   }
507:   PetscCommDestroy(&comm);
508:   return(0);
509: }

511: /* ---------------------------------------------------------------------------------------*/

513: /*@C
514:     PetscFPrintf - Prints to a file, only from the first
515:     processor in the communicator.

517:     Not Collective

519:     Input Parameters:
520: +   comm - the communicator
521: .   fd - the file pointer
522: -   format - the usual printf() format string

524:     Level: intermediate

526:     Fortran Note:
527:     This routine is not supported in Fortran.

529:    Concepts: printing^in parallel
530:    Concepts: printf^in parallel

532: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
533:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
534: @*/
535: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
536: {
538:   PetscMPIInt    rank;

541:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
542:   MPI_Comm_rank(comm,&rank);
543:   if (!rank) {
544:     va_list Argp;
545:     va_start(Argp,format);
546:     (*PetscVFPrintf)(fd,format,Argp);
547:     if (petsc_history && (fd !=petsc_history)) {
548:       va_start(Argp,format);
549:       (*PetscVFPrintf)(petsc_history,format,Argp);
550:     }
551:     va_end(Argp);
552:   }
553:   return(0);
554: }

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

560:     Not Collective

562:     Input Parameters:
563: +   comm - the communicator
564: -   format - the usual printf() format string

566:    Level: intermediate

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

572:    Concepts: printing^in parallel
573:    Concepts: printf^in parallel

575: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
576: @*/
577: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
578: {
580:   PetscMPIInt    rank;

583:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
584:   MPI_Comm_rank(comm,&rank);
585:   if (!rank) {
586:     va_list Argp;
587:     va_start(Argp,format);
588:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
589:     if (petsc_history) {
590:       va_start(Argp,format);
591:       (*PetscVFPrintf)(petsc_history,format,Argp);
592:     }
593:     va_end(Argp);
594:   }
595:   return(0);
596: }

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

603:       To use, write your own function for example,
604: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
605: ${
606: $ return(0);
607: $}
608: then before the call to PetscInitialize() do the assignment
609: $    PetscHelpPrintf = mypetschelpprintf;

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

613:   Level:  developer

615: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
616: @*/
617: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
618: {
620:   PetscMPIInt    rank;

623:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
624:   MPI_Comm_rank(comm,&rank);
625:   if (!rank) {
626:     va_list Argp;
627:     va_start(Argp,format);
628:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
629:     if (petsc_history) {
630:       va_start(Argp,format);
631:       (*PetscVFPrintf)(petsc_history,format,Argp);
632:     }
633:     va_end(Argp);
634:   }
635:   return(0);
636: }

638: /* ---------------------------------------------------------------------------------------*/


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

644:     Collective on MPI_Comm

646:     Input Parameters:
647: +   comm - the communicator
648: .   fd - the file pointer
649: -   len - the length of the output buffer

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

654:     Level: intermediate

656: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
657:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

659: @*/
660: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
661: {
663:   PetscMPIInt    rank;

666:   MPI_Comm_rank(comm,&rank);

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

671:     if (!ptr) {
672:       string[0] = 0;
673:       if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
674:     }
675:   }
676:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
677:   return(0);
678: }

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

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

688:   if (fd != stdout && fd != stderr) { /* handle regular files */
689:     PetscVFPrintfDefault(fd,format,Argp);
690:   } else {
691:     size_t len=8*1024,length;
692:     char   buf[len];

694:     PetscVSNPrintf(buf,len,format,&length,Argp);
695:     SwiftClosure(buf);
696:   }
697:   return(0);
698: }

700: /*
701:    Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
702: */
703: PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
704: {
705:   PetscVFPrintf = PetscVFPrintfToString;
706:   SwiftClosure  = closure;
707:   return 0;
708: }
709: #endif

711: #if defined(PETSC_HAVE_MATLAB_ENGINE)
712: #include <mex.h>
713: PetscErrorCode  PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
714: {

718:   if (fd != stdout && fd != stderr) { /* handle regular files */
719:     PetscVFPrintfDefault(fd,format,Argp);
720:   } else {
721:     size_t len=8*1024,length;
722:     char   buf[len];

724:     PetscVSNPrintf(buf,len,format,&length,Argp);
725:     mexPrintf("%s",buf);
726:   }
727:   return(0);
728: }
729: #endif

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

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

737:  Level: developer

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

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