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