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