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 = sizeof(PetscAbortSourceFiles)/sizeof(PetscAbortSourceFiles[0]); 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 CHKERRQ(); 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 CHKERRQ(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 CHKERRQ(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(), CHKERRQ() 282 PetscAbortErrorHandler(), PetscTraceBackErrorHandler() 283 @*/ 284 PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific) 285 { 286 PetscFunctionBegin; 287 if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1]; 288 else if (text) *text = NULL; 289 290 if (specific) *specific = PetscErrorBaseMessage; 291 PetscFunctionReturn(0); 292 } 293 294 #if defined(PETSC_CLANGUAGE_CXX) 295 /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software 296 * would be broken if implementations did not handle it it some common cases. However, keep in mind 297 * 298 * Rule 62. Don't allow exceptions to propagate across module boundaries 299 * 300 * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface 301 * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed. 302 * 303 * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message 304 * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that 305 * seems crazy to me. 306 */ 307 #include <sstream> 308 #include <stdexcept> 309 static void PetscCxxErrorThrow() 310 { 311 const char *str; 312 if (eh && eh->ctx) { 313 std::ostringstream *msg; 314 msg = (std::ostringstream*) eh->ctx; 315 str = msg->str().c_str(); 316 } else str = "Error detected in C PETSc"; 317 318 throw std::runtime_error(str); 319 } 320 #endif 321 322 /*@C 323 PetscError - Routine that is called when an error has been detected, usually called through the macro SETERRQ(PETSC_COMM_SELF,). 324 325 Collective on comm 326 327 Input Parameters: 328 + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine 329 . line - the line number of the error (indicated by __LINE__) 330 . func - the function name in which the error was detected 331 . file - the file in which the error was detected (indicated by __FILE__) 332 . n - the generic error number 333 . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error 334 - mess - formatted message string - aka printf 335 336 Options Database: 337 + -error_output_stdout - output the error messages to stdout instead of the default stderr 338 - -error_output_none - do not output the error messages 339 340 Level: intermediate 341 342 Notes: 343 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 344 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, 345 KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into 346 hard errors managed via PetscError(). 347 348 PETSc provides a rich supply of error handlers, see the list below, and users can also provide their own error handlers. 349 350 Most users need not directly use this routine and the error handlers, but 351 can instead use the simplified interface SETERRQ, which has the calling 352 sequence 353 $ SETERRQ(comm,n,mess) 354 355 Fortran Note: 356 This routine is used differently from Fortran 357 $ PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message) 358 359 Set the error handler with PetscPushErrorHandler(). 360 361 Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes) 362 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 363 but this annoying. 364 365 .seealso: PetscErrorCode, PetscPushErrorHandler(), PetscPopErrorHandler(), PetscTraceBackErrorHandler(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), 366 PetscReturnErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler(), 367 SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ(), SETERRQ(), PetscErrorMessage(), PETSCABORT() 368 @*/ 369 PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...) 370 { 371 va_list Argp; 372 size_t fullLength; 373 char buf[2048],*lbuf = NULL; 374 PetscBool ismain; 375 PetscErrorCode ierr; 376 377 if (!func) func = "User provided function"; 378 if (!file) file = "User file"; 379 if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF; 380 381 /* Compose the message evaluating the print format */ 382 if (mess) { 383 va_start(Argp,mess); 384 PetscVSNPrintf(buf,2048,mess,&fullLength,Argp); 385 va_end(Argp); 386 lbuf = buf; 387 if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023); 388 } 389 390 if (p == PETSC_ERROR_INITIAL && n != PETSC_ERR_MEMC) PetscMallocValidate(__LINE__,PETSC_FUNCTION_NAME,__FILE__); 391 392 if (!eh) ierr = PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,NULL); 393 else ierr = (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx); 394 PetscStackClearTop; 395 396 /* 397 If this is called from the main() routine we call MPI_Abort() instead of 398 return to allow the parallel program to be properly shutdown. 399 400 Does not call PETSCABORT() since that would provide the wrong source file and line number information 401 */ 402 PetscStrncmp(func,"main",4,&ismain); 403 if (ismain) { 404 PetscMPIInt errcode; 405 errcode = (PetscMPIInt)(0 + 0*line*1000 + ierr); 406 if (petscwaitonerrorflg) { PetscSleep(1000); } 407 MPI_Abort(MPI_COMM_WORLD,errcode); 408 } 409 410 #if defined(PETSC_CLANGUAGE_CXX) 411 if (p == PETSC_ERROR_IN_CXX) { 412 PetscCxxErrorThrow(); 413 } 414 #endif 415 return ierr; 416 } 417 418 /* -------------------------------------------------------------------------*/ 419 420 /*@C 421 PetscIntView - Prints an array of integers; useful for debugging. 422 423 Collective on PetscViewer 424 425 Input Parameters: 426 + N - number of integers in array 427 . idx - array of integers 428 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 429 430 Level: intermediate 431 432 Developer Notes: 433 idx cannot be const because may be passed to binary viewer where byte swapping is done 434 435 .seealso: PetscRealView() 436 @*/ 437 PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer) 438 { 439 PetscMPIInt rank,size; 440 PetscInt j,i,n = N/20,p = N % 20; 441 PetscBool iascii,isbinary; 442 MPI_Comm comm; 443 444 PetscFunctionBegin; 445 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 446 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 447 if (N) PetscValidIntPointer(idx,2); 448 CHKERRQ(PetscObjectGetComm((PetscObject)viewer,&comm)); 449 CHKERRMPI(MPI_Comm_size(comm,&size)); 450 CHKERRMPI(MPI_Comm_rank(comm,&rank)); 451 452 CHKERRQ(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii)); 453 CHKERRQ(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary)); 454 if (iascii) { 455 CHKERRQ(PetscViewerASCIIPushSynchronized(viewer)); 456 for (i=0; i<n; i++) { 457 if (size > 1) { 458 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":", rank, 20*i)); 459 } else { 460 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*i)); 461 } 462 for (j=0; j<20; j++) { 463 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[i*20+j])); 464 } 465 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 466 } 467 if (p) { 468 if (size > 1) { 469 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":",rank ,20*n)); 470 } else { 471 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*n)); 472 } 473 for (i=0; i<p; i++) CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[20*n+i])); 474 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 475 } 476 CHKERRQ(PetscViewerFlush(viewer)); 477 CHKERRQ(PetscViewerASCIIPopSynchronized(viewer)); 478 } else if (isbinary) { 479 PetscMPIInt *sizes,Ntotal,*displs,NN; 480 PetscInt *array; 481 482 CHKERRQ(PetscMPIIntCast(N,&NN)); 483 484 if (size > 1) { 485 if (rank) { 486 CHKERRMPI(MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm)); 487 CHKERRMPI(MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm)); 488 } else { 489 CHKERRQ(PetscMalloc1(size,&sizes)); 490 CHKERRMPI(MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm)); 491 Ntotal = sizes[0]; 492 CHKERRQ(PetscMalloc1(size,&displs)); 493 displs[0] = 0; 494 for (i=1; i<size; i++) { 495 Ntotal += sizes[i]; 496 displs[i] = displs[i-1] + sizes[i-1]; 497 } 498 CHKERRQ(PetscMalloc1(Ntotal,&array)); 499 CHKERRMPI(MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm)); 500 CHKERRQ(PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT)); 501 CHKERRQ(PetscFree(sizes)); 502 CHKERRQ(PetscFree(displs)); 503 CHKERRQ(PetscFree(array)); 504 } 505 } else { 506 CHKERRQ(PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT)); 507 } 508 } else { 509 const char *tname; 510 CHKERRQ(PetscObjectGetName((PetscObject)viewer,&tname)); 511 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 512 } 513 PetscFunctionReturn(0); 514 } 515 516 /*@C 517 PetscRealView - Prints an array of doubles; useful for debugging. 518 519 Collective on PetscViewer 520 521 Input Parameters: 522 + N - number of PetscReal in array 523 . idx - array of PetscReal 524 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 525 526 Level: intermediate 527 528 Developer Notes: 529 idx cannot be const because may be passed to binary viewer where byte swapping is done 530 531 .seealso: PetscIntView() 532 @*/ 533 PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer) 534 { 535 PetscMPIInt rank,size; 536 PetscInt j,i,n = N/5,p = N % 5; 537 PetscBool iascii,isbinary; 538 MPI_Comm comm; 539 540 PetscFunctionBegin; 541 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 542 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 543 PetscValidRealPointer(idx,2); 544 CHKERRQ(PetscObjectGetComm((PetscObject)viewer,&comm)); 545 CHKERRMPI(MPI_Comm_size(comm,&size)); 546 CHKERRMPI(MPI_Comm_rank(comm,&rank)); 547 548 CHKERRQ(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii)); 549 CHKERRQ(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary)); 550 if (iascii) { 551 PetscInt tab; 552 553 CHKERRQ(PetscViewerASCIIPushSynchronized(viewer)); 554 CHKERRQ(PetscViewerASCIIGetTab(viewer, &tab)); 555 for (i=0; i<n; i++) { 556 CHKERRQ(PetscViewerASCIISetTab(viewer, tab)); 557 if (size > 1) { 558 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*i)); 559 } else { 560 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*i)); 561 } 562 CHKERRQ(PetscViewerASCIISetTab(viewer, 0)); 563 for (j=0; j<5; j++) { 564 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j])); 565 } 566 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 567 } 568 if (p) { 569 CHKERRQ(PetscViewerASCIISetTab(viewer, tab)); 570 if (size > 1) { 571 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*n)); 572 } else { 573 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*n)); 574 } 575 CHKERRQ(PetscViewerASCIISetTab(viewer, 0)); 576 for (i=0; i<p; i++) CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i])); 577 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 578 } 579 CHKERRQ(PetscViewerFlush(viewer)); 580 CHKERRQ(PetscViewerASCIISetTab(viewer, tab)); 581 CHKERRQ(PetscViewerASCIIPopSynchronized(viewer)); 582 } else if (isbinary) { 583 PetscMPIInt *sizes,*displs, Ntotal,NN; 584 PetscReal *array; 585 586 CHKERRQ(PetscMPIIntCast(N,&NN)); 587 588 if (size > 1) { 589 if (rank) { 590 CHKERRMPI(MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm)); 591 CHKERRMPI(MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm)); 592 } else { 593 CHKERRQ(PetscMalloc1(size,&sizes)); 594 CHKERRMPI(MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm)); 595 Ntotal = sizes[0]; 596 CHKERRQ(PetscMalloc1(size,&displs)); 597 displs[0] = 0; 598 for (i=1; i<size; i++) { 599 Ntotal += sizes[i]; 600 displs[i] = displs[i-1] + sizes[i-1]; 601 } 602 CHKERRQ(PetscMalloc1(Ntotal,&array)); 603 CHKERRMPI(MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm)); 604 CHKERRQ(PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL)); 605 CHKERRQ(PetscFree(sizes)); 606 CHKERRQ(PetscFree(displs)); 607 CHKERRQ(PetscFree(array)); 608 } 609 } else { 610 CHKERRQ(PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL)); 611 } 612 } else { 613 const char *tname; 614 CHKERRQ(PetscObjectGetName((PetscObject)viewer,&tname)); 615 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 616 } 617 PetscFunctionReturn(0); 618 } 619 620 /*@C 621 PetscScalarView - Prints an array of scalars; useful for debugging. 622 623 Collective on PetscViewer 624 625 Input Parameters: 626 + N - number of scalars in array 627 . idx - array of scalars 628 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 629 630 Level: intermediate 631 632 Developer Notes: 633 idx cannot be const because may be passed to binary viewer where byte swapping is done 634 635 .seealso: PetscIntView(), PetscRealView() 636 @*/ 637 PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer) 638 { 639 PetscMPIInt rank,size; 640 PetscInt j,i,n = N/3,p = N % 3; 641 PetscBool iascii,isbinary; 642 MPI_Comm comm; 643 644 PetscFunctionBegin; 645 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 646 PetscValidHeader(viewer,3); 647 if (N) PetscValidScalarPointer(idx,2); 648 CHKERRQ(PetscObjectGetComm((PetscObject)viewer,&comm)); 649 CHKERRMPI(MPI_Comm_size(comm,&size)); 650 CHKERRMPI(MPI_Comm_rank(comm,&rank)); 651 652 CHKERRQ(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii)); 653 CHKERRQ(PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary)); 654 if (iascii) { 655 CHKERRQ(PetscViewerASCIIPushSynchronized(viewer)); 656 for (i=0; i<n; i++) { 657 if (size > 1) { 658 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*i)); 659 } else { 660 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*i)); 661 } 662 for (j=0; j<3; j++) { 663 #if defined(PETSC_USE_COMPLEX) 664 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]))); 665 #else 666 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j])); 667 #endif 668 } 669 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 670 } 671 if (p) { 672 if (size > 1) { 673 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*n)); 674 } else { 675 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*n)); 676 } 677 for (i=0; i<p; i++) { 678 #if defined(PETSC_USE_COMPLEX) 679 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]))); 680 #else 681 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i])); 682 #endif 683 } 684 CHKERRQ(PetscViewerASCIISynchronizedPrintf(viewer,"\n")); 685 } 686 CHKERRQ(PetscViewerFlush(viewer)); 687 CHKERRQ(PetscViewerASCIIPopSynchronized(viewer)); 688 } else if (isbinary) { 689 PetscMPIInt *sizes,Ntotal,*displs,NN; 690 PetscScalar *array; 691 692 CHKERRQ(PetscMPIIntCast(N,&NN)); 693 694 if (size > 1) { 695 if (rank) { 696 CHKERRMPI(MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm)); 697 CHKERRMPI(MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm)); 698 } else { 699 CHKERRQ(PetscMalloc1(size,&sizes)); 700 CHKERRMPI(MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm)); 701 Ntotal = sizes[0]; 702 CHKERRQ(PetscMalloc1(size,&displs)); 703 displs[0] = 0; 704 for (i=1; i<size; i++) { 705 Ntotal += sizes[i]; 706 displs[i] = displs[i-1] + sizes[i-1]; 707 } 708 CHKERRQ(PetscMalloc1(Ntotal,&array)); 709 CHKERRMPI(MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm)); 710 CHKERRQ(PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR)); 711 CHKERRQ(PetscFree(sizes)); 712 CHKERRQ(PetscFree(displs)); 713 CHKERRQ(PetscFree(array)); 714 } 715 } else { 716 CHKERRQ(PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR)); 717 } 718 } else { 719 const char *tname; 720 CHKERRQ(PetscObjectGetName((PetscObject)viewer,&tname)); 721 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 722 } 723 PetscFunctionReturn(0); 724 } 725 726 #if defined(PETSC_HAVE_CUDA) 727 #include <petscdevice.h> 728 PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status) 729 { 730 switch(status) { 731 #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */ 732 case CUBLAS_STATUS_SUCCESS: return "CUBLAS_STATUS_SUCCESS"; 733 case CUBLAS_STATUS_NOT_INITIALIZED: return "CUBLAS_STATUS_NOT_INITIALIZED"; 734 case CUBLAS_STATUS_ALLOC_FAILED: return "CUBLAS_STATUS_ALLOC_FAILED"; 735 case CUBLAS_STATUS_INVALID_VALUE: return "CUBLAS_STATUS_INVALID_VALUE"; 736 case CUBLAS_STATUS_ARCH_MISMATCH: return "CUBLAS_STATUS_ARCH_MISMATCH"; 737 case CUBLAS_STATUS_MAPPING_ERROR: return "CUBLAS_STATUS_MAPPING_ERROR"; 738 case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED"; 739 case CUBLAS_STATUS_INTERNAL_ERROR: return "CUBLAS_STATUS_INTERNAL_ERROR"; 740 case CUBLAS_STATUS_NOT_SUPPORTED: return "CUBLAS_STATUS_NOT_SUPPORTED"; 741 case CUBLAS_STATUS_LICENSE_ERROR: return "CUBLAS_STATUS_LICENSE_ERROR"; 742 #endif 743 default: return "unknown error"; 744 } 745 } 746 PETSC_EXTERN const char* PetscCUSolverGetErrorName(cusolverStatus_t status) 747 { 748 switch(status) { 749 #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */ 750 case CUSOLVER_STATUS_SUCCESS: return "CUSOLVER_STATUS_SUCCESS"; 751 case CUSOLVER_STATUS_NOT_INITIALIZED: return "CUSOLVER_STATUS_NOT_INITIALIZED"; 752 case CUSOLVER_STATUS_INVALID_VALUE: return "CUSOLVER_STATUS_INVALID_VALUE"; 753 case CUSOLVER_STATUS_ARCH_MISMATCH: return "CUSOLVER_STATUS_ARCH_MISMATCH"; 754 case CUSOLVER_STATUS_INTERNAL_ERROR: return "CUSOLVER_STATUS_INTERNAL_ERROR"; 755 #if (CUDART_VERSION >= 9000) /* CUDA 9.0 had these defined on June 2021 */ 756 case CUSOLVER_STATUS_ALLOC_FAILED: return "CUSOLVER_STATUS_ALLOC_FAILED"; 757 case CUSOLVER_STATUS_MAPPING_ERROR: return "CUSOLVER_STATUS_MAPPING_ERROR"; 758 case CUSOLVER_STATUS_EXECUTION_FAILED: return "CUSOLVER_STATUS_EXECUTION_FAILED"; 759 case CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED: return "CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED"; 760 case CUSOLVER_STATUS_NOT_SUPPORTED : return "CUSOLVER_STATUS_NOT_SUPPORTED "; 761 case CUSOLVER_STATUS_ZERO_PIVOT: return "CUSOLVER_STATUS_ZERO_PIVOT"; 762 case CUSOLVER_STATUS_INVALID_LICENSE: return "CUSOLVER_STATUS_INVALID_LICENSE"; 763 #endif 764 #endif 765 default: return "unknown error"; 766 } 767 } 768 PETSC_EXTERN const char* PetscCUFFTGetErrorName(cufftResult result) 769 { 770 switch (result) { 771 case CUFFT_SUCCESS: return "CUFFT_SUCCESS"; 772 case CUFFT_INVALID_PLAN: return "CUFFT_INVALID_PLAN"; 773 case CUFFT_ALLOC_FAILED: return "CUFFT_ALLOC_FAILED"; 774 case CUFFT_INVALID_TYPE: return "CUFFT_INVALID_TYPE"; 775 case CUFFT_INVALID_VALUE: return "CUFFT_INVALID_VALUE"; 776 case CUFFT_INTERNAL_ERROR: return "CUFFT_INTERNAL_ERROR"; 777 case CUFFT_EXEC_FAILED: return "CUFFT_EXEC_FAILED"; 778 case CUFFT_SETUP_FAILED: return "CUFFT_SETUP_FAILED"; 779 case CUFFT_INVALID_SIZE: return "CUFFT_INVALID_SIZE"; 780 case CUFFT_UNALIGNED_DATA: return "CUFFT_UNALIGNED_DATA"; 781 case CUFFT_INCOMPLETE_PARAMETER_LIST: return "CUFFT_INCOMPLETE_PARAMETER_LIST"; 782 case CUFFT_INVALID_DEVICE: return "CUFFT_INVALID_DEVICE"; 783 case CUFFT_PARSE_ERROR: return "CUFFT_PARSE_ERROR"; 784 case CUFFT_NO_WORKSPACE: return "CUFFT_NO_WORKSPACE"; 785 case CUFFT_NOT_IMPLEMENTED: return "CUFFT_NOT_IMPLEMENTED"; 786 case CUFFT_LICENSE_ERROR: return "CUFFT_LICENSE_ERROR"; 787 case CUFFT_NOT_SUPPORTED: return "CUFFT_NOT_SUPPORTED"; 788 default: return "unknown error"; 789 } 790 } 791 #endif 792 793 #if defined(PETSC_HAVE_HIP) 794 #include <petscdevice.h> 795 PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status) 796 { 797 switch(status) { 798 case HIPBLAS_STATUS_SUCCESS: return "HIPBLAS_STATUS_SUCCESS"; 799 case HIPBLAS_STATUS_NOT_INITIALIZED: return "HIPBLAS_STATUS_NOT_INITIALIZED"; 800 case HIPBLAS_STATUS_ALLOC_FAILED: return "HIPBLAS_STATUS_ALLOC_FAILED"; 801 case HIPBLAS_STATUS_INVALID_VALUE: return "HIPBLAS_STATUS_INVALID_VALUE"; 802 case HIPBLAS_STATUS_ARCH_MISMATCH: return "HIPBLAS_STATUS_ARCH_MISMATCH"; 803 case HIPBLAS_STATUS_MAPPING_ERROR: return "HIPBLAS_STATUS_MAPPING_ERROR"; 804 case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED"; 805 case HIPBLAS_STATUS_INTERNAL_ERROR: return "HIPBLAS_STATUS_INTERNAL_ERROR"; 806 case HIPBLAS_STATUS_NOT_SUPPORTED: return "HIPBLAS_STATUS_NOT_SUPPORTED"; 807 default: return "unknown error"; 808 } 809 } 810 #endif 811