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;
30: /*@C
31: PetscFormatConvert - Takes a PETSc format string and converts it to a reqular C format string
33: Input Parameters:
34: + format - the PETSc format string
35: . newformat - the location to put the standard C format string values
36: - size - the length of newformat
38: 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
40: Level: developer
42: @*/
43: PetscErrorCode PetscFormatConvert(const char *format,char *newformat,size_t size)
44: {
45: PetscInt i = 0,j = 0;
47: while (format[i] && i < (PetscInt)size-1) {
48: if (format[i] == '%' && format[i+1] == 'D') {
49: newformat[j++] = '%';
50: #if !defined(PETSC_USE_64BIT_INDICES)
51: newformat[j++] = 'd';
52: #else
53: newformat[j++] = 'l';
54: newformat[j++] = 'l';
55: newformat[j++] = 'd';
56: #endif
57: i += 2;
58: } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
59: newformat[j++] = '%';
60: newformat[j++] = format[i+1];
61: #if !defined(PETSC_USE_64BIT_INDICES)
62: newformat[j++] = 'd';
63: #else
64: newformat[j++] = 'l';
65: newformat[j++] = 'l';
66: newformat[j++] = 'd';
67: #endif
68: i += 3;
69: } else if (format[i] == '%' && format[i+1] == 'G') {
70: newformat[j++] = '%';
71: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
72: newformat[j++] = 'g';
73: #elif defined(PETSC_USE_REAL_LONG_DOUBLE)
74: newformat[j++] = 'L';
75: newformat[j++] = 'g';
76: #elif defined(PETSC_USE_REAL___FLOAT128)
77: newformat[j++] = 'Q';
78: newformat[j++] = 'e';
79: #endif
80: i += 2;
81: }else {
82: newformat[j++] = format[i++];
83: }
84: }
85: newformat[j] = 0;
86: return 0;
87: }
88:
91: /*@C
92: PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
93: function arguments into a string using the format statement.
95: Input Parameters:
96: + str - location to put result
97: . len - the amount of space in str
98: + format - the PETSc format string
99: - fullLength - the amount of space in str actually used.
101: Note: No error handling because may be called by error handler
103: Level: developer
105: @*/
106: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
107: {
108: /* no malloc since may be called by error handler */
109: char *newformat;
110: char formatbuf[8*1024];
111: size_t oldLength,length;
112: int fullLengthInt;
114:
115: PetscStrlen(format, &oldLength);
116: if (oldLength < 8*1024) {
117: newformat = formatbuf;
118: } else {
119: PetscMalloc((oldLength+1) * sizeof(char), &newformat);
120: }
121: PetscFormatConvert(format,newformat,oldLength+1);
122: PetscStrlen(newformat, &length);
123: #if 0
124: if (length > len) {
125: newformat[len] = '\0';
126: }
127: #endif
128: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
129: fullLengthInt = vsnprintf(str,len,newformat,(char *)Argp);
130: #elif defined(PETSC_HAVE_VSNPRINTF)
131: fullLengthInt = vsnprintf(str,len,newformat,Argp);
132: #elif defined(PETSC_HAVE__VSNPRINTF)
133: fullLengthInt = _vsnprintf(str,len,newformat,Argp);
134: #else
135: #error "vsnprintf not found"
136: #endif
137: if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
138: *fullLength = (size_t)fullLengthInt;
139: if (oldLength >= 8*1024) {
140: PetscFree(newformat);
141: }
142: return 0;
143: }
147: PetscErrorCode PetscZopeLog(const char *format,va_list Argp)
148: {
149: /* no malloc since may be called by error handler */
150: char newformat[8*1024];
151: char log[8*1024];
152: char logstart[] = " <<<log>>>";
153: size_t len,formatlen;
155: PetscFormatConvert(format,newformat,8*1024);
156: PetscStrlen(logstart, &len);
157: PetscMemcpy(log, logstart, len);
158: PetscStrlen(newformat, &formatlen);
159: PetscMemcpy(&(log[len]), newformat, formatlen);
160: if (PETSC_ZOPEFD){
161: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
162: vfprintf(PETSC_ZOPEFD,log,(char *)Argp);
163: #else
164: vfprintf(PETSC_ZOPEFD,log,Argp);
165: #endif
166: fflush(PETSC_ZOPEFD);
167: }
168: return 0;
169: }
173: /*@C
174: PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
175: can be replaced with something that does not simply write to a file.
177: To use, write your own function for example,
178: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
179: ${
181: $
183: $ if (fd != stdout && fd != stderr) { handle regular files
184: $ PetscVFPrintfDefault(fd,format,Argp); CHKERR(ierr);
185: $ } else {
186: $ char buff[BIG];
187: $ size_t length;
188: $ PetscVSNPrintf(buff,BIG,format,&length,Argp);
189: $ now send buff to whatever stream or whatever you want
190: $ }
191: $ return(0);
192: $}
193: then before the call to PetscInitialize() do the assignment
194: $ PetscVFPrintf = mypetscvfprintf;
196: Notes: For error messages this may be called by any process, for regular standard out it is
197: called only by process 0 of a given communicator
199: No error handling because may be called by error handler
201: Level: developer
203: .seealso: PetscVSNPrintf(), PetscErrorPrintf()
205: @*/
206: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
207: {
208: /* no malloc since may be called by error handler (assume no long messages in errors) */
209: char *newformat;
210: char formatbuf[8*1024];
211: size_t oldLength;
213: PetscStrlen(format, &oldLength);
214: if (oldLength < 8*1024) {
215: newformat = formatbuf;
216: } else {
217: (void)PetscMalloc((oldLength+1) * sizeof(char), &newformat);
218: }
219: PetscFormatConvert(format,newformat,oldLength+1);
221: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
222: vfprintf(fd,newformat,(char *)Argp);
223: #else
224: vfprintf(fd,newformat,Argp);
225: #endif
226: fflush(fd);
227: if (oldLength >= 8*1024) {
228: (void)PetscFree(newformat);
229: }
230: return 0;
231: }
235: /*@C
236: PetscSNPrintf - Prints to a string of given length
238: Not Collective
240: Input Parameters:
241: + str - the string to print to
242: . len - the length of str
243: . format - the usual printf() format string
244: - any arguments
246: Level: intermediate
248: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
249: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
250: @*/
251: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
252: {
254: size_t fullLength;
255: va_list Argp;
258: va_start(Argp,format);
259: PetscVSNPrintf(str,len,format,&fullLength,Argp);
260: return(0);
261: }
265: /*@C
266: PetscSNPrintfCount - Prints to a string of given length, returns count
268: Not Collective
270: Input Parameters:
271: + str - the string to print to
272: . len - the length of str
273: . format - the usual printf() format string
274: . countused - number of characters used
275: - any arguments
277: Level: intermediate
279: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
280: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
281: @*/
282: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
283: {
285: va_list Argp;
288: va_start(Argp,countused);
289: PetscVSNPrintf(str,len,format,countused,Argp);
290: return(0);
291: }
293: /* ----------------------------------------------------------------------- */
295: PrintfQueue queue = 0,queuebase = 0;
296: int queuelength = 0;
297: FILE *queuefile = PETSC_NULL;
301: /*@C
302: PetscSynchronizedPrintf - Prints synchronized output from several processors.
303: Output of the first processor is followed by that of the second, etc.
305: Not Collective
307: Input Parameters:
308: + comm - the communicator
309: - format - the usual printf() format string
311: Level: intermediate
313: Notes:
314: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
315: from all the processors to be printed.
317: Fortran Note:
318: The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
319: That is, you can only pass a single character string from Fortran.
321: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
322: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
323: @*/
324: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
325: {
327: PetscMPIInt rank;
330: MPI_Comm_rank(comm,&rank);
331:
332: /* First processor prints immediately to stdout */
333: if (!rank) {
334: va_list Argp;
335: va_start(Argp,format);
336: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
337: if (petsc_history) {
338: va_start(Argp,format);
339: (*PetscVFPrintf)(petsc_history,format,Argp);
340: }
341: va_end(Argp);
342: } else { /* other processors add to local queue */
343: va_list Argp;
344: PrintfQueue next;
345: size_t fullLength = 8191;
347: PetscNew(struct _PrintfQueue,&next);
348: if (queue) {queue->next = next; queue = next; queue->next = 0;}
349: else {queuebase = queue = next;}
350: queuelength++;
351: next->size = -1;
352: while((PetscInt)fullLength >= next->size) {
353: next->size = fullLength+1;
354: PetscMalloc(next->size * sizeof(char), &next->string);
355: va_start(Argp,format);
356: PetscMemzero(next->string,next->size);
357: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
358: va_end(Argp);
359: }
360: }
361:
362: return(0);
363: }
364:
367: /*@C
368: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
369: several processors. Output of the first processor is followed by that of the
370: second, etc.
372: Not Collective
374: Input Parameters:
375: + comm - the communicator
376: . fd - the file pointer
377: - format - the usual printf() format string
379: Level: intermediate
381: Notes:
382: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
383: from all the processors to be printed.
385: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
386: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
388: @*/
389: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
390: {
392: PetscMPIInt rank;
395: MPI_Comm_rank(comm,&rank);
396:
397: /* First processor prints immediately to fp */
398: if (!rank) {
399: va_list Argp;
400: va_start(Argp,format);
401: (*PetscVFPrintf)(fp,format,Argp);
402: queuefile = fp;
403: if (petsc_history && (fp !=petsc_history)) {
404: va_start(Argp,format);
405: (*PetscVFPrintf)(petsc_history,format,Argp);
406: }
407: va_end(Argp);
408: } else { /* other processors add to local queue */
409: va_list Argp;
410: PrintfQueue next;
411: size_t fullLength = 8191;
412: PetscNew(struct _PrintfQueue,&next);
413: if (queue) {queue->next = next; queue = next; queue->next = 0;}
414: else {queuebase = queue = next;}
415: queuelength++;
416: next->size = -1;
417: while((PetscInt)fullLength >= next->size) {
418: next->size = fullLength+1;
419: PetscMalloc(next->size * sizeof(char), &next->string);
420: va_start(Argp,format);
421: PetscMemzero(next->string,next->size);
422: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
423: va_end(Argp);
424: }
425: }
426: return(0);
427: }
431: /*@
432: PetscSynchronizedFlush - Flushes to the screen output from all processors
433: involved in previous PetscSynchronizedPrintf() calls.
435: Collective on MPI_Comm
437: Input Parameters:
438: . comm - the communicator
440: Level: intermediate
442: Notes:
443: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
444: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
446: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
447: PetscViewerASCIISynchronizedPrintf()
448: @*/
449: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
450: {
452: PetscMPIInt rank,size,tag,i,j,n,dummy = 0;
453: char *message;
454: MPI_Status status;
455: FILE *fd;
458: PetscCommDuplicate(comm,&comm,&tag);
459: MPI_Comm_rank(comm,&rank);
460: MPI_Comm_size(comm,&size);
462: /* First processor waits for messages from all other processors */
463: if (!rank) {
464: if (queuefile) {
465: fd = queuefile;
466: } else {
467: fd = PETSC_STDOUT;
468: }
469: for (i=1; i<size; i++) {
470: /* to prevent a flood of messages to process zero, request each message separately */
471: MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
472: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
473: for (j=0; j<n; j++) {
474: PetscMPIInt size;
476: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
477: PetscMalloc(size * sizeof(char), &message);
478: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
479: PetscFPrintf(comm,fd,"%s",message);
480: PetscFree(message);
481: }
482: }
483: queuefile = PETSC_NULL;
484: } else { /* other processors send queue to processor 0 */
485: PrintfQueue next = queuebase,previous;
487: MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
488: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
489: for (i=0; i<queuelength; i++) {
490: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
491: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
492: previous = next;
493: next = next->next;
494: PetscFree(previous->string);
495: PetscFree(previous);
496: }
497: queue = 0;
498: queuelength = 0;
499: }
500: PetscCommDestroy(&comm);
501: return(0);
502: }
504: /* ---------------------------------------------------------------------------------------*/
508: /*@C
509: PetscFPrintf - Prints to a file, only from the first
510: processor in the communicator.
512: Not Collective
514: Input Parameters:
515: + comm - the communicator
516: . fd - the file pointer
517: - format - the usual printf() format string
519: Level: intermediate
521: Fortran Note:
522: This routine is not supported in Fortran.
524: Concepts: printing^in parallel
525: Concepts: printf^in parallel
527: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
528: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
529: @*/
530: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
531: {
533: PetscMPIInt rank;
536: MPI_Comm_rank(comm,&rank);
537: if (!rank) {
538: va_list Argp;
539: va_start(Argp,format);
540: (*PetscVFPrintf)(fd,format,Argp);
541: if (petsc_history && (fd !=petsc_history)) {
542: va_start(Argp,format);
543: (*PetscVFPrintf)(petsc_history,format,Argp);
544: }
545: va_end(Argp);
546: }
547: return(0);
548: }
552: /*@C
553: PetscPrintf - Prints to standard out, only from the first
554: processor in the communicator.
556: Not Collective
558: Input Parameters:
559: + comm - the communicator
560: - format - the usual printf() format string
562: Level: intermediate
564: Fortran Note:
565: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
566: That is, you can only pass a single character string from Fortran.
568: Notes: The %A format specifier is special. It assumes an argument of type PetscReal
569: and is replaced with %G unless the absolute value is < 1.e-12 when it is replaced
570: with "< 1.e-12" (1.e-6 for single precision).
572: Concepts: printing^in parallel
573: Concepts: printf^in parallel
575: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
576: @*/
577: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
578: {
580: PetscMPIInt rank;
581: size_t len;
582: char *nformat,*sub1,*sub2;
583: PetscReal value;
586: if (!comm) comm = PETSC_COMM_WORLD;
587: MPI_Comm_rank(comm,&rank);
588: if (!rank) {
589: va_list Argp;
590: va_start(Argp,format);
592: PetscStrstr(format,"%A",&sub1);
593: if (sub1) {
594: PetscStrstr(format,"%",&sub2);
595: if (sub1 != sub2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
596: PetscStrlen(format,&len);
597: PetscMalloc((len+16)*sizeof(char),&nformat);
598: PetscStrcpy(nformat,format);
599: PetscStrstr(nformat,"%",&sub2);
600: sub2[0] = 0;
601: value = va_arg(Argp,double);
602: #if defined(PETSC_USE_REAL_SINGLE)
603: if (PetscAbsReal(value) < 1.e-6) {
604: PetscStrcat(nformat,"< 1.e-6");
605: #else
606: if (PetscAbsReal(value) < 1.e-12) {
607: PetscStrcat(nformat,"< 1.e-12");
608: #endif
609: } else {
610: PetscStrcat(nformat,"%G");
611: va_end(Argp);
612: va_start(Argp,format);
613: }
614: PetscStrcat(nformat,sub1+2);
615: } else {
616: nformat = (char*)format;
617: }
618: (*PetscVFPrintf)(PETSC_STDOUT,nformat,Argp);
619: if (petsc_history) {
620: va_start(Argp,format);
621: (*PetscVFPrintf)(petsc_history,nformat,Argp);
622: }
623: va_end(Argp);
624: if (sub1) {PetscFree(nformat);}
625: }
626: return(0);
627: }
629: /* ---------------------------------------------------------------------------------------*/
632: /*@C
633: PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by
634: replacinng it with something that does not simply write to a stdout.
636: To use, write your own function for example,
637: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
638: ${
639: $ return(0);
640: $}
641: then before the call to PetscInitialize() do the assignment
642: $ PetscHelpPrintf = mypetschelpprintf;
644: Note: the default routine used is called PetscHelpPrintfDefault().
646: Level: developer
648: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
649: @*/
650: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
651: {
653: PetscMPIInt rank;
656: if (!comm) comm = PETSC_COMM_WORLD;
657: MPI_Comm_rank(comm,&rank);
658: if (!rank) {
659: va_list Argp;
660: va_start(Argp,format);
661: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
662: if (petsc_history) {
663: va_start(Argp,format);
664: (*PetscVFPrintf)(petsc_history,format,Argp);
665: }
666: va_end(Argp);
667: }
668: return(0);
669: }
671: /* ---------------------------------------------------------------------------------------*/
676: /*@C
677: PetscSynchronizedFGets - Several processors all get the same line from a file.
679: Collective on MPI_Comm
681: Input Parameters:
682: + comm - the communicator
683: . fd - the file pointer
684: - len - the length of the output buffer
686: Output Parameter:
687: . string - the line read from the file
689: Level: intermediate
691: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
692: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
694: @*/
695: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
696: {
698: PetscMPIInt rank;
701: MPI_Comm_rank(comm,&rank);
703: if (!rank) {
704: char *ptr = fgets(string, len, fp);
706: if (!ptr) {
707: if (feof(fp)) {
708: len = 0;
709: } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
710: }
711: }
712: MPI_Bcast(string,len,MPI_BYTE,0,comm);
713: return(0);
714: }
716: #if defined(PETSC_HAVE_MATLAB_ENGINE)
717: #include <mex.h>
720: PetscErrorCode PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
721: {
725: if (fd != stdout && fd != stderr) { /* handle regular files */
726: PetscVFPrintfDefault(fd,format,Argp);
727: } else {
728: size_t len=8*1024,length;
729: char buf[len];
731: PetscVSNPrintf(buf,len,format,&length,Argp);
732: mexPrintf("%s",buf);
733: }
734: return(0);
735: }
736: #endif