int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt i,n,first,step;
IS set;
const PetscInt *indices;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);
CHKERRQ(ierr);
n = 10;
first = 3;
step = 2;
/*
Create stride index set, starting at 3 with a stride of 2
Note each processor is generating its own index set
(in this case they are all identical)
*/
ierr = ISCreateStride(PETSC_COMM_SELF,n,first,step,&set);
CHKERRQ(ierr);
ierr = ISView(set,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
/*
Extract indices from set.
*/
ierr = ISGetIndices(set,&indices);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Printing indices directly\n");
CHKERRQ(ierr);
for (i=0; i<n; i++) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"%D\n",indices[i]);
CHKERRQ(ierr);
}
ierr = ISRestoreIndices(set,&indices);
CHKERRQ(ierr);
/*
Determine information on stride
*/
ierr = ISStrideGetInfo(set,&first,&step);
CHKERRQ(ierr);
if (first != 3 || step != 2) SETERRQ(PETSC_COMM_SELF,1,"Stride info not correct!\n");
ierr = ISDestroy(&set);
CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*@
ISAllGather - Given an index set (IS) on each processor, generates a large
index set (same on each processor) by concatenating together each
processors index set.
Collective on IS
Input Parameter:
. is - the distributed index set
Output Parameter:
. isout - the concatenated index set (same on all processors)
Notes:
ISAllGather() is clearly not scalable for large index sets.
The IS created on each processor must be created with a common
communicator (e.g., PETSC_COMM_WORLD). If the index sets were created
with PETSC_COMM_SELF, this routine will not work as expected, since
each process will generate its own new IS that consists only of
itself.
The communicator for this new IS is PETSC_COMM_SELF
Level: intermediate
Concepts: gather^index sets
Concepts: index sets^gathering to all processors
Concepts: IS^gathering to all processors
.seealso: ISCreateGeneral(), ISCreateStride(), ISCreateBlock()
@*/
PetscErrorCode ISAllGather(IS is,IS *isout)
{
PetscErrorCode ierr;
PetscInt *indices,n,i,N,step,first;
const PetscInt *lindices;
MPI_Comm comm;
PetscMPIInt size,*sizes = NULL,*offsets = NULL,nn;
PetscBool stride;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(isout,2);
ierr = PetscObjectGetComm((PetscObject)is,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)is,ISSTRIDE,&stride);CHKERRQ(ierr);
if (size == 1 && stride) { /* should handle parallel ISStride also */
ierr = ISStrideGetInfo(is,&first,&step);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,n,first,step,isout);CHKERRQ(ierr);
} else {
ierr = PetscMalloc2(size,&sizes,size,&offsets);CHKERRQ(ierr);
ierr = PetscMPIIntCast(n,&nn);CHKERRQ(ierr);
ierr = MPI_Allgather(&nn,1,MPI_INT,sizes,1,MPI_INT,comm);CHKERRQ(ierr);
offsets[0] = 0;
for (i=1; i<size; i++) {
PetscInt s = offsets[i-1] + sizes[i-1];
ierr = PetscMPIIntCast(s,&offsets[i]);CHKERRQ(ierr);
}
N = offsets[size-1] + sizes[size-1];
ierr = PetscMalloc1(N,&indices);CHKERRQ(ierr);
ierr = ISGetIndices(is,&lindices);CHKERRQ(ierr);
ierr = MPI_Allgatherv((void*)lindices,nn,MPIU_INT,indices,sizes,offsets,MPIU_INT,comm);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&lindices);CHKERRQ(ierr);
ierr = PetscFree2(sizes,offsets);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,N,indices,PETSC_OWN_POINTER,isout);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscInt i,n,start,stride;
const PetscInt *ii;
IS is;
PetscBool flg;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
/*
Test IS of size 0
*/
ierr = ISCreateStride(PETSC_COMM_SELF,0,0,2,&is);CHKERRQ(ierr);
ierr = ISGetSize(is,&n);CHKERRQ(ierr);
if (n != 0) SETERRQ(PETSC_COMM_SELF,1,"ISCreateStride");
ierr = ISStrideGetInfo(is,&start,&stride);CHKERRQ(ierr);
if (start != 0) SETERRQ(PETSC_COMM_SELF,1,"ISStrideGetInfo");
if (stride != 2) SETERRQ(PETSC_COMM_SELF,1,"ISStrideGetInfo");
ierr = PetscObjectTypeCompare((PetscObject)is,ISSTRIDE,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISStride");
ierr = ISGetIndices(is,&ii);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&ii);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
/*
Test ISGetIndices()
*/
ierr = ISCreateStride(PETSC_COMM_SELF,10000,-8,3,&is);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
ierr = ISGetIndices(is,&ii);CHKERRQ(ierr);
for (i=0; i<10000; i++) {
if (ii[i] != -8 + 3*i) SETERRQ(PETSC_COMM_SELF,1,"ISGetIndices");
}
ierr = ISRestoreIndices(is,&ii);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode MatGetSubMatrix_BlockMat(Mat A,IS isrow,IS iscol,MatReuse scall,Mat *B)
{
Mat_BlockMat *a = (Mat_BlockMat*)A->data;
Mat_SeqAIJ *c;
PetscErrorCode ierr;
PetscInt i,k,first,step,lensi,nrows,ncols;
PetscInt *j_new,*i_new,*aj = a->j,*ailen = a->ilen;
PetscScalar *a_new;
Mat C,*aa = a->a;
PetscBool stride,equal;
PetscFunctionBegin;
ierr = ISEqual(isrow,iscol,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only for idential column and row indices");
ierr = PetscObjectTypeCompare((PetscObject)iscol,ISSTRIDE,&stride);CHKERRQ(ierr);
if (!stride) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only for stride indices");
ierr = ISStrideGetInfo(iscol,&first,&step);CHKERRQ(ierr);
if (step != A->rmap->bs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can only select one entry from each block");
ierr = ISGetLocalSize(isrow,&nrows);CHKERRQ(ierr);
ncols = nrows;
/* create submatrix */
if (scall == MAT_REUSE_MATRIX) {
PetscInt n_cols,n_rows;
C = *B;
ierr = MatGetSize(C,&n_rows,&n_cols);CHKERRQ(ierr);
if (n_rows != nrows || n_cols != ncols) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Reused submatrix wrong size");
ierr = MatZeroEntries(C);CHKERRQ(ierr);
} else {
ierr = MatCreate(PetscObjectComm((PetscObject)A),&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,nrows,ncols,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
if (A->symmetric) {
ierr = MatSetType(C,MATSEQSBAIJ);CHKERRQ(ierr);
} else {
ierr = MatSetType(C,MATSEQAIJ);CHKERRQ(ierr);
}
ierr = MatSeqAIJSetPreallocation(C,0,ailen);CHKERRQ(ierr);
ierr = MatSeqSBAIJSetPreallocation(C,1,0,ailen);CHKERRQ(ierr);
}
c = (Mat_SeqAIJ*)C->data;
/* loop over rows inserting into submatrix */
a_new = c->a;
j_new = c->j;
i_new = c->i;
for (i=0; i<nrows; i++) {
lensi = ailen[i];
for (k=0; k<lensi; k++) {
*j_new++ = *aj++;
ierr = MatGetValue(*aa++,first,first,a_new++);CHKERRQ(ierr);
}
i_new[i+1] = i_new[i] + lensi;
c->ilen[i] = lensi;
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
*B = C;
PetscFunctionReturn(0);
}
void PETSC_STDCALL isstridegetinfo_(IS is,PetscInt *first,PetscInt *step, int *__ierr ){
*__ierr = ISStrideGetInfo(
(IS)PetscToPointer((is) ),first,step);
}
