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: va_start(Argp,format);
278: (*PetscVFPrintf)(petsc_history,format,Argp);
279: }
280: va_end(Argp);
281: } else { /* other processors add to local queue */
282: va_list Argp;
283: PrintfQueue next;
284: int fullLength = 8191;
286: PetscNew(struct _PrintfQueue,&next);
287: if (queue) {queue->next = next; queue = next; queue->next = 0;}
288: else {queuebase = queue = next;}
289: queuelength++;
290: next->size = -1;
291: while(fullLength >= next->size) {
292: next->size = fullLength+1;
293: PetscMalloc(next->size * sizeof(char), &next->string);
294: va_start(Argp,format);
295: PetscMemzero(next->string,next->size);
296: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
297: va_end(Argp);
298: }
299: }
300:
301: return(0);
302: }
303:
306: /*@C
307: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
308: several processors. Output of the first processor is followed by that of the
309: second, etc.
311: Not Collective
313: Input Parameters:
314: + comm - the communicator
315: . fd - the file pointer
316: - format - the usual printf() format string
318: Level: intermediate
320: Notes:
321: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
322: from all the processors to be printed.
324: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
325: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
327: @*/
328: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
329: {
331: PetscMPIInt rank;
334: MPI_Comm_rank(comm,&rank);
335:
336: /* First processor prints immediately to fp */
337: if (!rank) {
338: va_list Argp;
339: va_start(Argp,format);
340: (*PetscVFPrintf)(fp,format,Argp);
341: queuefile = fp;
342: if (petsc_history && (fp !=petsc_history)) {
343: va_start(Argp,format);
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 && (fd !=petsc_history)) {
478: va_start(Argp,format);
479: (*PetscVFPrintf)(petsc_history,format,Argp);
480: }
481: va_end(Argp);
482: }
483: return(0);
484: }
488: /*@C
489: PetscPrintf - Prints to standard out, only from the first
490: processor in the communicator.
492: Not Collective
494: Input Parameters:
495: + comm - the communicator
496: - format - the usual printf() format string
498: Level: intermediate
500: Fortran Note:
501: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
502: That is, you can only pass a single character string from Fortran.
504: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
505: replaced with < 1.e-12
507: Concepts: printing^in parallel
508: Concepts: printf^in parallel
510: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
511: @*/
512: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
513: {
515: PetscMPIInt rank;
516: size_t len;
517: char *nformat,*sub1,*sub2;
518: PetscReal value;
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);
527: PetscStrstr(format,"%A",&sub1);
528: if (sub1) {
529: PetscStrstr(format,"%",&sub2);
530: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
531: PetscStrlen(format,&len);
532: PetscMalloc((len+16)*sizeof(char),&nformat);
533: PetscStrcpy(nformat,format);
534: PetscStrstr(nformat,"%",&sub2);
535: sub2[0] = 0;
536: value = (double)va_arg(Argp,double);
537: if (PetscAbsReal(value) < 1.e-12) {
538: PetscStrcat(nformat,"< 1.e-12");
539: } else {
540: PetscStrcat(nformat,"%g");
541: va_end(Argp);
542: va_start(Argp,format);
543: }
544: PetscStrcat(nformat,sub1+2);
545: } else {
546: nformat = (char*)format;
547: }
548: (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
549: if (petsc_history) {
550: va_start(Argp,format);
551: (*PetscVFPrintf)(petsc_history,nformat,Argp);
552: }
553: va_end(Argp);
554: if (sub1) {PetscFree(nformat);}
555: }
556: return(0);
557: }
559: /* ---------------------------------------------------------------------------------------*/
562: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
563: {
565: PetscMPIInt rank;
568: if (!comm) comm = PETSC_COMM_WORLD;
569: MPI_Comm_rank(comm,&rank);
570: if (!rank) {
571: va_list Argp;
572: va_start(Argp,format);
573: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
574: if (petsc_history) {
575: va_start(Argp,format);
576: (*PetscVFPrintf)(petsc_history,format,Argp);
577: }
578: va_end(Argp);
579: }
580: return(0);
581: }
583: /* ---------------------------------------------------------------------------------------*/
588: /*@C
589: PetscSynchronizedFGets - Several processors all get the same line from a file.
591: Collective on MPI_Comm
593: Input Parameters:
594: + comm - the communicator
595: . fd - the file pointer
596: - len - the length of the output buffer
598: Output Parameter:
599: . string - the line read from the file
601: Level: intermediate
603: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
604: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
606: @*/
607: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
608: {
610: PetscMPIInt rank;
613: MPI_Comm_rank(comm,&rank);
614:
615: if (!rank) {
616: fgets(string,len,fp);
617: }
618: MPI_Bcast(string,len,MPI_BYTE,0,comm);
619: return(0);
620: }