Actual source code: mprint.c
petsc-3.4.5 2014-06-29
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 newformat[j++] = format[i++];
88: }
89: newformat[j] = 0;
90: return(0);
91: }
95: /*@C
96: PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
97: function arguments into a string using the format statement.
99: Input Parameters:
100: + str - location to put result
101: . len - the amount of space in str
102: + format - the PETSc format string
103: - fullLength - the amount of space in str actually used.
105: 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
106: a recursion will occur and possible crash.
108: Level: developer
110: @*/
111: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
112: {
113: char *newformat;
114: char formatbuf[8*1024];
115: size_t oldLength,length;
116: int fullLengthInt;
120: PetscStrlen(format, &oldLength);
121: if (oldLength < 8*1024) {
122: newformat = formatbuf;
123: oldLength = 8*1024-1;
124: } else {
125: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
126: PetscMalloc(oldLength * sizeof(char), &newformat);
127: }
128: PetscFormatConvert(format,newformat,oldLength);
129: PetscStrlen(newformat, &length);
130: #if 0
131: if (length > len) newformat[len] = '\0';
132: #endif
133: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
134: fullLengthInt = vsnprintf(str,len,newformat,(char*)Argp);
135: #elif defined(PETSC_HAVE_VSNPRINTF)
136: fullLengthInt = vsnprintf(str,len,newformat,Argp);
137: #elif defined(PETSC_HAVE__VSNPRINTF)
138: fullLengthInt = _vsnprintf(str,len,newformat,Argp);
139: #else
140: #error "vsnprintf not found"
141: #endif
142: if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
143: if (fullLength) *fullLength = (size_t)fullLengthInt;
144: if (oldLength >= 8*1024) {
145: PetscFree(newformat);
146: }
147: return(0);
148: }
152: /*@C
153: PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
154: can be replaced with something that does not simply write to a file.
156: To use, write your own function for example,
157: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
158: ${
160: $
162: $ if (fd != stdout && fd != stderr) { handle regular files
163: $ PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
164: $ } else {
165: $ char buff[BIG];
166: $ size_t length;
167: $ PetscVSNPrintf(buff,BIG,format,&length,Argp);
168: $ now send buff to whatever stream or whatever you want
169: $ }
170: $ return(0);
171: $}
172: then before the call to PetscInitialize() do the assignment
173: $ PetscVFPrintf = mypetscvfprintf;
175: Notes: For error messages this may be called by any process, for regular standard out it is
176: called only by process 0 of a given communicator
178: Developer Notes: this could be called by an error handler, if that happens then a recursion of the error handler may occur
179: and a crash
181: Level: developer
183: .seealso: PetscVSNPrintf(), PetscErrorPrintf()
185: @*/
186: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
187: {
188: char *newformat;
189: char formatbuf[8*1024];
190: size_t oldLength;
194: PetscStrlen(format, &oldLength);
195: if (oldLength < 8*1024) {
196: newformat = formatbuf;
197: oldLength = 8*1024-1;
198: } else {
199: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
200: PetscMalloc(oldLength * sizeof(char), &newformat);
201: }
202: PetscFormatConvert(format,newformat,oldLength);
204: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
205: vfprintf(fd,newformat,(char*)Argp);
206: #else
207: vfprintf(fd,newformat,Argp);
208: #endif
209: fflush(fd);
210: if (oldLength >= 8*1024) {
211: PetscFree(newformat);
212: }
213: return(0);
214: }
218: /*@C
219: PetscSNPrintf - Prints to a string of given length
221: Not Collective
223: Input Parameters:
224: + str - the string to print to
225: . len - the length of str
226: . format - the usual printf() format string
227: - any arguments
229: Level: intermediate
231: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
232: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
233: @*/
234: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
235: {
237: size_t fullLength;
238: va_list Argp;
241: va_start(Argp,format);
242: PetscVSNPrintf(str,len,format,&fullLength,Argp);
243: return(0);
244: }
248: /*@C
249: PetscSNPrintfCount - Prints to a string of given length, returns count
251: Not Collective
253: Input Parameters:
254: + str - the string to print to
255: . len - the length of str
256: . format - the usual printf() format string
257: . countused - number of characters used
258: - any arguments
260: Level: intermediate
262: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
263: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
264: @*/
265: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
266: {
268: va_list Argp;
271: va_start(Argp,countused);
272: PetscVSNPrintf(str,len,format,countused,Argp);
273: return(0);
274: }
276: /* ----------------------------------------------------------------------- */
278: PrintfQueue petsc_printfqueue = 0,petsc_printfqueuebase = 0;
279: int petsc_printfqueuelength = 0;
280: FILE *petsc_printfqueuefile = NULL;
284: /*@C
285: PetscSynchronizedPrintf - Prints synchronized output from several processors.
286: Output of the first processor is followed by that of the second, etc.
288: Not Collective
290: Input Parameters:
291: + comm - the communicator
292: - format - the usual printf() format string
294: Level: intermediate
296: Notes:
297: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
298: from all the processors to be printed.
300: Fortran Note:
301: The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
302: That is, you can only pass a single character string from Fortran.
304: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
305: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
306: @*/
307: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
308: {
310: PetscMPIInt rank;
313: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
314: MPI_Comm_rank(comm,&rank);
316: /* First processor prints immediately to stdout */
317: if (!rank) {
318: va_list Argp;
319: va_start(Argp,format);
320: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
321: if (petsc_history) {
322: va_start(Argp,format);
323: (*PetscVFPrintf)(petsc_history,format,Argp);
324: }
325: va_end(Argp);
326: } else { /* other processors add to local queue */
327: va_list Argp;
328: PrintfQueue next;
329: size_t fullLength = 8191;
331: PetscNew(struct _PrintfQueue,&next);
332: if (petsc_printfqueue) {
333: petsc_printfqueue->next = next;
334: petsc_printfqueue = next;
335: 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;
342: PetscMalloc(next->size * sizeof(char), &next->string);
343: va_start(Argp,format);
344: PetscMemzero(next->string,next->size);
345: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
346: va_end(Argp);
347: }
348: }
349: return(0);
350: }
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: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
383: MPI_Comm_rank(comm,&rank);
385: /* First processor prints immediately to fp */
386: if (!rank) {
387: va_list Argp;
388: va_start(Argp,format);
389: (*PetscVFPrintf)(fp,format,Argp);
391: petsc_printfqueuefile = fp;
392: if (petsc_history && (fp !=petsc_history)) {
393: va_start(Argp,format);
394: (*PetscVFPrintf)(petsc_history,format,Argp);
395: }
396: va_end(Argp);
397: } else { /* other processors add to local queue */
398: va_list Argp;
399: PrintfQueue next;
400: size_t fullLength = 8191;
401: PetscNew(struct _PrintfQueue,&next);
402: if (petsc_printfqueue) {
403: petsc_printfqueue->next = next;
404: petsc_printfqueue = next;
405: petsc_printfqueue->next = 0;
406: } else petsc_printfqueuebase = petsc_printfqueue = next;
407: petsc_printfqueuelength++;
408: next->size = -1;
409: while ((PetscInt)fullLength >= next->size) {
410: next->size = fullLength+1;
411: PetscMalloc(next->size * sizeof(char), &next->string);
412: va_start(Argp,format);
413: PetscMemzero(next->string,next->size);
414: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
415: va_end(Argp);
416: }
417: }
418: return(0);
419: }
423: /*@
424: PetscSynchronizedFlush - Flushes to the screen output from all processors
425: involved in previous PetscSynchronizedPrintf() calls.
427: Collective on MPI_Comm
429: Input Parameters:
430: . comm - the communicator
432: Level: intermediate
434: Notes:
435: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
436: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
438: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
439: PetscViewerASCIISynchronizedPrintf()
440: @*/
441: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
442: {
444: PetscMPIInt rank,size,tag,i,j,n = 0,dummy = 0;
445: char *message;
446: MPI_Status status;
447: FILE *fd;
450: PetscCommDuplicate(comm,&comm,&tag);
451: MPI_Comm_rank(comm,&rank);
452: MPI_Comm_size(comm,&size);
454: /* First processor waits for messages from all other processors */
455: if (!rank) {
456: if (petsc_printfqueuefile) fd = petsc_printfqueuefile;
457: else fd = PETSC_STDOUT;
458: for (i=1; i<size; i++) {
459: /* to prevent a flood of messages to process zero, request each message separately */
460: MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
461: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
462: for (j=0; j<n; j++) {
463: PetscMPIInt size = 0;
465: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
466: PetscMalloc(size * sizeof(char), &message);
467: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
468: PetscFPrintf(comm,fd,"%s",message);
469: PetscFree(message);
470: }
471: }
472: petsc_printfqueuefile = NULL;
473: } else { /* other processors send queue to processor 0 */
474: PrintfQueue next = petsc_printfqueuebase,previous;
476: MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
477: MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
478: for (i=0; i<petsc_printfqueuelength; i++) {
479: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
480: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
481: previous = next;
482: next = next->next;
483: PetscFree(previous->string);
484: PetscFree(previous);
485: }
486: petsc_printfqueue = 0;
487: petsc_printfqueuelength = 0;
488: }
489: PetscCommDestroy(&comm);
490: return(0);
491: }
493: /* ---------------------------------------------------------------------------------------*/
497: /*@C
498: PetscFPrintf - Prints to a file, only from the first
499: processor in the communicator.
501: Not Collective
503: Input Parameters:
504: + comm - the communicator
505: . fd - the file pointer
506: - format - the usual printf() format string
508: Level: intermediate
510: Fortran Note:
511: This routine is not supported in Fortran.
513: Concepts: printing^in parallel
514: Concepts: printf^in parallel
516: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
517: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
518: @*/
519: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
520: {
522: PetscMPIInt rank;
525: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
526: MPI_Comm_rank(comm,&rank);
527: if (!rank) {
528: va_list Argp;
529: va_start(Argp,format);
530: (*PetscVFPrintf)(fd,format,Argp);
531: if (petsc_history && (fd !=petsc_history)) {
532: va_start(Argp,format);
533: (*PetscVFPrintf)(petsc_history,format,Argp);
534: }
535: va_end(Argp);
536: }
537: return(0);
538: }
542: /*@C
543: PetscPrintf - Prints to standard out, only from the first
544: processor in the communicator. Calls from other processes are ignored.
546: Not Collective
548: Input Parameters:
549: + comm - the communicator
550: - format - the usual printf() format string
552: Level: intermediate
554: Fortran Note:
555: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
556: That is, you can only pass a single character string from Fortran.
558: Concepts: printing^in parallel
559: Concepts: printf^in parallel
561: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
562: @*/
563: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
564: {
566: PetscMPIInt rank;
569: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
570: MPI_Comm_rank(comm,&rank);
571: if (!rank) {
572: va_list Argp;
573: va_start(Argp,format);
574: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
575: if (petsc_history) {
576: va_start(Argp,format);
577: (*PetscVFPrintf)(petsc_history,format,Argp);
578: }
579: va_end(Argp);
580: }
581: return(0);
582: }
584: /* ---------------------------------------------------------------------------------------*/
587: /*@C
588: PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by
589: replacinng it with something that does not simply write to a stdout.
591: To use, write your own function for example,
592: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
593: ${
594: $ return(0);
595: $}
596: then before the call to PetscInitialize() do the assignment
597: $ PetscHelpPrintf = mypetschelpprintf;
599: Note: the default routine used is called PetscHelpPrintfDefault().
601: Level: developer
603: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
604: @*/
605: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
606: {
608: PetscMPIInt rank;
611: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
612: MPI_Comm_rank(comm,&rank);
613: if (!rank) {
614: va_list Argp;
615: va_start(Argp,format);
616: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
617: if (petsc_history) {
618: va_start(Argp,format);
619: (*PetscVFPrintf)(petsc_history,format,Argp);
620: }
621: va_end(Argp);
622: }
623: return(0);
624: }
626: /* ---------------------------------------------------------------------------------------*/
631: /*@C
632: PetscSynchronizedFGets - Several processors all get the same line from a file.
634: Collective on MPI_Comm
636: Input Parameters:
637: + comm - the communicator
638: . fd - the file pointer
639: - len - the length of the output buffer
641: Output Parameter:
642: . string - the line read from the file, at end of file string[0] == 0
644: Level: intermediate
646: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
647: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
649: @*/
650: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
651: {
653: PetscMPIInt rank;
656: MPI_Comm_rank(comm,&rank);
658: if (!rank) {
659: char *ptr = fgets(string, len, fp);
661: if (!ptr) {
662: string[0] = 0;
663: if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
664: }
665: }
666: MPI_Bcast(string,len,MPI_BYTE,0,comm);
667: return(0);
668: }
670: #if defined(PETSC_HAVE_MATLAB_ENGINE)
671: #include <mex.h>
674: PetscErrorCode PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
675: {
679: if (fd != stdout && fd != stderr) { /* handle regular files */
680: PetscVFPrintfDefault(fd,format,Argp);
681: } else {
682: size_t len=8*1024,length;
683: char buf[len];
685: PetscVSNPrintf(buf,len,format,&length,Argp);
686: mexPrintf("%s",buf);
687: }
688: return(0);
689: }
690: #endif
694: /*@C
695: PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations
697: Input Parameters:
698: . format - the PETSc format string
700: Level: developer
702: @*/
703: PetscErrorCode PetscFormatStrip(char *format)
704: {
705: size_t loc1 = 0, loc2 = 0;
708: while (format[loc2]) {
709: if (format[loc2] == '%') {
710: format[loc1++] = format[loc2++];
711: while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
712: }
713: format[loc1++] = format[loc2++];
714: }
715: return(0);
716: }