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,int *fullLength,va_list Argp)
81: {
82: /* no malloc since may be called by error handler */
83: char *newformat;
84: char formatbuf[8*1024];
85: size_t oldLength,length;
87:
88: PetscStrlen(format, &oldLength);
89: if (oldLength < 8*1024) {
90: newformat = formatbuf;
91: } else {
92: PetscMalloc((oldLength+1) * sizeof(char), &newformat);
93: }
94: PetscFormatConvert(format,newformat,oldLength+1);
95: PetscStrlen(newformat, &length);
96: #if 0
97: if (length > len) {
98: newformat[len] = '\0';
99: }
100: #endif
101: #if defined(PETSC_HAVE_VPRINTF_CHAR)
102: *fullLength = vsnprintf(str,len,newformat,(char *)Argp);
103: #elif defined(PETSC_HAVE_VSNPRINTF)
104: *fullLength = vsnprintf(str,len,newformat,Argp);
105: #elif defined(PETSC_HAVE__VSNPRINTF)
106: *fullLength = _vsnprintf(str,len,newformat,Argp);
107: #else
108: #error "vsnprintf not found"
109: #endif
110: if (oldLength >= 8*1024) {
111: PetscFree(newformat);
112: }
113: return 0;
114: }
119: PetscErrorCode PetscZopeLog(const char *format,va_list Argp){
120: /* no malloc since may be called by error handler */
121: char newformat[8*1024];
122: char log[8*1024];
123:
125: char logstart[] = " <<<log>>>";
126: size_t len;
127: size_t formatlen;
128: PetscFormatConvert(format,newformat,8*1024);
129: PetscStrlen(logstart, &len);
130: PetscMemcpy(log, logstart, len);
131: PetscStrlen(newformat, &formatlen);
132: PetscMemcpy(&(log[len]), newformat, formatlen);
133: if(PETSC_ZOPEFD != NULL){
134: #if defined(PETSC_HAVE_VPRINTF_CHAR)
135: vfprintf(PETSC_ZOPEFD,log,(char *)Argp);
136: #else
137: vfprintf(PETSC_ZOPEFD,log,Argp);
138: fflush(PETSC_ZOPEFD);
139: #endif
140: }
141: return 0;
142: }
146: /*
147: All PETSc standard out and error messages are sent through this function; so, in theory, this can
148: can be replaced with something that does not simply write to a file.
150: Note: For error messages this may be called by a process, for regular standard out it is
151: called only by process 0 of a given communicator
153: No error handling because may be called by error handler
154: */
155: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
156: {
157: /* no malloc since may be called by error handler (assume no long messages in errors) */
158: char *newformat;
159: char formatbuf[8*1024];
160: size_t oldLength;
163: PetscStrlen(format, &oldLength);
164: if (oldLength < 8*1024) {
165: newformat = formatbuf;
166: } else {
167: PetscMalloc((oldLength+1) * sizeof(char), &newformat);
168: }
169: PetscFormatConvert(format,newformat,oldLength+1);
170: if(PETSC_ZOPEFD != NULL && PETSC_ZOPEFD != PETSC_STDOUT){
171: va_list s;
172: #if defined(PETSC_HAVE_VA_COPY)
173: va_copy(s, Argp);
174: #elif defined(PETSC_HAVE___VA_COPY)
175: __va_copy(s, Argp);
176: #else
177: SETERRQ(PETSC_ERR_SUP_SYS,"Zope not supported due to missing va_copy()");
178: #endif
180: #if defined(PETSC_HAVE_VA_COPY) || defined(PETSC_HAVE___VA_COPY)
181: #if defined(PETSC_HAVE_VPRINTF_CHAR)
182: vfprintf(PETSC_ZOPEFD,newformat,(char *)s);
183: #else
184: vfprintf(PETSC_ZOPEFD,newformat,s);
185: fflush(PETSC_ZOPEFD);
186: #endif
187: #endif
188: }
190: #if defined(PETSC_HAVE_VPRINTF_CHAR)
191: vfprintf(fd,newformat,(char *)Argp);
192: #else
193: vfprintf(fd,newformat,Argp);
194: fflush(fd);
195: #endif
196: if (oldLength >= 8*1024) {
197: if (PetscFree(newformat)) {};
198: }
199: return 0;
200: }
204: /*@C
205: PetscSNPrintf - Prints to a string of given length
207: Not Collective
209: Input Parameters:
210: + str - the string to print to
211: . len - the length of str
212: . format - the usual printf() format string
213: - any arguments
215: Level: intermediate
217: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
218: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
219: @*/
220: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
221: {
223: int fullLength;
224: va_list Argp;
227: va_start(Argp,format);
228: PetscVSNPrintf(str,len,format,&fullLength,Argp);
229: return(0);
230: }
232: /* ----------------------------------------------------------------------- */
234: PrintfQueue queue = 0,queuebase = 0;
235: int queuelength = 0;
236: FILE *queuefile = PETSC_NULL;
240: /*@C
241: PetscSynchronizedPrintf - Prints synchronized output from several processors.
242: Output of the first processor is followed by that of the second, etc.
244: Not Collective
246: Input Parameters:
247: + comm - the communicator
248: - format - the usual printf() format string
250: Level: intermediate
252: Notes:
253: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
254: from all the processors to be printed.
256: Fortran Note:
257: The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
258: That is, you can only pass a single character string from Fortran.
260: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
261: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
262: @*/
263: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
264: {
266: PetscMPIInt rank;
269: MPI_Comm_rank(comm,&rank);
270:
271: /* First processor prints immediately to stdout */
272: if (!rank) {
273: va_list Argp;
274: va_start(Argp,format);
275: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
276: if (petsc_history) {
277: (*PetscVFPrintf)(petsc_history,format,Argp);
278: }
279: va_end(Argp);
280: } else { /* other processors add to local queue */
281: va_list Argp;
282: PrintfQueue next;
283: int fullLength = 8191;
285: PetscNew(struct _PrintfQueue,&next);
286: if (queue) {queue->next = next; queue = next; queue->next = 0;}
287: else {queuebase = queue = next;}
288: queuelength++;
289: next->size = -1;
290: while(fullLength >= next->size) {
291: next->size = fullLength+1;
292: PetscMalloc(next->size * sizeof(char), &next->string);
293: va_start(Argp,format);
294: PetscMemzero(next->string,next->size);
295: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
296: va_end(Argp);
297: }
298: }
299:
300: return(0);
301: }
302:
305: /*@C
306: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
307: several processors. Output of the first processor is followed by that of the
308: second, etc.
310: Not Collective
312: Input Parameters:
313: + comm - the communicator
314: . fd - the file pointer
315: - format - the usual printf() format string
317: Level: intermediate
319: Notes:
320: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
321: from all the processors to be printed.
323: Contributed by: Matthew Knepley
325: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
326: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
328: @*/
329: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
330: {
332: PetscMPIInt rank;
335: MPI_Comm_rank(comm,&rank);
336:
337: /* First processor prints immediately to fp */
338: if (!rank) {
339: va_list Argp;
340: va_start(Argp,format);
341: (*PetscVFPrintf)(fp,format,Argp);
342: queuefile = fp;
343: if (petsc_history) {
344: (*PetscVFPrintf)(petsc_history,format,Argp);
345: }
346: va_end(Argp);
347: } else { /* other processors add to local queue */
348: va_list Argp;
349: PrintfQueue next;
350: int fullLength = 8191;
351: PetscNew(struct _PrintfQueue,&next);
352: if (queue) {queue->next = next; queue = next; queue->next = 0;}
353: else {queuebase = queue = next;}
354: queuelength++;
355: next->size = -1;
356: while(fullLength >= next->size) {
357: next->size = fullLength+1;
358: PetscMalloc(next->size * sizeof(char), &next->string);
359: va_start(Argp,format);
360: PetscMemzero(next->string,next->size);
361: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
362: va_end(Argp);
363: }
364: }
365: return(0);
366: }
370: /*@
371: PetscSynchronizedFlush - Flushes to the screen output from all processors
372: involved in previous PetscSynchronizedPrintf() calls.
374: Collective on MPI_Comm
376: Input Parameters:
377: . comm - the communicator
379: Level: intermediate
381: Notes:
382: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
383: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
385: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
386: PetscViewerASCIISynchronizedPrintf()
387: @*/
388: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
389: {
391: PetscMPIInt rank,size,tag,i,j,n;
392: char *message;
393: MPI_Status status;
394: FILE *fd;
397: PetscCommDuplicate(comm,&comm,&tag);
398: MPI_Comm_rank(comm,&rank);
399: MPI_Comm_size(comm,&size);
401: /* First processor waits for messages from all other processors */
402: if (!rank) {
403: if (queuefile) {
404: fd = queuefile;
405: } else {
406: fd = PETSC_STDOUT;
407: }
408: for (i=1; i<size; i++) {
409: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
410: for (j=0; j<n; j++) {
411: int size;
413: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
414: PetscMalloc(size * sizeof(char), &message);
415: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
416: PetscFPrintf(comm,fd,"%s",message);
417: PetscFree(message);
418: }
419: }
420: queuefile = PETSC_NULL;
421: } else { /* other processors send queue to processor 0 */
422: PrintfQueue next = queuebase,previous;
424: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
425: for (i=0; i<queuelength; i++) {
426: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
427: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
428: previous = next;
429: next = next->next;
430: PetscFree(previous->string);
431: PetscFree(previous);
432: }
433: queue = 0;
434: queuelength = 0;
435: }
436: PetscCommDestroy(&comm);
437: return(0);
438: }
440: /* ---------------------------------------------------------------------------------------*/
444: /*@C
445: PetscFPrintf - Prints to a file, only from the first
446: processor in the communicator.
448: Not Collective
450: Input Parameters:
451: + comm - the communicator
452: . fd - the file pointer
453: - format - the usual printf() format string
455: Level: intermediate
457: Fortran Note:
458: This routine is not supported in Fortran.
460: Concepts: printing^in parallel
461: Concepts: printf^in parallel
463: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
464: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
465: @*/
466: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
467: {
469: PetscMPIInt rank;
472: MPI_Comm_rank(comm,&rank);
473: if (!rank) {
474: va_list Argp;
475: va_start(Argp,format);
476: (*PetscVFPrintf)(fd,format,Argp);
477: if (petsc_history) {
478: (*PetscVFPrintf)(petsc_history,format,Argp);
479: }
480: va_end(Argp);
481: }
482: return(0);
483: }
487: /*@C
488: PetscPrintf - Prints to standard out, only from the first
489: processor in the communicator.
491: Not Collective
493: Input Parameters:
494: + comm - the communicator
495: - format - the usual printf() format string
497: Level: intermediate
499: Fortran Note:
500: The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
501: That is, you can only pass a single character string from Fortran.
503: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
504: replaced with < 1.e-12
506: Concepts: printing^in parallel
507: Concepts: printf^in parallel
509: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
510: @*/
511: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
512: {
514: PetscMPIInt rank;
515: size_t len;
516: char *nformat,*sub1,*sub2;
517: PetscReal value;
520: if (!comm) comm = PETSC_COMM_WORLD;
521: MPI_Comm_rank(comm,&rank);
522: if (!rank) {
523: va_list Argp;
524: va_start(Argp,format);
526: PetscStrstr(format,"%A",&sub1);
527: if (sub1) {
528: PetscStrstr(format,"%",&sub2);
529: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
530: PetscStrlen(format,&len);
531: PetscMalloc((len+16)*sizeof(char),&nformat);
532: PetscStrcpy(nformat,format);
533: PetscStrstr(nformat,"%",&sub2);
534: sub2[0] = 0;
535: value = (double)va_arg(Argp,double);
536: if (PetscAbsReal(value) < 1.e-12) {
537: PetscStrcat(nformat,"< 1.e-12");
538: } else {
539: PetscStrcat(nformat,"%g");
540: va_end(Argp);
541: va_start(Argp,format);
542: }
543: PetscStrcat(nformat,sub1+2);
544: } else {
545: nformat = (char*)format;
546: }
547: (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
548: if (petsc_history) {
549: (*PetscVFPrintf)(petsc_history,nformat,Argp);
550: }
551: va_end(Argp);
552: if (sub1) {PetscFree(nformat);}
553: }
554: return(0);
555: }
557: /* ---------------------------------------------------------------------------------------*/
560: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
561: {
563: PetscMPIInt rank;
566: if (!comm) comm = PETSC_COMM_WORLD;
567: MPI_Comm_rank(comm,&rank);
568: if (!rank) {
569: va_list Argp;
570: va_start(Argp,format);
571: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
572: if (petsc_history) {
573: (*PetscVFPrintf)(petsc_history,format,Argp);
574: }
575: va_end(Argp);
576: }
577: return(0);
578: }
580: /* ---------------------------------------------------------------------------------------*/
585: /*@C
586: PetscSynchronizedFGets - Several processors all get the same line from a file.
588: Collective on MPI_Comm
590: Input Parameters:
591: + comm - the communicator
592: . fd - the file pointer
593: - len - the length of the output buffer
595: Output Parameter:
596: . string - the line read from the file
598: Level: intermediate
600: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
601: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
603: @*/
604: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
605: {
607: PetscMPIInt rank;
610: MPI_Comm_rank(comm,&rank);
611:
612: if (!rank) {
613: fgets(string,len,fp);
614: }
615: MPI_Bcast(string,len,MPI_BYTE,0,comm);
616: return(0);
617: }