Date: 2013-07-02T14:40:27+00:00

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

      2: /*
      3:      Provides the functions for index sets (IS) defined by a list of integers.
      4:    These are for blocks of data, each block is indicated with a single integer.
      5: */
      6: #include <petsc-private/isimpl.h>               /*I  "petscis.h"     I*/
      7: #include <petscvec.h>
      8: #include <petscviewer.h>

     10: typedef struct {
     11:   PetscInt  N,n;                  /* number of blocks */
     12:   PetscBool sorted;             /* are the blocks sorted? */
     13:   PetscInt  *idx;
     14: } IS_Block;

     18: PetscErrorCode ISDestroy_Block(IS is)
     19: {
     20:   IS_Block       *is_block = (IS_Block*)is->data;

     24:   PetscFree(is_block->idx);
     25:   PetscObjectComposeFunction((PetscObject)is,"ISBlockSetIndices_C",0);
     26:   PetscObjectComposeFunction((PetscObject)is,"ISBlockGetIndices_C",0);
     27:   PetscObjectComposeFunction((PetscObject)is,"ISBlockRestoreIndices_C",0);
     28:   PetscObjectComposeFunction((PetscObject)is,"ISBlockGetSize_C",0);
     29:   PetscObjectComposeFunction((PetscObject)is,"ISBlockGetLocalSize_C",0);
     30:   PetscFree(is->data);
     31:   return(0);
     32: }

     36: PetscErrorCode ISGetIndices_Block(IS in,const PetscInt *idx[])
     37: {
     38:   IS_Block       *sub = (IS_Block*)in->data;
     40:   PetscInt       i,j,k,bs = in->bs,n = sub->n,*ii,*jj;

     43:   if (bs == 1) *idx = sub->idx;
     44:   else {
     45:     PetscMalloc(bs*n*sizeof(PetscInt),&jj);
     46:     *idx = jj;
     47:     k    = 0;
     48:     ii   = sub->idx;
     49:     for (i=0; i<n; i++)
     50:       for (j=0; j<bs; j++)
     51:         jj[k++] = bs*ii[i] + j;
     52:   }
     53:   return(0);
     54: }

     58: PetscErrorCode ISRestoreIndices_Block(IS in,const PetscInt *idx[])
     59: {
     60:   IS_Block       *sub = (IS_Block*)in->data;

     64:   if (in->bs != 1) {
     65:     PetscFree(*(void**)idx);
     66:   } else {
     67:     if (*idx !=  sub->idx) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must restore with value from ISGetIndices()");
     68:   }
     69:   return(0);
     70: }

     74: PetscErrorCode ISGetSize_Block(IS is,PetscInt *size)
     75: {
     76:   IS_Block *sub = (IS_Block*)is->data;

     79:   *size = is->bs*sub->N;
     80:   return(0);
     81: }

     85: PetscErrorCode ISGetLocalSize_Block(IS is,PetscInt *size)
     86: {
     87:   IS_Block *sub = (IS_Block*)is->data;

     90:   *size = is->bs*sub->n;
     91:   return(0);
     92: }

     96: PetscErrorCode ISInvertPermutation_Block(IS is,PetscInt nlocal,IS *isout)
     97: {
     98:   IS_Block       *sub = (IS_Block*)is->data;
     99:   PetscInt       i,*ii,n = sub->n,*idx = sub->idx;
    100:   PetscMPIInt    size;

    104:   MPI_Comm_size(PetscObjectComm((PetscObject)is),&size);
    105:   if (size == 1) {
    106:     PetscMalloc(n*sizeof(PetscInt),&ii);
    107:     for (i=0; i<n; i++) ii[idx[i]] = i;
    108:     ISCreateBlock(PETSC_COMM_SELF,is->bs,n,ii,PETSC_OWN_POINTER,isout);
    109:     ISSetPermutation(*isout);
    110:   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No inversion written yet for block IS");
    111:   return(0);
    112: }

    116: PetscErrorCode ISView_Block(IS is, PetscViewer viewer)
    117: {
    118:   IS_Block       *sub = (IS_Block*)is->data;
    120:   PetscInt       i,n = sub->n,*idx = sub->idx;
    121:   PetscBool      iascii;

    124:   PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
    125:   if (iascii) {
    126:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
    127:     if (is->isperm) {
    128:       PetscViewerASCIISynchronizedPrintf(viewer,"Block Index set is permutation\n");
    129:     }
    130:     PetscViewerASCIISynchronizedPrintf(viewer,"Block size %D\n",is->bs);
    131:     PetscViewerASCIISynchronizedPrintf(viewer,"Number of block indices in set %D\n",n);
    132:     PetscViewerASCIISynchronizedPrintf(viewer,"The first indices of each block are\n");
    133:     for (i=0; i<n; i++) {
    134:       PetscViewerASCIISynchronizedPrintf(viewer,"Block %D Index %D\n",i,idx[i]);
    135:     }
    136:     PetscViewerFlush(viewer);
    137:     PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
    138:   }
    139:   return(0);
    140: }

    144: PetscErrorCode ISSort_Block(IS is)
    145: {
    146:   IS_Block       *sub = (IS_Block*)is->data;

    150:   if (sub->sorted) return(0);
    151:   PetscSortInt(sub->n,sub->idx);
    152:   sub->sorted = PETSC_TRUE;
    153:   return(0);
    154: }

    158: PetscErrorCode ISSorted_Block(IS is,PetscBool  *flg)
    159: {
    160:   IS_Block *sub = (IS_Block*)is->data;

    163:   *flg = sub->sorted;
    164:   return(0);
    165: }

    169: PetscErrorCode ISDuplicate_Block(IS is,IS *newIS)
    170: {
    172:   IS_Block       *sub = (IS_Block*)is->data;

    175:   ISCreateBlock(PetscObjectComm((PetscObject)is),is->bs,sub->n,sub->idx,PETSC_COPY_VALUES,newIS);
    176:   return(0);
    177: }

    181: PetscErrorCode ISIdentity_Block(IS is,PetscBool  *ident)
    182: {
    183:   IS_Block *is_block = (IS_Block*)is->data;
    184:   PetscInt i,n = is_block->n,*idx = is_block->idx,bs = is->bs;

    187:   is->isidentity = PETSC_TRUE;
    188:   *ident         = PETSC_TRUE;
    189:   for (i=0; i<n; i++) {
    190:     if (idx[i] != bs*i) {
    191:       is->isidentity = PETSC_FALSE;
    192:       *ident         = PETSC_FALSE;
    193:       return(0);
    194:     }
    195:   }
    196:   return(0);
    197: }

    201: static PetscErrorCode ISCopy_Block(IS is,IS isy)
    202: {
    203:   IS_Block       *is_block = (IS_Block*)is->data,*isy_block = (IS_Block*)isy->data;

    207:   if (is_block->n != isy_block->n || is_block->N != isy_block->N || is->bs != isy->bs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Index sets incompatible");
    208:   isy_block->sorted = is_block->sorted;
    209:   PetscMemcpy(isy_block->idx,is_block->idx,is_block->n*sizeof(PetscInt));
    210:   return(0);
    211: }

    215: static PetscErrorCode ISOnComm_Block(IS is,MPI_Comm comm,PetscCopyMode mode,IS *newis)
    216: {
    218:   IS_Block       *sub = (IS_Block*)is->data;

    221:   if (mode == PETSC_OWN_POINTER) SETERRQ(comm,PETSC_ERR_ARG_WRONG,"Cannot use PETSC_OWN_POINTER");
    222:   ISCreateBlock(comm,is->bs,sub->n,sub->idx,mode,newis);
    223:   return(0);
    224: }

    228: static PetscErrorCode ISSetBlockSize_Block(IS is,PetscInt bs)
    229: {
    231:   if (is->bs != bs) SETERRQ2(PetscObjectComm((PetscObject)is),PETSC_ERR_ARG_SIZ,"Cannot change block size for ISBLOCK from %D to %D",is->bs,bs);
    232:   return(0);
    233: }

    236: static struct _ISOps myops = { ISGetSize_Block,
    237:                                ISGetLocalSize_Block,
    238:                                ISGetIndices_Block,
    239:                                ISRestoreIndices_Block,
    240:                                ISInvertPermutation_Block,
    241:                                ISSort_Block,
    242:                                ISSorted_Block,
    243:                                ISDuplicate_Block,
    244:                                ISDestroy_Block,
    245:                                ISView_Block,
    246:                                ISIdentity_Block,
    247:                                ISCopy_Block,
    248:                                0,
    249:                                ISOnComm_Block,
    250:                                ISSetBlockSize_Block,
    251:                                0};

    255: /*@
    256:    ISBlockSetIndices - The indices are relative to entries, not blocks.

    258:    Collective on IS

    260:    Input Parameters:
    261: +  is - the index set
    262: .  bs - number of elements in each block, one for each block and count of block not indices
    263: .   n - the length of the index set (the number of blocks)
    264: .  idx - the list of integers, these are by block, not by location
    265: +  mode - see PetscCopyMode, only PETSC_COPY_VALUES and PETSC_OWN_POINTER are supported

    268:    Notes:
    269:    When the communicator is not MPI_COMM_SELF, the operations on the
    270:    index sets, IS, are NOT conceptually the same as MPI_Group operations.
    271:    The index sets are then distributed sets of indices and thus certain operations
    272:    on them are collective.

    274:    Example:
    275:    If you wish to index the values {0,1,4,5}, then use
    276:    a block size of 2 and idx of {0,2}.

    278:    Level: beginner

    280:   Concepts: IS^block
    281:   Concepts: index sets^block
    282:   Concepts: block^index set

    284: .seealso: ISCreateStride(), ISCreateGeneral(), ISAllGather()
    285: @*/
    286: PetscErrorCode  ISBlockSetIndices(IS is,PetscInt bs,PetscInt n,const PetscInt idx[],PetscCopyMode mode)
    287: {

    291:   PetscUseMethod(is,"ISBlockSetIndices_C",(IS,PetscInt,PetscInt,const PetscInt[],PetscCopyMode),(is,bs,n,idx,mode));
    292:   return(0);
    293: }

    297: PetscErrorCode  ISBlockSetIndices_Block(IS is,PetscInt bs,PetscInt n,const PetscInt idx[],PetscCopyMode mode)
    298: {
    300:   PetscInt       i,min,max;
    301:   IS_Block       *sub   = (IS_Block*)is->data;
    302:   PetscBool      sorted = PETSC_TRUE;

    305:   PetscFree(sub->idx);
    306:   sub->n = n;
    307:   MPI_Allreduce(&n,&sub->N,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)is));
    308:   for (i=1; i<n; i++) {
    309:     if (idx[i] < idx[i-1]) {sorted = PETSC_FALSE; break;}
    310:   }
    311:   if (n) min = max = idx[0];
    312:   else   min = max = 0;
    313:   for (i=1; i<n; i++) {
    314:     if (idx[i] < min) min = idx[i];
    315:     if (idx[i] > max) max = idx[i];
    316:   }
    317:   if (mode == PETSC_COPY_VALUES) {
    318:     PetscMalloc(n*sizeof(PetscInt),&sub->idx);
    319:     PetscLogObjectMemory(is,n*sizeof(PetscInt));
    320:     PetscMemcpy(sub->idx,idx,n*sizeof(PetscInt));
    321:   } else if (mode == PETSC_OWN_POINTER) sub->idx = (PetscInt*) idx;
    322:   else SETERRQ(PetscObjectComm((PetscObject)is),PETSC_ERR_SUP,"Only supports PETSC_COPY_VALUES and PETSC_OWN_POINTER");

    324:   sub->sorted = sorted;
    325:   is->bs      = bs;
    326:   is->min     = bs*min;
    327:   is->max     = bs*max+bs-1;
    328:   is->data    = (void*)sub;
    329:   PetscMemcpy(is->ops,&myops,sizeof(myops));
    330:   is->isperm  = PETSC_FALSE;
    331:   return(0);
    332: }

    336: /*@
    337:    ISCreateBlock - Creates a data structure for an index set containing
    338:    a list of integers. The indices are relative to entries, not blocks.

    340:    Collective on MPI_Comm

    342:    Input Parameters:
    343: +  comm - the MPI communicator
    344: .  bs - number of elements in each block
    345: .  n - the length of the index set (the number of blocks)
    346: .  idx - the list of integers, one for each block and count of block not indices
    347: -  mode - see PetscCopyMode, only PETSC_COPY_VALUES and PETSC_OWN_POINTER are supported in this routine

    349:    Output Parameter:
    350: .  is - the new index set

    352:    Notes:
    353:    When the communicator is not MPI_COMM_SELF, the operations on the
    354:    index sets, IS, are NOT conceptually the same as MPI_Group operations.
    355:    The index sets are then distributed sets of indices and thus certain operations
    356:    on them are collective.

    358:    Example:
    359:    If you wish to index the values {0,1,6,7}, then use
    360:    a block size of 2 and idx of {0,3}.

    362:    Level: beginner

    364:   Concepts: IS^block
    365:   Concepts: index sets^block
    366:   Concepts: block^index set

    368: .seealso: ISCreateStride(), ISCreateGeneral(), ISAllGather()
    369: @*/
    370: PetscErrorCode  ISCreateBlock(MPI_Comm comm,PetscInt bs,PetscInt n,const PetscInt idx[],PetscCopyMode mode,IS *is)
    371: {

    376:   if (n < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"length < 0");

    379:   ISCreate(comm,is);
    380:   ISSetType(*is,ISBLOCK);
    381:   ISBlockSetIndices(*is,bs,n,idx,mode);
    382:   return(0);
    383: }

    387: PetscErrorCode  ISBlockGetIndices_Block(IS is,const PetscInt *idx[])
    388: {
    389:   IS_Block *sub = (IS_Block*)is->data;

    392:   *idx = sub->idx;
    393:   return(0);
    394: }

    398: PetscErrorCode  ISBlockRestoreIndices_Block(IS is,const PetscInt *idx[])
    399: {
    401:   return(0);
    402: }

    406: /*@C
    407:    ISBlockGetIndices - Gets the indices associated with each block.

    409:    Not Collective

    411:    Input Parameter:
    412: .  is - the index set

    414:    Output Parameter:
    415: .  idx - the integer indices, one for each block and count of block not indices

    417:    Level: intermediate

    419:    Concepts: IS^block
    420:    Concepts: index sets^getting indices
    421:    Concepts: index sets^block

    423: .seealso: ISGetIndices(), ISBlockRestoreIndices()
    424: @*/
    425: PetscErrorCode  ISBlockGetIndices(IS is,const PetscInt *idx[])
    426: {

    430:   PetscUseMethod(is,"ISBlockGetIndices_C",(IS,const PetscInt*[]),(is,idx));
    431:   return(0);
    432: }

    436: /*@C
    437:    ISBlockRestoreIndices - Restores the indices associated with each block.

    439:    Not Collective

    441:    Input Parameter:
    442: .  is - the index set

    444:    Output Parameter:
    445: .  idx - the integer indices

    447:    Level: intermediate

    449:    Concepts: IS^block
    450:    Concepts: index sets^getting indices
    451:    Concepts: index sets^block

    453: .seealso: ISRestoreIndices(), ISBlockGetIndices()
    454: @*/
    455: PetscErrorCode  ISBlockRestoreIndices(IS is,const PetscInt *idx[])
    456: {

    460:   PetscUseMethod(is,"ISBlockRestoreIndices_C",(IS,const PetscInt*[]),(is,idx));
    461:   return(0);
    462: }

    466: /*@
    467:    ISBlockGetLocalSize - Returns the local number of blocks in the index set.

    469:    Not Collective

    471:    Input Parameter:
    472: .  is - the index set

    474:    Output Parameter:
    475: .  size - the local number of blocks

    477:    Level: intermediate

    479:    Concepts: IS^block sizes
    480:    Concepts: index sets^block sizes

    482: .seealso: ISGetBlockSize(), ISBlockGetSize(), ISGetSize(), ISCreateBlock()
    483: @*/
    484: PetscErrorCode  ISBlockGetLocalSize(IS is,PetscInt *size)
    485: {

    489:   PetscUseMethod(is,"ISBlockGetLocalSize_C",(IS,PetscInt*),(is,size));
    490:   return(0);
    491: }

    495: PetscErrorCode  ISBlockGetLocalSize_Block(IS is,PetscInt *size)
    496: {
    497:   IS_Block *sub = (IS_Block*)is->data;

    500:   *size = sub->n;
    501:   return(0);
    502: }

    506: /*@
    507:    ISBlockGetSize - Returns the global number of blocks in the index set.

    509:    Not Collective

    511:    Input Parameter:
    512: .  is - the index set

    514:    Output Parameter:
    515: .  size - the global number of blocks

    517:    Level: intermediate

    519:    Concepts: IS^block sizes
    520:    Concepts: index sets^block sizes

    522: .seealso: ISGetBlockSize(), ISBlockGetLocalSize(), ISGetSize(), ISCreateBlock()
    523: @*/
    524: PetscErrorCode  ISBlockGetSize(IS is,PetscInt *size)
    525: {

    529:   PetscUseMethod(is,"ISBlockGetSize_C",(IS,PetscInt*),(is,size));
    530:   return(0);
    531: }

    535: PetscErrorCode  ISBlockGetSize_Block(IS is,PetscInt *size)
    536: {
    537:   IS_Block *sub = (IS_Block*)is->data;

    540:   *size = sub->N;
    541:   return(0);
    542: }

    546: PetscErrorCode  ISToGeneral_Block(IS inis)
    547: {
    549:   const PetscInt *idx;
    550:   PetscInt       n;

    553:   ISGetLocalSize(inis,&n);
    554:   ISGetIndices(inis,&idx);
    555:   ISSetType(inis,ISGENERAL);
    556:   ISGeneralSetIndices(inis,n,idx,PETSC_OWN_POINTER);
    557:   return(0);
    558: }

    562: PETSC_EXTERN PetscErrorCode ISCreate_Block(IS is)
    563: {
    565:   IS_Block       *sub;

    568:   PetscNewLog(is,IS_Block,&sub);
    569:   is->data = sub;
    570:   PetscObjectComposeFunction((PetscObject)is,"ISBlockSetIndices_C",ISBlockSetIndices_Block);
    571:   PetscObjectComposeFunction((PetscObject)is,"ISBlockGetIndices_C",ISBlockGetIndices_Block);
    572:   PetscObjectComposeFunction((PetscObject)is,"ISBlockRestoreIndices_C",ISBlockRestoreIndices_Block);
    573:   PetscObjectComposeFunction((PetscObject)is,"ISBlockGetSize_C",ISBlockGetSize_Block);
    574:   PetscObjectComposeFunction((PetscObject)is,"ISBlockGetLocalSize_C",ISBlockGetLocalSize_Block);
    575:   return(0);
    576: }