Actual source code: err.c


  2: /*
  3:       Code that allows one to set the error handlers
  4:       Portions of this code are under:
  5:       Copyright (c) 2022 Advanced Micro Devices, Inc. All rights reserved.
  6: */
  7: #include <petsc/private/petscimpl.h>
  8: #include <petscviewer.h>

 10: typedef struct _EH *EH;
 11: struct _EH {
 12:   PetscErrorCode (*handler)(MPI_Comm, int, const char *, const char *, PetscErrorCode, PetscErrorType, const char *, void *);
 13:   void *ctx;
 14:   EH    previous;
 15: };

 17: static EH eh = NULL;

 19: /*@C
 20:    PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
 21:     load the file where the error occurred. Then calls the "previous" error handler.

 23:    Not Collective

 25:    Input Parameters:
 26: +  comm - communicator over which error occurred
 27: .  line - the line number of the error (indicated by __LINE__)
 28: .  file - the file in which the error was detected (indicated by __FILE__)
 29: .  mess - an error text string, usually just printed to the screen
 30: .  n - the generic error number
 31: .  p - specific error number
 32: -  ctx - error handler context

 34:    Options Database Key:
 35: .   -on_error_emacs <machinename> - will contact machinename to open the Emacs client there

 37:    Level: developer

 39:    Note:
 40:    You must put (server-start) in your .emacs file for the emacsclient software to work

 42:    Developer Note:
 43:    Since this is an error handler it cannot call `PetscCall()`; thus we just return if an error is detected.
 44:    But some of the functions it calls do perform error checking that may not be appropriate in a error handler call.

 46: .seealso: `PetscError()`, `PetscPushErrorHandler()`, `PetscPopErrorHandler()`, `PetscAttachDebuggerErrorHandler()`,
 47:           `PetscAbortErrorHandler()`, `PetscMPIAbortErrorHandler()`, `PetscTraceBackErrorHandler()`, `PetscReturnErrorHandler()`
 48:  @*/
 49: PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm comm, int line, const char *fun, const char *file, PetscErrorCode n, PetscErrorType p, const char *mess, void *ctx)
 50: {
 52:   char           command[PETSC_MAX_PATH_LEN];
 53:   const char    *pdir;
 54:   FILE          *fp;

 56:   PetscGetPetscDir(&pdir);
 57:   if (ierr) return ierr;
 58:   sprintf(command, "cd %s; emacsclient --no-wait +%d %s\n", pdir, line, file);
 59: #if defined(PETSC_HAVE_POPEN)
 60:   PetscPOpen(MPI_COMM_WORLD, (char *)ctx, command, "r", &fp);
 61:   if (ierr) return ierr;
 62:   PetscPClose(MPI_COMM_WORLD, fp);
 63:   if (ierr) return ierr;
 64: #else
 65:   SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot run external programs on this machine");
 66: #endif
 67:   PetscPopErrorHandler();
 68:   if (ierr) return ierr; /* remove this handler from the stack of handlers */
 69:   if (!eh) {
 70:     PetscTraceBackErrorHandler(comm, line, fun, file, n, p, mess, NULL);
 71:     if (ierr) return ierr;
 72:   } else {
 73:     (*eh->handler)(comm, line, fun, file, n, p, mess, eh->ctx);
 74:     if (ierr) return ierr;
 75:   }
 76:   return 0;
 77: }

 79: /*@C
 80:    PetscPushErrorHandler - Sets a routine to be called on detection of errors.

 82:    Not Collective

 84:    Input Parameters:
 85: +  handler - error handler routine
 86: -  ctx - optional handler context that contains information needed by the handler (for
 87:          example file pointers for error messages etc.)

 89:    Calling sequence of handler:
 90: $    int handler(MPI_Comm comm,int line,char *func,char *file,PetscErrorCode n,int p,char *mess,void *ctx);

 92: +  comm - communicator over which error occurred
 93: .  line - the line number of the error (indicated by __LINE__)
 94: .  file - the file in which the error was detected (indicated by __FILE__)
 95: .  n - the generic error number (see list defined in include/petscerror.h)
 96: .  p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
 97: .  mess - an error text string, usually just printed to the screen
 98: -  ctx - the error handler context

100:    Options Database Keys:
101: +   -on_error_attach_debugger <noxterm,gdb or dbx> - starts up the debugger if an error occurs
102: -   -on_error_abort - aborts the program if an error occurs

104:    Level: intermediate

106:    Note:
107:    The currently available PETSc error handlers include `PetscTraceBackErrorHandler()`,
108:    `PetscAttachDebuggerErrorHandler()`, `PetscAbortErrorHandler()`, and `PetscMPIAbortErrorHandler()`, `PetscReturnErrorHandler()`.

110:    Fortran Note:
111:     You can only push one error handler from Fortran before poping it.

113: .seealso: `PetscPopErrorHandler()`, `PetscAttachDebuggerErrorHandler()`, `PetscAbortErrorHandler()`, `PetscTraceBackErrorHandler()`, `PetscPushSignalHandler()`
114: @*/
115: PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm, int, const char *, const char *, PetscErrorCode, PetscErrorType, const char *, void *), void *ctx)
116: {
117:   EH neweh;

119:   PetscNew(&neweh);
120:   if (eh) neweh->previous = eh;
121:   else neweh->previous = NULL;
122:   neweh->handler = handler;
123:   neweh->ctx     = ctx;
124:   eh             = neweh;
125:   return 0;
126: }

128: /*@
129:    PetscPopErrorHandler - Removes the latest error handler that was
130:    pushed with `PetscPushErrorHandler()`.

132:    Not Collective

134:    Level: intermediate

136: .seealso: `PetscPushErrorHandler()`
137: @*/
138: PetscErrorCode PetscPopErrorHandler(void)
139: {
140:   EH tmp;

142:   if (!eh) return 0;
143:   tmp = eh;
144:   eh  = eh->previous;
145:   PetscFree(tmp);
146:   return 0;
147: }

149: /*@C
150:   PetscReturnErrorHandler - Error handler that causes a return without printing an error message.

152:    Not Collective

154:    Input Parameters:
155: +  comm - communicator over which error occurred
156: .  line - the line number of the error (indicated by __LINE__)
157: .  file - the file in which the error was detected (indicated by __FILE__)
158: .  mess - an error text string, usually just printed to the screen
159: .  n - the generic error number
160: .  p - specific error number
161: -  ctx - error handler context

163:    Level: developer

165:    Notes:
166:    Most users need not directly employ this routine and the other error
167:    handlers, but can instead use the simplified interface `SETERRQ()`, which has
168:    the calling sequence
169: $     SETERRQ(comm,number,mess)

171:    `PetscIgnoreErrorHandler()` does the same thing as this function, but is deprecated, you should use this function.

173:    Use `PetscPushErrorHandler()` to set the desired error handler.

175: .seealso: `PetscPushErrorHandler()`, `PetscPopErrorHandler()`, `PetscError()`, `PetscAbortErrorHandler()`, `PetscMPIAbortErrorHandler()`, `PetscTraceBackErrorHandler()`,
176:           `PetscAttachDebuggerErrorHandler()`, `PetscEmacsClientErrorHandler()`
177:  @*/
178: PetscErrorCode PetscReturnErrorHandler(MPI_Comm comm, int line, const char *fun, const char *file, PetscErrorCode n, PetscErrorType p, const char *mess, void *ctx)
179: {
180:   return n;
181: }

183: static char PetscErrorBaseMessage[1024];
184: /*
185:        The numerical values for these are defined in include/petscerror.h; any changes
186:    there must also be made here
187: */
188: static const char *PetscErrorStrings[] = {
189:   /*55 */ "Out of memory",
190:   "No support for this operation for this object type",
191:   "No support for this operation on this system",
192:   /*58 */ "Operation done in wrong order",
193:   /*59 */ "Signal received",
194:   /*60 */ "Nonconforming object sizes",
195:   "Argument aliasing not permitted",
196:   "Invalid argument",
197:   /*63 */ "Argument out of range",
198:   "Corrupt argument: https://petsc.org/release/faq/#valgrind",
199:   "Unable to open file",
200:   "Read from file failed",
201:   "Write to file failed",
202:   "Invalid pointer",
203:   /*69 */ "Arguments must have same type",
204:   /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
205:   /*71 */ "Zero pivot in LU factorization: https://petsc.org/release/faq/#zeropivot",
206:   /*72 */ "Floating point exception",
207:   /*73 */ "Object is in wrong state",
208:   "Corrupted Petsc object",
209:   "Arguments are incompatible",
210:   "Error in external library",
211:   /*77 */ "Petsc has generated inconsistent data",
212:   "Memory corruption: https://petsc.org/release/faq/#valgrind",
213:   "Unexpected data in file",
214:   /*80 */ "Arguments must have same communicators",
215:   /*81 */ "Zero pivot in Cholesky factorization: https://petsc.org/release/faq/#zeropivot",
216:   "",
217:   "",
218:   "Overflow in integer operation: https://petsc.org/release/faq/#64-bit-indices",
219:   /*85 */ "Null argument, when expecting valid pointer",
220:   /*86 */ "Unknown type. Check for miss-spelling or missing package: https://petsc.org/release/install/install/#external-packages",
221:   /*87 */ "MPI library at runtime is not compatible with MPI used at compile time",
222:   /*88 */ "Error in system call",
223:   /*89 */ "Object Type not set: https://petsc.org/release/faq/#object-type-not-set",
224:   /*90 */ "",
225:   /*   */ "",
226:   /*92 */ "See https://petsc.org/release/overview/linear_solve_table/ for possible LU and Cholesky solvers",
227:   /*93 */ "You cannot overwrite this option since that will conflict with other previously set options",
228:   /*94 */ "Example/application run with number of MPI ranks it does not support",
229:   /*95 */ "Missing or incorrect user input",
230:   /*96 */ "GPU resources unavailable",
231:   /*97 */ "GPU error",
232:   /*98 */ "General MPI error",
233:   /*99 */ "PetscError() incorrectly returned an error code of 0"};

235: /*@C
236:    PetscErrorMessage - returns the text string associated with a PETSc error code.

238:    Not Collective

240:    Input Parameter:
241: .   errnum - the error code

243:    Output Parameters:
244: +  text - the error message (NULL if not desired)
245: -  specific - the specific error message that was set with `SETERRQ()` or `PetscError()`.  (NULL if not desired)

247:    Level: developer

249: .seealso: `PetscPushErrorHandler()`, `PetscAttachDebuggerErrorHandler()`, `PetscError()`, `SETERRQ()`, `PetscCall()`
250:           `PetscAbortErrorHandler()`, `PetscTraceBackErrorHandler()`
251:  @*/
252: PetscErrorCode PetscErrorMessage(int errnum, const char *text[], char **specific)
253: {
254:   size_t len;

256:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) {
257:     *text = PetscErrorStrings[errnum - PETSC_ERR_MIN_VALUE - 1];
258:     PetscStrlen(*text, &len);
259:     if (!len) *text = NULL;
260:   } else if (text) *text = NULL;

262:   if (specific) *specific = PetscErrorBaseMessage;
263:   return 0;
264: }

266: #if defined(PETSC_CLANGUAGE_CXX)
267:   /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
268:  * would be broken if implementations did not handle it it some common cases. However, keep in mind
269:  *
270:  *   Rule 62. Don't allow exceptions to propagate across module boundaries
271:  *
272:  * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
273:  * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
274:  *
275:  * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message
276:  * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that
277:  * seems crazy to me.
278:  */
279:   #include <sstream>
280:   #include <stdexcept>
281: static void PetscCxxErrorThrow()
282: {
283:   const char *str;
284:   if (eh && eh->ctx) {
285:     std::ostringstream *msg;
286:     msg = (std::ostringstream *)eh->ctx;
287:     str = msg->str().c_str();
288:   } else str = "Error detected in C PETSc";

290:   throw std::runtime_error(str);
291: }
292: #endif

294: /*@C
295:    PetscError - Routine that is called when an error has been detected, usually called through the macro SETERRQ(PETSC_COMM_SELF,).

297:   Collective

299:    Input Parameters:
300: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
301: .  line - the line number of the error (indicated by __LINE__)
302: .  func - the function name in which the error was detected
303: .  file - the file in which the error was detected (indicated by __FILE__)
304: .  n - the generic error number
305: .  p - `PETSC_ERROR_INITIAL` indicates the error was initially detected, `PETSC_ERROR_REPEAT` indicates this is a traceback from a previously detected error
306: -  mess - formatted message string - aka printf

308:   Options Database Keys:
309: +  -error_output_stdout - output the error messages to stdout instead of the default stderr
310: -  -error_output_none - do not output the error messages

312:   Level: intermediate

314:    Notes:
315:    PETSc error handling is done with error return codes. A non-zero return indicates an error
316:    was detected. The return-value of this routine is what is ultimately returned by
317:    `SETERRQ()`.

319:    Note that numerical errors (potential divide by zero, for example) are not managed by the
320:    error return codes; they are managed via, for example, `KSPGetConvergedReason()` that
321:    indicates if the solve was successful or not. The option `-ksp_error_if_not_converged`, for
322:    example, turns numerical failures into hard errors managed via `PetscError()`.

324:    PETSc provides a rich supply of error handlers, see the list below, and users can also
325:    provide their own error handlers.

327:    If the user sets their own error handler (via `PetscPushErrorHandler()`) they may return any
328:    arbitrary value from it, but are encouraged to return nonzero values. If the return value is
329:    zero, `SETERRQ()` will ignore the value and return `PETSC_ERR_RETURN` (a nonzero value)
330:    instead.

332:    Most users need not directly use this routine and the error handlers, but can instead use
333:    the simplified interface `PetscCall()` or `SETERRQ()`.

335:    Fortran Note:
336:    This routine is used differently from Fortran
337: $    PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)

339:    Developer Note:
340:    Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
341:    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
342:    but this annoying.

344: .seealso: `PetscErrorCode`, `PetscPushErrorHandler()`, `PetscPopErrorHandler()`, `PetscTraceBackErrorHandler()`, `PetscAbortErrorHandler()`, `PetscMPIAbortErrorHandler()`,
345:           `PetscReturnErrorHandler()`, `PetscAttachDebuggerErrorHandler()`, `PetscEmacsClientErrorHandler()`,
346:           `SETERRQ()`, `PetscCall()`, `CHKMEMQ`, `SETERRQ()`, `SETERRQ()`, `PetscErrorMessage()`, `PETSCABORT()`
347: @*/
348: PetscErrorCode PetscError(MPI_Comm comm, int line, const char *func, const char *file, PetscErrorCode n, PetscErrorType p, const char *mess, ...)
349: {
350:   va_list        Argp;
351:   size_t         fullLength;
352:   char           buf[2048], *lbuf = NULL;
353:   PetscBool      ismain;

356:   if (!PetscErrorHandlingInitialized) return n;
357:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

359:   /* Compose the message evaluating the print format */
360:   if (mess) {
361:     va_start(Argp, mess);
362:     PetscVSNPrintf(buf, 2048, mess, &fullLength, Argp);
363:     va_end(Argp);
364:     lbuf = buf;
365:     if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage, lbuf, 1023);
366:   }

368:   if (p == PETSC_ERROR_INITIAL && n != PETSC_ERR_MEMC) PetscMallocValidate(__LINE__, PETSC_FUNCTION_NAME, __FILE__);

370:   if (!eh) PetscTraceBackErrorHandler(comm, line, func, file, n, p, lbuf, NULL);
371:   else (*eh->handler)(comm, line, func, file, n, p, lbuf, eh->ctx);
372:   PetscStackClearTop;

374:   /*
375:       If this is called from the main() routine we call MPI_Abort() instead of
376:     return to allow the parallel program to be properly shutdown.

378:     Does not call PETSCABORT() since that would provide the wrong source file and line number information
379:   */
380:   if (func) {
381:     PetscStrncmp(func, "main", 4, &ismain);
382:     if (ismain) {
383:       if (petscwaitonerrorflg) PetscSleep(1000);
384:       PETSCABORT(comm, ierr);
385:     }
386:   }
387: #if defined(PETSC_CLANGUAGE_CXX)
388:   if (p == PETSC_ERROR_IN_CXX) PetscCxxErrorThrow();
389: #endif
390:   return ierr;
391: }

393: /* -------------------------------------------------------------------------*/

395: /*@C
396:     PetscIntView - Prints an array of integers; useful for debugging.

398:     Collective

400:     Input Parameters:
401: +   N - number of integers in array
402: .   idx - array of integers
403: -   viewer - location to print array, `PETSC_VIEWER_STDOUT_WORLD`, `PETSC_VIEWER_STDOUT_SELF` or 0

405:   Level: intermediate

407:     Note:
408:     This may be called from within the debugger

410:     Developer Note:
411:     idx cannot be const because may be passed to binary viewer where temporary byte swapping may be done

413: .seealso: `PetscViewer`, `PetscRealView()`
414: @*/
415: PetscErrorCode PetscIntView(PetscInt N, const PetscInt idx[], PetscViewer viewer)
416: {
417:   PetscMPIInt rank, size;
418:   PetscInt    j, i, n = N / 20, p = N % 20;
419:   PetscBool   iascii, isbinary;
420:   MPI_Comm    comm;

422:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
425:   PetscObjectGetComm((PetscObject)viewer, &comm);
426:   MPI_Comm_size(comm, &size);
427:   MPI_Comm_rank(comm, &rank);

429:   PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii);
430:   PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERBINARY, &isbinary);
431:   if (iascii) {
432:     PetscViewerASCIIPushSynchronized(viewer);
433:     for (i = 0; i < n; i++) {
434:       if (size > 1) {
435:         PetscViewerASCIISynchronizedPrintf(viewer, "[%d] %" PetscInt_FMT ":", rank, 20 * i);
436:       } else {
437:         PetscViewerASCIISynchronizedPrintf(viewer, "%" PetscInt_FMT ":", 20 * i);
438:       }
439:       for (j = 0; j < 20; j++) PetscViewerASCIISynchronizedPrintf(viewer, " %" PetscInt_FMT, idx[i * 20 + j]);
440:       PetscViewerASCIISynchronizedPrintf(viewer, "\n");
441:     }
442:     if (p) {
443:       if (size > 1) {
444:         PetscViewerASCIISynchronizedPrintf(viewer, "[%d] %" PetscInt_FMT ":", rank, 20 * n);
445:       } else {
446:         PetscViewerASCIISynchronizedPrintf(viewer, "%" PetscInt_FMT ":", 20 * n);
447:       }
448:       for (i = 0; i < p; i++) PetscViewerASCIISynchronizedPrintf(viewer, " %" PetscInt_FMT, idx[20 * n + i]);
449:       PetscViewerASCIISynchronizedPrintf(viewer, "\n");
450:     }
451:     PetscViewerFlush(viewer);
452:     PetscViewerASCIIPopSynchronized(viewer);
453:   } else if (isbinary) {
454:     PetscMPIInt *sizes, Ntotal, *displs, NN;
455:     PetscInt    *array;

457:     PetscMPIIntCast(N, &NN);

459:     if (size > 1) {
460:       if (rank) {
461:         MPI_Gather(&NN, 1, MPI_INT, NULL, 0, MPI_INT, 0, comm);
462:         MPI_Gatherv((void *)idx, NN, MPIU_INT, NULL, NULL, NULL, MPIU_INT, 0, comm);
463:       } else {
464:         PetscMalloc1(size, &sizes);
465:         MPI_Gather(&NN, 1, MPI_INT, sizes, 1, MPI_INT, 0, comm);
466:         Ntotal = sizes[0];
467:         PetscMalloc1(size, &displs);
468:         displs[0] = 0;
469:         for (i = 1; i < size; i++) {
470:           Ntotal += sizes[i];
471:           displs[i] = displs[i - 1] + sizes[i - 1];
472:         }
473:         PetscMalloc1(Ntotal, &array);
474:         MPI_Gatherv((void *)idx, NN, MPIU_INT, array, sizes, displs, MPIU_INT, 0, comm);
475:         PetscViewerBinaryWrite(viewer, array, Ntotal, PETSC_INT);
476:         PetscFree(sizes);
477:         PetscFree(displs);
478:         PetscFree(array);
479:       }
480:     } else {
481:       PetscViewerBinaryWrite(viewer, idx, N, PETSC_INT);
482:     }
483:   } else {
484:     const char *tname;
485:     PetscObjectGetName((PetscObject)viewer, &tname);
486:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot handle that PetscViewer of type %s", tname);
487:   }
488:   return 0;
489: }

491: /*@C
492:     PetscRealView - Prints an array of doubles; useful for debugging.

494:     Collective

496:     Input Parameters:
497: +   N - number of `PetscReal` in array
498: .   idx - array of `PetscReal`
499: -   viewer - location to print array, `PETSC_VIEWER_STDOUT_WORLD`, `PETSC_VIEWER_STDOUT_SELF` or 0

501:   Level: intermediate

503:     Note:
504:     This may be called from within the debugger

506:     Developer Note:
507:     idx cannot be const because may be passed to binary viewer where temporary byte swapping may be done

509: .seealso: `PetscViewer`, `PetscIntView()`
510: @*/
511: PetscErrorCode PetscRealView(PetscInt N, const PetscReal idx[], PetscViewer viewer)
512: {
513:   PetscMPIInt rank, size;
514:   PetscInt    j, i, n = N / 5, p = N % 5;
515:   PetscBool   iascii, isbinary;
516:   MPI_Comm    comm;

518:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
521:   PetscObjectGetComm((PetscObject)viewer, &comm);
522:   MPI_Comm_size(comm, &size);
523:   MPI_Comm_rank(comm, &rank);

525:   PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii);
526:   PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERBINARY, &isbinary);
527:   if (iascii) {
528:     PetscInt tab;

530:     PetscViewerASCIIPushSynchronized(viewer);
531:     PetscViewerASCIIGetTab(viewer, &tab);
532:     for (i = 0; i < n; i++) {
533:       PetscViewerASCIISetTab(viewer, tab);
534:       if (size > 1) {
535:         PetscViewerASCIISynchronizedPrintf(viewer, "[%d] %2" PetscInt_FMT ":", rank, 5 * i);
536:       } else {
537:         PetscViewerASCIISynchronizedPrintf(viewer, "%2" PetscInt_FMT ":", 5 * i);
538:       }
539:       PetscViewerASCIISetTab(viewer, 0);
540:       for (j = 0; j < 5; j++) PetscViewerASCIISynchronizedPrintf(viewer, " %12.4e", (double)idx[i * 5 + j]);
541:       PetscViewerASCIISynchronizedPrintf(viewer, "\n");
542:     }
543:     if (p) {
544:       PetscViewerASCIISetTab(viewer, tab);
545:       if (size > 1) {
546:         PetscViewerASCIISynchronizedPrintf(viewer, "[%d] %2" PetscInt_FMT ":", rank, 5 * n);
547:       } else {
548:         PetscViewerASCIISynchronizedPrintf(viewer, "%2" PetscInt_FMT ":", 5 * n);
549:       }
550:       PetscViewerASCIISetTab(viewer, 0);
551:       for (i = 0; i < p; i++) PetscViewerASCIISynchronizedPrintf(viewer, " %12.4e", (double)idx[5 * n + i]);
552:       PetscViewerASCIISynchronizedPrintf(viewer, "\n");
553:     }
554:     PetscViewerFlush(viewer);
555:     PetscViewerASCIISetTab(viewer, tab);
556:     PetscViewerASCIIPopSynchronized(viewer);
557:   } else if (isbinary) {
558:     PetscMPIInt *sizes, *displs, Ntotal, NN;
559:     PetscReal   *array;

561:     PetscMPIIntCast(N, &NN);

563:     if (size > 1) {
564:       if (rank) {
565:         MPI_Gather(&NN, 1, MPI_INT, NULL, 0, MPI_INT, 0, comm);
566:         MPI_Gatherv((PetscReal *)idx, NN, MPIU_REAL, NULL, NULL, NULL, MPIU_REAL, 0, comm);
567:       } else {
568:         PetscMalloc1(size, &sizes);
569:         MPI_Gather(&NN, 1, MPI_INT, sizes, 1, MPI_INT, 0, comm);
570:         Ntotal = sizes[0];
571:         PetscMalloc1(size, &displs);
572:         displs[0] = 0;
573:         for (i = 1; i < size; i++) {
574:           Ntotal += sizes[i];
575:           displs[i] = displs[i - 1] + sizes[i - 1];
576:         }
577:         PetscMalloc1(Ntotal, &array);
578:         MPI_Gatherv((PetscReal *)idx, NN, MPIU_REAL, array, sizes, displs, MPIU_REAL, 0, comm);
579:         PetscViewerBinaryWrite(viewer, array, Ntotal, PETSC_REAL);
580:         PetscFree(sizes);
581:         PetscFree(displs);
582:         PetscFree(array);
583:       }
584:     } else {
585:       PetscViewerBinaryWrite(viewer, (void *)idx, N, PETSC_REAL);
586:     }
587:   } else {
588:     const char *tname;
589:     PetscObjectGetName((PetscObject)viewer, &tname);
590:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot handle that PetscViewer of type %s", tname);
591:   }
592:   return 0;
593: }

595: /*@C
596:     PetscScalarView - Prints an array of `PetscScalar`; useful for debugging.

598:     Collective

600:     Input Parameters:
601: +   N - number of scalars in array
602: .   idx - array of scalars
603: -   viewer - location to print array, `PETSC_VIEWER_STDOUT_WORLD`, `PETSC_VIEWER_STDOUT_SELF` or 0

605:   Level: intermediate

607:     Note:
608:     This may be called from within the debugger

610:     Developer Note:
611:     idx cannot be const because may be passed to binary viewer where byte swapping may be done

613: .seealso: `PetscViewer`, `PetscIntView()`, `PetscRealView()`
614: @*/
615: PetscErrorCode PetscScalarView(PetscInt N, const PetscScalar idx[], PetscViewer viewer)
616: {
617:   PetscMPIInt rank, size;
618:   PetscInt    j, i, n = N / 3, p = N % 3;
619:   PetscBool   iascii, isbinary;
620:   MPI_Comm    comm;

622:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
625:   PetscObjectGetComm((PetscObject)viewer, &comm);
626:   MPI_Comm_size(comm, &size);
627:   MPI_Comm_rank(comm, &rank);

629:   PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii);
630:   PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERBINARY, &isbinary);
631:   if (iascii) {
632:     PetscViewerASCIIPushSynchronized(viewer);
633:     for (i = 0; i < n; i++) {
634:       if (size > 1) {
635:         PetscViewerASCIISynchronizedPrintf(viewer, "[%d] %2" PetscInt_FMT ":", rank, 3 * i);
636:       } else {
637:         PetscViewerASCIISynchronizedPrintf(viewer, "%2" PetscInt_FMT ":", 3 * i);
638:       }
639:       for (j = 0; j < 3; j++) {
640: #if defined(PETSC_USE_COMPLEX)
641:         PetscViewerASCIISynchronizedPrintf(viewer, " (%12.4e,%12.4e)", (double)PetscRealPart(idx[i * 3 + j]), (double)PetscImaginaryPart(idx[i * 3 + j]));
642: #else
643:         PetscViewerASCIISynchronizedPrintf(viewer, " %12.4e", (double)idx[i * 3 + j]);
644: #endif
645:       }
646:       PetscViewerASCIISynchronizedPrintf(viewer, "\n");
647:     }
648:     if (p) {
649:       if (size > 1) {
650:         PetscViewerASCIISynchronizedPrintf(viewer, "[%d] %2" PetscInt_FMT ":", rank, 3 * n);
651:       } else {
652:         PetscViewerASCIISynchronizedPrintf(viewer, "%2" PetscInt_FMT ":", 3 * n);
653:       }
654:       for (i = 0; i < p; i++) {
655: #if defined(PETSC_USE_COMPLEX)
656:         PetscViewerASCIISynchronizedPrintf(viewer, " (%12.4e,%12.4e)", (double)PetscRealPart(idx[n * 3 + i]), (double)PetscImaginaryPart(idx[n * 3 + i]));
657: #else
658:         PetscViewerASCIISynchronizedPrintf(viewer, " %12.4e", (double)idx[3 * n + i]);
659: #endif
660:       }
661:       PetscViewerASCIISynchronizedPrintf(viewer, "\n");
662:     }
663:     PetscViewerFlush(viewer);
664:     PetscViewerASCIIPopSynchronized(viewer);
665:   } else if (isbinary) {
666:     PetscMPIInt *sizes, Ntotal, *displs, NN;
667:     PetscScalar *array;

669:     PetscMPIIntCast(N, &NN);

671:     if (size > 1) {
672:       if (rank) {
673:         MPI_Gather(&NN, 1, MPI_INT, NULL, 0, MPI_INT, 0, comm);
674:         MPI_Gatherv((void *)idx, NN, MPIU_SCALAR, NULL, NULL, NULL, MPIU_SCALAR, 0, comm);
675:       } else {
676:         PetscMalloc1(size, &sizes);
677:         MPI_Gather(&NN, 1, MPI_INT, sizes, 1, MPI_INT, 0, comm);
678:         Ntotal = sizes[0];
679:         PetscMalloc1(size, &displs);
680:         displs[0] = 0;
681:         for (i = 1; i < size; i++) {
682:           Ntotal += sizes[i];
683:           displs[i] = displs[i - 1] + sizes[i - 1];
684:         }
685:         PetscMalloc1(Ntotal, &array);
686:         MPI_Gatherv((void *)idx, NN, MPIU_SCALAR, array, sizes, displs, MPIU_SCALAR, 0, comm);
687:         PetscViewerBinaryWrite(viewer, array, Ntotal, PETSC_SCALAR);
688:         PetscFree(sizes);
689:         PetscFree(displs);
690:         PetscFree(array);
691:       }
692:     } else {
693:       PetscViewerBinaryWrite(viewer, (void *)idx, N, PETSC_SCALAR);
694:     }
695:   } else {
696:     const char *tname;
697:     PetscObjectGetName((PetscObject)viewer, &tname);
698:     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot handle that PetscViewer of type %s", tname);
699:   }
700:   return 0;
701: }

703: #if defined(PETSC_HAVE_CUDA)
704: #include <petscdevice_cuda.h>
705: PETSC_EXTERN const char *PetscCUBLASGetErrorName(cublasStatus_t status)
706: {
707:   switch (status) {
708:   #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
709:   case CUBLAS_STATUS_SUCCESS:
710:     return "CUBLAS_STATUS_SUCCESS";
711:   case CUBLAS_STATUS_NOT_INITIALIZED:
712:     return "CUBLAS_STATUS_NOT_INITIALIZED";
713:   case CUBLAS_STATUS_ALLOC_FAILED:
714:     return "CUBLAS_STATUS_ALLOC_FAILED";
715:   case CUBLAS_STATUS_INVALID_VALUE:
716:     return "CUBLAS_STATUS_INVALID_VALUE";
717:   case CUBLAS_STATUS_ARCH_MISMATCH:
718:     return "CUBLAS_STATUS_ARCH_MISMATCH";
719:   case CUBLAS_STATUS_MAPPING_ERROR:
720:     return "CUBLAS_STATUS_MAPPING_ERROR";
721:   case CUBLAS_STATUS_EXECUTION_FAILED:
722:     return "CUBLAS_STATUS_EXECUTION_FAILED";
723:   case CUBLAS_STATUS_INTERNAL_ERROR:
724:     return "CUBLAS_STATUS_INTERNAL_ERROR";
725:   case CUBLAS_STATUS_NOT_SUPPORTED:
726:     return "CUBLAS_STATUS_NOT_SUPPORTED";
727:   case CUBLAS_STATUS_LICENSE_ERROR:
728:     return "CUBLAS_STATUS_LICENSE_ERROR";
729:   #endif
730:   default:
731:     return "unknown error";
732:   }
733: }
734: PETSC_EXTERN const char *PetscCUSolverGetErrorName(cusolverStatus_t status)
735: {
736:   switch (status) {
737:   #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
738:   case CUSOLVER_STATUS_SUCCESS:
739:     return "CUSOLVER_STATUS_SUCCESS";
740:   case CUSOLVER_STATUS_NOT_INITIALIZED:
741:     return "CUSOLVER_STATUS_NOT_INITIALIZED";
742:   case CUSOLVER_STATUS_INVALID_VALUE:
743:     return "CUSOLVER_STATUS_INVALID_VALUE";
744:   case CUSOLVER_STATUS_ARCH_MISMATCH:
745:     return "CUSOLVER_STATUS_ARCH_MISMATCH";
746:   case CUSOLVER_STATUS_INTERNAL_ERROR:
747:     return "CUSOLVER_STATUS_INTERNAL_ERROR";
748:     #if (CUDART_VERSION >= 9000) /* CUDA 9.0 had these defined on June 2021 */
749:   case CUSOLVER_STATUS_ALLOC_FAILED:
750:     return "CUSOLVER_STATUS_ALLOC_FAILED";
751:   case CUSOLVER_STATUS_MAPPING_ERROR:
752:     return "CUSOLVER_STATUS_MAPPING_ERROR";
753:   case CUSOLVER_STATUS_EXECUTION_FAILED:
754:     return "CUSOLVER_STATUS_EXECUTION_FAILED";
755:   case CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED:
756:     return "CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED";
757:   case CUSOLVER_STATUS_NOT_SUPPORTED:
758:     return "CUSOLVER_STATUS_NOT_SUPPORTED ";
759:   case CUSOLVER_STATUS_ZERO_PIVOT:
760:     return "CUSOLVER_STATUS_ZERO_PIVOT";
761:   case CUSOLVER_STATUS_INVALID_LICENSE:
762:     return "CUSOLVER_STATUS_INVALID_LICENSE";
763:     #endif
764:   #endif
765:   default:
766:     return "unknown error";
767:   }
768: }
769: PETSC_EXTERN const char *PetscCUFFTGetErrorName(cufftResult result)
770: {
771:   switch (result) {
772:   case CUFFT_SUCCESS:
773:     return "CUFFT_SUCCESS";
774:   case CUFFT_INVALID_PLAN:
775:     return "CUFFT_INVALID_PLAN";
776:   case CUFFT_ALLOC_FAILED:
777:     return "CUFFT_ALLOC_FAILED";
778:   case CUFFT_INVALID_TYPE:
779:     return "CUFFT_INVALID_TYPE";
780:   case CUFFT_INVALID_VALUE:
781:     return "CUFFT_INVALID_VALUE";
782:   case CUFFT_INTERNAL_ERROR:
783:     return "CUFFT_INTERNAL_ERROR";
784:   case CUFFT_EXEC_FAILED:
785:     return "CUFFT_EXEC_FAILED";
786:   case CUFFT_SETUP_FAILED:
787:     return "CUFFT_SETUP_FAILED";
788:   case CUFFT_INVALID_SIZE:
789:     return "CUFFT_INVALID_SIZE";
790:   case CUFFT_UNALIGNED_DATA:
791:     return "CUFFT_UNALIGNED_DATA";
792:   case CUFFT_INCOMPLETE_PARAMETER_LIST:
793:     return "CUFFT_INCOMPLETE_PARAMETER_LIST";
794:   case CUFFT_INVALID_DEVICE:
795:     return "CUFFT_INVALID_DEVICE";
796:   case CUFFT_PARSE_ERROR:
797:     return "CUFFT_PARSE_ERROR";
798:   case CUFFT_NO_WORKSPACE:
799:     return "CUFFT_NO_WORKSPACE";
800:   case CUFFT_NOT_IMPLEMENTED:
801:     return "CUFFT_NOT_IMPLEMENTED";
802:   case CUFFT_LICENSE_ERROR:
803:     return "CUFFT_LICENSE_ERROR";
804:   case CUFFT_NOT_SUPPORTED:
805:     return "CUFFT_NOT_SUPPORTED";
806:   default:
807:     return "unknown error";
808:   }
809: }
810: #endif

812: #if defined(PETSC_HAVE_HIP)
813: #include <petscdevice_hip.h>
814: PETSC_EXTERN const char *PetscHIPBLASGetErrorName(hipblasStatus_t status)
815: {
816:   switch (status) {
817:   case HIPBLAS_STATUS_SUCCESS:
818:     return "HIPBLAS_STATUS_SUCCESS";
819:   case HIPBLAS_STATUS_NOT_INITIALIZED:
820:     return "HIPBLAS_STATUS_NOT_INITIALIZED";
821:   case HIPBLAS_STATUS_ALLOC_FAILED:
822:     return "HIPBLAS_STATUS_ALLOC_FAILED";
823:   case HIPBLAS_STATUS_INVALID_VALUE:
824:     return "HIPBLAS_STATUS_INVALID_VALUE";
825:   case HIPBLAS_STATUS_ARCH_MISMATCH:
826:     return "HIPBLAS_STATUS_ARCH_MISMATCH";
827:   case HIPBLAS_STATUS_MAPPING_ERROR:
828:     return "HIPBLAS_STATUS_MAPPING_ERROR";
829:   case HIPBLAS_STATUS_EXECUTION_FAILED:
830:     return "HIPBLAS_STATUS_EXECUTION_FAILED";
831:   case HIPBLAS_STATUS_INTERNAL_ERROR:
832:     return "HIPBLAS_STATUS_INTERNAL_ERROR";
833:   case HIPBLAS_STATUS_NOT_SUPPORTED:
834:     return "HIPBLAS_STATUS_NOT_SUPPORTED";
835:   default:
836:     return "unknown error";
837:   }
838: }
839: PETSC_EXTERN const char *PetscHIPSPARSEGetErrorName(hipsparseStatus_t status)
840: {
841:   switch (status) {
842:   case HIPSPARSE_STATUS_SUCCESS:
843:     return "HIPSPARSE_STATUS_SUCCESS";
844:   case HIPSPARSE_STATUS_NOT_INITIALIZED:
845:     return "HIPSPARSE_STATUS_NOT_INITIALIZED";
846:   case HIPSPARSE_STATUS_ALLOC_FAILED:
847:     return "HIPSPARSE_STATUS_ALLOC_FAILED";
848:   case HIPSPARSE_STATUS_INVALID_VALUE:
849:     return "HIPSPARSE_STATUS_INVALID_VALUE";
850:   case HIPSPARSE_STATUS_ARCH_MISMATCH:
851:     return "HIPSPARSE_STATUS_ARCH_MISMATCH";
852:   case HIPSPARSE_STATUS_MAPPING_ERROR:
853:     return "HIPSPARSE_STATUS_MAPPING_ERROR";
854:   case HIPSPARSE_STATUS_EXECUTION_FAILED:
855:     return "HIPSPARSE_STATUS_EXECUTION_FAILED";
856:   case HIPSPARSE_STATUS_INTERNAL_ERROR:
857:     return "HIPSPARSE_STATUS_INTERNAL_ERROR";
858:   case HIPSPARSE_STATUS_MATRIX_TYPE_NOT_SUPPORTED:
859:     return "HIPSPARSE_STATUS_MATRIX_TYPE_NOT_SUPPORTED";
860:   case HIPSPARSE_STATUS_ZERO_PIVOT:
861:     return "HIPSPARSE_STATUS_ZERO_PIVOT";
862:   case HIPSPARSE_STATUS_NOT_SUPPORTED:
863:     return "HIPSPARSE_STATUS_NOT_SUPPORTED";
864:   case HIPSPARSE_STATUS_INSUFFICIENT_RESOURCES:
865:     return "HIPSPARSE_STATUS_INSUFFICIENT_RESOURCES";
866:   default:
867:     return "unknown error";
868:   }
869: }
870: PETSC_EXTERN const char *PetscHIPSolverGetErrorName(hipsolverStatus_t status)
871: {
872:   switch (status) {
873:   case HIPSOLVER_STATUS_SUCCESS:
874:     return "HIPSOLVER_STATUS_SUCCESS";
875:   case HIPSOLVER_STATUS_NOT_INITIALIZED:
876:     return "HIPSOLVER_STATUS_NOT_INITIALIZED";
877:   case HIPSOLVER_STATUS_ALLOC_FAILED:
878:     return "HIPSOLVER_STATUS_ALLOC_FAILED";
879:   case HIPSOLVER_STATUS_MAPPING_ERROR:
880:     return "HIPSOLVER_STATUS_MAPPING_ERROR";
881:   case HIPSOLVER_STATUS_INVALID_VALUE:
882:     return "HIPSOLVER_STATUS_INVALID_VALUE";
883:   case HIPSOLVER_STATUS_EXECUTION_FAILED:
884:     return "HIPSOLVER_STATUS_EXECUTION_FAILED";
885:   case HIPSOLVER_STATUS_INTERNAL_ERROR:
886:     return "HIPSOLVER_STATUS_INTERNAL_ERROR";
887:   case HIPSOLVER_STATUS_NOT_SUPPORTED:
888:     return "HIPSOLVER_STATUS_NOT_SUPPORTED ";
889:   case HIPSOLVER_STATUS_ARCH_MISMATCH:
890:     return "HIPSOLVER_STATUS_ARCH_MISMATCH";
891:   case HIPSOLVER_STATUS_HANDLE_IS_NULLPTR:
892:     return "HIPSOLVER_STATUS_HANDLE_IS_NULLPTR";
893:   case HIPSOLVER_STATUS_INVALID_ENUM:
894:     return "HIPSOLVER_STATUS_INVALID_ENUM";
895:   case HIPSOLVER_STATUS_UNKNOWN:
896:   default:
897:     return "HIPSOLVER_STATUS_UNKNOWN";
898:   }
899: }
900: #endif

902: /*@
903:       PetscMPIErrorString - Given an MPI error code returns the `MPI_Error_string()` appropriately
904:            formatted for displaying with the PETSc error handlers.

906:  Input Parameter:
907: .  err - the MPI error code

909:  Output Parameter:
910: .  string - the MPI error message, should declare its length to be larger than `MPI_MAX_ERROR_STRING`

912:    Level: developer

914:  Note:
915:     Does not return an error code or do error handling because it may be called from inside an error handler

917: @*/
918: void PetscMPIErrorString(PetscMPIInt err, char *string)
919: {
920:   char        errorstring[MPI_MAX_ERROR_STRING];
921:   PetscMPIInt len, j = 0;

923:   MPI_Error_string(err, (char *)errorstring, &len);
924:   for (PetscMPIInt i = 0; i < len; i++) {
925:     string[j++] = errorstring[i];
926:     if (errorstring[i] == '\n') {
927:       for (PetscMPIInt k = 0; k < 16; k++) string[j++] = ' ';
928:     }
929:   }
930:   string[j] = 0;
931: }