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: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), 91 PetscAbortErrorHandler() 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 to the current 195 level. 196 197 Not Collective 198 199 Input Parameters: 200 + comm - communicator over which error occurred 201 . line - the line number of the error (indicated by __LINE__) 202 . file - the file in which the error was detected (indicated by __FILE__) 203 . mess - an error text string, usually just printed to the screen 204 . n - the generic error number 205 . p - specific error number 206 - ctx - error handler context 207 208 Level: developer 209 210 Notes: 211 Most users need not directly employ this routine and the other error 212 handlers, but can instead use the simplified interface SETERRQ, which has 213 the calling sequence 214 $ SETERRQ(comm,number,mess) 215 216 Notes for experienced users: 217 This routine is good for catching errors such as zero pivots in preconditioners 218 or breakdown of iterative methods. It is not appropriate for memory violations 219 and similar errors. 220 221 Use PetscPushErrorHandler() to set the desired error handler. The 222 currently available PETSc error handlers include PetscTraceBackErrorHandler(), 223 PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler() 224 225 .seealso: PetscPushErrorHandler(), PetscPopErrorHandler(). 226 @*/ 227 228 PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx) 229 { 230 PetscFunctionBegin; 231 PetscFunctionReturn(n); 232 } 233 234 static char PetscErrorBaseMessage[1024]; 235 /* 236 The numerical values for these are defined in include/petscerror.h; any changes 237 there must also be made here 238 */ 239 static const char *PetscErrorStrings[] = { 240 /*55 */ "Out of memory", 241 "No support for this operation for this object type", 242 "No support for this operation on this system", 243 /*58 */ "Operation done in wrong order", 244 /*59 */ "Signal received", 245 /*60 */ "Nonconforming object sizes", 246 "Argument aliasing not permitted", 247 "Invalid argument", 248 /*63 */ "Argument out of range", 249 "Corrupt argument: https://www.mcs.anl.gov/petsc/documentation/faq.html#valgrind", 250 "Unable to open file", 251 "Read from file failed", 252 "Write to file failed", 253 "Invalid pointer", 254 /*69 */ "Arguments must have same type", 255 /*70 */ "Attempt to use a pointer that does not point to a valid accessible location", 256 /*71 */ "Zero pivot in LU factorization: https://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot", 257 /*72 */ "Floating point exception", 258 /*73 */ "Object is in wrong state", 259 "Corrupted Petsc object", 260 "Arguments are incompatible", 261 "Error in external library", 262 /*77 */ "Petsc has generated inconsistent data", 263 "Memory corruption: https://www.mcs.anl.gov/petsc/documentation/installation.html#valgrind", 264 "Unexpected data in file", 265 /*80 */ "Arguments must have same communicators", 266 /*81 */ "Zero pivot in Cholesky factorization: https://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot", 267 " ", 268 " ", 269 "Overflow in integer operation: https://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices", 270 /*85 */ "Null argument, when expecting valid pointer", 271 /*86 */ "Unknown type. Check for miss-spelling or missing package: https://www.mcs.anl.gov/petsc/documentation/installation.html#external", 272 /*87 */ "MPI library at runtime is not compatible with MPI used at compile time", 273 /*88 */ "Error in system call", 274 /*89 */ "Object Type not set: https://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset", 275 /*90 */ " ", 276 /* */ " ", 277 /*92 */ "See https://www.mcs.anl.gov/petsc/documentation/linearsolvertable.html for possible LU and Cholesky solvers", 278 /*93 */ "You cannot overwrite this option since that will conflict with other previously set options", 279 /*94 */ "Example/application run with number of MPI ranks it does not support", 280 /*95 */ "Missing or incorrect user input ", 281 }; 282 283 /*@C 284 PetscErrorMessage - returns the text string associated with a PETSc error code. 285 286 Not Collective 287 288 Input Parameter: 289 . errnum - the error code 290 291 Output Parameter: 292 + text - the error message (NULL if not desired) 293 - specific - the specific error message that was set with SETERRxxx() or PetscError(). (NULL if not desired) 294 295 Level: developer 296 297 .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ() 298 PetscAbortErrorHandler(), PetscTraceBackErrorHandler() 299 @*/ 300 PetscErrorCode PetscErrorMessage(int errnum,const char *text[],char **specific) 301 { 302 PetscFunctionBegin; 303 if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1]; 304 else if (text) *text = NULL; 305 306 if (specific) *specific = PetscErrorBaseMessage; 307 PetscFunctionReturn(0); 308 } 309 310 #if defined(PETSC_CLANGUAGE_CXX) 311 /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software 312 * would be broken if implementations did not handle it it some common cases. However, keep in mind 313 * 314 * Rule 62. Don't allow exceptions to propagate across module boundaries 315 * 316 * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface 317 * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed. 318 * 319 * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message 320 * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that 321 * seems crazy to me. 322 */ 323 #include <sstream> 324 #include <stdexcept> 325 static void PetscCxxErrorThrow() { 326 const char *str; 327 if (eh && eh->ctx) { 328 std::ostringstream *msg; 329 msg = (std::ostringstream*) eh->ctx; 330 str = msg->str().c_str(); 331 } else str = "Error detected in C PETSc"; 332 333 throw std::runtime_error(str); 334 } 335 #endif 336 337 /*@C 338 PetscError - Routine that is called when an error has been detected, 339 usually called through the macro SETERRQ(PETSC_COMM_SELF,). 340 341 Not Collective 342 343 Input Parameters: 344 + comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine 345 . line - the line number of the error (indicated by __LINE__) 346 . func - the function name in which the error was detected 347 . file - the file in which the error was detected (indicated by __FILE__) 348 . n - the generic error number 349 . p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error 350 - mess - formatted message string - aka printf 351 352 Level: intermediate 353 354 Notes: 355 Most users need not directly use this routine and the error handlers, but 356 can instead use the simplified interface SETERRQ, which has the calling 357 sequence 358 $ SETERRQ(comm,n,mess) 359 360 Fortran Note: 361 This routine is used differently from Fortran 362 $ PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message) 363 364 Experienced users can set the error handler with PetscPushErrorHandler(). 365 366 Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes) 367 BUT this routine does call regular PETSc functions that may call error handlers, this is problematic and could be fixed by never calling other PETSc routines 368 but this annoying. 369 370 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), 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 PetscFunctionBegin; 381 if (!func) func = "User provided function"; 382 if (!file) file = "User file"; 383 if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF; 384 385 /* Compose the message evaluating the print format */ 386 if (mess) { 387 va_start(Argp,mess); 388 PetscVSNPrintf(buf,2048,mess,&fullLength,Argp); 389 va_end(Argp); 390 lbuf = buf; 391 if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023); 392 } 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 397 /* 398 If this is called from the main() routine we call MPI_Abort() instead of 399 return to allow the parallel program to be properly shutdown. 400 401 Does not call PETSCABORT() since that would provide the wrong source file and line number information 402 */ 403 PetscStrncmp(func,"main",4,&ismain); 404 if (ismain) { 405 PetscMPIInt errcode; 406 errcode = (PetscMPIInt)(0 + line*1000 + ierr); 407 if (petscwaitonerror) {PetscSleep(1000);} 408 MPI_Abort(comm,errcode); 409 } 410 411 #if defined(PETSC_CLANGUAGE_CXX) 412 if (p == PETSC_ERROR_IN_CXX) { 413 PetscCxxErrorThrow(); 414 } 415 #endif 416 PetscFunctionReturn(ierr); 417 } 418 419 /* -------------------------------------------------------------------------*/ 420 421 /*@C 422 PetscIntView - Prints an array of integers; useful for debugging. 423 424 Collective on PetscViewer 425 426 Input Parameters: 427 + N - number of integers in array 428 . idx - array of integers 429 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 430 431 Level: intermediate 432 433 Developer Notes: 434 idx cannot be const because may be passed to binary viewer where byte swapping is done 435 436 .seealso: PetscRealView() 437 @*/ 438 PetscErrorCode PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer) 439 { 440 PetscErrorCode ierr; 441 PetscMPIInt rank,size; 442 PetscInt j,i,n = N/20,p = N % 20; 443 PetscBool iascii,isbinary; 444 MPI_Comm comm; 445 446 PetscFunctionBegin; 447 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 448 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 449 if (N) PetscValidIntPointer(idx,2); 450 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 451 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 452 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 453 454 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 455 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 456 if (iascii) { 457 ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr); 458 for (i=0; i<n; i++) { 459 if (size > 1) { 460 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:", rank, 20*i);CHKERRQ(ierr); 461 } else { 462 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);CHKERRQ(ierr); 463 } 464 for (j=0; j<20; j++) { 465 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);CHKERRQ(ierr); 466 } 467 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 468 } 469 if (p) { 470 if (size > 1) { 471 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:",rank ,20*n);CHKERRQ(ierr); 472 } else { 473 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);CHKERRQ(ierr); 474 } 475 for (i=0; i<p; i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);CHKERRQ(ierr);} 476 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 477 } 478 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 479 ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr); 480 } else if (isbinary) { 481 PetscMPIInt *sizes,Ntotal,*displs,NN; 482 PetscInt *array; 483 484 ierr = PetscMPIIntCast(N,&NN);CHKERRQ(ierr); 485 486 if (size > 1) { 487 if (rank) { 488 ierr = MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);CHKERRQ(ierr); 489 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm);CHKERRQ(ierr); 490 } else { 491 ierr = PetscMalloc1(size,&sizes);CHKERRQ(ierr); 492 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 493 Ntotal = sizes[0]; 494 ierr = PetscMalloc1(size,&displs);CHKERRQ(ierr); 495 displs[0] = 0; 496 for (i=1; i<size; i++) { 497 Ntotal += sizes[i]; 498 displs[i] = displs[i-1] + sizes[i-1]; 499 } 500 ierr = PetscMalloc1(Ntotal,&array);CHKERRQ(ierr); 501 ierr = MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);CHKERRQ(ierr); 502 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT);CHKERRQ(ierr); 503 ierr = PetscFree(sizes);CHKERRQ(ierr); 504 ierr = PetscFree(displs);CHKERRQ(ierr); 505 ierr = PetscFree(array);CHKERRQ(ierr); 506 } 507 } else { 508 ierr = PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT);CHKERRQ(ierr); 509 } 510 } else { 511 const char *tname; 512 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 513 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 514 } 515 PetscFunctionReturn(0); 516 } 517 518 /*@C 519 PetscRealView - Prints an array of doubles; useful for debugging. 520 521 Collective on PetscViewer 522 523 Input Parameters: 524 + N - number of PetscReal in array 525 . idx - array of PetscReal 526 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 527 528 Level: intermediate 529 530 Developer Notes: 531 idx cannot be const because may be passed to binary viewer where byte swapping is done 532 533 .seealso: PetscIntView() 534 @*/ 535 PetscErrorCode PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer) 536 { 537 PetscErrorCode ierr; 538 PetscMPIInt rank,size; 539 PetscInt j,i,n = N/5,p = N % 5; 540 PetscBool iascii,isbinary; 541 MPI_Comm comm; 542 543 PetscFunctionBegin; 544 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 545 PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,3); 546 PetscValidScalarPointer(idx,2); 547 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 548 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 549 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 550 551 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 552 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 553 if (iascii) { 554 PetscInt tab; 555 556 ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr); 557 ierr = PetscViewerASCIIGetTab(viewer, &tab);CHKERRQ(ierr); 558 for (i=0; i<n; i++) { 559 ierr = PetscViewerASCIISetTab(viewer, tab);CHKERRQ(ierr); 560 if (size > 1) { 561 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*i);CHKERRQ(ierr); 562 } else { 563 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);CHKERRQ(ierr); 564 } 565 ierr = PetscViewerASCIISetTab(viewer, 0);CHKERRQ(ierr); 566 for (j=0; j<5; j++) { 567 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);CHKERRQ(ierr); 568 } 569 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 570 } 571 if (p) { 572 ierr = PetscViewerASCIISetTab(viewer, tab);CHKERRQ(ierr); 573 if (size > 1) { 574 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*n);CHKERRQ(ierr); 575 } else { 576 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);CHKERRQ(ierr); 577 } 578 ierr = PetscViewerASCIISetTab(viewer, 0);CHKERRQ(ierr); 579 for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);CHKERRQ(ierr);} 580 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 581 } 582 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 583 ierr = PetscViewerASCIISetTab(viewer, tab);CHKERRQ(ierr); 584 ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr); 585 } else if (isbinary) { 586 PetscMPIInt *sizes,*displs, Ntotal,NN; 587 PetscReal *array; 588 589 ierr = PetscMPIIntCast(N,&NN);CHKERRQ(ierr); 590 591 if (size > 1) { 592 if (rank) { 593 ierr = MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);CHKERRQ(ierr); 594 ierr = MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm);CHKERRQ(ierr); 595 } else { 596 ierr = PetscMalloc1(size,&sizes);CHKERRQ(ierr); 597 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 598 Ntotal = sizes[0]; 599 ierr = PetscMalloc1(size,&displs);CHKERRQ(ierr); 600 displs[0] = 0; 601 for (i=1; i<size; i++) { 602 Ntotal += sizes[i]; 603 displs[i] = displs[i-1] + sizes[i-1]; 604 } 605 ierr = PetscMalloc1(Ntotal,&array);CHKERRQ(ierr); 606 ierr = MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);CHKERRQ(ierr); 607 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL);CHKERRQ(ierr); 608 ierr = PetscFree(sizes);CHKERRQ(ierr); 609 ierr = PetscFree(displs);CHKERRQ(ierr); 610 ierr = PetscFree(array);CHKERRQ(ierr); 611 } 612 } else { 613 ierr = PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL);CHKERRQ(ierr); 614 } 615 } else { 616 const char *tname; 617 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 618 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 619 } 620 PetscFunctionReturn(0); 621 } 622 623 /*@C 624 PetscScalarView - Prints an array of scalars; useful for debugging. 625 626 Collective on PetscViewer 627 628 Input Parameters: 629 + N - number of scalars in array 630 . idx - array of scalars 631 - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0 632 633 Level: intermediate 634 635 Developer Notes: 636 idx cannot be const because may be passed to binary viewer where byte swapping is done 637 638 .seealso: PetscIntView(), PetscRealView() 639 @*/ 640 PetscErrorCode PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer) 641 { 642 PetscErrorCode ierr; 643 PetscMPIInt rank,size; 644 PetscInt j,i,n = N/3,p = N % 3; 645 PetscBool iascii,isbinary; 646 MPI_Comm comm; 647 648 PetscFunctionBegin; 649 if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; 650 PetscValidHeader(viewer,3); 651 if (N) PetscValidScalarPointer(idx,2); 652 ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr); 653 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 654 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 655 656 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 657 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 658 if (iascii) { 659 ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr); 660 for (i=0; i<n; i++) { 661 if (size > 1) { 662 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*i);CHKERRQ(ierr); 663 } else { 664 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);CHKERRQ(ierr); 665 } 666 for (j=0; j<3; j++) { 667 #if defined(PETSC_USE_COMPLEX) 668 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));CHKERRQ(ierr); 669 #else 670 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);CHKERRQ(ierr); 671 #endif 672 } 673 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 674 } 675 if (p) { 676 if (size > 1) { 677 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*n);CHKERRQ(ierr); 678 } else { 679 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);CHKERRQ(ierr); 680 } 681 for (i=0; i<p; i++) { 682 #if defined(PETSC_USE_COMPLEX) 683 ierr = PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));CHKERRQ(ierr); 684 #else 685 ierr = PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);CHKERRQ(ierr); 686 #endif 687 } 688 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr); 689 } 690 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 691 ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr); 692 } else if (isbinary) { 693 PetscMPIInt *sizes,Ntotal,*displs,NN; 694 PetscScalar *array; 695 696 ierr = PetscMPIIntCast(N,&NN);CHKERRQ(ierr); 697 698 if (size > 1) { 699 if (rank) { 700 ierr = MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);CHKERRQ(ierr); 701 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 702 } else { 703 ierr = PetscMalloc1(size,&sizes);CHKERRQ(ierr); 704 ierr = MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);CHKERRQ(ierr); 705 Ntotal = sizes[0]; 706 ierr = PetscMalloc1(size,&displs);CHKERRQ(ierr); 707 displs[0] = 0; 708 for (i=1; i<size; i++) { 709 Ntotal += sizes[i]; 710 displs[i] = displs[i-1] + sizes[i-1]; 711 } 712 ierr = PetscMalloc1(Ntotal,&array);CHKERRQ(ierr); 713 ierr = MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 714 ierr = PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR);CHKERRQ(ierr); 715 ierr = PetscFree(sizes);CHKERRQ(ierr); 716 ierr = PetscFree(displs);CHKERRQ(ierr); 717 ierr = PetscFree(array);CHKERRQ(ierr); 718 } 719 } else { 720 ierr = PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR);CHKERRQ(ierr); 721 } 722 } else { 723 const char *tname; 724 ierr = PetscObjectGetName((PetscObject)viewer,&tname);CHKERRQ(ierr); 725 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname); 726 } 727 PetscFunctionReturn(0); 728 } 729 730 #if defined(PETSC_HAVE_CUDA) 731 #include <petsccublas.h> 732 PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status) 733 { 734 switch(status) { 735 #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */ 736 case CUBLAS_STATUS_SUCCESS: return "CUBLAS_STATUS_SUCCESS"; 737 case CUBLAS_STATUS_NOT_INITIALIZED: return "CUBLAS_STATUS_NOT_INITIALIZED"; 738 case CUBLAS_STATUS_ALLOC_FAILED: return "CUBLAS_STATUS_ALLOC_FAILED"; 739 case CUBLAS_STATUS_INVALID_VALUE: return "CUBLAS_STATUS_INVALID_VALUE"; 740 case CUBLAS_STATUS_ARCH_MISMATCH: return "CUBLAS_STATUS_ARCH_MISMATCH"; 741 case CUBLAS_STATUS_MAPPING_ERROR: return "CUBLAS_STATUS_MAPPING_ERROR"; 742 case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED"; 743 case CUBLAS_STATUS_INTERNAL_ERROR: return "CUBLAS_STATUS_INTERNAL_ERROR"; 744 case CUBLAS_STATUS_NOT_SUPPORTED: return "CUBLAS_STATUS_NOT_SUPPORTED"; 745 case CUBLAS_STATUS_LICENSE_ERROR: return "CUBLAS_STATUS_LICENSE_ERROR"; 746 #endif 747 default: return "unknown error"; 748 } 749 } 750 #endif 751