Actual source code: mprint.c
1: #define PETSC_DLL
2: /*
3: Utilites routines to add simple ASCII IO capability.
4: */
5: #include src/sys/src/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: */
14: PetscErrorCode PETSC_DLLEXPORT PetscFormatConvert(const char *format,char *newformat)
15: {
16: PetscInt i = 0,j = 0;
18: while (format[i] && i < 8*1024-1) {
19: if (format[i] == '%' && format[i+1] == 'D') {
20: newformat[j++] = '%';
21: #if defined(PETSC_USE_32BIT_INT)
22: newformat[j++] = 'd';
23: #else
24: newformat[j++] = 'l';
25: newformat[j++] = 'l';
26: newformat[j++] = 'd';
27: #endif
28: i += 2;
29: } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') {
30: newformat[j++] = '%';
31: newformat[j++] = format[i+1];
32: #if defined(PETSC_USE_32BIT_INT)
33: newformat[j++] = 'd';
34: #else
35: newformat[j++] = 'l';
36: newformat[j++] = 'l';
37: newformat[j++] = 'd';
38: #endif
39: i += 3;
40: }else {
41: newformat[j++] = format[i++];
42: }
43: }
44: newformat[j] = 0;
45: return 0;
46: }
47:
50: /*
51: No error handling because may be called by error handler
52: */
53: PetscErrorCode PETSC_DLLEXPORT PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp)
54: {
55: /* no malloc since may be called by error handler */
56: char newformat[8*1024];
57:
58: PetscFormatConvert(format,newformat);
59: #if defined(PETSC_HAVE_VPRINTF_CHAR)
60: vsprintf(str,newformat,(char *)Argp);
61: #else
62: vsprintf(str,newformat,Argp);
63: #endif
64: return 0;
65: }
69: /*
70: No error handling because may be called by error handler
71: */
72: PetscErrorCode PETSC_DLLEXPORT PetscVFPrintf(FILE *fd,const char *format,va_list Argp)
73: {
74: /* no malloc since may be called by error handler */
75: char newformat[8*1024];
76:
77: PetscFormatConvert(format,newformat);
78: #if defined(PETSC_HAVE_VPRINTF_CHAR)
79: vfprintf(fd,newformat,(char *)Argp);
80: #else
81: vfprintf(fd,newformat,Argp);
82: fflush(fd);
83: #endif
84: return 0;
85: }
87: /* ----------------------------------------------------------------------- */
89: PrintfQueue queue = 0,queuebase = 0;
90: int queuelength = 0;
91: FILE *queuefile = PETSC_NULL;
95: /*@C
96: PetscSynchronizedPrintf - Prints synchronized output from several processors.
97: Output of the first processor is followed by that of the second, etc.
99: Not Collective
101: Input Parameters:
102: + comm - the communicator
103: - format - the usual printf() format string
105: Level: intermediate
107: Notes:
108: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
109: from all the processors to be printed.
111: Fortran Note:
112: The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
113: That is, you can only pass a single character string from Fortran.
115: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
117: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
118: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
119: @*/
120: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
121: {
123: PetscMPIInt rank;
126: MPI_Comm_rank(comm,&rank);
127:
128: /* First processor prints immediately to stdout */
129: if (!rank) {
130: va_list Argp;
131: va_start(Argp,format);
132: PetscVFPrintf(stdout,format,Argp);
133: fflush(stdout);
134: if (petsc_history) {
135: PetscVFPrintf(petsc_history,format,Argp);
136: fflush(petsc_history);
137: }
138: va_end(Argp);
139: } else { /* other processors add to local queue */
140: va_list Argp;
141: PrintfQueue next;
143: PetscNew(struct _PrintfQueue,&next);
144: if (queue) {queue->next = next; queue = next; queue->next = 0;}
145: else {queuebase = queue = next;}
146: queuelength++;
147: va_start(Argp,format);
148: PetscMemzero(next->string,QUEUESTRINGSIZE);
149: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
150: va_end(Argp);
151: }
152:
153: return(0);
154: }
155:
158: /*@C
159: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
160: several processors. Output of the first processor is followed by that of the
161: second, etc.
163: Not Collective
165: Input Parameters:
166: + comm - the communicator
167: . fd - the file pointer
168: - format - the usual printf() format string
170: Level: intermediate
172: Notes:
173: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
174: from all the processors to be printed.
176: The length of the formatted message cannot exceed QUEUESTRINGSIZE characters.
178: Contributed by: Matthew Knepley
180: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
181: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
183: @*/
184: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
185: {
187: PetscMPIInt rank;
190: MPI_Comm_rank(comm,&rank);
191:
192: /* First processor prints immediately to fp */
193: if (!rank) {
194: va_list Argp;
195: va_start(Argp,format);
196: PetscVFPrintf(fp,format,Argp);
197: fflush(fp);
198: queuefile = fp;
199: if (petsc_history) {
200: PetscVFPrintf(petsc_history,format,Argp);
201: fflush(petsc_history);
202: }
203: va_end(Argp);
204: } else { /* other processors add to local queue */
205: va_list Argp;
206: PrintfQueue next;
207: PetscNew(struct _PrintfQueue,&next);
208: if (queue) {queue->next = next; queue = next; queue->next = 0;}
209: else {queuebase = queue = next;}
210: queuelength++;
211: va_start(Argp,format);
212: PetscMemzero(next->string,QUEUESTRINGSIZE);
213: PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);
214: va_end(Argp);
215: }
216: return(0);
217: }
221: /*@C
222: PetscSynchronizedFlush - Flushes to the screen output from all processors
223: involved in previous PetscSynchronizedPrintf() calls.
225: Collective on MPI_Comm
227: Input Parameters:
228: . comm - the communicator
230: Level: intermediate
232: Notes:
233: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
234: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
236: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
237: PetscViewerASCIISynchronizedPrintf()
238: @*/
239: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFlush(MPI_Comm comm)
240: {
242: PetscMPIInt rank,size,tag,i,j,n;
243: char message[QUEUESTRINGSIZE];
244: MPI_Status status;
245: FILE *fd;
248: PetscCommDuplicate(comm,&comm,&tag);
249: MPI_Comm_rank(comm,&rank);
250: MPI_Comm_size(comm,&size);
252: /* First processor waits for messages from all other processors */
253: if (!rank) {
254: if (queuefile) {
255: fd = queuefile;
256: } else {
257: fd = stdout;
258: }
259: for (i=1; i<size; i++) {
260: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
261: for (j=0; j<n; j++) {
262: MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
263: fprintf(fd,"%s",message);
264: if (petsc_history) {
265: fprintf(petsc_history,"%s",message);
266: }
267: }
268: }
269: fflush(fd);
270: if (petsc_history) fflush(petsc_history);
271: queuefile = PETSC_NULL;
272: } else { /* other processors send queue to processor 0 */
273: PrintfQueue next = queuebase,previous;
275: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
276: for (i=0; i<queuelength; i++) {
277: MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
278: previous = next;
279: next = next->next;
280: PetscFree(previous);
281: }
282: queue = 0;
283: queuelength = 0;
284: }
285: PetscCommDestroy(&comm);
286: return(0);
287: }
289: /* ---------------------------------------------------------------------------------------*/
293: /*@C
294: PetscFPrintf - Prints to a file, only from the first
295: processor in the communicator.
297: Not Collective
299: Input Parameters:
300: + comm - the communicator
301: . fd - the file pointer
302: - format - the usual printf() format string
304: Level: intermediate
306: Fortran Note:
307: This routine is not supported in Fortran.
309: Concepts: printing^in parallel
310: Concepts: printf^in parallel
312: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
313: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
314: @*/
315: PetscErrorCode PETSC_DLLEXPORT PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
316: {
318: PetscMPIInt rank;
321: MPI_Comm_rank(comm,&rank);
322: if (!rank) {
323: va_list Argp;
324: va_start(Argp,format);
325: PetscVFPrintf(fd,format,Argp);
326: fflush(fd);
327: if (petsc_history) {
328: PetscVFPrintf(petsc_history,format,Argp);
329: fflush(petsc_history);
330: }
331: va_end(Argp);
332: }
333: return(0);
334: }
338: /*@C
339: PetscPrintf - Prints to standard out, only from the first
340: processor in the communicator.
342: Not Collective
344: Input Parameters:
345: + comm - the communicator
346: - format - the usual printf() format string
348: Level: intermediate
350: Fortran Note:
351: The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran.
352: That is, you can only pass a single character string from Fortran.
354: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
355: replaced with < 1.e-12
357: Concepts: printing^in parallel
358: Concepts: printf^in parallel
360: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
361: @*/
362: PetscErrorCode PETSC_DLLEXPORT PetscPrintf(MPI_Comm comm,const char format[],...)
363: {
365: PetscMPIInt rank;
366: size_t len;
367: char *nformat,*sub1,*sub2;
368: PetscReal value;
371: if (!comm) comm = PETSC_COMM_WORLD;
372: MPI_Comm_rank(comm,&rank);
373: if (!rank) {
374: va_list Argp;
375: va_start(Argp,format);
377: PetscStrstr(format,"%A",&sub1);
378: if (sub1) {
379: PetscStrstr(format,"%",&sub2);
380: if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string");
381: PetscStrlen(format,&len);
382: PetscMalloc((len+16)*sizeof(char),&nformat);
383: PetscStrcpy(nformat,format);
384: PetscStrstr(nformat,"%",&sub2);
385: sub2[0] = 0;
386: value = (double)va_arg(Argp,double);
387: if (PetscAbsReal(value) < 1.e-12) {
388: PetscStrcat(nformat,"< 1.e-12");
389: } else {
390: PetscStrcat(nformat,"%g");
391: va_end(Argp);
392: va_start(Argp,format);
393: }
394: PetscStrcat(nformat,sub1+2);
395: } else {
396: nformat = (char*)format;
397: }
398: PetscVFPrintf(stdout,nformat,Argp);
399: fflush(stdout);
400: if (petsc_history) {
401: PetscVFPrintf(petsc_history,nformat,Argp);
402: fflush(petsc_history);
403: }
404: va_end(Argp);
405: if (sub1) {PetscFree(nformat);}
406: }
407: return(0);
408: }
410: /* ---------------------------------------------------------------------------------------*/
413: PetscErrorCode PETSC_DLLEXPORT PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
414: {
416: PetscMPIInt rank;
419: if (!comm) comm = PETSC_COMM_WORLD;
420: MPI_Comm_rank(comm,&rank);
421: if (!rank) {
422: va_list Argp;
423: va_start(Argp,format);
424: PetscVFPrintf(stdout,format,Argp);
425: fflush(stdout);
426: if (petsc_history) {
427: PetscVFPrintf(petsc_history,format,Argp);
428: fflush(petsc_history);
429: }
430: va_end(Argp);
431: }
432: return(0);
433: }
435: /* ---------------------------------------------------------------------------------------*/
437: static char arch[10],hostname[64],username[16],pname[PETSC_MAX_PATH_LEN],date[64];
438: static PetscTruth PetscErrorPrintfInitializeCalled = PETSC_FALSE;
442: /*
443: Initializes arch, hostname, username,date so that system calls do NOT need
444: to be made during the error handler.
445: */
446: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfInitialize()
447: {
451: PetscGetArchType(arch,10);
452: PetscGetHostName(hostname,64);
453: PetscGetUserName(username,16);
454: PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);
455: PetscGetDate(date,64);
456: PetscErrorPrintfInitializeCalled = PETSC_TRUE;
457: return(0);
458: }
463: PetscErrorCode PETSC_DLLEXPORT PetscErrorPrintfDefault(const char format[],...)
464: {
465: va_list Argp;
466: static PetscTruth PetscErrorPrintfCalled = PETSC_FALSE;
467: static PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
468: static FILE *fd;
469: char version[256];
470: PetscErrorCode ierr;
472: /*
473: InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
474: from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
475: */
477: /*
479: it may be called by PetscStackView().
481: This function does not do error checking because it is called by the error handlers.
482: */
484: if (!PetscErrorPrintfCalled) {
485: PetscTruth use_stderr;
487: PetscErrorPrintfCalled = PETSC_TRUE;
488: InPetscErrorPrintfDefault = PETSC_TRUE;
490: PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
491: if (use_stderr) {
492: fd = stderr;
493: } else {
494: fd = stdout;
495: }
497: /*
498: On the SGI machines and Cray T3E, if errors are generated "simultaneously" by
499: different processors, the messages are printed all jumbled up; to try to
500: prevent this we have each processor wait based on their rank
501: */
502: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
503: {
504: PetscMPIInt rank;
505: if (PetscGlobalRank > 8) rank = 8; else rank = PetscGlobalRank;
506: PetscSleep(rank);
507: }
508: #endif
509:
510: PetscGetVersion(&version);
512: fprintf(fd,"--------------------------------------------\
513: ------------------------------\n");
514: fprintf(fd,"%s\n",version);
515: fprintf(fd,"See docs/changes/index.html for recent updates.\n");
516: fprintf(fd,"See docs/faq.html for hints about trouble shooting.\n");
517: fprintf(fd,"See docs/index.html for manual pages.\n");
518: fprintf(fd,"--------------------------------------------\
519: ---------------------------\n");
520: if (PetscErrorPrintfInitializeCalled) {
521: fprintf(fd,"%s on a %s named %s by %s %s\n",pname,arch,hostname,username,date);
522: }
523: fprintf(fd,"Libraries linked from %s\n",PETSC_LIB_DIR);
524: fprintf(fd,"Configure run at %s\n",PETSC_CONFIGURE_RUN_TIME);
525: fprintf(fd,"Configure options %s\n",PETSC_CONFIGURE_OPTIONS);
526: fprintf(fd,"--------------------------------------------\
527: ---------------------------\n");
528: fflush(fd);
529: InPetscErrorPrintfDefault = PETSC_FALSE;
530: }
532: if (!InPetscErrorPrintfDefault) {
533: va_start(Argp,format);
534: fprintf(fd,"[%d]PETSC ERROR: ",PetscGlobalRank);
535: PetscVFPrintf(fd,format,Argp);
536: fflush(fd);
537: va_end(Argp);
538: }
539: return 0;
540: }
544: /*@C
545: PetscSynchronizedFGets - Several processors all get the same line from a file.
547: Collective on MPI_Comm
549: Input Parameters:
550: + comm - the communicator
551: . fd - the file pointer
552: - len - the length of the output buffer
554: Output Parameter:
555: . string - the line read from the file
557: Level: intermediate
559: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
560: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
562: @*/
563: PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[])
564: {
566: PetscMPIInt rank;
569: MPI_Comm_rank(comm,&rank);
570:
571: if (!rank) {
572: fgets(string,len,fp);
573: }
574: MPI_Bcast(string,len,MPI_BYTE,0,comm);
575: return(0);
576: }