Actual source code: mprint.c
1: /*$Id: mprint.c,v 1.64 2001/08/28 01:01:27 bsmith 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 characters.
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_VPRINTF_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_VPRINTF_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_VPRINTF_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 characters.
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 (PetscAbsReal(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: int PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
360: {
361: int rank,ierr;
364: if (!comm) comm = PETSC_COMM_WORLD;
365: MPI_Comm_rank(comm,&rank);
366: if (!rank) {
367: va_list Argp;
368: va_start(Argp,format);
369: #if defined(PETSC_HAVE_VPRINTF_CHAR)
370: vfprintf(stdout,format,(char *)Argp);
371: #else
372: vfprintf(stdout,format,Argp);
373: #endif
374: fflush(stdout);
375: if (petsc_history) {
376: #if defined(PETSC_HAVE_VPRINTF_CHAR)
377: vfprintf(petsc_history,format,(char *)Argp);
378: #else
379: vfprintf(petsc_history,format,Argp);
380: #endif
381: fflush(petsc_history);
382: }
383: va_end(Argp);
384: }
385: return(0);
386: }
388: /* ---------------------------------------------------------------------------------------*/
389: /*MC
390: PetscErrorPrintf - Prints error messages.
392: Not Collective
394: Synopsis:
395: int (*PetscErrorPrintf)(const char format[],...);
397: Input Parameters:
398: . format - the usual printf() format string
400: Level: developer
402: Fortran Note:
403: This routine is not supported in Fortran.
405: Concepts: error messages^printing
406: Concepts: printing^error messages
408: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscHelpPrintf()
409: M*/
411: /*MC
412: PetscHelpPrintf - Prints help messages.
414: Not Collective
416: Synopsis:
417: int (*PetscHelpPrintf)(const char format[],...);
419: Input Parameters:
420: . format - the usual printf() format string
422: Level: developer
424: Fortran Note:
425: This routine is not supported in Fortran.
427: Concepts: help messages^printing
428: Concepts: printing^help messages
430: .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscErrorPrintf()
431: M*/
433: int PetscErrorPrintfDefault(const char format[],...)
434: {
435: va_list Argp;
436: static PetscTruth PetscErrorPrintfCalled = PETSC_FALSE;
437: static PetscTruth InPetscErrorPrintfDefault = PETSC_FALSE;
438: static FILE *fd;
439: char version[256];
440: /*
441: InPetscErrorPrintfDefault is used to prevent the error handler called (potentially)
442: from PetscSleep(), PetscGetArchName(), ... below from printing its own error message.
443: */
445: /*
447: it may be called by PetscStackView().
449: This function does not do error checking because it is called by the error handlers.
450: */
452: if (!PetscErrorPrintfCalled) {
453: char arch[10],hostname[64],username[16],pname[256],date[64];
454: PetscTruth use_stderr;
456: PetscErrorPrintfCalled = PETSC_TRUE;
457: InPetscErrorPrintfDefault = PETSC_TRUE;
459: PetscOptionsHasName(PETSC_NULL,"-error_output_stderr",&use_stderr);
460: if (use_stderr) {
461: fd = stderr;
462: } else {
463: fd = stdout;
464: }
466: /*
467: On the SGI machines and Cray T3E, if errors are generated "simultaneously" by
468: different processors, the messages are printed all jumbled up; to try to
469: prevent this we have each processor wait based on their rank
470: */
471: #if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
472: {
473: int rank;
474: MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
475: if (rank > 8) rank = 8;
476: PetscSleep(rank);
477: }
478: #endif
479:
480: PetscGetVersion(&version);
482: /* Cannot do error checking on these calls because we are called by error handler */
483: PetscGetArchType(arch,10);
484: PetscGetHostName(hostname,64);
485: PetscGetUserName(username,16);
486: PetscGetProgramName(pname,256);
487: PetscGetInitialDate(date,64);
488: fprintf(fd,"--------------------------------------------
489: ------------------------------n");
490: fprintf(fd,"%sn",version);
491: fprintf(fd,"%sn",PETSC_AUTHOR_INFO);
492: fprintf(fd,"See docs/copyright.html for copyright information.n");
493: fprintf(fd,"See docs/changes.html for recent updates.n");
494: fprintf(fd,"See docs/troubleshooting.html for hints about trouble shooting.n");
495: fprintf(fd,"See docs/manualpages/index.html for manual pages.n");
496: fprintf(fd,"--------------------------------------------
497: ---------------------------n");
498: fprintf(fd,"%s on a %s named %s by %s %sn",pname,arch,hostname,username,date);
499: #if !defined (PARCH_win32)
500: fprintf(fd,"Libraries linked from %sn",PETSC_LIB_DIR);
501: #endif
502: fprintf(fd,"--------------------------------------------
503: ---------------------------n");
504: fflush(fd);
505: InPetscErrorPrintfDefault = PETSC_FALSE;
506: }
508: if (!InPetscErrorPrintfDefault) {
509: va_start(Argp,format);
510: #if defined(PETSC_HAVE_VPRINTF_CHAR)
511: vfprintf(fd,format,(char *)Argp);
512: #else
513: vfprintf(fd,format,Argp);
514: #endif
515: fflush(fd);
516: va_end(Argp);
517: }
518: return 0;
519: }
521: /*@C
522: PetscSynchronizedFGets - Several processors all get the same line from a file.
524: Collective on MPI_Comm
526: Input Parameters:
527: + comm - the communicator
528: . fd - the file pointer
529: - len - the lenght of the output buffer
531: Output Parameter:
532: . string - the line read from the file
534: Level: intermediate
536: .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
537: PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
539: @*/
540: int PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,int len,char string[])
541: {
542: int ierr,rank;
545: MPI_Comm_rank(comm,&rank);
546:
547: /* First processor prints immediately to fp */
548: if (!rank) {
549: fgets(string,len,fp);
550: }
551: MPI_Bcast(string,len,MPI_BYTE,0,comm);
552: return(0);
553: }