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;
23: /*
24: Used to output to Zope
25: */
26: FILE *PETSC_ZOPEFD = 0;
30: PetscErrorCode PetscFormatConvert(const char *format,char *newformat,PetscInt size)
31: {
32: PetscInt i = 0,j = 0;
34: while (format[i] && i < size-1) {
35: if (format[i] == '%' && format[i+1] == 'D') {
36: newformat[j++] = '%';
37: #if !defined(PETSC_USE_64BIT_INDICES)
38: newformat[j++] = 'd';
39: #else
40: newformat[j++] = 'l';
41: newformat[j++] = 'l';
42: newformat[j++] = 'd';
43: #endif
44: i += 2;
45: } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
46: newformat[j++] = '%';
47: newformat[j++] = format[i+1];
48: #if !defined(PETSC_USE_64BIT_INDICES)
49: newformat[j++] = 'd';
50: #else
51: newformat[j++] = 'l';
52: newformat[j++] = 'l';
53: newformat[j++] = 'd';
54: #endif
55: i += 3;
56: } else if (format[i] == '%' && format[i+1] == 'G') {
57: newformat[j++] = '%';
58: #if defined(PETSC_USE_INT)
59: newformat[j++] = 'd';
60: #elif !defined(PETSC_USE_LONG_DOUBLE)
61: newformat[j++] = 'g';
62: #else
63: newformat[j++] = 'L';
64: newformat[j++] = 'g';
65: #endif
66: i += 2;
67: }else {
68: newformat[j++] = format[i++];
69: }
70: }
71: newformat[j] = 0;
72: return 0;
73: }
74:
77: /*
78: No error handling because may be called by error handler
79: */
80: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp)
81: {
82: /* no malloc since may be called by error handler */
83: char newformat[8*1024];
84: size_t length;
86:
87: PetscFormatConvert(format,newformat,8*1024);
88: PetscStrlen(newformat, &length);
89: if (length > len) {
90: newformat[len] = '\0';
91: }
92: #if defined(PETSC_HAVE_VPRINTF_CHAR)
93: vsprintf(str,newformat,(char *)Argp);
94: #else
95: vsprintf(str,newformat,Argp);
96: #endif
97: return 0;
98: }
103: PetscErrorCode PetscZopeLog(const char *format,va_list Argp){
104: /* no malloc since may be called by error handler */
105: char newformat[8*1024];
106: char log[8*1024];
107:
109: char logstart[] = " <<<log>>>";
110: size_t len;
111: size_t formatlen;
112: PetscFormatConvert(format,newformat,8*1024);
113: PetscStrlen(logstart, &len);
114: PetscMemcpy(log, logstart, len);
115: PetscStrlen(newformat, &formatlen);
116: PetscMemcpy(&(log[len]), newformat, formatlen);
117: if(PETSC_ZOPEFD != NULL){
118: #if defined(PETSC_HAVE_VPRINTF_CHAR)
119: vfprintf(PETSC_ZOPEFD,log,(char *)Argp);
120: #else
121: vfprintf(PETSC_ZOPEFD,log,Argp);
122: fflush(PETSC_ZOPEFD);
123: #endif
124: }
125: return 0;
126: }
130: /*
131: All PETSc standard out and error messages are sent through this function; so, in theory, this can
132: can be replaced with something that does not simply write to a file.
134: Note: For error messages this may be called by a process, for regular standard out it is
135: called only by process 0 of a given communicator
137: No error handling because may be called by error handler
138: */
139: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
140: {
141: /* no malloc since may be called by error handler */
142: char newformat[8*1024];
145: PetscFormatConvert(format,newformat,8*1024);
146: if(PETSC_ZOPEFD != NULL && PETSC_ZOPEFD != PETSC_STDOUT){
147: va_list s;
148: #if defined(PETSC_HAVE_VA_COPY)
149: va_copy(s, Argp);
150: #elif defined(PETSC_HAVE___VA_COPY)
151: __va_copy(s, Argp);
152: #else
153: SETERRQ(PETSC_ERR_SUP_SYS,"Zope not supported due to missing va_copy()");
154: #endif
156: #if defined(PETSC_HAVE_VPRINTF_CHAR)
157: vfprintf(PETSC_ZOPEFD,newformat,(char *)s);
158: #else
159: vfprintf(PETSC_ZOPEFD,newformat,s);
160: fflush(PETSC_ZOPEFD);
161: #endif
162: }
164: #if defined(PETSC_HAVE_VPRINTF_CHAR)
165: vfprintf(fd,newformat,(char *)Argp);
166: #else
167: vfprintf(fd,newformat,Argp);
168: fflush(fd);
169: #endif
170: return 0;
171: }
175: /*@C
176: PetscSNPrintf - Prints to a string of given length
178: Not Collective
180: Input Parameters:
181: + str - the string to print to
182: . len - the length of str
183: . format - the usual printf() format string
184: - any arguments
186: Level: intermediate
188: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
189: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
190: @*/
191: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
192: {
194: va_list Argp;
197: va_start(Argp,format);
198: PetscVSNPrintf(str,len,format,Argp);
199: return(0);
200: }
202: /* ----------------------------------------------------------------------- */
204: PrintfQueue queue = 0,queuebase = 0;
205: int queuelength = 0;
206: FILE *queuefile = PETSC_NULL;
210: /*@C
211: PetscSynchronizedPrintf - Prints synchronized output from several processors.
212: Output of the first processor is followed by that of the second, etc.
214: Not Collective
216: Input Parameters:
217: + comm - the communicator
218: - format - the usual printf() format string
220: Level: intermediate
222: Notes:
223: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
224: from all the processors to be printed.
226: Fortran Note:
227: The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
228: That is, you can only pass a single character string from Fortran.
230: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
232: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
233: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
234: @*/
235: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
236: {
238: PetscMPIInt rank;
241: MPI_Comm_rank(comm,&rank);
242:
243: /* First processor prints immediately to stdout */
244: if (!rank) {
245: va_list Argp;
246: va_start(Argp,format);
247: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
248: if (petsc_history) {
249: (*PetscVFPrintf)(petsc_history,format,Argp);
250: }
251: va_end(Argp);
252: } else { /* other processors add to local queue */
253: va_list Argp;
254: PrintfQueue next;
256: PetscNew(struct _PrintfQueue,&next);
257: if (queue) {queue->next = next; queue = next; queue->next = 0;}
258: else {queuebase = queue = next;}
259: queuelength++;
260: va_start(Argp,format);
261: PetscMemzero(next->string,QUEUESTRINGSIZE);
262: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
263: va_end(Argp);
264: }
265:
266: return(0);
267: }
268:
271: /*@C
272: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
273: several processors. Output of the first processor is followed by that of the
274: second, etc.
276: Not Collective
278: Input Parameters:
279: + comm - the communicator
280: . fd - the file pointer
281: - format - the usual printf() format string
283: Level: intermediate
285: Notes:
286: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
287: from all the processors to be printed.
289: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
291: Contributed by: Matthew Knepley
293: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
294: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
296: @*/
297: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
298: {
300: PetscMPIInt rank;
303: MPI_Comm_rank(comm,&rank);
304:
305: /* First processor prints immediately to fp */
306: if (!rank) {
307: va_list Argp;
308: va_start(Argp,format);
309: (*PetscVFPrintf)(fp,format,Argp);
310: queuefile = fp;
311: if (petsc_history) {
312: (*PetscVFPrintf)(petsc_history,format,Argp);
313: }
314: va_end(Argp);
315: } else { /* other processors add to local queue */
316: va_list Argp;
317: PrintfQueue next;
318: PetscNew(struct _PrintfQueue,&next);
319: if (queue) {queue->next = next; queue = next; queue->next = 0;}
320: else {queuebase = queue = next;}
321: queuelength++;
322: va_start(Argp,format);
323: PetscMemzero(next->string,QUEUESTRINGSIZE);
324: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
325: va_end(Argp);
326: }
327: return(0);
328: }
332: /*@
333: PetscSynchronizedFlush - Flushes to the screen output from all processors
334: involved in previous PetscSynchronizedPrintf() calls.
336: Collective on MPI_Comm
338: Input Parameters:
339: . comm - the communicator
341: Level: intermediate
343: Notes:
344: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
345: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
347: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
348: PetscViewerASCIISynchronizedPrintf()
349: @*/
350: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
351: {
353: PetscMPIInt rank,size,tag,i,j,n;
354: char message[QUEUESTRINGSIZE];
355: MPI_Status status;
356: FILE *fd;
359: PetscCommDuplicate(comm,&comm,&tag);
360: MPI_Comm_rank(comm,&rank);
361: MPI_Comm_size(comm,&size);
363: /* First processor waits for messages from all other processors */
364: if (!rank) {
365: if (queuefile) {
366: fd = queuefile;
367: } else {
368: fd = PETSC_STDOUT;
369: }
370: for (i=1; i<size; i++) {
371: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
372: for (j=0; j<n; j++) {
373: MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
374: PetscFPrintf(comm,fd,"%s",message);
375: }
376: }
377: queuefile = PETSC_NULL;
378: } else { /* other processors send queue to processor 0 */
379: PrintfQueue next = queuebase,previous;
381: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
382: for (i=0; i<queuelength; i++) {
383: MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
384: previous = next;
385: next = next->next;
386: PetscFree(previous);
387: }
388: queue = 0;
389: queuelength = 0;
390: }
391: PetscCommDestroy(&comm);
392: return(0);
393: }
395: /* ---------------------------------------------------------------------------------------*/
399: /*@C
400: PetscFPrintf - Prints to a file, only from the first
401: processor in the communicator.
403: Not Collective
405: Input Parameters:
406: + comm - the communicator
407: . fd - the file pointer
408: - format - the usual printf() format string
410: Level: intermediate
412: Fortran Note:
413: This routine is not supported in Fortran.
415: Concepts: printing^in parallel
416: Concepts: printf^in parallel
418: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
419: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
420: @*/
421: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
422: {
424: PetscMPIInt rank;
427: MPI_Comm_rank(comm,&rank);
428: if (!rank) {
429: va_list Argp;
430: va_start(Argp,format);
431: (*PetscVFPrintf)(fd,format,Argp);
432: if (petsc_history) {
433: (*PetscVFPrintf)(petsc_history,format,Argp);
434: }
435: va_end(Argp);
436: }
437: return(0);
438: }
442: /*@C
443: PetscPrintf - Prints to standard out, only from the first
444: processor in the communicator.
446: Not Collective
448: Input Parameters:
449: + comm - the communicator
450: - format - the usual printf() format string
452: Level: intermediate
454: Fortran Note:
455: The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
456: That is, you can only pass a single character string from Fortran.
458: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
459: replaced with < 1.e-12
461: Concepts: printing^in parallel
462: Concepts: printf^in parallel
464: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
465: @*/
466: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
467: {
469: PetscMPIInt rank;
470: size_t len;
471: char *nformat,*sub1,*sub2;
472: PetscReal value;
475: if (!comm) comm = PETSC_COMM_WORLD;
476: MPI_Comm_rank(comm,&rank);
477: if (!rank) {
478: va_list Argp;
479: va_start(Argp,format);
481: PetscStrstr(format,"%A",&sub1);
482: if (sub1) {
483: PetscStrstr(format,"%",&sub2);
484: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
485: PetscStrlen(format,&len);
486: PetscMalloc((len+16)*sizeof(char),&nformat);
487: PetscStrcpy(nformat,format);
488: PetscStrstr(nformat,"%",&sub2);
489: sub2[0] = 0;
490: value = (double)va_arg(Argp,double);
491: if (PetscAbsReal(value) < 1.e-12) {
492: PetscStrcat(nformat,"< 1.e-12");
493: } else {
494: PetscStrcat(nformat,"%g");
495: va_end(Argp);
496: va_start(Argp,format);
497: }
498: PetscStrcat(nformat,sub1+2);
499: } else {
500: nformat = (char*)format;
501: }
502: (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
503: if (petsc_history) {
504: (*PetscVFPrintf)(petsc_history,nformat,Argp);
505: }
506: va_end(Argp);
507: if (sub1) {PetscFree(nformat);}
508: }
509: return(0);
510: }
512: /* ---------------------------------------------------------------------------------------*/
515: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
516: {
518: PetscMPIInt rank;
521: if (!comm) comm = PETSC_COMM_WORLD;
522: MPI_Comm_rank(comm,&rank);
523: if (!rank) {
524: va_list Argp;
525: va_start(Argp,format);
526: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
527: if (petsc_history) {
528: (*PetscVFPrintf)(petsc_history,format,Argp);
529: }
530: va_end(Argp);
531: }
532: return(0);
533: }
535: /* ---------------------------------------------------------------------------------------*/
540: /*@C
541: PetscSynchronizedFGets - Several processors all get the same line from a file.
543: Collective on MPI_Comm
545: Input Parameters:
546: + comm - the communicator
547: . fd - the file pointer
548: - len - the length of the output buffer
550: Output Parameter:
551: . string - the line read from the file
553: Level: intermediate
555: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
556: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
558: @*/
559: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
560: {
562: PetscMPIInt rank;
565: MPI_Comm_rank(comm,&rank);
566:
567: if (!rank) {
568: fgets(string,len,fp);
569: }
570: MPI_Bcast(string,len,MPI_BYTE,0,comm);
571: return(0);
572: }