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