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); }