Exemplo n.º 1
0
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);
}
Exemplo n.º 2
0
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);
}