static dErr dUnitsAssignName(dUnits un,const char *(*namer)(dUnit),const char *proposed,dInt n,const dReal expon[],char **assigned)
{
dErr err;
char buf[1024],*p = buf;
dInt left = 1024;
dFunctionBegin;
if (proposed) {
err = PetscStrallocpy(proposed,assigned);dCHK(err);
dFunctionReturn(0);
}
buf[0] = 0;
for (dInt i=0; i<n; i++) {
const char *s;
dUnit base;
dInt len;
if (expon[i] == 0) continue;
err = dUnitsGetBase(un,i,&base);dCHK(err);
s = namer(base);
if (expon[i] == 1)
len = snprintf(p,left,"%s ",s);
else if (round(expon[i]) == expon[i])
len = snprintf(p,left,"%s^%1.0f ",s,expon[i]);
else
len = snprintf(p,left,"%s^%f ",s,expon[i]);
left -= len;
p += len;
}
p[-1] = 0; // Kill trailing space
err = PetscStrallocpy(buf,assigned);dCHK(err);
dFunctionReturn(0);
}
dErr dUnitsInitializePackage(const dUNUSED char path[])
{
dErr err;
dFunctionBegin;
if (dUnitsPackageInitialized) dFunctionReturn(0);
dUnitsPackageInitialized = dTRUE;
err = PetscClassIdRegister("dUnits",&dUNITS_CLASSID);dCHK(err);
err = PetscRegisterFinalize(dUnitsFinalizePackage);dCHK(err);
dFunctionReturn(0);
}
dErr dFSRotationDestroy(dFSRotation *rot)
{
dErr err;
dFunctionBegin;
if (!*rot) dFunctionReturn(0);
dValidHeader(*rot,dFSROT_CLASSID,1);
err = ISDestroy(&(*rot)->is);dCHK(err);
err = VecDestroy(&(*rot)->strong);dCHK(err);
err = dFree2((*rot)->rmat,(*rot)->nstrong);dCHK(err);
err = PetscHeaderDestroy(rot);dCHK(err);
dFunctionReturn(0);
}
dErr dUnitsView(dUnits un,dViewer viewer)
{
dBool iascii;
dErr err;
dFunctionBegin;
dValidHeader(un,dUNITS_CLASSID,1);
if (!viewer) {err = PetscViewerASCIIGetStdout(((dObject)un)->comm,&viewer);dCHK(err);}
dValidHeader(viewer,PETSC_VIEWER_CLASSID,2);
PetscCheckSameComm(un,1,viewer,2);
err = PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);dCHK(err);
if (iascii) {
err = PetscObjectPrintClassNamePrefixType((PetscObject)un,viewer,"Units Manager");dCHK(err);
err = PetscViewerASCIIPushTab(viewer);dCHK(err);
for (dInt i=0; i<un->nalloc && un->list[i]; i++) {
dUnit u = un->list[i];
err = PetscViewerASCIIPrintf(viewer,"%-12s: 1 internal unit = %10.4e %s (%s) = %10.4e %s\n",
dUnitQuantityName(u),dUnitDimensionalize(u,1.0),dUnitName(u),dUnitShortName(u),dUnitDimensionalizeSI(u,1.0),dUnitSIName(u));dCHK(err);
err = PetscViewerASCIIPrintf(viewer,"%-12s 1 %s = %10.4e %s\n","",dUnitShortName(u),dUnitDimensionalizeSI(u,dUnitNonDimensionalize(u,1.0)),dUnitSIName(u));dCHK(err);
}
err = PetscViewerASCIIPopTab(viewer);dCHK(err);
} else dERROR(((dObject)un)->comm,PETSC_ERR_SUP,"Viewer type %s not supported",((PetscObject)viewer)->type_name);
dFunctionReturn(0);
}
dErr dUnitsSetFromOptions(dUnits un)
{
dErr err;
dFunctionBegin;
dValidHeader(un,dUNITS_CLASSID,1);
err = PetscOptionsBegin(((PetscObject)un)->comm,((PetscObject)un)->prefix,"Units manager","dUnits");dCHK(err);
for (dUnitsBaseType btype = 0; btype < dUNITS_MAX; btype++) {
char opt[256],help[256],uspec[256];
dReal commonpersi = 1.0,scale = 1.0;
dBool flg;
err = PetscSNPrintf(opt,sizeof opt,"-units_%s",dUnitsBaseTypes[btype]);dCHK(err);
err = PetscSNPrintf(uspec,sizeof uspec,"%s:%s:%f:%f",dUnitsBaseNamesSI[btype],dUnitsBaseNamesShortSI[btype],commonpersi,scale);
err = PetscSNPrintf(help,sizeof help,"Common name:short name:one common unit of %s expressed in %s:common units per non-dimensionalized",dUnitsBaseTypes[btype],dUnitsBaseNamesSI[btype]);dCHK(err);
err = PetscOptionsString(opt,help,"dUnitsSetBase",uspec,uspec,sizeof uspec,&flg);dCHK(err);
if (flg) {
char *longname,*shortname,*buf1,*buf2;
longname = uspec;
if (!(shortname = strchr(longname,':'))) dERROR(((dObject)un)->comm,PETSC_ERR_USER,"The field specification '%s' is ':' delimited",opt);
*shortname++ = 0;
if (!(buf1 = strchr(shortname,':'))) dERROR(((dObject)un)->comm,PETSC_ERR_USER,"The field specification for '%s' needs four arguments, but only two given",longname);
*buf1++ = 0;
if (!(buf2 = strchr(buf1,':'))) dERROR(((dObject)un)->comm,PETSC_ERR_USER,"The field specification for '%s' needs four arguments, but only three given",longname);
*buf2++ = 0;
if (sscanf(buf1,"%lf",&commonpersi) != 1) dERROR(((dObject)un)->comm,PETSC_ERR_USER,"Size of common unit '%s' could not be parsed from '%s'",longname,buf1);
if (sscanf(buf2,"%lf",&scale) != 1) dERROR(((dObject)un)->comm,PETSC_ERR_USER,"Scale for common unit '%s' could not be parsed from '%s'",longname,buf2);
err = dUnitsSetBase(un,btype,longname,shortname,commonpersi,scale,NULL);dCHK(err);
}
}
err = PetscOptionsEnd();dCHK(err);
dFunctionReturn(0);
}
// Logically collective
dErr dUnitsCreateUnit(dUnits un,const char *type,const char *longname,const char *shortname,dInt n,const dReal expon[],dUnit *newunit)
{
dErr err;
dUnit unit;
dFunctionBegin;
dValidHeader(un,dUNITS_CLASSID,1);
if (n < 1 || n > dUNITS_MAX) dERROR(((dObject)un)->comm,PETSC_ERR_ARG_OUTOFRANGE,"The number of exponents %D must be positive, but no larger than %D",n,(dInt)dUNITS_MAX);
dValidRealPointer(expon,5);
dValidPointer(newunit,6);
err = dUnitsGetEmptyUnit_Private(un,&unit);dCHK(err);
err = PetscStrallocpy(type,&unit->quantity);dCHK(err);
err = dUnitsAssignName(un,dUnitName,longname,n,expon,&unit->longname);dCHK(err);
err = dUnitsAssignName(un,dUnitShortName,shortname,n,expon,&unit->shortname);dCHK(err);
err = dUnitsAssignName(un,dUnitSIName,NULL,n,expon,&unit->siname);dCHK(err);
unit->toSI = 1.0;
unit->toCommon = 1.0;
for (dInt i=0; i<n; i++) {
dUnit base;
err = dUnitsGetBase(un,i,&base);dCHK(err);
unit->toCommon *= PetscPowScalar(dUnitDimensionalize(base,1.0),expon[i]);
unit->toSI *= PetscPowScalar(dUnitDimensionalizeSI(base,1.0),expon[i]);
unit->expon[i] = expon[i];
}
*newunit = unit;
dFunctionReturn(0);
}
/** Create a cache for Dirichlet part of closure vector, and scatter from global closure to Dirichlet cache.
@arg[in] gvec Global vector
@arg[out] dcache New vector to hold the Dirichlet values
@arg[out] dscat Scatter from global closure to \a dcache
@note This could be local but it doesn't cost anything to make it global.
**/
dErr VecDohpCreateDirichletCache(Vec gvec,Vec *dcache,VecScatter *dscat)
{
MPI_Comm comm;
dErr err;
dBool isdohp;
IS from;
Vec gc;
dInt n,nc,crstart;
dFunctionBegin;
dValidHeader(gvec,VEC_CLASSID,1);
dValidPointer(dcache,2);
dValidPointer(dscat,3);
err = PetscTypeCompare((PetscObject)gvec,VECDOHP,&isdohp);dCHK(err);
if (!isdohp) dERROR(PETSC_COMM_SELF,PETSC_ERR_SUP,"Vec type %s",((PetscObject)gvec)->type_name);
err = PetscObjectGetComm((PetscObject)gvec,&comm);dCHK(err);
err = VecGetLocalSize(gvec,&n);dCHK(err);
err = VecDohpGetClosure(gvec,&gc);dCHK(err);
err = VecGetLocalSize(gc,&nc);dCHK(err);
err = VecGetOwnershipRange(gc,&crstart,NULL);dCHK(err);
err = VecCreateMPI(comm,nc-n,PETSC_DECIDE,dcache);dCHK(err);
err = ISCreateStride(comm,nc-n,crstart+n,1,&from);dCHK(err);
err = VecScatterCreate(gc,from,*dcache,NULL,dscat);dCHK(err);
err = VecDohpRestoreClosure(gvec,&gc);dCHK(err);
err = ISDestroy(&from);dCHK(err);
/* \todo deal with rotations */
dFunctionReturn(0);
}
/** Set rotation for certain nodes in a function space
*
* @param fs the function space
* @param is index set of nodes to rotate, sequential, with respect blocks of local vector
* @param rot Rotation matrices at all nodes in \a is. Should have length \c bs*bs*size(is).
* @param ns number of dofs to enforce strongly at each node (every entry must have 0<=ns[i]<=bs)
* @param v Vector of values for strongly enforced dofs
*
* @example Consider 2D flow over a bed with known melt rates. Suppose the local velocity vector is
*
* [u0x,u0y; u1x,u1y; u2x,u2y; u3x,u3y | u4x,u4y]
*
* (4 owned blocks, one ghosted block) and nodes 1,4 are on the slip boundary with normal and tangent vectors n1,t1,n4,t4
* and melt rates r1,r4. To enforce the melt rate strongly, use
*
* \a is = [1,4]
* \a rot = [n10,n11,t10,t11, n40,n41,t40,t41]
* \a ns = [1,1]
* \a v = [r1,r4]
*
* The rotated vector will become (. = \cdot)
*
* [u0x,u0y; u1.n1,u1.t1; u2x,u2y; u3x,u3y | u4.n4,u4.t4]
*
* and strongly enforcing melt rate produces the global vector
*
* [u0x,u0y; r1,u1.t1; u2x,u2y; u3x,u3y | r4,u4.t4] .
*
* This is what the solver sees, the Jacobian will always have rows and columns of the identity corresponding to the
* strongly enforced components (2,8 of the local vector) and the residual will always be 0 in these components. Hence
* the Newton step v will always be of the form
*
* [v0x,v0y; 0,v1y; v2x,v2y; v3x,v3y | 0,v4y] .
**/
dErr dFSRotationCreate(dFS fs,IS is,dReal rmat[],dInt ns[],Vec v,dFSRotation *inrot)
{
dFSRotation rot;
dInt bs,n;
dErr err;
dFunctionBegin;
dValidHeader(fs,DM_CLASSID,1);
dValidHeader(is,IS_CLASSID,2);
dValidRealPointer(rmat,3);
dValidIntPointer(ns,4);
dValidHeader(v,VEC_CLASSID,5);
dValidPointer(inrot,6);
*inrot = 0;
err = PetscHeaderCreate(rot,_p_dFSRotation,struct _dFSRotationOps,dFSROT_CLASSID,"dFSRotation","Local function space rotation","FS",PETSC_COMM_SELF,dFSRotationDestroy,dFSRotationView);dCHK(err);
err = dFSGetBlockSize(fs,&bs);dCHK(err);
rot->bs = bs;
err = ISGetSize(is,&n);dCHK(err);
rot->n = n;
err = PetscObjectReference((PetscObject)is);dCHK(err);
rot->is = is;
err = PetscObjectReference((PetscObject)v);dCHK(err);
rot->strong = v;
for (dInt i=0; i<n; i++) {
if (ns[i] < 0 || bs < ns[i]) dERROR(PETSC_COMM_SELF,1,"Number of strong dofs must be between 0 and bs=%d (inclusive)",bs);
/* \todo Check that every rmat is orthogonal */
}
err = dMallocA2(n*bs*bs,&rot->rmat,n,&rot->nstrong);dCHK(err);
err = dMemcpy(rot->rmat,rmat,n*bs*bs*sizeof rmat[0]);dCHK(err);
err = dMemcpy(rot->nstrong,ns,n*sizeof ns[0]);dCHK(err);
*inrot = rot;
dFunctionReturn(0);
}
dErr dFSGetBoundingBox(dFS fs,dReal bbox[3][2])
{
dErr err;
Vec X;
const dScalar *x;
dInt n;
dFunctionBegin;
for (dInt i=0; i<3; i++) {
bbox[i][0] = PETSC_MAX_REAL;
bbox[i][1] = PETSC_MIN_REAL;
}
err = dFSGetGeometryVectorExpanded(fs,&X);
dCHK(err);
err = VecGetLocalSize(X,&n);
dCHK(err);
err = VecGetArrayRead(X,&x);
dCHK(err);
for (dInt i=0; i<n; i++) {
dInt j = i%3;
bbox[j][0] = dMin(bbox[j][0],x[i]);
bbox[j][1] = dMax(bbox[j][1],x[i]);
}
err = VecRestoreArrayRead(X,&x);
dCHK(err);
dFunctionReturn(0);
}
static dErr VHTCaseSolution_Jako(VHTCase scase,const dReal x[3],dScalar rhou[],dScalar drhou[],dScalar *p,dScalar dp[],dScalar *E,dScalar dE[])
{ /* Defines inhomogeneous Dirichlet boundary conditions */
VHTCase_Jako *jako = scase->data;
struct VHTRheology *rheo = &scase->rheo;
double h,b;
dInt pixel,xp,yp;
dReal u[3],dh[2] = {0,0};
dScalar e;
dErr err;
dFunctionBegin;
err = JakoFindPixel(scase,x,&xp,&yp);dCHK(err);
pixel = yp*jako->nx + xp;
h = jako->h[pixel];
b = jako->b[pixel];
err = JakoGradient2(scase,jako->h,xp,yp,dh);dCHK(err);
err = JakoSIAVelocity(scase,b,h,dh,x[2],u);dCHK(err);
err = JakoInternalEnergy(scase,b,h,x,&e);dCHK(err);
for (dInt i=0; i<3; i++) rhou[i] = rheo->rhoi * u[i]; // Just assume constant density
for (dInt i=0; i<9; i++) drhou[i] = 0;
*p = rheo->rhoi * rheo->gravity[2] * (h - x[2]);
for (dInt i=0; i<3; i++) dp[i] = -rheo->rhoi * rheo->gravity[i];
*E = rheo->rhoi * e;
for (dInt i=0; i<3; i++) dE[i] = 0;
dFunctionReturn(0);
}
dErr VecCreateDohp(MPI_Comm comm,dInt bs,dInt n,dInt nc,dInt nghosts,const dInt ghosts[],Vec *v)
{
Vec_MPI *vmpi;
Vec vc,vg;
dScalar *a;
dErr err;
dFunctionBegin;
dValidPointer(v,7);
*v = 0;
err = VecCreateGhostBlock(comm,bs,nc*bs,PETSC_DECIDE,nghosts,ghosts,&vc);dCHK(err);
err = VecGetArray(vc,&a);dCHK(err);
err = VecCreateMPIWithArray(comm,n*bs,PETSC_DECIDE,a,&vg);dCHK(err);
err = VecRestoreArray(vc,&a);dCHK(err);
err = VecSetBlockSize(vg,bs);dCHK(err);
vmpi = vg->data;
if (vmpi->localrep) dERROR(PETSC_COMM_SELF,1,"Vector has localrep, expected no localrep");
vmpi->localrep = vc; /* subvert this field to mean closed rep */
/* Since we subvect .localrep, VecDestroy_MPI will automatically destroy the closed form */
vg->ops->duplicate = VecDuplicate_Dohp;
//vg->ops->destroy = VecDestroy_Dohp;
/* It might be useful to set the (block) LocalToGlobal mapping here, but in the use case I have in mind, the user is
* always working with the closed form anyway (in function evaluation). The \e matrix does need a customized
* LocalToGlobal mapping.
*/
err = PetscObjectChangeTypeName((dObject)vg,VECDOHP);dCHK(err);
*v = vg;
dFunctionReturn(0);
}
static dErr VHTCaseCreate_Wind(VHTCase scase)
{
dFunctionBegin;
scase->reality = dTRUE;
scase->solution = VHTCaseSolution_Wind;
scase->forcing = VHTCaseForcing_Wind;
dFunctionReturn(0);
}
dErr dViewerRegisterAll(const char *path)
{
dErr err;
dFunctionBegin;
err = PetscViewerRegister(PETSCVIEWERDHM,path,"PetscViewerCreate_DHM",PetscViewerCreate_DHM);dCHK(err);
dFunctionReturn(0);
}
/** Get coordinates for every node in closure (every subelement vertex)
*
* @note This function cannot be implemented for all \a dFS types. For most purposes, users should
* \a dFSGetGeometryVectorExpanded and evaluate (element by element) on the nodes of their choice
* (with a self-quadrature).
*
* @param fs Function space
* @param inx the new vector with block size 3 and the same number of blocks as the closure vector
**/
dErr dFSGetNodalCoordinatesGlobal(dFS fs,Vec *inx)
{
dErr err;
Vec Expanded,Ones,X,Count,Xclosure,Countclosure;
dFS fs3;
dFunctionBegin;
dValidHeader(fs,DM_CLASSID,1);
dValidPointer(inx,2);
*inx = 0;
err = dFSGetNodalCoordinateFS(fs,&fs3);
dCHK(err);
err = dFSGetNodalCoordinatesExpanded(fs,&Expanded);
dCHK(err);
if (!fs->nodalcoord.global) {
err = dFSCreateGlobalVector(fs3,&fs->nodalcoord.global);
dCHK(err);
}
X = fs->nodalcoord.global;
/* Count the number of occurances of each node in the closure. */
err = VecDuplicate(Expanded,&Ones);
dCHK(err);
err = VecDuplicate(X,&Count);
dCHK(err);
err = VecDohpZeroEntries(Count);
dCHK(err);
err = VecSet(Ones,1.);
dCHK(err);
err = dFSExpandedToGlobal(fs3,Ones,Count,dFS_INHOMOGENEOUS,ADD_VALUES);
dCHK(err);
err = VecDestroy(&Ones);
dCHK(err);
err = VecDohpZeroEntries(X);
dCHK(err);
err = dFSExpandedToGlobal(fs3,Expanded,X,dFS_INHOMOGENEOUS,ADD_VALUES);
dCHK(err);
err = VecDohpGetClosure(X,&Xclosure);
dCHK(err);
err = VecDohpGetClosure(Count,&Countclosure);
dCHK(err);
err = VecPointwiseDivide(Xclosure,Xclosure,Countclosure);
dCHK(err);
err = VecDohpRestoreClosure(X,&Xclosure);
dCHK(err);
err = VecDohpRestoreClosure(Count,&Countclosure);
dCHK(err);
err = VecDestroy(&Count);
dCHK(err);
*inx = X;
dFunctionReturn(0);
}
/** Apply rotation to global vector
*
* @note does nothing if rotation is NULL
**/
dErr dFSRotationApply(dFSRotation rot,Vec g,dFSRotateMode rmode,dFSHomogeneousMode hmode)
{
dErr err;
Vec gc,lf;
dFunctionBegin;
if (!rot) dFunctionReturn(0);
dValidHeader(rot,dFSROT_CLASSID,1);
dValidHeader(g,VEC_CLASSID,2);
if (rot->ops->apply) {
err = rot->ops->apply(rot,g,rmode,hmode);dCHK(err);
} else {
err = VecDohpGetClosure(g,&gc);dCHK(err);
err = VecGhostGetLocalForm(gc,&lf);dCHK(err);
err = dFSRotationApplyLocal(rot,lf,rmode,hmode);dCHK(err); /* \todo only rotate the global portion */
err = VecGhostRestoreLocalForm(gc,&lf);dCHK(err);
err = VecDohpRestoreClosure(g,&gc);dCHK(err);
}
dFunctionReturn(0);
}
dErr dViewerDHMSetTime(dViewer viewer,dReal time)
{
dErr err,(*r)(dViewer,dReal);
dFunctionBegin;
err = PetscObjectQueryFunction((PetscObject)viewer,"dViewerDHMSetTime_C",(void(**)(void))&r);dCHK(err);
if (r) {
err = (*r)(viewer,time);dCHK(err);
}
dFunctionReturn(0);
}
dErr dViewerDHMSetTimeUnits(dViewer viewer,const char *units,dReal scale)
{
dErr err,(*r)(dViewer,const char*,dReal);
dFunctionBegin;
err = PetscObjectQueryFunction((PetscObject)viewer,"dViewerDHMSetTimeUnits_C",(void(**)(void))&r);dCHK(err);
if (r) {
err = (*r)(viewer,units,scale);dCHK(err);
}
dFunctionReturn(0);
}
/** dFSGetNodalCoordinateFS - Gets an FS the same size as the solution FS, but with block size 3 to hold nodal coordinates
*
*/
dErr dFSGetNodalCoordinateFS(dFS fs,dFS *nfs)
{
dErr err;
dFunctionBegin;
if (!fs->nodalcoord.fs) {
err = dFSRedimension(fs,3,dFS_INTERIOR,&fs->nodalcoord.fs);
dCHK(err);
}
*nfs = fs->nodalcoord.fs;
dFunctionReturn(0);
}
static dErr JakoViewWKT(OGRSpatialReferenceH ref,const char *name,PetscViewer viewer)
{
dErr err;
OGRErr oerr;
char *wkt;
dFunctionBegin;
oerr = OSRExportToPrettyWkt(ref,&wkt,0);dOGRCHK(oerr);
err = PetscViewerASCIIPrintf(viewer,"WKT %s: %s\n\n",name,wkt);dCHK(err);
OGRFree(wkt);
dFunctionReturn(0);
}
static dErr VHTCaseView_Jako(VHTCase scase,PetscViewer viewer)
{
VHTCase_Jako *jako = scase->data;
dErr err;
dFunctionBegin;
err = PetscViewerASCIIPrintf(viewer,"VHTCase: Jakobshavn\n");dCHK(err);
err = JakoViewWKT(jako->utmref,"UTM",viewer);dCHK(err);
err = JakoViewWKT(jako->llref,"LonLat",viewer);dCHK(err);
err = JakoViewWKT(jako->ianref,"Ian",viewer);dCHK(err);
dFunctionReturn(0);
}
static dErr JakoInternalEnergy_Sharp2(VHTCase scase,dReal b,dReal h,const dReal x[],dScalar *e)
{
struct VHTRheology *rheo = &scase->rheo;
dReal z,t,T;
dFunctionBegin;
z = (x[2] - b) / (h-b); // Normalize to [0,1] plus possible fuzz
z = dMax(0,dMin(1,z)); // Clip to [0,1]
t = z < 0.3 ? 0 : (z < 0.7 ? 2 : 1);
T = rheo->T3 - (rheo->T3 - rheo->T0)*t; // Maximum value is at the bed and equal to T3, extends past T0
*e = rheo->c_i * (T - rheo->T0); // energy/mass
dFunctionReturn(0);
}
static dErr JakoInternalEnergy_Smooth(VHTCase scase,dReal b,dReal h,const dReal x[],dScalar *e)
{
struct VHTRheology *rheo = &scase->rheo;
dReal z,t,T;
dFunctionBegin;
z = (x[2] - b) / (h-b); // Normalize to [0,1] plus possible fuzz
z = dMax(0,dMin(1,z)); // Clip to [0,1]
t = 90*dSqr(z)*exp(-5*z); // hump with maximum value close to 2
T = rheo->T3 - (rheo->T3 - rheo->T0)*t; // Maximum value is at the bed and equal to T3, extends past T0
*e = rheo->c_i * (T - rheo->T0); // energy/mass
dFunctionReturn(0);
}
dErr dUnitsFindUnit(dUnits un,const char *name,dUnit *unit)
{
dErr err;
dFunctionBegin;
*unit = NULL;
for (dInt i=0; i<un->nalloc; i++) {
dBool flg;
dUnit t = un->list[i];
err = PetscStrcmp(t->longname,name,&flg);dCHK(err);
if (flg) {*unit = t; break;}
}
dFunctionReturn(0);
}
dErr dUnitsDestroy(dUnits *unp)
{
dUnits un = *unp;
dErr err;
dFunctionBegin;
if (!un) dFunctionReturn(0);
PetscValidHeaderSpecific(un,dUNITS_CLASSID,1);
if (--((PetscObject)un)->refct > 0) dFunctionReturn(0);
for (dInt i=0; i<un->nalloc; i++) {
dUnit u = un->list[i];
if (u) {
err = dFree(u->quantity);dCHK(err);
err = dFree(u->longname);dCHK(err);
err = dFree(u->shortname);dCHK(err);
err = dFree(u->siname);dCHK(err);
}
err = dFree(un->list[i]);dCHK(err);
}
err = dFree(un->list);dCHK(err);
err = PetscHeaderDestroy(unp);dCHK(err);
dFunctionReturn(0);
}
static dErr VecStateSync_Private(Vec x,Vec y)
{
dInt xstate,ystate;
dErr err;
dFunctionBegin;
dValidHeader(x,VEC_CLASSID,1);
dValidHeader(y,VEC_CLASSID,2);
err = PetscObjectStateQuery((dObject)x,&xstate);dCHK(err);
err = PetscObjectStateQuery((dObject)y,&ystate);dCHK(err);
err = PetscObjectSetState((dObject)x,dMaxInt(xstate,ystate));dCHK(err);
err = PetscObjectSetState((dObject)y,dMaxInt(xstate,ystate));dCHK(err);
dFunctionReturn(0);
}
static dErr JakoInternalEnergy_Sharp1(VHTCase scase,dReal b,dReal h,const dReal x[],dScalar *e)
{
struct VHTRheology *rheo = &scase->rheo;
dReal z,t,T;
dFunctionBegin;
z = (x[2] - b) / (h-b); // Normalize to [0,1] plus possible fuzz
z = dMax(0,dMin(1,z)); // Clip to [0,1]
t = floor(5 * z) * 0.2;
T = rheo->T3 - (rheo->T3 - rheo->T0)*t; // Maximum value is at the bed and equal to T3, extends past T0
*e = rheo->c_i * (T - rheo->T0); // energy/mass
//printf("b %g h %g H %g z %g t %g T %g e %g\n",b,h,h-b,z,t,T,e[0]);
dFunctionReturn(0);
}
static dErr dUnitsGetEmptyUnit_Private(dUnits un,dUnit *unit)
{
dInt i;
dErr err;
dFunctionBegin;
*unit = NULL;
for (i=0; i<un->nalloc && un->list[i]; i++) ;
if (i == un->nalloc) dERROR(((dObject)un)->comm,PETSC_ERR_SUP,"reallocation not implemented");
err = dCallocA(1,&un->list[i]);dCHK(err);
un->list[i]->world = un;
*unit = un->list[i];
dFunctionReturn(0);
}
/** Get the number of subelements and number of vertices of subelements.
**/
dErr dFSGetSubElementMesh(dFS fs,dInt nelems,dInt nconn,dEntTopology topo[],dInt off[],dInt ind[])
{
dErr err;
dFunctionBegin;
dValidHeader(fs,DM_CLASSID,1);
dValidIntPointer(topo,4);
dValidIntPointer(off,5);
dValidIntPointer(ind,6);
if (!fs->ops->getsubelementmesh) dERROR(PETSC_COMM_SELF,1,"not implemented");
err = (*fs->ops->getsubelementmesh)(fs,nelems,nconn,topo,off,ind);
dCHK(err);
dFunctionReturn(0);
}
/** Get the number of subelements and number of vertices of subelements.
*
* @note the number of vertices is the same as the number of local nodes in closure vertor.
**/
dErr dFSGetSubElementMeshSize(dFS fs,dInt *nelems,dInt *nverts,dInt *nconn)
{
dErr err;
dFunctionBegin;
dValidHeader(fs,DM_CLASSID,1);
dValidIntPointer(nelems,2);
dValidIntPointer(nverts,3);
dValidIntPointer(nconn,4);
if (!fs->ops->getsubelementmeshsize) dERROR(PETSC_COMM_SELF,1,"not implemented");
err = (*fs->ops->getsubelementmeshsize)(fs,nelems,nverts,nconn);
dCHK(err);
dFunctionReturn(0);
}
/** Get displacements of every node in expanded vector.
*
* @param fs Function space
* @param ingeom the new geometry vector with block size 3 and same number of blocks as points in the expanded vector.
*
* @note This is not suitable for use as a function space,
*
* @note It is important to get geometry associated with boundary sets because it will frequently be projected against
* the boundary.
**/
dErr dFSGetGeometryVectorExpanded(dFS fs,Vec *ingeom)
{
dErr err;
dFunctionBegin;
dValidHeader(fs,DM_CLASSID,1);
dValidPointer(ingeom,2);
*ingeom = 0;
if (!fs->geometry.expanded) {
err = dFSCreateGeometryFromMesh_Private(fs);
dCHK(err);
}
*ingeom = fs->geometry.expanded;
dFunctionReturn(0);
}
