1 #define PETSC_DLL 2 /* 3 Utilites routines to add simple ASCII IO capability. 4 */ 5 #include "src/sys/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; 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 #undef __FUNCT__ 25 #define __FUNCT__ "PetscFormatConvert" 26 PetscErrorCode PETSC_DLLEXPORT PetscFormatConvert(const char *format,char *newformat,PetscInt size) 27 { 28 PetscInt i = 0,j = 0; 29 30 while (format[i] && i < size-1) { 31 if (format[i] == '%' && format[i+1] == 'D') { 32 newformat[j++] = '%'; 33 #if defined(PETSC_USE_32BIT_INT) 34 newformat[j++] = 'd'; 35 #else 36 newformat[j++] = 'l'; 37 newformat[j++] = 'l'; 38 newformat[j++] = 'd'; 39 #endif 40 i += 2; 41 } else if (format[i] == '%' && format[i+1] >= '1' && format[i+1] <= '9' && format[i+2] == 'D') { 42 newformat[j++] = '%'; 43 newformat[j++] = format[i+1]; 44 #if defined(PETSC_USE_32BIT_INT) 45 newformat[j++] = 'd'; 46 #else 47 newformat[j++] = 'l'; 48 newformat[j++] = 'l'; 49 newformat[j++] = 'd'; 50 #endif 51 i += 3; 52 } else if (format[i] == '%' && format[i+1] == 'G') { 53 newformat[j++] = '%'; 54 #if defined(PETSC_USE_INT) 55 newformat[j++] = 'd'; 56 #elif !defined(PETSC_USE_LONG_DOUBLE) 57 newformat[j++] = 'g'; 58 #else 59 newformat[j++] = 'L'; 60 newformat[j++] = 'g'; 61 #endif 62 i += 2; 63 }else { 64 newformat[j++] = format[i++]; 65 } 66 } 67 newformat[j] = 0; 68 return 0; 69 } 70 71 #undef __FUNCT__ 72 #define __FUNCT__ "PetscVSNPrintf" 73 /* 74 No error handling because may be called by error handler 75 */ 76 PetscErrorCode PETSC_DLLEXPORT PetscVSNPrintf(char *str,size_t len,const char *format,va_list Argp) 77 { 78 /* no malloc since may be called by error handler */ 79 char newformat[8*1024]; 80 size_t length; 81 PetscErrorCode ierr; 82 83 PetscFormatConvert(format,newformat,8*1024); 84 ierr = PetscStrlen(newformat, &length);CHKERRQ(ierr); 85 if (length > len) { 86 newformat[len] = '\0'; 87 } 88 #if defined(PETSC_HAVE_VPRINTF_CHAR) 89 vsprintf(str,newformat,(char *)Argp); 90 #else 91 vsprintf(str,newformat,Argp); 92 #endif 93 return 0; 94 } 95 96 #undef __FUNCT__ 97 #define __FUNCT__ "PetscVFPrintf" 98 /* 99 All PETSc standard out and error messages are sent through this function; so, in theory, this can 100 can be replaced with something that does not simply write to a file. 101 102 Note: For error messages this may be called by a process, for regular standard out it is 103 called only by process 0 of a given communicator 104 105 No error handling because may be called by error handler 106 */ 107 PetscErrorCode PETSC_DLLEXPORT PetscVFPrintf(FILE *fd,const char *format,va_list Argp) 108 { 109 /* no malloc since may be called by error handler */ 110 char newformat[8*1024]; 111 112 extern FILE * PETSC_ZOPEFD; 113 PetscFormatConvert(format,newformat,8*1024); 114 if(PETSC_ZOPEFD != NULL){ 115 va_list s; 116 va_copy(s, Argp); 117 #if defined(PETSC_HAVE_VPRINTF_CHAR) 118 vfprintf(PETSC_ZOPEFD,newformat,(char *)s); 119 #else 120 vfprintf(PETSC_ZOPEFD,newformat,s); 121 fflush(PETSC_ZOPEFD); 122 #endif 123 } 124 125 #if defined(PETSC_HAVE_VPRINTF_CHAR) 126 vfprintf(fd,newformat,(char *)Argp); 127 #else 128 vfprintf(fd,newformat,Argp); 129 fflush(fd); 130 #endif 131 132 133 return 0; 134 } 135 136 #undef __FUNCT__ 137 #define __FUNCT__ "PetscSNPrintf" 138 /*@C 139 PetscSNPrintf - Prints to a string of given length 140 141 Not Collective 142 143 Input Parameters: 144 + str - the string to print to 145 . len - the length of str 146 . format - the usual printf() format string 147 - any arguments 148 149 Level: intermediate 150 151 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), PetscVSNPrintf(), 152 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf() 153 @*/ 154 PetscErrorCode PETSC_DLLEXPORT PetscSNPrintf(char *str,size_t len,const char format[],...) 155 { 156 PetscErrorCode ierr; 157 va_list Argp; 158 159 PetscFunctionBegin; 160 va_start(Argp,format); 161 ierr = PetscVSNPrintf(str,len,format,Argp);CHKERRQ(ierr); 162 PetscFunctionReturn(0); 163 } 164 165 /* ----------------------------------------------------------------------- */ 166 167 PrintfQueue queue = 0,queuebase = 0; 168 int queuelength = 0; 169 FILE *queuefile = PETSC_NULL; 170 171 #undef __FUNCT__ 172 #define __FUNCT__ "PetscSynchronizedPrintf" 173 /*@C 174 PetscSynchronizedPrintf - Prints synchronized output from several processors. 175 Output of the first processor is followed by that of the second, etc. 176 177 Not Collective 178 179 Input Parameters: 180 + comm - the communicator 181 - format - the usual printf() format string 182 183 Level: intermediate 184 185 Notes: 186 REQUIRES a intervening call to PetscSynchronizedFlush() for the information 187 from all the processors to be printed. 188 189 Fortran Note: 190 The call sequence is PetscSynchronizedPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran. 191 That is, you can only pass a single character string from Fortran. 192 193 The length of the formatted message cannot exceed QUEUESTRINGSIZE characters. 194 195 .seealso: PetscSynchronizedFlush(), PetscSynchronizedFPrintf(), PetscFPrintf(), 196 PetscPrintf(), PetscViewerASCIIPrintf(), PetscViewerASCIISynchronizedPrintf() 197 @*/ 198 PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedPrintf(MPI_Comm comm,const char format[],...) 199 { 200 PetscErrorCode ierr; 201 PetscMPIInt rank; 202 203 PetscFunctionBegin; 204 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 205 206 /* First processor prints immediately to stdout */ 207 if (!rank) { 208 va_list Argp; 209 va_start(Argp,format); 210 ierr = PetscVFPrintf(PETSC_STDOUT,format,Argp);CHKERRQ(ierr); 211 if (petsc_history) { 212 ierr = PetscVFPrintf(petsc_history,format,Argp);CHKERRQ(ierr); 213 } 214 va_end(Argp); 215 } else { /* other processors add to local queue */ 216 va_list Argp; 217 PrintfQueue next; 218 219 ierr = PetscNew(struct _PrintfQueue,&next);CHKERRQ(ierr); 220 if (queue) {queue->next = next; queue = next; queue->next = 0;} 221 else {queuebase = queue = next;} 222 queuelength++; 223 va_start(Argp,format); 224 ierr = PetscMemzero(next->string,QUEUESTRINGSIZE);CHKERRQ(ierr); 225 ierr = PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);CHKERRQ(ierr); 226 va_end(Argp); 227 } 228 229 PetscFunctionReturn(0); 230 } 231 232 #undef __FUNCT__ 233 #define __FUNCT__ "PetscSynchronizedFPrintf" 234 /*@C 235 PetscSynchronizedFPrintf - Prints synchronized output to the specified file from 236 several processors. Output of the first processor is followed by that of the 237 second, etc. 238 239 Not Collective 240 241 Input Parameters: 242 + comm - the communicator 243 . fd - the file pointer 244 - format - the usual printf() format string 245 246 Level: intermediate 247 248 Notes: 249 REQUIRES a intervening call to PetscSynchronizedFlush() for the information 250 from all the processors to be printed. 251 252 The length of the formatted message cannot exceed QUEUESTRINGSIZE characters. 253 254 Contributed by: Matthew Knepley 255 256 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf(), 257 PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf() 258 259 @*/ 260 PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFPrintf(MPI_Comm comm,FILE* fp,const char format[],...) 261 { 262 PetscErrorCode ierr; 263 PetscMPIInt rank; 264 265 PetscFunctionBegin; 266 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 267 268 /* First processor prints immediately to fp */ 269 if (!rank) { 270 va_list Argp; 271 va_start(Argp,format); 272 ierr = PetscVFPrintf(fp,format,Argp);CHKERRQ(ierr); 273 queuefile = fp; 274 if (petsc_history) { 275 ierr = PetscVFPrintf(petsc_history,format,Argp);CHKERRQ(ierr); 276 } 277 va_end(Argp); 278 } else { /* other processors add to local queue */ 279 va_list Argp; 280 PrintfQueue next; 281 ierr = PetscNew(struct _PrintfQueue,&next);CHKERRQ(ierr); 282 if (queue) {queue->next = next; queue = next; queue->next = 0;} 283 else {queuebase = queue = next;} 284 queuelength++; 285 va_start(Argp,format); 286 ierr = PetscMemzero(next->string,QUEUESTRINGSIZE);CHKERRQ(ierr); 287 ierr = PetscVSNPrintf(next->string,QUEUESTRINGSIZE,format,Argp);CHKERRQ(ierr); 288 va_end(Argp); 289 } 290 PetscFunctionReturn(0); 291 } 292 293 #undef __FUNCT__ 294 #define __FUNCT__ "PetscSynchronizedFlush" 295 /*@ 296 PetscSynchronizedFlush - Flushes to the screen output from all processors 297 involved in previous PetscSynchronizedPrintf() calls. 298 299 Collective on MPI_Comm 300 301 Input Parameters: 302 . comm - the communicator 303 304 Level: intermediate 305 306 Notes: 307 Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with 308 different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush(). 309 310 .seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(), 311 PetscViewerASCIISynchronizedPrintf() 312 @*/ 313 PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFlush(MPI_Comm comm) 314 { 315 PetscErrorCode ierr; 316 PetscMPIInt rank,size,tag,i,j,n; 317 char message[QUEUESTRINGSIZE]; 318 MPI_Status status; 319 FILE *fd; 320 321 PetscFunctionBegin; 322 ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr); 323 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 324 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 325 326 /* First processor waits for messages from all other processors */ 327 if (!rank) { 328 if (queuefile) { 329 fd = queuefile; 330 } else { 331 fd = PETSC_STDOUT; 332 } 333 for (i=1; i<size; i++) { 334 ierr = MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr); 335 for (j=0; j<n; j++) { 336 ierr = MPI_Recv(message,QUEUESTRINGSIZE,MPI_CHAR,i,tag,comm,&status);CHKERRQ(ierr); 337 ierr = PetscFPrintf(comm,fd,"%s",message); 338 } 339 } 340 queuefile = PETSC_NULL; 341 } else { /* other processors send queue to processor 0 */ 342 PrintfQueue next = queuebase,previous; 343 344 ierr = MPI_Send(&queuelength,1,MPI_INT,0,tag,comm);CHKERRQ(ierr); 345 for (i=0; i<queuelength; i++) { 346 ierr = MPI_Send(next->string,QUEUESTRINGSIZE,MPI_CHAR,0,tag,comm);CHKERRQ(ierr); 347 previous = next; 348 next = next->next; 349 ierr = PetscFree(previous);CHKERRQ(ierr); 350 } 351 queue = 0; 352 queuelength = 0; 353 } 354 ierr = PetscCommDestroy(&comm);CHKERRQ(ierr); 355 PetscFunctionReturn(0); 356 } 357 358 /* ---------------------------------------------------------------------------------------*/ 359 360 #undef __FUNCT__ 361 #define __FUNCT__ "PetscFPrintf" 362 /*@C 363 PetscFPrintf - Prints to a file, only from the first 364 processor in the communicator. 365 366 Not Collective 367 368 Input Parameters: 369 + comm - the communicator 370 . fd - the file pointer 371 - format - the usual printf() format string 372 373 Level: intermediate 374 375 Fortran Note: 376 This routine is not supported in Fortran. 377 378 Concepts: printing^in parallel 379 Concepts: printf^in parallel 380 381 .seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIPrintf(), 382 PetscViewerASCIISynchronizedPrintf(), PetscSynchronizedFlush() 383 @*/ 384 PetscErrorCode PETSC_DLLEXPORT PetscFPrintf(MPI_Comm comm,FILE* fd,const char format[],...) 385 { 386 PetscErrorCode ierr; 387 PetscMPIInt rank; 388 389 PetscFunctionBegin; 390 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 391 if (!rank) { 392 va_list Argp; 393 va_start(Argp,format); 394 ierr = PetscVFPrintf(fd,format,Argp);CHKERRQ(ierr); 395 if (petsc_history) { 396 ierr = PetscVFPrintf(petsc_history,format,Argp);CHKERRQ(ierr); 397 } 398 va_end(Argp); 399 } 400 PetscFunctionReturn(0); 401 } 402 403 #undef __FUNCT__ 404 #define __FUNCT__ "PetscPrintf" 405 /*@C 406 PetscPrintf - Prints to standard out, only from the first 407 processor in the communicator. 408 409 Not Collective 410 411 Input Parameters: 412 + comm - the communicator 413 - format - the usual printf() format string 414 415 Level: intermediate 416 417 Fortran Note: 418 The call sequence is PetscPrintf(PetscViewer, character(*), PetscErrorCode ierr) from Fortran. 419 That is, you can only pass a single character string from Fortran. 420 421 Notes: %A is replace with %g unless the value is < 1.e-12 when it is 422 replaced with < 1.e-12 423 424 Concepts: printing^in parallel 425 Concepts: printf^in parallel 426 427 .seealso: PetscFPrintf(), PetscSynchronizedPrintf() 428 @*/ 429 PetscErrorCode PETSC_DLLEXPORT PetscPrintf(MPI_Comm comm,const char format[],...) 430 { 431 PetscErrorCode ierr; 432 PetscMPIInt rank; 433 size_t len; 434 char *nformat,*sub1,*sub2; 435 PetscReal value; 436 437 PetscFunctionBegin; 438 if (!comm) comm = PETSC_COMM_WORLD; 439 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 440 if (!rank) { 441 va_list Argp; 442 va_start(Argp,format); 443 444 ierr = PetscStrstr(format,"%A",&sub1);CHKERRQ(ierr); 445 if (sub1) { 446 ierr = PetscStrstr(format,"%",&sub2);CHKERRQ(ierr); 447 if (sub1 != sub2) SETERRQ(PETSC_ERR_ARG_WRONG,"%%A format must be first in format string"); 448 ierr = PetscStrlen(format,&len);CHKERRQ(ierr); 449 ierr = PetscMalloc((len+16)*sizeof(char),&nformat);CHKERRQ(ierr); 450 ierr = PetscStrcpy(nformat,format);CHKERRQ(ierr); 451 ierr = PetscStrstr(nformat,"%",&sub2);CHKERRQ(ierr); 452 sub2[0] = 0; 453 value = (double)va_arg(Argp,double); 454 if (PetscAbsReal(value) < 1.e-12) { 455 ierr = PetscStrcat(nformat,"< 1.e-12");CHKERRQ(ierr); 456 } else { 457 ierr = PetscStrcat(nformat,"%g");CHKERRQ(ierr); 458 va_end(Argp); 459 va_start(Argp,format); 460 } 461 ierr = PetscStrcat(nformat,sub1+2);CHKERRQ(ierr); 462 } else { 463 nformat = (char*)format; 464 } 465 ierr = PetscVFPrintf(PETSC_STDOUT,nformat,Argp);CHKERRQ(ierr); 466 if (petsc_history) { 467 ierr = PetscVFPrintf(petsc_history,nformat,Argp);CHKERRQ(ierr); 468 } 469 va_end(Argp); 470 if (sub1) {ierr = PetscFree(nformat);CHKERRQ(ierr);} 471 } 472 PetscFunctionReturn(0); 473 } 474 475 /* ---------------------------------------------------------------------------------------*/ 476 #undef __FUNCT__ 477 #define __FUNCT__ "PetscHelpPrintfDefault" 478 PetscErrorCode PETSC_DLLEXPORT PetscHelpPrintfDefault(MPI_Comm comm,const char format[],...) 479 { 480 PetscErrorCode ierr; 481 PetscMPIInt rank; 482 483 PetscFunctionBegin; 484 if (!comm) comm = PETSC_COMM_WORLD; 485 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 486 if (!rank) { 487 va_list Argp; 488 va_start(Argp,format); 489 ierr = PetscVFPrintf(PETSC_STDOUT,format,Argp);CHKERRQ(ierr); 490 if (petsc_history) { 491 ierr = PetscVFPrintf(petsc_history,format,Argp);CHKERRQ(ierr); 492 } 493 va_end(Argp); 494 } 495 PetscFunctionReturn(0); 496 } 497 498 /* ---------------------------------------------------------------------------------------*/ 499 500 501 #undef __FUNCT__ 502 #define __FUNCT__ "PetscSynchronizedFGets" 503 /*@C 504 PetscSynchronizedFGets - Several processors all get the same line from a file. 505 506 Collective on MPI_Comm 507 508 Input Parameters: 509 + comm - the communicator 510 . fd - the file pointer 511 - len - the length of the output buffer 512 513 Output Parameter: 514 . string - the line read from the file 515 516 Level: intermediate 517 518 .seealso: PetscSynchronizedPrintf(), PetscSynchronizedFlush(), 519 PetscFOpen(), PetscViewerASCIISynchronizedPrintf(), PetscViewerASCIIPrintf() 520 521 @*/ 522 PetscErrorCode PETSC_DLLEXPORT PetscSynchronizedFGets(MPI_Comm comm,FILE* fp,size_t len,char string[]) 523 { 524 PetscErrorCode ierr; 525 PetscMPIInt rank; 526 527 PetscFunctionBegin; 528 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 529 530 if (!rank) { 531 fgets(string,len,fp); 532 } 533 ierr = MPI_Bcast(string,len,MPI_BYTE,0,comm);CHKERRQ(ierr); 534 PetscFunctionReturn(0); 535 } 536