Actual source code: mprint.c

  1: /*$Id: mprint.c,v 1.60 2001/04/05 21:06:46 balay 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 charactors.

 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_VFPRINTF_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_VFPRINTF_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_VFPRINTF_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 charactors.

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 (PetscAbsDouble(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: /*@C
360:     PetscHelpPrintfDefault - Prints to standard out, only from the first
361:     processor in the communicator.

363:     Not Collective

365:     Input Parameters:
366: +   comm - the communicator
367: -   format - the usual printf() format string 

369:    Level: developer

371:     Fortran Note:
372:     This routine is not supported in Fortran.

374:     Concepts: help messages^printing
375:     Concepts: printing^help messages

377: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
378: @*/
379: int PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
380: {
381:   int rank,ierr;

384:   if (!comm) comm = PETSC_COMM_WORLD;
385:   MPI_Comm_rank(comm,&rank);
386:   if (!rank) {
387:     va_list Argp;
388:     va_start(Argp,format);
389: #if defined(PETSC_HAVE_VPRINTF_CHAR)
390:     vfprintf(stdout,format,(char *)Argp);
391: #else
392:     vfprintf(stdout,format,Argp);
393: #endif
394:     fflush(stdout);
395:     if (petsc_history) {
396: #if defined(PETSC_HAVE_VPRINTF_CHAR)
397:       vfprintf(petsc_history,format,(char *)Argp);
398: #else
399:       vfprintf(petsc_history,format,Argp);
400: #endif
401:       fflush(petsc_history);
402:     }
403:     va_end(Argp);
404:   }
405:   return(0);
406: }

408: /* ---------------------------------------------------------------------------------------*/
409: /*@C
410:     PetscErrorPrintfDefault - Prints error messages.

412:     Not Collective

414:     Input Parameters:
415: .   format - the usual printf() format string 

417:    Level: developer

419:     Fortran Note:
420:     This routine is not supported in Fortran.

422:     Concepts: error messages^printing
423:     Concepts: printing^error messages

425: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
426: @*/
427: int PetscErrorPrintfDefault(const char format[],...)
428: {
429:   va_list            Argp;
430:   static  PetscTruth PetscErrorPrintfCalled    = PETSC_FALSE;
431:   static  PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
432:   static  FILE       *fd;
433:   /*
434:       InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
435:      from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
436:   */

438:   /*
440:     it may be called by PetscStackView().

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

445:   if (!PetscErrorPrintfCalled) {
446:     char       arch[10],hostname[64],username[16],pname[256],date[64];
447:     PetscTruth use_stderr;

449:     PetscErrorPrintfCalled    = PETSC_TRUE;
450:     InPetscErrorPrintfDefault = PETSC_TRUE;

452:     PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
453:     if (use_stderr) {
454:       fd = stderr;
455:     } else {
456:       fd = stdout;
457:     }

459:     /*
460:         On the SGI machines and Cray T3E, if errors are generated  "simultaneously" by
461:       different processors, the messages are printed all jumbled up; to try to 
462:       prevent this we have each processor wait based on their rank
463:     */
464: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
465:     {
466:       int        rank;
467:       MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
468:       if (rank > 8) rank = 8;
469:       PetscSleep(rank);
470:     }
471: #endif

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

499:   if (!InPetscErrorPrintfDefault) {
500:     va_start(Argp,format);
501: #if defined(PETSC_HAVE_VPRINTF_CHAR)
502:     vfprintf(fd,format,(char *)Argp);
503: #else
504:     vfprintf(fd,format,Argp);
505: #endif
506:     fflush(fd);
507:     va_end(Argp);
508:   }
509:   return 0;
510: }

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

515:     Collective on MPI_Comm

517:     Input Parameters:
518: +   comm - the communicator
519: .   fd - the file pointer
520: -   len - the lenght of the output buffer

522:     Output Parameter:
523: .   string - the line read from the file

525:     Level: intermediate

527: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 
528:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

530: @*/
531: int PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,int len,char string[])
532: {
533:   int ierr,rank;

536:   MPI_Comm_rank(comm,&rank);
537: 
538:   /* First processor prints immediately to fp */
539:   if (!rank) {
540:     fgets(string,len,fp);
541:   }
542:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
543:   return(0);
544: }