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: #include "petscconfiginfo.h"
  7: /*
  8:    If petsc_history is on, then all Petsc*Printf() results are saved
  9:    if the appropriate (usually .petschistory) file.
 10: */
 12: /*
 13:      Allows one to overwrite where standard out is sent. For example
 14:      PETSC_STDOUT = fopen("/dev/ttyXX","w") will cause all standard out
 15:      writes to go to terminal XX; assuming you have write permission there
 16: */
 17: FILE *PETSC_STDOUT = 0;

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

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

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

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

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

117: /* ----------------------------------------------------------------------- */

119: PrintfQueue queue       = 0,queuebase = 0;
120: int         queuelength = 0;
121: FILE        *queuefile  = PETSC_NULL;

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

129:     Not Collective

131:     Input Parameters:
132: +   comm - the communicator
133: -   format - the usual printf() format string 

135:    Level: intermediate

137:     Notes:
138:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
139:     from all the processors to be printed.

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

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

147: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
148:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
149: @*/
150: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
151: {
153:   PetscMPIInt    rank;

156:   MPI_Comm_rank(comm,&rank);
157: 
158:   /* First processor prints immediately to stdout */
159:   if (!rank) {
160:     va_list Argp;
161:     va_start(Argp,format);
162:     PetscVFPrintf(PETSC_STDOUT,format,Argp);
163:     if (petsc_history) {
164:       PetscVFPrintf(petsc_history,format,Argp);
165:     }
166:     va_end(Argp);
167:   } else { /* other processors add to local queue */
168:     va_list     Argp;
169:     PrintfQueue next;

171:     PetscNew(struct _PrintfQueue,&next);
172:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
173:     else       {queuebase   = queue = next;}
174:     queuelength++;
175:     va_start(Argp,format);
176:     PetscMemzero(next->string,QUEUESTRINGSIZE);
177:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
178:     va_end(Argp);
179:   }
180: 
181:   return(0);
182: }
183: 
186: /*@C
187:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
188:     several processors.  Output of the first processor is followed by that of the 
189:     second, etc.

191:     Not Collective

193:     Input Parameters:
194: +   comm - the communicator
195: .   fd - the file pointer
196: -   format - the usual printf() format string 

198:     Level: intermediate

200:     Notes:
201:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
202:     from all the processors to be printed.

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

206:     Contributed by: Matthew Knepley

208: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
209:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

211: @*/
212: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
213: {
215:   PetscMPIInt    rank;

218:   MPI_Comm_rank(comm,&rank);
219: 
220:   /* First processor prints immediately to fp */
221:   if (!rank) {
222:     va_list Argp;
223:     va_start(Argp,format);
224:     PetscVFPrintf(fp,format,Argp);
225:     queuefile = fp;
226:     if (petsc_history) {
227:       PetscVFPrintf(petsc_history,format,Argp);
228:     }
229:     va_end(Argp);
230:   } else { /* other processors add to local queue */
231:     va_list     Argp;
232:     PrintfQueue next;
233:     PetscNew(struct _PrintfQueue,&next);
234:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
235:     else       {queuebase   = queue = next;}
236:     queuelength++;
237:     va_start(Argp,format);
238:     PetscMemzero(next->string,QUEUESTRINGSIZE);
239:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
240:     va_end(Argp);
241:   }
242:   return(0);
243: }

247: /*@
248:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
249:     involved in previous PetscSynchronizedPrintf() calls.

251:     Collective on MPI_Comm

253:     Input Parameters:
254: .   comm - the communicator

256:     Level: intermediate

258:     Notes:
259:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
260:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

262: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
263:           PetscViewerASCIISynchronizedPrintf()
264: @*/
265: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFlush(MPI_Comm comm)
266: {
268:   PetscMPIInt    rank,size,tag,i,j,n;
269:   char           message[QUEUESTRINGSIZE];
270:   MPI_Status     status;
271:   FILE           *fd;

274:   PetscCommDuplicate(comm,&comm,&tag);
275:   MPI_Comm_rank(comm,&rank);
276:   MPI_Comm_size(comm,&size);

278:   /* First processor waits for messages from all other processors */
279:   if (!rank) {
280:     if (queuefile) {
281:       fd = queuefile;
282:     } else {
283:       fd = PETSC_STDOUT;
284:     }
285:     for (i=1; i<size; i++) {
286:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
287:       for (j=0; j<n; j++) {
288:         MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
289:         PetscFPrintf(comm,fd,"%s",message);
290:       }
291:     }
292:     queuefile = PETSC_NULL;
293:   } else { /* other processors send queue to processor 0 */
294:     PrintfQueue next = queuebase,previous;

296:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
297:     for (i=0; i<queuelength; i++) {
298:       MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
299:       previous = next;
300:       next     = next->next;
301:       PetscFree(previous);
302:     }
303:     queue       = 0;
304:     queuelength = 0;
305:   }
306:   PetscCommDestroy(&comm);
307:   return(0);
308: }

310: /* ---------------------------------------------------------------------------------------*/

314: /*@C
315:     PetscFPrintf - Prints to a file, only from the first
316:     processor in the communicator.

318:     Not Collective

320:     Input Parameters:
321: +   comm - the communicator
322: .   fd - the file pointer
323: -   format - the usual printf() format string 

325:     Level: intermediate

327:     Fortran Note:
328:     This routine is not supported in Fortran.

330:    Concepts: printing^in parallel
331:    Concepts: printf^in parallel

333: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
334:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
335: @*/
336: PetscErrorCode PETSC_DLLEXPORT PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
337: {
339:   PetscMPIInt    rank;

342:   MPI_Comm_rank(comm,&rank);
343:   if (!rank) {
344:     va_list Argp;
345:     va_start(Argp,format);
346:     PetscVFPrintf(fd,format,Argp);
347:     if (petsc_history) {
348:       PetscVFPrintf(petsc_history,format,Argp);
349:     }
350:     va_end(Argp);
351:   }
352:   return(0);
353: }

357: /*@C
358:     PetscPrintf - Prints to standard out, only from the first
359:     processor in the communicator.

361:     Not Collective

363:     Input Parameters:
364: +   comm - the communicator
365: -   format - the usual printf() format string 

367:    Level: intermediate

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

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

376:    Concepts: printing^in parallel
377:    Concepts: printf^in parallel

379: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
380: @*/
381: PetscErrorCode PETSC_DLLEXPORT PetscPrintf(MPI_Comm comm,const char format[],...)
382: {
384:   PetscMPIInt    rank;
385:   size_t         len;
386:   char           *nformat,*sub1,*sub2;
387:   PetscReal      value;

390:   if (!comm) comm = PETSC_COMM_WORLD;
391:   MPI_Comm_rank(comm,&rank);
392:   if (!rank) {
393:     va_list Argp;
394:     va_start(Argp,format);

396:     PetscStrstr(format,"%A",&sub1);
397:     if (sub1) {
398:       PetscStrstr(format,"%",&sub2);
399:       if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
400:       PetscStrlen(format,&len);
401:       PetscMalloc((len+16)*sizeof(char),&nformat);
402:       PetscStrcpy(nformat,format);
403:       PetscStrstr(nformat,"%",&sub2);
404:       sub2[0] = 0;
405:       value   = (double)va_arg(Argp,double);
406:       if (PetscAbsReal(value) < 1.e-12) {
407:         PetscStrcat(nformat,"< 1.e-12");
408:       } else {
409:         PetscStrcat(nformat,"%g");
410:         va_end(Argp);
411:         va_start(Argp,format);
412:       }
413:       PetscStrcat(nformat,sub1+2);
414:     } else {
415:       nformat = (char*)format;
416:     }
417:     PetscVFPrintf(PETSC_STDOUT,nformat,Argp);
418:     if (petsc_history) {
419:       PetscVFPrintf(petsc_history,nformat,Argp);
420:     }
421:     va_end(Argp);
422:     if (sub1) {PetscFree(nformat);}
423:   }
424:   return(0);
425: }

427: /* ---------------------------------------------------------------------------------------*/
430: PetscErrorCode PETSC_DLLEXPORT PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
431: {
433:   PetscMPIInt    rank;

436:   if (!comm) comm = PETSC_COMM_WORLD;
437:   MPI_Comm_rank(comm,&rank);
438:   if (!rank) {
439:     va_list Argp;
440:     va_start(Argp,format);
441:     PetscVFPrintf(PETSC_STDOUT,format,Argp);
442:     if (petsc_history) {
443:       PetscVFPrintf(petsc_history,format,Argp);
444:     }
445:     va_end(Argp);
446:   }
447:   return(0);
448: }

450: /* ---------------------------------------------------------------------------------------*/

452: static char  arch[10],hostname[64],username[16],pname[PETSC_MAX_PATH_LEN],date[64];
453: static PetscTruth PetscErrorPrintfInitializeCalled = PETSC_FALSE;

457: /*
458:    Initializes arch, hostname, username,date so that system calls do NOT need
459:    to be made during the error handler.
460: */
461: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfInitialize()
462: {

466:   PetscGetArchType(arch,10);
467:   PetscGetHostName(hostname,64);
468:   PetscGetUserName(username,16);
469:   PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);
470:   PetscGetDate(date,64);
471:   PetscErrorPrintfInitializeCalled = PETSC_TRUE;
472:   return(0);
473: }


478: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfDefault(const char format[],...)
479: {
480:   va_list            Argp;
481:   static  PetscTruth PetscErrorPrintfCalled    = PETSC_FALSE;
482:   static  PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
483:   static  FILE       *fd;
484:   char               version[256];
485:   PetscErrorCode     ierr;

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

492:   /*
494:     it may be called by PetscStackView().

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

499:   if (!PetscErrorPrintfCalled) {
500:     PetscTruth use_stderr;

502:     PetscErrorPrintfCalled    = PETSC_TRUE;
503:     InPetscErrorPrintfDefault = PETSC_TRUE;

505:     PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
506:     if (use_stderr) {
507:       fd = stderr;
508:     } else {
509:       fd = PETSC_STDOUT;
510:     }

512:     /*
513:         On the SGI machines and Cray T3E, if errors are generated  "simultaneously" by
514:       different processors, the messages are printed all jumbled up; to try to 
515:       prevent this we have each processor wait based on their rank
516:     */
517: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
518:     {
519:       PetscMPIInt rank;
520:       if (PetscGlobalRank > 8) rank = 8; else rank = PetscGlobalRank;
521:       PetscSleep(rank);
522:     }
523: #endif
524: 
525:     PetscGetVersion(&version);

527:     PetscFPrintf(PETSC_COMM_SELF,fd,"------------------------------------------------------------------------\n");
528:     PetscFPrintf(PETSC_COMM_SELF,fd,"%s\n",version);
529:     PetscFPrintf(PETSC_COMM_SELF,fd,"See docs/changes/index.html for recent updates.\n");
530:     PetscFPrintf(PETSC_COMM_SELF,fd,"See docs/faq.html for hints about trouble shooting.\n");
531:     PetscFPrintf(PETSC_COMM_SELF,fd,"See docs/index.html for manual pages.\n");
532:     PetscFPrintf(PETSC_COMM_SELF,fd,"------------------------------------------------------------------------\n");
533:     if (PetscErrorPrintfInitializeCalled) {
534:       PetscFPrintf(PETSC_COMM_SELF,fd,"%s on a %s named %s by %s %s\n",pname,arch,hostname,username,date);
535:     }
536:     PetscFPrintf(PETSC_COMM_SELF,fd,"Libraries linked from %s\n",PETSC_LIB_DIR);
537:     PetscFPrintf(PETSC_COMM_SELF,fd,"Configure run at %s\n",petscconfigureruntime);
538:     PetscFPrintf(PETSC_COMM_SELF,fd,"Configure options %s\n",petscconfigureoptions);
539:     PetscFPrintf(PETSC_COMM_SELF,fd,"------------------------------------------------------------------------\n");
540:     InPetscErrorPrintfDefault = PETSC_FALSE;
541:   }

543:   if (!InPetscErrorPrintfDefault) {
544:     PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]PETSC ERROR: ",PetscGlobalRank);
545:     va_start(Argp,format);
546:     PetscVFPrintf(fd,format,Argp);
547:     va_end(Argp);
548:   }
549:   return 0;
550: }

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

557:     Collective on MPI_Comm

559:     Input Parameters:
560: +   comm - the communicator
561: .   fd - the file pointer
562: -   len - the length of the output buffer

564:     Output Parameter:
565: .   string - the line read from the file

567:     Level: intermediate

569: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 
570:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

572: @*/
573: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
574: {
576:   PetscMPIInt    rank;

579:   MPI_Comm_rank(comm,&rank);
580: 
581:   if (!rank) {
582:     fgets(string,len,fp);
583:   }
584:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
585:   return(0);
586: }