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