Actual source code: mprint.c

petsc-3.5.2 2014-09-08
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)

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

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

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

 41:  Level: developer

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

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

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

 89:    Input Parameters:
 90: +   str - location to put result
 91: .   len - the amount of space in str
 92: +   format - the PETSc format string
 93: -   fullLength - the amount of space in str actually used.

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

 98:  Level: developer

100: @*/
101: PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
102: {
103:   char           *newformat;
104:   char           formatbuf[8*1024];
105:   size_t         oldLength,length;
106:   int            fullLengthInt;

110:   PetscStrlen(format, &oldLength);
111:   if (oldLength < 8*1024) {
112:     newformat = formatbuf;
113:     oldLength = 8*1024-1;
114:   } else {
115:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
116:     PetscMalloc1(oldLength, &newformat);
117:   }
118:   PetscFormatConvert(format,newformat,oldLength);
119:   PetscStrlen(newformat, &length);
120: #if 0
121:   if (length > len) newformat[len] = '\0';
122: #endif
123: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
124:   fullLengthInt = vsnprintf(str,len,newformat,(char*)Argp);
125: #elif defined(PETSC_HAVE_VSNPRINTF)
126:   fullLengthInt = vsnprintf(str,len,newformat,Argp);
127: #elif defined(PETSC_HAVE__VSNPRINTF)
128:   fullLengthInt = _vsnprintf(str,len,newformat,Argp);
129: #else
130: #error "vsnprintf not found"
131: #endif
132:   if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
133:   if (fullLength) *fullLength = (size_t)fullLengthInt;
134:   if (oldLength >= 8*1024) {
135:     PetscFree(newformat);
136:   }
137:   return(0);
138: }

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

146:       To use, write your own function for example,
147: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
148: ${
150: $
152: $   if (fd != stdout && fd != stderr) {  handle regular files
153: $      PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
154: $  } else {
155: $     char   buff[BIG];
156: $     size_t length;
157: $     PetscVSNPrintf(buff,BIG,format,&length,Argp);
158: $     now send buff to whatever stream or whatever you want
159: $ }
160: $ return(0);
161: $}
162: then before the call to PetscInitialize() do the assignment
163: $    PetscVFPrintf = mypetscvfprintf;

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

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

171:   Level:  developer

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

175: @*/
176: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
177: {
178:   char           *newformat;
179:   char           formatbuf[8*1024];
180:   size_t         oldLength;

184:   PetscStrlen(format, &oldLength);
185:   if (oldLength < 8*1024) {
186:     newformat = formatbuf;
187:     oldLength = 8*1024-1;
188:   } else {
189:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
190:     PetscMalloc1(oldLength, &newformat);
191:   }
192:   PetscFormatConvert(format,newformat,oldLength);

194: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
195:   vfprintf(fd,newformat,(char*)Argp);
196: #else
197:   vfprintf(fd,newformat,Argp);
198: #endif
199:   fflush(fd);
200:   if (oldLength >= 8*1024) {
201:     PetscFree(newformat);
202:   }
203:   return(0);
204: }

208: /*@C
209:     PetscSNPrintf - Prints to a string of given length

211:     Not Collective

213:     Input Parameters:
214: +   str - the string to print to
215: .   len - the length of str
216: .   format - the usual printf() format string
217: -   any arguments

219:    Level: intermediate

221: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
222:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
223: @*/
224: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
225: {
227:   size_t         fullLength;
228:   va_list        Argp;

231:   va_start(Argp,format);
232:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
233:   return(0);
234: }

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

241:     Not Collective

243:     Input Parameters:
244: +   str - the string to print to
245: .   len - the length of str
246: .   format - the usual printf() format string
247: .   countused - number of characters used
248: -   any arguments

250:    Level: intermediate

252: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
253:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
254: @*/
255: PetscErrorCode  PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
256: {
258:   va_list        Argp;

261:   va_start(Argp,countused);
262:   PetscVSNPrintf(str,len,format,countused,Argp);
263:   return(0);
264: }

266: /* ----------------------------------------------------------------------- */

268: PrintfQueue petsc_printfqueue       = 0,petsc_printfqueuebase = 0;
269: int         petsc_printfqueuelength = 0;

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

277:     Not Collective

279:     Input Parameters:
280: +   comm - the communicator
281: -   format - the usual printf() format string

283:    Level: intermediate

285:     Notes:
286:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
287:     from all the processors to be printed.

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

293: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
294:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
295: @*/
296: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
297: {
299:   PetscMPIInt    rank;

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

305:   /* First processor prints immediately to stdout */
306:   if (!rank) {
307:     va_list Argp;
308:     va_start(Argp,format);
309:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
310:     if (petsc_history) {
311:       va_start(Argp,format);
312:       (*PetscVFPrintf)(petsc_history,format,Argp);
313:     }
314:     va_end(Argp);
315:   } else { /* other processors add to local queue */
316:     va_list     Argp;
317:     PrintfQueue next;
318:     size_t      fullLength = 8191;

320:     PetscNew(&next);
321:     if (petsc_printfqueue) {
322:       petsc_printfqueue->next = next;
323:       petsc_printfqueue       = next;
324:       petsc_printfqueue->next = 0;
325:     } else petsc_printfqueuebase = petsc_printfqueue = next;
326:     petsc_printfqueuelength++;
327:     next->size = -1;
328:     while ((PetscInt)fullLength >= next->size) {
329:       next->size = fullLength+1;

331:       PetscMalloc1(next->size, &next->string);
332:       va_start(Argp,format);
333:       PetscMemzero(next->string,next->size);
334:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
335:       va_end(Argp);
336:     }
337:   }
338:   return(0);
339: }

343: /*@C
344:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
345:     several processors.  Output of the first processor is followed by that of the
346:     second, etc.

348:     Not Collective

350:     Input Parameters:
351: +   comm - the communicator
352: .   fd - the file pointer
353: -   format - the usual printf() format string

355:     Level: intermediate

357:     Notes:
358:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
359:     from all the processors to be printed.

361: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
362:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

364: @*/
365: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
366: {
368:   PetscMPIInt    rank;

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

374:   /* First processor prints immediately to fp */
375:   if (!rank) {
376:     va_list Argp;
377:     va_start(Argp,format);
378:     (*PetscVFPrintf)(fp,format,Argp);
379:     if (petsc_history && (fp !=petsc_history)) {
380:       va_start(Argp,format);
381:       (*PetscVFPrintf)(petsc_history,format,Argp);
382:     }
383:     va_end(Argp);
384:   } else { /* other processors add to local queue */
385:     va_list     Argp;
386:     PrintfQueue next;
387:     size_t      fullLength = 8191;
388:     PetscNew(&next);
389:     if (petsc_printfqueue) {
390:       petsc_printfqueue->next = next;
391:       petsc_printfqueue       = next;
392:       petsc_printfqueue->next = 0;
393:     } else petsc_printfqueuebase = petsc_printfqueue = next;
394:     petsc_printfqueuelength++;
395:     next->size = -1;
396:     while ((PetscInt)fullLength >= next->size) {
397:       next->size = fullLength+1;
398:       PetscMalloc1(next->size, &next->string);
399:       va_start(Argp,format);
400:       PetscMemzero(next->string,next->size);
401:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
402:       va_end(Argp);
403:     }
404:   }
405:   return(0);
406: }

410: /*@C
411:     PetscSynchronizedFlush - Flushes to the screen output from all processors
412:     involved in previous PetscSynchronizedPrintf() calls.

414:     Collective on MPI_Comm

416:     Input Parameters:
417: +   comm - the communicator
418: -   fd - the file pointer (valid on process 0 of the communicator)

420:     Level: intermediate

422:     Notes:
423:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
424:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

426: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
427:           PetscViewerASCIISynchronizedPrintf()
428: C@*/
429: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
430: {
432:   PetscMPIInt    rank,size,tag,i,j,n = 0,dummy = 0;
433:   char          *message;
434:   MPI_Status     status;

437:   PetscCommDuplicate(comm,&comm,&tag);
438:   MPI_Comm_rank(comm,&rank);
439:   MPI_Comm_size(comm,&size);

441:   /* First processor waits for messages from all other processors */
442:   if (!rank) {
443:     if (!fd) fd = PETSC_STDOUT;
444:     for (i=1; i<size; i++) {
445:       /* to prevent a flood of messages to process zero, request each message separately */
446:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
447:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
448:       for (j=0; j<n; j++) {
449:         PetscMPIInt size = 0;

451:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
452:         PetscMalloc1(size, &message);
453:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
454:         PetscFPrintf(comm,fd,"%s",message);
455:         PetscFree(message);
456:       }
457:     }
458:   } else { /* other processors send queue to processor 0 */
459:     PrintfQueue next = petsc_printfqueuebase,previous;

461:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
462:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
463:     for (i=0; i<petsc_printfqueuelength; i++) {
464:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
465:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
466:       previous = next;
467:       next     = next->next;
468:       PetscFree(previous->string);
469:       PetscFree(previous);
470:     }
471:     petsc_printfqueue       = 0;
472:     petsc_printfqueuelength = 0;
473:   }
474:   PetscCommDestroy(&comm);
475:   return(0);
476: }

478: /* ---------------------------------------------------------------------------------------*/

482: /*@C
483:     PetscFPrintf - Prints to a file, only from the first
484:     processor in the communicator.

486:     Not Collective

488:     Input Parameters:
489: +   comm - the communicator
490: .   fd - the file pointer
491: -   format - the usual printf() format string

493:     Level: intermediate

495:     Fortran Note:
496:     This routine is not supported in Fortran.

498:    Concepts: printing^in parallel
499:    Concepts: printf^in parallel

501: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
502:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
503: @*/
504: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
505: {
507:   PetscMPIInt    rank;

510:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
511:   MPI_Comm_rank(comm,&rank);
512:   if (!rank) {
513:     va_list Argp;
514:     va_start(Argp,format);
515:     (*PetscVFPrintf)(fd,format,Argp);
516:     if (petsc_history && (fd !=petsc_history)) {
517:       va_start(Argp,format);
518:       (*PetscVFPrintf)(petsc_history,format,Argp);
519:     }
520:     va_end(Argp);
521:   }
522:   return(0);
523: }

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

531:     Not Collective

533:     Input Parameters:
534: +   comm - the communicator
535: -   format - the usual printf() format string

537:    Level: intermediate

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

543:    Concepts: printing^in parallel
544:    Concepts: printf^in parallel

546: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
547: @*/
548: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
549: {
551:   PetscMPIInt    rank;

554:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
555:   MPI_Comm_rank(comm,&rank);
556:   if (!rank) {
557:     va_list Argp;
558:     va_start(Argp,format);
559:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
560:     if (petsc_history) {
561:       va_start(Argp,format);
562:       (*PetscVFPrintf)(petsc_history,format,Argp);
563:     }
564:     va_end(Argp);
565:   }
566:   return(0);
567: }

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

576:       To use, write your own function for example,
577: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
578: ${
579: $ return(0);
580: $}
581: then before the call to PetscInitialize() do the assignment
582: $    PetscHelpPrintf = mypetschelpprintf;

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

586:   Level:  developer

588: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
589: @*/
590: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
591: {
593:   PetscMPIInt    rank;

596:   if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
597:   MPI_Comm_rank(comm,&rank);
598:   if (!rank) {
599:     va_list Argp;
600:     va_start(Argp,format);
601:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
602:     if (petsc_history) {
603:       va_start(Argp,format);
604:       (*PetscVFPrintf)(petsc_history,format,Argp);
605:     }
606:     va_end(Argp);
607:   }
608:   return(0);
609: }

611: /* ---------------------------------------------------------------------------------------*/


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

619:     Collective on MPI_Comm

621:     Input Parameters:
622: +   comm - the communicator
623: .   fd - the file pointer
624: -   len - the length of the output buffer

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

629:     Level: intermediate

631: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
632:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

634: @*/
635: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
636: {
638:   PetscMPIInt    rank;

641:   MPI_Comm_rank(comm,&rank);

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

646:     if (!ptr) {
647:       string[0] = 0;
648:       if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
649:     }
650:   }
651:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
652:   return(0);
653: }

655: #if defined(PETSC_HAVE_MATLAB_ENGINE)
656: #include <mex.h>
659: PetscErrorCode  PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
660: {

664:   if (fd != stdout && fd != stderr) { /* handle regular files */
665:     PetscVFPrintfDefault(fd,format,Argp);
666:   } else {
667:     size_t len=8*1024,length;
668:     char   buf[len];

670:     PetscVSNPrintf(buf,len,format,&length,Argp);
671:     mexPrintf("%s",buf);
672:   }
673:   return(0);
674: }
675: #endif

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

682:    Input Parameters:
683: .   format - the PETSc format string

685:  Level: developer

687: @*/
688: PetscErrorCode  PetscFormatStrip(char *format)
689: {
690:   size_t loc1 = 0, loc2 = 0;

693:   while (format[loc2]) {
694:     if (format[loc2] == '%') {
695:       format[loc1++] = format[loc2++];
696:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
697:     }
698:     format[loc1++] = format[loc2++];
699:   }
700:   return(0);
701: }