int model_z2fk(model* m, int vid, double fi, double fj, double z, double* fk)
{
void* grid = m->grids[m->vars[vid].gridid];
int isperiodic_x = grid_isperiodic_x(grid);
int** numlevels = grid_getnumlevels(grid);
int ni, nj;
int i1, i2, j1, j2, k2;
if (isnan(fi + fj)) {
*fk = NaN;
return STATUS_OUTSIDEGRID;
}
grid_z2fk(grid, fi, fj, z, fk);
if (isnan(*fk))
return STATUS_OUTSIDEGRID;
if (grid_getvtype(grid) == GRIDVTYPE_SIGMA)
return STATUS_OK;
/*
* a depth check for z-grid:
*/
model_getvardims(m, vid, &ni, &nj, NULL);
i1 = floor(fi);
i2 = ceil(fi);
if (i1 == -1)
i1 = (isperiodic_x) ? ni - 1 : i2;
if (i2 == ni)
i2 = (isperiodic_x) ? 0 : i1;
j1 = floor(fj);
j2 = ceil(fj);
if (j1 == -1)
j1 = j2;
if (j2 == nj)
j2 = j1;
k2 = floor(*fk);
if (numlevels[j1][i1] <= k2 && numlevels[j1][i2] <= k2 && numlevels[j2][i1] <= k2 && numlevels[j2][i2] <= k2) {
*fk = NaN;
return STATUS_LAND;
} else if (numlevels[j1][i1] <= k2 || numlevels[j1][i2] <= k2 || numlevels[j2][i1] <= k2 || numlevels[j2][i2] <= k2) {
float** depth = grid_getdepth(grid);
int ni, nj;
double v;
grid_getdims(grid, &ni, &nj, NULL);
v = interpolate2d(fi, fj, ni, nj, depth, numlevels, grid_isperiodic_x(grid));
if (z > v)
return STATUS_LAND;
}
return STATUS_OK;
}
static void z2fk(void* p, double fi, double fj, double z, double* fk)
{
grid* g = (grid*) p;
gnz_simple* nodes = g->gridnodes_z;
/*
* for sigma coordinates convert `z' to sigma
*/
if (g->vtype == GRIDVTYPE_SIGMA) {
int ni = 0, nj = 0;
double depth;
if (g->htype == GRIDHTYPE_LATLON) {
gnxy_simple* nodes = (gnxy_simple*) g->gridnodes_xy;
ni = nodes->nx;
nj = nodes->ny;
#if !defined(NO_GRIDUTILS)
} else if (g->htype == GRIDHTYPE_CURVILINEAR) {
gnxy_curv* nodes = (gnxy_curv*) g->gridnodes_xy;
ni = gridnodes_getnx(nodes->gn);
nj = gridnodes_getny(nodes->gn);
#endif
} else
enkf_quit("programming error");
depth = (double) interpolate2d(fi, fj, ni, nj, g->depth, g->numlevels, grid_isperiodic_x(g));
z /= depth;
}
*fk = z2fk_basic(nodes->nz, nodes->zt, nodes->zc, z);
}
int model_xy2fij(model* m, int vid, double x, double y, double* fi, double* fj)
{
void* grid = m->grids[m->vars[vid].gridid];
int** numlevels = grid_getnumlevels(grid);
int lontype = grid_getlontype(grid);
int ni, nj;
int i1, i2, j1, j2;
if (lontype == LONTYPE_180) {
if (x > 180.0)
x -= 360.0;
} else if (lontype == LONTYPE_360) {
if (x < 0.0)
x += 360.0;
}
grid_xy2fij(grid, x, y, fi, fj);
if (isnan(*fi + *fj))
return STATUS_OUTSIDEGRID;
/*
* Note that this section should be consistent with similar sections in
* interpolate2d() and interpolate3d().
*/
i1 = floor(*fi);
i2 = ceil(*fi);
j1 = floor(*fj);
j2 = ceil(*fj);
model_getvardims(m, vid, &ni, &nj, NULL);
if (i1 == -1)
i1 = (grid_isperiodic_x(model_getvargrid(m, vid))) ? ni - 1 : i2;
if (i2 == ni)
i2 = (grid_isperiodic_x(model_getvargrid(m, vid))) ? 0 : i1;
if (j1 == -1)
j1 = (grid_isperiodic_y(model_getvargrid(m, vid))) ? nj - 1 : j2;
if (i2 == nj)
j2 = (grid_isperiodic_y(model_getvargrid(m, vid))) ? 0 : j1;
if (numlevels[j1][i1] == 0 && numlevels[j1][i2] == 0 && numlevels[j2][i1] == 0 && numlevels[j2][i2] == 0) {
*fi = NaN;
*fj = NaN;
return STATUS_LAND;
}
return STATUS_OK;
}
void grid_print(grid* g, char offset[])
{
int nx, ny, nz;
enkf_printf("%sgrid info:\n", offset);
switch (g->htype) {
case GRIDHTYPE_LATLON:
enkf_printf("%s hor type = LATLON\n", offset);
enkf_printf("%s periodic by X = %s\n", offset, grid_isperiodic_x(g) ? "yes" : "no");
break;
#if !defined(NO_GRIDUTILS)
case GRIDHTYPE_CURVILINEAR:
enkf_printf("%s hor type = CURVILINEAR\n", offset);
if (g->maptype == GRIDMAP_TYPE_BINARY)
enkf_printf("%s map type = BINARY TREE\n", offset);
else if (g->maptype == GRIDMAP_TYPE_KDTREE)
enkf_printf("%s map type = KD-TREE\n", offset);
else
enkf_quit("unknown grid map type");
break;
#endif
default:
enkf_printf("%s h type = NONE\n", offset);
}
grid_getdims(g, &nx, &ny, &nz);
enkf_printf("%s dims = %d x %d x %d\n", offset, nx, ny, nz);
if (!isnan(g->lonbase))
enkf_printf("%s longitude range = [%.3f, %.3f]\n", offset, g->lonbase, g->lonbase + 360.0);
else
enkf_printf("%s longitude range = any\n", offset);
switch (g->vtype) {
case GRIDVTYPE_Z:
enkf_printf("%s vert type = Z\n", offset);
break;
case GRIDVTYPE_SIGMA:
enkf_printf("%s vert type = SIGMA\n", offset);
break;
default:
enkf_printf("%s vert type = NONE\n", offset);
}
if (g->sfactor != 1.0)
enkf_printf("%s SFACTOR = \"%.f\"\n", offset, g->sfactor);
}
void grid_print(grid* g, char offset[])
{
int nx, ny, nz;
enkf_printf("%sgrid info:\n", offset);
switch (g->htype) {
case GRIDHTYPE_LATLON_REGULAR:
enkf_printf("%s hor type = LATLON_REGULAR\n", offset);
break;
case GRIDHTYPE_LATLON_IRREGULAR:
enkf_printf("%s hor type = LATLON_IRREGULAR\n", offset);
break;
#if !defined(NO_GRIDUTILS)
case GRIDHTYPE_CURVILINEAR:
enkf_printf("%s hor type = CURVILINEAR\n", offset);
break;
#endif
default:
enkf_printf("%s h type = NONE\n", offset);
}
enkf_printf("%s periodic by X = %s\n", offset, grid_isperiodic_x(g) ? "yes" : "no");
enkf_printf("%s periodic by Y = %s\n", offset, grid_isperiodic_y(g) ? "yes" : "no");
grid_getdims(g, &nx, &ny, &nz);
enkf_printf("%s dims = %d x %d x %d\n", offset, nx, ny, nz);
if (!isnan(g->lonbase))
enkf_printf("%s longitude range = [%.3f, %.3f]\n", offset, g->lonbase, g->lonbase + 360.0);
else
enkf_printf("%s longitude range = any\n", offset);
switch (g->vtype) {
case GRIDVTYPE_Z:
enkf_printf("%s vert type = Z\n", offset);
break;
case GRIDVTYPE_SIGMA:
enkf_printf("%s vert type = SIGMA\n", offset);
break;
default:
enkf_printf("%s vert type = NONE\n", offset);
}
}
/** Updates ensemble observations by applying X5
*/
static void update_HE(dasystem* das)
{
model* m = das->m;
int ngrid = model_getngrid(m);
int gid;
observations* obs = das->obs;
int e, o;
float* HEi_f;
float* HEi_a;
char do_T = 'T';
float alpha = 1.0f;
float beta = 0.0f;
int inc = 1;
enkf_printf(" updating HE:\n");
assert(das->s_mode == S_MODE_HE_f);
HEi_f = malloc(das->nmem * sizeof(ENSOBSTYPE));
HEi_a = malloc(das->nmem * sizeof(ENSOBSTYPE));
/*
* the following code for interpolation of X5 essentially coincides with
* that in das_updatefields()
*/
for (gid = 0, o = 0; gid < ngrid && o < obs->nobs; ++gid) {
void* grid = model_getgridbyid(m, gid);
int periodic_i = grid_isperiodic_x(grid);
int periodic_j = grid_isperiodic_y(grid);
char fname_X5[MAXSTRLEN];
int ncid;
int varid;
int dimids[3];
size_t dimlens[3];
size_t start[3], count[3];
float** X5j = NULL;
float** X5jj = NULL;
float** X5jj1 = NULL;
float** X5jj2 = NULL;
int mni, mnj;
int* iiter;
int* jiter;
int i, j, ni, nj;
int jj, stepj, ii, stepi;
assert(obs->obstypes[obs->data[o].type].gridid == gid);
das_getfname_X5(das, grid, fname_X5);
ncw_open(fname_X5, NC_NOWRITE, &ncid);
ncw_inq_varid(fname_X5, ncid, "X5", &varid);
ncw_inq_vardimid(fname_X5, ncid, varid, dimids);
for (i = 0; i < 3; ++i)
ncw_inq_dimlen(fname_X5, ncid, dimids[i], &dimlens[i]);
ni = dimlens[1];
nj = dimlens[0];
assert((int) dimlens[2] == das->nmem * das->nmem);
jiter = malloc((nj + 1) * sizeof(int)); /* "+ 1" to handle periodic
* grids */
iiter = malloc((ni + 1) * sizeof(int));
for (j = 0, i = 0; j < nj; ++j, i += das->stride)
jiter[j] = i;
if (periodic_j)
jiter[nj] = jiter[nj - 1] + das->stride;
for (i = 0, j = 0; i < ni; ++i, j += das->stride)
iiter[i] = j;
if (periodic_i)
iiter[ni] = iiter[ni - 1] + das->stride;
grid_getdims(grid, &mni, &mnj, NULL);
start[0] = 0;
start[1] = 0;
start[2] = 0;
count[0] = 1;
count[1] = ni;
count[2] = das->nmem * das->nmem;
X5j = alloc2d(mni, das->nmem * das->nmem, sizeof(float));
if (das->stride > 1) {
X5jj = alloc2d(ni, das->nmem * das->nmem, sizeof(float));
X5jj1 = alloc2d(ni, das->nmem * das->nmem, sizeof(float));
X5jj2 = alloc2d(ni, das->nmem * das->nmem, sizeof(float));
ncw_get_vara_float(fname_X5, ncid, varid, start, count, X5jj2[0]);
}
/*
* jj, ii are the indices of the subsampled grid; i, j are the indices
* of the model grid
*/
for (jj = 0, j = 0; jj < nj; ++jj) {
for (stepj = 0; stepj < das->stride && j < mnj; ++stepj, ++j) {
if (das->stride == 1) {
/*
* no interpolation necessary; simply read the ETMs for the
* j-th row from disk
*/
start[0] = j;
ncw_get_vara_float(fname_X5, ncid, varid, start, count, X5j[0]);
} else {
/*
* the following code interpolates the ETM back to the
* original grid, first by j, and then by i
*/
if (stepj == 0) {
memcpy(X5jj[0], X5jj2[0], ni * das->nmem * das->nmem * sizeof(float));
memcpy(X5jj1[0], X5jj2[0], ni * das->nmem * das->nmem * sizeof(float));
if (jj < nj - 1 || periodic_j) {
start[0] = (jj + 1) % nj;
ncw_get_vara_float(fname_X5, ncid, varid, start, count, X5jj2[0]);
}
} else {
float weight2 = (float) stepj / das->stride;
float weight1 = (float) 1.0 - weight2;
for (ii = 0; ii < ni; ++ii) {
float* X5jjii = X5jj[ii];
float* X5jj1ii = X5jj1[ii];
float* X5jj2ii = X5jj2[ii];
for (e = 0; e < das->nmem * das->nmem; ++e)
X5jjii[e] = X5jj1ii[e] * weight1 + X5jj2ii[e] * weight2;
}
}
for (ii = 0, i = 0; ii < ni; ++ii) {
for (stepi = 0; stepi < das->stride && i < mni; ++stepi, ++i) {
if (stepi == 0)
memcpy(X5j[i], X5jj[ii], das->nmem * das->nmem * sizeof(float));
else {
float weight2 = (float) stepi / das->stride;
float weight1 = (float) 1.0 - weight2;
float* X5jjii1 = X5jj[ii];
float* X5ji = X5j[i];
float* X5jjii2;
if (ii < ni - 1)
X5jjii2 = X5jj[ii + 1];
else
X5jjii2 = X5jj[(periodic_i) ? (ii + 1) % ni : ii];
for (e = 0; e < das->nmem * das->nmem; ++e)
X5ji[e] = X5jjii1[e] * weight1 + X5jjii2[e] * weight2;
}
}
}
} /* stride != 1 */
/*
* (at this stage X5j should contain the array of X5 matrices
* for the j-th row of the grid)
*/
if (o >= obs->nobs)
break;
if ((int) (obs->data[o].fj) > j)
continue;
for (; o < obs->nobs && (int) (obs->data[o].fj) == j; ++o) {
float inflation = model_getvarinflation(m, obs->obstypes[obs->data[o].type].vid);
/*
* HE(i, :) = HE(i, :) * X5
*/
i = (int) (obs->data[o].fi);
for (e = 0; e < das->nmem; ++e)
HEi_f[e] = das->S[e][o];
sgemv_(&do_T, &das->nmem, &das->nmem, &alpha, X5j[i], &das->nmem, HEi_f, &inc, &beta, HEi_a, &inc);
/*
* applying inflation:
*/
if (fabsf(inflation - 1.0f) > EPSF) {
float v_av = 0.0f;
for (e = 0; e < das->nmem; ++e)
v_av += HEi_a[e];
v_av /= (float) das->nmem;
for (e = 0; e < das->nmem; ++e)
HEi_a[e] = (HEi_a[e] - v_av) * inflation + v_av;
}
for (e = 0; e < das->nmem; ++e)
das->S[e][o] = HEi_a[e];
}
} /* for stepj */
} /* for jj */
ncw_close(fname_X5, ncid);
free(iiter);
free(jiter);
free2d(X5j);
if (das->stride > 1) {
free2d(X5jj);
free2d(X5jj1);
free2d(X5jj2);
}
} /* for gid */
free(HEi_a);
free(HEi_f);
das->s_mode = S_MODE_HE_a;
} /* update_HE() */
static void update_Hx(dasystem* das)
{
model* m = das->m;
int ngrid = model_getngrid(m);
int gid;
observations* obs = das->obs;
int e, o;
enkf_printf(" updating Hx:\n");
assert(das->s_mode == S_MODE_HE_f);
/*
* the following code for interpolation of X5 essentially coincides with
* that in das_updatefields()
*/
for (gid = 0, o = 0; gid < ngrid && o < obs->nobs; ++gid) {
void* grid = model_getgridbyid(m, gid);
int periodic_i = grid_isperiodic_x(grid);
int periodic_j = grid_isperiodic_y(grid);
char fname_w[MAXSTRLEN];
int ncid;
int varid;
int dimids[3];
size_t dimlens[3];
size_t start[3], count[3];
float** wj = NULL;
float** wjj = NULL;
float** wjj1 = NULL;
float** wjj2 = NULL;
int mni, mnj;
int* iiter;
int* jiter;
int i, j, ni, nj;
int jj, stepj, ii, stepi;
assert(obs->obstypes[obs->data[o].type].gridid == gid);
das_getfname_w(das, grid, fname_w);
ncw_open(fname_w, NC_NOWRITE, &ncid);
ncw_inq_varid(fname_w, ncid, "w", &varid);
ncw_inq_vardimid(fname_w, ncid, varid, dimids);
for (i = 0; i < 3; ++i)
ncw_inq_dimlen(fname_w, ncid, dimids[i], &dimlens[i]);
ni = dimlens[1];
nj = dimlens[0];
assert((int) dimlens[2] == das->nmem);
jiter = malloc((nj + 1) * sizeof(int)); /* "+ 1" to handle periodic
* grids */
iiter = malloc((ni + 1) * sizeof(int));
for (j = 0, i = 0; j < nj; ++j, i += das->stride)
jiter[j] = i;
if (periodic_j)
jiter[nj] = jiter[nj - 1] + das->stride;
for (i = 0, j = 0; i < ni; ++i, j += das->stride)
iiter[i] = j;
if (periodic_i)
iiter[ni] = iiter[ni - 1] + das->stride;
grid_getdims(grid, &mni, &mnj, NULL);
start[0] = 0;
start[1] = 0;
start[2] = 0;
count[0] = 1;
count[1] = ni;
count[2] = das->nmem;
wj = alloc2d(mni, das->nmem, sizeof(float));
if (das->stride > 1) {
wjj = alloc2d(ni, das->nmem, sizeof(float));
wjj1 = alloc2d(ni, das->nmem, sizeof(float));
wjj2 = alloc2d(ni, das->nmem, sizeof(float));
ncw_get_vara_float(fname_w, ncid, varid, start, count, wjj2[0]);
}
/*
* jj, ii are the indices of the subsampled grid; i, j are the indices
* of the model grid
*/
for (jj = 0, j = 0; jj < nj; ++jj) {
for (stepj = 0; stepj < das->stride && j < mnj; ++stepj, ++j) {
if (das->stride == 1) {
/*
* no interpolation necessary; simply read the ETMs for the
* j-th row from disk
*/
start[0] = j;
ncw_get_vara_float(fname_w, ncid, varid, start, count, wj[0]);
} else {
/*
* the following code interpolates the ETM back to the
* original grid, first by j, and then by i
*/
if (stepj == 0) {
memcpy(wjj[0], wjj2[0], ni * das->nmem * sizeof(float));
memcpy(wjj1[0], wjj2[0], ni * das->nmem * sizeof(float));
if (jj < nj - 1 || periodic_j) {
start[0] = (jj + 1) % nj;
ncw_get_vara_float(fname_w, ncid, varid, start, count, wjj2[0]);
}
} else {
float weight2 = (float) stepj / das->stride;
float weight1 = (float) 1.0 - weight2;
for (ii = 0; ii < ni; ++ii) {
float* wjjii = wjj[ii];
float* wjj1ii = wjj1[ii];
float* wjj2ii = wjj2[ii];
for (e = 0; e < das->nmem; ++e)
wjjii[e] = wjj1ii[e] * weight1 + wjj2ii[e] * weight2;
}
}
for (ii = 0, i = 0; ii < ni; ++ii) {
for (stepi = 0; stepi < das->stride && i < mni; ++stepi, ++i) {
if (stepi == 0)
memcpy(wj[i], wjj[ii], das->nmem * sizeof(float));
else {
float weight2 = (float) stepi / das->stride;
float weight1 = (float) 1.0 - weight2;
float* wjjii1 = wjj[ii];
float* wji = wj[i];
float* wjjii2;
if (ii < ni - 1)
wjjii2 = wjj[ii + 1];
else
wjjii2 = wjj[(periodic_i) ? (ii + 1) % ni : ii];
for (e = 0; e < das->nmem; ++e)
wji[e] = wjjii1[e] * weight1 + wjjii2[e] * weight2;
}
}
}
} /* stride != 1 */
/*
* (at this stage wj should contain the array of b vectors for
* the j-th row of the grid)
*/
if (o >= obs->nobs)
break;
if ((int) (obs->data[o].fj) > j)
continue;
for (; o < obs->nobs && (int) (obs->data[o].fj) == j; ++o) {
double dHx = 0.0;
double Hx = 0.0;
for (e = 0; e < das->nmem; ++e)
Hx += das->S[e][o];
Hx /= (double) das->nmem;
i = (int) (obs->data[o].fi);
/*
* HE(i, :) += HA(i, :) * b * 1'
*/
for (e = 0; e < das->nmem; ++e)
dHx += (das->S[e][o] - Hx) * wj[i][e];
for (e = 0; e < das->nmem; ++e)
das->S[e][o] += dHx;
}
} /* for stepj */
} /* for jj */
ncw_close(fname_w, ncid);
free(iiter);
free(jiter);
free2d(wj);
if (das->stride > 1) {
free2d(wjj);
free2d(wjj1);
free2d(wjj2);
}
} /* for gid */
das->s_mode = S_MODE_HE_a;
} /* update_Hx() */