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;

 20: PetscErrorCode  PetscFormatConvert(const char *format,char *newformat,PetscInt size)
 21: {
 22:   PetscInt i = 0,j = 0;

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

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

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

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

118: /*@C
119:     PetscSNPrintf - Prints to a string of given length

121:     Not Collective

123:     Input Parameters:
124: +   str - the string to print to
125: .   len - the length of str
126: .   format - the usual printf() format string 
127: -   any arguments

129:    Level: intermediate

131: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
132:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
133: @*/
134: PetscErrorCode  PetscSNPrintf(char *str,size_t len,const char format[],...)
135: {
137:   va_list        Argp;

140:   va_start(Argp,format);
141:   PetscVSNPrintf(str,len,format,Argp);
142:   return(0);
143: }

145: /* ----------------------------------------------------------------------- */

147: PrintfQueue queue       = 0,queuebase = 0;
148: int         queuelength = 0;
149: FILE        *queuefile  = PETSC_NULL;

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

157:     Not Collective

159:     Input Parameters:
160: +   comm - the communicator
161: -   format - the usual printf() format string 

163:    Level: intermediate

165:     Notes:
166:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
167:     from all the processors to be printed.

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

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

175: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
176:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
177: @*/
178: PetscErrorCode  PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
179: {
181:   PetscMPIInt    rank;

184:   MPI_Comm_rank(comm,&rank);
185: 
186:   /* First processor prints immediately to stdout */
187:   if (!rank) {
188:     va_list Argp;
189:     va_start(Argp,format);
190:     PetscVFPrintf(PETSC_STDOUT,format,Argp);
191:     if (petsc_history) {
192:       PetscVFPrintf(petsc_history,format,Argp);
193:     }
194:     va_end(Argp);
195:   } else { /* other processors add to local queue */
196:     va_list     Argp;
197:     PrintfQueue next;

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

219:     Not Collective

221:     Input Parameters:
222: +   comm - the communicator
223: .   fd - the file pointer
224: -   format - the usual printf() format string 

226:     Level: intermediate

228:     Notes:
229:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
230:     from all the processors to be printed.

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

234:     Contributed by: Matthew Knepley

236: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
237:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

239: @*/
240: PetscErrorCode  PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
241: {
243:   PetscMPIInt    rank;

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

275: /*@
276:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
277:     involved in previous PetscSynchronizedPrintf() calls.

279:     Collective on MPI_Comm

281:     Input Parameters:
282: .   comm - the communicator

284:     Level: intermediate

286:     Notes:
287:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
288:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

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

302:   PetscCommDuplicate(comm,&comm,&tag);
303:   MPI_Comm_rank(comm,&rank);
304:   MPI_Comm_size(comm,&size);

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

324:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
325:     for (i=0; i<queuelength; i++) {
326:       MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
327:       previous = next;
328:       next     = next->next;
329:       PetscFree(previous);
330:     }
331:     queue       = 0;
332:     queuelength = 0;
333:   }
334:   PetscCommDestroy(&comm);
335:   return(0);
336: }

338: /* ---------------------------------------------------------------------------------------*/

342: /*@C
343:     PetscFPrintf - Prints to a file, only from the first
344:     processor in the communicator.

346:     Not Collective

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

353:     Level: intermediate

355:     Fortran Note:
356:     This routine is not supported in Fortran.

358:    Concepts: printing^in parallel
359:    Concepts: printf^in parallel

361: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
362:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
363: @*/
364: PetscErrorCode  PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
365: {
367:   PetscMPIInt    rank;

370:   MPI_Comm_rank(comm,&rank);
371:   if (!rank) {
372:     va_list Argp;
373:     va_start(Argp,format);
374:     PetscVFPrintf(fd,format,Argp);
375:     if (petsc_history) {
376:       PetscVFPrintf(petsc_history,format,Argp);
377:     }
378:     va_end(Argp);
379:   }
380:   return(0);
381: }

385: /*@C
386:     PetscPrintf - Prints to standard out, only from the first
387:     processor in the communicator.

389:     Not Collective

391:     Input Parameters:
392: +   comm - the communicator
393: -   format - the usual printf() format string 

395:    Level: intermediate

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

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

404:    Concepts: printing^in parallel
405:    Concepts: printf^in parallel

407: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
408: @*/
409: PetscErrorCode  PetscPrintf(MPI_Comm comm,const char format[],...)
410: {
412:   PetscMPIInt    rank;
413:   size_t         len;
414:   char           *nformat,*sub1,*sub2;
415:   PetscReal      value;

418:   if (!comm) comm = PETSC_COMM_WORLD;
419:   MPI_Comm_rank(comm,&rank);
420:   if (!rank) {
421:     va_list Argp;
422:     va_start(Argp,format);

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

455: /* ---------------------------------------------------------------------------------------*/
458: PetscErrorCode  PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
459: {
461:   PetscMPIInt    rank;

464:   if (!comm) comm = PETSC_COMM_WORLD;
465:   MPI_Comm_rank(comm,&rank);
466:   if (!rank) {
467:     va_list Argp;
468:     va_start(Argp,format);
469:     PetscVFPrintf(PETSC_STDOUT,format,Argp);
470:     if (petsc_history) {
471:       PetscVFPrintf(petsc_history,format,Argp);
472:     }
473:     va_end(Argp);
474:   }
475:   return(0);
476: }

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


483: PetscErrorCode  PetscErrorPrintfDefault(const char format[],...)
484: {
485:   va_list            Argp;
486:   static  PetscTruth PetscErrorPrintfCalled    = PETSC_FALSE;
487:   static  PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
488:   static  FILE       *fd;

490:   /*
491:       InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
492:      from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
493:   */

495:   /*
497:     it may be called by PetscStackView().

499:       This function does not do error checking because it is called by the error handlers.
500:   */

502:   if (!PetscErrorPrintfCalled) {
503:     PetscTruth use_stderr;

505:     PetscErrorPrintfCalled    = PETSC_TRUE;
506:     InPetscErrorPrintfDefault = PETSC_TRUE;

508:     PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
509:     if (use_stderr) {
510:       fd = stderr;
511:     } else {
512:       fd = PETSC_STDOUT;
513:     }

515:     /*
516:         On the SGI machines and Cray T3E, if errors are generated  "simultaneously" by
517:       different processors, the messages are printed all jumbled up; to try to 
518:       prevent this we have each processor wait based on their rank
519:     */
520: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
521:     {
522:       PetscMPIInt rank;
523:       if (PetscGlobalRank > 8) rank = 8; else rank = PetscGlobalRank;
524:       PetscSleep(rank);
525:     }
526: #endif
527:     InPetscErrorPrintfDefault = PETSC_FALSE;
528:   }
529: 
530:   if (!InPetscErrorPrintfDefault) {
531:     PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]PETSC ERROR: ",PetscGlobalRank);
532:     va_start(Argp,format);
533:     PetscVFPrintf(fd,format,Argp);
534:     va_end(Argp);
535:   }
536:   return 0;
537: }

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

544:     Collective on MPI_Comm

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

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

554:     Level: intermediate

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

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

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