PetscErrorCode checkPositivity(PorousCtx *user,Vec X) {
PetscErrorCode ierr;
PetscInt i,j,xs,ys,xm,ym;
DM da = user->da;
WPnode **wp;
PetscFunctionBegin;
ierr = DMDAGetCorners(da,&xs,&ys,PETSC_NULL,&xm,&ym,PETSC_NULL);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,X,&wp);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (wp[j][i].W < 0) {
SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE,
"negative water thickness W at (i,j)=(%d,%d) during function eval %d",
i,j,user->fcncount);
}
if (wp[j][i].P < 0) {
SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE,
"negative water pressure P at (i,j)=(%d,%d) during function eval %d",
i,j,user->fcncount);
}
}
}
ierr = DMDAVecRestoreArray(da,X,&wp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVMultInPlaceTranspose - Update a set of vectors as V(:,s:e-1) = V*Q'(:,s:e-1).
Logically Collective on BV
Input Parameters:
+ Q - a sequential dense matrix
. s - first column of V to be overwritten
- e - first column of V not to be overwritten
Input/Output Parameter:
+ V - basis vectors
Notes:
This is a variant of BVMultInPlace() where the conjugate transpose
of Q is used.
Level: intermediate
.seealso: BVMultInPlace()
@*/
PetscErrorCode BVMultInPlaceTranspose(BV V,Mat Q,PetscInt s,PetscInt e)
{
PetscErrorCode ierr;
PetscBool match;
PetscInt m,n;
PetscFunctionBegin;
PetscValidHeaderSpecific(V,BV_CLASSID,1);
PetscValidHeaderSpecific(Q,MAT_CLASSID,2);
PetscValidLogicalCollectiveInt(V,s,3);
PetscValidLogicalCollectiveInt(V,e,4);
PetscValidType(V,1);
BVCheckSizes(V,1);
PetscValidType(Q,2);
ierr = PetscObjectTypeCompare((PetscObject)Q,MATSEQDENSE,&match);CHKERRQ(ierr);
if (!match) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Mat argument must be of type seqdense");
if (s<V->l || s>V->m) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument s has wrong value %D, should be between %D and %D",s,V->l,V->m);
if (e<V->l || e>V->m) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument e has wrong value %D, should be between %D and %D",e,V->l,V->m);
ierr = MatGetSize(Q,&m,&n);CHKERRQ(ierr);
if (n<V->k) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat argument has %D columns, should have at least %D",n,V->k);
if (e>m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat argument only has %D rows, the requested value of e is larger: %D",m,e);
if (s>=e || !V->n) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(BV_Mult,V,Q,0,0);CHKERRQ(ierr);
ierr = (*V->ops->multinplacetrans)(V,Q,s,e);CHKERRQ(ierr);
ierr = PetscLogEventEnd(BV_Mult,V,Q,0,0);CHKERRQ(ierr);
ierr = PetscObjectStateIncrease((PetscObject)V);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
DMLabelMakeValid_Private - Transfer stratum data from the hash format to the sorted list format
Input parameter:
+ label - The DMLabel
- v - The stratum value
Output parameter:
. label - The DMLabel with stratum in sorted list format
Level: developer
.seealso: DMLabelCreate()
*/
static PetscErrorCode DMLabelMakeValid_Private(DMLabel label, PetscInt v)
{
PetscInt off;
PetscErrorCode ierr;
if (label->arrayValid[v]) return 0;
if (v >= label->numStrata) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Trying to access invalid stratum %D in DMLabelMakeValid_Private\n", v);
PetscFunctionBegin;
PetscHashISize(label->ht[v], label->stratumSizes[v]);
ierr = PetscMalloc1(label->stratumSizes[v], &label->points[v]);CHKERRQ(ierr);
off = 0;
ierr = PetscHashIGetKeys(label->ht[v], &off, &(label->points[v][0]));CHKERRQ(ierr);
if (off != label->stratumSizes[v]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Invalid number of contributed points %D from value %D should be %D", off, label->stratumValues[v], label->stratumSizes[v]);
PetscHashIClear(label->ht[v]);
ierr = PetscSortInt(label->stratumSizes[v], label->points[v]);CHKERRQ(ierr);
if (label->bt) {
PetscInt p;
for (p = 0; p < label->stratumSizes[v]; ++p) {
const PetscInt point = label->points[v][p];
if ((point < label->pStart) || (point >= label->pEnd)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Label point %D is not in [%D, %D)", point, label->pStart, label->pEnd);
ierr = PetscBTSet(label->bt, point - label->pStart);CHKERRQ(ierr);
}
}
label->arrayValid[v] = PETSC_TRUE;
++label->state;
PetscFunctionReturn(0);
}
/*@
PetscDTReconstructPoly - create matrix representing polynomial reconstruction using cell intervals and evaluation at target intervals
Not Collective
Input Arguments:
+ degree - degree of reconstruction polynomial
. nsource - number of source intervals
. sourcex - sorted coordinates of source cell boundaries (length nsource+1)
. ntarget - number of target intervals
- targetx - sorted coordinates of target cell boundaries (length ntarget+1)
Output Arguments:
. R - reconstruction matrix, utarget = sum_s R[t*nsource+s] * usource[s]
Level: advanced
.seealso: PetscDTLegendreEval()
@*/
PetscErrorCode PetscDTReconstructPoly(PetscInt degree,PetscInt nsource,const PetscReal *sourcex,PetscInt ntarget,const PetscReal *targetx,PetscReal *R)
{
PetscErrorCode ierr;
PetscInt i,j,k,*bdegrees,worksize;
PetscReal xmin,xmax,center,hscale,*sourcey,*targety,*Bsource,*Bsinv,*Btarget;
PetscScalar *tau,*work;
PetscFunctionBegin;
PetscValidRealPointer(sourcex,3);
PetscValidRealPointer(targetx,5);
PetscValidRealPointer(R,6);
if (degree >= nsource) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Reconstruction degree %D must be less than number of source intervals %D",degree,nsource);
#if defined(PETSC_USE_DEBUG)
for (i=0; i<nsource; i++) {
if (sourcex[i] >= sourcex[i+1]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Source interval %D has negative orientation (%G,%G)",i,sourcex[i],sourcex[i+1]);
}
for (i=0; i<ntarget; i++) {
if (targetx[i] >= targetx[i+1]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Target interval %D has negative orientation (%G,%G)",i,targetx[i],targetx[i+1]);
}
#endif
xmin = PetscMin(sourcex[0],targetx[0]);
xmax = PetscMax(sourcex[nsource],targetx[ntarget]);
center = (xmin + xmax)/2;
hscale = (xmax - xmin)/2;
worksize = nsource;
ierr = PetscMalloc4(degree+1,PetscInt,&bdegrees,nsource+1,PetscReal,&sourcey,nsource*(degree+1),PetscReal,&Bsource,worksize,PetscScalar,&work);CHKERRQ(ierr);
ierr = PetscMalloc4(nsource,PetscScalar,&tau,nsource*(degree+1),PetscReal,&Bsinv,ntarget+1,PetscReal,&targety,ntarget*(degree+1),PetscReal,&Btarget);CHKERRQ(ierr);
for (i=0; i<=nsource; i++) sourcey[i] = (sourcex[i]-center)/hscale;
for (i=0; i<=degree; i++) bdegrees[i] = i+1;
ierr = PetscDTLegendreIntegrate(nsource,sourcey,degree+1,bdegrees,PETSC_TRUE,Bsource);CHKERRQ(ierr);
ierr = PetscDTPseudoInverseQR(nsource,nsource,degree+1,Bsource,Bsinv,tau,nsource,work);CHKERRQ(ierr);
for (i=0; i<=ntarget; i++) targety[i] = (targetx[i]-center)/hscale;
ierr = PetscDTLegendreIntegrate(ntarget,targety,degree+1,bdegrees,PETSC_FALSE,Btarget);CHKERRQ(ierr);
for (i=0; i<ntarget; i++) {
PetscReal rowsum = 0;
for (j=0; j<nsource; j++) {
PetscReal sum = 0;
for (k=0; k<degree+1; k++) {
sum += Btarget[i*(degree+1)+k] * Bsinv[k*nsource+j];
}
R[i*nsource+j] = sum;
rowsum += sum;
}
for (j=0; j<nsource; j++) R[i*nsource+j] /= rowsum; /* normalize each row */
}
ierr = PetscFree4(bdegrees,sourcey,Bsource,work);CHKERRQ(ierr);
ierr = PetscFree4(tau,Bsinv,targety,Btarget);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode CheckFVMGeometry(DM dm, PetscInt cell, PetscInt spaceDim, PetscReal centroidEx[], PetscReal normalEx[], PetscReal volEx)
{
PetscReal centroid[3], normal[3], vol;
PetscInt d;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMPlexComputeCellGeometryFVM(dm, cell, &vol, centroid, normal);CHKERRQ(ierr);
for (d = 0; d < spaceDim; ++d) {
if (fabs(centroid[d] - centroidEx[d]) > 1.0e-9) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid centroid[%d]: %g != %g", d, centroid[d], centroidEx[d]);
if (fabs(normal[d] - normalEx[d]) > 1.0e-9) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid normal[%d]: %g != %g", d, normal[d], normalEx[d]);
}
if (fabs(volEx - vol) > 1.0e-9) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid volume = %g != %g", vol, volEx);
PetscFunctionReturn(0);
}
/*@
DMDAConvertToCell - Convert (i,j,k) to local cell number
Not Collective
Input Parameter:
+ da - the distributed array
= s - A MatStencil giving (i,j,k)
Output Parameter:
. cell - the local cell number
Level: developer
.seealso: DMDAVecGetClosure()
@*/
PetscErrorCode DMDAConvertToCell(DM dm, MatStencil s, PetscInt *cell)
{
DM_DA *da = (DM_DA*) dm->data;
const PetscInt dim = dm->dim;
const PetscInt mx = (da->Xe - da->Xs)/da->w, my = da->Ye - da->Ys /*, mz = da->Ze - da->Zs*/;
const PetscInt il = s.i - da->Xs/da->w, jl = dim > 1 ? s.j - da->Ys : 0, kl = dim > 2 ? s.k - da->Zs : 0;
PetscFunctionBegin;
*cell = -1;
if ((s.i < da->Xs/da->w) || (s.i >= da->Xe/da->w)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Stencil i %d should be in [%d, %d)", s.i, da->Xs/da->w, da->Xe/da->w);
if ((dim > 1) && ((s.j < da->Ys) || (s.j >= da->Ye))) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Stencil j %d should be in [%d, %d)", s.j, da->Ys, da->Ye);
if ((dim > 2) && ((s.k < da->Zs) || (s.k >= da->Ze))) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Stencil k %d should be in [%d, %d)", s.k, da->Zs, da->Ze);
*cell = (kl*my + jl)*mx + il;
PetscFunctionReturn(0);
}
PetscErrorCode MatBlockMatSetPreallocation_BlockMat(Mat A,PetscInt bs,PetscInt nz,PetscInt *nnz)
{
Mat_BlockMat *bmat = (Mat_BlockMat*)A->data;
PetscErrorCode ierr;
PetscInt i;
PetscFunctionBegin;
ierr = PetscLayoutSetBlockSize(A->rmap,bs);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(A->cmap,bs);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr);
ierr = PetscLayoutGetBlockSize(A->rmap,&bs);CHKERRQ(ierr);
if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
if (nz < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nz cannot be less than 0: value %d",nz);
if (nnz) {
for (i=0; i<A->rmap->n/bs; i++) {
if (nnz[i] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be less than 0: local row %d value %d",i,nnz[i]);
if (nnz[i] > A->cmap->n/bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be greater than row length: local row %d value %d rowlength %d",i,nnz[i],A->cmap->n/bs);
}
}
bmat->mbs = A->rmap->n/bs;
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,bs,NULL,&bmat->right);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,bs,NULL,&bmat->middle);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,bs,&bmat->left);CHKERRQ(ierr);
if (!bmat->imax) {
ierr = PetscMalloc2(A->rmap->n,&bmat->imax,A->rmap->n,&bmat->ilen);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,2*A->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
}
if (nnz) {
nz = 0;
for (i=0; i<A->rmap->n/A->rmap->bs; i++) {
bmat->imax[i] = nnz[i];
nz += nnz[i];
}
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Currently requires block row by row preallocation");
/* bmat->ilen will count nonzeros in each row so far. */
for (i=0; i<bmat->mbs; i++) bmat->ilen[i] = 0;
/* allocate the matrix space */
ierr = MatSeqXAIJFreeAIJ(A,(PetscScalar**)&bmat->a,&bmat->j,&bmat->i);CHKERRQ(ierr);
ierr = PetscMalloc3(nz,&bmat->a,nz,&bmat->j,A->rmap->n+1,&bmat->i);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,(A->rmap->n+1)*sizeof(PetscInt)+nz*(sizeof(PetscScalar)+sizeof(PetscInt)));CHKERRQ(ierr);
bmat->i[0] = 0;
for (i=1; i<bmat->mbs+1; i++) {
bmat->i[i] = bmat->i[i-1] + bmat->imax[i-1];
}
bmat->singlemalloc = PETSC_TRUE;
bmat->free_a = PETSC_TRUE;
bmat->free_ij = PETSC_TRUE;
bmat->nz = 0;
bmat->maxnz = nz;
A->info.nz_unneeded = (double)bmat->maxnz;
ierr = MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PetscSplitOwnership - Given a global (or local) length determines a local
(or global) length via a simple formula
Collective on MPI_Comm (if n or N is PETSC_DECIDE)
Input Parameters:
+ comm - MPI communicator that shares the object being divided
. n - local length (or PETSC_DECIDE to have it set)
- N - global length (or PETSC_DECIDE)
Level: developer
Notes:
n and N cannot be both PETSC_DECIDE
If one processor calls this with n or N of PETSC_DECIDE then all processors
must. Otherwise, an error is thrown in debug mode while the program will hang
in optimized (i.e. configured --with-debugging=0) mode.
.seealso: PetscSplitOwnershipBlock()
@*/
PetscErrorCode PetscSplitOwnership(MPI_Comm comm,PetscInt *n,PetscInt *N)
{
PetscErrorCode ierr;
PetscMPIInt size,rank;
PetscFunctionBegin;
if (*N == PETSC_DECIDE && *n == PETSC_DECIDE) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Both n and N cannot be PETSC_DECIDE\n likely a call to VecSetSizes() or MatSetSizes() is wrong.\nSee https://www.mcs.anl.gov/petsc/documentation/faq.html#split");
#if defined(PETSC_USE_DEBUG)
{
PetscMPIInt l[2],g[2];
l[0] = (*n == PETSC_DECIDE) ? 1 : 0;
l[1] = (*N == PETSC_DECIDE) ? 1 : 0;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPIU_Allreduce(l,g,2,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
if (g[0] && g[0] != size) SETERRQ(comm,PETSC_ERR_ARG_INCOMP,"All processes must supply PETSC_DECIDE for local size");
if (g[1] && g[1] != size) SETERRQ(comm,PETSC_ERR_ARG_INCOMP,"All processes must supply PETSC_DECIDE for global size");
}
#endif
if (*N == PETSC_DECIDE) {
ierr = MPIU_Allreduce(n,N,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
} else if (*n == PETSC_DECIDE) {
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
*n = *N/size + ((*N % size) > rank);
#if defined(PETSC_USE_DEBUG)
} else {
PetscInt tmp;
ierr = MPIU_Allreduce(n,&tmp,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
if (tmp != *N) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Sum of local lengths %D does not equal global length %D, my local length %D\n likely a call to VecSetSizes() or MatSetSizes() is wrong.\nSee https://www.mcs.anl.gov/petsc/documentation/faq.html#split",tmp,*N,*n);
#endif
}
PetscFunctionReturn(0);
}
/*@C
DMDAVecGetArrayDOFRead - Returns a multiple dimension array that shares data with
the underlying vector and is indexed using the global dimensions.
Not Collective
Input Parameter:
+ da - the distributed array
- vec - the vector, either a vector the same size as one obtained with
DMCreateGlobalVector() or DMCreateLocalVector()
Output Parameter:
. array - the array
Notes:
Call DMDAVecRestoreArrayDOFRead() once you have finished accessing the vector entries.
In C, the indexing is "backwards" from what expects: array[k][j][i][DOF] NOT array[i][j][k][DOF]!
In Fortran 90 you do not need a version of DMDAVecRestoreArrayDOF() just use DMDAVecRestoreArrayReadF90() and declare your array with one higher dimension,
see src/dm/examples/tutorials/ex11f90.F
Level: intermediate
.keywords: distributed array, get, corners, nodes, local indices, coordinates
.seealso: DMDAGetGhostCorners(), DMDAGetCorners(), VecGetArray(), VecRestoreArray(), DMDAVecRestoreArray(), DMDAVecGetArray(), DMDAVecRestoreArrayDOF()
@*/
PetscErrorCode DMDAVecGetArrayDOFRead(DM da,Vec vec,void *array)
{
PetscErrorCode ierr;
PetscInt xs,ys,zs,xm,ym,zm,gxs,gys,gzs,gxm,gym,gzm,N,dim,dof;
PetscFunctionBegin;
ierr = DMDAGetCorners(da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
ierr = DMDAGetGhostCorners(da,&gxs,&gys,&gzs,&gxm,&gym,&gzm);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,&dim,0,0,0,0,0,0,&dof,0,0,0,0,0);CHKERRQ(ierr);
/* Handle case where user passes in global vector as opposed to local */
ierr = VecGetLocalSize(vec,&N);CHKERRQ(ierr);
if (N == xm*ym*zm*dof) {
gxm = xm;
gym = ym;
gzm = zm;
gxs = xs;
gys = ys;
gzs = zs;
} else if (N != gxm*gym*gzm*dof) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Vector local size %D is not compatible with DMDA local sizes %D %D\n",N,xm*ym*zm*dof,gxm*gym*gzm*dof);
if (dim == 1) {
ierr = VecGetArray2dRead(vec,gxm,dof,gxs,0,(PetscScalar***)array);CHKERRQ(ierr);
} else if (dim == 2) {
ierr = VecGetArray3dRead(vec,gym,gxm,dof,gys,gxs,0,(PetscScalar****)array);CHKERRQ(ierr);
} else if (dim == 3) {
ierr = VecGetArray4dRead(vec,gzm,gym,gxm,dof,gzs,gys,gxs,0,(PetscScalar*****)array);CHKERRQ(ierr);
} else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"DMDA dimension not 1, 2, or 3, it is %D\n",dim);
PetscFunctionReturn(0);
}
PetscErrorCode DMLabelClearStratum(DMLabel label, PetscInt value)
{
PetscInt v;
PetscErrorCode ierr;
PetscFunctionBegin;
for (v = 0; v < label->numStrata; ++v) {
if (label->stratumValues[v] == value) break;
}
if (v >= label->numStrata) PetscFunctionReturn(0);
if (label->validIS[v]) {
if (label->bt) {
PetscInt i;
const PetscInt *points;
ierr = ISGetIndices(label->points[v], &points);CHKERRQ(ierr);
for (i = 0; i < label->stratumSizes[v]; ++i) {
const PetscInt point = points[i];
if ((point < label->pStart) || (point >= label->pEnd)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Label point %D is not in [%D, %D)", point, label->pStart, label->pEnd);
ierr = PetscBTClear(label->bt, point - label->pStart);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(label->points[v], &points);CHKERRQ(ierr);
}
ierr = ISDestroy(&(label->points[v]));CHKERRQ(ierr);
label->stratumSizes[v] = 0;
ierr = ISCreateGeneral(PETSC_COMM_SELF,0,NULL,PETSC_OWN_POINTER,&(label->points[v]));CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) (label->points[v]), "indices");CHKERRQ(ierr);
} else {
PetscHashIClear(label->ht[v]);
}
PetscFunctionReturn(0);
}
PetscErrorCode DMLabelSetStratumIS(DMLabel label, PetscInt value, IS is)
{
PetscInt v, numStrata;
PetscErrorCode ierr;
PetscFunctionBegin;
numStrata = label->numStrata;
for (v = 0; v < numStrata; v++) {
if (label->stratumValues[v] == value) break;
}
if (v >= numStrata) {ierr = DMLabelAddStratum(label,value);CHKERRQ(ierr);}
if (is == label->points[v]) PetscFunctionReturn(0);
ierr = DMLabelClearStratum(label,value);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&(label->stratumSizes[v]));CHKERRQ(ierr);
label->stratumValues[v] = value;
label->validIS[v] = PETSC_TRUE;
ierr = PetscObjectReference((PetscObject)is);CHKERRQ(ierr);
ierr = ISDestroy(&(label->points[v]));CHKERRQ(ierr);
if (label->bt) {
const PetscInt *points;
PetscInt p;
ierr = ISGetIndices(is,&points);CHKERRQ(ierr);
for (p = 0; p < label->stratumSizes[v]; ++p) {
const PetscInt point = points[p];
if ((point < label->pStart) || (point >= label->pEnd)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Label point %D is not in [%D, %D)", point, label->pStart, label->pEnd);
ierr = PetscBTSet(label->bt, point - label->pStart);CHKERRQ(ierr);
}
}
label->points[v] = is;
PetscFunctionReturn(0);
}
/* This can be hooked into SetValue(), ClearValue(), etc. for updating */
PetscErrorCode DMLabelCreateIndex(DMLabel label, PetscInt pStart, PetscInt pEnd)
{
PetscInt v;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMLabelMakeAllValid_Private(label);CHKERRQ(ierr);
if (label->bt) {ierr = PetscBTDestroy(&label->bt);CHKERRQ(ierr);}
label->pStart = pStart;
label->pEnd = pEnd;
ierr = PetscBTCreate(pEnd - pStart, &label->bt);CHKERRQ(ierr);
ierr = PetscBTMemzero(pEnd - pStart, label->bt);CHKERRQ(ierr);
for (v = 0; v < label->numStrata; ++v) {
const PetscInt *points;
PetscInt i;
ierr = ISGetIndices(label->points[v],&points);CHKERRQ(ierr);
for (i = 0; i < label->stratumSizes[v]; ++i) {
const PetscInt point = points[i];
if ((point < pStart) || (point >= pEnd)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Label point %D is not in [%D, %D)", point, pStart, pEnd);
ierr = PetscBTSet(label->bt, point - pStart);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(label->points[v],&points);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode UMCheckElements(UM *mesh) {
PetscErrorCode ierr;
const int *ae;
int k, m;
if ((mesh->K == 0) || (mesh->e == NULL)) {
SETERRQ(PETSC_COMM_WORLD,1,
"number of elements unknown; call UMReadElements() first\n");
}
if (mesh->N == 0) {
SETERRQ(PETSC_COMM_WORLD,2,
"node size unknown so element check impossible; call UMReadNodes() first\n");
}
ierr = ISGetIndices(mesh->e,&ae); CHKERRQ(ierr);
for (k = 0; k < mesh->K; k++) {
for (m = 0; m < 3; m++) {
if ((ae[3*k+m] < 0) || (ae[3*k+m] >= mesh->N)) {
SETERRQ3(PETSC_COMM_WORLD,3,
"index e[%d]=%d invalid: not between 0 and N-1=%d\n",
3*k+m,ae[3*k+m],mesh->N-1);
}
}
// FIXME: could add check for distinct indices
}
ierr = ISRestoreIndices(mesh->e,&ae); CHKERRQ(ierr);
return 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 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);
}
/* Compose an IS with an ISLocalToGlobalMapping to map from IS source indices to global indices */
static PetscErrorCode ISL2GCompose(IS is,ISLocalToGlobalMapping ltog,ISLocalToGlobalMapping *cltog)
{
PetscErrorCode ierr;
const PetscInt *idx;
PetscInt m,*idxm;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidHeaderSpecific(ltog,IS_LTOGM_CLASSID,2);
PetscValidPointer(cltog,3);
ierr = ISGetLocalSize(is,&m);CHKERRQ(ierr);
ierr = ISGetIndices(is,&idx);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
{
PetscInt i;
for (i=0; i<m; i++) {
if (idx[i] < 0 || ltog->n <= idx[i]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"is[%D] = %D is not in the local range [0:%D]",i,idx[i],ltog->n);
}
}
#endif
ierr = PetscMalloc(m*sizeof(PetscInt),&idxm);CHKERRQ(ierr);
if (ltog) {
ierr = ISLocalToGlobalMappingApply(ltog,m,idx,idxm);CHKERRQ(ierr);
} else {
ierr = PetscMemcpy(idxm,idx,m*sizeof(PetscInt));CHKERRQ(ierr);
}
ierr = ISLocalToGlobalMappingCreate(((PetscObject)is)->comm,m,idxm,PETSC_OWN_POINTER,cltog);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&idx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SingleBodyPoints::updateMeshIdx(const type::Mesh &mesh)
{
PetscFunctionBeginUser;
// loop through points owned locally and find indices
for (PetscInt i = bgPt, c = 0; i < edPt; ++i, ++c)
{
for (PetscInt d = 0; d < dim; ++d)
{
if (mesh->min[d] >= coords[i][d] || mesh->max[d] <= coords[i][d])
{
SETERRQ3(PETSC_COMM_WORLD, PETSC_ERR_MAX_VALUE,
"body coordinate %g is outside domain [%g, %g] !",
coords[i][d], mesh->min[d], mesh->max[d]);
}
meshIdx[c][d] = std::upper_bound(mesh->coord[4][d],
mesh->coord[4][d] + mesh->n[4][d],
coords[i][d]) -
mesh->coord[4][d] - 1;
}
}
PetscFunctionReturn(0);
} // updateMeshIdx
PetscErrorCode KSPSetUpNorms_Private(KSP ksp,KSPNormType *normtype,PCSide *pcside)
{
PetscInt i,j,best,ibest = 0,jbest = 0;
PetscFunctionBegin;
best = 0;
for (i=0; i<KSP_NORM_MAX; i++) {
for (j=0; j<PC_SIDE_MAX; j++) {
if ((ksp->normtype == KSP_NORM_DEFAULT || ksp->normtype == i)
&& (ksp->pc_side == PC_SIDE_DEFAULT || ksp->pc_side == j)
&& (ksp->normsupporttable[i][j] > best)) {
best = ksp->normsupporttable[i][j];
ibest = i;
jbest = j;
}
}
}
if (best < 1) {
if (ksp->normtype == KSP_NORM_DEFAULT && ksp->pc_side == PC_SIDE_DEFAULT) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_PLIB,"The %s KSP implementation did not call KSPSetSupportedNorm()",((PetscObject)ksp)->type_name);
if (ksp->normtype == KSP_NORM_DEFAULT) SETERRQ2(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"KSP %s does not support %s",((PetscObject)ksp)->type_name,PCSides[ksp->pc_side]);
if (ksp->pc_side == PC_SIDE_DEFAULT) SETERRQ2(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"KSP %s does not support %s",((PetscObject)ksp)->type_name,KSPNormTypes[ksp->normtype]);
SETERRQ3(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"KSP %s does not support %s with %s",((PetscObject)ksp)->type_name,KSPNormTypes[ksp->normtype],PCSides[ksp->pc_side]);
}
*normtype = (KSPNormType)ibest;
*pcside = (PCSide)jbest;
PetscFunctionReturn(0);
}
/*@C
PetscBagRegisterBool - add a logical value to the bag
Logically Collective on PetscBag
Input Parameter:
+ bag - the bag of values
. addr - location of logical in struct
. mdefault - the initial value
. name - name of the variable
- help - longer string with more information about the value
Level: beginner
.seealso: PetscBag, PetscBagSetName(), PetscBagView(), PetscBagLoad(), PetscBagGetData()
PetscBagRegisterInt(), PetscBagRegisterBool(), PetscBagRegisterScalar()
PetscBagSetFromOptions(), PetscBagCreate(), PetscBagGetName(), PetscBagRegisterEnum()
@*/
PetscErrorCode PetscBagRegisterBool(PetscBag bag,void *addr,PetscBool mdefault,const char *name,const char *help)
{
PetscErrorCode ierr;
PetscBagItem item;
char nname[PETSC_BAG_NAME_LENGTH+1];
PetscBool printhelp;
PetscFunctionBegin;
/* the checks here with != PETSC_FALSE and PETSC_TRUE is a special case; here we truly demand that the value be 0 or 1 */
if (mdefault != PETSC_FALSE && mdefault != PETSC_TRUE) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Boolean %s %s must be boolean; integer value %d",name,help,(int)mdefault);
nname[0] = '-';
nname[1] = 0;
ierr = PetscStrncat(nname,name,PETSC_BAG_NAME_LENGTH-1);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-help",&printhelp);CHKERRQ(ierr);
if (printhelp) {
ierr = (*PetscHelpPrintf)(bag->bagcomm," -%s%s <%s>: %s \n",bag->bagprefix ? bag->bagprefix : "",name,PetscBools[mdefault],help);CHKERRQ(ierr);
}
ierr = PetscOptionsGetBool(bag->bagprefix,nname,&mdefault,NULL);CHKERRQ(ierr);
ierr = PetscNew(&item);CHKERRQ(ierr);
item->dtype = PETSC_BOOL;
item->offset = ((char*)addr) - ((char*)bag);
if (item->offset > bag->bagsize) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Registered item %s %s is not in bag memory space",name,help);
item->next = 0;
item->msize = 1;
*(PetscBool*)addr = mdefault;
ierr = PetscBagRegister_Private(bag,item,name,help);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatPartitioningHierarchical_DetermineDestination(MatPartitioning part, IS partitioning, PetscInt pstart, PetscInt pend, IS *destination)
{
MPI_Comm comm;
PetscMPIInt rank,size,target;
PetscInt plocalsize,*dest_indices,i;
const PetscInt *part_indices;
PetscErrorCode ierr;
PetscFunctionBegin;
/*communicator*/
ierr = PetscObjectGetComm((PetscObject)part,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if((pend-pstart)>size) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"range [%D, %D] should be smaller than or equal to size %D",pstart,pend,size);CHKERRQ(ierr);
if(pstart>pend) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP," pstart %D should be smaller than pend %D",pstart,pend);CHKERRQ(ierr);
/*local size*/
ierr = ISGetLocalSize(partitioning,&plocalsize);CHKERRQ(ierr);
ierr = PetscCalloc1(plocalsize,&dest_indices);CHKERRQ(ierr);
ierr = ISGetIndices(partitioning,&part_indices);CHKERRQ(ierr);
for(i=0; i<plocalsize; i++){
/*compute target */
target = part_indices[i]-pstart;
/*mark out of range entity as -1*/
if(part_indices[i]<pstart || part_indices[i]>pend) target = -1;
dest_indices[i] = target;
}
/*return destination back*/
ierr = ISCreateGeneral(comm,plocalsize,dest_indices,PETSC_OWN_POINTER,destination);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
DMLabelClearValue - Clear the value a label assigns to a point
Input Parameters:
+ label - the DMLabel
. point - the point
- value - The point value
Level: intermediate
.seealso: DMLabelCreate(), DMLabelGetValue(), DMLabelSetValue()
@*/
PetscErrorCode DMLabelClearValue(DMLabel label, PetscInt point, PetscInt value)
{
PetscInt v, p;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Find label value */
for (v = 0; v < label->numStrata; ++v) {
if (label->stratumValues[v] == value) break;
}
if (v >= label->numStrata) PetscFunctionReturn(0);
if (label->arrayValid[v]) {
/* Check whether point exists */
ierr = PetscFindInt(point, label->stratumSizes[v], &label->points[v][0], &p);CHKERRQ(ierr);
if (p >= 0) {
ierr = PetscMemmove(&label->points[v][p], &label->points[v][p+1], (label->stratumSizes[v]-p-1) * sizeof(PetscInt));CHKERRQ(ierr);
--label->stratumSizes[v];
if (label->bt) {
if ((point < label->pStart) || (point >= label->pEnd)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Label point %D is not in [%D, %D)", point, label->pStart, label->pEnd);
ierr = PetscBTClear(label->bt, point - label->pStart);CHKERRQ(ierr);
}
}
} else {
ierr = PetscHashIDelKey(label->ht[v], point);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode DMLabelClearStratum(DMLabel label, PetscInt value)
{
PetscInt v;
PetscErrorCode ierr;
PetscFunctionBegin;
for (v = 0; v < label->numStrata; ++v) {
if (label->stratumValues[v] == value) break;
}
if (v >= label->numStrata) PetscFunctionReturn(0);
if (label->bt) {
PetscInt i;
for (i = 0; i < label->stratumSizes[v]; ++i) {
const PetscInt point = label->points[v][i];
if ((point < label->pStart) || (point >= label->pEnd)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Label point %D is not in [%D, %D)", point, label->pStart, label->pEnd);
ierr = PetscBTClear(label->bt, point - label->pStart);CHKERRQ(ierr);
}
}
if (label->arrayValid[v]) {
label->stratumSizes[v] = 0;
} else {
PetscHashIClear(label->ht[v]);
}
PetscFunctionReturn(0);
}
/*
*) Ensures data gets been packed appropriately and no overlaps occur
*/
PetscErrorCode DataExPackData(DataEx de,PetscMPIInt proc_id,PetscInt n,void *data)
{
PetscMPIInt local;
PetscInt insert_location;
void *dest;
PetscErrorCode ierr;
PetscFunctionBegin;
if (de->packer_status == DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Packed data have been defined. To modify these call DataExInitializeSendCount(), DataExAddToSendCount(), DataExPackInitialize() first" );
else if (de->packer_status != DEOBJECT_INITIALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Packed data must be defined. Call DataExInitializeSendCount(), DataExAddToSendCount(), DataExPackInitialize() first" );
if (!de->send_message) SETERRQ( de->comm, PETSC_ERR_ORDER, "send_message is not initialized. Call DataExPackInitialize() first" );
ierr = _DataExConvertProcIdToLocalIndex( de, proc_id, &local );CHKERRQ(ierr);
if (local == -1) SETERRQ1( PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "proc_id %d is not registered neighbour", (int)proc_id );
if (n+de->pack_cnt[local] > de->messages_to_be_sent[local]) SETERRQ3( PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Trying to pack too many entries to be sent to proc %d. Space requested = %D: Attempt to insert %D",
(int)proc_id, de->messages_to_be_sent[local], n+de->pack_cnt[local] );
/* copy memory */
insert_location = de->message_offsets[local] + de->pack_cnt[local];
dest = ((char*)de->send_message) + de->unit_message_size*insert_location;
ierr = PetscMemcpy(dest, data, de->unit_message_size * n);CHKERRQ(ierr);
/* increment counter */
de->pack_cnt[local] = de->pack_cnt[local] + n;
PetscFunctionReturn(0);
}
PetscErrorCode DMSwarmDataFieldVerifyAccess(const DMSwarmDataField gfield,const size_t size)
{
PetscFunctionBegin;
#if defined(DMSWARM_DATAFIELD_POINT_ACCESS_GUARD)
if (gfield->atomic_size != size) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_USER,"Field \"%s\" must be mapped to %zu bytes, your intended structure is %zu bytes in length.",gfield->name, gfield->atomic_size, size );
#endif
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);
}
/*@C
PetscViewerVTKFWrite - write binary data preceded by 32-bit int length (in bytes), does not do byte swapping.
Logically collective on PetscViewer
Input Parameters:
+ viewer - logically collective viewer, data written from rank 0
. fp - file pointer valid on rank 0
. data - data pointer valid on rank 0
. n - number of data items
- dtype - data type
Level: developer
Notes: If PetscScalar is __float128 then the binary files are written in double precision
Concepts: VTK files
Concepts: PetscViewer^creating
.seealso: DMDAVTKWriteAll(), DMComplexVTKWriteAll(), PetscViewerSetFormat(), PetscViewerVTKOpen(), PetscBinaryWrite()
@*/
PetscErrorCode PetscViewerVTKFWrite(PetscViewer viewer,FILE *fp,const void *data,PetscInt n,PetscDataType dtype)
{
PetscErrorCode ierr;
PetscMPIInt rank;
#if defined(PETSC_USE_REAL___FLOAT128)
PetscInt i;
double *tmp = NULL;
PetscReal *ttmp = (PetscReal*)data;
#endif
PetscFunctionBegin;
if (n < 0) SETERRQ1(PetscObjectComm((PetscObject)viewer),PETSC_ERR_ARG_OUTOFRANGE,"Trying to write a negative amount of data %D",n);
if (!n) PetscFunctionReturn(0);
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)viewer),&rank);CHKERRQ(ierr);
if (!rank) {
size_t count;
PetscInt size;
PetscVTKInt bytes;
switch (dtype) {
case PETSC_DOUBLE:
size = sizeof(double);
break;
case PETSC_FLOAT:
size = sizeof(float);
break;
#if defined(PETSC_USE_REAL___FLOAT128)
case PETSC___FLOAT128:
size = sizeof(double);
ierr = PetscMalloc1(n,&tmp);CHKERRQ(ierr);
for (i=0; i<n; i++) tmp[i] = ttmp[i];
data = (void*) tmp;
break;
#endif
case PETSC_INT:
size = sizeof(PetscInt);
break;
case PETSC_ENUM:
size = sizeof(PetscEnum);
break;
case PETSC_CHAR:
size = sizeof(char);
break;
default: SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"Data type not supported");
}
bytes = PetscVTKIntCast(size*n);
count = fwrite(&bytes,sizeof(int),1,fp);
if (count != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_WRITE,"Error writing byte count");
count = fwrite(data,size,(size_t)n,fp);
if ((PetscInt)count != n) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_FILE_WRITE,"Wrote %D/%D array members of size %D",(PetscInt)count,n,(PetscInt)size);
#if defined(PETSC_USE_REAL___FLOAT128)
ierr = PetscFree(tmp);CHKERRQ(ierr);
#endif
}
PetscFunctionReturn(0);
}
/* FormFunctionLocal - Evaluates nonlinear residual function r(x) on
local process patch. */
PetscErrorCode FormFunctionLocal(DMDALocalInfo *info,
PetscScalar **x,PetscScalar **r,PorousCtx *user) {
PetscErrorCode ierr;
PetscInt i,j;
PetscReal hx,hy,hxohy,hyohx,carea;
PetscReal beta = user->beta, sig = user->sigma;
PetscScalar W, Wpow, Weast, Wwest, Wnorth, Wsouth,
Qx, Qy;
PetscScalar **f;
PetscFunctionBegin;
user->fcncount = user->fcncount + 1;
for (j=info->ys; j<info->ys+info->ym; j++) {
for (i=info->xs; i<info->xs+info->xm; i++) {
if (x[j][i] < 0) {
SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE,
"negative solution value at (i,j)=(%d,%d) during function eval %d",
i,j,user->fcncount);
}
}
}
hx = (2.0 * user->L) / (PetscReal)(info->mx-1);
hy = (2.0 * user->L) / (PetscReal)(info->my-1);
hxohy = hx / hy;
hyohx = hy / hx;
carea = hx * hy;
/* Compute function over the locally owned part of the grid */
ierr = DMDAVecGetArray(info->da,user->f,&f);CHKERRQ(ierr);
for (j=info->ys; j<info->ys+info->ym; j++) {
for (i=info->xs; i<info->xs+info->xm; i++) {
if (i == 0 || j == 0 || i == info->mx-1 || j == info->my-1) {
/* since Dirichlet condition, residual at boundary is current value */
r[j][i] = carea * x[j][i];
} else {
W = x[j][i];
Weast = 0.5 * (x[j][i+1] + W);
Wwest = 0.5 * (x[j][i-1] + W);
Wnorth = 0.5 * (x[j+1][i] + W);
Wsouth = 0.5 * (x[j-1][i] + W);
Wpow = pow(W,sig);
Qx = ( Weast * (pow(x[j][i+1],sig) - Wpow)
- Wwest * (Wpow - pow(x[j][i-1],sig)) );
Qy = ( Wnorth * (pow(x[j+1][i],sig) - Wpow)
- Wsouth * (Wpow - pow(x[j-1][i],sig)) );
r[j][i] = carea * (W - f[j][i]) - beta * (hyohx * Qx + hxohy * Qy);
}
}
}
ierr = DMDAVecRestoreArray(info->da,user->f,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscBoxUpload - Loads a file to the Box Drive
This routine has not yet been written; it is just copied from Google Drive
Not collective, only the first process in the MPI_Comm uploads the file
Input Parameters:
+ comm - MPI communicator
. access_token - obtained with PetscBoxRefresh(), pass NULL to have PETSc generate one
- filename - file to upload; if you upload multiple times it will have different names each time on Box Drive
Options Database:
. -box_refresh_token XXX
Usage Patterns:
With PETSc option -box_refresh_token XXX given
PetscBoxUpload(comm,NULL,filename); will upload file with no user interaction
Without PETSc option -box_refresh_token XXX given
PetscBoxUpload(comm,NULL,filename); for first use will prompt user to authorize access to Box Drive with their processor
With PETSc option -box_refresh_token XXX given
PetscBoxRefresh(comm,NULL,access_token,sizeof(access_token));
PetscBoxUpload(comm,access_token,filename);
With refresh token entered in some way by the user
PetscBoxRefresh(comm,refresh_token,access_token,sizeof(access_token));
PetscBoxUpload(comm,access_token,filename);
PetscBoxAuthorize(comm,access_token,refresh_token,sizeof(access_token));
PetscBoxUpload(comm,access_token,filename);
Level: intermediate
.seealso: PetscURLShorten(), PetscBoxAuthorize(), PetscBoxRefresh()
@*/
PetscErrorCode PetscBoxUpload(MPI_Comm comm,const char access_token[],const char filename[])
{
SSL_CTX *ctx;
SSL *ssl;
int sock;
PetscErrorCode ierr;
char head[1024],buff[8*1024],*body,*title;
PetscMPIInt rank;
struct stat sb;
size_t len,blen,rd;
FILE *fd;
PetscFunctionBegin;
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
if (!rank) {
ierr = PetscStrcpy(head,"Authorization: Bearer ");CHKERRQ(ierr);
ierr = PetscStrcat(head,access_token);CHKERRQ(ierr);
ierr = PetscStrcat(head,"\r\n");CHKERRQ(ierr);
ierr = PetscStrcat(head,"uploadType: multipart\r\n");CHKERRQ(ierr);
ierr = stat(filename,&sb);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to stat file: %s",filename);
len = 1024 + sb.st_size;
ierr = PetscMalloc1(len,&body);CHKERRQ(ierr);
ierr = PetscStrcpy(body,"--foo_bar_baz\r\n"
"Content-Type: application/json\r\n\r\n"
"{");CHKERRQ(ierr);
ierr = PetscPushJSONValue(body,"title",filename,len);CHKERRQ(ierr);
ierr = PetscStrcat(body,",");CHKERRQ(ierr);
ierr = PetscPushJSONValue(body,"mimeType","text.html",len);CHKERRQ(ierr);
ierr = PetscStrcat(body,",");CHKERRQ(ierr);
ierr = PetscPushJSONValue(body,"description","a file",len);CHKERRQ(ierr);
ierr = PetscStrcat(body, "}\r\n\r\n"
"--foo_bar_baz\r\n"
"Content-Type: text/html\r\n\r\n");CHKERRQ(ierr);
ierr = PetscStrlen(body,&blen);CHKERRQ(ierr);
fd = fopen (filename, "r");
if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open file: %s",filename);
rd = fread (body+blen, sizeof (unsigned char), sb.st_size, fd);
if (rd != (size_t)sb.st_size) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to read entire file: %s %d %d",filename,(int)rd,(int)sb.st_size);
fclose(fd);
body[blen + rd] = 0;
ierr = PetscStrcat(body,"\r\n\r\n"
"--foo_bar_baz\r\n");CHKERRQ(ierr);
ierr = PetscSSLInitializeContext(&ctx);CHKERRQ(ierr);
ierr = PetscHTTPSConnect("www.boxapis.com",443,ctx,&sock,&ssl);CHKERRQ(ierr);
ierr = PetscHTTPSRequest("POST","www.boxapis.com/upload/drive/v2/files/",head,"multipart/related; boundary=\"foo_bar_baz\"",body,ssl,buff,sizeof(buff));CHKERRQ(ierr);
ierr = PetscFree(body);CHKERRQ(ierr);
ierr = PetscSSLDestroyContext(ctx);CHKERRQ(ierr);
close(sock);
ierr = PetscStrstr(buff,"\"title\"",&title);CHKERRQ(ierr);
if (!title) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Upload of file %s failed",filename);
}
PetscFunctionReturn(0);
}
static PetscErrorCode VecSetUp_NestIS_Private(Vec V,PetscInt nb,IS is[])
{
Vec_Nest *ctx = (Vec_Nest*)V->data;
PetscInt i,offset,m,n,M,N;
PetscErrorCode ierr;
PetscFunctionBegin;
if (is) { /* Do some consistency checks and reference the is */
offset = V->map->rstart;
for (i=0; i<ctx->nb; i++) {
ierr = ISGetSize(is[i],&M);CHKERRQ(ierr);
ierr = VecGetSize(ctx->v[i],&N);CHKERRQ(ierr);
if (M != N) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"In slot %D, IS of size %D is not compatible with Vec of size %D",i,M,N);
ierr = ISGetLocalSize(is[i],&m);CHKERRQ(ierr);
ierr = VecGetLocalSize(ctx->v[i],&n);CHKERRQ(ierr);
if (m != n) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"In slot %D, IS of local size %D is not compatible with Vec of local size %D",i,m,n);
#if defined(PETSC_USE_DEBUG)
{ /* This test can be expensive */
PetscInt start;
PetscBool contiguous;
ierr = ISContiguousLocal(is[i],offset,offset+n,&start,&contiguous);CHKERRQ(ierr);
if (!contiguous) SETERRQ1(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Index set %D is not contiguous with layout of matching vector",i);
if (start != 0) SETERRQ1(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Index set %D introduces overlap or a hole",i);
}
#endif
ierr = PetscObjectReference((PetscObject)is[i]);CHKERRQ(ierr);
ctx->is[i] = is[i];
offset += n;
}
} else { /* Create a contiguous ISStride for each entry */
offset = V->map->rstart;
for (i=0; i<ctx->nb; i++) {
PetscInt bs;
ierr = VecGetLocalSize(ctx->v[i],&n);CHKERRQ(ierr);
ierr = VecGetBlockSize(ctx->v[i],&bs);CHKERRQ(ierr);
ierr = ISCreateStride(((PetscObject)ctx->v[i])->comm,n,offset,1,&ctx->is[i]);CHKERRQ(ierr);
ierr = ISSetBlockSize(ctx->is[i],bs);CHKERRQ(ierr);
offset += n;
}
}
PetscFunctionReturn(0);
}
PetscErrorCode MatAssemblyEnd_BlockMat(Mat A,MatAssemblyType mode)
{
Mat_BlockMat *a = (Mat_BlockMat*)A->data;
PetscErrorCode ierr;
PetscInt fshift = 0,i,j,*ai = a->i,*aj = a->j,*imax = a->imax;
PetscInt m = a->mbs,*ip,N,*ailen = a->ilen,rmax = 0;
Mat *aa = a->a,*ap;
PetscFunctionBegin;
if (mode == MAT_FLUSH_ASSEMBLY) PetscFunctionReturn(0);
if (m) rmax = ailen[0]; /* determine row with most nonzeros */
for (i=1; i<m; i++) {
/* move each row back by the amount of empty slots (fshift) before it*/
fshift += imax[i-1] - ailen[i-1];
rmax = PetscMax(rmax,ailen[i]);
if (fshift) {
ip = aj + ai[i];
ap = aa + ai[i];
N = ailen[i];
for (j=0; j<N; j++) {
ip[j-fshift] = ip[j];
ap[j-fshift] = ap[j];
}
}
ai[i] = ai[i-1] + ailen[i-1];
}
if (m) {
fshift += imax[m-1] - ailen[m-1];
ai[m] = ai[m-1] + ailen[m-1];
}
/* reset ilen and imax for each row */
for (i=0; i<m; i++) {
ailen[i] = imax[i] = ai[i+1] - ai[i];
}
a->nz = ai[m];
for (i=0; i<a->nz; i++) {
#if defined(PETSC_USE_DEBUG)
if (!aa[i]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Null matrix at location %D column %D nz %D",i,aj[i],a->nz);
#endif
ierr = MatAssemblyBegin(aa[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(aa[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
ierr = PetscInfo4(A,"Matrix size: %D X %D; storage space: %D unneeded,%D used\n",m,A->cmap->n/A->cmap->bs,fshift,a->nz);CHKERRQ(ierr);
ierr = PetscInfo1(A,"Number of mallocs during MatSetValues() is %D\n",a->reallocs);CHKERRQ(ierr);
ierr = PetscInfo1(A,"Maximum nonzeros in any row is %D\n",rmax);CHKERRQ(ierr);
A->info.mallocs += a->reallocs;
a->reallocs = 0;
A->info.nz_unneeded = (double)fshift;
a->rmax = rmax;
ierr = MatMarkDiagonal_BlockMat(A);CHKERRQ(ierr);
PetscFunctionReturn(0);
}