void model_addorreplacedata(model* m, char tag[], int vid, int alloctype, void* data) { modeldata* mdata; int i; int ni, nj, nk; for (i = 0; i < m->ndata; ++i) if (strcmp(tag, m->data[i].tag) == 0) break; mdata = &m->data[i]; if (i == m->ndata) { if (m->ndata % NMODELDATA_INC == 0) m->data = realloc(m->data, (m->ndata + NMODELDATA_INC) * sizeof(modeldata)); mdata->tag = strdup(tag); mdata->vid = vid; mdata->alloctype = alloctype; m->ndata++; } else assert(mdata->alloctype == alloctype); model_getvardims(m, mdata->vid, &ni, &nj, &nk); if (mdata->alloctype == ALLOCTYPE_1D) memcpy(mdata->data, data, nk * sizeof(float)); else if (mdata->alloctype == ALLOCTYPE_2D) mdata->data = copy2d(data, nj, ni, sizeof(float)); else if (mdata->alloctype == ALLOCTYPE_3D) mdata->data = copy3d(data, nk, nj, ni, sizeof(float)); else enkf_quit("programming error"); }
void model_read3dfield(model* m, char fname[], char varname[], float* v) { int ni, nj, nk; int mvid = model_getvarid(m, varname, 1); model_getvardims(m, mvid, &ni, &nj, &nk); read3dfield(fname, varname, ni, nj, nk, v); }
void model_writefieldas(model* m, char fname[], char varname[], char varnameas[], int k, float* v) { int ni, nj, nk; int mvid = model_getvarid(m, varnameas, 1); model_getvardims(m, mvid, &ni, &nj, &nk); assert(k < nk); writefield(fname, varname, k, ni, nj, nk, v); }
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; }
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 model_randomisefield(model* m, int varid, float** v) { float deflation = (float) m->vars[varid].deflation; float sigma = (float) m->vars[varid].sigma; float s; int ni, nj; int i, j; double tmp[2]; get_normalpair(tmp); s = (float) (sqrt(1.0 - deflation * deflation) * tmp[0]) * sigma; model_getvardims(m, varid, &ni, &nj, NULL); for (j = 0; j < nj; ++j) for (i = 0; i < ni; ++i) v[j][i] = deflation * v[j][i] + s; }
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); }