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