Actual source code: mprint.c
1: #define PETSC_DLL
2: /*
3: Utilites routines to add simple ASCII IO capability.
4: */
5: #include src/sys/fileio/mprint.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;
20: PetscErrorCode PetscFormatConvert(const char *format,char *newformat,PetscInt size)
21: {
22: PetscInt i = 0,j = 0;
24: while (format[i] && i < size-1) {
25: if (format[i] == '%' && format[i+1] == 'D') {
26: newformat[j++] = '%';
27: #if defined(PETSC_USE_32BIT_INT)
28: newformat[j++] = 'd';
29: #else
30: newformat[j++] = 'l';
31: newformat[j++] = 'l';
32: newformat[j++] = 'd';
33: #endif
34: i += 2;
35: } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
36: newformat[j++] = '%';
37: newformat[j++] = format[i+1];
38: #if defined(PETSC_USE_32BIT_INT)
39: newformat[j++] = 'd';
40: #else
41: newformat[j++] = 'l';
42: newformat[j++] = 'l';
43: newformat[j++] = 'd';
44: #endif
45: i += 3;
46: } else if (format[i] == '%' && format[i+1] == 'G') {
47: newformat[j++] = '%';
48: #if defined(PETSC_USE_INT)
49: newformat[j++] = 'd';
50: #elif !defined(PETSC_USE_LONG_DOUBLE)
51: newformat[j++] = 'g';
52: #else
53: newformat[j++] = 'L';
54: newformat[j++] = 'g';
55: #endif
56: i += 2;
57: }else {
58: newformat[j++] = format[i++];
59: }
60: }
61: newformat[j] = 0;
62: return 0;
63: }
64:
67: /*
68: No error handling because may be called by error handler
69: */
70: PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp)
71: {
72: /* no malloc since may be called by error handler */
73: char newformat[8*1024];
74: size_t length;
76:
77: PetscFormatConvert(format,newformat,8*1024);
78: PetscStrlen(newformat, &length);
79: if (length > len) {
80: newformat[len] = '\0';
81: }
82: #if defined(PETSC_HAVE_VPRINTF_CHAR)
83: vsprintf(str,newformat,(char *)Argp);
84: #else
85: vsprintf(str,newformat,Argp);
86: #endif
87: return 0;
88: }
92: /*
93: All PETSc standard out and error messages are sent through this function; so, in theory, this can
94: can be replaced with something that does not simply write to a file.
96: Note: For error messages this may be called by a process, for regular standard out it is
97: called only by process 0 of a given communicator
99: No error handling because may be called by error handler
100: */
101: PetscErrorCode PetscVFPrintf(FILE *fd,const char *format,va_list Argp)
102: {
103: /* no malloc since may be called by error handler */
104: char newformat[8*1024];
105:
106: PetscFormatConvert(format,newformat,8*1024);
107: #if defined(PETSC_HAVE_VPRINTF_CHAR)
108: vfprintf(fd,newformat,(char *)Argp);
109: #else
110: vfprintf(fd,newformat,Argp);
111: fflush(fd);
112: #endif
113: return 0;
114: }
118: /*@C
119: PetscSNPrintf - Prints to a string of given length
121: Not Collective
123: Input Parameters:
124: + str - the string to print to
125: . len - the length of str
126: . format - the usual printf() format string
127: - any arguments
129: Level: intermediate
131: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
132: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
133: @*/
134: PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
135: {
137: va_list Argp;
140: va_start(Argp,format);
141: PetscVSNPrintf(str,len,format,Argp);
142: return(0);
143: }
145: /* ----------------------------------------------------------------------- */
147: PrintfQueue queue = 0,queuebase = 0;
148: int queuelength = 0;
149: FILE *queuefile = PETSC_NULL;
153: /*@C
154: PetscSynchronizedPrintf - Prints synchronized output from several processors.
155: Output of the first processor is followed by that of the second, etc.
157: Not Collective
159: Input Parameters:
160: + comm - the communicator
161: - format - the usual printf() format string
163: Level: intermediate
165: Notes:
166: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
167: from all the processors to be printed.
169: Fortran Note:
170: The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
171: That is, you can only pass a single character string from Fortran.
173: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
175: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
176: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
177: @*/
178: PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
179: {
181: PetscMPIInt rank;
184: MPI_Comm_rank(comm,&rank);
185:
186: /* First processor prints immediately to stdout */
187: if (!rank) {
188: va_list Argp;
189: va_start(Argp,format);
190: PetscVFPrintf(PETSC_STDOUT,format,Argp);
191: if (petsc_history) {
192: PetscVFPrintf(petsc_history,format,Argp);
193: }
194: va_end(Argp);
195: } else { /* other processors add to local queue */
196: va_list Argp;
197: PrintfQueue next;
199: PetscNew(struct _PrintfQueue,&next);
200: if (queue) {queue->next = next; queue = next; queue->next = 0;}
201: else {queuebase = queue = next;}
202: queuelength++;
203: va_start(Argp,format);
204: PetscMemzero(next->string,QUEUESTRINGSIZE);
205: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
206: va_end(Argp);
207: }
208:
209: return(0);
210: }
211:
214: /*@C
215: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
216: several processors. Output of the first processor is followed by that of the
217: second, etc.
219: Not Collective
221: Input Parameters:
222: + comm - the communicator
223: . fd - the file pointer
224: - format - the usual printf() format string
226: Level: intermediate
228: Notes:
229: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
230: from all the processors to be printed.
232: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
234: Contributed by: Matthew Knepley
236: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
237: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
239: @*/
240: PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
241: {
243: PetscMPIInt rank;
246: MPI_Comm_rank(comm,&rank);
247:
248: /* First processor prints immediately to fp */
249: if (!rank) {
250: va_list Argp;
251: va_start(Argp,format);
252: PetscVFPrintf(fp,format,Argp);
253: queuefile = fp;
254: if (petsc_history) {
255: PetscVFPrintf(petsc_history,format,Argp);
256: }
257: va_end(Argp);
258: } else { /* other processors add to local queue */
259: va_list Argp;
260: PrintfQueue next;
261: PetscNew(struct _PrintfQueue,&next);
262: if (queue) {queue->next = next; queue = next; queue->next = 0;}
263: else {queuebase = queue = next;}
264: queuelength++;
265: va_start(Argp,format);
266: PetscMemzero(next->string,QUEUESTRINGSIZE);
267: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
268: va_end(Argp);
269: }
270: return(0);
271: }
275: /*@
276: PetscSynchronizedFlush - Flushes to the screen output from all processors
277: involved in previous PetscSynchronizedPrintf() calls.
279: Collective on MPI_Comm
281: Input Parameters:
282: . comm - the communicator
284: Level: intermediate
286: Notes:
287: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
288: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
290: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
291: PetscViewerASCIISynchronizedPrintf()
292: @*/
293: PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
294: {
296: PetscMPIInt rank,size,tag,i,j,n;
297: char message[QUEUESTRINGSIZE];
298: MPI_Status status;
299: FILE *fd;
302: PetscCommDuplicate(comm,&comm,&tag);
303: MPI_Comm_rank(comm,&rank);
304: MPI_Comm_size(comm,&size);
306: /* First processor waits for messages from all other processors */
307: if (!rank) {
308: if (queuefile) {
309: fd = queuefile;
310: } else {
311: fd = PETSC_STDOUT;
312: }
313: for (i=1; i<size; i++) {
314: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
315: for (j=0; j<n; j++) {
316: MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
317: PetscFPrintf(comm,fd,"%s",message);
318: }
319: }
320: queuefile = PETSC_NULL;
321: } else { /* other processors send queue to processor 0 */
322: PrintfQueue next = queuebase,previous;
324: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
325: for (i=0; i<queuelength; i++) {
326: MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
327: previous = next;
328: next = next->next;
329: PetscFree(previous);
330: }
331: queue = 0;
332: queuelength = 0;
333: }
334: PetscCommDestroy(&comm);
335: return(0);
336: }
338: /* ---------------------------------------------------------------------------------------*/
342: /*@C
343: PetscFPrintf - Prints to a file, only from the first
344: processor in the communicator.
346: Not Collective
348: Input Parameters:
349: + comm - the communicator
350: . fd - the file pointer
351: - format - the usual printf() format string
353: Level: intermediate
355: Fortran Note:
356: This routine is not supported in Fortran.
358: Concepts: printing^in parallel
359: Concepts: printf^in parallel
361: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
362: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
363: @*/
364: PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
365: {
367: PetscMPIInt rank;
370: MPI_Comm_rank(comm,&rank);
371: if (!rank) {
372: va_list Argp;
373: va_start(Argp,format);
374: PetscVFPrintf(fd,format,Argp);
375: if (petsc_history) {
376: PetscVFPrintf(petsc_history,format,Argp);
377: }
378: va_end(Argp);
379: }
380: return(0);
381: }
385: /*@C
386: PetscPrintf - Prints to standard out, only from the first
387: processor in the communicator.
389: Not Collective
391: Input Parameters:
392: + comm - the communicator
393: - format - the usual printf() format string
395: Level: intermediate
397: Fortran Note:
398: The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
399: That is, you can only pass a single character string from Fortran.
401: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
402: replaced with < 1.e-12
404: Concepts: printing^in parallel
405: Concepts: printf^in parallel
407: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
408: @*/
409: PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
410: {
412: PetscMPIInt rank;
413: size_t len;
414: char *nformat,*sub1,*sub2;
415: PetscReal value;
418: if (!comm) comm = PETSC_COMM_WORLD;
419: MPI_Comm_rank(comm,&rank);
420: if (!rank) {
421: va_list Argp;
422: va_start(Argp,format);
424: PetscStrstr(format,"%A",&sub1);
425: if (sub1) {
426: PetscStrstr(format,"%",&sub2);
427: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
428: PetscStrlen(format,&len);
429: PetscMalloc((len+16)*sizeof(char),&nformat);
430: PetscStrcpy(nformat,format);
431: PetscStrstr(nformat,"%",&sub2);
432: sub2[0] = 0;
433: value = (double)va_arg(Argp,double);
434: if (PetscAbsReal(value) < 1.e-12) {
435: PetscStrcat(nformat,"< 1.e-12");
436: } else {
437: PetscStrcat(nformat,"%g");
438: va_end(Argp);
439: va_start(Argp,format);
440: }
441: PetscStrcat(nformat,sub1+2);
442: } else {
443: nformat = (char*)format;
444: }
445: PetscVFPrintf(PETSC_STDOUT,nformat,Argp);
446: if (petsc_history) {
447: PetscVFPrintf(petsc_history,nformat,Argp);
448: }
449: va_end(Argp);
450: if (sub1) {PetscFree(nformat);}
451: }
452: return(0);
453: }
455: /* ---------------------------------------------------------------------------------------*/
458: PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
459: {
461: PetscMPIInt rank;
464: if (!comm) comm = PETSC_COMM_WORLD;
465: MPI_Comm_rank(comm,&rank);
466: if (!rank) {
467: va_list Argp;
468: va_start(Argp,format);
469: PetscVFPrintf(PETSC_STDOUT,format,Argp);
470: if (petsc_history) {
471: PetscVFPrintf(petsc_history,format,Argp);
472: }
473: va_end(Argp);
474: }
475: return(0);
476: }
478: /* ---------------------------------------------------------------------------------------*/
483: PetscErrorCode PetscErrorPrintfDefault(const char format[],...)
484: {
485: va_list Argp;
486: static PetscTruth PetscErrorPrintfCalled = PETSC_FALSE;
487: static PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
488: static FILE *fd;
490: /*
491: InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
492: from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
493: */
495: /*
497: it may be called by PetscStackView().
499: This function does not do error checking because it is called by the error handlers.
500: */
502: if (!PetscErrorPrintfCalled) {
503: PetscTruth use_stderr;
505: PetscErrorPrintfCalled = PETSC_TRUE;
506: InPetscErrorPrintfDefault = PETSC_TRUE;
508: PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
509: if (use_stderr) {
510: fd = stderr;
511: } else {
512: fd = PETSC_STDOUT;
513: }
515: /*
516: On the SGI machines and Cray T3E, if errors are generated "simultaneously" by
517: different processors, the messages are printed all jumbled up; to try to
518: prevent this we have each processor wait based on their rank
519: */
520: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
521: {
522: PetscMPIInt rank;
523: if (PetscGlobalRank > 8) rank = 8; else rank = PetscGlobalRank;
524: PetscSleep(rank);
525: }
526: #endif
527: InPetscErrorPrintfDefault = PETSC_FALSE;
528: }
529:
530: if (!InPetscErrorPrintfDefault) {
531: PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]PETSC ERROR: ",PetscGlobalRank);
532: va_start(Argp,format);
533: PetscVFPrintf(fd,format,Argp);
534: va_end(Argp);
535: }
536: return 0;
537: }
541: /*@C
542: PetscSynchronizedFGets - Several processors all get the same line from a file.
544: Collective on MPI_Comm
546: Input Parameters:
547: + comm - the communicator
548: . fd - the file pointer
549: - len - the length of the output buffer
551: Output Parameter:
552: . string - the line read from the file
554: Level: intermediate
556: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
557: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
559: @*/
560: PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
561: {
563: PetscMPIInt rank;
566: MPI_Comm_rank(comm,&rank);
567:
568: if (!rank) {
569: fgets(string,len,fp);
570: }
571: MPI_Bcast(string,len,MPI_BYTE,0,comm);
572: return(0);
573: }