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: }