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: #undef __FUNCT__
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: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
38: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
39: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
40: @*/
41: int PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
42: {
43: int ierr,rank;
46: MPI_Comm_rank(comm,&rank);
47:
48: /* First processor prints immediately to stdout */
49: if (!rank) {
50: va_list Argp;
51: va_start(Argp,format);
52: #if defined(PETSC_HAVE_VPRINTF_CHAR)
53: vfprintf(stdout,format,(char*)Argp);
54: #else
55: vfprintf(stdout,format,Argp);
56: #endif
57: fflush(stdout);
58: if (petsc_history) {
59: #if defined(PETSC_HAVE_VPRINTF_CHAR)
60: vfprintf(petsc_history,format,(char *)Argp);
61: #else
62: vfprintf(petsc_history,format,Argp);
63: #endif
64: fflush(petsc_history);
65: }
66: va_end(Argp);
67: } else { /* other processors add to local queue */
68: int len;
69: va_list Argp;
70: PrintfQueue next;
72: PetscNew(struct _PrintfQueue,&next);
73: if (queue) {queue->next = next; queue = next; queue->next = 0;}
74: else {queuebase = queue = next;}
75: queuelength++;
76: va_start(Argp,format);
77: #if defined(PETSC_HAVE_VPRINTF_CHAR)
78: vsprintf(next->string,format,(char *)Argp);
79: #else
80: vsprintf(next->string,format,Argp);
81: #endif
82: va_end(Argp);
83: PetscStrlen(next->string,&len);
84: if (len > QUEUESTRINGSIZE) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Formatted string longer than %d bytes",QUEUESTRINGSIZE);
85: }
86:
87: return(0);
88: }
89:
90: #undef __FUNCT__
92: /*@C
93: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
94: several processors. Output of the first processor is followed by that of the
95: second, etc.
97: Not Collective
99: Input Parameters:
100: + comm - the communicator
101: . fd - the file pointer
102: - format - the usual printf() format string
104: Level: intermediate
106: Notes:
107: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
108: from all the processors to be printed.
110: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
112: Contributed by: Matthew Knepley
114: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
115: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
117: @*/
118: int PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
119: {
120: int ierr,rank;
123: MPI_Comm_rank(comm,&rank);
124:
125: /* First processor prints immediately to fp */
126: if (!rank) {
127: va_list Argp;
128: va_start(Argp,format);
129: #if defined(PETSC_HAVE_VPRINTF_CHAR)
130: vfprintf(fp,format,(char*)Argp);
131: #else
132: vfprintf(fp,format,Argp);
133: #endif
134: fflush(fp);
135: queuefile = fp;
136: if (petsc_history) {
137: #if defined(PETSC_HAVE_VPRINTF_CHAR)
138: vfprintf(petsc_history,format,(char *)Argp);
139: #else
140: vfprintf(petsc_history,format,Argp);
141: #endif
142: fflush(petsc_history);
143: }
144: va_end(Argp);
145: } else { /* other processors add to local queue */
146: int len;
147: va_list Argp;
148: PrintfQueue next;
149: PetscNew(struct _PrintfQueue,&next);
150: if (queue) {queue->next = next; queue = next; queue->next = 0;}
151: else {queuebase = queue = next;}
152: queuelength++;
153: va_start(Argp,format);
154: #if defined(PETSC_HAVE_VPRINTF_CHAR)
155: vsprintf(next->string,format,(char *)Argp);
156: #else
157: vsprintf(next->string,format,Argp);
158: #endif
159: va_end(Argp);
160: PetscStrlen(next->string,&len);
161: if (len > QUEUESTRINGSIZE) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Formatted string longer then %d bytes",QUEUESTRINGSIZE);
162: }
163:
164: return(0);
165: }
167: #undef __FUNCT__
169: /*@C
170: PetscSynchronizedFlush - Flushes to the screen output from all processors
171: involved in previous PetscSynchronizedPrintf() calls.
173: Collective on MPI_Comm
175: Input Parameters:
176: . comm - the communicator
178: Level: intermediate
180: Notes:
181: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
182: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
184: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
185: PetscViewerASCIISynchronizedPrintf()
186: @*/
187: int PetscSynchronizedFlush(MPI_Comm comm)
188: {
189: int rank,size,i,j,n,tag,ierr;
190: char message[QUEUESTRINGSIZE];
191: MPI_Status status;
192: FILE *fd;
195: MPI_Comm_rank(comm,&rank);
196: MPI_Comm_size(comm,&size);
198: PetscCommGetNewTag(comm,&tag);
199: /* First processor waits for messages from all other processors */
200: if (!rank) {
201: if (queuefile) {
202: fd = queuefile;
203: } else {
204: fd = stdout;
205: }
206: for (i=1; i<size; i++) {
207: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
208: for (j=0; j<n; j++) {
209: MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
210: fprintf(fd,"%s",message);
211: if (petsc_history) {
212: fprintf(petsc_history,"%s",message);
213: }
214: }
215: }
216: fflush(fd);
217: if (petsc_history) fflush(petsc_history);
218: queuefile = PETSC_NULL;
219: } else { /* other processors send queue to processor 0 */
220: PrintfQueue next = queuebase,previous;
222: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
223: for (i=0; i<queuelength; i++) {
224: ierr = MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
225: previous = next;
226: next = next->next;
227: ierr = PetscFree(previous);
228: }
229: queue = 0;
230: queuelength = 0;
231: }
232: return(0);
233: }
235: /* ---------------------------------------------------------------------------------------*/
237: #undef __FUNCT__
239: /*@C
240: PetscFPrintf - Prints to a file, only from the first
241: processor in the communicator.
243: Not Collective
245: Input Parameters:
246: + comm - the communicator
247: . fd - the file pointer
248: - format - the usual printf() format string
250: Level: intermediate
252: Fortran Note:
253: This routine is not supported in Fortran.
255: Concepts: printing^in parallel
256: Concepts: printf^in parallel
258: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
259: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
260: @*/
261: int PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
262: {
263: int rank,ierr;
266: MPI_Comm_rank(comm,&rank);
267: if (!rank) {
268: va_list Argp;
269: va_start(Argp,format);
270: #if defined(PETSC_HAVE_VPRINTF_CHAR)
271: vfprintf(fd,format,(char*)Argp);
272: #else
273: vfprintf(fd,format,Argp);
274: #endif
275: fflush(fd);
276: if (petsc_history) {
277: #if defined(PETSC_HAVE_VPRINTF_CHAR)
278: vfprintf(petsc_history,format,(char *)Argp);
279: #else
280: vfprintf(petsc_history,format,Argp);
281: #endif
282: fflush(petsc_history);
283: }
284: va_end(Argp);
285: }
286: return(0);
287: }
289: #undef __FUNCT__
291: /*@C
292: PetscPrintf - Prints to standard out, only from the first
293: processor in the communicator.
295: Not Collective
297: Input Parameters:
298: + comm - the communicator
299: - format - the usual printf() format string
301: Level: intermediate
303: Fortran Note:
304: This routine is not supported in Fortran.
306: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
307: replaced with < 1.e-12
309: Concepts: printing^in parallel
310: Concepts: printf^in parallel
312: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
313: @*/
314: int PetscPrintf(MPI_Comm comm,const char format[],...)
315: {
316: int rank,ierr,len;
317: char *nformat,*sub1,*sub2;
318: PetscReal value;
321: if (!comm) comm = PETSC_COMM_WORLD;
322: MPI_Comm_rank(comm,&rank);
323: if (!rank) {
324: va_list Argp;
325: va_start(Argp,format);
327: PetscStrstr(format,"%A",&sub1);
328: if (sub1) {
329: PetscStrstr(format,"%",&sub2);
330: if (sub1 != sub2) SETERRQ(1,"%%A format must be first in format string");
331: ierr = PetscStrlen(format,&len);
332: ierr = PetscMalloc((len+16)*sizeof(char),&nformat);
333: ierr = PetscStrcpy(nformat,format);
334: ierr = PetscStrstr(nformat,"%",&sub2);
335: sub2[0] = 0;
336: value = (double)va_arg(Argp,double);
337: if (PetscAbsReal(value) < 1.e-12) {
338: ierr = PetscStrcat(nformat,"< 1.e-12");
339: } else {
340: ierr = PetscStrcat(nformat,"%g");
341: va_end(Argp);
342: va_start(Argp,format);
343: }
344: ierr = PetscStrcat(nformat,sub1+2);
345: } else {
346: nformat = (char*)format;
347: }
348: #if defined(PETSC_HAVE_VPRINTF_CHAR)
349: vfprintf(stdout,nformat,(char *)Argp);
350: #else
351: vfprintf(stdout,nformat,Argp);
352: #endif
353: fflush(stdout);
354: if (petsc_history) {
355: #if defined(PETSC_HAVE_VPRINTF_CHAR)
356: vfprintf(petsc_history,nformat,(char *)Argp);
357: #else
358: vfprintf(petsc_history,nformat,Argp);
359: #endif
360: fflush(petsc_history);
361: }
362: va_end(Argp);
363: if (sub1) {PetscFree(nformat);}
364: }
365: return(0);
366: }
368: /* ---------------------------------------------------------------------------------------*/
369: #undef __FUNCT__
371: int PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
372: {
373: int rank,ierr;
376: if (!comm) comm = PETSC_COMM_WORLD;
377: MPI_Comm_rank(comm,&rank);
378: if (!rank) {
379: va_list Argp;
380: va_start(Argp,format);
381: #if defined(PETSC_HAVE_VPRINTF_CHAR)
382: vfprintf(stdout,format,(char *)Argp);
383: #else
384: vfprintf(stdout,format,Argp);
385: #endif
386: fflush(stdout);
387: if (petsc_history) {
388: #if defined(PETSC_HAVE_VPRINTF_CHAR)
389: vfprintf(petsc_history,format,(char *)Argp);
390: #else
391: vfprintf(petsc_history,format,Argp);
392: #endif
393: fflush(petsc_history);
394: }
395: va_end(Argp);
396: }
397: return(0);
398: }
400: /* ---------------------------------------------------------------------------------------*/
401: /*MC
402: PetscErrorPrintf - Prints error messages.
404: Not Collective
406: Synopsis:
407: int (*PetscErrorPrintf)(const char format[],...);
409: Input Parameters:
410: . format - the usual printf() format string
412: Level: developer
414: Fortran Note:
415: This routine is not supported in Fortran.
417: Concepts: error messages^printing
418: Concepts: printing^error messages
420: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscHelpPrintf()
421: M*/
423: /*MC
424: PetscHelpPrintf - Prints help messages.
426: Not Collective
428: Synopsis:
429: int (*PetscHelpPrintf)(const char format[],...);
431: Input Parameters:
432: . format - the usual printf() format string
434: Level: developer
436: Fortran Note:
437: This routine is not supported in Fortran.
439: Concepts: help messages^printing
440: Concepts: printing^help messages
442: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscErrorPrintf()
443: M*/
445: #undef __FUNCT__
447: int PetscErrorPrintfDefault(const char format[],...)
448: {
449: va_list Argp;
450: static PetscTruth PetscErrorPrintfCalled = PETSC_FALSE;
451: static PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
452: static FILE *fd;
453: char version[256];
454: /*
455: InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
456: from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
457: */
459: /*
461: it may be called by PetscStackView().
463: This function does not do error checking because it is called by the error handlers.
464: */
466: if (!PetscErrorPrintfCalled) {
467: char arch[10],hostname[64],username[16],pname[PETSC_MAX_PATH_LEN],date[64];
468: PetscTruth use_stderr;
470: PetscErrorPrintfCalled = PETSC_TRUE;
471: InPetscErrorPrintfDefault = PETSC_TRUE;
473: PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
474: if (use_stderr) {
475: fd = stderr;
476: } else {
477: fd = stdout;
478: }
480: /*
481: On the SGI machines and Cray T3E, if errors are generated "simultaneously" by
482: different processors, the messages are printed all jumbled up; to try to
483: prevent this we have each processor wait based on their rank
484: */
485: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
486: {
487: int rank;
488: MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
489: if (rank > 8) rank = 8;
490: PetscSleep(rank);
491: }
492: #endif
493:
494: PetscGetVersion(&version);
496: /* Cannot do error checking on these calls because we are called by error handler */
497: PetscGetArchType(arch,10);
498: PetscGetHostName(hostname,64);
499: PetscGetUserName(username,16);
500: PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);
501: PetscGetInitialDate(date,64);
502: fprintf(fd,"--------------------------------------------
503: ------------------------------n");
504: fprintf(fd,"%sn",version);
505: fprintf(fd,"%sn",PETSC_AUTHOR_INFO);
506: fprintf(fd,"See docs/copyright.html for copyright information.n");
507: fprintf(fd,"See docs/changes.html for recent updates.n");
508: fprintf(fd,"See docs/troubleshooting.html for hints about trouble shooting.n");
509: fprintf(fd,"See docs/manualpages/index.html for manual pages.n");
510: fprintf(fd,"--------------------------------------------
511: ---------------------------n");
512: fprintf(fd,"%s on a %s named %s by %s %sn",pname,arch,hostname,username,date);
513: #if !defined (PARCH_win32)
514: fprintf(fd,"Libraries linked from %sn",PETSC_LIB_DIR);
515: #endif
516: fprintf(fd,"--------------------------------------------
517: ---------------------------n");
518: fflush(fd);
519: InPetscErrorPrintfDefault = PETSC_FALSE;
520: }
522: if (!InPetscErrorPrintfDefault) {
523: va_start(Argp,format);
524: #if defined(PETSC_HAVE_VPRINTF_CHAR)
525: vfprintf(fd,format,(char *)Argp);
526: #else
527: vfprintf(fd,format,Argp);
528: #endif
529: fflush(fd);
530: va_end(Argp);
531: }
532: return 0;
533: }
535: #undef __FUNCT__
537: /*@C
538: PetscSynchronizedFGets - Several processors all get the same line from a file.
540: Collective on MPI_Comm
542: Input Parameters:
543: + comm - the communicator
544: . fd - the file pointer
545: - len - the lenght of the output buffer
547: Output Parameter:
548: . string - the line read from the file
550: Level: intermediate
552: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
553: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
555: @*/
556: int PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,int len,char string[])
557: {
558: int ierr,rank;
561: MPI_Comm_rank(comm,&rank);
562:
563: /* First processor prints immediately to fp */
564: if (!rank) {
565: fgets(string,len,fp);
566: }
567: MPI_Bcast(string,len,MPI_BYTE,0,comm);
568: return(0);
569: }