PetscErrorCode ISInvertPermutation_General(IS is,PetscInt nlocal,IS *isout)
{
IS_General *sub = (IS_General*)is->data;
PetscInt i,*ii,n,nstart;
const PetscInt *idx = sub->idx;
PetscMPIInt size;
IS istmp,nistmp;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscLayoutGetLocalSize(is->map, &n);CHKERRQ(ierr);
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)is),&size);CHKERRQ(ierr);
if (size == 1) {
ierr = PetscMalloc1(n,&ii);CHKERRQ(ierr);
for (i=0; i<n; i++) ii[idx[i]] = i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,ii,PETSC_OWN_POINTER,isout);CHKERRQ(ierr);
ierr = ISSetPermutation(*isout);CHKERRQ(ierr);
} else {
/* crude, nonscalable get entire IS on each processor */
if (nlocal == PETSC_DECIDE) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Do not yet support nlocal of PETSC_DECIDE");
ierr = ISAllGather(is,&istmp);CHKERRQ(ierr);
ierr = ISSetPermutation(istmp);CHKERRQ(ierr);
ierr = ISInvertPermutation(istmp,PETSC_DECIDE,&nistmp);CHKERRQ(ierr);
ierr = ISDestroy(&istmp);CHKERRQ(ierr);
/* get the part we need */
ierr = MPI_Scan(&nlocal,&nstart,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)is));CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
{
PetscInt N;
PetscMPIInt rank;
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)is),&rank);CHKERRQ(ierr);
ierr = PetscLayoutGetSize(is->map, &N);CHKERRQ(ierr);
if (rank == size-1) {
if (nstart != N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Sum of nlocal lengths %d != total IS length %d",nstart,N);
}
}
#endif
nstart -= nlocal;
ierr = ISGetIndices(nistmp,&idx);CHKERRQ(ierr);
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)is),nlocal,idx+nstart,PETSC_COPY_VALUES,isout);CHKERRQ(ierr);
ierr = ISRestoreIndices(nistmp,&idx);CHKERRQ(ierr);
ierr = ISDestroy(&nistmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode ISInvertPermutation_Stride(IS is,PetscInt nlocal,IS *perm)
{
IS_Stride *isstride = (IS_Stride*)is->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (is->isidentity) {
ierr = ISCreateStride(PETSC_COMM_SELF,isstride->n,0,1,perm);CHKERRQ(ierr);
} else {
IS tmp;
const PetscInt *indices,n = isstride->n;
ierr = ISGetIndices(is,&indices);CHKERRQ(ierr);
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)is),n,indices,PETSC_COPY_VALUES,&tmp);CHKERRQ(ierr);
ierr = ISSetPermutation(tmp);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&indices);CHKERRQ(ierr);
ierr = ISInvertPermutation(tmp,nlocal,perm);CHKERRQ(ierr);
ierr = ISDestroy(&tmp);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;
}
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);
}
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;
}
PETSC_INTERN PetscErrorCode MatReorderForNonzeroDiagonal_SeqAIJ(Mat mat,PetscReal abstol,IS ris,IS cis)
{
PetscErrorCode ierr;
PetscInt prow,k,nz,n,repl,*j,*col,*row,m,*icol,nnz,*jj,kk;
PetscScalar *v,*vv;
PetscReal repla;
IS icis;
PetscFunctionBegin;
/* access the indices of the IS directly, because it changes them */
row = ((IS_General*)ris->data)->idx;
col = ((IS_General*)cis->data)->idx;
ierr = ISInvertPermutation(cis,PETSC_DECIDE,&icis);CHKERRQ(ierr);
icol = ((IS_General*)icis->data)->idx;
ierr = MatGetSize(mat,&m,&n);CHKERRQ(ierr);
for (prow=0; prow<n; prow++) {
ierr = MatGetRow_SeqAIJ(mat,row[prow],&nz,&j,&v);CHKERRQ(ierr);
for (k=0; k<nz; k++) {
if (icol[j[k]] == prow) break;
}
if (k >= nz || PetscAbsScalar(v[k]) <= abstol) {
/* Element too small or zero; find the best candidate */
repla = (k >= nz) ? 0.0 : PetscAbsScalar(v[k]);
/*
Look for a later column we can swap with this one
*/
for (k=0; k<nz; k++) {
if (icol[j[k]] > prow && PetscAbsScalar(v[k]) > repla) {
/* found a suitable later column */
repl = icol[j[k]];
SWAP(icol[col[prow]],icol[col[repl]]);
SWAP(col[prow],col[repl]);
goto found;
}
}
/*
Did not find a suitable later column so look for an earlier column
We need to be sure that we don't introduce a zero in a previous
diagonal
*/
for (k=0; k<nz; k++) {
if (icol[j[k]] < prow && PetscAbsScalar(v[k]) > repla) {
/* See if this one will work */
repl = icol[j[k]];
ierr = MatGetRow_SeqAIJ(mat,row[repl],&nnz,&jj,&vv);CHKERRQ(ierr);
for (kk=0; kk<nnz; kk++) {
if (icol[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > abstol) {
ierr = MatRestoreRow_SeqAIJ(mat,row[repl],&nnz,&jj,&vv);CHKERRQ(ierr);
SWAP(icol[col[prow]],icol[col[repl]]);
SWAP(col[prow],col[repl]);
goto found;
}
}
ierr = MatRestoreRow_SeqAIJ(mat,row[repl],&nnz,&jj,&vv);CHKERRQ(ierr);
}
}
/*
No column suitable; instead check all future rows
Note: this will be very slow
*/
for (k=prow+1; k<n; k++) {
ierr = MatGetRow_SeqAIJ(mat,row[k],&nnz,&jj,&vv);CHKERRQ(ierr);
for (kk=0; kk<nnz; kk++) {
if (icol[jj[kk]] == prow && PetscAbsScalar(vv[kk]) > abstol) {
/* found a row */
SWAP(row[prow],row[k]);
goto found;
}
}
ierr = MatRestoreRow_SeqAIJ(mat,row[k],&nnz,&jj,&vv);CHKERRQ(ierr);
}
found:;
}
ierr = MatRestoreRow_SeqAIJ(mat,row[prow],&nz,&j,&v);CHKERRQ(ierr);
}
ierr = ISDestroy(&icis);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatReorderingSeqSBAIJ(Mat A,IS perm)
{
Mat_SeqSBAIJ *a=(Mat_SeqSBAIJ *)A->data;
PetscErrorCode ierr;
const PetscInt mbs=a->mbs,*rip,*riip;
PetscInt *ai,*aj,*r;
PetscInt *nzr,nz,jmin,jmax,j,k,ajk,i;
IS iperm; /* inverse of perm */
PetscFunctionBegin;
if (!mbs) PetscFunctionReturn(0);
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Matrix reordering is not supported for sbaij matrix. Use aij format");
ierr = ISGetIndices(perm,&rip);CHKERRQ(ierr);
ierr = ISInvertPermutation(perm,PETSC_DECIDE,&iperm);CHKERRQ(ierr);
ierr = ISGetIndices(iperm,&riip);CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
if (rip[i] != riip[i]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Non-symmetric permutation, use symmetric permutation for symmetric matrices");
}
ierr = ISRestoreIndices(iperm,&riip);CHKERRQ(ierr);
ierr = ISDestroy(&iperm);CHKERRQ(ierr);
if (!a->inew){
ierr = PetscMalloc2(mbs+1,PetscInt,&ai, 2*a->i[mbs],PetscInt,&aj);CHKERRQ(ierr);
} else {
ai = a->inew; aj = a->jnew;
}
ierr = PetscMemcpy(ai,a->i,(mbs+1)*sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscMemcpy(aj,a->j,(a->i[mbs])*sizeof(PetscInt));CHKERRQ(ierr);
/*
Phase 1: Find row index r in which to store each nonzero.
Initialize count of nonzeros to be stored in each row (nzr).
At the end of this phase, a nonzero a(*,*)=a(r(),aj())
s.t. a(perm(r),perm(aj)) will fall into upper triangle part.
*/
ierr = PetscMalloc(mbs*sizeof(PetscInt),&nzr);CHKERRQ(ierr);
ierr = PetscMalloc(ai[mbs]*sizeof(PetscInt),&r);CHKERRQ(ierr);
for (i=0; i<mbs; i++) nzr[i] = 0;
for (i=0; i<ai[mbs]; i++) r[i] = 0;
/* for each nonzero element */
for (i=0; i<mbs; i++){
nz = ai[i+1] - ai[i];
j = ai[i];
/* printf("nz = %d, j=%d\n",nz,j); */
while (nz--){
/* --- find row (=r[j]) and column (=aj[j]) in which to store a[j] ...*/
k = aj[j]; /* col. index */
/* printf("nz = %d, k=%d\n", nz,k); */
/* for entry that will be permuted into lower triangle, swap row and col. index */
if (rip[k] < rip[i]) aj[j] = i;
else k = i;
r[j] = k; j++;
nzr[k] ++; /* increment count of nonzeros in that row */
}
}
/* Phase 2: Find new ai and permutation to apply to (aj,a).
Determine pointers (r) to delimit rows in permuted (aj,a).
Note: r is different from r used in phase 1.
At the end of this phase, (aj[j],a[j]) will be stored in
(aj[r(j)],a[r(j)]).
*/
for (i=0; i<mbs; i++){
ai[i+1] = ai[i] + nzr[i];
nzr[i] = ai[i+1];
}
/* determine where each (aj[j], a[j]) is stored in new (aj,a)
for each nonzero element (in reverse order) */
jmin = ai[0]; jmax = ai[mbs];
nz = jmax - jmin;
j = jmax-1;
while (nz--){
i = r[j]; /* row value */
if (aj[j] == i) r[j] = ai[i]; /* put diagonal nonzero at beginning of row */
else { /* put off-diagonal nonzero in last unused location in row */
nzr[i]--; r[j] = nzr[i];
}
j--;
}
a->a2anew = aj + ai[mbs];
ierr = PetscMemcpy(a->a2anew,r,ai[mbs]*sizeof(PetscInt));CHKERRQ(ierr);
/* Phase 3: permute (aj,a) to upper triangular form (wrt new ordering) */
for (j=jmin; j<jmax; j++){
while (r[j] != j){
k = r[j]; r[j] = r[k]; r[k] = k;
ajk = aj[k]; aj[k] = aj[j]; aj[j] = ajk;
/* ak = aa[k]; aa[k] = aa[j]; aa[j] = ak; */
}
}
ierr= ISRestoreIndices(perm,&rip);CHKERRQ(ierr);
a->inew = ai;
a->jnew = aj;
ierr = ISDestroy(&a->row);CHKERRQ(ierr);
ierr = ISDestroy(&a->icol);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
ierr = ISDestroy(&a->row);CHKERRQ(ierr);
a->row = perm;
ierr = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
ierr = ISDestroy(&a->icol);CHKERRQ(ierr);
a->icol = perm;
ierr = PetscFree(nzr);CHKERRQ(ierr);
ierr = PetscFree(r);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatICCFactorSymbolic_SeqAIJ_Bas(Mat fact,Mat A,IS perm,const MatFactorInfo *info)
{
Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
Mat_SeqSBAIJ *b;
PetscErrorCode ierr;
PetscBool perm_identity,missing;
PetscInt reallocs=0,i,*ai=a->i,*aj=a->j,am=A->rmap->n,*ui;
const PetscInt *rip,*riip;
PetscInt j;
PetscInt d;
PetscInt ncols,*cols,*uj;
PetscReal fill=info->fill,levels=info->levels;
IS iperm;
spbas_matrix Pattern_0, Pattern_P;
PetscFunctionBegin;
if (A->rmap->n != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be square matrix, rows %D columns %D",A->rmap->n,A->cmap->n);
ierr = MatMissingDiagonal(A,&missing,&d);CHKERRQ(ierr);
if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",d);
ierr = ISIdentity(perm,&perm_identity);CHKERRQ(ierr);
ierr = ISInvertPermutation(perm,PETSC_DECIDE,&iperm);CHKERRQ(ierr);
/* ICC(0) without matrix ordering: simply copies fill pattern */
if (!levels && perm_identity) {
ierr = PetscMalloc1(am+1,&ui);CHKERRQ(ierr);
ui[0] = 0;
for (i=0; i<am; i++) {
ui[i+1] = ui[i] + ai[i+1] - a->diag[i];
}
ierr = PetscMalloc1(ui[am]+1,&uj);CHKERRQ(ierr);
cols = uj;
for (i=0; i<am; i++) {
aj = a->j + a->diag[i];
ncols = ui[i+1] - ui[i];
for (j=0; j<ncols; j++) *cols++ = *aj++;
}
} else { /* case: levels>0 || (levels=0 && !perm_identity) */
ierr = ISGetIndices(iperm,&riip);CHKERRQ(ierr);
ierr = ISGetIndices(perm,&rip);CHKERRQ(ierr);
/* Create spbas_matrix for pattern */
ierr = spbas_pattern_only(am, am, ai, aj, &Pattern_0);CHKERRQ(ierr);
/* Apply the permutation */
ierr = spbas_apply_reordering(&Pattern_0, rip, riip);CHKERRQ(ierr);
/* Raise the power */
ierr = spbas_power(Pattern_0, (int) levels+1, &Pattern_P);CHKERRQ(ierr);
ierr = spbas_delete(Pattern_0);CHKERRQ(ierr);
/* Keep only upper triangle of pattern */
ierr = spbas_keep_upper(&Pattern_P);CHKERRQ(ierr);
/* Convert to Sparse Row Storage */
ierr = spbas_matrix_to_crs(Pattern_P, NULL, &ui, &uj);CHKERRQ(ierr);
ierr = spbas_delete(Pattern_P);CHKERRQ(ierr);
} /* end of case: levels>0 || (levels=0 && !perm_identity) */
/* put together the new matrix in MATSEQSBAIJ format */
b = (Mat_SeqSBAIJ*)(fact)->data;
b->singlemalloc = PETSC_FALSE;
ierr = PetscMalloc1(ui[am]+1,&b->a);CHKERRQ(ierr);
b->j = uj;
b->i = ui;
b->diag = 0;
b->ilen = 0;
b->imax = 0;
b->row = perm;
b->col = perm;
ierr = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)perm);CHKERRQ(ierr);
b->icol = iperm;
b->pivotinblocks = PETSC_FALSE; /* need to get from MatFactorInfo */
ierr = PetscMalloc1(am+1,&b->solve_work);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)(fact),(ui[am]-am)*(sizeof(PetscInt)+sizeof(MatScalar)));CHKERRQ(ierr);
b->maxnz = b->nz = ui[am];
b->free_a = PETSC_TRUE;
b->free_ij = PETSC_TRUE;
(fact)->info.factor_mallocs = reallocs;
(fact)->info.fill_ratio_given = fill;
if (ai[am] != 0) {
(fact)->info.fill_ratio_needed = ((PetscReal)ui[am])/((PetscReal)ai[am]);
} else {
(fact)->info.fill_ratio_needed = 0.0;
}
/* (fact)->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ_inplace; */
PetscFunctionReturn(0);
}
void PETSC_STDCALL isinvertpermutation_(IS is,PetscInt *nlocal,IS *isout, int *__ierr ){
*__ierr = ISInvertPermutation(
(IS)PetscToPointer((is) ),*nlocal,isout);
}
int main(int argc,char **args)
{
MatType mtype = MATMPIAIJ; /* matrix format */
Mat A,B; /* matrix */
PetscViewer fd; /* viewer */
char file[PETSC_MAX_PATH_LEN]; /* input file name */
PetscBool flg,viewMats,viewIS,viewVecs;
PetscInt ierr,*nlocal,m,n;
PetscMPIInt rank,size;
MatPartitioning part;
IS is,isn;
Vec xin, xout;
VecScatter scat;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL, "-view_mats", &viewMats);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL, "-view_is", &viewIS);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL, "-view_vecs", &viewVecs);CHKERRQ(ierr);
/*
Determine file from which we read the matrix
*/
ierr = PetscOptionsGetString(NULL,"-f",file,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr);
/*
Open binary file. Note that we use FILE_MODE_READ to indicate
reading from this file.
*/
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_READ,&fd);CHKERRQ(ierr);
/*
Load the matrix and vector; then destroy the viewer.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetType(A,mtype);CHKERRQ(ierr);
ierr = MatLoad(A,fd);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&xin);CHKERRQ(ierr);
ierr = VecLoad(xin,fd);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr);
if (viewMats) {
if (!rank) printf("Original matrix:\n");
ierr = MatView(A,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
}
if (viewVecs) {
if (!rank) printf("Original vector:\n");
ierr = VecView(xin,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* Partition the graph of the matrix */
ierr = MatPartitioningCreate(PETSC_COMM_WORLD,&part);CHKERRQ(ierr);
ierr = MatPartitioningSetAdjacency(part,A);CHKERRQ(ierr);
ierr = MatPartitioningSetFromOptions(part);CHKERRQ(ierr);
/* get new processor owner number of each vertex */
ierr = MatPartitioningApply(part,&is);CHKERRQ(ierr);
if (viewIS) {
if (!rank) printf("IS1 - new processor ownership:\n");
ierr = ISView(is,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* get new global number of each old global number */
ierr = ISPartitioningToNumbering(is,&isn);CHKERRQ(ierr);
if (viewIS) {
if (!rank) printf("IS2 - new global numbering:\n");
ierr = ISView(isn,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* get number of new vertices for each processor */
ierr = PetscMalloc(size*sizeof(PetscInt),&nlocal);CHKERRQ(ierr);
ierr = ISPartitioningCount(is,size,nlocal);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
/* get old global number of each new global number */
ierr = ISInvertPermutation(isn,nlocal[rank],&is);CHKERRQ(ierr);
ierr = PetscFree(nlocal);CHKERRQ(ierr);
ierr = ISDestroy(&isn);CHKERRQ(ierr);
ierr = MatPartitioningDestroy(&part);CHKERRQ(ierr);
if (viewIS) {
if (!rank) printf("IS3=inv(IS2) - old global number of each new global number:\n");
ierr = ISView(is,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* move the matrix rows to the new processes they have been assigned to by the permutation */
ierr = ISSort(is);CHKERRQ(ierr);
ierr = MatGetSubMatrix(A,is,is,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
/* move the vector rows to the new processes they have been assigned to */
ierr = MatGetLocalSize(B,&m,&n);CHKERRQ(ierr);
ierr = VecCreateMPI(PETSC_COMM_WORLD,m,PETSC_DECIDE,&xout);CHKERRQ(ierr);
ierr = VecScatterCreate(xin,is,xout,NULL,&scat);CHKERRQ(ierr);
ierr = VecScatterBegin(scat,xin,xout,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat,xin,xout,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scat);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
if (viewMats) {
if (!rank) printf("Partitioned matrix:\n");
ierr = MatView(B,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
}
if (viewVecs) {
if (!rank) printf("Mapped vector:\n");
ierr = VecView(xout,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
{
PetscInt rstart,i,*nzd,*nzo,nzl,nzmax = 0,*ncols,nrow,j;
Mat J;
const PetscInt *cols;
const PetscScalar *vals;
PetscScalar *nvals;
ierr = MatGetOwnershipRange(B,&rstart,NULL);CHKERRQ(ierr);
ierr = PetscMalloc(2*m*sizeof(PetscInt),&nzd);CHKERRQ(ierr);
ierr = PetscMemzero(nzd,2*m*sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscMalloc(2*m*sizeof(PetscInt),&nzo);CHKERRQ(ierr);
ierr = PetscMemzero(nzo,2*m*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<m; i++) {
ierr = MatGetRow(B,i+rstart,&nzl,&cols,NULL);CHKERRQ(ierr);
for (j=0; j<nzl; j++) {
if (cols[j] >= rstart && cols[j] < rstart+n) {
nzd[2*i] += 2;
nzd[2*i+1] += 2;
} else {
nzo[2*i] += 2;
nzo[2*i+1] += 2;
}
}
nzmax = PetscMax(nzmax,nzd[2*i]+nzo[2*i]);
ierr = MatRestoreRow(B,i+rstart,&nzl,&cols,NULL);CHKERRQ(ierr);
}
ierr = MatCreateAIJ(PETSC_COMM_WORLD,2*m,2*m,PETSC_DECIDE,PETSC_DECIDE,0,nzd,0,nzo,&J);CHKERRQ(ierr);
ierr = PetscInfo(0,"Created empty Jacobian matrix\n");CHKERRQ(ierr);
ierr = PetscFree(nzd);CHKERRQ(ierr);
ierr = PetscFree(nzo);CHKERRQ(ierr);
ierr = PetscMalloc2(nzmax,PetscInt,&ncols,nzmax,PetscScalar,&nvals);CHKERRQ(ierr);
ierr = PetscMemzero(nvals,nzmax*sizeof(PetscScalar));CHKERRQ(ierr);
for (i=0; i<m; i++) {
ierr = MatGetRow(B,i+rstart,&nzl,&cols,&vals);CHKERRQ(ierr);
for (j=0; j<nzl; j++) {
ncols[2*j] = 2*cols[j];
ncols[2*j+1] = 2*cols[j]+1;
}
nrow = 2*(i+rstart);
ierr = MatSetValues(J,1,&nrow,2*nzl,ncols,nvals,INSERT_VALUES);CHKERRQ(ierr);
nrow = 2*(i+rstart) + 1;
ierr = MatSetValues(J,1,&nrow,2*nzl,ncols,nvals,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(B,i+rstart,&nzl,&cols,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (viewMats) {
if (!rank) printf("Jacobian matrix structure:\n");
ierr = MatView(J,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
}
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = PetscFree2(ncols,nvals);CHKERRQ(ierr);
}
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = VecDestroy(&xin);CHKERRQ(ierr);
ierr = VecDestroy(&xout);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
static PetscErrorCode permutematrix(Mat Ain, Mat Bin, Mat *Aout, Mat *Bout, int **permIndices)
{
PetscErrorCode ierr;
MatPartitioning part;
IS isn, is, iscols;
PetscInt *nlocal,localCols,m,n;
PetscMPIInt size, rank;
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Ain,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MatGetSize(Ain,&m,&n);CHKERRQ(ierr);
ierr = MatPartitioningCreate(comm,&part);CHKERRQ(ierr);
ierr = MatPartitioningSetAdjacency(part,Ain);CHKERRQ(ierr);
ierr = MatPartitioningSetFromOptions(part);CHKERRQ(ierr);
/* get new processor owner number of each vertex */
ierr = MatPartitioningApply(part,&is);CHKERRQ(ierr);
/* get new global number of each old global number */
ierr = ISPartitioningToNumbering(is,&isn);CHKERRQ(ierr);
ierr = PetscMalloc(size*sizeof(int),&nlocal);CHKERRQ(ierr);
/* get number of new vertices for each processor */
ierr = ISPartitioningCount(is,size,nlocal);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
/* get old global number of each new global number */
ierr = ISInvertPermutation(isn,nlocal[rank],&is);CHKERRQ(ierr);
ierr = ISDestroy(&isn);CHKERRQ(ierr);
ierr = MatPartitioningDestroy(&part);CHKERRQ(ierr);
ierr = ISSort(is);CHKERRQ(ierr);
/* If matrix is square, the permutation is applied to rows and columns;
otherwise it is only applied to rows. */
if (m == n) {
iscols = is;
localCols = nlocal[rank];
} else {
PetscInt lowj, highj;
ierr = MatGetOwnershipRangeColumn(Ain,&lowj,&highj);CHKERRQ(ierr);
localCols = highj-lowj;
ierr = ISCreateStride(comm,localCols, lowj, 1, &iscols);CHKERRQ(ierr);
}
/* copy permutation */
if (permIndices) {
const PetscInt *indices;
PetscInt i;
*permIndices = malloc(sizeof(int)*(nlocal[rank]+localCols));
ierr = ISGetIndices(is, &indices);CHKERRQ(ierr);
for (i=0; i<nlocal[rank]; i++) (*permIndices)[i] = indices[i];
ierr = ISRestoreIndices(is, &indices);CHKERRQ(ierr);
ierr = ISGetIndices(iscols, &indices);CHKERRQ(ierr);
for (i=0; i<localCols; i++) (*permIndices)[i+nlocal[rank]] = indices[i];
ierr = ISRestoreIndices(iscols, &indices);CHKERRQ(ierr);
}
ierr = PetscFree(nlocal);CHKERRQ(ierr);
ierr = MatGetSubMatrix(Ain,is,iscols,MAT_INITIAL_MATRIX,Aout);CHKERRQ(ierr);
if (Bin && Bout) {
ierr = MatGetSubMatrix(Bin,is,iscols,MAT_INITIAL_MATRIX,Bout);CHKERRQ(ierr);
}
ierr = ISDestroy(&is);CHKERRQ(ierr);
if (m != n) {
ierr = ISDestroy(&iscols);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
