Actual source code: block.c

  1: /*
  2:      Provides the functions for index sets (IS) defined by a list of integers.
  3:    These are for blocks of data, each block is indicated with a single integer.
  4: */
 5:  #include src/vec/is/isimpl.h
 6:  #include petscsys.h

  8: EXTERN PetscErrorCode VecInitializePackage(char *);

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

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

 25:   PetscFree(is_block->idx);
 26:   PetscFree(is_block);
 27:   PetscLogObjectDestroy(is);
 28:   PetscHeaderDestroy(is); return(0);
 29: }

 33: PetscErrorCode ISGetIndices_Block(IS in,PetscInt **idx)
 34: {
 35:   IS_Block       *sub = (IS_Block*)in->data;
 37:   PetscInt       i,j,k,bs = sub->bs,n = sub->n,*ii,*jj;

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

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

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

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

 81:   *size = sub->bs*sub->N;
 82:   return(0);
 83: }

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

 92:   *size = sub->bs*sub->n;
 93:   return(0);
 94: }

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

106:   MPI_Comm_size(is->comm,&size);
107:   if (size == 1) {
108:     PetscMalloc(n*sizeof(PetscInt),&ii);
109:     for (i=0; i<n; i++) {
110:       ii[idx[i]] = i;
111:     }
112:     ISCreateBlock(PETSC_COMM_SELF,sub->bs,n,ii,isout);
113:     ISSetPermutation(*isout);
114:     PetscFree(ii);
115:   } else {
116:     SETERRQ(PETSC_ERR_SUP,"No inversion written yet for block IS");
117:   }
118:   return(0);
119: }

123: PetscErrorCode ISView_Block(IS is, PetscViewer viewer)
124: {
125:   IS_Block       *sub = (IS_Block *)is->data;
127:   PetscInt       i,n = sub->n,*idx = sub->idx;
128:   PetscTruth     iascii;

131:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
132:   if (iascii) {
133:     if (is->isperm) {
134:       PetscViewerASCIISynchronizedPrintf(viewer,"Block Index set is permutation\n");
135:     }
136:     PetscViewerASCIISynchronizedPrintf(viewer,"Block size %D\n",sub->bs);
137:     PetscViewerASCIISynchronizedPrintf(viewer,"Number of block indices in set %D\n",n);
138:     PetscViewerASCIISynchronizedPrintf(viewer,"The first indices of each block are\n");
139:     for (i=0; i<n; i++) {
140:       PetscViewerASCIISynchronizedPrintf(viewer,"%D %D\n",i,idx[i]);
141:     }
142:     PetscViewerFlush(viewer);
143:   } else {
144:     SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported for this object",((PetscObject)viewer)->type_name);
145:   }
146:   return(0);
147: }

151: PetscErrorCode ISSort_Block(IS is)
152: {
153:   IS_Block       *sub = (IS_Block *)is->data;

157:   if (sub->sorted) return(0);
158:   PetscSortInt(sub->n,sub->idx);
159:   sub->sorted = PETSC_TRUE;
160:   return(0);
161: }

165: PetscErrorCode ISSorted_Block(IS is,PetscTruth *flg)
166: {
167:   IS_Block *sub = (IS_Block *)is->data;

170:   *flg = sub->sorted;
171:   return(0);
172: }

176: PetscErrorCode ISDuplicate_Block(IS is,IS *newIS)
177: {
179:   IS_Block       *sub = (IS_Block *)is->data;

182:   ISCreateBlock(is->comm,sub->bs,sub->n,sub->idx,newIS);
183:   return(0);
184: }

188: PetscErrorCode ISIdentity_Block(IS is,PetscTruth *ident)
189: {
190:   IS_Block *is_block = (IS_Block*)is->data;
191:   PetscInt i,n = is_block->n,*idx = is_block->idx,bs = is_block->bs;

194:   is->isidentity = PETSC_TRUE;
195:   *ident         = PETSC_TRUE;
196:   for (i=0; i<n; i++) {
197:     if (idx[i] != bs*i) {
198:       is->isidentity = PETSC_FALSE;
199:       *ident         = PETSC_FALSE;
200:       return(0);
201:     }
202:   }
203:   return(0);
204: }

206: static struct _ISOps myops = { ISGetSize_Block,
207:                                ISGetLocalSize_Block,
208:                                ISGetIndices_Block,
209:                                ISRestoreIndices_Block,
210:                                ISInvertPermutation_Block,
211:                                ISSort_Block,
212:                                ISSorted_Block,
213:                                ISDuplicate_Block,
214:                                ISDestroy_Block,
215:                                ISView_Block,
216:                                ISIdentity_Block };
219: /*@C
220:    ISCreateBlock - Creates a data structure for an index set containing
221:    a list of integers. The indices are relative to entries, not blocks. 

223:    Collective on MPI_Comm

225:    Input Parameters:
226: +  n - the length of the index set (the number of blocks)
227: .  bs - number of elements in each block
228: .  idx - the list of integers
229: -  comm - the MPI communicator

231:    Output Parameter:
232: .  is - the new index set

234:    Notes:
235:    When the communicator is not MPI_COMM_SELF, the operations on the 
236:    index sets, IS, are NOT conceptually the same as MPI_Group operations. 
237:    The index sets are then distributed sets of indices and thus certain operations
238:    on them are collective. 

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

244:    Level: beginner

246:   Concepts: IS^block
247:   Concepts: index sets^block
248:   Concepts: block^index set

250: .seealso: ISCreateStride(), ISCreateGeneral(), ISAllGather()
251: @*/
252: PetscErrorCode ISCreateBlock(MPI_Comm comm,PetscInt bs,PetscInt n,const PetscInt idx[],IS *is)
253: {
255:   PetscInt       i,min,max;
256:   IS             Nindex;
257:   IS_Block       *sub;
258:   PetscTruth     sorted = PETSC_TRUE;

262:   if (n < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"length < 0");
264:   *is = PETSC_NULL;
265: #ifndef PETSC_USE_DYNAMIC_LIBRARIES
266:   VecInitializePackage(PETSC_NULL);
267: #endif

269:   PetscHeaderCreate(Nindex,_p_IS,struct _ISOps,IS_COOKIE,IS_BLOCK,"IS",comm,ISDestroy,ISView);
270:   PetscLogObjectCreate(Nindex);
271:   PetscNew(IS_Block,&sub);
272:   PetscLogObjectMemory(Nindex,sizeof(IS_Block)+n*sizeof(PetscInt)+sizeof(struct _p_IS));
273:   PetscMalloc(n*sizeof(PetscInt),&sub->idx);
274:   sub->n = n;
275:   MPI_Allreduce(&n,&sub->N,1,MPIU_INT,MPI_SUM,comm);
276:   for (i=1; i<n; i++) {
277:     if (idx[i] < idx[i-1]) {sorted = PETSC_FALSE; break;}
278:   }
279:   if (n) {min = max = idx[0];} else {min = max = 0;}
280:   for (i=1; i<n; i++) {
281:     if (idx[i] < min) min = idx[i];
282:     if (idx[i] > max) max = idx[i];
283:   }
284:   PetscMemcpy(sub->idx,idx,n*sizeof(PetscInt));
285:   sub->sorted     = sorted;
286:   sub->bs         = bs;
287:   Nindex->min     = min;
288:   Nindex->max     = max;
289:   Nindex->data    = (void*)sub;
290:   PetscMemcpy(Nindex->ops,&myops,sizeof(myops));
291:   Nindex->isperm  = PETSC_FALSE;
292:   *is = Nindex; return(0);
293: }


298: /*@C
299:    ISBlockGetIndices - Gets the indices associated with each block.

301:    Not Collective

303:    Input Parameter:
304: .  is - the index set

306:    Output Parameter:
307: .  idx - the integer indices

309:    Level: intermediate

311:    Concepts: IS^block
312:    Concepts: index sets^getting indices
313:    Concepts: index sets^block

315: .seealso: ISGetIndices(), ISBlockRestoreIndices()
316: @*/
317: PetscErrorCode ISBlockGetIndices(IS in,PetscInt *idx[])
318: {
319:   IS_Block *sub;

324:   if (in->type != IS_BLOCK) SETERRQ(PETSC_ERR_ARG_WRONG,"Not a block index set");

326:   sub = (IS_Block*)in->data;
327:   *idx = sub->idx;
328:   return(0);
329: }

333: /*@C
334:    ISBlockRestoreIndices - Restores the indices associated with each block.

336:    Not Collective

338:    Input Parameter:
339: .  is - the index set

341:    Output Parameter:
342: .  idx - the integer indices

344:    Level: intermediate

346:    Concepts: IS^block
347:    Concepts: index sets^getting indices
348:    Concepts: index sets^block

350: .seealso: ISRestoreIndices(), ISBlockGetIndices()
351: @*/
352: PetscErrorCode ISBlockRestoreIndices(IS is,PetscInt *idx[])
353: {
357:   if (is->type != IS_BLOCK) SETERRQ(PETSC_ERR_ARG_WRONG,"Not a block index set");
358:   return(0);
359: }

363: /*@
364:    ISBlockGetBlockSize - Returns the number of elements in a block.

366:    Not Collective

368:    Input Parameter:
369: .  is - the index set

371:    Output Parameter:
372: .  size - the number of elements in a block

374:    Level: intermediate

376:    Concepts: IS^block size
377:    Concepts: index sets^block size

379: .seealso: ISBlockGetSize(), ISGetSize(), ISBlock(), ISCreateBlock()
380: @*/
381: PetscErrorCode ISBlockGetBlockSize(IS is,PetscInt *size)
382: {
383:   IS_Block *sub;

388:   if (is->type != IS_BLOCK) SETERRQ(PETSC_ERR_ARG_WRONG,"Not a block index set");

390:   sub = (IS_Block *)is->data;
391:   *size = sub->bs;
392:   return(0);
393: }

397: /*@C
398:    ISBlock - Checks whether an index set is blocked.

400:    Not Collective

402:    Input Parameter:
403: .  is - the index set

405:    Output Parameter:
406: .  flag - PETSC_TRUE if a block index set, else PETSC_FALSE

408:    Level: intermediate

410:    Concepts: IS^block
411:    Concepts: index sets^block

413: .seealso: ISBlockGetSize(), ISGetSize(), ISBlockGetBlockSize(), ISCreateBlock()
414: @*/
415: PetscErrorCode ISBlock(IS is,PetscTruth *flag)
416: {
420:   if (is->type != IS_BLOCK) *flag = PETSC_FALSE;
421:   else                          *flag = PETSC_TRUE;
422:   return(0);
423: }

427: /*@
428:    ISBlockGetSize - Returns the number of blocks in the index set.

430:    Not Collective

432:    Input Parameter:
433: .  is - the index set

435:    Output Parameter:
436: .  size - the number of blocks

438:    Level: intermediate

440:    Concepts: IS^block sizes
441:    Concepts: index sets^block sizes

443: .seealso: ISBlockGetBlockSize(), ISGetSize(), ISBlock(), ISCreateBlock()
444: @*/
445: PetscErrorCode ISBlockGetSize(IS is,PetscInt *size)
446: {
447:   IS_Block *sub;

452:   if (is->type != IS_BLOCK) SETERRQ(PETSC_ERR_ARG_WRONG,"Not a block index set");

454:   sub = (IS_Block *)is->data;
455:   *size = sub->n;
456:   return(0);
457: }