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); }