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(1,"Stride info not correct!\n");
ierr = ISDestroy(set);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 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);
}
/*@
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++) offsets[i] = offsets[i-1] + sizes[i-1];
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);
}
/* 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;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidHeaderSpecific(ltog,IS_LTOGM_CLASSID,2);
PetscValidPointer(cltog,3);
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),m,idxm,PETSC_OWN_POINTER,cltog);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&idx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode ISToGeneral_Block(IS inis)
{
IS_Block *sub = (IS_Block*)inis->data;
PetscInt bs,n;
const PetscInt *idx;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = ISGetBlockSize(inis,&bs);CHKERRQ(ierr);
ierr = ISGetLocalSize(inis,&n);CHKERRQ(ierr);
ierr = ISGetIndices(inis,&idx);CHKERRQ(ierr);
if (bs == 1) {
PetscCopyMode mode = sub->allocated ? PETSC_OWN_POINTER : PETSC_USE_POINTER;
sub->allocated = PETSC_FALSE; /* prevent deallocation when changing the subtype*/
ierr = ISSetType(inis,ISGENERAL);CHKERRQ(ierr);
ierr = ISGeneralSetIndices(inis,n,idx,mode);CHKERRQ(ierr);
} else {
ierr = ISSetType(inis,ISGENERAL);CHKERRQ(ierr);
ierr = ISGeneralSetIndices(inis,n,idx,PETSC_OWN_POINTER);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode DMLabelGetStratumBounds(DMLabel label, PetscInt value, PetscInt *start, PetscInt *end)
{
PetscInt v;
PetscErrorCode ierr;
PetscFunctionBegin;
if (start) {PetscValidPointer(start, 3); *start = 0;}
if (end) {PetscValidPointer(end, 4); *end = 0;}
for (v = 0; v < label->numStrata; ++v) {
const PetscInt *points;
if (label->stratumValues[v] != value) continue;
ierr = DMLabelMakeValid_Private(label, v);CHKERRQ(ierr);
if (label->stratumSizes[v] <= 0) break;
ierr = ISGetIndices(label->points[v],&points);CHKERRQ(ierr);
if (start) *start = points[0];
if (end) *end = points[label->stratumSizes[v]-1]+1;
ierr = ISRestoreIndices(label->points[v],&points);CHKERRQ(ierr);
break;
}
PetscFunctionReturn(0);
}
/*@
ISComplement - Given an index set (IS) generates the complement index set. That is all
all indices that are NOT in the given set.
Collective on IS
Input Parameter:
+ is - the index set
. nmin - the first index desired in the local part of the complement
- nmax - the largest index desired in the local part of the complement (note that all indices in is must be greater or equal to nmin and less than nmax)
Output Parameter:
. isout - the complement
Notes: The communicator for this new IS is the same as for the input IS
For a parallel IS, this will generate the local part of the complement on each process
To generate the entire complement (on each process) of a parallel IS, first call ISAllGather() and then
call this routine.
Level: intermediate
Concepts: gather^index sets
Concepts: index sets^gathering to all processors
Concepts: IS^gathering to all processors
.seealso: ISCreateGeneral(), ISCreateStride(), ISCreateBlock(), ISAllGather()
@*/
PetscErrorCode ISComplement(IS is,PetscInt nmin,PetscInt nmax,IS *isout)
{
PetscErrorCode ierr;
const PetscInt *indices;
PetscInt n,i,j,unique,cnt,*nindices;
PetscBool sorted;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(isout,3);
if (nmin < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nmin %D cannot be negative",nmin);
if (nmin > nmax) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nmin %D cannot be greater than nmax %D",nmin,nmax);
ierr = ISSorted(is,&sorted);CHKERRQ(ierr);
if (!sorted) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Index set must be sorted");
ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
ierr = ISGetIndices(is,&indices);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
for (i=0; i<n; i++) {
if (indices[i] < nmin) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Index %D's value %D is smaller than minimum given %D",i,indices[i],nmin);
if (indices[i] >= nmax) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Index %D's value %D is larger than maximum given %D",i,indices[i],nmax);
}
#endif
/* Count number of unique entries */
unique = (n>0);
for (i=0; i<n-1; i++) {
if (indices[i+1] != indices[i]) unique++;
}
ierr = PetscMalloc1(nmax-nmin-unique,&nindices);CHKERRQ(ierr);
cnt = 0;
for (i=nmin,j=0; i<nmax; i++) {
if (j<n && i==indices[j]) do { j++; } while (j<n && i==indices[j]);
else nindices[cnt++] = i;
}
if (cnt != nmax-nmin-unique) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Number of entries found in complement %D does not match expected %D",cnt,nmax-nmin-unique);
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)is),cnt,nindices,PETSC_OWN_POINTER,isout);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&indices);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
ISSetPermutation - Informs the index set that it is a permutation.
Logically Collective on IS
Input Parmeters:
. is - the index set
Level: intermediate
Concepts: permutation
Concepts: index sets^permutation
The debug version of the libraries (./configure --with-debugging=1) checks if the
index set is actually a permutation. The optimized version just believes you.
.seealso: ISPermutation()
@*/
PetscErrorCode ISSetPermutation(IS is)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
#if defined(PETSC_USE_DEBUG)
{
PetscMPIInt size;
PetscErrorCode ierr;
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)is),&size);
CHKERRQ(ierr);
if (size == 1) {
PetscInt i,n,*idx;
const PetscInt *iidx;
ierr = ISGetSize(is,&n);
CHKERRQ(ierr);
ierr = PetscMalloc1(n,&idx);
CHKERRQ(ierr);
ierr = ISGetIndices(is,&iidx);
CHKERRQ(ierr);
ierr = PetscMemcpy(idx,iidx,n*sizeof(PetscInt));
CHKERRQ(ierr);
ierr = PetscSortInt(n,idx);
CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (idx[i] != i) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Index set is not a permutation");
}
ierr = PetscFree(idx);
CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&iidx);
CHKERRQ(ierr);
}
}
#endif
is->isperm = PETSC_TRUE;
PetscFunctionReturn(0);
}
/*@
ISLocalToGlobalMappingApplyIS - Creates from an IS in the local numbering
a new index set using the global numbering defined in an ISLocalToGlobalMapping
context.
Not collective
Input Parameters:
+ mapping - mapping between local and global numbering
- is - index set in local numbering
Output Parameters:
. newis - index set in global numbering
Level: advanced
Concepts: mapping^local to global
.seealso: ISLocalToGlobalMappingApply(), ISLocalToGlobalMappingCreate(),
ISLocalToGlobalMappingDestroy(), ISGlobalToLocalMappingApply()
@*/
PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingApplyIS(ISLocalToGlobalMapping mapping,IS is,IS *newis)
{
PetscErrorCode ierr;
PetscInt n,i,*idxmap,*idxout,Nmax = mapping->n;
const PetscInt *idxin;
PetscFunctionBegin;
PetscValidHeaderSpecific(mapping,IS_LTOGM_COOKIE,1);
PetscValidHeaderSpecific(is,IS_COOKIE,2);
PetscValidPointer(newis,3);
ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
ierr = ISGetIndices(is,&idxin);CHKERRQ(ierr);
idxmap = mapping->indices;
ierr = PetscMalloc(n*sizeof(PetscInt),&idxout);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (idxin[i] >= Nmax) SETERRQ3(PETSC_ERR_ARG_OUTOFRANGE,"Local index %d too large %d (max) at %d",idxin[i],Nmax-1,i);
idxout[i] = idxmap[idxin[i]];
}
ierr = ISRestoreIndices(is,&idxin);CHKERRQ(ierr);
ierr = ISCreateGeneralNC(PETSC_COMM_SELF,n,idxout,newis);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
VecISSet - Sets the elements of a vector, specified by an index set, to a constant
Input Parameter:
+ V - the vector
. S - the locations in the vector
- c - the constant
.seealso VecSet()
Level: advanced
@*/
PetscErrorCode VecISSet(Vec V,IS S, PetscScalar c)
{
PetscErrorCode ierr;
PetscInt nloc,low,high,i;
const PetscInt *s;
PetscScalar *v;
PetscFunctionBegin;
PetscValidHeaderSpecific(V,VEC_CLASSID,1);
PetscValidHeaderSpecific(S,IS_CLASSID,2);
PetscValidType(V,3);
PetscCheckSameComm(V,3,S,1);
ierr = VecGetOwnershipRange(V, &low, &high);CHKERRQ(ierr);
ierr = ISGetLocalSize(S,&nloc);CHKERRQ(ierr);
ierr = ISGetIndices(S, &s);CHKERRQ(ierr);
ierr = VecGetArray(V,&v);CHKERRQ(ierr);
for (i=0; i<nloc; i++){
v[s[i]-low] = c;
}
ierr = ISRestoreIndices(S, &s);CHKERRQ(ierr);
ierr = VecRestoreArray(V,&v);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
ISConcatenate - Forms a new IS by locally concatenating the indices from an IS list without reordering.
Collective on comm.
Input Parameter:
+ comm - communicator of the concatenated IS.
. len - size of islist array (nonnegative)
- islist - array of index sets
Output Parameters:
. isout - The concatenated index set; empty, if len == 0.
Notes: The semantics of calling this on comm imply that the comms of the members if islist also contain this rank.
Level: intermediate
.seealso: ISDifference(), ISSum(), ISExpand()
Concepts: index sets^concatenation
Concepts: IS^concatenation
@*/
PetscErrorCode ISConcatenate(MPI_Comm comm, PetscInt len, const IS islist[], IS *isout)
{
PetscErrorCode ierr;
PetscInt i,n,N;
const PetscInt *iidx;
PetscInt *idx;
PetscFunctionBegin;
PetscValidPointer(islist,2);
#if defined(PETSC_USE_DEBUG)
for(i = 0; i < len; ++i) {
PetscValidHeaderSpecific(islist[i], IS_CLASSID, 1);
}
#endif
PetscValidPointer(isout, 5);
if(!len) {
ierr = ISCreateStride(comm, 0,0,0, isout); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if(len < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Negative array length: %D", len);
N = 0;
for(i = 0; i < len; ++i) {
ierr = ISGetLocalSize(islist[i], &n); CHKERRQ(ierr);
N += n;
}
ierr = PetscMalloc(sizeof(PetscInt)*N, &idx); CHKERRQ(ierr);
N = 0;
for(i = 0; i < len; ++i) {
ierr = ISGetLocalSize(islist[i], &n); CHKERRQ(ierr);
ierr = ISGetIndices(islist[i], &iidx); CHKERRQ(ierr);
ierr = PetscMemcpy(idx+N,iidx, sizeof(PetscInt)*n); CHKERRQ(ierr);
N += n;
}
ierr = ISCreateGeneral(comm, N, idx, PETSC_OWN_POINTER, isout); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatPartitioningHierarchical_AssembleSubdomain(Mat adj,IS destination,Mat *sadj, ISLocalToGlobalMapping *mapping)
{
IS irows,icols;
PetscInt irows_ln;
PetscMPIInt rank;
const PetscInt *irows_indices;
MPI_Comm comm;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)adj,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
/* figure out where data comes from */
ierr = ISBuildTwoSided(destination,NULL,&irows);CHKERRQ(ierr);
ierr = ISDuplicate(irows,&icols);CHKERRQ(ierr);
ierr = ISGetLocalSize(irows,&irows_ln);CHKERRQ(ierr);
ierr = ISGetIndices(irows,&irows_indices);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingCreate(comm,1,irows_ln,irows_indices,PETSC_COPY_VALUES,mapping);CHKERRQ(ierr);
ierr = ISRestoreIndices(irows,&irows_indices);CHKERRQ(ierr);
ierr = MatGetSubMatrices(adj,1,&irows,&icols,MAT_INITIAL_MATRIX,&sadj);CHKERRQ(ierr);
ierr = ISDestroy(&irows);CHKERRQ(ierr);
ierr = ISDestroy(&icols);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatLUFactorSymbolic_SeqBAIJ_inplace(Mat B,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
{
Mat_SeqBAIJ *a = (Mat_SeqBAIJ*)A->data,*b;
PetscInt n =a->mbs,bs = A->rmap->bs,bs2=a->bs2;
PetscBool row_identity,col_identity,both_identity;
IS isicol;
PetscErrorCode ierr;
const PetscInt *r,*ic;
PetscInt i,*ai=a->i,*aj=a->j;
PetscInt *bi,*bj,*ajtmp;
PetscInt *bdiag,row,nnz,nzi,reallocs=0,nzbd,*im;
PetscReal f;
PetscInt nlnk,*lnk,k,**bi_ptr;
PetscFreeSpaceList free_space=NULL,current_space=NULL;
PetscBT lnkbt;
PetscBool missing;
PetscFunctionBegin;
if (A->rmap->N != A->cmap->N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"matrix must be square");
ierr = MatMissingDiagonal(A,&missing,&i);CHKERRQ(ierr);
if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);
ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
/* get new row and diagonal pointers, must be allocated separately because they will be given to the Mat_SeqAIJ and freed separately */
ierr = PetscMalloc1(n+1,&bi);CHKERRQ(ierr);
ierr = PetscMalloc1(n+1,&bdiag);CHKERRQ(ierr);
bi[0] = bdiag[0] = 0;
/* linked list for storing column indices of the active row */
nlnk = n + 1;
ierr = PetscLLCreate(n,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
ierr = PetscMalloc2(n+1,&bi_ptr,n+1,&im);CHKERRQ(ierr);
/* initial FreeSpace size is f*(ai[n]+1) */
f = info->fill;
ierr = PetscFreeSpaceGet(PetscRealIntMultTruncate(f,ai[n]+1),&free_space);CHKERRQ(ierr);
current_space = free_space;
for (i=0; i<n; i++) {
/* copy previous fill into linked list */
nzi = 0;
nnz = ai[r[i]+1] - ai[r[i]];
ajtmp = aj + ai[r[i]];
ierr = PetscLLAddPerm(nnz,ajtmp,ic,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
nzi += nlnk;
/* add pivot rows into linked list */
row = lnk[n];
while (row < i) {
nzbd = bdiag[row] - bi[row] + 1; /* num of entries in the row with column index <= row */
ajtmp = bi_ptr[row] + nzbd; /* points to the entry next to the diagonal */
ierr = PetscLLAddSortedLU(ajtmp,row,nlnk,lnk,lnkbt,i,nzbd,im);CHKERRQ(ierr);
nzi += nlnk;
row = lnk[row];
}
bi[i+1] = bi[i] + nzi;
im[i] = nzi;
/* mark bdiag */
nzbd = 0;
nnz = nzi;
k = lnk[n];
while (nnz-- && k < i) {
nzbd++;
k = lnk[k];
}
bdiag[i] = bi[i] + nzbd;
/* if free space is not available, make more free space */
if (current_space->local_remaining<nzi) {
nnz = PetscIntMultTruncate(n - i,nzi); /* estimated and max additional space needed */
ierr = PetscFreeSpaceGet(nnz,¤t_space);CHKERRQ(ierr);
reallocs++;
}
/* copy data into free space, then initialize lnk */
ierr = PetscLLClean(n,n,nzi,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
bi_ptr[i] = current_space->array;
current_space->array += nzi;
current_space->local_used += nzi;
current_space->local_remaining -= nzi;
}
#if defined(PETSC_USE_INFO)
if (ai[n] != 0) {
PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %g needed %g\n",reallocs,(double)f,(double)af);CHKERRQ(ierr);
ierr = PetscInfo1(A,"Run with -pc_factor_fill %g or use \n",(double)af);CHKERRQ(ierr);
ierr = PetscInfo1(A,"PCFactorSetFill(pc,%g);\n",(double)af);CHKERRQ(ierr);
ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
} else {
ierr = PetscInfo(A,"Empty matrix\n");CHKERRQ(ierr);
}
#endif
ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
/* destroy list of free space and other temporary array(s) */
ierr = PetscMalloc1(bi[n]+1,&bj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,bj);CHKERRQ(ierr);
ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
ierr = PetscFree2(bi_ptr,im);CHKERRQ(ierr);
/* put together the new matrix */
ierr = MatSeqBAIJSetPreallocation_SeqBAIJ(B,bs,MAT_SKIP_ALLOCATION,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)B,(PetscObject)isicol);CHKERRQ(ierr);
b = (Mat_SeqBAIJ*)(B)->data;
b->free_a = PETSC_TRUE;
b->free_ij = PETSC_TRUE;
b->singlemalloc = PETSC_FALSE;
ierr = PetscMalloc1((bi[n]+1)*bs2,&b->a);CHKERRQ(ierr);
b->j = bj;
b->i = bi;
b->diag = bdiag;
b->free_diag = PETSC_TRUE;
b->ilen = 0;
b->imax = 0;
b->row = isrow;
b->col = iscol;
b->pivotinblocks = (info->pivotinblocks) ? PETSC_TRUE : PETSC_FALSE;
ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
b->icol = isicol;
ierr = PetscMalloc1(bs*n+bs,&b->solve_work);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)B,(bi[n]-n)*(sizeof(PetscInt)+sizeof(PetscScalar)*bs2));CHKERRQ(ierr);
b->maxnz = b->nz = bi[n];
(B)->factortype = MAT_FACTOR_LU;
(B)->info.factor_mallocs = reallocs;
(B)->info.fill_ratio_given = f;
if (ai[n] != 0) {
(B)->info.fill_ratio_needed = ((PetscReal)bi[n])/((PetscReal)ai[n]);
} else {
(B)->info.fill_ratio_needed = 0.0;
}
ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
ierr = ISIdentity(iscol,&col_identity);CHKERRQ(ierr);
both_identity = (PetscBool) (row_identity && col_identity);
ierr = MatSeqBAIJSetNumericFactorization_inplace(B,both_identity);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode AOCreate_MemoryScalable(AO ao)
{
PetscErrorCode ierr;
IS isapp=ao->isapp,ispetsc=ao->ispetsc;
const PetscInt *mypetsc,*myapp;
PetscInt napp,n_local,N,i,start,*petsc,*lens,*disp;
MPI_Comm comm;
AO_MemoryScalable *aomems;
PetscLayout map;
PetscMPIInt size,rank;
PetscFunctionBegin;
/* create special struct aomems */
ierr = PetscNewLog(ao, AO_MemoryScalable, &aomems);
CHKERRQ(ierr);
ao->data = (void*) aomems;
ierr = PetscMemcpy(ao->ops,&AOOps_MemoryScalable,sizeof(struct _AOOps));
CHKERRQ(ierr);
ierr = PetscObjectChangeTypeName((PetscObject)ao,AOMEMORYSCALABLE);
CHKERRQ(ierr);
/* transmit all local lengths of isapp to all processors */
ierr = PetscObjectGetComm((PetscObject)isapp,&comm);
CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &size);
CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &rank);
CHKERRQ(ierr);
ierr = PetscMalloc2(size,PetscInt,&lens,size,PetscInt,&disp);
CHKERRQ(ierr);
ierr = ISGetLocalSize(isapp,&napp);
CHKERRQ(ierr);
ierr = MPI_Allgather(&napp, 1, MPIU_INT, lens, 1, MPIU_INT, comm);
CHKERRQ(ierr);
N = 0;
for (i = 0; i < size; i++) {
disp[i] = N;
N += lens[i];
}
/* If ispetsc is 0 then use "natural" numbering */
if (napp) {
if (!ispetsc) {
start = disp[rank];
ierr = PetscMalloc((napp+1) * sizeof(PetscInt), &petsc);
CHKERRQ(ierr);
for (i=0; i<napp; i++) petsc[i] = start + i;
} else {
ierr = ISGetIndices(ispetsc,&mypetsc);
CHKERRQ(ierr);
petsc = (PetscInt*)mypetsc;
}
}
/* create a map with global size N - used to determine the local sizes of ao - shall we use local napp instead of N? */
ierr = PetscLayoutCreate(comm,&map);
CHKERRQ(ierr);
map->bs = 1;
map->N = N;
ierr = PetscLayoutSetUp(map);
CHKERRQ(ierr);
ao->N = N;
ao->n = map->n;
aomems->map = map;
/* create distributed indices app_loc: petsc->app and petsc_loc: app->petsc */
n_local = map->n;
ierr = PetscMalloc2(n_local,PetscInt, &aomems->app_loc,n_local,PetscInt,&aomems->petsc_loc);
CHKERRQ(ierr);
ierr = PetscLogObjectMemory(ao,2*n_local*sizeof(PetscInt));
CHKERRQ(ierr);
ierr = PetscMemzero(aomems->app_loc,n_local*sizeof(PetscInt));
CHKERRQ(ierr);
ierr = PetscMemzero(aomems->petsc_loc,n_local*sizeof(PetscInt));
CHKERRQ(ierr);
ierr = ISGetIndices(isapp,&myapp);
CHKERRQ(ierr);
ierr = AOCreateMemoryScalable_private(comm,napp,petsc,myapp,ao,aomems->app_loc);
CHKERRQ(ierr);
ierr = AOCreateMemoryScalable_private(comm,napp,myapp,petsc,ao,aomems->petsc_loc);
CHKERRQ(ierr);
ierr = ISRestoreIndices(isapp,&myapp);
CHKERRQ(ierr);
if (napp) {
if (ispetsc) {
ierr = ISRestoreIndices(ispetsc,&mypetsc);
CHKERRQ(ierr);
} else {
ierr = PetscFree(petsc);
CHKERRQ(ierr);
}
}
ierr = PetscFree2(lens,disp);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Version for when blocks are 4 by 4 */
PetscErrorCode MatCholeskyFactorNumeric_SeqSBAIJ_4(Mat C,Mat A,const MatFactorInfo *info)
{
Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data,*b = (Mat_SeqSBAIJ*)C->data;
IS perm = b->row;
PetscErrorCode ierr;
const PetscInt *ai,*aj,*perm_ptr,mbs=a->mbs,*bi=b->i,*bj=b->j;
PetscInt i,j,*a2anew,k,k1,jmin,jmax,*jl,*il,vj,nexti,ili;
MatScalar *ba = b->a,*aa,*ap,*dk,*uik;
MatScalar *u,*diag,*rtmp,*rtmp_ptr;
PetscBool pivotinblocks = b->pivotinblocks;
PetscReal shift = info->shiftamount;
PetscBool allowzeropivot,zeropivotdetected=PETSC_FALSE;
PetscFunctionBegin;
/* initialization */
allowzeropivot = PetscNot(A->erroriffailure);
ierr = PetscCalloc1(16*mbs,&rtmp);CHKERRQ(ierr);
ierr = PetscMalloc2(mbs,&il,mbs,&jl);CHKERRQ(ierr);
il[0] = 0;
for (i=0; i<mbs; i++) jl[i] = mbs;
ierr = PetscMalloc2(16,&dk,16,&uik);CHKERRQ(ierr);
ierr = ISGetIndices(perm,&perm_ptr);CHKERRQ(ierr);
/* check permutation */
if (!a->permute) {
ai = a->i; aj = a->j; aa = a->a;
} else {
ai = a->inew; aj = a->jnew;
ierr = PetscMalloc1(16*ai[mbs],&aa);CHKERRQ(ierr);
ierr = PetscMemcpy(aa,a->a,16*ai[mbs]*sizeof(MatScalar));CHKERRQ(ierr);
ierr = PetscMalloc1(ai[mbs],&a2anew);CHKERRQ(ierr);
ierr = PetscMemcpy(a2anew,a->a2anew,(ai[mbs])*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
jmin = ai[i]; jmax = ai[i+1];
for (j=jmin; j<jmax; j++) {
while (a2anew[j] != j) {
k = a2anew[j]; a2anew[j] = a2anew[k]; a2anew[k] = k;
for (k1=0; k1<16; k1++) {
dk[k1] = aa[k*16+k1];
aa[k*16+k1] = aa[j*16+k1];
aa[j*16+k1] = dk[k1];
}
}
/* transform columnoriented blocks that lie in the lower triangle to roworiented blocks */
if (i > aj[j]) {
/* printf("change orientation, row: %d, col: %d\n",i,aj[j]); */
ap = aa + j*16; /* ptr to the beginning of j-th block of aa */
for (k=0; k<16; k++) dk[k] = ap[k]; /* dk <- j-th block of aa */
for (k=0; k<4; k++) { /* j-th block of aa <- dk^T */
for (k1=0; k1<4; k1++) *ap++ = dk[k + 4*k1];
}
}
}
}
ierr = PetscFree(a2anew);CHKERRQ(ierr);
}
/* for each row k */
for (k = 0; k<mbs; k++) {
/*initialize k-th row with elements nonzero in row perm(k) of A */
jmin = ai[perm_ptr[k]]; jmax = ai[perm_ptr[k]+1];
if (jmin < jmax) {
ap = aa + jmin*16;
for (j = jmin; j < jmax; j++) {
vj = perm_ptr[aj[j]]; /* block col. index */
rtmp_ptr = rtmp + vj*16;
for (i=0; i<16; i++) *rtmp_ptr++ = *ap++;
}
}
/* modify k-th row by adding in those rows i with U(i,k) != 0 */
ierr = PetscMemcpy(dk,rtmp+k*16,16*sizeof(MatScalar));CHKERRQ(ierr);
i = jl[k]; /* first row to be added to k_th row */
while (i < mbs) {
nexti = jl[i]; /* next row to be added to k_th row */
/* compute multiplier */
ili = il[i]; /* index of first nonzero element in U(i,k:bms-1) */
/* uik = -inv(Di)*U_bar(i,k) */
diag = ba + i*16;
u = ba + ili*16;
uik[0] = -(diag[0]*u[0] + diag[4]*u[1] + diag[8]*u[2] + diag[12]*u[3]);
uik[1] = -(diag[1]*u[0] + diag[5]*u[1] + diag[9]*u[2] + diag[13]*u[3]);
uik[2] = -(diag[2]*u[0] + diag[6]*u[1] + diag[10]*u[2]+ diag[14]*u[3]);
uik[3] = -(diag[3]*u[0] + diag[7]*u[1] + diag[11]*u[2]+ diag[15]*u[3]);
uik[4] = -(diag[0]*u[4] + diag[4]*u[5] + diag[8]*u[6] + diag[12]*u[7]);
uik[5] = -(diag[1]*u[4] + diag[5]*u[5] + diag[9]*u[6] + diag[13]*u[7]);
uik[6] = -(diag[2]*u[4] + diag[6]*u[5] + diag[10]*u[6]+ diag[14]*u[7]);
uik[7] = -(diag[3]*u[4] + diag[7]*u[5] + diag[11]*u[6]+ diag[15]*u[7]);
uik[8] = -(diag[0]*u[8] + diag[4]*u[9] + diag[8]*u[10] + diag[12]*u[11]);
uik[9] = -(diag[1]*u[8] + diag[5]*u[9] + diag[9]*u[10] + diag[13]*u[11]);
uik[10]= -(diag[2]*u[8] + diag[6]*u[9] + diag[10]*u[10]+ diag[14]*u[11]);
uik[11]= -(diag[3]*u[8] + diag[7]*u[9] + diag[11]*u[10]+ diag[15]*u[11]);
uik[12]= -(diag[0]*u[12] + diag[4]*u[13] + diag[8]*u[14] + diag[12]*u[15]);
uik[13]= -(diag[1]*u[12] + diag[5]*u[13] + diag[9]*u[14] + diag[13]*u[15]);
uik[14]= -(diag[2]*u[12] + diag[6]*u[13] + diag[10]*u[14]+ diag[14]*u[15]);
uik[15]= -(diag[3]*u[12] + diag[7]*u[13] + diag[11]*u[14]+ diag[15]*u[15]);
/* update D(k) += -U(i,k)^T * U_bar(i,k) */
dk[0] += uik[0]*u[0] + uik[1]*u[1] + uik[2]*u[2] + uik[3]*u[3];
dk[1] += uik[4]*u[0] + uik[5]*u[1] + uik[6]*u[2] + uik[7]*u[3];
dk[2] += uik[8]*u[0] + uik[9]*u[1] + uik[10]*u[2]+ uik[11]*u[3];
dk[3] += uik[12]*u[0]+ uik[13]*u[1]+ uik[14]*u[2]+ uik[15]*u[3];
dk[4] += uik[0]*u[4] + uik[1]*u[5] + uik[2]*u[6] + uik[3]*u[7];
dk[5] += uik[4]*u[4] + uik[5]*u[5] + uik[6]*u[6] + uik[7]*u[7];
dk[6] += uik[8]*u[4] + uik[9]*u[5] + uik[10]*u[6]+ uik[11]*u[7];
dk[7] += uik[12]*u[4]+ uik[13]*u[5]+ uik[14]*u[6]+ uik[15]*u[7];
dk[8] += uik[0]*u[8] + uik[1]*u[9] + uik[2]*u[10] + uik[3]*u[11];
dk[9] += uik[4]*u[8] + uik[5]*u[9] + uik[6]*u[10] + uik[7]*u[11];
dk[10]+= uik[8]*u[8] + uik[9]*u[9] + uik[10]*u[10]+ uik[11]*u[11];
dk[11]+= uik[12]*u[8]+ uik[13]*u[9]+ uik[14]*u[10]+ uik[15]*u[11];
dk[12]+= uik[0]*u[12] + uik[1]*u[13] + uik[2]*u[14] + uik[3]*u[15];
dk[13]+= uik[4]*u[12] + uik[5]*u[13] + uik[6]*u[14] + uik[7]*u[15];
dk[14]+= uik[8]*u[12] + uik[9]*u[13] + uik[10]*u[14]+ uik[11]*u[15];
dk[15]+= uik[12]*u[12]+ uik[13]*u[13]+ uik[14]*u[14]+ uik[15]*u[15];
ierr = PetscLogFlops(64.0*4.0);CHKERRQ(ierr);
/* update -U(i,k) */
ierr = PetscMemcpy(ba+ili*16,uik,16*sizeof(MatScalar));CHKERRQ(ierr);
/* add multiple of row i to k-th row ... */
jmin = ili + 1; jmax = bi[i+1];
if (jmin < jmax) {
for (j=jmin; j<jmax; j++) {
/* rtmp += -U(i,k)^T * U_bar(i,j) */
rtmp_ptr = rtmp + bj[j]*16;
u = ba + j*16;
rtmp_ptr[0] += uik[0]*u[0] + uik[1]*u[1] + uik[2]*u[2] + uik[3]*u[3];
rtmp_ptr[1] += uik[4]*u[0] + uik[5]*u[1] + uik[6]*u[2] + uik[7]*u[3];
rtmp_ptr[2] += uik[8]*u[0] + uik[9]*u[1] + uik[10]*u[2]+ uik[11]*u[3];
rtmp_ptr[3] += uik[12]*u[0]+ uik[13]*u[1]+ uik[14]*u[2]+ uik[15]*u[3];
rtmp_ptr[4] += uik[0]*u[4] + uik[1]*u[5] + uik[2]*u[6] + uik[3]*u[7];
rtmp_ptr[5] += uik[4]*u[4] + uik[5]*u[5] + uik[6]*u[6] + uik[7]*u[7];
rtmp_ptr[6] += uik[8]*u[4] + uik[9]*u[5] + uik[10]*u[6]+ uik[11]*u[7];
rtmp_ptr[7] += uik[12]*u[4]+ uik[13]*u[5]+ uik[14]*u[6]+ uik[15]*u[7];
rtmp_ptr[8] += uik[0]*u[8] + uik[1]*u[9] + uik[2]*u[10] + uik[3]*u[11];
rtmp_ptr[9] += uik[4]*u[8] + uik[5]*u[9] + uik[6]*u[10] + uik[7]*u[11];
rtmp_ptr[10]+= uik[8]*u[8] + uik[9]*u[9] + uik[10]*u[10]+ uik[11]*u[11];
rtmp_ptr[11]+= uik[12]*u[8]+ uik[13]*u[9]+ uik[14]*u[10]+ uik[15]*u[11];
rtmp_ptr[12]+= uik[0]*u[12] + uik[1]*u[13] + uik[2]*u[14] + uik[3]*u[15];
rtmp_ptr[13]+= uik[4]*u[12] + uik[5]*u[13] + uik[6]*u[14] + uik[7]*u[15];
rtmp_ptr[14]+= uik[8]*u[12] + uik[9]*u[13] + uik[10]*u[14]+ uik[11]*u[15];
rtmp_ptr[15]+= uik[12]*u[12]+ uik[13]*u[13]+ uik[14]*u[14]+ uik[15]*u[15];
}
ierr = PetscLogFlops(2.0*64.0*(jmax-jmin));CHKERRQ(ierr);
/* ... add i to row list for next nonzero entry */
il[i] = jmin; /* update il(i) in column k+1, ... mbs-1 */
j = bj[jmin];
jl[i] = jl[j]; jl[j] = i; /* update jl */
}
i = nexti;
}
/* save nonzero entries in k-th row of U ... */
/* invert diagonal block */
diag = ba+k*16;
ierr = PetscMemcpy(diag,dk,16*sizeof(MatScalar));CHKERRQ(ierr);
if (pivotinblocks) {
ierr = PetscKernel_A_gets_inverse_A_4(diag,shift, allowzeropivot,&zeropivotdetected);CHKERRQ(ierr);
if (zeropivotdetected) C->factorerrortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
} else {
ierr = PetscKernel_A_gets_inverse_A_4_nopivot(diag);CHKERRQ(ierr);
}
jmin = bi[k]; jmax = bi[k+1];
if (jmin < jmax) {
for (j=jmin; j<jmax; j++) {
vj = bj[j]; /* block col. index of U */
u = ba + j*16;
rtmp_ptr = rtmp + vj*16;
for (k1=0; k1<16; k1++) {
*u++ = *rtmp_ptr;
*rtmp_ptr++ = 0.0;
}
}
/* ... add k to row list for first nonzero entry in k-th row */
il[k] = jmin;
i = bj[jmin];
jl[k] = jl[i]; jl[i] = k;
}
}
ierr = PetscFree(rtmp);CHKERRQ(ierr);
ierr = PetscFree2(il,jl);CHKERRQ(ierr);
ierr = PetscFree2(dk,uik);CHKERRQ(ierr);
if (a->permute) {
ierr = PetscFree(aa);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(perm,&perm_ptr);CHKERRQ(ierr);
C->ops->solve = MatSolve_SeqSBAIJ_4_inplace;
C->ops->solvetranspose = MatSolve_SeqSBAIJ_4_inplace;
C->assembled = PETSC_TRUE;
C->preallocated = PETSC_TRUE;
ierr = PetscLogFlops(1.3333*64*b->mbs);CHKERRQ(ierr); /* from inverting diagonal blocks */
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat Amat;
PetscErrorCode ierr;
SNES snes;
KSP ksp;
MPI_Comm comm;
PetscMPIInt npe,rank;
PetscLogStage stage[7];
PetscBool test_nonzero_cols=PETSC_FALSE,use_nearnullspace=PETSC_TRUE;
Vec xx,bb;
PetscInt iter,i,N,dim=3,cells[3]={1,1,1},max_conv_its,local_sizes[7],run_type=1;
DM dm,distdm,basedm;
PetscBool flg;
char convType[256];
PetscReal Lx,mdisp[10],err[10];
const char * const options[10] = {"-ex56_dm_refine 0",
"-ex56_dm_refine 1",
"-ex56_dm_refine 2",
"-ex56_dm_refine 3",
"-ex56_dm_refine 4",
"-ex56_dm_refine 5",
"-ex56_dm_refine 6",
"-ex56_dm_refine 7",
"-ex56_dm_refine 8",
"-ex56_dm_refine 9"};
PetscFunctionBeginUser;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
comm = PETSC_COMM_WORLD;
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &npe);CHKERRQ(ierr);
/* options */
ierr = PetscOptionsBegin(comm,NULL,"3D bilinear Q1 elasticity options","");CHKERRQ(ierr);
{
i = 3;
ierr = PetscOptionsIntArray("-cells", "Number of (flux tube) processor in each dimension", "ex56.c", cells, &i, NULL);CHKERRQ(ierr);
Lx = 1.; /* or ne for rod */
max_conv_its = 3;
ierr = PetscOptionsInt("-max_conv_its","Number of iterations in convergence study","",max_conv_its,&max_conv_its,NULL);CHKERRQ(ierr);
if (max_conv_its<=0 || max_conv_its>7) SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_USER, "Bad number of iterations for convergence test (%D)",max_conv_its);
ierr = PetscOptionsReal("-lx","Length of domain","",Lx,&Lx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alpha","material coefficient inside circle","",s_soft_alpha,&s_soft_alpha,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-test_nonzero_cols","nonzero test","",test_nonzero_cols,&test_nonzero_cols,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-use_mat_nearnullspace","MatNearNullSpace API test","",use_nearnullspace,&use_nearnullspace,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-run_type","0: twisting load on cantalever, 1: 3rd order accurate convergence test","",run_type,&run_type,NULL);CHKERRQ(ierr);
i = 3;
ierr = PetscOptionsInt("-mat_block_size","","",i,&i,&flg);CHKERRQ(ierr);
if (!flg || i!=3) SETERRQ2(PETSC_COMM_WORLD, PETSC_ERR_USER, "'-mat_block_size 3' must be set (%D) and = 3 (%D)",flg,flg? i : 3);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscLogStageRegister("Mesh Setup", &stage[6]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Setup", &stage[0]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Solve", &stage[1]);CHKERRQ(ierr);
/* create DM, Plex calls DMSetup */
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
ierr = DMPlexCreateHexBoxMesh(comm, dim, cells, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, &dm);CHKERRQ(ierr);
{
DMLabel label;
IS is;
ierr = DMCreateLabel(dm, "boundary");CHKERRQ(ierr);
ierr = DMGetLabel(dm, "boundary", &label);CHKERRQ(ierr);
ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
if (run_type==0) {
ierr = DMGetStratumIS(dm, "boundary", 1, &is);CHKERRQ(ierr);
ierr = DMCreateLabel(dm,"Faces");CHKERRQ(ierr);
if (is) {
PetscInt d, f, Nf;
const PetscInt *faces;
PetscInt csize;
PetscSection cs;
Vec coordinates ;
DM cdm;
ierr = ISGetLocalSize(is, &Nf);CHKERRQ(ierr);
ierr = ISGetIndices(is, &faces);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
ierr = DMGetDefaultSection(cdm, &cs);CHKERRQ(ierr);
/* Check for each boundary face if any component of its centroid is either 0.0 or 1.0 */
for (f = 0; f < Nf; ++f) {
PetscReal faceCoord;
PetscInt b,v;
PetscScalar *coords = NULL;
PetscInt Nv;
ierr = DMPlexVecGetClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
Nv = csize/dim; /* Calculate mean coordinate vector */
for (d = 0; d < dim; ++d) {
faceCoord = 0.0;
for (v = 0; v < Nv; ++v) faceCoord += PetscRealPart(coords[v*dim+d]);
faceCoord /= Nv;
for (b = 0; b < 2; ++b) {
if (PetscAbs(faceCoord - b) < PETSC_SMALL) { /* domain have not been set yet, still [0,1]^3 */
ierr = DMSetLabelValue(dm, "Faces", faces[f], d*2+b+1);CHKERRQ(ierr);
}
}
}
ierr = DMPlexVecRestoreClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(is, &faces);CHKERRQ(ierr);
}
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = DMGetLabel(dm, "Faces", &label);CHKERRQ(ierr);
ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
}
}
{
PetscInt dimEmbed, i;
PetscInt nCoords;
PetscScalar *coords,bounds[] = {0,Lx,-.5,.5,-.5,.5,}; /* x_min,x_max,y_min,y_max */
Vec coordinates;
if (run_type==1) {
for (i = 0; i < 2*dim; i++) bounds[i] = (i%2) ? 1 : 0;
}
ierr = DMGetCoordinatesLocal(dm,&coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDim(dm,&dimEmbed);CHKERRQ(ierr);
if (dimEmbed != dim) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"dimEmbed != dim %D",dimEmbed);CHKERRQ(ierr);
ierr = VecGetLocalSize(coordinates,&nCoords);CHKERRQ(ierr);
if (nCoords % dimEmbed) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Coordinate vector the wrong size");CHKERRQ(ierr);
ierr = VecGetArray(coordinates,&coords);CHKERRQ(ierr);
for (i = 0; i < nCoords; i += dimEmbed) {
PetscInt j;
PetscScalar *coord = &coords[i];
for (j = 0; j < dimEmbed; j++) {
coord[j] = bounds[2 * j] + coord[j] * (bounds[2 * j + 1] - bounds[2 * j]);
}
}
ierr = VecRestoreArray(coordinates,&coords);CHKERRQ(ierr);
ierr = DMSetCoordinatesLocal(dm,coordinates);CHKERRQ(ierr);
}
/* convert to p4est, and distribute */
ierr = PetscOptionsBegin(comm, "", "Mesh conversion options", "DMPLEX");CHKERRQ(ierr);
ierr = PetscOptionsFList("-dm_type","Convert DMPlex to another format (should not be Plex!)","ex56.c",DMList,DMPLEX,convType,256,&flg);CHKERRQ(ierr);
ierr = PetscOptionsEnd();
if (flg) {
DM newdm;
ierr = DMConvert(dm,convType,&newdm);CHKERRQ(ierr);
if (newdm) {
const char *prefix;
PetscBool isForest;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)newdm,prefix);CHKERRQ(ierr);
ierr = DMIsForest(newdm,&isForest);CHKERRQ(ierr);
if (isForest) {
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Converted to non Forest?");
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = newdm;
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Convert failed?");
} else {
/* Plex Distribute mesh over processes */
ierr = DMPlexDistribute(dm, 0, NULL, &distdm);CHKERRQ(ierr);
if (distdm) {
const char *prefix;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)distdm,prefix);CHKERRQ(ierr);
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = distdm;
}
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
basedm = dm; dm = NULL;
for (iter=0 ; iter<max_conv_its ; iter++) {
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
/* make new DM */
ierr = DMClone(basedm, &dm);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject) dm, "ex56_");CHKERRQ(ierr);
ierr = PetscObjectSetName( (PetscObject)dm,"Mesh");CHKERRQ(ierr);
ierr = PetscOptionsClearValue(NULL,"-ex56_dm_refine");CHKERRQ(ierr);
ierr = PetscOptionsInsertString(NULL,options[iter]);CHKERRQ(ierr);
ierr = DMSetFromOptions(dm);CHKERRQ(ierr); /* refinement done here in Plex, p4est */
/* snes */
ierr = SNESCreate(comm, &snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes, dm);CHKERRQ(ierr);
/* fem */
{
const PetscInt Ncomp = dim;
const PetscInt components[] = {0,1,2};
const PetscInt Nfid = 1, Npid = 1;
const PetscInt fid[] = {1}; /* The fixed faces (x=0) */
const PetscInt pid[] = {2}; /* The faces with loading (x=L_x) */
PetscFE fe;
PetscDS prob;
DM cdm = dm;
ierr = PetscFECreateDefault(dm, dim, dim, PETSC_FALSE, NULL, PETSC_DECIDE, &fe);CHKERRQ(ierr); /* elasticity */
ierr = PetscObjectSetName((PetscObject) fe, "deformation");CHKERRQ(ierr);
/* FEM prob */
ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
ierr = PetscDSSetDiscretization(prob, 0, (PetscObject) fe);CHKERRQ(ierr);
/* setup problem */
if (run_type==1) {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u_x4, f1_u_3d);CHKERRQ(ierr);
} else {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u, f1_u_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetBdResidual(prob, 0, f0_bd_u_3d, f1_bd_u);CHKERRQ(ierr);
}
/* bcs */
if (run_type==1) {
PetscInt id = 1;
ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", "boundary", 0, 0, NULL, (void (*)()) zero, 1, &id, NULL);CHKERRQ(ierr);
} else {
ierr = PetscDSAddBoundary(prob, DM_BC_ESSENTIAL, "fixed", "Faces", 0, Ncomp, components, (void (*)()) zero, Nfid, fid, NULL);CHKERRQ(ierr);
ierr = PetscDSAddBoundary(prob, DM_BC_NATURAL, "traction", "Faces", 0, Ncomp, components, NULL, Npid, pid, NULL);CHKERRQ(ierr);
}
while (cdm) {
ierr = DMSetDS(cdm,prob);CHKERRQ(ierr);
ierr = DMGetCoarseDM(cdm, &cdm);CHKERRQ(ierr);
}
ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
}
/* vecs & mat */
ierr = DMCreateGlobalVector(dm,&xx);CHKERRQ(ierr);
ierr = VecDuplicate(xx, &bb);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) bb, "b");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) xx, "u");CHKERRQ(ierr);
ierr = DMCreateMatrix(dm, &Amat);CHKERRQ(ierr);
ierr = VecGetSize(bb,&N);CHKERRQ(ierr);
local_sizes[iter] = N;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d global equations, %d vertices\n",rank,PETSC_FUNCTION_NAME,N,N/dim);CHKERRQ(ierr);
if (use_nearnullspace && N/dim > 1) {
/* Set up the near null space (a.k.a. rigid body modes) that will be used by the multigrid preconditioner */
DM subdm;
MatNullSpace nearNullSpace;
PetscInt fields = 0;
PetscObject deformation;
ierr = DMCreateSubDM(dm, 1, &fields, NULL, &subdm);CHKERRQ(ierr);
ierr = DMPlexCreateRigidBody(subdm, &nearNullSpace);CHKERRQ(ierr);
ierr = DMGetField(dm, 0, &deformation);CHKERRQ(ierr);
ierr = PetscObjectCompose(deformation, "nearnullspace", (PetscObject) nearNullSpace);CHKERRQ(ierr);
ierr = DMDestroy(&subdm);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nearNullSpace);CHKERRQ(ierr); /* created by DM and destroyed by Mat */
}
ierr = DMPlexSetSNESLocalFEM(dm,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, Amat, Amat, NULL, NULL);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = DMSetUp(dm);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stage[0]);CHKERRQ(ierr);
/* ksp */
ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(ksp,PETSC_TRUE);CHKERRQ(ierr);
/* test BCs */
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
if (test_nonzero_cols) {
if (rank==0) ierr = VecSetValue(xx,0,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(xx);CHKERRQ(ierr);
ierr = VecAssemblyEnd(xx);CHKERRQ(ierr);
}
ierr = VecZeroEntries(bb);CHKERRQ(ierr);
ierr = VecGetSize(bb,&i);CHKERRQ(ierr);
local_sizes[iter] = i;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d equations in vector, %d vertices\n",rank,PETSC_FUNCTION_NAME,i,i/dim);CHKERRQ(ierr);
/* setup solver, dummy solve to really setup */
if (0) {
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,50);CHKERRQ(ierr);
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
/* solve */
ierr = PetscLogStagePush(stage[1]);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = VecNorm(xx,NORM_INFINITY,&mdisp[iter]);CHKERRQ(ierr);
ierr = DMViewFromOptions(dm, NULL, "-dm_view");CHKERRQ(ierr);
{
PetscViewer viewer = NULL;
PetscViewerFormat fmt;
ierr = PetscOptionsGetViewer(comm,"ex56_","-vec_view",&viewer,&fmt,&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscViewerPushFormat(viewer,fmt);CHKERRQ(ierr);
ierr = VecView(xx,viewer);CHKERRQ(ierr);
ierr = VecView(bb,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* Free work space */
ierr = DMDestroy(&dm);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = VecDestroy(&xx);CHKERRQ(ierr);
ierr = VecDestroy(&bb);CHKERRQ(ierr);
ierr = MatDestroy(&Amat);CHKERRQ(ierr);
}
ierr = DMDestroy(&basedm);CHKERRQ(ierr);
if (run_type==1) {
err[0] = 59.975208 - mdisp[0]; /* error with what I think is the exact solution */
} else {
err[0] = 171.038 - mdisp[0];
}
for (iter=1 ; iter<max_conv_its ; iter++) {
if (run_type==1) {
err[iter] = 59.975208 - mdisp[iter];
} else {
err[iter] = 171.038 - mdisp[iter];
}
PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %D) N=%12D, max displ=%9.7e, disp diff=%9.2e, error=%4.3e, rate=%3.2g\n",
rank,PETSC_FUNCTION_NAME,iter,local_sizes[iter],mdisp[iter],
mdisp[iter]-mdisp[iter-1],err[iter],log(err[iter-1]/err[iter])/log(2.));
}
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode DMSetUp_DA_2D(DM da)
{
DM_DA *dd = (DM_DA*)da->data;
const PetscInt M = dd->M;
const PetscInt N = dd->N;
PetscInt m = dd->m;
PetscInt n = dd->n;
const PetscInt dof = dd->w;
const PetscInt s = dd->s;
DMDABoundaryType bx = dd->bx;
DMDABoundaryType by = dd->by;
DMDAStencilType stencil_type = dd->stencil_type;
PetscInt *lx = dd->lx;
PetscInt *ly = dd->ly;
MPI_Comm comm;
PetscMPIInt rank,size;
PetscInt xs,xe,ys,ye,x,y,Xs,Xe,Ys,Ye,start,end,IXs,IXe,IYs,IYe;
PetscInt up,down,left,right,i,n0,n1,n2,n3,n5,n6,n7,n8,*idx,nn,*idx_cpy;
const PetscInt *idx_full;
PetscInt xbase,*bases,*ldims,j,x_t,y_t,s_t,base,count;
PetscInt s_x,s_y; /* s proportionalized to w */
PetscInt sn0 = 0,sn2 = 0,sn6 = 0,sn8 = 0;
Vec local,global;
VecScatter ltog,gtol;
IS to,from,ltogis;
PetscErrorCode ierr;
PetscFunctionBegin;
if (stencil_type == DMDA_STENCIL_BOX && (bx == DMDA_BOUNDARY_MIRROR || by == DMDA_BOUNDARY_MIRROR)) SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_SUP,"Mirror boundary and box stencil");
ierr = PetscObjectGetComm((PetscObject)da,&comm);
CHKERRQ(ierr);
#if !defined(PETSC_USE_64BIT_INDICES)
if (((Petsc64bitInt) M)*((Petsc64bitInt) N)*((Petsc64bitInt) dof) > (Petsc64bitInt) PETSC_MPI_INT_MAX) SETERRQ3(comm,PETSC_ERR_INT_OVERFLOW,"Mesh of %D by %D by %D (dof) is too large for 32 bit indices",M,N,dof);
#endif
if (dof < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Must have 1 or more degrees of freedom per node: %D",dof);
if (s < 0) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Stencil width cannot be negative: %D",s);
ierr = MPI_Comm_size(comm,&size);
CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);
CHKERRQ(ierr);
if (m != PETSC_DECIDE) {
if (m < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in X direction: %D",m);
else if (m > size) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in X direction: %D %d",m,size);
}
if (n != PETSC_DECIDE) {
if (n < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in Y direction: %D",n);
else if (n > size) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in Y direction: %D %d",n,size);
}
if (m == PETSC_DECIDE || n == PETSC_DECIDE) {
if (n != PETSC_DECIDE) {
m = size/n;
} else if (m != PETSC_DECIDE) {
n = size/m;
} else {
/* try for squarish distribution */
m = (PetscInt)(0.5 + PetscSqrtReal(((PetscReal)M)*((PetscReal)size)/((PetscReal)N)));
if (!m) m = 1;
while (m > 0) {
n = size/m;
if (m*n == size) break;
m--;
}
if (M > N && m < n) {
PetscInt _m = m;
m = n;
n = _m;
}
}
if (m*n != size) SETERRQ(comm,PETSC_ERR_PLIB,"Unable to create partition, check the size of the communicator and input m and n ");
} else if (m*n != size) SETERRQ(comm,PETSC_ERR_ARG_OUTOFRANGE,"Given Bad partition");
if (M < m) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Partition in x direction is too fine! %D %D",M,m);
if (N < n) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Partition in y direction is too fine! %D %D",N,n);
/*
Determine locally owned region
xs is the first local node number, x is the number of local nodes
*/
if (!lx) {
ierr = PetscMalloc(m*sizeof(PetscInt), &dd->lx);
CHKERRQ(ierr);
lx = dd->lx;
for (i=0; i<m; i++) {
lx[i] = M/m + ((M % m) > i);
}
}
x = lx[rank % m];
xs = 0;
for (i=0; i<(rank % m); i++) {
xs += lx[i];
}
#if defined(PETSC_USE_DEBUG)
left = xs;
for (i=(rank % m); i<m; i++) {
left += lx[i];
}
if (left != M) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Sum of lx across processors not equal to M: %D %D",left,M);
#endif
/*
Determine locally owned region
ys is the first local node number, y is the number of local nodes
*/
if (!ly) {
ierr = PetscMalloc(n*sizeof(PetscInt), &dd->ly);
CHKERRQ(ierr);
ly = dd->ly;
for (i=0; i<n; i++) {
ly[i] = N/n + ((N % n) > i);
}
}
y = ly[rank/m];
ys = 0;
for (i=0; i<(rank/m); i++) {
ys += ly[i];
}
#if defined(PETSC_USE_DEBUG)
left = ys;
for (i=(rank/m); i<n; i++) {
left += ly[i];
}
if (left != N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Sum of ly across processors not equal to N: %D %D",left,N);
#endif
/*
check if the scatter requires more than one process neighbor or wraps around
the domain more than once
*/
if ((x < s) && ((m > 1) || (bx == DMDA_BOUNDARY_PERIODIC))) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local x-width of domain x %D is smaller than stencil width s %D",x,s);
if ((y < s) && ((n > 1) || (by == DMDA_BOUNDARY_PERIODIC))) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local y-width of domain y %D is smaller than stencil width s %D",y,s);
xe = xs + x;
ye = ys + y;
/* determine ghost region (Xs) and region scattered into (IXs) */
if (xs-s > 0) {
Xs = xs - s;
IXs = xs - s;
} else {
if (bx) {
Xs = xs - s;
} else {
Xs = 0;
}
IXs = 0;
}
if (xe+s <= M) {
Xe = xe + s;
IXe = xe + s;
} else {
if (bx) {
Xs = xs - s;
Xe = xe + s;
} else {
Xe = M;
}
IXe = M;
}
if (bx == DMDA_BOUNDARY_PERIODIC || bx == DMDA_BOUNDARY_MIRROR) {
IXs = xs - s;
IXe = xe + s;
Xs = xs - s;
Xe = xe + s;
}
if (ys-s > 0) {
Ys = ys - s;
IYs = ys - s;
} else {
if (by) {
Ys = ys - s;
} else {
Ys = 0;
}
IYs = 0;
}
if (ye+s <= N) {
Ye = ye + s;
IYe = ye + s;
} else {
if (by) {
Ye = ye + s;
} else {
Ye = N;
}
IYe = N;
}
if (by == DMDA_BOUNDARY_PERIODIC || by == DMDA_BOUNDARY_MIRROR) {
IYs = ys - s;
IYe = ye + s;
Ys = ys - s;
Ye = ye + s;
}
/* stencil length in each direction */
s_x = s;
s_y = s;
/* determine starting point of each processor */
nn = x*y;
ierr = PetscMalloc2(size+1,PetscInt,&bases,size,PetscInt,&ldims);
CHKERRQ(ierr);
ierr = MPI_Allgather(&nn,1,MPIU_INT,ldims,1,MPIU_INT,comm);
CHKERRQ(ierr);
bases[0] = 0;
for (i=1; i<=size; i++) {
bases[i] = ldims[i-1];
}
for (i=1; i<=size; i++) {
bases[i] += bases[i-1];
}
base = bases[rank]*dof;
/* allocate the base parallel and sequential vectors */
dd->Nlocal = x*y*dof;
ierr = VecCreateMPIWithArray(comm,dof,dd->Nlocal,PETSC_DECIDE,0,&global);
CHKERRQ(ierr);
dd->nlocal = (Xe-Xs)*(Ye-Ys)*dof;
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,dof,dd->nlocal,0,&local);
CHKERRQ(ierr);
/* generate appropriate vector scatters */
/* local to global inserts non-ghost point region into global */
ierr = VecGetOwnershipRange(global,&start,&end);
CHKERRQ(ierr);
ierr = ISCreateStride(comm,x*y*dof,start,1,&to);
CHKERRQ(ierr);
ierr = PetscMalloc(x*y*sizeof(PetscInt),&idx);
CHKERRQ(ierr);
left = xs - Xs;
right = left + x;
down = ys - Ys;
up = down + y;
count = 0;
for (i=down; i<up; i++) {
for (j=left; j<right; j++) {
idx[count++] = i*(Xe-Xs) + j;
}
}
ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&from);
CHKERRQ(ierr);
ierr = VecScatterCreate(local,from,global,to,<og);
CHKERRQ(ierr);
ierr = PetscLogObjectParent(dd,ltog);
CHKERRQ(ierr);
ierr = ISDestroy(&from);
CHKERRQ(ierr);
ierr = ISDestroy(&to);
CHKERRQ(ierr);
/* global to local must include ghost points within the domain,
but not ghost points outside the domain that aren't periodic */
if (stencil_type == DMDA_STENCIL_BOX) {
count = (IXe-IXs)*(IYe-IYs);
ierr = PetscMalloc(count*sizeof(PetscInt),&idx);
CHKERRQ(ierr);
left = IXs - Xs;
right = left + (IXe-IXs);
down = IYs - Ys;
up = down + (IYe-IYs);
count = 0;
for (i=down; i<up; i++) {
for (j=left; j<right; j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&to);
CHKERRQ(ierr);
} else {
/* must drop into cross shape region */
/* ---------|
| top |
|--- ---| up
| middle |
| |
---- ---- down
| bottom |
-----------
Xs xs xe Xe */
count = (ys-IYs)*x + y*(IXe-IXs) + (IYe-ye)*x;
ierr = PetscMalloc(count*sizeof(PetscInt),&idx);
CHKERRQ(ierr);
left = xs - Xs;
right = left + x;
down = ys - Ys;
up = down + y;
count = 0;
/* bottom */
for (i=(IYs-Ys); i<down; i++) {
for (j=left; j<right; j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
/* middle */
for (i=down; i<up; i++) {
for (j=(IXs-Xs); j<(IXe-Xs); j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
/* top */
for (i=up; i<up+IYe-ye; i++) {
for (j=left; j<right; j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&to);
CHKERRQ(ierr);
}
/* determine who lies on each side of us stored in n6 n7 n8
n3 n5
n0 n1 n2
*/
/* Assume the Non-Periodic Case */
n1 = rank - m;
if (rank % m) {
n0 = n1 - 1;
} else {
n0 = -1;
}
if ((rank+1) % m) {
n2 = n1 + 1;
n5 = rank + 1;
n8 = rank + m + 1;
if (n8 >= m*n) n8 = -1;
} else {
n2 = -1;
n5 = -1;
n8 = -1;
}
if (rank % m) {
n3 = rank - 1;
n6 = n3 + m;
if (n6 >= m*n) n6 = -1;
} else {
n3 = -1;
n6 = -1;
}
n7 = rank + m;
if (n7 >= m*n) n7 = -1;
if (bx == DMDA_BOUNDARY_PERIODIC && by == DMDA_BOUNDARY_PERIODIC) {
/* Modify for Periodic Cases */
/* Handle all four corners */
if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1;
if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0;
if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m;
if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1;
/* Handle Top and Bottom Sides */
if (n1 < 0) n1 = rank + m * (n-1);
if (n7 < 0) n7 = rank - m * (n-1);
if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
/* Handle Left and Right Sides */
if (n3 < 0) n3 = rank + (m-1);
if (n5 < 0) n5 = rank - (m-1);
if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
} else if (by == DMDA_BOUNDARY_PERIODIC) { /* Handle Top and Bottom Sides */
if (n1 < 0) n1 = rank + m * (n-1);
if (n7 < 0) n7 = rank - m * (n-1);
if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
} else if (bx == DMDA_BOUNDARY_PERIODIC) { /* Handle Left and Right Sides */
if (n3 < 0) n3 = rank + (m-1);
if (n5 < 0) n5 = rank - (m-1);
if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
}
ierr = PetscMalloc(9*sizeof(PetscInt),&dd->neighbors);
CHKERRQ(ierr);
dd->neighbors[0] = n0;
dd->neighbors[1] = n1;
dd->neighbors[2] = n2;
dd->neighbors[3] = n3;
dd->neighbors[4] = rank;
dd->neighbors[5] = n5;
dd->neighbors[6] = n6;
dd->neighbors[7] = n7;
dd->neighbors[8] = n8;
if (stencil_type == DMDA_STENCIL_STAR) {
/* save corner processor numbers */
sn0 = n0;
sn2 = n2;
sn6 = n6;
sn8 = n8;
n0 = n2 = n6 = n8 = -1;
}
ierr = PetscMalloc((Xe-Xs)*(Ye-Ys)*sizeof(PetscInt),&idx);
CHKERRQ(ierr);
ierr = PetscLogObjectMemory(da,(Xe-Xs)*(Ye-Ys)*sizeof(PetscInt));
CHKERRQ(ierr);
nn = 0;
xbase = bases[rank];
for (i=1; i<=s_y; i++) {
if (n0 >= 0) { /* left below */
x_t = lx[n0 % m];
y_t = ly[(n0/m)];
s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
if (n1 >= 0) { /* directly below */
x_t = x;
y_t = ly[(n1/m)];
s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(s_y - i + 1) + j;
}
if (n2 >= 0) { /* right below */
x_t = lx[n2 % m];
y_t = ly[(n2/m)];
s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
}
for (i=0; i<y; i++) {
if (n3 >= 0) { /* directly left */
x_t = lx[n3 % m];
/* y_t = y; */
s_t = bases[n3] + (i+1)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*i + s_x - j;
}
for (j=0; j<x; j++) idx[nn++] = xbase++; /* interior */
if (n5 >= 0) { /* directly right */
x_t = lx[n5 % m];
/* y_t = y; */
s_t = bases[n5] + (i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*(i + 1) - 2 - j;
}
}
for (i=1; i<=s_y; i++) {
if (n6 >= 0) { /* left above */
x_t = lx[n6 % m];
/* y_t = ly[(n6/m)]; */
s_t = bases[n6] + (i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
if (n7 >= 0) { /* directly above */
x_t = x;
/* y_t = ly[(n7/m)]; */
s_t = bases[n7] + (i-1)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(y - i - 1) + j;
}
if (n8 >= 0) { /* right above */
x_t = lx[n8 % m];
/* y_t = ly[(n8/m)]; */
s_t = bases[n8] + (i-1)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
}
ierr = ISCreateBlock(comm,dof,nn,idx,PETSC_COPY_VALUES,&from);
CHKERRQ(ierr);
ierr = VecScatterCreate(global,from,local,to,>ol);
CHKERRQ(ierr);
ierr = PetscLogObjectParent(da,gtol);
CHKERRQ(ierr);
ierr = ISDestroy(&to);
CHKERRQ(ierr);
ierr = ISDestroy(&from);
CHKERRQ(ierr);
if (stencil_type == DMDA_STENCIL_STAR) {
n0 = sn0;
n2 = sn2;
n6 = sn6;
n8 = sn8;
}
if (((stencil_type == DMDA_STENCIL_STAR) ||
(bx && bx != DMDA_BOUNDARY_PERIODIC) ||
(by && by != DMDA_BOUNDARY_PERIODIC))) {
/*
Recompute the local to global mappings, this time keeping the
information about the cross corner processor numbers and any ghosted
but not periodic indices.
*/
nn = 0;
xbase = bases[rank];
for (i=1; i<=s_y; i++) {
if (n0 >= 0) { /* left below */
x_t = lx[n0 % m];
y_t = ly[(n0/m)];
s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (xs-Xs > 0 && ys-Ys > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
if (n1 >= 0) { /* directly below */
x_t = x;
y_t = ly[(n1/m)];
s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (ys-Ys > 0) {
if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(s_y - i + 1) + j;
} else {
for (j=0; j<x; j++) idx[nn++] = -1;
}
}
if (n2 >= 0) { /* right below */
x_t = lx[n2 % m];
y_t = ly[(n2/m)];
s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (Xe-xe> 0 && ys-Ys > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
for (i=0; i<y; i++) {
if (n3 >= 0) { /* directly left */
x_t = lx[n3 % m];
/* y_t = y; */
s_t = bases[n3] + (i+1)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (xs-Xs > 0) {
if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*i + s_x - j;
} else {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
for (j=0; j<x; j++) idx[nn++] = xbase++; /* interior */
if (n5 >= 0) { /* directly right */
x_t = lx[n5 % m];
/* y_t = y; */
s_t = bases[n5] + (i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (Xe-xe > 0) {
if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*(i + 1) - 2 - j;
} else {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
}
for (i=1; i<=s_y; i++) {
if (n6 >= 0) { /* left above */
x_t = lx[n6 % m];
/* y_t = ly[(n6/m)]; */
s_t = bases[n6] + (i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (xs-Xs > 0 && Ye-ye > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
if (n7 >= 0) { /* directly above */
x_t = x;
/* y_t = ly[(n7/m)]; */
s_t = bases[n7] + (i-1)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (Ye-ye > 0) {
if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(y - i - 1) + j;
} else {
for (j=0; j<x; j++) idx[nn++] = -1;
}
}
if (n8 >= 0) { /* right above */
x_t = lx[n8 % m];
/* y_t = ly[(n8/m)]; */
s_t = bases[n8] + (i-1)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (Xe-xe > 0 && Ye-ye > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
}
/*
Set the local to global ordering in the global vector, this allows use
of VecSetValuesLocal().
*/
ierr = ISCreateBlock(comm,dof,nn,idx,PETSC_OWN_POINTER,<ogis);
CHKERRQ(ierr);
ierr = PetscMalloc(nn*dof*sizeof(PetscInt),&idx_cpy);
CHKERRQ(ierr);
ierr = PetscLogObjectMemory(da,nn*dof*sizeof(PetscInt));
CHKERRQ(ierr);
ierr = ISGetIndices(ltogis, &idx_full);
CHKERRQ(ierr);
ierr = PetscMemcpy(idx_cpy,idx_full,nn*dof*sizeof(PetscInt));
CHKERRQ(ierr);
ierr = ISRestoreIndices(ltogis, &idx_full);
CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingCreateIS(ltogis,&da->ltogmap);
CHKERRQ(ierr);
ierr = PetscLogObjectParent(da,da->ltogmap);
CHKERRQ(ierr);
ierr = ISDestroy(<ogis);
CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingBlock(da->ltogmap,dd->w,&da->ltogmapb);
CHKERRQ(ierr);
ierr = PetscLogObjectParent(da,da->ltogmap);
CHKERRQ(ierr);
ierr = PetscFree2(bases,ldims);
CHKERRQ(ierr);
dd->m = m;
dd->n = n;
/* note petsc expects xs/xe/Xs/Xe to be multiplied by #dofs in many places */
dd->xs = xs*dof;
dd->xe = xe*dof;
dd->ys = ys;
dd->ye = ye;
dd->zs = 0;
dd->ze = 1;
dd->Xs = Xs*dof;
dd->Xe = Xe*dof;
dd->Ys = Ys;
dd->Ye = Ye;
dd->Zs = 0;
dd->Ze = 1;
ierr = VecDestroy(&local);
CHKERRQ(ierr);
ierr = VecDestroy(&global);
CHKERRQ(ierr);
dd->gtol = gtol;
dd->ltog = ltog;
dd->idx = idx_cpy;
dd->Nl = nn*dof;
dd->base = base;
da->ops->view = DMView_DA_2d;
dd->ltol = NULL;
dd->ao = NULL;
PetscFunctionReturn(0);
}
static PetscErrorCode PCBDDCScalingSetUp_Deluxe_Private(PC pc)
{
PC_BDDC *pcbddc=(PC_BDDC*)pc->data;
PCBDDCDeluxeScaling deluxe_ctx=pcbddc->deluxe_ctx;
PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
PetscScalar *matdata,*matdata2;
PetscInt i,max_subset_size,cum,cum2;
const PetscInt *idxs;
PetscBool newsetup = PETSC_FALSE;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!sub_schurs) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Missing PCBDDCSubSchurs");
if (!sub_schurs->n_subs) PetscFunctionReturn(0);
/* Allocate arrays for subproblems */
if (!deluxe_ctx->seq_n) {
deluxe_ctx->seq_n = sub_schurs->n_subs;
ierr = PetscCalloc5(deluxe_ctx->seq_n,&deluxe_ctx->seq_scctx,deluxe_ctx->seq_n,&deluxe_ctx->seq_work1,deluxe_ctx->seq_n,&deluxe_ctx->seq_work2,deluxe_ctx->seq_n,&deluxe_ctx->seq_mat,deluxe_ctx->seq_n,&deluxe_ctx->seq_mat_inv_sum);CHKERRQ(ierr);
newsetup = PETSC_TRUE;
} else if (deluxe_ctx->seq_n != sub_schurs->n_subs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Number of deluxe subproblems %D is different from the sub_schurs %D",deluxe_ctx->seq_n,sub_schurs->n_subs);
/* the change of basis is just a reference to sub_schurs->change (if any) */
deluxe_ctx->change = sub_schurs->change;
deluxe_ctx->change_with_qr = sub_schurs->change_with_qr;
/* Create objects for deluxe */
max_subset_size = 0;
for (i=0;i<sub_schurs->n_subs;i++) {
PetscInt subset_size;
ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
max_subset_size = PetscMax(subset_size,max_subset_size);
}
if (newsetup) {
ierr = PetscMalloc1(2*max_subset_size,&deluxe_ctx->workspace);CHKERRQ(ierr);
}
cum = cum2 = 0;
ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(sub_schurs->S_Ej_all,&matdata);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_all,&matdata2);CHKERRQ(ierr);
for (i=0;i<deluxe_ctx->seq_n;i++) {
PetscInt subset_size;
ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
if (newsetup) {
IS sub;
/* work vectors */
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,subset_size,deluxe_ctx->workspace,&deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,subset_size,deluxe_ctx->workspace+subset_size,&deluxe_ctx->seq_work2[i]);CHKERRQ(ierr);
/* scatters */
ierr = ISCreateGeneral(PETSC_COMM_SELF,subset_size,idxs+cum,PETSC_COPY_VALUES,&sub);CHKERRQ(ierr);
ierr = VecScatterCreate(pcbddc->work_scaling,sub,deluxe_ctx->seq_work1[i],NULL,&deluxe_ctx->seq_scctx[i]);CHKERRQ(ierr);
ierr = ISDestroy(&sub);CHKERRQ(ierr);
}
/* S_E_j */
ierr = MatDestroy(&deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,matdata+cum2,&deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
/* \sum_k S^k_E_j */
ierr = MatDestroy(&deluxe_ctx->seq_mat_inv_sum[i]);CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,matdata2+cum2,&deluxe_ctx->seq_mat_inv_sum[i]);CHKERRQ(ierr);
ierr = MatSetOption(deluxe_ctx->seq_mat_inv_sum[i],MAT_SPD,sub_schurs->is_posdef);CHKERRQ(ierr);
ierr = MatSetOption(deluxe_ctx->seq_mat_inv_sum[i],MAT_HERMITIAN,sub_schurs->is_hermitian);CHKERRQ(ierr);
if (sub_schurs->is_hermitian) {
ierr = MatCholeskyFactor(deluxe_ctx->seq_mat_inv_sum[i],NULL,NULL);CHKERRQ(ierr);
} else {
ierr = MatLUFactor(deluxe_ctx->seq_mat_inv_sum[i],NULL,NULL,NULL);CHKERRQ(ierr);
}
if (pcbddc->deluxe_singlemat) {
Mat X,Y;
if (!sub_schurs->is_hermitian) {
ierr = MatTranspose(deluxe_ctx->seq_mat[i],MAT_INITIAL_MATRIX,&X);CHKERRQ(ierr);
} else {
ierr = PetscObjectReference((PetscObject)deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
X = deluxe_ctx->seq_mat[i];
}
ierr = MatDuplicate(X,MAT_DO_NOT_COPY_VALUES,&Y);CHKERRQ(ierr);
if (!sub_schurs->is_hermitian) {
ierr = PCBDDCMatTransposeMatSolve_SeqDense(deluxe_ctx->seq_mat_inv_sum[i],X,Y);CHKERRQ(ierr);
} else {
ierr = MatMatSolve(deluxe_ctx->seq_mat_inv_sum[i],X,Y);CHKERRQ(ierr);
}
ierr = MatDestroy(&deluxe_ctx->seq_mat_inv_sum[i]);CHKERRQ(ierr);
ierr = MatDestroy(&deluxe_ctx->seq_mat[i]);CHKERRQ(ierr);
ierr = MatDestroy(&X);CHKERRQ(ierr);
if (deluxe_ctx->change) {
Mat C,CY;
if (!deluxe_ctx->change_with_qr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only QR based change of basis");
ierr = KSPGetOperators(deluxe_ctx->change[i],&C,NULL);CHKERRQ(ierr);
ierr = MatMatMult(C,Y,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&CY);CHKERRQ(ierr);
ierr = MatMatTransposeMult(CY,C,MAT_REUSE_MATRIX,PETSC_DEFAULT,&Y);CHKERRQ(ierr);
ierr = MatDestroy(&CY);CHKERRQ(ierr);
}
ierr = MatTranspose(Y,MAT_INPLACE_MATRIX,&Y);CHKERRQ(ierr);
deluxe_ctx->seq_mat[i] = Y;
}
cum += subset_size;
cum2 += subset_size*subset_size;
}
ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs);CHKERRQ(ierr);
ierr = MatSeqAIJRestoreArray(sub_schurs->S_Ej_all,&matdata);CHKERRQ(ierr);
ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_all,&matdata2);CHKERRQ(ierr);
if (pcbddc->deluxe_singlemat) {
deluxe_ctx->change = NULL;
deluxe_ctx->change_with_qr = PETSC_FALSE;
}
if (deluxe_ctx->change && !deluxe_ctx->change_with_qr) {
for (i=0;i<deluxe_ctx->seq_n;i++) {
if (newsetup) {
PC pc;
ierr = KSPGetPC(deluxe_ctx->change[i],&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCLU);CHKERRQ(ierr);
ierr = KSPSetFromOptions(deluxe_ctx->change[i]);CHKERRQ(ierr);
}
ierr = KSPSetUp(deluxe_ctx->change[i]);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode DMPlexVTKWriteAll_ASCII(DM dm, PetscViewer viewer)
{
MPI_Comm comm;
PetscViewer_VTK *vtk = (PetscViewer_VTK*) viewer->data;
FILE *fp;
PetscViewerVTKObjectLink link;
PetscSection coordSection, globalCoordSection;
PetscLayout vLayout;
Vec coordinates;
PetscReal lengthScale;
PetscInt vMax, totVertices, totCells;
PetscBool hasPoint = PETSC_FALSE, hasCell = PETSC_FALSE, writePartition = PETSC_FALSE;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
ierr = PetscFOpen(comm, vtk->filename, "wb", &fp);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "# vtk DataFile Version 2.0\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "Simplicial Mesh Example\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "ASCII\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "DATASET UNSTRUCTURED_GRID\n");CHKERRQ(ierr);
/* Vertices */
ierr = DMPlexGetScale(dm, PETSC_UNIT_LENGTH, &lengthScale);CHKERRQ(ierr);
ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
ierr = PetscSectionCreateGlobalSection(coordSection, dm->sf, PETSC_FALSE, PETSC_FALSE, &globalCoordSection);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
if (vMax >= 0) {
PetscInt pStart, pEnd, p, localSize = 0;
ierr = PetscSectionGetChart(globalCoordSection, &pStart, &pEnd);CHKERRQ(ierr);
pEnd = PetscMin(pEnd, vMax);
for (p = pStart; p < pEnd; ++p) {
PetscInt dof;
ierr = PetscSectionGetDof(globalCoordSection, p, &dof);CHKERRQ(ierr);
if (dof > 0) ++localSize;
}
ierr = PetscLayoutCreate(PetscObjectComm((PetscObject)dm), &vLayout);CHKERRQ(ierr);
ierr = PetscLayoutSetLocalSize(vLayout, localSize);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(vLayout, 1);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(vLayout);CHKERRQ(ierr);
} else {
ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject)dm), globalCoordSection, &vLayout);CHKERRQ(ierr);
}
ierr = PetscLayoutGetSize(vLayout, &totVertices);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "POINTS %d double\n", totVertices);CHKERRQ(ierr);
ierr = DMPlexVTKWriteSection_ASCII(dm, coordSection, globalCoordSection, coordinates, fp, 3, PETSC_DETERMINE, lengthScale);CHKERRQ(ierr);
/* Cells */
ierr = DMPlexVTKWriteCells_ASCII(dm, fp, &totCells);CHKERRQ(ierr);
/* Vertex fields */
for (link = vtk->link; link; link = link->next) {
if ((link->ft == PETSC_VTK_POINT_FIELD) || (link->ft == PETSC_VTK_POINT_VECTOR_FIELD)) hasPoint = PETSC_TRUE;
if ((link->ft == PETSC_VTK_CELL_FIELD) || (link->ft == PETSC_VTK_CELL_VECTOR_FIELD)) hasCell = PETSC_TRUE;
}
if (hasPoint) {
ierr = PetscFPrintf(comm, fp, "POINT_DATA %d\n", totVertices);CHKERRQ(ierr);
for (link = vtk->link; link; link = link->next) {
Vec X = (Vec) link->vec;
DM dmX;
PetscSection section, globalSection, newSection = NULL;
const char *name;
PetscInt enforceDof = PETSC_DETERMINE;
if ((link->ft != PETSC_VTK_POINT_FIELD) && (link->ft != PETSC_VTK_POINT_VECTOR_FIELD)) continue;
if (link->ft == PETSC_VTK_POINT_VECTOR_FIELD) enforceDof = 3;
ierr = PetscObjectGetName(link->vec, &name);CHKERRQ(ierr);
ierr = VecGetDM(X, &dmX);CHKERRQ(ierr);
if (dmX) {
DMLabel subpointMap, subpointMapX;
PetscInt dim, dimX, pStart, pEnd, qStart, qEnd;
ierr = DMGetDefaultSection(dmX, §ion);CHKERRQ(ierr);
/* Here is where we check whether dmX is a submesh of dm */
ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMGetDimension(dmX, &dimX);CHKERRQ(ierr);
ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
ierr = DMPlexGetChart(dmX, &qStart, &qEnd);CHKERRQ(ierr);
ierr = DMPlexGetSubpointMap(dm, &subpointMap);CHKERRQ(ierr);
ierr = DMPlexGetSubpointMap(dmX, &subpointMapX);CHKERRQ(ierr);
if (((dim != dimX) || ((pEnd-pStart) < (qEnd-qStart))) && subpointMap && !subpointMapX) {
const PetscInt *ind = NULL;
IS subpointIS;
PetscInt n = 0, q;
ierr = PetscSectionGetChart(section, &qStart, &qEnd);CHKERRQ(ierr);
ierr = DMPlexCreateSubpointIS(dm, &subpointIS);CHKERRQ(ierr);
if (subpointIS) {
ierr = ISGetLocalSize(subpointIS, &n);CHKERRQ(ierr);
ierr = ISGetIndices(subpointIS, &ind);CHKERRQ(ierr);
}
ierr = PetscSectionCreate(comm, &newSection);CHKERRQ(ierr);
ierr = PetscSectionSetChart(newSection, pStart, pEnd);CHKERRQ(ierr);
for (q = qStart; q < qEnd; ++q) {
PetscInt dof, off, p;
ierr = PetscSectionGetDof(section, q, &dof);CHKERRQ(ierr);
if (dof) {
ierr = PetscFindInt(q, n, ind, &p);CHKERRQ(ierr);
if (p >= pStart) {
ierr = PetscSectionSetDof(newSection, p, dof);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(section, q, &off);CHKERRQ(ierr);
ierr = PetscSectionSetOffset(newSection, p, off);CHKERRQ(ierr);
}
}
}
if (subpointIS) {
ierr = ISRestoreIndices(subpointIS, &ind);CHKERRQ(ierr);
ierr = ISDestroy(&subpointIS);CHKERRQ(ierr);
}
/* No need to setup section */
section = newSection;
}
} else {
ierr = PetscObjectQuery(link->vec, "section", (PetscObject*) §ion);CHKERRQ(ierr);
if (!section) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
}
if (!section) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
ierr = PetscSectionCreateGlobalSection(section, dm->sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
ierr = DMPlexVTKWriteField_ASCII(dm, section, globalSection, X, name, fp, enforceDof, PETSC_DETERMINE, 1.0);CHKERRQ(ierr);
ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
if (newSection) {ierr = PetscSectionDestroy(&newSection);CHKERRQ(ierr);}
}
}
/* Cell Fields */
ierr = PetscOptionsGetBool(((PetscObject) dm)->prefix, "-dm_view_partition", &writePartition, NULL);CHKERRQ(ierr);
if (hasCell || writePartition) {
ierr = PetscFPrintf(comm, fp, "CELL_DATA %d\n", totCells);CHKERRQ(ierr);
for (link = vtk->link; link; link = link->next) {
Vec X = (Vec) link->vec;
DM dmX;
PetscSection section, globalSection;
const char *name;
PetscInt enforceDof = PETSC_DETERMINE;
if ((link->ft != PETSC_VTK_CELL_FIELD) && (link->ft != PETSC_VTK_CELL_VECTOR_FIELD)) continue;
if (link->ft == PETSC_VTK_CELL_VECTOR_FIELD) enforceDof = 3;
ierr = PetscObjectGetName(link->vec, &name);CHKERRQ(ierr);
ierr = VecGetDM(X, &dmX);CHKERRQ(ierr);
if (dmX) {
ierr = DMGetDefaultSection(dmX, §ion);CHKERRQ(ierr);
} else {
PetscContainer c;
ierr = PetscObjectQuery(link->vec, "section", (PetscObject*) &c);CHKERRQ(ierr);
if (!c) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
ierr = PetscContainerGetPointer(c, (void**) §ion);CHKERRQ(ierr);
}
if (!section) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
ierr = PetscSectionCreateGlobalSection(section, dm->sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
ierr = DMPlexVTKWriteField_ASCII(dm, section, globalSection, X, name, fp, enforceDof, PETSC_DETERMINE, 1.0);CHKERRQ(ierr);
ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
}
if (writePartition) {
ierr = PetscFPrintf(comm, fp, "SCALARS partition int 1\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "LOOKUP_TABLE default\n");CHKERRQ(ierr);
ierr = DMPlexVTKWritePartition_ASCII(dm, fp);CHKERRQ(ierr);
}
}
/* Cleanup */
ierr = PetscSectionDestroy(&globalCoordSection);CHKERRQ(ierr);
ierr = PetscLayoutDestroy(&vLayout);CHKERRQ(ierr);
ierr = PetscFClose(comm, fp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MatPartitioningApply_Hierarchical(MatPartitioning part,IS *partitioning)
{
MatPartitioning_Hierarchical *hpart = (MatPartitioning_Hierarchical*)part->data;
const PetscInt *fineparts_indices, *coarseparts_indices;
PetscInt *parts_indices,i,j,mat_localsize;
Mat mat = part->adj,adj,sadj;
PetscBool flg;
PetscInt bs = 1;
MatPartitioning finePart, coarsePart;
PetscInt *coarse_vertex_weights = 0;
PetscMPIInt size,rank;
MPI_Comm comm,scomm;
IS destination,fineparts_temp;
ISLocalToGlobalMapping mapping;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)part,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIADJ,&flg);CHKERRQ(ierr);
if (flg) {
adj = mat;
ierr = PetscObjectReference((PetscObject)adj);CHKERRQ(ierr);
}else {
/* bs indicates if the converted matrix is "reduced" from the original and hence the
resulting partition results need to be stretched to match the original matrix */
ierr = MatConvert(mat,MATMPIADJ,MAT_INITIAL_MATRIX,&adj);CHKERRQ(ierr);
if (adj->rmap->n > 0) bs = mat->rmap->n/adj->rmap->n;
}
/*local size of mat*/
mat_localsize = adj->rmap->n;
/* check parameters */
/* how many small subdomains we want from a given 'big' suddomain */
if(!hpart->Nfineparts) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG," must set number of small subdomains for each big subdomain \n");
if(!hpart->Ncoarseparts && !part->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE," did not either set number of coarse parts or total number of parts \n");
if(part->n && part->n%hpart->Nfineparts!=0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,
" total number of parts %D can not be divided by number of fine parts %D\n",part->n,hpart->Nfineparts);
if(part->n){
hpart->Ncoarseparts = part->n/hpart->Nfineparts;
}else{
part->n = hpart->Ncoarseparts*hpart->Nfineparts;
}
/* we do not support this case currently, but this restriction should be
* removed in the further
* */
if(hpart->Ncoarseparts>size) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP," we do not support number of coarse parts %D > size %D \n",hpart->Ncoarseparts,size);
/*create a coarse partitioner */
ierr = MatPartitioningCreate(comm,&coarsePart);CHKERRQ(ierr);
/*if did not set partitioning type yet, use parmetis by default */
if(!hpart->coarseparttype){
ierr = MatPartitioningSetType(coarsePart,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
}else{
ierr = MatPartitioningSetType(coarsePart,hpart->coarseparttype);CHKERRQ(ierr);
}
ierr = MatPartitioningSetAdjacency(coarsePart,adj);CHKERRQ(ierr);
ierr = MatPartitioningSetNParts(coarsePart, hpart->Ncoarseparts);CHKERRQ(ierr);
/*copy over vertex weights */
if(part->vertex_weights){
ierr = PetscMalloc(sizeof(PetscInt)*mat_localsize,&coarse_vertex_weights);CHKERRQ(ierr);
ierr = PetscMemcpy(coarse_vertex_weights,part->vertex_weights,sizeof(PetscInt)*mat_localsize);CHKERRQ(ierr);
ierr = MatPartitioningSetVertexWeights(coarsePart,coarse_vertex_weights);CHKERRQ(ierr);
}
/*It looks nontrivial to support part weights */
/*if(part->part_weights){
ierr = PetscMalloc(sizeof(part->part_weights)*1,&coarse_partition_weights);CHKERRQ(ierr);
ierr = PetscMemcpy(coarse_partition_weights,part->part_weights,sizeof(part->part_weights)*1);CHKERRQ(ierr);
ierr = MatPartitioningSetPartitionWeights(coarsePart,coarse_partition_weights);CHKERRQ(ierr);
}*/
ierr = MatPartitioningApply(coarsePart,&hpart->coarseparts);CHKERRQ(ierr);
ierr = MatPartitioningDestroy(&coarsePart);CHKERRQ(ierr);
/* In the current implementation, destination should be the same as hpart->coarseparts,
* and this interface is preserved to deal with the case hpart->coarseparts>size in the
* future.
* */
ierr = MatPartitioningHierarchical_DetermineDestination(part,hpart->coarseparts,0,hpart->Ncoarseparts,&destination);CHKERRQ(ierr);
/* create a sub-matrix*/
ierr = MatPartitioningHierarchical_AssembleSubdomain(adj,destination,&sadj,&mapping);CHKERRQ(ierr);
ierr = ISDestroy(&destination);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)sadj,&scomm);CHKERRQ(ierr);
/*create a fine partitioner */
ierr = MatPartitioningCreate(scomm,&finePart);CHKERRQ(ierr);
/*if do not set partitioning type, use parmetis by default */
if(!hpart->fineparttype){
ierr = MatPartitioningSetType(finePart,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
}else{
ierr = MatPartitioningSetType(finePart,hpart->fineparttype);CHKERRQ(ierr);
}
ierr = MatPartitioningSetAdjacency(finePart,sadj);CHKERRQ(ierr);
ierr = MatPartitioningSetNParts(finePart, hpart->Nfineparts);CHKERRQ(ierr);
ierr = MatPartitioningApply(finePart,&fineparts_temp);CHKERRQ(ierr);
ierr = MatDestroy(&sadj);CHKERRQ(ierr);
ierr = MatPartitioningDestroy(&finePart);CHKERRQ(ierr);
ierr = MatPartitioningHierarchical_ReassembleFineparts(adj,fineparts_temp,mapping,&hpart->fineparts);CHKERRQ(ierr);
ierr = ISDestroy(&fineparts_temp);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingDestroy(&mapping);CHKERRQ(ierr);
ierr = ISGetIndices(hpart->fineparts,&fineparts_indices);CHKERRQ(ierr);
ierr = ISGetIndices(hpart->coarseparts,&coarseparts_indices);CHKERRQ(ierr);
ierr = PetscMalloc1(bs*adj->rmap->n,&parts_indices);CHKERRQ(ierr);
for(i=0; i<adj->rmap->n; i++){
for(j=0; j<bs; j++){
parts_indices[bs*i+j] = fineparts_indices[i]+coarseparts_indices[i]*hpart->Nfineparts;
}
}
ierr = ISCreateGeneral(comm,bs*adj->rmap->n,parts_indices,PETSC_OWN_POINTER,partitioning);CHKERRQ(ierr);
ierr = MatDestroy(&adj);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
DMPlexPermute - Reorder the mesh according to the input permutation
Collective on DM
Input Parameter:
+ dm - The DMPlex object
- perm - The point permutation, perm[old point number] = new point number
Output Parameter:
. pdm - The permuted DM
Level: intermediate
.keywords: mesh
.seealso: MatPermute()
@*/
PetscErrorCode DMPlexPermute(DM dm, IS perm, DM *pdm)
{
DM_Plex *plex = (DM_Plex *) dm->data, *plexNew;
PetscSection section, sectionNew;
PetscInt dim;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
PetscValidHeaderSpecific(perm, IS_CLASSID, 2);
PetscValidPointer(pdm, 3);
ierr = DMCreate(PetscObjectComm((PetscObject) dm), pdm);CHKERRQ(ierr);
ierr = DMSetType(*pdm, DMPLEX);CHKERRQ(ierr);
ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMSetDimension(*pdm, dim);CHKERRQ(ierr);
ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr);
if (section) {
ierr = PetscSectionPermute(section, perm, §ionNew);CHKERRQ(ierr);
ierr = DMSetDefaultSection(*pdm, sectionNew);CHKERRQ(ierr);
ierr = PetscSectionDestroy(§ionNew);CHKERRQ(ierr);
}
plexNew = (DM_Plex *) (*pdm)->data;
/* Ignore ltogmap, ltogmapb */
/* Ignore sf, defaultSF */
/* Ignore globalVertexNumbers, globalCellNumbers */
/* Remap coordinates */
{
DM cdm, cdmNew;
PetscSection csection, csectionNew;
Vec coordinates, coordinatesNew;
PetscScalar *coords, *coordsNew;
const PetscInt *pperm;
PetscInt pStart, pEnd, p;
const char *name;
ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
ierr = DMGetDefaultSection(cdm, &csection);CHKERRQ(ierr);
ierr = PetscSectionPermute(csection, perm, &csectionNew);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = VecDuplicate(coordinates, &coordinatesNew);CHKERRQ(ierr);
ierr = PetscObjectGetName((PetscObject)coordinates,&name);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)coordinatesNew,name);CHKERRQ(ierr);
ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
ierr = VecGetArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
ierr = PetscSectionGetChart(csectionNew, &pStart, &pEnd);CHKERRQ(ierr);
ierr = ISGetIndices(perm, &pperm);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt dof, off, offNew, d;
ierr = PetscSectionGetDof(csectionNew, p, &dof);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(csection, p, &off);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(csectionNew, pperm[p], &offNew);CHKERRQ(ierr);
for (d = 0; d < dof; ++d) coordsNew[offNew+d] = coords[off+d];
}
ierr = ISRestoreIndices(perm, &pperm);CHKERRQ(ierr);
ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
ierr = VecRestoreArray(coordinatesNew, &coordsNew);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(*pdm, &cdmNew);CHKERRQ(ierr);
ierr = DMSetDefaultSection(cdmNew, csectionNew);CHKERRQ(ierr);
ierr = DMSetCoordinatesLocal(*pdm, coordinatesNew);CHKERRQ(ierr);
ierr = PetscSectionDestroy(&csectionNew);CHKERRQ(ierr);
ierr = VecDestroy(&coordinatesNew);CHKERRQ(ierr);
}
/* Reorder labels */
{
PetscInt numLabels, l;
DMLabel label, labelNew;
ierr = DMGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
for (l = numLabels-1; l >= 0; --l) {
ierr = DMGetLabelByNum(dm, l, &label);CHKERRQ(ierr);
ierr = DMLabelPermute(label, perm, &labelNew);CHKERRQ(ierr);
ierr = DMAddLabel(*pdm, labelNew);CHKERRQ(ierr);
}
if (plex->subpointMap) {ierr = DMLabelPermute(plex->subpointMap, perm, &plexNew->subpointMap);CHKERRQ(ierr);}
}
/* Reorder topology */
{
const PetscInt *pperm;
PetscInt maxConeSize, maxSupportSize, n, pStart, pEnd, p;
ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
plexNew->maxConeSize = maxConeSize;
plexNew->maxSupportSize = maxSupportSize;
ierr = PetscSectionDestroy(&plexNew->coneSection);CHKERRQ(ierr);
ierr = PetscSectionPermute(plex->coneSection, perm, &plexNew->coneSection);CHKERRQ(ierr);
ierr = PetscSectionGetStorageSize(plexNew->coneSection, &n);CHKERRQ(ierr);
ierr = PetscMalloc1(n, &plexNew->cones);CHKERRQ(ierr);
ierr = PetscMalloc1(n, &plexNew->coneOrientations);CHKERRQ(ierr);
ierr = ISGetIndices(perm, &pperm);CHKERRQ(ierr);
ierr = PetscSectionGetChart(plex->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt dof, off, offNew, d;
ierr = PetscSectionGetDof(plexNew->coneSection, pperm[p], &dof);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(plex->coneSection, p, &off);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(plexNew->coneSection, pperm[p], &offNew);CHKERRQ(ierr);
for (d = 0; d < dof; ++d) {
plexNew->cones[offNew+d] = pperm[plex->cones[off+d]];
plexNew->coneOrientations[offNew+d] = plex->coneOrientations[off+d];
}
}
ierr = PetscSectionDestroy(&plexNew->supportSection);CHKERRQ(ierr);
ierr = PetscSectionPermute(plex->supportSection, perm, &plexNew->supportSection);CHKERRQ(ierr);
ierr = PetscSectionGetStorageSize(plexNew->supportSection, &n);CHKERRQ(ierr);
ierr = PetscMalloc1(n, &plexNew->supports);CHKERRQ(ierr);
ierr = PetscSectionGetChart(plex->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt dof, off, offNew, d;
ierr = PetscSectionGetDof(plexNew->supportSection, pperm[p], &dof);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(plex->supportSection, p, &off);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(plexNew->supportSection, pperm[p], &offNew);CHKERRQ(ierr);
for (d = 0; d < dof; ++d) {
plexNew->supports[offNew+d] = pperm[plex->supports[off+d]];
}
}
ierr = ISRestoreIndices(perm, &pperm);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt i,n = 5;
PetscInt getpetsc[] = {0,3,4},getapp[] = {2,1,9,7};
PetscInt getpetsc1[] = {0,3,4},getapp1[] = {2,1,9,7};
PetscInt getpetsc2[] = {0,3,4},getapp2[] = {2,1,9,7};
PetscInt getpetsc3[] = {0,3,4},getapp3[] = {2,1,9,7};
PetscInt getpetsc4[] = {0,3,4},getapp4[] = {2,1,9,7};
PetscMPIInt rank,size;
IS ispetsc,isapp;
AO ao;
const PetscInt *app;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* create the index sets */
ierr = ISCreateStride(PETSC_COMM_WORLD,n,rank,size,&isapp);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_WORLD,n,n*rank,1,&ispetsc);CHKERRQ(ierr); /* natural numbering */
/* create the application ordering */
ierr = AOCreateBasicIS(isapp,ispetsc,&ao);CHKERRQ(ierr);
ierr = AOView(ao,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = AOPetscToApplication(ao,4,getapp);CHKERRQ(ierr);
ierr = AOApplicationToPetsc(ao,3,getpetsc);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] 2,1,9,7 PetscToApplication %D %D %D %D\n",rank,getapp[0],getapp[1],getapp[2],getapp[3]);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] 0,3,4 ApplicationToPetsc %D %D %D\n",rank,getpetsc[0],getpetsc[1],getpetsc[2]);CHKERRQ(ierr);
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
ierr = AODestroy(&ao);CHKERRQ(ierr);
/* test MemoryScalable ao */
/*-------------------------*/
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nTest AOCreateMemoryScalable: \n");CHKERRQ(ierr);
ierr = AOCreateMemoryScalableIS(isapp,ispetsc,&ao);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = AOView(ao,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = AOPetscToApplication(ao,4,getapp1);CHKERRQ(ierr);
ierr = AOApplicationToPetsc(ao,3,getpetsc1);CHKERRQ(ierr);
/* Check accuracy */;
for (i=0; i<4; i++) {
if (getapp1[i] != getapp[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getapp1 %d != getapp %d",getapp1[i],getapp[i]);
}
for (i=0; i<3; i++) {
if (getpetsc1[i] != getpetsc[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getpetsc1 %d != getpetsc %d",getpetsc1[i],getpetsc[i]);
}
ierr = AODestroy(&ao);CHKERRQ(ierr);
/* test MemoryScalable ao: ispetsc = NULL */
/*-----------------------------------------------*/
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nTest AOCreateMemoryScalable with ispetsc=NULL:\n");CHKERRQ(ierr);
ierr = AOCreateMemoryScalableIS(isapp,NULL,&ao);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = AOView(ao,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = AOPetscToApplication(ao,4,getapp2);CHKERRQ(ierr);
ierr = AOApplicationToPetsc(ao,3,getpetsc2);CHKERRQ(ierr);
/* Check accuracy */;
for (i=0; i<4; i++) {
if (getapp2[i] != getapp[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getapp2 %d != getapp %d",getapp2[i],getapp[i]);
}
for (i=0; i<3; i++) {
if (getpetsc2[i] != getpetsc[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getpetsc2 %d != getpetsc %d",getpetsc2[i],getpetsc[i]);
}
ierr = AODestroy(&ao);CHKERRQ(ierr);
/* test AOCreateMemoryScalable() ao: */
ierr = ISGetIndices(isapp,&app);CHKERRQ(ierr);
ierr = AOCreateMemoryScalable(PETSC_COMM_WORLD,n,app,NULL,&ao);CHKERRQ(ierr);
ierr = ISRestoreIndices(isapp,&app);CHKERRQ(ierr);
ierr = AOPetscToApplication(ao,4,getapp4);CHKERRQ(ierr);
ierr = AOApplicationToPetsc(ao,3,getpetsc4);CHKERRQ(ierr);
/* Check accuracy */;
for (i=0; i<4; i++) {
if (getapp4[i] != getapp[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getapp4 %d != getapp %d",getapp4[i],getapp[i]);
}
for (i=0; i<3; i++) {
if (getpetsc4[i] != getpetsc[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getpetsc4 %d != getpetsc %d",getpetsc4[i],getpetsc[i]);
}
ierr = AODestroy(&ao);CHKERRQ(ierr);
/* test general API */
/*------------------*/
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nTest general API: \n");CHKERRQ(ierr);
ierr = AOCreate(PETSC_COMM_WORLD,&ao);CHKERRQ(ierr);
ierr = AOSetIS(ao,isapp,ispetsc);CHKERRQ(ierr);
ierr = AOSetType(ao,AOMEMORYSCALABLE);CHKERRQ(ierr);
ierr = AOSetFromOptions(ao);CHKERRQ(ierr);
/* ispetsc and isapp are nolonger used. */
ierr = ISDestroy(&ispetsc);CHKERRQ(ierr);
ierr = ISDestroy(&isapp);CHKERRQ(ierr);
ierr = AOPetscToApplication(ao,4,getapp3);CHKERRQ(ierr);
ierr = AOApplicationToPetsc(ao,3,getpetsc3);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] 2,1,9,7 PetscToApplication %D %D %D %D\n",rank,getapp3[0],getapp3[1],getapp3[2],getapp3[3]);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] 0,3,4 ApplicationToPetsc %D %D %D\n",rank,getpetsc3[0],getpetsc3[1],getpetsc3[2]);CHKERRQ(ierr);
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
/* Check accuracy */;
for (i=0; i<4; i++) {
if (getapp3[i] != getapp[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getapp3 %d != getapp %d",getapp3[i],getapp[i]);
}
for (i=0; i<3; i++) {
if (getpetsc3[i] != getpetsc[i]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"getpetsc3 %d != getpetsc %d",getpetsc3[i],getpetsc[i]);
}
ierr = AODestroy(&ao);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode DMPlexVTKWriteCells_ASCII(DM dm, FILE *fp, PetscInt *totalCells)
{
MPI_Comm comm;
DMLabel label;
IS globalVertexNumbers = NULL;
const PetscInt *gvertex;
PetscInt dim;
PetscInt numCorners = 0, totCorners = 0, maxCorners, *corners;
PetscInt numCells = 0, totCells = 0, maxCells, cellHeight;
PetscInt numLabelCells, maxLabelCells, cMax, cStart, cEnd, c, vStart, vEnd, v;
PetscMPIInt numProcs, rank, proc, tag;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
ierr = PetscCommGetNewTag(comm, &tag);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
ierr = DMPlexGetLabel(dm, "vtk", &label);CHKERRQ(ierr);
ierr = DMPlexGetStratumSize(dm, "vtk", 1, &numLabelCells);CHKERRQ(ierr);
ierr = MPI_Allreduce(&numLabelCells, &maxLabelCells, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
if (!maxLabelCells) label = NULL;
for (c = cStart; c < cEnd; ++c) {
PetscInt *closure = NULL;
PetscInt closureSize, value;
if (label) {
ierr = DMLabelGetValue(label, c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
for (v = 0; v < closureSize*2; v += 2) {
if ((closure[v] >= vStart) && (closure[v] < vEnd)) ++numCorners;
}
ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
++numCells;
}
maxCells = numCells;
ierr = MPI_Reduce(&numCells, &totCells, 1, MPIU_INT, MPI_SUM, 0, comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&numCells, &maxCells, 1, MPIU_INT, MPI_MAX, 0, comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&numCorners, &totCorners, 1, MPIU_INT, MPI_SUM, 0, comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&numCorners, &maxCorners, 1, MPIU_INT, MPI_MAX, 0, comm);CHKERRQ(ierr);
ierr = DMPlexGetVertexNumbering(dm, &globalVertexNumbers);CHKERRQ(ierr);
ierr = ISGetIndices(globalVertexNumbers, &gvertex);CHKERRQ(ierr);
ierr = PetscMalloc1(maxCells, &corners);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "CELLS %d %d\n", totCells, totCorners+totCells);CHKERRQ(ierr);
if (!rank) {
PetscInt *remoteVertices;
int *vertices;
ierr = PetscMalloc1(maxCorners, &vertices);CHKERRQ(ierr);
for (c = cStart, numCells = 0; c < cEnd; ++c) {
PetscInt *closure = NULL;
PetscInt closureSize, value, nC = 0;
if (label) {
ierr = DMLabelGetValue(label, c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
for (v = 0; v < closureSize*2; v += 2) {
if ((closure[v] >= vStart) && (closure[v] < vEnd)) {
const PetscInt gv = gvertex[closure[v] - vStart];
vertices[nC++] = gv < 0 ? -(gv+1) : gv;
}
}
ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
corners[numCells++] = nC;
ierr = PetscFPrintf(comm, fp, "%d ", nC);CHKERRQ(ierr);
ierr = DMPlexInvertCell(dim, nC, vertices);CHKERRQ(ierr);
for (v = 0; v < nC; ++v) {
ierr = PetscFPrintf(comm, fp, " %d", vertices[v]);CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, "\n");CHKERRQ(ierr);
}
if (numProcs > 1) {ierr = PetscMalloc1(maxCorners+maxCells, &remoteVertices);CHKERRQ(ierr);}
for (proc = 1; proc < numProcs; ++proc) {
MPI_Status status;
ierr = MPI_Recv(&numCorners, 1, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
ierr = MPI_Recv(remoteVertices, numCorners, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
for (c = 0; c < numCorners;) {
PetscInt nC = remoteVertices[c++];
for (v = 0; v < nC; ++v, ++c) {
vertices[v] = remoteVertices[c];
}
ierr = DMPlexInvertCell(dim, nC, vertices);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "%d ", nC);CHKERRQ(ierr);
for (v = 0; v < nC; ++v) {
ierr = PetscFPrintf(comm, fp, " %d", vertices[v]);CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, "\n");CHKERRQ(ierr);
}
}
if (numProcs > 1) {ierr = PetscFree(remoteVertices);CHKERRQ(ierr);}
ierr = PetscFree(vertices);CHKERRQ(ierr);
} else {
PetscInt *localVertices, numSend = numCells+numCorners, k = 0;
ierr = PetscMalloc1(numSend, &localVertices);CHKERRQ(ierr);
for (c = cStart, numCells = 0; c < cEnd; ++c) {
PetscInt *closure = NULL;
PetscInt closureSize, value, nC = 0;
if (label) {
ierr = DMLabelGetValue(label, c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
for (v = 0; v < closureSize*2; v += 2) {
if ((closure[v] >= vStart) && (closure[v] < vEnd)) {
const PetscInt gv = gvertex[closure[v] - vStart];
closure[nC++] = gv < 0 ? -(gv+1) : gv;
}
}
corners[numCells++] = nC;
localVertices[k++] = nC;
for (v = 0; v < nC; ++v, ++k) {
localVertices[k] = closure[v];
}
ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
}
if (k != numSend) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Invalid number of vertices to send %d should be %d", k, numSend);
ierr = MPI_Send(&numSend, 1, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
ierr = MPI_Send(localVertices, numSend, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
ierr = PetscFree(localVertices);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(globalVertexNumbers, &gvertex);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "CELL_TYPES %d\n", totCells);CHKERRQ(ierr);
if (!rank) {
PetscInt cellType;
for (c = 0; c < numCells; ++c) {
ierr = DMPlexVTKGetCellType(dm, dim, corners[c], &cellType);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "%d\n", cellType);CHKERRQ(ierr);
}
for (proc = 1; proc < numProcs; ++proc) {
MPI_Status status;
ierr = MPI_Recv(&numCells, 1, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
ierr = MPI_Recv(corners, numCells, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
for (c = 0; c < numCells; ++c) {
ierr = DMPlexVTKGetCellType(dm, dim, corners[c], &cellType);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "%d\n", cellType);CHKERRQ(ierr);
}
}
} else {
ierr = MPI_Send(&numCells, 1, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
ierr = MPI_Send(corners, numCells, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
}
ierr = PetscFree(corners);CHKERRQ(ierr);
*totalCells = totCells;
PetscFunctionReturn(0);
}
/*
DMCoarsen_SNESVI - Computes the regular coarsened DM then computes additional information about its inactive set
*/
PetscErrorCode DMCoarsen_SNESVI(DM dm1,MPI_Comm comm,DM *dm2)
{
PetscErrorCode ierr;
PetscContainer isnes;
DM_SNESVI *dmsnesvi1;
Vec finemarked,coarsemarked;
IS inactive;
VecScatter inject;
const PetscInt *index;
PetscInt n,k,cnt = 0,rstart,*coarseindex;
PetscScalar *marked;
PetscFunctionBegin;
ierr = PetscObjectQuery((PetscObject)dm1,"VI",(PetscObject *)&isnes);CHKERRQ(ierr);
if (!isnes) SETERRQ(((PetscObject)dm1)->comm,PETSC_ERR_PLIB,"Composed VI data structure is missing");
ierr = PetscContainerGetPointer(isnes,(void**)&dmsnesvi1);CHKERRQ(ierr);
/* get the original coarsen */
ierr = (*dmsnesvi1->coarsen)(dm1,comm,dm2);CHKERRQ(ierr);
/* not sure why this extra reference is needed, but without the dm2 disappears too early */
ierr = PetscObjectReference((PetscObject)*dm2);CHKERRQ(ierr);
/* need to set back global vectors in order to use the original injection */
ierr = DMClearGlobalVectors(dm1);CHKERRQ(ierr);
dm1->ops->createglobalvector = dmsnesvi1->createglobalvector;
ierr = DMCreateGlobalVector(dm1,&finemarked);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(*dm2,&coarsemarked);CHKERRQ(ierr);
/*
fill finemarked with locations of inactive points
*/
ierr = ISGetIndices(dmsnesvi1->inactive,&index);CHKERRQ(ierr);
ierr = ISGetLocalSize(dmsnesvi1->inactive,&n);CHKERRQ(ierr);
ierr = VecSet(finemarked,0.0);CHKERRQ(ierr);
for (k=0;k<n;k++){
ierr = VecSetValue(finemarked,index[k],1.0,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(finemarked);CHKERRQ(ierr);
ierr = VecAssemblyEnd(finemarked);CHKERRQ(ierr);
ierr = DMCreateInjection(*dm2,dm1,&inject);CHKERRQ(ierr);
ierr = VecScatterBegin(inject,finemarked,coarsemarked,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(inject,finemarked,coarsemarked,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterDestroy(&inject);CHKERRQ(ierr);
/*
create index set list of coarse inactive points from coarsemarked
*/
ierr = VecGetLocalSize(coarsemarked,&n);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(coarsemarked,&rstart,PETSC_NULL);CHKERRQ(ierr);
ierr = VecGetArray(coarsemarked,&marked);CHKERRQ(ierr);
for (k=0; k<n; k++) {
if (marked[k] != 0.0) cnt++;
}
ierr = PetscMalloc(cnt*sizeof(PetscInt),&coarseindex);CHKERRQ(ierr);
cnt = 0;
for (k=0; k<n; k++) {
if (marked[k] != 0.0) coarseindex[cnt++] = k + rstart;
}
ierr = VecRestoreArray(coarsemarked,&marked);CHKERRQ(ierr);
ierr = ISCreateGeneral(((PetscObject)coarsemarked)->comm,cnt,coarseindex,PETSC_OWN_POINTER,&inactive);CHKERRQ(ierr);
ierr = DMClearGlobalVectors(dm1);CHKERRQ(ierr);
dm1->ops->createglobalvector = DMCreateGlobalVector_SNESVI;
ierr = DMSetVI(*dm2,inactive);CHKERRQ(ierr);
ierr = VecDestroy(&finemarked);CHKERRQ(ierr);
ierr = VecDestroy(&coarsemarked);CHKERRQ(ierr);
ierr = ISDestroy(&inactive);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscMPIInt rank,size;
PetscInt i,n,*indices;
const PetscInt *ii;
IS is,newis;
PetscBool flg;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/*
Test IS of size 0
*/
ierr = ISCreateGeneral(PETSC_COMM_SELF,0,&n,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = ISGetSize(is,&n);CHKERRQ(ierr);
if (n != 0) SETERRQ(PETSC_COMM_SELF,1,"ISGetSize");
ierr = ISDestroy(&is);CHKERRQ(ierr);
/*
Create large IS and test ISGetIndices()
*/
n = 10000 + rank;
ierr = PetscMalloc1(n,&indices);CHKERRQ(ierr);
for (i=0; i<n; i++) indices[i] = rank + i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = ISGetIndices(is,&ii);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (ii[i] != indices[i]) SETERRQ(PETSC_COMM_SELF,1,"ISGetIndices");
}
ierr = ISRestoreIndices(is,&ii);CHKERRQ(ierr);
/*
Check identity and permutation
*/
ierr = ISPermutation(is,&flg);CHKERRQ(ierr);
if (flg) SETERRQ(PETSC_COMM_SELF,1,"ISPermutation");
ierr = ISIdentity(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISIdentity");
ierr = ISSetPermutation(is);CHKERRQ(ierr);
ierr = ISSetIdentity(is);CHKERRQ(ierr);
ierr = ISPermutation(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISPermutation");
ierr = ISIdentity(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISIdentity");
/*
Check equality of index sets
*/
ierr = ISEqual(is,is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISEqual");
/*
Sorting
*/
ierr = ISSort(is);CHKERRQ(ierr);
ierr = ISSorted(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISSort");
/*
Thinks it is a different type?
*/
ierr = PetscObjectTypeCompare((PetscObject)is,ISSTRIDE,&flg);CHKERRQ(ierr);
if (flg) SETERRQ(PETSC_COMM_SELF,1,"ISStride");
ierr = PetscObjectTypeCompare((PetscObject)is,ISBLOCK,&flg);CHKERRQ(ierr);
if (flg) SETERRQ(PETSC_COMM_SELF,1,"ISBlock");
ierr = ISDestroy(&is);CHKERRQ(ierr);
/*
Inverting permutation
*/
for (i=0; i<n; i++) indices[i] = n - i - 1;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = PetscFree(indices);CHKERRQ(ierr);
ierr = ISSetPermutation(is);CHKERRQ(ierr);
ierr = ISInvertPermutation(is,PETSC_DECIDE,&newis);CHKERRQ(ierr);
ierr = ISGetIndices(newis,&ii);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (ii[i] != n - i - 1) SETERRQ(PETSC_COMM_SELF,1,"ISInvertPermutation");
}
ierr = ISRestoreIndices(newis,&ii);CHKERRQ(ierr);
ierr = ISDestroy(&newis);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/*@C
TaoVecGetSubVec - Gets a subvector using the IS
Input Parameters:
+ vfull - the full matrix
. is - the index set for the subvector
. reduced_type - the method TAO is using for subsetting (TAO_SUBSET_SUBVEC, TAO_SUBSET_MASK, TAO_SUBSET_MATRIXFREE)
- maskvalue - the value to set the unused vector elements to (for TAO_SUBSET_MASK or TAO_SUBSET_MATRIXFREE)
Output Parameters:
. vreduced - the subvector
Notes:
maskvalue should usually be 0.0, unless a pointwise divide will be used.
@*/
PetscErrorCode TaoVecGetSubVec(Vec vfull, IS is, TaoSubsetType reduced_type, PetscReal maskvalue, Vec *vreduced)
{
PetscErrorCode ierr;
PetscInt nfull,nreduced,nreduced_local,rlow,rhigh,flow,fhigh;
PetscInt i,nlocal;
PetscReal *fv,*rv;
const PetscInt *s;
IS ident;
VecType vtype;
VecScatter scatter;
MPI_Comm comm;
PetscFunctionBegin;
PetscValidHeaderSpecific(vfull,VEC_CLASSID,1);
PetscValidHeaderSpecific(is,IS_CLASSID,2);
ierr = VecGetSize(vfull, &nfull);CHKERRQ(ierr);
ierr = ISGetSize(is, &nreduced);CHKERRQ(ierr);
if (nreduced == nfull) {
ierr = VecDestroy(vreduced);CHKERRQ(ierr);
ierr = VecDuplicate(vfull,vreduced);CHKERRQ(ierr);
ierr = VecCopy(vfull,*vreduced);CHKERRQ(ierr);
} else {
switch (reduced_type) {
case TAO_SUBSET_SUBVEC:
ierr = VecGetType(vfull,&vtype);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(vfull,&flow,&fhigh);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&nreduced_local);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)vfull,&comm);CHKERRQ(ierr);
if (*vreduced) {
ierr = VecDestroy(vreduced);CHKERRQ(ierr);
}
ierr = VecCreate(comm,vreduced);CHKERRQ(ierr);
ierr = VecSetType(*vreduced,vtype);CHKERRQ(ierr);
ierr = VecSetSizes(*vreduced,nreduced_local,nreduced);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(*vreduced,&rlow,&rhigh);CHKERRQ(ierr);
ierr = ISCreateStride(comm,nreduced_local,rlow,1,&ident);CHKERRQ(ierr);
ierr = VecScatterCreate(vfull,is,*vreduced,ident,&scatter);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter,vfull,*vreduced,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter,vfull,*vreduced,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scatter);CHKERRQ(ierr);
ierr = ISDestroy(&ident);CHKERRQ(ierr);
break;
case TAO_SUBSET_MASK:
case TAO_SUBSET_MATRIXFREE:
/* vr[i] = vf[i] if i in is
vr[i] = 0 otherwise */
if (!*vreduced) {
ierr = VecDuplicate(vfull,vreduced);CHKERRQ(ierr);
}
ierr = VecSet(*vreduced,maskvalue);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&nlocal);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(vfull,&flow,&fhigh);CHKERRQ(ierr);
ierr = VecGetArray(vfull,&fv);CHKERRQ(ierr);
ierr = VecGetArray(*vreduced,&rv);CHKERRQ(ierr);
ierr = ISGetIndices(is,&s);CHKERRQ(ierr);
if (nlocal > (fhigh-flow)) SETERRQ2(PETSC_COMM_WORLD,1,"IS local size %d > Vec local size %d",nlocal,fhigh-flow);
for (i=0;i<nlocal;i++) {
rv[s[i]-flow] = fv[s[i]-flow];
}
ierr = ISRestoreIndices(is,&s);CHKERRQ(ierr);
ierr = VecRestoreArray(vfull,&fv);CHKERRQ(ierr);
ierr = VecRestoreArray(*vreduced,&rv);CHKERRQ(ierr);
break;
}
}
PetscFunctionReturn(0);
}
/*@
DMPlexGetOrdering - Calculate a reordering of the mesh
Collective on DM
Input Parameter:
+ dm - The DMPlex object
. otype - type of reordering, one of the following:
$ MATORDERINGNATURAL - Natural
$ MATORDERINGND - Nested Dissection
$ MATORDERING1WD - One-way Dissection
$ MATORDERINGRCM - Reverse Cuthill-McKee
$ MATORDERINGQMD - Quotient Minimum Degree
- label - [Optional] Label used to segregate ordering into sets, or NULL
Output Parameter:
. perm - The point permutation as an IS, perm[old point number] = new point number
Note: The label is used to group sets of points together by label value. This makes it easy to reorder a mesh which
has different types of cells, and then loop over each set of reordered cells for assembly.
Level: intermediate
.keywords: mesh
.seealso: MatGetOrdering()
@*/
PetscErrorCode DMPlexGetOrdering(DM dm, MatOrderingType otype, DMLabel label, IS *perm)
{
PetscInt numCells = 0;
PetscInt *start = NULL, *adjacency = NULL, *cperm, *clperm, *invclperm, *mask, *xls, pStart, pEnd, c, i;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
PetscValidPointer(perm, 3);
ierr = DMPlexCreateNeighborCSR(dm, 0, &numCells, &start, &adjacency);CHKERRQ(ierr);
ierr = PetscMalloc3(numCells,&cperm,numCells,&mask,numCells*2,&xls);CHKERRQ(ierr);
if (numCells) {
/* Shift for Fortran numbering */
for (i = 0; i < start[numCells]; ++i) ++adjacency[i];
for (i = 0; i <= numCells; ++i) ++start[i];
ierr = SPARSEPACKgenrcm(&numCells, start, adjacency, cperm, mask, xls);CHKERRQ(ierr);
}
ierr = PetscFree(start);CHKERRQ(ierr);
ierr = PetscFree(adjacency);CHKERRQ(ierr);
/* Shift for Fortran numbering */
for (c = 0; c < numCells; ++c) --cperm[c];
/* Segregate */
if (label) {
IS valueIS;
const PetscInt *values;
PetscInt numValues, numPoints = 0;
PetscInt *sperm, *vsize, *voff, v;
ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
ierr = ISSort(valueIS);CHKERRQ(ierr);
ierr = ISGetLocalSize(valueIS, &numValues);CHKERRQ(ierr);
ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
ierr = PetscCalloc3(numCells,&sperm,numValues,&vsize,numValues+1,&voff);CHKERRQ(ierr);
for (v = 0; v < numValues; ++v) {
ierr = DMLabelGetStratumSize(label, values[v], &vsize[v]);CHKERRQ(ierr);
if (v < numValues-1) voff[v+2] += vsize[v] + voff[v+1];
numPoints += vsize[v];
}
if (numPoints != numCells) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Label only covers %D cells < %D total", numPoints, numCells);
for (c = 0; c < numCells; ++c) {
const PetscInt oldc = cperm[c];
PetscInt val, vloc;
ierr = DMLabelGetValue(label, oldc, &val);CHKERRQ(ierr);
if (val == -1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cell %D not present in label", oldc);
ierr = PetscFindInt(val, numValues, values, &vloc);CHKERRQ(ierr);
if (vloc < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Value %D not present label", val);
sperm[voff[vloc+1]++] = oldc;
}
for (v = 0; v < numValues; ++v) {
if (voff[v+1] - voff[v] != vsize[v]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of %D values found is %D != %D", values[v], voff[v+1] - voff[v], vsize[v]);
}
ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
ierr = PetscMemcpy(cperm, sperm, numCells * sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscFree3(sperm, vsize, voff);CHKERRQ(ierr);
}
/* Construct closure */
ierr = DMPlexCreateOrderingClosure_Static(dm, numCells, cperm, &clperm, &invclperm);CHKERRQ(ierr);
ierr = PetscFree3(cperm,mask,xls);CHKERRQ(ierr);
ierr = PetscFree(clperm);CHKERRQ(ierr);
/* Invert permutation */
ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd-pStart, invclperm, PETSC_OWN_POINTER, perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C,Cperm;
PetscInt i,j,m = 5,n = 5,Ii,J,ncols;
PetscErrorCode ierr;
PetscScalar v;
PetscMPIInt size;
IS rperm,cperm,icperm;
const PetscInt *rperm_ptr,*cperm_ptr,*cols;
const PetscScalar *vals;
PetscBool TestMyorder=PETSC_FALSE;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This is a uniprocessor example only!");
/* create the matrix for the five point stencil, YET AGAIN */
ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,m*n,m*n,5,NULL,&C);
ierr = MatSetUp(C);
CHKERRQ(ierr);
for (i=0; i<m; i++) {
for (j=0; j<n; j++) {
v = -1.0;
Ii = j + n*i;
if (i>0) {
J = Ii - n;
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);
CHKERRQ(ierr);
}
if (i<m-1) {
J = Ii + n;
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);
CHKERRQ(ierr);
}
if (j>0) {
J = Ii - 1;
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);
CHKERRQ(ierr);
}
if (j<n-1) {
J = Ii + 1;
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);
CHKERRQ(ierr);
}
v = 4.0;
ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);
CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatGetOrdering(C,MATORDERINGND,&rperm,&cperm);
CHKERRQ(ierr);
ierr = ISView(rperm,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
ierr = ISDestroy(&rperm);
CHKERRQ(ierr);
ierr = ISDestroy(&cperm);
CHKERRQ(ierr);
ierr = MatGetOrdering(C,MATORDERINGRCM,&rperm,&cperm);
CHKERRQ(ierr);
ierr = ISView(rperm,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
ierr = ISDestroy(&rperm);
CHKERRQ(ierr);
ierr = ISDestroy(&cperm);
CHKERRQ(ierr);
ierr = MatGetOrdering(C,MATORDERINGQMD,&rperm,&cperm);
CHKERRQ(ierr);
ierr = ISView(rperm,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
ierr = ISDestroy(&rperm);
CHKERRQ(ierr);
ierr = ISDestroy(&cperm);
CHKERRQ(ierr);
/* create Cperm = rperm*C*icperm */
ierr = PetscOptionsGetBool(NULL,"-testmyordering",&TestMyorder,NULL);
CHKERRQ(ierr);
if (TestMyorder) {
ierr = MatGetOrdering_myordering(C,MATORDERINGQMD,&rperm,&cperm);
CHKERRQ(ierr);
printf("myordering's rperm:\n");
ierr = ISView(rperm,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
ierr = ISInvertPermutation(cperm,PETSC_DECIDE,&icperm);
CHKERRQ(ierr);
ierr = ISGetIndices(rperm,&rperm_ptr);
CHKERRQ(ierr);
ierr = ISGetIndices(icperm,&cperm_ptr);
CHKERRQ(ierr);
ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,m*n,m*n,5,NULL,&Cperm);
CHKERRQ(ierr);
for (i=0; i<m*n; i++) {
ierr = MatGetRow(C,rperm_ptr[i],&ncols,&cols,&vals);
CHKERRQ(ierr);
for (j=0; j<ncols; j++) {
/* printf(" (%d %d %g)\n",i,cperm_ptr[cols[j]],vals[j]); */
ierr = MatSetValues(Cperm,1,&i,1,&cperm_ptr[cols[j]],&vals[j],INSERT_VALUES);
CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(Cperm,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(Cperm,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = ISRestoreIndices(rperm,&rperm_ptr);
CHKERRQ(ierr);
ierr = ISRestoreIndices(icperm,&cperm_ptr);
CHKERRQ(ierr);
ierr = ISDestroy(&rperm);
CHKERRQ(ierr);
ierr = ISDestroy(&cperm);
CHKERRQ(ierr);
ierr = ISDestroy(&icperm);
CHKERRQ(ierr);
ierr = MatDestroy(&Cperm);
CHKERRQ(ierr);
}
ierr = MatDestroy(&C);
CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode ISView_General_HDF5(IS is, PetscViewer viewer)
{
hid_t filespace; /* file dataspace identifier */
hid_t chunkspace; /* chunk dataset property identifier */
hid_t plist_id; /* property list identifier */
hid_t dset_id; /* dataset identifier */
hid_t memspace; /* memory dataspace identifier */
hid_t inttype; /* int type (H5T_NATIVE_INT or H5T_NATIVE_LLONG) */
hid_t file_id, group;
herr_t status;
hsize_t dim, maxDims[3], dims[3], chunkDims[3], count[3],offset[3];
PetscInt bs, N, n, timestep, low;
const PetscInt *ind;
const char *isname;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = ISGetBlockSize(is,&bs);CHKERRQ(ierr);
ierr = PetscViewerHDF5OpenGroup(viewer, &file_id, &group);CHKERRQ(ierr);
ierr = PetscViewerHDF5GetTimestep(viewer, ×tep);CHKERRQ(ierr);
/* Create the dataspace for the dataset.
*
* dims - holds the current dimensions of the dataset
*
* maxDims - holds the maximum dimensions of the dataset (unlimited
* for the number of time steps with the current dimensions for the
* other dimensions; so only additional time steps can be added).
*
* chunkDims - holds the size of a single time step (required to
* permit extending dataset).
*/
dim = 0;
if (timestep >= 0) {
dims[dim] = timestep+1;
maxDims[dim] = H5S_UNLIMITED;
chunkDims[dim] = 1;
++dim;
}
ierr = ISGetSize(is, &N);CHKERRQ(ierr);
ierr = ISGetLocalSize(is, &n);CHKERRQ(ierr);
ierr = PetscHDF5IntCast(N/bs,dims + dim);CHKERRQ(ierr);
maxDims[dim] = dims[dim];
chunkDims[dim] = dims[dim];
++dim;
if (bs >= 1) {
dims[dim] = bs;
maxDims[dim] = dims[dim];
chunkDims[dim] = dims[dim];
++dim;
}
filespace = H5Screate_simple(dim, dims, maxDims);
if (filespace == -1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot H5Screate_simple()");
#if defined(PETSC_USE_64BIT_INDICES)
inttype = H5T_NATIVE_LLONG;
#else
inttype = H5T_NATIVE_INT;
#endif
/* Create the dataset with default properties and close filespace */
ierr = PetscObjectGetName((PetscObject) is, &isname);CHKERRQ(ierr);
if (!H5Lexists(group, isname, H5P_DEFAULT)) {
/* Create chunk */
chunkspace = H5Pcreate(H5P_DATASET_CREATE);
if (chunkspace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Pcreate()");
status = H5Pset_chunk(chunkspace, dim, chunkDims);CHKERRQ(status);
#if (H5_VERS_MAJOR * 10000 + H5_VERS_MINOR * 100 + H5_VERS_RELEASE >= 10800)
dset_id = H5Dcreate2(group, isname, inttype, filespace, H5P_DEFAULT, chunkspace, H5P_DEFAULT);
#else
dset_id = H5Dcreate(group, isname, inttype, filespace, H5P_DEFAULT);
#endif
if (dset_id == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Dcreate2()");
status = H5Pclose(chunkspace);CHKERRQ(status);
} else {
dset_id = H5Dopen2(group, isname, H5P_DEFAULT);
status = H5Dset_extent(dset_id, dims);CHKERRQ(status);
}
status = H5Sclose(filespace);CHKERRQ(status);
/* Each process defines a dataset and writes it to the hyperslab in the file */
dim = 0;
if (timestep >= 0) {
count[dim] = 1;
++dim;
}
ierr = PetscHDF5IntCast(n/bs,count + dim);CHKERRQ(ierr);
++dim;
if (bs >= 1) {
count[dim] = bs;
++dim;
}
if (n > 0) {
memspace = H5Screate_simple(dim, count, NULL);
if (memspace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Screate_simple()");
} else {
/* Can't create dataspace with zero for any dimension, so create null dataspace. */
memspace = H5Screate(H5S_NULL);
if (memspace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Screate()");
}
/* Select hyperslab in the file */
ierr = PetscLayoutGetRange(is->map, &low, NULL);CHKERRQ(ierr);
dim = 0;
if (timestep >= 0) {
offset[dim] = timestep;
++dim;
}
ierr = PetscHDF5IntCast(low/bs,offset + dim);CHKERRQ(ierr);
++dim;
if (bs >= 1) {
offset[dim] = 0;
++dim;
}
if (n > 0) {
filespace = H5Dget_space(dset_id);
if (filespace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Dget_space()");
status = H5Sselect_hyperslab(filespace, H5S_SELECT_SET, offset, NULL, count, NULL);CHKERRQ(status);
} else {
/* Create null filespace to match null memspace. */
filespace = H5Screate(H5S_NULL);
if (filespace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Screate(H5S_NULL)");
}
/* Create property list for collective dataset write */
plist_id = H5Pcreate(H5P_DATASET_XFER);
if (plist_id == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Pcreate()");
#if defined(PETSC_HAVE_H5PSET_FAPL_MPIO)
status = H5Pset_dxpl_mpio(plist_id, H5FD_MPIO_COLLECTIVE);CHKERRQ(status);
#endif
/* To write dataset independently use H5Pset_dxpl_mpio(plist_id, H5FD_MPIO_INDEPENDENT) */
ierr = ISGetIndices(is, &ind);CHKERRQ(ierr);
status = H5Dwrite(dset_id, inttype, memspace, filespace, plist_id, ind);CHKERRQ(status);
status = H5Fflush(file_id, H5F_SCOPE_GLOBAL);CHKERRQ(status);
ierr = ISGetIndices(is, &ind);CHKERRQ(ierr);
/* Close/release resources */
if (group != file_id) {status = H5Gclose(group);CHKERRQ(status);}
status = H5Pclose(plist_id);CHKERRQ(status);
status = H5Sclose(filespace);CHKERRQ(status);
status = H5Sclose(memspace);CHKERRQ(status);
status = H5Dclose(dset_id);CHKERRQ(status);
ierr = PetscInfo1(is, "Wrote IS object with name %s\n", isname);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
* Increase overlap for the sub-matrix across sub communicator
* sub-matrix could be a graph or numerical matrix
* */
PetscErrorCode MatIncreaseOverlapSplit_Single(Mat mat,IS *is,PetscInt ov)
{
PetscInt i,nindx,*indices_sc,*indices_ov,localsize,*localsizes_sc,localsize_tmp;
PetscInt *indices_ov_rd,nroots,nleaves,*localoffsets,*indices_recv,*sources_sc,*sources_sc_rd;
const PetscInt *indices;
PetscMPIInt srank,ssize,issamecomm,k,grank;
IS is_sc,allis_sc,partitioning;
MPI_Comm gcomm,dcomm,scomm;
PetscSF sf;
PetscSFNode *remote;
Mat *smat;
MatPartitioning part;
PetscErrorCode ierr;
PetscFunctionBegin;
/* get a sub communicator before call individual MatIncreaseOverlap
* since the sub communicator may be changed.
* */
ierr = PetscObjectGetComm((PetscObject)(*is),&dcomm);CHKERRQ(ierr);
/*make a copy before the original one is deleted*/
ierr = PetscCommDuplicate(dcomm,&scomm,NULL);CHKERRQ(ierr);
/*get a global communicator, where mat should be a global matrix */
ierr = PetscObjectGetComm((PetscObject)mat,&gcomm);CHKERRQ(ierr);
/*increase overlap on each individual subdomain*/
ierr = (*mat->ops->increaseoverlap)(mat,1,is,ov);CHKERRQ(ierr);
/*compare communicators */
ierr = MPI_Comm_compare(gcomm,scomm,&issamecomm);CHKERRQ(ierr);
/* if the sub-communicator is the same as the global communicator,
* user does not want to use a sub-communicator
* */
if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT) PetscFunctionReturn(0);
/* if the sub-communicator is petsc_comm_self,
* user also does not care the sub-communicator
* */
ierr = MPI_Comm_compare(scomm,PETSC_COMM_SELF,&issamecomm);CHKERRQ(ierr);
if(issamecomm == MPI_IDENT || issamecomm == MPI_CONGRUENT){PetscFunctionReturn(0);}
/*local rank, size in a sub-communicator */
ierr = MPI_Comm_rank(scomm,&srank);CHKERRQ(ierr);
ierr = MPI_Comm_size(scomm,&ssize);CHKERRQ(ierr);
ierr = MPI_Comm_rank(gcomm,&grank);CHKERRQ(ierr);
/*create a new IS based on sub-communicator
* since the old IS is often based on petsc_comm_self
* */
ierr = ISGetLocalSize(*is,&nindx);CHKERRQ(ierr);
ierr = PetscCalloc1(nindx,&indices_sc);CHKERRQ(ierr);
ierr = ISGetIndices(*is,&indices);CHKERRQ(ierr);
ierr = PetscMemcpy(indices_sc,indices,sizeof(PetscInt)*nindx);CHKERRQ(ierr);
ierr = ISRestoreIndices(*is,&indices);CHKERRQ(ierr);
/*we do not need any more*/
ierr = ISDestroy(is);CHKERRQ(ierr);
/*create a index set based on the sub communicator */
ierr = ISCreateGeneral(scomm,nindx,indices_sc,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr);
/*gather all indices within the sub communicator*/
ierr = ISAllGather(is_sc,&allis_sc);CHKERRQ(ierr);
ierr = ISDestroy(&is_sc);CHKERRQ(ierr);
/* gather local sizes */
ierr = PetscMalloc1(ssize,&localsizes_sc);CHKERRQ(ierr);
/*get individual local sizes for all index sets*/
ierr = MPI_Gather(&nindx,1,MPIU_INT,localsizes_sc,1,MPIU_INT,0,scomm);CHKERRQ(ierr);
/*only root does these computations */
if(!srank){
/*get local size for the big index set*/
ierr = ISGetLocalSize(allis_sc,&localsize);CHKERRQ(ierr);
ierr = PetscCalloc2(localsize,&indices_ov,localsize,&sources_sc);CHKERRQ(ierr);
ierr = PetscCalloc2(localsize,&indices_ov_rd,localsize,&sources_sc_rd);CHKERRQ(ierr);
ierr = ISGetIndices(allis_sc,&indices);CHKERRQ(ierr);
ierr = PetscMemcpy(indices_ov,indices,sizeof(PetscInt)*localsize);CHKERRQ(ierr);
ierr = ISRestoreIndices(allis_sc,&indices);CHKERRQ(ierr);
/*we do not need it any more */
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*assign corresponding sources */
localsize_tmp = 0;
for(k=0; k<ssize; k++){
for(i=0; i<localsizes_sc[k]; i++){
sources_sc[localsize_tmp++] = k;
}
}
/*record where indices come from */
ierr = PetscSortIntWithArray(localsize,indices_ov,sources_sc);CHKERRQ(ierr);
/*count local sizes for reduced indices */
ierr = PetscMemzero(localsizes_sc,sizeof(PetscInt)*ssize);CHKERRQ(ierr);
/*initialize the first entity*/
if(localsize){
indices_ov_rd[0] = indices_ov[0];
sources_sc_rd[0] = sources_sc[0];
localsizes_sc[sources_sc[0]]++;
}
localsize_tmp = 1;
/*remove duplicate integers */
for(i=1; i<localsize; i++){
if(indices_ov[i] != indices_ov[i-1]){
indices_ov_rd[localsize_tmp] = indices_ov[i];
sources_sc_rd[localsize_tmp++] = sources_sc[i];
localsizes_sc[sources_sc[i]]++;
}
}
ierr = PetscFree2(indices_ov,sources_sc);CHKERRQ(ierr);
ierr = PetscCalloc1(ssize+1,&localoffsets);CHKERRQ(ierr);
for(k=0; k<ssize; k++){
localoffsets[k+1] = localoffsets[k] + localsizes_sc[k];
}
/*construct a star forest to send data back */
nleaves = localoffsets[ssize];
ierr = PetscMemzero(localoffsets,(ssize+1)*sizeof(PetscInt));CHKERRQ(ierr);
nroots = localsizes_sc[srank];
ierr = PetscCalloc1(nleaves,&remote);CHKERRQ(ierr);
for(i=0; i<nleaves; i++){
remote[i].rank = sources_sc_rd[i];
remote[i].index = localoffsets[sources_sc_rd[i]]++;
}
ierr = PetscFree(localoffsets);CHKERRQ(ierr);
}else{
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*Allocate a 'zero' pointer */
ierr = PetscCalloc1(0,&remote);CHKERRQ(ierr);
nleaves = 0;
indices_ov_rd = 0;
sources_sc_rd = 0;
}
/*scatter sizes to everybody */
ierr = MPI_Scatter(localsizes_sc,1, MPIU_INT,&nroots,1, MPIU_INT,0,scomm);CHKERRQ(ierr);
/*free memory */
ierr = PetscFree(localsizes_sc);CHKERRQ(ierr);
ierr = PetscCalloc1(nroots,&indices_recv);CHKERRQ(ierr);
/*ierr = MPI_Comm_dup(scomm,&dcomm);CHKERRQ(ierr);*/
/*set data back to every body */
ierr = PetscSFCreate(scomm,&sf);CHKERRQ(ierr);
ierr = PetscSFSetType(sf,PETSCSFBASIC);CHKERRQ(ierr);
ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
ierr = PetscSFSetGraph(sf,nroots,nleaves,PETSC_NULL,PETSC_OWN_POINTER,remote,PETSC_OWN_POINTER);CHKERRQ(ierr);
ierr = PetscSFReduceBegin(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr);
ierr = PetscSFReduceEnd(sf,MPIU_INT,indices_ov_rd,indices_recv,MPIU_REPLACE);CHKERRQ(ierr);
ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
/* free memory */
ierr = PetscFree2(indices_ov_rd,sources_sc_rd);CHKERRQ(ierr);
/*create a index set*/
ierr = ISCreateGeneral(scomm,nroots,indices_recv,PETSC_OWN_POINTER,&is_sc);CHKERRQ(ierr);
/*construct a parallel submatrix */
ierr = MatGetSubMatricesMPI(mat,1,&is_sc,&is_sc,MAT_INITIAL_MATRIX,&smat);CHKERRQ(ierr);
/* we do not need them any more */
ierr = ISDestroy(&allis_sc);CHKERRQ(ierr);
/*create a partitioner to repartition the sub-matrix*/
ierr = MatPartitioningCreate(scomm,&part);CHKERRQ(ierr);
ierr = MatPartitioningSetAdjacency(part,smat[0]);CHKERRQ(ierr);
#if PETSC_HAVE_PARMETIS
/* if there exists a ParMETIS installation, we try to use ParMETIS
* because a repartition routine possibly work better
* */
ierr = MatPartitioningSetType(part,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
/*try to use reparition function, instead of partition function */
ierr = MatPartitioningParmetisSetRepartition(part);CHKERRQ(ierr);
#else
/*we at least provide a default partitioner to rebalance the computation */
ierr = MatPartitioningSetType(part,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
#endif
/*user can pick up any partitioner by using an option*/
ierr = MatPartitioningSetFromOptions(part);CHKERRQ(ierr);
/* apply partition */
ierr = MatPartitioningApply(part,&partitioning);CHKERRQ(ierr);
ierr = MatPartitioningDestroy(&part);CHKERRQ(ierr);
ierr = MatDestroy(&(smat[0]));CHKERRQ(ierr);
ierr = PetscFree(smat);CHKERRQ(ierr);
/* get local rows including overlap */
ierr = ISBuildTwoSided(partitioning,is_sc,is);CHKERRQ(ierr);
/* destroy */
ierr = ISDestroy(&is_sc);CHKERRQ(ierr);
ierr = ISDestroy(&partitioning);CHKERRQ(ierr);
ierr = PetscCommDestroy(&scomm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
