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 **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;
}
int main(int argc,char **args)
{
Mat A,Atrans,sA,*submatA,*submatsA;
PetscErrorCode ierr;
PetscMPIInt size,rank;
PetscInt bs=1,mbs=10,ov=1,i,j,k,*rows,*cols,nd=2,*idx,rstart,rend,sz,M,N,Mbs;
PetscScalar *vals,rval,one=1.0;
IS *is1,*is2;
PetscRandom rand;
PetscBool flg,TestOverlap,TestSubMat,TestAllcols,test_sorted=PETSC_FALSE;
PetscInt vid = -1;
#if defined(PETSC_USE_LOG)
PetscLogStage stages[2];
#endif
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-mat_block_size",&bs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-mat_mbs",&mbs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-ov",&ov,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-nd",&nd,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-view_id",&vid,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL, "-test_overlap", &TestOverlap);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL, "-test_submat", &TestSubMat);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL, "-test_allcols", &TestAllcols);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-test_sorted",&test_sorted,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,mbs*bs,mbs*bs,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetType(A,MATBAIJ);CHKERRQ(ierr);
ierr = MatSeqBAIJSetPreallocation(A,bs,PETSC_DEFAULT,NULL);CHKERRQ(ierr);
ierr = MatMPIBAIJSetPreallocation(A,bs,PETSC_DEFAULT,NULL,PETSC_DEFAULT,NULL);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&rstart,&rend);CHKERRQ(ierr);
ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr);
Mbs = M/bs;
ierr = PetscMalloc1(bs,&rows);CHKERRQ(ierr);
ierr = PetscMalloc1(bs,&cols);CHKERRQ(ierr);
ierr = PetscMalloc1(bs*bs,&vals);CHKERRQ(ierr);
ierr = PetscMalloc1(M,&idx);CHKERRQ(ierr);
/* Now set blocks of values */
for (j=0; j<bs*bs; j++) vals[j] = 0.0;
for (i=0; i<Mbs; i++) {
cols[0] = i*bs; rows[0] = i*bs;
for (j=1; j<bs; j++) {
rows[j] = rows[j-1]+1;
cols[j] = cols[j-1]+1;
}
ierr = MatSetValues(A,bs,rows,bs,cols,vals,ADD_VALUES);CHKERRQ(ierr);
}
/* second, add random blocks */
for (i=0; i<20*bs; i++) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
cols[0] = bs*(PetscInt)(PetscRealPart(rval)*Mbs);
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
rows[0] = rstart + bs*(PetscInt)(PetscRealPart(rval)*mbs);
for (j=1; j<bs; j++) {
rows[j] = rows[j-1]+1;
cols[j] = cols[j-1]+1;
}
for (j=0; j<bs*bs; j++) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
vals[j] = rval;
}
ierr = MatSetValues(A,bs,rows,bs,cols,vals,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* make A a symmetric matrix: A <- A^T + A */
ierr = MatTranspose(A,MAT_INITIAL_MATRIX, &Atrans);CHKERRQ(ierr);
ierr = MatAXPY(A,one,Atrans,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatDestroy(&Atrans);CHKERRQ(ierr);
ierr = MatTranspose(A,MAT_INITIAL_MATRIX, &Atrans);CHKERRQ(ierr);
ierr = MatEqual(A, Atrans, &flg);CHKERRQ(ierr);
if (flg) {
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
} else SETERRQ(PETSC_COMM_SELF,1,"A+A^T is non-symmetric");
ierr = MatDestroy(&Atrans);CHKERRQ(ierr);
/* create a SeqSBAIJ matrix sA (= A) */
ierr = MatConvert(A,MATSBAIJ,MAT_INITIAL_MATRIX,&sA);CHKERRQ(ierr);
if (vid >= 0 && vid < size) {
if (!rank) printf("A: \n");
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
if (!rank) printf("sA: \n");
ierr = MatView(sA,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* Test sA==A through MatMult() */
ierr = MatMultEqual(A,sA,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Error in MatConvert(): A != sA");
/* Test MatIncreaseOverlap() */
ierr = PetscMalloc1(nd,&is1);CHKERRQ(ierr);
ierr = PetscMalloc1(nd,&is2);CHKERRQ(ierr);
for (i=0; i<nd; i++) {
if (!TestAllcols) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
sz = (PetscInt)((0.5+0.2*PetscRealPart(rval))*mbs); /* 0.5*mbs < sz < 0.7*mbs */
for (j=0; j<sz; j++) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
idx[j*bs] = bs*(PetscInt)(PetscRealPart(rval)*Mbs);
for (k=1; k<bs; k++) idx[j*bs+k] = idx[j*bs]+k;
}
ierr = ISCreateGeneral(PETSC_COMM_SELF,sz*bs,idx,PETSC_COPY_VALUES,is1+i);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,sz*bs,idx,PETSC_COPY_VALUES,is2+i);CHKERRQ(ierr);
if (rank == vid) {
ierr = PetscPrintf(PETSC_COMM_SELF," [%d] IS sz[%d]: %d\n",rank,i,sz);CHKERRQ(ierr);
ierr = ISView(is2[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
} else { /* Test all rows and colums */
sz = M;
ierr = ISCreateStride(PETSC_COMM_SELF,sz,0,1,is1+i);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,sz,0,1,is2+i);CHKERRQ(ierr);
if (rank == vid) {
PetscBool colflag;
ierr = ISIdentity(is2[i],&colflag);CHKERRQ(ierr);
printf("[%d] is2[%d], colflag %d\n",rank,(int)i,(int)colflag);
ierr = ISView(is2[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
}
}
ierr = PetscLogStageRegister("MatOv_SBAIJ",&stages[0]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("MatOv_BAIJ",&stages[1]);CHKERRQ(ierr);
/* Test MatIncreaseOverlap */
if (TestOverlap) {
ierr = PetscLogStagePush(stages[0]);CHKERRQ(ierr);
ierr = MatIncreaseOverlap(sA,nd,is2,ov);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stages[1]);CHKERRQ(ierr);
ierr = MatIncreaseOverlap(A,nd,is1,ov);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
if (rank == vid) {
printf("\n[%d] IS from BAIJ:\n",rank);
ierr = ISView(is1[0],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
printf("\n[%d] IS from SBAIJ:\n",rank);
ierr = ISView(is2[0],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
for (i=0; i<nd; ++i) {
ierr = ISEqual(is1[i],is2[i],&flg);CHKERRQ(ierr);
if (!flg) {
if (!rank) {
ierr = ISSort(is1[i]);CHKERRQ(ierr);
/* ISView(is1[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); */
ierr = ISSort(is2[i]);CHKERRQ(ierr);
/* ISView(is2[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); */
}
SETERRQ1(PETSC_COMM_SELF,1,"i=%D, is1 != is2",i);
}
}
}
/* Test MatCreateSubmatrices */
if (TestSubMat) {
if (test_sorted) {
for (i = 0; i < nd; ++i) {
ierr = ISSort(is1[i]);CHKERRQ(ierr);
}
}
ierr = MatCreateSubMatrices(A,nd,is1,is1,MAT_INITIAL_MATRIX,&submatA);CHKERRQ(ierr);
ierr = MatCreateSubMatrices(sA,nd,is1,is1,MAT_INITIAL_MATRIX,&submatsA);CHKERRQ(ierr);
ierr = MatMultEqual(A,sA,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"A != sA");
/* Now test MatCreateSubmatrices with MAT_REUSE_MATRIX option */
ierr = MatCreateSubMatrices(A,nd,is1,is1,MAT_REUSE_MATRIX,&submatA);CHKERRQ(ierr);
ierr = MatCreateSubMatrices(sA,nd,is1,is1,MAT_REUSE_MATRIX,&submatsA);CHKERRQ(ierr);
ierr = MatMultEqual(A,sA,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"MatCreateSubmatrices(): A != sA");
ierr = MatDestroySubMatrices(nd,&submatA);CHKERRQ(ierr);
ierr = MatDestroySubMatrices(nd,&submatsA);CHKERRQ(ierr);
}
/* Free allocated memory */
for (i=0; i<nd; ++i) {
ierr = ISDestroy(&is1[i]);CHKERRQ(ierr);
ierr = ISDestroy(&is2[i]);CHKERRQ(ierr);
}
ierr = PetscFree(is1);CHKERRQ(ierr);
ierr = PetscFree(is2);CHKERRQ(ierr);
ierr = PetscFree(idx);CHKERRQ(ierr);
ierr = PetscFree(rows);CHKERRQ(ierr);
ierr = PetscFree(cols);CHKERRQ(ierr);
ierr = PetscFree(vals);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&sA);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
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);
}
PetscErrorCode MatCholeskyFactorNumeric_SeqAIJ_Bas(Mat B,Mat A,const MatFactorInfo *info)
{
Mat C = B;
Mat_SeqSBAIJ *b=(Mat_SeqSBAIJ*)C->data;
IS ip=b->row,iip = b->icol;
PetscErrorCode ierr;
const PetscInt *rip,*riip;
PetscInt mbs=A->rmap->n,*bi=b->i,*bj=b->j;
MatScalar *ba = b->a;
PetscReal shiftnz = info->shiftamount;
PetscReal droptol = -1;
PetscBool perm_identity;
spbas_matrix Pattern, matrix_L,matrix_LT;
PetscReal mem_reduction;
PetscFunctionBegin;
/* Reduce memory requirements: erase values of B-matrix */
ierr = PetscFree(ba);CHKERRQ(ierr);
/* Compress (maximum) sparseness pattern of B-matrix */
ierr = spbas_compress_pattern(bi, bj, mbs, mbs, SPBAS_DIAGONAL_OFFSETS,&Pattern, &mem_reduction);CHKERRQ(ierr);
ierr = PetscFree(bi);CHKERRQ(ierr);
ierr = PetscFree(bj);CHKERRQ(ierr);
ierr = PetscInfo1(NULL," compression rate for spbas_compress_pattern %g \n",(double)mem_reduction);CHKERRQ(ierr);
/* Make Cholesky decompositions with larger Manteuffel shifts until no more negative diagonals are found. */
ierr = ISGetIndices(ip,&rip);CHKERRQ(ierr);
ierr = ISGetIndices(iip,&riip);CHKERRQ(ierr);
if (info->usedt) {
droptol = info->dt;
}
for (ierr = NEGATIVE_DIAGONAL; ierr == NEGATIVE_DIAGONAL;)
{
ierr = spbas_incomplete_cholesky(A, rip, riip, Pattern, droptol, shiftnz,&matrix_LT);CHKERRQ(ierr);
if (ierr == NEGATIVE_DIAGONAL) {
shiftnz *= 1.5;
if (shiftnz < 1e-5) shiftnz=1e-5;
ierr = PetscInfo1(NULL,"spbas_incomplete_cholesky found a negative diagonal. Trying again with Manteuffel shift=%g\n",(double)shiftnz);CHKERRQ(ierr);
}
}
ierr = spbas_delete(Pattern);CHKERRQ(ierr);
ierr = PetscInfo1(NULL," memory_usage for spbas_incomplete_cholesky %g bytes per row\n", (double)(PetscReal) (spbas_memory_requirement(matrix_LT)/ (PetscReal) mbs));CHKERRQ(ierr);
ierr = ISRestoreIndices(ip,&rip);CHKERRQ(ierr);
ierr = ISRestoreIndices(iip,&riip);CHKERRQ(ierr);
/* Convert spbas_matrix to compressed row storage */
ierr = spbas_transpose(matrix_LT, &matrix_L);CHKERRQ(ierr);
ierr = spbas_delete(matrix_LT);CHKERRQ(ierr);
ierr = spbas_matrix_to_crs(matrix_L, &ba, &bi, &bj);CHKERRQ(ierr);
b->i =bi; b->j=bj; b->a=ba;
ierr = spbas_delete(matrix_L);CHKERRQ(ierr);
/* Set the appropriate solution functions */
ierr = ISIdentity(ip,&perm_identity);CHKERRQ(ierr);
if (perm_identity) {
(B)->ops->solve = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
(B)->ops->solvetranspose = MatSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
(B)->ops->forwardsolve = MatForwardSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
(B)->ops->backwardsolve = MatBackwardSolve_SeqSBAIJ_1_NaturalOrdering_inplace;
} else {
(B)->ops->solve = MatSolve_SeqSBAIJ_1_inplace;
(B)->ops->solvetranspose = MatSolve_SeqSBAIJ_1_inplace;
(B)->ops->forwardsolve = MatForwardSolve_SeqSBAIJ_1_inplace;
(B)->ops->backwardsolve = MatBackwardSolve_SeqSBAIJ_1_inplace;
}
C->assembled = PETSC_TRUE;
C->preallocated = PETSC_TRUE;
ierr = PetscLogFlops(C->rmap->n);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void PETSC_STDCALL isidentity_(IS is,PetscBool *ident, int *__ierr ){
*__ierr = ISIdentity(
(IS)PetscToPointer((is) ),ident);
}
PetscErrorCode MatIncreaseOverlap_MPISBAIJ(Mat C,PetscInt is_max,IS is[],PetscInt ov)
{
PetscErrorCode ierr;
PetscInt i,N=C->cmap->N, bs=C->rmap->bs,M=C->rmap->N,Mbs=M/bs,*nidx,isz,iov;
IS *is_new,*is_row;
Mat *submats;
Mat_MPISBAIJ *c=(Mat_MPISBAIJ*)C->data;
Mat_SeqSBAIJ *asub_i;
PetscBT table;
PetscInt *ai,brow,nz,nis,l,nmax,nstages_local,nstages,max_no,pos;
const PetscInt *idx;
PetscBool flg,*allcolumns,*allrows;
PetscFunctionBegin;
ierr = PetscMalloc1(is_max,&is_new);
CHKERRQ(ierr);
/* Convert the indices into block format */
ierr = ISCompressIndicesGeneral(N,C->rmap->n,bs,is_max,is,is_new);
CHKERRQ(ierr);
if (ov < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative overlap specified\n");
/* ----- previous non-scalable implementation ----- */
flg = PETSC_FALSE;
ierr = PetscOptionsHasName(NULL,NULL, "-IncreaseOverlap_old", &flg);
CHKERRQ(ierr);
if (flg) { /* previous non-scalable implementation */
printf("use previous non-scalable implementation...\n");
for (i=0; i<ov; ++i) {
ierr = MatIncreaseOverlap_MPISBAIJ_Once(C,is_max,is_new);
CHKERRQ(ierr);
}
} else { /* implementation using modified BAIJ routines */
ierr = PetscMalloc1(Mbs+1,&nidx);
CHKERRQ(ierr);
ierr = PetscBTCreate(Mbs,&table);
CHKERRQ(ierr); /* for column search */
ierr = PetscMalloc2(is_max+1,&allcolumns,is_max+1,&allrows);
CHKERRQ(ierr);
/* Create is_row */
ierr = PetscMalloc1(is_max,&is_row);
CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,Mbs,0,1,&is_row[0]);
CHKERRQ(ierr);
allrows[0] = PETSC_TRUE;
for (i=1; i<is_max; i++) {
is_row[i] = is_row[0]; /* reuse is_row[0] */
allrows[i] = PETSC_TRUE;
}
/* Allocate memory to hold all the submatrices - Modified from MatGetSubMatrices_MPIBAIJ() */
ierr = PetscMalloc1(is_max+1,&submats);
CHKERRQ(ierr);
/* Check for special case: each processor gets entire matrix columns */
for (i=0; i<is_max; i++) {
ierr = ISIdentity(is_new[i],&flg);
CHKERRQ(ierr);
ierr = ISGetLocalSize(is_new[i],&isz);
CHKERRQ(ierr);
if (flg && isz == Mbs) {
allcolumns[i] = PETSC_TRUE;
} else {
allcolumns[i] = PETSC_FALSE;
}
}
/* Determine the number of stages through which submatrices are done */
nmax = 20*1000000 / (c->Nbs * sizeof(PetscInt));
if (!nmax) nmax = 1;
nstages_local = is_max/nmax + ((is_max % nmax) ? 1 : 0);
/* Make sure every processor loops through the nstages */
ierr = MPIU_Allreduce(&nstages_local,&nstages,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)C));
CHKERRQ(ierr);
for (iov=0; iov<ov; ++iov) {
/* 1) Get submats for column search */
for (i=0,pos=0; i<nstages; i++) {
if (pos+nmax <= is_max) max_no = nmax;
else if (pos == is_max) max_no = 0;
else max_no = is_max-pos;
c->ijonly = PETSC_TRUE;
ierr = MatGetSubMatrices_MPIBAIJ_local(C,max_no,is_row+pos,is_new+pos,MAT_INITIAL_MATRIX,allrows+pos,allcolumns+pos,submats+pos);
CHKERRQ(ierr);
pos += max_no;
}
/* 2) Row search */
ierr = MatIncreaseOverlap_MPIBAIJ_Once(C,is_max,is_new);
CHKERRQ(ierr);
/* 3) Column search */
for (i=0; i<is_max; i++) {
asub_i = (Mat_SeqSBAIJ*)submats[i]->data;
ai = asub_i->i;;
/* put is_new obtained from MatIncreaseOverlap_MPIBAIJ() to table */
ierr = PetscBTMemzero(Mbs,table);
CHKERRQ(ierr);
ierr = ISGetIndices(is_new[i],&idx);
CHKERRQ(ierr);
ierr = ISGetLocalSize(is_new[i],&nis);
CHKERRQ(ierr);
for (l=0; l<nis; l++) {
ierr = PetscBTSet(table,idx[l]);
CHKERRQ(ierr);
nidx[l] = idx[l];
}
isz = nis;
/* add column entries to table */
for (brow=0; brow<Mbs; brow++) {
nz = ai[brow+1] - ai[brow];
if (nz) {
if (!PetscBTLookupSet(table,brow)) nidx[isz++] = brow;
}
}
ierr = ISRestoreIndices(is_new[i],&idx);
CHKERRQ(ierr);
ierr = ISDestroy(&is_new[i]);
CHKERRQ(ierr);
/* create updated is_new */
ierr = ISCreateGeneral(PETSC_COMM_SELF,isz,nidx,PETSC_COPY_VALUES,is_new+i);
CHKERRQ(ierr);
}
/* Free tmp spaces */
for (i=0; i<is_max; i++) {
ierr = MatDestroy(&submats[i]);
CHKERRQ(ierr);
}
}
ierr = PetscFree2(allcolumns,allrows);
CHKERRQ(ierr);
ierr = PetscBTDestroy(&table);
CHKERRQ(ierr);
ierr = PetscFree(submats);
CHKERRQ(ierr);
ierr = ISDestroy(&is_row[0]);
CHKERRQ(ierr);
ierr = PetscFree(is_row);
CHKERRQ(ierr);
ierr = PetscFree(nidx);
CHKERRQ(ierr);
}
for (i=0; i<is_max; i++) {
ierr = ISDestroy(&is[i]);
CHKERRQ(ierr);
}
ierr = ISExpandIndicesGeneral(N,N,bs,is_max,is_new,is);
CHKERRQ(ierr);
for (i=0; i<is_max; i++) {
ierr = ISDestroy(&is_new[i]);
CHKERRQ(ierr);
}
ierr = PetscFree(is_new);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
