diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ce0343f714..c88e96ae2b 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)") diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 13fc4df75d..dec59a717d 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -5,7 +5,7 @@ module MOM_coms ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_coms_wrapper, only : PE_here, root_PE, num_PEs, Set_PElist, Get_PElist +use MOM_coms_wrapper, only : PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist use MOM_coms_wrapper, only : broadcast, field_chksum, MOM_infra_init, MOM_infra_end use MOM_coms_wrapper, only : sum_across_PEs, max_across_PEs, min_across_PEs @@ -13,7 +13,7 @@ module MOM_coms public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum -public :: Set_PElist, Get_PElist +public :: set_PElist, Get_PElist, Set_rootPE 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(=) diff --git a/src/framework/MOM_coms_wrapper.F90 b/src/framework/MOM_coms_wrapper.F90 index 954f6da93c..034381c9f3 100644 --- a/src/framework/MOM_coms_wrapper.F90 +++ b/src/framework/MOM_coms_wrapper.F90 @@ -6,6 +6,7 @@ module MOM_coms_wrapper use fms_mod, only : fms_end, MOM_infra_init => fms_init use memutils_mod, only : print_memuse_stats use mpp_mod, only : PE_here => mpp_pe, root_PE => mpp_root_pe, num_PEs => mpp_npes +use mpp_mod, only : set_rootPE => mpp_set_root_pe use mpp_mod, only : Set_PElist => mpp_set_current_pelist, Get_PElist => mpp_get_current_pelist use mpp_mod, only : mpp_broadcast, mpp_sync, mpp_sync_self, field_chksum => mpp_chksum use mpp_mod, only : sum_across_PEs => mpp_sum, max_across_PEs => mpp_max, min_across_PEs => mpp_min @@ -13,7 +14,7 @@ module MOM_coms_wrapper implicit none ; private public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Set_PElist, Get_PElist -public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum +public :: set_rootPE, broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum ! This module provides interfaces to the non-domain-oriented communication subroutines. diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 56ac0b3ccf..69fa617a6c 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -31,6 +31,9 @@ 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 mpp_domains_mod, only : broadcast_domain => mpp_broadcast_domain use fms_io_mod, only : file_exist, parse_mask_table use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set, fms_affinity_get @@ -52,7 +55,7 @@ module MOM_domains public :: compute_block_extent, get_global_shape, get_layout_extents public :: MOM_thread_affinity_set, set_MOM_thread_affinity public :: get_simple_array_i_ind, get_simple_array_j_ind -public :: domain2D, domain1D +public :: domain2D, domain1D, global_field, redistribute_array, broadcast_domain !> Do a halo update on an array interface pass_var @@ -104,6 +107,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 + !> Extract the 1-d domain components from a MOM_domain or domain2d interface get_domain_components module procedure get_domain_components_MD, get_domain_components_d2D @@ -2110,6 +2118,44 @@ subroutine get_global_shape(domain, niglobal, njglobal) njglobal = domain%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 + !> Returns arrays of the i- and j- sizes of the h-point computational domains for each !! element of the grid layout. Any input values in the extent arrays are discarded, so !! they are effectively intent out despite their declared intent of inout. 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 diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 670be5d3fb..42c4894dd3 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 +use MOM_io, only : SINGLE_FILE +use MOM_domains, only : domain2d, global_field, get_domain_extent +use MOM_domains, only : pass_var, redistribute_array, broadcast_domain +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