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_SCALAR_INT)
59: newformat[j++] = 'd';
60: #elif !defined(PETSC_USE_SCALAR_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_VSNPRINTF_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_VFPRINTF_CHAR)
135: vfprintf(PETSC_ZOPEFD,log,(char *)Argp);
136: #else
137: vfprintf(PETSC_ZOPEFD,log,Argp);
138: #endif
139: fflush(PETSC_ZOPEFD);
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: (void)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_VFPRINTF_CHAR)
182: vfprintf(PETSC_ZOPEFD,newformat,(char *)s);
183: #else
184: vfprintf(PETSC_ZOPEFD,newformat,s);
185: #endif
186: fflush(PETSC_ZOPEFD);
187: #endif
188: }
190: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
191: vfprintf(fd,newformat,(char *)Argp);
192: #else
193: vfprintf(fd,newformat,Argp);
194: #endif
195: fflush(fd);
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(MPI_Comm, 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: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
324: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
326: @*/
327: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
328: {
330: PetscMPIInt rank;
333: MPI_Comm_rank(comm,&rank);
334:
335: /* First processor prints immediately to fp */
336: if (!rank) {
337: va_list Argp;
338: va_start(Argp,format);
339: (*PetscVFPrintf)(fp,format,Argp);
340: queuefile = fp;
341: if (petsc_history) {
342: (*PetscVFPrintf)(petsc_history,format,Argp);
343: }
344: va_end(Argp);
345: } else { /* other processors add to local queue */
346: va_list Argp;
347: PrintfQueue next;
348: int fullLength = 8191;
349: PetscNew(struct _PrintfQueue,&next);
350: if (queue) {queue->next = next; queue = next; queue->next = 0;}
351: else {queuebase = queue = next;}
352: queuelength++;
353: next->size = -1;
354: while(fullLength >= next->size) {
355: next->size = fullLength+1;
356: PetscMalloc(next->size * sizeof(char), &next->string);
357: va_start(Argp,format);
358: PetscMemzero(next->string,next->size);
359: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
360: va_end(Argp);
361: }
362: }
363: return(0);
364: }
368: /*@
369: PetscSynchronizedFlush - Flushes to the screen output from all processors
370: involved in previous PetscSynchronizedPrintf() calls.
372: Collective on MPI_Comm
374: Input Parameters:
375: . comm - the communicator
377: Level: intermediate
379: Notes:
380: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
381: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
383: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
384: PetscViewerASCIISynchronizedPrintf()
385: @*/
386: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
387: {
389: PetscMPIInt rank,size,tag,i,j,n;
390: char *message;
391: MPI_Status status;
392: FILE *fd;
395: PetscCommDuplicate(comm,&comm,&tag);
396: MPI_Comm_rank(comm,&rank);
397: MPI_Comm_size(comm,&size);
399: /* First processor waits for messages from all other processors */
400: if (!rank) {
401: if (queuefile) {
402: fd = queuefile;
403: } else {
404: fd = PETSC_STDOUT;
405: }
406: for (i=1; i<size; i++) {
407: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
408: for (j=0; j<n; j++) {
409: int size;
411: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
412: PetscMalloc(size * sizeof(char), &message);
413: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
414: PetscFPrintf(comm,fd,"%s",message);
415: PetscFree(message);
416: }
417: }
418: queuefile = PETSC_NULL;
419: } else { /* other processors send queue to processor 0 */
420: PrintfQueue next = queuebase,previous;
422: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
423: for (i=0; i<queuelength; i++) {
424: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
425: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
426: previous = next;
427: next = next->next;
428: PetscFree(previous->string);
429: PetscFree(previous);
430: }
431: queue = 0;
432: queuelength = 0;
433: }
434: PetscCommDestroy(&comm);
435: return(0);
436: }
438: /* ---------------------------------------------------------------------------------------*/
442: /*@C
443: PetscFPrintf - Prints to a file, only from the first
444: processor in the communicator.
446: Not Collective
448: Input Parameters:
449: + comm - the communicator
450: . fd - the file pointer
451: - format - the usual printf() format string
453: Level: intermediate
455: Fortran Note:
456: This routine is not supported in Fortran.
458: Concepts: printing^in parallel
459: Concepts: printf^in parallel
461: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
462: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
463: @*/
464: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
465: {
467: PetscMPIInt rank;
470: MPI_Comm_rank(comm,&rank);
471: if (!rank) {
472: va_list Argp;
473: va_start(Argp,format);
474: (*PetscVFPrintf)(fd,format,Argp);
475: if (petsc_history) {
476: (*PetscVFPrintf)(petsc_history,format,Argp);
477: }
478: va_end(Argp);
479: }
480: return(0);
481: }
485: /*@C
486: PetscPrintf - Prints to standard out, only from the first
487: processor in the communicator.
489: Not Collective
491: Input Parameters:
492: + comm - the communicator
493: - format - the usual printf() format string
495: Level: intermediate
497: Fortran Note:
498: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
499: That is, you can only pass a single character string from Fortran.
501: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
502: replaced with < 1.e-12
504: Concepts: printing^in parallel
505: Concepts: printf^in parallel
507: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
508: @*/
509: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
510: {
512: PetscMPIInt rank;
513: size_t len;
514: char *nformat,*sub1,*sub2;
515: PetscReal value;
518: if (!comm) comm = PETSC_COMM_WORLD;
519: MPI_Comm_rank(comm,&rank);
520: if (!rank) {
521: va_list Argp;
522: va_start(Argp,format);
524: PetscStrstr(format,"%A",&sub1);
525: if (sub1) {
526: PetscStrstr(format,"%",&sub2);
527: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
528: PetscStrlen(format,&len);
529: PetscMalloc((len+16)*sizeof(char),&nformat);
530: PetscStrcpy(nformat,format);
531: PetscStrstr(nformat,"%",&sub2);
532: sub2[0] = 0;
533: value = (double)va_arg(Argp,double);
534: if (PetscAbsReal(value) < 1.e-12) {
535: PetscStrcat(nformat,"< 1.e-12");
536: } else {
537: PetscStrcat(nformat,"%g");
538: va_end(Argp);
539: va_start(Argp,format);
540: }
541: PetscStrcat(nformat,sub1+2);
542: } else {
543: nformat = (char*)format;
544: }
545: (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
546: if (petsc_history) {
547: (*PetscVFPrintf)(petsc_history,nformat,Argp);
548: }
549: va_end(Argp);
550: if (sub1) {PetscFree(nformat);}
551: }
552: return(0);
553: }
555: /* ---------------------------------------------------------------------------------------*/
558: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
559: {
561: PetscMPIInt rank;
564: if (!comm) comm = PETSC_COMM_WORLD;
565: MPI_Comm_rank(comm,&rank);
566: if (!rank) {
567: va_list Argp;
568: va_start(Argp,format);
569: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
570: if (petsc_history) {
571: (*PetscVFPrintf)(petsc_history,format,Argp);
572: }
573: va_end(Argp);
574: }
575: return(0);
576: }
578: /* ---------------------------------------------------------------------------------------*/
583: /*@C
584: PetscSynchronizedFGets - Several processors all get the same line from a file.
586: Collective on MPI_Comm
588: Input Parameters:
589: + comm - the communicator
590: . fd - the file pointer
591: - len - the length of the output buffer
593: Output Parameter:
594: . string - the line read from the file
596: Level: intermediate
598: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
599: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
601: @*/
602: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
603: {
605: PetscMPIInt rank;
608: MPI_Comm_rank(comm,&rank);
609:
610: if (!rank) {
611: fgets(string,len,fp);
612: }
613: MPI_Bcast(string,len,MPI_BYTE,0,comm);
614: return(0);
615: }