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;

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

 24:     Not Collective

 26:     Input Parameters:
 27: +   comm - the communicator
 28: -   format - the usual printf() format string 

 30:    Level: intermediate

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

 36:     Fortran Note:
 37:     The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), int ierr) from Fortran. 
 38:     That is, you can only pass a single character string from Fortran.

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

 42: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 
 43:           PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
 44: @*/
 45: int PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
 46: {
 47:   int ierr,rank;

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

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

101:     Not Collective

103:     Input Parameters:
104: +   comm - the communicator
105: .   fd - the file pointer
106: -   format - the usual printf() format string 

108:     Level: intermediate

110:     Notes:
111:     REQUIRES a intervening call to PetscSynchronizedFlush() for the information 
112:     from all the processors to be printed.

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

116:     Contributed by: Matthew Knepley

118: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
119:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

121: @*/
122: int PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
123: {
124:   int ierr,rank;

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

173: /*@C
174:     PetscSynchronizedFlush - Flushes to the screen output from all processors 
175:     involved in previous PetscSynchronizedPrintf() calls.

177:     Collective on MPI_Comm

179:     Input Parameters:
180: .   comm - the communicator

182:     Level: intermediate

184:     Notes:
185:     Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
186:     different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().

188: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
189:           PetscViewerASCIISynchronizedPrintf()
190: @*/
191: int PetscSynchronizedFlush(MPI_Comm comm)
192: {
193:   int        rank,size,i,j,n,tag,ierr;
194:   char       message[QUEUESTRINGSIZE];
195:   MPI_Status status;
196:   FILE       *fd;

199:   MPI_Comm_rank(comm,&rank);
200:   MPI_Comm_size(comm,&size);

202:   PetscCommGetNewTag(comm,&tag);
203:   /* First processor waits for messages from all other processors */
204:   if (!rank) {
205:     if (queuefile) {
206:       fd = queuefile;
207:     } else {
208:       fd = stdout;
209:     }
210:     for (i=1; i<size; i++) {
211:       MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
212:       for (j=0; j<n; j++) {
213:         MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
214:         fprintf(fd,"%s",message);
215:         if (petsc_history) {
216:           fprintf(petsc_history,"%s",message);
217:         }
218:       }
219:     }
220:     fflush(fd);
221:     if (petsc_history) fflush(petsc_history);
222:     queuefile = PETSC_NULL;
223:   } else { /* other processors send queue to processor 0 */
224:     PrintfQueue next = queuebase,previous;

226:     MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
227:     for (i=0; i<queuelength; i++) {
228:       MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
229:       previous = next;
230:       next     = next->next;
231:       PetscFree(previous);
232:     }
233:     queue       = 0;
234:     queuelength = 0;
235:   }
236:   return(0);
237: }

239: /* ---------------------------------------------------------------------------------------*/

243: /*@C
244:     PetscFPrintf - Prints to a file, only from the first
245:     processor in the communicator.

247:     Not Collective

249:     Input Parameters:
250: +   comm - the communicator
251: .   fd - the file pointer
252: -   format - the usual printf() format string 

254:     Level: intermediate

256:     Fortran Note:
257:     This routine is not supported in Fortran.

259:    Concepts: printing^in parallel
260:    Concepts: printf^in parallel

262: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
263:           PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
264: @*/
265: int PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
266: {
267:   int rank,ierr;

270:   MPI_Comm_rank(comm,&rank);
271:   if (!rank) {
272:     va_list Argp;
273:     va_start(Argp,format);
274: #if defined(PETSC_HAVE_VPRINTF_CHAR)
275:     vfprintf(fd,format,(char*)Argp);
276: #else
277:     vfprintf(fd,format,Argp);
278: #endif
279:     fflush(fd);
280:     if (petsc_history) {
281: #if defined(PETSC_HAVE_VPRINTF_CHAR)
282:       vfprintf(petsc_history,format,(char *)Argp);
283: #else
284:       vfprintf(petsc_history,format,Argp);
285: #endif
286:       fflush(petsc_history);
287:     }
288:     va_end(Argp);
289:   }
290:   return(0);
291: }

295: /*@C
296:     PetscPrintf - Prints to standard out, only from the first
297:     processor in the communicator.

299:     Not Collective

301:     Input Parameters:
302: +   comm - the communicator
303: -   format - the usual printf() format string 

305:    Level: intermediate

307:     Fortran Note:
308:     The call sequence is PetscPrintf(PetscViewer, character(*), int ierr) from Fortran. 
309:     That is, you can only pass a single character string from Fortran.

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

314:    Concepts: printing^in parallel
315:    Concepts: printf^in parallel

317: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
318: @*/
319: int PetscPrintf(MPI_Comm comm,const char format[],...)
320: {
321:   int       rank,ierr,len;
322:   char      *nformat,*sub1,*sub2;
323:   PetscReal value;

326:   if (!comm) comm = PETSC_COMM_WORLD;
327:   MPI_Comm_rank(comm,&rank);
328:   if (!rank) {
329:     va_list Argp;
330:     va_start(Argp,format);

332:     PetscStrstr(format,"%A",&sub1);
333:     if (sub1) {
334:       PetscStrstr(format,"%",&sub2);
335:       if (sub1 != sub2) SETERRQ(1,"%%A format must be first in format string");
336:       PetscStrlen(format,&len);
337:       PetscMalloc((len+16)*sizeof(char),&nformat);
338:       PetscStrcpy(nformat,format);
339:       PetscStrstr(nformat,"%",&sub2);
340:       sub2[0] = 0;
341:       value   = (double)va_arg(Argp,double);
342:       if (PetscAbsReal(value) < 1.e-12) {
343:         PetscStrcat(nformat,"< 1.e-12");
344:       } else {
345:         PetscStrcat(nformat,"%g");
346:         va_end(Argp);
347:         va_start(Argp,format);
348:       }
349:       PetscStrcat(nformat,sub1+2);
350:     } else {
351:       nformat = (char*)format;
352:     }
353: #if defined(PETSC_HAVE_VPRINTF_CHAR)
354:     vfprintf(stdout,nformat,(char *)Argp);
355: #else
356:     vfprintf(stdout,nformat,Argp);
357: #endif
358:     fflush(stdout);
359:     if (petsc_history) {
360: #if defined(PETSC_HAVE_VPRINTF_CHAR)
361:       vfprintf(petsc_history,nformat,(char *)Argp);
362: #else
363:       vfprintf(petsc_history,nformat,Argp);
364: #endif
365:       fflush(petsc_history);
366:     }
367:     va_end(Argp);
368:     if (sub1) {PetscFree(nformat);}
369:   }
370:   return(0);
371: }

373: /* ---------------------------------------------------------------------------------------*/
376: int PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
377: {
378:   int rank,ierr;

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

405: /* ---------------------------------------------------------------------------------------*/

409: int PetscErrorPrintfDefault(const char format[],...)
410: {
411:   va_list            Argp;
412:   static  PetscTruth PetscErrorPrintfCalled    = PETSC_FALSE;
413:   static  PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
414:   static  FILE       *fd;
415:   char               version[256];
416:   /*
417:       InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
418:      from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
419:   */

421:   /*
423:     it may be called by PetscStackView().

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

428:   if (!PetscErrorPrintfCalled) {
429:     char       arch[10],hostname[64],username[16],pname[PETSC_MAX_PATH_LEN],date[64];
430:     PetscTruth use_stderr;

432:     PetscErrorPrintfCalled    = PETSC_TRUE;
433:     InPetscErrorPrintfDefault = PETSC_TRUE;

435:     PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
436:     if (use_stderr) {
437:       fd = stderr;
438:     } else {
439:       fd = stdout;
440:     }

442:     /*
443:         On the SGI machines and Cray T3E, if errors are generated  "simultaneously" by
444:       different processors, the messages are printed all jumbled up; to try to 
445:       prevent this we have each processor wait based on their rank
446:     */
447: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
448:     {
449:       int        rank;
450:       MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
451:       if (rank > 8) rank = 8;
452:       PetscSleep(rank);
453:     }
454: #endif
455: 
456:     PetscGetVersion(&version);

458:     /* Cannot do error checking on these calls because we are called by error handler */
459:     PetscGetArchType(arch,10);
460:     PetscGetHostName(hostname,64);
461:     PetscGetUserName(username,16);
462:     PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);
463:     PetscGetInitialDate(date,64);
464:     fprintf(fd,"--------------------------------------------\
465: ------------------------------\n");
466:     fprintf(fd,"%s\n",version);
467:     fprintf(fd,"%s\n",PETSC_AUTHOR_INFO);
468:     fprintf(fd,"See docs/changes/index.html for recent updates.\n");
469:     fprintf(fd,"See docs/troubleshooting.html for hints about trouble shooting.\n");
470:     fprintf(fd,"See docs/index.html for manual pages.\n");
471:     fprintf(fd,"--------------------------------------------\
472: ---------------------------\n");
473:     fprintf(fd,"%s on a %s named %s by %s %s\n",pname,arch,hostname,username,date);
474: #if !defined (PARCH_win32)
475:     fprintf(fd,"Libraries linked from %s\n",PETSC_LIB_DIR);
476: #endif
477:     fprintf(fd,"--------------------------------------------\
478: ---------------------------\n");
479:     fflush(fd);
480:     InPetscErrorPrintfDefault = PETSC_FALSE;
481:   }

483:   if (!InPetscErrorPrintfDefault) {
484:     va_start(Argp,format);
485: #if defined(PETSC_HAVE_VPRINTF_CHAR)
486:     vfprintf(fd,format,(char *)Argp);
487: #else
488:     vfprintf(fd,format,Argp);
489: #endif
490:     fflush(fd);
491:     va_end(Argp);
492:   }
493:   return 0;
494: }

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

501:     Collective on MPI_Comm

503:     Input Parameters:
504: +   comm - the communicator
505: .   fd - the file pointer
506: -   len - the lenght of the output buffer

508:     Output Parameter:
509: .   string - the line read from the file

511:     Level: intermediate

513: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 
514:           PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()

516: @*/
517: int PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,int len,char string[])
518: {
519:   int ierr,rank;

522:   MPI_Comm_rank(comm,&rank);
523: 
524:   /* First processor prints immediately to fp */
525:   if (!rank) {
526:     fgets(string,len,fp);
527:   }
528:   MPI_Bcast(string,len,MPI_BYTE,0,comm);
529:   return(0);
530: }