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