src/layered/rpe.h
Resting Potential Energy
See Ilicak et al., 2012, appendix A and Petersen et al., 2015, section 2.3. This should obviously be much better documented than this.
Note that other more computationally-efficient options exist, based for example on sampling of histograms of density.
[petersen2015] |
Mark R. Petersen, Douglas W. Jacobsen, Todd D. Ringler, Matthew W. Hecht, and Mathew E. Maltrud. Evaluation of the arbitrary Lagrangian–Eulerian vertical coordinate method in the MPAS-ocean model. Ocean Modelling, 86:93–113, 2015. [ DOI | http ] |
[ilicak2012] |
Mehmet Ilicak, Alistair J. Adcroft, Stephen M. Griffies, and Robert W. Hallberg. Spurious dianeutral mixing and the role of momentum closure. Ocean Modelling, 45-46:37–58, 2012. [ DOI | http ] |
#include "utils.h"
#if dimension == 2
# include "fractions.h"
#endif
struct _Zarea {
scalar zb; // compulsory
double * A, * V; // compulsory
int n; // compulsory
double max; // optional (default 0.)
double min; // optional (default zb.min)
};
typedef struct _Zarea Zarea;
#define A(i) (a->A[i])
double area_integral (Zarea * a, double z1, double z2, double * Az)
{
assert (z2 >= z1);
double dz = (a->max - a->min)/(a->n - 1);
int i2 = (z2 - a->min)/(a->max - a->min)*(a->n - 1);
double f1, f2, z;
if (i2 < 0)
= z2 = 0.;
z else if (i2 < a->n - 1) {
= A(i2), z = a->min + dz*i2;
f1 = A(i2) + (z2 - z)/dz*(A(i2 + 1) - f1);
f2 }
else {
= a->max, f1 = f2 = A(a->n - 1);
z = a->n - 1;
i2 }
double v2, zv2;
if (z < z2) {
= (z2 - z)*(f2 + f1)/2.;
v2 = ((sq(z2) - sq(z))/2.*(f1*z2 - f2*z) +
zv2 (cube(z2) - cube(z))/3.*(f2 - f1))/(z2 - z);
}
else= 0., zv2 = 0.;
v2
int i1;
double v1, zv1;
if (z1 <= a->min)
= 0., zv1 = 0., i1 = -1;
v1 else {
= (z1 - a->min)/(a->max - a->min)*(a->n - 1);
i1 double f1, f2, z;
if (i1 >= a->n - 1) {
= f2 = A(a->n - 1);
f1 = a->max;
z }
else {
= A(i1) + (z1 - a->min - i1*dz)/dz*(A(i1 + 1) - A(i1));
f1 if (i2 > i1)
= A(i1 + 1), z = a->min + dz*(i1 + 1);
f2
else= A(i1), z = a->min + dz*i1;
f2 }
if (z != z1) {
= (z - z1)*(f2 + f1)/2.;
v1 = ((sq(z) - sq(z1))/2.*(f1*z - f2*z1) +
zv1 (cube(z) - cube(z1))/3.*(f2 - f1))/(z - z1);
}
else= 0., zv1 = 0.;
v1 }
double V = v1 + v2;
*Az = zv1 + zv2;
for (int i = i1 + 1; i < i2; i++) {
= a->min + i*dz, z2 = z + dz;
z = A(i), f2 = A(i+1);
f1 += (z2 - z)*(f2 + f1)/2.;
V *Az += ((sq(z2) - sq(z))/2.*(f1*z2 - f2*z) +
(cube(z2) - cube(z))/3.*(f2 - f1))/(z2 - z);
}
return V;
}
double area_z2 (Zarea * a, double z1, double dv, double * Az)
{
double zm = z1, z2 = z1 + 10.*(a->max - a->min);
double vol = area_integral (a, z1, z2, Az);
assert (vol > dv);
while (fabs (z2 - zm) > dry) {
double z = (zm + z2)/2.;
= area_integral (a, z1, z, Az);
vol if (vol > dv) z2 = z;
else zm = z;
// fprintf (stderr, "^^^ dv = %g: zm: %g z2: %g vol: %g\n", dv, zm, z2, vol);
}
// assert (fabs(dv - vol) < 1e-6*dv);
return (zm + z2)/2.;
}
Zarea zarea (scalar zb, double * A, double * V, int n,
double max = 0., double min = 0.)
{
if (min == 0.)
= statsf (zb).min;
min for (int i = 0; i < n; i++) {
double val = min + i*(max - min)/(n - 1);
#if dimension == 2
scalar f[];
fractions (zb, f, val = val);
stats sf = statsf(f);
[i] = sf.volume - sf.sum;
A#else
double area = 0.;
foreach(reduction(+:area)) {
double a = (zb[] + zb[-1])/2. - val, b = (zb[] + zb[1])/2. - val;
if (a*b < 0.) {
double x = a/(a - b);
+= dv()*(a < 0. ? x : 1. - x);
area }
else if (a < 0.)
+= dv();
area }
[i] = area;
A#endif
}
return (Zarea){ zb, A, V, n, max, min };
}
Zarea zvolume (scalar zb, double * A, double * V, int n,
double max = 0., double min = 0.)
{
Zarea s = zarea (zb, A, V, n, max, min);
double volume = 0.;
for (int i = 0; i < n; i++) {
double dz = (s.max - s.min)/(n - 1);
+= dz*A[i];
volume [i] = volume;
V}
return s;
}
double volumez (Zarea s, double volume)
{
if (volume <= 0.) return s.min;
if (volume >= s.V[s.n-1]) return s.max;
int a = 0, b = s.n - 1;
while (b > a + 1) {
int i = (a + b)/2;
if (s.V[i] > volume) b = i;
else a = i;
}
double c = (s.V[a] - volume)/(s.V[a] - s.V[b]);
double dz = (s.max - s.min)/(s.n - 1);
return (s.min + a*dz)*(1. - c) + (s.min + b*dz)*c;
}
double zareaval (Zarea s, double z)
{
double dz = (s.max - s.min)/(s.n - 1);
int j = (z - s.min)/dz;
assert (j >= 0 && j < s.n - 1);
#if 0
printf ("A %d %g %g %g\n", j, s.A[j], s.A[j+1],
.A[j] + (z - s.min)/dz*(s.A[j+1] - s.A[j]));
s#endif
return s.A[j] + (z - s.min)/dz*(s.A[j+1] - s.A[j]);
}
double barycenter (Zarea s, double z1, double z2)
{
if (z1 == z2)
return z1;
assert (z1 >= s.min && z1 < z2 && z2 <= s.max);
int n = 1;
double dz = (z2 - z1)/n, sz = 0., sa = 0., z = z1 + dz/2.;
for (int i = 0; i < n; i++) {
double a = zareaval (s, z);
+= a, sz += z*a, z += dz;
sa }
// printf ("# %g %g %g\n", z1, z2, sz/sa);
return sz/sa;
}
typedef struct {
double rho, dv, z;
} Parcel;
int heavier_than (const void * a, const void * b)
{
Parcel * p1 = (Parcel *)a, * p2 = (Parcel *)b;
return p1->rho > p2->rho ? -1 : 1;
}
double energy (double * PE = NULL, double * KE = NULL)
{
double vPE = 0., vKE = 0.;
foreach(reduction(+:vPE) reduction(+:vKE)) {
double z = zb[];
() {
foreach_layer+= h[]/2;
z double mass = h[]*dv()*(1. + drho(T[]));
+= mass*z;
vPE #if NH
+= mass*sq(w[])/2.;
vKE #endif
foreach_dimension()
+= mass*sq(u.x[])/2.;
vKE += h[]/2;
z }
}
*= G;
vPE if (PE) *PE = vPE;
if (KE) *KE = vKE;
return vPE + vKE;
}
// Parallel sort
size_t psort (void ** base, size_t nmemb, size_t size,
int (* compar)(const void *, const void *))
{
#if _MPI // fixme: sorting is not done in parallel
// Number of MPI processes and current rank
int nproc, rank;
(MPI_COMM_WORLD, &nproc);
MPI_Comm_size (MPI_COMM_WORLD, &rank);
MPI_Comm_rank
int counts[nproc];
// Each process tells the root how many elements it holds
*= size;
nmemb (&nmemb, 1, MPI_INT, counts, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Gather
// Displacements in the receive buffer for MPI_GATHERV
int disps[nproc];
// Displacement for the first chunk of data - 0
for (int i = 0; i < nproc; i++)
[i] = i > 0 ? (disps[i - 1] + counts[i - 1]) : 0;
disps
if (rank == 0) {
size_t nmemb1 = disps[nproc-1] + counts[nproc-1];
void * alldata = malloc (nmemb1);
(*base, nmemb, MPI_BYTE,
MPI_Gatherv , counts, disps, MPI_BYTE, 0, MPI_COMM_WORLD);
alldatafree (*base);
*base = alldata;
= nmemb1/size;
nmemb (*base, nmemb, size, compar);
qsort }
else(*base, nmemb, MPI_BYTE,
MPI_Gatherv , counts, disps, MPI_BYTE, 0, MPI_COMM_WORLD);
NULL#else
(*base, nmemb, size, compar);
qsort #endif
return nmemb;
}
// Resting Potential Energy: see e.g. Ilicak et al, 2012, Appendix A
trace
double RPE (int n = 100)
{
double A[n], V[n];
Zarea vol = zarea (zb, A, V, n);
#if 0
for (int i = 0; i < vol.n; i++) {
double dz = (vol.max - vol.min)/(vol.n - 1);
fprintf (stderr, "%g %g %g\n", vol.min + i*dz, V[i], - statsf (zb).sum);
}
for (double volume = 0.; volume <= V[vol.n-1]; volume += V[vol.n-1]/35.)
printf ("%g %g\n", volumez (vol, volume), volume);
exit (0);
#endif
long nb = 0;
foreach_leaf() nb++;
*= nl;
nb Parcel * p = malloc (sizeof(Parcel)*nb);
long i = 0;
foreach_leaf()
() {
foreach_layerassert (i < nb);
[i++] = (Parcel){ 1. + drho(T[]), h[]*dv() };
p}
= psort ((void **) &p, nb, sizeof (Parcel), heavier_than);
nb
double RPE = HUGE;
if (pid() == 0) {
RPE = 0.;
double volume = 0.;
double z = vol.min;
for (int i = 0; i < nb; i++)
if (p[i].dv > 0.) {
+= p[i].dv;
volume #if 1
double Az, zt = area_z2 (&vol, z, p[i].dv, &Az);
[i].z = Az/p[i].dv;
pRPE += p[i].rho*Az; // see e.g. (1) in Ilicak et al, 2012
#else
double zt = volumez (vol, volume);
[i].z = barycenter (vol, z, zt);
p
// fprintf (stderr, "&& %g %g %g %g\n", zt, zt1, p[i].z, Az/p[i].dv);
[i].z = Az/p[i].dv;
pRPE += p[i].rho*p[i].z*p[i].dv; // see e.g. (1) in Ilicak et al, 2012
#endif
// fprintf (stdout, "%g %g %g %g\n", p[i].rho, p[i].dv, p[i].z, zt);
= zt;
z }
}
// fprintf (stdout, "****\n");
(RPE, MPI_DOUBLE, MPI_MIN);
mpi_all_reduce free (p);
return RPE*G;
}