void das_getHE(dasystem* das)
{
observations* obs = das->obs;
model* m = das->m;
ENSOBSTYPE* Hx = NULL;
int i, e;
das->s_mode = S_MODE_HE_f;
if (obs->nobs == 0)
return;
if (das->nmem <= 0)
das_getnmem(das);
enkf_printf(" ensemble size = %d\n", das->nmem);
assert(das->nmem > 0);
distribute_iterations(0, das->nmem - 1, nprocesses, rank, " ");
/*
* ensemble observation array to be filled
*/
assert(das->S == NULL);
das->S = alloc2d(das->nmem, obs->nobs, sizeof(ENSOBSTYPE));
if (das->mode == MODE_ENOI)
Hx = calloc(obs->nobs, sizeof(ENSOBSTYPE));
for (i = 0; i < obs->nobstypes; ++i) {
obstype* ot = &obs->obstypes[i];
float*** vvv = NULL;
float** vv = NULL;
H_fn H = NULL;
int mvid;
int ni, nj, nk;
int nobs;
int* obsids;
char fname[MAXSTRLEN];
enkf_printf(" %s ", ot->name);
fflush(stdout);
mvid = model_getvarid(m, obs->obstypes[i].varname);
if (mvid < 0)
enkf_quit("variable \"%s\" required for observation type \"%s\" is not defined", obs->obstypes[i].varname, ot->name);
if (ot->issurface) {
model_getvardims(m, mvid, &ni, &nj, NULL);
vv = alloc2d(nj, ni, sizeof(float));
} else {
model_getvardims(m, mvid, &ni, &nj, &nk);
vvv = alloc3d(nk, nj, ni, sizeof(float));
}
/*
* set H
*/
H = getH(ot->name, ot->hfunction);
if (ot->isasync) {
int t1 = get_tshift(ot->date_min, ot->async_tstep);
int t2 = get_tshift(ot->date_max, ot->async_tstep);
int t;
for (t = t1; t <= t2; ++t) {
enkf_printf("|");
obs_find_bytypeandtime(obs, i, t, &nobs, &obsids);
if (nobs == 0)
continue;
if (das->mode == MODE_ENKF || !enkf_fstatsonly) {
for (e = my_first_iteration; e <= my_last_iteration; ++e) {
int success = model_getmemberfname_async(m, das->ensdir, ot->varname, ot->name, e + 1, t, fname);
H(das, nobs, obsids, fname, e + 1, t, ot->varname, ot->varname2, (ot->issurface) ? (void*) vv : (void*) vvv, das->S[e]);
enkf_printf((success) ? "a" : "s");
fflush(stdout);
}
}
if (das->mode == MODE_ENOI) {
if (enkf_obstype == OBSTYPE_VALUE) {
int success = model_getbgfname_async(m, das->bgdir, ot->varname, ot->name, t, fname);
H(das, nobs, obsids, fname, -1, t, ot->varname, ot->varname2, (ot->issurface) ? (void*) vv : (void*) vvv, Hx);
enkf_printf((success) ? "A" : "S");
fflush(stdout);
} else if (enkf_obstype == OBSTYPE_INNOVATION) {
Hx[0] = 0;
enkf_printf("-");
fflush(stdout);
}
}
free(obsids);
}
} else {
obs_find_bytype(obs, i, &nobs, &obsids);
if (nobs == 0)
goto next;
if (das->mode == MODE_ENKF || !enkf_fstatsonly) {
for (e = my_first_iteration; e <= my_last_iteration; ++e) {
model_getmemberfname(m, das->ensdir, ot->varname, e + 1, fname);
H(das, nobs, obsids, fname, e + 1, MAXINT, ot->varname, ot->varname2, (ot->issurface) ? (void*) vv : (void*) vvv, das->S[e]);
enkf_printf(".");
fflush(stdout);
}
}
if (das->mode == MODE_ENOI) {
if (enkf_obstype == OBSTYPE_VALUE) {
model_getbgfname(m, das->bgdir, ot->varname, fname);
H(das, nobs, obsids, fname, -1, MAXINT, ot->varname, ot->varname2, (ot->issurface) ? (void*) vv : (void*) vvv, Hx);
enkf_printf("+");
fflush(stdout);
} else if (enkf_obstype == OBSTYPE_INNOVATION) {
Hx[0] = 0;
enkf_printf("-");
fflush(stdout);
}
}
free(obsids);
}
next:
if (ot->issurface)
free2d(vv);
else
free3d(vvv);
enkf_printf("\n");
} /* for i (over obstypes) */
#if defined(MPI)
if (das->mode == MODE_ENKF || !enkf_fstatsonly) {
#if !defined(HE_VIAFILE)
/*
* communicate HE via MPI
*/
int ierror, count;
/*
* Blocking communications can create a bottleneck in instances with
* large number of observations (e.g., 2e6 obs., 144 members, 48
* processes), but asynchronous send/receive seem to work well
*/
if (rank > 0) {
MPI_Request request;
/*
* send ensemble observations to master
*/
count = (my_last_iteration - my_first_iteration + 1) * obs->nobs;
ierror = MPI_Isend(das->S[my_first_iteration], count, MPIENSOBSTYPE, 0, rank, MPI_COMM_WORLD, &request);
assert(ierror == MPI_SUCCESS);
} else {
int r;
MPI_Request* requests = malloc((nprocesses - 1) * sizeof(MPI_Request));
/*
* collect ensemble observations from slaves
*/
for (r = 1; r < nprocesses; ++r) {
count = (last_iteration[r] - first_iteration[r] + 1) * obs->nobs;
ierror = MPI_Irecv(das->S[first_iteration[r]], count, MPIENSOBSTYPE, r, r, MPI_COMM_WORLD, &requests[r - 1]);
assert(ierror == MPI_SUCCESS);
}
ierror = MPI_Waitall(nprocesses - 1, requests, MPI_STATUS_IGNORE);
assert(ierror == MPI_SUCCESS);
free(requests);
}
/*
* now send the full set of ensemble observations to slaves
*/
count = das->nmem * obs->nobs;
ierror = MPI_Bcast(das->S[0], count, MPIENSOBSTYPE, 0, MPI_COMM_WORLD);
assert(ierror == MPI_SUCCESS);
#else
/*
* communicate HE via file
*/
{
int ncid;
int varid;
size_t start[2], count[2];
if (rank == 0) {
int dimids[2];
ncw_create(FNAME_HE, NC_CLOBBER | NC_64BIT_OFFSET, &ncid);
ncw_def_dim(FNAME_HE, ncid, "m", das->nmem, &dimids[0]);
ncw_def_dim(FNAME_HE, ncid, "p", obs->nobs, &dimids[1]);
ncw_def_var(FNAME_HE, ncid, "HE", NC_FLOAT, 2, dimids, &varid);
ncw_close(FNAME_HE, ncid);
}
MPI_Barrier(MPI_COMM_WORLD);
ncw_open(FNAME_HE, NC_WRITE, &ncid);
ncw_inq_varid(FNAME_HE, ncid, "HE", &varid);
start[0] = my_first_iteration;
start[1] = 0;
count[0] = my_last_iteration - my_first_iteration + 1;
count[1] = obs->nobs;
ncw_put_vara_float(FNAME_HE, ncid, varid, start, count, das->S[my_first_iteration]);
ncw_close(FNAME_HE, ncid);
MPI_Barrier(MPI_COMM_WORLD);
ncw_open(FNAME_HE, NC_NOWRITE, &ncid);
ncw_inq_varid(FNAME_HE, ncid, "HE", &varid);
ncw_get_var_float(FNAME_HE, ncid, varid, das->S[0]);
ncw_close(FNAME_HE, ncid);
}
#endif
}
#endif
if (das->mode == MODE_ENOI) {
/*
* subtract ensemble mean; add background
*/
if (!enkf_fstatsonly) {
double* ensmean = calloc(obs->nobs, sizeof(double));
for (e = 0; e < das->nmem; ++e) {
ENSOBSTYPE* Se = das->S[e];
for (i = 0; i < obs->nobs; ++i)
ensmean[i] += Se[i];
}
for (i = 0; i < obs->nobs; ++i)
ensmean[i] /= (double) das->nmem;
for (e = 0; e < das->nmem; ++e) {
ENSOBSTYPE* Se = das->S[e];
for (i = 0; i < obs->nobs; ++i)
Se[i] += Hx[i] - ensmean[i];
}
free(ensmean);
} else {
for (e = 0; e < das->nmem; ++e) {
ENSOBSTYPE* Se = das->S[e];
for (i = 0; i < obs->nobs; ++i)
Se[i] = Hx[i];
}
}
}
if (das->mode == MODE_ENOI)
free(Hx);
}
void das_getHE(dasystem* das)
{
observations* obs = das->obs;
model* m = das->m;
ENSOBSTYPE* Hx = NULL;
int i, e;
das->s_mode = S_MODE_HE_f;
if (obs->nobs == 0)
return;
if (das->nmem <= 0)
das_setnmem(das);
enkf_printf(" ensemble size = %d\n", das->nmem);
assert(das->nmem > 0);
distribute_iterations(0, das->nmem - 1, nprocesses, rank, " ");
/*
* ensemble observation array to be filled
*/
assert(das->S == NULL);
das->S = alloc2d(das->nmem, obs->nobs, sizeof(ENSOBSTYPE));
if (das->mode == MODE_ENOI)
Hx = calloc(obs->nobs, sizeof(ENSOBSTYPE));
for (i = 0; i < obs->nobstypes; ++i) {
obstype* ot = &obs->obstypes[i];
float*** vvv = NULL;
float** vv = NULL;
H_fn H = NULL;
int mvid;
int ni, nj, nk;
int nobs;
int* obsids;
char fname[MAXSTRLEN];
enkf_printf(" %s ", ot->name);
fflush(stdout);
mvid = model_getvarid(m, obs->obstypes[i].varnames[0], 1);
if (ot->issurface) {
model_getvardims(m, mvid, &ni, &nj, NULL);
vv = alloc2d(nj, ni, sizeof(float));
} else {
model_getvardims(m, mvid, &ni, &nj, &nk);
vvv = alloc3d(nk, nj, ni, sizeof(float));
}
/*
* set H
*/
H = getH(ot->name, ot->hfunction);
if (ot->isasync) {
int t1 = get_tshift(ot->date_min, ot->async_tstep);
int t2 = get_tshift(ot->date_max, ot->async_tstep);
int t;
for (t = t1; t <= t2; ++t) {
enkf_printf("|");
obs_find_bytypeandtime(obs, i, t, &nobs, &obsids);
if (nobs == 0)
continue;
/*
* for EnOI it is essential sometimes (e.g. in some bias
* correction cases) that the background is interpolated first
*/
if (das->mode == MODE_ENOI) {
if (enkf_obstype == OBSTYPE_VALUE) {
int success = model_getbgfname_async(m, das->bgdir, ot->varnames[0], ot->name, t, fname);
H(das, nobs, obsids, fname, -1, t, (ot->issurface) ? (void*) vv : (void*) vvv, Hx);
enkf_printf((success) ? "A" : "S");
fflush(stdout);
} else if (enkf_obstype == OBSTYPE_INNOVATION) {
Hx[0] = 0;
enkf_printf("-");
fflush(stdout);
}
}
if (das->mode == MODE_ENKF || !enkf_fstatsonly) {
for (e = my_first_iteration; e <= my_last_iteration; ++e) {
int success = model_getmemberfname_async(m, das->ensdir, ot->varnames[0], ot->name, e + 1, t, fname);
H(das, nobs, obsids, fname, e + 1, t, (ot->issurface) ? (void*) vv : (void*) vvv, das->S[e]);
enkf_printf((success) ? "a" : "s");
fflush(stdout);
}
}
free(obsids);
}
} else {
obs_find_bytype(obs, i, &nobs, &obsids);
if (nobs == 0)
goto next;
/*
* for EnOI it is essential sometimes (e.g. in some bias correction
* cases) that the background is interpolated first
*/
if (das->mode == MODE_ENOI) {
if (enkf_obstype == OBSTYPE_VALUE) {
model_getbgfname(m, das->bgdir, ot->varnames[0], fname);
H(das, nobs, obsids, fname, -1, INT_MAX, (ot->issurface) ? (void*) vv : (void*) vvv, Hx);
enkf_printf("+");
fflush(stdout);
} else if (enkf_obstype == OBSTYPE_INNOVATION) {
Hx[0] = 0;
enkf_printf("-");
fflush(stdout);
}
}
if (das->mode == MODE_ENKF || !enkf_fstatsonly) {
for (e = my_first_iteration; e <= my_last_iteration; ++e) {
model_getmemberfname(m, das->ensdir, ot->varnames[0], e + 1, fname);
H(das, nobs, obsids, fname, e + 1, INT_MAX, (ot->issurface) ? (void*) vv : (void*) vvv, das->S[e]);
enkf_printf(".");
fflush(stdout);
}
}
free(obsids);
}
next:
if (ot->issurface)
free(vv);
else
free(vvv);
enkf_printf("\n");
} /* for i (over obstypes) */
#if defined(MPI)
if (das->mode == MODE_ENKF || !enkf_fstatsonly) {
#if !defined(HE_VIAFILE)
/*
* communicate HE via MPI
*/
int ierror, sendcount, *recvcounts, *displs;
recvcounts = malloc(nprocesses * sizeof(int));
displs = malloc(nprocesses * sizeof(int));
sendcount = my_number_of_iterations * obs->nobs;
for (i = 0; i < nprocesses; ++i) {
recvcounts[i] = number_of_iterations[i] * obs->nobs;
displs[i] = first_iteration[i] * obs->nobs;
}
ierror = MPI_Allgatherv(das->S[my_first_iteration], sendcount, MPIENSOBSTYPE, das->S[0], recvcounts, displs, MPIENSOBSTYPE, MPI_COMM_WORLD);
assert(ierror == MPI_SUCCESS);
free(recvcounts);
free(displs);
#else
/*
* communicate HE via file
*/
{
int ncid;
int varid;
size_t start[2], count[2];
if (rank == 0) {
int dimids[2];
ncw_create(FNAME_HE, NC_CLOBBER | NETCDF_FORMAT, &ncid);
ncw_def_dim(FNAME_HE, ncid, "m", das->nmem, &dimids[0]);
ncw_def_dim(FNAME_HE, ncid, "p", obs->nobs, &dimids[1]);
ncw_def_var(FNAME_HE, ncid, "HE", NC_FLOAT, 2, dimids, &varid);
ncw_close(FNAME_HE, ncid);
}
MPI_Barrier(MPI_COMM_WORLD);
ncw_open(FNAME_HE, NC_WRITE, &ncid);
ncw_inq_varid(FNAME_HE, ncid, "HE", &varid);
start[0] = my_first_iteration;
start[1] = 0;
count[0] = my_last_iteration - my_first_iteration + 1;
count[1] = obs->nobs;
ncw_put_vara_float(FNAME_HE, ncid, varid, start, count, das->S[my_first_iteration]);
ncw_close(FNAME_HE, ncid);
MPI_Barrier(MPI_COMM_WORLD);
ncw_open(FNAME_HE, NC_NOWRITE, &ncid);
ncw_inq_varid(FNAME_HE, ncid, "HE", &varid);
ncw_get_var_float(FNAME_HE, ncid, varid, das->S[0]);
ncw_close(FNAME_HE, ncid);
}
#endif
}
#endif
if (das->mode == MODE_ENOI) {
/*
* subtract ensemble mean; add background
*/
if (!enkf_fstatsonly) {
double* ensmean = calloc(obs->nobs, sizeof(double));
for (e = 0; e < das->nmem; ++e) {
ENSOBSTYPE* Se = das->S[e];
for (i = 0; i < obs->nobs; ++i)
ensmean[i] += Se[i];
}
for (i = 0; i < obs->nobs; ++i)
ensmean[i] /= (double) das->nmem;
for (e = 0; e < das->nmem; ++e) {
ENSOBSTYPE* Se = das->S[e];
for (i = 0; i < obs->nobs; ++i)
Se[i] += Hx[i] - ensmean[i];
}
free(ensmean);
} else {
for (e = 0; e < das->nmem; ++e) {
ENSOBSTYPE* Se = das->S[e];
for (i = 0; i < obs->nobs; ++i)
Se[i] = Hx[i];
}
}
}
if (das->mode == MODE_ENOI)
free(Hx);
}