static PetscErrorCode ISL2GComposeBlock(IS is,ISLocalToGlobalMapping ltog,ISLocalToGlobalMapping *cltog)
{
PetscErrorCode ierr;
const PetscInt *idx;
PetscInt m,*idxm;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidHeaderSpecific(ltog,IS_LTOGM_CLASSID,2);
PetscValidPointer(cltog,3);
ierr = ISBlockGetLocalSize(is,&m);CHKERRQ(ierr);
ierr = ISBlockGetIndices(is,&idx);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
{
PetscInt i;
for (i=0; i<m; i++) {
if (idx[i] < 0 || ltog->n <= idx[i]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"is[%D] = %D is not in the local range [0:%D]",i,idx[i],ltog->n);
}
}
#endif
ierr = PetscMalloc(m*sizeof(PetscInt),&idxm);CHKERRQ(ierr);
if (ltog) {
ierr = ISLocalToGlobalMappingApply(ltog,m,idx,idxm);CHKERRQ(ierr);
} else {
ierr = PetscMemcpy(idxm,idx,m*sizeof(PetscInt));CHKERRQ(ierr);
}
ierr = ISLocalToGlobalMappingCreate(((PetscObject)is)->comm,m,idxm,PETSC_OWN_POINTER,cltog);CHKERRQ(ierr);
ierr = ISBlockRestoreIndices(is,&idx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Compose an IS with an ISLocalToGlobalMapping to map from IS source indices to global indices */
static PetscErrorCode ISL2GCompose(IS is,ISLocalToGlobalMapping ltog,ISLocalToGlobalMapping *cltog)
{
PetscErrorCode ierr;
const PetscInt *idx;
PetscInt m,*idxm;
PetscBool isblock;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidHeaderSpecific(ltog,IS_LTOGM_CLASSID,2);
PetscValidPointer(cltog,3);
ierr = PetscObjectTypeCompare((PetscObject)is,ISBLOCK,&isblock);CHKERRQ(ierr);
if (isblock) {
PetscInt bs,lbs;
ierr = ISGetBlockSize(is,&bs);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingGetBlockSize(ltog,&lbs);CHKERRQ(ierr);
if (bs == lbs) {
ierr = ISGetLocalSize(is,&m);CHKERRQ(ierr);
m = m/bs;
ierr = ISBlockGetIndices(is,&idx);CHKERRQ(ierr);
ierr = PetscMalloc1(m,&idxm);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingApplyBlock(ltog,m,idx,idxm);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingCreate(PetscObjectComm((PetscObject)is),bs,m,idxm,PETSC_OWN_POINTER,cltog);CHKERRQ(ierr);
ierr = ISBlockRestoreIndices(is,&idx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
}
ierr = ISGetLocalSize(is,&m);CHKERRQ(ierr);
ierr = ISGetIndices(is,&idx);CHKERRQ(ierr);
ierr = PetscMalloc1(m,&idxm);CHKERRQ(ierr);
if (ltog) {
ierr = ISLocalToGlobalMappingApply(ltog,m,idx,idxm);CHKERRQ(ierr);
} else {
ierr = PetscMemcpy(idxm,idx,m*sizeof(PetscInt));CHKERRQ(ierr);
}
ierr = ISLocalToGlobalMappingCreate(PetscObjectComm((PetscObject)is),1,m,idxm,PETSC_OWN_POINTER,cltog);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&idx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode ISL2GComposeBlock(IS is,ISLocalToGlobalMapping ltog,ISLocalToGlobalMapping *cltog)
{
PetscErrorCode ierr;
const PetscInt *idx;
PetscInt m,*idxm;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidHeaderSpecific(ltog,IS_LTOGM_CLASSID,2);
PetscValidPointer(cltog,3);
ierr = ISBlockGetLocalSize(is,&m);CHKERRQ(ierr);
ierr = ISBlockGetIndices(is,&idx);CHKERRQ(ierr);
ierr = PetscMalloc1(m,&idxm);CHKERRQ(ierr);
if (ltog) {
ierr = ISLocalToGlobalMappingApply(ltog,m,idx,idxm);CHKERRQ(ierr);
} else {
ierr = PetscMemcpy(idxm,idx,m*sizeof(PetscInt));CHKERRQ(ierr);
}
ierr = ISLocalToGlobalMappingCreate(PetscObjectComm((PetscObject)is),m,idxm,PETSC_OWN_POINTER,cltog);CHKERRQ(ierr);
ierr = ISBlockRestoreIndices(is,&idx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode ISCompressIndicesSorted(PetscInt n,PetscInt bs,PetscInt imax,const IS is_in[],IS is_out[])
{
PetscErrorCode ierr;
PetscInt i,j,k,val,len,*nidx,bbs;
const PetscInt *idx,*idx_local;
PetscBool flg,isblock;
#if defined(PETSC_USE_CTABLE)
PetscInt maxsz;
#else
PetscInt Nbs=n/bs;
#endif
PetscFunctionBegin;
for (i=0; i<imax; i++) {
ierr = ISSorted(is_in[i],&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Indices are not sorted");
}
#if defined(PETSC_USE_CTABLE)
/* Now check max size */
for (i=0,maxsz=0; i<imax; i++) {
ierr = ISGetLocalSize(is_in[i],&len);CHKERRQ(ierr);
if (len%bs !=0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Indices are not block ordered");
len = len/bs; /* The reduced index size */
if (len > maxsz) maxsz = len;
}
ierr = PetscMalloc1(maxsz,&nidx);CHKERRQ(ierr);
#else
ierr = PetscMalloc1(Nbs,&nidx);CHKERRQ(ierr);
#endif
/* Now check if the indices are in block order */
for (i=0; i<imax; i++) {
ierr = ISGetLocalSize(is_in[i],&len);CHKERRQ(ierr);
/* special case where IS is already block IS of the correct size */
ierr = PetscObjectTypeCompare((PetscObject)is_in[i],ISBLOCK,&isblock);CHKERRQ(ierr);
if (isblock) {
ierr = ISBlockGetLocalSize(is_in[i],&bbs);CHKERRQ(ierr);
if (bs == bbs) {
len = len/bs;
ierr = ISBlockGetIndices(is_in[i],&idx);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,len,idx,PETSC_COPY_VALUES,(is_out+i));CHKERRQ(ierr);
ierr = ISBlockRestoreIndices(is_in[i],&idx);CHKERRQ(ierr);
continue;
}
}
ierr = ISGetIndices(is_in[i],&idx);CHKERRQ(ierr);
if (len%bs !=0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Indices are not block ordered");
len = len/bs; /* The reduced index size */
idx_local = idx;
for (j=0; j<len; j++) {
val = idx_local[0];
if (val%bs != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Indices are not block ordered");
for (k=0; k<bs; k++) {
if (val+k != idx_local[k]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Indices are not block ordered");
}
nidx[j] = val/bs;
idx_local += bs;
}
ierr = ISRestoreIndices(is_in[i],&idx);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,len,nidx,PETSC_COPY_VALUES,(is_out+i));CHKERRQ(ierr);
}
ierr = PetscFree(nidx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}