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

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

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

 55: static EH eh = NULL;

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

 61:    Not Collective

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

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

 75:    Level: developer

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

 80:    Developer Note:
 81:    Since this is an error handler it cannot call CHKERRQ(); thus we just return if an error is detected.

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

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

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

114:    Not Collective

116:    Input Parameters:
117: +  handler - error handler routine
118: -  ctx - optional handler context that contains information needed by the handler (for
119:          example file pointers for error messages etc.)

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

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

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

136:    Level: intermediate

138:    Notes:
139:    The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
140:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

142:    Fortran Notes:
143:     You can only push one error handler from Fortran before poping it.

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

147: @*/
148: PetscErrorCode  PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
149: {
150:   EH             neweh;

154:   PetscNew(&neweh);
155:   if (eh) neweh->previous = eh;
156:   else    neweh->previous = NULL;
157:   neweh->handler = handler;
158:   neweh->ctx     = ctx;
159:   eh             = neweh;
160:   return(0);
161: }

163: /*@
164:    PetscPopErrorHandler - Removes the latest error handler that was
165:    pushed with PetscPushErrorHandler().

167:    Not Collective

169:    Level: intermediate

171: .seealso: PetscPushErrorHandler()
172: @*/
173: PetscErrorCode  PetscPopErrorHandler(void)
174: {
175:   EH             tmp;

179:   if (!eh) return(0);
180:   tmp  = eh;
181:   eh   = eh->previous;
182:   PetscFree(tmp);
183:   return(0);
184: }

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

189:    Not Collective

191:    Input Parameters:
192: +  comm - communicator over which error occurred
193: .  line - the line number of the error (indicated by __LINE__)
194: .  file - the file in which the error was detected (indicated by __FILE__)
195: .  mess - an error text string, usually just printed to the screen
196: .  n - the generic error number
197: .  p - specific error number
198: -  ctx - error handler context

200:    Level: developer

202:    Notes:
203:    Most users need not directly employ this routine and the other error
204:    handlers, but can instead use the simplified interface SETERRQ, which has
205:    the calling sequence
206: $     SETERRQ(comm,number,mess)

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

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

212: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler(), PetscError(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(),
213:            PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler()
214:  @*/
215: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
216: {
217:   return n;
218: }

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

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

275:    Not Collective

277:    Input Parameter:
278: .   errnum - the error code

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

284:    Level: developer

286: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscError(), SETERRQ(), CHKERRQ()
287:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
288:  @*/
289: PetscErrorCode  PetscErrorMessage(int errnum,const char *text[],char **specific)
290: {
292:   if (text && errnum > PETSC_ERR_MIN_VALUE && errnum < PETSC_ERR_MAX_VALUE) *text = PetscErrorStrings[errnum-PETSC_ERR_MIN_VALUE-1];
293:   else if (text) *text = NULL;

295:   if (specific) *specific = PetscErrorBaseMessage;
296:   return(0);
297: }

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

323:   throw std::runtime_error(str);
324: }
325: #endif

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

330:   Collective on comm

332:    Input Parameters:
333: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
334: .  line - the line number of the error (indicated by __LINE__)
335: .  func - the function name in which the error was detected
336: .  file - the file in which the error was detected (indicated by __FILE__)
337: .  n - the generic error number
338: .  p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
339: -  mess - formatted message string - aka printf

341:   Options Database:
342: +  -error_output_stdout - output the error messages to stdout instead of the default stderr
343: -  -error_output_none - do not output the error messages

345:   Level: intermediate

347:    Notes:
348:    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
349:    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,
350:    KSPGetConvergedReason() that indicates if the solve was successful or not. The option -ksp_error_if_not_converged, for example, turns numerical failures into
351:    hard errors managed via PetscError().

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

355:    Most users need not directly use this routine and the error handlers, but
356:    can instead use the simplified interface SETERRQ, which has the calling
357:    sequence
358: $     SETERRQ(comm,n,mess)

360:    Fortran Note:
361:    This routine is used differently from Fortran
362: $    PetscError(MPI_Comm comm,PetscErrorCode n,PetscErrorType p,char *message)

364:    Set the error handler with PetscPushErrorHandler().

366:    Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
367:    BUT this routine does call regular PETSc functions that may call error handlers, this is problematic and could be fixed by never calling other PETSc routines
368:    but this annoying.

370: .seealso: PetscErrorCode, PetscPushErrorHandler(), PetscPopErrorHandler(), PetscTraceBackErrorHandler(),  PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(),
371:           PetscReturnErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler(),
372:           SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), PetscErrorMessage(), PETSCABORT()
373: @*/
374: PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
375: {
376:   va_list        Argp;
377:   size_t         fullLength;
378:   char           buf[2048],*lbuf = NULL;
379:   PetscBool      ismain;

382:   if (!func) func = "User provided function";
383:   if (!file) file = "User file";
384:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

386:   /* Compose the message evaluating the print format */
387:   if (mess) {
388:     va_start(Argp,mess);
389:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
390:     va_end(Argp);
391:     lbuf = buf;
392:     if (p == PETSC_ERROR_INITIAL) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
393:   }

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

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

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

405:     Does not call PETSCABORT() since that would provide the wrong source file and line number information
406:   */
407:   PetscStrncmp(func,"main",4,&ismain);
408:   if (ismain) {
409:     PetscMPIInt errcode;
410:     errcode = (PetscMPIInt)(0 + 0*line*1000 + ierr);
411:     if (petscwaitonerrorflg) { PetscSleep(1000); }
412:     MPI_Abort(MPI_COMM_WORLD,errcode);
413:   }

415: #if defined(PETSC_CLANGUAGE_CXX)
416:   if (p == PETSC_ERROR_IN_CXX) {
417:     PetscCxxErrorThrow();
418:   }
419: #endif
420:   return ierr;
421: }

423: /* -------------------------------------------------------------------------*/

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

428:     Collective on PetscViewer

430:     Input Parameters:
431: +   N - number of integers in array
432: .   idx - array of integers
433: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

435:   Level: intermediate

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

440: .seealso: PetscRealView()
441: @*/
442: PetscErrorCode  PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
443: {
445:   PetscMPIInt    rank,size;
446:   PetscInt       j,i,n = N/20,p = N % 20;
447:   PetscBool      iascii,isbinary;
448:   MPI_Comm       comm;

451:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
454:   PetscObjectGetComm((PetscObject)viewer,&comm);
455:   MPI_Comm_size(comm,&size);
456:   MPI_Comm_rank(comm,&rank);

458:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
459:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
460:   if (iascii) {
461:     PetscViewerASCIIPushSynchronized(viewer);
462:     for (i=0; i<n; i++) {
463:       if (size > 1) {
464:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:", rank, 20*i);
465:       } else {
466:         PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
467:       }
468:       for (j=0; j<20; j++) {
469:         PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
470:       }
471:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
472:     }
473:     if (p) {
474:       if (size > 1) {
475:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %D:",rank ,20*n);
476:       } else {
477:         PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
478:       }
479:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
480:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
481:     }
482:     PetscViewerFlush(viewer);
483:     PetscViewerASCIIPopSynchronized(viewer);
484:   } else if (isbinary) {
485:     PetscMPIInt *sizes,Ntotal,*displs,NN;
486:     PetscInt    *array;

488:     PetscMPIIntCast(N,&NN);

490:     if (size > 1) {
491:       if (rank) {
492:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
493:         MPI_Gatherv((void*)idx,NN,MPIU_INT,NULL,NULL,NULL,MPIU_INT,0,comm);
494:       } else {
495:         PetscMalloc1(size,&sizes);
496:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
497:         Ntotal    = sizes[0];
498:         PetscMalloc1(size,&displs);
499:         displs[0] = 0;
500:         for (i=1; i<size; i++) {
501:           Ntotal   += sizes[i];
502:           displs[i] =  displs[i-1] + sizes[i-1];
503:         }
504:         PetscMalloc1(Ntotal,&array);
505:         MPI_Gatherv((void*)idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
506:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_INT);
507:         PetscFree(sizes);
508:         PetscFree(displs);
509:         PetscFree(array);
510:       }
511:     } else {
512:       PetscViewerBinaryWrite(viewer,idx,N,PETSC_INT);
513:     }
514:   } else {
515:     const char *tname;
516:     PetscObjectGetName((PetscObject)viewer,&tname);
517:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
518:   }
519:   return(0);
520: }

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

525:     Collective on PetscViewer

527:     Input Parameters:
528: +   N - number of PetscReal in array
529: .   idx - array of PetscReal
530: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

532:   Level: intermediate

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

537: .seealso: PetscIntView()
538: @*/
539: PetscErrorCode  PetscRealView(PetscInt N,const PetscReal idx[],PetscViewer viewer)
540: {
542:   PetscMPIInt    rank,size;
543:   PetscInt       j,i,n = N/5,p = N % 5;
544:   PetscBool      iascii,isbinary;
545:   MPI_Comm       comm;

548:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
551:   PetscObjectGetComm((PetscObject)viewer,&comm);
552:   MPI_Comm_size(comm,&size);
553:   MPI_Comm_rank(comm,&rank);

555:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
556:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
557:   if (iascii) {
558:     PetscInt tab;

560:     PetscViewerASCIIPushSynchronized(viewer);
561:     PetscViewerASCIIGetTab(viewer, &tab);
562:     for (i=0; i<n; i++) {
563:       PetscViewerASCIISetTab(viewer, tab);
564:       if (size > 1) {
565:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*i);
566:       } else {
567:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
568:       }
569:       PetscViewerASCIISetTab(viewer, 0);
570:       for (j=0; j<5; j++) {
571:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
572:       }
573:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
574:     }
575:     if (p) {
576:       PetscViewerASCIISetTab(viewer, tab);
577:       if (size > 1) {
578:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,(int)5*n);
579:       } else {
580:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
581:       }
582:       PetscViewerASCIISetTab(viewer, 0);
583:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
584:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
585:     }
586:     PetscViewerFlush(viewer);
587:     PetscViewerASCIISetTab(viewer, tab);
588:     PetscViewerASCIIPopSynchronized(viewer);
589:   } else if (isbinary) {
590:     PetscMPIInt *sizes,*displs, Ntotal,NN;
591:     PetscReal   *array;

593:     PetscMPIIntCast(N,&NN);

595:     if (size > 1) {
596:       if (rank) {
597:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
598:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,NULL,NULL,NULL,MPIU_REAL,0,comm);
599:       } else {
600:         PetscMalloc1(size,&sizes);
601:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
602:         Ntotal    = sizes[0];
603:         PetscMalloc1(size,&displs);
604:         displs[0] = 0;
605:         for (i=1; i<size; i++) {
606:           Ntotal   += sizes[i];
607:           displs[i] =  displs[i-1] + sizes[i-1];
608:         }
609:         PetscMalloc1(Ntotal,&array);
610:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
611:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL);
612:         PetscFree(sizes);
613:         PetscFree(displs);
614:         PetscFree(array);
615:       }
616:     } else {
617:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL);
618:     }
619:   } else {
620:     const char *tname;
621:     PetscObjectGetName((PetscObject)viewer,&tname);
622:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
623:   }
624:   return(0);
625: }

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

630:     Collective on PetscViewer

632:     Input Parameters:
633: +   N - number of scalars in array
634: .   idx - array of scalars
635: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

637:   Level: intermediate

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

642: .seealso: PetscIntView(), PetscRealView()
643: @*/
644: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
645: {
647:   PetscMPIInt    rank,size;
648:   PetscInt       j,i,n = N/3,p = N % 3;
649:   PetscBool      iascii,isbinary;
650:   MPI_Comm       comm;

653:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
656:   PetscObjectGetComm((PetscObject)viewer,&comm);
657:   MPI_Comm_size(comm,&size);
658:   MPI_Comm_rank(comm,&rank);

660:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
661:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
662:   if (iascii) {
663:     PetscViewerASCIIPushSynchronized(viewer);
664:     for (i=0; i<n; i++) {
665:       if (size > 1) {
666:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*i);
667:       } else {
668:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
669:       }
670:       for (j=0; j<3; j++) {
671: #if defined(PETSC_USE_COMPLEX)
672:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
673: #else
674:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
675: #endif
676:       }
677:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
678:     }
679:     if (p) {
680:       if (size > 1) {
681:         PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %2d:",rank ,3*n);
682:       } else {
683:         PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
684:       }
685:       for (i=0; i<p; i++) {
686: #if defined(PETSC_USE_COMPLEX)
687:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
688: #else
689:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
690: #endif
691:       }
692:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
693:     }
694:     PetscViewerFlush(viewer);
695:     PetscViewerASCIIPopSynchronized(viewer);
696:   } else if (isbinary) {
697:     PetscMPIInt *sizes,Ntotal,*displs,NN;
698:     PetscScalar *array;

700:     PetscMPIIntCast(N,&NN);

702:     if (size > 1) {
703:       if (rank) {
704:         MPI_Gather(&NN,1,MPI_INT,NULL,0,MPI_INT,0,comm);
705:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,NULL,NULL,NULL,MPIU_SCALAR,0,comm);
706:       } else {
707:         PetscMalloc1(size,&sizes);
708:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
709:         Ntotal    = sizes[0];
710:         PetscMalloc1(size,&displs);
711:         displs[0] = 0;
712:         for (i=1; i<size; i++) {
713:           Ntotal   += sizes[i];
714:           displs[i] =  displs[i-1] + sizes[i-1];
715:         }
716:         PetscMalloc1(Ntotal,&array);
717:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
718:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR);
719:         PetscFree(sizes);
720:         PetscFree(displs);
721:         PetscFree(array);
722:       }
723:     } else {
724:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR);
725:     }
726:   } else {
727:     const char *tname;
728:     PetscObjectGetName((PetscObject)viewer,&tname);
729:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
730:   }
731:   return(0);
732: }

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

801: #if defined(PETSC_HAVE_HIP)
802: #include <petscdevice.h>
803: PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status)
804: {
805:   switch(status) {
806:     case HIPBLAS_STATUS_SUCCESS:          return "HIPBLAS_STATUS_SUCCESS";
807:     case HIPBLAS_STATUS_NOT_INITIALIZED:  return "HIPBLAS_STATUS_NOT_INITIALIZED";
808:     case HIPBLAS_STATUS_ALLOC_FAILED:     return "HIPBLAS_STATUS_ALLOC_FAILED";
809:     case HIPBLAS_STATUS_INVALID_VALUE:    return "HIPBLAS_STATUS_INVALID_VALUE";
810:     case HIPBLAS_STATUS_ARCH_MISMATCH:    return "HIPBLAS_STATUS_ARCH_MISMATCH";
811:     case HIPBLAS_STATUS_MAPPING_ERROR:    return "HIPBLAS_STATUS_MAPPING_ERROR";
812:     case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED";
813:     case HIPBLAS_STATUS_INTERNAL_ERROR:   return "HIPBLAS_STATUS_INTERNAL_ERROR";
814:     case HIPBLAS_STATUS_NOT_SUPPORTED:    return "HIPBLAS_STATUS_NOT_SUPPORTED";
815:     default:                              return "unknown error";
816:   }
817: }
818: #endif