1 2 /* 3 Code that allows one to set the error handlers 4 */ 5 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/ 6 #include <petscviewer.h> 7 8 /* A table of Petsc source files containing calls to PETSCABORT. We assume this table will 9 stay stable for a while. When things changed, we just need to add new files to the table. 10 */ 11 static const char* PetscAbortSourceFiles[] = { 12 "Souce code of main", /* 0 */ 13 "Not Found", /* 1, not found in petsc, but may be in users' code if they called PETSCABORT. */ 14 "sys/error/adebug.c", 15 "src/sys/error/errstop.c", 16 "sys/error/fp.c", 17 "sys/error/signal.c", /* 5 */ 18 "sys/ftn-custom/zutils.c", 19 "sys/logging/utils/stagelog.c", 20 "sys/mpiuni/mpitime.c", 21 "sys/objects/init.c", 22 "sys/objects/pinit.c", /* 10 */ 23 "vec/vec/interface/dlregisvec.c", 24 "vec/vec/utils/comb.c" 25 }; 26 27 /* Find index of the soure file where a PETSCABORT was called. */ 28 PetscErrorCode PetscAbortFindSourceFile_Private(const char* filepath, PetscInt *idx) 29 { 30 PetscErrorCode ierr; 31 PetscInt i,n = PETSC_STATIC_ARRAY_LENGTH(PetscAbortSourceFiles); 32 PetscBool match; 33 char subpath[PETSC_MAX_PATH_LEN]; 34 35 ierr = PetscStackView(stderr);if (ierr) return ierr; 36 *idx = 1; 37 for (i=2; i<n; i++) { 38 ierr = PetscFixFilename(PetscAbortSourceFiles[i],subpath);if (ierr) return ierr; 39 ierr = PetscStrendswith(filepath,subpath,&match);if (ierr) return ierr; 40 if (match) {*idx = i; break;} 41 } 42 return 0; 43 } 44 45 typedef struct _EH *EH; 46 struct _EH { 47 PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*); 48 void *ctx; 49 EH previous; 50 }; 51 52 static EH eh = NULL; 53 54 /*@C 55 PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to 56 load the file where the error occurred. Then calls the "previous" error handler. 57 58 Not Collective 59 60 Input Parameters: 61 + comm - communicator over which error occurred 62 . line - the line number of the error (indicated by __LINE__) 63 . file - the file in which the error was detected (indicated by __FILE__) 64 . mess - an error text string, usually just printed to the screen 65 . n - the generic error number 66 . p - specific error number 67 - ctx - error handler context 68 69 Options Database Key: 70 . -on_error_emacs <machinename> - will contact machinename to open the Emacs client there 71 72 Level: developer 73 74 Notes: 75 You must put (server-start) in your .emacs file for the emacsclient software to work 76 77 Developer Note: 78 Since this is an error handler it cannot call PetscCall(); thus we just return if an error is detected. 79 80 .seealso: `PetscError()`, `PetscPushErrorHandler()`, `PetscPopErrorHandler()`, `PetscAttachDebuggerErrorHandler()`, 81 `PetscAbortErrorHandler()`, `PetscMPIAbortErrorHandler()`, `PetscTraceBackErrorHandler()`, `PetscReturnErrorHandler()` 82 @*/ 83 PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx) 84 { 85 PetscErrorCode ierr; 86 char command[PETSC_MAX_PATH_LEN]; 87 const char *pdir; 88 FILE *fp; 89 90 PetscFunctionBegin; 91 ierr = PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr); 92 sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file); 93 #if defined(PETSC_HAVE_POPEN) 94 ierr = PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr); 95 ierr = PetscPClose(MPI_COMM_WORLD,fp);if (ierr) PetscFunctionReturn(ierr); 96 #else 97 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine"); 98 #endif 99 ierr = PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */ 100 if (!eh) { 101 ierr = PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,NULL);if (ierr) PetscFunctionReturn(ierr); 102 } else { 103 ierr = (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr); 104 } 105 PetscFunctionReturn(ierr); 106 } 107 108 /*@C 109 PetscPushErrorHandler - Sets a routine to be called on detection of errors. 110 111 Not Collective 112 113 Input Parameters: 114 + handler - error handler routine 115 - ctx - optional handler context that contains information needed by the handler (for 116 example file pointers for error messages etc.) 117 118 Calling sequence of handler: 119 $ int handler(MPI_Comm comm,int line,char *func,char *file,PetscErrorCode n,int p,char *mess,void *ctx); 120 121 + comm - communicator over which error occurred 122 . line - the line number of the error (indicated by __LINE__) 123 . file - the file in which the error was detected (indicated by __FILE__) 124 . n - the generic error number (see list defined in include/petscerror.h) 125 . p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT 126 . mess - an error text string, usually just printed to the screen 127 - ctx - the error handler context 128 129 Options Database Keys: 130 + -on_error_attach_debugger <noxterm,gdb or dbx> - starts up the debugger if an error occurs 131 - -on_error_abort - aborts the program if an error occurs 132 133 Level: intermediate 134 135 Notes: 136 The currently available PETSc error handlers include PetscTraceBackErrorHandler(), 137 PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler(). 138 139 Fortran Notes: 140 You can only push one error handler from Fortran before poping it. 141 142 .seealso: `PetscPopErrorHandler()`, `PetscAttachDebuggerErrorHandler()`, `PetscAbortErrorHandler()`, `PetscTraceBackErrorHandler()`, `PetscPushSignalHandler()` 143 144 @*/ 145 PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx) 146 { 147 EH neweh; 148 149 PetscFunctionBegin; 150 PetscCall(PetscNew(&neweh)); 151 if (eh) neweh->previous = eh; 152 else neweh->previous = NULL; 153 neweh->handler = handler; 154 neweh->ctx = ctx; 155 eh = neweh; 156 PetscFunctionReturn(0); 157 } 158 159 /*@ 160 PetscPopErrorHandler - Removes the latest error handler that was 161 pushed with PetscPushErrorHandler(). 162 163 Not Collective 164 165 Level: intermediate 166 167 .seealso: `PetscPushErrorHandler()` 168 @*/ 169 PetscErrorCode PetscPopErrorHandler(void) 170 { 171 EH tmp; 172 173 PetscFunctionBegin; 174 if (!eh) PetscFunctionReturn(0); 175 tmp = eh; 176 eh = eh->previous; 177 PetscCall(PetscFree(tmp)); 178 PetscFunctionReturn(0); 179 } 180 181 /*@C 182 PetscReturnErrorHandler - Error handler that causes a return without printing an error message. 183 184 Not Collective 185 186 Input Parameters: 187 + comm - communicator over which error occurred 188 . line - the line number of the error (indicated by __LINE__) 189 . file - the file in which the error was detected (indicated by __FILE__) 190 . mess - an error text string, usually just printed to the screen 191 . n - the generic error number 192 . p - specific error number 193 - ctx - error handler context 194 195 Level: developer 196 197 Notes: 198 Most users need not directly employ this routine and the other error 199 handlers, but can instead use the simplified interface SETERRQ, which has 200 the calling sequence 201 $ SETERRQ(comm,number,mess) 202 203 PetscIgnoreErrorHandler() does the same thing as this function, but is deprecated, you should use this function. 204 205 Use PetscPushErrorHandler() to set the desired error handler. 206 207 .seealso: `PetscPushErrorHandler()`, `PetscPopErrorHandler()`, `PetscError()`, `PetscAbortErrorHandler()`, `PetscMPIAbortErrorHandler()`, `PetscTraceBackErrorHandler()`, 208 `PetscAttachDebuggerErrorHandler()`, `PetscEmacsClientErrorHandler()` 209 @*/ 210 PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx) 211 { 212 return n; 213 } 214 215 static char PetscErrorBaseMessage[1024]; 216 /* 217 The numerical values for these are defined in include/petscerror.h; any changes 218 there must also be made here 219 */ 220 static const char *PetscErrorStrings[] = { 221 /*55 */ "Out of memory", 222 "No support for this operation for this object type", 223 "No support for this operation on this system", 224 /*58 */ "Operation done in wrong order", 225 /*59 */ "Signal received", 226 /*60 */ "Nonconforming object sizes", 227 "Argument aliasing not permitted", 228 "Invalid argument", 229 /*63 */ "Argument out of range", 230 "Corrupt argument: https://petsc.org/release/faq/#valgrind", 231 "Unable to open file", 232 "Read from file failed", 233 "Write to file failed", 234 "Invalid pointer", 235 /*69 */ "Arguments must have same type", 236 /*70 */ "Attempt to use a pointer that does not point to a valid accessible location", 237 /*71 */ "Zero pivot in LU factorization: https://petsc.org/release/faq/#zeropivot", 238 /*72 */ "Floating point exception", 239 /*73 */ "Object is in wrong state", 240 "Corrupted Petsc object", 241 "Arguments are incompatible", 242 "Error in external library", 243 /*77 */ "Petsc has generated inconsistent data", 244 "Memory corruption: https://petsc.org/release/faq/#valgrind", 245 "Unexpected data in file", 246 /*80 */ "Arguments must have same communicators", 247 /*81 */ "Zero pivot in Cholesky factorization: https://petsc.org/release/faq/#zeropivot", 248 "", 249 "", 250 "Overflow in integer operation: https://petsc.org/release/faq/#64-bit-indices", 251 /*85 */ "Null argument, when expecting valid pointer", 252 /*86 */ "Unknown type. Check for miss-spelling or missing package: https://petsc.org/release/install/install/#external-packages", 253 /*87 */ "MPI library at runtime is not compatible with MPI used at compile time", 254 /*88 */ "Error in system call", 255 /*89 */ "Object Type not set: https://petsc.org/release/faq/#object-type-not-set", 256 /*90 */ "", 257 /* */ "", 258 /*92 */ "See https://petsc.org/release/overview/linear_solve_table/ for possible LU and Cholesky solvers", 259 /*93 */ "You cannot overwrite this option since that will conflict with other previously set options", 260 /*94 */ "Example/application run with number of MPI ranks it does not support", 261 /*95 */ "Missing or incorrect user input", 262 /*96 */ "GPU resources unavailable", 263 /*97 */ "GPU error", 264 /*98 */ "General MPI error" 265 }; 266 267 /*@C 268 PetscErrorMessage - returns the text string associated with a PETSc error code. 269 270 Not Collective 271 272 Input Parameter: 273 . errnum - the error code 274 275 Output Parameters: 276 + text - the error message (NULL if not desired) 277 - specific - the specific error message that was set with SETERRxxx() or PetscError(). (NULL if not desired) 278 279 Level: developer 280 281 .seealso: `PetscPushErrorHandler()`, `PetscAttachDebuggerErrorHandler()`, `PetscError()`, `SETERRQ()`, `PetscCall()` 282 `PetscAbortErrorHandler()`, `PetscTraceBackErrorHandler()` 283 @*/ 284 PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific) 285 { 286 size_t len; 287 288 PetscFunctionBegin; 289 if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) { 290 *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1]; 291 PetscCall(PetscStrlen(*text,&len)); 292 if (!len) *text = NULL; 293 } 294 else if (text) *text = NULL; 295 296 if (specific) *specific = PetscErrorBaseMessage; 297 PetscFunctionReturn(0); 298 } 299 300 #if defined(PETSC_CLANGUAGE_CXX) 301 /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software 302 * would be broken if implementations did not handle it it some common cases. However, keep in mind 303 * 304 * Rule 62. Don't allow exceptions to propagate across module boundaries 305 * 306 * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface 307 * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed. 308 * 309 * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message 310 * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that 311 * seems crazy to me. 312 */ 313 #include <sstream> 314 #include <stdexcept> 315 static void PetscCxxErrorThrow() 316 { 317 const char *str; 318 if (eh && eh->ctx) { 319 std::ostringstream *msg; 320 msg = (std::ostringstream*) eh->ctx; 321 str = msg->str().c_str(); 322 } else str = "Error detected in C PETSc"; 323 324 throw std::runtime_error(str); 325 } 326 #endif 327 328 /*@C 329 PetscError - Routine that is called when an error has been detected, usually called through the macro SETERRQ(PETSC_COMM_SELF,). 330 331 Collective on comm 332 333 Input Parameters: 334 + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine 335 . line - the line number of the error (indicated by __LINE__) 336 . func - the function name in which the error was detected 337 . file - the file in which the error was detected (indicated by __FILE__) 338 . n - the generic error number 339 . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error 340 - mess - formatted message string - aka printf 341 342 Options Database: 343 + -error_output_stdout - output the error messages to stdout instead of the default stderr 344 - -error_output_none - do not output the error messages 345 346 Level: intermediate 347 348 Notes: 349 PETSc error handling is done with error return codes. A non-zero return indicates an error was detected. Errors are generally not something that the code 350 can recover from. Note that numerical errors (potential divide by zero, for example) are not managed by the error return codes; they are managed via, for example, 351 KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into 352 hard errors managed via PetscError(). 353 354 PETSc provides a rich supply of error handlers, see the list below, and users can also provide their own error handlers. 355 356 Most users need not directly use this routine and the error handlers, but 357 can instead use the simplified interface SETERRQ, which has the calling 358 sequence 359 $ SETERRQ(comm,n,mess) 360 361 Fortran Note: 362 This routine is used differently from Fortran 363 $ PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message) 364 365 Set the error handler with PetscPushErrorHandler(). 366 367 Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes) 368 BUT this routine does call regular PETSc functions that may call error handlers, this is problematic and could be fixed by never calling other PETSc routines 369 but this annoying. 370 371 .seealso: `PetscErrorCode`, `PetscPushErrorHandler()`, `PetscPopErrorHandler()`, `PetscTraceBackErrorHandler()`, `PetscAbortErrorHandler()`, `PetscMPIAbortErrorHandler()`, 372 `PetscReturnErrorHandler()`, `PetscAttachDebuggerErrorHandler()`, `PetscEmacsClientErrorHandler()`, 373 `SETERRQ()`, `PetscCall()`, `CHKMEMQ`, `SETERRQ()`, `SETERRQ()`, `PetscErrorMessage()`, `PETSCABORT()` 374 @*/ 375 PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...) 376 { 377 va_list Argp; 378 size_t fullLength; 379 char buf[2048],*lbuf = NULL; 380 PetscBool ismain; 381 PetscErrorCode ierr; 382 383 if (!PetscErrorHandlingInitialized) return n; 384 if (!file) file = "User file"; 385 if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF; 386 387 /* Compose the message evaluating the print format */ 388 if (mess) { 389 va_start(Argp,mess); 390 PetscVSNPrintf(buf,2048,mess,&fullLength,Argp); 391 va_end(Argp); 392 lbuf = buf; 393 if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023); 394 } 395 396 if (p == PETSC_ERROR_INITIAL && n != PETSC_ERR_MEMC) PetscMallocValidate(__LINE__,PETSC_FUNCTION_NAME,__FILE__); 397 398 if (!eh) ierr = PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,NULL); 399 else ierr = (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx); 400 PetscStackClearTop; 401 402 /* 403 If this is called from the main() routine we call MPI_Abort() instead of 404 return to allow the parallel program to be properly shutdown. 405 406 Does not call PETSCABORT() since that would provide the wrong source file and line number information 407 */ 408 if (func) { 409 PetscStrncmp(func,"main",4,&ismain); 410 if (ismain) { 411 if (petscwaitonerrorflg) PetscSleep(1000); 412 MPI_Abort(MPI_COMM_WORLD,(PetscMPIInt)(0 + 0*line*1000 + ierr)); 413 } 414 } 415 #if defined(PETSC_CLANGUAGE_CXX) 416 if (p == PETSC_ERROR_IN_CXX) { 417 PetscCxxErrorThrow(); 418 } 419 #endif 420 return ierr; 421 } 422 423 /* -------------------------------------------------------------------------*/ 424 425 /*@C 426 PetscIntView - Prints an array of integers; useful for debugging. 427 428 Collective on PetscViewer 429 430 Input Parameters: 431 + N - number of integers in array 432 . idx - array of integers 433 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 434 435 Level: intermediate 436 437 Developer Notes: 438 idx cannot be const because may be passed to binary viewer where byte swapping is done 439 440 .seealso: `PetscRealView()` 441 @*/ 442 PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer) 443 { 444 PetscMPIInt rank,size; 445 PetscInt j,i,n = N/20,p = N % 20; 446 PetscBool iascii,isbinary; 447 MPI_Comm comm; 448 449 PetscFunctionBegin; 450 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 451 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 452 if (N) PetscValidIntPointer(idx,2); 453 PetscCall(PetscObjectGetComm((PetscObject)viewer,&comm)); 454 PetscCallMPI(MPI_Comm_size(comm,&size)); 455 PetscCallMPI(MPI_Comm_rank(comm,&rank)); 456 457 PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii)); 458 PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary)); 459 if (iascii) { 460 PetscCall(PetscViewerASCIIPushSynchronized(viewer)); 461 for (i=0; i<n; i++) { 462 if (size > 1) { 463 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":", rank, 20*i)); 464 } else { 465 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*i)); 466 } 467 for (j=0; j<20; j++) { 468 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[i*20+j])); 469 } 470 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 471 } 472 if (p) { 473 if (size > 1) { 474 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":",rank ,20*n)); 475 } else { 476 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*n)); 477 } 478 for (i=0; i<p; i++) PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[20*n+i])); 479 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 480 } 481 PetscCall(PetscViewerFlush(viewer)); 482 PetscCall(PetscViewerASCIIPopSynchronized(viewer)); 483 } else if (isbinary) { 484 PetscMPIInt *sizes,Ntotal,*displs,NN; 485 PetscInt *array; 486 487 PetscCall(PetscMPIIntCast(N,&NN)); 488 489 if (size > 1) { 490 if (rank) { 491 PetscCallMPI(MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm)); 492 PetscCallMPI(MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm)); 493 } else { 494 PetscCall(PetscMalloc1(size,&sizes)); 495 PetscCallMPI(MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm)); 496 Ntotal = sizes[0]; 497 PetscCall(PetscMalloc1(size,&displs)); 498 displs[0] = 0; 499 for (i=1; i<size; i++) { 500 Ntotal += sizes[i]; 501 displs[i] = displs[i-1] + sizes[i-1]; 502 } 503 PetscCall(PetscMalloc1(Ntotal,&array)); 504 PetscCallMPI(MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm)); 505 PetscCall(PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT)); 506 PetscCall(PetscFree(sizes)); 507 PetscCall(PetscFree(displs)); 508 PetscCall(PetscFree(array)); 509 } 510 } else { 511 PetscCall(PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT)); 512 } 513 } else { 514 const char *tname; 515 PetscCall(PetscObjectGetName((PetscObject)viewer,&tname)); 516 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 517 } 518 PetscFunctionReturn(0); 519 } 520 521 /*@C 522 PetscRealView - Prints an array of doubles; useful for debugging. 523 524 Collective on PetscViewer 525 526 Input Parameters: 527 + N - number of PetscReal in array 528 . idx - array of PetscReal 529 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 530 531 Level: intermediate 532 533 Developer Notes: 534 idx cannot be const because may be passed to binary viewer where byte swapping is done 535 536 .seealso: `PetscIntView()` 537 @*/ 538 PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer) 539 { 540 PetscMPIInt rank,size; 541 PetscInt j,i,n = N/5,p = N % 5; 542 PetscBool iascii,isbinary; 543 MPI_Comm comm; 544 545 PetscFunctionBegin; 546 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 547 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 548 PetscValidRealPointer(idx,2); 549 PetscCall(PetscObjectGetComm((PetscObject)viewer,&comm)); 550 PetscCallMPI(MPI_Comm_size(comm,&size)); 551 PetscCallMPI(MPI_Comm_rank(comm,&rank)); 552 553 PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii)); 554 PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary)); 555 if (iascii) { 556 PetscInt tab; 557 558 PetscCall(PetscViewerASCIIPushSynchronized(viewer)); 559 PetscCall(PetscViewerASCIIGetTab(viewer, &tab)); 560 for (i=0; i<n; i++) { 561 PetscCall(PetscViewerASCIISetTab(viewer, tab)); 562 if (size > 1) { 563 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*i)); 564 } else { 565 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*i)); 566 } 567 PetscCall(PetscViewerASCIISetTab(viewer, 0)); 568 for (j=0; j<5; j++) { 569 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j])); 570 } 571 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 572 } 573 if (p) { 574 PetscCall(PetscViewerASCIISetTab(viewer, tab)); 575 if (size > 1) { 576 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*n)); 577 } else { 578 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*n)); 579 } 580 PetscCall(PetscViewerASCIISetTab(viewer, 0)); 581 for (i=0; i<p; i++) PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i])); 582 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 583 } 584 PetscCall(PetscViewerFlush(viewer)); 585 PetscCall(PetscViewerASCIISetTab(viewer, tab)); 586 PetscCall(PetscViewerASCIIPopSynchronized(viewer)); 587 } else if (isbinary) { 588 PetscMPIInt *sizes,*displs, Ntotal,NN; 589 PetscReal *array; 590 591 PetscCall(PetscMPIIntCast(N,&NN)); 592 593 if (size > 1) { 594 if (rank) { 595 PetscCallMPI(MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm)); 596 PetscCallMPI(MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm)); 597 } else { 598 PetscCall(PetscMalloc1(size,&sizes)); 599 PetscCallMPI(MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm)); 600 Ntotal = sizes[0]; 601 PetscCall(PetscMalloc1(size,&displs)); 602 displs[0] = 0; 603 for (i=1; i<size; i++) { 604 Ntotal += sizes[i]; 605 displs[i] = displs[i-1] + sizes[i-1]; 606 } 607 PetscCall(PetscMalloc1(Ntotal,&array)); 608 PetscCallMPI(MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm)); 609 PetscCall(PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL)); 610 PetscCall(PetscFree(sizes)); 611 PetscCall(PetscFree(displs)); 612 PetscCall(PetscFree(array)); 613 } 614 } else { 615 PetscCall(PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL)); 616 } 617 } else { 618 const char *tname; 619 PetscCall(PetscObjectGetName((PetscObject)viewer,&tname)); 620 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 621 } 622 PetscFunctionReturn(0); 623 } 624 625 /*@C 626 PetscScalarView - Prints an array of scalars; useful for debugging. 627 628 Collective on PetscViewer 629 630 Input Parameters: 631 + N - number of scalars in array 632 . idx - array of scalars 633 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 634 635 Level: intermediate 636 637 Developer Notes: 638 idx cannot be const because may be passed to binary viewer where byte swapping is done 639 640 .seealso: `PetscIntView()`, `PetscRealView()` 641 @*/ 642 PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer) 643 { 644 PetscMPIInt rank,size; 645 PetscInt j,i,n = N/3,p = N % 3; 646 PetscBool iascii,isbinary; 647 MPI_Comm comm; 648 649 PetscFunctionBegin; 650 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 651 PetscValidHeader(viewer,3); 652 if (N) PetscValidScalarPointer(idx,2); 653 PetscCall(PetscObjectGetComm((PetscObject)viewer,&comm)); 654 PetscCallMPI(MPI_Comm_size(comm,&size)); 655 PetscCallMPI(MPI_Comm_rank(comm,&rank)); 656 657 PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii)); 658 PetscCall(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary)); 659 if (iascii) { 660 PetscCall(PetscViewerASCIIPushSynchronized(viewer)); 661 for (i=0; i<n; i++) { 662 if (size > 1) { 663 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*i)); 664 } else { 665 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*i)); 666 } 667 for (j=0; j<3; j++) { 668 #if defined(PETSC_USE_COMPLEX) 669 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]))); 670 #else 671 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j])); 672 #endif 673 } 674 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 675 } 676 if (p) { 677 if (size > 1) { 678 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*n)); 679 } else { 680 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*n)); 681 } 682 for (i=0; i<p; i++) { 683 #if defined(PETSC_USE_COMPLEX) 684 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]))); 685 #else 686 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i])); 687 #endif 688 } 689 PetscCall(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 690 } 691 PetscCall(PetscViewerFlush(viewer)); 692 PetscCall(PetscViewerASCIIPopSynchronized(viewer)); 693 } else if (isbinary) { 694 PetscMPIInt *sizes,Ntotal,*displs,NN; 695 PetscScalar *array; 696 697 PetscCall(PetscMPIIntCast(N,&NN)); 698 699 if (size > 1) { 700 if (rank) { 701 PetscCallMPI(MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm)); 702 PetscCallMPI(MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm)); 703 } else { 704 PetscCall(PetscMalloc1(size,&sizes)); 705 PetscCallMPI(MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm)); 706 Ntotal = sizes[0]; 707 PetscCall(PetscMalloc1(size,&displs)); 708 displs[0] = 0; 709 for (i=1; i<size; i++) { 710 Ntotal += sizes[i]; 711 displs[i] = displs[i-1] + sizes[i-1]; 712 } 713 PetscCall(PetscMalloc1(Ntotal,&array)); 714 PetscCallMPI(MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm)); 715 PetscCall(PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR)); 716 PetscCall(PetscFree(sizes)); 717 PetscCall(PetscFree(displs)); 718 PetscCall(PetscFree(array)); 719 } 720 } else { 721 PetscCall(PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR)); 722 } 723 } else { 724 const char *tname; 725 PetscCall(PetscObjectGetName((PetscObject)viewer,&tname)); 726 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 727 } 728 PetscFunctionReturn(0); 729 } 730 731 #if defined(PETSC_HAVE_CUDA) 732 #include <petscdevice.h> 733 PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status) 734 { 735 switch(status) { 736 #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */ 737 case CUBLAS_STATUS_SUCCESS: return "CUBLAS_STATUS_SUCCESS"; 738 case CUBLAS_STATUS_NOT_INITIALIZED: return "CUBLAS_STATUS_NOT_INITIALIZED"; 739 case CUBLAS_STATUS_ALLOC_FAILED: return "CUBLAS_STATUS_ALLOC_FAILED"; 740 case CUBLAS_STATUS_INVALID_VALUE: return "CUBLAS_STATUS_INVALID_VALUE"; 741 case CUBLAS_STATUS_ARCH_MISMATCH: return "CUBLAS_STATUS_ARCH_MISMATCH"; 742 case CUBLAS_STATUS_MAPPING_ERROR: return "CUBLAS_STATUS_MAPPING_ERROR"; 743 case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED"; 744 case CUBLAS_STATUS_INTERNAL_ERROR: return "CUBLAS_STATUS_INTERNAL_ERROR"; 745 case CUBLAS_STATUS_NOT_SUPPORTED: return "CUBLAS_STATUS_NOT_SUPPORTED"; 746 case CUBLAS_STATUS_LICENSE_ERROR: return "CUBLAS_STATUS_LICENSE_ERROR"; 747 #endif 748 default: return "unknown error"; 749 } 750 } 751 PETSC_EXTERN const char* PetscCUSolverGetErrorName(cusolverStatus_t status) 752 { 753 switch(status) { 754 #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */ 755 case CUSOLVER_STATUS_SUCCESS: return "CUSOLVER_STATUS_SUCCESS"; 756 case CUSOLVER_STATUS_NOT_INITIALIZED: return "CUSOLVER_STATUS_NOT_INITIALIZED"; 757 case CUSOLVER_STATUS_INVALID_VALUE: return "CUSOLVER_STATUS_INVALID_VALUE"; 758 case CUSOLVER_STATUS_ARCH_MISMATCH: return "CUSOLVER_STATUS_ARCH_MISMATCH"; 759 case CUSOLVER_STATUS_INTERNAL_ERROR: return "CUSOLVER_STATUS_INTERNAL_ERROR"; 760 #if (CUDART_VERSION >= 9000) /* CUDA 9.0 had these defined on June 2021 */ 761 case CUSOLVER_STATUS_ALLOC_FAILED: return "CUSOLVER_STATUS_ALLOC_FAILED"; 762 case CUSOLVER_STATUS_MAPPING_ERROR: return "CUSOLVER_STATUS_MAPPING_ERROR"; 763 case CUSOLVER_STATUS_EXECUTION_FAILED: return "CUSOLVER_STATUS_EXECUTION_FAILED"; 764 case CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED: return "CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED"; 765 case CUSOLVER_STATUS_NOT_SUPPORTED : return "CUSOLVER_STATUS_NOT_SUPPORTED "; 766 case CUSOLVER_STATUS_ZERO_PIVOT: return "CUSOLVER_STATUS_ZERO_PIVOT"; 767 case CUSOLVER_STATUS_INVALID_LICENSE: return "CUSOLVER_STATUS_INVALID_LICENSE"; 768 #endif 769 #endif 770 default: return "unknown error"; 771 } 772 } 773 PETSC_EXTERN const char* PetscCUFFTGetErrorName(cufftResult result) 774 { 775 switch (result) { 776 case CUFFT_SUCCESS: return "CUFFT_SUCCESS"; 777 case CUFFT_INVALID_PLAN: return "CUFFT_INVALID_PLAN"; 778 case CUFFT_ALLOC_FAILED: return "CUFFT_ALLOC_FAILED"; 779 case CUFFT_INVALID_TYPE: return "CUFFT_INVALID_TYPE"; 780 case CUFFT_INVALID_VALUE: return "CUFFT_INVALID_VALUE"; 781 case CUFFT_INTERNAL_ERROR: return "CUFFT_INTERNAL_ERROR"; 782 case CUFFT_EXEC_FAILED: return "CUFFT_EXEC_FAILED"; 783 case CUFFT_SETUP_FAILED: return "CUFFT_SETUP_FAILED"; 784 case CUFFT_INVALID_SIZE: return "CUFFT_INVALID_SIZE"; 785 case CUFFT_UNALIGNED_DATA: return "CUFFT_UNALIGNED_DATA"; 786 case CUFFT_INCOMPLETE_PARAMETER_LIST: return "CUFFT_INCOMPLETE_PARAMETER_LIST"; 787 case CUFFT_INVALID_DEVICE: return "CUFFT_INVALID_DEVICE"; 788 case CUFFT_PARSE_ERROR: return "CUFFT_PARSE_ERROR"; 789 case CUFFT_NO_WORKSPACE: return "CUFFT_NO_WORKSPACE"; 790 case CUFFT_NOT_IMPLEMENTED: return "CUFFT_NOT_IMPLEMENTED"; 791 case CUFFT_LICENSE_ERROR: return "CUFFT_LICENSE_ERROR"; 792 case CUFFT_NOT_SUPPORTED: return "CUFFT_NOT_SUPPORTED"; 793 default: return "unknown error"; 794 } 795 } 796 #endif 797 798 #if defined(PETSC_HAVE_HIP) 799 #include <petscdevice.h> 800 PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status) 801 { 802 switch(status) { 803 case HIPBLAS_STATUS_SUCCESS: return "HIPBLAS_STATUS_SUCCESS"; 804 case HIPBLAS_STATUS_NOT_INITIALIZED: return "HIPBLAS_STATUS_NOT_INITIALIZED"; 805 case HIPBLAS_STATUS_ALLOC_FAILED: return "HIPBLAS_STATUS_ALLOC_FAILED"; 806 case HIPBLAS_STATUS_INVALID_VALUE: return "HIPBLAS_STATUS_INVALID_VALUE"; 807 case HIPBLAS_STATUS_ARCH_MISMATCH: return "HIPBLAS_STATUS_ARCH_MISMATCH"; 808 case HIPBLAS_STATUS_MAPPING_ERROR: return "HIPBLAS_STATUS_MAPPING_ERROR"; 809 case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED"; 810 case HIPBLAS_STATUS_INTERNAL_ERROR: return "HIPBLAS_STATUS_INTERNAL_ERROR"; 811 case HIPBLAS_STATUS_NOT_SUPPORTED: return "HIPBLAS_STATUS_NOT_SUPPORTED"; 812 default: return "unknown error"; 813 } 814 } 815 #endif 816 817 /*@ 818 PetscMPIErrorString - Given an MPI error code returns the MPI_Error_string() appropriately 819 formatted for displaying with the PETSc error handlers. 820 821 Input Parameter: 822 . err - the MPI error code 823 824 Output Parameter: 825 . string - the MPI error message, should declare its length to be larger than MPI_MAX_ERROR_STRING 826 827 Level: developer 828 829 Notes: 830 Does not return an error code or do error handling because it may be called from inside an error handler 831 832 @*/ 833 void PetscMPIErrorString(PetscMPIInt err, char* string) 834 { 835 char errorstring[MPI_MAX_ERROR_STRING]; 836 PetscMPIInt len, j = 0; 837 838 MPI_Error_string(err,(char*)errorstring,&len); 839 for (PetscMPIInt i=0; i<len; i++) { 840 string[j++] = errorstring[i]; 841 if (errorstring[i] == '\n') { 842 for (PetscMPIInt k=0; k<16; k++) string[j++] = ' '; 843 } 844 } 845 string[j] = 0; 846 } 847 848