Actual source code: mprint.c
1: #define PETSC_DLL
2: /*
3: Utilites routines to add simple ASCII IO capability.
4: */
5: #include src/sys/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: */
11: /*
12: Allows one to overwrite where standard out is sent. For example
13: PETSC_STDOUT = fopen("/dev/ttyXX","w") will cause all standard out
14: writes to go to terminal XX; assuming you have write permission there
15: */
16: FILE *PETSC_STDOUT = 0;
17: /*
18: Allows one to overwrite where standard error is sent. For example
19: PETSC_STDERR = fopen("/dev/ttyXX","w") will cause all standard error
20: writes to go to terminal XX; assuming you have write permission there
21: */
22: FILE *PETSC_STDERR = 0;
26: PetscErrorCode PetscFormatConvert(const char *format,char *newformat,PetscInt size)
27: {
28: PetscInt i = 0,j = 0;
30: while (format[i] && i < size-1) {
31: if (format[i] == '%' && format[i+1] == 'D') {
32: newformat[j++] = '%';
33: #if defined(PETSC_USE_32BIT_INT)
34: newformat[j++] = 'd';
35: #else
36: newformat[j++] = 'l';
37: newformat[j++] = 'l';
38: newformat[j++] = 'd';
39: #endif
40: i += 2;
41: } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
42: newformat[j++] = '%';
43: newformat[j++] = format[i+1];
44: #if defined(PETSC_USE_32BIT_INT)
45: newformat[j++] = 'd';
46: #else
47: newformat[j++] = 'l';
48: newformat[j++] = 'l';
49: newformat[j++] = 'd';
50: #endif
51: i += 3;
52: } else if (format[i] == '%' && format[i+1] == 'G') {
53: newformat[j++] = '%';
54: #if defined(PETSC_USE_INT)
55: newformat[j++] = 'd';
56: #elif !defined(PETSC_USE_LONG_DOUBLE)
57: newformat[j++] = 'g';
58: #else
59: newformat[j++] = 'L';
60: newformat[j++] = 'g';
61: #endif
62: i += 2;
63: }else {
64: newformat[j++] = format[i++];
65: }
66: }
67: newformat[j] = 0;
68: return 0;
69: }
70:
73: /*
74: No error handling because may be called by error handler
75: */
76: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp)
77: {
78: /* no malloc since may be called by error handler */
79: char newformat[8*1024];
80: size_t length;
82:
83: PetscFormatConvert(format,newformat,8*1024);
84: PetscStrlen(newformat, &length);
85: if (length > len) {
86: newformat[len] = '\0';
87: }
88: #if defined(PETSC_HAVE_VPRINTF_CHAR)
89: vsprintf(str,newformat,(char *)Argp);
90: #else
91: vsprintf(str,newformat,Argp);
92: #endif
93: return 0;
94: }
98: /*
99: All PETSc standard out and error messages are sent through this function; so, in theory, this can
100: can be replaced with something that does not simply write to a file.
102: Note: For error messages this may be called by a process, for regular standard out it is
103: called only by process 0 of a given communicator
105: No error handling because may be called by error handler
106: */
107: PetscErrorCode PetscVFPrintf(FILE *fd,const char *format,va_list Argp)
108: {
109: /* no malloc since may be called by error handler */
110: char newformat[8*1024];
111:
112: PetscFormatConvert(format,newformat,8*1024);
113: #if defined(PETSC_HAVE_VPRINTF_CHAR)
114: vfprintf(fd,newformat,(char *)Argp);
115: #else
116: vfprintf(fd,newformat,Argp);
117: fflush(fd);
118: #endif
119: return 0;
120: }
124: /*@C
125: PetscSNPrintf - Prints to a string of given length
127: Not Collective
129: Input Parameters:
130: + str - the string to print to
131: . len - the length of str
132: . format - the usual printf() format string
133: - any arguments
135: Level: intermediate
137: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
138: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
139: @*/
140: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
141: {
143: va_list Argp;
146: va_start(Argp,format);
147: PetscVSNPrintf(str,len,format,Argp);
148: return(0);
149: }
151: /* ----------------------------------------------------------------------- */
153: PrintfQueue queue = 0,queuebase = 0;
154: int queuelength = 0;
155: FILE *queuefile = PETSC_NULL;
159: /*@C
160: PetscSynchronizedPrintf - Prints synchronized output from several processors.
161: Output of the first processor is followed by that of the second, etc.
163: Not Collective
165: Input Parameters:
166: + comm - the communicator
167: - format - the usual printf() format string
169: Level: intermediate
171: Notes:
172: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
173: from all the processors to be printed.
175: Fortran Note:
176: The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
177: That is, you can only pass a single character string from Fortran.
179: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
181: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
182: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
183: @*/
184: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
185: {
187: PetscMPIInt rank;
190: MPI_Comm_rank(comm,&rank);
191:
192: /* First processor prints immediately to stdout */
193: if (!rank) {
194: va_list Argp;
195: va_start(Argp,format);
196: PetscVFPrintf(PETSC_STDOUT,format,Argp);
197: if (petsc_history) {
198: PetscVFPrintf(petsc_history,format,Argp);
199: }
200: va_end(Argp);
201: } else { /* other processors add to local queue */
202: va_list Argp;
203: PrintfQueue next;
205: PetscNew(struct _PrintfQueue,&next);
206: if (queue) {queue->next = next; queue = next; queue->next = 0;}
207: else {queuebase = queue = next;}
208: queuelength++;
209: va_start(Argp,format);
210: PetscMemzero(next->string,QUEUESTRINGSIZE);
211: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
212: va_end(Argp);
213: }
214:
215: return(0);
216: }
217:
220: /*@C
221: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
222: several processors. Output of the first processor is followed by that of the
223: second, etc.
225: Not Collective
227: Input Parameters:
228: + comm - the communicator
229: . fd - the file pointer
230: - format - the usual printf() format string
232: Level: intermediate
234: Notes:
235: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
236: from all the processors to be printed.
238: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
240: Contributed by: Matthew Knepley
242: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
243: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
245: @*/
246: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
247: {
249: PetscMPIInt rank;
252: MPI_Comm_rank(comm,&rank);
253:
254: /* First processor prints immediately to fp */
255: if (!rank) {
256: va_list Argp;
257: va_start(Argp,format);
258: PetscVFPrintf(fp,format,Argp);
259: queuefile = fp;
260: if (petsc_history) {
261: PetscVFPrintf(petsc_history,format,Argp);
262: }
263: va_end(Argp);
264: } else { /* other processors add to local queue */
265: va_list Argp;
266: PrintfQueue next;
267: PetscNew(struct _PrintfQueue,&next);
268: if (queue) {queue->next = next; queue = next; queue->next = 0;}
269: else {queuebase = queue = next;}
270: queuelength++;
271: va_start(Argp,format);
272: PetscMemzero(next->string,QUEUESTRINGSIZE);
273: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
274: va_end(Argp);
275: }
276: return(0);
277: }
281: /*@
282: PetscSynchronizedFlush - Flushes to the screen output from all processors
283: involved in previous PetscSynchronizedPrintf() calls.
285: Collective on MPI_Comm
287: Input Parameters:
288: . comm - the communicator
290: Level: intermediate
292: Notes:
293: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
294: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
296: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
297: PetscViewerASCIISynchronizedPrintf()
298: @*/
299: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
300: {
302: PetscMPIInt rank,size,tag,i,j,n;
303: char message[QUEUESTRINGSIZE];
304: MPI_Status status;
305: FILE *fd;
308: PetscCommDuplicate(comm,&comm,&tag);
309: MPI_Comm_rank(comm,&rank);
310: MPI_Comm_size(comm,&size);
312: /* First processor waits for messages from all other processors */
313: if (!rank) {
314: if (queuefile) {
315: fd = queuefile;
316: } else {
317: fd = PETSC_STDOUT;
318: }
319: for (i=1; i<size; i++) {
320: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
321: for (j=0; j<n; j++) {
322: MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
323: PetscFPrintf(comm,fd,"%s",message);
324: }
325: }
326: queuefile = PETSC_NULL;
327: } else { /* other processors send queue to processor 0 */
328: PrintfQueue next = queuebase,previous;
330: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
331: for (i=0; i<queuelength; i++) {
332: MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
333: previous = next;
334: next = next->next;
335: PetscFree(previous);
336: }
337: queue = 0;
338: queuelength = 0;
339: }
340: PetscCommDestroy(&comm);
341: return(0);
342: }
344: /* ---------------------------------------------------------------------------------------*/
348: /*@C
349: PetscFPrintf - Prints to a file, only from the first
350: processor in the communicator.
352: Not Collective
354: Input Parameters:
355: + comm - the communicator
356: . fd - the file pointer
357: - format - the usual printf() format string
359: Level: intermediate
361: Fortran Note:
362: This routine is not supported in Fortran.
364: Concepts: printing^in parallel
365: Concepts: printf^in parallel
367: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
368: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
369: @*/
370: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
371: {
373: PetscMPIInt rank;
376: MPI_Comm_rank(comm,&rank);
377: if (!rank) {
378: va_list Argp;
379: va_start(Argp,format);
380: PetscVFPrintf(fd,format,Argp);
381: if (petsc_history) {
382: PetscVFPrintf(petsc_history,format,Argp);
383: }
384: va_end(Argp);
385: }
386: return(0);
387: }
391: /*@C
392: PetscPrintf - Prints to standard out, only from the first
393: processor in the communicator.
395: Not Collective
397: Input Parameters:
398: + comm - the communicator
399: - format - the usual printf() format string
401: Level: intermediate
403: Fortran Note:
404: The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
405: That is, you can only pass a single character string from Fortran.
407: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
408: replaced with < 1.e-12
410: Concepts: printing^in parallel
411: Concepts: printf^in parallel
413: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
414: @*/
415: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
416: {
418: PetscMPIInt rank;
419: size_t len;
420: char *nformat,*sub1,*sub2;
421: PetscReal value;
424: if (!comm) comm = PETSC_COMM_WORLD;
425: MPI_Comm_rank(comm,&rank);
426: if (!rank) {
427: va_list Argp;
428: va_start(Argp,format);
430: PetscStrstr(format,"%A",&sub1);
431: if (sub1) {
432: PetscStrstr(format,"%",&sub2);
433: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
434: PetscStrlen(format,&len);
435: PetscMalloc((len+16)*sizeof(char),&nformat);
436: PetscStrcpy(nformat,format);
437: PetscStrstr(nformat,"%",&sub2);
438: sub2[0] = 0;
439: value = (double)va_arg(Argp,double);
440: if (PetscAbsReal(value) < 1.e-12) {
441: PetscStrcat(nformat,"< 1.e-12");
442: } else {
443: PetscStrcat(nformat,"%g");
444: va_end(Argp);
445: va_start(Argp,format);
446: }
447: PetscStrcat(nformat,sub1+2);
448: } else {
449: nformat = (char*)format;
450: }
451: PetscVFPrintf(PETSC_STDOUT,nformat,Argp);
452: if (petsc_history) {
453: PetscVFPrintf(petsc_history,nformat,Argp);
454: }
455: va_end(Argp);
456: if (sub1) {PetscFree(nformat);}
457: }
458: return(0);
459: }
461: /* ---------------------------------------------------------------------------------------*/
464: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
465: {
467: PetscMPIInt rank;
470: if (!comm) comm = PETSC_COMM_WORLD;
471: MPI_Comm_rank(comm,&rank);
472: if (!rank) {
473: va_list Argp;
474: va_start(Argp,format);
475: PetscVFPrintf(PETSC_STDOUT,format,Argp);
476: if (petsc_history) {
477: PetscVFPrintf(petsc_history,format,Argp);
478: }
479: va_end(Argp);
480: }
481: return(0);
482: }
484: /* ---------------------------------------------------------------------------------------*/
489: /*@C
490: PetscSynchronizedFGets - Several processors all get the same line from a file.
492: Collective on MPI_Comm
494: Input Parameters:
495: + comm - the communicator
496: . fd - the file pointer
497: - len - the length of the output buffer
499: Output Parameter:
500: . string - the line read from the file
502: Level: intermediate
504: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
505: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
507: @*/
508: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
509: {
511: PetscMPIInt rank;
514: MPI_Comm_rank(comm,&rank);
515:
516: if (!rank) {
517: fgets(string,len,fp);
518: }
519: MPI_Bcast(string,len,MPI_BYTE,0,comm);
520: return(0);
521: }