Actual source code: mprint.c
petsc-3.5.4 2015-05-23
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: newformat[j++] = format[i++];
52: newformat[j++] = format[i++];
53: } else if (format[i] == '%') {
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: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%G format is no longer supported, use %%g and caste the argument to double");
68: break;
69: case 'F':
70: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%g and caste the argument to double");
71: break;
72: default:
73: newformat[j++] = format[i];
74: break;
75: }
76: i++;
77: } else newformat[j++] = format[i++];
78: }
79: newformat[j] = 0;
80: return(0);
81: }
85: /*@C
86: PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
87: function arguments into a string using the format statement.
89: Input Parameters:
90: + str - location to put result
91: . len - the amount of space in str
92: + format - the PETSc format string
93: - fullLength - the amount of space in str actually used.
95: 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
96: a recursion will occur and possible crash.
98: Level: developer
100: @*/
101: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
102: {
103: char *newformat;
104: char formatbuf[8*1024];
105: size_t oldLength,length;
106: int fullLengthInt;
110: PetscStrlen(format, &oldLength);
111: if (oldLength < 8*1024) {
112: newformat = formatbuf;
113: oldLength = 8*1024-1;
114: } else {
115: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
116: PetscMalloc1(oldLength, &newformat);
117: }
118: PetscFormatConvert(format,newformat,oldLength);
119: PetscStrlen(newformat, &length);
120: #if 0
121: if (length > len) newformat[len] = '\0';
122: #endif
123: #if defined(PETSC_HAVE_VSNPRINTF_CHAR)
124: fullLengthInt = vsnprintf(str,len,newformat,(char*)Argp);
125: #elif defined(PETSC_HAVE_VSNPRINTF)
126: fullLengthInt = vsnprintf(str,len,newformat,Argp);
127: #elif defined(PETSC_HAVE__VSNPRINTF)
128: fullLengthInt = _vsnprintf(str,len,newformat,Argp);
129: #else
130: #error "vsnprintf not found"
131: #endif
132: if (fullLengthInt < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"vsnprintf() failed");
133: if (fullLength) *fullLength = (size_t)fullLengthInt;
134: if (oldLength >= 8*1024) {
135: PetscFree(newformat);
136: }
137: return(0);
138: }
142: /*@C
143: PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
144: can be replaced with something that does not simply write to a file.
146: To use, write your own function for example,
147: $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
148: ${
150: $
152: $ if (fd != stdout && fd != stderr) { handle regular files
153: $ PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
154: $ } else {
155: $ char buff[BIG];
156: $ size_t length;
157: $ PetscVSNPrintf(buff,BIG,format,&length,Argp);
158: $ now send buff to whatever stream or whatever you want
159: $ }
160: $ return(0);
161: $}
162: then before the call to PetscInitialize() do the assignment
163: $ PetscVFPrintf = mypetscvfprintf;
165: Notes: For error messages this may be called by any process, for regular standard out it is
166: called only by process 0 of a given communicator
168: Developer Notes: this could be called by an error handler, if that happens then a recursion of the error handler may occur
169: and a crash
171: Level: developer
173: .seealso: PetscVSNPrintf(), PetscErrorPrintf()
175: @*/
176: PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
177: {
178: char *newformat;
179: char formatbuf[8*1024];
180: size_t oldLength;
184: PetscStrlen(format, &oldLength);
185: if (oldLength < 8*1024) {
186: newformat = formatbuf;
187: oldLength = 8*1024-1;
188: } else {
189: oldLength = PETSC_MAX_LENGTH_FORMAT(oldLength);
190: PetscMalloc1(oldLength, &newformat);
191: }
192: PetscFormatConvert(format,newformat,oldLength);
194: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
195: vfprintf(fd,newformat,(char*)Argp);
196: #else
197: vfprintf(fd,newformat,Argp);
198: #endif
199: fflush(fd);
200: if (oldLength >= 8*1024) {
201: PetscFree(newformat);
202: }
203: return(0);
204: }
208: /*@C
209: PetscSNPrintf - Prints to a string of given length
211: Not Collective
213: Input Parameters:
214: + str - the string to print to
215: . len - the length of str
216: . format - the usual printf() format string
217: - any arguments
219: Level: intermediate
221: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
222: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
223: @*/
224: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
225: {
227: size_t fullLength;
228: va_list Argp;
231: va_start(Argp,format);
232: PetscVSNPrintf(str,len,format,&fullLength,Argp);
233: return(0);
234: }
238: /*@C
239: PetscSNPrintfCount - Prints to a string of given length, returns count
241: Not Collective
243: Input Parameters:
244: + str - the string to print to
245: . len - the length of str
246: . format - the usual printf() format string
247: . countused - number of characters used
248: - any arguments
250: Level: intermediate
252: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
253: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf()
254: @*/
255: PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
256: {
258: va_list Argp;
261: va_start(Argp,countused);
262: PetscVSNPrintf(str,len,format,countused,Argp);
263: return(0);
264: }
266: /* ----------------------------------------------------------------------- */
268: PrintfQueue petsc_printfqueue = 0,petsc_printfqueuebase = 0;
269: int petsc_printfqueuelength = 0;
273: /*@C
274: PetscSynchronizedPrintf - Prints synchronized output from several processors.
275: Output of the first processor is followed by that of the second, etc.
277: Not Collective
279: Input Parameters:
280: + comm - the communicator
281: - format - the usual printf() format string
283: Level: intermediate
285: Notes:
286: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
287: from all the processors to be printed.
289: Fortran Note:
290: The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
291: That is, you can only pass a single character string from Fortran.
293: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
294: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
295: @*/
296: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
297: {
299: PetscMPIInt rank;
302: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
303: MPI_Comm_rank(comm,&rank);
305: /* First processor prints immediately to stdout */
306: if (!rank) {
307: va_list Argp;
308: va_start(Argp,format);
309: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
310: if (petsc_history) {
311: va_start(Argp,format);
312: (*PetscVFPrintf)(petsc_history,format,Argp);
313: }
314: va_end(Argp);
315: } else { /* other processors add to local queue */
316: va_list Argp;
317: PrintfQueue next;
318: size_t fullLength = 8191;
320: PetscNew(&next);
321: if (petsc_printfqueue) {
322: petsc_printfqueue->next = next;
323: petsc_printfqueue = next;
324: petsc_printfqueue->next = 0;
325: } else petsc_printfqueuebase = petsc_printfqueue = next;
326: petsc_printfqueuelength++;
327: next->size = -1;
328: while ((PetscInt)fullLength >= next->size) {
329: next->size = fullLength+1;
331: PetscMalloc1(next->size, &next->string);
332: va_start(Argp,format);
333: PetscMemzero(next->string,next->size);
334: PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);
335: va_end(Argp);
336: }
337: }
338: return(0);
339: }
343: /*@C
344: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
345: several processors. Output of the first processor is followed by that of the
346: second, etc.
348: Not Collective
350: Input Parameters:
351: + comm - the communicator
352: . fd - the file pointer
353: - format - the usual printf() format string
355: Level: intermediate
357: Notes:
358: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
359: from all the processors to be printed.
361: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
362: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
364: @*/
365: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
366: {
368: PetscMPIInt rank;
371: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
372: MPI_Comm_rank(comm,&rank);
374: /* First processor prints immediately to fp */
375: if (!rank) {
376: va_list Argp;
377: va_start(Argp,format);
378: (*PetscVFPrintf)(fp,format,Argp);
379: if (petsc_history && (fp !=petsc_history)) {
380: va_start(Argp,format);
381: (*PetscVFPrintf)(petsc_history,format,Argp);
382: }
383: va_end(Argp);
384: } else { /* other processors add to local queue */
385: va_list Argp;
386: PrintfQueue next;
387: size_t fullLength = 8191;
388: PetscNew(&next);
389: if (petsc_printfqueue) {
390: petsc_printfqueue->next = next;
391: petsc_printfqueue = next;
392: petsc_printfqueue->next = 0;
393: } else petsc_printfqueuebase = petsc_printfqueue = next;
394: petsc_printfqueuelength++;
395: next->size = -1;
396: while ((PetscInt)fullLength >= next->size) {
397: next->size = fullLength+1;
398: PetscMalloc1(next->size, &next->string);
399: va_start(Argp,format);
400: PetscMemzero(next->string,next->size);
401: PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);
402: va_end(Argp);
403: }
404: }
405: return(0);
406: }
410: /*@C
411: PetscSynchronizedFlush - Flushes to the screen output from all processors
412: involved in previous PetscSynchronizedPrintf() calls.
414: Collective on MPI_Comm
416: Input Parameters:
417: + comm - the communicator
418: - fd - the file pointer (valid on process 0 of the communicator)
420: Level: intermediate
422: Notes:
423: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
424: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
426: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
427: PetscViewerASCIISynchronizedPrintf()
428: @*/
429: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
430: {
432: PetscMPIInt rank,size,tag,i,j,n = 0,dummy = 0;
433: char *message;
434: MPI_Status status;
437: PetscCommDuplicate(comm,&comm,&tag);
438: MPI_Comm_rank(comm,&rank);
439: MPI_Comm_size(comm,&size);
441: /* First processor waits for messages from all other processors */
442: if (!rank) {
443: if (!fd) fd = PETSC_STDOUT;
444: for (i=1; i<size; i++) {
445: /* to prevent a flood of messages to process zero, request each message separately */
446: MPI_Send(&dummy,1,MPI_INT,i,tag,comm);
447: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
448: for (j=0; j<n; j++) {
449: PetscMPIInt size = 0;
451: MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);
452: PetscMalloc1(size, &message);
453: MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);
454: PetscFPrintf(comm,fd,"%s",message);
455: PetscFree(message);
456: }
457: }
458: } else { /* other processors send queue to processor 0 */
459: PrintfQueue next = petsc_printfqueuebase,previous;
461: MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);
462: MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);
463: for (i=0; i<petsc_printfqueuelength; i++) {
464: MPI_Send(&next->size,1,MPI_INT,0,tag,comm);
465: MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);
466: previous = next;
467: next = next->next;
468: PetscFree(previous->string);
469: PetscFree(previous);
470: }
471: petsc_printfqueue = 0;
472: petsc_printfqueuelength = 0;
473: }
474: PetscCommDestroy(&comm);
475: return(0);
476: }
478: /* ---------------------------------------------------------------------------------------*/
482: /*@C
483: PetscFPrintf - Prints to a file, only from the first
484: processor in the communicator.
486: Not Collective
488: Input Parameters:
489: + comm - the communicator
490: . fd - the file pointer
491: - format - the usual printf() format string
493: Level: intermediate
495: Fortran Note:
496: This routine is not supported in Fortran.
498: Concepts: printing^in parallel
499: Concepts: printf^in parallel
501: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
502: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
503: @*/
504: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
505: {
507: PetscMPIInt rank;
510: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
511: MPI_Comm_rank(comm,&rank);
512: if (!rank) {
513: va_list Argp;
514: va_start(Argp,format);
515: (*PetscVFPrintf)(fd,format,Argp);
516: if (petsc_history && (fd !=petsc_history)) {
517: va_start(Argp,format);
518: (*PetscVFPrintf)(petsc_history,format,Argp);
519: }
520: va_end(Argp);
521: }
522: return(0);
523: }
527: /*@C
528: PetscPrintf - Prints to standard out, only from the first
529: processor in the communicator. Calls from other processes are ignored.
531: Not Collective
533: Input Parameters:
534: + comm - the communicator
535: - format - the usual printf() format string
537: Level: intermediate
539: Fortran Note:
540: The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
541: That is, you can only pass a single character string from Fortran.
543: Concepts: printing^in parallel
544: Concepts: printf^in parallel
546: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
547: @*/
548: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
549: {
551: PetscMPIInt rank;
554: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
555: MPI_Comm_rank(comm,&rank);
556: if (!rank) {
557: va_list Argp;
558: va_start(Argp,format);
559: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
560: if (petsc_history) {
561: va_start(Argp,format);
562: (*PetscVFPrintf)(petsc_history,format,Argp);
563: }
564: va_end(Argp);
565: }
566: return(0);
567: }
569: /* ---------------------------------------------------------------------------------------*/
572: /*@C
573: PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by
574: replacinng it with something that does not simply write to a stdout.
576: To use, write your own function for example,
577: $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
578: ${
579: $ return(0);
580: $}
581: then before the call to PetscInitialize() do the assignment
582: $ PetscHelpPrintf = mypetschelpprintf;
584: Note: the default routine used is called PetscHelpPrintfDefault().
586: Level: developer
588: .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
589: @*/
590: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
591: {
593: PetscMPIInt rank;
596: if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
597: MPI_Comm_rank(comm,&rank);
598: if (!rank) {
599: va_list Argp;
600: va_start(Argp,format);
601: (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);
602: if (petsc_history) {
603: va_start(Argp,format);
604: (*PetscVFPrintf)(petsc_history,format,Argp);
605: }
606: va_end(Argp);
607: }
608: return(0);
609: }
611: /* ---------------------------------------------------------------------------------------*/
616: /*@C
617: PetscSynchronizedFGets - Several processors all get the same line from a file.
619: Collective on MPI_Comm
621: Input Parameters:
622: + comm - the communicator
623: . fd - the file pointer
624: - len - the length of the output buffer
626: Output Parameter:
627: . string - the line read from the file, at end of file string[0] == 0
629: Level: intermediate
631: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
632: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
634: @*/
635: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
636: {
638: PetscMPIInt rank;
641: MPI_Comm_rank(comm,&rank);
643: if (!rank) {
644: char *ptr = fgets(string, len, fp);
646: if (!ptr) {
647: string[0] = 0;
648: if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
649: }
650: }
651: MPI_Bcast(string,len,MPI_BYTE,0,comm);
652: return(0);
653: }
655: #if defined(PETSC_HAVE_MATLAB_ENGINE)
656: #include <mex.h>
659: PetscErrorCode PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp)
660: {
664: if (fd != stdout && fd != stderr) { /* handle regular files */
665: PetscVFPrintfDefault(fd,format,Argp);
666: } else {
667: size_t len=8*1024,length;
668: char buf[len];
670: PetscVSNPrintf(buf,len,format,&length,Argp);
671: mexPrintf("%s",buf);
672: }
673: return(0);
674: }
675: #endif
679: /*@C
680: PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations
682: Input Parameters:
683: . format - the PETSc format string
685: Level: developer
687: @*/
688: PetscErrorCode PetscFormatStrip(char *format)
689: {
690: size_t loc1 = 0, loc2 = 0;
693: while (format[loc2]) {
694: if (format[loc2] == '%') {
695: format[loc1++] = format[loc2++];
696: while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
697: }
698: format[loc1++] = format[loc2++];
699: }
700: return(0);
701: }