Date: 2013-07-02T14:38:38+00:00

Actual source code: err.c
petsc-3.4.2 2013-07-02

      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*,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: .  dir - the directory of the file (indicated by __SDIR__)
     31: .  mess - an error text string, usually just printed to the screen
     32: .  n - the generic error number
     33: .  p - specific error number
     34: -  ctx - error handler context

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

     39:    Level: developer

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

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

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

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

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

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

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

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

     91:    Not Collective

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

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

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

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

    115:    Level: intermediate

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

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

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

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

    132:   PetscNew(struct _EH,&neweh);
    133:   if (eh) neweh->previous = eh;
    134:   else    neweh->previous = 0;
    135:   neweh->handler = handler;
    136:   neweh->ctx     = ctx;
    137:   eh             = neweh;
    138:   return(0);
    139: }

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

    147:    Not Collective

    149:    Level: intermediate

    151:    Concepts: error handler^setting

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

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

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

    174:    Not Collective

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

    187:    Level: developer

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

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

    200:    Use PetscPushErrorHandler() to set the desired error handler.  The
    201:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
    202:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscAbortErrorHandler()

    204:    Concepts: error handler

    206: .seealso:  PetscPushErrorHandler(), PetscPopErrorHandler().
    207:  @*/

    209: PetscErrorCode  PetscReturnErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
    210: {
    212:   PetscFunctionReturn(n);
    213: }

    215: static char PetscErrorBaseMessage[1024];
    216: /*
    217:        The numerical values for these are defined in include/petscerror.h; any changes
    218:    there must also be made here
    219: */
    220: static const char *PetscErrorStrings[] = {
    221:   /*55 */ "Out of memory",
    222:           "No support for this operation for this object type",
    223:           "No support for this operation on this system",
    224:   /*58 */ "Operation done in wrong order",
    225:   /*59 */ "Signal received",
    226:   /*60 */ "Nonconforming object sizes",
    227:           "Argument aliasing not permitted",
    228:           "Invalid argument",
    229:   /*63 */ "Argument out of range",
    230:           "Corrupt argument:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#valgrind",
    231:           "Unable to open file",
    232:           "Read from file failed",
    233:           "Write to file failed",
    234:           "Invalid pointer",
    235:   /*69 */ "Arguments must have same type",
    236:   /*70 */ "Attempt to use a pointer that does not point to a valid accessible location",
    237:   /*71 */ "Detected zero pivot in LU factorization:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#ZeroPivot",
    238:   /*72 */ "Floating point exception",
    239:   /*73 */ "Object is in wrong state",
    240:           "Corrupted Petsc object",
    241:           "Arguments are incompatible",
    242:           "Error in external library",
    243:   /*77 */ "Petsc has generated inconsistent data",
    244:           "Memory corruption",
    245:           "Unexpected data in file",
    246:   /*80 */ "Arguments must have same communicators",
    247:   /*81 */ "Detected zero pivot in Cholesky factorization:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#ZeroPivot",
    248:           "  ",
    249:           "  ",
    250:           "Overflow in integer operation:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#64-bit-indices",
    251:   /*85 */ "Null argument, when expecting valid pointer",
    252:   /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type:\nsee http://www.mcs.anl.gov/petsc/documentation/installation.html#external",
    253:   /*87 */ "Not used",
    254:   /*88 */ "Error in system call",
    255:   /*89 */ "Object Type not set:\nsee http://www.mcs.anl.gov/petsc/documentation/faq.html#objecttypenotset"
    256:   /*90 */ "  ",
    257:   /*   */ "  ",
    258:   /*   */ "  ",
    259:   /*   */ "  ",
    260:   /*   */ "  ",
    261:   /*95 */ "  ",
    262: };

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

    269:    Not Collective

    271:    Input Parameter:
    272: .   errnum - the error code

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

    278:    Level: developer

    280:    Concepts: error handler^messages

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

    291:   if (specific) *specific = PetscErrorBaseMessage;
    292:   return(0);
    293: }

    295: #if defined(PETSC_CLANGUAGE_CXX)
    296: /* C++ exceptions are formally not allowed to propagate through extern "C" code. In practice, far too much software
    297:  * would be broken if implementations did not handle it it some common cases. However, keep in mind
    298:  *
    299:  *   Rule 62. Don't allow exceptions to propagate across module boundaries
    300:  *
    301:  * in "C++ Coding Standards" by Sutter and Alexandrescu. (This accounts for part of the ongoing C++ binary interface
    302:  * instability.) Having PETSc raise errors as C++ exceptions was probably misguided and should eventually be removed.
    303:  */
    304: static void PetscCxxErrorThrow() {
    305:   const char *str;
    306:   if (eh && eh->ctx) {
    307:     std::ostringstream *msg;
    308:     msg = (std::ostringstream*) eh->ctx;
    309:     str = msg->str().c_str();
    310:   } else str = "Error detected in C PETSc";

    312:   throw PETSc::Exception(str);
    313: }
    314: #endif

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

    322:    Not Collective

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

    335:   Level: intermediate

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

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

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

    349:    Concepts: error^setting condition

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

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

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

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

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

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

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

    398: /* -------------------------------------------------------------------------*/

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

    405:     Collective on PetscViewer

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

    412:   Level: intermediate

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

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

    426:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    429:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

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

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

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

    494:     Collective on PetscViewer

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

    501:   Level: intermediate

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

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

    515:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    518:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

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

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

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

    583:     Collective on PetscViewer

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

    590:   Level: intermediate

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

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

    604:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    607:   PetscObjectGetComm((PetscObject)viewer,&comm);

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

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

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