Actual source code: err.c


  2: /*
  3:       Code that allows one to set the error handlers
  4: */
  5: #include <petsc/private/petscimpl.h>
  6: #include <petscviewer.h>

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

 15: static EH eh = NULL;

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

 21:    Not Collective

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

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

 35:    Level: developer

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

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

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

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

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

 80:    Not Collective

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

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

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

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

102:    Level: intermediate

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

108:    Fortran Note:
109:     You can only push one error handler from Fortran before poping it.

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

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

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

130:    Not Collective

132:    Level: intermediate

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

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

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

150:    Not Collective

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

161:    Level: developer

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

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

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

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

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

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

236:    Not Collective

238:    Input Parameter:
239: .   errnum - the error code

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

245:    Level: developer

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

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

260:   if (specific) *specific = PetscErrorBaseMessage;
261:   return 0;
262: }

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

288:   throw std::runtime_error(str);
289: }
290: #endif

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

295:   Collective

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

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

310:   Level: intermediate

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

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

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

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

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

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

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

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

354:   if (!PetscErrorHandlingInitialized) return n;
355:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

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

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

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

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

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

391: /* -------------------------------------------------------------------------*/

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

396:     Collective on viewer

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

403:   Level: intermediate

405:     Note:
406:     This may be called from within the debugger

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

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

420:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
423:   PetscObjectGetComm((PetscObject)viewer, &comm);
424:   MPI_Comm_size(comm, &size);
425:   MPI_Comm_rank(comm, &rank);

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

455:     PetscMPIIntCast(N, &NN);

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

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

492:     Collective on viewer

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

499:   Level: intermediate

501:     Note:
502:     This may be called from within the debugger

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

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

516:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
519:   PetscObjectGetComm((PetscObject)viewer, &comm);
520:   MPI_Comm_size(comm, &size);
521:   MPI_Comm_rank(comm, &rank);

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

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

559:     PetscMPIIntCast(N, &NN);

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

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

596:     Collective on viewer

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

603:   Level: intermediate

605:     Note:
606:     This may be called from within the debugger

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

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

620:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
623:   PetscObjectGetComm((PetscObject)viewer, &comm);
624:   MPI_Comm_size(comm, &size);
625:   MPI_Comm_rank(comm, &rank);

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

667:     PetscMPIIntCast(N, &NN);

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

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

810: #if defined(PETSC_HAVE_HIP)
811: #include <petscdevice_hip.h>
812: PETSC_EXTERN const char *PetscHIPBLASGetErrorName(hipblasStatus_t status)
813: {
814:   switch (status) {
815:   case HIPBLAS_STATUS_SUCCESS:
816:     return "HIPBLAS_STATUS_SUCCESS";
817:   case HIPBLAS_STATUS_NOT_INITIALIZED:
818:     return "HIPBLAS_STATUS_NOT_INITIALIZED";
819:   case HIPBLAS_STATUS_ALLOC_FAILED:
820:     return "HIPBLAS_STATUS_ALLOC_FAILED";
821:   case HIPBLAS_STATUS_INVALID_VALUE:
822:     return "HIPBLAS_STATUS_INVALID_VALUE";
823:   case HIPBLAS_STATUS_ARCH_MISMATCH:
824:     return "HIPBLAS_STATUS_ARCH_MISMATCH";
825:   case HIPBLAS_STATUS_MAPPING_ERROR:
826:     return "HIPBLAS_STATUS_MAPPING_ERROR";
827:   case HIPBLAS_STATUS_EXECUTION_FAILED:
828:     return "HIPBLAS_STATUS_EXECUTION_FAILED";
829:   case HIPBLAS_STATUS_INTERNAL_ERROR:
830:     return "HIPBLAS_STATUS_INTERNAL_ERROR";
831:   case HIPBLAS_STATUS_NOT_SUPPORTED:
832:     return "HIPBLAS_STATUS_NOT_SUPPORTED";
833:   default:
834:     return "unknown error";
835:   }
836: }
837: #endif

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

843:  Input Parameter:
844: .  err - the MPI error code

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

849:    Level: developer

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

854: @*/
855: void PetscMPIErrorString(PetscMPIInt err, char *string)
856: {
857:   char        errorstring[MPI_MAX_ERROR_STRING];
858:   PetscMPIInt len, j = 0;

860:   MPI_Error_string(err, (char *)errorstring, &len);
861:   for (PetscMPIInt i = 0; i < len; i++) {
862:     string[j++] = errorstring[i];
863:     if (errorstring[i] == '\n') {
864:       for (PetscMPIInt k = 0; k < 16; k++) string[j++] = ' ';
865:     }
866:   }
867:   string[j] = 0;
868: }