1 /*
2 Utilites routines to add simple ASCII IO capability.
3 */
4 #include <../src/sys/fileio/mprint.h>
5 #include <errno.h>
6 /*
7 If petsc_history is on, then all Petsc*Printf() results are saved
8 if the appropriate (usually .petschistory) file.
9 */
10 PETSC_INTERN FILE *petsc_history;
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 = NULL;
17 /*
18 Allows one to overwrite where standard error is sent. For example
19 PETSC_STDERR = fopen("/dev/ttyXX","w") will cause all standard error
20 writes to go to terminal XX; assuming you have write permission there
21 */
22 FILE *PETSC_STDERR = NULL;
23
24 /*@C
25 PetscFormatConvertGetSize - Gets the length of a string needed to hold format converted with PetscFormatConvert()
26
27 Input Parameter:
28 . format - the PETSc format string
29
30 Output Parameter:
31 . size - the needed length of the new format
32
33 Level: developer
34
35 .seealso: PetscFormatConvert(), PetscVSNPrintf(), PetscVFPrintf()
36
37 @*/
PetscFormatConvertGetSize(const char * format,size_t * size)38 PetscErrorCode PetscFormatConvertGetSize(const char *format,size_t *size)
39 {
40 PetscInt i = 0;
41
42 PetscFunctionBegin;
43 *size = 0;
44 while (format[i]) {
45 if (format[i] == '%' && format[i+1] == '%') {
46 i++; i++; *size += 2;
47 } else if (format[i] == '%') {
48 /* Find the letter */
49 for (; format[i] && format[i] <= '9'; i++,(*size += 1));
50 switch (format[i]) {
51 case 'D':
52 #if defined(PETSC_USE_64BIT_INDICES)
53 *size += 2;
54 #endif
55 break;
56 case 'g':
57 *size += 4;
58 break;
59 default:
60 break;
61 }
62 *size += 1;
63 i++;
64 } else {
65 i++;
66 *size += 1;
67 }
68 }
69 *size += 1; /* space for NULL character */
70 PetscFunctionReturn(0);
71 }
72
73 /*@C
74 PetscFormatConvert - Takes a PETSc format string and converts the %D to %d for 32 bit PETSc indices and %lld for 64 bit PETSc indices. Also
75 converts %g to [|%g|] so that PetscVSNPrintf() can easily insure all %g formatted numbers have a decimal point when printed.
76
77 Input Parameters:
78 + format - the PETSc format string
79 . newformat - the location to put the new format
80 - size - the length of newformat, you can use PetscFormatConvertGetSize() to compute the needed size
81
82 Note: this exists so we can have the same code when PetscInt is either int or long long int
83
84 Level: developer
85
86 .seealso: PetscFormatConvertGetSize(), PetscVSNPrintf(), PetscVFPrintf()
87
88 @*/
PetscFormatConvert(const char * format,char * newformat)89 PetscErrorCode PetscFormatConvert(const char *format,char *newformat)
90 {
91 PetscInt i = 0, j = 0;
92
93 PetscFunctionBegin;
94 while (format[i]) {
95 if (format[i] == '%' && format[i+1] == '%') {
96 newformat[j++] = format[i++];
97 newformat[j++] = format[i++];
98 } else if (format[i] == '%') {
99 if (format[i+1] == 'g') {
100 newformat[j++] = '[';
101 newformat[j++] = '|';
102 }
103 /* Find the letter */
104 for (; format[i] && format[i] <= '9'; i++) newformat[j++] = format[i];
105 switch (format[i]) {
106 case 'D':
107 #if !defined(PETSC_USE_64BIT_INDICES)
108 newformat[j++] = 'd';
109 #else
110 newformat[j++] = 'l';
111 newformat[j++] = 'l';
112 newformat[j++] = 'd';
113 #endif
114 break;
115 case 'g':
116 newformat[j++] = format[i];
117 if (format[i-1] == '%') {
118 newformat[j++] = '|';
119 newformat[j++] = ']';
120 }
121 break;
122 case 'G':
123 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%G format is no longer supported, use %%g and cast the argument to double");
124 break;
125 case 'F':
126 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"%%F format is no longer supported, use %%f and cast the argument to double");
127 break;
128 default:
129 newformat[j++] = format[i];
130 break;
131 }
132 i++;
133 } else newformat[j++] = format[i++];
134 }
135 newformat[j] = 0;
136 PetscFunctionReturn(0);
137 }
138
139 #define PETSCDEFAULTBUFFERSIZE 8*1024
140
141 /*@C
142 PetscVSNPrintf - The PETSc version of vsnprintf(). Converts a PETSc format string into a standard C format string and then puts all the
143 function arguments into a string using the format statement.
144
145 Input Parameters:
146 + str - location to put result
147 . len - the amount of space in str
148 + format - the PETSc format string
149 - fullLength - the amount of space in str actually used.
150
151 Developer Notes:
152 this function may be called from an error handler, if an error occurs when it is called by the error handler than likely
153 a recursion will occur and possible crash.
154
155 Level: developer
156
157 .seealso: PetscVSNPrintf(), PetscErrorPrintf(), PetscVPrintf()
158
159 @*/
PetscVSNPrintf(char * str,size_t len,const char * format,size_t * fullLength,va_list Argp)160 PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp)
161 {
162 char *newformat = NULL;
163 char formatbuf[PETSCDEFAULTBUFFERSIZE];
164 size_t newLength;
165 PetscErrorCode ierr;
166 int flen;
167
168 PetscFunctionBegin;
169 ierr = PetscFormatConvertGetSize(format,&newLength);CHKERRQ(ierr);
170 if (newLength < PETSCDEFAULTBUFFERSIZE) {
171 newformat = formatbuf;
172 newLength = PETSCDEFAULTBUFFERSIZE-1;
173 } else {
174 ierr = PetscMalloc1(newLength, &newformat);CHKERRQ(ierr);
175 }
176 ierr = PetscFormatConvert(format,newformat);CHKERRQ(ierr);
177 #if defined(PETSC_HAVE_VSNPRINTF)
178 flen = vsnprintf(str,len,newformat,Argp);
179 #else
180 #error "vsnprintf not found"
181 #endif
182 if (newLength > PETSCDEFAULTBUFFERSIZE-1) {
183 ierr = PetscFree(newformat);CHKERRQ(ierr);
184 }
185 {
186 PetscBool foundedot;
187 size_t cnt = 0,ncnt = 0,leng;
188 ierr = PetscStrlen(str,&leng);CHKERRQ(ierr);
189 if (leng > 4) {
190 for (cnt=0; cnt<leng-4; cnt++) {
191 if (str[cnt] == '[' && str[cnt+1] == '|'){
192 flen -= 4;
193 cnt++; cnt++;
194 foundedot = PETSC_FALSE;
195 for (; cnt<leng-1; cnt++) {
196 if (str[cnt] == '|' && str[cnt+1] == ']'){
197 cnt++;
198 if (!foundedot) str[ncnt++] = '.';
199 ncnt--;
200 break;
201 } else {
202 if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE;
203 str[ncnt++] = str[cnt];
204 }
205 }
206 } else {
207 str[ncnt] = str[cnt];
208 }
209 ncnt++;
210 }
211 while (cnt < leng) {
212 str[ncnt] = str[cnt]; ncnt++; cnt++;
213 }
214 str[ncnt] = 0;
215 }
216 }
217 #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
218 /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */
219 {
220 size_t cnt = 0,ncnt = 0,leng;
221 ierr = PetscStrlen(str,&leng);CHKERRQ(ierr);
222 if (leng > 5) {
223 for (cnt=0; cnt<leng-4; cnt++) {
224 if (str[cnt] == 'e' && (str[cnt+1] == '-' || str[cnt+1] == '+') && str[cnt+2] == '0' && str[cnt+3] >= '0' && str[cnt+3] <= '9' && str[cnt+4] >= '0' && str[cnt+4] <= '9') {
225 str[ncnt] = str[cnt]; ncnt++; cnt++;
226 str[ncnt] = str[cnt]; ncnt++; cnt++; cnt++;
227 str[ncnt] = str[cnt];
228 } else {
229 str[ncnt] = str[cnt];
230 }
231 ncnt++;
232 }
233 while (cnt < leng) {
234 str[ncnt] = str[cnt]; ncnt++; cnt++;
235 }
236 str[ncnt] = 0;
237 }
238 }
239 #endif
240 if (fullLength) *fullLength = 1 + (size_t) flen;
241 PetscFunctionReturn(0);
242 }
243
244 /*@C
245 PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can
246 can be replaced with something that does not simply write to a file.
247
248 To use, write your own function for example,
249 $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp)
250 ${
251 $ PetscErrorCode ierr;
252 $
253 $ PetscFunctionBegin;
254 $ if (fd != stdout && fd != stderr) { handle regular files
255 $ ierr = PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr);
256 $ } else {
257 $ char buff[BIG];
258 $ size_t length;
259 $ ierr = PetscVSNPrintf(buff,BIG,format,&length,Argp);CHKERRQ(ierr);
260 $ now send buff to whatever stream or whatever you want
261 $ }
262 $ PetscFunctionReturn(0);
263 $}
264 then before the call to PetscInitialize() do the assignment
265 $ PetscVFPrintf = mypetscvfprintf;
266
267 Notes:
268 For error messages this may be called by any process, for regular standard out it is
269 called only by process 0 of a given communicator
270
271 Developer Notes:
272 this could be called by an error handler, if that happens then a recursion of the error handler may occur
273 and a crash
274
275 Level: developer
276
277 .seealso: PetscVSNPrintf(), PetscErrorPrintf()
278
279 @*/
PetscVFPrintfDefault(FILE * fd,const char * format,va_list Argp)280 PetscErrorCode PetscVFPrintfDefault(FILE *fd,const char *format,va_list Argp)
281 {
282 char str[PETSCDEFAULTBUFFERSIZE];
283 char *buff = str;
284 size_t fullLength;
285 PetscErrorCode ierr;
286 #if defined(PETSC_HAVE_VA_COPY)
287 va_list Argpcopy;
288 #endif
289
290 PetscFunctionBegin;
291 #if defined(PETSC_HAVE_VA_COPY)
292 va_copy(Argpcopy,Argp);
293 #endif
294 ierr = PetscVSNPrintf(str,sizeof(str),format,&fullLength,Argp);CHKERRQ(ierr);
295 if (fullLength > sizeof(str)) {
296 ierr = PetscMalloc1(fullLength,&buff);CHKERRQ(ierr);
297 #if defined(PETSC_HAVE_VA_COPY)
298 ierr = PetscVSNPrintf(buff,fullLength,format,NULL,Argpcopy);CHKERRQ(ierr);
299 #else
300 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"C89 does not support va_copy() hence cannot print long strings with PETSc printing routines");
301 #endif
302 }
303 fprintf(fd,"%s",buff);CHKERRQ(ierr);
304 fflush(fd);
305 if (buff != str) {
306 ierr = PetscFree(buff);CHKERRQ(ierr);
307 }
308 PetscFunctionReturn(0);
309 }
310
311 /*@C
312 PetscSNPrintf - Prints to a string of given length
313
314 Not Collective
315
316 Input Parameters:
317 + str - the string to print to
318 . len - the length of str
319 . format - the usual printf() format string
320 - any arguments
321
322 Level: intermediate
323
324 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
325 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscVFPrintf()
326 @*/
PetscSNPrintf(char * str,size_t len,const char format[],...)327 PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...)
328 {
329 PetscErrorCode ierr;
330 size_t fullLength;
331 va_list Argp;
332
333 PetscFunctionBegin;
334 va_start(Argp,format);
335 ierr = PetscVSNPrintf(str,len,format,&fullLength,Argp);CHKERRQ(ierr);
336 PetscFunctionReturn(0);
337 }
338
339 /*@C
340 PetscSNPrintfCount - Prints to a string of given length, returns count
341
342 Not Collective
343
344 Input Parameters:
345 + str - the string to print to
346 . len - the length of str
347 . format - the usual printf() format string
348 - any arguments
349
350 Output Parameter:
351 . countused - number of characters used
352
353 Level: intermediate
354
355 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(),
356 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf(), PetscVFPrintf()
357 @*/
PetscSNPrintfCount(char * str,size_t len,const char format[],size_t * countused,...)358 PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...)
359 {
360 PetscErrorCode ierr;
361 va_list Argp;
362
363 PetscFunctionBegin;
364 va_start(Argp,countused);
365 ierr = PetscVSNPrintf(str,len,format,countused,Argp);CHKERRQ(ierr);
366 PetscFunctionReturn(0);
367 }
368
369 /* ----------------------------------------------------------------------- */
370
371 PrintfQueue petsc_printfqueue = NULL,petsc_printfqueuebase = NULL;
372 int petsc_printfqueuelength = 0;
373
374 /*@C
375 PetscSynchronizedPrintf - Prints synchronized output from several processors.
376 Output of the first processor is followed by that of the second, etc.
377
378 Not Collective
379
380 Input Parameters:
381 + comm - the communicator
382 - format - the usual printf() format string
383
384 Level: intermediate
385
386 Notes:
387 REQUIRES a call to PetscSynchronizedFlush() by all the processes after the completion of the calls to PetscSynchronizedPrintf() for the information
388 from all the processors to be printed.
389
390 Fortran Note:
391 The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
392 That is, you can only pass a single character string from Fortran.
393
394 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(),
395 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf()
396 @*/
PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)397 PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...)
398 {
399 PetscErrorCode ierr;
400 PetscMPIInt rank;
401
402 PetscFunctionBegin;
403 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
404 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
405
406 /* First processor prints immediately to stdout */
407 if (!rank) {
408 va_list Argp;
409 va_start(Argp,format);
410 ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr);
411 if (petsc_history) {
412 va_start(Argp,format);
413 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
414 }
415 va_end(Argp);
416 } else { /* other processors add to local queue */
417 va_list Argp;
418 PrintfQueue next;
419 size_t fullLength = PETSCDEFAULTBUFFERSIZE;
420
421 ierr = PetscNew(&next);CHKERRQ(ierr);
422 if (petsc_printfqueue) {
423 petsc_printfqueue->next = next;
424 petsc_printfqueue = next;
425 petsc_printfqueue->next = NULL;
426 } else petsc_printfqueuebase = petsc_printfqueue = next;
427 petsc_printfqueuelength++;
428 next->size = -1;
429 next->string = NULL;
430 while ((PetscInt)fullLength >= next->size) {
431 next->size = fullLength+1;
432 ierr = PetscFree(next->string);CHKERRQ(ierr);
433 ierr = PetscMalloc1(next->size, &next->string);CHKERRQ(ierr);
434 va_start(Argp,format);
435 ierr = PetscArrayzero(next->string,next->size);CHKERRQ(ierr);
436 ierr = PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);CHKERRQ(ierr);
437 va_end(Argp);
438 }
439 }
440 PetscFunctionReturn(0);
441 }
442
443 /*@C
444 PetscSynchronizedFPrintf - Prints synchronized output to the specified file from
445 several processors. Output of the first processor is followed by that of the
446 second, etc.
447
448 Not Collective
449
450 Input Parameters:
451 + comm - the communicator
452 . fd - the file pointer
453 - format - the usual printf() format string
454
455 Level: intermediate
456
457 Notes:
458 REQUIRES a intervening call to PetscSynchronizedFlush() for the information
459 from all the processors to be printed.
460
461 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(),
462 PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
463
464 @*/
PetscSynchronizedFPrintf(MPI_Comm comm,FILE * fp,const char format[],...)465 PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...)
466 {
467 PetscErrorCode ierr;
468 PetscMPIInt rank;
469
470 PetscFunctionBegin;
471 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
472 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
473
474 /* First processor prints immediately to fp */
475 if (!rank) {
476 va_list Argp;
477 va_start(Argp,format);
478 ierr = (*PetscVFPrintf)(fp,format,Argp);CHKERRQ(ierr);
479 if (petsc_history && (fp !=petsc_history)) {
480 va_start(Argp,format);
481 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
482 }
483 va_end(Argp);
484 } else { /* other processors add to local queue */
485 va_list Argp;
486 PrintfQueue next;
487 size_t fullLength = PETSCDEFAULTBUFFERSIZE;
488
489 ierr = PetscNew(&next);CHKERRQ(ierr);
490 if (petsc_printfqueue) {
491 petsc_printfqueue->next = next;
492 petsc_printfqueue = next;
493 petsc_printfqueue->next = NULL;
494 } else petsc_printfqueuebase = petsc_printfqueue = next;
495 petsc_printfqueuelength++;
496 next->size = -1;
497 next->string = NULL;
498 while ((PetscInt)fullLength >= next->size) {
499 next->size = fullLength+1;
500 ierr = PetscFree(next->string);CHKERRQ(ierr);
501 ierr = PetscMalloc1(next->size, &next->string);CHKERRQ(ierr);
502 va_start(Argp,format);
503 ierr = PetscArrayzero(next->string,next->size);CHKERRQ(ierr);
504 ierr = PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);CHKERRQ(ierr);
505 va_end(Argp);
506 }
507 }
508 PetscFunctionReturn(0);
509 }
510
511 /*@C
512 PetscSynchronizedFlush - Flushes to the screen output from all processors
513 involved in previous PetscSynchronizedPrintf()/PetscSynchronizedFPrintf() calls.
514
515 Collective
516
517 Input Parameters:
518 + comm - the communicator
519 - fd - the file pointer (valid on process 0 of the communicator)
520
521 Level: intermediate
522
523 Notes:
524 If PetscSynchronizedPrintf() and/or PetscSynchronizedFPrintf() are called with
525 different MPI communicators there must be an intervening call to PetscSynchronizedFlush() between the calls with different MPI communicators.
526
527 From Fortran pass PETSC_STDOUT if the flush is for standard out; otherwise pass a value obtained from PetscFOpen()
528
529 .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
530 PetscViewerASCIISynchronizedPrintf()
531 @*/
PetscSynchronizedFlush(MPI_Comm comm,FILE * fd)532 PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm,FILE *fd)
533 {
534 PetscErrorCode ierr;
535 PetscMPIInt rank,size,tag,i,j,n = 0,dummy = 0;
536 char *message;
537 MPI_Status status;
538
539 PetscFunctionBegin;
540 ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
541 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
542 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
543
544 /* First processor waits for messages from all other processors */
545 if (!rank) {
546 if (!fd) fd = PETSC_STDOUT;
547 for (i=1; i<size; i++) {
548 /* to prevent a flood of messages to process zero, request each message separately */
549 ierr = MPI_Send(&dummy,1,MPI_INT,i,tag,comm);CHKERRQ(ierr);
550 ierr = MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
551 for (j=0; j<n; j++) {
552 PetscMPIInt size = 0;
553
554 ierr = MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
555 ierr = PetscMalloc1(size, &message);CHKERRQ(ierr);
556 ierr = MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);CHKERRQ(ierr);
557 ierr = PetscFPrintf(comm,fd,"%s",message);CHKERRQ(ierr);
558 ierr = PetscFree(message);CHKERRQ(ierr);
559 }
560 }
561 } else { /* other processors send queue to processor 0 */
562 PrintfQueue next = petsc_printfqueuebase,previous;
563
564 ierr = MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);CHKERRQ(ierr);
565 ierr = MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
566 for (i=0; i<petsc_printfqueuelength; i++) {
567 ierr = MPI_Send(&next->size,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
568 ierr = MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);CHKERRQ(ierr);
569 previous = next;
570 next = next->next;
571 ierr = PetscFree(previous->string);CHKERRQ(ierr);
572 ierr = PetscFree(previous);CHKERRQ(ierr);
573 }
574 petsc_printfqueue = NULL;
575 petsc_printfqueuelength = 0;
576 }
577 ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
578 PetscFunctionReturn(0);
579 }
580
581 /* ---------------------------------------------------------------------------------------*/
582
583 /*@C
584 PetscFPrintf - Prints to a file, only from the first
585 processor in the communicator.
586
587 Not Collective
588
589 Input Parameters:
590 + comm - the communicator
591 . fd - the file pointer
592 - format - the usual printf() format string
593
594 Level: intermediate
595
596 Fortran Note:
597 This routine is not supported in Fortran.
598
599
600 .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(),
601 PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush()
602 @*/
PetscFPrintf(MPI_Comm comm,FILE * fd,const char format[],...)603 PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...)
604 {
605 PetscErrorCode ierr;
606 PetscMPIInt rank;
607
608 PetscFunctionBegin;
609 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
610 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
611 if (!rank) {
612 va_list Argp;
613 va_start(Argp,format);
614 ierr = (*PetscVFPrintf)(fd,format,Argp);CHKERRQ(ierr);
615 if (petsc_history && (fd !=petsc_history)) {
616 va_start(Argp,format);
617 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
618 }
619 va_end(Argp);
620 }
621 PetscFunctionReturn(0);
622 }
623
624 /*@C
625 PetscPrintf - Prints to standard out, only from the first
626 processor in the communicator. Calls from other processes are ignored.
627
628 Not Collective
629
630 Input Parameters:
631 + comm - the communicator
632 - format - the usual printf() format string
633
634 Level: intermediate
635
636 Notes:
637 PetscPrintf() supports some format specifiers that are unique to PETSc.
638 See the manual page for PetscFormatConvert() for details.
639
640 Fortran Note:
641 The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran.
642 That is, you can only pass a single character string from Fortran.
643
644
645 .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscFormatConvert()
646 @*/
PetscPrintf(MPI_Comm comm,const char format[],...)647 PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...)
648 {
649 PetscErrorCode ierr;
650 PetscMPIInt rank;
651
652 PetscFunctionBegin;
653 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
654 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
655 if (!rank) {
656 va_list Argp;
657 va_start(Argp,format);
658 ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr);
659 if (petsc_history) {
660 va_start(Argp,format);
661 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
662 }
663 va_end(Argp);
664 }
665 PetscFunctionReturn(0);
666 }
667
668 /* ---------------------------------------------------------------------------------------*/
669 /*@C
670 PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by
671 replacinng it with something that does not simply write to a stdout.
672
673 To use, write your own function for example,
674 $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....)
675 ${
676 $ PetscFunctionReturn(0);
677 $}
678 then before the call to PetscInitialize() do the assignment
679 $ PetscHelpPrintf = mypetschelpprintf;
680
681 Note: the default routine used is called PetscHelpPrintfDefault().
682
683 Level: developer
684
685 .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf()
686 @*/
PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)687 PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...)
688 {
689 PetscErrorCode ierr;
690 PetscMPIInt rank;
691
692 PetscFunctionBegin;
693 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed");
694 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
695 if (!rank) {
696 va_list Argp;
697 va_start(Argp,format);
698 ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr);
699 if (petsc_history) {
700 va_start(Argp,format);
701 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
702 }
703 va_end(Argp);
704 }
705 PetscFunctionReturn(0);
706 }
707
708 /* ---------------------------------------------------------------------------------------*/
709
710
711 /*@C
712 PetscSynchronizedFGets - Several processors all get the same line from a file.
713
714 Collective
715
716 Input Parameters:
717 + comm - the communicator
718 . fd - the file pointer
719 - len - the length of the output buffer
720
721 Output Parameter:
722 . string - the line read from the file, at end of file string[0] == 0
723
724 Level: intermediate
725
726 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(),
727 PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf()
728
729 @*/
PetscSynchronizedFGets(MPI_Comm comm,FILE * fp,size_t len,char string[])730 PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[])
731 {
732 PetscErrorCode ierr;
733 PetscMPIInt rank;
734
735 PetscFunctionBegin;
736 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
737
738 if (!rank) {
739 char *ptr = fgets(string, len, fp);
740
741 if (!ptr) {
742 string[0] = 0;
743 if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno);
744 }
745 }
746 ierr = MPI_Bcast(string,len,MPI_BYTE,0,comm);CHKERRQ(ierr);
747 PetscFunctionReturn(0);
748 }
749
750 #if defined(PETSC_HAVE_CLOSURE)
751 int (^SwiftClosure)(const char*) = 0;
752
PetscVFPrintfToString(FILE * fd,const char format[],va_list Argp)753 PetscErrorCode PetscVFPrintfToString(FILE *fd,const char format[],va_list Argp)
754 {
755 PetscErrorCode ierr;
756
757 PetscFunctionBegin;
758 if (fd != stdout && fd != stderr) { /* handle regular files */
759 ierr = PetscVFPrintfDefault(fd,format,Argp);CHKERRQ(ierr);
760 } else {
761 size_t length;
762 char buff[PETSCDEFAULTBUFFERSIZE];
763
764 ierr = PetscVSNPrintf(buff,sizeof(buff),format,&length,Argp);CHKERRQ(ierr);
765 ierr = SwiftClosure(buff);CHKERRQ(ierr);
766 }
767 PetscFunctionReturn(0);
768 }
769
770 /*
771 Provide a Swift function that processes all the PETSc calls to PetscVFPrintf()
772 */
773 PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*))
774 {
775 PetscVFPrintf = PetscVFPrintfToString;
776 SwiftClosure = closure;
777 return 0;
778 }
779 #endif
780
781 /*@C
782 PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations
783
784 Input Parameters:
785 . format - the PETSc format string
786
787 Level: developer
788
789 @*/
PetscFormatStrip(char * format)790 PetscErrorCode PetscFormatStrip(char *format)
791 {
792 size_t loc1 = 0, loc2 = 0;
793
794 PetscFunctionBegin;
795 while (format[loc2]) {
796 if (format[loc2] == '%') {
797 format[loc1++] = format[loc2++];
798 while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++;
799 }
800 format[loc1++] = format[loc2++];
801 }
802 PetscFunctionReturn(0);
803 }
804
PetscFormatRealArray(char buf[],size_t len,const char * fmt,PetscInt n,const PetscReal x[])805 PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[])
806 {
807 PetscErrorCode ierr;
808 PetscInt i;
809 size_t left,count;
810 char *p;
811
812 PetscFunctionBegin;
813 for (i=0,p=buf,left=len; i<n; i++) {
814 ierr = PetscSNPrintfCount(p,left,fmt,&count,(double)x[i]);CHKERRQ(ierr);
815 if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer");
816 left -= count;
817 p += count-1;
818 *p++ = ' ';
819 }
820 p[i ? 0 : -1] = 0;
821 PetscFunctionReturn(0);
822 }
823