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: /* 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: };

 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[PETSC_MAX_PATH_LEN];

 35:   PetscStackView(stderr);if (ierr) return ierr;
 36:   *idx = 1;
 37:   for (i=2; i<n; i++) {
 38:     PetscFixFilename(PetscAbortSourceFiles[i],subpath);if (ierr) return ierr;
 39:     PetscStrendswith(filepath,subpath,&match);if (ierr) return ierr;
 40:     if (match) {*idx = i; break;}
 41:   }
 42:   return 0;
 43: }

 45: typedef struct _EH *EH;
 46: struct _EH {
 47:   PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
 48:   void           *ctx;
 49:   EH             previous;
 50: };

 52: static EH eh = NULL;

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

 58:    Not Collective

 60:    Input Parameters:
 61: +  comm - communicator over which error occurred
 62: .  line - the line number of the error (indicated by __LINE__)
 63: .  file - the file in which the error was detected (indicated by __FILE__)
 64: .  mess - an error text string, usually just printed to the screen
 65: .  n - the generic error number
 66: .  p - specific error number
 67: -  ctx - error handler context

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

 72:    Level: developer

 74:    Notes:
 75:    You must put (server-start) in your .emacs file for the emacsclient software to work

 77:    Developer Note:
 78:    Since this is an error handler it cannot call ; thus we just return if an error is detected.

 80: .seealso: PetscError(), PetscPushErrorHandler(), PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(),
 81:           PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscReturnErrorHandler()
 82:  @*/
 83: PetscErrorCode  PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
 84: {
 86:   char           command[PETSC_MAX_PATH_LEN];
 87:   const char     *pdir;
 88:   FILE           *fp;

 90:   PetscGetPetscDir(&pdir);if (ierr) return ierr;
 91:   sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
 92: #if defined(PETSC_HAVE_POPEN)
 93:   PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) return ierr;
 94:   PetscPClose(MPI_COMM_WORLD,fp);if (ierr) return ierr;
 95: #else
 96:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
 97: #endif
 98:   PetscPopErrorHandler();if (ierr) return ierr; /* remove this handler from the stack of handlers */
 99:   if (!eh) {
100:     PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,NULL);if (ierr) return ierr;
101:   } else {
102:     (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) return ierr;
103:   }
104:   return ierr;
105: }

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

110:    Not Collective

112:    Input Parameters:
113: +  handler - error handler routine
114: -  ctx - optional handler context that contains information needed by the handler (for
115:          example file pointers for error messages etc.)

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

120: +  comm - communicator over which error occurred
121: .  line - the line number of the error (indicated by __LINE__)
122: .  file - the file in which the error was detected (indicated by __FILE__)
123: .  n - the generic error number (see list defined in include/petscerror.h)
124: .  p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
125: .  mess - an error text string, usually just printed to the screen
126: -  ctx - the error handler context

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

132:    Level: intermediate

134:    Notes:
135:    The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
136:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

138:    Fortran Notes:
139:     You can only push one error handler from Fortran before poping it.

141: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler(), PetscPushSignalHandler()

143: @*/
144: PetscErrorCode  PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
145: {
146:   EH             neweh;

148:   PetscNew(&neweh);
149:   if (eh) neweh->previous = eh;
150:   else    neweh->previous = NULL;
151:   neweh->handler = handler;
152:   neweh->ctx     = ctx;
153:   eh             = neweh;
154:   return 0;
155: }

157: /*@
158:    PetscPopErrorHandler - Removes the latest error handler that was
159:    pushed with PetscPushErrorHandler().

161:    Not Collective

163:    Level: intermediate

165: .seealso: PetscPushErrorHandler()
166: @*/
167: PetscErrorCode  PetscPopErrorHandler(void)
168: {
169:   EH             tmp;

171:   if (!eh) return 0;
172:   tmp  = eh;
173:   eh   = eh->previous;
174:   PetscFree(tmp);
175:   return 0;
176: }

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

181:    Not Collective

183:    Input Parameters:
184: +  comm - communicator over which error occurred
185: .  line - the line number of the error (indicated by __LINE__)
186: .  file - the file in which the error was detected (indicated by __FILE__)
187: .  mess - an error text string, usually just printed to the screen
188: .  n - the generic error number
189: .  p - specific error number
190: -  ctx - error handler context

192:    Level: developer

194:    Notes:
195:    Most users need not directly employ this routine and the other error
196:    handlers, but can instead use the simplified interface SETERRQ, which has
197:    the calling sequence
198: $     SETERRQ(comm,number,mess)

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

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

204: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler(), PetscError(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(),
205:            PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler()
206:  @*/
207: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
208: {
209:   return n;
210: }

212: static char PetscErrorBaseMessage[1024];
213: /*
214:        The numerical values for these are defined in include/petscerror.h; any changes
215:    there must also be made here
216: */
217: static const char *PetscErrorStrings[] = {
218:   /*55 */ "Out of memory",
219:           "No support for this operation for this object type",
220:           "No support for this operation on this system",
221:   /*58 */ "Operation done in wrong order",
222:   /*59 */ "Signal received",
223:   /*60 */ "Nonconforming object sizes",
224:           "Argument aliasing not permitted",
225:           "Invalid argument",
226:   /*63 */ "Argument out of range",
227:           "Corrupt argument: https://petsc.org/release/faq/#valgrind",
228:           "Unable to open file",
229:           "Read from file failed",
230:           "Write to file failed",
231:           "Invalid pointer",
232:   /*69 */ "Arguments must have same type",
233:   /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
234:   /*71 */ "Zero pivot in LU factorization: https://petsc.org/release/faq/#zeropivot",
235:   /*72 */ "Floating point exception",
236:   /*73 */ "Object is in wrong state",
237:           "Corrupted Petsc object",
238:           "Arguments are incompatible",
239:           "Error in external library",
240:   /*77 */ "Petsc has generated inconsistent data",
241:           "Memory corruption: https://petsc.org/release/faq/#valgrind",
242:           "Unexpected data in file",
243:   /*80 */ "Arguments must have same communicators",
244:   /*81 */ "Zero pivot in Cholesky factorization: https://petsc.org/release/faq/#zeropivot",
245:           "  ",
246:           "  ",
247:           "Overflow in integer operation: https://petsc.org/release/faq/#64-bit-indices",
248:   /*85 */ "Null argument, when expecting valid pointer",
249:   /*86 */ "Unknown type. Check for miss-spelling or missing package: https://petsc.org/release/install/install/#external-packages",
250:   /*87 */ "MPI library at runtime is not compatible with MPI used at compile time",
251:   /*88 */ "Error in system call",
252:   /*89 */ "Object Type not set: https://petsc.org/release/faq/#object-type-not-set",
253:   /*90 */ "  ",
254:   /*   */ "  ",
255:   /*92 */ "See https://petsc.org/release/overview/linear_solve_table/ for possible LU and Cholesky solvers",
256:   /*93 */ "You cannot overwrite this option since that will conflict with other previously set options",
257:   /*94 */ "Example/application run with number of MPI ranks it does not support",
258:   /*95 */ "Missing or incorrect user input ",
259:   /*96 */ "GPU resources unavailable ",
260:   /*97 */ "GPU error ",
261:   /*98 */ "General MPI error "
262: };

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

267:    Not Collective

269:    Input Parameter:
270: .   errnum - the error code

272:    Output Parameters:
273: +  text - the error message (NULL if not desired)
274: -  specific - the specific error message that was set with SETERRxxx() or PetscError().  (NULL if not desired)

276:    Level: developer

278: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), PetscCall()
279:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
280:  @*/
281: PetscErrorCode  PetscErrorMessage(int errnum,const char *text[],char **specific)
282: {
283:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
284:   else if (text) *text = NULL;

286:   if (specific) *specific = PetscErrorBaseMessage;
287:   return 0;
288: }

290: #if defined(PETSC_CLANGUAGE_CXX)
291: /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
292:  * would be broken if implementations did not handle it it some common cases. However, keep in mind
293:  *
294:  *   Rule 62. Don't allow exceptions to propagate across module boundaries
295:  *
296:  * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
297:  * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
298:  *
299:  * Here is the problem: You have a C++ function call a PETSc function, and you would like to maintain the error message
300:  * and stack information from the PETSc error. You could make everyone write exactly this code in their C++, but that
301:  * seems crazy to me.
302:  */
303: #include <sstream>
304: #include <stdexcept>
305: static void PetscCxxErrorThrow()
306: {
307:   const char *str;
308:   if (eh && eh->ctx) {
309:     std::ostringstream *msg;
310:     msg = (std::ostringstream*) eh->ctx;
311:     str = msg->str().c_str();
312:   } else str = "Error detected in C PETSc";

314:   throw std::runtime_error(str);
315: }
316: #endif

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

321:   Collective on comm

323:    Input Parameters:
324: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
325: .  line - the line number of the error (indicated by __LINE__)
326: .  func - the function name in which the error was detected
327: .  file - the file in which the error was detected (indicated by __FILE__)
328: .  n - the generic error number
329: .  p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
330: -  mess - formatted message string - aka printf

332:   Options Database:
333: +  -error_output_stdout - output the error messages to stdout instead of the default stderr
334: -  -error_output_none - do not output the error messages

336:   Level: intermediate

338:    Notes:
339:    PETSc error handling is done with error return codes. A non-zero return indicates an error was detected. Errors are generally not something that the code
340:    can recover from. Note that numerical errors (potential divide by zero, for example) are not managed by the error return codes; they are managed via, for example,
341:    KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into
342:    hard errors managed via PetscError().

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

346:    Most users need not directly use this routine and the error handlers, but
347:    can instead use the simplified interface SETERRQ, which has the calling
348:    sequence
349: $     SETERRQ(comm,n,mess)

351:    Fortran Note:
352:    This routine is used differently from Fortran
353: $    PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)

355:    Set the error handler with PetscPushErrorHandler().

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

361: .seealso: PetscErrorCode, PetscPushErrorHandler(), PetscPopErrorHandler(), PetscTraceBackErrorHandler(),  PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(),
362:           PetscReturnErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler(),
363:           SETERRQ(), PetscCall(), CHKMEMQ, SETERRQ(), SETERRQ(), PetscErrorMessage(), PETSCABORT()
364: @*/
365: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
366: {
367:   va_list        Argp;
368:   size_t         fullLength;
369:   char           buf[2048],*lbuf = NULL;
370:   PetscBool      ismain;

373:   if (!PetscErrorHandlingInitialized) return n;
374:   if (!func) func = "User provided function";
375:   if (!file) file = "User file";
376:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

378:   /* Compose the message evaluating the print format */
379:   if (mess) {
380:     va_start(Argp,mess);
381:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
382:     va_end(Argp);
383:     lbuf = buf;
384:     if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
385:   }

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

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

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

397:     Does not call PETSCABORT() since that would provide the wrong source file and line number information
398:   */
399:   PetscStrncmp(func,"main",4,&ismain);
400:   if (ismain) {
401:     PetscMPIInt errcode;
402:     errcode = (PetscMPIInt)(0 + 0*line*1000 + ierr);
403:     if (petscwaitonerrorflg) { PetscSleep(1000); }
404:     MPI_Abort(MPI_COMM_WORLD,errcode);
405:   }

407: #if defined(PETSC_CLANGUAGE_CXX)
408:   if (p == PETSC_ERROR_IN_CXX) {
409:     PetscCxxErrorThrow();
410:   }
411: #endif
412:   return ierr;
413: }

415: /* -------------------------------------------------------------------------*/

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

420:     Collective on PetscViewer

422:     Input Parameters:
423: +   N - number of integers in array
424: .   idx - array of integers
425: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

427:   Level: intermediate

429:     Developer Notes:
430:     idx cannot be const because may be passed to binary viewer where byte swapping is done

432: .seealso: PetscRealView()
433: @*/
434: PetscErrorCode  PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
435: {
436:   PetscMPIInt    rank,size;
437:   PetscInt       j,i,n = N/20,p = N % 20;
438:   PetscBool      iascii,isbinary;
439:   MPI_Comm       comm;

441:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
444:   PetscObjectGetComm((PetscObject)viewer,&comm);
445:   MPI_Comm_size(comm,&size);
446:   MPI_Comm_rank(comm,&rank);

448:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
449:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
450:   if (iascii) {
451:     PetscViewerASCIIPushSynchronized(viewer);
452:     for (i=0; i<n; i++) {
453:       if (size > 1) {
454:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":", rank, 20*i);
455:       } else {
456:         PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*i);
457:       }
458:       for (j=0; j<20; j++) {
459:         PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[i*20+j]);
460:       }
461:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
462:     }
463:     if (p) {
464:       if (size > 1) {
465:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %" PetscInt_FMT ":",rank ,20*n);
466:       } else {
467:         PetscViewerASCIISynchronizedPrintf(viewer,"%" PetscInt_FMT ":",20*n);
468:       }
469:       for (i=0; i<p; i++) PetscViewerASCIISynchronizedPrintf(viewer," %" PetscInt_FMT,idx[20*n+i]);
470:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
471:     }
472:     PetscViewerFlush(viewer);
473:     PetscViewerASCIIPopSynchronized(viewer);
474:   } else if (isbinary) {
475:     PetscMPIInt *sizes,Ntotal,*displs,NN;
476:     PetscInt    *array;

478:     PetscMPIIntCast(N,&NN);

480:     if (size > 1) {
481:       if (rank) {
482:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
483:         MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm);
484:       } else {
485:         PetscMalloc1(size,&sizes);
486:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
487:         Ntotal    = sizes[0];
488:         PetscMalloc1(size,&displs);
489:         displs[0] = 0;
490:         for (i=1; i<size; i++) {
491:           Ntotal   += sizes[i];
492:           displs[i] =  displs[i-1] + sizes[i-1];
493:         }
494:         PetscMalloc1(Ntotal,&array);
495:         MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
496:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT);
497:         PetscFree(sizes);
498:         PetscFree(displs);
499:         PetscFree(array);
500:       }
501:     } else {
502:       PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT);
503:     }
504:   } else {
505:     const char *tname;
506:     PetscObjectGetName((PetscObject)viewer,&tname);
507:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
508:   }
509:   return 0;
510: }

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

515:     Collective on PetscViewer

517:     Input Parameters:
518: +   N - number of PetscReal in array
519: .   idx - array of PetscReal
520: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

522:   Level: intermediate

524:     Developer Notes:
525:     idx cannot be const because may be passed to binary viewer where byte swapping is done

527: .seealso: PetscIntView()
528: @*/
529: PetscErrorCode  PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
530: {
531:   PetscMPIInt    rank,size;
532:   PetscInt       j,i,n = N/5,p = N % 5;
533:   PetscBool      iascii,isbinary;
534:   MPI_Comm       comm;

536:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
539:   PetscObjectGetComm((PetscObject)viewer,&comm);
540:   MPI_Comm_size(comm,&size);
541:   MPI_Comm_rank(comm,&rank);

543:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
544:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
545:   if (iascii) {
546:     PetscInt tab;

548:     PetscViewerASCIIPushSynchronized(viewer);
549:     PetscViewerASCIIGetTab(viewer, &tab);
550:     for (i=0; i<n; i++) {
551:       PetscViewerASCIISetTab(viewer, tab);
552:       if (size > 1) {
553:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*i);
554:       } else {
555:         PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*i);
556:       }
557:       PetscViewerASCIISetTab(viewer, 0);
558:       for (j=0; j<5; j++) {
559:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
560:       }
561:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
562:     }
563:     if (p) {
564:       PetscViewerASCIISetTab(viewer, tab);
565:       if (size > 1) {
566:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,5*n);
567:       } else {
568:         PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",5*n);
569:       }
570:       PetscViewerASCIISetTab(viewer, 0);
571:       for (i=0; i<p; i++) PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);
572:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
573:     }
574:     PetscViewerFlush(viewer);
575:     PetscViewerASCIISetTab(viewer, tab);
576:     PetscViewerASCIIPopSynchronized(viewer);
577:   } else if (isbinary) {
578:     PetscMPIInt *sizes,*displs, Ntotal,NN;
579:     PetscReal   *array;

581:     PetscMPIIntCast(N,&NN);

583:     if (size > 1) {
584:       if (rank) {
585:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
586:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm);
587:       } else {
588:         PetscMalloc1(size,&sizes);
589:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
590:         Ntotal    = sizes[0];
591:         PetscMalloc1(size,&displs);
592:         displs[0] = 0;
593:         for (i=1; i<size; i++) {
594:           Ntotal   += sizes[i];
595:           displs[i] =  displs[i-1] + sizes[i-1];
596:         }
597:         PetscMalloc1(Ntotal,&array);
598:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
599:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL);
600:         PetscFree(sizes);
601:         PetscFree(displs);
602:         PetscFree(array);
603:       }
604:     } else {
605:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL);
606:     }
607:   } else {
608:     const char *tname;
609:     PetscObjectGetName((PetscObject)viewer,&tname);
610:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
611:   }
612:   return 0;
613: }

615: /*@C
616:     PetscScalarView - Prints an array of scalars; useful for debugging.

618:     Collective on PetscViewer

620:     Input Parameters:
621: +   N - number of scalars in array
622: .   idx - array of scalars
623: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

625:   Level: intermediate

627:     Developer Notes:
628:     idx cannot be const because may be passed to binary viewer where byte swapping is done

630: .seealso: PetscIntView(), PetscRealView()
631: @*/
632: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
633: {
634:   PetscMPIInt    rank,size;
635:   PetscInt       j,i,n = N/3,p = N % 3;
636:   PetscBool      iascii,isbinary;
637:   MPI_Comm       comm;

639:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
642:   PetscObjectGetComm((PetscObject)viewer,&comm);
643:   MPI_Comm_size(comm,&size);
644:   MPI_Comm_rank(comm,&rank);

646:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
647:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
648:   if (iascii) {
649:     PetscViewerASCIIPushSynchronized(viewer);
650:     for (i=0; i<n; i++) {
651:       if (size > 1) {
652:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*i);
653:       } else {
654:         PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*i);
655:       }
656:       for (j=0; j<3; j++) {
657: #if defined(PETSC_USE_COMPLEX)
658:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
659: #else
660:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
661: #endif
662:       }
663:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
664:     }
665:     if (p) {
666:       if (size > 1) {
667:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2" PetscInt_FMT ":",rank ,3*n);
668:       } else {
669:         PetscViewerASCIISynchronizedPrintf(viewer,"%2" PetscInt_FMT ":",3*n);
670:       }
671:       for (i=0; i<p; i++) {
672: #if defined(PETSC_USE_COMPLEX)
673:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
674: #else
675:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
676: #endif
677:       }
678:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
679:     }
680:     PetscViewerFlush(viewer);
681:     PetscViewerASCIIPopSynchronized(viewer);
682:   } else if (isbinary) {
683:     PetscMPIInt *sizes,Ntotal,*displs,NN;
684:     PetscScalar *array;

686:     PetscMPIIntCast(N,&NN);

688:     if (size > 1) {
689:       if (rank) {
690:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
691:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm);
692:       } else {
693:         PetscMalloc1(size,&sizes);
694:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
695:         Ntotal    = sizes[0];
696:         PetscMalloc1(size,&displs);
697:         displs[0] = 0;
698:         for (i=1; i<size; i++) {
699:           Ntotal   += sizes[i];
700:           displs[i] =  displs[i-1] + sizes[i-1];
701:         }
702:         PetscMalloc1(Ntotal,&array);
703:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
704:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR);
705:         PetscFree(sizes);
706:         PetscFree(displs);
707:         PetscFree(array);
708:       }
709:     } else {
710:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR);
711:     }
712:   } else {
713:     const char *tname;
714:     PetscObjectGetName((PetscObject)viewer,&tname);
715:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
716:   }
717:   return 0;
718: }

720: #if defined(PETSC_HAVE_CUDA)
721: #include <petscdevice.h>
722: PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status)
723: {
724:   switch(status) {
725: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
726:     case CUBLAS_STATUS_SUCCESS:          return "CUBLAS_STATUS_SUCCESS";
727:     case CUBLAS_STATUS_NOT_INITIALIZED:  return "CUBLAS_STATUS_NOT_INITIALIZED";
728:     case CUBLAS_STATUS_ALLOC_FAILED:     return "CUBLAS_STATUS_ALLOC_FAILED";
729:     case CUBLAS_STATUS_INVALID_VALUE:    return "CUBLAS_STATUS_INVALID_VALUE";
730:     case CUBLAS_STATUS_ARCH_MISMATCH:    return "CUBLAS_STATUS_ARCH_MISMATCH";
731:     case CUBLAS_STATUS_MAPPING_ERROR:    return "CUBLAS_STATUS_MAPPING_ERROR";
732:     case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED";
733:     case CUBLAS_STATUS_INTERNAL_ERROR:   return "CUBLAS_STATUS_INTERNAL_ERROR";
734:     case CUBLAS_STATUS_NOT_SUPPORTED:    return "CUBLAS_STATUS_NOT_SUPPORTED";
735:     case CUBLAS_STATUS_LICENSE_ERROR:    return "CUBLAS_STATUS_LICENSE_ERROR";
736: #endif
737:     default:                             return "unknown error";
738:   }
739: }
740: PETSC_EXTERN const char* PetscCUSolverGetErrorName(cusolverStatus_t status)
741: {
742:   switch(status) {
743: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
744:     case CUSOLVER_STATUS_SUCCESS:          return "CUSOLVER_STATUS_SUCCESS";
745:     case CUSOLVER_STATUS_NOT_INITIALIZED:  return "CUSOLVER_STATUS_NOT_INITIALIZED";
746:     case CUSOLVER_STATUS_INVALID_VALUE:    return "CUSOLVER_STATUS_INVALID_VALUE";
747:     case CUSOLVER_STATUS_ARCH_MISMATCH:    return "CUSOLVER_STATUS_ARCH_MISMATCH";
748:     case CUSOLVER_STATUS_INTERNAL_ERROR:   return "CUSOLVER_STATUS_INTERNAL_ERROR";
749: #if (CUDART_VERSION >= 9000) /* CUDA 9.0 had these defined on June 2021 */
750:     case CUSOLVER_STATUS_ALLOC_FAILED:     return "CUSOLVER_STATUS_ALLOC_FAILED";
751:     case CUSOLVER_STATUS_MAPPING_ERROR:    return "CUSOLVER_STATUS_MAPPING_ERROR";
752:     case CUSOLVER_STATUS_EXECUTION_FAILED: return "CUSOLVER_STATUS_EXECUTION_FAILED";
753:     case CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED: return "CUSOLVER_STATUS_MATRIX_TYPE_NOT_SUPPORTED";
754:     case CUSOLVER_STATUS_NOT_SUPPORTED :  return "CUSOLVER_STATUS_NOT_SUPPORTED ";
755:     case CUSOLVER_STATUS_ZERO_PIVOT:      return "CUSOLVER_STATUS_ZERO_PIVOT";
756:     case CUSOLVER_STATUS_INVALID_LICENSE: return "CUSOLVER_STATUS_INVALID_LICENSE";
757: #endif
758: #endif
759:     default:                             return "unknown error";
760:   }
761: }
762: PETSC_EXTERN const char* PetscCUFFTGetErrorName(cufftResult result)
763: {
764:  switch (result) {
765:  case CUFFT_SUCCESS:                   return "CUFFT_SUCCESS";
766:  case CUFFT_INVALID_PLAN:              return "CUFFT_INVALID_PLAN";
767:  case CUFFT_ALLOC_FAILED:              return "CUFFT_ALLOC_FAILED";
768:  case CUFFT_INVALID_TYPE:              return "CUFFT_INVALID_TYPE";
769:  case CUFFT_INVALID_VALUE:             return "CUFFT_INVALID_VALUE";
770:  case CUFFT_INTERNAL_ERROR:            return "CUFFT_INTERNAL_ERROR";
771:  case CUFFT_EXEC_FAILED:               return "CUFFT_EXEC_FAILED";
772:  case CUFFT_SETUP_FAILED:              return "CUFFT_SETUP_FAILED";
773:  case CUFFT_INVALID_SIZE:              return "CUFFT_INVALID_SIZE";
774:  case CUFFT_UNALIGNED_DATA:            return "CUFFT_UNALIGNED_DATA";
775:  case CUFFT_INCOMPLETE_PARAMETER_LIST: return "CUFFT_INCOMPLETE_PARAMETER_LIST";
776:  case CUFFT_INVALID_DEVICE:            return "CUFFT_INVALID_DEVICE";
777:  case CUFFT_PARSE_ERROR:               return "CUFFT_PARSE_ERROR";
778:  case CUFFT_NO_WORKSPACE:              return "CUFFT_NO_WORKSPACE";
779:  case CUFFT_NOT_IMPLEMENTED:           return "CUFFT_NOT_IMPLEMENTED";
780:  case CUFFT_LICENSE_ERROR:             return "CUFFT_LICENSE_ERROR";
781:  case CUFFT_NOT_SUPPORTED:             return "CUFFT_NOT_SUPPORTED";
782:  default:                              return "unknown error";
783:  }
784: }
785: #endif

787: #if defined(PETSC_HAVE_HIP)
788: #include <petscdevice.h>
789: PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status)
790: {
791:   switch(status) {
792:     case HIPBLAS_STATUS_SUCCESS:          return "HIPBLAS_STATUS_SUCCESS";
793:     case HIPBLAS_STATUS_NOT_INITIALIZED:  return "HIPBLAS_STATUS_NOT_INITIALIZED";
794:     case HIPBLAS_STATUS_ALLOC_FAILED:     return "HIPBLAS_STATUS_ALLOC_FAILED";
795:     case HIPBLAS_STATUS_INVALID_VALUE:    return "HIPBLAS_STATUS_INVALID_VALUE";
796:     case HIPBLAS_STATUS_ARCH_MISMATCH:    return "HIPBLAS_STATUS_ARCH_MISMATCH";
797:     case HIPBLAS_STATUS_MAPPING_ERROR:    return "HIPBLAS_STATUS_MAPPING_ERROR";
798:     case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED";
799:     case HIPBLAS_STATUS_INTERNAL_ERROR:   return "HIPBLAS_STATUS_INTERNAL_ERROR";
800:     case HIPBLAS_STATUS_NOT_SUPPORTED:    return "HIPBLAS_STATUS_NOT_SUPPORTED";
801:     default:                              return "unknown error";
802:   }
803: }
804: #endif