Actual source code: mprint.c

  1: /*$Id: mprint.c,v 1.64 2001/08/28 01:01:27 bsmith Exp $*/
  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: */
 10: extern FILE *petsc_history;

 12: /* ----------------------------------------------------------------------- */

 14: PrintfQueue queue       = 0,queuebase = 0;
 15: int         queuelength = 0;
 16: FILE        *queuefile  = PETSC_NULL;

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

 22:     Not Collective

 24:     Input Parameters:
 25: +   comm - the communicator
 26: -   format - the usual printf() format string 

 28:    Level: intermediate

 30:     Notes:
 31:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
 32:     from all the processors to be printed.

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

 36: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
 37:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
 38: @*/
 39: int PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
 40: {
 41:   int ierr,rank;

 44:   MPI_Comm_rank(comm,&rank);
 45: 
 46:   /* First processor prints immediately to stdout */
 47:   if (!rank) {
 48:     va_list Argp;
 49:     va_start(Argp,format);
 50: #if defined(PETSC_HAVE_VPRINTF_CHAR)
 51:     vfprintf(stdout,format,(char*)Argp);
 52: #else
 53:     vfprintf(stdout,format,Argp);
 54: #endif
 55:     fflush(stdout);
 56:     if (petsc_history) {
 57: #if defined(PETSC_HAVE_VPRINTF_CHAR)
 58:       vfprintf(petsc_history,format,(char *)Argp);
 59: #else
 60:       vfprintf(petsc_history,format,Argp);
 61: #endif
 62:       fflush(petsc_history);
 63:     }
 64:     va_end(Argp);
 65:   } else { /* other processors add to local queue */
 66:     int         len;
 67:     va_list     Argp;
 68:     PrintfQueue next;

 70:     PetscNew(struct _PrintfQueue,&next);
 71:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
 72:     else       {queuebase   = queue = next;}
 73:     queuelength++;
 74:     va_start(Argp,format);
 75: #if defined(PETSC_HAVE_VPRINTF_CHAR)
 76:     vsprintf(next->string,format,(char *)Argp);
 77: #else
 78:     vsprintf(next->string,format,Argp);
 79: #endif
 80:     va_end(Argp);
 81:     PetscStrlen(next->string,&len);
 82:     if (len > QUEUESTRINGSIZE) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Formatted string longer than %d bytes",QUEUESTRINGSIZE);
 83:   }
 84: 
 85:   return(0);
 86: }
 87: 
 88: /*@C
 89:     PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
 90:     several processors.  Output of the first processor is followed by that of the 
 91:     second, etc.

 93:     Not Collective

 95:     Input Parameters:
 96: +   comm - the communicator
 97: .   fd - the file pointer
 98: -   format - the usual printf() format string 

100:     Level: intermediate

102:     Notes:
103:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
104:     from all the processors to be printed.

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

108:     Contributed by: Matthew Knepley

110: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
111:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

113: @*/
114: int PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
115: {
116:   int ierr,rank;

119:   MPI_Comm_rank(comm,&rank);
120: 
121:   /* First processor prints immediately to fp */
122:   if (!rank) {
123:     va_list Argp;
124:     va_start(Argp,format);
125: #if defined(PETSC_HAVE_VPRINTF_CHAR)
126:     vfprintf(fp,format,(char*)Argp);
127: #else
128:     vfprintf(fp,format,Argp);
129: #endif
130:     fflush(fp);
131:     queuefile = fp;
132:     if (petsc_history) {
133: #if defined(PETSC_HAVE_VPRINTF_CHAR)
134:       vfprintf(petsc_history,format,(char *)Argp);
135: #else
136:       vfprintf(petsc_history,format,Argp);
137: #endif
138:       fflush(petsc_history);
139:     }
140:     va_end(Argp);
141:   } else { /* other processors add to local queue */
142:     int         len;
143:     va_list     Argp;
144:     PrintfQueue next;
145:     PetscNew(struct _PrintfQueue,&next);
146:     if (queue) {queue->next = next; queue = next; queue->next = 0;}
147:     else       {queuebase   = queue = next;}
148:     queuelength++;
149:     va_start(Argp,format);
150: #if defined(PETSC_HAVE_VPRINTF_CHAR)
151:     vsprintf(next->string,format,(char *)Argp);
152: #else
153:     vsprintf(next->string,format,Argp);
154: #endif
155:     va_end(Argp);
156:     PetscStrlen(next->string,&len);
157:     if (len > QUEUESTRINGSIZE) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Formatted string longer then %d bytes",QUEUESTRINGSIZE);
158:   }
159: 
160:   return(0);
161: }

163: /*@C
164:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
165:     involved in previous PetscSynchronizedPrintf() calls.

167:     Collective on MPI_Comm

169:     Input Parameters:
170: .   comm - the communicator

172:     Level: intermediate

174:     Notes:
175:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
176:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

178: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
179:           PetscViewerASCIISynchronizedPrintf()
180: @*/
181: int PetscSynchronizedFlush(MPI_Comm comm)
182: {
183:   int        rank,size,i,j,n,tag,ierr;
184:   char       message[QUEUESTRINGSIZE];
185:   MPI_Status status;
186:   FILE       *fd;

189:   MPI_Comm_rank(comm,&rank);
190:   MPI_Comm_size(comm,&size);

192:   PetscCommGetNewTag(comm,&tag);
193:   /* First processor waits for messages from all other processors */
194:   if (!rank) {
195:     if (queuefile) {
196:       fd = queuefile;
197:     } else {
198:       fd = stdout;
199:     }
200:     for (i=1; i<size; i++) {
201:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
202:       for (j=0; j<n; j++) {
203:         MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
204:         fprintf(fd,"%s",message);
205:         if (petsc_history) {
206:           fprintf(petsc_history,"%s",message);
207:         }
208:       }
209:     }
210:     fflush(fd);
211:     if (petsc_history) fflush(petsc_history);
212:     queuefile = PETSC_NULL;
213:   } else { /* other processors send queue to processor 0 */
214:     PrintfQueue next = queuebase,previous;

216:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
217:     for (i=0; i<queuelength; i++) {
218:       ierr     = MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
219:       previous = next;
220:       next     = next->next;
221:       ierr     = PetscFree(previous);
222:     }
223:     queue       = 0;
224:     queuelength = 0;
225:   }
226:   return(0);
227: }

229: /* ---------------------------------------------------------------------------------------*/

231: /*@C
232:     PetscFPrintf - Prints to a file, only from the first
233:     processor in the communicator.

235:     Not Collective

237:     Input Parameters:
238: +   comm - the communicator
239: .   fd - the file pointer
240: -   format - the usual printf() format string 

242:     Level: intermediate

244:     Fortran Note:
245:     This routine is not supported in Fortran.

247:    Concepts: printing^in parallel
248:    Concepts: printf^in parallel

250: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
251:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
252: @*/
253: int PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
254: {
255:   int rank,ierr;

258:   MPI_Comm_rank(comm,&rank);
259:   if (!rank) {
260:     va_list Argp;
261:     va_start(Argp,format);
262: #if defined(PETSC_HAVE_VPRINTF_CHAR)
263:     vfprintf(fd,format,(char*)Argp);
264: #else
265:     vfprintf(fd,format,Argp);
266: #endif
267:     fflush(fd);
268:     if (petsc_history) {
269: #if defined(PETSC_HAVE_VPRINTF_CHAR)
270:       vfprintf(petsc_history,format,(char *)Argp);
271: #else
272:       vfprintf(petsc_history,format,Argp);
273: #endif
274:       fflush(petsc_history);
275:     }
276:     va_end(Argp);
277:   }
278:   return(0);
279: }

281: /*@C
282:     PetscPrintf - Prints to standard out, only from the first
283:     processor in the communicator.

285:     Not Collective

287:     Input Parameters:
288: +   comm - the communicator
289: -   format - the usual printf() format string 

291:    Level: intermediate

293:     Fortran Note:
294:     This routine is not supported in Fortran.

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

299:    Concepts: printing^in parallel
300:    Concepts: printf^in parallel

302: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
303: @*/
304: int PetscPrintf(MPI_Comm comm,const char format[],...)
305: {
306:   int       rank,ierr,len;
307:   char      *nformat,*sub1,*sub2;
308:   PetscReal value;

311:   if (!comm) comm = PETSC_COMM_WORLD;
312:   MPI_Comm_rank(comm,&rank);
313:   if (!rank) {
314:     va_list Argp;
315:     va_start(Argp,format);

317:     PetscStrstr(format,"%A",&sub1);
318:     if (sub1) {
319:       PetscStrstr(format,"%",&sub2);
320:       if (sub1 != sub2) SETERRQ(1,"%%A format must be first in format string");
321:       ierr    = PetscStrlen(format,&len);
322:       ierr    = PetscMalloc((len+16)*sizeof(char),&nformat);
323:       ierr    = PetscStrcpy(nformat,format);
324:       ierr    = PetscStrstr(nformat,"%",&sub2);
325:       sub2[0] = 0;
326:       value   = (double)va_arg(Argp,double);
327:       if (PetscAbsReal(value) < 1.e-12) {
328:         ierr    = PetscStrcat(nformat,"< 1.e-12");
329:       } else {
330:         ierr    = PetscStrcat(nformat,"%g");
331:         va_end(Argp);
332:         va_start(Argp,format);
333:       }
334:       ierr    = PetscStrcat(nformat,sub1+2);
335:     } else {
336:       nformat = (char*)format;
337:     }
338: #if defined(PETSC_HAVE_VPRINTF_CHAR)
339:     vfprintf(stdout,nformat,(char *)Argp);
340: #else
341:     vfprintf(stdout,nformat,Argp);
342: #endif
343:     fflush(stdout);
344:     if (petsc_history) {
345: #if defined(PETSC_HAVE_VPRINTF_CHAR)
346:       vfprintf(petsc_history,nformat,(char *)Argp);
347: #else
348:       vfprintf(petsc_history,nformat,Argp);
349: #endif
350:       fflush(petsc_history);
351:     }
352:     va_end(Argp);
353:     if (sub1) {PetscFree(nformat);}
354:   }
355:   return(0);
356: }

358: /* ---------------------------------------------------------------------------------------*/
359: int PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
360: {
361:   int rank,ierr;

364:   if (!comm) comm = PETSC_COMM_WORLD;
365:   MPI_Comm_rank(comm,&rank);
366:   if (!rank) {
367:     va_list Argp;
368:     va_start(Argp,format);
369: #if defined(PETSC_HAVE_VPRINTF_CHAR)
370:     vfprintf(stdout,format,(char *)Argp);
371: #else
372:     vfprintf(stdout,format,Argp);
373: #endif
374:     fflush(stdout);
375:     if (petsc_history) {
376: #if defined(PETSC_HAVE_VPRINTF_CHAR)
377:       vfprintf(petsc_history,format,(char *)Argp);
378: #else
379:       vfprintf(petsc_history,format,Argp);
380: #endif
381:       fflush(petsc_history);
382:     }
383:     va_end(Argp);
384:   }
385:   return(0);
386: }

388: /* ---------------------------------------------------------------------------------------*/
389: /*MC
390:     PetscErrorPrintf - Prints error messages.

392:     Not Collective

394:    Synopsis:
395:      int (*PetscErrorPrintf)(const char format[],...);

397:     Input Parameters:
398: .   format - the usual printf() format string 

400:    Level: developer

402:     Fortran Note:
403:     This routine is not supported in Fortran.

405:     Concepts: error messages^printing
406:     Concepts: printing^error messages

408: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscHelpPrintf()
409: M*/

411: /*MC
412:     PetscHelpPrintf - Prints help messages.

414:     Not Collective

416:    Synopsis:
417:      int (*PetscHelpPrintf)(const char format[],...);

419:     Input Parameters:
420: .   format - the usual printf() format string 

422:    Level: developer

424:     Fortran Note:
425:     This routine is not supported in Fortran.

427:     Concepts: help messages^printing
428:     Concepts: printing^help messages

430: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscErrorPrintf()
431: M*/

433: int PetscErrorPrintfDefault(const char format[],...)
434: {
435:   va_list            Argp;
436:   static  PetscTruth PetscErrorPrintfCalled    = PETSC_FALSE;
437:   static  PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
438:   static  FILE       *fd;
439:   char               version[256];
440:   /*
441:       InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
442:      from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
443:   */

445:   /*
447:     it may be called by PetscStackView().

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

452:   if (!PetscErrorPrintfCalled) {
453:     char       arch[10],hostname[64],username[16],pname[256],date[64];
454:     PetscTruth use_stderr;

456:     PetscErrorPrintfCalled    = PETSC_TRUE;
457:     InPetscErrorPrintfDefault = PETSC_TRUE;

459:     PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
460:     if (use_stderr) {
461:       fd = stderr;
462:     } else {
463:       fd = stdout;
464:     }

466:     /*
467:         On the SGI machines and Cray T3E, if errors are generated  "simultaneously" by
468:       different processors, the messages are printed all jumbled up; to try to 
469:       prevent this we have each processor wait based on their rank
470:     */
471: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
472:     {
473:       int        rank;
474:       MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
475:       if (rank > 8) rank = 8;
476:       PetscSleep(rank);
477:     }
478: #endif
479: 
480:     PetscGetVersion(&version);

482:     /* Cannot do error checking on these calls because we are called by error handler */
483:     PetscGetArchType(arch,10);
484:     PetscGetHostName(hostname,64);
485:     PetscGetUserName(username,16);
486:     PetscGetProgramName(pname,256);
487:     PetscGetInitialDate(date,64);
488:     fprintf(fd,"--------------------------------------------
489: ------------------------------n");
490:     fprintf(fd,"%sn",version);
491:     fprintf(fd,"%sn",PETSC_AUTHOR_INFO);
492:     fprintf(fd,"See docs/copyright.html for copyright information.n");
493:     fprintf(fd,"See docs/changes.html for recent updates.n");
494:     fprintf(fd,"See docs/troubleshooting.html for hints about trouble shooting.n");
495:     fprintf(fd,"See docs/manualpages/index.html for manual pages.n");
496:     fprintf(fd,"--------------------------------------------
497: ---------------------------n");
498:     fprintf(fd,"%s on a %s named %s by %s %sn",pname,arch,hostname,username,date);
499: #if !defined (PARCH_win32)
500:     fprintf(fd,"Libraries linked from %sn",PETSC_LIB_DIR);
501: #endif
502:     fprintf(fd,"--------------------------------------------
503: ---------------------------n");
504:     fflush(fd);
505:     InPetscErrorPrintfDefault = PETSC_FALSE;
506:   }

508:   if (!InPetscErrorPrintfDefault) {
509:     va_start(Argp,format);
510: #if defined(PETSC_HAVE_VPRINTF_CHAR)
511:     vfprintf(fd,format,(char *)Argp);
512: #else
513:     vfprintf(fd,format,Argp);
514: #endif
515:     fflush(fd);
516:     va_end(Argp);
517:   }
518:   return 0;
519: }

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

524:     Collective on MPI_Comm

526:     Input Parameters:
527: +   comm - the communicator
528: .   fd - the file pointer
529: -   len - the lenght of the output buffer

531:     Output Parameter:
532: .   string - the line read from the file

534:     Level: intermediate

536: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 
537:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

539: @*/
540: int PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,int len,char string[])
541: {
542:   int ierr,rank;

545:   MPI_Comm_rank(comm,&rank);
546: 
547:   /* First processor prints immediately to fp */
548:   if (!rank) {
549:     fgets(string,len,fp);
550:   }
551:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
552:   return(0);
553: }