Skip to content

Commit

Permalink
fix: sync filter_mod.dopplerfold with filter_mod
Browse files Browse the repository at this point in the history
fixes: #565
  • Loading branch information
hkershaw-brown committed Oct 26, 2023
1 parent 6c6ac53 commit c78fa71
Showing 1 changed file with 52 additions and 2 deletions.
54 changes: 52 additions & 2 deletions assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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()

Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit c78fa71

Please sign in to comment.