Merge pull request #140 from Hallberg-NOAA/revise_framework

SIS2: Revise the SIS2 use of framework code

src/SIS_ctrl_types.F90

@@ -12,8 +12,7 @@ module SIS_ctrl_types
 use SIS_diag_mediator, only : register_SIS_diag_field, register_static_field
 use SIS_dyn_trans,     only : dyn_trans_CS
 use SIS_fast_thermo,   only : fast_thermo_CS
-use SIS_framework,     only : domain2D, CORNER, EAST, NORTH
-use SIS_framework,     only : coupler_2d_bc_type, coupler_3d_bc_type
+use SIS_framework,     only : domain2D, coupler_2d_bc_type, coupler_3d_bc_type
 use SIS_framework,     only : coupler_type_initialized, coupler_type_set_diags
 use SIS_hor_grid,      only : SIS_hor_grid_type
 use SIS_optics,        only : SIS_optics_CS

src/SIS_diag_mediator.F90

@@ -3,20 +3,17 @@ module SIS_diag_mediator
 
 ! This file is a part of SIS2. See LICENSE.md for the license.
 
-use SIS_hor_grid, only : SIS_hor_grid_type
-use ice_grid, only : ice_grid_type
-
-use MOM_coms, only : PE_here
-use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, is_root_pe
-use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
-use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc
-use MOM_string_functions, only : lowercase, uppercase, slasher
-use MOM_time_manager, only : time_type
-
-use diag_manager_mod, only : diag_manager_init, send_data, diag_axis_init
-use diag_manager_mod, only : register_diag_field_fms=>register_diag_field
-use diag_manager_mod, only : register_static_field_fms=>register_static_field
-use SIS_framework,    only : EAST, NORTH
+use ice_grid,               only : ice_grid_type
+use MOM_coms,               only : PE_here
+use MOM_diag_manager_infra, only : diag_manager_init=>MOM_diag_manager_init
+use MOM_diag_manager_infra, only : register_diag_field_infra, register_static_field_infra
+use MOM_diag_manager_infra, only : send_data_infra, diag_axis_init=>MOM_diag_axis_init, EAST, NORTH
+use MOM_error_handler,      only : SIS_error=>MOM_error, FATAL, is_root_pe
+use MOM_file_parser,        only : get_param, log_param, log_version, param_file_type
+use MOM_safe_alloc,         only : safe_alloc_ptr, safe_alloc_alloc
+use MOM_string_functions,   only : lowercase, uppercase, slasher
+use MOM_time_manager,       only : time_type
+use SIS_hor_grid,           only : SIS_hor_grid_type
 
 implicit none ; private
 
@@ -174,30 +171,23 @@ subroutine set_SIS_axes_info(G, IG, param_file, diag_cs, set_vertical, axes_set_
   endif
 
   id_xq = diag_axis_init('xB', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', &
-            'Boundary point nominal longitude',set_name=set_name, &
-             Domain2=G%Domain%mpp_domain, domain_position=EAST)
+            'Boundary point nominal longitude', G%Domain, set_name=set_name, position=EAST)
   id_yq = diag_axis_init('yB', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', &
-            'Boundary point nominal latitude', set_name=set_name, &
-             Domain2=G%Domain%mpp_domain, domain_position=NORTH)
+            'Boundary point nominal latitude', G%Domain, set_name=set_name, position=NORTH)
 
   id_xhe = diag_axis_init('xTe', G%gridLonB(G%isg-1:G%ieg), G%x_axis_units, 'x', &
-            'T-cell edge nominal longitude', set_name=set_name, &
-             Domain2=G%Domain%mpp_domain, domain_position=EAST)
+            'T-cell edge nominal longitude', G%Domain, set_name=set_name, position=EAST)
   id_yhe = diag_axis_init('yTe', G%gridLatB(G%jsg-1:G%jeg), G%y_axis_units, 'y', &
-            'T-cell edge nominal latitude', set_name=set_name, &
-            Domain2=G%Domain%mpp_domain, domain_position=NORTH)
+            'T-cell edge nominal latitude', G%Domain, set_name=set_name, position=NORTH)
   id_xh = diag_axis_init('xT', G%gridLonT(G%isg:G%ieg), G%x_axis_units, 'x', &
-              'T point nominal longitude', set_name=set_name, edges=id_xhe, &
-              Domain2=G%Domain%mpp_domain)
+              'T point nominal longitude', G%Domain, set_name=set_name, edges=id_xhe)
   id_yh = diag_axis_init('yT', G%gridLatT(G%jsg:G%jeg), G%y_axis_units, 'y', &
-              'T point nominal latitude', set_name=set_name, edges=id_yhe, &
-              Domain2=G%Domain%mpp_domain)
+              'T point nominal latitude', G%Domain, set_name=set_name, edges=id_yhe)
 
   if (set_vert) then
     do k=1,IG%NkIce+1 ; zinter_ice(k) = real(k-1) / real(IG%NkIce) ; enddo
     do k=1,IG%NkIce ; zlev_ice(k) = (k-0.5) / real(IG%NkIce) ; enddo
-    id_zl = diag_axis_init('zl', zlev_ice, 'layer', 'z', 'Cell depth', &
-                           set_name=set_name)
+    id_zl = diag_axis_init('zl', zlev_ice, 'layer', 'z', 'Cell depth', set_name=set_name)
     id_zi = diag_axis_init('zi', zinter_ice, 'interface', 'z', &
                            'Cell interface depth', set_name=set_name)
   else
@@ -281,7 +271,7 @@ end subroutine set_SIS_diag_mediator_grid
 !> Offer a 2d diagnostic field for output or averaging
 subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask)
   integer,           intent(in) :: diag_field_id !< the id for an output variable returned by a
-                                              !! previous call to register_diag_field.
+                                              !! previous call to register_SIS_diag_field.
   real,    target,   intent(in) :: field(:,:) !< The 2-d array being offered for output or averaging.
   type(SIS_diag_ctrl), target, &
                      intent(in) :: diag_cs !< A structure that is used to regulate diagnostic output
@@ -366,35 +356,35 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask)
 
   if (is_stat) then
     if (present(mask)) then
-      used = send_data(fms_diag_id, locfield, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, mask=mask)
     elseif(i_data .and. associated(diag%mask2d)) then
-      used = send_data(fms_diag_id, locfield, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%mask2d)
     elseif((.not.i_data) .and. associated(diag%mask2d_comp)) then
-      used = send_data(fms_diag_id, locfield, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%mask2d_comp)
     else
-      used = send_data(fms_diag_id, locfield, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev)
     endif
   elseif (diag_cs%ave_enabled) then
     if (present(mask)) then
-      used = send_data(fms_diag_id, locfield, diag_cs%time_end, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, &
-                       weight=diag_cs%time_int, mask=mask)
+                       time=diag_cs%time_end, weight=diag_cs%time_int, mask=mask)
     elseif(i_data .and. associated(diag%mask2d)) then
-      used = send_data(fms_diag_id, locfield, diag_cs%time_end, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, &
-                       weight=diag_cs%time_int, rmask=diag%mask2d)
+                       time=diag_cs%time_end, weight=diag_cs%time_int, rmask=diag%mask2d)
     elseif((.not.i_data) .and. associated(diag%mask2d_comp)) then
-      used = send_data(fms_diag_id, locfield, diag_cs%time_end, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, &
-                       weight=diag_cs%time_int, rmask=diag%mask2d_comp)
+                       time=diag_cs%time_end, weight=diag_cs%time_int, rmask=diag%mask2d_comp)
     else
-      used = send_data(fms_diag_id, locfield, diag_cs%time_end, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, &
-                       weight=diag_cs%time_int)
+                       time=diag_cs%time_end, weight=diag_cs%time_int)
     endif
   endif
 
@@ -405,7 +395,7 @@ end subroutine post_data_2d
 !> Offer a 3d diagnostic field for output or averaging
 subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask)
   integer,           intent(in) :: diag_field_id !< the id for an output variable returned by a
-                                              !! previous call to register_diag_field.
+                                              !! previous call to register_SIS_diag_field.
   real,    target,   intent(in) :: field(:,:,:) !< The 3-d array being offered for output or averaging.
   type(SIS_diag_ctrl), target, &
                      intent(in) :: diag_cs !< A structure that is used to regulate diagnostic output
@@ -483,28 +473,28 @@ subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask)
 
   if (is_stat) then
     if (present(mask)) then
-      used = send_data(fms_diag_id, locfield, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, mask=mask)
     elseif(associated(diag%mask3d)) then
-      used = send_data(fms_diag_id, locfield, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%mask3d)
     else
-      used = send_data(fms_diag_id, locfield, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev)
     endif
   elseif (diag_cs%ave_enabled) then
     if (present(mask)) then
-      used = send_data(fms_diag_id, locfield, diag_cs%time_end, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, &
-                       weight=diag_cs%time_int, mask=mask)
+                       time=diag_cs%time_end, weight=diag_cs%time_int, mask=mask)
     elseif(associated(diag%mask3d)) then
-      used = send_data(fms_diag_id, locfield, diag_cs%time_end, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, &
-                       weight=diag_cs%time_int, rmask=diag%mask3d)
+                       time=diag_cs%time_end, weight=diag_cs%time_int, rmask=diag%mask3d)
     else
-      used = send_data(fms_diag_id, locfield, diag_cs%time_end, &
+      used = send_data_infra(fms_diag_id, locfield, &
                        is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, &
-                       weight=diag_cs%time_int)
+                       time=diag_cs%time_end, weight=diag_cs%time_int)
     endif
   endif
 
@@ -585,20 +575,20 @@ function register_SIS_diag_field(module_name, field_name, axes, init_time, &
 
   ! Local variables
   character(len=240) :: mesg
-  real :: MOM_missing_value
+  real :: SIS_missing_value
   integer :: primary_id, fms_id
   type(SIS_diag_ctrl), pointer :: diag_cs => NULL() ! A structure that is used
                                                ! to regulate diagnostic output
   type(diag_type), pointer :: diag => NULL()
 
-  MOM_missing_value = axes%diag_cs%missing_value
-  if(present(missing_value)) MOM_missing_value = missing_value
+  SIS_missing_value = axes%diag_cs%missing_value
+  if(present(missing_value)) SIS_missing_value = missing_value
 
   diag_cs => axes%diag_cs
   primary_id = -1
 
-  fms_id = register_diag_field_fms(module_name, field_name, axes%handles, &
-         init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, &
+  fms_id = register_diag_field_infra(module_name, field_name, axes%handles, &
+         init_time, long_name=long_name, units=units, missing_value=SIS_missing_value, &
          range=range, mask_variant=mask_variant, standard_name=standard_name, &
          verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, &
          interp_method=interp_method, tile_count=tile_count)
@@ -664,7 +654,7 @@ function register_SIS_diag_field(module_name, field_name, axes, init_time, &
       elseif (axes%id == diag_cs%axesCvc0%id) then
         diag%mask3d =>  diag_cs%mask3dCvC(:,:,0:)
   !   else
-  !       call SIS_error(FATAL, "SIS_diag_mediator:register_diag_field: " // &
+  !       call SIS_error(FATAL, "SIS_diag_mediator:register_SIS_diag_field: " // &
   !            "unknown axes for diagnostic variable "//trim(field_name))
       endif
     !2d masks
@@ -680,11 +670,11 @@ function register_SIS_diag_field(module_name, field_name, axes, init_time, &
       elseif (axes%id == diag_cs%axesCv1%id) then
         diag%mask2d =>  diag_cs%mask2dCv
   !   else
-  !       call SIS_error(FATAL, "SIS_diag_mediator:register_diag_field: " // &
+  !       call SIS_error(FATAL, "SIS_diag_mediator:register_SIS_diag_field: " // &
   !            "unknown axes for diagnostic variable "//trim(field_name))
       endif
     else
-      call SIS_error(FATAL, "SIS_diag_mediator:register_diag_field: " // &
+      call SIS_error(FATAL, "SIS_diag_mediator:register_SIS_diag_field: " // &
            "unknown axes for diagnostic variable "//trim(field_name))
     endif
   endif ! if (primary_id>-1)
@@ -715,18 +705,18 @@ function register_static_field(module_name, field_name, axes, &
 
   ! Local variables
   character(len=240) :: mesg
-  real :: MOM_missing_value
+  real :: SIS_missing_value
   integer :: primary_id, fms_id
   type(SIS_diag_ctrl), pointer :: diag_cs !< A structure that is used to regulate diagnostic output
 
-  MOM_missing_value = axes%diag_cs%missing_value
-  if(present(missing_value)) MOM_missing_value = missing_value
+  SIS_missing_value = axes%diag_cs%missing_value
+  if(present(missing_value)) SIS_missing_value = missing_value
 
   diag_cs => axes%diag_cs
   primary_id = -1
 
-  fms_id = register_static_field_fms(module_name, field_name, axes%handles, &
-       long_name=long_name, units=units, missing_value=MOM_missing_value, &
+  fms_id = register_static_field_infra(module_name, field_name, axes%handles, &
+       long_name=long_name, units=units, missing_value=SIS_missing_value, &
        range=range, mask_variant=mask_variant, standard_name=standard_name, &
        do_not_log=do_not_log, &
        interp_method=interp_method, tile_count=tile_count)

src/SIS_framework.F90

@@ -4,25 +4,24 @@ module SIS_framework
 
 ! This file is part of SIS2. See LICENSE.md for the license.
 
-use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type
-use coupler_types_mod, only : coupler_type_spawn, coupler_type_initialized, coupler_type_send_data
-use coupler_types_mod, only : coupler_type_redistribute_data, coupler_type_copy_data
-use coupler_types_mod, only : coupler_type_increment_data, coupler_type_rescale_data
 use coupler_types_mod, only : coupler_type_register_restarts
-use coupler_types_mod, only : coupler_type_set_diags, coupler_type_write_chksums
 
 use fms_io_mod,        only : set_domain, nullify_domain
+
 use fms_io_mod,        only : restart_file_type, FMS1_register_restart=>register_restart_field
 use fms_io_mod,        only : save_restart_FMS1=>save_restart, FMS1_restore_state=>restore_state
 use fms_io_mod,        only : FMS1_query_initialized=>query_initialized
 ! use fms2_io_mod,       only : query_initialized=>is_registered_to_restart
-use mpp_mod,           only : SIS_chksum=>mpp_chksum
-use mpp_domains_mod,   only : domain2D, CENTER, CORNER, EAST, NORTH
-use mpp_domains_mod,   only : get_layout=>mpp_get_layout, get_compute_domain=>mpp_get_compute_domain
-use mpp_domains_mod,   only : redistribute_data=>mpp_redistribute
-use mpp_domains_mod,   only : broadcast_domain=>mpp_broadcast_domain
 
-use MOM_domains,       only : MOM_domain_type
+use MOM_coms_infra,    only : SIS_chksum=>field_chksum
+use MOM_coupler_types, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type
+use MOM_coupler_types, only : coupler_type_spawn, coupler_type_initialized, coupler_type_send_data
+use MOM_coupler_types, only : coupler_type_copy_data,  coupler_type_redistribute_data
+use MOM_coupler_types, only : coupler_type_increment_data, coupler_type_rescale_data
+use MOM_coupler_types, only : coupler_type_set_diags, coupler_type_write_chksums
+use MOM_domain_infra,  only : MOM_domain_type, domain2D, get_domain_extent
+use MOM_domain_infra,  only : global_field, redistribute_data=>redistribute_array, broadcast_domain
+use MOM_domain_infra,  only : CENTER, CORNER, EAST=>EAST_FACE, NORTH=>NORTH_FACE, EAST_FACE, NORTH_FACE
 use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint
 use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, NOTE
 use MOM_safe_alloc,    only : safe_alloc=>safe_alloc_alloc, safe_alloc_ptr
@@ -31,15 +30,18 @@ module SIS_framework
 
 implicit none ; private
 
-public :: SIS_chksum, redistribute_data, domain2D, CENTER, CORNER, EAST, NORTH, axis_names_from_pos
-public :: set_domain, nullify_domain, get_layout, get_compute_domain, broadcast_domain
+public :: SIS_chksum, redistribute_data, domain2D, axis_names_from_pos
+public :: set_domain, nullify_domain, get_domain_extent, broadcast_domain
 public :: restart_file_type, restore_SIS_state, register_restart_field, save_restart, query_inited
 public :: coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type
 public :: coupler_type_spawn, coupler_type_initialized, coupler_type_send_data
 public :: coupler_type_redistribute_data, coupler_type_copy_data, coupler_type_rescale_data
 public :: coupler_type_increment_data, coupler_type_write_chksums, coupler_type_set_diags
 public :: query_initialized, SIS_restart_init, SIS_restart_end, only_read_from_restarts
 public :: SIS_initialize_framework, safe_alloc, safe_alloc_ptr
+! These encoding constants are used to indicate the discretization position of a variable
+public :: CENTER, CORNER, EAST, NORTH, EAST_FACE, NORTH_FACE
+
 
 !> A restart registry and the control structure for restarts
 type, public :: SIS_restart_CS ; private
@@ -594,9 +596,9 @@ subroutine axis_names_from_pos(dim_names, position, varname)
     dim_names(1:2) = (/ "ih", "jh" /)
   elseif (position == CORNER) then
     dim_names(1:2) = (/ "iq", "jq" /)
-  elseif (position == NORTH) then
+  elseif (position == NORTH_FACE) then
     dim_names(1:2) = (/ "iq", "jq" /)
-  elseif (position == EAST) then
+  elseif (position == EAST_FACE) then
     dim_names(1:2) = (/ "iq", "jq" /)
   elseif (present(varname)) then
     call SIS_error(FATAL, "set_axis_names_from_pos: Unrecognized position setting for "//trim(varname))

src/SIS_slow_thermo.F90

@@ -21,13 +21,13 @@ module SIS_slow_thermo
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
 
 
-use data_override_mod, only : data_override
 
 use ice_grid,          only : ice_grid_type
 use ice_spec_mod,      only : get_sea_surface
 
 use MOM_cpu_clock,     only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
 use MOM_cpu_clock,     only : CLOCK_COMPONENT, CLOCK_LOOP, CLOCK_ROUTINE
+use MOM_data_override, only : data_override
 use MOM_EOS,           only : EOS_type, calculate_density_derivs
 use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, SIS_mesg=>MOM_mesg
 use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint

src/SIS_state_initialization.F90

@@ -9,10 +9,10 @@ module SIS_state_initialization
 ! routines have options that just read and log their input parameters.         !
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
 
-use data_override_mod, only : data_override, data_override_init, data_override_unset_domains
 use ice_grid,          only : ice_grid_type
 use ice_type_mod,      only : ice_data_type, dealloc_ice_arrays
 use ice_type_mod,      only : ice_type_slow_reg_restarts
+use MOM_data_override, only : data_override, data_override_init, data_override_unset_domains
 use MOM_domains,       only : MOM_domain_type
 use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, SIS_mesg=>MOM_mesg
 use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint