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