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