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_64BIT_INDICES)
 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_64BIT_INDICES)
 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_SCALAR_INT)
 59:       newformat[j++] = 'd';
 60: #elif !defined(PETSC_USE_SCALAR_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,int *fullLength,va_list Argp)
 81: {
 82:   /* no malloc since may be called by error handler */
 83:   char          *newformat;
 84:   char           formatbuf[8*1024];
 85:   size_t         oldLength,length;
 87: 
 88:   PetscStrlen(format, &oldLength);
 89:   if (oldLength < 8*1024) {
 90:     newformat = formatbuf;
 91:   } else {
 92:     PetscMalloc((oldLength+1) * sizeof(char), &newformat);
 93:   }
 94:   PetscFormatConvert(format,newformat,oldLength+1);
 95:   PetscStrlen(newformat, &length);
 96: #if 0
 97:   if (length > len) {
 98:     newformat[len] = '\0';
 99:   }
100: #endif
101: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
102:   *fullLength = vsnprintf(str,len,newformat,(char *)Argp);
103: #elif defined(PETSC_HAVE_VSNPRINTF)
104:   *fullLength = vsnprintf(str,len,newformat,Argp);
105: #elif defined(PETSC_HAVE__VSNPRINTF)
106:   *fullLength = _vsnprintf(str,len,newformat,Argp);
107: #else
108: #error "vsnprintf not found"
109: #endif
110:   if (oldLength >= 8*1024) {
111:     PetscFree(newformat);
112:   }
113:   return 0;
114: }


119: PetscErrorCode  PetscZopeLog(const char *format,va_list Argp){
120:   /* no malloc since may be called by error handler */
121:   char     newformat[8*1024];
122:   char     log[8*1024];
123: 
125:   char logstart[] = " <<<log>>>";
126:   size_t len;
127:   size_t formatlen;
128:   PetscFormatConvert(format,newformat,8*1024);
129:   PetscStrlen(logstart, &len);
130:   PetscMemcpy(log, logstart, len);
131:   PetscStrlen(newformat, &formatlen);
132:   PetscMemcpy(&(log[len]), newformat, formatlen);
133:   if(PETSC_ZOPEFD != NULL){
134: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
135:   vfprintf(PETSC_ZOPEFD,log,(char *)Argp);
136: #else
137:   vfprintf(PETSC_ZOPEFD,log,Argp);
138: #endif
139:   fflush(PETSC_ZOPEFD);
140: }
141:   return 0;
142: }

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

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

153:    No error handling because may be called by error handler
154: */
155: PetscErrorCode  PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
156: {
157:   /* no malloc since may be called by error handler (assume no long messages in errors) */
158:   char        *newformat;
159:   char         formatbuf[8*1024];
160:   size_t       oldLength;

163:   PetscStrlen(format, &oldLength);
164:   if (oldLength < 8*1024) {
165:     newformat = formatbuf;
166:   } else {
167:     (void)PetscMalloc((oldLength+1) * sizeof(char), &newformat);
168:   }
169:   PetscFormatConvert(format,newformat,oldLength+1);
170:   if(PETSC_ZOPEFD != NULL && PETSC_ZOPEFD != PETSC_STDOUT){
171:     va_list s;
172: #if defined(PETSC_HAVE_VA_COPY)
173:     va_copy(s, Argp);
174: #elif defined(PETSC_HAVE___VA_COPY)
175:     __va_copy(s, Argp);
176: #else
177:     SETERRQ(PETSC_ERR_SUP_SYS,"Zope not supported due to missing va_copy()");
178: #endif

180: #if defined(PETSC_HAVE_VA_COPY) || defined(PETSC_HAVE___VA_COPY)
181: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
182:     vfprintf(PETSC_ZOPEFD,newformat,(char *)s);
183: #else
184:     vfprintf(PETSC_ZOPEFD,newformat,s);
185: #endif
186:     fflush(PETSC_ZOPEFD);
187: #endif
188:   }

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

204: /*@C
205:     PetscSNPrintf - Prints to a string of given length

207:     Not Collective

209:     Input Parameters:
210: +   str - the string to print to
211: .   len - the length of str
212: .   format - the usual printf() format string 
213: -   any arguments

215:    Level: intermediate

217: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
218:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
219: @*/
220: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
221: {
223:   int            fullLength;
224:   va_list        Argp;

227:   va_start(Argp,format);
228:   PetscVSNPrintf(str,len,format,&fullLength,Argp);
229:   return(0);
230: }

232: /* ----------------------------------------------------------------------- */

234: PrintfQueue queue       = 0,queuebase = 0;
235: int         queuelength = 0;
236: FILE        *queuefile  = PETSC_NULL;

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

244:     Not Collective

246:     Input Parameters:
247: +   comm - the communicator
248: -   format - the usual printf() format string 

250:    Level: intermediate

252:     Notes:
253:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
254:     from all the processors to be printed.

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

260: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
261:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
262: @*/
263: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
264: {
266:   PetscMPIInt    rank;

269:   MPI_Comm_rank(comm,&rank);
270: 
271:   /* First processor prints immediately to stdout */
272:   if (!rank) {
273:     va_list Argp;
274:     va_start(Argp,format);
275:     (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
276:     if (petsc_history) {
277:       va_start(Argp,format);
278:       (*PetscVFPrintf)(petsc_history,format,Argp);
279:     }
280:     va_end(Argp);
281:   } else { /* other processors add to local queue */
282:     va_list     Argp;
283:     PrintfQueue next;
284:     int         fullLength = 8191;

286:     PetscNew(struct _PrintfQueue,&next);
287:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
288:     else       {queuebase   = queue = next;}
289:     queuelength++;
290:     next->size = -1;
291:     while(fullLength >= next->size) {
292:       next->size = fullLength+1;
293:       PetscMalloc(next->size * sizeof(char), &next->string);
294:       va_start(Argp,format);
295:       PetscMemzero(next->string,next->size);
296:       PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
297:       va_end(Argp);
298:     }
299:   }
300: 
301:   return(0);
302: }
303: 
306: /*@C
307:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
308:     several processors.  Output of the first processor is followed by that of the 
309:     second, etc.

311:     Not Collective

313:     Input Parameters:
314: +   comm - the communicator
315: .   fd - the file pointer
316: -   format - the usual printf() format string 

318:     Level: intermediate

320:     Notes:
321:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
322:     from all the processors to be printed.

324: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
325:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

327: @*/
328: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
329: {
331:   PetscMPIInt    rank;

334:   MPI_Comm_rank(comm,&rank);
335: 
336:   /* First processor prints immediately to fp */
337:   if (!rank) {
338:     va_list Argp;
339:     va_start(Argp,format);
340:     (*PetscVFPrintf)(fp,format,Argp);
341:     queuefile = fp;
342:     if (petsc_history && (fp !=petsc_history)) {
343:       va_start(Argp,format);
344:       (*PetscVFPrintf)(petsc_history,format,Argp);
345:     }
346:     va_end(Argp);
347:   } else { /* other processors add to local queue */
348:     va_list     Argp;
349:     PrintfQueue next;
350:     int         fullLength = 8191;
351:     PetscNew(struct _PrintfQueue,&next);
352:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
353:     else       {queuebase   = queue = next;}
354:     queuelength++;
355:     next->size = -1;
356:     while(fullLength >= next->size) {
357:       next->size = fullLength+1;
358:       PetscMalloc(next->size * sizeof(char), &next->string);
359:       va_start(Argp,format);
360:       PetscMemzero(next->string,next->size);
361:       PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
362:       va_end(Argp);
363:     }
364:   }
365:   return(0);
366: }

370: /*@
371:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
372:     involved in previous PetscSynchronizedPrintf() calls.

374:     Collective on MPI_Comm

376:     Input Parameters:
377: .   comm - the communicator

379:     Level: intermediate

381:     Notes:
382:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
383:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

385: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
386:           PetscViewerASCIISynchronizedPrintf()
387: @*/
388: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm)
389: {
391:   PetscMPIInt    rank,size,tag,i,j,n;
392:   char          *message;
393:   MPI_Status     status;
394:   FILE           *fd;

397:   PetscCommDuplicate(comm,&comm,&tag);
398:   MPI_Comm_rank(comm,&rank);
399:   MPI_Comm_size(comm,&size);

401:   /* First processor waits for messages from all other processors */
402:   if (!rank) {
403:     if (queuefile) {
404:       fd = queuefile;
405:     } else {
406:       fd = PETSC_STDOUT;
407:     }
408:     for (i=1; i<size; i++) {
409:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
410:       for (j=0; j<n; j++) {
411:         int size;

413:         MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
414:         PetscMalloc(size * sizeof(char), &message);
415:         MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
416:         PetscFPrintf(comm,fd,"%s",message);
417:         PetscFree(message);
418:       }
419:     }
420:     queuefile = PETSC_NULL;
421:   } else { /* other processors send queue to processor 0 */
422:     PrintfQueue next = queuebase,previous;

424:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
425:     for (i=0; i<queuelength; i++) {
426:       MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
427:       MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
428:       previous = next;
429:       next     = next->next;
430:       PetscFree(previous->string);
431:       PetscFree(previous);
432:     }
433:     queue       = 0;
434:     queuelength = 0;
435:   }
436:   PetscCommDestroy(&comm);
437:   return(0);
438: }

440: /* ---------------------------------------------------------------------------------------*/

444: /*@C
445:     PetscFPrintf - Prints to a file, only from the first
446:     processor in the communicator.

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:     Fortran Note:
458:     This routine is not supported in Fortran.

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

463: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
464:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
465: @*/
466: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
467: {
469:   PetscMPIInt    rank;

472:   MPI_Comm_rank(comm,&rank);
473:   if (!rank) {
474:     va_list Argp;
475:     va_start(Argp,format);
476:     (*PetscVFPrintf)(fd,format,Argp);
477:     if (petsc_history && (fd !=petsc_history)) {
478:       va_start(Argp,format);
479:       (*PetscVFPrintf)(petsc_history,format,Argp);
480:       }
481:     va_end(Argp);
482:   }
483:   return(0);
484: }

488: /*@C
489:     PetscPrintf - Prints to standard out, only from the first
490:     processor in the communicator.

492:     Not Collective

494:     Input Parameters:
495: +   comm - the communicator
496: -   format - the usual printf() format string 

498:    Level: intermediate

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

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

507:    Concepts: printing^in parallel
508:    Concepts: printf^in parallel

510: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
511: @*/
512: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
513: {
515:   PetscMPIInt    rank;
516:   size_t         len;
517:   char           *nformat,*sub1,*sub2;
518:   PetscReal      value;

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);

527:     PetscStrstr(format,"%A",&sub1);
528:     if (sub1) {
529:       PetscStrstr(format,"%",&sub2);
530:       if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
531:       PetscStrlen(format,&len);
532:       PetscMalloc((len+16)*sizeof(char),&nformat);
533:       PetscStrcpy(nformat,format);
534:       PetscStrstr(nformat,"%",&sub2);
535:       sub2[0] = 0;
536:       value   = (double)va_arg(Argp,double);
537:       if (PetscAbsReal(value) < 1.e-12) {
538:         PetscStrcat(nformat,"< 1.e-12");
539:       } else {
540:         PetscStrcat(nformat,"%g");
541:         va_end(Argp);
542:         va_start(Argp,format);
543:       }
544:       PetscStrcat(nformat,sub1+2);
545:     } else {
546:       nformat = (char*)format;
547:     }
548:     (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
549:     if (petsc_history) {
550:       va_start(Argp,format);
551:       (*PetscVFPrintf)(petsc_history,nformat,Argp);
552:     }
553:     va_end(Argp);
554:     if (sub1) {PetscFree(nformat);}
555:   }
556:   return(0);
557: }

559: /* ---------------------------------------------------------------------------------------*/
562: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
563: {
565:   PetscMPIInt    rank;

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

583: /* ---------------------------------------------------------------------------------------*/


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

591:     Collective on MPI_Comm

593:     Input Parameters:
594: +   comm - the communicator
595: .   fd - the file pointer
596: -   len - the length of the output buffer

598:     Output Parameter:
599: .   string - the line read from the file

601:     Level: intermediate

603: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 
604:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

606: @*/
607: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
608: {
610:   PetscMPIInt    rank;

613:   MPI_Comm_rank(comm,&rank);
614: 
615:   if (!rank) {
616:     fgets(string,len,fp);
617:   }
618:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
619:   return(0);
620: }