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