Actual source code: mprint.c

petsc-3.3-p7 2013-05-11
  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:       /* Find the letter */
 52:       for ( ; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
 53:       switch (format[i]) {
 54:       case 'D':
 55: #if !defined(PETSC_USE_64BIT_INDICES)
 56:         newformat[j++] = 'd';
 57: #else
 58:         newformat[j++] = 'l';
 59:         newformat[j++] = 'l';
 60:         newformat[j++] = 'd';
 61: #endif
 62:         break;
 63:       case 'G':
 64: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
 65:         newformat[j++] = 'g';
 66: #elif defined(PETSC_USE_REAL___FLOAT128)
 67:         newformat[j++] = 'Q';
 68:         newformat[j++] = 'g';
 69: #endif
 70:         break;
 71:       case 'F':
 72: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
 73:         newformat[j++] = 'f';
 74: #elif defined(PETSC_USE_REAL_LONG_DOUBLE)
 75:         newformat[j++] = 'L';
 76:         newformat[j++] = 'f';
 77: #elif defined(PETSC_USE_REAL___FLOAT128)
 78:         newformat[j++] = 'Q';
 79:         newformat[j++] = 'f';
 80: #endif
 81:         break;
 82:       default:
 83:         newformat[j++] = format[i];
 84:         break;
 85:       }
 86:       i++;
 87:     } else {
 88:       newformat[j++] = format[i++];
 89:     }
 90:   }
 91:   newformat[j] = 0;
 92:   return(0);
 93: }
 94: 
 97: /*@C 
 98:      PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the 
 99:        function arguments into a string using the format statement.

101:    Input Parameters:
102: +   str - location to put result
103: .   len - the amount of space in str
104: +   format - the PETSc format string
105: -   fullLength - the amount of space in str actually used.

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

110:  Level: developer

112: @*/
113: PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
114: {
115:   char          *newformat;
116:   char           formatbuf[8*1024];
117:   size_t         oldLength,length;
118:   int            fullLengthInt;

122:   PetscStrlen(format, &oldLength);
123:   if (oldLength < 8*1024) {
124:     newformat = formatbuf;
125:     oldLength = 8*1024-1;
126:   } else {
127:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
128:     PetscMalloc(oldLength * sizeof(char), &newformat);
129:   }
130:   PetscFormatConvert(format,newformat,oldLength);
131:   PetscStrlen(newformat, &length);
132: #if 0
133:   if (length > len) {
134:     newformat[len] = '\0';
135:   }
136: #endif
137: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
138:   fullLengthInt = vsnprintf(str,len,newformat,(char *)Argp);
139: #elif defined(PETSC_HAVE_VSNPRINTF)
140:   fullLengthInt = vsnprintf(str,len,newformat,Argp);
141: #elif defined(PETSC_HAVE__VSNPRINTF)
142:   fullLengthInt = _vsnprintf(str,len,newformat,Argp);
143: #else
144: #error "vsnprintf not found"
145: #endif
146:   if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
147:   if (fullLength) *fullLength = (size_t)fullLengthInt;
148:   if (oldLength >= 8*1024) {
149:     PetscFree(newformat);
150:   }
151:   return(0);
152: }

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

160:       To use, write your own function for example,
161: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
162: ${
164: $
166: $   if (fd != stdout && fd != stderr) {  handle regular files 
167: $      PetscVFPrintfDefault(fd,format,Argp); CHKERR(ierr);
168: $  } else {
169: $     char   buff[BIG];
170: $     size_t length;
171: $     PetscVSNPrintf(buff,BIG,format,&length,Argp);
172: $     now send buff to whatever stream or whatever you want 
173: $ }
174: $ return(0);
175: $}
176: then before the call to PetscInitialize() do the assignment
177: $    PetscVFPrintf = mypetscvfprintf;

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

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

185:   Level:  developer

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

189: @*/
190: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
191: {
192:   char           *newformat;
193:   char           formatbuf[8*1024];
194:   size_t         oldLength;

198:   PetscStrlen(format, &oldLength);
199:   if (oldLength < 8*1024) {
200:     newformat = formatbuf;
201:     oldLength = 8*1024-1;
202:   } else {
203:     oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
204:     PetscMalloc(oldLength * sizeof(char), &newformat);
205:   }
206:   PetscFormatConvert(format,newformat,oldLength);

208: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
209:   vfprintf(fd,newformat,(char *)Argp);
210: #else
211:   vfprintf(fd,newformat,Argp);
212: #endif
213:   fflush(fd);
214:   if (oldLength >= 8*1024) {
215:     PetscFree(newformat);
216:   }
217:   return(0);
218: }

222: /*@C
223:     PetscSNPrintf - Prints to a string of given length

225:     Not Collective

227:     Input Parameters:
228: +   str - the string to print to
229: .   len - the length of str
230: .   format - the usual printf() format string 
231: -   any arguments

233:    Level: intermediate

235: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
236:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
237: @*/
238: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
239: {
241:   size_t         fullLength;
242:   va_list        Argp;

245:   va_start(Argp,format);
246:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
247:   return(0);
248: }

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

255:     Not Collective

257:     Input Parameters:
258: +   str - the string to print to
259: .   len - the length of str
260: .   format - the usual printf() format string
261: .   countused - number of characters used
262: -   any arguments

264:    Level: intermediate

266: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
267:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
268: @*/
269: PetscErrorCode  PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
270: {
272:   va_list        Argp;

275:   va_start(Argp,countused);
276:   PetscVSNPrintf(str,len,format,countused,Argp);
277:   return(0);
278: }

280: /* ----------------------------------------------------------------------- */

282: PrintfQueue petsc_printfqueue = 0,petsc_printfqueuebase = 0;
283: int         petsc_printfqueuelength = 0;
284: FILE        *petsc_printfqueuefile  = PETSC_NULL;

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

292:     Not Collective

294:     Input Parameters:
295: +   comm - the communicator
296: -   format - the usual printf() format string 

298:    Level: intermediate

300:     Notes:
301:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
302:     from all the processors to be printed.

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

308: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
309:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
310: @*/
311: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
312: {
314:   PetscMPIInt    rank;

317:   MPI_Comm_rank(comm,&rank);
318: 
319:   /* First processor prints immediately to stdout */
320:   if (!rank) {
321:     va_list Argp;
322:     va_start(Argp,format);
323:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
324:     if (petsc_history) {
325:       va_start(Argp,format);
326:       (*PetscVFPrintf)(petsc_history,format,Argp);
327:     }
328:     va_end(Argp);
329:   } else { /* other processors add to local queue */
330:     va_list     Argp;
331:     PrintfQueue next;
332:     size_t      fullLength = 8191;

334:     PetscNew(struct _PrintfQueue,&next);
335:     if (petsc_printfqueue) {petsc_printfqueue->next = next; petsc_printfqueue = next; petsc_printfqueue->next = 0;}
336:     else                   {petsc_printfqueuebase   = petsc_printfqueue = next;}
337:     petsc_printfqueuelength++;
338:     next->size = -1;
339:     while((PetscInt)fullLength >= next->size) {
340:       next->size = fullLength+1;
341:       PetscMalloc(next->size * sizeof(char), &next->string);
342:       va_start(Argp,format);
343:       PetscMemzero(next->string,next->size);
344:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
345:       va_end(Argp);
346:     }
347:   }
348: 
349:   return(0);
350: }
351: 
354: /*@C
355:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
356:     several processors.  Output of the first processor is followed by that of the 
357:     second, etc.

359:     Not Collective

361:     Input Parameters:
362: +   comm - the communicator
363: .   fd - the file pointer
364: -   format - the usual printf() format string 

366:     Level: intermediate

368:     Notes:
369:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
370:     from all the processors to be printed.

372: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
373:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

375: @*/
376: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
377: {
379:   PetscMPIInt    rank;

382:   MPI_Comm_rank(comm,&rank);
383: 
384:   /* First processor prints immediately to fp */
385:   if (!rank) {
386:     va_list Argp;
387:     va_start(Argp,format);
388:     (*PetscVFPrintf)(fp,format,Argp);
389:     petsc_printfqueuefile = fp;
390:     if (petsc_history && (fp !=petsc_history)) {
391:       va_start(Argp,format);
392:       (*PetscVFPrintf)(petsc_history,format,Argp);
393:     }
394:     va_end(Argp);
395:   } else { /* other processors add to local queue */
396:     va_list     Argp;
397:     PrintfQueue next;
398:     size_t      fullLength = 8191;
399:     PetscNew(struct _PrintfQueue,&next);
400:     if (petsc_printfqueue) {petsc_printfqueue->next = next; petsc_printfqueue = next; petsc_printfqueue->next = 0;}
401:     else                   {petsc_printfqueuebase   = petsc_printfqueue = next;}
402:     petsc_printfqueuelength++;
403:     next->size = -1;
404:     while((PetscInt)fullLength >= next->size) {
405:       next->size = fullLength+1;
406:       PetscMalloc(next->size * sizeof(char), &next->string);
407:       va_start(Argp,format);
408:       PetscMemzero(next->string,next->size);
409:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
410:       va_end(Argp);
411:     }
412:   }
413:   return(0);
414: }

418: /*@
419:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
420:     involved in previous PetscSynchronizedPrintf() calls.

422:     Collective on MPI_Comm

424:     Input Parameters:
425: .   comm - the communicator

427:     Level: intermediate

429:     Notes:
430:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
431:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

433: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
434:           PetscViewerASCIISynchronizedPrintf()
435: @*/
436: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm)
437: {
439:   PetscMPIInt    rank,size,tag,i,j,n,dummy = 0;
440:   char          *message;
441:   MPI_Status     status;
442:   FILE           *fd;

445:   PetscCommDuplicate(comm,&comm,&tag);
446:   MPI_Comm_rank(comm,&rank);
447:   MPI_Comm_size(comm,&size);

449:   /* First processor waits for messages from all other processors */
450:   if (!rank) {
451:     if (petsc_printfqueuefile) {
452:       fd = petsc_printfqueuefile;
453:     } else {
454:       fd = PETSC_STDOUT;
455:     }
456:     for (i=1; i<size; i++) {
457:       /* to prevent a flood of messages to process zero, request each message separately */
458:       MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
459:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
460:       for (j=0; j<n; j++) {
461:         PetscMPIInt size;

463:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
464:         PetscMalloc(size * sizeof(char), &message);
465:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
466:         PetscFPrintf(comm,fd,"%s",message);
467:         PetscFree(message);
468:       }
469:     }
470:     petsc_printfqueuefile = PETSC_NULL;
471:   } else { /* other processors send queue to processor 0 */
472:     PrintfQueue next = petsc_printfqueuebase,previous;

474:     MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
475:     MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
476:     for (i=0; i<petsc_printfqueuelength; i++) {
477:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
478:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
479:       previous = next;
480:       next     = next->next;
481:       PetscFree(previous->string);
482:       PetscFree(previous);
483:     }
484:     petsc_printfqueue       = 0;
485:     petsc_printfqueuelength = 0;
486:   }
487:   PetscCommDestroy(&comm);
488:   return(0);
489: }

491: /* ---------------------------------------------------------------------------------------*/

495: /*@C
496:     PetscFPrintf - Prints to a file, only from the first
497:     processor in the communicator.

499:     Not Collective

501:     Input Parameters:
502: +   comm - the communicator
503: .   fd - the file pointer
504: -   format - the usual printf() format string 

506:     Level: intermediate

508:     Fortran Note:
509:     This routine is not supported in Fortran.

511:    Concepts: printing^in parallel
512:    Concepts: printf^in parallel

514: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
515:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
516: @*/
517: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
518: {
520:   PetscMPIInt    rank;

523:   MPI_Comm_rank(comm,&rank);
524:   if (!rank) {
525:     va_list Argp;
526:     va_start(Argp,format);
527:     (*PetscVFPrintf)(fd,format,Argp);
528:     if (petsc_history && (fd !=petsc_history)) {
529:       va_start(Argp,format);
530:       (*PetscVFPrintf)(petsc_history,format,Argp);
531:       }
532:     va_end(Argp);
533:   }
534:   return(0);
535: }

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

543:     Not Collective

545:     Input Parameters:
546: +   comm - the communicator
547: -   format - the usual printf() format string 

549:    Level: intermediate

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

555:    Concepts: printing^in parallel
556:    Concepts: printf^in parallel

558: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
559: @*/
560: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
561: {
563:   PetscMPIInt    rank;

566:   if (!comm) comm = PETSC_COMM_WORLD;
567:   MPI_Comm_rank(comm,&rank);
568:   if (!rank) {
569:     va_list Argp;
570:     va_start(Argp,format);
571:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
572:     if (petsc_history) {
573:       va_start(Argp,format);
574:       (*PetscVFPrintf)(petsc_history,format,Argp);
575:     }
576:     va_end(Argp);
577:   }
578:   return(0);
579: }

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

588:       To use, write your own function for example,
589: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
590: ${
591: $ return(0);
592: $}
593: then before the call to PetscInitialize() do the assignment
594: $    PetscHelpPrintf = mypetschelpprintf;

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

598:   Level:  developer

600: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
601: @*/
602: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
603: {
605:   PetscMPIInt    rank;

608:   if (!comm) comm = PETSC_COMM_WORLD;
609:   MPI_Comm_rank(comm,&rank);
610:   if (!rank) {
611:     va_list Argp;
612:     va_start(Argp,format);
613:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
614:     if (petsc_history) {
615:       va_start(Argp,format);
616:       (*PetscVFPrintf)(petsc_history,format,Argp);
617:     }
618:     va_end(Argp);
619:   }
620:   return(0);
621: }

623: /* ---------------------------------------------------------------------------------------*/


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

631:     Collective on MPI_Comm

633:     Input Parameters:
634: +   comm - the communicator
635: .   fd - the file pointer
636: -   len - the length of the output buffer

638:     Output Parameter:
639: .   string - the line read from the file

641:     Level: intermediate

643: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
644:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

646: @*/
647: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
648: {
650:   PetscMPIInt    rank;

653:   MPI_Comm_rank(comm,&rank);

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

658:     if (!ptr) {
659:       if (feof(fp)) {
660:         len = 0;
661:       } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
662:     }
663:   }
664:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
665:   return(0);
666: }

668: #if defined(PETSC_HAVE_MATLAB_ENGINE)
669: #include <mex.h>
672: PetscErrorCode  PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
673: {

677:   if (fd != stdout && fd != stderr) { /* handle regular files */
678:     PetscVFPrintfDefault(fd,format,Argp);
679:   } else {
680:     size_t len=8*1024,length;
681:     char   buf[len];

683:     PetscVSNPrintf(buf,len,format,&length,Argp);
684:     mexPrintf("%s",buf);
685:  }
686:  return(0);
687: }
688: #endif

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

695:    Input Parameters:
696: .   format - the PETSc format string

698:  Level: developer

700: @*/
701: PetscErrorCode  PetscFormatStrip(char *format)
702: {
703:   size_t   loc1 = 0, loc2 = 0;

706:   while (format[loc2]){
707:     if (format[loc2] == '%') {
708:       format[loc1++] = format[loc2++];
709:       while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
710:     }
711:     format[loc1++] = format[loc2++];
712:   }
713:   return(0);
714: }