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 extern 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 = 0; 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 = 0; 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 @*/ 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 @*/ 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: this function may be called from an error handler, if an error occurs when it is called by the error handler than likely 152 a recursion will occur and possible crash. 153 154 Level: developer 155 156 .seealso: PetscVSNPrintf(), PetscErrorPrintf(), PetscVPrintf() 157 158 @*/ 159 PetscErrorCode PetscVSNPrintf(char *str,size_t len,const char *format,size_t *fullLength,va_list Argp) 160 { 161 char *newformat = NULL; 162 char formatbuf[PETSCDEFAULTBUFFERSIZE]; 163 size_t newLength; 164 PetscErrorCode ierr; 165 int flen; 166 167 PetscFunctionBegin; 168 ierr = PetscFormatConvertGetSize(format,&newLength);CHKERRQ(ierr); 169 if (newLength < PETSCDEFAULTBUFFERSIZE) { 170 newformat = formatbuf; 171 newLength = PETSCDEFAULTBUFFERSIZE-1; 172 } else { 173 ierr = PetscMalloc1(newLength, &newformat);CHKERRQ(ierr); 174 } 175 ierr = PetscFormatConvert(format,newformat);CHKERRQ(ierr); 176 #if defined(PETSC_HAVE_VSNPRINTF_CHAR) 177 flen = (size_t) vsnprintf(str,len,newformat,(char*)Argp); 178 #elif defined(PETSC_HAVE_VSNPRINTF) 179 flen = (size_t) vsnprintf(str,len,newformat,Argp); 180 #elif defined(PETSC_HAVE__VSNPRINTF) 181 flen = (size_t) _vsnprintf(str,len,newformat,Argp); 182 #else 183 #error "vsnprintf not found" 184 #endif 185 if (fullLength) *fullLength = 1 + (size_t) flen; 186 if (newLength > PETSCDEFAULTBUFFERSIZE-1) { 187 ierr = PetscFree(newformat);CHKERRQ(ierr); 188 } 189 { 190 PetscBool foundedot; 191 size_t cnt = 0,ncnt = 0,leng; 192 ierr = PetscStrlen(str,&leng);CHKERRQ(ierr); 193 if (leng > 4) { 194 for (cnt=0; cnt<leng-4; cnt++) { 195 if (str[cnt] == '[' && str[cnt+1] == '|'){ 196 cnt++; cnt++; 197 foundedot = PETSC_FALSE; 198 for (; cnt<leng-1; cnt++) { 199 if (str[cnt] == '|' && str[cnt+1] == ']'){ 200 cnt++; 201 if (!foundedot) str[ncnt++] = '.'; 202 ncnt--; 203 break; 204 } else { 205 if (str[cnt] == 'e' || str[cnt] == '.') foundedot = PETSC_TRUE; 206 str[ncnt++] = str[cnt]; 207 } 208 } 209 } else { 210 str[ncnt] = str[cnt]; 211 } 212 ncnt++; 213 } 214 while (cnt < leng) { 215 str[ncnt] = str[cnt]; ncnt++; cnt++; 216 } 217 str[ncnt] = 0; 218 } 219 } 220 #if defined(PETSC_HAVE_WINDOWS_H) && !defined(PETSC_HAVE__SET_OUTPUT_FORMAT) 221 /* older Windows OS always produces e-+0np for floating point output; remove the extra 0 */ 222 { 223 size_t cnt = 0,ncnt = 0,leng; 224 ierr = PetscStrlen(str,&leng);CHKERRQ(ierr); 225 if (leng > 5) { 226 for (cnt=0; cnt<leng-4; cnt++) { 227 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') { 228 str[ncnt] = str[cnt]; ncnt++; cnt++; 229 str[ncnt] = str[cnt]; ncnt++; cnt++; cnt++; 230 str[ncnt] = str[cnt]; 231 } else { 232 str[ncnt] = str[cnt]; 233 } 234 ncnt++; 235 } 236 while (cnt < leng) { 237 str[ncnt] = str[cnt]; ncnt++; cnt++; 238 } 239 str[ncnt] = 0; 240 } 241 } 242 #endif 243 PetscFunctionReturn(0); 244 } 245 246 /*@C 247 PetscVFPrintf - All PETSc standard out and error messages are sent through this function; so, in theory, this can 248 can be replaced with something that does not simply write to a file. 249 250 To use, write your own function for example, 251 $PetscErrorCode mypetscvfprintf(FILE *fd,const char format[],va_list Argp) 252 ${ 253 $ PetscErrorCode ierr; 254 $ 255 $ PetscFunctionBegin; 256 $ if (fd != stdout && fd != stderr) { handle regular files 257 $ ierr = PetscVFPrintfDefault(fd,format,Argp);CHKERR(ierr); 258 $ } else { 259 $ char buff[BIG]; 260 $ size_t length; 261 $ ierr = PetscVSNPrintf(buff,BIG,format,&length,Argp);CHKERRQ(ierr); 262 $ now send buff to whatever stream or whatever you want 263 $ } 264 $ PetscFunctionReturn(0); 265 $} 266 then before the call to PetscInitialize() do the assignment 267 $ PetscVFPrintf = mypetscvfprintf; 268 269 Notes: For error messages this may be called by any process, for regular standard out it is 270 called only by process 0 of a given communicator 271 272 Developer Notes: 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 @*/ 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 va_list Argpcopy; 287 288 PetscFunctionBegin; 289 va_copy(Argpcopy,Argp); 290 ierr = PetscVSNPrintf(str,sizeof(str),format,&fullLength,Argp);CHKERRQ(ierr); 291 if (fullLength > sizeof(str)) { 292 ierr = PetscMalloc1(fullLength,&buff);CHKERRQ(ierr); 293 ierr = PetscVSNPrintf(buff,fullLength,format,NULL,Argpcopy);CHKERRQ(ierr); 294 } 295 fprintf(fd,"%s",buff);CHKERRQ(ierr); 296 fflush(fd); 297 if (buff != str) { 298 ierr = PetscFree(buff);CHKERRQ(ierr); 299 } 300 PetscFunctionReturn(0); 301 } 302 303 /*@C 304 PetscSNPrintf - Prints to a string of given length 305 306 Not Collective 307 308 Input Parameters: 309 + str - the string to print to 310 . len - the length of str 311 . format - the usual printf() format string 312 - any arguments 313 314 Level: intermediate 315 316 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(), 317 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscVFPrintf() 318 @*/ 319 PetscErrorCode PetscSNPrintf(char *str,size_t len,const char format[],...) 320 { 321 PetscErrorCode ierr; 322 size_t fullLength; 323 va_list Argp; 324 325 PetscFunctionBegin; 326 va_start(Argp,format); 327 ierr = PetscVSNPrintf(str,len,format,&fullLength,Argp);CHKERRQ(ierr); 328 PetscFunctionReturn(0); 329 } 330 331 /*@C 332 PetscSNPrintfCount - Prints to a string of given length, returns count 333 334 Not Collective 335 336 Input Parameters: 337 + str - the string to print to 338 . len - the length of str 339 . format - the usual printf() format string 340 . countused - number of characters used 341 - any arguments 342 343 Level: intermediate 344 345 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(), 346 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf(), PetscSNPrintf(), PetscVFPrintf() 347 @*/ 348 PetscErrorCode PetscSNPrintfCount(char *str,size_t len,const char format[],size_t *countused,...) 349 { 350 PetscErrorCode ierr; 351 va_list Argp; 352 353 PetscFunctionBegin; 354 va_start(Argp,countused); 355 ierr = PetscVSNPrintf(str,len,format,countused,Argp);CHKERRQ(ierr); 356 PetscFunctionReturn(0); 357 } 358 359 /* ----------------------------------------------------------------------- */ 360 361 PrintfQueue petsc_printfqueue = 0,petsc_printfqueuebase = 0; 362 int petsc_printfqueuelength = 0; 363 364 /*@C 365 PetscSynchronizedPrintf - Prints synchronized output from several processors. 366 Output of the first processor is followed by that of the second, etc. 367 368 Not Collective 369 370 Input Parameters: 371 + comm - the communicator 372 - format - the usual printf() format string 373 374 Level: intermediate 375 376 Notes: 377 REQUIRES a call to PetscSynchronizedFlush() by all the processes after the completion of the calls to PetscSynchronizedPrintf() for the information 378 from all the processors to be printed. 379 380 Fortran Note: 381 The call sequence is PetscSynchronizedPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran. 382 That is, you can only pass a single character string from Fortran. 383 384 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 385 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf() 386 @*/ 387 PetscErrorCode PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...) 388 { 389 PetscErrorCode ierr; 390 PetscMPIInt rank; 391 392 PetscFunctionBegin; 393 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 394 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 395 396 /* First processor prints immediately to stdout */ 397 if (!rank) { 398 va_list Argp; 399 va_start(Argp,format); 400 ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr); 401 if (petsc_history) { 402 va_start(Argp,format); 403 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr); 404 } 405 va_end(Argp); 406 } else { /* other processors add to local queue */ 407 va_list Argp; 408 PrintfQueue next; 409 size_t fullLength = PETSCDEFAULTBUFFERSIZE; 410 411 ierr = PetscNew(&next);CHKERRQ(ierr); 412 if (petsc_printfqueue) { 413 petsc_printfqueue->next = next; 414 petsc_printfqueue = next; 415 petsc_printfqueue->next = 0; 416 } else petsc_printfqueuebase = petsc_printfqueue = next; 417 petsc_printfqueuelength++; 418 next->size = -1; 419 next->string = NULL; 420 while ((PetscInt)fullLength >= next->size) { 421 next->size = fullLength+1; 422 ierr = PetscFree(next->string);CHKERRQ(ierr); 423 ierr = PetscMalloc1(next->size, &next->string);CHKERRQ(ierr); 424 va_start(Argp,format); 425 ierr = PetscMemzero(next->string,next->size);CHKERRQ(ierr); 426 ierr = PetscVSNPrintf(next->string,next->size,format, &fullLength,Argp);CHKERRQ(ierr); 427 va_end(Argp); 428 } 429 } 430 PetscFunctionReturn(0); 431 } 432 433 /*@C 434 PetscSynchronizedFPrintf - Prints synchronized output to the specified file from 435 several processors. Output of the first processor is followed by that of the 436 second, etc. 437 438 Not Collective 439 440 Input Parameters: 441 + comm - the communicator 442 . fd - the file pointer 443 - format - the usual printf() format string 444 445 Level: intermediate 446 447 Notes: 448 REQUIRES a intervening call to PetscSynchronizedFlush() for the information 449 from all the processors to be printed. 450 451 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(), 452 PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf() 453 454 @*/ 455 PetscErrorCode PetscSynchronizedFPrintf(MPI_Comm comm,FILE *fp,const char format[],...) 456 { 457 PetscErrorCode ierr; 458 PetscMPIInt rank; 459 460 PetscFunctionBegin; 461 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 462 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 463 464 /* First processor prints immediately to fp */ 465 if (!rank) { 466 va_list Argp; 467 va_start(Argp,format); 468 ierr = (*PetscVFPrintf)(fp,format,Argp);CHKERRQ(ierr); 469 if (petsc_history && (fp !=petsc_history)) { 470 va_start(Argp,format); 471 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr); 472 } 473 va_end(Argp); 474 } else { /* other processors add to local queue */ 475 va_list Argp; 476 PrintfQueue next; 477 size_t fullLength = PETSCDEFAULTBUFFERSIZE; 478 479 ierr = PetscNew(&next);CHKERRQ(ierr); 480 if (petsc_printfqueue) { 481 petsc_printfqueue->next = next; 482 petsc_printfqueue = next; 483 petsc_printfqueue->next = 0; 484 } else petsc_printfqueuebase = petsc_printfqueue = next; 485 petsc_printfqueuelength++; 486 next->size = -1; 487 next->string = NULL; 488 while ((PetscInt)fullLength >= next->size) { 489 next->size = fullLength+1; 490 ierr = PetscFree(next->string);CHKERRQ(ierr); 491 ierr = PetscMalloc1(next->size, &next->string);CHKERRQ(ierr); 492 va_start(Argp,format); 493 ierr = PetscMemzero(next->string,next->size);CHKERRQ(ierr); 494 ierr = PetscVSNPrintf(next->string,next->size,format,&fullLength,Argp);CHKERRQ(ierr); 495 va_end(Argp); 496 } 497 } 498 PetscFunctionReturn(0); 499 } 500 501 /*@C 502 PetscSynchronizedFlush - Flushes to the screen output from all processors 503 involved in previous PetscSynchronizedPrintf()/PetscSynchronizedFPrintf() calls. 504 505 Collective on MPI_Comm 506 507 Input Parameters: 508 + comm - the communicator 509 - fd - the file pointer (valid on process 0 of the communicator) 510 511 Level: intermediate 512 513 Notes: 514 If PetscSynchronizedPrintf() and/or PetscSynchronizedFPrintf() are called with 515 different MPI communicators there must be an intervening call to PetscSynchronizedFlush() between the calls with different MPI communicators. 516 517 From Fortran pass PETSC_STDOUT if the flush is for standard out; otherwise pass a value obtained from PetscFOpen() 518 519 .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(), 520 PetscViewerASCIISynchronizedPrintf() 521 @*/ 522 PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm,FILE *fd) 523 { 524 PetscErrorCode ierr; 525 PetscMPIInt rank,size,tag,i,j,n = 0,dummy = 0; 526 char *message; 527 MPI_Status status; 528 529 PetscFunctionBegin; 530 ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr); 531 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 532 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 533 534 /* First processor waits for messages from all other processors */ 535 if (!rank) { 536 if (!fd) fd = PETSC_STDOUT; 537 for (i=1; i<size; i++) { 538 /* to prevent a flood of messages to process zero, request each message separately */ 539 ierr = MPI_Send(&dummy,1,MPI_INT,i,tag,comm);CHKERRQ(ierr); 540 ierr = MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr); 541 for (j=0; j<n; j++) { 542 PetscMPIInt size = 0; 543 544 ierr = MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr); 545 ierr = PetscMalloc1(size, &message);CHKERRQ(ierr); 546 ierr = MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);CHKERRQ(ierr); 547 ierr = PetscFPrintf(comm,fd,"%s",message);CHKERRQ(ierr); 548 ierr = PetscFree(message);CHKERRQ(ierr); 549 } 550 } 551 } else { /* other processors send queue to processor 0 */ 552 PrintfQueue next = petsc_printfqueuebase,previous; 553 554 ierr = MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);CHKERRQ(ierr); 555 ierr = MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);CHKERRQ(ierr); 556 for (i=0; i<petsc_printfqueuelength; i++) { 557 ierr = MPI_Send(&next->size,1,MPI_INT,0,tag,comm);CHKERRQ(ierr); 558 ierr = MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);CHKERRQ(ierr); 559 previous = next; 560 next = next->next; 561 ierr = PetscFree(previous->string);CHKERRQ(ierr); 562 ierr = PetscFree(previous);CHKERRQ(ierr); 563 } 564 petsc_printfqueue = 0; 565 petsc_printfqueuelength = 0; 566 } 567 ierr = PetscCommDestroy(&comm);CHKERRQ(ierr); 568 PetscFunctionReturn(0); 569 } 570 571 /* ---------------------------------------------------------------------------------------*/ 572 573 /*@C 574 PetscFPrintf - Prints to a file, only from the first 575 processor in the communicator. 576 577 Not Collective 578 579 Input Parameters: 580 + comm - the communicator 581 . fd - the file pointer 582 - format - the usual printf() format string 583 584 Level: intermediate 585 586 Fortran Note: 587 This routine is not supported in Fortran. 588 589 Concepts: printing^in parallel 590 Concepts: printf^in parallel 591 592 .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(), 593 PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush() 594 @*/ 595 PetscErrorCode PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...) 596 { 597 PetscErrorCode ierr; 598 PetscMPIInt rank; 599 600 PetscFunctionBegin; 601 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 602 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 603 if (!rank) { 604 va_list Argp; 605 va_start(Argp,format); 606 ierr = (*PetscVFPrintf)(fd,format,Argp);CHKERRQ(ierr); 607 if (petsc_history && (fd !=petsc_history)) { 608 va_start(Argp,format); 609 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr); 610 } 611 va_end(Argp); 612 } 613 PetscFunctionReturn(0); 614 } 615 616 /*@C 617 PetscPrintf - Prints to standard out, only from the first 618 processor in the communicator. Calls from other processes are ignored. 619 620 Not Collective 621 622 Input Parameters: 623 + comm - the communicator 624 - format - the usual printf() format string 625 626 Level: intermediate 627 628 Fortran Note: 629 The call sequence is PetscPrintf(MPI_Comm, character(*), PetscErrorCode ierr) from Fortran. 630 That is, you can only pass a single character string from Fortran. 631 632 Concepts: printing^in parallel 633 Concepts: printf^in parallel 634 635 .seealso: PetscFPrintf(), PetscSynchronizedPrintf() 636 @*/ 637 PetscErrorCode PetscPrintf(MPI_Comm comm,const char format[],...) 638 { 639 PetscErrorCode ierr; 640 PetscMPIInt rank; 641 642 PetscFunctionBegin; 643 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 644 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 645 if (!rank) { 646 va_list Argp; 647 va_start(Argp,format); 648 ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr); 649 if (petsc_history) { 650 va_start(Argp,format); 651 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr); 652 } 653 va_end(Argp); 654 } 655 PetscFunctionReturn(0); 656 } 657 658 /* ---------------------------------------------------------------------------------------*/ 659 /*@C 660 PetscHelpPrintf - All PETSc help messages are passing through this function. You can change how help messages are printed by 661 replacinng it with something that does not simply write to a stdout. 662 663 To use, write your own function for example, 664 $PetscErrorCode mypetschelpprintf(MPI_Comm comm,const char format[],....) 665 ${ 666 $ PetscFunctionReturn(0); 667 $} 668 then before the call to PetscInitialize() do the assignment 669 $ PetscHelpPrintf = mypetschelpprintf; 670 671 Note: the default routine used is called PetscHelpPrintfDefault(). 672 673 Level: developer 674 675 .seealso: PetscVSNPrintf(), PetscVFPrintf(), PetscErrorPrintf() 676 @*/ 677 PetscErrorCode PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...) 678 { 679 PetscErrorCode ierr; 680 PetscMPIInt rank; 681 682 PetscFunctionBegin; 683 if (comm == MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Called with MPI_COMM_NULL, likely PetscObjectComm() failed"); 684 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 685 if (!rank) { 686 va_list Argp; 687 va_start(Argp,format); 688 ierr = (*PetscVFPrintf)(PETSC_STDOUT,format,Argp);CHKERRQ(ierr); 689 if (petsc_history) { 690 va_start(Argp,format); 691 ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr); 692 } 693 va_end(Argp); 694 } 695 PetscFunctionReturn(0); 696 } 697 698 /* ---------------------------------------------------------------------------------------*/ 699 700 701 /*@C 702 PetscSynchronizedFGets - Several processors all get the same line from a file. 703 704 Collective on MPI_Comm 705 706 Input Parameters: 707 + comm - the communicator 708 . fd - the file pointer 709 - len - the length of the output buffer 710 711 Output Parameter: 712 . string - the line read from the file, at end of file string[0] == 0 713 714 Level: intermediate 715 716 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 717 PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf() 718 719 @*/ 720 PetscErrorCode PetscSynchronizedFGets(MPI_Comm comm,FILE *fp,size_t len,char string[]) 721 { 722 PetscErrorCode ierr; 723 PetscMPIInt rank; 724 725 PetscFunctionBegin; 726 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 727 728 if (!rank) { 729 char *ptr = fgets(string, len, fp); 730 731 if (!ptr) { 732 string[0] = 0; 733 if (!feof(fp)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file: %d", errno); 734 } 735 } 736 ierr = MPI_Bcast(string,len,MPI_BYTE,0,comm);CHKERRQ(ierr); 737 PetscFunctionReturn(0); 738 } 739 740 #if defined(PETSC_HAVE_CLOSURES) 741 int (^SwiftClosure)(const char*) = 0; 742 743 PetscErrorCode PetscVFPrintfToString(FILE *fd,const char format[],va_list Argp) 744 { 745 PetscErrorCode ierr; 746 747 PetscFunctionBegin; 748 if (fd != stdout && fd != stderr) { /* handle regular files */ 749 ierr = PetscVFPrintfDefault(fd,format,Argp);CHKERRQ(ierr); 750 } else { 751 size_t length; 752 char buff[PETSCDEFAULTBUFFERSIZE]; 753 754 ierr = PetscVSNPrintf(buf,size(buff),format,&length,Argp);CHKERRQ(ierr); 755 ierr = SwiftClosure(buff);CHKERRQ(ierr); 756 } 757 PetscFunctionReturn(0); 758 } 759 760 /* 761 Provide a Swift function that processes all the PETSc calls to PetscVFPrintf() 762 */ 763 PetscErrorCode PetscVFPrintfSetClosure(int (^closure)(const char*)) 764 { 765 PetscVFPrintf = PetscVFPrintfToString; 766 SwiftClosure = closure; 767 return 0; 768 } 769 #endif 770 771 #if defined(PETSC_HAVE_MATLAB_ENGINE) 772 #include <mex.h> 773 PetscErrorCode PetscVFPrintf_Matlab(FILE *fd,const char format[],va_list Argp) 774 { 775 PetscErrorCode ierr; 776 777 PetscFunctionBegin; 778 if (fd != stdout && fd != stderr) { /* handle regular files */ 779 ierr = PetscVFPrintfDefault(fd,format,Argp);CHKERRQ(ierr); 780 } else { 781 size_t length; 782 char buff[len]; 783 784 ierr = PetscVSNPrintf(buff,sizeof(buff),format,&length,Argp);CHKERRQ(ierr); 785 mexPrintf("%s",buf); 786 } 787 PetscFunctionReturn(0); 788 } 789 #endif 790 791 /*@C 792 PetscFormatStrip - Takes a PETSc format string and removes all numerical modifiers to % operations 793 794 Input Parameters: 795 . format - the PETSc format string 796 797 Level: developer 798 799 @*/ 800 PetscErrorCode PetscFormatStrip(char *format) 801 { 802 size_t loc1 = 0, loc2 = 0; 803 804 PetscFunctionBegin; 805 while (format[loc2]) { 806 if (format[loc2] == '%') { 807 format[loc1++] = format[loc2++]; 808 while (format[loc2] && ((format[loc2] >= '0' && format[loc2] <= '9') || format[loc2] == '.')) loc2++; 809 } 810 format[loc1++] = format[loc2++]; 811 } 812 PetscFunctionReturn(0); 813 } 814 815