Eliminated mpp calls from coupled_driver

Hallberg-NOAA · Hallberg-NOAA · commit 73304ebf89ee · 2021-01-24T08:18:15.000-05:00
Channel all infrastructure calls from coupled_driver via the MOM6 framework
code.  This includes changing the type of one of the arguments and eliminating
another argument to initialize_ocean_public_type to pass a MOM_domain_type, and
using clone_MOM_domain to create the domain2D element of the Ocean_sfc type.
All answers are bitwise identical.
diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90
@@ -7,6 +7,9 @@ module MOM_surface_forcing_gfdl
 !#CTRL# use MOM_controlled_forcing, only : ctrl_forcing_CS
 use MOM_coms,             only : reproducing_sum, field_chksum
 use MOM_constants,        only : hlv, hlf
+use MOM_coupler_types,    only : coupler_2d_bc_type, coupler_type_write_chksums
+use MOM_coupler_types,    only : coupler_type_initialized, coupler_type_spawn
+use MOM_coupler_types,    only : coupler_type_copy_data
 use MOM_cpu_clock,        only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
 use MOM_cpu_clock,        only : CLOCK_SUBCOMPONENT
 use MOM_diag_mediator,    only : diag_ctrl, safe_alloc_ptr, time_type
@@ -23,7 +26,7 @@ module MOM_surface_forcing_gfdl
 use MOM_grid,             only : ocean_grid_type
 use MOM_interpolate,      only : init_external_field, time_interp_external
 use MOM_interpolate,      only : time_interp_external_init
-use MOM_io,               only : slasher, write_version_number, MOM_read_data
+use MOM_io,               only : slasher, write_version_number, MOM_read_data, stdout
 use MOM_restart,          only : register_restart_field, restart_init, MOM_restart_CS
 use MOM_restart,          only : restart_init_end, save_restart, restore_state
 use MOM_string_functions, only : uppercase
@@ -33,11 +36,7 @@ module MOM_surface_forcing_gfdl
 use user_revise_forcing,  only : user_alter_forcing, user_revise_forcing_init
 use user_revise_forcing,  only : user_revise_forcing_CS
 
-use coupler_types_mod,    only : coupler_2d_bc_type, coupler_type_write_chksums
-use coupler_types_mod,    only : coupler_type_initialized, coupler_type_spawn
-use coupler_types_mod,    only : coupler_type_copy_data
 use data_override_mod,    only : data_override_init, data_override
-use fms_mod,              only : stdout
 
 implicit none ; private
 
@@ -318,8 +317,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
 
   if ((.not.coupler_type_initialized(fluxes%tr_fluxes)) .and. &
       coupler_type_initialized(IOB%fluxes)) &
-    call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, &
-                            (/is,is,ie,ie/), (/js,js,je,je/))
+    call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, (/is,is,ie,ie/), (/js,js,je,je/))
   !   It might prove valuable to use the same array extents as the rest of the
   ! ocean model, rather than using haloless arrays, in which case the last line
   ! would be: (             (/isd,is,ie,ied/), (/jsd,js,je,jed/))
@@ -1628,7 +1626,7 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)
                                          !! ocean in a coupled model whose checksums are reported
   integer ::   n,m, outunit
 
-  outunit = stdout()
+  outunit = stdout
 
   write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep
   write(outunit,100) 'iobt%u_flux         ', field_chksum( iobt%u_flux         )
diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90
@@ -17,10 +17,14 @@ module ocean_model_mod
 use MOM, only : get_ocean_stocks, step_offline
 use MOM_coms,      only : field_chksum
 use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf
+use MOM_coupler_types, only : coupler_1d_bc_type, coupler_2d_bc_type
+use MOM_coupler_types, only : coupler_type_spawn, coupler_type_write_chksums
+use MOM_coupler_types, only : coupler_type_initialized, coupler_type_copy_data
+use MOM_coupler_types, only : coupler_type_set_diags, coupler_type_send_data
 use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging
 use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end
-use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE
-use MOM_domains, only : TO_ALL, Omit_Corners
+use MOM_domains, only : MOM_domain_type, domain2d, clone_MOM_domain, get_domain_extent
+use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE, TO_ALL, Omit_Corners
 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
 use MOM_error_handler, only : callTree_enter, callTree_leave
 use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct
@@ -31,7 +35,7 @@ module ocean_model_mod
 use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags
 use MOM_get_input, only : Get_MOM_Input, directories
 use MOM_grid, only : ocean_grid_type
-use MOM_io, only : close_file, file_exists, read_data, write_version_number
+use MOM_io, only : close_file, file_exists, read_data, write_version_number, stdout
 use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
 use MOM_restart, only : MOM_restart_CS, save_restart
 use MOM_string_functions, only : uppercase
@@ -52,14 +56,6 @@ module ocean_model_mod
 use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart
 use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init
 use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves
-use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type
-use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums
-use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data
-use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data
-use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain
-use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain
-use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux
-use fms_mod, only : stdout
 
 #include <MOM_memory.h>
 
@@ -107,7 +103,7 @@ module ocean_model_mod
                     !! points of the two velocity components. Valid entries
                     !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW,
                     !! corresponding to the community-standard Arakawa notation.
-                    !! (These are named integers taken from mpp_parameter_mod.)
+                    !! (These are named integers taken from the MOM_domains module.)
                     !! Following MOM5, stagger is BGRID_NE by default when the
                     !! ocean is initialized, but here it is set to -999 so that
                     !! a global max across ocean and non-ocean processors can be
@@ -391,14 +387,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas
     call MOM_wave_interface_init_lite(param_file)
   endif
 
-  if (associated(OS%grid%Domain%maskmap)) then
-    call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, &
-                                      OS%diag, maskmap=OS%grid%Domain%maskmap, &
-                                      gas_fields_ocn=gas_fields_ocn)
-  else
-    call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, &
-                                      OS%diag, gas_fields_ocn=gas_fields_ocn)
-  endif
+  call initialize_ocean_public_type(OS%grid%Domain, Ocean_sfc, OS%diag, &
+                                    gas_fields_ocn=gas_fields_ocn)
 
   ! This call can only occur here if the coupler_bc_type variables have been
   ! initialized already using the information from gas_fields_ocn.
@@ -513,8 +503,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
                           (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
 
   ! Translate Ice_ocean_boundary into fluxes and forces.
-  call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), &
-                              index_bnds(3), index_bnds(4))
+  call get_domain_extent(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), index_bnds(3), index_bnds(4))
 
   if (do_dyn) then
     call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, &
@@ -733,7 +722,7 @@ end subroutine ocean_model_end
 subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
   type(ocean_state_type),     pointer    :: OS  !< A pointer to the structure containing the
                                                 !! internal ocean state (in).
-  type(time_type),            intent(in) :: Time !< The model time at this call, needed for mpp_write calls.
+  type(time_type),            intent(in) :: Time !< The model time at this call, needed for writing files.
   character(len=*), optional, intent(in) :: directory  !<  An optional directory into which to
                                                 !! write these restart files.
   character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-stamp)
@@ -765,16 +754,12 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix)
 end subroutine ocean_model_save_restart
 
 !> Initialize the public ocean type
-subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, &
-                                        gas_fields_ocn)
-  type(domain2D),          intent(in)    :: input_domain !< The ocean model domain description
+subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, gas_fields_ocn)
+  type(MOM_domain_type),   intent(in)    :: input_domain !< The ocean model domain description
   type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly
-                                !! visible ocean surface properties after initialization, whose
-                                !! elements are allocated here.
-  type(diag_ctrl),         intent(in)    :: diag  !< A structure that regulates diagnsotic output
-  logical, dimension(:,:), &
-                 optional, intent(in)    :: maskmap !< A mask indicating which virtual processors
-                                              !! are actually in use.  If missing, all are used.
+                                              !! visible ocean surface properties after
+                                              !! initialization, whose elements are allocated here.
+  type(diag_ctrl),         intent(in)    :: diag  !< A structure that regulates diagnostic output
   type(coupler_1d_bc_type), &
                  optional, intent(in)    :: gas_fields_ocn !< If present, this type describes the
                                               !! ocean and surface-ice fields that will participate
@@ -786,14 +771,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap,
   ! and have no halos.
   integer :: isc, iec, jsc, jec
 
-  call mpp_get_layout(input_domain,layout)
-  call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz)
-  if (PRESENT(maskmap)) then
-    call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap)
-  else
-    call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain)
-  endif
-  call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec)
+  call clone_MOM_domain(input_domain, Ocean_sfc%Domain, halo_size=0, symmetric=.false.)
+
+  call get_domain_extent(Ocean_sfc%Domain, isc, iec, jsc, jec)
 
   allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), &
              Ocean_sfc%s_surf (isc:iec,jsc:jec), &
@@ -849,8 +829,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_
   is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
   call pass_vector(sfc_state%u, sfc_state%v, G%Domain)
 
-  call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, &
-                              jsc_bnd, jec_bnd)
+  call get_domain_extent(Ocean_sfc%Domain, isc_bnd, iec_bnd, jsc_bnd, jec_bnd)
   if (present(patm)) then
     ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd).
     if (.not.present(press_to_z)) call MOM_error(FATAL, &
@@ -1044,20 +1023,17 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc)
   integer                   , intent(in) :: isc   !< The starting i-index of array2D
   integer                   , intent(in) :: jsc   !< The starting j-index of array2D
 
-  integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j
+  integer :: g_isc, g_iec, g_jsc, g_jec, g_isd, g_ied, g_jsd, g_jed, i, j
 
   if (.not.associated(OS)) return
   if (.not.OS%is_ocean_pe) return
 
-! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain.
-! We want to return the MOM data on the mpp (compute) domain
-! Get MOM domain extents
-  call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec)
-  call mpp_get_data_domain   (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed)
+  ! The problem is that %areaT is on MOM domain but Ice_Ocean_Boundary%... is on a haloless domain.
+  ! We want to return the MOM data on the haloless (compute) domain
+  call get_domain_extent(OS%grid%Domain, g_isc, g_iec, g_jsc, g_jec, g_isd, g_ied, g_jsd, g_jed)
 
   g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1
 
-
   select case(name)
     case('area')
       array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec)
@@ -1127,7 +1103,7 @@ subroutine ocean_public_type_chksum(id, timestep, ocn)
                                              !! visible ocean surface fields.
   integer :: n, m, outunit
 
-  outunit = stdout()
+  outunit = stdout
 
   write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep
   write(outunit,100) 'ocean%t_surf   ', field_chksum(ocn%t_surf )
@@ -1180,8 +1156,7 @@ subroutine ocean_model_get_UV_surf(OS, Ocean, name, array2D, isc, jsc)
   G => OS%grid
   is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
 
-  call mpp_get_compute_domain(Ocean%Domain, isc_bnd, iec_bnd, &
-                              jsc_bnd, jec_bnd)
+  call get_domain_extent(Ocean%Domain, isc_bnd, iec_bnd, jsc_bnd, jec_bnd)
 
   i0 = is - isc_bnd ; j0 = js - jsc_bnd
 
