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", 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 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,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 #ifdef PETSC_CLANGUAGE_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 .seealso: PetscRealView() 589 @*/ 590 PetscErrorCode PETSC_DLLEXPORT PetscIntView(PetscInt N,PetscInt idx[],PetscViewer viewer) 591 { 592 PetscErrorCode ierr; 593 PetscInt j,i,n = N/20,p = N % 20; 594 PetscTruth iascii,isbinary; 595 MPI_Comm comm; 596 597 PetscFunctionBegin; 598 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 599 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3); 600 PetscValidIntPointer(idx,2); 601 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 602 603 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr); 604 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr); 605 if (iascii) { 606 for (i=0; i<n; i++) { 607 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr); 608 for (j=0; j<20; j++) { 609 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr); 610 } 611 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 612 } 613 if (p) { 614 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr); 615 for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);} 616 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 617 } 618 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 619 } else if (isbinary) { 620 PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = PetscMPIIntCast(N); 621 PetscInt *array; 622 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 623 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 624 625 if (size > 1) { 626 if (rank) { 627 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 628 ierr = MPI_Gatherv(idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);CHKERRQ(ierr); 629 } else { 630 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 631 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 632 Ntotal = sizes[0]; 633 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 634 displs[0] = 0; 635 for (i=1; i<size; i++) { 636 Ntotal += sizes[i]; 637 displs[i] = displs[i-1] + sizes[i-1]; 638 } 639 ierr = PetscMalloc(Ntotal*sizeof(PetscInt),&array);CHKERRQ(ierr); 640 ierr = MPI_Gatherv(idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr); 641 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); 642 ierr = PetscFree(sizes);CHKERRQ(ierr); 643 ierr = PetscFree(displs);CHKERRQ(ierr); 644 ierr = PetscFree(array);CHKERRQ(ierr); 645 } 646 } else { 647 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); 648 } 649 } else { 650 const char *tname; 651 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 652 SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 653 } 654 PetscFunctionReturn(0); 655 } 656 657 #undef __FUNCT__ 658 #define __FUNCT__ "PetscRealView" 659 /*@C 660 PetscRealView - Prints an array of doubles; useful for debugging. 661 662 Collective on PetscViewer 663 664 Input Parameters: 665 + N - number of doubles in array 666 . idx - array of doubles 667 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 668 669 Level: intermediate 670 671 .seealso: PetscIntView() 672 @*/ 673 PetscErrorCode PETSC_DLLEXPORT PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer) 674 { 675 PetscErrorCode ierr; 676 PetscInt j,i,n = N/5,p = N % 5; 677 PetscTruth iascii,isbinary; 678 MPI_Comm comm; 679 680 PetscFunctionBegin; 681 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 682 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,3); 683 PetscValidScalarPointer(idx,2); 684 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 685 686 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr); 687 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr); 688 if (iascii) { 689 for (i=0; i<n; i++) { 690 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);CHKERRQ(ierr); 691 for (j=0; j<5; j++) { 692 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);CHKERRQ(ierr); 693 } 694 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 695 } 696 if (p) { 697 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);CHKERRQ(ierr); 698 for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);CHKERRQ(ierr);} 699 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 700 } 701 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 702 } else if (isbinary) { 703 PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = PetscMPIIntCast(N); 704 PetscReal *array; 705 706 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 707 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 708 709 if (size > 1) { 710 if (rank) { 711 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 712 ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 713 } else { 714 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 715 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 716 Ntotal = sizes[0]; 717 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 718 displs[0] = 0; 719 for (i=1; i<size; i++) { 720 Ntotal += sizes[i]; 721 displs[i] = displs[i-1] + sizes[i-1]; 722 } 723 ierr = PetscMalloc(Ntotal*sizeof(PetscReal),&array);CHKERRQ(ierr); 724 ierr = MPI_Gatherv(idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);CHKERRQ(ierr); 725 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);CHKERRQ(ierr); 726 ierr = PetscFree(sizes);CHKERRQ(ierr); 727 ierr = PetscFree(displs);CHKERRQ(ierr); 728 ierr = PetscFree(array);CHKERRQ(ierr); 729 } 730 } else { 731 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_REAL,PETSC_FALSE);CHKERRQ(ierr); 732 } 733 } else { 734 const char *tname; 735 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 736 SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 737 } 738 PetscFunctionReturn(0); 739 } 740 741 #undef __FUNCT__ 742 #define __FUNCT__ "PetscScalarView" 743 /*@C 744 PetscScalarView - Prints an array of scalars; useful for debugging. 745 746 Collective on PetscViewer 747 748 Input Parameters: 749 + N - number of scalars in array 750 . idx - array of scalars 751 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 752 753 Level: intermediate 754 755 .seealso: PetscIntView(), PetscRealView() 756 @*/ 757 PetscErrorCode PETSC_DLLEXPORT PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer) 758 { 759 PetscErrorCode ierr; 760 PetscInt j,i,n = N/3,p = N % 3; 761 PetscTruth iascii,isbinary; 762 MPI_Comm comm; 763 764 PetscFunctionBegin; 765 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 766 PetscValidHeader(viewer,3); 767 PetscValidScalarPointer(idx,2); 768 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 769 770 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);CHKERRQ(ierr); 771 ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);CHKERRQ(ierr); 772 if (iascii) { 773 for (i=0; i<n; i++) { 774 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr); 775 for (j=0; j<3; j++) { 776 #if defined (PETSC_USE_COMPLEX) 777 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 778 PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr); 779 #else 780 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);CHKERRQ(ierr); 781 #endif 782 } 783 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 784 } 785 if (p) { 786 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr); 787 for (i=0; i<p; i++) { 788 #if defined (PETSC_USE_COMPLEX) 789 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", 790 PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr); 791 #else 792 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);CHKERRQ(ierr); 793 #endif 794 } 795 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 796 } 797 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 798 } else if (isbinary) { 799 PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = PetscMPIIntCast(N); 800 PetscScalar *array; 801 802 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 803 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 804 805 if (size > 1) { 806 if (rank) { 807 ierr = MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);CHKERRQ(ierr); 808 ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 809 } else { 810 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&sizes);CHKERRQ(ierr); 811 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 812 Ntotal = sizes[0]; 813 ierr = PetscMalloc(size*sizeof(PetscMPIInt),&displs);CHKERRQ(ierr); 814 displs[0] = 0; 815 for (i=1; i<size; i++) { 816 Ntotal += sizes[i]; 817 displs[i] = displs[i-1] + sizes[i-1]; 818 } 819 ierr = PetscMalloc(Ntotal*sizeof(PetscScalar),&array);CHKERRQ(ierr); 820 ierr = MPI_Gatherv(idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 821 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);CHKERRQ(ierr); 822 ierr = PetscFree(sizes);CHKERRQ(ierr); 823 ierr = PetscFree(displs);CHKERRQ(ierr); 824 ierr = PetscFree(array);CHKERRQ(ierr); 825 } 826 } else { 827 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr); 828 } 829 } else { 830 const char *tname; 831 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 832 SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 833 } 834 PetscFunctionReturn(0); 835 } 836 837 838 839 840