Actual source code: mprint.c

      1: #define PETSC_DLL
      2: /*
      3:       Utilites routines to add simple ASCII IO capability.
      4: */
     5:  #include src/sys/src/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: */

     14: PetscErrorCode PETSC_DLLEXPORT PetscFormatConvert(const char *format,char *newformat)
     15: {
     16:   PetscInt i = 0,j = 0;

     18:   while (format[i] && i < 8*1024-1) {
     19:     if (format[i] == '%' && format[i+1] == 'D') {
     20:       newformat[j++] = '%';
     21: #if defined(PETSC_USE_32BIT_INT)
     22:       newformat[j++] = 'd';
     23: #else
     24:       newformat[j++] = 'l';
     25:       newformat[j++] = 'l';
     26:       newformat[j++] = 'd';
     27: #endif
     28:       i += 2;
     29:     } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
     30:       newformat[j++] = '%';
     31:       newformat[j++] = format[i+1];
     32: #if defined(PETSC_USE_32BIT_INT)
     33:       newformat[j++] = 'd';
     34: #else
     35:       newformat[j++] = 'l';
     36:       newformat[j++] = 'l';
     37:       newformat[j++] = 'd';
     38: #endif
     39:       i += 3;
     40:     }else {
     41:       newformat[j++] = format[i++];
     42:     }
     43:   }
     44:   newformat[j] = 0;
     45:   return 0;
     46: }
     47:
     50: /*
     51:    No error handling because may be called by error handler
     52: */
     53: PetscErrorCode PETSC_DLLEXPORT PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp)
     54: {
     55:   /* no malloc since may be called by error handler */
     56:   char     newformat[8*1024];
     57:
     58:   PetscFormatConvert(format,newformat);
     59: #if defined(PETSC_HAVE_VPRINTF_CHAR)
     60:   vsprintf(str,newformat,(char *)Argp);
     61: #else
     62:   vsprintf(str,newformat,Argp);
     63: #endif
     64:   return 0;
     65: }

     69: /*
     70:    No error handling because may be called by error handler
     71: */
     72: PetscErrorCode PETSC_DLLEXPORT PetscVFPrintf(FILE *fd,const char *format,va_list Argp)
     73: {
     74:   /* no malloc since may be called by error handler */
     75:   char     newformat[8*1024];
     76:
     77:   PetscFormatConvert(format,newformat);
     78: #if defined(PETSC_HAVE_VPRINTF_CHAR)
     79:   vfprintf(fd,newformat,(char *)Argp);
     80: #else
     81:   vfprintf(fd,newformat,Argp);
     82:   fflush(fd);
     83: #endif
     84:   return 0;
     85: }

     87: /* ----------------------------------------------------------------------- */

     89: PrintfQueue queue       = 0,queuebase = 0;
     90: int         queuelength = 0;
     91: FILE        *queuefile  = PETSC_NULL;

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

     99:     Not Collective

    101:     Input Parameters:
    102: +   comm - the communicator
    103: -   format - the usual printf() format string

    105:    Level: intermediate

    107:     Notes:
    108:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information
    109:     from all the processors to be printed.

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

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

    117: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
    118:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
    119: @*/
    120: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
    121: {
    123:   PetscMPIInt    rank;

    126:   MPI_Comm_rank(comm,&rank);
    127:
    128:   /* First processor prints immediately to stdout */
    129:   if (!rank) {
    130:     va_list Argp;
    131:     va_start(Argp,format);
    132:     PetscVFPrintf(stdout,format,Argp);
    133:     fflush(stdout);
    134:     if (petsc_history) {
    135:       PetscVFPrintf(petsc_history,format,Argp);
    136:       fflush(petsc_history);
    137:     }
    138:     va_end(Argp);
    139:   } else { /* other processors add to local queue */
    140:     va_list     Argp;
    141:     PrintfQueue next;

    143:     PetscNew(struct _PrintfQueue,&next);
    144:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
    145:     else       {queuebase   = queue = next;}
    146:     queuelength++;
    147:     va_start(Argp,format);
    148:     PetscMemzero(next->string,QUEUESTRINGSIZE);
    149:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
    150:     va_end(Argp);
    151:   }
    152:
    153:   return(0);
    154: }
    155:
    158: /*@C
    159:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
    160:     several processors.  Output of the first processor is followed by that of the
    161:     second, etc.

    163:     Not Collective

    165:     Input Parameters:
    166: +   comm - the communicator
    167: .   fd - the file pointer
    168: -   format - the usual printf() format string

    170:     Level: intermediate

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

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

    178:     Contributed by: Matthew Knepley

    180: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
    181:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    183: @*/
    184: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
    185: {
    187:   PetscMPIInt    rank;

    190:   MPI_Comm_rank(comm,&rank);
    191:
    192:   /* First processor prints immediately to fp */
    193:   if (!rank) {
    194:     va_list Argp;
    195:     va_start(Argp,format);
    196:     PetscVFPrintf(fp,format,Argp);
    197:     fflush(fp);
    198:     queuefile = fp;
    199:     if (petsc_history) {
    200:       PetscVFPrintf(petsc_history,format,Argp);
    201:       fflush(petsc_history);
    202:     }
    203:     va_end(Argp);
    204:   } else { /* other processors add to local queue */
    205:     va_list     Argp;
    206:     PrintfQueue next;
    207:     PetscNew(struct _PrintfQueue,&next);
    208:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
    209:     else       {queuebase   = queue = next;}
    210:     queuelength++;
    211:     va_start(Argp,format);
    212:     PetscMemzero(next->string,QUEUESTRINGSIZE);
    213:     PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
    214:     va_end(Argp);
    215:   }
    216:   return(0);
    217: }

    221: /*@C
    222:     PetscSynchronizedFlush - Flushes to the screen output from all processors
    223:     involved in previous PetscSynchronizedPrintf() calls.

    225:     Collective on MPI_Comm

    227:     Input Parameters:
    228: .   comm - the communicator

    230:     Level: intermediate

    232:     Notes:
    233:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
    234:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

    236: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
    237:           PetscViewerASCIISynchronizedPrintf()
    238: @*/
    239: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFlush(MPI_Comm comm)
    240: {
    242:   PetscMPIInt    rank,size,tag,i,j,n;
    243:   char           message[QUEUESTRINGSIZE];
    244:   MPI_Status     status;
    245:   FILE           *fd;

    248:   PetscCommDuplicate(comm,&comm,&tag);
    249:   MPI_Comm_rank(comm,&rank);
    250:   MPI_Comm_size(comm,&size);

    252:   /* First processor waits for messages from all other processors */
    253:   if (!rank) {
    254:     if (queuefile) {
    255:       fd = queuefile;
    256:     } else {
    257:       fd = stdout;
    258:     }
    259:     for (i=1; i<size; i++) {
    260:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
    261:       for (j=0; j<n; j++) {
    262:         MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
    263:         fprintf(fd,"%s",message);
    264:         if (petsc_history) {
    265:           fprintf(petsc_history,"%s",message);
    266:         }
    267:       }
    268:     }
    269:     fflush(fd);
    270:     if (petsc_history) fflush(petsc_history);
    271:     queuefile = PETSC_NULL;
    272:   } else { /* other processors send queue to processor 0 */
    273:     PrintfQueue next = queuebase,previous;

    275:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
    276:     for (i=0; i<queuelength; i++) {
    277:       MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
    278:       previous = next;
    279:       next     = next->next;
    280:       PetscFree(previous);
    281:     }
    282:     queue       = 0;
    283:     queuelength = 0;
    284:   }
    285:   PetscCommDestroy(&comm);
    286:   return(0);
    287: }

    289: /* ---------------------------------------------------------------------------------------*/

    293: /*@C
    294:     PetscFPrintf - Prints to a file, only from the first
    295:     processor in the communicator.

    297:     Not Collective

    299:     Input Parameters:
    300: +   comm - the communicator
    301: .   fd - the file pointer
    302: -   format - the usual printf() format string

    304:     Level: intermediate

    306:     Fortran Note:
    307:     This routine is not supported in Fortran.

    309:    Concepts: printing^in parallel
    310:    Concepts: printf^in parallel

    312: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
    313:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
    314: @*/
    315: PetscErrorCode PETSC_DLLEXPORT PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
    316: {
    318:   PetscMPIInt    rank;

    321:   MPI_Comm_rank(comm,&rank);
    322:   if (!rank) {
    323:     va_list Argp;
    324:     va_start(Argp,format);
    325:     PetscVFPrintf(fd,format,Argp);
    326:     fflush(fd);
    327:     if (petsc_history) {
    328:       PetscVFPrintf(petsc_history,format,Argp);
    329:       fflush(petsc_history);
    330:     }
    331:     va_end(Argp);
    332:   }
    333:   return(0);
    334: }

    338: /*@C
    339:     PetscPrintf - Prints to standard out, only from the first
    340:     processor in the communicator.

    342:     Not Collective

    344:     Input Parameters:
    345: +   comm - the communicator
    346: -   format - the usual printf() format string

    348:    Level: intermediate

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

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

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

    360: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
    361: @*/
    362: PetscErrorCode PETSC_DLLEXPORT PetscPrintf(MPI_Comm comm,const char format[],...)
    363: {
    365:   PetscMPIInt    rank;
    366:   size_t         len;
    367:   char           *nformat,*sub1,*sub2;
    368:   PetscReal      value;

    371:   if (!comm) comm = PETSC_COMM_WORLD;
    372:   MPI_Comm_rank(comm,&rank);
    373:   if (!rank) {
    374:     va_list Argp;
    375:     va_start(Argp,format);

    377:     PetscStrstr(format,"%A",&sub1);
    378:     if (sub1) {
    379:       PetscStrstr(format,"%",&sub2);
    380:       if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
    381:       PetscStrlen(format,&len);
    382:       PetscMalloc((len+16)*sizeof(char),&nformat);
    383:       PetscStrcpy(nformat,format);
    384:       PetscStrstr(nformat,"%",&sub2);
    385:       sub2[0] = 0;
    386:       value   = (double)va_arg(Argp,double);
    387:       if (PetscAbsReal(value) < 1.e-12) {
    388:         PetscStrcat(nformat,"< 1.e-12");
    389:       } else {
    390:         PetscStrcat(nformat,"%g");
    391:         va_end(Argp);
    392:         va_start(Argp,format);
    393:       }
    394:       PetscStrcat(nformat,sub1+2);
    395:     } else {
    396:       nformat = (char*)format;
    397:     }
    398:     PetscVFPrintf(stdout,nformat,Argp);
    399:     fflush(stdout);
    400:     if (petsc_history) {
    401:       PetscVFPrintf(petsc_history,nformat,Argp);
    402:       fflush(petsc_history);
    403:     }
    404:     va_end(Argp);
    405:     if (sub1) {PetscFree(nformat);}
    406:   }
    407:   return(0);
    408: }

    410: /* ---------------------------------------------------------------------------------------*/
    413: PetscErrorCode PETSC_DLLEXPORT PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
    414: {
    416:   PetscMPIInt    rank;

    419:   if (!comm) comm = PETSC_COMM_WORLD;
    420:   MPI_Comm_rank(comm,&rank);
    421:   if (!rank) {
    422:     va_list Argp;
    423:     va_start(Argp,format);
    424:     PetscVFPrintf(stdout,format,Argp);
    425:     fflush(stdout);
    426:     if (petsc_history) {
    427:       PetscVFPrintf(petsc_history,format,Argp);
    428:       fflush(petsc_history);
    429:     }
    430:     va_end(Argp);
    431:   }
    432:   return(0);
    433: }

    435: /* ---------------------------------------------------------------------------------------*/

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

    442: /*
    443:    Initializes arch, hostname, username,date so that system calls do NOT need
    444:    to be made during the error handler.
    445: */
    446: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfInitialize()
    447: {

    451:   PetscGetArchType(arch,10);
    452:   PetscGetHostName(hostname,64);
    453:   PetscGetUserName(username,16);
    454:   PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);
    455:   PetscGetDate(date,64);
    456:   PetscErrorPrintfInitializeCalled = PETSC_TRUE;
    457:   return(0);
    458: }

    463: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfDefault(const char format[],...)
    464: {
    465:   va_list            Argp;
    466:   static  PetscTruth PetscErrorPrintfCalled    = PETSC_FALSE;
    467:   static  PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
    468:   static  FILE       *fd;
    469:   char               version[256];
    470:   PetscErrorCode     ierr;

    472:   /*
    473:       InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
    474:      from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
    475:   */

    477:   /*
    479:     it may be called by PetscStackView().

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

    484:   if (!PetscErrorPrintfCalled) {
    485:     PetscTruth use_stderr;

    487:     PetscErrorPrintfCalled    = PETSC_TRUE;
    488:     InPetscErrorPrintfDefault = PETSC_TRUE;

    490:     PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
    491:     if (use_stderr) {
    492:       fd = stderr;
    493:     } else {
    494:       fd = stdout;
    495:     }

    497:     /*
    498:         On the SGI machines and Cray T3E, if errors are generated  "simultaneously" by
    499:       different processors, the messages are printed all jumbled up; to try to
    500:       prevent this we have each processor wait based on their rank
    501:     */
    502: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
    503:     {
    504:       PetscMPIInt rank;
    505:       if (PetscGlobalRank > 8) rank = 8; else rank = PetscGlobalRank;
    506:       PetscSleep(rank);
    507:     }
    508: #endif
    509:
    510:     PetscGetVersion(&version);

    512:     fprintf(fd,"--------------------------------------------\
    513: ------------------------------\n");
    514:     fprintf(fd,"%s\n",version);
    515:     fprintf(fd,"See docs/changes/index.html for recent updates.\n");
    516:     fprintf(fd,"See docs/faq.html for hints about trouble shooting.\n");
    517:     fprintf(fd,"See docs/index.html for manual pages.\n");
    518:     fprintf(fd,"--------------------------------------------\
    519: ---------------------------\n");
    520:     if (PetscErrorPrintfInitializeCalled) {
    521:       fprintf(fd,"%s on a %s named %s by %s %s\n",pname,arch,hostname,username,date);
    522:     }
    523:     fprintf(fd,"Libraries linked from %s\n",PETSC_LIB_DIR);
    524:     fprintf(fd,"Configure run at %s\n",PETSC_CONFIGURE_RUN_TIME);
    525:     fprintf(fd,"Configure options %s\n",PETSC_CONFIGURE_OPTIONS);
    526:     fprintf(fd,"--------------------------------------------\
    527: ---------------------------\n");
    528:     fflush(fd);
    529:     InPetscErrorPrintfDefault = PETSC_FALSE;
    530:   }

    532:   if (!InPetscErrorPrintfDefault) {
    533:     va_start(Argp,format);
    534:     fprintf(fd,"[%d]PETSC ERROR: ",PetscGlobalRank);
    535:     PetscVFPrintf(fd,format,Argp);
    536:     fflush(fd);
    537:     va_end(Argp);
    538:   }
    539:   return 0;
    540: }

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

    547:     Collective on MPI_Comm

    549:     Input Parameters:
    550: +   comm - the communicator
    551: .   fd - the file pointer
    552: -   len - the length of the output buffer

    554:     Output Parameter:
    555: .   string - the line read from the file

    557:     Level: intermediate

    559: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
    560:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

    562: @*/
    563: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
    564: {
    566:   PetscMPIInt    rank;

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