From 6b24190c68e554d216e877528eb78c2ff72bce71 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 15 Jan 2021 12:38:36 -0500 Subject: [PATCH 1/5] update analysis time after call to oda , consistent with SPEAR configurations --- src/core/MOM.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f11ce42407..7d4d9b73cb 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -880,12 +880,12 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo ; endif if (CS%ensemble_ocean) then - ! update the time for the next analysis step if needed - call set_analysis_time(CS%Time,CS%odaCS) ! store ensemble vector in odaCS call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) ! call DA interface call oda(CS%Time,CS%odaCS) + ! update the time for the next analysis step if needed + call set_analysis_time(CS%Time,CS%odaCS) endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") From b6ce7c74257db76a47c93ddd72b0f7db8b0cfb9b Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 15 Jan 2021 12:41:06 -0500 Subject: [PATCH 2/5] pass through interfaces for mpp_broadcast_domain and mpp_set_root_pe --- src/framework/MOM_coms.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 0c6b948980..c6f3fe6dd5 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -10,17 +10,19 @@ module MOM_coms use mpp_mod, only : PE_here => mpp_pe, root_PE => mpp_root_pe, num_PEs => mpp_npes use mpp_mod, only : Set_PElist => mpp_set_current_pelist, Get_PElist => mpp_get_current_pelist use mpp_mod, only : broadcast => mpp_broadcast +use mpp_domains_mod, only : broadcast_domain => mpp_broadcast_domain +use mpp_mod, only : set_rootPE => mpp_set_root_pe use mpp_mod, only : sum_across_PEs => mpp_sum, max_across_PEs => mpp_max, min_across_PEs => mpp_min implicit none ; private public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end -public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs +public :: broadcast, broadcast_domain, sum_across_PEs, min_across_PEs, max_across_PEs public :: reproducing_sum, reproducing_sum_EFP, EFP_sum_across_PEs, EFP_list_sum_across_PEs public :: EFP_plus, EFP_minus, EFP_to_real, real_to_EFP, EFP_real_diff public :: operator(+), operator(-), assignment(=) public :: query_EFP_overflow_error, reset_EFP_overflow_error -public :: Set_PElist, Get_PElist +public :: Set_PElist, Get_PElist, Set_rootPE ! This module provides interfaces to the non-domain-oriented communication subroutines. From bfdbe211519cfb5874c5a93febbfa5cbf7022809 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 15 Jan 2021 12:42:58 -0500 Subject: [PATCH 3/5] New interfaces for array redistribution across domains. --- src/framework/MOM_domains.F90 | 47 ++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 46cc9c526a..1567546885 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -30,6 +30,8 @@ module MOM_domains use mpp_domains_mod, only : To_East => WUPDATE, To_West => EUPDATE, Omit_Corners => EDGEUPDATE use mpp_domains_mod, only : To_North => SUPDATE, To_South => NUPDATE use mpp_domains_mod, only : CENTER, CORNER, NORTH_FACE => NORTH, EAST_FACE => EAST +use mpp_domains_mod, only : global_field => mpp_global_field +use mpp_domains_mod, only : mpp_redistribute use fms_io_mod, only : file_exist, parse_mask_table use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set, fms_affinity_get @@ -48,7 +50,7 @@ module MOM_domains public :: start_group_pass, complete_group_pass public :: compute_block_extent, get_global_shape public :: get_simple_array_i_ind, get_simple_array_j_ind -public :: domain2D +public :: domain2D, global_field, redistribute_array !> Do a halo update on an array interface pass_var @@ -100,6 +102,11 @@ module MOM_domains module procedure clone_MD_to_MD, clone_MD_to_d2D end interface clone_MOM_domain +!> Pass an array from one MOM domain to another +interface redistribute_array + module procedure redistribute_array_3d, redistribute_array_2d +end interface redistribute_array + !> The MOM_domain_type contains information about the domain decompositoin. type, public :: MOM_domain_type type(domain2D), pointer :: mpp_domain => NULL() !< The FMS domain with halos @@ -1979,4 +1986,42 @@ subroutine get_global_shape(domain, niglobal, njglobal) end subroutine get_global_shape +!> Returns various data that has been stored in a MOM_domain_type +subroutine redistribute_array_2d(Domain1, array1, Domain2, array2, complete) + type(domain2d), & + intent(in) :: Domain1 !< The MOM domain from which to extract information. + real, dimension(:,:), intent(in) :: array1 !< The array from which to extract information. + type(domain2d), & + intent(in) :: Domain2 !< The MOM domain receiving information. + real, dimension(:,:), intent(out) :: array2 !< The array receiving information. + logical, optional, intent(in) :: complete !< If true, finish communication before proceeding. + + ! Local variables + logical :: do_complete + + do_complete=.true.;if (PRESENT(complete)) do_complete = complete + + call mpp_redistribute(Domain1, array1, Domain2, array2, do_complete) + +end subroutine redistribute_array_2d + +!> Returns various data that has been stored in a MOM_domain_type +subroutine redistribute_array_3d(Domain1, array1, Domain2, array2, complete) + type(domain2d), & + intent(in) :: Domain1 !< The MOM domain from which to extract information. + real, dimension(:,:,:), intent(in) :: array1 !< The array from which to extract information. + type(domain2d), & + intent(in) :: Domain2 !< The MOM domain receiving information. + real, dimension(:,:,:), intent(out) :: array2 !< The array receiving information. + logical, optional, intent(in) :: complete !< If true, finish communication before proceeding. + + ! Local variables + logical :: do_complete + + do_complete=.true.;if (PRESENT(complete)) do_complete = complete + + call mpp_redistribute(Domain1, array1, Domain2, array2, do_complete) + +end subroutine redistribute_array_3d + end module MOM_domains From 18aff413ac7561193e48992299591bde7c698d5c Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 15 Jan 2021 12:44:08 -0500 Subject: [PATCH 4/5] Replace FMS infrastructure specific calls with equivalent MOM interfaces --- src/ocean_data_assim/MOM_oda_driver.F90 | 157 +++++++++++++----------- 1 file changed, 86 insertions(+), 71 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 670be5d3fb..a85f9c8484 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -1,29 +1,27 @@ !> Interfaces for MOM6 ensembles and data assimilation. module MOM_oda_driver_mod - ! This file is part of MOM6. see LICENSE.md for the license. - -use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe -use mpp_mod, only : set_current_pelist => mpp_set_current_pelist -use mpp_mod, only : set_root_pe => mpp_set_root_pe -use mpp_mod, only : mpp_sync_self, mpp_sum, get_pelist=>mpp_get_current_pelist, mpp_root_pe -use mpp_mod, only : set_stack_size=>mpp_set_stack_size, broadcast=>mpp_broadcast -use mpp_io_mod, only : io_set_stack_size=>mpp_io_set_stack_size -use mpp_io_mod, only : MPP_SINGLE,MPP_MULTI -use mpp_domains_mod, only : domain2d, mpp_global_field -use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_data_domain -use mpp_domains_mod, only : mpp_redistribute, mpp_broadcast_domain -use mpp_domains_mod, only : set_domains_stack_size=>mpp_domains_set_stack_size -use diag_manager_mod, only : register_diag_field, diag_axis_init, send_data -use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size -use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist -use time_manager_mod, only : time_type, decrement_time, increment_time -use time_manager_mod, only : get_date, operator(>=),operator(/=),operator(==),operator(<) -use constants_mod, only : radius, epsln +! This file is part of MOM6. see LICENSE.md for the license. + +! MOM infrastructure +use MOM_error_handler, only : stdout, stdlog, MOM_error +use MOM_coms, only : PE_here, num_PEs +use MOM_coms, only : set_PElist, set_rootPE, Get_PElist, broadcast, broadcast_domain +use MOM_io, only : SINGLE_FILE +use MOM_domains, only : domain2d, global_field, get_domain_extent +use MOM_domains, only : pass_var, redistribute_array +use MOM_diag_mediator, only : register_diag_field, diag_axis_init, post_data +use MOM_ensemble_manager, only : get_ensemble_id, get_ensemble_size +use MOM_ensemble_manager, only : get_ensemble_pelist, get_ensemble_filter_pelist +use MOM_time_manager, only : time_type, real_to_time, get_date +use MOM_time_manager, only : operator(+), operator(>=), operator(/=) +use MOM_time_manager, only : operator(==),operator(<) ! ODA Modules use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct use ocean_da_core_mod, only : ocean_da_core_init, get_profiles -!use eakf_oda_mod, only : ensemble_filter +#ifdef ENABLE_ECDA +use eakf_oda_mod, only : ensemble_filter +#endif use write_ocean_obs_mod, only : open_profile_file use write_ocean_obs_mod, only : write_profile,close_profile_file use kdtree, only : kd_root !# JEDI @@ -57,6 +55,11 @@ module MOM_oda_driver_mod #include +!> A structure with a pointer to a domain2d, to allow for the creation of arrays of pointers. +type :: ptr_mpp_domain + type(domain2d), pointer :: mpp_domain => NULL() !< pointer to a domain2d +end type ptr_mpp_domain + !> Control structure that contains a transpose of the ocean state across ensemble members. type, public :: ODA_CS ; private type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space @@ -64,7 +67,7 @@ module MOM_oda_driver_mod !! or increments to prior in DA space integer :: nk !< number of vertical layers used for DA type(ocean_grid_type), pointer :: Grid => NULL() !< MOM6 grid type and decomposition for the DA - type(ptr_mpp_domain), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects + type(MOM_domain_type), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects !! for ensemble members type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA type(unit_scale_type), pointer :: & @@ -98,10 +101,6 @@ module MOM_oda_driver_mod type(diag_ctrl) :: diag_cs ! A structure with a pointer to a domain2d, to allow for the creation of arrays of pointers. -type :: ptr_mpp_domain - type(domain2d), pointer :: mpp_domain => NULL() !< pointer to an mpp domain2d -end type ptr_mpp_domain !>@{ DA parameters integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 @@ -130,6 +129,8 @@ subroutine init_oda(Time, G, GV, CS) type(param_file_type) :: PF integer :: n, m, k, i, j, nk integer :: is,ie,js,je,isd,ied,jsd,jed + integer :: isg,ieg,jsg,jeg + integer :: idg_offset, jdg_offset integer :: stdout_unit character(len=32) :: assim_method integer :: npes_pm, ens_info(6), ni, nj @@ -139,7 +140,7 @@ subroutine init_oda(Time, G, GV, CS) character(len=200) :: inputdir, basin_file logical :: reentrant_x, reentrant_y, tripolar_N, symmetric - if (associated(CS)) call mpp_error(FATAL, 'Calling oda_init with associated control structure') + if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) ! Use ens1 parameters , this could be changed at a later time ! if it were desirable to have alternate parameters, e.g. for the grid @@ -182,7 +183,7 @@ subroutine init_oda(Time, G, GV, CS) case('no_assim') CS%assim_method = NO_ASSIM case default - call mpp_error(FATAL, 'Invalid assimilation method provided') + call MOM_error(FATAL, "Invalid assimilation method provided") end select ens_info = get_ensemble_size() @@ -195,16 +196,16 @@ subroutine init_oda(Time, G, GV, CS) call get_ensemble_pelist(CS%ensemble_pelist, 'ocean') call get_ensemble_filter_pelist(CS%filter_pelist, 'ocean') - call set_current_pelist(CS%filter_pelist) + call set_PElist(CS%filter_pelist) allocate(CS%domains(CS%ensemble_size)) CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain do n=1,CS%ensemble_size if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain) - call set_root_pe(CS%ensemble_pelist(n,1)) - call mpp_broadcast_domain(CS%domains(n)%mpp_domain) + call set_rootPE(CS%ensemble_pelist(n,1)) + call broadcast_domain(CS%domains(n)%mpp_domain) enddo - call set_root_pe(CS%filter_pelist(1)) + call set_rootPE(CS%filter_pelist(1)) allocate(CS%Grid) ! params NIHALO_ODA, NJHALO_ODA set the DA halo size call MOM_domains_init(CS%Grid%Domain,PF,param_suffix='_ODA') @@ -239,7 +240,12 @@ subroutine init_oda(Time, G, GV, CS) call initialize_regridding(CS%regridCS, CS%GV, CS%US, dG%max_depth,PF,'oda_driver',coord_mode,'','') call initialize_remapping(CS%remapCS,'PLM') call set_regrid_params(CS%regridCS, min_thickness=0.) - call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed) + ! breaking with the MOM6 convention and using global indices + call get_domain_extent(G%Domain,is,ie,js,je,isd,ied,jsd,jed,& + isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) + isd=isd+idg_offset; ied=ied+idg_offset + jsd=jsd+jdg_offset; jed=jed+jdg_offset + !call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed) if (.not. associated(CS%h)) then allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0 ! assign thicknesses @@ -247,10 +253,13 @@ subroutine init_oda(Time, G, GV, CS) endif allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0 allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0 - call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) - - call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) + ! get domain extents for the analysis grid and use global indexing + !call get_domain_extent(CS%Grid%Domain,is,ie,js,je,isd,ied,jsd,jed,& + ! isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) + !isd=isd+idg_offset; ied=ied+idg_offset + !jsd=jsd+jdg_offset; jed=jed+jdg_offset + !call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) allocate(CS%oda_grid) CS%oda_grid%x => CS%Grid%geolonT CS%oda_grid%y => CS%Grid%geolatT @@ -268,9 +277,9 @@ subroutine init_oda(Time, G, GV, CS) allocate(T_grid%x(CS%ni,CS%nj)) allocate(T_grid%y(CS%ni,CS%nj)) allocate(T_grid%basin_mask(CS%ni,CS%nj)) - call mpp_global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) - call mpp_global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) - call mpp_global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) + call global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) + call global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) + call global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) T_grid%ni = CS%ni T_grid%nj = CS%nj T_grid%nk = CS%nk @@ -282,7 +291,7 @@ subroutine init_oda(Time, G, GV, CS) T_grid%z(:,:,:) = 0.0 do k = 1, CS%nk - call mpp_global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) + call global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) do i=1,CS%ni ; do j=1,CS%nj if ( global2D(i,j) > 1 ) then T_grid%mask(i,j,k) = 1.0 @@ -300,7 +309,7 @@ subroutine init_oda(Time, G, GV, CS) CS%Time=Time !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) + call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) end subroutine init_oda !> Copy ensemble member tracers to ensemble vector. @@ -312,14 +321,15 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), allocatable :: T, S + real, dimension(SZI_(G),SZJ_(G),CS%nk) :: T, S type(ocean_grid_type), pointer :: Grid=>NULL() integer :: i,j, m, n, ss integer :: is, ie, js, je integer :: isc, iec, jsc, jec integer :: isd, ied, jsd, jed + integer :: isg, ieg, jsg, jeg, idg_offset, jdg_offset integer :: id - logical :: used + logical :: used, symmetric ! return if not time for analysis if (Time < CS%Time) return @@ -328,32 +338,36 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) if (.not. associated(CS%GV)) call MOM_ERROR(FATAL,'ODA_CS ensemble vertical grid not associated') !! switch to global pelist - call set_current_pelist(CS%filter_pelist) + call set_PElist(CS%filter_pelist) call MOM_mesg('Setting prior') + ! computational domain for the analysis grid isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec - call mpp_get_compute_domain(CS%domains(CS%ensemble_id)%mpp_domain,is,ie,js,je) - call mpp_get_data_domain(CS%domains(CS%ensemble_id)%mpp_domain,isd,ied,jsd,jed) - allocate(T(isd:ied,jsd:jed,CS%nk)) - allocate(S(isd:ied,jsd:jed,CS%nk)) - - do j=js,je ; do i=is,ie + ! array extents for the ensemble member + !call get_domain_extent(CS%domains(CS%ensemble_id),is,ie,js,je,isd,ied,jsd,jed,& + ! isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) + ! remap temperature and salinity from the ensemble member to the analysis grid + do j=G%jsc,G%jec ; do i=G%isc,G%iec call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), & CS%nk, CS%h(i,j,:), T(i,j,:)) call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), & CS%nk, CS%h(i,j,:), S(i,j,:)) enddo ; enddo - + ! cast ensemble members to the analysis domain do m=1,CS%ensemble_size - call mpp_redistribute(CS%domains(m)%mpp_domain, T,& + call redistribute_array(CS%domains(m)%mpp_domain, T,& CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.) - call mpp_redistribute(CS%domains(m)%mpp_domain, S,& + call redistribute_array(CS%domains(m)%mpp_domain, S,& CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.) enddo - deallocate(T,S) + + do m=1,CS%ensemble_size + call pass_var(CS%Ocean_prior%T(:,:,:,m),CS%Grid%domain) + call pass_var(CS%Ocean_prior%S(:,:,:,m),CS%Grid%domain) + enddo !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) + call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) return @@ -377,7 +391,7 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) !! switch to global pelist - call set_current_pelist(CS%filter_pelist) + call set_PElist(CS%filter_pelist) call MOM_mesg('Getting posterior') get_inc = .true. @@ -391,26 +405,26 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) endif do m=1,CS%ensemble_size if (get_inc) then - call mpp_redistribute(CS%mpp_domain, Ocean_increment%T(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) - call mpp_redistribute(CS%mpp_domain, Ocean_increment%S(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) + call redistribute_array(CS%mpp_domain, Ocean_increment%T(:,:,:,m),& + CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + call redistribute_array(CS%mpp_domain, Ocean_increment%S(:,:,:,m),& + CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) else - call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) - call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) + call redistribute_array(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m),& + CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + call redistribute_array(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m),& + CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) endif enddo tv => CS%tv h => CS%h !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) + call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) end subroutine get_posterior_tracer -!> Gather observations and sall ODA routines +!> Gather observations and call ODA routines subroutine oda(Time, CS) type(time_type), intent(in) :: Time !< the current model time type(oda_CS), intent(inout) :: CS !< the ocean DA control structure @@ -422,7 +436,7 @@ subroutine oda(Time, CS) if ( Time >= CS%Time ) then !! switch to global pelist - call set_current_pelist(CS%filter_pelist) + call set_PElist(CS%filter_pelist) call get_profiles(Time, CS%Profiles, CS%CProfiles) #ifdef ENABLE_ECDA @@ -430,7 +444,7 @@ subroutine oda(Time, CS) #endif !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) + call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) endif @@ -479,7 +493,8 @@ subroutine set_analysis_time(Time,CS) integer :: yr, mon, day, hr, min, sec if (Time >= CS%Time) then - CS%Time=increment_time(CS%Time,CS%assim_frequency*3600) + ! increment the analysis time to the next step converting to seconds + CS%Time = CS%Time + real_to_time(CS%US%T_to_s*(CS%assim_frequency*3600.)) call get_date(Time, yr, mon, day, hr, min, sec) write(mesg,*) 'Model Time: ', yr, mon, day, hr, min, sec @@ -505,11 +520,11 @@ subroutine save_obs_diff(filename,CS) integer :: fid ! profile file handle type(ocean_profile_type), pointer :: Prof=>NULL() - fid = open_profile_file(trim(filename), nvar=2, thread=MPP_SINGLE, fset=MPP_SINGLE) + fid = open_profile_file(trim(filename), nvar=2, thread=SINGLE_FILE, fset=SINGLE_FILE) Prof=>CS%CProfiles !! switch to global pelist - !call set_current_pelist(CS%filter_pelist) + !call set_PElist(CS%filter_pelist) do while (associated(Prof)) call write_profile(fid,Prof) @@ -518,7 +533,7 @@ subroutine save_obs_diff(filename,CS) call close_profile_file(fid) !! switch back to ensemble member pelist - !call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) + !call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) return end subroutine save_obs_diff From 408e3a402a242639a9599b174809c91b9f00846c Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 15 Jan 2021 12:47:11 -0500 Subject: [PATCH 5/5] Pass through interface to FMS ensemble manager --- src/framework/MOM_ensemble_manager.F90 | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 src/framework/MOM_ensemble_manager.F90 diff --git a/src/framework/MOM_ensemble_manager.F90 b/src/framework/MOM_ensemble_manager.F90 new file mode 100644 index 0000000000..191dd79c9a --- /dev/null +++ b/src/framework/MOM_ensemble_manager.F90 @@ -0,0 +1,14 @@ +!> A simple (very thin) wrapper for managing ensemble member layout information +module MOM_ensemble_manager + +! This file is part of MOM6. See LICENSE.md for the license. + +use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size +use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist + +implicit none ; private + +public get_ensemble_id, get_ensemble_size, get_ensemble_pelist, get_ensemble_filter_pelist + + +end module MOM_ensemble_manager