Actual source code: mprint.c
petsc-3.3-p7 2013-05-11
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: */
10: extern FILE *petsc_history;
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;
24: /*
25: Return the maximum expected new size of the format
26: */
27: #define PETSC_MAX_LENGTH_FORMAT(l) (l+l/8)
31: /*@C
32: PetscFormatConvert - Takes a PETSc format string and converts it to a reqular C format string
34: Input Parameters:
35: + format - the PETSc format string
36: . newformat - the location to put the standard C format string values
37: - size - the length of newformat
39: Note: this exists so we can have the same code when PetscInt is either int or long long and PetscScalar is either __float128, double, or float
41: Level: developer
43: @*/
44: PetscErrorCode PetscFormatConvert(const char *format,char *newformat,size_t size)
45: {
46: PetscInt i = 0,j = 0;
49: while (format[i] && j < (PetscInt)size-1) {
50: if (format[i] == '%' && format[i+1] != '%') {
51: /* Find the letter */
52: for ( ; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
53: switch (format[i]) {
54: case 'D':
55: #if !defined(PETSC_USE_64BIT_INDICES)
56: newformat[j++] = 'd';
57: #else
58: newformat[j++] = 'l';
59: newformat[j++] = 'l';
60: newformat[j++] = 'd';
61: #endif
62: break;
63: case 'G':
64: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
65: newformat[j++] = 'g';
66: #elif defined(PETSC_USE_REAL___FLOAT128)
67: newformat[j++] = 'Q';
68: newformat[j++] = 'g';
69: #endif
70: break;
71: case 'F':
72: #if defined(PETSC_USE_REAL_DOUBLE) || defined(PETSC_USE_REAL_SINGLE)
73: newformat[j++] = 'f';
74: #elif defined(PETSC_USE_REAL_LONG_DOUBLE)
75: newformat[j++] = 'L';
76: newformat[j++] = 'f';
77: #elif defined(PETSC_USE_REAL___FLOAT128)
78: newformat[j++] = 'Q';
79: newformat[j++] = 'f';
80: #endif
81: break;
82: default:
83: newformat[j++] = format[i];
84: break;
85: }
86: i++;
87: } else {
88: newformat[j++] = format[i++];
89: }
90: }
91: newformat[j] = 0;
92: return(0);
93: }
94:
97: /*@C
98: PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
99: function arguments into a string using the format statement.
101: Input Parameters:
102: + str - location to put result
103: . len - the amount of space in str
104: + format - the PETSc format string
105: - fullLength - the amount of space in str actually used.
107: Developer Notes: this function may be called from an error handler, if an error occurs when it is called by the error handler than likely
108: a recursion will occur and possible crash.
110: Level: developer
112: @*/
113: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
114: {
115: char *newformat;
116: char formatbuf[8*1024];
117: size_t oldLength,length;
118: int fullLengthInt;
122: PetscStrlen(format, &oldLength);
123: if (oldLength < 8*1024) {
124: newformat = formatbuf;
125: oldLength = 8*1024-1;
126: } else {
127: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
128: PetscMalloc(oldLength * sizeof(char), &newformat);
129: }
130: PetscFormatConvert(format,newformat,oldLength);
131: PetscStrlen(newformat, &length);
132: #if 0
133: if (length > len) {
134: newformat[len] = '\0';
135: }
136: #endif
137: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
138: fullLengthInt = vsnprintf(str,len,newformat,(char *)Argp);
139: #elif defined(PETSC_HAVE_VSNPRINTF)
140: fullLengthInt = vsnprintf(str,len,newformat,Argp);
141: #elif defined(PETSC_HAVE__VSNPRINTF)
142: fullLengthInt = _vsnprintf(str,len,newformat,Argp);
143: #else
144: #error "vsnprintf not found"
145: #endif
146: if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
147: if (fullLength) *fullLength = (size_t)fullLengthInt;
148: if (oldLength >= 8*1024) {
149: PetscFree(newformat);
150: }
151: return(0);
152: }
156: /*@C
157: PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
158: can be replaced with something that does not simply write to a file.
160: To use, write your own function for example,
161: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
162: ${
164: $
166: $ if (fd != stdout && fd != stderr) { handle regular files
167: $ PetscVFPrintfDefault(fd,format,Argp); CHKERR(ierr);
168: $ } else {
169: $ char buff[BIG];
170: $ size_t length;
171: $ PetscVSNPrintf(buff,BIG,format,&length,Argp);
172: $ now send buff to whatever stream or whatever you want
173: $ }
174: $ return(0);
175: $}
176: then before the call to PetscInitialize() do the assignment
177: $ PetscVFPrintf = mypetscvfprintf;
179: Notes: For error messages this may be called by any process, for regular standard out it is
180: called only by process 0 of a given communicator
182: Developer Notes: this could be called by an error handler, if that happens then a recursion of the error handler may occur
183: and a crash
185: Level: developer
187: .seealso: PetscVSNPrintf(), PetscErrorPrintf()
189: @*/
190: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
191: {
192: char *newformat;
193: char formatbuf[8*1024];
194: size_t oldLength;
198: PetscStrlen(format, &oldLength);
199: if (oldLength < 8*1024) {
200: newformat = formatbuf;
201: oldLength = 8*1024-1;
202: } else {
203: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
204: PetscMalloc(oldLength * sizeof(char), &newformat);
205: }
206: PetscFormatConvert(format,newformat,oldLength);
208: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
209: vfprintf(fd,newformat,(char *)Argp);
210: #else
211: vfprintf(fd,newformat,Argp);
212: #endif
213: fflush(fd);
214: if (oldLength >= 8*1024) {
215: PetscFree(newformat);
216: }
217: return(0);
218: }
222: /*@C
223: PetscSNPrintf - Prints to a string of given length
225: Not Collective
227: Input Parameters:
228: + str - the string to print to
229: . len - the length of str
230: . format - the usual printf() format string
231: - any arguments
233: Level: intermediate
235: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
236: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
237: @*/
238: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
239: {
241: size_t fullLength;
242: va_list Argp;
245: va_start(Argp,format);
246: PetscVSNPrintf(str,len,format,&fullLength,Argp);
247: return(0);
248: }
252: /*@C
253: PetscSNPrintfCount - Prints to a string of given length, returns count
255: Not Collective
257: Input Parameters:
258: + str - the string to print to
259: . len - the length of str
260: . format - the usual printf() format string
261: . countused - number of characters used
262: - any arguments
264: Level: intermediate
266: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
267: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
268: @*/
269: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
270: {
272: va_list Argp;
275: va_start(Argp,countused);
276: PetscVSNPrintf(str,len,format,countused,Argp);
277: return(0);
278: }
280: /* ----------------------------------------------------------------------- */
282: PrintfQueue petsc_printfqueue = 0,petsc_printfqueuebase = 0;
283: int petsc_printfqueuelength = 0;
284: FILE *petsc_printfqueuefile = PETSC_NULL;
288: /*@C
289: PetscSynchronizedPrintf - Prints synchronized output from several processors.
290: Output of the first processor is followed by that of the second, etc.
292: Not Collective
294: Input Parameters:
295: + comm - the communicator
296: - format - the usual printf() format string
298: Level: intermediate
300: Notes:
301: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
302: from all the processors to be printed.
304: Fortran Note:
305: The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
306: That is, you can only pass a single character string from Fortran.
308: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
309: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
310: @*/
311: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
312: {
314: PetscMPIInt rank;
317: MPI_Comm_rank(comm,&rank);
318:
319: /* First processor prints immediately to stdout */
320: if (!rank) {
321: va_list Argp;
322: va_start(Argp,format);
323: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
324: if (petsc_history) {
325: va_start(Argp,format);
326: (*PetscVFPrintf)(petsc_history,format,Argp);
327: }
328: va_end(Argp);
329: } else { /* other processors add to local queue */
330: va_list Argp;
331: PrintfQueue next;
332: size_t fullLength = 8191;
334: PetscNew(struct _PrintfQueue,&next);
335: if (petsc_printfqueue) {petsc_printfqueue->next = next; petsc_printfqueue = next; petsc_printfqueue->next = 0;}
336: else {petsc_printfqueuebase = petsc_printfqueue = next;}
337: petsc_printfqueuelength++;
338: next->size = -1;
339: while((PetscInt)fullLength >= next->size) {
340: next->size = fullLength+1;
341: PetscMalloc(next->size * sizeof(char), &next->string);
342: va_start(Argp,format);
343: PetscMemzero(next->string,next->size);
344: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
345: va_end(Argp);
346: }
347: }
348:
349: return(0);
350: }
351:
354: /*@C
355: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
356: several processors. Output of the first processor is followed by that of the
357: second, etc.
359: Not Collective
361: Input Parameters:
362: + comm - the communicator
363: . fd - the file pointer
364: - format - the usual printf() format string
366: Level: intermediate
368: Notes:
369: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
370: from all the processors to be printed.
372: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
373: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
375: @*/
376: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
377: {
379: PetscMPIInt rank;
382: MPI_Comm_rank(comm,&rank);
383:
384: /* First processor prints immediately to fp */
385: if (!rank) {
386: va_list Argp;
387: va_start(Argp,format);
388: (*PetscVFPrintf)(fp,format,Argp);
389: petsc_printfqueuefile = fp;
390: if (petsc_history && (fp !=petsc_history)) {
391: va_start(Argp,format);
392: (*PetscVFPrintf)(petsc_history,format,Argp);
393: }
394: va_end(Argp);
395: } else { /* other processors add to local queue */
396: va_list Argp;
397: PrintfQueue next;
398: size_t fullLength = 8191;
399: PetscNew(struct _PrintfQueue,&next);
400: if (petsc_printfqueue) {petsc_printfqueue->next = next; petsc_printfqueue = next; petsc_printfqueue->next = 0;}
401: else {petsc_printfqueuebase = petsc_printfqueue = next;}
402: petsc_printfqueuelength++;
403: next->size = -1;
404: while((PetscInt)fullLength >= next->size) {
405: next->size = fullLength+1;
406: PetscMalloc(next->size * sizeof(char), &next->string);
407: va_start(Argp,format);
408: PetscMemzero(next->string,next->size);
409: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
410: va_end(Argp);
411: }
412: }
413: return(0);
414: }
418: /*@
419: PetscSynchronizedFlush - Flushes to the screen output from all processors
420: involved in previous PetscSynchronizedPrintf() calls.
422: Collective on MPI_Comm
424: Input Parameters:
425: . comm - the communicator
427: Level: intermediate
429: Notes:
430: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
431: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
433: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
434: PetscViewerASCIISynchronizedPrintf()
435: @*/
436: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
437: {
439: PetscMPIInt rank,size,tag,i,j,n,dummy = 0;
440: char *message;
441: MPI_Status status;
442: FILE *fd;
445: PetscCommDuplicate(comm,&comm,&tag);
446: MPI_Comm_rank(comm,&rank);
447: MPI_Comm_size(comm,&size);
449: /* First processor waits for messages from all other processors */
450: if (!rank) {
451: if (petsc_printfqueuefile) {
452: fd = petsc_printfqueuefile;
453: } else {
454: fd = PETSC_STDOUT;
455: }
456: for (i=1; i<size; i++) {
457: /* to prevent a flood of messages to process zero, request each message separately */
458: MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
459: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
460: for (j=0; j<n; j++) {
461: PetscMPIInt size;
463: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
464: PetscMalloc(size * sizeof(char), &message);
465: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
466: PetscFPrintf(comm,fd,"%s",message);
467: PetscFree(message);
468: }
469: }
470: petsc_printfqueuefile = PETSC_NULL;
471: } else { /* other processors send queue to processor 0 */
472: PrintfQueue next = petsc_printfqueuebase,previous;
474: MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
475: MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
476: for (i=0; i<petsc_printfqueuelength; i++) {
477: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
478: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
479: previous = next;
480: next = next->next;
481: PetscFree(previous->string);
482: PetscFree(previous);
483: }
484: petsc_printfqueue = 0;
485: petsc_printfqueuelength = 0;
486: }
487: PetscCommDestroy(&comm);
488: return(0);
489: }
491: /* ---------------------------------------------------------------------------------------*/
495: /*@C
496: PetscFPrintf - Prints to a file, only from the first
497: processor in the communicator.
499: Not Collective
501: Input Parameters:
502: + comm - the communicator
503: . fd - the file pointer
504: - format - the usual printf() format string
506: Level: intermediate
508: Fortran Note:
509: This routine is not supported in Fortran.
511: Concepts: printing^in parallel
512: Concepts: printf^in parallel
514: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
515: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
516: @*/
517: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
518: {
520: PetscMPIInt rank;
523: MPI_Comm_rank(comm,&rank);
524: if (!rank) {
525: va_list Argp;
526: va_start(Argp,format);
527: (*PetscVFPrintf)(fd,format,Argp);
528: if (petsc_history && (fd !=petsc_history)) {
529: va_start(Argp,format);
530: (*PetscVFPrintf)(petsc_history,format,Argp);
531: }
532: va_end(Argp);
533: }
534: return(0);
535: }
539: /*@C
540: PetscPrintf - Prints to standard out, only from the first
541: processor in the communicator. Calls from other processes are ignored.
543: Not Collective
545: Input Parameters:
546: + comm - the communicator
547: - format - the usual printf() format string
549: Level: intermediate
551: Fortran Note:
552: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
553: That is, you can only pass a single character string from Fortran.
555: Concepts: printing^in parallel
556: Concepts: printf^in parallel
558: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
559: @*/
560: PetscErrorCode PetscPrintf(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: va_start(Argp,format);
574: (*PetscVFPrintf)(petsc_history,format,Argp);
575: }
576: va_end(Argp);
577: }
578: return(0);
579: }
581: /* ---------------------------------------------------------------------------------------*/
584: /*@C
585: PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by
586: replacinng it with something that does not simply write to a stdout.
588: To use, write your own function for example,
589: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
590: ${
591: $ return(0);
592: $}
593: then before the call to PetscInitialize() do the assignment
594: $ PetscHelpPrintf = mypetschelpprintf;
596: Note: the default routine used is called PetscHelpPrintfDefault().
598: Level: developer
600: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
601: @*/
602: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
603: {
605: PetscMPIInt rank;
608: if (!comm) comm = PETSC_COMM_WORLD;
609: MPI_Comm_rank(comm,&rank);
610: if (!rank) {
611: va_list Argp;
612: va_start(Argp,format);
613: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
614: if (petsc_history) {
615: va_start(Argp,format);
616: (*PetscVFPrintf)(petsc_history,format,Argp);
617: }
618: va_end(Argp);
619: }
620: return(0);
621: }
623: /* ---------------------------------------------------------------------------------------*/
628: /*@C
629: PetscSynchronizedFGets - Several processors all get the same line from a file.
631: Collective on MPI_Comm
633: Input Parameters:
634: + comm - the communicator
635: . fd - the file pointer
636: - len - the length of the output buffer
638: Output Parameter:
639: . string - the line read from the file
641: Level: intermediate
643: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
644: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
646: @*/
647: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
648: {
650: PetscMPIInt rank;
653: MPI_Comm_rank(comm,&rank);
655: if (!rank) {
656: char *ptr = fgets(string, len, fp);
658: if (!ptr) {
659: if (feof(fp)) {
660: len = 0;
661: } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
662: }
663: }
664: MPI_Bcast(string,len,MPI_BYTE,0,comm);
665: return(0);
666: }
668: #if defined(PETSC_HAVE_MATLAB_ENGINE)
669: #include <mex.h>
672: PetscErrorCode PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
673: {
677: if (fd != stdout && fd != stderr) { /* handle regular files */
678: PetscVFPrintfDefault(fd,format,Argp);
679: } else {
680: size_t len=8*1024,length;
681: char buf[len];
683: PetscVSNPrintf(buf,len,format,&length,Argp);
684: mexPrintf("%s",buf);
685: }
686: return(0);
687: }
688: #endif
692: /*@C
693: PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations
695: Input Parameters:
696: . format - the PETSc format string
698: Level: developer
700: @*/
701: PetscErrorCode PetscFormatStrip(char *format)
702: {
703: size_t loc1 = 0, loc2 = 0;
706: while (format[loc2]){
707: if (format[loc2] == '%') {
708: format[loc1++] = format[loc2++];
709: while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
710: }
711: format[loc1++] = format[loc2++];
712: }
713: return(0);
714: }