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