Actual source code: mprint.c

  1: #define PETSC_DLL
  2: /*
  3:       Utilites routines to add simple ASCII IO capability.
  4: */
 5:  #include src/sys/fileio/mprint.h
  6: /*
  7:    If petsc_history is on, then all Petsc*Printf() results are saved
  8:    if the appropriate (usually .petschistory) file.
  9: */
 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;
 23: /*
 24:      Used to output to Zope
 25: */
 26: FILE *PETSC_ZOPEFD = 0;

 30: PetscErrorCode  PetscFormatConvert(const char *format,char *newformat,PetscInt size)
 31: {
 32:   PetscInt i = 0,j = 0;

 34:   while (format[i] && i < size-1) {
 35:     if (format[i] == '%' && format[i+1] == 'D') {
 36:       newformat[j++] = '%';
 37: #if defined(PETSC_USE_32BIT_INT)
 38:       newformat[j++] = 'd';
 39: #else
 40:       newformat[j++] = 'l';
 41:       newformat[j++] = 'l';
 42:       newformat[j++] = 'd';
 43: #endif
 44:       i += 2;
 45:     } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
 46:       newformat[j++] = '%';
 47:       newformat[j++] = format[i+1];
 48: #if defined(PETSC_USE_32BIT_INT)
 49:       newformat[j++] = 'd';
 50: #else
 51:       newformat[j++] = 'l';
 52:       newformat[j++] = 'l';
 53:       newformat[j++] = 'd';
 54: #endif
 55:       i += 3;
 56:     } else if (format[i] == '%' && format[i+1] == 'G') {
 57:       newformat[j++] = '%';
 58: #if defined(PETSC_USE_INT)
 59:       newformat[j++] = 'd';
 60: #elif !defined(PETSC_USE_LONG_DOUBLE)
 61:       newformat[j++] = 'g';
 62: #else
 63:       newformat[j++] = 'L';
 64:       newformat[j++] = 'g';
 65: #endif
 66:       i += 2;
 67:     }else {
 68:       newformat[j++] = format[i++];
 69:     }
 70:   }
 71:   newformat[j] = 0;
 72:   return 0;
 73: }
 74: 
 77: /* 
 78:    No error handling because may be called by error handler
 79: */
 80: PetscErrorCode  PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp)
 81: {
 82:   /* no malloc since may be called by error handler */
 83:   char           newformat[8*1024];
 84:   size_t         length;
 86: 
 87:   PetscFormatConvert(format,newformat,8*1024);
 88:   PetscStrlen(newformat, &length);
 89:   if (length > len) {
 90:     newformat[len] = '\0';
 91:   }
 92: #if defined(PETSC_HAVE_VPRINTF_CHAR)
 93:   vsprintf(str,newformat,(char *)Argp);
 94: #else
 95:   vsprintf(str,newformat,Argp);
 96: #endif
 97:   return 0;
 98: }


103: PetscErrorCode  PetscZopeLog(const char *format,va_list Argp){
104:   /* no malloc since may be called by error handler */
105:   char     newformat[8*1024];
106:   char     log[8*1024];
107: 
109:   char logstart[] = " <<<log>>>";
110:   size_t len;
111:   size_t formatlen;
112:   PetscFormatConvert(format,newformat,8*1024);
113:   PetscStrlen(logstart, &len);
114:   PetscMemcpy(log, logstart, len);
115:   PetscStrlen(newformat, &formatlen);
116:   PetscMemcpy(&(log[len]), newformat, formatlen);
117:   if(PETSC_ZOPEFD != NULL){
118: #if defined(PETSC_HAVE_VPRINTF_CHAR)
119:   vfprintf(PETSC_ZOPEFD,log,(char *)Argp);
120: #else
121:   vfprintf(PETSC_ZOPEFD,log,Argp);
122:   fflush(PETSC_ZOPEFD);
123: #endif
124: }
125:   return 0;
126: }

130: /* 
131:    All PETSc standard out and error messages are sent through this function; so, in theory, this can
132:    can be replaced with something that does not simply write to a file. 

134:    Note: For error messages this may be called by a process, for regular standard out it is
135:    called only by process 0 of a given communicator

137:    No error handling because may be called by error handler
138: */
139: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
140: {
141:   /* no malloc since may be called by error handler */
142:   char        newformat[8*1024];

145:   PetscFormatConvert(format,newformat,8*1024);
146:   if(PETSC_ZOPEFD != NULL && PETSC_ZOPEFD != PETSC_STDOUT){
147:     va_list s;
148: #if defined(PETSC_HAVE_VA_COPY)
149:     va_copy(s, Argp);
150: #elif defined(PETSC_HAVE___VA_COPY)
151:     __va_copy(s, Argp);
152: #else
153:     SETERRQ(PETSC_ERR_SUP_SYS,"Zope not supported due to missing va_copy()");
154: #endif

156: #if defined(PETSC_HAVE_VPRINTF_CHAR)
157:     vfprintf(PETSC_ZOPEFD,newformat,(char *)s);
158: #else
159:     vfprintf(PETSC_ZOPEFD,newformat,s);
160:     fflush(PETSC_ZOPEFD);
161: #endif
162:   }

164: #if defined(PETSC_HAVE_VPRINTF_CHAR)
165:   vfprintf(fd,newformat,(char *)Argp);
166: #else
167:   vfprintf(fd,newformat,Argp);
168:   fflush(fd);
169: #endif
170:   return 0;
171: }

175: /*@C
176:     PetscSNPrintf - Prints to a string of given length

178:     Not Collective

180:     Input Parameters:
181: +   str - the string to print to
182: .   len - the length of str
183: .   format - the usual printf() format string 
184: -   any arguments

186:    Level: intermediate

188: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
189:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
190: @*/
191: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
192: {
194:   va_list        Argp;

197:   va_start(Argp,format);
198:   PetscVSNPrintf(str,len,format,Argp);
199:   return(0);
200: }

202: /* ----------------------------------------------------------------------- */

204: PrintfQueue queue       = 0,queuebase = 0;
205: int         queuelength = 0;
206: FILE        *queuefile  = PETSC_NULL;

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

214:     Not Collective

216:     Input Parameters:
217: +   comm - the communicator
218: -   format - the usual printf() format string 

220:    Level: intermediate

222:     Notes:
223:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
224:     from all the processors to be printed.

226:     Fortran Note:
227:     The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran. 
228:     That is, you can only pass a single character string from Fortran.

230:     The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.

232: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
233:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
234: @*/
235: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
236: {
238:   PetscMPIInt    rank;

241:   MPI_Comm_rank(comm,&rank);
242: 
243:   /* First processor prints immediately to stdout */
244:   if (!rank) {
245:     va_list Argp;
246:     va_start(Argp,format);
247:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
248:     if (petsc_history) {
249:       (*PetscVFPrintf)(petsc_history,format,Argp);
250:     }
251:     va_end(Argp);
252:   } else { /* other processors add to local queue */
253:     va_list     Argp;
254:     PrintfQueue next;

256:     PetscNew(struct _PrintfQueue,&next);
257:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
258:     else       {queuebase   = queue = next;}
259:     queuelength++;
260:     va_start(Argp,format);
261:     PetscMemzero(next->string,QUEUESTRINGSIZE);
262:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
263:     va_end(Argp);
264:   }
265: 
266:   return(0);
267: }
268: 
271: /*@C
272:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
273:     several processors.  Output of the first processor is followed by that of the 
274:     second, etc.

276:     Not Collective

278:     Input Parameters:
279: +   comm - the communicator
280: .   fd - the file pointer
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:     The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.

291:     Contributed by: Matthew Knepley

293: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
294:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

296: @*/
297: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
298: {
300:   PetscMPIInt    rank;

303:   MPI_Comm_rank(comm,&rank);
304: 
305:   /* First processor prints immediately to fp */
306:   if (!rank) {
307:     va_list Argp;
308:     va_start(Argp,format);
309:     (*PetscVFPrintf)(fp,format,Argp);
310:     queuefile = fp;
311:     if (petsc_history) {
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:     PetscNew(struct _PrintfQueue,&next);
319:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
320:     else       {queuebase   = queue = next;}
321:     queuelength++;
322:     va_start(Argp,format);
323:     PetscMemzero(next->string,QUEUESTRINGSIZE);
324:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
325:     va_end(Argp);
326:   }
327:   return(0);
328: }

332: /*@
333:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
334:     involved in previous PetscSynchronizedPrintf() calls.

336:     Collective on MPI_Comm

338:     Input Parameters:
339: .   comm - the communicator

341:     Level: intermediate

343:     Notes:
344:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
345:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

347: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
348:           PetscViewerASCIISynchronizedPrintf()
349: @*/
350: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm)
351: {
353:   PetscMPIInt    rank,size,tag,i,j,n;
354:   char           message[QUEUESTRINGSIZE];
355:   MPI_Status     status;
356:   FILE           *fd;

359:   PetscCommDuplicate(comm,&comm,&tag);
360:   MPI_Comm_rank(comm,&rank);
361:   MPI_Comm_size(comm,&size);

363:   /* First processor waits for messages from all other processors */
364:   if (!rank) {
365:     if (queuefile) {
366:       fd = queuefile;
367:     } else {
368:       fd = PETSC_STDOUT;
369:     }
370:     for (i=1; i<size; i++) {
371:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
372:       for (j=0; j<n; j++) {
373:         MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
374:         PetscFPrintf(comm,fd,"%s",message);
375:       }
376:     }
377:     queuefile = PETSC_NULL;
378:   } else { /* other processors send queue to processor 0 */
379:     PrintfQueue next = queuebase,previous;

381:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
382:     for (i=0; i<queuelength; i++) {
383:       MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
384:       previous = next;
385:       next     = next->next;
386:       PetscFree(previous);
387:     }
388:     queue       = 0;
389:     queuelength = 0;
390:   }
391:   PetscCommDestroy(&comm);
392:   return(0);
393: }

395: /* ---------------------------------------------------------------------------------------*/

399: /*@C
400:     PetscFPrintf - Prints to a file, only from the first
401:     processor in the communicator.

403:     Not Collective

405:     Input Parameters:
406: +   comm - the communicator
407: .   fd - the file pointer
408: -   format - the usual printf() format string 

410:     Level: intermediate

412:     Fortran Note:
413:     This routine is not supported in Fortran.

415:    Concepts: printing^in parallel
416:    Concepts: printf^in parallel

418: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
419:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
420: @*/
421: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
422: {
424:   PetscMPIInt    rank;

427:   MPI_Comm_rank(comm,&rank);
428:   if (!rank) {
429:     va_list Argp;
430:     va_start(Argp,format);
431:     (*PetscVFPrintf)(fd,format,Argp);
432:     if (petsc_history) {
433:       (*PetscVFPrintf)(petsc_history,format,Argp);
434:     }
435:     va_end(Argp);
436:   }
437:   return(0);
438: }

442: /*@C
443:     PetscPrintf - Prints to standard out, only from the first
444:     processor in the communicator.

446:     Not Collective

448:     Input Parameters:
449: +   comm - the communicator
450: -   format - the usual printf() format string 

452:    Level: intermediate

454:     Fortran Note:
455:     The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran. 
456:     That is, you can only pass a single character string from Fortran.

458:    Notes: %A is replace with %g unless the value is < 1.e-12 when it is 
459:           replaced with < 1.e-12

461:    Concepts: printing^in parallel
462:    Concepts: printf^in parallel

464: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
465: @*/
466: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
467: {
469:   PetscMPIInt    rank;
470:   size_t         len;
471:   char           *nformat,*sub1,*sub2;
472:   PetscReal      value;

475:   if (!comm) comm = PETSC_COMM_WORLD;
476:   MPI_Comm_rank(comm,&rank);
477:   if (!rank) {
478:     va_list Argp;
479:     va_start(Argp,format);

481:     PetscStrstr(format,"%A",&sub1);
482:     if (sub1) {
483:       PetscStrstr(format,"%",&sub2);
484:       if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
485:       PetscStrlen(format,&len);
486:       PetscMalloc((len+16)*sizeof(char),&nformat);
487:       PetscStrcpy(nformat,format);
488:       PetscStrstr(nformat,"%",&sub2);
489:       sub2[0] = 0;
490:       value   = (double)va_arg(Argp,double);
491:       if (PetscAbsReal(value) < 1.e-12) {
492:         PetscStrcat(nformat,"< 1.e-12");
493:       } else {
494:         PetscStrcat(nformat,"%g");
495:         va_end(Argp);
496:         va_start(Argp,format);
497:       }
498:       PetscStrcat(nformat,sub1+2);
499:     } else {
500:       nformat = (char*)format;
501:     }
502:     (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
503:     if (petsc_history) {
504:       (*PetscVFPrintf)(petsc_history,nformat,Argp);
505:     }
506:     va_end(Argp);
507:     if (sub1) {PetscFree(nformat);}
508:   }
509:   return(0);
510: }

512: /* ---------------------------------------------------------------------------------------*/
515: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
516: {
518:   PetscMPIInt    rank;

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

535: /* ---------------------------------------------------------------------------------------*/


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

543:     Collective on MPI_Comm

545:     Input Parameters:
546: +   comm - the communicator
547: .   fd - the file pointer
548: -   len - the length of the output buffer

550:     Output Parameter:
551: .   string - the line read from the file

553:     Level: intermediate

555: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 
556:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

558: @*/
559: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
560: {
562:   PetscMPIInt    rank;

565:   MPI_Comm_rank(comm,&rank);
566: 
567:   if (!rank) {
568:     fgets(string,len,fp);
569:   }
570:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
571:   return(0);
572: }