Date: 2015-10-02T21:59:33+00:00

Actual source code: err.c
petsc-3.6.2 2015-10-02
Report Typos and Errors

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

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

     15: static EH eh = 0;

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

     23:    Not Collective

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

     35:    Options Database Key:
     36: .   -on_error_emacs <machinename>

     38:    Level: developer

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

     43:    Most users need not directly employ this routine and the other error
     44:    handlers, but can instead use the simplified interface SETERRQ, which has
     45:    the calling sequence
     46: $     SETERRQ(PETSC_COMM_SELF,number,p,mess)

     48:    Notes for experienced users:
     49:    Use PetscPushErrorHandler() to set the desired error handler.

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

     53:    Concepts: emacs^going to on error
     54:    Concepts: error handler^going to line in emacs

     56: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
     57:           PetscAbortErrorHandler()
     58:  @*/
     59: PetscErrorCode  PetscEmacsClientErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
     60: {
     62:   char           command[PETSC_MAX_PATH_LEN];
     63:   const char     *pdir;
     64:   FILE           *fp;
     65:   int            rval;

     68:   PetscGetPetscDir(&pdir);if (ierr) PetscFunctionReturn(ierr);
     69:   sprintf(command,"cd %s; emacsclient --no-wait +%d %s\n",pdir,line,file);
     70: #if defined(PETSC_HAVE_POPEN)
     71:   PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);if (ierr) PetscFunctionReturn(ierr);
     72:   PetscPClose(MPI_COMM_WORLD,fp,&rval);if (ierr) PetscFunctionReturn(ierr);
     73: #else
     74:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
     75: #endif
     76:   PetscPopErrorHandler();if (ierr) PetscFunctionReturn(ierr); /* remove this handler from the stack of handlers */
     77:   if (!eh) {
     78:     PetscTraceBackErrorHandler(comm,line,fun,file,n,p,mess,0);if (ierr) PetscFunctionReturn(ierr);
     79:   } else {
     80:     (*eh->handler)(comm,line,fun,file,n,p,mess,eh->ctx);if (ierr) PetscFunctionReturn(ierr);
     81:   }
     82:   PetscFunctionReturn(ierr);
     83: }

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

     90:    Not Collective

     92:    Input Parameters:
     93: +  handler - error handler routine
     94: -  ctx - optional handler context that contains information needed by the handler (for
     95:          example file pointers for error messages etc.)

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

    100: +  comm - communicator over which error occured
    101: .  line - the line number of the error (indicated by __LINE__)
    102: .  func - the function where the error occured (indicated by __FUNCT__)
    103: .  file - the file in which the error was detected (indicated by __FILE__)
    104: .  n - the generic error number (see list defined in include/petscerror.h)
    105: .  p - PETSC_ERROR_INITIAL if error just detected, otherwise PETSC_ERROR_REPEAT
    106: .  mess - an error text string, usually just printed to the screen
    107: -  ctx - the error handler context

    109:    Options Database Keys:
    110: +   -on_error_attach_debugger <noxterm,gdb or dbx>
    111: -   -on_error_abort

    113:    Level: intermediate

    115:    Notes:
    116:    The currently available PETSc error handlers include PetscTraceBackErrorHandler(),
    117:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler(), PetscReturnErrorHandler().

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

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

    123: @*/
    124: PetscErrorCode  PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm comm,int,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void *ctx)
    125: {
    126:   EH             neweh;

    130:   PetscNew(&neweh);
    131:   if (eh) neweh->previous = eh;
    132:   else    neweh->previous = 0;
    133:   neweh->handler = handler;
    134:   neweh->ctx     = ctx;
    135:   eh             = neweh;
    136:   return(0);
    137: }

    141: /*@
    142:    PetscPopErrorHandler - Removes the latest error handler that was
    143:    pushed with PetscPushErrorHandler().

    145:    Not Collective

    147:    Level: intermediate

    149:    Concepts: error handler^setting

    151: .seealso: PetscPushErrorHandler()
    152: @*/
    153: PetscErrorCode  PetscPopErrorHandler(void)
    154: {
    155:   EH             tmp;

    159:   if (!eh) return(0);
    160:   tmp  = eh;
    161:   eh   = eh->previous;
    162:   PetscFree(tmp);
    163:   return(0);
    164: }

    168: /*@C
    169:   PetscReturnErrorHandler - Error handler that causes a return to the current
    170:   level.

    172:    Not Collective

    174:    Input Parameters:
    175: +  comm - communicator over which error occurred
    176: .  line - the line number of the error (indicated by __LINE__)
    177: .  func - the function where error is detected (indicated by __FUNCT__)
    178: .  file - the file in which the error was detected (indicated by __FILE__)
    179: .  mess - an error text string, usually just printed to the screen
    180: .  n - the generic error number
    181: .  p - specific error number
    182: -  ctx - error handler context

    184:    Level: developer

    186:    Notes:
    187:    Most users need not directly employ this routine and the other error
    188:    handlers, but can instead use the simplified interface SETERRQ, which has
    189:    the calling sequence
    190: $     SETERRQ(comm,number,mess)

    192:    Notes for experienced users:
    193:    This routine is good for catching errors such as zero pivots in preconditioners
    194:    or breakdown of iterative methods. It is not appropriate for memory violations
    195:    and similar errors.

    197:    Use PetscPushErrorHandler() to set the desired error handler.  The
    198:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
    199:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()

    201:    Concepts: error handler

    203: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
    204:  @*/

    206: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
    207: {
    209:   PetscFunctionReturn(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: http://www.mcs.anl.gov/petsc/documentation/faq.html#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: http://www.mcs.anl.gov/petsc/documentation/faq.html#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: http://www.mcs.anl.gov/petsc/documentation/installation.html#valgrind",
    242:           "Unexpected data in file",
    243:   /*80 */ "Arguments must have same communicators",
    244:   /*81 */ "Zero pivot in Cholesky factorization: http://www.mcs.anl.gov/petsc/documentation/faq.html#zeropivot",
    245:           "  ",
    246:           "  ",
    247:           "Overflow in integer operation: http://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices",
    248:   /*85 */ "Null argument, when expecting valid pointer",
    249:   /*86 */ "Unknown type. Check for miss-spelling or missing package: http://www.mcs.anl.gov/petsc/documentation/installation.html#external",
    250:   /*87 */ "Not used",
    251:   /*88 */ "Error in system call",
    252:   /*89 */ "Object Type not set: http://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset"
    253:   /*90 */ "  ",
    254:   /*   */ "  ",
    255:   /*92 */ " ",
    256:   /*   */ "See http://www.mcs.anl.gov/petsc/documentation/linearsolvertable.html for possible LU and Cholesky solvers",
    257:   /*   */ "  ",
    258:   /*95 */ "  ",
    259: };

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

    266:    Not Collective

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

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

    275:    Level: developer

    277:    Concepts: error handler^messages

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

    288:   if (specific) *specific = PetscErrorBaseMessage;
    289:   return(0);
    290: }

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

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

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

    325:    Not Collective

    327:    Input Parameters:
    328: +  comm - communicator over which error occurred.  ALL ranks of this communicator MUST call this routine
    329: .  line - the line number of the error (indicated by __LINE__)
    330: .  func - the function where the error occured (indicated by __FUNCT__)
    331: .  file - the file in which the error was detected (indicated by __FILE__)
    332: .  mess - an error text string, usually just printed to the screen
    333: .  n - the generic error number
    334: .  p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
    335: -  mess - formatted message string - aka printf

    337:   Level: intermediate

    339:    Notes:
    340:    Most users need not directly use this routine and the error handlers, but
    341:    can instead use the simplified interface SETERRQ, which has the calling
    342:    sequence
    343: $     SETERRQ(comm,n,mess)

    345:    Experienced users can set the error handler with PetscPushErrorHandler().

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

    351:    Concepts: error^setting condition

    353: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
    354: @*/
    355: PetscErrorCode  PetscError(MPI_Comm comm,int line,const char *func,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,...)
    356: {
    357:   va_list        Argp;
    358:   size_t         fullLength;
    359:   char           buf[2048],*lbuf = 0;
    360:   PetscBool      ismain,isunknown;

    364:   if (!func) func = "User provided function";
    365:   if (!file) file = "User file";
    366:   if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;

    368:   /* Compose the message evaluating the print format */
    369:   if (mess) {
    370:     va_start(Argp,mess);
    371:     PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
    372:     va_end(Argp);
    373:     lbuf = buf;
    374:     if (p == 1) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
    375:   }

    377:   if (!eh) PetscTraceBackErrorHandler(comm,line,func,file,n,p,lbuf,0);
    378:   else     (*eh->handler)(comm,line,func,file,n,p,lbuf,eh->ctx);

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

    384:     Since this is in the error handler we don't check the errors below. Of course,
    385:     PetscStrncmp() does its own error checking which is problamatic
    386:   */
    387:   PetscStrncmp(func,"main",4,&ismain);
    388:   PetscStrncmp(func,"unknown",7,&isunknown);
    389:   if (ismain || isunknown) MPI_Abort(PETSC_COMM_WORLD,(int)ierr);

    391: #if defined(PETSC_CLANGUAGE_CXX)
    392:   if (p == PETSC_ERROR_IN_CXX) {
    393:     PetscCxxErrorThrow();
    394:   }
    395: #endif
    396:   PetscFunctionReturn(ierr);
    397: }

    399: /* -------------------------------------------------------------------------*/

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

    406:     Collective on PetscViewer

    408:     Input Parameters:
    409: +   N - number of integers in array
    410: .   idx - array of integers
    411: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

    413:   Level: intermediate

    415:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done

    417: .seealso: PetscRealView()
    418: @*/
    419: PetscErrorCode  PetscIntView(PetscInt N,const PetscInt idx[],PetscViewer viewer)
    420: {
    422:   PetscInt       j,i,n = N/20,p = N % 20;
    423:   PetscBool      iascii,isbinary;
    424:   MPI_Comm       comm;

    427:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    430:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

    454:     PetscMPIIntCast(N,&NN);
    455:     MPI_Comm_rank(comm,&rank);
    456:     MPI_Comm_size(comm,&size);

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

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

    495:     Collective on PetscViewer

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

    502:   Level: intermediate

    504:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done

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

    516:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    519:   PetscObjectGetComm((PetscObject)viewer,&comm);

    521:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
    522:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
    523:   if (iascii) {
    524:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
    525:     for (i=0; i<n; i++) {
    526:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*i);
    527:       for (j=0; j<5; j++) {
    528:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*5+j]);
    529:       }
    530:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    531:     }
    532:     if (p) {
    533:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",(int)5*n);
    534:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[5*n+i]);}
    535:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    536:     }
    537:     PetscViewerFlush(viewer);
    538:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
    539:   } else if (isbinary) {
    540:     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN;
    541:     PetscReal   *array;

    543:     PetscMPIIntCast(N,&NN);
    544:     MPI_Comm_rank(comm,&rank);
    545:     MPI_Comm_size(comm,&size);

    547:     if (size > 1) {
    548:       if (rank) {
    549:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
    550:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,0,0,0,MPIU_REAL,0,comm);
    551:       } else {
    552:         PetscMalloc1(size,&sizes);
    553:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
    554:         Ntotal    = sizes[0];
    555:         PetscMalloc1(size,&displs);
    556:         displs[0] = 0;
    557:         for (i=1; i<size; i++) {
    558:           Ntotal   += sizes[i];
    559:           displs[i] =  displs[i-1] + sizes[i-1];
    560:         }
    561:         PetscMalloc1(Ntotal,&array);
    562:         MPI_Gatherv((PetscReal*)idx,NN,MPIU_REAL,array,sizes,displs,MPIU_REAL,0,comm);
    563:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_REAL,PETSC_TRUE);
    564:         PetscFree(sizes);
    565:         PetscFree(displs);
    566:         PetscFree(array);
    567:       }
    568:     } else {
    569:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_REAL,PETSC_FALSE);
    570:     }
    571:   } else {
    572:     const char *tname;
    573:     PetscObjectGetName((PetscObject)viewer,&tname);
    574:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
    575:   }
    576:   return(0);
    577: }

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

    584:     Collective on PetscViewer

    586:     Input Parameters:
    587: +   N - number of scalars in array
    588: .   idx - array of scalars
    589: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

    591:   Level: intermediate

    593:     Developer Notes: idx cannot be const because may be passed to binary viewer where byte swappping is done

    595: .seealso: PetscIntView(), PetscRealView()
    596: @*/
    597: PetscErrorCode  PetscScalarView(PetscInt N,const PetscScalar idx[],PetscViewer viewer)
    598: {
    600:   PetscInt       j,i,n = N/3,p = N % 3;
    601:   PetscBool      iascii,isbinary;
    602:   MPI_Comm       comm;

    605:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    608:   PetscObjectGetComm((PetscObject)viewer,&comm);

    610:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
    611:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);
    612:   if (iascii) {
    613:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
    614:     for (i=0; i<n; i++) {
    615:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
    616:       for (j=0; j<3; j++) {
    617: #if defined(PETSC_USE_COMPLEX)
    618:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[i*3+j]),(double)PetscImaginaryPart(idx[i*3+j]));
    619: #else
    620:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[i*3+j]);
    621: #endif
    622:       }
    623:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    624:     }
    625:     if (p) {
    626:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
    627:       for (i=0; i<p; i++) {
    628: #if defined(PETSC_USE_COMPLEX)
    629:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)", (double)PetscRealPart(idx[n*3+i]),(double)PetscImaginaryPart(idx[n*3+i]));
    630: #else
    631:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",(double)idx[3*n+i]);
    632: #endif
    633:       }
    634:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    635:     }
    636:     PetscViewerFlush(viewer);
    637:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
    638:   } else if (isbinary) {
    639:     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN;
    640:     PetscScalar *array;

    642:     PetscMPIIntCast(N,&NN);
    643:     MPI_Comm_rank(comm,&rank);
    644:     MPI_Comm_size(comm,&size);

    646:     if (size > 1) {
    647:       if (rank) {
    648:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
    649:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
    650:       } else {
    651:         PetscMalloc1(size,&sizes);
    652:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
    653:         Ntotal    = sizes[0];
    654:         PetscMalloc1(size,&displs);
    655:         displs[0] = 0;
    656:         for (i=1; i<size; i++) {
    657:           Ntotal   += sizes[i];
    658:           displs[i] =  displs[i-1] + sizes[i-1];
    659:         }
    660:         PetscMalloc1(Ntotal,&array);
    661:         MPI_Gatherv((void*)idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
    662:         PetscViewerBinaryWrite(viewer,array,Ntotal,PETSC_SCALAR,PETSC_TRUE);
    663:         PetscFree(sizes);
    664:         PetscFree(displs);
    665:         PetscFree(array);
    666:       }
    667:     } else {
    668:       PetscViewerBinaryWrite(viewer,(void*) idx,N,PETSC_SCALAR,PETSC_FALSE);
    669:     }
    670:   } else {
    671:     const char *tname;
    672:     PetscObjectGetName((PetscObject)viewer,&tname);
    673:     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
    674:   }
    675:   return(0);
    676: }