1 #define PETSC_DLL 2 /* 3 Code that allows one to set the error handlers 4 */ 5 #include "petsc.h" /*I "petsc.h" I*/ 6 #include "petscsys.h" 7 #include <stdarg.h> 8 #if defined(PETSC_HAVE_STDLIB_H) 9 #include <stdlib.h> 10 #endif 11 12 typedef struct _EH *EH; 13 struct _EH { 14 int cookie; 15 PetscErrorCode (*handler)(int,const char*,const char*,const char *,PetscErrorCode,int,const char*,void *); 16 void *ctx; 17 EH previous; 18 }; 19 20 static EH eh = 0; 21 22 #undef __FUNCT__ 23 #define __FUNCT__ "PetscEmacsClientErrorHandler" 24 /*@C 25 PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to 26 load the file where the error occured. Then calls the "previous" error handler. 27 28 Not Collective 29 30 Input Parameters: 31 + line - the line number of the error (indicated by __LINE__) 32 . func - the function where error is detected (indicated by __FUNCT__) 33 . file - the file in which the error was detected (indicated by __FILE__) 34 . dir - the directory of the file (indicated by __SDIR__) 35 . mess - an error text string, usually just printed to the screen 36 . n - the generic error number 37 . p - specific error number 38 - ctx - error handler context 39 40 Options Database Key: 41 . -on_error_emacs <machinename> 42 43 Level: developer 44 45 Notes: 46 You must put (server-start) in your .emacs file for the emacsclient software to work 47 48 Most users need not directly employ this routine and the other error 49 handlers, but can instead use the simplified interface SETERRQ, which has 50 the calling sequence 51 $ SETERRQ(number,p,mess) 52 53 Notes for experienced users: 54 Use PetscPushErrorHandler() to set the desired error handler. 55 56 Concepts: emacs^going to on error 57 Concepts: error handler^going to line in emacs 58 59 .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 60 PetscAbortErrorHandler() 61 @*/ 62 PetscErrorCode PETSC_DLLEXPORT PetscEmacsClientErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx) 63 { 64 PetscErrorCode ierr; 65 char command[PETSC_MAX_PATH_LEN]; 66 const char *pdir; 67 FILE *fp; 68 69 PetscFunctionBegin; 70 /* Note: don't check error codes since this an error handler :-) */ 71 ierr = PetscGetPetscDir(&pdir);CHKERRQ(ierr); 72 sprintf(command,"emacsclient +%d %s/%s%s\n",line,pdir,dir,file); 73 #if defined(PETSC_HAVE_POPEN) 74 ierr = PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp); 75 ierr = PetscPClose(MPI_COMM_WORLD,fp); 76 #else 77 SETERRQ(PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine"); 78 #endif 79 ierr = PetscPopErrorHandler(); /* remove this handler from the stack of handlers */ 80 if (!eh) ierr = PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0); 81 else ierr = (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx); 82 PetscFunctionReturn(ierr); 83 } 84 85 #undef __FUNCT__ 86 #define __FUNCT__ "PetscPushErrorHandler" 87 /*@C 88 PetscPushErrorHandler - Sets a routine to be called on detection of errors. 89 90 Not Collective 91 92 Input Parameters: 93 + handler - error handler routine 94 - ctx - optional handler context that contains information needed by the handler (for 95 example file pointers for error messages etc.) 96 97 Calling sequence of handler: 98 $ int handler(int line,char *func,char *file,char *dir,PetscErrorCode n,int p,char *mess,void *ctx); 99 100 + func - the function where the error occured (indicated by __FUNCT__) 101 . line - the line number of the error (indicated by __LINE__) 102 . file - the file in which the error was detected (indicated by __FILE__) 103 . dir - the directory of the file (indicated by __SDIR__) 104 . n - the generic error number (see list defined in include/petscerror.h) 105 . p - the specific error number 106 . mess - an error text string, usually just printed to the screen 107 - ctx - the error handler context 108 109 Options Database Keys: 110 + -on_error_attach_debugger <noxterm,gdb or dbx> 111 - -on_error_abort 112 113 Level: intermediate 114 115 Notes: 116 The currently available PETSc error handlers include PetscTraceBackErrorHandler(), 117 PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler(). 118 119 Fortran Notes: You can only push one error handler from Fortran before poping it. 120 121 .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler() 122 123 @*/ 124 PetscErrorCode PETSC_DLLEXPORT PetscPushErrorHandler(PetscErrorCode (*handler)(int,const char *,const char*,const char*,PetscErrorCode,int,const char*,void*),void *ctx) 125 { 126 EH neweh; 127 PetscErrorCode ierr; 128 129 PetscFunctionBegin; 130 ierr = PetscNew(struct _EH,&neweh);CHKERRQ(ierr); 131 if (eh) {neweh->previous = eh;} 132 else {neweh->previous = 0;} 133 neweh->handler = handler; 134 neweh->ctx = ctx; 135 eh = neweh; 136 PetscFunctionReturn(0); 137 } 138 139 #undef __FUNCT__ 140 #define __FUNCT__ "PetscPopErrorHandler" 141 /*@ 142 PetscPopErrorHandler - Removes the latest error handler that was 143 pushed with PetscPushErrorHandler(). 144 145 Not Collective 146 147 Level: intermediate 148 149 Concepts: error handler^setting 150 151 .seealso: PetscPushErrorHandler() 152 @*/ 153 PetscErrorCode PETSC_DLLEXPORT PetscPopErrorHandler(void) 154 { 155 EH tmp; 156 PetscErrorCode ierr; 157 158 PetscFunctionBegin; 159 if (!eh) PetscFunctionReturn(0); 160 tmp = eh; 161 eh = eh->previous; 162 ierr = PetscFree(tmp);CHKERRQ(ierr); 163 164 PetscFunctionReturn(0); 165 } 166 167 #undef __FUNCT__ 168 #define __FUNCT__ "PetscReturnErrorHandler" 169 /*@C 170 PetscReturnErrorHandler - Error handler that causes a return to the current 171 level. 172 173 Not Collective 174 175 Input Parameters: 176 + line - the line number of the error (indicated by __LINE__) 177 . func - the function where error is detected (indicated by __FUNCT__) 178 . file - the file in which the error was detected (indicated by __FILE__) 179 . dir - the directory of the file (indicated by __SDIR__) 180 . mess - an error text string, usually just printed to the screen 181 . n - the generic error number 182 . p - specific error number 183 - ctx - error handler context 184 185 Level: developer 186 187 Notes: 188 Most users need not directly employ this routine and the other error 189 handlers, but can instead use the simplified interface SETERRQ, which has 190 the calling sequence 191 $ SETERRQ(number,p,mess) 192 193 Notes for experienced users: 194 This routine is good for catching errors such as zero pivots in preconditioners 195 or breakdown of iterative methods. It is not appropriate for memory violations 196 and similar errors. 197 198 Use PetscPushErrorHandler() to set the desired error handler. The 199 currently available PETSc error handlers include PetscTraceBackErrorHandler(), 200 PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler() 201 202 Concepts: error handler 203 204 .seealso: PetscPushErrorHandler(), PetscPopErrorHandler(). 205 @*/ 206 207 PetscErrorCode PETSC_DLLEXPORT PetscReturnErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx) 208 { 209 PetscFunctionBegin; 210 PetscFunctionReturn(n); 211 } 212 213 static char PetscErrorBaseMessage[1024]; 214 /* 215 The numerical values for these are defined in include/petscerror.h; any changes 216 there must also be made here 217 */ 218 static const char *PetscErrorStrings[] = { 219 /*55 */ "Out of memory", 220 "No support for this operation for this object type", 221 "No support for this operation on this system", 222 /*58 */ "Operation done in wrong order", 223 /*59 */ "Signal received", 224 /*60 */ "Nonconforming object sizes", 225 "Argument aliasing not permitted", 226 "Invalid argument", 227 /*63 */ "Argument out of range", 228 "Corrupt argument: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#Corrupt", 229 "Unable to open file", 230 "Read from file failed", 231 "Write to file failed", 232 "Invalid pointer", 233 /*69 */ "Arguments must have same type", 234 "", 235 /*71 */ "Detected zero pivot in LU factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot", 236 /*72 */ "Floating point exception", 237 /*73 */ "Object is in wrong state", 238 "Corrupted Petsc object", 239 "Arguments are incompatible", 240 "Error in external library", 241 /*77 */ "Petsc has generated inconsistent data", 242 "Memory corruption", 243 "Unexpected data in file", 244 /*80 */ "Arguments must have same communicators", 245 /*81 */ "Detected zero pivot in Cholesky factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot", 246 " ", 247 " ", 248 " ", 249 /*85 */ "Null argument, when expecting valid pointer", 250 /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type\n seehttp://www.mcs.anl.gov/petsc/petsc-as/documentation/installation.html#external", 251 /*87 */ "Not used", 252 /*88 */ "Error in system call", 253 /*89 */ "Object Type not set: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#typenotset"}; 254 255 #undef __FUNCT__ 256 #define __FUNCT__ "PetscErrorMessage" 257 /*@C 258 PetscErrorMessage - returns the text string associated with a PETSc error code. 259 260 Not Collective 261 262 Input Parameter: 263 . errnum - the error code 264 265 Output Parameter: 266 + text - the error message (PETSC_NULL if not desired) 267 - specific - the specific error message that was set with SETERRxxx() or PetscError(). (PETSC_NULL if not desired) 268 269 Level: developer 270 271 Concepts: error handler^messages 272 273 .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 274 PetscAbortErrorHandler(), PetscTraceBackErrorHandler() 275 @*/ 276 PetscErrorCode PETSC_DLLEXPORT PetscErrorMessage(int errnum,const char *text[],char **specific) 277 { 278 PetscFunctionBegin; 279 if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) { 280 *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1]; 281 } else if (text) *text = 0; 282 283 if (specific) { 284 *specific = PetscErrorBaseMessage; 285 } 286 PetscFunctionReturn(0); 287 } 288 289 #if defined(PETSC_USE_ERRORCHECKING) 290 PetscErrorCode PETSC_DLLEXPORT PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0}; 291 PetscInt PETSC_DLLEXPORT PetscErrorUncatchableCount = 0; 292 PetscErrorCode PETSC_DLLEXPORT PetscExceptions[PETSC_EXCEPTIONS_MAX] = {0}; 293 PetscInt PETSC_DLLEXPORT PetscExceptionsCount = 0; 294 PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp = 0; 295 PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp1 = 0; 296 297 #undef __FUNCT__ 298 #define __FUNCT__ "PetscErrorIsCatchable" 299 /*@C 300 PetscErrorIsCatchable - Returns if a PetscErrorCode can be caught with a PetscExceptionTry1() or 301 PetscExceptionPush() 302 303 Input Parameters: 304 . err - error code 305 306 Level: advanced 307 308 Notes: 309 PETSc must not be configured using the option --with-errorchecking=0 for this to work 310 311 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorSetCatchable() 312 @*/ 313 PetscTruth PETSC_DLLEXPORT PetscErrorIsCatchable(PetscErrorCode err) 314 { 315 PetscInt i; 316 for (i=0; i<PetscErrorUncatchableCount; i++) { 317 if (err == PetscErrorUncatchable[i]) return PETSC_FALSE; 318 } 319 return PETSC_TRUE; 320 } 321 322 #undef __FUNCT__ 323 #define __FUNCT__ "PetscErrorSetCatchable" 324 /*@ 325 PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1() 326 PetscExceptionCaught() pair, or PetscExceptionPush(). By default all errors are catchable. 327 328 Input Parameters: 329 + err - error code 330 - flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught 331 332 Level: advanced 333 334 Notes: 335 PETSc must not be configured using the option --with-errorchecking=0 for this to work 336 337 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop(), PetscErrorIsCatchable() 338 @*/ 339 PetscErrorCode PETSC_DLLEXPORT PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg) 340 { 341 PetscFunctionBegin; 342 if (!flg && PetscErrorIsCatchable(err)) { 343 /* add to list of uncatchable */ 344 if (PetscErrorUncatchableCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscErrorUncatchable is overflowed, recompile \nsrc/sysd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX"); 345 PetscErrorUncatchable[PetscErrorUncatchableCount++] = err; 346 } else if (flg && !PetscErrorIsCatchable(err)) { 347 /* remove from list of uncatchable */ 348 PetscInt i; 349 for (i=0; i<PetscErrorUncatchableCount; i++) { 350 if (PetscErrorUncatchable[i] == err) break; 351 } 352 for (;i<PetscErrorUncatchableCount; i++) { 353 PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1]; 354 } 355 PetscErrorUncatchableCount--; 356 } 357 PetscFunctionReturn(0); 358 } 359 360 #undef __FUNCT__ 361 #define __FUNCT__ "PetscExceptionPush" 362 /*@ 363 PetscExceptionPush - Adds the exception as one to be caught and passed up. If passed up 364 can be checked with PetscExceptionCaught() or PetscExceptionValue() 365 366 Input Parameters: 367 . err - the exception to catch 368 369 Level: advanced 370 371 Notes: 372 PETSc must not be configured using the option --with-errorchecking=0 for this to work 373 374 Use PetscExceptionPop() to remove this as a value to be caught 375 376 This is not usually needed in C/C++ rather use PetscExceptionTry1() 377 378 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop() 379 @*/ 380 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPush(PetscErrorCode err) 381 { 382 PetscFunctionBegin; 383 if (PetscExceptionsCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is overflowed, recompile \nsrc/sysd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX"); 384 if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err; 385 PetscFunctionReturn(0); 386 } 387 388 #undef __FUNCT__ 389 #define __FUNCT__ "PetscExceptionPop" 390 /*@ 391 PetscExceptionPop - Removes the most recent exception asked to be caught with PetscExceptionPush() 392 393 Input Parameters: 394 . err - the exception that was pushed 395 396 Level: advanced 397 398 Notes: 399 PETSc must not be configured using the option --with-errorchecking=0 for this to work 400 401 This is not usually needed in C/C++ rather use PetscExceptionTry1() 402 403 .seealso: PetscExceptionTry1(), PetscExceptionCaught(), PetscExceptionPush(), PetscExceptionPop() 404 @*/ 405 PetscErrorCode PETSC_DLLEXPORT PetscExceptionPop(PetscErrorCode err) 406 { 407 PetscFunctionBegin; 408 if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty"); 409 if (PetscErrorIsCatchable(err)) PetscExceptionsCount--; 410 PetscFunctionReturn(0); 411 } 412 #endif 413 414 #undef __FUNCT__ 415 #define __FUNCT__ "PetscError" 416 /*@C 417 PetscError - Routine that is called when an error has been detected, 418 usually called through the macro SETERRQ(). 419 420 Not Collective 421 422 Input Parameters: 423 + line - the line number of the error (indicated by __LINE__) 424 . func - the function where the error occured (indicated by __FUNCT__) 425 . dir - the directory of file (indicated by __SDIR__) 426 . file - the file in which the error was detected (indicated by __FILE__) 427 . mess - an error text string, usually just printed to the screen 428 . n - the generic error number 429 . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a 430 previously detected error 431 - mess - formatted message string - aka printf 432 433 Level: intermediate 434 435 Notes: 436 Most users need not directly use this routine and the error handlers, but 437 can instead use the simplified interface SETERRQ, which has the calling 438 sequence 439 $ SETERRQ(n,mess) 440 441 Experienced users can set the error handler with PetscPushErrorHandler(). 442 443 Concepts: error^setting condition 444 445 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2() 446 @*/ 447 PetscErrorCode PETSC_DLLEXPORT PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...) 448 { 449 va_list Argp; 450 int fullLength; 451 PetscErrorCode ierr; 452 char buf[2048],*lbuf = 0; 453 PetscTruth ismain,isunknown; 454 #if defined(PETSC_USE_ERRORCHECKING) 455 PetscInt i; 456 #endif 457 458 if (!func) func = "User provided function"; 459 if (!file) file = "User file"; 460 if (!dir) dir = " "; 461 462 PetscFunctionBegin; 463 /* Compose the message evaluating the print format */ 464 if (mess) { 465 va_start(Argp,mess); 466 PetscVSNPrintf(buf,2048,mess,&fullLength,Argp); 467 va_end(Argp); 468 lbuf = buf; 469 if (p == 1) { 470 PetscStrncpy(PetscErrorBaseMessage,lbuf,1023); 471 } 472 } 473 474 #if defined(PETSC_USE_ERRORCHECKING) 475 /* check if user is catching this exception */ 476 for (i=0; i<PetscExceptionsCount; i++) { 477 if (n == PetscExceptions[i]) PetscFunctionReturn(n); 478 } 479 #endif 480 481 if (!eh) ierr = PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0); 482 else ierr = (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx); 483 484 /* 485 If this is called from the main() routine we call MPI_Abort() instead of 486 return to allow the parallel program to be properly shutdown. 487 488 Since this is in the error handler we don't check the errors below. Of course, 489 PetscStrncmp() does its own error checking which is problamatic 490 */ 491 PetscStrncmp(func,"main",4,&ismain); 492 PetscStrncmp(func,"unknown",7,&isunknown); 493 if (ismain || isunknown) { 494 MPI_Abort(PETSC_COMM_WORLD,(int)ierr); 495 } 496 PetscFunctionReturn(ierr); 497 } 498 499 #ifdef PETSC_CLANGUAGE_CXX 500 #undef __FUNCT__ 501 #define __FUNCT__ "PetscErrorCxx" 502 /*@C 503 PetscErrorCxx - Routine that is called when an error has been detected, 504 usually called through the macro SETERROR(). 505 506 Not Collective 507 508 Input Parameters: 509 + line - the line number of the error (indicated by __LINE__) 510 . func - the function where the error occured (indicated by __FUNCT__) 511 . dir - the directory of file (indicated by __SDIR__) 512 . file - the file in which the error was detected (indicated by __FILE__) 513 . n - the generic error number 514 . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a 515 previously detected error 516 517 Level: intermediate 518 519 Notes: 520 Most users need not directly use this routine and the error handlers, but 521 can instead use the simplified interface SETERRQ, which has the calling 522 sequence 523 $ SETERRQ(n,mess) 524 525 Experienced users can set the error handler with PetscPushErrorHandler(). 526 527 Concepts: error^setting condition 528 529 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2() 530 @*/ 531 void PETSC_DLLEXPORT PetscErrorCxx(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p) 532 { 533 PetscTruth ismain, isunknown; 534 #if 0 535 #if defined(PETSC_USE_ERRORCHECKING) 536 PetscInt i; 537 #endif 538 #endif 539 540 if (!func) func = "User provided function"; 541 if (!file) file = "User file"; 542 if (!dir) dir = " "; 543 544 #if 0 545 #if defined(PETSC_USE_ERRORCHECKING) 546 /* check if user is catching this exception */ 547 for (i=0; i<PetscExceptionsCount; i++) { 548 if (n == PetscExceptions[i]) PetscFunctionReturn(n); 549 } 550 #endif 551 #endif 552 553 std::ostringstream msg; 554 555 PetscTraceBackErrorHandlerCxx(line, func, file, dir, n, p, msg); 556 557 /* 558 If this is called from the main() routine we call MPI_Abort() instead of 559 return to allow the parallel program to be properly shutdown. 560 561 Since this is in the error handler we don't check the errors below. Of course, 562 PetscStrncmp() does its own error checking which is problamatic 563 */ 564 PetscStrncmp(func,"main",4,&ismain); 565 PetscStrncmp(func,"unknown",7,&isunknown); 566 if (ismain || isunknown) { 567 MPI_Abort(PETSC_COMM_WORLD, (int) n); 568 } 569 throw PETSc::Exception(msg.str().c_str()); 570 } 571 #endif 572 573 /* -------------------------------------------------------------------------*/ 574 575 #undef __FUNCT__ 576 #define __FUNCT__ "PetscIntView" 577 /*@C 578 PetscIntView - Prints an array of integers; useful for debugging. 579 580 Collective on PetscViewer 581 582 Input Parameters: 583 + N - number of integers in array 584 . idx - array of integers 585 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 586 587 Level: intermediate 588 589 .seealso: PetscRealView() 590 @*/ 591 PetscErrorCode PETSC_DLLEXPORT PetscIntView(PetscInt N,PetscInt idx[],PetscViewer viewer) 592 { 593 PetscErrorCode ierr; 594 PetscInt j,i,n = N/20,p = N % 20; 595 PetscTruth iascii,isbinary; 596 MPI_Comm comm; 597 598 PetscFunctionBegin; 599 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 600 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3); 601 PetscValidIntPointer(idx,2); 602 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 603 604 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr); 605 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr); 606 if (iascii) { 607 for (i=0; i<n; i++) { 608 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr); 609 for (j=0; j<20; j++) { 610 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr); 611 } 612 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 613 } 614 if (p) { 615 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr); 616 for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);} 617 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 618 } 619 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 620 } else if (isbinary) { 621 PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N); 622 PetscInt *array; 623 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 624 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 625 626 if (size > 1) { 627 if (rank) { 628 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 629 ierr = MPI_Gatherv(idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr); 630 } else { 631 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 632 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 633 Ntotal = sizes[0]; 634 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 635 displs[0] = 0; 636 for (i=1; i<size; i++) { 637 Ntotal += sizes[i]; 638 displs[i] = displs[i-1] + sizes[i-1]; 639 } 640 ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr); 641 ierr = MPI_Gatherv(idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr); 642 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); 643 ierr = PetscFree(sizes);CHKERRQ(ierr); 644 ierr = PetscFree(displs);CHKERRQ(ierr); 645 ierr = PetscFree(array);CHKERRQ(ierr); 646 } 647 } else { 648 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); 649 } 650 } else { 651 const char *tname; 652 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 653 SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 654 } 655 PetscFunctionReturn(0); 656 } 657 658 #undef __FUNCT__ 659 #define __FUNCT__ "PetscRealView" 660 /*@C 661 PetscRealView - Prints an array of doubles; useful for debugging. 662 663 Collective on PetscViewer 664 665 Input Parameters: 666 + N - number of doubles in array 667 . idx - array of doubles 668 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 669 670 Level: intermediate 671 672 .seealso: PetscIntView() 673 @*/ 674 PetscErrorCode PETSC_DLLEXPORT PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer) 675 { 676 PetscErrorCode ierr; 677 PetscInt j,i,n = N/5,p = N % 5; 678 PetscTruth iascii,isbinary; 679 MPI_Comm comm; 680 681 PetscFunctionBegin; 682 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 683 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3); 684 PetscValidScalarPointer(idx,2); 685 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 686 687 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr); 688 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr); 689 if (iascii) { 690 for (i=0; i<n; i++) { 691 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr); 692 for (j=0; j<5; j++) { 693 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr); 694 } 695 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 696 } 697 if (p) { 698 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr); 699 for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);} 700 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 701 } 702 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 703 } else if (isbinary) { 704 PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N); 705 PetscReal *array; 706 707 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 708 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 709 710 if (size > 1) { 711 if (rank) { 712 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 713 ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 714 } else { 715 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 716 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 717 Ntotal = sizes[0]; 718 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 719 displs[0] = 0; 720 for (i=1; i<size; i++) { 721 Ntotal += sizes[i]; 722 displs[i] = displs[i-1] + sizes[i-1]; 723 } 724 ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr); 725 ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 726 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr); 727 ierr = PetscFree(sizes);CHKERRQ(ierr); 728 ierr = PetscFree(displs);CHKERRQ(ierr); 729 ierr = PetscFree(array);CHKERRQ(ierr); 730 } 731 } else { 732 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr); 733 } 734 } else { 735 const char *tname; 736 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 737 SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 738 } 739 PetscFunctionReturn(0); 740 } 741 742 #undef __FUNCT__ 743 #define __FUNCT__ "PetscScalarView" 744 /*@C 745 PetscScalarView - Prints an array of scalars; useful for debugging. 746 747 Collective on PetscViewer 748 749 Input Parameters: 750 + N - number of scalars in array 751 . idx - array of scalars 752 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 753 754 Level: intermediate 755 756 .seealso: PetscIntView(), PetscRealView() 757 @*/ 758 PetscErrorCode PETSC_DLLEXPORT PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer) 759 { 760 PetscErrorCode ierr; 761 PetscInt j,i,n = N/3,p = N % 3; 762 PetscTruth iascii,isbinary; 763 MPI_Comm comm; 764 765 PetscFunctionBegin; 766 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 767 PetscValidHeader(viewer,3); 768 PetscValidScalarPointer(idx,2); 769 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 770 771 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr); 772 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr); 773 if (iascii) { 774 for (i=0; i<n; i++) { 775 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr); 776 for (j=0; j<3; j++) { 777 #if defined (PETSC_USE_COMPLEX) 778 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 779 PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr); 780 #else 781 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr); 782 #endif 783 } 784 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 785 } 786 if (p) { 787 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr); 788 for (i=0; i<p; i++) { 789 #if defined (PETSC_USE_COMPLEX) 790 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 791 PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr); 792 #else 793 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr); 794 #endif 795 } 796 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 797 } 798 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 799 } else if (isbinary) { 800 PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N); 801 PetscScalar *array; 802 803 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 804 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 805 806 if (size > 1) { 807 if (rank) { 808 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 809 ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 810 } else { 811 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 812 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 813 Ntotal = sizes[0]; 814 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 815 displs[0] = 0; 816 for (i=1; i<size; i++) { 817 Ntotal += sizes[i]; 818 displs[i] = displs[i-1] + sizes[i-1]; 819 } 820 ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr); 821 ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 822 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr); 823 ierr = PetscFree(sizes);CHKERRQ(ierr); 824 ierr = PetscFree(displs);CHKERRQ(ierr); 825 ierr = PetscFree(array);CHKERRQ(ierr); 826 } 827 } else { 828 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr); 829 } 830 } else { 831 const char *tname; 832 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 833 SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 834 } 835 PetscFunctionReturn(0); 836 } 837 838 839 840 841