Actual source code: mprint.c
1: /*$Id: mprint.c,v 1.60 2001/04/05 21:06:46 balay Exp $*/
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: */
10: extern FILE *petsc_history;
12: /* ----------------------------------------------------------------------- */
14: PrintfQueue queue = 0,queuebase = 0;
15: int queuelength = 0;
16: FILE *queuefile = PETSC_NULL;
18: /*@C
19: PetscSynchronizedPrintf - Prints synchronized output from several processors.
20: Output of the first processor is followed by that of the second, etc.
22: Not Collective
24: Input Parameters:
25: + comm - the communicator
26: - format - the usual printf() format string
28: Level: intermediate
30: Notes:
31: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
32: from all the processors to be printed.
34: The length of the formatted message cannot exceed QUEUESTRINGSIZE charactors.
36: .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
37: PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
38: @*/
39: int PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
40: {
41: int ierr,rank;
44: MPI_Comm_rank(comm,&rank);
45:
46: /* First processor prints immediately to stdout */
47: if (!rank) {
48: va_list Argp;
49: va_start(Argp,format);
50: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
51: vfprintf(stdout,format,(char*)Argp);
52: #else
53: vfprintf(stdout,format,Argp);
54: #endif
55: fflush(stdout);
56: if (petsc_history) {
57: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
58: vfprintf(petsc_history,format,(char *)Argp);
59: #else
60: vfprintf(petsc_history,format,Argp);
61: #endif
62: fflush(petsc_history);
63: }
64: va_end(Argp);
65: } else { /* other processors add to local queue */
66: int len;
67: va_list Argp;
68: PrintfQueue next;
70: PetscNew(struct _PrintfQueue,&next);
71: if (queue) {queue->next = next; queue = next; queue->next = 0;}
72: else {queuebase = queue = next;}
73: queuelength++;
74: va_start(Argp,format);
75: #if defined(PETSC_HAVE_VFPRINTF_CHAR)
76: vsprintf(next->string,format,(char *)Argp);
77: #else
78: vsprintf(next->string,format,Argp);
79: #endif
80: va_end(Argp);
81: PetscStrlen(next->string,&len);
82: if (len > QUEUESTRINGSIZE) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Formatted string longer than %d bytes",QUEUESTRINGSIZE);
83: }
84:
85: return(0);
86: }
87:
88: /*@C
89: PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
90: several processors. Output of the first processor is followed by that of the
91: second, etc.
93: Not Collective
95: Input Parameters:
96: + comm - the communicator
97: . fd - the file pointer
98: - format - the usual printf() format string
100: Level: intermediate
102: Notes:
103: REQUIRES a intervening call to PetscSynchronizedFlush() for the information
104: from all the processors to be printed.
106: The length of the formatted message cannot exceed QUEUESTRINGSIZE charactors.
108: Contributed by: Matthew Knepley
110: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
111: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
113: @*/
114: int PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...)
115: {
116: int ierr,rank;
119: MPI_Comm_rank(comm,&rank);
120:
121: /* First processor prints immediately to fp */
122: if (!rank) {
123: va_list Argp;
124: va_start(Argp,format);
125: #if defined(PETSC_HAVE_VPRINTF_CHAR)
126: vfprintf(fp,format,(char*)Argp);
127: #else
128: vfprintf(fp,format,Argp);
129: #endif
130: fflush(fp);
131: queuefile = fp;
132: if (petsc_history) {
133: #if defined(PETSC_HAVE_VPRINTF_CHAR)
134: vfprintf(petsc_history,format,(char *)Argp);
135: #else
136: vfprintf(petsc_history,format,Argp);
137: #endif
138: fflush(petsc_history);
139: }
140: va_end(Argp);
141: } else { /* other processors add to local queue */
142: int len;
143: va_list Argp;
144: PrintfQueue next;
145: PetscNew(struct _PrintfQueue,&next);
146: if (queue) {queue->next = next; queue = next; queue->next = 0;}
147: else {queuebase = queue = next;}
148: queuelength++;
149: va_start(Argp,format);
150: #if defined(PETSC_HAVE_VPRINTF_CHAR)
151: vsprintf(next->string,format,(char *)Argp);
152: #else
153: vsprintf(next->string,format,Argp);
154: #endif
155: va_end(Argp);
156: PetscStrlen(next->string,&len);
157: if (len > QUEUESTRINGSIZE) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Formatted string longer then %d bytes",QUEUESTRINGSIZE);
158: }
159:
160: return(0);
161: }
163: /*@C
164: PetscSynchronizedFlush - Flushes to the screen output from all processors
165: involved in previous PetscSynchronizedPrintf() calls.
167: Collective on MPI_Comm
169: Input Parameters:
170: . comm - the communicator
172: Level: intermediate
174: Notes:
175: Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
176: different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
178: .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
179: PetscViewerASCIISynchronizedPrintf()
180: @*/
181: int PetscSynchronizedFlush(MPI_Comm comm)
182: {
183: int rank,size,i,j,n,tag,ierr;
184: char message[QUEUESTRINGSIZE];
185: MPI_Status status;
186: FILE *fd;
189: MPI_Comm_rank(comm,&rank);
190: MPI_Comm_size(comm,&size);
192: PetscCommGetNewTag(comm,&tag);
193: /* First processor waits for messages from all other processors */
194: if (!rank) {
195: if (queuefile) {
196: fd = queuefile;
197: } else {
198: fd = stdout;
199: }
200: for (i=1; i<size; i++) {
201: MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);
202: for (j=0; j<n; j++) {
203: MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);
204: fprintf(fd,"%s",message);
205: if (petsc_history) {
206: fprintf(petsc_history,"%s",message);
207: }
208: }
209: }
210: fflush(fd);
211: if (petsc_history) fflush(petsc_history);
212: queuefile = PETSC_NULL;
213: } else { /* other processors send queue to processor 0 */
214: PrintfQueue next = queuebase,previous;
216: MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);
217: for (i=0; i<queuelength; i++) {
218: ierr = MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);
219: previous = next;
220: next = next->next;
221: ierr = PetscFree(previous);
222: }
223: queue = 0;
224: queuelength = 0;
225: }
226: return(0);
227: }
229: /* ---------------------------------------------------------------------------------------*/
231: /*@C
232: PetscFPrintf - Prints to a file, only from the first
233: processor in the communicator.
235: Not Collective
237: Input Parameters:
238: + comm - the communicator
239: . fd - the file pointer
240: - format - the usual printf() format string
242: Level: intermediate
244: Fortran Note:
245: This routine is not supported in Fortran.
247: Concepts: printing^in parallel
248: Concepts: printf^in parallel
250: .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
251: PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
252: @*/
253: int PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
254: {
255: int rank,ierr;
258: MPI_Comm_rank(comm,&rank);
259: if (!rank) {
260: va_list Argp;
261: va_start(Argp,format);
262: #if defined(PETSC_HAVE_VPRINTF_CHAR)
263: vfprintf(fd,format,(char*)Argp);
264: #else
265: vfprintf(fd,format,Argp);
266: #endif
267: fflush(fd);
268: if (petsc_history) {
269: #if defined(PETSC_HAVE_VPRINTF_CHAR)
270: vfprintf(petsc_history,format,(char *)Argp);
271: #else
272: vfprintf(petsc_history,format,Argp);
273: #endif
274: fflush(petsc_history);
275: }
276: va_end(Argp);
277: }
278: return(0);
279: }
281: /*@C
282: PetscPrintf - Prints to standard out, only from the first
283: processor in the communicator.
285: Not Collective
287: Input Parameters:
288: + comm - the communicator
289: - format - the usual printf() format string
291: Level: intermediate
293: Fortran Note:
294: This routine is not supported in Fortran.
296: Notes: %A is replace with %g unless the value is < 1.e-12 when it is
297: replaced with < 1.e-12
299: Concepts: printing^in parallel
300: Concepts: printf^in parallel
302: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
303: @*/
304: int PetscPrintf(MPI_Comm comm,const char format[],...)
305: {
306: int rank,ierr,len;
307: char *nformat,*sub1,*sub2;
308: PetscReal value;
311: if (!comm) comm = PETSC_COMM_WORLD;
312: MPI_Comm_rank(comm,&rank);
313: if (!rank) {
314: va_list Argp;
315: va_start(Argp,format);
317: PetscStrstr(format,"%A",&sub1);
318: if (sub1) {
319: PetscStrstr(format,"%",&sub2);
320: if (sub1 != sub2) SETERRQ(1,"%A format must be first in format string");
321: ierr = PetscStrlen(format,&len);
322: ierr = PetscMalloc((len+16)*sizeof(char),&nformat);
323: ierr = PetscStrcpy(nformat,format);
324: ierr = PetscStrstr(nformat,"%",&sub2);
325: sub2[0] = 0;
326: value = (double)va_arg(Argp,double);
327: if (PetscAbsDouble(value) < 1.e-12) {
328: ierr = PetscStrcat(nformat,"< 1.e-12");
329: } else {
330: ierr = PetscStrcat(nformat,"%g");
331: va_end(Argp);
332: va_start(Argp,format);
333: }
334: ierr = PetscStrcat(nformat,sub1+2);
335: } else {
336: nformat = (char*)format;
337: }
338: #if defined(PETSC_HAVE_VPRINTF_CHAR)
339: vfprintf(stdout,nformat,(char *)Argp);
340: #else
341: vfprintf(stdout,nformat,Argp);
342: #endif
343: fflush(stdout);
344: if (petsc_history) {
345: #if defined(PETSC_HAVE_VPRINTF_CHAR)
346: vfprintf(petsc_history,nformat,(char *)Argp);
347: #else
348: vfprintf(petsc_history,nformat,Argp);
349: #endif
350: fflush(petsc_history);
351: }
352: va_end(Argp);
353: if (sub1) {PetscFree(nformat);}
354: }
355: return(0);
356: }
358: /* ---------------------------------------------------------------------------------------*/
359: /*@C
360: PetscHelpPrintfDefault - Prints to standard out, only from the first
361: processor in the communicator.
363: Not Collective
365: Input Parameters:
366: + comm - the communicator
367: - format - the usual printf() format string
369: Level: developer
371: Fortran Note:
372: This routine is not supported in Fortran.
374: Concepts: help messages^printing
375: Concepts: printing^help messages
377: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
378: @*/
379: int PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
380: {
381: int rank,ierr;
384: if (!comm) comm = PETSC_COMM_WORLD;
385: MPI_Comm_rank(comm,&rank);
386: if (!rank) {
387: va_list Argp;
388: va_start(Argp,format);
389: #if defined(PETSC_HAVE_VPRINTF_CHAR)
390: vfprintf(stdout,format,(char *)Argp);
391: #else
392: vfprintf(stdout,format,Argp);
393: #endif
394: fflush(stdout);
395: if (petsc_history) {
396: #if defined(PETSC_HAVE_VPRINTF_CHAR)
397: vfprintf(petsc_history,format,(char *)Argp);
398: #else
399: vfprintf(petsc_history,format,Argp);
400: #endif
401: fflush(petsc_history);
402: }
403: va_end(Argp);
404: }
405: return(0);
406: }
408: /* ---------------------------------------------------------------------------------------*/
409: /*@C
410: PetscErrorPrintfDefault - Prints error messages.
412: Not Collective
414: Input Parameters:
415: . format - the usual printf() format string
417: Level: developer
419: Fortran Note:
420: This routine is not supported in Fortran.
422: Concepts: error messages^printing
423: Concepts: printing^error messages
425: .seealso: PetscFPrintf(), PetscSynchronizedPrintf()
426: @*/
427: int PetscErrorPrintfDefault(const char format[],...)
428: {
429: va_list Argp;
430: static PetscTruth PetscErrorPrintfCalled = PETSC_FALSE;
431: static PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
432: static FILE *fd;
433: /*
434: InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
435: from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
436: */
438: /*
440: it may be called by PetscStackView().
442: This function does not do error checking because it is called by the error handlers.
443: */
445: if (!PetscErrorPrintfCalled) {
446: char arch[10],hostname[64],username[16],pname[256],date[64];
447: PetscTruth use_stderr;
449: PetscErrorPrintfCalled = PETSC_TRUE;
450: InPetscErrorPrintfDefault = PETSC_TRUE;
452: PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
453: if (use_stderr) {
454: fd = stderr;
455: } else {
456: fd = stdout;
457: }
459: /*
460: On the SGI machines and Cray T3E, if errors are generated "simultaneously" by
461: different processors, the messages are printed all jumbled up; to try to
462: prevent this we have each processor wait based on their rank
463: */
464: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
465: {
466: int rank;
467: MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
468: if (rank > 8) rank = 8;
469: PetscSleep(rank);
470: }
471: #endif
473: /* Cannot do error checking on these calls because we are called by error handler */
474: PetscGetArchType(arch,10);
475: PetscGetHostName(hostname,64);
476: PetscGetUserName(username,16);
477: PetscGetProgramName(pname,256);
478: PetscGetInitialDate(date,64);
479: fprintf(fd,"--------------------------------------------
480: ------------------------------n");
481: fprintf(fd,"%sn",PETSC_VERSION_NUMBER);
482: fprintf(fd,"%sn",PETSC_AUTHOR_INFO);
483: fprintf(fd,"See docs/copyright.html for copyright information.n");
484: fprintf(fd,"See docs/changes.html for recent updates.n");
485: fprintf(fd,"See docs/troubleshooting.html for hints about trouble shooting.n");
486: fprintf(fd,"See docs/manualpages/index.html for manual pages.n");
487: fprintf(fd,"--------------------------------------------
488: ---------------------------n");
489: fprintf(fd,"%s on a %s named %s by %s %sn",pname,arch,hostname,username,date);
490: #if !defined (PARCH_win32)
491: fprintf(fd,"Libraries linked from %sn",PETSC_LIB_DIR);
492: #endif
493: fprintf(fd,"--------------------------------------------
494: ---------------------------n");
495: fflush(fd);
496: InPetscErrorPrintfDefault = PETSC_FALSE;
497: }
499: if (!InPetscErrorPrintfDefault) {
500: va_start(Argp,format);
501: #if defined(PETSC_HAVE_VPRINTF_CHAR)
502: vfprintf(fd,format,(char *)Argp);
503: #else
504: vfprintf(fd,format,Argp);
505: #endif
506: fflush(fd);
507: va_end(Argp);
508: }
509: return 0;
510: }
512: /*@C
513: PetscSynchronizedFGets - Several processors all get the same line from a file.
515: Collective on MPI_Comm
517: Input Parameters:
518: + comm - the communicator
519: . fd - the file pointer
520: - len - the lenght of the output buffer
522: Output Parameter:
523: . string - the line read from the file
525: Level: intermediate
527: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
528: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
530: @*/
531: int PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,int len,char string[])
532: {
533: int ierr,rank;
536: MPI_Comm_rank(comm,&rank);
537:
538: /* First processor prints immediately to fp */
539: if (!rank) {
540: fgets(string,len,fp);
541: }
542: MPI_Bcast(string,len,MPI_BYTE,0,comm);
543: return(0);
544: }