Actual source code: mprint.c
1: /*
2: Utilites routines to add simple ASCII IO capability.
3: */
4: #include <../src/sys/fileio/mprint.h>
5: #include <errno.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;
28: /*
29: Return the maximum expected new size of the format
30: */
31: #define PETSC_MAX_LENGTH_FORMAT(l) (l+l/8)
35: /*@C
36: PetscFormatConvert - Takes a PETSc format string and converts it to a reqular C format string
38: Input Parameters:
39: + format - the PETSc format string
40: . newformat - the location to put the standard C format string values
41: - size - the length of newformat
43: Note: this exists so we can have the same code when PetscInt is either int or long long and PetscScalar is either double or float
45: Level: developer
47: @*/
48: PetscErrorCode PetscFormatConvert(const char *format,char *newformat,size_t size)
49: {
50: PetscInt i = 0,j = 0;
52: while (format[i] && j < (PetscInt)size-1) {
53: if (format[i] == '%' && format[i+1] != '%') {
54: /* Find the letter */
55: for ( ; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
56: switch (format[i]) {
57: case 'D':
58: #if !defined(PETSC_USE_64BIT_INDICES)
59: newformat[j++] = 'd';
60: #else
61: newformat[j++] = 'l';
62: newformat[j++] = 'l';
63: newformat[j++] = 'd';
64: #endif
65: break;
66: case 'G':
67: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
68: newformat[j++] = 'g';
69: #elif defined(PETSC_USE_REAL_LONG_DOUBLE)
70: newformat[j++] = 'L';
71: newformat[j++] = 'g';
72: #elif defined(PETSC_USE_REAL___FLOAT128)
73: newformat[j++] = 'Q';
74: newformat[j++] = 'g';
75: #endif
76: break;
77: case 'F':
78: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
79: newformat[j++] = 'f';
80: #elif defined(PETSC_USE_REAL_LONG_DOUBLE)
81: newformat[j++] = 'L';
82: newformat[j++] = 'f';
83: #elif defined(PETSC_USE_REAL___FLOAT128)
84: newformat[j++] = 'Q';
85: newformat[j++] = 'f';
86: #endif
87: break;
88: default:
89: newformat[j++] = format[i];
90: break;
91: }
92: i++;
93: } else {
94: newformat[j++] = format[i++];
95: }
96: }
97: newformat[j] = 0;
98: return 0;
99: }
100:
103: /*@C
104: PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
105: function arguments into a string using the format statement.
107: Input Parameters:
108: + str - location to put result
109: . len - the amount of space in str
110: + format - the PETSc format string
111: - fullLength - the amount of space in str actually used.
113: Note: No error handling because may be called by error handler
115: Level: developer
117: @*/
118: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
119: {
120: /* no malloc since may be called by error handler */
121: char *newformat;
122: char formatbuf[8*1024];
123: size_t oldLength,length;
124: int fullLengthInt;
126:
127: PetscStrlen(format, &oldLength);
128: if (oldLength < 8*1024) {
129: newformat = formatbuf;
130: oldLength = 8*1024-1;
131: } else {
132: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
133: PetscMalloc(oldLength * sizeof(char), &newformat);
134: }
135: PetscFormatConvert(format,newformat,oldLength);
136: PetscStrlen(newformat, &length);
137: #if 0
138: if (length > len) {
139: newformat[len] = '\0';
140: }
141: #endif
142: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
143: fullLengthInt = vsnprintf(str,len,newformat,(char *)Argp);
144: #elif defined(PETSC_HAVE_VSNPRINTF)
145: fullLengthInt = vsnprintf(str,len,newformat,Argp);
146: #elif defined(PETSC_HAVE__VSNPRINTF)
147: fullLengthInt = _vsnprintf(str,len,newformat,Argp);
148: #else
149: #error "vsnprintf not found"
150: #endif
151: if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
152: *fullLength = (size_t)fullLengthInt;
153: if (oldLength >= 8*1024) {
154: PetscFree(newformat);
155: }
156: return 0;
157: }
161: PetscErrorCode PetscZopeLog(const char *format,va_list Argp)
162: {
163: /* no malloc since may be called by error handler */
164: char newformat[8*1024];
165: char log[8*1024];
166: char logstart[] = " <<<log>>>";
167: size_t len,formatlen;
169: PetscFormatConvert(format,newformat,8*1024);
170: PetscStrlen(logstart, &len);
171: PetscMemcpy(log, logstart, len);
172: PetscStrlen(newformat, &formatlen);
173: PetscMemcpy(&(log[len]), newformat, formatlen);
174: if (PETSC_ZOPEFD){
175: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
176: vfprintf(PETSC_ZOPEFD,log,(char *)Argp);
177: #else
178: vfprintf(PETSC_ZOPEFD,log,Argp);
179: #endif
180: fflush(PETSC_ZOPEFD);
181: }
182: return 0;
183: }
187: /*@C
188: PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
189: can be replaced with something that does not simply write to a file.
191: To use, write your own function for example,
192: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
193: ${
195: $
197: $ if (fd != stdout && fd != stderr) { handle regular files
198: $ PetscVFPrintfDefault(fd,format,Argp); CHKERR(ierr);
199: $ } else {
200: $ char buff[BIG];
201: $ size_t length;
202: $ PetscVSNPrintf(buff,BIG,format,&length,Argp);
203: $ now send buff to whatever stream or whatever you want
204: $ }
205: $ return(0);
206: $}
207: then before the call to PetscInitialize() do the assignment
208: $ PetscVFPrintf = mypetscvfprintf;
210: Notes: For error messages this may be called by any process, for regular standard out it is
211: called only by process 0 of a given communicator
213: No error handling because may be called by error handler
215: Level: developer
217: .seealso: PetscVSNPrintf(), PetscErrorPrintf()
219: @*/
220: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
221: {
222: /* no malloc since may be called by error handler (assume no long messages in errors) */
223: char *newformat;
224: char formatbuf[8*1024];
225: size_t oldLength;
227: PetscStrlen(format, &oldLength);
228: if (oldLength < 8*1024) {
229: newformat = formatbuf;
230: oldLength = 8*1024-1;
231: } else {
232: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
233: (void)PetscMalloc(oldLength * sizeof(char), &newformat);
234: }
235: PetscFormatConvert(format,newformat,oldLength);
237: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
238: vfprintf(fd,newformat,(char *)Argp);
239: #else
240: vfprintf(fd,newformat,Argp);
241: #endif
242: fflush(fd);
243: if (oldLength >= 8*1024) {
244: (void)PetscFree(newformat);
245: }
246: return 0;
247: }
251: /*@C
252: PetscSNPrintf - Prints to a string of given length
254: Not Collective
256: Input Parameters:
257: + str - the string to print to
258: . len - the length of str
259: . format - the usual printf() format string
260: - any arguments
262: Level: intermediate
264: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
265: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
266: @*/
267: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
268: {
270: size_t fullLength;
271: va_list Argp;
274: va_start(Argp,format);
275: PetscVSNPrintf(str,len,format,&fullLength,Argp);
276: return(0);
277: }
281: /*@C
282: PetscSNPrintfCount - Prints to a string of given length, returns count
284: Not Collective
286: Input Parameters:
287: + str - the string to print to
288: . len - the length of str
289: . format - the usual printf() format string
290: . countused - number of characters used
291: - any arguments
293: Level: intermediate
295: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
296: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
297: @*/
298: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
299: {
301: va_list Argp;
304: va_start(Argp,countused);
305: PetscVSNPrintf(str,len,format,countused,Argp);
306: return(0);
307: }
309: /* ----------------------------------------------------------------------- */
311: PrintfQueue queue = 0,queuebase = 0;
312: int queuelength = 0;
313: FILE *queuefile = PETSC_NULL;
317: /*@C
318: PetscSynchronizedPrintf - Prints synchronized output from several processors.
319: Output of the first processor is followed by that of the second, etc.
321: Not Collective
323: Input Parameters:
324: + comm - the communicator
325: - format - the usual printf() format string
327: Level: intermediate
329: Notes:
330: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
331: from all the processors to be printed.
333: Fortran Note:
334: The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
335: That is, you can only pass a single character string from Fortran.
337: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
338: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
339: @*/
340: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
341: {
343: PetscMPIInt rank;
346: MPI_Comm_rank(comm,&rank);
347:
348: /* First processor prints immediately to stdout */
349: if (!rank) {
350: va_list Argp;
351: va_start(Argp,format);
352: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
353: if (petsc_history) {
354: va_start(Argp,format);
355: (*PetscVFPrintf)(petsc_history,format,Argp);
356: }
357: va_end(Argp);
358: } else { /* other processors add to local queue */
359: va_list Argp;
360: PrintfQueue next;
361: size_t fullLength = 8191;
363: PetscNew(struct _PrintfQueue,&next);
364: if (queue) {queue->next = next; queue = next; queue->next = 0;}
365: else {queuebase = queue = next;}
366: queuelength++;
367: next->size = -1;
368: while((PetscInt)fullLength >= next->size) {
369: next->size = fullLength+1;
370: PetscMalloc(next->size * sizeof(char), &next->string);
371: va_start(Argp,format);
372: PetscMemzero(next->string,next->size);
373: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
374: va_end(Argp);
375: }
376: }
377:
378: return(0);
379: }
380:
383: /*@C
384: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
385: several processors. Output of the first processor is followed by that of the
386: second, etc.
388: Not Collective
390: Input Parameters:
391: + comm - the communicator
392: . fd - the file pointer
393: - format - the usual printf() format string
395: Level: intermediate
397: Notes:
398: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
399: from all the processors to be printed.
401: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
402: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
404: @*/
405: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
406: {
408: PetscMPIInt rank;
411: MPI_Comm_rank(comm,&rank);
412:
413: /* First processor prints immediately to fp */
414: if (!rank) {
415: va_list Argp;
416: va_start(Argp,format);
417: (*PetscVFPrintf)(fp,format,Argp);
418: queuefile = fp;
419: if (petsc_history && (fp !=petsc_history)) {
420: va_start(Argp,format);
421: (*PetscVFPrintf)(petsc_history,format,Argp);
422: }
423: va_end(Argp);
424: } else { /* other processors add to local queue */
425: va_list Argp;
426: PrintfQueue next;
427: size_t fullLength = 8191;
428: PetscNew(struct _PrintfQueue,&next);
429: if (queue) {queue->next = next; queue = next; queue->next = 0;}
430: else {queuebase = queue = next;}
431: queuelength++;
432: next->size = -1;
433: while((PetscInt)fullLength >= next->size) {
434: next->size = fullLength+1;
435: PetscMalloc(next->size * sizeof(char), &next->string);
436: va_start(Argp,format);
437: PetscMemzero(next->string,next->size);
438: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
439: va_end(Argp);
440: }
441: }
442: return(0);
443: }
447: /*@
448: PetscSynchronizedFlush - Flushes to the screen output from all processors
449: involved in previous PetscSynchronizedPrintf() calls.
451: Collective on MPI_Comm
453: Input Parameters:
454: . comm - the communicator
456: Level: intermediate
458: Notes:
459: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
460: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
462: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
463: PetscViewerASCIISynchronizedPrintf()
464: @*/
465: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
466: {
468: PetscMPIInt rank,size,tag,i,j,n,dummy = 0;
469: char *message;
470: MPI_Status status;
471: FILE *fd;
474: PetscCommDuplicate(comm,&comm,&tag);
475: MPI_Comm_rank(comm,&rank);
476: MPI_Comm_size(comm,&size);
478: /* First processor waits for messages from all other processors */
479: if (!rank) {
480: if (queuefile) {
481: fd = queuefile;
482: } else {
483: fd = PETSC_STDOUT;
484: }
485: for (i=1; i<size; i++) {
486: /* to prevent a flood of messages to process zero, request each message separately */
487: MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
488: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
489: for (j=0; j<n; j++) {
490: PetscMPIInt size;
492: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
493: PetscMalloc(size * sizeof(char), &message);
494: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
495: PetscFPrintf(comm,fd,"%s",message);
496: PetscFree(message);
497: }
498: }
499: queuefile = PETSC_NULL;
500: } else { /* other processors send queue to processor 0 */
501: PrintfQueue next = queuebase,previous;
503: MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
504: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
505: for (i=0; i<queuelength; i++) {
506: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
507: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
508: previous = next;
509: next = next->next;
510: PetscFree(previous->string);
511: PetscFree(previous);
512: }
513: queue = 0;
514: queuelength = 0;
515: }
516: PetscCommDestroy(&comm);
517: return(0);
518: }
520: /* ---------------------------------------------------------------------------------------*/
524: /*@C
525: PetscFPrintf - Prints to a file, only from the first
526: processor in the communicator.
528: Not Collective
530: Input Parameters:
531: + comm - the communicator
532: . fd - the file pointer
533: - format - the usual printf() format string
535: Level: intermediate
537: Fortran Note:
538: This routine is not supported in Fortran.
540: Concepts: printing^in parallel
541: Concepts: printf^in parallel
543: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
544: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
545: @*/
546: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
547: {
549: PetscMPIInt rank;
552: MPI_Comm_rank(comm,&rank);
553: if (!rank) {
554: va_list Argp;
555: va_start(Argp,format);
556: (*PetscVFPrintf)(fd,format,Argp);
557: if (petsc_history && (fd !=petsc_history)) {
558: va_start(Argp,format);
559: (*PetscVFPrintf)(petsc_history,format,Argp);
560: }
561: va_end(Argp);
562: }
563: return(0);
564: }
568: /*@C
569: PetscPrintf - Prints to standard out, only from the first
570: processor in the communicator.
572: Not Collective
574: Input Parameters:
575: + comm - the communicator
576: - format - the usual printf() format string
578: Level: intermediate
580: Fortran Note:
581: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
582: That is, you can only pass a single character string from Fortran.
584: Notes: The %A format specifier is special. It assumes an argument of type PetscReal
585: and is replaced with %G unless the absolute value is < 1.e-12 when it is replaced
586: with "< 1.e-12" (1.e-6 for single precision).
588: Concepts: printing^in parallel
589: Concepts: printf^in parallel
591: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
592: @*/
593: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
594: {
596: PetscMPIInt rank;
597: size_t len;
598: char *nformat,*sub1,*sub2;
599: PetscReal value;
602: if (!comm) comm = PETSC_COMM_WORLD;
603: MPI_Comm_rank(comm,&rank);
604: if (!rank) {
605: va_list Argp;
606: va_start(Argp,format);
608: PetscStrstr(format,"%A",&sub1);
609: if (sub1) {
610: PetscStrstr(format,"%",&sub2);
611: if (sub1 != sub2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
612: PetscStrlen(format,&len);
613: PetscMalloc((len+16)*sizeof(char),&nformat);
614: PetscStrcpy(nformat,format);
615: PetscStrstr(nformat,"%",&sub2);
616: sub2[0] = 0;
617: value = va_arg(Argp,double);
618: #if defined(PETSC_USE_REAL_SINGLE)
619: if (PetscAbsReal(value) < 1.e-6) {
620: PetscStrcat(nformat,"< 1.e-6");
621: #else
622: if (PetscAbsReal(value) < 1.e-12) {
623: PetscStrcat(nformat,"< 1.e-12");
624: #endif
625: } else {
626: PetscStrcat(nformat,"%G");
627: va_end(Argp);
628: va_start(Argp,format);
629: }
630: PetscStrcat(nformat,sub1+2);
631: } else {
632: nformat = (char*)format;
633: }
634: (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
635: if (petsc_history) {
636: va_start(Argp,format);
637: (*PetscVFPrintf)(petsc_history,nformat,Argp);
638: }
639: va_end(Argp);
640: if (sub1) {PetscFree(nformat);}
641: }
642: return(0);
643: }
645: /* ---------------------------------------------------------------------------------------*/
648: /*@C
649: PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by
650: replacinng it with something that does not simply write to a stdout.
652: To use, write your own function for example,
653: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
654: ${
655: $ return(0);
656: $}
657: then before the call to PetscInitialize() do the assignment
658: $ PetscHelpPrintf = mypetschelpprintf;
660: Note: the default routine used is called PetscHelpPrintfDefault().
662: Level: developer
664: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
665: @*/
666: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
667: {
669: PetscMPIInt rank;
672: if (!comm) comm = PETSC_COMM_WORLD;
673: MPI_Comm_rank(comm,&rank);
674: if (!rank) {
675: va_list Argp;
676: va_start(Argp,format);
677: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
678: if (petsc_history) {
679: va_start(Argp,format);
680: (*PetscVFPrintf)(petsc_history,format,Argp);
681: }
682: va_end(Argp);
683: }
684: return(0);
685: }
687: /* ---------------------------------------------------------------------------------------*/
692: /*@C
693: PetscSynchronizedFGets - Several processors all get the same line from a file.
695: Collective on MPI_Comm
697: Input Parameters:
698: + comm - the communicator
699: . fd - the file pointer
700: - len - the length of the output buffer
702: Output Parameter:
703: . string - the line read from the file
705: Level: intermediate
707: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
708: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
710: @*/
711: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
712: {
714: PetscMPIInt rank;
717: MPI_Comm_rank(comm,&rank);
719: if (!rank) {
720: char *ptr = fgets(string, len, fp);
722: if (!ptr) {
723: if (feof(fp)) {
724: len = 0;
725: } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
726: }
727: }
728: MPI_Bcast(string,len,MPI_BYTE,0,comm);
729: return(0);
730: }
732: #if defined(PETSC_HAVE_MATLAB_ENGINE)
733: #include <mex.h>
736: PetscErrorCode PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
737: {
741: if (fd != stdout && fd != stderr) { /* handle regular files */
742: PetscVFPrintfDefault(fd,format,Argp);
743: } else {
744: size_t len=8*1024,length;
745: char buf[len];
747: PetscVSNPrintf(buf,len,format,&length,Argp);
748: mexPrintf("%s",buf);
749: }
750: return(0);
751: }
752: #endif