static PetscErrorCode DMDestroy_Sliced(DM dm)
{
PetscErrorCode ierr;
DM_Sliced *slice = (DM_Sliced*)dm->data;
PetscFunctionBegin;
ierr = PetscFree(slice->ghosts);CHKERRQ(ierr);
if (slice->dfill) {ierr = PetscFree3(slice->dfill,slice->dfill->i,slice->dfill->j);CHKERRQ(ierr);}
if (slice->ofill) {ierr = PetscFree3(slice->ofill,slice->ofill->i,slice->ofill->j);CHKERRQ(ierr);}
/* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
ierr = PetscFree(slice);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatCholeskyFactorSymbolic_CHOLMOD(Mat F,Mat A,IS perm,const MatFactorInfo *info)
{
Mat_CHOLMOD *chol = (Mat_CHOLMOD*)F->spptr;
PetscErrorCode ierr;
cholmod_sparse cholA;
PetscBool aijalloc;
PetscInt *fset = 0;
size_t fsize = 0;
PetscFunctionBegin;
ierr = (*chol->Wrap)(A,PETSC_FALSE,&cholA,&aijalloc);CHKERRQ(ierr);
static_F = F;
if (chol->factor) {
ierr = !cholmod_X_resymbol(&cholA,fset,fsize,(int)chol->pack,chol->factor,chol->common);
if (ierr) SETERRQ1(((PetscObject)F)->comm,PETSC_ERR_LIB,"CHOLMOD analysis failed with status %d",chol->common->status);
} else if (perm) {
const PetscInt *ip;
ierr = ISGetIndices(perm,&ip);CHKERRQ(ierr);
chol->factor = cholmod_X_analyze_p(&cholA,(PetscInt*)ip,fset,fsize,chol->common);
if (!chol->factor) SETERRQ1(((PetscObject)F)->comm,PETSC_ERR_LIB,"CHOLMOD analysis failed with status %d",chol->common->status);
ierr = ISRestoreIndices(perm,&ip);CHKERRQ(ierr);
} else {
chol->factor = cholmod_X_analyze(&cholA,chol->common);
if (!chol->factor) SETERRQ1(((PetscObject)F)->comm,PETSC_ERR_LIB,"CHOLMOD analysis failed with status %d",chol->common->status);
}
if (aijalloc) {ierr = PetscFree3(cholA.p,cholA.i,cholA.x);CHKERRQ(ierr);}
F->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_CHOLMOD;
PetscFunctionReturn(0);
}
PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Tetrahedron_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
{
PetscReal *v0, *J, *invJ, detJ;
PetscScalar *a, *coords;
PetscInt p;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscMalloc3(ctx->dim,&v0,ctx->dim*ctx->dim,&J,ctx->dim*ctx->dim,&invJ);CHKERRQ(ierr);
ierr = VecGetArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = VecGetArray(v, &a);CHKERRQ(ierr);
for (p = 0; p < ctx->n; ++p) {
PetscInt c = ctx->cells[p];
const PetscInt order[3] = {2, 1, 3};
PetscScalar *x = NULL;
PetscReal xi[4];
PetscInt d, f, comp;
ierr = DMPlexComputeCellGeometry(dm, c, v0, J, invJ, &detJ);CHKERRQ(ierr);
if (detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ, c);
ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] = x[0*ctx->dof+comp];
for (d = 0; d < ctx->dim; ++d) {
xi[d] = 0.0;
for (f = 0; f < ctx->dim; ++f) xi[d] += invJ[d*ctx->dim+f]*0.5*PetscRealPart(coords[p*ctx->dim+f] - v0[f]);
for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] += PetscRealPart(x[order[d]*ctx->dof+comp] - x[0*ctx->dof+comp])*xi[d];
}
ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
}
ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
ierr = VecRestoreArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = PetscFree3(v0, J, invJ);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscViewerRestoreSingleton_Draw(PetscViewer viewer,PetscViewer *sviewer)
{
PetscErrorCode ierr;
PetscMPIInt rank;
PetscInt i;
PetscViewer_Draw *vdraw = (PetscViewer_Draw *)viewer->data,*vsdraw;
PetscFunctionBegin;
if (!vdraw->singleton_made) {
SETERRQ(PETSC_ERR_ORDER,"Trying to restore a singleton that was not gotten");
}
ierr = MPI_Comm_rank(((PetscObject)viewer)->comm,&rank);CHKERRQ(ierr);
if (!rank) {
vsdraw = (PetscViewer_Draw *)(*sviewer)->data;
for (i=0; i<vdraw->draw_max; i++) {
if (vdraw->draw[i] && vsdraw->draw[i]) {
ierr = PetscDrawRestoreSingleton(vdraw->draw[i],&vsdraw->draw[i]);CHKERRQ(ierr);
}
}
ierr = PetscFree3(vsdraw->draw,vsdraw->drawlg,vsdraw->drawaxis);CHKERRQ(ierr);
ierr = PetscFree((*sviewer)->data);CHKERRQ(ierr);
ierr = PetscHeaderDestroy(*sviewer);CHKERRQ(ierr);
}
vdraw->singleton_made = PETSC_FALSE;
PetscFunctionReturn(0);
}
/*
MatGetOrdering_RCM - Find the Reverse Cuthill-McKee ordering of a given matrix.
*/
PETSC_INTERN PetscErrorCode MatGetOrdering_RCM(Mat mat,MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i,*mask,*xls,nrow,*perm;
const PetscInt *ia,*ja;
PetscBool done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);
CHKERRQ(ierr);
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc3(nrow,&mask,nrow,&perm,2*nrow,&xls);
CHKERRQ(ierr);
SPARSEPACKgenrcm(&nrow,ia,ja,perm,mask,xls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,NULL,&ia,&ja,&done);
CHKERRQ(ierr);
/* shift because Sparsepack indices start at one */
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,row);
CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);
CHKERRQ(ierr);
ierr = PetscFree3(mask,perm,xls);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Check whether a was created via MPI_Type_contiguous from b
*
*/
PetscErrorCode MPIPetsc_Type_compare_contig(MPI_Datatype a,MPI_Datatype b,PetscInt *n)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype);CHKERRQ(ierr);
*n = PETSC_FALSE;
if (atype == btype) {
*n = 1;
PetscFunctionReturn(0);
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
if (acombiner == MPI_COMBINER_CONTIGUOUS && aintcount >= 1) {
PetscMPIInt *aints;
MPI_Aint *aaddrs;
MPI_Datatype *atypes;
ierr = PetscMalloc3(aintcount,&aints,aaddrcount,&aaddrs,atypecount,&atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
if (atypes[0] == btype) *n = aints[0];
ierr = PetscFree3(aints,aaddrs,atypes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatDestroy_LUSOL(Mat A)
{
PetscErrorCode ierr;
Mat_LUSOL *lusol=(Mat_LUSOL*)A->spptr;
PetscFunctionBegin;
if (lusol && lusol->CleanUpLUSOL) {
ierr = PetscFree(lusol->ip);CHKERRQ(ierr);
ierr = PetscFree(lusol->iq);CHKERRQ(ierr);
ierr = PetscFree(lusol->lenc);CHKERRQ(ierr);
ierr = PetscFree(lusol->lenr);CHKERRQ(ierr);
ierr = PetscFree(lusol->locc);CHKERRQ(ierr);
ierr = PetscFree(lusol->locr);CHKERRQ(ierr);
ierr = PetscFree(lusol->iploc);CHKERRQ(ierr);
ierr = PetscFree(lusol->iqloc);CHKERRQ(ierr);
ierr = PetscFree(lusol->ipinv);CHKERRQ(ierr);
ierr = PetscFree(lusol->iqinv);CHKERRQ(ierr);
ierr = PetscFree(lusol->mnsw);CHKERRQ(ierr);
ierr = PetscFree(lusol->mnsv);CHKERRQ(ierr);
ierr = PetscFree3(lusol->data,lusol->indc,lusol->indr);CHKERRQ(ierr);
}
ierr = PetscFree(A->spptr);CHKERRQ(ierr);
ierr = MatDestroy_SeqAIJ(A);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMRefineHierarchy_DA(DM da,PetscInt nlevels,DM daf[])
{
PetscErrorCode ierr;
PetscInt i,n,*refx,*refy,*refz;
PetscFunctionBegin;
PetscValidHeaderSpecific(da,DM_CLASSID,1);
if (nlevels < 0) SETERRQ(((PetscObject)da)->comm,PETSC_ERR_ARG_OUTOFRANGE,"nlevels cannot be negative");
if (nlevels == 0) PetscFunctionReturn(0);
PetscValidPointer(daf,3);
/* Get refinement factors, defaults taken from the coarse DMDA */
ierr = PetscMalloc3(nlevels,PetscInt,&refx,nlevels,PetscInt,&refy,nlevels,PetscInt,&refz);CHKERRQ(ierr);
for (i=0; i<nlevels; i++) {
ierr = DMDAGetRefinementFactor(da,&refx[i],&refy[i],&refz[i]);CHKERRQ(ierr);
}
n = nlevels;
ierr = PetscOptionsGetIntArray(((PetscObject)da)->prefix,"-da_refine_hierarchy_x",refx,&n,PETSC_NULL);CHKERRQ(ierr);
n = nlevels;
ierr = PetscOptionsGetIntArray(((PetscObject)da)->prefix,"-da_refine_hierarchy_y",refy,&n,PETSC_NULL);CHKERRQ(ierr);
n = nlevels;
ierr = PetscOptionsGetIntArray(((PetscObject)da)->prefix,"-da_refine_hierarchy_z",refz,&n,PETSC_NULL);CHKERRQ(ierr);
ierr = DMDASetRefinementFactor(da,refx[0],refy[0],refz[0]);CHKERRQ(ierr);
ierr = DMRefine(da,((PetscObject)da)->comm,&daf[0]);CHKERRQ(ierr);
for (i=1; i<nlevels; i++) {
ierr = DMDASetRefinementFactor(daf[i-1],refx[i],refy[i],refz[i]);CHKERRQ(ierr);
ierr = DMRefine(daf[i-1],((PetscObject)da)->comm,&daf[i]);CHKERRQ(ierr);
}
ierr = PetscFree3(refx,refy,refz);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SlicedDestroy - Destroys a vector slice.
Collective on Sliced
Input Parameter:
. slice - the slice object
Level: advanced
.seealso SlicedCreate(), SlicedCreateGlobalVector(), SlicedGetGlobalIndices()
@*/
PetscErrorCode PETSCDM_DLLEXPORT SlicedDestroy(Sliced slice)
{
PetscErrorCode ierr;
PetscTruth done;
PetscFunctionBegin;
ierr = DMDestroy_Private((DM)slice,&done);CHKERRQ(ierr);
if (!done) PetscFunctionReturn(0);
if (slice->globalvector) {ierr = VecDestroy(slice->globalvector);CHKERRQ(ierr);}
ierr = PetscFree(slice->ghosts);CHKERRQ(ierr);
if (slice->dfill) {ierr = PetscFree3(slice->dfill,slice->dfill->i,slice->dfill->j);CHKERRQ(ierr);}
if (slice->ofill) {ierr = PetscFree3(slice->ofill,slice->ofill->i,slice->ofill->j);CHKERRQ(ierr);}
ierr = PetscHeaderDestroy(slice);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPDestroy_PIPEFCG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i;
KSP_PIPEFCG *pipefcg;
PetscFunctionBegin;
pipefcg = (KSP_PIPEFCG*)ksp->data;
/* Destroy "standard" work vecs */
VecDestroyVecs(ksp->nwork,&ksp->work);
/* Destroy vectors of old directions and the arrays that manage pointers to them */
if(pipefcg->nvecs){
for(i=0;i<pipefcg->nchunks;++i){
ierr = VecDestroyVecs(pipefcg->chunksizes[i],&pipefcg->pPvecs[i]);CHKERRQ(ierr);
ierr = VecDestroyVecs(pipefcg->chunksizes[i],&pipefcg->pSvecs[i]);CHKERRQ(ierr);
ierr = VecDestroyVecs(pipefcg->chunksizes[i],&pipefcg->pQvecs[i]);CHKERRQ(ierr);
ierr = VecDestroyVecs(pipefcg->chunksizes[i],&pipefcg->pZETAvecs[i]);CHKERRQ(ierr);
}
}
ierr = PetscFree4(pipefcg->Pvecs,pipefcg->Svecs,pipefcg->pPvecs,pipefcg->pSvecs);CHKERRQ(ierr);
ierr = PetscFree4(pipefcg->Qvecs,pipefcg->ZETAvecs,pipefcg->pQvecs,pipefcg->pZETAvecs);CHKERRQ(ierr);
ierr = PetscFree4(pipefcg->Pold,pipefcg->Sold,pipefcg->Qold,pipefcg->ZETAold);CHKERRQ(ierr);
ierr = PetscFree(pipefcg->chunksizes);CHKERRQ(ierr);
ierr = PetscFree3(pipefcg->dots,pipefcg->etas,pipefcg->redux);CHKERRQ(ierr);
ierr = KSPDestroyDefault(ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
/*
MatOrdering_RCM - Find the Reverse Cuthill-McKee ordering of a given matrix.
*/
#undef __FUNCT__
#define __FUNCT__ "MatOrdering_RCM"
PetscErrorCode PETSCMAT_DLLEXPORT MatOrdering_RCM(Mat mat,const MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i,*mask,*xls,nrow,*ia,*ja,*perm;
PetscTruth done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc3(nrow,PetscInt,&mask,nrow,PetscInt,&perm,2*nrow,PetscInt,&xls);CHKERRQ(ierr);
SPARSEPACKgenrcm(&nrow,ia,ja,perm,mask,xls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
/* shift because Sparsepack indices start at one */
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,col);CHKERRQ(ierr);
ierr = PetscFree3(mask,perm,xls);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* collective on KSP */
PetscErrorCode KSPPlotEigenContours_Private(KSP ksp,PetscInt neig,const PetscReal *r,const PetscReal *c)
{
PetscErrorCode ierr;
PetscReal xmin,xmax,ymin,ymax,*xloc,*yloc,*value,px0,py0,rscale,iscale;
PetscInt M,N,i,j;
PetscMPIInt rank;
PetscViewer viewer;
PetscDraw draw;
PetscDrawAxis drawaxis;
PetscFunctionBegin;
ierr = MPI_Comm_rank(((PetscObject)ksp)->comm,&rank);CHKERRQ(ierr);
if (rank) PetscFunctionReturn(0);
M = 80;
N = 80;
xmin = r[0]; xmax = r[0];
ymin = c[0]; ymax = c[0];
for (i=1; i<neig; i++) {
xmin = PetscMin(xmin,r[i]);
xmax = PetscMax(xmax,r[i]);
ymin = PetscMin(ymin,c[i]);
ymax = PetscMax(ymax,c[i]);
}
ierr = PetscMalloc3(M,PetscReal,&xloc,N,PetscReal,&yloc,M*N,PetscReal,&value);CHKERRQ(ierr);
for (i=0; i<M; i++) xloc[i] = xmin - 0.1*(xmax-xmin) + 1.2*(xmax-xmin)*i/(M-1);
for (i=0; i<N; i++) yloc[i] = ymin - 0.1*(ymax-ymin) + 1.2*(ymax-ymin)*i/(N-1);
ierr = PolyEval(neig,r,c,0,0,&px0,&py0);CHKERRQ(ierr);
rscale = px0/(PetscSqr(px0)+PetscSqr(py0));
iscale = -py0/(PetscSqr(px0)+PetscSqr(py0));
for (j=0; j<N; j++) {
for (i=0; i<M; i++) {
PetscReal px,py,tx,ty,tmod;
ierr = PolyEval(neig,r,c,xloc[i],yloc[j],&px,&py);CHKERRQ(ierr);
tx = px*rscale - py*iscale;
ty = py*rscale + px*iscale;
tmod = PetscSqr(tx) + PetscSqr(ty); /* modulus of the complex polynomial */
if (tmod > 1) tmod = 1.0;
if (tmod > 0.5 && tmod < 1) tmod = 0.5;
if (tmod > 0.2 && tmod < 0.5) tmod = 0.2;
if (tmod > 0.05 && tmod < 0.2) tmod = 0.05;
if (tmod < 1e-3) tmod = 1e-3;
value[i+j*M] = PetscLogScalar(tmod) / PetscLogScalar(10.0);
}
}
ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Iteratively Computed Eigen-contours",PETSC_DECIDE,PETSC_DECIDE,450,450,&viewer);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawTensorContour(draw,M,N,PETSC_NULL,PETSC_NULL,value);CHKERRQ(ierr);
if (0) {
ierr = PetscDrawAxisCreate(draw,&drawaxis);CHKERRQ(ierr);
ierr = PetscDrawAxisSetLimits(drawaxis,xmin,xmax,ymin,ymax);CHKERRQ(ierr);
ierr = PetscDrawAxisSetLabels(drawaxis,"Eigen-counters","real","imag");CHKERRQ(ierr);
ierr = PetscDrawAxisDraw(drawaxis);CHKERRQ(ierr);
ierr = PetscDrawAxisDestroy(&drawaxis);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscFree3(xloc,yloc,value);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode BuildGradientReconstruction(DM dm, PetscFV fvm, DM dmFace, PetscScalar *fgeom, DM dmCell, PetscScalar *cgeom)
{
DMLabel ghostLabel;
PetscScalar *dx, *grad, **gref;
PetscInt dim, cStart, cEnd, c, cEndInterior, maxNumFaces;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
ierr = DMPlexGetMaxSizes(dm, &maxNumFaces, NULL);CHKERRQ(ierr);
ierr = PetscFVLeastSquaresSetMaxFaces(fvm, maxNumFaces);CHKERRQ(ierr);
ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
ierr = PetscMalloc3(maxNumFaces*dim, &dx, maxNumFaces*dim, &grad, maxNumFaces, &gref);CHKERRQ(ierr);
for (c = cStart; c < cEndInterior; c++) {
const PetscInt *faces;
PetscInt numFaces, usedFaces, f, d;
const CellGeom *cg;
PetscBool boundary;
PetscInt ghost;
ierr = DMPlexPointLocalRead(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
ierr = DMPlexGetConeSize(dm, c, &numFaces);CHKERRQ(ierr);
ierr = DMPlexGetCone(dm, c, &faces);CHKERRQ(ierr);
if (numFaces < dim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cell %D has only %D faces, not enough for gradient reconstruction", c, numFaces);
for (f = 0, usedFaces = 0; f < numFaces; ++f) {
const CellGeom *cg1;
FaceGeom *fg;
const PetscInt *fcells;
PetscInt ncell, side;
ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
ierr = DMPlexIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
if ((ghost >= 0) || boundary) continue;
ierr = DMPlexGetSupport(dm, faces[f], &fcells);CHKERRQ(ierr);
side = (c != fcells[0]); /* c is on left=0 or right=1 of face */
ncell = fcells[!side]; /* the neighbor */
ierr = DMPlexPointLocalRef(dmFace, faces[f], fgeom, &fg);CHKERRQ(ierr);
ierr = DMPlexPointLocalRead(dmCell, ncell, cgeom, &cg1);CHKERRQ(ierr);
for (d = 0; d < dim; ++d) dx[usedFaces*dim+d] = cg1->centroid[d] - cg->centroid[d];
gref[usedFaces++] = fg->grad[side]; /* Gradient reconstruction term will go here */
}
if (!usedFaces) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Mesh contains isolated cell (no neighbors). Is it intentional?");
ierr = PetscFVComputeGradient(fvm, usedFaces, dx, grad);CHKERRQ(ierr);
for (f = 0, usedFaces = 0; f < numFaces; ++f) {
ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
ierr = DMPlexIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
if ((ghost >= 0) || boundary) continue;
for (d = 0; d < dim; ++d) gref[usedFaces][d] = grad[usedFaces*dim+d];
++usedFaces;
}
}
ierr = PetscFree3(dx, grad, gref);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_CP(PC pc)
{
PC_CP *cp = (PC_CP*)pc->data;
PetscInt i,j,*colcnt;
PetscErrorCode ierr;
PetscTruth flg;
Mat_SeqAIJ *aij = (Mat_SeqAIJ*)pc->pmat->data;
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)pc->pmat,MATSEQAIJ,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_ERR_SUP,"Currently only handles SeqAIJ matrices");
ierr = MatGetLocalSize(pc->pmat,&cp->m,&cp->n);CHKERRQ(ierr);
if (cp->m != cp->n) SETERRQ(PETSC_ERR_SUP,"Currently only for square matrices");
if (!cp->work) {ierr = MatGetVecs(pc->pmat,&cp->work,PETSC_NULL);CHKERRQ(ierr);}
if (!cp->d) {ierr = PetscMalloc(cp->n*sizeof(PetscScalar),&cp->d);CHKERRQ(ierr);}
if (cp->a && pc->flag != SAME_NONZERO_PATTERN) {
ierr = PetscFree3(cp->a,cp->i,cp->j);CHKERRQ(ierr);
cp->a = 0;
}
/* convert to column format */
if (!cp->a) {
ierr = PetscMalloc3(aij->nz,PetscScalar,&cp->a,cp->n+1,PetscInt,&cp->i,aij->nz,PetscInt,&cp->j);CHKERRQ(ierr);
}
ierr = PetscMalloc(cp->n*sizeof(PetscInt),&colcnt);CHKERRQ(ierr);
ierr = PetscMemzero(colcnt,cp->n*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<aij->nz; i++) {
colcnt[aij->j[i]]++;
}
cp->i[0] = 0;
for (i=0; i<cp->n; i++) {
cp->i[i+1] = cp->i[i] + colcnt[i];
}
ierr = PetscMemzero(colcnt,cp->n*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<cp->m; i++) { /* over rows */
for (j=aij->i[i]; j<aij->i[i+1]; j++) { /* over columns in row */
cp->j[cp->i[aij->j[j]]+colcnt[aij->j[j]]] = i;
cp->a[cp->i[aij->j[j]]+colcnt[aij->j[j]]++] = aij->a[j];
}
}
ierr = PetscFree(colcnt);CHKERRQ(ierr);
/* compute sum of squares of each column d[] */
for (i=0; i<cp->n; i++) { /* over columns */
cp->d[i] = 0.;
for (j=cp->i[i]; j<cp->i[i+1]; j++) { /* over rows in column */
cp->d[i] += cp->a[j]*cp->a[j];
}
cp->d[i] = 1.0/cp->d[i];
}
PetscFunctionReturn(0);
}
static PetscErrorCode PCReset_CP(PC pc)
{
PC_CP *cp = (PC_CP*)pc->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscFree(cp->d);CHKERRQ(ierr);
ierr = VecDestroy(&cp->work);CHKERRQ(ierr);
ierr = PetscFree3(cp->a,cp->i,cp->j);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMLabelDestroy(DMLabel *label)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (--(*label)->refct > 0) {PetscFunctionReturn(0);}
ierr = PetscFree((*label)->name);CHKERRQ(ierr);
ierr = PetscFree3((*label)->stratumValues,(*label)->stratumOffsets,(*label)->stratumSizes);CHKERRQ(ierr);
ierr = PetscFree((*label)->points);CHKERRQ(ierr);
ierr = PetscFree(*label);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscFEGeomDestroy(PetscFEGeom **geom)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!*geom) PetscFunctionReturn(0);
ierr = PetscFree3((*geom)->v,(*geom)->J,(*geom)->detJ);CHKERRQ(ierr);
ierr = PetscFree((*geom)->invJ);CHKERRQ(ierr);
ierr = PetscFree4((*geom)->face,(*geom)->n,(*geom)->suppInvJ[0],(*geom)->suppInvJ[1]);CHKERRQ(ierr);
ierr = PetscFree(*geom);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESReset_QN(SNES snes)
{
PetscErrorCode ierr;
SNES_QN *qn;
PetscFunctionBegin;
if (snes->data) {
qn = (SNES_QN*)snes->data;
if (qn->U) {
ierr = VecDestroyVecs(qn->m, &qn->U);CHKERRQ(ierr);
}
if (qn->V) {
ierr = VecDestroyVecs(qn->m, &qn->V);CHKERRQ(ierr);
}
if (qn->singlereduction) {
ierr = PetscFree3(qn->dXdFmat, qn->dFtdX, qn->YtdX);CHKERRQ(ierr);
}
ierr = PetscFree3(qn->alpha, qn->beta, qn->dXtdF);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatDestroy_SeqSBSTRM(Mat A)
{
PetscErrorCode ierr;
Mat_SeqSBSTRM *sbstrm = (Mat_SeqSBSTRM*) A->spptr;
if (sbstrm) {
ierr = PetscFree3(sbstrm->as, sbstrm->asi, sbstrm->asj);CHKERRQ(ierr);
}
ierr = PetscObjectChangeTypeName((PetscObject)A, MATSEQSBAIJ);CHKERRQ(ierr);
ierr = MatDestroy_SeqSBAIJ(A);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscViewerDrawGetDraw - Returns PetscDraw object from PetscViewer object.
This PetscDraw object may then be used to perform graphics using
PetscDrawXXX() commands.
Collective on PetscViewer
Input Parameters:
+ viewer - the PetscViewer (created with PetscViewerDrawOpen())
- windownumber - indicates which subwindow (usually 0)
Ouput Parameter:
. draw - the draw object
Level: intermediate
Concepts: drawing^accessing PetscDraw context from PetscViewer
Concepts: graphics
.seealso: PetscViewerDrawGetLG(), PetscViewerDrawGetAxis(), PetscViewerDrawOpen()
@*/
PetscErrorCode PetscViewerDrawGetDraw(PetscViewer viewer,PetscInt windownumber,PetscDraw *draw)
{
PetscViewer_Draw *vdraw;
PetscErrorCode ierr;
PetscBool isdraw;
PetscFunctionBegin;
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,1);
PetscValidLogicalCollectiveInt(viewer,windownumber,2);
if (draw) PetscValidPointer(draw,3);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
if (!isdraw) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Must be draw type PetscViewer");
if (windownumber < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Window number cannot be negative");
vdraw = (PetscViewer_Draw*)viewer->data;
windownumber += vdraw->draw_base;
if (windownumber >= vdraw->draw_max) {
/* allocate twice as many slots as needed */
PetscInt draw_max = vdraw->draw_max;
PetscDraw *tdraw = vdraw->draw;
PetscDrawLG *drawlg = vdraw->drawlg;
PetscDrawAxis *drawaxis = vdraw->drawaxis;
vdraw->draw_max = 2*windownumber;
ierr = PetscCalloc3(vdraw->draw_max,&vdraw->draw,vdraw->draw_max,&vdraw->drawlg,vdraw->draw_max,&vdraw->drawaxis);CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->draw,tdraw,draw_max*sizeof(PetscDraw));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->drawlg,drawlg,draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->drawaxis,drawaxis,draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr);
ierr = PetscFree3(tdraw,drawlg,drawaxis);CHKERRQ(ierr);
}
if (!vdraw->draw[windownumber]) {
char *title = vdraw->title, tmp_str[128];
if (windownumber) {
ierr = PetscSNPrintf(tmp_str,sizeof(tmp_str),"%s:%d",vdraw->title?vdraw->title:"",windownumber);CHKERRQ(ierr);
title = tmp_str;
}
ierr = PetscDrawCreate(PetscObjectComm((PetscObject)viewer),vdraw->display,title,PETSC_DECIDE,PETSC_DECIDE,vdraw->w,vdraw->h,&vdraw->draw[windownumber]);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)viewer,(PetscObject)vdraw->draw[windownumber]);CHKERRQ(ierr);
if (vdraw->drawtype) {
ierr = PetscDrawSetType(vdraw->draw[windownumber],vdraw->drawtype);CHKERRQ(ierr);
}
ierr = PetscDrawSetPause(vdraw->draw[windownumber],vdraw->pause);CHKERRQ(ierr);
ierr = PetscDrawSetOptionsPrefix(vdraw->draw[windownumber],((PetscObject)viewer)->prefix);CHKERRQ(ierr);
ierr = PetscDrawSetFromOptions(vdraw->draw[windownumber]);CHKERRQ(ierr);
}
if (draw) *draw = vdraw->draw[windownumber];
if (draw) PetscValidHeaderSpecific(*draw,PETSC_DRAW_CLASSID,-1);
PetscFunctionReturn(0);
}
PetscErrorCode MatDestroy_SeqAIJ_Inode(Mat A)
{
PetscErrorCode ierr;
Mat_SeqAIJ *a=(Mat_SeqAIJ*)A->data;
PetscFunctionBegin;
ierr = PetscFree(a->inode.size);CHKERRQ(ierr);
ierr = PetscFree3(a->inode.ibdiag,a->inode.bdiag,a->inode.ssor_work);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)A,"MatInodeAdjustForInodes_C",NULL);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)A,"MatInodeGetInodeSizes_C",NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscViewerDrawGetDraw - Returns PetscDraw object from PetscViewer object.
This PetscDraw object may then be used to perform graphics using
PetscDrawXXX() commands.
Not collective (but PetscDraw returned will be parallel object if PetscViewer is)
Input Parameters:
+ viewer - the PetscViewer (created with PetscViewerDrawOpen())
- windownumber - indicates which subwindow (usually 0)
Ouput Parameter:
. draw - the draw object
Level: intermediate
Concepts: drawing^accessing PetscDraw context from PetscViewer
Concepts: graphics
.seealso: PetscViewerDrawGetLG(), PetscViewerDrawGetAxis(), PetscViewerDrawOpen()
@*/
PetscErrorCode PETSC_DLLEXPORT PetscViewerDrawGetDraw(PetscViewer viewer,PetscInt windownumber,PetscDraw *draw)
{
PetscViewer_Draw *vdraw = (PetscViewer_Draw*)viewer->data;
PetscErrorCode ierr;
PetscTruth isdraw;
char *title;
PetscFunctionBegin;
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,1);
if (draw) PetscValidPointer(draw,3);
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);CHKERRQ(ierr);
if (!isdraw) {
SETERRQ(PETSC_ERR_ARG_WRONG,"Must be draw type PetscViewer");
}
if (windownumber < 0) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Window number cannot be negative");
}
windownumber += vdraw->draw_base;
if (windownumber >= vdraw->draw_max) {
/* allocate twice as many slots as needed */
PetscInt draw_max = vdraw->draw_max;
PetscDraw *tdraw = vdraw->draw;
PetscDrawLG *drawlg = vdraw->drawlg;
PetscDrawAxis *drawaxis = vdraw->drawaxis;
vdraw->draw_max = 2*windownumber;
ierr = PetscMalloc3(vdraw->draw_max,PetscDraw,&vdraw->draw,vdraw->draw_max,PetscDrawLG,&vdraw->drawlg,vdraw->draw_max,PetscDrawAxis,&vdraw->drawaxis);CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->draw,vdraw->draw_max*sizeof(PetscDraw));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawlg,vdraw->draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawaxis,vdraw->draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->draw,tdraw,draw_max*sizeof(PetscDraw));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->drawlg,drawlg,draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->drawaxis,drawaxis,draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr);
ierr = PetscFree3(tdraw,drawlg,drawaxis);CHKERRQ(ierr);
}
if (!vdraw->draw[windownumber]) {
if (!windownumber) {
title = vdraw->title;
} else {
char tmp_str[128];
ierr = PetscSNPrintf(tmp_str, 128, "%s:%d", vdraw->title,windownumber);CHKERRQ(ierr);
title = tmp_str;
}
ierr = PetscDrawCreate(((PetscObject)viewer)->comm,vdraw->display,title,PETSC_DECIDE,PETSC_DECIDE,vdraw->w,vdraw->h,&vdraw->draw[windownumber]);CHKERRQ(ierr);
ierr = PetscDrawSetFromOptions(vdraw->draw[windownumber]);CHKERRQ(ierr);
}
if (draw) *draw = vdraw->draw[windownumber];
PetscFunctionReturn(0);
}
PetscErrorCode PetscMatStashSpaceDestroy(PetscMatStashSpace *space)
{
PetscMatStashSpace a;
PetscErrorCode ierr;
PetscFunctionBegin;
while (*space) {
a = (*space)->next;
ierr = PetscFree3((*space)->space_head,(*space)->idx,(*space)->idy);CHKERRQ(ierr);
ierr = PetscFree((*space));CHKERRQ(ierr);
*space = a;
}
*space = NULL;
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatGetOrdering_WBM(Mat mat, MatOrderingType type, IS *row, IS *col)
{
PetscScalar *a, *dw;
const PetscInt *ia, *ja;
const PetscInt job = 5;
PetscInt *perm, nrow, ncol, nnz, liw, *iw, ldw, i;
PetscBool done;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
ncol = nrow;
nnz = ia[nrow];
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = MatSeqAIJGetArray(mat, &a);CHKERRQ(ierr);
switch (job) {
case 1: liw = 4*nrow + ncol; ldw = 0;break;
case 2: liw = 2*nrow + 2*ncol; ldw = ncol;break;
case 3: liw = 8*nrow + 2*ncol + nnz; ldw = nnz;break;
case 4: liw = 3*nrow + 2*ncol; ldw = 2*ncol + nnz;break;
case 5: liw = 3*nrow + 2*ncol; ldw = nrow + 2*ncol + nnz;break;
}
ierr = PetscMalloc3(liw,&iw,ldw,&dw,nrow,&perm);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUPERLU_DIST)
{
PetscInt num, info[10], icntl[10];
ierr = mc64id_dist(icntl);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64id_dist returned %d\n",ierr);
icntl[0] = 0; /* allow printing error messages (f2c'd code uses if non-negative, ignores value otherwise) */
icntl[1] = -1; /* suppress warnings */
icntl[2] = -1; /* ignore diagnostic output [default] */
icntl[3] = 0; /* perform consistency checks [default] */
ierr = mc64ad_dist(&job, &nrow, &nnz, ia, ja, a, &num, perm, &liw, iw, &ldw, dw, icntl, info);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64ad_dist returned %d\n",ierr);
}
#else
SETERRQ(PetscObjectComm((PetscObject) mat), PETSC_ERR_SUP, "WBM using MC64 does not support complex numbers");
#endif
ierr = MatRestoreRowIJ(mat, 1, PETSC_TRUE, PETSC_TRUE, NULL, &ia, &ja, &done);CHKERRQ(ierr);
for (i = 0; i < nrow; ++i) perm[i]--;
/* If job == 5, dw[0..ncols] contains the column scaling and dw[ncols..ncols+nrows] contains the row scaling */
ierr = ISCreateStride(PETSC_COMM_SELF, nrow, 0, 1, row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);CHKERRQ(ierr);
ierr = PetscFree3(iw,dw,perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
SVDAllocateSolution - Allocate memory storage for common variables such
as the singular values and the basis vectors.
Collective on SVD
Input Parameters:
+ svd - eigensolver context
- extra - number of additional positions, used for methods that require a
working basis slightly larger than ncv
Developers Notes:
This is PETSC_EXTERN because it may be required by user plugin SVD
implementations.
This is called at setup after setting the value of ncv and the flag leftbasis.
Level: developer
@*/
PetscErrorCode SVDAllocateSolution(SVD svd,PetscInt extra)
{
PetscErrorCode ierr;
PetscInt oldsize,requested;
Vec tr,tl;
PetscFunctionBegin;
requested = svd->ncv + extra;
/* oldsize is zero if this is the first time setup is called */
ierr = BVGetSizes(svd->V,NULL,NULL,&oldsize);CHKERRQ(ierr);
/* allocate sigma */
if (requested != oldsize) {
if (oldsize) {
ierr = PetscFree3(svd->sigma,svd->perm,svd->errest);CHKERRQ(ierr);
}
ierr = PetscMalloc3(requested,&svd->sigma,requested,&svd->perm,requested,&svd->errest);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)svd,PetscMax(0,requested-oldsize)*(2*sizeof(PetscReal)+sizeof(PetscInt)));CHKERRQ(ierr);
}
/* allocate V */
if (!svd->V) { ierr = SVDGetBV(svd,&svd->V,NULL);CHKERRQ(ierr); }
if (!oldsize) {
if (!((PetscObject)(svd->V))->type_name) {
ierr = BVSetType(svd->V,BVSVEC);CHKERRQ(ierr);
}
ierr = SVDMatGetVecs(svd,&tr,NULL);CHKERRQ(ierr);
ierr = BVSetSizesFromVec(svd->V,tr,requested);CHKERRQ(ierr);
ierr = VecDestroy(&tr);CHKERRQ(ierr);
} else {
ierr = BVResize(svd->V,requested,PETSC_FALSE);CHKERRQ(ierr);
}
/* allocate U */
if (svd->leftbasis) {
if (!svd->U) { ierr = SVDGetBV(svd,NULL,&svd->U);CHKERRQ(ierr); }
if (!oldsize) {
if (!((PetscObject)(svd->U))->type_name) {
ierr = BVSetType(svd->U,BVSVEC);CHKERRQ(ierr);
}
ierr = SVDMatGetVecs(svd,NULL,&tl);CHKERRQ(ierr);
ierr = BVSetSizesFromVec(svd->U,tl,requested);CHKERRQ(ierr);
ierr = VecDestroy(&tl);CHKERRQ(ierr);
} else {
ierr = BVResize(svd->U,requested,PETSC_FALSE);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
/*@
PetscConvEstDestroy - Destroys a PetscConvEst object
Collective on PetscConvEst
Input Parameter:
. ce - The PetscConvEst object
Level: beginner
.keywords: PetscConvEst, convergence, destroy
.seealso: PetscConvEstCreate(), PetscConvEstGetConvRate()
@*/
PetscErrorCode PetscConvEstDestroy(PetscConvEst *ce)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!*ce) PetscFunctionReturn(0);
PetscValidHeaderSpecific((*ce),PETSC_OBJECT_CLASSID,1);
if (--((PetscObject)(*ce))->refct > 0) {
*ce = NULL;
PetscFunctionReturn(0);
}
ierr = PetscFree3((*ce)->initGuess, (*ce)->exactSol, (*ce)->ctxs);CHKERRQ(ierr);
ierr = PetscFree((*ce)->errors);CHKERRQ(ierr);
ierr = PetscHeaderDestroy(ce);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESMSRegisterDestroy - Frees the list of schemes that were registered by TSRosWRegister().
Not Collective
Level: advanced
.keywords: TSRosW, register, destroy
.seealso: TSRosWRegister(), TSRosWRegisterAll(), TSRosWRegisterDynamic()
@*/
PetscErrorCode SNESMSRegisterDestroy(void)
{
PetscErrorCode ierr;
SNESMSTableauLink link;
PetscFunctionBegin;
while ((link = SNESMSTableauList)) {
SNESMSTableau t = &link->tab;
SNESMSTableauList = link->next;
ierr = PetscFree3(t->gamma,t->delta,t->betasub);CHKERRQ(ierr);
ierr = PetscFree(t->name);CHKERRQ(ierr);
ierr = PetscFree(link);CHKERRQ(ierr);
}
SNESMSRegisterAllCalled = PETSC_FALSE;
PetscFunctionReturn(0);
}
/*@
ISPartitioningToNumbering - Takes an ISPartitioning and on each processor
generates an IS that contains a new global node number for each index based
on the partitioing.
Collective on IS
Input Parameters
. partitioning - a partitioning as generated by MatPartitioningApply()
Output Parameter:
. is - on each processor the index set that defines the global numbers
(in the new numbering) for all the nodes currently (before the partitioning)
on that processor
Level: advanced
.seealso: MatPartitioningCreate(), AOCreateBasic(), ISPartitioningCount()
@*/
PetscErrorCode ISPartitioningToNumbering(IS part,IS *is)
{
MPI_Comm comm;
PetscInt i,np,npt,n,*starts = NULL,*sums = NULL,*lsizes = NULL,*newi = NULL;
const PetscInt *indices = NULL;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)part,&comm);CHKERRQ(ierr);
/* count the number of partitions, i.e., virtual processors */
ierr = ISGetLocalSize(part,&n);CHKERRQ(ierr);
ierr = ISGetIndices(part,&indices);CHKERRQ(ierr);
np = 0;
for (i=0; i<n; i++) np = PetscMax(np,indices[i]);
ierr = MPI_Allreduce(&np,&npt,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
np = npt+1; /* so that it looks like a MPI_Comm_size output */
/*
lsizes - number of elements of each partition on this particular processor
sums - total number of "previous" nodes for any particular partition
starts - global number of first element in each partition on this processor
*/
ierr = PetscMalloc3(np,&lsizes,np,&starts,np,&sums);CHKERRQ(ierr);
ierr = PetscMemzero(lsizes,np*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<n; i++) lsizes[indices[i]]++;
ierr = MPI_Allreduce(lsizes,sums,np,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
ierr = MPI_Scan(lsizes,starts,np,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
for (i=0; i<np; i++) starts[i] -= lsizes[i];
for (i=1; i<np; i++) {
sums[i] += sums[i-1];
starts[i] += sums[i-1];
}
/*
For each local index give it the new global number
*/
ierr = PetscMalloc1(n,&newi);CHKERRQ(ierr);
for (i=0; i<n; i++) newi[i] = starts[indices[i]]++;
ierr = PetscFree3(lsizes,starts,sums);CHKERRQ(ierr);
ierr = ISRestoreIndices(part,&indices);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,n,newi,PETSC_OWN_POINTER,is);CHKERRQ(ierr);
ierr = ISSetPermutation(*is);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
DenseTridiagonal - Solves a real tridiagonal Hermitian Eigenvalue Problem.
Input Parameters:
+ n - dimension of the eigenproblem
. D - pointer to the array containing the diagonal elements
- E - pointer to the array containing the off-diagonal elements
Output Parameters:
+ w - pointer to the array to store the computed eigenvalues
- V - pointer to the array to store the eigenvectors
Notes:
If V is NULL then the eigenvectors are not computed.
This routine use LAPACK routines xSTEVR.
*/
static PetscErrorCode DenseTridiagonal(PetscInt n_,PetscReal *D,PetscReal *E,PetscReal *w,PetscScalar *V)
{
#if defined(SLEPC_MISSING_LAPACK_STEVR)
PetscFunctionBegin;
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"STEVR - Lapack routine is unavailable");
#else
PetscErrorCode ierr;
PetscReal abstol = 0.0,vl,vu,*work;
PetscBLASInt il,iu,m,*isuppz,n,lwork,*iwork,liwork,info;
const char *jobz;
#if defined(PETSC_USE_COMPLEX)
PetscInt i,j;
PetscReal *VV;
#endif
PetscFunctionBegin;
ierr = PetscBLASIntCast(n_,&n);CHKERRQ(ierr);
ierr = PetscBLASIntCast(20*n_,&lwork);CHKERRQ(ierr);
ierr = PetscBLASIntCast(10*n_,&liwork);CHKERRQ(ierr);
if (V) {
jobz = "V";
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc1(n*n,&VV);CHKERRQ(ierr);
#endif
} else jobz = "N";
ierr = PetscMalloc3(2*n,&isuppz,lwork,&work,liwork,&iwork);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
PetscStackCallBLAS("LAPACKstevr",LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,VV,&n,isuppz,work,&lwork,iwork,&liwork,&info));
#else
PetscStackCallBLAS("LAPACKstevr",LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,iwork,&liwork,&info));
#endif
ierr = PetscFPTrapPop();CHKERRQ(ierr);
if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack DSTEVR %d",info);
#if defined(PETSC_USE_COMPLEX)
if (V) {
for (i=0;i<n;i++)
for (j=0;j<n;j++)
V[i*n+j] = VV[i*n+j];
ierr = PetscFree(VV);CHKERRQ(ierr);
}
#endif
ierr = PetscFree3(isuppz,work,iwork);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
/* Check whether a was created via MPI_Type_contiguous from b
*
*/
PetscErrorCode MPIPetsc_Type_compare_contig(MPI_Datatype a,MPI_Datatype b,PetscInt *n)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscBool freeatype,freebtype;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype,&freeatype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype,&freebtype);CHKERRQ(ierr);
*n = PETSC_FALSE;
if (atype == btype) {
*n = 1;
goto free_types;
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
if (acombiner == MPI_COMBINER_CONTIGUOUS && aintcount >= 1) {
PetscMPIInt *aints;
MPI_Aint *aaddrs;
MPI_Datatype *atypes;
PetscInt i;
PetscBool same;
ierr = PetscMalloc3(aintcount,&aints,aaddrcount,&aaddrs,atypecount,&atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
/* Check for identity first. */
if (atypes[0] == btype) {
*n = aints[0];
} else {
/* atypes[0] merely has to be equivalent to the type used to create atype. */
ierr = MPIPetsc_Type_compare(atypes[0],btype,&same);CHKERRQ(ierr);
if (same) *n = aints[0];
}
for (i=0; i<atypecount; i++) {
ierr = MPIPetsc_Type_free(&(atypes[i]));CHKERRQ(ierr);
}
ierr = PetscFree3(aints,aaddrs,atypes);CHKERRQ(ierr);
}
free_types:
if (freeatype) {
ierr = MPIPetsc_Type_free(&atype);CHKERRQ(ierr);
}
if (freebtype) {
ierr = MPIPetsc_Type_free(&btype);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
