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

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

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

     53: static EH eh = NULL;

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

     59:    Not Collective

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

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

     73:    Level: developer

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

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

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

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

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

    113:    Not Collective

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

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

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

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

    135:    Level: intermediate

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

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

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

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

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

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

    166:    Not Collective

    168:    Level: intermediate

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

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

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

    188:    Not Collective

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

    199:    Level: developer

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

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

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

    211: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler(), PetscError(), PetscAbortErrorHandler(), PetscMPIAbortErrorHandler(), PetscTraceBackErrorHandler(),
    212:            PetscAttachDebuggerErrorHandler(), PetscEmacsClientErrorHandler()
    213:  @*/
    214: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
    215: {
    217:   PetscFunctionReturn(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 Parameter:
    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:   const char *str;
    316:   if (eh && eh->ctx) {
    317:     std::ostringstream *msg;
    318:     msg = (std::ostringstream*) eh->ctx;
    319:     str = msg->str().c_str();
    320:   } else str = "Error detected in C PETSc";

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

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

    329:   Collective on comm

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

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

    344:   Level: intermediate

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

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

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

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

    363:    Set the error handler with PetscPushErrorHandler().

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

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

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

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

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

    422: /* -------------------------------------------------------------------------*/

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

    427:     Collective on PetscViewer

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

    434:   Level: intermediate

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

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

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

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

    487:     PetscMPIIntCast(N,&NN);

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

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

    524:     Collective on PetscViewer

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

    531:   Level: intermediate

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

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

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

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

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

    592:     PetscMPIIntCast(N,&NN);

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

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

    629:     Collective on PetscViewer

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

    636:   Level: intermediate

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

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

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

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

    699:     PetscMPIIntCast(N,&NN);

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

    733: #if defined(PETSC_HAVE_CUDA)
    734: #include <petsccublas.h>
    735: PETSC_EXTERN const char* PetscCUBLASGetErrorName(cublasStatus_t status)
    736: {
    737:   switch(status) {
    738: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
    739:     case CUBLAS_STATUS_SUCCESS:          return "CUBLAS_STATUS_SUCCESS";
    740:     case CUBLAS_STATUS_NOT_INITIALIZED:  return "CUBLAS_STATUS_NOT_INITIALIZED";
    741:     case CUBLAS_STATUS_ALLOC_FAILED:     return "CUBLAS_STATUS_ALLOC_FAILED";
    742:     case CUBLAS_STATUS_INVALID_VALUE:    return "CUBLAS_STATUS_INVALID_VALUE";
    743:     case CUBLAS_STATUS_ARCH_MISMATCH:    return "CUBLAS_STATUS_ARCH_MISMATCH";
    744:     case CUBLAS_STATUS_MAPPING_ERROR:    return "CUBLAS_STATUS_MAPPING_ERROR";
    745:     case CUBLAS_STATUS_EXECUTION_FAILED: return "CUBLAS_STATUS_EXECUTION_FAILED";
    746:     case CUBLAS_STATUS_INTERNAL_ERROR:   return "CUBLAS_STATUS_INTERNAL_ERROR";
    747:     case CUBLAS_STATUS_NOT_SUPPORTED:    return "CUBLAS_STATUS_NOT_SUPPORTED";
    748:     case CUBLAS_STATUS_LICENSE_ERROR:    return "CUBLAS_STATUS_LICENSE_ERROR";
    749: #endif
    750:     default:                             return "unknown error";
    751:   }
    752: }
    753: PETSC_EXTERN const char* PetscCUSolverGetErrorName(cusolverStatus_t status)
    754: {
    755:   switch(status) {
    756: #if (CUDART_VERSION >= 8000) /* At least CUDA 8.0 of Sep. 2016 had these */
    757:     case CUSOLVER_STATUS_SUCCESS:          return "CUSOLVER_STATUS_SUCCESS";
    758:     case CUSOLVER_STATUS_NOT_INITIALIZED:  return "CUSOLVER_STATUS_NOT_INITIALIZED";
    759:     case CUSOLVER_STATUS_INVALID_VALUE:    return "CUSOLVER_STATUS_INVALID_VALUE";
    760:     case CUSOLVER_STATUS_ARCH_MISMATCH:    return "CUSOLVER_STATUS_ARCH_MISMATCH";
    761:     case CUSOLVER_STATUS_INTERNAL_ERROR:   return "CUSOLVER_STATUS_INTERNAL_ERROR";
    762: #endif
    763:     default:                             return "unknown error";
    764:   }
    765: }
    766: #endif

    768: #if defined(PETSC_HAVE_HIP)
    769: #include <petschipblas.h>
    770: PETSC_EXTERN const char* PetscHIPBLASGetErrorName(hipblasStatus_t status)
    771: {
    772:   switch(status) {
    773:     case HIPBLAS_STATUS_SUCCESS:          return "HIPBLAS_STATUS_SUCCESS";
    774:     case HIPBLAS_STATUS_NOT_INITIALIZED:  return "HIPBLAS_STATUS_NOT_INITIALIZED";
    775:     case HIPBLAS_STATUS_ALLOC_FAILED:     return "HIPBLAS_STATUS_ALLOC_FAILED";
    776:     case HIPBLAS_STATUS_INVALID_VALUE:    return "HIPBLAS_STATUS_INVALID_VALUE";
    777:     case HIPBLAS_STATUS_ARCH_MISMATCH:    return "HIPBLAS_STATUS_ARCH_MISMATCH";
    778:     case HIPBLAS_STATUS_MAPPING_ERROR:    return "HIPBLAS_STATUS_MAPPING_ERROR";
    779:     case HIPBLAS_STATUS_EXECUTION_FAILED: return "HIPBLAS_STATUS_EXECUTION_FAILED";
    780:     case HIPBLAS_STATUS_INTERNAL_ERROR:   return "HIPBLAS_STATUS_INTERNAL_ERROR";
    781:     case HIPBLAS_STATUS_NOT_SUPPORTED:    return "HIPBLAS_STATUS_NOT_SUPPORTED";
    782:     default:                              return "unknown error";
    783:   }
    784: }
    785: #endif