From c78fa7152e0756f484207a911b3e3e7e26b3c9ff Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 26 Oct 2023 09:37:02 -0400 Subject: [PATCH] fix: sync filter_mod.dopplerfold with filter_mod fixes: #565 --- .../assimilation/filter_mod.dopplerfold.f90 | 54 ++++++++++++++++++- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90 b/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90 index 8ac1147de6..9041bfc221 100644 --- a/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90 +++ b/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90 @@ -385,7 +385,6 @@ subroutine filter_main() write(msgstring, '(A,I5)') 'running with an ensemble size of ', ens_size call error_handler(E_MSG,'filter_main:', msgstring, source) - call set_missing_ok_status(allow_missing_clm) allow_missing = get_missing_ok_status() @@ -982,6 +981,7 @@ subroutine filter_main() call timestamp_message('After computing posterior observation values') call trace_message('After computing posterior observation values') + call trace_message('Before posterior obs space diagnostics') ! Write posterior observation space diagnostics @@ -995,6 +995,10 @@ subroutine filter_main() call trace_message('After posterior obs space diagnostics') else + ! call this alternate routine to collect any updated QC values that may + ! have been set in the assimilation loop and copy them to the outgoing obs seq + call obs_space_sync_QCs(obs_fwd_op_ens_handle, seq, keys, num_obs_in_set, & + OBS_GLOBAL_QC_COPY, DART_qc_index) call deallocate_single_copy(obs_fwd_op_ens_handle, prior_qc_copy) endif @@ -1593,7 +1597,7 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size, OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, OBS_VAL_COPY, & OBS_ERR_VAR_COPY, DART_qc_index, do_post) -! Do prior observation space diagnostics on the set of obs corresponding to keys +! Do observation space diagnostics on the set of obs corresponding to keys type(ensemble_type), intent(inout) :: obs_fwd_op_ens_handle, qc_ens_handle integer, intent(in) :: ens_size @@ -1701,6 +1705,52 @@ end subroutine obs_space_diagnostics !------------------------------------------------------------------------- +subroutine obs_space_sync_QCs(obs_fwd_op_ens_handle, & + seq, keys, num_obs_in_set, OBS_GLOBAL_QC_COPY, DART_qc_index) + + +type(ensemble_type), intent(inout) :: obs_fwd_op_ens_handle +integer, intent(in) :: num_obs_in_set +integer, intent(in) :: keys(num_obs_in_set) +type(obs_sequence_type), intent(inout) :: seq +integer, intent(in) :: OBS_GLOBAL_QC_COPY +integer, intent(in) :: DART_qc_index + +integer :: j +integer :: io_task, my_task +real(r8), allocatable :: obs_temp(:) +real(r8) :: rvalue(1) + +! this is a query routine to return which task has +! logical processing element 0 in this ensemble. +io_task = map_pe_to_task(obs_fwd_op_ens_handle, 0) +my_task = my_task_id() + +! create temp space for QC values +if (my_task == io_task) then + allocate(obs_temp(num_obs_in_set)) +else + allocate(obs_temp(1)) +endif + +! Optimize: Could we use a gather instead of a transpose and get copy? +call all_copies_to_all_vars(obs_fwd_op_ens_handle) + +! Update the qc global value +call get_copy(io_task, obs_fwd_op_ens_handle, OBS_GLOBAL_QC_COPY, obs_temp) +if(my_task == io_task) then + do j = 1, obs_fwd_op_ens_handle%num_vars + rvalue(1) = obs_temp(j) + call replace_qc(seq, keys(j), rvalue, DART_qc_index) + end do +endif + +deallocate(obs_temp) + +end subroutine obs_space_sync_QCs + +!------------------------------------------------------------------------- + subroutine filter_sync_keys_time(ens_handle, key_bounds, num_obs_in_set, time1, time2) integer, intent(inout) :: key_bounds(2), num_obs_in_set