Actual source code: mprint.c

petsc-3.13.6 2020-09-29
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:         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       = NULL,petsc_printfqueuebase = NULL;
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 = NULL;
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:       PetscArrayzero(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 = NULL;
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:       PetscArrayzero(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

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       = NULL;
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.


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

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

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

628:     Not Collective

630:     Input Parameters:
631: +   comm - the communicator
632: -   format - the usual printf() format string

634:     Level: intermediate

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

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


645: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscFormatConvert()
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

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_CLOSURE)
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(buff,sizeof(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: }