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); }
#include <petscis.h> #include <petsc/private/f90impl.h> #if defined(PETSC_HAVE_FORTRAN_CAPS) #define isblockgetindicesf90_ ISBLOCKGETINDICESF90 #define isblockrestoreindicesf90_ ISBLOCKRESTOREINDICESF90 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) #define isblockgetindicesf90_ isblockgetindicesf90 #define isblockrestoreindicesf90_ isblockrestoreindicesf90 #endif PETSC_EXTERN void PETSC_STDCALL isblockgetindicesf90_(IS *x,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd)) { const PetscInt *fa; PetscInt len; *__ierr = ISBlockGetIndices(*x,&fa); if (*__ierr) return; *__ierr = ISBlockGetLocalSize(*x,&len); if (*__ierr) return; *__ierr = F90Array1dCreate((void*)fa,PETSC_INT,1,len,ptr PETSC_F90_2PTR_PARAM(ptrd)); } PETSC_EXTERN void PETSC_STDCALL isblockrestoreindicesf90_(IS *x,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd)) { const PetscInt *fa; *__ierr = F90Array1dAccess(ptr,PETSC_INT,(void**)&fa PETSC_F90_2PTR_PARAM(ptrd));if (*__ierr) return; *__ierr = F90Array1dDestroy(ptr,PETSC_INT PETSC_F90_2PTR_PARAM(ptrd));if (*__ierr) return; *__ierr = ISBlockRestoreIndices(*x,&fa); }