Actual source code: mprint.c

petsc-3.14.6 2021-03-30
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 = NULL;
 17: /*
 18:      Allows one to overwrite where standard error is sent. For example
 19:      PETSC_STDERR = fopen("/dev/ttyXX","w") will cause all standard error
 20:      writes to go to terminal XX; assuming you have write permission there
 21: */
 22: FILE *PETSC_STDERR = NULL;

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

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

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

 33:  Level: developer

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

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

 43:   *size = 0;
 44:   while (format[i]) {
 45:     if (format[i] == '%' && format[i+1] == '%') {
 46:       i++; i++; *size += 2;
 47:     } else if (format[i] == '%') {
 48:       /* Find the letter */
 49:       for (; format[i] && format[i] <= '9'; i++,(*size += 1));
 50:       switch (format[i]) {
 51:       case 'D':
 52: #if defined(PETSC_USE_64BIT_INDICES)
 53:         *size += 2;
 54: #endif
 55:         break;
 56:       case 'g':
 57:         *size += 4;
 58:         break;
 59:       default:
 60:         break;
 61:       }
 62:       *size += 1;
 63:       i++;
 64:     } else {
 65:       i++;
 66:       *size += 1;
 67:     }
 68:   }
 69:   *size += 1; /* space for NULL character */
 70:   return(0);
 71: }

 73: /*@C
 74:      PetscFormatConvert - Takes a PETSc format string and converts the %D to %d for 32 bit PETSc indices and %lld for 64 bit PETSc indices. Also
 75:                         converts %g to [|%g|] so that PetscVSNPrintf() can easily insure all %g formatted numbers have a decimal point when printed.

 77:    Input Parameters:
 78: +   format - the PETSc format string
 79: .   newformat - the location to put the new format
 80: -   size - the length of newformat, you can use PetscFormatConvertGetSize() to compute the needed size

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

 84:  Level: developer

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

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

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

137: #define PETSCDEFAULTBUFFERSIZE 8*1024

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

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

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

153:  Level: developer

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

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

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

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

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

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

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

273:   Level:  developer

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

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

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

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

312:     Not Collective

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

320:    Level: intermediate

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

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

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

340:     Not Collective

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

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

351:    Level: intermediate

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

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

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

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

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

376:     Not Collective

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

382:    Level: intermediate

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

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

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

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

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

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

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

446:     Not Collective

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

453:     Level: intermediate

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

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

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

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

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

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

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

513:     Collective

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

519:     Level: intermediate

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

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

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

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

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

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

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

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

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

585:     Not Collective

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

592:     Level: intermediate

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


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

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

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

626:     Not Collective

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

632:     Level: intermediate

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

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


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

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

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

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

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


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

693:     Collective

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

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

703:     Level: intermediate

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

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

715:   MPI_Comm_rank(comm,&rank);

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

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

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

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

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

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

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

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

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

766:  Level: developer

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

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

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

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