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;

 26: PetscErrorCode  PetscFormatConvert(const char *format,char *newformat,PetscInt size)
 27: {
 28:   PetscInt i = 0,j = 0;

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

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

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

105:    No error handling because may be called by error handler
106: */
107: PetscErrorCode  PetscVFPrintf(FILE *fd,const char *format,va_list Argp)
108: {
109:   /* no malloc since may be called by error handler */
110:   char     newformat[8*1024];
111: 
112:   PetscFormatConvert(format,newformat,8*1024);
113: #if defined(PETSC_HAVE_VPRINTF_CHAR)
114:   vfprintf(fd,newformat,(char *)Argp);
115: #else
116:   vfprintf(fd,newformat,Argp);
117:   fflush(fd);
118: #endif
119:   return 0;
120: }

124: /*@C
125:     PetscSNPrintf - Prints to a string of given length

127:     Not Collective

129:     Input Parameters:
130: +   str - the string to print to
131: .   len - the length of str
132: .   format - the usual printf() format string 
133: -   any arguments

135:    Level: intermediate

137: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
138:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
139: @*/
140: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
141: {
143:   va_list        Argp;

146:   va_start(Argp,format);
147:   PetscVSNPrintf(str,len,format,Argp);
148:   return(0);
149: }

151: /* ----------------------------------------------------------------------- */

153: PrintfQueue queue       = 0,queuebase = 0;
154: int         queuelength = 0;
155: FILE        *queuefile  = PETSC_NULL;

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

163:     Not Collective

165:     Input Parameters:
166: +   comm - the communicator
167: -   format - the usual printf() format string 

169:    Level: intermediate

171:     Notes:
172:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
173:     from all the processors to be printed.

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

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

181: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
182:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
183: @*/
184: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
185: {
187:   PetscMPIInt    rank;

190:   MPI_Comm_rank(comm,&rank);
191: 
192:   /* First processor prints immediately to stdout */
193:   if (!rank) {
194:     va_list Argp;
195:     va_start(Argp,format);
196:     PetscVFPrintf(PETSC_STDOUT,format,Argp);
197:     if (petsc_history) {
198:       PetscVFPrintf(petsc_history,format,Argp);
199:     }
200:     va_end(Argp);
201:   } else { /* other processors add to local queue */
202:     va_list     Argp;
203:     PrintfQueue next;

205:     PetscNew(struct _PrintfQueue,&next);
206:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
207:     else       {queuebase   = queue = next;}
208:     queuelength++;
209:     va_start(Argp,format);
210:     PetscMemzero(next->string,QUEUESTRINGSIZE);
211:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
212:     va_end(Argp);
213:   }
214: 
215:   return(0);
216: }
217: 
220: /*@C
221:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
222:     several processors.  Output of the first processor is followed by that of the 
223:     second, etc.

225:     Not Collective

227:     Input Parameters:
228: +   comm - the communicator
229: .   fd - the file pointer
230: -   format - the usual printf() format string 

232:     Level: intermediate

234:     Notes:
235:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
236:     from all the processors to be printed.

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

240:     Contributed by: Matthew Knepley

242: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
243:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

245: @*/
246: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
247: {
249:   PetscMPIInt    rank;

252:   MPI_Comm_rank(comm,&rank);
253: 
254:   /* First processor prints immediately to fp */
255:   if (!rank) {
256:     va_list Argp;
257:     va_start(Argp,format);
258:     PetscVFPrintf(fp,format,Argp);
259:     queuefile = fp;
260:     if (petsc_history) {
261:       PetscVFPrintf(petsc_history,format,Argp);
262:     }
263:     va_end(Argp);
264:   } else { /* other processors add to local queue */
265:     va_list     Argp;
266:     PrintfQueue next;
267:     PetscNew(struct _PrintfQueue,&next);
268:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
269:     else       {queuebase   = queue = next;}
270:     queuelength++;
271:     va_start(Argp,format);
272:     PetscMemzero(next->string,QUEUESTRINGSIZE);
273:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
274:     va_end(Argp);
275:   }
276:   return(0);
277: }

281: /*@
282:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
283:     involved in previous PetscSynchronizedPrintf() calls.

285:     Collective on MPI_Comm

287:     Input Parameters:
288: .   comm - the communicator

290:     Level: intermediate

292:     Notes:
293:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
294:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

296: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
297:           PetscViewerASCIISynchronizedPrintf()
298: @*/
299: PetscErrorCode  PetscSynchronizedFlush(MPI_Comm comm)
300: {
302:   PetscMPIInt    rank,size,tag,i,j,n;
303:   char           message[QUEUESTRINGSIZE];
304:   MPI_Status     status;
305:   FILE           *fd;

308:   PetscCommDuplicate(comm,&comm,&tag);
309:   MPI_Comm_rank(comm,&rank);
310:   MPI_Comm_size(comm,&size);

312:   /* First processor waits for messages from all other processors */
313:   if (!rank) {
314:     if (queuefile) {
315:       fd = queuefile;
316:     } else {
317:       fd = PETSC_STDOUT;
318:     }
319:     for (i=1; i<size; i++) {
320:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
321:       for (j=0; j<n; j++) {
322:         MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
323:         PetscFPrintf(comm,fd,"%s",message);
324:       }
325:     }
326:     queuefile = PETSC_NULL;
327:   } else { /* other processors send queue to processor 0 */
328:     PrintfQueue next = queuebase,previous;

330:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
331:     for (i=0; i<queuelength; i++) {
332:       MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
333:       previous = next;
334:       next     = next->next;
335:       PetscFree(previous);
336:     }
337:     queue       = 0;
338:     queuelength = 0;
339:   }
340:   PetscCommDestroy(&comm);
341:   return(0);
342: }

344: /* ---------------------------------------------------------------------------------------*/

348: /*@C
349:     PetscFPrintf - Prints to a file, only from the first
350:     processor in the communicator.

352:     Not Collective

354:     Input Parameters:
355: +   comm - the communicator
356: .   fd - the file pointer
357: -   format - the usual printf() format string 

359:     Level: intermediate

361:     Fortran Note:
362:     This routine is not supported in Fortran.

364:    Concepts: printing^in parallel
365:    Concepts: printf^in parallel

367: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
368:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
369: @*/
370: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
371: {
373:   PetscMPIInt    rank;

376:   MPI_Comm_rank(comm,&rank);
377:   if (!rank) {
378:     va_list Argp;
379:     va_start(Argp,format);
380:     PetscVFPrintf(fd,format,Argp);
381:     if (petsc_history) {
382:       PetscVFPrintf(petsc_history,format,Argp);
383:     }
384:     va_end(Argp);
385:   }
386:   return(0);
387: }

391: /*@C
392:     PetscPrintf - Prints to standard out, only from the first
393:     processor in the communicator.

395:     Not Collective

397:     Input Parameters:
398: +   comm - the communicator
399: -   format - the usual printf() format string 

401:    Level: intermediate

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

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

410:    Concepts: printing^in parallel
411:    Concepts: printf^in parallel

413: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
414: @*/
415: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
416: {
418:   PetscMPIInt    rank;
419:   size_t         len;
420:   char           *nformat,*sub1,*sub2;
421:   PetscReal      value;

424:   if (!comm) comm = PETSC_COMM_WORLD;
425:   MPI_Comm_rank(comm,&rank);
426:   if (!rank) {
427:     va_list Argp;
428:     va_start(Argp,format);

430:     PetscStrstr(format,"%A",&sub1);
431:     if (sub1) {
432:       PetscStrstr(format,"%",&sub2);
433:       if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
434:       PetscStrlen(format,&len);
435:       PetscMalloc((len+16)*sizeof(char),&nformat);
436:       PetscStrcpy(nformat,format);
437:       PetscStrstr(nformat,"%",&sub2);
438:       sub2[0] = 0;
439:       value   = (double)va_arg(Argp,double);
440:       if (PetscAbsReal(value) < 1.e-12) {
441:         PetscStrcat(nformat,"< 1.e-12");
442:       } else {
443:         PetscStrcat(nformat,"%g");
444:         va_end(Argp);
445:         va_start(Argp,format);
446:       }
447:       PetscStrcat(nformat,sub1+2);
448:     } else {
449:       nformat = (char*)format;
450:     }
451:     PetscVFPrintf(PETSC_STDOUT,nformat,Argp);
452:     if (petsc_history) {
453:       PetscVFPrintf(petsc_history,nformat,Argp);
454:     }
455:     va_end(Argp);
456:     if (sub1) {PetscFree(nformat);}
457:   }
458:   return(0);
459: }

461: /* ---------------------------------------------------------------------------------------*/
464: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
465: {
467:   PetscMPIInt    rank;

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

484: /* ---------------------------------------------------------------------------------------*/


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

492:     Collective on MPI_Comm

494:     Input Parameters:
495: +   comm - the communicator
496: .   fd - the file pointer
497: -   len - the length of the output buffer

499:     Output Parameter:
500: .   string - the line read from the file

502:     Level: intermediate

504: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 
505:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

507: @*/
508: PetscErrorCode  PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
509: {
511:   PetscMPIInt    rank;

514:   MPI_Comm_rank(comm,&rank);
515: 
516:   if (!rank) {
517:     fgets(string,len,fp);
518:   }
519:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
520:   return(0);
521: }