PetscErrorCode CheckFEMGeometry(DM dm, PetscInt cell, PetscInt spaceDim, PetscReal v0Ex[], PetscReal JEx[], PetscReal invJEx[], PetscReal detJEx) { PetscReal v0[3], J[9], invJ[9], detJ; PetscInt d, i, j; PetscErrorCode ierr; PetscFunctionBegin; ierr = DMPlexComputeCellGeometry(dm, cell, v0, J, invJ, &detJ);CHKERRQ(ierr); for (d = 0; d < spaceDim; ++d) { if (v0[d] != v0Ex[d]) { switch (spaceDim) { case 2: SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid v0 (%g, %g) != (%g, %g)", v0[0], v0[1], v0Ex[0], v0Ex[1]);break; case 3: SETERRQ6(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid v0 (%g, %g, %g) != (%g, %g, %g)", v0[0], v0[1], v0[2], v0Ex[0], v0Ex[1], v0Ex[2]);break; default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid space dimension %d", spaceDim); } } } for (i = 0; i < spaceDim; ++i) { for (j = 0; j < spaceDim; ++j) { if (fabs(J[i*spaceDim+j] - JEx[i*spaceDim+j]) > 1.0e-9) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid J[%d,%d]: %g != %g", i, j, J[i*spaceDim+j], JEx[i*spaceDim+j]); if (fabs(invJ[i*spaceDim+j] - invJEx[i*spaceDim+j]) > 1.0e-9) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid invJ[%d,%d]: %g != %g", i, j, invJ[i*spaceDim+j], invJEx[i*spaceDim+j]); } } if (fabs(detJ - detJEx) > 1.0e-9) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid |J| = %g != %g", detJ, detJEx); PetscFunctionReturn(0); }
/*@ MatSetSizes - Sets the local and global sizes, and checks to determine compatibility Collective on Mat Input Parameters: + A - the matrix . m - number of local rows (or PETSC_DECIDE) . n - number of local columns (or PETSC_DECIDE) . M - number of global rows (or PETSC_DETERMINE) - N - number of global columns (or PETSC_DETERMINE) Notes: m (n) and M (N) cannot be both PETSC_DECIDE If one processor calls this with M (N) of PETSC_DECIDE then all processors must, otherwise the program will hang. If PETSC_DECIDE is not used for the arguments 'm' and 'n', then the user must ensure that they are chosen to be compatible with the vectors. To do this, one first considers the matrix-vector product 'y = A x'. The 'm' that is used in the above routine must match the local size used in the vector creation routine VecCreateMPI() for 'y'. Likewise, the 'n' used must match that used as the local size in VecCreateMPI() for 'x'. You cannot change the sizes once they have been set. The sizes must be set before MatSetUp() or MatXXXSetPreallocation() is called. Level: beginner .seealso: MatGetSize(), PetscSplitOwnership() @*/ PetscErrorCode MatSetSizes(Mat A, PetscInt m, PetscInt n, PetscInt M, PetscInt N) { PetscFunctionBegin; PetscValidHeaderSpecific(A,MAT_CLASSID,1); if (M > 0 && m > M) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Local column size %D cannot be larger than global column size %D",m,M); if (N > 0 && n > N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Local row size %D cannot be larger than global row size %D",n,N); if ((A->rmap->n >= 0 || A->rmap->N >= 0) && (A->rmap->n != m || A->rmap->N != M)) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot change/reset row sizes to %D local %D global after previously setting them to %D local %D global",m,M,A->rmap->n,A->rmap->N); if ((A->cmap->n >= 0 || A->cmap->N >= 0) && (A->cmap->n != n || A->cmap->N != N)) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot change/reset column sizes to %D local %D global after previously setting them to %D local %D global",n,N,A->cmap->n,A->cmap->N); A->rmap->n = m; A->cmap->n = n; A->rmap->N = M; A->cmap->N = N; PetscFunctionReturn(0); }
/*@ MatAXPY - Computes Y = a*X + Y. Logically Collective on Mat Input Parameters: + a - the scalar multiplier . X - the first matrix . Y - the second matrix - str - either SAME_NONZERO_PATTERN, DIFFERENT_NONZERO_PATTERN or SUBSET_NONZERO_PATTERN (nonzeros of X is a subset of Y's) Level: intermediate .keywords: matrix, add .seealso: MatAYPX() @*/ PetscErrorCode MatAXPY(Mat Y,PetscScalar a,Mat X,MatStructure str) { PetscErrorCode ierr; PetscInt m1,m2,n1,n2; PetscFunctionBegin; PetscValidHeaderSpecific(X,MAT_CLASSID,3); PetscValidHeaderSpecific(Y,MAT_CLASSID,1); PetscValidLogicalCollectiveScalar(Y,a,2); ierr = MatGetSize(X,&m1,&n1);CHKERRQ(ierr); ierr = MatGetSize(Y,&m2,&n2);CHKERRQ(ierr); if (m1 != m2 || n1 != n2) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Non conforming matrix add: %D %D %D %D",m1,m2,n1,n2); ierr = PetscLogEventBegin(MAT_AXPY,Y,0,0,0);CHKERRQ(ierr); if (Y->ops->axpy) { ierr = (*Y->ops->axpy)(Y,a,X,str);CHKERRQ(ierr); } else { ierr = MatAXPY_Basic(Y,a,X,str);CHKERRQ(ierr); } ierr = PetscLogEventEnd(MAT_AXPY,Y,0,0,0);CHKERRQ(ierr); #if defined(PETSC_HAVE_CUSP) if (Y->valid_GPU_matrix != PETSC_CUSP_UNALLOCATED) { Y->valid_GPU_matrix = PETSC_CUSP_CPU; } #endif PetscFunctionReturn(0); }
/*@ BVMultVec - Computes y = beta*y + alpha*X*q. Logically Collective on BV and Vec Input Parameters: + X - a basis vectors object . alpha,beta - scalars . y - a vector - q - an array of scalars Output Parameter: . y - the modified vector Notes: This operation is the analogue of BVMult() but with a BV and a Vec, instead of two BV. Note that arguments are listed in different order with respect to BVMult(). If X has leading columns specified, then these columns do not participate in the computation. The length of array q must be equal to the number of active columns of X minus the number of leading columns, i.e. the first entry of q multiplies the first non-leading column. Level: intermediate .seealso: BVMult(), BVMultColumn(), BVMultInPlace(), BVSetActiveColumns() @*/ PetscErrorCode BVMultVec(BV X,PetscScalar alpha,PetscScalar beta,Vec y,PetscScalar *q) { PetscErrorCode ierr; PetscInt n,N; PetscFunctionBegin; PetscValidHeaderSpecific(X,BV_CLASSID,1); PetscValidLogicalCollectiveScalar(X,alpha,2); PetscValidLogicalCollectiveScalar(X,beta,3); PetscValidHeaderSpecific(y,VEC_CLASSID,4); PetscValidPointer(q,5); PetscValidType(X,1); BVCheckSizes(X,1); PetscValidType(y,4); PetscCheckSameComm(X,1,y,4); ierr = VecGetSize(y,&N);CHKERRQ(ierr); ierr = VecGetLocalSize(y,&n);CHKERRQ(ierr); if (N!=X->N || n!=X->n) SETERRQ4(PetscObjectComm((PetscObject)X),PETSC_ERR_ARG_INCOMP,"Vec sizes (global %D, local %D) do not match BV sizes (global %D, local %D)",N,n,X->N,X->n); if (!X->n) PetscFunctionReturn(0); ierr = PetscLogEventBegin(BV_Mult,X,y,0,0);CHKERRQ(ierr); ierr = (*X->ops->multvec)(X,alpha,beta,y,q);CHKERRQ(ierr); ierr = PetscLogEventEnd(BV_Mult,X,y,0,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode CompareCones(DM dm, DM idm) { PetscInt cStart, cEnd, c, vStart, vEnd, v; PetscErrorCode ierr; PetscFunctionBegin; ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr); for (c = cStart; c < cEnd; ++c) { const PetscInt *cone; PetscInt *points = NULL, numPoints, p, numVertices = 0, coneSize; ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr); ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr); ierr = DMPlexGetTransitiveClosure(idm, c, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr); for (p = 0; p < numPoints*2; p += 2) { const PetscInt point = points[p]; if ((point >= vStart) && (point < vEnd)) points[numVertices++] = point; } if (numVertices != coneSize) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "In cell %d, cone size %d != %d vertices in closure", c, coneSize, numVertices); for (v = 0; v < numVertices; ++v) { if (cone[v] != points[v]) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "In cell %d, cone point %d is %d != %d vertex in closure", c, v, cone[v], points[v]); } ierr = DMPlexRestoreTransitiveClosure(idm, c, PETSC_TRUE, &numPoints, &points);CHKERRQ(ierr); } PetscFunctionReturn(0); }
/*@ BVInsertVec - Insert a vector into the specified column. Collective on BV Input Parameters: + V - basis vectors . j - the column of V to be overwritten - w - the vector to be copied Level: intermediate .seealso: BVInsertVecs() @*/ PetscErrorCode BVInsertVec(BV V,PetscInt j,Vec w) { PetscErrorCode ierr; PetscInt n,N; Vec v; PetscFunctionBegin; PetscValidHeaderSpecific(V,BV_CLASSID,1); PetscValidLogicalCollectiveInt(V,j,2); PetscValidHeaderSpecific(w,VEC_CLASSID,3); PetscValidType(V,1); BVCheckSizes(V,1); PetscCheckSameComm(V,1,w,3); ierr = VecGetSize(w,&N);CHKERRQ(ierr); ierr = VecGetLocalSize(w,&n);CHKERRQ(ierr); if (N!=V->N || n!=V->n) SETERRQ4(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"Vec sizes (global %D, local %D) do not match BV sizes (global %D, local %D)",N,n,V->N,V->n); if (j<-V->nc || j>=V->m) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument j has wrong value %D, should be between %D and %D",j,-V->nc,V->m-1); ierr = BVGetColumn(V,j,&v);CHKERRQ(ierr); ierr = VecCopy(w,v);CHKERRQ(ierr); ierr = BVRestoreColumn(V,j,&v);CHKERRQ(ierr); ierr = PetscObjectStateIncrease((PetscObject)V);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode SetupQuadrature(AppCtx *user) { PetscReal *x, *w; const PetscInt dim = user->dim; PetscInt order, numPoints, p, d; PetscErrorCode ierr; PetscFunctionBeginUser; /* Velocity discretization */ order = PetscMax(user->order[0], user->order[1]); numPoints = dim > 1 ? dim > 2 ? order*PetscSqr(order) : PetscSqr(order) : order; if (numPoints != NUM_QUADRATURE_POINTS_0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of quadrature points: %d != %d", numPoints, NUM_QUADRATURE_POINTS_0); ierr = PetscDTGaussJacobiQuadrature(dim, order, -1.0, 1.0, &x, &w);CHKERRQ(ierr); for (p = 0; p < numPoints; ++p) { for (d = 0; d < dim; ++d) { if (fabs(x[p*dim+d] - points_0[p*dim+d]) > 1.0e-10) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid point %d, component %d: %g != %g", p, d, x[p*dim+d], points_0[p*dim+d]); } if (fabs(w[p] - weights_0[p]) > 1.0e-10) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid weight %d: %g != %g", p, w[p], weights_0[p]); } user->fem.quad[0].numQuadPoints = numPoints; user->fem.quad[0].quadPoints = x; user->fem.quad[0].quadWeights = w; user->fem.quad[0].numBasisFuncs = NUM_BASIS_FUNCTIONS_0; user->fem.quad[0].numComponents = NUM_BASIS_COMPONENTS_0; user->fem.quad[0].basis = Basis_0; user->fem.quad[0].basisDer = BasisDerivatives_0; /* Pressure discretization */ order = PetscMax(user->order[0], user->order[1]); numPoints = dim > 1 ? dim > 2 ? order*PetscSqr(order) : PetscSqr(order) : order; if (numPoints != NUM_QUADRATURE_POINTS_1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of quadrature points: %d != %d", numPoints, NUM_QUADRATURE_POINTS_1); ierr = PetscDTGaussJacobiQuadrature(dim, order, -1.0, 1.0, &x, &w);CHKERRQ(ierr); for (p = 0; p < numPoints; ++p) { for (d = 0; d < dim; ++d) { if (fabs(x[p*dim+d] - points_1[p*dim+d]) > 1.0e-10) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid point %d, component %d: %g != %g", p, d, x[p*dim+d], points_1[p*dim+d]); } if (fabs(w[p] - weights_1[p]) > 1.0e-10) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid weight %d: %g != %g", p, w[p], weights_1[p]); } user->fem.quad[1].numQuadPoints = numPoints; user->fem.quad[1].quadPoints = x; user->fem.quad[1].quadWeights = w; user->fem.quad[1].numBasisFuncs = NUM_BASIS_FUNCTIONS_1; user->fem.quad[1].numComponents = NUM_BASIS_COMPONENTS_1; user->fem.quad[1].basis = Basis_1; user->fem.quad[1].basisDer = BasisDerivatives_1; PetscFunctionReturn(0); }
/*@ MatMultEqual - Compares matrix-vector products of two matrices. Collective on Mat Input Parameters: + A - the first matrix - B - the second matrix - n - number of random vectors to be tested Output Parameter: . flg - PETSC_TRUE if the products are equal; PETSC_FALSE otherwise. Level: intermediate Concepts: matrices^equality between @*/ PetscErrorCode MatMultEqual(Mat A,Mat B,PetscInt n,PetscBool *flg) { PetscErrorCode ierr; Vec x,s1,s2; PetscRandom rctx; PetscReal r1,r2,tol=1.e-10; PetscInt am,an,bm,bn,k; PetscScalar none = -1.0; PetscFunctionBegin; PetscValidHeaderSpecific(A,MAT_CLASSID,1); PetscValidHeaderSpecific(B,MAT_CLASSID,2); ierr = MatGetLocalSize(A,&am,&an);CHKERRQ(ierr); ierr = MatGetLocalSize(B,&bm,&bn);CHKERRQ(ierr); if (am != bm || an != bn) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Mat A,Mat B: local dim %D %D %D %D",am,bm,an,bn); PetscCheckSameComm(A,1,B,2); #if defined(PETSC_USE_REAL_SINGLE) tol = 1.e-5; #endif ierr = PetscRandomCreate(((PetscObject)A)->comm,&rctx);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr); ierr = VecCreate(((PetscObject)A)->comm,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,an,PETSC_DECIDE);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecCreate(((PetscObject)A)->comm,&s1);CHKERRQ(ierr); ierr = VecSetSizes(s1,am,PETSC_DECIDE);CHKERRQ(ierr); ierr = VecSetFromOptions(s1);CHKERRQ(ierr); ierr = VecDuplicate(s1,&s2);CHKERRQ(ierr); *flg = PETSC_TRUE; for (k=0; k<n; k++) { ierr = VecSetRandom(x,rctx);CHKERRQ(ierr); ierr = MatMult(A,x,s1);CHKERRQ(ierr); ierr = MatMult(B,x,s2);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_INFINITY,&r2);CHKERRQ(ierr); if (r2 < tol){ ierr = VecNorm(s1,NORM_INFINITY,&r1);CHKERRQ(ierr); } else { ierr = VecAXPY(s2,none,s1);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_INFINITY,&r1);CHKERRQ(ierr); r1 /= r2; } if (r1 > tol) { *flg = PETSC_FALSE; ierr = PetscInfo2(A,"Error: %D-th MatMult() %G\n",k,r1);CHKERRQ(ierr); break; } } ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&s1);CHKERRQ(ierr); ierr = VecDestroy(&s2);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@ PFApplyVec - Applies the mathematical function to a vector Collective on PF Input Parameters: + pf - the function context - x - input vector (or PETSC_NULL for the vector (0,1, .... N-1) Output Parameter: . y - output vector Level: beginner .keywords: PF, apply .seealso: PFApply(), PFCreate(), PFDestroy(), PFSetType(), PFSet() @*/ PetscErrorCode PFApplyVec(PF pf,Vec x,Vec y) { PetscErrorCode ierr; PetscInt i,rstart,rend,n,p; PetscBool nox = PETSC_FALSE; PetscFunctionBegin; PetscValidHeaderSpecific(pf,PF_CLASSID,1); PetscValidHeaderSpecific(y,VEC_CLASSID,3); if (x) { PetscValidHeaderSpecific(x,VEC_CLASSID,2); if (x == y) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_IDN,"x and y must be different vectors"); } else { PetscScalar *xx; PetscInt lsize; ierr = VecGetLocalSize(y,&lsize);CHKERRQ(ierr); lsize = pf->dimin*lsize/pf->dimout; ierr = VecCreateMPI(((PetscObject)y)->comm,lsize,PETSC_DETERMINE,&x);CHKERRQ(ierr); nox = PETSC_TRUE; ierr = VecGetOwnershipRange(x,&rstart,&rend);CHKERRQ(ierr); ierr = VecGetArray(x,&xx);CHKERRQ(ierr); for (i=rstart; i<rend; i++) { xx[i-rstart] = (PetscScalar)i; } ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr); } ierr = VecGetLocalSize(x,&n);CHKERRQ(ierr); ierr = VecGetLocalSize(y,&p);CHKERRQ(ierr); if ((pf->dimin*(n/pf->dimin)) != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local input vector length %D not divisible by dimin %D of function",n,pf->dimin); if ((pf->dimout*(p/pf->dimout)) != p) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local output vector length %D not divisible by dimout %D of function",p,pf->dimout); if ((n/pf->dimin) != (p/pf->dimout)) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local vector lengths %D %D are wrong for dimin and dimout %D %D of function",n,p,pf->dimin,pf->dimout); if (pf->ops->applyvec) { ierr = (*pf->ops->applyvec)(pf->data,x,y);CHKERRQ(ierr); } else { PetscScalar *xx,*yy; ierr = VecGetLocalSize(x,&n);CHKERRQ(ierr); n = n/pf->dimin; ierr = VecGetArray(x,&xx);CHKERRQ(ierr); ierr = VecGetArray(y,&yy);CHKERRQ(ierr); if (!pf->ops->apply) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"No function has been provided for this PF"); ierr = (*pf->ops->apply)(pf->data,n,xx,yy);CHKERRQ(ierr); ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr); ierr = VecRestoreArray(y,&yy);CHKERRQ(ierr); } if (nox) { ierr = VecDestroy(&x);CHKERRQ(ierr); } PetscFunctionReturn(0); }
/*@ PetscDrawSetViewPort - Sets the portion of the window (page) to which draw routines will write. Collective on PetscDraw Input Parameters: + xl,yl,xr,yr - upper right and lower left corners of subwindow These numbers must always be between 0.0 and 1.0. Lower left corner is (0,0). - draw - the drawing context Level: advanced Concepts: drawing^in subset of window Concepts: graphics^in subset of window @*/ PetscErrorCode PetscDrawSetViewPort(PetscDraw draw,PetscReal xl,PetscReal yl,PetscReal xr,PetscReal yr) { PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(draw,PETSC_DRAW_CLASSID,1); if (xl < 0.0 || xr > 1.0 || yl < 0.0 || yr > 1.0 || xr <= xl || yr <= yl) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"ViewPort values must be >= 0 and <= 1: Instead %g %g %g %g",(double)xl,(double)yl,(double)xr,(double)yr); draw->port_xl = xl; draw->port_yl = yl; draw->port_xr = xr; draw->port_yr = yr; if (draw->ops->setviewport) { ierr = (*draw->ops->setviewport)(draw,xl,yl,xr,yr);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PetscErrorCode DMDASplitComm2d(MPI_Comm comm,PetscInt M,PetscInt N,PetscInt sw,MPI_Comm *outcomm) { PetscErrorCode ierr; PetscInt m,n = 0,x = 0,y = 0; PetscMPIInt size,csize,rank; PetscFunctionBegin; ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); csize = 4*size; do { if (csize % 4) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cannot split communicator of size %d tried %d %D %D",size,csize,x,y); csize = csize/4; m = (PetscInt)(0.5 + PetscSqrtReal(((PetscReal)M)*((PetscReal)csize)/((PetscReal)N))); if (!m) m = 1; while (m > 0) { n = csize/m; if (m*n == csize) break; m--; } if (M > N && m < n) {PetscInt _m = m; m = n; n = _m;} x = M/m + ((M % m) > ((csize-1) % m)); y = (N + (csize-1)/m)/n; } while ((x < 4 || y < 4) && csize > 1); if (size != csize) { MPI_Group entire_group,sub_group; PetscMPIInt i,*groupies; ierr = MPI_Comm_group(comm,&entire_group);CHKERRQ(ierr); ierr = PetscMalloc1(csize,&groupies);CHKERRQ(ierr); for (i=0; i<csize; i++) { groupies[i] = (rank/csize)*csize + i; } ierr = MPI_Group_incl(entire_group,csize,groupies,&sub_group);CHKERRQ(ierr); ierr = PetscFree(groupies);CHKERRQ(ierr); ierr = MPI_Comm_create(comm,sub_group,outcomm);CHKERRQ(ierr); ierr = MPI_Group_free(&entire_group);CHKERRQ(ierr); ierr = MPI_Group_free(&sub_group);CHKERRQ(ierr); ierr = PetscInfo1(0,"DMDASplitComm2d:Creating redundant coarse problems of size %d\n",csize);CHKERRQ(ierr); } else { *outcomm = comm; } PetscFunctionReturn(0); }
/*@ BVInsertVecs - Insert a set of vectors into the specified columns. Collective on BV Input Parameters: + V - basis vectors . s - first column of V to be overwritten . W - set of vectors to be copied - orth - flag indicating if the vectors must be orthogonalized Input/Output Parameter: . m - number of input vectors, on output the number of linearly independent vectors Notes: Copies the contents of vectors W to V(:,s:s+n). If the orthogonalization flag is set, then the vectors are copied one by one and then orthogonalized against the previous ones. If any of them is linearly dependent then it is discarded and the value of m is decreased. Level: intermediate .seealso: BVInsertVec(), BVOrthogonalizeColumn() @*/ PetscErrorCode BVInsertVecs(BV V,PetscInt s,PetscInt *m,Vec *W,PetscBool orth) { PetscErrorCode ierr; PetscInt n,N,i,ndep; PetscBool lindep; PetscReal norm; Vec v; PetscFunctionBegin; PetscValidHeaderSpecific(V,BV_CLASSID,1); PetscValidLogicalCollectiveInt(V,s,2); PetscValidPointer(m,3); PetscValidLogicalCollectiveInt(V,*m,3); if (!*m) PetscFunctionReturn(0); if (*m<0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Number of vectors (given %D) cannot be negative",*m); PetscValidPointer(W,4); PetscValidHeaderSpecific(*W,VEC_CLASSID,4); PetscValidLogicalCollectiveBool(V,orth,5); PetscValidType(V,1); BVCheckSizes(V,1); PetscCheckSameComm(V,1,*W,4); ierr = VecGetSize(*W,&N);CHKERRQ(ierr); ierr = VecGetLocalSize(*W,&n);CHKERRQ(ierr); if (N!=V->N || n!=V->n) SETERRQ4(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"Vec sizes (global %D, local %D) do not match BV sizes (global %D, local %D)",N,n,V->N,V->n); if (s<0 || s>=V->m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument s has wrong value %D, should be between 0 and %D",s,V->m-1); if (s+(*m)>V->m) SETERRQ1(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Too many vectors provided, there is only room for %D",V->m); ndep = 0; for (i=0;i<*m;i++) { ierr = BVGetColumn(V,s+i-ndep,&v);CHKERRQ(ierr); ierr = VecCopy(W[i],v);CHKERRQ(ierr); ierr = BVRestoreColumn(V,s+i-ndep,&v);CHKERRQ(ierr); if (orth) { ierr = BVOrthogonalizeColumn(V,s+i-ndep,NULL,&norm,&lindep);CHKERRQ(ierr); if (norm==0.0 || lindep) { ierr = PetscInfo1(V,"Removing linearly dependent vector %D\n",i);CHKERRQ(ierr); ndep++; } else { ierr = BVScaleColumn(V,s+i-ndep,1.0/norm);CHKERRQ(ierr); } } } *m -= ndep; ierr = PetscObjectStateIncrease((PetscObject)V);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode MatISSetLocalMat_IS(Mat mat,Mat local) { Mat_IS *is = (Mat_IS*)mat->data; PetscInt nrows,ncols,orows,ocols; PetscErrorCode ierr; PetscFunctionBegin; if (is->A) { ierr = MatGetSize(is->A,&orows,&ocols);CHKERRQ(ierr); ierr = MatGetSize(local,&nrows,&ncols);CHKERRQ(ierr); if (orows != nrows || ocols != ncols) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local MATIS matrix should be of size %dx%d (you passed a %dx%d matrix)\n",orows,ocols,nrows,ncols); } ierr = PetscObjectReference((PetscObject)local);CHKERRQ(ierr); ierr = MatDestroy(&is->A);CHKERRQ(ierr); is->A = local; PetscFunctionReturn(0); }
EXTERN_C_BEGIN #undef __FUNCT__ #define __FUNCT__ "MatMPIAdjSetPreallocation_MPIAdj" PetscErrorCode PETSCMAT_DLLEXPORT MatMPIAdjSetPreallocation_MPIAdj(Mat B,PetscInt *i,PetscInt *j,PetscInt *values) { Mat_MPIAdj *b = (Mat_MPIAdj *)B->data; PetscErrorCode ierr; #if defined(PETSC_USE_DEBUG) PetscInt ii; #endif PetscFunctionBegin; ierr = PetscLayoutSetBlockSize(B->rmap,1);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize(B->cmap,1);CHKERRQ(ierr); ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr); ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr); #if defined(PETSC_USE_DEBUG) if (i[0] != 0) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"First i[] index must be zero, instead it is %D\n",i[0]); for (ii=1; ii<B->rmap->n; ii++) { if (i[ii] < 0 || i[ii] < i[ii-1]) { SETERRQ4(PETSC_ERR_ARG_OUTOFRANGE,"i[%D]=%D index is out of range: i[%D]=%D",ii,i[ii],ii-1,i[ii-1]); } } for (ii=0; ii<i[B->rmap->n]; ii++) { if (j[ii] < 0 || j[ii] >= B->cmap->N) { SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Column index %D out of range %D\n",ii,j[ii]); } } #endif B->preallocated = PETSC_TRUE; b->j = j; b->i = i; b->values = values; b->nz = i[B->rmap->n]; b->diag = 0; b->symmetric = PETSC_FALSE; b->freeaij = PETSC_TRUE; ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@ MatAYPX - Computes Y = a*Y + X. Logically on Mat Input Parameters: + a - the PetscScalar multiplier . Y - the first matrix . X - the second matrix - str - either SAME_NONZERO_PATTERN, DIFFERENT_NONZERO_PATTERN or SUBSET_NONZERO_PATTERN Level: intermediate .keywords: matrix, add .seealso: MatAXPY() @*/ PetscErrorCode MatAYPX(Mat Y,PetscScalar a,Mat X,MatStructure str) { PetscScalar one = 1.0; PetscErrorCode ierr; PetscInt mX,mY,nX,nY; PetscFunctionBegin; PetscValidHeaderSpecific(X,MAT_CLASSID,3); PetscValidHeaderSpecific(Y,MAT_CLASSID,1); PetscValidLogicalCollectiveScalar(Y,a,2); ierr = MatGetSize(X,&mX,&nX);CHKERRQ(ierr); ierr = MatGetSize(X,&mY,&nY);CHKERRQ(ierr); if (mX != mY || nX != nY) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Non conforming matrices: %D %D first %D %D second",mX,mY,nX,nY); ierr = MatScale(Y,a);CHKERRQ(ierr); ierr = MatAXPY(Y,one,X,str);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@ MatGetColumnVector - Gets the values from a given column of a matrix. Not Collective Input Parameters: + A - the matrix . yy - the vector - c - the column requested (in global numbering) Level: advanced Notes: Each processor for which this is called gets the values for its rows. Since PETSc matrices are usually stored in compressed row format, this routine will generally be slow. The vector must have the same parallel row layout as the matrix. Contributed by: Denis Vanderstraeten .keywords: matrix, column, get .seealso: MatGetRow(), MatGetDiagonal() @*/ PetscErrorCode MatGetColumnVector(Mat A,Vec yy,PetscInt col) { PetscScalar *y; const PetscScalar *v; PetscErrorCode ierr; PetscInt i,j,nz,N,Rs,Re,rs,re; const PetscInt *idx; PetscFunctionBegin; PetscValidHeaderSpecific(A,MAT_CLASSID,1); PetscValidHeaderSpecific(yy,VEC_CLASSID,2); if (col < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Requested negative column: %D",col); ierr = MatGetSize(A,NULL,&N);CHKERRQ(ierr); if (col >= N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Requested column %D larger than number columns in matrix %D",col,N); ierr = MatGetOwnershipRange(A,&Rs,&Re);CHKERRQ(ierr); ierr = VecGetOwnershipRange(yy,&rs,&re);CHKERRQ(ierr); if (Rs != rs || Re != re) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Matrix %D %D does not have same ownership range (size) as vector %D %D",Rs,Re,rs,re); if (A->ops->getcolumnvector) { ierr = (*A->ops->getcolumnvector)(A,yy,col);CHKERRQ(ierr); } else { ierr = VecSet(yy,0.0);CHKERRQ(ierr); ierr = VecGetArray(yy,&y);CHKERRQ(ierr); for (i=Rs; i<Re; i++) { ierr = MatGetRow(A,i,&nz,&idx,&v);CHKERRQ(ierr); if (nz && idx[0] <= col) { /* Should use faster search here */ for (j=0; j<nz; j++) { if (idx[j] >= col) { if (idx[j] == col) y[i-rs] = v[j]; break; } } } ierr = MatRestoreRow(A,i,&nz,&idx,&v);CHKERRQ(ierr); } ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PetscErrorCode MatDiagonalSet_Default(Mat Y,Vec D,InsertMode is) { PetscErrorCode ierr; PetscInt i,start,end,vstart,vend; PetscScalar *v; PetscFunctionBegin; ierr = VecGetOwnershipRange(D,&vstart,&vend);CHKERRQ(ierr); ierr = MatGetOwnershipRange(Y,&start,&end);CHKERRQ(ierr); if (vstart != start || vend != end) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Vector ownership range not compatible with matrix: %D %D vec %D %D mat",vstart,vend,start,end); ierr = VecGetArray(D,&v);CHKERRQ(ierr); for (i=start; i<end; i++) { ierr = MatSetValues(Y,1,&i,1,&i,v+i-start,is);CHKERRQ(ierr); } ierr = VecRestoreArray(D,&v);CHKERRQ(ierr); ierr = MatAssemblyBegin(Y,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(Y,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode MatMatMultSymbolic_MPIAIJ_MPIAIJ(Mat A,Mat B,PetscReal fill,Mat *C) { PetscErrorCode ierr; PetscInt start,end; Mat_MatMatMultMPI *mult; PetscContainer container; PetscFunctionBegin; if (A->cmap->rstart != B->rmap->rstart || A->cmap->rend != B->rmap->rend){ SETERRQ4(PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, (%D, %D) != (%D,%D)",A->cmap->rstart,A->cmap->rend,B->rmap->rstart,B->rmap->rend); } ierr = PetscNew(Mat_MatMatMultMPI,&mult);CHKERRQ(ierr); /* create a seq matrix B_seq = submatrix of B by taking rows of B that equal to nonzero col of A */ ierr = MatGetBrowsOfAcols(A,B,MAT_INITIAL_MATRIX,&mult->isrowb,&mult->iscolb,&mult->brstart,&mult->B_seq);CHKERRQ(ierr); /* create a seq matrix A_seq = submatrix of A by taking all local rows of A */ start = A->rmap->rstart; end = A->rmap->rend; ierr = ISCreateStride(PETSC_COMM_SELF,end-start,start,1,&mult->isrowa);CHKERRQ(ierr); ierr = MatGetLocalMatCondensed(A,MAT_INITIAL_MATRIX,&mult->isrowa,&mult->isrowb,&mult->A_loc);CHKERRQ(ierr); /* compute C_seq = A_seq * B_seq */ ierr = MatMatMult_SeqAIJ_SeqAIJ(mult->A_loc,mult->B_seq,MAT_INITIAL_MATRIX,fill,&mult->C_seq);CHKERRQ(ierr); /* create mpi matrix C by concatinating C_seq */ ierr = PetscObjectReference((PetscObject)mult->C_seq);CHKERRQ(ierr); /* prevent C_seq being destroyed by MatMerge() */ ierr = MatMerge(((PetscObject)A)->comm,mult->C_seq,B->cmap->n,MAT_INITIAL_MATRIX,C);CHKERRQ(ierr); /* attach the supporting struct to C for reuse of symbolic C */ ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); ierr = PetscContainerSetPointer(container,mult);CHKERRQ(ierr); ierr = PetscObjectCompose((PetscObject)(*C),"Mat_MatMatMultMPI",(PetscObject)container);CHKERRQ(ierr); ierr = PetscContainerSetUserDestroy(container,PetscContainerDestroy_Mat_MatMatMultMPI);CHKERRQ(ierr); mult->MatDestroy = (*C)->ops->destroy; mult->MatDuplicate = (*C)->ops->duplicate; (*C)->ops->destroy = MatDestroy_MPIAIJ_MatMatMult; (*C)->ops->duplicate = MatDuplicate_MPIAIJ_MatMatMult; PetscFunctionReturn(0); }
PetscErrorCode MatPtAPSymbolic_MPIAIJ_MPIAIJ(Mat A,Mat P,PetscReal fill,Mat *C) { PetscErrorCode ierr; Mat Cmpi; Mat_PtAPMPI *ptap; PetscFreeSpaceList free_space=NULL,current_space=NULL; Mat_MPIAIJ *a =(Mat_MPIAIJ*)A->data,*p=(Mat_MPIAIJ*)P->data,*c; Mat_SeqAIJ *ad =(Mat_SeqAIJ*)(a->A)->data,*ao=(Mat_SeqAIJ*)(a->B)->data; Mat_SeqAIJ *p_loc,*p_oth; PetscInt *pi_loc,*pj_loc,*pi_oth,*pj_oth,*pdti,*pdtj,*poti,*potj,*ptJ; PetscInt *adi=ad->i,*aj,*aoi=ao->i,nnz; PetscInt *lnk,*owners_co,*coi,*coj,i,k,pnz,row; PetscInt am=A->rmap->n,pN=P->cmap->N,pm=P->rmap->n,pn=P->cmap->n; PetscBT lnkbt; MPI_Comm comm; PetscMPIInt size,rank,tagi,tagj,*len_si,*len_s,*len_ri,icompleted=0; PetscInt **buf_rj,**buf_ri,**buf_ri_k; PetscInt len,proc,*dnz,*onz,*owners; PetscInt nzi,*pti,*ptj; PetscInt nrows,*buf_s,*buf_si,*buf_si_i,**nextrow,**nextci; MPI_Request *swaits,*rwaits; MPI_Status *sstatus,rstatus; Mat_Merge_SeqsToMPI *merge; PetscInt *api,*apj,*Jptr,apnz,*prmap=p->garray,pon,nspacedouble=0,j,ap_rmax=0; PetscReal afill=1.0,afill_tmp; PetscInt rmax; #if defined(PTAP_PROFILE) PetscLogDouble t0,t1,t2,t3,t4; #endif PetscFunctionBegin; ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr); #if defined(PTAP_PROFILE) ierr = PetscTime(&t0);CHKERRQ(ierr); #endif /* check if matrix local sizes are compatible */ if (A->rmap->rstart != P->rmap->rstart || A->rmap->rend != P->rmap->rend) { SETERRQ4(comm,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, Arow (%D, %D) != Prow (%D,%D)",A->rmap->rstart,A->rmap->rend,P->rmap->rstart,P->rmap->rend); } if (A->cmap->rstart != P->rmap->rstart || A->cmap->rend != P->rmap->rend) { SETERRQ4(comm,PETSC_ERR_ARG_SIZ,"Matrix local dimensions are incompatible, Acol (%D, %D) != Prow (%D,%D)",A->cmap->rstart,A->cmap->rend,P->rmap->rstart,P->rmap->rend); } ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); /* create struct Mat_PtAPMPI and attached it to C later */ ierr = PetscNew(&ptap);CHKERRQ(ierr); ierr = PetscNew(&merge);CHKERRQ(ierr); ptap->merge = merge; ptap->reuse = MAT_INITIAL_MATRIX; /* get P_oth by taking rows of P (= non-zero cols of local A) from other processors */ ierr = MatGetBrowsOfAoCols_MPIAIJ(A,P,MAT_INITIAL_MATRIX,&ptap->startsj_s,&ptap->startsj_r,&ptap->bufa,&ptap->P_oth);CHKERRQ(ierr); /* get P_loc by taking all local rows of P */ ierr = MatMPIAIJGetLocalMat(P,MAT_INITIAL_MATRIX,&ptap->P_loc);CHKERRQ(ierr); p_loc = (Mat_SeqAIJ*)(ptap->P_loc)->data; p_oth = (Mat_SeqAIJ*)(ptap->P_oth)->data; pi_loc = p_loc->i; pj_loc = p_loc->j; pi_oth = p_oth->i; pj_oth = p_oth->j; #if defined(PTAP_PROFILE) ierr = PetscTime(&t1);CHKERRQ(ierr); #endif /* first, compute symbolic AP = A_loc*P = A_diag*P_loc + A_off*P_oth */ /*-------------------------------------------------------------------*/ ierr = PetscMalloc1((am+1),&api);CHKERRQ(ierr); api[0] = 0; /* create and initialize a linked list */ ierr = PetscLLCondensedCreate(pN,pN,&lnk,&lnkbt);CHKERRQ(ierr); /* Initial FreeSpace size is fill*(nnz(A) + nnz(P)) -OOM for ex56, np=8k on Intrepid! */ ierr = PetscFreeSpaceGet((PetscInt)(fill*(adi[am]+aoi[am]+pi_loc[pm])),&free_space);CHKERRQ(ierr); current_space = free_space; for (i=0; i<am; i++) { /* diagonal portion of A */ nzi = adi[i+1] - adi[i]; aj = ad->j + adi[i]; for (j=0; j<nzi; j++) { row = aj[j]; pnz = pi_loc[row+1] - pi_loc[row]; Jptr = pj_loc + pi_loc[row]; /* add non-zero cols of P into the sorted linked list lnk */ ierr = PetscLLCondensedAddSorted(pnz,Jptr,lnk,lnkbt);CHKERRQ(ierr); } /* off-diagonal portion of A */ nzi = aoi[i+1] - aoi[i]; aj = ao->j + aoi[i]; for (j=0; j<nzi; j++) { row = aj[j]; pnz = pi_oth[row+1] - pi_oth[row]; Jptr = pj_oth + pi_oth[row]; ierr = PetscLLCondensedAddSorted(pnz,Jptr,lnk,lnkbt);CHKERRQ(ierr); } apnz = lnk[0]; api[i+1] = api[i] + apnz; if (ap_rmax < apnz) ap_rmax = apnz; /* if free space is not available, double the total space in the list */ if (current_space->local_remaining<apnz) { ierr = PetscFreeSpaceGet(apnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr); nspacedouble++; } /* Copy data into free space, then initialize lnk */ ierr = PetscLLCondensedClean(pN,apnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr); current_space->array += apnz; current_space->local_used += apnz; current_space->local_remaining -= apnz; } /* Allocate space for apj, initialize apj, and */ /* destroy list of free space and other temporary array(s) */ ierr = PetscMalloc1((api[am]+1),&apj);CHKERRQ(ierr); ierr = PetscFreeSpaceContiguous(&free_space,apj);CHKERRQ(ierr); afill_tmp = (PetscReal)api[am]/(adi[am]+aoi[am]+pi_loc[pm]+1); if (afill_tmp > afill) afill = afill_tmp; #if defined(PTAP_PROFILE) ierr = PetscTime(&t2);CHKERRQ(ierr); #endif /* determine symbolic Co=(p->B)^T*AP - send to others */ /*----------------------------------------------------*/ ierr = MatGetSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);CHKERRQ(ierr); /* then, compute symbolic Co = (p->B)^T*AP */ pon = (p->B)->cmap->n; /* total num of rows to be sent to other processors >= (num of nonzero rows of C_seq) - pn */ ierr = PetscMalloc1((pon+1),&coi);CHKERRQ(ierr); coi[0] = 0; /* set initial free space to be fill*(nnz(p->B) + nnz(AP)) */ nnz = fill*(poti[pon] + api[am]); ierr = PetscFreeSpaceGet(nnz,&free_space);CHKERRQ(ierr); current_space = free_space; for (i=0; i<pon; i++) { pnz = poti[i+1] - poti[i]; ptJ = potj + poti[i]; for (j=0; j<pnz; j++) { row = ptJ[j]; /* row of AP == col of Pot */ apnz = api[row+1] - api[row]; Jptr = apj + api[row]; /* add non-zero cols of AP into the sorted linked list lnk */ ierr = PetscLLCondensedAddSorted(apnz,Jptr,lnk,lnkbt);CHKERRQ(ierr); } nnz = lnk[0]; /* If free space is not available, double the total space in the list */ if (current_space->local_remaining<nnz) { ierr = PetscFreeSpaceGet(nnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr); nspacedouble++; } /* Copy data into free space, and zero out denserows */ ierr = PetscLLCondensedClean(pN,nnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr); current_space->array += nnz; current_space->local_used += nnz; current_space->local_remaining -= nnz; coi[i+1] = coi[i] + nnz; } ierr = PetscMalloc1((coi[pon]+1),&coj);CHKERRQ(ierr); ierr = PetscFreeSpaceContiguous(&free_space,coj);CHKERRQ(ierr); afill_tmp = (PetscReal)coi[pon]/(poti[pon] + api[am]+1); if (afill_tmp > afill) afill = afill_tmp; ierr = MatRestoreSymbolicTranspose_SeqAIJ(p->B,&poti,&potj);CHKERRQ(ierr); /* send j-array (coj) of Co to other processors */ /*----------------------------------------------*/ /* determine row ownership */ ierr = PetscLayoutCreate(comm,&merge->rowmap);CHKERRQ(ierr); merge->rowmap->n = pn; merge->rowmap->bs = 1; ierr = PetscLayoutSetUp(merge->rowmap);CHKERRQ(ierr); owners = merge->rowmap->range; /* determine the number of messages to send, their lengths */ ierr = PetscMalloc2(size,&len_si,size,&sstatus);CHKERRQ(ierr); ierr = PetscMemzero(len_si,size*sizeof(PetscMPIInt));CHKERRQ(ierr); ierr = PetscCalloc1(size,&merge->len_s);CHKERRQ(ierr); len_s = merge->len_s; merge->nsend = 0; ierr = PetscMalloc1((size+2),&owners_co);CHKERRQ(ierr); proc = 0; for (i=0; i<pon; i++) { while (prmap[i] >= owners[proc+1]) proc++; len_si[proc]++; /* num of rows in Co to be sent to [proc] */ len_s[proc] += coi[i+1] - coi[i]; } len = 0; /* max length of buf_si[] */ owners_co[0] = 0; for (proc=0; proc<size; proc++) { owners_co[proc+1] = owners_co[proc] + len_si[proc]; if (len_si[proc]) { merge->nsend++; len_si[proc] = 2*(len_si[proc] + 1); len += len_si[proc]; } } /* determine the number and length of messages to receive for coi and coj */ ierr = PetscGatherNumberOfMessages(comm,NULL,len_s,&merge->nrecv);CHKERRQ(ierr); ierr = PetscGatherMessageLengths2(comm,merge->nsend,merge->nrecv,len_s,len_si,&merge->id_r,&merge->len_r,&len_ri);CHKERRQ(ierr); /* post the Irecv and Isend of coj */ ierr = PetscCommGetNewTag(comm,&tagj);CHKERRQ(ierr); ierr = PetscPostIrecvInt(comm,tagj,merge->nrecv,merge->id_r,merge->len_r,&buf_rj,&rwaits);CHKERRQ(ierr); ierr = PetscMalloc1((merge->nsend+1),&swaits);CHKERRQ(ierr); for (proc=0, k=0; proc<size; proc++) { if (!len_s[proc]) continue; i = owners_co[proc]; ierr = MPI_Isend(coj+coi[i],len_s[proc],MPIU_INT,proc,tagj,comm,swaits+k);CHKERRQ(ierr); k++; } /* receives and sends of coj are complete */ for (i=0; i<merge->nrecv; i++) { ierr = MPI_Waitany(merge->nrecv,rwaits,&icompleted,&rstatus);CHKERRQ(ierr); } ierr = PetscFree(rwaits);CHKERRQ(ierr); if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,swaits,sstatus);CHKERRQ(ierr);} /* send and recv coi */ /*-------------------*/ ierr = PetscCommGetNewTag(comm,&tagi);CHKERRQ(ierr); ierr = PetscPostIrecvInt(comm,tagi,merge->nrecv,merge->id_r,len_ri,&buf_ri,&rwaits);CHKERRQ(ierr); ierr = PetscMalloc1((len+1),&buf_s);CHKERRQ(ierr); buf_si = buf_s; /* points to the beginning of k-th msg to be sent */ for (proc=0,k=0; proc<size; proc++) { if (!len_s[proc]) continue; /* form outgoing message for i-structure: buf_si[0]: nrows to be sent [1:nrows]: row index (global) [nrows+1:2*nrows+1]: i-structure index */ /*-------------------------------------------*/ nrows = len_si[proc]/2 - 1; buf_si_i = buf_si + nrows+1; buf_si[0] = nrows; buf_si_i[0] = 0; nrows = 0; for (i=owners_co[proc]; i<owners_co[proc+1]; i++) { nzi = coi[i+1] - coi[i]; buf_si_i[nrows+1] = buf_si_i[nrows] + nzi; /* i-structure */ buf_si[nrows+1] = prmap[i] -owners[proc]; /* local row index */ nrows++; } ierr = MPI_Isend(buf_si,len_si[proc],MPIU_INT,proc,tagi,comm,swaits+k);CHKERRQ(ierr); k++; buf_si += len_si[proc]; } i = merge->nrecv; while (i--) { ierr = MPI_Waitany(merge->nrecv,rwaits,&icompleted,&rstatus);CHKERRQ(ierr); } ierr = PetscFree(rwaits);CHKERRQ(ierr); if (merge->nsend) {ierr = MPI_Waitall(merge->nsend,swaits,sstatus);CHKERRQ(ierr);} ierr = PetscFree2(len_si,sstatus);CHKERRQ(ierr); ierr = PetscFree(len_ri);CHKERRQ(ierr); ierr = PetscFree(swaits);CHKERRQ(ierr); ierr = PetscFree(buf_s);CHKERRQ(ierr); #if defined(PTAP_PROFILE) ierr = PetscTime(&t3);CHKERRQ(ierr); #endif /* compute the local portion of C (mpi mat) */ /*------------------------------------------*/ ierr = MatGetSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);CHKERRQ(ierr); /* allocate pti array and free space for accumulating nonzero column info */ ierr = PetscMalloc1((pn+1),&pti);CHKERRQ(ierr); pti[0] = 0; /* set initial free space to be fill*(nnz(P) + nnz(AP)) */ nnz = fill*(pi_loc[pm] + api[am]); ierr = PetscFreeSpaceGet(nnz,&free_space);CHKERRQ(ierr); current_space = free_space; ierr = PetscMalloc3(merge->nrecv,&buf_ri_k,merge->nrecv,&nextrow,merge->nrecv,&nextci);CHKERRQ(ierr); for (k=0; k<merge->nrecv; k++) { buf_ri_k[k] = buf_ri[k]; /* beginning of k-th recved i-structure */ nrows = *buf_ri_k[k]; nextrow[k] = buf_ri_k[k] + 1; /* next row number of k-th recved i-structure */ nextci[k] = buf_ri_k[k] + (nrows + 1); /* poins to the next i-structure of k-th recved i-structure */ } ierr = MatPreallocateInitialize(comm,pn,pn,dnz,onz);CHKERRQ(ierr); rmax = 0; for (i=0; i<pn; i++) { /* add pdt[i,:]*AP into lnk */ pnz = pdti[i+1] - pdti[i]; ptJ = pdtj + pdti[i]; for (j=0; j<pnz; j++) { row = ptJ[j]; /* row of AP == col of Pt */ apnz = api[row+1] - api[row]; Jptr = apj + api[row]; /* add non-zero cols of AP into the sorted linked list lnk */ ierr = PetscLLCondensedAddSorted(apnz,Jptr,lnk,lnkbt);CHKERRQ(ierr); } /* add received col data into lnk */ for (k=0; k<merge->nrecv; k++) { /* k-th received message */ if (i == *nextrow[k]) { /* i-th row */ nzi = *(nextci[k]+1) - *nextci[k]; Jptr = buf_rj[k] + *nextci[k]; ierr = PetscLLCondensedAddSorted(nzi,Jptr,lnk,lnkbt);CHKERRQ(ierr); nextrow[k]++; nextci[k]++; } } nnz = lnk[0]; /* if free space is not available, make more free space */ if (current_space->local_remaining<nnz) { ierr = PetscFreeSpaceGet(nnz+current_space->total_array_size,¤t_space);CHKERRQ(ierr); nspacedouble++; } /* copy data into free space, then initialize lnk */ ierr = PetscLLCondensedClean(pN,nnz,current_space->array,lnk,lnkbt);CHKERRQ(ierr); ierr = MatPreallocateSet(i+owners[rank],nnz,current_space->array,dnz,onz);CHKERRQ(ierr); current_space->array += nnz; current_space->local_used += nnz; current_space->local_remaining -= nnz; pti[i+1] = pti[i] + nnz; if (nnz > rmax) rmax = nnz; } ierr = MatRestoreSymbolicTranspose_SeqAIJ(p->A,&pdti,&pdtj);CHKERRQ(ierr); ierr = PetscFree3(buf_ri_k,nextrow,nextci);CHKERRQ(ierr); ierr = PetscMalloc1((pti[pn]+1),&ptj);CHKERRQ(ierr); ierr = PetscFreeSpaceContiguous(&free_space,ptj);CHKERRQ(ierr); afill_tmp = (PetscReal)pti[pn]/(pi_loc[pm] + api[am]+1); if (afill_tmp > afill) afill = afill_tmp; ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr); /* create symbolic parallel matrix Cmpi */ /*--------------------------------------*/ ierr = MatCreate(comm,&Cmpi);CHKERRQ(ierr); ierr = MatSetSizes(Cmpi,pn,pn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetBlockSizes(Cmpi,P->cmap->bs,P->cmap->bs);CHKERRQ(ierr); ierr = MatSetType(Cmpi,MATMPIAIJ);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(Cmpi,0,dnz,0,onz);CHKERRQ(ierr); ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr); merge->bi = pti; /* Cseq->i */ merge->bj = ptj; /* Cseq->j */ merge->coi = coi; /* Co->i */ merge->coj = coj; /* Co->j */ merge->buf_ri = buf_ri; merge->buf_rj = buf_rj; merge->owners_co = owners_co; merge->destroy = Cmpi->ops->destroy; merge->duplicate = Cmpi->ops->duplicate; /* Cmpi is not ready for use - assembly will be done by MatPtAPNumeric() */ Cmpi->assembled = PETSC_FALSE; Cmpi->ops->destroy = MatDestroy_MPIAIJ_PtAP; Cmpi->ops->duplicate = MatDuplicate_MPIAIJ_MatPtAP; /* attach the supporting struct to Cmpi for reuse */ c = (Mat_MPIAIJ*)Cmpi->data; c->ptap = ptap; ptap->api = api; ptap->apj = apj; ptap->rmax = ap_rmax; *C = Cmpi; /* flag 'scalable' determines which implementations to be used: 0: do dense axpy in MatPtAPNumeric() - fast, but requires storage of a nonscalable dense array apa; 1: do sparse axpy in MatPtAPNumeric() - might slow, uses a sparse array apa */ /* set default scalable */ ptap->scalable = PETSC_TRUE; ierr = PetscOptionsGetBool(((PetscObject)Cmpi)->prefix,"-matptap_scalable",&ptap->scalable,NULL);CHKERRQ(ierr); if (!ptap->scalable) { /* Do dense axpy */ ierr = PetscCalloc1(pN,&ptap->apa);CHKERRQ(ierr); } else { ierr = PetscCalloc1(ap_rmax+1,&ptap->apa);CHKERRQ(ierr); } #if defined(PTAP_PROFILE) ierr = PetscTime(&t4);CHKERRQ(ierr); if (rank==1) PetscPrintf(MPI_COMM_SELF," [%d] PtAPSymbolic %g/P + %g/AP + %g/comm + %g/PtAP = %g\n",rank,t1-t0,t2-t1,t3-t2,t4-t3,t4-t0);CHKERRQ(ierr); #endif #if defined(PETSC_USE_INFO) if (pti[pn] != 0) { ierr = PetscInfo3(Cmpi,"Reallocs %D; Fill ratio: given %G needed %G.\n",nspacedouble,fill,afill);CHKERRQ(ierr); ierr = PetscInfo1(Cmpi,"Use MatPtAP(A,P,MatReuse,%G,&C) for best performance.\n",afill);CHKERRQ(ierr); } else { ierr = PetscInfo(Cmpi,"Empty matrix product\n");CHKERRQ(ierr); } #endif PetscFunctionReturn(0); }
PetscErrorCode DMInterpolationSetUp(DMInterpolationInfo ctx, DM dm, PetscBool redundantPoints) { MPI_Comm comm = ctx->comm; PetscScalar *a; PetscInt p, q, i; PetscMPIInt rank, size; PetscErrorCode ierr; Vec pointVec; IS cellIS; PetscLayout layout; PetscReal *globalPoints; PetscScalar *globalPointsScalar; const PetscInt *ranges; PetscMPIInt *counts, *displs; const PetscInt *foundCells; PetscMPIInt *foundProcs, *globalProcs; PetscInt n, N; PetscFunctionBegin; PetscValidHeaderSpecific(dm, DM_CLASSID, 1); ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr); ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr); if (ctx->dim < 0) SETERRQ(comm, PETSC_ERR_ARG_WRONGSTATE, "The spatial dimension has not been set"); /* Locate points */ n = ctx->nInput; if (!redundantPoints) { ierr = PetscLayoutCreate(comm, &layout);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize(layout, 1);CHKERRQ(ierr); ierr = PetscLayoutSetLocalSize(layout, n);CHKERRQ(ierr); ierr = PetscLayoutSetUp(layout);CHKERRQ(ierr); ierr = PetscLayoutGetSize(layout, &N);CHKERRQ(ierr); /* Communicate all points to all processes */ ierr = PetscMalloc3(N*ctx->dim,&globalPoints,size,&counts,size,&displs);CHKERRQ(ierr); ierr = PetscLayoutGetRanges(layout, &ranges);CHKERRQ(ierr); for (p = 0; p < size; ++p) { counts[p] = (ranges[p+1] - ranges[p])*ctx->dim; displs[p] = ranges[p]*ctx->dim; } ierr = MPI_Allgatherv(ctx->points, n*ctx->dim, MPIU_REAL, globalPoints, counts, displs, MPIU_REAL, comm);CHKERRQ(ierr); } else { N = n; globalPoints = ctx->points; counts = displs = NULL; layout = NULL; } #if 0 ierr = PetscMalloc3(N,&foundCells,N,&foundProcs,N,&globalProcs);CHKERRQ(ierr); /* foundCells[p] = m->locatePoint(&globalPoints[p*ctx->dim]); */ #else #if defined(PETSC_USE_COMPLEX) ierr = PetscMalloc1(N,&globalPointsScalar);CHKERRQ(ierr); for (i=0; i<N; i++) globalPointsScalar[i] = globalPoints[i]; #else globalPointsScalar = globalPoints; #endif ierr = VecCreateSeqWithArray(PETSC_COMM_SELF, ctx->dim, N*ctx->dim, globalPointsScalar, &pointVec);CHKERRQ(ierr); ierr = PetscMalloc2(N,&foundProcs,N,&globalProcs);CHKERRQ(ierr); ierr = DMLocatePoints(dm, pointVec, &cellIS);CHKERRQ(ierr); ierr = ISGetIndices(cellIS, &foundCells);CHKERRQ(ierr); #endif for (p = 0; p < N; ++p) { if (foundCells[p] >= 0) foundProcs[p] = rank; else foundProcs[p] = size; } /* Let the lowest rank process own each point */ ierr = MPI_Allreduce(foundProcs, globalProcs, N, MPI_INT, MPI_MIN, comm);CHKERRQ(ierr); ctx->n = 0; for (p = 0; p < N; ++p) { if (globalProcs[p] == size) SETERRQ4(comm, PETSC_ERR_PLIB, "Point %d: %g %g %g not located in mesh", p, globalPoints[p*ctx->dim+0], ctx->dim > 1 ? globalPoints[p*ctx->dim+1] : 0.0, ctx->dim > 2 ? globalPoints[p*ctx->dim+2] : 0.0); else if (globalProcs[p] == rank) ctx->n++; } /* Create coordinates vector and array of owned cells */ ierr = PetscMalloc1(ctx->n, &ctx->cells);CHKERRQ(ierr); ierr = VecCreate(comm, &ctx->coords);CHKERRQ(ierr); ierr = VecSetSizes(ctx->coords, ctx->n*ctx->dim, PETSC_DECIDE);CHKERRQ(ierr); ierr = VecSetBlockSize(ctx->coords, ctx->dim);CHKERRQ(ierr); ierr = VecSetType(ctx->coords,VECSTANDARD);CHKERRQ(ierr); ierr = VecGetArray(ctx->coords, &a);CHKERRQ(ierr); for (p = 0, q = 0, i = 0; p < N; ++p) { if (globalProcs[p] == rank) { PetscInt d; for (d = 0; d < ctx->dim; ++d, ++i) a[i] = globalPoints[p*ctx->dim+d]; ctx->cells[q++] = foundCells[p]; } } ierr = VecRestoreArray(ctx->coords, &a);CHKERRQ(ierr); #if 0 ierr = PetscFree3(foundCells,foundProcs,globalProcs);CHKERRQ(ierr); #else ierr = PetscFree2(foundProcs,globalProcs);CHKERRQ(ierr); ierr = ISRestoreIndices(cellIS, &foundCells);CHKERRQ(ierr); ierr = ISDestroy(&cellIS);CHKERRQ(ierr); ierr = VecDestroy(&pointVec);CHKERRQ(ierr); #endif if ((void*)globalPointsScalar != (void*)globalPoints) {ierr = PetscFree(globalPointsScalar);CHKERRQ(ierr);} if (!redundantPoints) {ierr = PetscFree3(globalPoints,counts,displs);CHKERRQ(ierr);} ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode DMPlexPreallocateOperator(DM dm, PetscInt bs, PetscSection section, PetscSection sectionGlobal, PetscInt dnz[], PetscInt onz[], PetscInt dnzu[], PetscInt onzu[], Mat A, PetscBool fillMatrix) { MPI_Comm comm; MatType mtype; PetscSF sf, sfDof, sfAdj; PetscSection leafSectionAdj, rootSectionAdj, sectionAdj, anchorSectionAdj; PetscInt nroots, nleaves, l, p; const PetscInt *leaves; const PetscSFNode *remotes; PetscInt dim, pStart, pEnd, numDof, globalOffStart, globalOffEnd, numCols; PetscInt *tmpAdj = NULL, *adj, *rootAdj, *anchorAdj = NULL, *cols, *remoteOffsets; PetscInt adjSize; PetscLayout rLayout; PetscInt locRows, rStart, rEnd, r; PetscMPIInt size; PetscBool doCommLocal, doComm, debug = PETSC_FALSE, isSymBlock, isSymSeqBlock, isSymMPIBlock; PetscBool useAnchors; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(dm, DM_CLASSID, 1); PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 3); PetscValidHeaderSpecific(sectionGlobal, PETSC_SECTION_CLASSID, 4); PetscValidHeaderSpecific(A, MAT_CLASSID, 9); if (dnz) PetscValidPointer(dnz,5); if (onz) PetscValidPointer(onz,6); if (dnzu) PetscValidPointer(dnzu,7); if (onzu) PetscValidPointer(onzu,8); ierr = PetscLogEventBegin(DMPLEX_Preallocate,dm,0,0,0);CHKERRQ(ierr); ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL, "-dm_view_preallocation", &debug, NULL);CHKERRQ(ierr); ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr); ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr); ierr = PetscSFGetGraph(sf, &nroots, NULL, NULL, NULL);CHKERRQ(ierr); doCommLocal = (size > 1) && (nroots >= 0) ? PETSC_TRUE : PETSC_FALSE; ierr = MPI_Allreduce(&doCommLocal, &doComm, 1, MPIU_BOOL, MPI_LAND, comm);CHKERRQ(ierr); /* Create dof SF based on point SF */ if (debug) { ierr = PetscPrintf(comm, "Input Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(section, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Input Global Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(sectionGlobal, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Input SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sf, NULL);CHKERRQ(ierr); } ierr = PetscSFCreateRemoteOffsets(sf, section, section, &remoteOffsets);CHKERRQ(ierr); ierr = PetscSFCreateSectionSF(sf, section, remoteOffsets, section, &sfDof);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Dof SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sfDof, NULL);CHKERRQ(ierr); } /* Create section for dof adjacency (dof ==> # adj dof) */ ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr); ierr = PetscSectionGetStorageSize(section, &numDof);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, &leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(leafSectionAdj, 0, numDof);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, &rootSectionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(rootSectionAdj, 0, numDof);CHKERRQ(ierr); /* Fill in the ghost dofs on the interface */ ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, &remotes);CHKERRQ(ierr); /* use constraints in finding adjacency in this routine */ ierr = DMPlexGetAdjacencyUseAnchors(dm,&useAnchors);CHKERRQ(ierr); ierr = DMPlexSetAdjacencyUseAnchors(dm,PETSC_TRUE);CHKERRQ(ierr); /* section - maps points to (# dofs, local dofs) sectionGlobal - maps points to (# dofs, global dofs) leafSectionAdj - maps unowned local dofs to # adj dofs rootSectionAdj - maps owned local dofs to # adj dofs adj - adj global dofs indexed by leafSectionAdj rootAdj - adj global dofs indexed by rootSectionAdj sf - describes shared points across procs sfDof - describes shared dofs across procs sfAdj - describes shared adjacent dofs across procs ** The bootstrapping process involves six rounds with similar structure of visiting neighbors of each point. (0). If there are point-to-point constraints, add the adjacencies of constrained points to anchors in anchorAdj (This is done in DMPlexComputeAnchorAdjacencies()) 1. Visit unowned points on interface, count adjacencies placing in leafSectionAdj Reduce those counts to rootSectionAdj (now redundantly counting some interface points) 2. Visit owned points on interface, count adjacencies placing in rootSectionAdj Create sfAdj connecting rootSectionAdj and leafSectionAdj 3. Visit unowned points on interface, write adjacencies to adj Gather adj to rootAdj (note that there is redundancy in rootAdj when multiple procs find the same adjacencies) 4. Visit owned points on interface, write adjacencies to rootAdj Remove redundancy in rootAdj ** The last two traversals use transitive closure 5. Visit all owned points in the subdomain, count dofs for each point (sectionAdj) Allocate memory addressed by sectionAdj (cols) 6. Visit all owned points in the subdomain, insert dof adjacencies into cols ** Knowing all the column adjacencies, check ownership and sum into dnz and onz */ ierr = DMPlexComputeAnchorAdjacencies(dm,section,sectionGlobal,&anchorSectionAdj,&anchorAdj);CHKERRQ(ierr); for (l = 0; l < nleaves; ++l) { PetscInt dof, off, d, q, anDof; PetscInt p = leaves[l], numAdj = PETSC_DETERMINE; if ((p < pStart) || (p >= pEnd)) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(leafSectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(leafSectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency Section for Preallocation on Leaves:\n");CHKERRQ(ierr); ierr = PetscSectionView(leafSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Get maximum remote adjacency sizes for owned dofs on interface (roots) */ if (doComm) { ierr = PetscSFReduceBegin(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr); ierr = PetscSFReduceEnd(sfDof, MPIU_INT, leafSectionAdj->atlasDof, rootSectionAdj->atlasDof, MPI_SUM);CHKERRQ(ierr); } if (debug) { ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Add in local adjacency sizes for owned dofs on interface (roots) */ for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, adof, dof, off, d, q, anDof; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(rootSectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = off; d < off+dof; ++d) { ierr = PetscSectionAddDof(rootSectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after local additions:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Create adj SF based on dof SF */ ierr = PetscSFCreateRemoteOffsets(sfDof, rootSectionAdj, leafSectionAdj, &remoteOffsets);CHKERRQ(ierr); ierr = PetscSFCreateSectionSF(sfDof, rootSectionAdj, remoteOffsets, leafSectionAdj, &sfAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency SF for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSFView(sfAdj, NULL);CHKERRQ(ierr); } ierr = PetscSFDestroy(&sfDof);CHKERRQ(ierr); /* Create leaf adjacency */ ierr = PetscSectionSetUp(leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionGetStorageSize(leafSectionAdj, &adjSize);CHKERRQ(ierr); ierr = PetscCalloc1(adjSize, &adj);CHKERRQ(ierr); for (l = 0; l < nleaves; ++l) { PetscInt dof, off, d, q, anDof, anOff; PetscInt p = leaves[l], numAdj = PETSC_DETERMINE; if ((p < pStart) || (p >= pEnd)) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { PetscInt aoff, i = 0; ierr = PetscSectionGetOffset(leafSectionAdj, d, &aoff);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd) { adj[aoff+i] = (ngoff < 0 ? -(ngoff+1) : ngoff) + nd; ++i; } } for (q = 0; q < anDof; q++) { adj[aoff+i] = anchorAdj[anOff+q]; ++i; } } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Leaf adjacency indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, adj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Gather adjacenct indices to root */ ierr = PetscSectionGetStorageSize(rootSectionAdj, &adjSize);CHKERRQ(ierr); ierr = PetscMalloc1(adjSize, &rootAdj);CHKERRQ(ierr); for (r = 0; r < adjSize; ++r) rootAdj[r] = -1; if (doComm) { ierr = PetscSFGatherBegin(sfAdj, MPIU_INT, adj, rootAdj);CHKERRQ(ierr); ierr = PetscSFGatherEnd(sfAdj, MPIU_INT, adj, rootAdj);CHKERRQ(ierr); } ierr = PetscSFDestroy(&sfAdj);CHKERRQ(ierr); ierr = PetscFree(adj);CHKERRQ(ierr); /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Root adjacency indices after gather\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Add in local adjacency indices for owned dofs on interface (roots) */ for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, adof, dof, off, d, q, anDof, anOff; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = off; d < off+dof; ++d) { PetscInt adof, aoff, i; ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr); i = adof-1; for (q = 0; q < anDof; q++) { rootAdj[aoff+i] = anchorAdj[anOff+q]; --i; } for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd) { rootAdj[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd; --i; } } } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Root adjacency indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Compress indices */ ierr = PetscSectionSetUp(rootSectionAdj);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt dof, cdof, off, d; PetscInt adof, aoff; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); if (!dof) continue; ierr = PetscSectionGetDof(rootSectionAdj, off, &adof);CHKERRQ(ierr); if (adof <= 0) continue; for (d = off; d < off+dof-cdof; ++d) { ierr = PetscSectionGetDof(rootSectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, d, &aoff);CHKERRQ(ierr); ierr = PetscSortRemoveDupsInt(&adof, &rootAdj[aoff]);CHKERRQ(ierr); ierr = PetscSectionSetDof(rootSectionAdj, d, adof);CHKERRQ(ierr); } } /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Adjancency Section for Preallocation on Roots after compression:\n");CHKERRQ(ierr); ierr = PetscSectionView(rootSectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(comm, "Root adjacency indices after compression\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, adjSize, rootAdj, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Build adjacency section: Maps global indices to sets of adjacent global indices */ ierr = PetscSectionGetOffsetRange(sectionGlobal, &globalOffStart, &globalOffEnd);CHKERRQ(ierr); ierr = PetscSectionCreate(comm, §ionAdj);CHKERRQ(ierr); ierr = PetscSectionSetChart(sectionAdj, globalOffStart, globalOffEnd);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, dof, cdof, off, goff, d, q, anDof; PetscBool found = PETSC_TRUE; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); for (d = 0; d < dof-cdof; ++d) { PetscInt ldof, rdof; ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr); ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr); if (ldof > 0) { /* We do not own this point */ } else if (rdof > 0) { ierr = PetscSectionSetDof(sectionAdj, goff+d, rdof);CHKERRQ(ierr); } else { found = PETSC_FALSE; } } if (found) continue; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, noff; if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, padj, &noff);CHKERRQ(ierr); for (d = goff; d < goff+dof-cdof; ++d) { ierr = PetscSectionAddDof(sectionAdj, d, ndof-ncdof);CHKERRQ(ierr); } } ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); if (anDof) { for (d = goff; d < goff+dof-cdof; ++d) { ierr = PetscSectionAddDof(sectionAdj, d, anDof);CHKERRQ(ierr); } } } ierr = PetscSectionSetUp(sectionAdj);CHKERRQ(ierr); if (debug) { ierr = PetscPrintf(comm, "Adjacency Section for Preallocation:\n");CHKERRQ(ierr); ierr = PetscSectionView(sectionAdj, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Get adjacent indices */ ierr = PetscSectionGetStorageSize(sectionAdj, &numCols);CHKERRQ(ierr); ierr = PetscMalloc1(numCols, &cols);CHKERRQ(ierr); for (p = pStart; p < pEnd; ++p) { PetscInt numAdj = PETSC_DETERMINE, dof, cdof, off, goff, d, q, anDof, anOff; PetscBool found = PETSC_TRUE; ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, p, &goff);CHKERRQ(ierr); for (d = 0; d < dof-cdof; ++d) { PetscInt ldof, rdof; ierr = PetscSectionGetDof(leafSectionAdj, off+d, &ldof);CHKERRQ(ierr); ierr = PetscSectionGetDof(rootSectionAdj, off+d, &rdof);CHKERRQ(ierr); if (ldof > 0) { /* We do not own this point */ } else if (rdof > 0) { PetscInt aoff, roff; ierr = PetscSectionGetOffset(sectionAdj, goff+d, &aoff);CHKERRQ(ierr); ierr = PetscSectionGetOffset(rootSectionAdj, off+d, &roff);CHKERRQ(ierr); ierr = PetscMemcpy(&cols[aoff], &rootAdj[roff], rdof * sizeof(PetscInt));CHKERRQ(ierr); } else { found = PETSC_FALSE; } } if (found) continue; ierr = DMPlexGetAdjacency(dm, p, &numAdj, &tmpAdj);CHKERRQ(ierr); ierr = PetscSectionGetDof(anchorSectionAdj, p, &anDof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(anchorSectionAdj, p, &anOff);CHKERRQ(ierr); for (d = goff; d < goff+dof-cdof; ++d) { PetscInt adof, aoff, i = 0; ierr = PetscSectionGetDof(sectionAdj, d, &adof);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, d, &aoff);CHKERRQ(ierr); for (q = 0; q < numAdj; ++q) { const PetscInt padj = tmpAdj[q]; PetscInt ndof, ncdof, ngoff, nd; const PetscInt *ncind; /* Adjacent points may not be in the section chart */ if ((padj < pStart) || (padj >= pEnd)) continue; ierr = PetscSectionGetDof(section, padj, &ndof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintDof(section, padj, &ncdof);CHKERRQ(ierr); ierr = PetscSectionGetConstraintIndices(section, padj, &ncind);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionGlobal, padj, &ngoff);CHKERRQ(ierr); for (nd = 0; nd < ndof-ncdof; ++nd, ++i) { cols[aoff+i] = ngoff < 0 ? -(ngoff+1)+nd : ngoff+nd; } } for (q = 0; q < anDof; q++, i++) { cols[aoff+i] = anchorAdj[anOff + q]; } if (i != adof) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of entries %D != %D for dof %D (point %D)", i, adof, d, p); } } ierr = PetscSectionDestroy(&anchorSectionAdj);CHKERRQ(ierr); ierr = PetscSectionDestroy(&leafSectionAdj);CHKERRQ(ierr); ierr = PetscSectionDestroy(&rootSectionAdj);CHKERRQ(ierr); ierr = PetscFree(anchorAdj);CHKERRQ(ierr); ierr = PetscFree(rootAdj);CHKERRQ(ierr); ierr = PetscFree(tmpAdj);CHKERRQ(ierr); /* Debugging */ if (debug) { IS tmp; ierr = PetscPrintf(comm, "Column indices\n");CHKERRQ(ierr); ierr = ISCreateGeneral(comm, numCols, cols, PETSC_USE_POINTER, &tmp);CHKERRQ(ierr); ierr = ISView(tmp, NULL);CHKERRQ(ierr); ierr = ISDestroy(&tmp);CHKERRQ(ierr); } /* Create allocation vectors from adjacency graph */ ierr = MatGetLocalSize(A, &locRows, NULL);CHKERRQ(ierr); ierr = PetscLayoutCreate(PetscObjectComm((PetscObject)A), &rLayout);CHKERRQ(ierr); ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); /* Only loop over blocks of rows */ if (rStart%bs || rEnd%bs) SETERRQ3(PetscObjectComm((PetscObject)A), PETSC_ERR_ARG_WRONG, "Invalid layout [%d, %d) for matrix, must be divisible by block size %d", rStart, rEnd, bs); for (r = rStart/bs; r < rEnd/bs; ++r) { const PetscInt row = r*bs; PetscInt numCols, cStart, c; ierr = PetscSectionGetDof(sectionAdj, row, &numCols);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, row, &cStart);CHKERRQ(ierr); for (c = cStart; c < cStart+numCols; ++c) { if ((cols[c] >= rStart*bs) && (cols[c] < rEnd*bs)) { ++dnz[r-rStart]; if (cols[c] >= row) ++dnzu[r-rStart]; } else { ++onz[r-rStart]; if (cols[c] >= row) ++onzu[r-rStart]; } } } if (bs > 1) { for (r = 0; r < locRows/bs; ++r) { dnz[r] /= bs; onz[r] /= bs; dnzu[r] /= bs; onzu[r] /= bs; } } /* Set matrix pattern */ ierr = MatXAIJSetPreallocation(A, bs, dnz, onz, dnzu, onzu);CHKERRQ(ierr); ierr = MatSetOption(A, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); /* Check for symmetric storage */ ierr = MatGetType(A, &mtype);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr); ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr); if (isSymBlock || isSymSeqBlock || isSymMPIBlock) {ierr = MatSetOption(A, MAT_IGNORE_LOWER_TRIANGULAR, PETSC_TRUE);CHKERRQ(ierr);} /* Fill matrix with zeros */ if (fillMatrix) { PetscScalar *values; PetscInt maxRowLen = 0; for (r = rStart; r < rEnd; ++r) { PetscInt len; ierr = PetscSectionGetDof(sectionAdj, r, &len);CHKERRQ(ierr); maxRowLen = PetscMax(maxRowLen, len); } ierr = PetscCalloc1(maxRowLen, &values);CHKERRQ(ierr); for (r = rStart; r < rEnd; ++r) { PetscInt numCols, cStart; ierr = PetscSectionGetDof(sectionAdj, r, &numCols);CHKERRQ(ierr); ierr = PetscSectionGetOffset(sectionAdj, r, &cStart);CHKERRQ(ierr); ierr = MatSetValues(A, 1, &r, numCols, &cols[cStart], values, INSERT_VALUES);CHKERRQ(ierr); } ierr = PetscFree(values);CHKERRQ(ierr); ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } /* restore original useAnchors */ ierr = DMPlexSetAdjacencyUseAnchors(dm,useAnchors);CHKERRQ(ierr); ierr = PetscSectionDestroy(§ionAdj);CHKERRQ(ierr); ierr = PetscFree(cols);CHKERRQ(ierr); ierr = PetscLogEventEnd(DMPLEX_Preallocate,dm,0,0,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc, char **argv) { AppCtx ctx; PetscErrorCode (**funcs)(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nf, PetscScalar *u, void *ctx); DM dm; PetscFE fe; DMInterpolationInfo interpolator; Vec lu, fieldVals; PetscScalar *vals; const PetscScalar *ivals, *vcoords; PetscReal *pcoords; PetscBool pointsAllProcs=PETSC_TRUE; PetscInt spaceDim, c, Np, p; PetscMPIInt rank, size; PetscViewer selfviewer; PetscErrorCode ierr; ierr = PetscInitialize(&argc, &argv, NULL,help);if (ierr) return ierr; ierr = ProcessOptions(PETSC_COMM_WORLD, &ctx);CHKERRQ(ierr); ierr = CreateMesh(PETSC_COMM_WORLD, &ctx, &dm);CHKERRQ(ierr); ierr = DMGetCoordinateDim(dm, &spaceDim);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr); /* Create points */ ierr = CreatePoints(dm, &Np, &pcoords, &pointsAllProcs, &ctx);CHKERRQ(ierr); /* Create interpolator */ ierr = DMInterpolationCreate(PETSC_COMM_WORLD, &interpolator);CHKERRQ(ierr); ierr = DMInterpolationSetDim(interpolator, spaceDim);CHKERRQ(ierr); ierr = DMInterpolationAddPoints(interpolator, Np, pcoords);CHKERRQ(ierr); ierr = DMInterpolationSetUp(interpolator, dm, pointsAllProcs);CHKERRQ(ierr); /* Check locations */ for (c = 0; c < interpolator->n; ++c) { ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD, "[%d]Point %D is in Cell %D\n", rank, c, interpolator->cells[c]);CHKERRQ(ierr); } ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD, NULL);CHKERRQ(ierr); ierr = VecView(interpolator->coords, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* Setup Discretization */ ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) dm), ctx.dim, Nc, ctx.cellSimplex, NULL, -1, &fe);CHKERRQ(ierr); ierr = DMSetField(dm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr); ierr = DMCreateDS(dm);CHKERRQ(ierr); ierr = PetscFEDestroy(&fe);CHKERRQ(ierr); /* Create function */ ierr = PetscCalloc2(Nc, &funcs, Nc, &vals);CHKERRQ(ierr); for (c = 0; c < Nc; ++c) funcs[c] = linear; ierr = DMGetLocalVector(dm, &lu);CHKERRQ(ierr); ierr = DMProjectFunctionLocal(dm, 0.0, funcs, NULL, INSERT_ALL_VALUES, lu);CHKERRQ(ierr); ierr = PetscViewerASCIIPushSynchronized(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscViewerGetSubViewer(PETSC_VIEWER_STDOUT_WORLD,PETSC_COMM_SELF,&selfviewer);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(selfviewer, "[%d]solution\n", rank);CHKERRQ(ierr); ierr = VecView(lu,selfviewer);CHKERRQ(ierr); ierr = PetscViewerRestoreSubViewer(PETSC_VIEWER_STDOUT_WORLD,PETSC_COMM_SELF,&selfviewer);CHKERRQ(ierr); ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscViewerASCIIPopSynchronized(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* Check interpolant */ ierr = VecCreateSeq(PETSC_COMM_SELF, interpolator->n * Nc, &fieldVals);CHKERRQ(ierr); ierr = DMInterpolationSetDof(interpolator, Nc);CHKERRQ(ierr); ierr = DMInterpolationEvaluate(interpolator, dm, lu, fieldVals);CHKERRQ(ierr); for (p = 0; p < size; ++p) { if (p == rank) { ierr = PetscPrintf(PETSC_COMM_SELF, "[%d]Field values\n", rank);CHKERRQ(ierr); ierr = VecView(fieldVals, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); } ierr = PetscBarrier((PetscObject) dm);CHKERRQ(ierr); } ierr = VecGetArrayRead(interpolator->coords, &vcoords);CHKERRQ(ierr); ierr = VecGetArrayRead(fieldVals, &ivals);CHKERRQ(ierr); for (p = 0; p < interpolator->n; ++p) { for (c = 0; c < Nc; ++c) { #if defined(PETSC_USE_COMPLEX) PetscReal vcoordsReal[3]; PetscInt i; for (i = 0; i < spaceDim; i++) vcoordsReal[i] = PetscRealPart(vcoords[p * spaceDim + i]); #else const PetscReal *vcoordsReal = &vcoords[p*spaceDim]; #endif (*funcs[c])(ctx.dim, 0.0, vcoordsReal, 1, vals, NULL); if (PetscAbsScalar(ivals[p*Nc+c] - vals[c]) > PETSC_SQRT_MACHINE_EPSILON) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid interpolated value %g != %g (%D, %D)", (double) PetscRealPart(ivals[p*Nc+c]), (double) PetscRealPart(vals[c]), p, c); } } ierr = VecRestoreArrayRead(interpolator->coords, &vcoords);CHKERRQ(ierr); ierr = VecRestoreArrayRead(fieldVals, &ivals);CHKERRQ(ierr); /* Cleanup */ ierr = PetscFree(pcoords);CHKERRQ(ierr); ierr = PetscFree2(funcs, vals);CHKERRQ(ierr); ierr = VecDestroy(&fieldVals);CHKERRQ(ierr); ierr = DMRestoreLocalVector(dm, &lu);CHKERRQ(ierr); ierr = DMInterpolationDestroy(&interpolator);CHKERRQ(ierr); ierr = DMDestroy(&dm);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
PetscErrorCode PCBDDCNullSpaceAssembleCorrection(PC pc,IS local_dofs) { PC_BDDC *pcbddc = (PC_BDDC*)pc->data; PC_IS *pcis = (PC_IS*)pc->data; Mat_IS* matis = (Mat_IS*)pc->pmat->data; KSP *local_ksp; PC newpc; NullSpaceCorrection_ctx shell_ctx; Mat local_mat,local_pmat,small_mat,inv_small_mat; MatStructure local_mat_struct; Vec work1,work2; const Vec *nullvecs; VecScatter scatter_ctx; IS is_aux; MatFactorInfo matinfo; PetscScalar *basis_mat,*Kbasis_mat,*array,*array_mat; PetscScalar one = 1.0,zero = 0.0, m_one = -1.0; PetscInt basis_dofs,basis_size,nnsp_size,i,k,n_I,n_R; PetscBool nnsp_has_cnst; PetscErrorCode ierr; PetscFunctionBegin; /* Infer the local solver */ ierr = ISGetSize(local_dofs,&basis_dofs);CHKERRQ(ierr); ierr = VecGetSize(pcis->vec1_D,&n_I);CHKERRQ(ierr); ierr = VecGetSize(pcbddc->vec1_R,&n_R);CHKERRQ(ierr); if (basis_dofs == n_I) { /* Dirichlet solver */ local_ksp = &pcbddc->ksp_D; } else if (basis_dofs == n_R) { /* Neumann solver */ local_ksp = &pcbddc->ksp_R; } else { SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in %s: unknown local IS size %d. n_I=%d, n_R=%d)\n",__FUNCT__,basis_dofs,n_I,n_R); } ierr = KSPGetOperators(*local_ksp,&local_mat,&local_pmat,&local_mat_struct);CHKERRQ(ierr); /* Get null space vecs */ ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nnsp_has_cnst,&nnsp_size,&nullvecs);CHKERRQ(ierr); basis_size = nnsp_size; if (nnsp_has_cnst) { basis_size++; } /* Create shell ctx */ ierr = PetscMalloc(sizeof(*shell_ctx),&shell_ctx);CHKERRQ(ierr); /* Create work vectors in shell context */ ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_small_1);CHKERRQ(ierr); ierr = VecSetSizes(shell_ctx->work_small_1,basis_size,basis_size);CHKERRQ(ierr); ierr = VecSetType(shell_ctx->work_small_1,VECSEQ);CHKERRQ(ierr); ierr = VecDuplicate(shell_ctx->work_small_1,&shell_ctx->work_small_2);CHKERRQ(ierr); ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_full_1);CHKERRQ(ierr); ierr = VecSetSizes(shell_ctx->work_full_1,basis_dofs,basis_dofs);CHKERRQ(ierr); ierr = VecSetType(shell_ctx->work_full_1,VECSEQ);CHKERRQ(ierr); ierr = VecDuplicate(shell_ctx->work_full_1,&shell_ctx->work_full_2);CHKERRQ(ierr); /* Allocate workspace */ ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->basis_mat );CHKERRQ(ierr); ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->Kbasis_mat);CHKERRQ(ierr); ierr = MatDenseGetArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr); ierr = MatDenseGetArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr); /* Restrict local null space on selected dofs (Dirichlet or Neumann) and compute matrices N and K*N */ ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr); ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr); ierr = VecScatterCreate(pcis->vec1_N,local_dofs,work1,(IS)0,&scatter_ctx);CHKERRQ(ierr); for (k=0;k<nnsp_size;k++) { ierr = VecScatterBegin(matis->ctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(matis->ctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr); ierr = VecScatterBegin(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr); ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr); ierr = VecResetArray(work1);CHKERRQ(ierr); ierr = VecResetArray(work2);CHKERRQ(ierr); } if (nnsp_has_cnst) { ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr); ierr = VecSet(work1,one);CHKERRQ(ierr); ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr); ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr); ierr = VecResetArray(work1);CHKERRQ(ierr); ierr = VecResetArray(work2);CHKERRQ(ierr); } ierr = VecDestroy(&work1);CHKERRQ(ierr); ierr = VecDestroy(&work2);CHKERRQ(ierr); ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr); ierr = MatDenseRestoreArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr); ierr = MatDenseRestoreArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr); /* Assemble another Mat object in shell context */ ierr = MatTransposeMatMult(shell_ctx->basis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&small_mat);CHKERRQ(ierr); ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr); ierr = ISCreateStride(PETSC_COMM_SELF,basis_size,0,1,&is_aux);CHKERRQ(ierr); ierr = MatLUFactor(small_mat,is_aux,is_aux,&matinfo);CHKERRQ(ierr); ierr = ISDestroy(&is_aux);CHKERRQ(ierr); ierr = PetscMalloc(basis_size*basis_size*sizeof(PetscScalar),&array_mat);CHKERRQ(ierr); for (k=0;k<basis_size;k++) { ierr = VecSet(shell_ctx->work_small_1,zero);CHKERRQ(ierr); ierr = VecSetValue(shell_ctx->work_small_1,k,one,INSERT_VALUES);CHKERRQ(ierr); ierr = VecAssemblyBegin(shell_ctx->work_small_1);CHKERRQ(ierr); ierr = VecAssemblyEnd(shell_ctx->work_small_1);CHKERRQ(ierr); ierr = MatSolve(small_mat,shell_ctx->work_small_1,shell_ctx->work_small_2);CHKERRQ(ierr); ierr = VecGetArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr); for (i=0;i<basis_size;i++) { array_mat[i*basis_size+k]=array[i]; } ierr = VecRestoreArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr); } ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_size,basis_size,array_mat,&inv_small_mat);CHKERRQ(ierr); ierr = MatMatMult(shell_ctx->basis_mat,inv_small_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&shell_ctx->Lbasis_mat);CHKERRQ(ierr); ierr = PetscFree(array_mat);CHKERRQ(ierr); ierr = MatDestroy(&inv_small_mat);CHKERRQ(ierr); ierr = MatDestroy(&small_mat);CHKERRQ(ierr); ierr = MatScale(shell_ctx->Kbasis_mat,m_one);CHKERRQ(ierr); /* Rebuild local PC */ ierr = KSPGetPC(*local_ksp,&shell_ctx->local_pc);CHKERRQ(ierr); ierr = PetscObjectReference((PetscObject)shell_ctx->local_pc);CHKERRQ(ierr); ierr = PCCreate(PETSC_COMM_SELF,&newpc);CHKERRQ(ierr); ierr = PCSetOperators(newpc,local_mat,local_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr); ierr = PCShellSetContext(newpc,shell_ctx);CHKERRQ(ierr); ierr = PCShellSetApply(newpc,PCBDDCApplyNullSpaceCorrectionPC);CHKERRQ(ierr); ierr = PCShellSetDestroy(newpc,PCBDDCDestroyNullSpaceCorrectionPC);CHKERRQ(ierr); ierr = PCSetUp(newpc);CHKERRQ(ierr); ierr = KSPSetPC(*local_ksp,newpc);CHKERRQ(ierr); ierr = PCDestroy(&newpc);CHKERRQ(ierr); ierr = KSPSetUp(*local_ksp);CHKERRQ(ierr); /* test */ /* TODO: this cause a deadlock when doing multilevel */ #if 0 if (pcbddc->dbg_flag) { KSP check_ksp; PC check_pc; Mat test_mat; Vec work3; PetscViewer viewer=pcbddc->dbg_viewer; PetscReal test_err,lambda_min,lambda_max; PetscBool setsym,issym=PETSC_FALSE; ierr = KSPGetPC(*local_ksp,&check_pc);CHKERRQ(ierr); ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr); ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr); ierr = VecDuplicate(shell_ctx->work_full_1,&work3);CHKERRQ(ierr); ierr = VecSetRandom(shell_ctx->work_small_1,NULL);CHKERRQ(ierr); ierr = MatMult(shell_ctx->basis_mat,shell_ctx->work_small_1,work1);CHKERRQ(ierr); ierr = VecCopy(work1,work2);CHKERRQ(ierr); ierr = MatMult(local_mat,work1,work3);CHKERRQ(ierr); ierr = PCApply(check_pc,work3,work1);CHKERRQ(ierr); ierr = VecAXPY(work1,m_one,work2);CHKERRQ(ierr); ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr); ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d error for nullspace correction for ",PetscGlobalRank); if (basis_dofs == n_I) { ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Dirichlet "); } else { ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Neumann "); } ierr = PetscViewerASCIISynchronizedPrintf(viewer,"solver is :%1.14e\n",test_err); ierr = MatTransposeMatMult(shell_ctx->Lbasis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&test_mat);CHKERRQ(ierr); ierr = MatShift(test_mat,one);CHKERRQ(ierr); ierr = MatNorm(test_mat,NORM_INFINITY,&test_err);CHKERRQ(ierr); ierr = MatDestroy(&test_mat);CHKERRQ(ierr); ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d error for nullspace matrices is :%1.14e\n",PetscGlobalRank,test_err); /* Create ksp object suitable for extreme eigenvalues' estimation */ ierr = KSPCreate(PETSC_COMM_SELF,&check_ksp);CHKERRQ(ierr); ierr = KSPSetOperators(check_ksp,local_mat,local_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); ierr = KSPSetTolerances(check_ksp,1.e-8,1.e-8,PETSC_DEFAULT,basis_dofs);CHKERRQ(ierr); ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr); ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr); if (issym) { ierr = KSPSetType(check_ksp,KSPCG);CHKERRQ(ierr); } ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr); ierr = KSPSetUp(check_ksp);CHKERRQ(ierr); ierr = VecSetRandom(work1,NULL);CHKERRQ(ierr); ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr); ierr = KSPSolve(check_ksp,work2,work2);CHKERRQ(ierr); ierr = VecAXPY(work2,m_one,work1);CHKERRQ(ierr); ierr = VecNorm(work2,NORM_INFINITY,&test_err);CHKERRQ(ierr); ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr); ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr); ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d error for adapted KSP %1.14e (it %d, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max); ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr); ierr = VecDestroy(&work1);CHKERRQ(ierr); ierr = VecDestroy(&work2);CHKERRQ(ierr); ierr = VecDestroy(&work3);CHKERRQ(ierr); ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); } #endif PetscFunctionReturn(0); }
/*@ MatSetSizes - Sets the local and global sizes, and checks to determine compatibility Collective on Mat Input Parameters: + A - the matrix . m - number of local rows (or PETSC_DECIDE) . n - number of local columns (or PETSC_DECIDE) . M - number of global rows (or PETSC_DETERMINE) - N - number of global columns (or PETSC_DETERMINE) Notes: m (n) and M (N) cannot be both PETSC_DECIDE If one processor calls this with M (N) of PETSC_DECIDE then all processors must, otherwise the program will hang. If PETSC_DECIDE is not used for the arguments 'm' and 'n', then the user must ensure that they are chosen to be compatible with the vectors. To do this, one first considers the matrix-vector product 'y = A x'. The 'm' that is used in the above routine must match the local size used in the vector creation routine VecCreateMPI() for 'y'. Likewise, the 'n' used must match that used as the local size in VecCreateMPI() for 'x'. Level: beginner .seealso: MatGetSize(), PetscSplitOwnership() @*/ PetscErrorCode PETSCMAT_DLLEXPORT MatSetSizes(Mat A, PetscInt m, PetscInt n, PetscInt M, PetscInt N) { PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(A,MAT_COOKIE,1); if (M > 0 && m > M) SETERRQ2(PETSC_ERR_ARG_INCOMP,"Local column size %D cannot be larger than global column size %D",m,M); if (N > 0 && n > N) SETERRQ2(PETSC_ERR_ARG_INCOMP,"Local row size %D cannot be larger than global row size %D",n,N); if (A->ops->setsizes) { /* Since this will not be set until the type has been set, this will NOT be called on the initial call of MatSetSizes() (which must be called BEFORE MatSetType() */ ierr = (*A->ops->setsizes)(A,m,n,M,N);CHKERRQ(ierr); } else { if ((A->rmap->n >= 0 || A->rmap->N >= 0) && (A->rmap->n != m || A->rmap->N != M)) SETERRQ4(PETSC_ERR_SUP,"Cannot change/reset row sizes to %D local %D global after previously setting them to %D local %D global",m,M,A->rmap->n,A->rmap->N); if ((A->cmap->n >= 0 || A->cmap->N >= 0) && (A->cmap->n != n || A->cmap->N != N)) SETERRQ4(PETSC_ERR_SUP,"Cannot change/reset column sizes to %D local %D global after previously setting them to %D local %D global",n,N,A->cmap->n,A->cmap->N); } A->rmap->n = m; A->cmap->n = n; A->rmap->N = M; A->cmap->N = N; if (A->ops->create) { ierr = (*A->ops->create)(A);CHKERRQ(ierr); A->ops->create = 0; } PetscFunctionReturn(0); }
/*@ DMNetworkSetSizes - Sets the local and global vertices and edges. Collective on DM Input Parameters: + dm - the dm object . nV - number of local vertices . nE - number of local edges . NV - number of global vertices (or PETSC_DETERMINE) - NE - number of global edges (or PETSC_DETERMINE) Notes If one processor calls this with NV (NE) of PETSC_DECIDE then all processors must, otherwise the prgram will hang. You cannot change the sizes once they have been set Level: intermediate .seealso: DMNetworkCreate @*/ PetscErrorCode DMNetworkSetSizes(DM dm, PetscInt nV, PetscInt nE, PetscInt NV, PetscInt NE) { PetscErrorCode ierr; DM_Network *network = (DM_Network*) dm->data; PetscInt a[2],b[2]; PetscFunctionBegin; PetscValidHeaderSpecific(dm,DM_CLASSID,1); if (NV > 0) PetscValidLogicalCollectiveInt(dm,NV,4); if (NE > 0) PetscValidLogicalCollectiveInt(dm,NE,5); if (NV > 0 && nV > NV) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Local vertex size %D cannot be larger than global vertex size %D",nV,NV); if (NE > 0 && nE > NE) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Local edge size %D cannot be larger than global edge size %D",nE,NE); if ((network->nNodes >= 0 || network->NNodes >= 0) && (network->nNodes != nV || network->NNodes != NV)) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot change/reset vertex sizes to %D local %D global after previously setting them to %D local %D global",nV,NV,network->nNodes,network->NNodes); if ((network->nEdges >= 0 || network->NEdges >= 0) && (network->nEdges != nE || network->NEdges != NE)) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot change/reset edge sizes to %D local %D global after previously setting them to %D local %D global",nE,NE,network->nEdges,network->NEdges); if (NE < 0 || NV < 0) { a[0] = nV; a[1] = nE; ierr = MPI_Allreduce(a,b,2,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); NV = b[0]; NE = b[1]; } network->nNodes = nV; network->NNodes = NV; network->nEdges = nE; network->NEdges = NE; PetscFunctionReturn(0); }
/* PetscTrFreeDefault - Free with tracing. Input Parameters: . a - pointer to a block allocated with PetscTrMalloc . lineno - line number where used. Use __LINE__ for this . function - function calling routine. Use __FUNCT__ for this . file - file name where used. Use __FILE__ for this . dir - directory where file is. Use __SDIR__ for this */ PetscErrorCode PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[]) { char *a = (char*)aa; TRSPACE *head; char *ahead; PetscErrorCode ierr; PetscClassId *nend; PetscFunctionBegin; /* Do not try to handle empty blocks */ if (!a) { (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file); SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block: Free called from %s() line %d in %s%s\n",function,line,dir,file); } if (TRdebugLevel) { ierr = PetscMallocValidate(line,function,file,dir);CHKERRQ(ierr); } ahead = a; a = a - sizeof(TrSPACE); head = (TRSPACE *)a; if (head->classid != CLASSID_VALUE) { (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file); (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a); SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory"); } nend = (PetscClassId *)(ahead + head->size); if (*nend != CLASSID_VALUE) { if (*nend == ALREADY_FREED) { (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file); (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE)); if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) { (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename); } else { (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename); } SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed"); } else { /* Damaged tail */ (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file); (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a); (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename); SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory"); } } /* Mark the location freed */ *nend = ALREADY_FREED; /* Save location where freed. If we suspect the line number, mark as allocated location */ if (line > 0 && line < 50000) { head->lineno = line; head->filename = file; head->functionname = function; head->dirname = dir; } else { head->lineno = - head->lineno; } /* zero out memory - helps to find some reuse of already freed memory */ ierr = PetscMemzero(aa,head->size);CHKERRQ(ierr); TRallocated -= head->size; TRfrags --; if (head->prev) head->prev->next = head->next; else TRhead = head->next; if (head->next) head->next->prev = head->prev; ierr = PetscFreeAlign(a,line,function,file,dir);CHKERRQ(ierr); PetscFunctionReturn(0); }