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: #include "petscconfiginfo.h"
7: /*
8: If petsc_history is on, then all Petsc*Printf() results are saved
9: if the appropriate (usually .petschistory) file.
10: */
12: /*
13: Allows one to overwrite where standard out is sent. For example
14: PETSC_STDOUT = fopen("/dev/ttyXX","w") will cause all standard out
15: writes to go to terminal XX; assuming you have write permission there
16: */
17: FILE *PETSC_STDOUT = 0;
21: PetscErrorCode PETSC_DLLEXPORT PetscFormatConvert(const char *format,char *newformat,PetscInt size)
22: {
23: PetscInt i = 0,j = 0;
25: while (format[i] && i < size-1) {
26: if (format[i] == '%' && format[i+1] == 'D') {
27: newformat[j++] = '%';
28: #if defined(PETSC_USE_32BIT_INT)
29: newformat[j++] = 'd';
30: #else
31: newformat[j++] = 'l';
32: newformat[j++] = 'l';
33: newformat[j++] = 'd';
34: #endif
35: i += 2;
36: } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
37: newformat[j++] = '%';
38: newformat[j++] = format[i+1];
39: #if defined(PETSC_USE_32BIT_INT)
40: newformat[j++] = 'd';
41: #else
42: newformat[j++] = 'l';
43: newformat[j++] = 'l';
44: newformat[j++] = 'd';
45: #endif
46: i += 3;
47: } else if (format[i] == '%' && format[i+1] == 'G') {
48: newformat[j++] = '%';
49: #if defined(PETSC_USE_INT)
50: newformat[j++] = 'd';
51: #elif !defined(PETSC_USE_LONG_DOUBLE)
52: newformat[j++] = 'g';
53: #else
54: newformat[j++] = 'L';
55: newformat[j++] = 'g';
56: #endif
57: i += 2;
58: }else {
59: newformat[j++] = format[i++];
60: }
61: }
62: newformat[j] = 0;
63: return 0;
64: }
65:
68: /*
69: No error handling because may be called by error handler
70: */
71: PetscErrorCode PETSC_DLLEXPORT PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp)
72: {
73: /* no malloc since may be called by error handler */
74: char newformat[8*1024];
75: size_t length;
77:
78: PetscFormatConvert(format,newformat,8*1024);
79: PetscStrlen(newformat, &length);
80: if (length > len) {
81: newformat[len] = '\0';
82: }
83: #if defined(PETSC_HAVE_VPRINTF_CHAR)
84: vsprintf(str,newformat,(char *)Argp);
85: #else
86: vsprintf(str,newformat,Argp);
87: #endif
88: return 0;
89: }
93: /*
94: All PETSc standard out and error messages are sent through this function; so, in theory, this can
95: can be replaced with something that does not simply write to a file.
97: Note: For error messages this may be called by a process, for regular standard out it is
98: called only by process 0 of a given communicator
100: No error handling because may be called by error handler
101: */
102: PetscErrorCode PETSC_DLLEXPORT PetscVFPrintf(FILE *fd,const char *format,va_list Argp)
103: {
104: /* no malloc since may be called by error handler */
105: char newformat[8*1024];
106:
107: PetscFormatConvert(format,newformat,8*1024);
108: #if defined(PETSC_HAVE_VPRINTF_CHAR)
109: vfprintf(fd,newformat,(char *)Argp);
110: #else
111: vfprintf(fd,newformat,Argp);
112: fflush(fd);
113: #endif
114: return 0;
115: }
117: /* ----------------------------------------------------------------------- */
119: PrintfQueue queue = 0,queuebase = 0;
120: int queuelength = 0;
121: FILE *queuefile = PETSC_NULL;
125: /*@C
126: PetscSynchronizedPrintf - Prints synchronized output from several processors.
127: Output of the first processor is followed by that of the second, etc.
129: Not Collective
131: Input Parameters:
132: + comm - the communicator
133: - format - the usual printf() format string
135: Level: intermediate
137: Notes:
138: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
139: from all the processors to be printed.
141: Fortran Note:
142: The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
143: That is, you can only pass a single character string from Fortran.
145: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
147: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
148: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
149: @*/
150: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
151: {
153: PetscMPIInt rank;
156: MPI_Comm_rank(comm,&rank);
157:
158: /* First processor prints immediately to stdout */
159: if (!rank) {
160: va_list Argp;
161: va_start(Argp,format);
162: PetscVFPrintf(PETSC_STDOUT,format,Argp);
163: if (petsc_history) {
164: PetscVFPrintf(petsc_history,format,Argp);
165: }
166: va_end(Argp);
167: } else { /* other processors add to local queue */
168: va_list Argp;
169: PrintfQueue next;
171: PetscNew(struct _PrintfQueue,&next);
172: if (queue) {queue->next = next; queue = next; queue->next = 0;}
173: else {queuebase = queue = next;}
174: queuelength++;
175: va_start(Argp,format);
176: PetscMemzero(next->string,QUEUESTRINGSIZE);
177: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
178: va_end(Argp);
179: }
180:
181: return(0);
182: }
183:
186: /*@C
187: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
188: several processors. Output of the first processor is followed by that of the
189: second, etc.
191: Not Collective
193: Input Parameters:
194: + comm - the communicator
195: . fd - the file pointer
196: - format - the usual printf() format string
198: Level: intermediate
200: Notes:
201: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
202: from all the processors to be printed.
204: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
206: Contributed by: Matthew Knepley
208: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
209: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
211: @*/
212: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
213: {
215: PetscMPIInt rank;
218: MPI_Comm_rank(comm,&rank);
219:
220: /* First processor prints immediately to fp */
221: if (!rank) {
222: va_list Argp;
223: va_start(Argp,format);
224: PetscVFPrintf(fp,format,Argp);
225: queuefile = fp;
226: if (petsc_history) {
227: PetscVFPrintf(petsc_history,format,Argp);
228: }
229: va_end(Argp);
230: } else { /* other processors add to local queue */
231: va_list Argp;
232: PrintfQueue next;
233: PetscNew(struct _PrintfQueue,&next);
234: if (queue) {queue->next = next; queue = next; queue->next = 0;}
235: else {queuebase = queue = next;}
236: queuelength++;
237: va_start(Argp,format);
238: PetscMemzero(next->string,QUEUESTRINGSIZE);
239: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
240: va_end(Argp);
241: }
242: return(0);
243: }
247: /*@
248: PetscSynchronizedFlush - Flushes to the screen output from all processors
249: involved in previous PetscSynchronizedPrintf() calls.
251: Collective on MPI_Comm
253: Input Parameters:
254: . comm - the communicator
256: Level: intermediate
258: Notes:
259: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
260: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
262: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
263: PetscViewerASCIISynchronizedPrintf()
264: @*/
265: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFlush(MPI_Comm comm)
266: {
268: PetscMPIInt rank,size,tag,i,j,n;
269: char message[QUEUESTRINGSIZE];
270: MPI_Status status;
271: FILE *fd;
274: PetscCommDuplicate(comm,&comm,&tag);
275: MPI_Comm_rank(comm,&rank);
276: MPI_Comm_size(comm,&size);
278: /* First processor waits for messages from all other processors */
279: if (!rank) {
280: if (queuefile) {
281: fd = queuefile;
282: } else {
283: fd = PETSC_STDOUT;
284: }
285: for (i=1; i<size; i++) {
286: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
287: for (j=0; j<n; j++) {
288: MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
289: PetscFPrintf(comm,fd,"%s",message);
290: }
291: }
292: queuefile = PETSC_NULL;
293: } else { /* other processors send queue to processor 0 */
294: PrintfQueue next = queuebase,previous;
296: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
297: for (i=0; i<queuelength; i++) {
298: MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
299: previous = next;
300: next = next->next;
301: PetscFree(previous);
302: }
303: queue = 0;
304: queuelength = 0;
305: }
306: PetscCommDestroy(&comm);
307: return(0);
308: }
310: /* ---------------------------------------------------------------------------------------*/
314: /*@C
315: PetscFPrintf - Prints to a file, only from the first
316: processor in the communicator.
318: Not Collective
320: Input Parameters:
321: + comm - the communicator
322: . fd - the file pointer
323: - format - the usual printf() format string
325: Level: intermediate
327: Fortran Note:
328: This routine is not supported in Fortran.
330: Concepts: printing^in parallel
331: Concepts: printf^in parallel
333: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
334: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
335: @*/
336: PetscErrorCode PETSC_DLLEXPORT PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
337: {
339: PetscMPIInt rank;
342: MPI_Comm_rank(comm,&rank);
343: if (!rank) {
344: va_list Argp;
345: va_start(Argp,format);
346: PetscVFPrintf(fd,format,Argp);
347: if (petsc_history) {
348: PetscVFPrintf(petsc_history,format,Argp);
349: }
350: va_end(Argp);
351: }
352: return(0);
353: }
357: /*@C
358: PetscPrintf - Prints to standard out, only from the first
359: processor in the communicator.
361: Not Collective
363: Input Parameters:
364: + comm - the communicator
365: - format - the usual printf() format string
367: Level: intermediate
369: Fortran Note:
370: The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
371: That is, you can only pass a single character string from Fortran.
373: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
374: replaced with < 1.e-12
376: Concepts: printing^in parallel
377: Concepts: printf^in parallel
379: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
380: @*/
381: PetscErrorCode PETSC_DLLEXPORT PetscPrintf(MPI_Comm comm,const char format[],...)
382: {
384: PetscMPIInt rank;
385: size_t len;
386: char *nformat,*sub1,*sub2;
387: PetscReal value;
390: if (!comm) comm = PETSC_COMM_WORLD;
391: MPI_Comm_rank(comm,&rank);
392: if (!rank) {
393: va_list Argp;
394: va_start(Argp,format);
396: PetscStrstr(format,"%A",&sub1);
397: if (sub1) {
398: PetscStrstr(format,"%",&sub2);
399: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
400: PetscStrlen(format,&len);
401: PetscMalloc((len+16)*sizeof(char),&nformat);
402: PetscStrcpy(nformat,format);
403: PetscStrstr(nformat,"%",&sub2);
404: sub2[0] = 0;
405: value = (double)va_arg(Argp,double);
406: if (PetscAbsReal(value) < 1.e-12) {
407: PetscStrcat(nformat,"< 1.e-12");
408: } else {
409: PetscStrcat(nformat,"%g");
410: va_end(Argp);
411: va_start(Argp,format);
412: }
413: PetscStrcat(nformat,sub1+2);
414: } else {
415: nformat = (char*)format;
416: }
417: PetscVFPrintf(PETSC_STDOUT,nformat,Argp);
418: if (petsc_history) {
419: PetscVFPrintf(petsc_history,nformat,Argp);
420: }
421: va_end(Argp);
422: if (sub1) {PetscFree(nformat);}
423: }
424: return(0);
425: }
427: /* ---------------------------------------------------------------------------------------*/
430: PetscErrorCode PETSC_DLLEXPORT PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
431: {
433: PetscMPIInt rank;
436: if (!comm) comm = PETSC_COMM_WORLD;
437: MPI_Comm_rank(comm,&rank);
438: if (!rank) {
439: va_list Argp;
440: va_start(Argp,format);
441: PetscVFPrintf(PETSC_STDOUT,format,Argp);
442: if (petsc_history) {
443: PetscVFPrintf(petsc_history,format,Argp);
444: }
445: va_end(Argp);
446: }
447: return(0);
448: }
450: /* ---------------------------------------------------------------------------------------*/
452: static char arch[10],hostname[64],username[16],pname[PETSC_MAX_PATH_LEN],date[64];
453: static PetscTruth PetscErrorPrintfInitializeCalled = PETSC_FALSE;
457: /*
458: Initializes arch, hostname, username,date so that system calls do NOT need
459: to be made during the error handler.
460: */
461: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfInitialize()
462: {
466: PetscGetArchType(arch,10);
467: PetscGetHostName(hostname,64);
468: PetscGetUserName(username,16);
469: PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);
470: PetscGetDate(date,64);
471: PetscErrorPrintfInitializeCalled = PETSC_TRUE;
472: return(0);
473: }
478: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfDefault(const char format[],...)
479: {
480: va_list Argp;
481: static PetscTruth PetscErrorPrintfCalled = PETSC_FALSE;
482: static PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
483: static FILE *fd;
484: char version[256];
485: PetscErrorCode ierr;
487: /*
488: InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
489: from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
490: */
492: /*
494: it may be called by PetscStackView().
496: This function does not do error checking because it is called by the error handlers.
497: */
499: if (!PetscErrorPrintfCalled) {
500: PetscTruth use_stderr;
502: PetscErrorPrintfCalled = PETSC_TRUE;
503: InPetscErrorPrintfDefault = PETSC_TRUE;
505: PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
506: if (use_stderr) {
507: fd = stderr;
508: } else {
509: fd = PETSC_STDOUT;
510: }
512: /*
513: On the SGI machines and Cray T3E, if errors are generated "simultaneously" by
514: different processors, the messages are printed all jumbled up; to try to
515: prevent this we have each processor wait based on their rank
516: */
517: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
518: {
519: PetscMPIInt rank;
520: if (PetscGlobalRank > 8) rank = 8; else rank = PetscGlobalRank;
521: PetscSleep(rank);
522: }
523: #endif
524:
525: PetscGetVersion(&version);
527: PetscFPrintf(PETSC_COMM_SELF,fd,"------------------------------------------------------------------------\n");
528: PetscFPrintf(PETSC_COMM_SELF,fd,"%s\n",version);
529: PetscFPrintf(PETSC_COMM_SELF,fd,"See docs/changes/index.html for recent updates.\n");
530: PetscFPrintf(PETSC_COMM_SELF,fd,"See docs/faq.html for hints about trouble shooting.\n");
531: PetscFPrintf(PETSC_COMM_SELF,fd,"See docs/index.html for manual pages.\n");
532: PetscFPrintf(PETSC_COMM_SELF,fd,"------------------------------------------------------------------------\n");
533: if (PetscErrorPrintfInitializeCalled) {
534: PetscFPrintf(PETSC_COMM_SELF,fd,"%s on a %s named %s by %s %s\n",pname,arch,hostname,username,date);
535: }
536: PetscFPrintf(PETSC_COMM_SELF,fd,"Libraries linked from %s\n",PETSC_LIB_DIR);
537: PetscFPrintf(PETSC_COMM_SELF,fd,"Configure run at %s\n",petscconfigureruntime);
538: PetscFPrintf(PETSC_COMM_SELF,fd,"Configure options %s\n",petscconfigureoptions);
539: PetscFPrintf(PETSC_COMM_SELF,fd,"------------------------------------------------------------------------\n");
540: InPetscErrorPrintfDefault = PETSC_FALSE;
541: }
543: if (!InPetscErrorPrintfDefault) {
544: PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]PETSC ERROR: ",PetscGlobalRank);
545: va_start(Argp,format);
546: PetscVFPrintf(fd,format,Argp);
547: va_end(Argp);
548: }
549: return 0;
550: }
554: /*@C
555: PetscSynchronizedFGets - Several processors all get the same line from a file.
557: Collective on MPI_Comm
559: Input Parameters:
560: + comm - the communicator
561: . fd - the file pointer
562: - len - the length of the output buffer
564: Output Parameter:
565: . string - the line read from the file
567: Level: intermediate
569: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
570: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
572: @*/
573: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
574: {
576: PetscMPIInt rank;
579: MPI_Comm_rank(comm,&rank);
580:
581: if (!rank) {
582: fgets(string,len,fp);
583: }
584: MPI_Bcast(string,len,MPI_BYTE,0,comm);
585: return(0);
586: }