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