Actual source code: err.c

      1: #define PETSC_DLL
      2: /*
      3:       Code that allows one to set the error handlers
      4: */
     5:  #include petsc.h
     6:  #include petscsys.h
      7: #include <stdarg.h>
      8: #if defined(PETSC_HAVE_STDLIB_H)
      9: #include <stdlib.h>
     10: #endif

     12: typedef struct _EH *EH;
     13: struct _EH {
     14:   int            cookie;
     15:   PetscErrorCode (*handler)(int,const char*,const char*,const char *,PetscErrorCode,int,const char*,void *);
     16:   void           *ctx;
     17:   EH             previous;
     18: };

     20: static EH eh = 0;

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

     28:    Not Collective

     30:    Input Parameters:
     31: +  line - the line number of the error (indicated by __LINE__)
     32: .  func - the function where error is detected (indicated by __FUNCT__)
     33: .  file - the file in which the error was detected (indicated by __FILE__)
     34: .  dir - the directory of the file (indicated by __SDIR__)
     35: .  mess - an error text string, usually just printed to the screen
     36: .  n - the generic error number
     37: .  p - specific error number
     38: -  ctx - error handler context

     40:    Options Database Key:
     41: .   -on_error_emacs <machinename>

     43:    Level: developer

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

     48:    Most users need not directly employ this routine and the other error
     49:    handlers, but can instead use the simplified interface SETERRQ, which has
     50:    the calling sequence
     51: $     SETERRQ(number,p,mess)

     53:    Notes for experienced users:
     54:    Use PetscPushErrorHandler() to set the desired error handler.  The
     55:    currently available PETSc error handlers include PetscTraceBackErrorHandler(),
     56:    PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscStopErrorHandler()

     58:    Concepts: emacs^going to on error
     59:    Concepts: error handler^going to line in emacs

     61: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
     62:           PetscAbortErrorHandler()
     63:  @*/
     64: PetscErrorCode PETSC_DLLEXPORT PetscEmacsClientErrorHandler(int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,void *ctx)
     65: {
     67:   char        command[PETSC_MAX_PATH_LEN];
     68:   const char  *pdir;
     69:   FILE        *fp;

     72:   /* Note: don't check error codes since this an error handler :-) */
     73:   PetscGetPetscDir(&pdir);
     74:   sprintf(command,"emacsclient +%d %s/%s%s\n",line,pdir,dir,file);
     75: #if defined(PETSC_HAVE_POPEN)
     76:   PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
     77:   PetscPClose(MPI_COMM_WORLD,fp);
     78: #else
     79:   SETERRQ(PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
     80: #endif
     81:   PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
     82:   if (!eh)     PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0);
     83:   else         (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx);
     84:   PetscFunctionReturn(ierr);
     85: }

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

     92:    Not Collective

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

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

    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 - the specific error number
    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: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()

    119: @*/
    120: PetscErrorCode PETSC_DLLEXPORT PetscPushErrorHandler(PetscErrorCode (*handler)(int,const char *,const char*,const char*,PetscErrorCode,int,const char*,void*),void *ctx)
    121: {
    122:   EH  neweh;

    126:   PetscNew(struct _EH,&neweh);
    127:   if (eh) {neweh->previous = eh;}
    128:   else    {neweh->previous = 0;}
    129:   neweh->handler = handler;
    130:   neweh->ctx     = ctx;
    131:   eh             = neweh;
    132:   return(0);
    133: }

    137: /*@C
    138:    PetscPopErrorHandler - Removes the latest error handler that was
    139:    pushed with PetscPushErrorHandler().

    141:    Not Collective

    143:    Level: intermediate

    145:    Concepts: error handler^setting

    147: .seealso: PetscPushErrorHandler()
    148: @*/
    149: PetscErrorCode PETSC_DLLEXPORT PetscPopErrorHandler(void)
    150: {
    151:   EH  tmp;

    155:   if (!eh) return(0);
    156:   tmp  = eh;
    157:   eh   = eh->previous;
    158:   PetscFree(tmp);

    160:   return(0);
    161: }
    162:
    163: static char PetscErrorBaseMessage[1024];
    164: /*
    165:        The numerical values for these are defined in include/petscerror.h; any changes
    166:    there must also be made here
    167: */
    168: static const char *PetscErrorStrings[] = {
    169:   /*55 */ "Out of memory",
    170:           "No support for this operation for this object type",
    171:           "No support for this operation on this system",
    172:   /*58 */ "Operation done in wrong order",
    173:   /*59 */ "Signal received",
    174:   /*60 */ "Nonconforming object sizes",
    175:           "Argument aliasing not permitted",
    176:           "Invalid argument",
    177:   /*63 */ "Argument out of range",
    178:           "Corrupt argument: see http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#Corrupt",
    179:           "Unable to open file",
    180:           "Read from file failed",
    181:           "Write to file failed",
    182:           "Invalid pointer",
    183:   /*69 */ "Arguments must have same type",
    184:           "",
    185:   /*71 */ "Detected zero pivot in LU factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
    186:   /*72 */ "Floating point exception",
    187:   /*73 */ "Object is in wrong state",
    188:           "Corrupted Petsc object",
    189:           "Arguments are incompatible",
    190:           "Error in external library",
    191:   /*77 */ "Petsc has generated inconsistent data",
    192:           "Memory corruption",
    193:           "Unexpected data in file",
    194:   /*80 */ "Arguments must have same communicators",
    195:   /*81 */ "Detected zero pivot in Cholesky factorization\nsee http://www.mcs.anl.gov/petsc/petsc-as/documentation/troubleshooting.html#ZeroPivot",
    196:           "  ",
    197:           "  ",
    198:           "  ",
    199:   /*85 */ "Null argument, when expecting valid pointer",
    200:   /*86 */ "Unknown type. Check for miss-spelling or missing external package needed for type"};

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

    207:    Not Collective

    209:    Input Parameter:
    210: .   errnum - the error code

    212:    Output Parameter:
    213: +  text - the error message (PETSC_NULL if not desired)
    214: -  specific - the specific error message that was set with SETERRxxx() or PetscError().  (PETSC_NULL if not desired)

    216:    Level: developer

    218:    Concepts: error handler^messages

    220: .seealso:  PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
    221:           PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
    222:  @*/
    223: PetscErrorCode PETSC_DLLEXPORT PetscErrorMessage(int errnum,const char *text[],char **specific)
    224: {
    226:   if (text && errnum >= PETSC_ERR_MEM && errnum <= PETSC_ERR_MEM_MALLOC_0) {
    227:     *text = PetscErrorStrings[errnum-PETSC_ERR_MEM];
    228:   } else if (text) *text = 0;

    230:   if (specific) {
    231:     *specific = PetscErrorBaseMessage;
    232:   }
    233:   return(0);
    234: }

    236: #if defined(PETSC_USE_ERRORCHECKING)
    237: PetscErrorCode PETSC_DLLEXPORT PetscErrorUncatchable[PETSC_EXCEPTIONS_MAX] = {0};
    238: PetscInt       PETSC_DLLEXPORT PetscErrorUncatchableCount                  = 0;
    239: PetscErrorCode PETSC_DLLEXPORT PetscExceptions[PETSC_EXCEPTIONS_MAX]       = {0};
    240: PetscInt       PETSC_DLLEXPORT PetscExceptionsCount                        = 0;
    241: PetscErrorCode PETSC_DLLEXPORT PetscExceptionTmp                           = 0;

    245: static PetscTruth PetscErrorIsCatchable(PetscErrorCode err)
    246: {
    247:   PetscInt i;
    248:   for (i=0; i<PetscErrorUncatchableCount; i++) {
    249:     if (err == PetscErrorUncatchable[i]) return PETSC_FALSE;
    250:   }
    251:   return PETSC_TRUE;
    252: }

    256: /*@
    257:       PetscErrorSetCatchable - Sets if a PetscErrorCode can be caught with a PetscExceptionTry1()
    258:     PetscExceptionCaught() pair. By default all errors are catchable.

    260:   Input Parameters:
    261: +   err - error code
    262: -   flg - PETSC_TRUE means allow to be caught, PETSC_FALSE means do not allow to be caught

    264:   Level: advanced

    266:    Notes:
    267:     PETSc must not be configured using the option --with-errorchecking=0 for this to work

    269: .seealso: PetscExceptionTry1(), PetscExceptionCaught()
    270: @*/
    271: PetscErrorCode PETSC_DLLEXPORT PetscErrorSetCatchable(PetscErrorCode err,PetscTruth flg)
    272: {
    274:   if (!flg && PetscErrorIsCatchable(err)) {
    275:     /* add to list of uncatchable */
    276:     if (PetscErrorUncatchableCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscErrorUncatchable is overflowed, recompile \nsrc/sys/srcd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX");
    277:     PetscErrorUncatchable[PetscErrorUncatchableCount++] = err;
    278:   } else if (flg && !PetscErrorIsCatchable(err)) {
    279:     /* remove from list of uncatchable */
    280:     PetscInt i;
    281:     for (i=0; i<PetscErrorUncatchableCount; i++) {
    282:       if (PetscErrorUncatchable[i] == err) break;
    283:     }
    284:     for (;i<PetscErrorUncatchableCount; i++) {
    285:       PetscErrorUncatchable[i] = PetscErrorUncatchable[i+1];
    286:     }
    287:     PetscErrorUncatchableCount--;
    288:   }
    289:   return(0);
    290: }

    294: PetscErrorCode PETSC_DLLEXPORT PetscExceptionPush(PetscErrorCode err)
    295: {
    297:   if (PetscExceptionsCount >= PETSC_EXCEPTIONS_MAX) SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is overflowed, recompile \nsrc/sys/srcd/error/err.c with a larger value for PETSC_EXCEPTIONS_MAX");
    298:   if (PetscErrorIsCatchable(err)) PetscExceptions[PetscExceptionsCount++] = err;
    299:   return(0);
    300: }

    304: void PETSC_DLLEXPORT PetscExceptionPop(PetscErrorCode err)
    305: {
    306:   /* if (PetscExceptionsCount <= 0)SETERRQ(PETSC_ERR_PLIB,"Stack for PetscExceptions is empty"); */
    307:   if (PetscErrorIsCatchable(err)) PetscExceptionsCount--;
    308: }
    309: #endif

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

    317:    Not Collective

    319:    Input Parameters:
    320: +  line - the line number of the error (indicated by __LINE__)
    321: .  func - the function where the error occured (indicated by __FUNCT__)
    322: .  dir - the directory of file (indicated by __SDIR__)
    323: .  file - the file in which the error was detected (indicated by __FILE__)
    324: .  mess - an error text string, usually just printed to the screen
    325: .  n - the generic error number
    326: .  p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
    327:    previously detected error
    328: -  mess - formatted message string - aka printf

    330:   Level: intermediate

    332:    Notes:
    333:    Most users need not directly use this routine and the error handlers, but
    334:    can instead use the simplified interface SETERRQ, which has the calling
    335:    sequence
    336: $     SETERRQ(n,mess)

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

    340:    Concepts: error^setting condition

    342: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
    343: @*/
    344: PetscErrorCode PETSC_DLLEXPORT PetscError(int line,const char *func,const char* file,const char *dir,PetscErrorCode n,int p,const char *mess,...)
    345: {
    346:   va_list        Argp;
    348:   char           buf[2048],*lbuf = 0;
    349:   PetscTruth     ismain,isunknown;
    350: #if defined(PETSC_USE_ERRORCHECKING)
    351:   PetscInt       i;
    352: #endif

    354:   if (!func)  func = "User provided function";
    355:   if (!file)  file = "User file";
    356:   if (!dir)   dir = " ";

    359:   /* Compose the message evaluating the print format */
    360:   if (mess) {
    361:     va_start(Argp,mess);
    362:     PetscVSNPrintf(buf,2048,mess,Argp);
    363:     va_end(Argp);
    364:     lbuf = buf;
    365:     if (p == 1) {
    366:       PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
    367:     }
    368:   }

    370: #if defined(PETSC_USE_ERRORCHECKING)
    371:   /* check if user is catching this exception */
    372:   for (i=0; i<PetscExceptionsCount; i++) {
    373:     if (n == PetscExceptions[i])  PetscFunctionReturn(n);
    374:   }
    375: #endif

    377:   if (!eh)     PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
    378:   else         (*eh->handler)(line,func,file,dir,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) {
    390:     MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
    391:   }
    392:   PetscFunctionReturn(ierr);
    393: }

    395: /* -------------------------------------------------------------------------*/

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

    402:     Collective on PetscViewer

    404:     Input Parameters:
    405: +   N - number of integers in array
    406: .   idx - array of integers
    407: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

    409:   Level: intermediate

    411: .seealso: PetscRealView()
    412: @*/
    413: PetscErrorCode PETSC_DLLEXPORT PetscIntView(PetscInt N,PetscInt idx[],PetscViewer viewer)
    414: {
    416:   PetscInt       j,i,n = N/20,p = N % 20;
    417:   PetscTruth     iascii,issocket;
    418:   MPI_Comm       comm;

    421:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    424:   PetscObjectGetComm((PetscObject)viewer,&comm);

    426:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
    427:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
    428:   if (iascii) {
    429:     for (i=0; i<n; i++) {
    430:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*i);
    431:       for (j=0; j<20; j++) {
    432:         PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[i*20+j]);
    433:       }
    434:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    435:     }
    436:     if (p) {
    437:       PetscViewerASCIISynchronizedPrintf(viewer,"%D:",20*n);
    438:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %D",idx[20*n+i]);}
    439:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    440:     }
    441:     PetscViewerFlush(viewer);
    442: #if defined(PETSC_USE_SOCKET_VIEWER)
    443:   } else if (issocket) {
    444:     PetscMPIInt rank,size,*sizes,Ntotal,*displs, NN = (PetscMPIInt)N;
    445:     PetscInt    *array;
    446:     MPI_Comm_rank(comm,&rank);
    447:     MPI_Comm_size(comm,&size);

    449:     if (size > 1) {
    450:       if (rank) {
    451:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
    452:         MPI_Gatherv(idx,NN,MPIU_INT,0,0,0,MPIU_INT,0,comm);
    453:       } else {
    454:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
    455:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPIU_INT,0,comm);
    456:         Ntotal    = sizes[0];
    457:         PetscMalloc(size*sizeof(PetscMPIInt),&displs);
    458:         displs[0] = 0;
    459:         for (i=1; i<size; i++) {
    460:           Ntotal    += sizes[i];
    461:           displs[i] =  displs[i-1] + sizes[i-1];
    462:         }
    463:         PetscMalloc(Ntotal*sizeof(PetscInt),&array);
    464:         MPI_Gatherv(idx,NN,MPIU_INT,array,sizes,displs,MPIU_INT,0,comm);
    465:         PetscViewerSocketPutInt(viewer,Ntotal,array);
    466:         PetscFree(sizes);
    467:         PetscFree(displs);
    468:         PetscFree(array);
    469:       }
    470:     } else {
    471:       PetscViewerSocketPutInt(viewer,N,idx);
    472:     }
    473: #endif
    474:   } else {
    475:     const char *tname;
    476:     PetscObjectGetName((PetscObject)viewer,&tname);
    477:     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
    478:   }
    479:   return(0);
    480: }

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

    487:     Collective on PetscViewer

    489:     Input Parameters:
    490: +   N - number of doubles in array
    491: .   idx - array of doubles
    492: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

    494:   Level: intermediate

    496: .seealso: PetscIntView()
    497: @*/
    498: PetscErrorCode PETSC_DLLEXPORT PetscRealView(PetscInt N,PetscReal idx[],PetscViewer viewer)
    499: {
    501:   PetscInt       j,i,n = N/5,p = N % 5;
    502:   PetscTruth     iascii,issocket;
    503:   MPI_Comm       comm;

    506:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    509:   PetscObjectGetComm((PetscObject)viewer,&comm);

    511:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
    512:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
    513:   if (iascii) {
    514:     for (i=0; i<n; i++) {
    515:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
    516:       for (j=0; j<5; j++) {
    517:          PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
    518:       }
    519:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    520:     }
    521:     if (p) {
    522:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
    523:       for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
    524:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    525:     }
    526:     PetscViewerFlush(viewer);
    527: #if defined(PETSC_USE_SOCKET_VIEWER)
    528:   } else if (issocket) {
    529:     PetscMPIInt rank,size,*sizes,*displs, Ntotal,NN = (PetscMPIInt)N;
    530:     PetscReal   *array;

    532:     MPI_Comm_rank(comm,&rank);
    533:     MPI_Comm_size(comm,&size);

    535:     if (size > 1) {
    536:       if (rank) {
    537:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
    538:         MPI_Gatherv(idx,NN,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
    539:       } else {
    540:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
    541:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
    542:         Ntotal = sizes[0];
    543:         PetscMalloc(size*sizeof(PetscMPIInt),&displs);
    544:         displs[0] = 0;
    545:         for (i=1; i<size; i++) {
    546:           Ntotal    += sizes[i];
    547:           displs[i] =  displs[i-1] + sizes[i-1];
    548:         }
    549:         PetscMalloc(Ntotal*sizeof(PetscReal),&array);
    550:         MPI_Gatherv(idx,NN,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
    551:         PetscViewerSocketPutReal(viewer,Ntotal,1,array);
    552:         PetscFree(sizes);
    553:         PetscFree(displs);
    554:         PetscFree(array);
    555:       }
    556:     } else {
    557:       PetscViewerSocketPutReal(viewer,N,1,idx);
    558:     }
    559: #endif
    560:   } else {
    561:     const char *tname;
    562:     PetscObjectGetName((PetscObject)viewer,&tname);
    563:     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
    564:   }
    565:   return(0);
    566: }

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

    573:     Collective on PetscViewer

    575:     Input Parameters:
    576: +   N - number of scalars in array
    577: .   idx - array of scalars
    578: -   viewer - location to print array,  PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0

    580:   Level: intermediate

    582: .seealso: PetscIntView(), PetscRealView()
    583: @*/
    584: PetscErrorCode PETSC_DLLEXPORT PetscScalarView(PetscInt N,PetscScalar idx[],PetscViewer viewer)
    585: {
    587:   PetscInt       j,i,n = N/3,p = N % 3;
    588:   PetscTruth     iascii,issocket;
    589:   MPI_Comm       comm;

    592:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
    595:   PetscObjectGetComm((PetscObject)viewer,&comm);

    597:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
    598:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
    599:   if (iascii) {
    600:     for (i=0; i<n; i++) {
    601:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
    602:       for (j=0; j<3; j++) {
    603: #if defined (PETSC_USE_COMPLEX)
    604:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
    605:                                  PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
    606: #else
    607:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
    608: #endif
    609:       }
    610:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    611:     }
    612:     if (p) {
    613:       PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
    614:       for (i=0; i<p; i++) {
    615: #if defined (PETSC_USE_COMPLEX)
    616:         PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
    617:                                  PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
    618: #else
    619:         PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
    620: #endif
    621:       }
    622:       PetscViewerASCIISynchronizedPrintf(viewer,"\n");
    623:     }
    624:     PetscViewerFlush(viewer);
    625: #if defined(PETSC_USE_SOCKET_VIEWER)
    626:   } else if (issocket) {
    627:     PetscMPIInt size,rank,*sizes,Ntotal,*displs,NN = (PetscMPIInt)N;
    628:     PetscScalar *array;

    630:     MPI_Comm_rank(comm,&rank);
    631:     MPI_Comm_size(comm,&size);

    633:     if (size > 1) {
    634:       if (rank) {
    635:         MPI_Gather(&NN,1,MPI_INT,0,0,MPI_INT,0,comm);
    636:         MPI_Gatherv(idx,NN,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
    637:       } else {
    638:         PetscMalloc(size*sizeof(PetscMPIInt),&sizes);
    639:         MPI_Gather(&NN,1,MPI_INT,sizes,1,MPI_INT,0,comm);
    640:         Ntotal = sizes[0];
    641:         PetscMalloc(size*sizeof(PetscMPIInt),&displs);
    642:         displs[0] = 0;
    643:         for (i=1; i<size; i++) {
    644:           Ntotal    += sizes[i];
    645:           displs[i] =  displs[i-1] + sizes[i-1];
    646:         }
    647:         PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
    648:         MPI_Gatherv(idx,NN,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
    649:         PetscViewerSocketPutScalar(viewer,Ntotal,1,array);
    650:         PetscFree(sizes);
    651:         PetscFree(displs);
    652:         PetscFree(array);
    653:       }
    654:     } else {
    655:       PetscViewerSocketPutScalar(viewer,N,1,idx);
    656:     }
    657: #endif
    658:   } else {
    659:     const char *tname;
    660:     PetscObjectGetName((PetscObject)viewer,&tname);
    661:     SETERRQ1(PETSC_ERR_SUP,"Cannot handle that PetscViewer of type %s",tname);
    662:   }
    663:   return(0);
    664: }