From f06c7ba6d80de707284cb627cef44f4b2f246298 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 11 Oct 2019 18:26:42 -0400 Subject: [PATCH 01/24] +Added optional scale arguments to chksum routines Added optional scale arguments to all of the SIS chksum routines to facilitate work with dimensionally rescaled variables. Answers in the Baltic test case are bitwise identical. --- src/SIS_debugging.F90 | 40 ++++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/src/SIS_debugging.F90 b/src/SIS_debugging.F90 index c76f889b..65e4d6c5 100644 --- a/src/SIS_debugging.F90 +++ b/src/SIS_debugging.F90 @@ -554,7 +554,7 @@ end subroutine check_redundant_vT2d ! ===================================================================== !> This subroutine does a checksum and redundant point check on a 3d C-grid vector. -subroutine uvchksum_3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine uvchksum_3d(mesg, u_comp, v_comp, G, halos, scalars, scale) character(len=*), intent(in) :: mesg !< An identifying message type(SIS_hor_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector @@ -562,12 +562,13 @@ subroutine uvchksum_3d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: scale !< A scaling factor for these arrays. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=scale) endif if (debug_redundant) then if (are_scalars) then @@ -580,7 +581,7 @@ subroutine uvchksum_3d(mesg, u_comp, v_comp, G, halos, scalars) end subroutine uvchksum_3d !> This subroutine does a checksum and redundant point check on a 2d C-grid vector. -subroutine uvchksum_2d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine uvchksum_2d(mesg, u_comp, v_comp, G, halos, scalars, scale) character(len=*), intent(in) :: mesg !< An identifying message type(SIS_hor_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector @@ -588,12 +589,13 @@ subroutine uvchksum_2d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: scale !< A scaling factor for these arrays. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=scale) endif if (debug_redundant) then if (are_scalars) then @@ -606,35 +608,37 @@ subroutine uvchksum_2d(mesg, u_comp, v_comp, G, halos, scalars) end subroutine uvchksum_2d !> This subroutine does a checksum and redundant point check on a 3d C-grid vector. -subroutine uvchksum_3d_dG(mesg, u_comp, v_comp, G, halos) +subroutine uvchksum_3d_dG(mesg, u_comp, v_comp, G, halos, scale) character(len=*), intent(in) :: mesg !< An identifying message type(dyn_horgrid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) + real, optional, intent(in) :: scale !< A scaling factor for these arrays. if (debug_chksums) then - call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=scale) endif end subroutine uvchksum_3d_dG !> This subroutine does a checksum and redundant point check on a 2d C-grid vector. -subroutine uvchksum_2d_dG(mesg, u_comp, v_comp, G, halos) +subroutine uvchksum_2d_dG(mesg, u_comp, v_comp, G, halos, scale) character(len=*), intent(in) :: mesg !< An identifying message type(dyn_horgrid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) + real, optional, intent(in) :: scale !< A scaling factor for these arrays. if (debug_chksums) then - call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call mom_uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=scale) endif end subroutine uvchksum_2d_dG !> This subroutine does a checksum and redundant point check on a 3d B-grid vector. -subroutine Bchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine Bchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars, scale) character(len=*), intent(in) :: mesg !< An identifying message type(SIS_hor_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector @@ -642,12 +646,13 @@ subroutine Bchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: scale !< A scaling factor for these arrays. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call mom_Bchksum_pair(mesg, u_comp, v_comp, G%HI, halos) + call mom_Bchksum_pair(mesg, u_comp, v_comp, G%HI, halos, scale=scale) endif if (debug_redundant) then if (are_scalars) then @@ -660,7 +665,7 @@ subroutine Bchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars) end subroutine Bchksum_pair_3d !> This subroutine does a checksum and redundant point check on a 2d B-grid vector. -subroutine Bchksum_pair_2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric) +subroutine Bchksum_pair_2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric, scale) character(len=*), intent(in) :: mesg !< An identifying message type(SIS_hor_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector @@ -670,12 +675,13 @@ subroutine Bchksum_pair_2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric) !! scalars that are being checked. logical, optional, intent(in) :: symmetric !< If true, do the checksums on the !! full symmetric computational domain. + real, optional, intent(in) :: scale !< A scaling factor for these arrays. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call mom_Bchksum_pair(mesg, u_comp, v_comp, G%HI, symmetric=symmetric, haloshift=halos) + call mom_Bchksum_pair(mesg, u_comp, v_comp, G%HI, symmetric=symmetric, haloshift=halos, scale=scale) endif if (debug_redundant) then if (are_scalars) then @@ -688,7 +694,7 @@ subroutine Bchksum_pair_2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric) end subroutine Bchksum_pair_2d !> This subroutine does a checksum and redundant point check on a 3d C-grid vector. -subroutine hchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine hchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars, scale) character(len=*), intent(in) :: mesg !< An identifying message type(SIS_hor_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector @@ -696,12 +702,13 @@ subroutine hchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: scale !< A scaling factor for these arrays. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call mom_hchksum_pair(mesg, u_comp, v_comp, G%HI, halos) + call mom_hchksum_pair(mesg, u_comp, v_comp, G%HI, halos, scale=scale) endif if (debug_redundant) then if (are_scalars) then @@ -714,7 +721,7 @@ subroutine hchksum_pair_3d(mesg, u_comp, v_comp, G, halos, scalars) end subroutine hchksum_pair_3d !> This subroutine does a checksum and redundant point check on a 2d C-grid vector. -subroutine hchksum_pair_2d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine hchksum_pair_2d(mesg, u_comp, v_comp, G, halos, scalars, scale) character(len=*), intent(in) :: mesg !< An identifying message type(SIS_hor_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector @@ -722,12 +729,13 @@ subroutine hchksum_pair_2d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: scale !< A scaling factor for these arrays. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call mom_hchksum_pair(mesg, u_comp, v_comp, G%HI, halos) + call mom_hchksum_pair(mesg, u_comp, v_comp, G%HI, halos, scale=scale) endif if (debug_redundant) then if (are_scalars) then From 2a5e98a538cd78df54b0e4daa43a4f0ffa3c22d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 11 Oct 2019 18:28:41 -0400 Subject: [PATCH 02/24] +Rescaled lengths in SIS_hor_grid_type Rescaled all of the lengths, inverse lengths, areas and inverse areas in the SIS_hor_grid_type, and added unit_scale_type elements to the fast and slow ice control structures and as a arguments to multiple routines. Answers in the Baltic test case are bitwise identical, but there are numerous public interface with added mandatory arguments. --- src/SIS_continuity.F90 | 161 ++++++++++++++++--------------- src/SIS_ctrl_types.F90 | 8 +- src/SIS_dyn_bgrid.F90 | 46 ++++----- src/SIS_dyn_cgrid.F90 | 102 +++++++++++--------- src/SIS_dyn_trans.F90 | 132 +++++++++++++------------ src/SIS_fixed_initialization.F90 | 16 +-- src/SIS_hor_grid.F90 | 59 +++++------ src/SIS_slow_thermo.F90 | 10 +- src/SIS_sum_output.F90 | 24 ++--- src/SIS_tracer_advect.F90 | 99 ++++++++++--------- src/SIS_transport.F90 | 59 ++++++----- src/SIS_utils.F90 | 42 ++++---- src/ice_age_tracer.F90 | 3 +- src/ice_model.F90 | 50 ++++++---- src/ice_type.F90 | 13 ++- src/slab_ice.F90 | 14 +-- src/specified_ice.F90 | 8 +- 17 files changed, 462 insertions(+), 384 deletions(-) diff --git a/src/SIS_continuity.F90 b/src/SIS_continuity.F90 index 6a0f8e73..bafdde0c 100644 --- a/src/SIS_continuity.F90 +++ b/src/SIS_continuity.F90 @@ -18,6 +18,7 @@ module SIS_continuity use SIS_diag_mediator, only : time_type, SIS_diag_ctrl use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type use SIS_hor_grid, only : SIS_hor_grid_type use ice_grid, only : ice_grid_type ! use MOM_variables, only : ocean_OBC_type, OBC_SIMPLE @@ -63,7 +64,7 @@ module SIS_continuity !> ice_continuity time steps the category thickness changes due to advection, !! using a monotonically limited, directionally split PPM scheme. -subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) +subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, US, IG, CS) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), & @@ -81,6 +82,7 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) intent(out) :: vh !< Volume flux through meridional faces = v*h*dx !! [H m2 s-1 ~> kg s-1]. real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. ! This subroutine time steps the category thicknesses, using a monotonically @@ -113,17 +115,17 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) do j=js,je ; do k=1,nCat ; do I=is-1,ie if (u(I,j) >= 0.0) then ; h_up = hin(i,j,k) else ; h_up = hin(i+1,j,k) ; endif - uh(I,j,k) = G%dy_Cu(I,j) * u(I,j) * h_up + uh(I,j,k) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * h_up enddo ; enddo ; enddo !$OMP do do J=js-1,je ; do k=1,nCat ; do i=is,ie if (v(i,J) >= 0.0) then ; h_up = hin(i,j,k) else ; h_up = hin(i,j+1,k) ; endif - vh(i,J,k) = G%dx_Cv(i,J) * v(i,J) * h_up + vh(i,J,k) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * h_up enddo ; enddo ; enddo !$OMP do do j=js,je ; do k=1,nCat ; do i=is,ie - h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * & + h(i,j,k) = hin(i,j,k) - dt* US%m_to_L**2*G%IareaT(i,j) * & ((uh(I,j,k) - uh(I-1,j,k)) + (vh(i,J,k) - vh(i,J-1,k))) if (h(i,j,k) < 0.0) then @@ -135,12 +137,12 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stensil ; LB%jeh = G%jec+stensil - call zonal_mass_flux(u, dt, G, IG, CS, LB, hin, uh) + call zonal_mass_flux(u, dt, G, US, IG, CS, LB, hin, uh) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of ice_continuity().') @@ -152,12 +154,12 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, dt, G, IG, CS, LB, h, vh) + call meridional_mass_flux(v, dt, G, US, IG, CS, LB, h, vh) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of ice_continuity().') @@ -170,12 +172,12 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) LB%ish = G%isc-stensil ; LB%ieh = G%iec+stensil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, dt, G, IG, CS, LB, hin, vh) + call meridional_mass_flux(v, dt, G, US, IG, CS, LB, hin, vh) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of ice_continuity().') @@ -186,12 +188,12 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, dt, G, IG, CS, LB, h, uh) + call zonal_mass_flux(u, dt, G, US, IG, CS, LB, h, uh) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of ice_continuity().') @@ -205,13 +207,14 @@ end subroutine ice_continuity !> ice_cover_transport advects the total fractional ice cover and limits them not to exceed 1. -subroutine ice_cover_transport(u, v, cvr, dt, G, IG, CS) +subroutine ice_cover_transport(u, v, cvr, dt, G, US, IG, CS) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u !< Zonal ice velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v !< Meridional ice velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: cvr !< Fractional ice cover [nondim]. real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. @@ -243,17 +246,17 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, IG, CS) do j=js,je ; do I=is-1,ie if (u(I,j) >= 0.0) then ; cvr_up = cvr(i,j) else ; cvr_up = cvr(i+1,j) ; endif - ucvr(I,j) = G%dy_Cu(I,j) * u(I,j) * cvr_up + ucvr(I,j) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * cvr_up enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie if (v(i,J) >= 0.0) then ; cvr_up = cvr(i,j) else ; cvr_up = cvr(i,j+1) ; endif - vcvr(i,J) = G%dx_Cv(i,J) * v(i,J) * cvr_up + vcvr(i,J) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * cvr_up enddo ; enddo !$OMP do do j=js,je ; do i=is,ie - cvr(i,j) = cvr(i,j) - dt* G%IareaT(i,j) * & + cvr(i,j) = cvr(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * & ((ucvr(I,j) - ucvr(I-1,j)) + (vcvr(i,J) - vcvr(i,J-1))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in ice_cover_transport().') @@ -262,12 +265,12 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, IG, CS) elseif (x_first) then ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc-stensil ; LB%jeh = G%jec+stensil - call zonal_mass_flux(u, dt, G, IG, CS, LB, htot_in=cvr, uh_tot=ucvr) + call zonal_mass_flux(u, dt, G, US, IG, CS, LB, htot_in=cvr, uh_tot=ucvr) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = cvr(i,j) - G%IareaT(i,j) * (dt*(ucvr(I,j) - ucvr(I-1,j))) + cvr(i,j) = cvr(i,j) - US%m_to_L**2*G%IareaT(i,j) * (dt*(ucvr(I,j) - ucvr(I-1,j))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in u-pass of ice_cover_transport().') enddo ; enddo @@ -275,12 +278,12 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, IG, CS) LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec ! Now advect meridionally, using the updated ice covers to determine the fluxes. - call meridional_mass_flux(v, dt, G, IG, CS, LB, htot_in=cvr, vh_tot=vcvr) + call meridional_mass_flux(v, dt, G, US, IG, CS, LB, htot_in=cvr, vh_tot=vcvr) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = max(1.0, cvr(i,j) - dt*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1))) + cvr(i,j) = max(1.0, cvr(i,j) - dt*US%m_to_L**2*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in v-pass of ice_cover_transport().') enddo ; enddo @@ -289,12 +292,12 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, IG, CS) else ! .not. x_first ! First, advect meridionally, so set the loop bounds accordingly. LB%ish = G%isc-stensil ; LB%ieh = G%iec+stensil ; LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, dt, G, IG, CS, LB, htot_in=cvr, vh_tot=vcvr) + call meridional_mass_flux(v, dt, G, US, IG, CS, LB, htot_in=cvr, vh_tot=vcvr) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = cvr(i,j) - dt*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1)) + cvr(i,j) = cvr(i,j) - dt*US%m_to_L**2*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1)) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in v-pass of ice_cover_transport().') enddo ; enddo @@ -302,12 +305,12 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, IG, CS) ! Now advect zonally, using the updated ice covers to determine the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, dt, G, IG, CS, LB, htot_in=cvr, uh_tot=ucvr) + call zonal_mass_flux(u, dt, G, US, IG, CS, LB, htot_in=cvr, uh_tot=ucvr) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = max(1.0, cvr(i,j) - dt* G%IareaT(i,j) * (ucvr(I,j) - ucvr(I-1,j))) + cvr(i,j) = max(1.0, cvr(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (ucvr(I,j) - ucvr(I-1,j))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in u-pass of ice_cover_transport().') enddo ; enddo @@ -322,7 +325,7 @@ end subroutine ice_cover_transport !! thickness categories due to advection, using a monotonically limited, directionally split PPM !! scheme or simple upwind 2-d scheme. It may also update the ice thickness, using fluxes that are !! proportional to the total fluxes times the ice mass divided by the total mass in the upwind cell. -subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) +subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u !< Zonal ice velocity [m s-1]. @@ -336,6 +339,7 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vh !< Total mass flux through meridional faces !! = v*h*dx [H m2 s-1 ~> kg s-1]. real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: h_ice !< Total ice mass per unit cell @@ -376,13 +380,13 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) do j=js,je ; do I=is-1,ie if (u(I,j) >= 0.0) then ; h_up = h_in(i,j) else ; h_up = h_in(i+1,j) ; endif - uh(I,j) = G%dy_Cu(I,j) * u(I,j) * h_up + uh(I,j) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * h_up enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie if (v(i,J) >= 0.0) then ; h_up = h_in(i,j) else ; h_up = h_in(i,j+1) ; endif - vh(i,J) = G%dx_Cv(i,J) * v(i,J) * h_up + vh(i,J) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * h_up enddo ; enddo if (present(h_ice)) then !$OMP do @@ -399,13 +403,13 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) enddo ; enddo !$OMP do do j=js,je ; do i=is,ie - h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * & + h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * & ((uh_ice(I,j) - uh_ice(I-1,j)) + (vh_ice(i,J) - vh_ice(i,J-1))) enddo ; enddo endif !$OMP do do j=js,je ; do i=is,ie - h(i,j) = h_in(i,j) - (dt * G%IareaT(i,j)) * & + h(i,j) = h_in(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * & ((uh(I,j) - uh(I-1,j)) + (vh(i,J) - vh(i,J-1))) ! if (h(i,j) < 0.0) call SIS_error(FATAL, & ! 'Negative thickness encountered in ice_total_continuity().') @@ -417,7 +421,7 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) elseif (x_first) then ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc-stensil ; LB%jeh = G%jec+stensil - call zonal_mass_flux(u, dt, G, IG, CS, LB, htot_in=h_in, uh_tot=uh) + call zonal_mass_flux(u, dt, G, US, IG, CS, LB, htot_in=h_in, uh_tot=uh) call cpu_clock_begin(id_clock_update) @@ -430,14 +434,14 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) else ; uh_ice(I,j) = 0.0 ; endif enddo do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) + h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) enddo enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h_in(i,j) - (dt * G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) + h(i,j) = h_in(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) ! if (h(i,j) < 0.0) call SIS_error(FATAL, & ! 'Negative thickness encountered in u-pass of ice_total_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then @@ -448,7 +452,7 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec ! Now advect meridionally, using the updated thicknesses to determine the fluxes. - call meridional_mass_flux(v, dt, G, IG, CS, LB, htot_in=h, vh_tot=vh) + call meridional_mass_flux(v, dt, G, US, IG, CS, LB, htot_in=h, vh_tot=vh) call cpu_clock_begin(id_clock_update) if (present(h_ice)) then @@ -460,13 +464,13 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) enddo ; enddo !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) + h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h(i,j) - (dt * G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) + h(i,j) = h(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) if (h(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of ice_total_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then @@ -478,7 +482,7 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) else ! .not. x_first ! First, advect meridionally, so set the loop bounds accordingly. LB%ish = G%isc-stensil ; LB%ieh = G%iec+stensil ; LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, dt, G, IG, CS, LB, htot_in=h_in, vh_tot=vh) + call meridional_mass_flux(v, dt, G, US, IG, CS, LB, htot_in=h_in, vh_tot=vh) call cpu_clock_begin(id_clock_update) if (present(h_ice)) then @@ -490,13 +494,13 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) enddo ; enddo !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) + h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h_in(i,j) - (dt * G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) + h(i,j) = h_in(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) ! if (h(i,j) < 0.0) call SIS_error(FATAL, & ! 'Negative thickness encountered in v-pass of ice_total_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then @@ -507,7 +511,7 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) ! Now advect zonally, using the updated thicknesses to determine the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, dt, G, IG, CS, LB, htot_in=h, uh_tot=uh) + call zonal_mass_flux(u, dt, G, US, IG, CS, LB, htot_in=h, uh_tot=uh) call cpu_clock_begin(id_clock_update) @@ -520,14 +524,14 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, IG, CS, h_ice) else ; uh_ice(I,j) = 0.0 ; endif enddo do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) + h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) enddo enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h(i,j) - (dt * G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) + h(i,j) = h(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) if (h(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of ice_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then @@ -543,7 +547,7 @@ end subroutine summed_continuity !> proportionate_continuity time steps the category thickness changes due to advection, !! using input total mass fluxes with the fluxes proprotionate to the relative upwind !! thicknesses. -subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & +subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, & h1, uh1, vh1, h2, uh2, vh2, h3, uh3, vh3) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type @@ -554,6 +558,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vh_tot !< Total mass flux through meridional faces !! [H m2 s-1 ~> kg s-1]. real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & @@ -617,7 +622,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & call merid_proportionate_fluxes(vh_tot, I_htot, h1, vh1, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * & + h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * & ((uh1(I,j,k) - uh1(I-1,j,k)) + (vh1(i,J,k) - vh1(i,J-1,k)))) enddo ; enddo ; enddo endif @@ -626,7 +631,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & call merid_proportionate_fluxes(vh_tot, I_htot, h2, vh2, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * & + h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * & ((uh2(I,j,k) - uh2(I-1,j,k)) + (vh2(i,J,k) - vh2(i,J-1,k)))) enddo ; enddo ; enddo endif @@ -635,7 +640,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & call merid_proportionate_fluxes(vh_tot, I_htot, h3, vh3, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * & + h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * & ((uh3(I,j,k) - uh3(I-1,j,k)) + (vh3(i,J,k) - vh3(i,J-1,k)))) enddo ; enddo ; enddo endif @@ -647,27 +652,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & call zonal_proportionate_fluxes(uh_tot, I_htot, h1, uh1, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) + h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h2)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h2, uh2, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) + h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h3)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h3, uh3, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) + h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot_in(i,j) - dt* G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) + h_tot(i,j) = h_tot_in(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of proportionate_continuity().') I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -679,27 +684,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & call merid_proportionate_fluxes(vh_tot, I_htot, h1, vh1, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) + h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h2)) then call merid_proportionate_fluxes(vh_tot, I_htot, h2, vh2, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) + h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h3)) then call merid_proportionate_fluxes(vh_tot, I_htot, h3, vh3, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) + h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot(i,j) - dt* G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) + h_tot(i,j) = h_tot(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of proportionate_continuity().') ! I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -713,27 +718,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & call merid_proportionate_fluxes(vh_tot, I_htot, h1, vh1, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) + h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h2)) then call merid_proportionate_fluxes(vh_tot, I_htot, h2, vh2, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) + h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h3)) then call merid_proportionate_fluxes(vh_tot, I_htot, h3, vh3, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) + h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot(i,j) - dt* G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) + h_tot(i,j) = h_tot(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of proportionate_continuity().') I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -746,27 +751,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, IG, CS, & call zonal_proportionate_fluxes(uh_tot, I_htot, h1, uh1, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) + h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h2)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h2, uh2, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) + h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h3)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h3, uh3, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) + h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot_in(i,j) - dt* G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) + h_tot(i,j) = h_tot_in(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of proportionate_continuity().') ! I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -834,12 +839,13 @@ end subroutine merid_proportionate_fluxes !> Calculates the mass or volume fluxes through the zonal !! faces, and other related quantities. -subroutine zonal_mass_flux(u, dt, G, IG, CS, LB, h_in, uh, htot_in, uh_tot) +subroutine zonal_mass_flux(u, dt, G, US, IG, CS, LB, h_in, uh, htot_in, uh_tot) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: u !< Zonal ice velocity [m s-1]. real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. @@ -911,24 +917,24 @@ subroutine zonal_mass_flux(u, dt, G, IG, CS, LB, h_in, uh, htot_in, uh_tot) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I,j) > 0.0) then - if (CS%vol_CFL) then ; CFL = (u(I,j) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j) * dt * G%IdxT(i,j) ; endif + if (CS%vol_CFL) then ; CFL = (u(I,j) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + else ; CFL = u(I,j) * dt * US%m_to_L*G%IdxT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*htot(i,j) - uhtot(I) = G%dy_Cu(I,j) * u(I,j) * & + uhtot(I) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * & (hR(i,j) + CFL * (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5))) ! h_marg = hR(i,j) + CFL * ((hL(i,j) - hR(i,j)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j) < 0.0) then - if (CS%vol_CFL) then ; CFL = (-u(I,j) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j) * dt * G%IdxT(i+1,j) ; endif + if (CS%vol_CFL) then ; CFL = (-u(I,j) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + else ; CFL = -u(I,j) * dt * US%m_to_L*G%IdxT(i+1,j) ; endif curv_3 = hL(i+1,j) + hR(i+1,j) - 2.0*htot(i+1,j) - uhtot(I) = G%dy_Cu(I,j) * u(I,j) * & + uhtot(I) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * & (hL(i+1,j) + CFL * (0.5*(hR(i+1,j)-hL(i+1,j)) + curv_3*(CFL - 1.5))) ! h_marg = hL(i+1) + CFL * ((hR(i+1,j)-hL(i+1,j)) + 3.0*curv_3*(CFL - 1.0)) else uhtot(I) = 0.0 ! h_marg = 0.5 * (hl(i+1,j) + hr(i,j)) endif -! duhdu(I,j) = G%dy_Cu(I,j) * h_marg ! * visc_rem(I) +! duhdu(I,j) = US%L_to_m*G%dy_Cu(I,j) * h_marg ! * visc_rem(I) enddo ! Partition the transports by category in proportion to their relative masses. @@ -956,12 +962,13 @@ end subroutine zonal_mass_flux !> Calculates the mass or volume fluxes through the meridional !! faces, and other related quantities. -subroutine meridional_mass_flux(v, dt, G, IG, CS, LB, h_in, vh, htot_in, vh_tot) +subroutine meridional_mass_flux(v, dt, G, US, IG, CS, LB, h_in, vh, htot_in, vh_tot) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJB_(G)), & intent(in) :: v !< Meridional ice velocity [m s-1]. real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. @@ -1035,24 +1042,24 @@ subroutine meridional_mass_flux(v, dt, G, IG, CS, LB, h_in, vh, htot_in, vh_tot) ! This sets vh and dvhdv. do i=ish,ieh if (v(i,J) > 0.0) then - if (CS%vol_CFL) then ; CFL = (v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J) * dt * G%IdyT(i,j) ; endif + if (CS%vol_CFL) then ; CFL = US%m_to_L*(v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i,J) * dt * US%m_to_L*G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*htot(i,j) - vhtot(i) = G%dx_Cv(i,J) * v(i,J) * ( hR(i,j) + CFL * & + vhtot(i) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) ! h_marg = hR(i,j) + CFL * ((hL(i,j) - hR(i,j)) + 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J) < 0.0) then - if (CS%vol_CFL) then ; CFL = (-v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J) * dt * G%IdyT(i,j+1) ; endif + if (CS%vol_CFL) then ; CFL = US%m_to_L*(-v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i,J) * dt * US%m_to_L*G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*htot(i,j+1) - vhtot(i) = G%dx_Cv(i,J) * v(i,J) * ( hL(i,j+1) + CFL * & + vhtot(i) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) ! h_marg = hL(i,j+1) + CFL * ((hR(i,j+1)-hL(i,j+1)) + 3.0*curv_3*(CFL - 1.0)) else vhtot(i) = 0.0 ! h_marg = 0.5 * (hl(i,j+1) + hr(i,j)) endif - ! dvhdv(i) = G%dx_Cv(i,J) * h_marg ! * visc_rem(i) + ! dvhdv(i) = US%L_to_m*G%dx_Cv(i,J) * h_marg ! * visc_rem(i) enddo ! Partition the transports by category in proportion to their relative masses. diff --git a/src/SIS_ctrl_types.F90 b/src/SIS_ctrl_types.F90 index 974efa48..a7772b1c 100644 --- a/src/SIS_ctrl_types.F90 +++ b/src/SIS_ctrl_types.F90 @@ -26,6 +26,7 @@ module SIS_ctrl_types use MOM_file_parser, only : param_file_type use MOM_hor_index, only : hor_index_type use MOM_time_manager, only : time_type, time_type_to_real +use MOM_unit_scaling, only : unit_scale_type use SIS_diag_mediator, only : SIS_diag_ctrl, post_data=>post_SIS_data use SIS_diag_mediator, only : register_SIS_diag_field, register_static_field use SIS_sum_output, only : SIS_sum_out_CS @@ -74,6 +75,7 @@ module SIS_ctrl_types !! shortwave radiation. type(SIS_hor_grid_type), pointer :: G => NULL() !< A structure containing metrics and grid info. + type(unit_scale_type), pointer :: US => NULL() !< A structure containing various unit conversion factors. type(ice_grid_type), pointer :: IG => NULL() !< A structure containing sea-ice specific grid info. type(simple_OSS_type), pointer :: sOSS => NULL() !< A structure containing the arrays !! that describe the ocean's surface state, as it is revealed @@ -148,6 +150,7 @@ module SIS_ctrl_types type(SIS_diag_ctrl) :: diag !< A structure that regulates diagnostics. type(SIS_hor_grid_type), pointer :: G => NULL() !< A structure containing metrics and grid info. + type(unit_scale_type), pointer :: US => NULL() !< A structure containing various unit conversion factors. type(ice_grid_type), pointer :: IG => NULL() !< A structure containing sea-ice specific grid info. type(ocean_sfc_state_type), pointer :: OSS => NULL() !< A structure containing the arrays !! that describe the ocean's surface state, as it is revealed @@ -175,7 +178,7 @@ module SIS_ctrl_types !> ice_diagnostics_init does the registration for a variety of sea-ice model !! diagnostics and saves several static diagnotic fields. -subroutine ice_diagnostics_init(IOF, OSS, FIA, G, IG, diag, Time, Cgrid) +subroutine ice_diagnostics_init(IOF, OSS, FIA, G, US, IG, diag, Time, Cgrid) type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(ocean_sfc_state_type), intent(inout) :: OSS !< A structure containing the arrays that describe @@ -183,6 +186,7 @@ subroutine ice_diagnostics_init(IOF, OSS, FIA, G, IG, diag, Time, Cgrid) type(fast_ice_avg_type), intent(inout) :: FIA !< A type containing averages of fields !! (mostly fluxes) over the fast updates type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_diag_ctrl), intent(in) :: diag !< A structure that is used to regulate diagnostic output type(time_type), intent(inout) :: Time !< The sea-ice model's clock, @@ -366,7 +370,7 @@ subroutine ice_diagnostics_init(IOF, OSS, FIA, G, IG, diag, Time, Cgrid) I_area_Earth = 1.0 / (16.0*atan(1.0)*G%Rad_Earth**2) !$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,I_area_Earth,tmp_diag) do j=jsc,jec ; do i=isc,iec - tmp_diag(i,j) = (G%areaT(i,j) * G%mask2dT(i,j)) * I_area_Earth + tmp_diag(i,j) = (US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) * I_area_Earth enddo ; enddo call post_data(id_cell_area, tmp_diag, diag, is_static=.true.) endif diff --git a/src/SIS_dyn_bgrid.F90 b/src/SIS_dyn_bgrid.F90 index 153a88ad..90b22e3d 100644 --- a/src/SIS_dyn_bgrid.F90 +++ b/src/SIS_dyn_bgrid.F90 @@ -18,6 +18,7 @@ module SIS_dyn_bgrid use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, SIS_mesg=>MOM_mesg use MOM_file_parser, only : get_param, log_param, read_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type +use MOM_unit_scaling, only : unit_scale_type use SIS_hor_grid, only : SIS_hor_grid_type use fms_io_mod, only : register_restart_field, restart_file_type use mpp_domains_mod, only : domain2D @@ -245,7 +246,7 @@ end subroutine find_ice_strength !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_B_dynamics takes a single dynamics timestep with EVP subcycles subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & - fxat, fyat, sea_lev, fxoc, fyoc, do_ridging, rdg_rate, dt_slow, G, CS) + fxat, fyat, sea_lev, fxoc, fyoc, do_ridging, rdg_rate, dt_slow, G, US, CS) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci !< Sea ice concentration [nondim] @@ -267,6 +268,7 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: rdg_rate !< ridging rate from drift state in UNITS? real, intent(in ) :: dt_slow !< The amount of time over which the ice !! dynamics are to be advanced [s]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module ! Local variables @@ -340,15 +342,15 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & dt_Rheo = dt_slow/EVP_steps do J=jsc-1,jec ; do I=isc-1,iec - dydx(I,J) = 0.5*((G%dyT(i+1,j+1) - G%dyT(i,j+1)) + (G%dyT(i+1,j) - G%dyT(i,j))) - dxdy(I,J) = 0.5*((G%dxT(i+1,j+1) - G%dxT(i+1,j)) + (G%dxT(i,j+1) - G%dxT(i,j))) + dydx(I,J) = 0.5*US%L_to_m*((G%dyT(i+1,j+1) - G%dyT(i,j+1)) + (G%dyT(i+1,j) - G%dyT(i,j))) + dxdy(I,J) = 0.5*US%L_to_m*((G%dxT(i+1,j+1) - G%dxT(i+1,j)) + (G%dxT(i,j+1) - G%dxT(i,j))) enddo ; enddo do j=jsc,jec ; do i=isc,iec - grid_fac1(i,j) = (G%dxCv(i,J)-G%dxCv(i,J-1))*G%IdyT(i,j) - grid_fac2(i,j) = (G%dyCu(I,j)-G%dyCu(I-1,j))*G%IdxT(i,j) - grid_fac3(i,j) = 0.5*G%dyT(i,j) * G%IdxT(i,j) - grid_fac4(i,j) = 0.5*G%dxT(i,j) * G%IdyT(i,j) + grid_fac1(i,j) = US%L_to_m*(G%dxCv(i,J)-G%dxCv(i,J-1))*US%m_to_L*G%IdyT(i,j) + grid_fac2(i,j) = US%L_to_m*(G%dyCu(I,j)-G%dyCu(I-1,j))*US%m_to_L*G%IdxT(i,j) + grid_fac3(i,j) = 0.5*US%L_to_m*G%dyT(i,j) * US%m_to_L*G%IdxT(i,j) + grid_fac4(i,j) = 0.5*US%L_to_m*G%dxT(i,j) * US%m_to_L*G%IdyT(i,j) enddo ; enddo !TOM> check where ice is present @@ -359,9 +361,9 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! sea level slope force do J=jsc-1,jec ; do I=isc-1,iec sldx(I,J) = -dt_Rheo*G%g_Earth*(0.5*((sea_lev(i+1,j+1)-sea_lev(i,j+1)) & - + (sea_lev(i+1,j)-sea_lev(i,j)))) * G%IdxBu(i,J) + + (sea_lev(i+1,j)-sea_lev(i,j)))) * US%m_to_L*G%IdxBu(i,J) sldy(I,J) = -dt_Rheo*G%g_Earth*(0.5*((sea_lev(i+1,j+1)-sea_lev(i+1,j)) & - + (sea_lev(i,j+1)-sea_lev(i,j)))) * G%IdyBu(I,J) + + (sea_lev(i,j+1)-sea_lev(i,j)))) * US%m_to_L*G%IdyBu(I,J) enddo ; enddo ! put ice/snow mass and concentration on v-grid, first finding mass on t-grid. @@ -386,10 +388,10 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! This is H&D97, Eq. 44, with their E_0 = 0.25. I_2dt_Rheo = 1.0 / (2.0*dt_Rheo) do j=jsc,jec ; do i=isc,iec - if (G%dxT(i,j) < G%dyT(i,j) ) then - edt(i,j) = I_2dt_Rheo * (G%dxT(i,j)**2 * mice(i,j)) + if (US%L_to_m*G%dxT(i,j) < US%L_to_m*G%dyT(i,j) ) then + edt(i,j) = I_2dt_Rheo * (US%L_to_m**2*G%dxT(i,j)**2 * mice(i,j)) else - edt(i,j) = I_2dt_Rheo * (G%dyT(i,j)**2 * mice(i,j)) + edt(i,j) = I_2dt_Rheo * (US%L_to_m**2*G%dyT(i,j)**2 * mice(i,j)) endif enddo ; enddo endif @@ -425,14 +427,14 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & do j=jsc,jec ; do i=isc,iec strn11(i,j) = (0.5*((ui(I,J)-ui(I-1,J)) + (ui(I,J-1)-ui(I-1,J-1))) + & 0.25*((vi(I,J)+vi(I-1,J-1)) + (vi(I,J-1)+vi(I-1,J))) * & - grid_fac1(i,j)) * G%IdxT(i,j) + grid_fac1(i,j)) * US%m_to_L*G%IdxT(i,j) strn22(i,j) = (0.5*((vi(I,J)-vi(I,J-1)) + (vi(I-1,J)-vi(I-1,J-1))) + & 0.25*((ui(I,J)+ui(I,J-1)) + (ui(I-1,J)+ui(I-1,J-1))) * & - grid_fac2(i,j)) * G%IdyT(i,j) - strn12(i,j) = 0.5*grid_fac3(i,j) * & + grid_fac2(i,j)) * US%m_to_L*G%IdyT(i,j) + strn12(i,j) = 0.5*grid_fac3(i,j) * US%m_to_L*& ( (vi(I,J)*G%IdyBu(I,J) - vi(I-1,J)*G%IdyBu(I-1,J)) + & (vi(I,J-1)*G%IdyBu(I,J-1) - vi(I-1,J-1)*G%IdyBu(I-1,J-1)) ) + & - 0.5*grid_fac4(i,j) * & + 0.5*grid_fac4(i,j) * US%m_to_L*& ( (ui(I,J)*G%IdxBu(I,J) - ui(I,J-1)*G%IdxBu(I,J-1)) + & (ui(I-1,J)*G%IdxBu(I-1,J) - ui(I-1,J-1)*G%IdxBu(I-1,J-1)) ) enddo ; enddo @@ -513,20 +515,20 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! ! first, timestep explicit parts (ice, wind & ocean part of water stress) ! - tmp1 = 0.5*((CS%sig12(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig12(i+1,j)*G%dxT(i+1,j)) + & + tmp1 = 0.5*US%L_to_m*((CS%sig12(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig12(i+1,j)*G%dxT(i+1,j)) + & (CS%sig12(i,j+1)*G%dxT(i,j+1) - CS%sig12(i,j)*G%dxT(i,j)) ) - tmp2 = 0.5*((CS%sig11(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig11(i,j+1)*G%dyT(i,j+1)) + & + tmp2 = 0.5*US%L_to_m*((CS%sig11(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig11(i,j+1)*G%dyT(i,j+1)) + & (CS%sig11(i+1,j)*G%dyT(i+1,j) - CS%sig11(i,j)*G%dyT(i,j)) ) - tmp6 = 0.5*((CS%sig12(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig12(i,j+1)*G%dyT(i,j+1)) + & + tmp6 = 0.5*US%L_to_m*((CS%sig12(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig12(i,j+1)*G%dyT(i,j+1)) + & (CS%sig12(i+1,j)*G%dyT(i+1,j) - CS%sig12(i,j)*G%dyT(i,j)) ) - tmp7 = 0.5*((CS%sig22(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig22(i+1,j)*G%dxT(i+1,j)) + & + tmp7 = 0.5*US%L_to_m*((CS%sig22(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig22(i+1,j)*G%dxT(i+1,j)) + & (CS%sig22(i,j+1)*G%dxT(i,j+1) - CS%sig22(i,j)*G%dxT(i,j))) tmp3 = 0.25*((CS%sig12(i+1,j+1)+CS%sig12(i,j)) + (CS%sig12(i+1,j)+CS%sig12(i,j+1)) ) tmp4 = 0.25*((CS%sig22(i+1,j+1)+CS%sig22(i,j)) + (CS%sig22(i+1,j)+CS%sig22(i,j+1)) ) tmp5 = 0.25*((CS%sig11(i+1,j+1)+CS%sig11(i,j)) + (CS%sig11(i+1,j)+CS%sig11(i,j+1)) ) - fxic_now = ( (tmp1 + tmp2) + (tmp3*dxdy(I,J) - tmp4*dydx(I,J)) ) * G%IareaBu(I,J) - fyic_now = ( (tmp6 + tmp7) + (tmp3*dydx(I,J) - tmp5*dxdy(I,J)) ) * G%IareaBu(I,J) + fxic_now = ( (tmp1 + tmp2) + (tmp3*dxdy(I,J) - tmp4*dydx(I,J)) ) * US%m_to_L**2*G%IareaBu(I,J) + fyic_now = ( (tmp6 + tmp7) + (tmp3*dydx(I,J) - tmp5*dxdy(I,J)) ) * US%m_to_L**2*G%IareaBu(I,J) !### REWRITE TO AVOID COMPLEX EXPRESSIONS. ui(I,J) = ui(I,J) + (fxic_now + civ(I,J)*fxat(I,J) + & diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index e1f96d1e..b93715ad 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -27,6 +27,7 @@ module SIS_dyn_cgrid use MOM_io, only : open_file, APPEND_FILE, ASCII_FILE, MULTIPLE, SINGLE_FILE use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-) use MOM_time_manager, only : set_date, get_time, get_date +use MOM_unit_scaling, only : unit_scale_type use SIS_hor_grid, only : SIS_hor_grid_type use fms_io_mod, only : register_restart_field, restart_file_type use fms_io_mod, only : restore_state, query_initialized @@ -433,7 +434,7 @@ end subroutine find_ice_strength !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_C_dynamics takes a single dynamics timestep with EVP subcycles subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & - fxat, fyat, sea_lev, fxoc, fyoc, dt_slow, G, CS) + fxat, fyat, sea_lev, fxoc, fyoc, dt_slow, G, US, CS) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci !< Sea ice concentration [nondim] @@ -453,6 +454,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & real, dimension(SZI_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean [Pa] real, intent(in ) :: dt_slow !< The amount of time over which the ice !! dynamics are to be advanced [s]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module ! Local variables @@ -514,7 +516,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! divided by the sum of the ocean areas around a point [m-2]. q, & ! A potential-vorticity-like field for the ice, the Coriolis parameter ! divided by a spatially averaged mass per unit area [s-1 m2 kg-1]. - dx2B, dy2B, & ! dx^2 or dy^2 at B points [m2]. + dx2B, dy2B, & ! dx^2 or dy^2 at B points [L2 ~> m2]. dx_dyB, dy_dxB ! dx/dy or dy_dx at B points [nondim]. real, dimension(SZIB_(G),SZJ_(G)) :: & azon, bzon, & ! _zon & _mer are the values of the Coriolis force which @@ -528,7 +530,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & real :: fxic_now, fyic_now ! ice internal stress convergence [kg m-1 s-2]. real :: drag_u, drag_v ! Drag rates with the ocean at u & v points [kg m-2 s-1]. real :: drag_max ! A maximum drag rate allowed in the ocean [kg m-2 s-1]. - real :: tot_area ! The sum of the area of the four neighboring cells [m2]. + real :: tot_area ! The sum of the area of the four neighboring cells [L2 ~> m2]. real :: dxharm ! The harmonic mean of the x- and y- grid spacings [m]. real :: muq2, mvq2 ! The product of the u- and v-face masses per unit cell ! area surrounding a vorticity point [kg2 m-4]. @@ -568,7 +570,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & real :: m_neglect ! A tiny mass per unit area [kg m-2]. real :: m_neglect2 ! A tiny mass per unit area squared [kg2 m-4]. real :: m_neglect4 ! A tiny mass per unit area to the 4th power [kg4 m-8]. - real :: sum_area ! The sum of ocean areas around a vorticity point [m2]. + real :: sum_area ! The sum of ocean areas around a vorticity point [L2 ~> m2]. type(time_type) :: & time_it_start, & ! The starting time of the iteratve steps. @@ -661,8 +663,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do j=jsc,jec do I=isc-1,iec ; if (G%dy_Cu(I,j) > 0.0) then - ui_min_trunc(I,j) = (-CS%CFL_trunc) * G%areaT(i+1,j) / (dt_slow*G%dy_Cu(I,j)) - ui_max_trunc(I,j) = CS%CFL_trunc * G%areaT(i,j) / (dt_slow*G%dy_Cu(I,j)) + ui_min_trunc(I,j) = (-CS%CFL_trunc) * US%L_to_m*G%areaT(i+1,j) / (dt_slow*G%dy_Cu(I,j)) + ui_max_trunc(I,j) = CS%CFL_trunc * US%L_to_m*G%areaT(i,j) / (dt_slow*G%dy_Cu(I,j)) endif ; enddo do I=isc-1,iec ; u_IC(I,j) = ui(I,j) ; enddo enddo @@ -670,8 +672,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do J=jsc-1,jec do i=isc,iec ; if (G%dx_Cv(i,J) > 0.0) then - vi_min_trunc(i,J) = (-CS%CFL_trunc) * G%areaT(i,j+1) / (dt_slow*G%dx_Cv(i,J)) - vi_max_trunc(i,J) = CS%CFL_trunc * G%areaT(i,j) / (dt_slow*G%dx_Cv(i,J)) + vi_min_trunc(i,J) = (-CS%CFL_trunc) * US%L_to_m*G%areaT(i,j+1) / (dt_slow*G%dx_Cv(i,J)) + vi_max_trunc(i,J) = CS%CFL_trunc * US%L_to_m*G%areaT(i,j) / (dt_slow*G%dx_Cv(i,J)) endif ; enddo do i=isc,iec ; v_IC(i,J) = vi(i,j) ; enddo enddo @@ -684,7 +686,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Precompute pres_mice and the minimum value of del_sh for stability. pres_mice(i,j) = CS%p0_rho*exp(-CS%c0*max(1.0-ci(i,j),0.0)) - dxharm = 2.0*G%dxT(i,j)*G%dyT(i,j) / (G%dxT(i,j) + G%dyT(i,j)) + dxharm = 2.0*US%L_to_m*G%dxT(i,j)*G%dyT(i,j) / (G%dxT(i,j) + G%dyT(i,j)) ! Setting a minimum value of del_sh is sufficient to guarantee numerical ! stability of the overall time-stepping for the velocities and stresses. ! Setting a minimum value of the shear magnitudes is equivalent to setting @@ -700,7 +702,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Ensure that the input stresses are not larger than could be justified by ! the ice pressure now, as the ice might have melted or been advected away ! during the thermodynamic and transport phases. - call limit_stresses(pres_mice, mice, CS%str_d, CS%str_t, CS%str_s, G, CS) + call limit_stresses(pres_mice, mice, CS%str_d, CS%str_t, CS%str_s, G, US, CS) ! Zero out ice velocities with no mass. !$OMP do @@ -732,10 +734,10 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do J=jsc-1,jec ; do I=isc-1,iec if (CS%weak_coast_stress) then - sum_area = (G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i,j+1) + G%areaT(i+1,j)) + sum_area = US%L_to_m**2*((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i,j+1) + G%areaT(i+1,j))) else - sum_area = (G%mask2dT(i,j)*G%areaT(i,j) + G%mask2dT(i+1,j+1)*G%areaT(i+1,j+1)) + & - (G%mask2dT(i,j+1)*G%areaT(i,j+1) + G%mask2dT(i+1,j)*G%areaT(i+1,j)) + sum_area = US%L_to_m**2*((G%mask2dT(i,j)*G%areaT(i,j) + G%mask2dT(i+1,j+1)*G%areaT(i+1,j+1)) + & + (G%mask2dT(i,j+1)*G%areaT(i,j+1) + G%mask2dT(i+1,j)*G%areaT(i+1,j))) endif if (sum_area <= 0.0) then ! This is a land point. @@ -783,7 +785,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP end do nowait !$OMP do do J=jsc-1,jec ; do I=isc-1,iec - tot_area = (G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1)) + tot_area = ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) q(I,J) = G%CoriolisBu(I,J) * tot_area / & (((G%areaT(i,j) * mis(i,j) + G%areaT(i+1,j+1) * mis(i+1,j+1)) + & (G%areaT(i+1,j) * mis(i+1,j) + G%areaT(i,j+1) * mis(i,j+1))) + tot_area * m_neglect) @@ -801,7 +803,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & I1_f2dt2_u(I,j) = 1.0 / ( 1.0 + dt * f2dt_u(I,j) ) ! Calculate the zonal acceleration due to the sea level slope. - PFu(I,j) = -G%g_Earth*(sea_lev(i+1,j)-sea_lev(i,j)) * G%IdxCu(I,j) + PFu(I,j) = -G%g_Earth*(sea_lev(i+1,j)-sea_lev(i,j)) * US%m_to_L*G%IdxCu(I,j) enddo ; enddo !$OMP end do nowait !$OMP do @@ -817,7 +819,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & I1_f2dt2_v(i,J) = 1.0 / ( 1.0 + dt * f2dt_v(i,J) ) ! Calculate the meridional acceleration due to the sea level slope. - PFv(i,J) = -G%g_Earth*(sea_lev(i,j+1)-sea_lev(i,j)) * G%IdyCv(i,J) + PFv(i,J) = -G%g_Earth*(sea_lev(i,j+1)-sea_lev(i,j)) * US%m_to_L*G%IdyCv(i,J) enddo ; enddo !$OMP end parallel @@ -852,21 +854,21 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP dx_dyB,dy_dxB,ui,vi) do J=jsc-halo_sh_Ds,jec+halo_sh_Ds-1 ; do I=isc-halo_sh_Ds,iec+halo_sh_Ds-1 ! This uses a no-slip boundary condition. - sh_Ds(I,J) = (2.0-G%mask2dBu(I,J)) * & + sh_Ds(I,J) = (2.0-G%mask2dBu(I,J)) * US%m_to_L * & (dx_dyB(I,J)*(ui(I,j+1)*G%IdxCu(I,j+1) - ui(I,j)*G%IdxCu(I,j)) + & dy_dxB(I,J)*(vi(i+1,J)*G%IdyCv(i+1,J) - vi(i,J)*G%IdyCv(i,J))) enddo ; enddo if (halo_sh_Ds < 2) call pass_var(sh_Ds, G%Domain, position=CORNER) !$OMP parallel do default(none) shared(isc,iec,jsc,jec,sh_Dt,sh_Dd,dy_dxT,dx_dyT,G,ui,vi) do j=jsc-1,jec+1 ; do i=isc-1,iec+1 - sh_Dt(i,j) = (dy_dxT(i,j)*(G%IdyCu(I,j) * ui(I,j) - & - G%IdyCu(I-1,j)*ui(I-1,j)) - & + sh_Dt(i,j) = US%m_to_L*(dy_dxT(i,j)*(G%IdyCu(I,j) * ui(I,j) - & + G%IdyCu(I-1,j)*ui(I-1,j)) - & dx_dyT(i,j)*(G%IdxCv(i,J) * vi(i,J) - & G%IdxCv(i,J-1)*vi(i,J-1))) - sh_Dd(i,j) = (G%IareaT(i,j)*(G%dyCu(I,j) * ui(I,j) - & - G%dyCu(I-1,j)*ui(I-1,j)) + & - G%IareaT(i,j)*(G%dxCv(i,J) * vi(i,J) - & - G%dxCv(i,J-1)*vi(i,J-1))) + sh_Dd(i,j) = US%m_to_L*(G%IareaT(i,j)*(G%dyCu(I,j) * ui(I,j) - & + G%dyCu(I-1,j)*ui(I-1,j)) + & + G%IareaT(i,j)*(G%dxCv(i,J) * vi(i,J) - & + G%dxCv(i,J-1)*vi(i,J-1))) enddo ; enddo if (CS%project_ci) then @@ -931,8 +933,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & do J=jsc-1,jec ; do I=isc-1,iec ! zeta is already set to 0 over land. CS%str_s(I,J) = I_1pdt_T * ( CS%str_s(I,J) + (I_EC2 * dt_2Tdamp) * & - ( ((G%areaT(i,j)*zeta(i,j) + G%areaT(i+1,j+1)*zeta(i+1,j+1)) + & - (G%areaT(i+1,j)*zeta(i+1,j) + G%areaT(i,j+1)*zeta(i,j+1))) * & + ( US%L_to_m**2*((G%areaT(i,j)*zeta(i,j) + G%areaT(i+1,j+1)*zeta(i+1,j+1)) + & + (G%areaT(i+1,j)*zeta(i+1,j) + G%areaT(i,j+1)*zeta(i,j+1))) * & mi_ratio_A_q(I,J) * sh_Ds(I,J) ) ) enddo ; enddo @@ -958,7 +960,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m x.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fxic_now = G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + & + fxic_now = US%m_to_L*G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + US%m_to_L * & (G%IdyCu(I,j)*(dy2T(i+1,j)*CS%str_t(i+1,j) - & dy2T(i,j) *CS%str_t(i,j)) + & G%IdxCu(I,j)*(dx2B(I,J) *CS%str_s(I,J) - & @@ -1010,12 +1012,12 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! sum accelerations to take averages. fxic(I,j) = fxic(I,j) + fxic_now - if (CS%id_fix_d>0) fxic_d(I,j) = fxic_d(I,j) + G%mask2dCu(I,j) * & + if (CS%id_fix_d>0) fxic_d(I,j) = fxic_d(I,j) + G%mask2dCu(I,j) * US%m_to_L * & G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) - if (CS%id_fix_t>0) fxic_t(I,j) = fxic_t(I,j) + G%mask2dCu(I,j) * & + if (CS%id_fix_t>0) fxic_t(I,j) = fxic_t(I,j) + G%mask2dCu(I,j) * US%m_to_L * & G%IdyCu(I,j)*(dy2T(i+1,j)* CS%str_t(i+1,j) - & dy2T(i,j) * CS%str_t(i,j) ) * G%IareaCu(I,j) - if (CS%id_fix_s>0) fxic_s(I,j) = fxic_s(I,j) + G%mask2dCu(I,j) * & + if (CS%id_fix_s>0) fxic_s(I,j) = fxic_s(I,j) + G%mask2dCu(I,j) * US%m_to_L * & G%IdxCu(I,j)*(dx2B(I,J) *CS%str_s(I,J) - & dx2B(I,J-1)*CS%str_s(I,J-1)) * G%IareaCu(I,j) @@ -1040,7 +1042,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m y.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fyic_now = G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + & + fyic_now = US%m_to_L*G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + US%m_to_L * & (-G%IdxCv(i,J)*(dx2T(i,j+1)*CS%str_t(i,j+1) - & dx2T(i,j) *CS%str_t(i,j)) + & G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & @@ -1094,11 +1096,11 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & fyic(i,J) = fyic(i,J) + fyic_now if (CS%id_fiy_d>0) fyic_d(i,J) = fyic_d(i,J) + G%mask2dCv(i,J) * & - G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) - if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * & + US%m_to_L*G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * US%m_to_L * & (G%IdxCv(i,J)*(dx2T(i,j+1)*(-CS%str_t(i,j+1)) - & dx2T(i,j) *(-CS%str_t(i,j))) ) * G%IareaCv(i,J) - if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * & + if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * US%m_to_L * & (G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & dy2B(I-1,J)*CS%str_s(I-1,J)) ) * G%IareaCv(i,J) @@ -1127,7 +1129,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & call post_SIS_data(CS%id_sigi_hifreq, diag_val, CS%diag) endif if (CS%id_sigii_hifreq>0) then - call find_sigII(mice, ci_proj, CS%str_t, CS%str_s, diag_val, G, CS) + call find_sigII(mice, ci_proj, CS%str_t, CS%str_s, diag_val, G, US, CS) call post_SIS_data(CS%id_sigii_hifreq, diag_val, CS%diag) endif if (CS%id_ci_hifreq>0) call post_SIS_data(CS%id_ci_hifreq, ci_proj, CS%diag) @@ -1197,7 +1199,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & if (mi_u(I,j) > m_neglect) then CS%ntrunc = CS%ntrunc + 1 call write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, & - PFu, fxat, dt_slow, G, CS) + PFu, fxat, dt_slow, G, US, CS) endif if (ui(I,j) < ui_min_trunc(I,j)) then ui(I,j) = 0.95 * ui_min_trunc(I,j) @@ -1223,7 +1225,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & if (mi_v(i,J) > m_neglect) then CS%ntrunc = CS%ntrunc + 1 call write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, & - PFv, fyat, dt_slow, G, CS) + PFv, fyat, dt_slow, G, US, CS) endif if (vi(i,J) < vi_min_trunc(i,J)) then vi(i,J) = 0.95 * vi_min_trunc(i,J) @@ -1286,7 +1288,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & call post_SIS_data(CS%id_sigi, diag_val, CS%diag) endif if (CS%id_sigii>0) then - call find_sigII(mice, ci, CS%str_t, CS%str_s, diag_val, G, CS) + call find_sigII(mice, ci, CS%str_t, CS%str_s, diag_val, G, US, CS) call post_SIS_data(CS%id_sigii, diag_val, CS%diag) endif if (CS%id_stren>0) then @@ -1348,7 +1350,7 @@ end subroutine SIS_C_dynamics !> limit_stresses ensures that the input stresses are not larger than could be justified by the ice !! pressure now, as the ice might have melted or been advected away during the thermodynamic and !! transport phases, or the ice flow convergence or divergence may have altered the ice concentration. -subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, CS, limit) +subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, US, CS, limit) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: pres_mice !< The ice internal pressure per !! unit column mass [N m kg-1]. @@ -1357,6 +1359,7 @@ subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, CS, limit) real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_d !< The divergence stress tensor component [Pa m]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_t !< The tension stress tensor component [Pa m]. real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: str_s !< The shearing stress tensor component [Pa m]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, optional, intent(in) :: limit !< A factor by which the strength limits are changed. @@ -1368,7 +1371,7 @@ subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, CS, limit) ! Local variables real :: pressure ! The internal ice pressure at a point [Pa]. real :: pres_avg ! The average of the internal ice pressures around a point [Pa]. - real :: sum_area ! The sum of ocean areas around a vorticity point [m2]. + real :: sum_area ! The sum of ocean areas around a vorticity point [L2 ~> m2]. real :: I_2EC ! 1/(2*EC), where EC is the yield curve axis ratio. real :: lim ! A local copy of the factor by which the limits are changed. real :: lim_2 ! The limit divided by 2. @@ -1493,21 +1496,22 @@ end subroutine find_sigI !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> find_sigII finds the second stress invariant -subroutine find_sigII(mi, ci, str_t, str_s, sigII, G, CS) +subroutine find_sigII(mi, ci, str_t, str_s, sigII, G, US, CS) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration [nondim] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: str_t !< The tension stress tensor component, [Pa m] real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: str_s !< The shearing stress tensor component [Pa m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigII !< The second stress invariant [nondim]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G)) :: & strength ! The ice strength [Pa m]. real, dimension(SZIB_(G),SZJB_(G)) :: & str_s_ss ! Str_s divided by the sum of the neighboring ice strengths. - real :: strength_sum ! The sum of the 4 neighboring strengths [Pa m]. - real :: sum_area ! The sum of ocean areas around a vorticity point [m2]. + real :: strength_sum ! The sum of the 4 neighboring strengths [L2 Pa m-1 ~> Pa m]. + real :: sum_area ! The sum of ocean areas around a vorticity point [L2 ~> m2]. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1647,7 +1651,7 @@ end subroutine SIS_C_dyn_read_alt_restarts !> write_u_trunc is used to record the location of any pseudo-zonal velocity !! truncations and related fields. subroutine write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, PFu, fxat, & - dt_slow, G, CS) + dt_slow, G, US, CS) integer, intent(in) :: I !< The i-index of the column to report on integer, intent(in) :: j !< The j-index of the column to report on type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type @@ -1661,6 +1665,7 @@ subroutine write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, PFu, fxat, real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: PFu !< The zonal Pressure force accleration [m s-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxat !< The zonal wind stress [Pa]. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real :: dt_mi, CFL @@ -1685,9 +1690,9 @@ subroutine write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, PFu, fxat, file = CS%u_file if (ui(I,j) > 0.0) then - CFL = (ui(I,j) * (dt_slow*G%dy_Cu(I,j))) / G%areaT(i,j) + CFL = (ui(I,j) * (dt_slow*US%m_to_L*G%dy_Cu(I,j))) / G%areaT(i,j) else - CFL = (ui(I,j) * (dt_slow*G%dy_Cu(I,j))) / G%areaT(i+1,j) + CFL = (ui(I,j) * (dt_slow*US%m_to_L*G%dy_Cu(I,j))) / G%areaT(i+1,j) endif @@ -1717,7 +1722,7 @@ end subroutine write_u_trunc !> write_v_trunc is used to record the location of any pseudo-meridional velocity !! truncations and related fields. subroutine write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, PFv, fyat, & - dt_slow, G, CS) + dt_slow, G, US, CS) integer, intent(in) :: i !< The i-index of the column to report on integer, intent(in) :: J !< The j-index of the column to report on type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type @@ -1731,6 +1736,7 @@ subroutine write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, PFv, fyat, real, dimension(SZI_(G),SZJB_(G)), intent(in) :: PFv !< The meridional pressure force accleration [m s-2]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyat !< The meridional wind stress [Pa]. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real :: dt_mi, CFL @@ -1756,9 +1762,9 @@ subroutine write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, PFv, fyat, file = CS%v_file if (vi(i,J) > 0.0) then - CFL = (vi(i,J) * (dt_slow*G%dx_Cv(i,J))) / G%areaT(i,j) + CFL = (vi(i,J) * (dt_slow*US%m_to_L*G%dx_Cv(i,J))) / G%areaT(i,j) else - CFL = (vi(i,J) * (dt_slow*G%dx_Cv(i,J))) / G%areaT(i,j+1) + CFL = (vi(i,J) * (dt_slow*US%m_to_L*G%dx_Cv(i,J))) / G%areaT(i,j+1) endif call get_date(CS%Time, yr, mo, day, hr, minute, sec) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index a86092d1..ab7a7177 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -24,6 +24,7 @@ module SIS_dyn_trans use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : operator(+), operator(-) use MOM_time_manager, only : operator(>), operator(*), operator(/), operator(/=) +use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_density_derivs use coupler_types_mod, only: coupler_type_initialized, coupler_type_send_data @@ -279,7 +280,7 @@ end subroutine update_icebergs !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_dynamics_trans makes the calls to do ice dynamics and mass and tracer transport -subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, IG, tracer_CSp) +subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, US, IG, tracer_CSp) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. @@ -289,6 +290,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I !! the ocean that are calculated by the ice model. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module type(icebergs), pointer :: icebergs_CS !< A control structure for the iceberg model. @@ -366,13 +368,13 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I if (CS%merged_cont) then ! Convert the category-resolved ice state into the simplified 2-d ice state. ! This should be called after a thermodynamic step or if ice_transport was called. - call convert_IST_to_simple_state(IST, CS%DS2d, CS%CAS, G, IG, CS) + call convert_IST_to_simple_state(IST, CS%DS2d, CS%CAS, G, US, IG, CS) ! Update the category-merged dynamics and use the merged continuity equation. - call SIS_merged_dyn_cont(OSS, FIA, IOF, CS%DS2d, dt_adv_cycle, Time_cycle_start, G, IG, CS) + call SIS_merged_dyn_cont(OSS, FIA, IOF, CS%DS2d, dt_adv_cycle, Time_cycle_start, G, US, IG, CS) ! Complete the category-resolved mass and tracer transport and update the ice state type. - call complete_IST_transport(CS%DS2d, CS%CAS, IST, dt_adv_cycle, G, IG, CS) + call complete_IST_transport(CS%DS2d, CS%CAS, IST, dt_adv_cycle, G, US, IG, CS) else ! (.not.CS%merged_cont) @@ -398,7 +400,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I enddo ; enddo ! Determine the whole-cell averaged mass of snow and ice. - call ice_state_to_cell_ave_state(IST, G, IG, CS%SIS_transport_CSp, CS%CAS) + call ice_state_to_cell_ave_state(IST, G, US, IG, CS%SIS_transport_CSp, CS%CAS) endif if (.not.CS%Warsaw_sum_order) then do j=jsd,jed ; do i=isd,ied ; ice_free(i,j) = max(1.0 - ice_cover(i,j), 0.0) ; enddo ; enddo @@ -425,7 +427,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I ! This block of code must be executed if ice_cover and ice_free or the various wind ! stresses were updated. call set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y_Cv, & - WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, CS%complete_ice_cover) + WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, US, CS%complete_ice_cover) if (CS%debug) then @@ -446,11 +448,11 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I if (CS%Warsaw_sum_order) then call SIS_C_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, CS%SIS_C_dyn_CSp) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) else call SIS_C_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, CS%SIS_C_dyn_CSp) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) endif call mpp_clock_end(iceClocka) @@ -486,7 +488,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I ! This block of code must be executed if ice_cover and ice_free or the various wind ! stresses were updated. call set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_B, & - WindStr_x_ocn_B, WindStr_y_ocn_B, G, CS%complete_ice_cover) + WindStr_x_ocn_B, WindStr_y_ocn_B, G, US, CS%complete_ice_cover) if (CS%debug) then call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G) @@ -504,12 +506,12 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I call SIS_B_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_B, IST%v_ice_B, & OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) else call SIS_B_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_B, IST%v_ice_B, & OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) endif call mpp_clock_end(iceClocka) @@ -573,16 +575,16 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) call enable_SIS_averaging(dt_slow_dyn, Time_cycle_start + real_to_time(nds*dt_slow_dyn), CS%diag) - call ice_cat_transport(CS%CAS, IST%TrReg, dt_slow_dyn, CS%adv_substeps, G, IG, CS%SIS_transport_CSp, & + call ice_cat_transport(CS%CAS, IST%TrReg, dt_slow_dyn, CS%adv_substeps, G, US, IG, CS%SIS_transport_CSp, & uc=IST%u_ice_C, vc=IST%v_ice_C) if (DS2d%nts==0) then if (CS%do_ridging) then - call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, IG, CS%SIS_transport_CSp, & + call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, US, IG, CS%SIS_transport_CSp, & rdg_rate=DS2d%avg_ridge_rate) DS2d%ridge_rate_count = 0. ; DS2d%avg_ridge_rate(:,:) = 0.0 else - call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, IG, CS%SIS_transport_CSp) + call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, US, IG, CS%SIS_transport_CSp) endif endif call mpp_clock_end(iceClock8) @@ -590,7 +592,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I endif ! (.not.CS%merged_cont) if (CS%column_check .and. (DS2d%nts==0)) & - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp, & message=" Post_transport")! , check_column=.true.) enddo ! nac = 1,nadv_cycle @@ -599,7 +601,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I call finish_ocean_top_stresses(IOF, G) ! Do diagnostics and update some information for the atmosphere. - call ice_state_cleanup(IST, OSS, IOF, dt_slow, G, IG, CS, tracer_CSp) + call ice_state_cleanup(IST, OSS, IOF, dt_slow, G, US, IG, CS, tracer_CSp) end subroutine SIS_dynamics_trans @@ -607,7 +609,7 @@ end subroutine SIS_dynamics_trans !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_multi_dyn_trans makes the calls to do ice dynamics and mass and tracer transport as !! appropriate for a dynamic and advective update cycle with multiple calls. -subroutine SIS_multi_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, IG, tracer_CSp, & +subroutine SIS_multi_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, US, IG, tracer_CSp, & start_cycle, end_cycle, cycle_length) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe @@ -618,6 +620,7 @@ subroutine SIS_multi_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, !! the ocean that are calculated by the ice model. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module type(icebergs), pointer :: icebergs_CS !< A control structure for the iceberg model. @@ -658,22 +661,22 @@ subroutine SIS_multi_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, ! Convert the category-resolved ice state into the simplified 2-d ice state. ! This should be called after a thermodynamic step or if ice_transport was called. if ((nac > 1) .or. cycle_start) & - call convert_IST_to_simple_state(IST, CS%DS2d, CS%CAS, G, IG, CS) + call convert_IST_to_simple_state(IST, CS%DS2d, CS%CAS, G, US, IG, CS) ! Update the category-merged dynamics and use the merged continuity equation. ! This could be called as many times as necessary. Time_cycle_start = CS%Time - real_to_time((nadv_cycle-(nac-1))*dt_adv_cycle) end_of_cycle = (nac < nadv_cycle) .or. cycle_end - call SIS_merged_dyn_cont(OSS, FIA, IOF, CS%DS2d, dt_adv_cycle, Time_cycle_start, G, IG, CS, & + call SIS_merged_dyn_cont(OSS, FIA, IOF, CS%DS2d, dt_adv_cycle, Time_cycle_start, G, US, IG, CS, & end_call=end_of_cycle) ! Complete the category-resolved mass and tracer transport and update the ice state type. ! This must be done before the next thermodynamic step. if (end_of_cycle) & - call complete_IST_transport(CS%DS2d, CS%CAS, IST, dt_adv_cycle, G, IG, CS) + call complete_IST_transport(CS%DS2d, CS%CAS, IST, dt_adv_cycle, G, US, IG, CS) if (CS%column_check .and. IST%valid_IST) & ! This is just here from early debugging exercises, - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp, & message=" Post_transport")! , check_column=.true.) enddo ! nac=0,nadv_cycle-1 @@ -683,19 +686,20 @@ subroutine SIS_multi_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, ! This must be done before returning control to the atmosphere and before writing any diagnostics. if (cycle_end) & - call ice_state_cleanup(IST, OSS, IOF, dt_diags, G, IG, CS, tracer_CSp) + call ice_state_cleanup(IST, OSS, IOF, dt_diags, G, US, IG, CS, tracer_CSp) end subroutine SIS_multi_dyn_trans !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Complete the category-resolved mass and tracer transport and update the ice state type. -subroutine complete_IST_transport(DS2d, CAS, IST, dt_adv_cycle, G, IG, CS) +subroutine complete_IST_transport(DS2d, CAS, IST, dt_adv_cycle, G, US, IG, CS) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(dyn_state_2d), intent(inout) :: DS2d !< A simplified 2-d description of the ice state !! integrated across thickness categories and layers. type(cell_average_state_type), intent(inout) :: CAS !< A structure with ocean-cell averaged masses. real, intent(in) :: dt_adv_cycle !< The time since the last IST transport [s]. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module @@ -708,17 +712,17 @@ subroutine complete_IST_transport(DS2d, CAS, IST, dt_adv_cycle, G, IG, CS) call mpp_clock_begin(iceClock8) ! Do the transport of mass and tracers by category and vertical layer. - call ice_cat_transport(CS%CAS, IST%TrReg, dt_adv_cycle, DS2d%nts, G, IG, & + call ice_cat_transport(CS%CAS, IST%TrReg, dt_adv_cycle, DS2d%nts, G, US, IG, & CS%SIS_transport_CSp, mca_tot=DS2d%mca_step(:,:,0:DS2d%nts), & uh_tot=DS2d%uh_step(:,:,1:DS2d%nts), vh_tot=DS2d%vh_step(:,:,1:DS2d%nts)) ! Convert the cell-averaged state back to the ice-state type, adjusting the ! category mass distributions, doing ridging, and updating the partition sizes. if (CS%do_ridging) then - call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, IG, CS%SIS_transport_CSp, & + call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, US, IG, CS%SIS_transport_CSp, & rdg_rate=DS2d%avg_ridge_rate) DS2d%ridge_rate_count = 0. ; DS2d%avg_ridge_rate(:,:) = 0.0 else - call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, IG, CS%SIS_transport_CSp) + call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, US, IG, CS%SIS_transport_CSp) endif DS2d%nts = 0 ! There is no outstanding transport to be done and IST is up-to-date. @@ -739,7 +743,7 @@ end subroutine complete_IST_transport !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Do final checks to set a consistent ice state and write diagnostics as appropriate. -subroutine ice_state_cleanup(IST, OSS, IOF, dt_slow, G, IG, CS, tracer_CSp) +subroutine ice_state_cleanup(IST, OSS, IOF, dt_slow, G, US, IG, CS, tracer_CSp) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. @@ -747,6 +751,7 @@ subroutine ice_state_cleanup(IST, OSS, IOF, dt_slow, G, IG, CS, tracer_CSp) !! the ocean that are calculated by the ice model. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module type(SIS_tracer_flow_control_CS), optional, pointer :: tracer_CSp !< The structure for controlling @@ -777,11 +782,11 @@ subroutine ice_state_cleanup(IST, OSS, IOF, dt_slow, G, IG, CS, tracer_CSp) if (CS%bounds_check) call IST_bounds_check(IST, G, IG, "End of ice_state_cleanup", OSS=OSS) if (CS%Time + real_to_time(0.5*dt_slow) > CS%write_ice_stats_time) then - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp, & tracer_CSp=tracer_CSp) CS%write_ice_stats_time = CS%write_ice_stats_time + CS%ice_stats_interval elseif (CS%column_check) then - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp) + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp) endif call mpp_clock_end(iceClock9) @@ -790,12 +795,13 @@ end subroutine ice_state_cleanup !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Convert the category-resolved ice state into the simplified 2-d ice state and a cell averaged state. -subroutine convert_IST_to_simple_state(IST, DS2d, CAS, G, IG, CS) +subroutine convert_IST_to_simple_state(IST, DS2d, CAS, G, US, IG, CS) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(dyn_state_2d), intent(inout) :: DS2d !< A simplified 2-d description of the ice state !! integrated across thickness categories and layers. type(cell_average_state_type), intent(inout) :: CAS !< A structure with ocean-cell averaged masses. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module @@ -838,7 +844,7 @@ subroutine convert_IST_to_simple_state(IST, DS2d, CAS, G, IG, CS) endif ! Determine the whole-cell averaged mass of snow and ice. - call ice_state_to_cell_ave_state(IST, G, IG, CS%SIS_transport_CSp, CAS) + call ice_state_to_cell_ave_state(IST, G, US, IG, CS%SIS_transport_CSp, CAS) IST%valid_IST = .false. @@ -849,7 +855,7 @@ end subroutine convert_IST_to_simple_state !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Update the category-merged ice state and call the merged continuity update. -subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, IG, CS, end_call) +subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, IG, CS, end_call) type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. type(fast_ice_avg_type), intent(in) :: FIA !< A type containing averages of fields @@ -861,6 +867,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, IG, real, intent(in) :: dt_cycle !< The slow ice dynamics timestep [s]. type(time_type), intent(in) :: TIme_start !< The starting time for this update cycle. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module logical, optional, intent(in) :: end_call !< If present and false, this call is @@ -932,7 +939,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, IG, ! This block of code must be executed if ice_cover and ice_free or the various wind ! stresses were updated. call set_wind_stresses_C(FIA, DS2d%ice_cover, ice_free, WindStr_x_Cu, WindStr_y_Cv, & - WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, CS%complete_ice_cover) + WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, US, CS%complete_ice_cover) if (CS%debug) then call uvchksum("Before SIS_C_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) @@ -951,7 +958,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, IG, if (CS%do_ridging) rdg_rate(:,:) = 0.0 call SIS_C_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_C, DS2d%v_ice_C, & OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, CS%SIS_C_dyn_CSp) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) call mpp_clock_end(iceClocka) if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) @@ -980,7 +987,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, IG, ! stresses were updated. call set_wind_stresses_B(FIA, DS2d%ice_cover, ice_free, WindStr_x_B, WindStr_y_B, & - WindStr_x_ocn_B, WindStr_y_ocn_B, G, CS%complete_ice_cover) + WindStr_x_ocn_B, WindStr_y_ocn_B, G, US, CS%complete_ice_cover) if (CS%debug) then call Bchksum_pair("[uv]_ice_B before dynamics", DS2d%u_ice_B, DS2d%v_ice_B, G) @@ -997,7 +1004,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, IG, call SIS_B_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_B, DS2d%v_ice_B, & OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) call mpp_clock_end(iceClocka) if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, G) @@ -1056,15 +1063,15 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, IG, if ((n < ndyn_steps*CS%adv_substeps) .or. continuing_call) then ! Some of the work is not needed for the last step before cat_ice_transport. call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & - DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, IG, CS%continuity_CSp, & + DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp, & h_ice=DS2d%mi_sum) - call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, dt_adv, G, IG, CS%cover_trans_CSp) + call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, dt_adv, G, US, IG, CS%cover_trans_CSp) call pass_var(DS2d%mi_sum, G%Domain, complete=.false.) call pass_var(DS2d%ice_cover, G%Domain, complete=.false.) call pass_var(DS2d%mca_step(:,:,n), G%Domain, complete=.true.) else call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & - DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, IG, CS%continuity_CSp) + DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp) endif enddo DS2d%nts = DS2d%nts + CS%adv_substeps @@ -1076,7 +1083,7 @@ end subroutine SIS_merged_dyn_cont !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> slab_ice_dynamics_trans makes the calls to do the slab ice version of dynamics and mass and tracer transport -subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, IG, tracer_CSp) +subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer_CSp) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe @@ -1087,6 +1094,7 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, IG, tracer_CSp !! the ocean that are calculated by the ice model. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module type(SIS_tracer_flow_control_CS), pointer :: tracer_CSp !< The structure for controlling calls to @@ -1160,7 +1168,7 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, IG, tracer_CSp ! This block of code must be executed if ice_cover and ice_free or the various wind ! stresses were updated. call set_wind_stresses_C(FIA, IST%part_size(:,:,1), IST%part_size(:,:,0), WindStr_x_Cu, WindStr_y_Cv, & - WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, CS%complete_ice_cover) + WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, US, CS%complete_ice_cover) if (CS%debug) then call uvchksum("Before SIS_C_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) @@ -1209,7 +1217,7 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, IG, tracer_CSp ! stresses were updated. call set_wind_stresses_B(FIA, IST%part_size(:,:,1), IST%part_size(:,:,0), WindStr_x_B, WindStr_y_B, & - WindStr_x_ocn_B, WindStr_y_ocn_B, G, CS%complete_ice_cover) + WindStr_x_ocn_B, WindStr_y_ocn_B, G, US, CS%complete_ice_cover) if (CS%debug) then call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G) @@ -1273,17 +1281,17 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, IG, tracer_CSp call enable_SIS_averaging(dt_slow_dyn, CS%Time - real_to_time((ndyn_steps-nds)*dt_slow_dyn), CS%diag) call slab_ice_advect(IST%u_ice_C, IST%v_ice_C, IST%mH_ice(:,:,1), 4.0*IG%kg_m2_to_H, & - dt_slow_dyn, G, IST%part_size(:,:,1), nsteps=CS%adv_substeps) + dt_slow_dyn, G, US, IST%part_size(:,:,1), nsteps=CS%adv_substeps) call mpp_clock_end(iceClock8) if (CS%column_check) & - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp, & message=" Post_transport")! , check_column=.true.) enddo ! nds=1,ndyn_steps call finish_ocean_top_stresses(IOF, G) - call ice_state_cleanup(IST, OSS, IOF, dt_slow, G, IG, CS, tracer_CSp) + call ice_state_cleanup(IST, OSS, IOF, dt_slow, G, US, IG, CS, tracer_CSp) end subroutine slab_ice_dyn_trans @@ -1804,7 +1812,7 @@ end subroutine set_ocean_top_stress_C2 !> set_wind_stresses_C determines the wind stresses on the ice and open ocean with !! a C-grid staggering of the points. subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y_Cv, & - WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, max_ice_cover) + WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, US, max_ice_cover) type(fast_ice_avg_type), intent(in) :: FIA !< A type containing averages of fields !! (mostly fluxes) over the fast updates type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type @@ -1818,6 +1826,7 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y real, dimension(SZI_(G),SZJB_(G)), intent(out) :: & WindStr_y_Cv, & !< Meridional wind stress averaged over the ice categores on C-grid v-points [Pa]. WindStr_y_ocn_Cv !< Meridional wind stress on the ice-free ocean on C-grid v-points [Pa]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, intent(in) :: max_ice_cover !< The fractional ice coverage !! that is close enough to 1 to be complete for the purpose of calculating !! wind stresses [nondim]. @@ -1872,18 +1881,18 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y !$OMP parallel default(shared) private(weights,I_wts) !$OMP do do j=jsc-1,jec+1 ; do I=isc-1,iec - weights = (G%areaT(i,j)*ice_cover(i,j) + G%areaT(i+1,j)*ice_cover(i+1,j)) + weights = US%L_to_m**2*(G%areaT(i,j)*ice_cover(i,j) + G%areaT(i+1,j)*ice_cover(i+1,j)) if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_x_Cu(I,j) = G%mask2dCu(I,j) * & + WindStr_x_Cu(I,j) = G%mask2dCu(I,j) *US%L_to_m**2* & (G%areaT(i,j) * ice_cover(i,j) * WindStr_x_A(i,j) + & G%areaT(i+1,j)*ice_cover(i+1,j)*WindStr_x_A(i+1,j)) * I_wts else WindStr_x_Cu(I,j) = 0.0 endif - weights = (G%areaT(i,j)*ice_free(i,j) + G%areaT(i+1,j)*ice_free(i+1,j)) + weights = US%L_to_m**2*(G%areaT(i,j)*ice_free(i,j) + G%areaT(i+1,j)*ice_free(i+1,j)) if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_x_ocn_Cu(I,j) = G%mask2dCu(I,j) * & + WindStr_x_ocn_Cu(I,j) = G%mask2dCu(I,j) *US%L_to_m**2* & (G%areaT(i,j) * ice_free(i,j) * WindStr_x_ocn_A(i,j) + & G%areaT(i+1,j)*ice_free(i+1,j)*WindStr_x_ocn_A(i+1,j)) * I_wts else @@ -1893,18 +1902,18 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y !$OMP end do nowait !$OMP do do J=jsc-1,jec ; do i=isc-1,iec+1 - weights = (G%areaT(i,j)*ice_cover(i,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) + weights = US%L_to_m**2*(G%areaT(i,j)*ice_cover(i,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) if (G%mask2dCv(i,J) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_y_Cv(i,J) = G%mask2dCv(i,J) * & + WindStr_y_Cv(i,J) = G%mask2dCv(i,J) *US%L_to_m**2* & (G%areaT(i,j) * ice_cover(i,j) * WindStr_y_A(i,j) + & G%areaT(i,j+1)*ice_cover(i,j+1)*WindStr_y_A(i,j+1)) * I_wts else WindStr_y_Cv(i,J) = 0.0 endif - weights = (G%areaT(i,j)*ice_free(i,j) + G%areaT(i,j+1)*ice_free(i,j+1)) + weights = US%L_to_m**2*(G%areaT(i,j)*ice_free(i,j) + G%areaT(i,j+1)*ice_free(i,j+1)) if (weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_y_ocn_Cv(i,J) = G%mask2dCv(i,J) * & + WindStr_y_ocn_Cv(i,J) = G%mask2dCv(i,J) *US%L_to_m**2* & (G%areaT(i,j) * ice_free(i,j) * WindStr_y_ocn_A(i,j) + & G%areaT(i,j+1)*ice_free(i,j+1)*WindStr_y_ocn_A(i,j+1)) * I_wts else @@ -1920,7 +1929,7 @@ end subroutine set_wind_stresses_C !> set_wind_stresses_B determines the wind stresses on the ice and open ocean with !! a B-grid staggering of the points. subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_B, & - WindStr_x_ocn_B, WindStr_y_ocn_B, G, max_ice_cover) + WindStr_x_ocn_B, WindStr_y_ocn_B, G, US, max_ice_cover) type(fast_ice_avg_type), intent(in) :: FIA !< A type containing averages of fields !! (mostly fluxes) over the fast updates type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type @@ -1933,6 +1942,7 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ WindStr_y_B, & !< averaged over the ice categories on a B-grid [Pa]. WindStr_x_ocn_B, & !< Zonal wind stress on the ice-free ocean on a B-grid [Pa]. WindStr_y_ocn_B !< Meridional wind stress on the ice-free ocean on a B-grid [Pa]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, intent(in) :: max_ice_cover !< The fractional ice coverage !! that is close enough to 1 to be complete for the purpose of calculating !! wind stresses [nondim]. @@ -1984,30 +1994,30 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ !$OMP parallel do default(shared) private(weights,I_wts) do J=jsc-1,jec ; do I=isc-1,iec ; if (G%mask2dBu(I,J) > 0.0) then - weights = ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1) + G%areaT(i,j)*ice_cover(i,j)) + & + weights = US%L_to_m**2*((G%areaT(i+1,j+1)*ice_cover(i+1,j+1) + G%areaT(i,j)*ice_cover(i,j)) + & (G%areaT(i+1,j)*ice_cover(i+1,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_B(I,J) = G%mask2dBu(I,J) * & + WindStr_x_B(I,J) = G%mask2dBu(I,J) *US%L_to_m**2* & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_x_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_x_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_x_A(i+1,j) + & G%areaT(i,j+1) * ice_cover(i,j+1) * WindStr_x_A(i,j+1)) ) * I_wts - WindStr_y_B(I,J) = G%mask2dBu(I,J) * & + WindStr_y_B(I,J) = G%mask2dBu(I,J) *US%L_to_m**2* & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_y_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_y_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_y_A(i+1,j) + & G%areaT(i,j+1) * ice_cover(i,j+1) * WindStr_y_A(i,j+1)) ) * I_wts - weights = ((G%areaT(i+1,j+1)*ice_free(i+1,j+1) + G%areaT(i,j)*ice_free(i,j)) + & + weights = US%L_to_m**2*((G%areaT(i+1,j+1)*ice_free(i+1,j+1) + G%areaT(i,j)*ice_free(i,j)) + & (G%areaT(i+1,j)*ice_free(i+1,j) + G%areaT(i,j+1)*ice_free(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * & + WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * US%L_to_m**2*& ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_x_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_x_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_x_ocn_A(i+1,j) + & G%areaT(i,j+1) * ice_free(i,j+1) * WindStr_x_ocn_A(i,j+1)) ) * I_wts - WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) * & + WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) *US%L_to_m**2* & ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_y_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_y_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_y_ocn_A(i+1,j) + & diff --git a/src/SIS_fixed_initialization.F90 b/src/SIS_fixed_initialization.F90 index d377a609..3df873a4 100644 --- a/src/SIS_fixed_initialization.F90 +++ b/src/SIS_fixed_initialization.F90 @@ -20,6 +20,7 @@ module SIS_fixed_initialization use MOM_shared_initialization, only : reset_face_lengths_named, reset_face_lengths_file, reset_face_lengths_list use MOM_shared_initialization, only : read_face_length_list, set_velocity_depth_max, set_velocity_depth_min use MOM_shared_initialization, only : compute_global_grid_integrals, write_ocean_geometry_file +use MOM_unit_scaling, only : unit_scale_type use netcdf @@ -32,8 +33,9 @@ module SIS_fixed_initialization !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_initialize_fixed sets up time-invariant quantities related to SIS's !! horizontal grid, bathymetry, restricted channel widths and the Coriolis parameter. -subroutine SIS_initialize_fixed(G, PF, write_geom, output_dir) +subroutine SIS_initialize_fixed(G, US, PF, write_geom, output_dir) type(dyn_horgrid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: write_geom !< If true, write grid geometry files. @@ -60,7 +62,7 @@ subroutine SIS_initialize_fixed(G, PF, write_geom, output_dir) inputdir = slasher(inputdir) ! Set up the parameters of the physical domain (i.e. the grid), G - call set_grid_metrics(G, PF) + call set_grid_metrics(G, PF, US) ! Set up the bottom depth, G%bathyT, either analytically or from a file call SIS_initialize_topography(G%bathyT, G%max_depth, G, PF) @@ -95,9 +97,9 @@ subroutine SIS_initialize_fixed(G, PF, write_geom, output_dir) default="none") select case ( trim(config) ) case ("none") - case ("list") ; call reset_face_lengths_list(G, PF) - case ("file") ; call reset_face_lengths_file(G, PF) - case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config)) + case ("list") ; call reset_face_lengths_list(G, PF, US) + case ("file") ; call reset_face_lengths_file(G, PF, US) + case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config), US) case default ; call MOM_error(FATAL, "SIS_initialize_fixed: "// & "Unrecognized channel configuration "//trim(config)) end select @@ -110,8 +112,8 @@ subroutine SIS_initialize_fixed(G, PF, write_geom, output_dir) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G) if (debug) then call Bchksum(G%CoriolisBu, "SIS_initialize_fixed: f ", G%HI) - call hchksum(G%dF_dx, "SIS_initialize_fixed: dF_dx ", G%HI) - call hchksum(G%dF_dy, "SIS_initialize_fixed: dF_dy ", G%HI) + call hchksum(G%dF_dx, "SIS_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L) + call hchksum(G%dF_dy, "SIS_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/SIS_hor_grid.F90 b/src/SIS_hor_grid.F90 index fa296aeb..14240cd4 100644 --- a/src/SIS_hor_grid.F90 +++ b/src/SIS_hor_grid.F90 @@ -16,6 +16,7 @@ module SIS_hor_grid use MOM_domains, only : MOM_domains_init, clone_MOM_domain use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, SIS_mesg=>MOM_mesg use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -75,12 +76,12 @@ module SIS_hor_grid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. - dxT, & !< dxT is delta x at h points [m]. - IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m], and IdyT is 1/dyT [m-1]. - IdyT, & !< dyT is delta y at h points [m], and IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. - IareaT !< 1/areaT [m-2]. + dxT, & !< dxT is delta x at h points [L ~> m]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. + dyT, & !< dyT is delta y at h points [L ~> m]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. + areaT, & !< The area of an h-cell [L2 ~> m2]. + IareaT !< 1/areaT [L-2 ~> m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: sin_rot !< The sine of the angular rotation between the local model grid northward !! and the true northward directions. @@ -92,36 +93,36 @@ module SIS_hor_grid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. - dxCu, & !< dxCu is delta x at u points [m]. - IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. - IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell in m. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. - areaCu !< The areas of the u-grid cells [m2]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. - dxCv, & !< dxCv is delta x at v points [m]. - IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. - IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell in m. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. - areaCv !< The areas of the v-grid cells [m2]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. - dxBu, & !< dxBu is delta x at q points [m]. - IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. - IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. + areaBu, & !< areaBu is the area of a q-cell [L2 ~> m2] + IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: gridLatT => NULL() !< The latitude of T points for the purpose of labeling the output axes. @@ -145,10 +146,12 @@ module SIS_hor_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points [s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 L-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m s-2]. + type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type + ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE type(hor_index_type), pointer :: Block(:) => NULL() !< Index ranges for each block diff --git a/src/SIS_slow_thermo.F90 b/src/SIS_slow_thermo.F90 index ac29f68b..c9ecfa06 100644 --- a/src/SIS_slow_thermo.F90 +++ b/src/SIS_slow_thermo.F90 @@ -33,6 +33,7 @@ module SIS_slow_thermo use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type +use MOM_unit_scaling, only : unit_scale_type use MOM_EOS, only : EOS_type, calculate_density_derivs use coupler_types_mod, only : coupler_type_spawn, coupler_type_initialized @@ -303,7 +304,7 @@ end subroutine post_flux_diagnostics !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> slow_thermodynamics takes care of slow ice thermodynamics and mass changes -subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, IG) +subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, US, IG) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice real, intent(in) :: dt_slow !< The thermodynamic step [s]. @@ -318,6 +319,7 @@ subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, IG) type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type ! Local variables @@ -363,7 +365,7 @@ subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, IG) call mpp_clock_begin(iceClock7) call accumulate_input_1(IST, FIA, OSS, dt_slow, G, IG, CS%sum_output_CSp) if (CS%column_check) & - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp, & message=" SIS_slow_thermo", check_column=.true.) call mpp_clock_end(iceClock7) @@ -467,13 +469,13 @@ subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, IG) if (associated(XSF)) call add_excess_fluxes(IOF, XSF, G) if (CS%column_check) & - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp, & message=" Post_thermo A", check_column=.true.) call adjust_ice_categories(IST%mH_ice, IST%mH_snow, IST%mH_pond, IST%part_size, & IST%TrReg, G, IG, CS%SIS_transport_CSp) !Niki: add ridging? if (CS%column_check) & - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp, & message=" Post_thermo B ", check_column=.true.) end subroutine slow_thermodynamics diff --git a/src/SIS_sum_output.F90 b/src/SIS_sum_output.F90 index b8e6b6b2..d6d0cb1e 100644 --- a/src/SIS_sum_output.F90 +++ b/src/SIS_sum_output.F90 @@ -24,6 +24,7 @@ module SIS_sum_output use MOM_string_functions, only : slasher use MOM_time_manager, only : time_type, get_time, operator(>), operator(-) use MOM_time_manager, only : get_date, get_calendar_type, NO_CALENDAR +use MOM_unit_scaling, only : unit_scale_type use SIS_types, only : ice_state_type, ice_ocean_flux_type, fast_ice_avg_type use SIS_types, only : ocean_sfc_state_type use SIS_hor_grid, only : SIS_hor_grid_type @@ -205,11 +206,12 @@ end subroutine SIS_sum_output_end !> Write out the sea ice statistics of the total sea-ice mass, heat and salt by !! hemisphere and other globally integrated quantities. -subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, tracer_CSp) +subroutine write_ice_statistics(IST, day, n, G, US, IG, CS, message, check_column, tracer_CSp) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(time_type), intent(inout) :: day !< The current model time. integer, intent(in) :: n !< The time step number of the current execution type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(SIS_sum_out_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_sum_output_init @@ -428,7 +430,7 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t do j=js,je ; do i=is,ie hem = 1 ; if (G%geolatT(i,j) < 0.0) hem = 2 do k=1,ncat ; if (G%mask2dT(i,j) * IST%part_size(i,j,k) > 0.0) then - area_pt = G%areaT(i,j) * G%mask2dT(i,j) * IST%part_size(i,j,k) + area_pt = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) * IST%part_size(i,j,k) ice_area(i,j,hem) = ice_area(i,j,hem) + area_pt col_mass(i,j,hem) = col_mass(i,j,hem) + area_pt * IG%H_to_kg_m2 * & @@ -446,11 +448,11 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t enddo endif ; enddo if (allocated(IST%snow_to_ocn)) then ; if (IST%snow_to_ocn(i,j) > 0.0) then - area_pt = G%areaT(i,j) * G%mask2dT(i,j) + area_pt = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) col_mass(i,j,hem) = col_mass(i,j,hem) + area_pt * IST%snow_to_ocn(i,j) col_heat(i,j,hem) = col_heat(i,j,hem) + area_pt * (IST%snow_to_ocn(i,j) * IST%enth_snow_to_ocn(i,j)) endif ; endif - if (ice_area(i,j,hem) > 0.1*G%AreaT(i,j)) ice_extent(i,j,hem) = G%AreaT(i,j) + if (ice_area(i,j,hem) > 0.1*US%L_to_m**2*G%areaT(i,j)) ice_extent(i,j,hem) = US%L_to_m**2*G%areaT(i,j) enddo ; enddo Area = reproducing_sum(ice_area, sums=Area_NS) @@ -471,24 +473,24 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t if (IST%Cgrid_dyn) then if (allocated(IST%u_ice_C)) then ; do j=js,je ; do I=is-1,ie if (IST%u_ice_C(I,j) < 0.0) then - CFL_trans = (-IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i+1,j)) else - CFL_trans = (IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i,j)) endif max_CFL = max(max_CFL, CFL_trans) enddo ; enddo ; endif if (allocated(IST%v_ice_C)) then ; do J=js-1,je ; do i=is,ie if (IST%v_ice_C(i,J) < 0.0) then - CFL_trans = (-IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j+1)) else - CFL_trans = (IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j)) endif max_CFL = max(max_CFL, CFL_trans) enddo ; enddo ; endif elseif (allocated(IST%u_ice_B) .and. allocated(IST%v_ice_B)) then do J=js-1,je ; do I=is-1,ie - CFL_u = abs(IST%u_ice_B(I,J)) * dt_CFL * G%IdxBu(I,J) - CFL_v = abs(IST%v_ice_B(I,J)) * dt_CFL * G%IdyBu(I,J) + CFL_u = abs(IST%u_ice_B(I,J)) * dt_CFL * US%m_to_L * G%IdxBu(I,J) + CFL_v = abs(IST%v_ice_B(I,J)) * dt_CFL * US%m_to_L * G%IdyBu(I,J) max_CFL = max(max_CFL, CFL_u, CFL_v) enddo ; enddo endif @@ -507,7 +509,7 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t CS%heat_prev_EFP = heat_EFP ; CS%net_heat_in_EFP = real_to_EFP(0.0) else do j=js,je ; do i=is,ie - area_h = G%areaT(i,j) * G%mask2dT(i,j) + area_h = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) CS%water_in_col(i,j) = area_h * CS%water_in_col(i,j) CS%heat_in_col(i,j) = area_h * CS%heat_in_col(i,j) CS%salt_in_col(i,j) = area_h * CS%salt_in_col(i,j) diff --git a/src/SIS_tracer_advect.F90 b/src/SIS_tracer_advect.F90 index fd530512..1a7afa66 100644 --- a/src/SIS_tracer_advect.F90 +++ b/src/SIS_tracer_advect.F90 @@ -10,6 +10,7 @@ module SIS_tracer_advect use MOM_domains, only : pass_var, pass_vector, sum_across_PEs, max_across_PEs use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, SIS_mesg=>MOM_mesg use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type use SIS_hor_grid, only : SIS_hor_grid_type use ice_grid, only : ice_grid_type use SIS_tracer_registry, only : SIS_tracer_registry_type, SIS_tracer_type, SIS_tracer_chksum @@ -44,7 +45,7 @@ module SIS_tracer_advect contains !> advect_SIS_tracers manages the advection of either the snow or ice tracers -subroutine advect_SIS_tracers(h_prev, h_end, uhtr, vhtr, dt, G, IG, CS, TrReg, snow_tr ) ! (, OBC) +subroutine advect_SIS_tracers(h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS, TrReg, snow_tr ) ! (, OBC) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & @@ -60,6 +61,7 @@ subroutine advect_SIS_tracers(h_prev, h_end, uhtr, vhtr, dt, G, IG, CS, TrReg, s intent(in) :: vhtr !< Accumulated volume or mass fluxes through !! meridional faces [H m2 s-1 ~> kg s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_tracer_advect_init. type(SIS_tracer_registry_type), pointer :: TrReg !< A pointer to the SIS tracer registry. @@ -80,15 +82,15 @@ subroutine advect_SIS_tracers(h_prev, h_end, uhtr, vhtr, dt, G, IG, CS, TrReg, s call cpu_clock_begin(id_clock_advect) if (snow_tr) then if (CS%use_upwind2d) then - call advect_upwind_2d(TrReg%Tr_snow, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG) + call advect_upwind_2d(TrReg%Tr_snow, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) else - call advect_tracer(TrReg%Tr_snow, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) + call advect_tracer(TrReg%Tr_snow, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) endif else if (CS%use_upwind2d) then - call advect_upwind_2d(TrReg%Tr_ice, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG) + call advect_upwind_2d(TrReg%Tr_ice, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) else - call advect_tracer(TrReg%Tr_ice, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) + call advect_tracer(TrReg%Tr_ice, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) endif endif call cpu_clock_end(id_clock_advect) @@ -97,7 +99,7 @@ end subroutine advect_SIS_tracers !> This subroutine time steps the tracer concentrations using a monotonic, conservative, !! weakly diffusive scheme. -subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, OBC) +subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) ! (, OBC) type(SIS_tracer_type), dimension(ntr), & intent(inout) :: Tr !< The tracer concentrations being advected type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type @@ -116,6 +118,7 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, !! meridional faces [H m2 s-1 ~> kg s-1]. real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: ntr !< The number of tracers to advect + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_tracer_advect_init. ! type(ocean_OBC_type), pointer :: OBC ! < This open boundary condition type specifies @@ -192,10 +195,10 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, ! bit of extra mass to avoid nonsensical tracer concentrations. This will ! lead rarely to a very slight non-conservation of tracers, but not mass. do j=js,je; do i=is,ie - hprev(i,j,k) = G%areaT(i,j) * (h_prev(i,j,k) + & + hprev(i,j,k) = US%L_to_m**2*G%areaT(i,j) * (h_prev(i,j,k) + & max(0.0, 1.0e-13*h_prev(i,j,k) - h_end(i,j,k))) if (h_end(i,j,k) - h_prev(i,j,k) + ((uhr(I,j,k) - uhr(I-1,j,k)) + & - (vhr(i,J,k) - vhr(i,J-1,k))) * G%IareaT(i,j) > & + (vhr(i,J,k) - vhr(i,J-1,k))) * US%m_to_L**2*G%IareaT(i,j) > & 1e-10*(h_end(i,j,k) + h_prev(i,j,k))) then !$OMP critical call SIS_error(WARNING, "Apparently inconsistent h_prev, h_end, uhr and vhr in advect_tracer.") @@ -206,12 +209,12 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, !$OMP end do nowait !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect(I,j) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) enddo ; enddo !$OMP end do nowait !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect(i,J) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) enddo ; enddo !$OMP end do nowait !$OMP do @@ -304,12 +307,12 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, if (x_first) then ! First, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & - isv, iev, jsv-stensil, jev+stensil, k, G, IG, & + isv, iev, jsv-stensil, jev+stensil, k, G, US, IG, & CS%usePPM, CS%usePCM) !(, OBC) ! Next, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & - isv, iev, jsv, jev, k, G, IG, CS%usePPM, CS%usePCM) !(, OBC) + isv, iev, jsv, jev, k, G, US, IG, CS%usePPM, CS%usePCM) !(, OBC) domore_k(k) = 0 do j=jsv-stensil,jev+stensil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -317,12 +320,12 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, else ! First, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & - isv-stensil, iev+stensil, jsv, jev, k, G, IG, & + isv-stensil, iev+stensil, jsv, jev, k, G, US, IG, & CS%usePPM, CS%usePCM) !(, OBC) ! Next, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & - isv, iev, jsv, jev, k, G, IG, CS%usePPM, CS%usePCM) !(, OBC) + isv, iev, jsv, jev, k, G, US, IG, CS%usePPM, CS%usePCM) !(, OBC) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -349,7 +352,7 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, end subroutine advect_tracer !> advect_scalar does advection of a single scalar tracer field. -subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, IG, CS) ! (, OBC) +subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS) ! (, OBC) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & @@ -367,6 +370,7 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, IG, CS) ! (, intent(in) :: vhtr !< Accumulated volume or mass fluxes through !! meridional faces [H m2 s-1 ~> kg s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_tracer_advect_init. @@ -428,9 +432,9 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, IG, CS) ! (, enddo ; enddo do j=js,je ; do i=is,ie - vol_end = (G%areaT(i,j) * h_end(i,j,k)) + vol_end = (US%L_to_m**2*G%areaT(i,j) * h_end(i,j,k)) Ivol_end = 0.0 ; if (vol_end > 0.0) Ivol_end = 1.0 / vol_end - scalar(i,j,k) = ( (G%areaT(i,j)*h_prev(i,j,k))*scalar(i,j,k) - & + scalar(i,j,k) = ( (US%L_to_m**2*G%areaT(i,j)*h_prev(i,j,k))*scalar(i,j,k) - & ((flux_U2d_x(I,j) - flux_U2d_x(I-1,j)) + & (flux_U2d_y(i,J) - flux_U2d_y(i,J-1))) ) * Ivol_end enddo ; enddo @@ -472,10 +476,10 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, IG, CS) ! (, ! bit of extra mass to avoid nonsensical tracer concentrations. This will ! lead rarely to a very slight non-conservation of tracers, but not mass. do i=is,ie ; do j=js,je - hprev(i,j,k) = G%areaT(i,j) * (h_prev(i,j,k) + & + hprev(i,j,k) = US%L_to_m**2*G%areaT(i,j) * (h_prev(i,j,k) + & max(0.0, 1.0e-13*h_prev(i,j,k) - h_end(i,j,k))) if (h_end(i,j,k) - h_prev(i,j,k) + ((uhr(I,j,k) - uhr(I-1,j,k)) + & - (vhr(i,J,k) - vhr(i,J-1,k))) * G%IareaT(i,j) > & + (vhr(i,J,k) - vhr(i,J-1,k))) * US%m_to_L**2*G%IareaT(i,j) > & 1e-10*(h_end(i,j,k) + h_prev(i,j,k))) then !$OMP critical call SIS_error(WARNING, "Apparently inconsistent h_prev, h_end, uhr and vhr in advect_tracer.") @@ -486,12 +490,12 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, IG, CS) ! (, !$OMP end do nowait !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect(I,j) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) enddo ; enddo !$OMP end do nowait !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect(i,J) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) enddo ; enddo !$OMP end parallel @@ -552,11 +556,11 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, IG, CS) ! (, if (x_first) then ! First, advect zonally. call advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & - isv, iev, jsv-stensil, jev+stensil, k, G, IG, CS%usePPM, CS%usePCM) !(, OBC) + isv, iev, jsv-stensil, jev+stensil, k, G, US, IG, CS%usePPM, CS%usePCM) !(, OBC) ! Next, advect meridionally. call advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & - isv, iev, jsv, jev, k, G, IG, CS%usePPM, CS%usePCM) !(, OBC) + isv, iev, jsv, jev, k, G, US, IG, CS%usePPM, CS%usePCM) !(, OBC) domore_k(k) = 0 do j=jsv-stensil,jev+stensil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -564,11 +568,11 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, IG, CS) ! (, else ! First, advect meridionally. call advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & - isv-stensil, iev+stensil, jsv, jev, k, G, IG, CS%usePPM, CS%usePCM) !(, OBC) + isv-stensil, iev+stensil, jsv, jev, k, G, US, IG, CS%usePPM, CS%usePCM) !(, OBC) ! Next, advect zonally. call advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & - isv, iev, jsv, jev, k, G, IG, CS%usePPM, CS%usePCM) !(, OBC) + isv, iev, jsv, jev, k, G, US, IG, CS%usePPM, CS%usePCM) !(, OBC) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -598,7 +602,7 @@ end subroutine advect_scalar !> advect_scalar_x does 1-d flux-form advection in the x-direction !! using a monotonic piecewise constant, linear, or parabolic scheme. subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & - is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) + is, ie, js, je, k, G, US, IG, usePPM, usePCM) ! (, OBC) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & @@ -622,6 +626,7 @@ subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The thickness category to work on + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors logical, intent(in) :: usePPM !< If true, use PPM tracer advection instead of PLM. logical, intent(in) :: usePCM !< If true, use PCM tracer advection instead of PLM. ! This subroutine does 1-d flux-form advection in the zonal direction using @@ -710,17 +715,17 @@ subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & haddW(i) = 0.0 ; haddE(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*G%areaT(i,j)) then + elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then ! Add a bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*G%areaT(i,j) - hnew + h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(uhh(I)) + abs(uhh(I-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddW(i) = h_add * (abs(uhh(I-1))*I_htot) haddE(i) = h_add * (abs(uhh(I))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -743,7 +748,7 @@ end subroutine advect_scalar_x !> advect_x does 1-d flux-form advection of multiple tracers in the x-direction !! using a monotonic piecewise constant, linear, or parabolic scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & - is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) + is, ie, js, je, k, G, US, IG, usePPM, usePCM) ! (, OBC) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_tracer_type), dimension(ntr), & @@ -769,6 +774,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The thickness category to work on + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors logical, intent(in) :: usePPM !< If true, use PPM tracer advection instead of PLM. logical, intent(in) :: usePCM !< If true, use PCM tracer advection instead of PLM. ! This subroutine does 1-d flux-form advection in the zonal direction using @@ -865,17 +871,17 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & haddW(i) = 0.0 ; haddE(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*G%areaT(i,j)) then + elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then ! Add a bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*G%areaT(i,j) - hnew + h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(uhh(I)) + abs(uhh(I-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddW(i) = h_add * (abs(uhh(I-1))*I_htot) haddE(i) = h_add * (abs(uhh(I))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -1071,7 +1077,7 @@ end subroutine kernel_PPMH3_Tr_x !> advect_scalar_y does 1-d flux-form advection in the y-direction using a !! monotonic piecewise constant, linear, or parabolic scheme. subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & - is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) + is, ie, js, je, k, G, US, IG, usePPM, usePCM) ! (, OBC) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & @@ -1095,6 +1101,7 @@ subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The thickness category to work on + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors logical, intent(in) :: usePPM !< If true, use PPM tracer advection instead of PLM. logical, intent(in) :: usePCM !< If true, use PCM tracer advection instead of PLM. ! This subroutine does 1-d flux-form advection using a monotonic piecewise linear scheme. @@ -1192,17 +1199,17 @@ subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & haddS(i) = 0.0 ; haddN(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*G%areaT(i,j)) then + elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then ! Add a tiny bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*G%areaT(i,j) - hnew + h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(vhh(i,J)) + abs(vhh(i,J-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddS(i) = h_add * (abs(vhh(i,J-1))*I_htot) haddN(i) = h_add * (abs(vhh(i,J))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -1224,7 +1231,7 @@ end subroutine advect_scalar_y !> advect_y does 1-d flux-form advection of multiple tracers in the y-direction !! using a monotonic piecewise constant, linear, or parabolic scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & - is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) + is, ie, js, je, k, G, US, IG, usePPM, usePCM) ! (, OBC) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_tracer_type), dimension(ntr), & @@ -1250,6 +1257,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The thickness category to work on + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors logical, intent(in) :: usePPM !< If true, use PPM tracer advection instead of PLM. logical, intent(in) :: usePCM !< If true, use PCM tracer advection instead of PLM. ! This subroutine does 1-d flux-form advection using a monotonic piecewise @@ -1350,17 +1358,17 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & haddS(i) = 0.0 ; haddN(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*G%areaT(i,j)) then + elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then ! Add a tiny bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*G%areaT(i,j) - hnew + h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(vhh(i,J)) + abs(vhh(i,J-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddS(i) = h_add * (abs(vhh(i,J-1))*I_htot) haddN(i) = h_add * (abs(vhh(i,J))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -1572,7 +1580,7 @@ end subroutine kernel_PPMH3_Tr_y !> Advect tracers laterally within their categories using 2-d upwind advection. -subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG) +subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_tracer_type), dimension(ntr), & @@ -1591,6 +1599,7 @@ subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG) !! meridional faces [H m2 s-1 ~> kg s-1]. real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: ntr !< The number of tracers to advect + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, dimension(SZIB_(G),SZJ_(G)) :: flux_x ! x-direction tracer fluxes [Conc kg] real, dimension(SZI_(G),SZJB_(G)) :: flux_y ! y-direction tracer fluxes [Conc kg] @@ -1604,7 +1613,7 @@ subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG) ! Reconstruct the old value of h ??? ! if (h_prev(i,j,k) > 0.0) then - ! h_last(i,j,k) = h_end(i,j,k) + dt * G%IareaT(i,j) * & + ! h_last(i,j,k) = h_end(i,j,k) + dt * US%m_to_L**2*G%IareaT(i,j) * & ! ((uh(I,j,k) - uh(I-1,j,k)) + (vh(i,J,k) - vh(i,J-1,k))) ! For now this is just non-directionally split upwind advection. @@ -1622,9 +1631,9 @@ subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG) enddo ; enddo do j=js,je ; do i=is,ie - vol_end = (G%areaT(i,j) * h_end(i,j,k)) + vol_end = (US%L_to_m**2*G%areaT(i,j) * h_end(i,j,k)) Ivol_end = 0.0 ; if (vol_end > 0.0) Ivol_end = 1.0 / vol_end - Tr(m)%t(i,j,k,l) = ( (G%areaT(i,j)*h_prev(i,j,k))*Tr(m)%t(i,j,k,l) - & + Tr(m)%t(i,j,k,l) = ( (US%L_to_m**2*G%areaT(i,j)*h_prev(i,j,k))*Tr(m)%t(i,j,k,l) - & ((flux_x(I,j) - flux_x(I-1,j)) + & (flux_y(i,J) - flux_y(i,J-1))) ) * Ivol_end enddo ; enddo diff --git a/src/SIS_transport.F90 b/src/SIS_transport.F90 index a94b5850..3c69add0 100644 --- a/src/SIS_transport.F90 +++ b/src/SIS_transport.F90 @@ -10,6 +10,7 @@ module SIS_transport use MOM_file_parser, only : get_param, log_param, read_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type use MOM_obsolete_params, only : obsolete_logical, obsolete_real +use MOM_unit_scaling, only : unit_scale_type use SIS_continuity, only : SIS_continuity_init, SIS_continuity_end use SIS_continuity, only : continuity=>ice_continuity, SIS_continuity_CS use SIS_continuity, only : summed_continuity, proportionate_continuity @@ -106,7 +107,7 @@ module SIS_transport !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> ice_cat_transport does ice transport of mass and tracers by thickness category -subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, IG, CS, uc, vc, mca_tot, uh_tot, vh_tot) +subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, mca_tot, uh_tot, vh_tot) type(cell_average_state_type), intent(inout) :: CAS !< A structure with ocean-cell averaged masses. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type @@ -115,6 +116,7 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, IG, CS, uc, vc, mca !! ice dynamics are to be advanced [s]. integer, intent(in) :: nsteps !< The number of advective iterations !! to use within this time step. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module real, dimension(SZIB_(G),SZJ_(G)), optional, intent(in) :: uc !< The zonal ice velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vc !< The meridional ice velocity [m s-1]. @@ -179,20 +181,20 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, IG, CS, uc, vc, mca if (merged_cont) then call proportionate_continuity(mca_tot(:,:,n-1), uh_tot(:,:,n), vh_tot(:,:,n), & - dt_adv, G, IG, CS%continuity_CSp, & + dt_adv, G, US, IG, CS%continuity_CSp, & h1=CAS%m_ice, uh1=uh_ice, vh1=vh_ice, & h2=CAS%m_snow, uh2=uh_snow, vh2=vh_snow, & h3=CAS%m_pond, uh3=uh_pond, vh3=vh_pond) else - call continuity(uc, vc, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, IG, CS%continuity_CSp) - call continuity(uc, vc, mca0_snow, CAS%m_snow, uh_snow, vh_snow, dt_adv, G, IG, CS%continuity_CSp) - call continuity(uc, vc, mca0_pond, CAS%m_pond, uh_pond, vh_pond, dt_adv, G, IG, CS%continuity_CSp) + call continuity(uc, vc, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, CS%continuity_CSp) + call continuity(uc, vc, mca0_snow, CAS%m_snow, uh_snow, vh_snow, dt_adv, G, US, IG, CS%continuity_CSp) + call continuity(uc, vc, mca0_pond, CAS%m_pond, uh_pond, vh_pond, dt_adv, G, US, IG, CS%continuity_CSp) endif - call advect_scalar(CAS%mH_ice, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, IG, CS%SIS_thick_adv_CSp) - call advect_SIS_tracers(mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, IG, & + call advect_scalar(CAS%mH_ice, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, CS%SIS_thick_adv_CSp) + call advect_SIS_tracers(mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, & CS%SIS_tr_adv_CSp, TrReg, snow_tr=.false.) - call advect_SIS_tracers(mca0_snow, CAS%m_snow, uh_snow, vh_snow, dt_adv, G, IG, & + call advect_SIS_tracers(mca0_snow, CAS%m_snow, uh_snow, vh_snow, dt_adv, G, US, IG, & CS%SIS_tr_adv_CSp, TrReg, snow_tr=.true.) ! Accumulated diagnostics @@ -214,12 +216,13 @@ end subroutine ice_cat_transport !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> finish_ice_transport completes the ice transport and thickness class redistribution -subroutine finish_ice_transport(CAS, IST, TrReg, G, IG, CS, rdg_rate) +subroutine finish_ice_transport(CAS, IST, TrReg, G, US, IG, CS, rdg_rate) type(cell_average_state_type), intent(inout) :: CAS !< A structure with ocean-cell averaged masses. type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(SIS_tracer_registry_type), pointer :: TrReg !< The registry of SIS ice and snow tracers. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: rdg_rate !< The ice ridging rate [s-1]. @@ -249,7 +252,7 @@ subroutine finish_ice_transport(CAS, IST, TrReg, G, IG, CS, rdg_rate) isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nCat = IG%CatIce ! Convert the ocean-cell averaged properties back into the ice_state_type. - call cell_ave_state_to_ice_state(CAS, G, IG, CS, IST, TrReg) + call cell_ave_state_to_ice_state(CAS, G, US, IG, CS, IST, TrReg) ! Compress the ice where the fractional coverage exceeds 1, starting with the ! thinnest category, in what amounts to a minimalist version of a sea-ice @@ -321,8 +324,8 @@ subroutine finish_ice_transport(CAS, IST, TrReg, G, IG, CS, rdg_rate) call pass_var(IST%mH_ice, G%Domain, complete=.true.) if (CS%check_conservation) then - call get_total_mass(IST, G, IG, tot_ice, tot_snow, scale=IG%H_to_kg_m2) - call get_total_enthalpy(IST, G, IG, enth_ice, enth_snow, scale=IG%H_to_kg_m2) + call get_total_mass(IST, G, US, IG, tot_ice, tot_snow, scale=IG%H_to_kg_m2) + call get_total_enthalpy(IST, G, US, IG, enth_ice, enth_snow, scale=IG%H_to_kg_m2) if (is_root_pe()) then I_tot_ice = abs(EFP_to_real(CAS%tot_ice)) @@ -373,7 +376,7 @@ subroutine finish_ice_transport(CAS, IST, TrReg, G, IG, CS, rdg_rate) ! if (CS%id_rdgo>0) call post_SIS_data(CS%id_rdgo, rdg_open, diag) ! if (CS%id_rdgv>0) then ! do j=jsc,jec ; do i=isc,iec -! tmp2d(i,j) = rdg_vosh(i,j) * G%areaT(i,j) * G%mask2dT(i,j) +! tmp2d(i,j) = rdg_vosh(i,j) * US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) ! enddo ; enddo ! call post_SIS_data(CS%id_rdgv, tmp2d, diag) ! endif @@ -386,9 +389,10 @@ end subroutine finish_ice_transport !> Determine the whole-cell averaged mass of snow and ice by thickness category based !! on the information in the ice state type. -subroutine ice_state_to_cell_ave_state(IST, G, IG, CS, CAS) +subroutine ice_state_to_cell_ave_state(IST, G, US, IG, CS, CAS) type(ice_state_type), intent(in) :: IST !< A type describing the state of the sea ice type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module type(cell_average_state_type), intent(inout) :: CAS !< A structure with ocean-cell averaged masses. @@ -447,16 +451,17 @@ subroutine ice_state_to_cell_ave_state(IST, G, IG, CS, CAS) if (allocated(CAS%vh_sum)) CAS%vh_sum(:,:) = 0.0 if (CS%check_conservation) then ! mw/new - need to update this for pond ? - call get_total_mass(IST, G, IG, CAS%tot_ice, CAS%tot_snow, scale=IG%H_to_kg_m2) - call get_total_enthalpy(IST, G, IG, CAS%enth_ice, CAS%enth_snow, scale=IG%H_to_kg_m2) + call get_total_mass(IST, G, US, IG, CAS%tot_ice, CAS%tot_snow, scale=IG%H_to_kg_m2) + call get_total_enthalpy(IST, G, US, IG, CAS%enth_ice, CAS%enth_snow, scale=IG%H_to_kg_m2) endif end subroutine ice_state_to_cell_ave_state !> Convert the ocean-cell averaged properties back into the ice_state_type. -subroutine cell_ave_state_to_ice_state(CAS, G, IG, CS, IST, TrReg) +subroutine cell_ave_state_to_ice_state(CAS, G, US, IG, CS, IST, TrReg) type(cell_average_state_type), intent(inout) :: CAS !< A structure with ocean-cell averaged masses. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice @@ -482,7 +487,7 @@ subroutine cell_ave_state_to_ice_state(CAS, G, IG, CS, IST, TrReg) do j=jsc,jec ; do k=1,nCat ; do i=isc,iec if (CAS%m_ice(i,j,k) > 0.0) then if (CS%roll_factor * (CAS%mH_ice(i,j,k)*IG%H_to_kg_m2/CS%Rho_Ice)**3 > & - (CAS%m_ice(i,j,k)*IG%H_to_kg_m2/CS%Rho_Ice)*G%areaT(i,j)) then + (CAS%m_ice(i,j,k)*IG%H_to_kg_m2/CS%Rho_Ice)*US%L_to_m**2*G%areaT(i,j)) then ! This ice is thicker than it is wide even if all the ice in a grid ! cell is collected into a single cube, so it will roll. Any snow on ! top will simply be redistributed into a thinner layer, although it @@ -490,7 +495,7 @@ subroutine cell_ave_state_to_ice_state(CAS, G, IG, CS, IST, TrReg) ! thinner so that it melts faster, but it should never be made thinner ! than IG%mH_cat_bound(1). CAS%mH_ice(i,j,k) = max((CS%Rho_ice*IG%kg_m2_to_H) * & - sqrt((CAS%m_ice(i,j,k)*G%areaT(i,j)) / & + sqrt((CAS%m_ice(i,j,k)*US%L_to_m**2*G%areaT(i,j)) / & (CS%roll_factor * CAS%mH_ice(i,j,k)) ), IG%mH_cat_bound(1)) endif @@ -967,9 +972,10 @@ subroutine compress_ice(part_sz, mH_ice, mH_snow, mH_pond, TrReg, G, IG, CS, CAS end subroutine compress_ice !> get_total_mass determines the globally integrated mass of snow and ice -subroutine get_total_mass(IST, G, IG, tot_ice, tot_snow, tot_pond, scale) +subroutine get_total_mass(IST, G, US, IG, tot_ice, tot_snow, tot_pond, scale) type(ice_state_type), intent(in) :: IST !< A type describing the state of the sea ice type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(EFP_type), intent(out) :: tot_ice !< The globally integrated total ice [kg]. type(EFP_type), intent(out) :: tot_snow !< The globally integrated total snow [kg]. @@ -987,12 +993,12 @@ subroutine get_total_mass(IST, G, IG, tot_ice, tot_snow, tot_pond, scale) sum_ice(:,:) = 0.0 sum_snow(:,:) = 0.0 do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec - sum_ice(i,j) = sum_ice(i,j) + G%areaT(i,j) * & + sum_ice(i,j) = sum_ice(i,j) + US%L_to_m**2*G%areaT(i,j) * & (IST%part_size(i,j,k) * (H_to_units*IST%mH_ice(i,j,k))) - sum_snow(i,j) = sum_snow(i,j) + G%areaT(i,j) * & + sum_snow(i,j) = sum_snow(i,j) + US%L_to_m**2*G%areaT(i,j) * & (IST%part_size(i,j,k) * (H_to_units*IST%mH_snow(i,j,k))) if (present(tot_pond)) & - sum_pond(i,j) = sum_pond(i,j) + G%areaT(i,j) * & + sum_pond(i,j) = sum_pond(i,j) + US%L_to_m**2*G%areaT(i,j) * & (IST%part_size(i,j,k) * (H_to_units*IST%mH_pond(i,j,k))) enddo ; enddo ; enddo @@ -1047,9 +1053,10 @@ subroutine cell_mass_from_CAS(CAS, G, IG, mca, scale) end subroutine cell_mass_from_CAS !> get_total_enthalpy determines the globally integrated enthalpy of snow and ice -subroutine get_total_enthalpy(IST, G, IG, enth_ice, enth_snow, scale) +subroutine get_total_enthalpy(IST, G, US, IG, enth_ice, enth_snow, scale) type(ice_state_type), intent(in) :: IST !< A type describing the state of the sea ice type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(EFP_type), intent(out) :: enth_ice !< The globally integrated total ice enthalpy [J]. type(EFP_type), intent(out) :: enth_snow !< The globally integrated total snow enthalpy [J]. @@ -1078,11 +1085,11 @@ subroutine get_total_enthalpy(IST, G, IG, enth_ice, enth_snow, scale) I_Nk = 1.0 / IG%NkIce do m=1,IG%NkIce ; do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec - sum_enth_ice(i,j) = sum_enth_ice(i,j) + (G%areaT(i,j) * & + sum_enth_ice(i,j) = sum_enth_ice(i,j) + (US%L_to_m**2*G%areaT(i,j) * & (((H_to_units*IST%mH_ice(i,j,k))*IST%part_size(i,j,k))*I_Nk)) * heat_ice(i,j,k,m) enddo ; enddo ; enddo ; enddo do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec - sum_enth_snow(i,j) = sum_enth_snow(i,j) + (G%areaT(i,j) * & + sum_enth_snow(i,j) = sum_enth_snow(i,j) + (US%L_to_m**2*G%areaT(i,j) * & ((H_to_units*IST%mH_snow(i,j,k))*IST%part_size(i,j,k))) * heat_snow(i,j,k,1) enddo ; enddo ; enddo !### What about sum_enth_pond? diff --git a/src/SIS_utils.F90 b/src/SIS_utils.F90 index 67ff9751..ed37edde 100644 --- a/src/SIS_utils.F90 +++ b/src/SIS_utils.F90 @@ -8,6 +8,7 @@ module SIS_utils use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING, SIS_mesg=>MOM_mesg use MOM_error_handler, only : is_root_pe use MOM_time_manager, only : time_type, get_date, get_time, set_date, operator(-) +use MOM_unit_scaling, only : unit_scale_type use SIS_diag_mediator, only : post_SIS_data, SIS_diag_ctrl use SIS_debugging, only : hchksum, Bchksum, uvchksum, hchksum_pair, Bchksum_pair use SIS_debugging, only : check_redundant_B @@ -104,12 +105,12 @@ subroutine ice_line(Time, cn_ocn, sst, G) do j=jsc,jec ; do i=isc,iec x(i,j) = 0.0 if (cn_ocn(i,j)<0.85 .and. n*G%geoLatT(i,j)>0.0) & - x(i,j) = G%mask2dT(i,j)*G%areaT(i,j) + x(i,j) = G%mask2dT(i,j)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo gx((n+3)/2) = g_sum(x(isc:iec,jsc:jec))/1e12 enddo gx(3) = g_sum(sst(isc:iec,jsc:jec)*G%mask2dT(isc:iec,jsc:jec)*G%areaT(isc:iec,jsc:jec)) / & - (g_sum(G%mask2dT(isc:iec,jsc:jec)*G%areaT(isc:iec,jsc:jec)) + 1e-10) + (g_sum(G%mask2dT(isc:iec,jsc:jec)*G%areaT(isc:iec,jsc:jec)) + G%US%m_to_L**2*1e-10) ! ! print info every 5 days ! @@ -288,9 +289,10 @@ subroutine post_avg_4d(id, val, part, diag, G, mask, scale, offset, wtd) end subroutine post_avg_4d !> Write checksums of the elements of the sea-ice grid -subroutine ice_grid_chksum(G, haloshift) - type(SIS_hor_grid_type), optional, intent(inout) :: G !< The horizontal grid type - integer, optional, intent(in) :: haloshift !< The size of the halo to check +subroutine ice_grid_chksum(G, US, haloshift) + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors + integer, optional, intent(in) :: haloshift !< The size of the halo to check integer :: isc, iec, jsc, jec, hs isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -301,10 +303,10 @@ subroutine ice_grid_chksum(G, haloshift) call hchksum(G%geoLatT, "G%geoLatT", G%HI, haloshift=hs) call hchksum(G%geoLonT, "G%geoLonT", G%HI, haloshift=hs) - call hchksum_pair("G%d[xy]T", G%dxT, G%dyT, G, halos=hs) - call hchksum_pair("G%Id[xy]T", G%IdxT, G%IdyT, G, halos=hs) - call hchksum(G%areaT, "G%areaT", G%HI, haloshift=hs) - call hchksum(G%IareaT, "G%IareaT", G%HI, haloshift=hs) + call hchksum_pair("G%d[xy]T", G%dxT, G%dyT, G, halos=hs, scale=US%L_to_m) + call hchksum_pair("G%Id[xy]T", G%IdxT, G%IdyT, G, halos=hs, scale=US%m_to_L) + call hchksum(G%areaT, "G%areaT", G%HI, haloshift=hs, scale=US%L_to_m**2) + call hchksum(G%IareaT, "G%IareaT", G%HI, haloshift=hs, scale=US%m_to_L**2) call hchksum(G%mask2dT, "G%mask2dT", G%HI, haloshift=hs) call hchksum(G%cos_rot, "G%cos_rot", G%HI) call hchksum(G%sin_rot, "G%sin_rot", G%HI) @@ -314,11 +316,11 @@ subroutine ice_grid_chksum(G, haloshift) call Bchksum(G%geoLatBu, "G%geoLatBu", G%HI, haloshift=hs) call Bchksum(G%geoLonBu, "G%geoLonBu", G%HI, haloshift=hs) - call Bchksum_pair("G%d[xy]Bu", G%dxBu, G%dyBu, G, halos=hs, scalars=.true.) - call Bchksum_pair("G%Id[xy]Bu", G%IdxBu, G%IdyBu, G, halos=hs, scalars=.true.) + call Bchksum_pair("G%d[xy]Bu", G%dxBu, G%dyBu, G, halos=hs, scalars=.true., scale=US%L_to_m) + call Bchksum_pair("G%Id[xy]Bu", G%IdxBu, G%IdyBu, G, halos=hs, scalars=.true., scale=US%m_to_L) - call Bchksum(G%areaBu, "G%areaBu", G%HI, haloshift=hs) - call Bchksum(G%IareaBu, "G%IareaBu", G%HI, haloshift=hs) + call Bchksum(G%areaBu, "G%areaBu", G%HI, haloshift=hs, scale=US%L_to_m**2) + call Bchksum(G%IareaBu, "G%IareaBu", G%HI, haloshift=hs, scale=US%m_to_L**2) call check_redundant_B("G%areaBu", G%areaBu, G, isc-1, iec+1, jsc-1, jec+1) call check_redundant_B("G%IareaBu", G%IareaBu, G, isc-1, iec+1, jsc-1, jec+1) @@ -328,17 +330,17 @@ subroutine ice_grid_chksum(G, haloshift) call uvchksum("G%geoLatC[uv]", G%geoLatCu, G%geoLatCv, G, halos=hs) call uvchksum("G%geolonC[uv]", G%geoLonCu, G%geoLonCv, G, halos=hs) - call uvchksum("G%d[xy]C[uv]", G%dxCu, G%dyCv, G, halos=hs, scalars=.true.) - call uvchksum("G%d[yx]C[uv]", G%dyCu, G%dxCv, G, halos=hs, scalars=.true.) - call uvchksum("G%Id[xy]C[uv]", G%IdxCu, G%IdyCv, G, halos=hs, scalars=.true.) - call uvchksum("G%Id[yx]C[uv]", G%IdyCu, G%IdxCv, G, halos=hs, scalars=.true.) + call uvchksum("G%d[xy]C[uv]", G%dxCu, G%dyCv, G, halos=hs, scalars=.true., scale=US%L_to_m) + call uvchksum("G%d[yx]C[uv]", G%dyCu, G%dxCv, G, halos=hs, scalars=.true., scale=US%L_to_m) + call uvchksum("G%Id[xy]C[uv]", G%IdxCu, G%IdyCv, G, halos=hs, scalars=.true., scale=US%m_to_L) + call uvchksum("G%Id[yx]C[uv]", G%IdyCu, G%IdxCv, G, halos=hs, scalars=.true., scale=US%m_to_L) - call uvchksum("G%areaC[uv]", G%areaCu, G%areaCv, G, halos=hs) - call uvchksum("G%IareaC[uv]", G%IareaCu, G%IareaCv, G, halos=hs) + call uvchksum("G%areaC[uv]", G%areaCu, G%areaCv, G, halos=hs, scale=US%L_to_m**2) + call uvchksum("G%IareaC[uv]", G%IareaCu, G%IareaCv, G, halos=hs, scale=US%m_to_L**2) call hchksum(G%bathyT, "G%bathyT", G%HI, haloshift=hs) call Bchksum(G%CoriolisBu, "G%CoriolisBu", G%HI, haloshift=hs) - call hchksum_pair("G%dF_d[xy]", G%dF_dx, G%dF_dy, G, halos=hs) + call hchksum_pair("G%dF_d[xy]", G%dF_dx, G%dF_dy, G, halos=hs, scale=US%m_to_L) end subroutine ice_grid_chksum diff --git a/src/ice_age_tracer.F90 b/src/ice_age_tracer.F90 index df256100..6a74f6d8 100644 --- a/src/ice_age_tracer.F90 +++ b/src/ice_age_tracer.F90 @@ -21,6 +21,7 @@ module ice_age_tracer use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING use MOM_error_handler, only : SIS_mesg=>MOM_mesg use MOM_string_functions, only : slasher +use MOM_unit_scaling, only : unit_scale_type use fms_mod, only : read_data use fms_io_mod, only : register_restart_field, restore_state @@ -417,7 +418,7 @@ function ice_age_stock(mi, stocks, G, IG, CS, names, units) avg_tr = avg_tr/IG%NkIce stocks(tr) = stocks(tr) + avg_tr * & - (G%mask2dT(i,j) * G%areaT(i,j) * mi(i,j,k)) + (G%mask2dT(i,j) * G%US%m_to_L**2*G%areaT(i,j) * mi(i,j,k)) enddo ; enddo ; enddo enddo diff --git a/src/ice_model.F90 b/src/ice_model.F90 index c4b65be1..32a61179 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -46,6 +46,8 @@ module ice_model_mod use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : operator(+), operator(-) use MOM_time_manager, only : operator(>), operator(*), operator(/), operator(/=) +use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init +use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling 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 @@ -170,6 +172,7 @@ subroutine update_ice_slow_thermo(Ice) type(ice_state_type), pointer :: sIST => NULL() type(fast_ice_avg_type), pointer :: FIA => NULL() type(ice_rad_type), pointer :: Rad => NULL() + type(unit_scale_type), pointer :: US => NULL() real :: dt_slow ! The time step over which to advance the model. integer :: i, j, i2, j2, i_off, j_off @@ -177,7 +180,7 @@ subroutine update_ice_slow_thermo(Ice) "The pointer to Ice%sCS must be associated in update_ice_slow_thermo.") sIST => Ice%sCS%IST ; sIG => Ice%sCS%IG ; sG => Ice%sCS%G ; FIA => Ice%sCS%FIA - Rad => Ice%sCS%Rad + Rad => Ice%sCS%Rad ; US => Ice%sCS%US call mpp_clock_begin(iceClock) ; call mpp_clock_begin(ice_clock_slow) ! Advance the slow PE clock to give the end time of the slow timestep. There @@ -239,7 +242,7 @@ subroutine update_ice_slow_thermo(Ice) endif call slow_thermodynamics(sIST, dt_slow, Ice%sCS%slow_thermo_CSp, Ice%sCS%OSS, FIA, & - Ice%sCS%XSF, Ice%sCS%IOF, sG, sIG) + Ice%sCS%XSF, Ice%sCS%IOF, sG, US, sIG) if (Ice%sCS%debug) then call Ice_public_type_chksum("Before set_ocean_top_fluxes", Ice, check_slow=.true.) call IOF_chksum("Before set_ocean_top_fluxes", Ice%sCS%IOF, sG) @@ -270,13 +273,14 @@ subroutine update_ice_dynamics_trans(Ice, time_step, start_cycle, end_cycle, cyc type(SIS_hor_grid_type), pointer :: sG => NULL() type(ice_state_type), pointer :: sIST => NULL() type(fast_ice_avg_type), pointer :: FIA => NULL() + type(unit_scale_type), pointer :: US => NULL() real :: dt_slow ! The time step over which to advance the model. logical :: do_multi_trans, cycle_start if (.not.associated(Ice%sCS)) call SIS_error(FATAL, & "The pointer to Ice%sCS must be associated in update_ice_dynamics_trans.") - sIST => Ice%sCS%IST ; sIG => Ice%sCS%IG ; sG => Ice%sCS%G ; FIA => Ice%sCS%FIA + sIST => Ice%sCS%IST ; sIG => Ice%sCS%IG ; sG => Ice%sCS%G ; FIA => Ice%sCS%FIA ; US => Ice%sCS%US dt_slow = time_type_to_real(Ice%sCS%Time_step_slow) if (present(time_step)) dt_slow = time_type_to_real(time_step) cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle @@ -308,17 +312,17 @@ subroutine update_ice_dynamics_trans(Ice, time_step, start_cycle, end_cycle, cyc if (Ice%sCS%specified_ice) then ! There is no ice dynamics or transport. call specified_ice_dynamics(sIST, Ice%sCS%OSS, FIA, Ice%sCS%IOF, dt_slow, & - Ice%sCS%specified_ice_CSp, sG, sIG) + Ice%sCS%specified_ice_CSp, sG, US, sIG) elseif (do_multi_trans) then call SIS_multi_dyn_trans(sIST, Ice%sCS%OSS, FIA, Ice%sCS%IOF, dt_slow, Ice%sCS%dyn_trans_CSp, & - Ice%icebergs, sG, sIG, Ice%sCS%SIS_tracer_flow_CSp, & + Ice%icebergs, sG, US, sIG, Ice%sCS%SIS_tracer_flow_CSp, & start_cycle, end_cycle, cycle_length) elseif (Ice%sCS%slab_ice) then ! Use a very old slab ice model. call slab_ice_dyn_trans(sIST, Ice%sCS%OSS, FIA, Ice%sCS%IOF, dt_slow, Ice%sCS%dyn_trans_CSp, & - sG, sIG, Ice%sCS%SIS_tracer_flow_CSp) + sG, US, sIG, Ice%sCS%SIS_tracer_flow_CSp) else ! This is the typical branch used by SIS2. call SIS_dynamics_trans(sIST, Ice%sCS%OSS, FIA, Ice%sCS%IOF, dt_slow, Ice%sCS%dyn_trans_CSp, & - Ice%icebergs, sG, sIG, Ice%sCS%SIS_tracer_flow_CSp) + Ice%icebergs, sG, US, sIG, Ice%sCS%SIS_tracer_flow_CSp) endif ! Set up the stresses and surface pressure in the externally visible structure Ice. @@ -1612,8 +1616,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" real :: enth_spec_snow, enth_spec_ice real, allocatable :: S_col(:) real :: pi ! pi = 3.1415926... calculated as 4*atan(1) @@ -1631,6 +1635,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, type(hor_index_type) :: sHI ! A hor_index_type for array extents on slow_ice_PEs. type(dyn_horgrid_type), pointer :: dG => NULL() + type(unit_scale_type), pointer :: US => NULL() ! These pointers are used only for coding convenience on slow PEs. type(SIS_hor_grid_type), pointer :: sG => NULL() type(MOM_domain_type), pointer :: sGD => NULL() @@ -1770,6 +1775,10 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") + + ! Determining the internal unit scaling factors for this run. + call unit_scaling_init(param_file, US) + call get_param(param_file, mdl, "SPECIFIED_ICE", specified_ice, & "If true, the ice is specified and there is no dynamics.", & default=.false.) @@ -2007,6 +2016,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, if (.not.associated(Ice%sCS)) allocate(Ice%sCS) if (.not.associated(Ice%sCS%IG)) allocate(Ice%sCS%IG) if (.not.associated(Ice%sCS%IST)) allocate(Ice%sCS%IST) + Ice%sCS%US => US Ice%sCS%Time = Time ! Set some pointers for convenience. @@ -2054,11 +2064,12 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call clone_MOM_domain(sGD, dG%Domain) ! Set the bathymetry, Coriolis parameter, open channel widths and masks. - call SIS_initialize_fixed(dG, param_file, write_geom_files, dirs%output_directory) + call SIS_initialize_fixed(dG, US, param_file, write_geom_files, dirs%output_directory) call set_hor_grid(sG, param_file, global_indexing=global_indexing) call copy_dyngrid_to_SIS_horgrid(dG, sG) call destroy_dyn_horgrid(dG) + Ice%sCS%G%US => US ! Allocate and register fields for restarts. @@ -2132,7 +2143,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, isc = sHI%isc ; iec = sHI%iec ; jsc = sHI%jsc ; jec = sHI%jec i_off = LBOUND(Ice%area,1) - sHI%isc ; j_off = LBOUND(Ice%area,2) - sHI%jsc do j=jsc,jec ; do i=isc,iec ; i2 = i+i_off ; j2 = j+j_off - Ice%area(i2,j2) = sG%areaT(i,j) * sG%mask2dT(i,j) + Ice%area(i2,j2) = US%L_to_m**2 * sG%areaT(i,j) * sG%mask2dT(i,j) enddo ; enddo endif ! slow_ice_PE @@ -2154,6 +2165,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, if (.not.associated(Ice%fCS%IST)) allocate(Ice%fCS%IST) endif + Ice%fCS%US => US + if (single_IST) then Ice%fCS%G => Ice%sCS%G fG => Ice%fCS%G @@ -2181,11 +2194,12 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call clone_MOM_domain(fGD, dG%Domain) ! Set the bathymetry, Coriolis parameter, open channel widths and masks. - call SIS_initialize_fixed(dG, param_file, .false., dirs%output_directory) + call SIS_initialize_fixed(dG, US, param_file, .false., dirs%output_directory) call set_hor_grid(Ice%fCS%G, param_file, global_indexing=global_indexing) call copy_dyngrid_to_SIS_horgrid(dG, Ice%fCS%G) call destroy_dyn_horgrid(dG) + Ice%fCS%G%US => US endif Ice%fCS%bounds_check = bounds_check @@ -2550,7 +2564,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! in the restart files have been initialized. Now call the initialization ! routines for any dependent sub-modules. - call ice_diagnostics_init(Ice%sCS%IOF, Ice%sCS%OSS, Ice%sCS%FIA, sG, sIG, & + call ice_diagnostics_init(Ice%sCS%IOF, Ice%sCS%OSS, Ice%sCS%FIA, sG, US, sIG, & Ice%sCS%diag, Ice%sCS%Time, Cgrid=sIST%Cgrid_dyn) Ice%axes(1:3) = Ice%sCS%diag%axesTc0%handles(1:3) @@ -2599,7 +2613,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, sGD%X_flags, sGD%Y_flags, time_type_to_real(Time_step_slow), & Time, sG%geoLonBu(isc:iec,jsc:jec), sG%geoLatBu(isc:iec,jsc:jec), & sG%mask2dT(isc-1:iec+1,jsc-1:jec+1), & - sG%dxCv(isc-1:iec+1,jsc-1:jec+1), sG%dyCu(isc-1:iec+1,jsc-1:jec+1), & + US%L_to_m*sG%dxCv(isc-1:iec+1,jsc-1:jec+1), US%L_to_m*sG%dyCu(isc-1:iec+1,jsc-1:jec+1), & Ice%area, sG%cos_rot(isc-1:iec+1,jsc-1:jec+1), & sG%sin_rot(isc-1:iec+1,jsc-1:jec+1), maskmap=sGD%maskmap ) else @@ -2608,20 +2622,20 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, sGD%X_flags, sGD%Y_flags, time_type_to_real(Time_step_slow), & Time, sG%geoLonBu(isc:iec,jsc:jec), sG%geoLatBu(isc:iec,jsc:jec), & sG%mask2dT(isc-1:iec+1,jsc-1:jec+1), & - sG%dxCv(isc-1:iec+1,jsc-1:jec+1), sG%dyCu(isc-1:iec+1,jsc-1:jec+1), & + US%L_to_m*sG%dxCv(isc-1:iec+1,jsc-1:jec+1), US%L_to_m*sG%dyCu(isc-1:iec+1,jsc-1:jec+1), & Ice%area, sG%cos_rot(isc-1:iec+1,jsc-1:jec+1), & sG%sin_rot(isc-1:iec+1,jsc-1:jec+1) ) endif endif ! Do any error checking here. - if (Ice%sCS%debug) call ice_grid_chksum(sG, haloshift=1) + if (Ice%sCS%debug) call ice_grid_chksum(sG, US, haloshift=1) if (specified_ice) then - call write_ice_statistics(sIST, Ice%sCS%Time, 0, sG, sIG, & + call write_ice_statistics(sIST, Ice%sCS%Time, 0, sG, US, sIG, & specified_ice_sum_output_CS(Ice%sCS%specified_ice_CSp)) else - call write_ice_statistics(sIST, Ice%sCS%Time, 0, sG, sIG, & + call write_ice_statistics(sIST, Ice%sCS%Time, 0, sG, US, sIG, & SIS_dyn_trans_sum_output_CS(Ice%sCS%dyn_trans_CSp)) endif endif ! slow_ice_PE diff --git a/src/ice_type.F90 b/src/ice_type.F90 index 7dd5bd2a..1b5a6de9 100644 --- a/src/ice_type.F90 +++ b/src/ice_type.F90 @@ -21,6 +21,7 @@ module ice_type_mod use MOM_file_parser, only : param_file_type use MOM_hor_index, only : hor_index_type use MOM_time_manager, only : time_type, time_type_to_real +use MOM_unit_scaling, only : unit_scale_type use SIS_debugging, only : chksum use SIS_diag_mediator, only : SIS_diag_ctrl, post_data=>post_SIS_data use SIS_diag_mediator, only : register_SIS_diag_field @@ -151,7 +152,9 @@ module ice_type_mod !< A pointer to the SIS fast ice update control structure type(SIS_slow_CS), pointer :: sCS => NULL() !< A pointer to the SIS slow ice update control structure - type(restart_file_type), pointer :: Ice_restart => NULL() + type(unit_scale_type), pointer :: US => NULL() + !< structure containing various unit conversion factors + type(restart_file_type), pointer :: Ice_restart => NULL() !< A pointer to the slow ice restart control structure type(restart_file_type), pointer :: Ice_fast_restart => NULL() !< A pointer to the fast ice restart control structure @@ -571,7 +574,7 @@ subroutine ice_stock_pe(Ice, index, value) value = 0.0 do k=1,ncat ; do j=jsc,jec ; do i=isc,iec value = value + kg_H * (IST%mH_ice(i,j,k) + (IST%mH_snow(i,j,k) + IST%mH_pond(i,j,k))) * & - IST%part_size(i,j,k) * (G%areaT(i,j)*G%mask2dT(i,j)) + IST%part_size(i,j,k) * (G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j)) enddo ; enddo ; enddo case (ISTOCK_HEAT) @@ -579,13 +582,13 @@ subroutine ice_stock_pe(Ice, index, value) if (slab_ice) then do k=1,ncat ; do j=jsc,jec ; do i=isc,iec if (IST%part_size(i,j,k)*IST%mH_ice(i,j,k) > 0.0) then - value = value - (G%areaT(i,j)*G%mask2dT(i,j)) * IST%part_size(i,j,k) * & + value = value - (G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j)) * IST%part_size(i,j,k) * & (kg_H * IST%mH_ice(i,j,k)) * LI endif enddo ; enddo ; enddo else !### Should this be changed to raise the temperature to 0 degC? do k=1,ncat ; do j=jsc,jec ; do i=isc,iec - part_wt = (G%areaT(i,j)*G%mask2dT(i,j)) * IST%part_size(i,j,k) + part_wt = (G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j)) * IST%part_size(i,j,k) if (part_wt*IST%mH_ice(i,j,k) > 0.0) then value = value - (part_wt * (kg_H * IST%mH_snow(i,j,k))) * & Energy_melt_enthS(IST%enth_snow(i,j,k,1), 0.0, IST%ITV) @@ -601,7 +604,7 @@ subroutine ice_stock_pe(Ice, index, value) !There is no salt in the snow. value = 0.0 do m=1,NkIce ; do k=1,ncat ; do j=jsc,jec ; do i=isc,iec - value = value + (IST%part_size(i,j,k) * (G%areaT(i,j)*G%mask2dT(i,j))) * & + value = value + (IST%part_size(i,j,k) * (G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j))) * & (0.001*(kg_H_Nk*IST%mH_ice(i,j,k))) * IST%sal_ice(i,j,k,m) enddo ; enddo ; enddo ; enddo diff --git a/src/slab_ice.F90 b/src/slab_ice.F90 index e30dd958..2d4b80ba 100644 --- a/src/slab_ice.F90 +++ b/src/slab_ice.F90 @@ -10,6 +10,7 @@ module slab_ice ! use MOM_file_parser, only : get_param, log_param, read_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type use MOM_obsolete_params, only : obsolete_logical, obsolete_real +use MOM_unit_scaling, only : unit_scale_type ! use SIS_diag_mediator, only : post_SIS_data, query_SIS_averaging_enabled, SIS_diag_ctrl ! use SIS_diag_mediator, only : register_diag_field=>register_SIS_diag_field, time_type ! use SIS_diag_mediator, only : safe_alloc_alloc @@ -27,7 +28,7 @@ module slab_ice !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Advect an ice tracer or the thickness using a very old slab-ice algorithm !! dating back to the Manabe model. -subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, part_sz, nsteps) +subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, US, part_sz, nsteps) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uc !< x-face advecting velocity [m s-1] real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vc !< y-face advecting velocity [m s-1] @@ -37,6 +38,7 @@ subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, part_sz, nsteps) real, intent(in ) :: stop_lim !< A tracer amount below which to !! stop advection, in the same units as tr [Conc] real, intent(in ) :: dt_slow !< The time covered by this call [s]. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: part_sz !< A part size that is set based on !! whether trc (which may be mass) exceeds 0. integer, optional, intent(in ) :: nsteps !< The number of advective substeps. @@ -60,9 +62,9 @@ subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, part_sz, nsteps) if ( avg > stop_lim .and. uc(I,j) * dif > 0.0) then uflx(I,j) = 0.0 elseif ( uc(i,j) > 0.0 ) then - uflx(I,j) = uc(I,j) * trc(i,j) * G%dy_Cu(I,j) + uflx(I,j) = uc(I,j) * trc(i,j) * US%L_to_m*G%dy_Cu(I,j) else - uflx(I,j) = uc(I,j) * trc(i+1,j) * G%dy_Cu(I,j) + uflx(I,j) = uc(I,j) * trc(i+1,j) * US%L_to_m*G%dy_Cu(I,j) endif enddo ; enddo @@ -72,15 +74,15 @@ subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, part_sz, nsteps) if (avg > stop_lim .and. vc(i,J) * dif > 0.0) then vflx(i,J) = 0.0 elseif ( vc(i,J) > 0.0 ) then - vflx(i,J) = vc(i,J) * trc(i,j) * G%dx_Cv(i,J) + vflx(i,J) = vc(i,J) * trc(i,j) * US%L_to_m*G%dx_Cv(i,J) else - vflx(i,J) = vc(i,J) * trc(i,j+1) * G%dx_Cv(i,J) + vflx(i,J) = vc(i,J) * trc(i,j+1) * US%L_to_m*G%dx_Cv(i,J) endif enddo ; enddo do j=jsc,jec ; do i=isc,iec trc(i,j) = trc(i,j) + dt_adv * ((uflx(I-1,j) - uflx(I,j)) + & - (vflx(i,J-1) - vflx(i,J)) ) * G%IareaT(i,j) + (vflx(i,J-1) - vflx(i,J)) ) * US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call pass_var(trc, G%Domain) diff --git a/src/specified_ice.F90 b/src/specified_ice.F90 index a8eeb96a..20ace05d 100644 --- a/src/specified_ice.F90 +++ b/src/specified_ice.F90 @@ -10,10 +10,11 @@ module specified_ice use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE 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 -use MOM_file_parser, only : get_param, read_param, log_param, log_version, param_file_type +use MOM_file_parser, only : get_param, read_param, log_param, log_version, param_file_type use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : operator(+), operator(-) use MOM_time_manager, only : operator(>), operator(*), operator(/), operator(/=) +use MOM_unit_scaling, only : unit_scale_type use SIS_diag_mediator, only : enable_SIS_averaging, disable_SIS_averaging use SIS_diag_mediator, only : query_SIS_averaging_enabled, SIS_diag_ctrl @@ -57,7 +58,7 @@ module specified_ice !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> specified_ice_dynamics does an update of ice dynamic quantities with specified ice. -subroutine specified_ice_dynamics(IST, OSS, FIA, IOF, dt_slow, CS, G, IG) +subroutine specified_ice_dynamics(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe @@ -68,6 +69,7 @@ subroutine specified_ice_dynamics(IST, OSS, FIA, IOF, dt_slow, CS, G, IG) !! the ocean that are calculated by the ice model. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(specified_ice_CS), pointer :: CS !< The control structure for the specified_ice module @@ -99,7 +101,7 @@ subroutine specified_ice_dynamics(IST, OSS, FIA, IOF, dt_slow, CS, G, IG) if (CS%bounds_check) call IST_bounds_check(IST, G, IG, "End of specified_ice_dynamics", OSS=OSS) if (CS%Time + real_to_time(0.5*dt_slow) > CS%write_ice_stats_time) then - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp) + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, US, IG, CS%sum_output_CSp) CS%write_ice_stats_time = CS%write_ice_stats_time + CS%ice_stats_interval endif From 887f0fa1b73bc22ddd204bf48ab9a467839ca751 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 11 Oct 2019 18:50:02 -0400 Subject: [PATCH 03/24] +Rescaled G%CoriolisBu Rescaled G%CoriolisBu, G%df_dx and G%df_dy for dimenisonal consistency testing. Answers in the Baltic test case are bitwise identical. --- src/SIS_dyn_bgrid.F90 | 8 ++++---- src/SIS_dyn_cgrid.F90 | 2 +- src/SIS_fixed_initialization.F90 | 10 +++++----- src/SIS_hor_grid.F90 | 6 +++--- src/SIS_utils.F90 | 4 ++-- 5 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/SIS_dyn_bgrid.F90 b/src/SIS_dyn_bgrid.F90 index 90b22e3d..ac683d6f 100644 --- a/src/SIS_dyn_bgrid.F90 +++ b/src/SIS_dyn_bgrid.F90 @@ -511,7 +511,7 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & do J=jsc-1,jec ; do I=isc-1,iec if( (G%mask2dBu(i,j)>0.5).and.(miv(i,j)>CS%MIV_MIN)) then ! timestep ice velocity (H&D eqn 22) rr = CS%cdw*CS%Rho_ocean*abs(cmplx(ui(i,j)-uo(i,j),vi(i,j)-vo(i,j))) * & - exp(sign(CS%blturn*pi/180,G%CoriolisBu(i,j))*(0.0,1.0)) + exp(sign(CS%blturn*pi/180,US%s_to_T*G%CoriolisBu(i,j))*(0.0,1.0)) ! ! first, timestep explicit parts (ice, wind & ocean part of water stress) ! @@ -540,7 +540,7 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! second, timestep implicit parts (Coriolis and ice part of water stress) ! newuv = cmplx(ui(I,J),vi(I,J)) / & - (1 + dt_Rheo*(0.0,1.0)*G%CoriolisBu(I,J) + civ(I,J)*rr*dtmiv(I,J)) + (1 + dt_Rheo*(0.0,1.0)*US%s_to_T*G%CoriolisBu(I,J) + civ(I,J)*rr*dtmiv(I,J)) ui(I,J) = real(newuv); vi(I,J) = aimag(newuv) ! ! sum for averages @@ -549,8 +549,8 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & fyic(I,J) = fyic(I,J) + fyic_now fxoc(I,J) = fxoc(I,J) + real(civ(I,J)*rr*cmplx(ui(I,J)-uo(I,J), vi(I,J)-vo(I,J))) fyoc(I,J) = fyoc(I,J) + aimag(civ(I,J)*rr*cmplx(ui(I,J)-uo(I,J), vi(I,J)-vo(I,J))) - fxco(I,J) = fxco(I,J) - miv(I,J)*real ((0.0,1.0)*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) - fyco(I,J) = fyco(I,J) - miv(I,J)*aimag((0.0,1.0)*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) + fxco(I,J) = fxco(I,J) - miv(I,J)*real ((0.0,1.0)*US%s_to_T*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) + fyco(I,J) = fyco(I,J) - miv(I,J)*aimag((0.0,1.0)*US%s_to_T*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) endif enddo ; enddo diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index b93715ad..355e2ca9 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -786,7 +786,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do J=jsc-1,jec ; do I=isc-1,iec tot_area = ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) - q(I,J) = G%CoriolisBu(I,J) * tot_area / & + q(I,J) = US%s_to_T*G%CoriolisBu(I,J) * tot_area / & (((G%areaT(i,j) * mis(i,j) + G%areaT(i+1,j+1) * mis(i+1,j+1)) + & (G%areaT(i+1,j) * mis(i+1,j) + G%areaT(i,j+1) * mis(i,j+1))) + tot_area * m_neglect) enddo ; enddo diff --git a/src/SIS_fixed_initialization.F90 b/src/SIS_fixed_initialization.F90 index 3df873a4..0dd9d5a1 100644 --- a/src/SIS_fixed_initialization.F90 +++ b/src/SIS_fixed_initialization.F90 @@ -107,13 +107,13 @@ subroutine SIS_initialize_fixed(G, US, PF, write_geom, output_dir) ! Calculate the value of the Coriolis parameter at the latitude ! ! of the q grid points [s-1]. - call MOM_initialize_rotation(G%CoriolisBu, G, PF) + call MOM_initialize_rotation(G%CoriolisBu, G, PF, US) ! Calculate the components of grad f (beta) - call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G) + call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US) if (debug) then - call Bchksum(G%CoriolisBu, "SIS_initialize_fixed: f ", G%HI) - call hchksum(G%dF_dx, "SIS_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L) - call hchksum(G%dF_dy, "SIS_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L) + call Bchksum(G%CoriolisBu, "SIS_initialize_fixed: f ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dx, "SIS_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L*US%s_to_T) + call hchksum(G%dF_dy, "SIS_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L*US%s_to_T) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/SIS_hor_grid.F90 b/src/SIS_hor_grid.F90 index 14240cd4..947fa0e6 100644 --- a/src/SIS_hor_grid.F90 +++ b/src/SIS_hor_grid.F90 @@ -144,10 +144,10 @@ module SIS_hor_grid real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & bathyT !< Ocean bottom depth at tracer points [m]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - CoriolisBu !< The Coriolis parameter at corner points [s-1]. + CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 L-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 L-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m s-2]. type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type diff --git a/src/SIS_utils.F90 b/src/SIS_utils.F90 index ed37edde..4f9b67c8 100644 --- a/src/SIS_utils.F90 +++ b/src/SIS_utils.F90 @@ -339,8 +339,8 @@ subroutine ice_grid_chksum(G, US, haloshift) call uvchksum("G%IareaC[uv]", G%IareaCu, G%IareaCv, G, halos=hs, scale=US%m_to_L**2) call hchksum(G%bathyT, "G%bathyT", G%HI, haloshift=hs) - call Bchksum(G%CoriolisBu, "G%CoriolisBu", G%HI, haloshift=hs) - call hchksum_pair("G%dF_d[xy]", G%dF_dx, G%dF_dy, G, halos=hs, scale=US%m_to_L) + call Bchksum(G%CoriolisBu, "G%CoriolisBu", G%HI, haloshift=hs, scale=US%s_to_T) + call hchksum_pair("G%dF_d[xy]", G%dF_dx, G%dF_dy, G, halos=hs, scale=US%s_to_T*US%m_to_L) end subroutine ice_grid_chksum From 62724c795ef29fcd31da94b8ce161604e202fd95 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 11 Oct 2019 19:05:29 -0400 Subject: [PATCH 04/24] +Rescaled G%bathyT Rescaled G%bathyT for dimenisonal consistency testing. Answers in the Baltic test case are bitwise identical. --- src/SIS_fixed_initialization.F90 | 32 ++++++++++++++++++-------------- src/SIS_hor_grid.F90 | 2 +- src/SIS_utils.F90 | 2 +- 3 files changed, 20 insertions(+), 16 deletions(-) diff --git a/src/SIS_fixed_initialization.F90 b/src/SIS_fixed_initialization.F90 index 0dd9d5a1..d96be872 100644 --- a/src/SIS_fixed_initialization.F90 +++ b/src/SIS_fixed_initialization.F90 @@ -65,17 +65,17 @@ subroutine SIS_initialize_fixed(G, US, PF, write_geom, output_dir) call set_grid_metrics(G, PF, US) ! Set up the bottom depth, G%bathyT, either analytically or from a file - call SIS_initialize_topography(G%bathyT, G%max_depth, G, PF) + call SIS_initialize_topography(G%bathyT, G%max_depth, G, PF, US) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) ! Initialize the various masks and any masked metrics. - call initialize_masks(G, PF) + call initialize_masks(G, PF, US) if (debug) then call hchksum(G%bathyT, 'SIS_initialize_fixed: depth ', G%HI, & - haloshift=min(1, G%ied-G%iec, G%jed-G%jec)) + haloshift=min(1, G%ied-G%iec, G%jed-G%jec), scale=US%Z_to_m) call hchksum(G%mask2dT, 'SIS_initialize_fixed: mask2dT ', G%HI) call uvchksum('SIS_initialize_fixed: mask2dC[uv] ', & G%mask2dCu, G%mask2dCv, G) @@ -120,7 +120,7 @@ subroutine SIS_initialize_fixed(G, US, PF, write_geom, output_dir) ! Write out all of the grid data used by this run. if (write_geom) call write_ocean_geometry_file(G, PF, output_dir, & - geom_file="sea_ice_geometry") + geom_file="sea_ice_geometry", US=US) call callTree_leave('SIS_initialize_fixed()') @@ -128,12 +128,13 @@ end subroutine SIS_initialize_fixed !> SIS_initialize_topography makes the appropriate call to set up the bathymetry. !! It is very similar to MOM_initialize_topography, but with fewer options. -subroutine SIS_initialize_topography(D, max_depth, G, PF) +subroutine SIS_initialize_topography(D, max_depth, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(out) :: D !< Ocean bottom depth in m type(param_file_type), intent(in) :: PF !< Parameter file structure - real, intent(out) :: max_depth !< Maximum depth of model in m + real, intent(out) :: max_depth !< Maximum depth of model [m or Z ~> m] + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with @@ -141,6 +142,7 @@ subroutine SIS_initialize_topography(D, max_depth, G, PF) ! Set up the bottom depth, G%bathyT either analytically or from file character(len=40) :: mdl = "SIS_initialize_topography" ! This subroutine's name. character(len=200) :: config + real :: Z_to_m call get_param(PF, mdl, "TOPO_CONFIG", config, & "This specifies how bathymetry is specified: \n"//& @@ -166,24 +168,26 @@ subroutine SIS_initialize_topography(D, max_depth, G, PF) ! fail_if_missing=.true.) max_depth = -1.e9; call read_param(PF, "MAXIMUM_DEPTH", max_depth) select case ( trim(config) ) - case ("file"); call initialize_topography_from_file(D, G, PF) - case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth) - case ("spoon"); call initialize_topography_named(D, G, PF, config, max_depth) - case ("bowl"); call initialize_topography_named(D, G, PF, config, max_depth) - case ("halfpipe"); call initialize_topography_named(D, G, PF, config, max_depth) + case ("file"); call initialize_topography_from_file(D, G, PF, US) + case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) + case ("spoon"); call initialize_topography_named(D, G, PF, config, max_depth, US) + case ("bowl"); call initialize_topography_named(D, G, PF, config, max_depth, US) + case ("halfpipe"); call initialize_topography_named(D, G, PF, config, max_depth, US) case default ; call MOM_error(FATAL,"SIS_initialize_topography: "// & "Unrecognized topography setup '"//trim(config)//"'") end select + + Z_to_m = 1.0 ; if (present(US)) Z_to_m = US%Z_to_m if (max_depth>0.) then - call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, & + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*Z_to_m, & "The maximum depth of the ocean.", units="m") else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth, & + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*Z_to_m, & "The (diagnosed) maximum depth of the ocean.", units="m") endif if (trim(config) .ne. "DOME") then - call limit_topography(D, G, PF, max_depth) + call limit_topography(D, G, PF, max_depth, US) endif end subroutine SIS_initialize_topography diff --git a/src/SIS_hor_grid.F90 b/src/SIS_hor_grid.F90 index 947fa0e6..9322f12d 100644 --- a/src/SIS_hor_grid.F90 +++ b/src/SIS_hor_grid.F90 @@ -142,7 +142,7 @@ module SIS_hor_grid ! Except on a Cartesian grid, these are usually some variant of "degrees". real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - bathyT !< Ocean bottom depth at tracer points [m]. + bathyT !< Ocean bottom depth at tracer points [Z ~> m]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & diff --git a/src/SIS_utils.F90 b/src/SIS_utils.F90 index 4f9b67c8..1762b40b 100644 --- a/src/SIS_utils.F90 +++ b/src/SIS_utils.F90 @@ -338,7 +338,7 @@ subroutine ice_grid_chksum(G, US, haloshift) call uvchksum("G%areaC[uv]", G%areaCu, G%areaCv, G, halos=hs, scale=US%L_to_m**2) call uvchksum("G%IareaC[uv]", G%IareaCu, G%IareaCv, G, halos=hs, scale=US%m_to_L**2) - call hchksum(G%bathyT, "G%bathyT", G%HI, haloshift=hs) + call hchksum(G%bathyT, "G%bathyT", G%HI, haloshift=hs, scale=US%Z_to_m) call Bchksum(G%CoriolisBu, "G%CoriolisBu", G%HI, haloshift=hs, scale=US%s_to_T) call hchksum_pair("G%dF_d[xy]", G%dF_dx, G%dF_dy, G, halos=hs, scale=US%s_to_T*US%m_to_L) From b5263a4b76b1a7982c82431f5034b9177b398b02 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 17 Oct 2019 18:50:34 -0400 Subject: [PATCH 05/24] +Add conversion arg to register_SIS_diag_field Added optional conversion arguments to register_SIS_diag_field, which allow diagnostics to be rescaled after they are posted. All answers are bitwise identical, but there are new optional arguments to a public interface. --- src/SIS_diag_mediator.F90 | 77 +++++++++++++++++++++++++++++---------- 1 file changed, 58 insertions(+), 19 deletions(-) diff --git a/src/SIS_diag_mediator.F90 b/src/SIS_diag_mediator.F90 index 86accbed..d46dce6f 100644 --- a/src/SIS_diag_mediator.F90 +++ b/src/SIS_diag_mediator.F90 @@ -45,6 +45,7 @@ module SIS_diag_mediator logical :: in_use !< This diagnostic is in use integer :: fms_diag_id !< underlying FMS diag id character(len=24) :: name !< The diagnostic name + real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero. real, pointer, dimension(:,:) :: mask2d => null() !< A 2-d mask on the data domain for this diagnostic real, pointer, dimension(:,:) :: mask2d_comp => null() !< A 2-d mask on the computational domain for this diagnostic real, pointer, dimension(:,:,:) :: mask3d => null() !< A 3-d mask for this diagnostic @@ -281,19 +282,21 @@ end subroutine set_SIS_diag_mediator_grid 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. - real, intent(in) :: field(:,:) !< The 2-d array being offered for output or averaging. + 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 logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. logical, optional, intent(in) :: mask(:,:) !< If present, use this logical array as the data mask. ! Local variables + real, dimension(:,:), pointer :: locfield logical :: used, is_stat logical :: i_data, j_data - integer :: isv, iev, jsv, jev + integer :: isv, iev, jsv, jev, i, j integer :: fms_diag_id type(diag_type), pointer :: diag => NULL() + locfield => NULL() is_stat = .false. ; if (present(is_static)) is_stat = is_static ! Get a pointer to the SIS diag type for this id, and the FMS-level diag id. @@ -332,6 +335,20 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask) call SIS_error(FATAL,"post_SIS_data_2d: peculiar size in j-direction "//trim(diag%name)) endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then + allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2) ) ) + do j=jsv,jev ; do i=isv,iev + if (field(i,j) == diag_cs%missing_value) then + locfield(i,j) = diag_cs%missing_value + else + locfield(i,j) = field(i,j) * diag%conversion_factor + endif + enddo ; enddo + locfield(isv:iev,jsv:jev) = field(isv:iev,jsv:jev) * diag%conversion_factor + else + locfield => field + endif + ! Handle cases where the data and computational domain are the same size. if (diag_cs%ied-diag_cs%isd == diag_cs%ie-diag_cs%is) i_data = j_data if (diag_cs%jed-diag_cs%jsd == diag_cs%je-diag_cs%js) j_data = i_data @@ -349,54 +366,57 @@ 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, field, & + used = send_data(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, field, & + used = send_data(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, field, & + used = send_data(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, field, & + used = send_data(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, field, diag_cs%time_end, & + used = send_data(fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, mask=mask) elseif(i_data .and. associated(diag%mask2d)) then - used = send_data(fms_diag_id, field, diag_cs%time_end, & + used = send_data(fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=diag%mask2d) elseif((.not.i_data) .and. associated(diag%mask2d_comp)) then - used = send_data(fms_diag_id, field, diag_cs%time_end, & + used = send_data(fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=diag%mask2d_comp) else - used = send_data(fms_diag_id, field, diag_cs%time_end, & + used = send_data(fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int) endif endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.) ) deallocate( locfield ) + 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. - real, intent(in) :: field(:,:,:) !< The 3-d array being offered for output or averaging. + 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 logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. logical, optional, intent(in) :: mask(:,:,:) !< If present, use this logical array as the data mask. ! Local variables + real, dimension(:,:,:), pointer :: locfield logical :: used ! The return value of send_data is not used for anything. logical :: is_stat - integer :: isv, iev, jsv, jev + integer :: isv, iev, jsv, jev, i, j, k, ks, ke integer :: fms_diag_id type(diag_type), pointer :: diag => NULL() @@ -438,6 +458,20 @@ subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask) call SIS_error(FATAL,"post_SIS_data_3d: peculiar size in j-direction") endif + ks = lbound(field,3) ; ke = ubound(field,3) + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then + allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2), ks:ke ) ) + do k=ks,ke ; do j=jsv,jev ; do i=isv,iev + if (field(i,j,k) == diag_cs%missing_value) then + locfield(i,j,k) = diag_cs%missing_value + else + locfield(i,j,k) = field(i,j,k) * diag%conversion_factor + endif + enddo ; enddo ; enddo + else + locfield => field + endif + if (present(mask)) then if ((size(field,1) /= size(mask,1)) .or. & (size(field,2) /= size(mask,2)) .or. & @@ -449,31 +483,33 @@ 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, field, & + used = send_data(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, field, & + used = send_data(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, field, & + used = send_data(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, field, diag_cs%time_end, & + used = send_data(fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, mask=mask) elseif(associated(diag%mask3d)) then - used = send_data(fms_diag_id, field, diag_cs%time_end, & + used = send_data(fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=diag%mask3d) else - used = send_data(fms_diag_id, field, diag_cs%time_end, & + used = send_data(fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int) endif endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.) ) deallocate( locfield ) + end subroutine post_data_3d !> Enable the accumulation of time averages over the specified time interval. @@ -525,7 +561,7 @@ end function get_SIS_diag_time_end !> Returns the "SIS_diag_mediator" handle for a group of diagnostics derived from one field. function register_SIS_diag_field(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count) result (register_diag_field) + verbose, do_not_log, err_msg, interp_method, tile_count, conversion) result (register_diag_field) integer :: register_diag_field !< The returned diagnostic handle character(len=*), intent(in) :: module_name !< Name of this module, usually "ice_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -545,6 +581,7 @@ function register_SIS_diag_field(module_name, field_name, axes, init_time, & character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not !! be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in SIS?) + real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file ! Local variables character(len=240) :: mesg @@ -572,6 +609,8 @@ function register_SIS_diag_field(module_name, field_name, axes, init_time, & if (len(field_name) > len(diag%name)) then diag%name = field_name(1:len(diag%name)) else ; diag%name = field_name ; endif + + if (present(conversion)) diag%conversion_factor = conversion endif if (is_root_pe() .and. diag_CS%doc_unit > 0) then From 68e01da3006bd164dd57e1ea17dc50174798a1f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 17 Oct 2019 18:59:42 -0400 Subject: [PATCH 06/24] +Rescaled many variables in SIS_C_dynamics Rescaled multiple variables passed to or used in SIS_C_dynamics for dimensional consistency testing. Also rescaled velocities passed to slab_ice_advect. All answers are bitwise identical in the Baltic test case, but there is dimensional rescaling of arguments to two public interfaces and a new unit_scale_type argument to another. --- src/SIS_dyn_cgrid.F90 | 390 ++++++++++++++++++++++-------------------- src/SIS_dyn_trans.F90 | 49 ++++-- src/ice_model.F90 | 2 +- src/slab_ice.F90 | 40 ++--- 4 files changed, 267 insertions(+), 214 deletions(-) diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index 355e2ca9..952ac78d 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -43,20 +43,20 @@ module SIS_dyn_cgrid !> The control structure with parameters regulating C-grid ice dynamics type, public :: SIS_C_dyn_CS ; private real, allocatable, dimension(:,:) :: & - str_t, & !< The tension stress tensor component [Pa m]. + str_t, & !< The tension stress tensor component [Pa m] will become [kg m-2 L2 T-2 ~> Pa m]. str_d, & !< The divergence stress tensor component [Pa m]. str_s !< The shearing stress tensor component (cross term) [Pa m]. ! parameters for calculating water drag and internal ice stresses - real :: p0 = 2.75e4 !< Pressure constant in the Hibbler rheology (Pa) - real :: p0_rho !< The pressure constant divided by ice density, N m kg-1. + real :: p0 = 2.75e4 !< Pressure constant in the Hibbler rheology [Pa] + real :: p0_rho !< The pressure constant divided by ice density [N m kg-1]. real :: c0 = 20.0 !< another pressure constant real :: cdw = 3.24e-3 !< ice/water drag coef. [nondim] real :: EC = 2.0 !< yield curve axis ratio real :: Rho_ocean = 1030.0 !< The nominal density of sea water [kg m-3]. real :: Rho_ice = 905.0 !< The nominal density of sea ice [kg m-3]. real :: drag_bg_vel2 = 0.0 !< A background (subgridscale) velocity for drag - !< with the ocean squared [m2 s-2]. + !< with the ocean squared [L2 T-2 ~> m2 s-2]. real :: min_ocn_inertial_h = 0. !< A minimum ocean thickness used to limit the viscous coupling !! rate implied for the ocean by the ice-ocean stress. real :: Tdamp !< The damping timescale of the stress tensor components toward @@ -87,7 +87,7 @@ module SIS_dyn_cgrid !! Otherwise they go to -P_ice. This setting is temporary. integer :: evp_sub_steps !< The number of iterations in the EVP dynamics !! for each slow time step. - real :: dt_Rheo !< The maximum sub-cycling time step for the EVP dynamics. + real :: dt_Rheo !< The maximum sub-cycling time step for the EVP dynamics [T ~> s]. type(time_type), pointer :: Time => NULL() !< A pointer to the ice model's clock. type(SIS_diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -132,10 +132,11 @@ module SIS_dyn_cgrid !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_C_dyn_init initializes the ice dynamics, sets parameters, and registers diagnostics -subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) +subroutine SIS_C_dyn_init(Time, G, US, param_file, diag, CS, ntrunc) type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, !! set with the current model time. type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(SIS_diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module @@ -169,7 +170,7 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) "The sub-cycling time step for iterating the rheology \n"//& "and ice momentum equations. If DT_RHEOLOGY is negative, \n"//& "the time step is set via NSTEPS_DYN.", units="seconds", & - default=-1.0) + default=-1.0, scale=US%s_to_T) CS%evp_sub_steps = -1 if (CS%dt_Rheo <= 0.0) & call get_param(param_file, mdl, "NSTEPS_DYN", CS%evp_sub_steps, & @@ -281,47 +282,55 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) CS%id_stren0 = register_diag_field('ice_model','STREN_0' ,diag%axesT1, Time, & 'ice strength at start of rheology', 'Pa*m', missing_value=missing) CS%id_fix = register_diag_field('ice_model', 'FI_X', diag%axesCu1, Time, & - 'ice internal stress - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice internal stress - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fiy = register_diag_field('ice_model', 'FI_Y', diag%axesCv1, Time, & - 'ice internal stress - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice internal stress - y component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fcx = register_diag_field('ice_model', 'FC_X', diag%axesCu1, Time, & - 'Coriolis force - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'Coriolis force - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fcy = register_diag_field('ice_model', 'FC_Y', diag%axesCv1, Time, & - 'Coriolis force - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'Coriolis force - y component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_Coru = register_diag_field('ice_model', 'Cor_ui', diag%axesCu1, Time,& - 'Coriolis ice acceleration - x component', 'm s-2', & + 'Coriolis ice acceleration - x component', & + 'm s-2', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') CS%id_Corv = register_diag_field('ice_model', 'Cor_vi', diag%axesCv1, Time,& - 'Coriolis ice acceleration - y component', 'm s-2', & + 'Coriolis ice acceleration - y component', & + 'm s-2', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') CS%id_fpx = register_diag_field('ice_model', 'FP_X', diag%axesCu1, Time, & - 'Pressure force - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'Pressure force - x component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fpy = register_diag_field('ice_model', 'FP_Y', diag%axesCv1, Time, & - 'Pressure force - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'Pressure force - y component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_PFu = register_diag_field('ice_model', 'Pfa_ui', diag%axesCu1, Time, & - 'Pressure-force ice acceleration - x component', 'm s-2', & + 'Pressure-force ice acceleration - x component', & + 'm s-2', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') CS%id_PFv = register_diag_field('ice_model', 'Pfa_vi', diag%axesCv1, Time, & - 'Pressure-force ice acceleration - y component', 'm s-2', & + 'Pressure-force ice acceleration - y component', & + 'm s-2', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') CS%id_fwx = register_diag_field('ice_model', 'FW_X', diag%axesCu1, Time, & - 'water stress on ice - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'water stress on ice - x component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fwy = register_diag_field('ice_model', 'FW_Y', diag%axesCv1, Time, & - 'water stress on ice - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'water stress on ice - y component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_ui = register_diag_field('ice_model', 'UI', diag%axesCu1, Time, & 'ice velocity - x component', 'm/s', missing_value=missing, & - interp_method='none') + interp_method='none', conversion=US%L_T_to_m_s) CS%id_vi = register_diag_field('ice_model', 'VI', diag%axesCv1, Time, & 'ice velocity - y component', 'm/s', missing_value=missing, & - interp_method='none') + interp_method='none', conversion=US%L_T_to_m_s) CS%id_mis = register_diag_field('ice_model', 'MIS_tot', diag%axesT1, Time, & 'Mass of ice and snow at t-points', 'kg m-2', missing_value=missing) CS%id_ci0 = register_diag_field('ice_model', 'CI_tot', diag%axesT1, Time, & @@ -338,23 +347,29 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) missing_value=missing, interp_method='none') CS%id_fix_d = register_diag_field('ice_model', 'FI_d_X', diag%axesCu1, Time, & - 'ice divergence internal stress - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice divergence internal stress - x component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fiy_d = register_diag_field('ice_model', 'FI_d_Y', diag%axesCv1, Time, & - 'ice divergence internal stress - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice divergence internal stress - y component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fix_t = register_diag_field('ice_model', 'FI_t_X', diag%axesCu1, Time, & - 'ice tension internal stress - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice tension internal stress - x component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fiy_t = register_diag_field('ice_model', 'FI_t_Y', diag%axesCv1, Time, & - 'ice tension internal stress - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice tension internal stress - y component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fix_s = register_diag_field('ice_model', 'FI_s_X', diag%axesCu1, Time, & - 'ice shearing internal stress - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice shearing internal stress - x component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fiy_s = register_diag_field('ice_model', 'FI_s_Y', diag%axesCv1, Time, & - 'ice shearing internal stress - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice shearing internal stress - y component', & + 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_str_d = register_diag_field('ice_model', 'str_d', diag%axesT1, Time, & 'ice divergence internal stress', 'Pa', missing_value=missing) @@ -363,22 +378,22 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) CS%id_str_s = register_diag_field('ice_model', 'str_s', diag%axesB1, Time, & 'ice shearing internal stress', 'Pa', missing_value=missing) CS%id_sh_d = register_diag_field('ice_model', 'sh_d', diag%axesT1, Time, & - 'ice divergence strain rate', 's-1', missing_value=missing) + 'ice divergence strain rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_sh_t = register_diag_field('ice_model', 'sh_t', diag%axesT1, Time, & - 'ice tension strain rate', 's-1', missing_value=missing) + 'ice tension strain rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_sh_s = register_diag_field('ice_model', 'sh_s', diag%axesB1, Time, & - 'ice shearing strain rate', 's-1', missing_value=missing) + 'ice shearing strain rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_del_sh = register_diag_field('ice_model', 'del_sh', diag%axesT1, Time, & - 'ice strain rate magnitude', 's-1', missing_value=missing) + 'ice strain rate magnitude', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_del_sh_min = register_diag_field('ice_model', 'del_sh_min', diag%axesT1, Time, & - 'minimum ice strain rate magnitude', 's-1', missing_value=missing) + 'minimum ice strain rate magnitude', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_ui_hifreq = register_diag_field('ice_model', 'ui_hf', diag%axesCu1, Time, & 'ice velocity - x component', 'm/s', missing_value=missing, & - interp_method='none') + interp_method='none', conversion=US%L_T_to_m_s) CS%id_vi_hifreq = register_diag_field('ice_model', 'vi_hf', diag%axesCv1, Time, & 'ice velocity - y component', 'm/s', missing_value=missing, & - interp_method='none') + interp_method='none, conversion=US%L_T_to_m_s') CS%id_str_d_hifreq = register_diag_field('ice_model', 'str_d_hf', diag%axesT1, Time, & 'ice divergence internal stress', 'Pa', missing_value=missing) CS%id_str_t_hifreq = register_diag_field('ice_model', 'str_t_hf', diag%axesT1, Time, & @@ -386,11 +401,11 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) CS%id_str_s_hifreq = register_diag_field('ice_model', 'str_s_hf', diag%axesB1, Time, & 'ice shearing internal stress', 'Pa', missing_value=missing) CS%id_sh_d_hifreq = register_diag_field('ice_model', 'sh_d_hf', diag%axesT1, Time, & - 'ice divergence rate', 's-1', missing_value=missing) + 'ice divergence rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_sh_t_hifreq = register_diag_field('ice_model', 'sh_t_hf', diag%axesT1, Time, & - 'ice tension rate', 's-1', missing_value=missing) + 'ice tension rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_sh_s_hifreq = register_diag_field('ice_model', 'sh_s_hf', diag%axesB1, Time, & - 'ice shearing rate', 's-1', missing_value=missing) + 'ice shearing rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_sigi_hifreq = register_diag_field('ice_model','sigI_hf' ,diag%axesT1, Time, & 'first stress invariant', 'none', missing_value=missing) CS%id_sigii_hifreq = register_diag_field('ice_model','sigII_hf' ,diag%axesT1, Time, & @@ -402,12 +417,12 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) CS%id_siu = register_diag_field('ice_model', 'siu', diag%axesT1, Time, & 'ice velocity - x component', 'm/s', missing_value=missing, & - interp_method='none') + interp_method='none', conversion=US%L_T_to_m_s) CS%id_siv = register_diag_field('ice_model', 'siv', diag%axesT1, Time, & 'ice velocity - y component', 'm/s', missing_value=missing, & - interp_method='none') + interp_method='none', conversion=US%L_T_to_m_s) CS%id_sispeed = register_diag_field('ice_model', 'sispeed', diag%axesT1, Time, & - 'ice speed', 'm/s', missing_value=missing) + 'ice speed', 'm/s', missing_value=missing, conversion=US%L_T_to_m_s) end subroutine SIS_C_dyn_init @@ -441,97 +456,98 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: mis !< Mass per unit ocean area of sea ice, !! snow and melt pond water [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: mice !< Mass per unit ocean area of sea ice [kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ui !< Zonal ice velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity [m s-1] - real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uo !< Zonal ocean velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity [m s-1] - real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: fxat !< Zonal air stress on ice [Pa] - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice [Pa] + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ui !< Zonal ice velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uo !< Zonal ocean velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: fxat !< Zonal air stress on ice [kg m-2 L T-2 ~> Pa] + real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: sea_lev !< The height of the sea level, including !! contributions from non-levitating ice from !! an earlier time step [m]. - real, dimension(SZIB_(G),SZJ_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean [Pa] - real, dimension(SZI_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean [Pa] + real, dimension(SZIB_(G),SZJ_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean [kg m-2 L T-2 ~> Pa] + real, dimension(SZI_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean [kg m-2 L T-2 ~> Pa] real, intent(in ) :: dt_slow !< The amount of time over which the ice - !! dynamics are to be advanced [s]. + !! dynamics are to be advanced [T ~> s]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & sh_Dt, & ! sh_Dt is the horizontal tension (du/dx - dv/dy) including - ! all metric terms [s-1]. + ! all metric terms [T-1 ~> s-1]. sh_Dd ! sh_Dd is the flow divergence (du/dx + dv/dy) including all - ! metric terms [s-1]. + ! metric terms [T-1 ~> s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & sh_Ds ! sh_Ds is the horizontal shearing strain (du/dy + dv/dx) - ! including all metric terms [s-1]. + ! including all metric terms [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & pres_mice, & ! The ice internal pressure per unit column mass [N m kg-1]. ci_proj, & ! The projected ice concentration [nondim]. - zeta, & ! The ice bulk viscosity [Pa m s] (i.e., [N s m-1]). - del_sh, & ! The magnitude of the shear rates [s-1]. + zeta, & ! The ice bulk viscosity [Pa m T ~> Pa m s] (i.e., [N s m-1]). + del_sh, & ! The magnitude of the shear rates [T-1 ~> s-1]. diag_val, & ! A temporary diagnostic array. del_sh_min_pr, & ! When multiplied by pres_mice, this gives the minimum - ! value of del_sh that is used in the calculation of zeta [s-1]. + ! value of del_sh that is used in the calculation of zeta [T-1 ~> s-1]. ! This is set based on considerations of numerical stability, ! and varies with the grid spacing. dx2T, dy2T, & ! dx^2 or dy^2 at T points [m2]. dx_dyT, dy_dxT, & ! dx/dy or dy_dx at T points [nondim]. - siu, siv, sispeed ! diagnostics on T points [m s-1]. + siu, siv, sispeed ! diagnostics on T points [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G)) :: & - fxic, & ! Zonal force due to internal stresses [Pa]. + fxic, & ! Zonal force due to internal stresses [kg m-2 L T-2 ~> Pa]. fxic_d, fxic_t, fxic_s, & ui_min_trunc, & ! The range of v-velocities beyond which the velocities - ui_max_trunc, & ! are truncated [m s-1], or 0 for land cells. - Cor_u, & ! Zonal Coriolis acceleration [m s-2]. - PFu, & ! Zonal hydrostatic pressure driven acceleration [m s-2]. + ui_max_trunc, & ! are truncated [L T-1 ~> m s-1], or 0 for land cells. + Cor_u, & ! Zonal Coriolis acceleration [L T-2 ~> m s-2]. + PFu, & ! Zonal hydrostatic pressure driven acceleration [L T-2 ~> m s-2]. diag_val_u, & ! A temporary diagnostic array. - u_tmp, & ! A temporary copy of the old values of ui [m s-1]. - u_IC, & ! The initial zonal ice velocities [m s-1]. + u_tmp, & ! A temporary copy of the old values of ui [L T-1 ~> m s-1]. + u_IC, & ! The initial zonal ice velocities [L T-1 ~> m s-1]. mi_u, & ! The total ice and snow mass interpolated to u points [kg m-2]. f2dt_u, &! The squared effective Coriolis parameter at u-points times a - ! time step [s-1]. + ! time step [T-1 ~> s-1]. I1_f2dt2_u ! 1 / ( 1 + f^2 dt^2) at u-points [nondim]. real, dimension(SZI_(G),SZJB_(G)) :: & - fyic, & ! Meridional force due to internal stresses [Pa]. + fyic, & ! Meridional force due to internal stresses [kg m-2 L T-2 ~> Pa]. fyic_d, fyic_t, fyic_s, & vi_min_trunc, & ! The range of v-velocities beyond which the velocities vi_max_trunc, & ! are truncated [m s-1], or 0 for land cells. - Cor_v, & ! Meridional Coriolis acceleration [m s-2]. - PFv, & ! Meridional hydrostatic pressure driven acceleration [m s-2]. + Cor_v, & ! Meridional Coriolis acceleration [L T-2 ~> m s-2]. + PFv, & ! Meridional hydrostatic pressure driven acceleration [L T-2 ~> m s-2]. diag_val_v, & ! A temporary diagnostic array. - v_IC, & ! The initial meridional ice velocities [m s-1]. + v_IC, & ! The initial meridional ice velocities [L T-1 ~> m s-1]. mi_v, & ! The total ice and snow mass interpolated to v points [kg m-2]. f2dt_v, &! The squared effective Coriolis parameter at v-points times a - ! time step [s-1]. + ! time step [T-1 ~> s-1]. I1_f2dt2_v ! 1 / ( 1 + f^2 dt^2) at v-points [nondim]. real, dimension(SZIB_(G),SZJB_(G)) :: & mi_ratio_A_q, & ! A ratio of the masses interpolated to the faces around a ! vorticity point that ranges between (4 mi_min/mi_max) and 1, - ! divided by the sum of the ocean areas around a point [m-2]. + ! divided by the sum of the ocean areas around a point [L-2 ~> m-2]. q, & ! A potential-vorticity-like field for the ice, the Coriolis parameter - ! divided by a spatially averaged mass per unit area [s-1 m2 kg-1]. + ! divided by a spatially averaged mass per unit area [T-1 m2 kg-1 ~> s-1 m2 kg-1]. dx2B, dy2B, & ! dx^2 or dy^2 at B points [L2 ~> m2]. dx_dyB, dy_dxB ! dx/dy or dy_dx at B points [nondim]. real, dimension(SZIB_(G),SZJ_(G)) :: & azon, bzon, & ! _zon & _mer are the values of the Coriolis force which czon, dzon, & ! are applied to the neighboring values of vi & ui, amer, bmer, & ! respectively to get the barotropic inertial rotation, - cmer, dmer ! in units of s-1. azon and amer couple the same pair of + cmer, dmer ! in units of [T-1 ~> s-1]. azon and amer couple the same pair of ! velocities, but with the influence going in opposite ! directions. - real :: Cor ! A Coriolis accleration [m s-2]. - real :: fxic_now, fyic_now ! ice internal stress convergence [kg m-1 s-2]. - real :: drag_u, drag_v ! Drag rates with the ocean at u & v points [kg m-2 s-1]. - real :: drag_max ! A maximum drag rate allowed in the ocean [kg m-2 s-1]. + real :: Cor ! A Coriolis accleration [L T-2 ~> m s-2]. + real :: fxic_now ! Zonal ice internal stress convergence [kg m-2 L T-2 ~> kg m-1 s-2]. + real :: fyic_now ! Meridional ice internal stress convergence [kg m-2 L T-2 ~> kg m-1 s-2]. + real :: drag_u, drag_v ! Drag rates with the ocean at u & v points [kg m-2 T-1 ~> kg m-2 s-1]. + real :: drag_max ! A maximum drag rate allowed in the ocean [kg m-2 T-1 ~> kg m-2 s-1]. real :: tot_area ! The sum of the area of the four neighboring cells [L2 ~> m2]. - real :: dxharm ! The harmonic mean of the x- and y- grid spacings [m]. + real :: dxharm ! The harmonic mean of the x- and y- grid spacings [L ~> m]. real :: muq2, mvq2 ! The product of the u- and v-face masses per unit cell ! area surrounding a vorticity point [kg2 m-4]. real :: muq, mvq ! The u- and v-face masses per unit cell area extrapolated @@ -541,23 +557,29 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & real :: I_1pdt_T ! 1.0 / (1.0 + dt_2Tdamp) [nondim]. real :: I_1pE2dt_T ! 1.0 / (1.0 + EC^2 * dt_2Tdamp) [nondim]. - real :: v2_at_u ! The squared v-velocity interpolated to u points [m s-1]. - real :: u2_at_v ! The squared u-velocity interpolated to v points [m s-1]. - real :: uio_init, m_uio_explicit, uio_pred ! , uio - real :: vio_init, m_vio_explicit, vio_pred ! , vio - real :: I_cdRhoDt, cdRho + real :: v2_at_u ! The squared v-velocity interpolated to u points [L2 T-2 ~> m2 s-2]. + real :: u2_at_v ! The squared u-velocity interpolated to v points [L2 T-2 ~> m2 s-2]. + real :: uio_init ! Ice-ocean velocity differences [L T-1 ~> m s-1] + real :: vio_init ! Ice-ocean velocity differences [L T-1 ~> m s-1] + real :: m_uio_explicit ! Ice-ocean velocity differences [L T-1 ~> m s-1] + real :: m_vio_explicit ! Ice-ocean velocity differences [L T-1 ~> m s-1] + real :: uio_pred ! Ice-ocean velocity differences [L T-1 ~> m s-1] + real :: vio_pred ! Ice-ocean velocity differences [L T-1 ~> m s-1] + real :: I_cdRhoDt ! The inverse of the product of the drag coefficient, ocean density and + ! timestep [m3 kg-1 s=1]. + real :: cdRho ! The ice density times the drag coefficient and rescaling factors [kg m-2 L-1 ~> kg m-3] real :: b_vel0 ! The initial difference between the velocity magnitude ! and the absolute value of the u- or v- component, plus ! the ice thickness divided by the time step and the drag - ! coefficient [m s-1]. - real :: uio_C ! A u-velocity difference between the ocean and ice [m s-1]. - real :: vio_C ! A v-velocity difference between the ocean and ice [m s-1]. + ! coefficient [L T-1 ~> m s-1]. + real :: uio_C ! A u-velocity difference between the ocean and ice [L T-1 ~> m s-1]. + real :: vio_C ! A v-velocity difference between the ocean and ice [L T-1 ~> m s-1]. real :: Tdamp ! The damping timescale of the stress tensor components - ! toward their equilibrium solution due to the elastic terms [s]. - real :: dt ! The short timestep associated with the EVP dynamics [s]. - real :: dt_2Tdamp ! The ratio of the timestep to the elastic damping timescale. - real :: dt_cumulative ! The elapsed time within this call to EVP dynamics [s]. + ! toward their equilibrium solution due to the elastic terms [T ~> s]. + real :: dt ! The short timestep associated with the EVP dynamics [T ~> s]. + real :: dt_2Tdamp ! The ratio of the timestep to the elastic damping timescale [nondim]. + real :: dt_cumulative ! The elapsed time within this call to EVP dynamics [T ~> s]. integer :: EVP_steps ! The number of EVP sub-steps that will actually be taken. real :: I_sub_steps ! The number inverse of the number of EVP time steps per ! slow time step. @@ -616,7 +638,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & dt = dt_slow/EVP_steps drag_max = CS%Rho_ocean * CS%min_ocn_inertial_h / dt_slow - I_cdRhoDt = 1.0 / (CS%cdw * CS%Rho_ocean * dt) + I_cdRhoDt = 1.0 / (CS%cdw * US%L_to_m*CS%Rho_ocean * dt) do_trunc_its = (CS%CFL_check_its .and. (CS%CFL_trunc > 0.0) .and. (dt_slow > 0.0)) EC2 = CS%EC**2 @@ -632,10 +654,10 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & (CS%id_ci_hifreq > 0) .or. (CS%id_stren_hifreq > 0)) then do_hifreq_output = query_SIS_averaging_enabled(CS%diag, time_int_in, time_end_in) if (do_hifreq_output) & - time_it_start = time_end_in - real_to_time(dt_slow) + time_it_start = time_end_in - real_to_time(US%T_to_s*dt_slow) endif - Tdamp = CS%Tdamp + Tdamp = US%s_to_T*CS%Tdamp if (CS%Tdamp == 0.0) then ! Hunke (2001) chooses a specified multiple (0.36) of dt_slow for Tdamp, and shows that ! stability requires Tdamp > 2*dt. Here 0.2 is used instead for greater stability. @@ -663,8 +685,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do j=jsc,jec do I=isc-1,iec ; if (G%dy_Cu(I,j) > 0.0) then - ui_min_trunc(I,j) = (-CS%CFL_trunc) * US%L_to_m*G%areaT(i+1,j) / (dt_slow*G%dy_Cu(I,j)) - ui_max_trunc(I,j) = CS%CFL_trunc * US%L_to_m*G%areaT(i,j) / (dt_slow*G%dy_Cu(I,j)) + ui_min_trunc(I,j) = (-CS%CFL_trunc) * G%areaT(i+1,j) / (dt_slow*G%dy_Cu(I,j)) + ui_max_trunc(I,j) = CS%CFL_trunc * G%areaT(i,j) / (dt_slow*G%dy_Cu(I,j)) endif ; enddo do I=isc-1,iec ; u_IC(I,j) = ui(I,j) ; enddo enddo @@ -672,8 +694,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do J=jsc-1,jec do i=isc,iec ; if (G%dx_Cv(i,J) > 0.0) then - vi_min_trunc(i,J) = (-CS%CFL_trunc) * US%L_to_m*G%areaT(i,j+1) / (dt_slow*G%dx_Cv(i,J)) - vi_max_trunc(i,J) = CS%CFL_trunc * US%L_to_m*G%areaT(i,j) / (dt_slow*G%dx_Cv(i,J)) + vi_min_trunc(i,J) = (-CS%CFL_trunc) * G%areaT(i,j+1) / (dt_slow*G%dx_Cv(i,J)) + vi_max_trunc(i,J) = CS%CFL_trunc * G%areaT(i,j) / (dt_slow*G%dx_Cv(i,J)) endif ; enddo do i=isc,iec ; v_IC(i,J) = vi(i,j) ; enddo enddo @@ -686,14 +708,14 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Precompute pres_mice and the minimum value of del_sh for stability. pres_mice(i,j) = CS%p0_rho*exp(-CS%c0*max(1.0-ci(i,j),0.0)) - dxharm = 2.0*US%L_to_m*G%dxT(i,j)*G%dyT(i,j) / (G%dxT(i,j) + G%dyT(i,j)) + dxharm = 2.0*G%dxT(i,j)*G%dyT(i,j) / (G%dxT(i,j) + G%dyT(i,j)) ! Setting a minimum value of del_sh is sufficient to guarantee numerical ! stability of the overall time-stepping for the velocities and stresses. ! Setting a minimum value of the shear magnitudes is equivalent to setting ! a maximum value of the effective lateral viscosities. ! I think that this is stable when CS%del_sh_min_scale >= 1. -RWH if (dxharm > 0.) then - del_sh_min_pr(i,j) = (2.0*CS%del_sh_min_scale * dt**2) / (Tdamp * dxharm**2) + del_sh_min_pr(i,j) = US%m_s_to_L_T**2*(2.0*CS%del_sh_min_scale * dt**2) / (Tdamp * dxharm**2) else del_sh_min_pr(i,j) = 0. endif @@ -734,9 +756,9 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do J=jsc-1,jec ; do I=isc-1,iec if (CS%weak_coast_stress) then - sum_area = US%L_to_m**2*((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i,j+1) + G%areaT(i+1,j))) + sum_area = ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i,j+1) + G%areaT(i+1,j))) else - sum_area = US%L_to_m**2*((G%mask2dT(i,j)*G%areaT(i,j) + G%mask2dT(i+1,j+1)*G%areaT(i+1,j+1)) + & + sum_area = ((G%mask2dT(i,j)*G%areaT(i,j) + G%mask2dT(i+1,j+1)*G%areaT(i+1,j+1)) + & (G%mask2dT(i,j+1)*G%areaT(i,j+1) + G%mask2dT(i+1,j)*G%areaT(i+1,j))) endif if (sum_area <= 0.0) then @@ -769,7 +791,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & else ! This is a straight coastline or all neighboring velocity points are ! masked out. In any case, with just 1 point, the ratio is always 1. - mi_ratio_A_q(I,J) = 1.0 / sum_area + mi_ratio_A_q(I,J) = 1.0 / (sum_area) endif enddo ; enddo !$OMP end do nowait @@ -786,7 +808,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do J=jsc-1,jec ; do I=isc-1,iec tot_area = ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) - q(I,J) = US%s_to_T*G%CoriolisBu(I,J) * tot_area / & + q(I,J) = G%CoriolisBu(I,J) * tot_area / & (((G%areaT(i,j) * mis(i,j) + G%areaT(i+1,j+1) * mis(i+1,j+1)) + & (G%areaT(i+1,j) * mis(i+1,j) + G%areaT(i,j+1) * mis(i,j+1))) + tot_area * m_neglect) enddo ; enddo @@ -803,7 +825,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & I1_f2dt2_u(I,j) = 1.0 / ( 1.0 + dt * f2dt_u(I,j) ) ! Calculate the zonal acceleration due to the sea level slope. - PFu(I,j) = -G%g_Earth*(sea_lev(i+1,j)-sea_lev(i,j)) * US%m_to_L*G%IdxCu(I,j) + PFu(I,j) = -US%m_s_to_L_T**2*G%g_Earth*(sea_lev(i+1,j)-sea_lev(i,j)) * G%IdxCu(I,j) enddo ; enddo !$OMP end do nowait !$OMP do @@ -819,15 +841,15 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & I1_f2dt2_v(i,J) = 1.0 / ( 1.0 + dt * f2dt_v(i,J) ) ! Calculate the meridional acceleration due to the sea level slope. - PFv(i,J) = -G%g_Earth*(sea_lev(i,j+1)-sea_lev(i,j)) * US%m_to_L*G%IdyCv(i,J) + PFv(i,J) = -US%m_s_to_L_T**2*G%g_Earth*(sea_lev(i,j+1)-sea_lev(i,j)) * G%IdyCv(i,J) enddo ; enddo !$OMP end parallel if (CS%debug .or. CS%debug_redundant) then - call uvchksum("PF[uv] in SIS_C_dynamics", PFu, PFv, G) - call uvchksum("f[xy]at in SIS_C_dynamics", fxat, fyat, G) - call uvchksum("[uv]i pre-steps SIS_C_dynamics", ui, vi, G) - call uvchksum("[uv]o in SIS_C_dynamics", uo, vo, G) + call uvchksum("PF[uv] in SIS_C_dynamics", PFu, PFv, G, scale=US%L_T_to_m_s*US%s_to_T) + call uvchksum("f[xy]at in SIS_C_dynamics", fxat, fyat, G, scale=US%L_T_to_m_s*US%s_to_T) + call uvchksum("[uv]i pre-steps SIS_C_dynamics", ui, vi, G, scale=US%L_T_to_m_s) + call uvchksum("[uv]o in SIS_C_dynamics", uo, vo, G, scale=US%L_T_to_m_s) endif dt_cumulative = 0.0 @@ -854,18 +876,18 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP dx_dyB,dy_dxB,ui,vi) do J=jsc-halo_sh_Ds,jec+halo_sh_Ds-1 ; do I=isc-halo_sh_Ds,iec+halo_sh_Ds-1 ! This uses a no-slip boundary condition. - sh_Ds(I,J) = (2.0-G%mask2dBu(I,J)) * US%m_to_L * & + sh_Ds(I,J) = (2.0-G%mask2dBu(I,J)) * & (dx_dyB(I,J)*(ui(I,j+1)*G%IdxCu(I,j+1) - ui(I,j)*G%IdxCu(I,j)) + & dy_dxB(I,J)*(vi(i+1,J)*G%IdyCv(i+1,J) - vi(i,J)*G%IdyCv(i,J))) enddo ; enddo if (halo_sh_Ds < 2) call pass_var(sh_Ds, G%Domain, position=CORNER) !$OMP parallel do default(none) shared(isc,iec,jsc,jec,sh_Dt,sh_Dd,dy_dxT,dx_dyT,G,ui,vi) do j=jsc-1,jec+1 ; do i=isc-1,iec+1 - sh_Dt(i,j) = US%m_to_L*(dy_dxT(i,j)*(G%IdyCu(I,j) * ui(I,j) - & + sh_Dt(i,j) = (dy_dxT(i,j)*(G%IdyCu(I,j) * ui(I,j) - & G%IdyCu(I-1,j)*ui(I-1,j)) - & dx_dyT(i,j)*(G%IdxCv(i,J) * vi(i,J) - & G%IdxCv(i,J-1)*vi(i,J-1))) - sh_Dd(i,j) = US%m_to_L*(G%IareaT(i,j)*(G%dyCu(I,j) * ui(I,j) - & + sh_Dd(i,j) = (G%IareaT(i,j)*(G%dyCu(I,j) * ui(I,j) - & G%dyCu(I-1,j)*ui(I-1,j)) + & G%IareaT(i,j)*(G%dxCv(i,J) * vi(i,J) - & G%dxCv(i,J-1)*vi(i,J-1))) @@ -933,13 +955,13 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & do J=jsc-1,jec ; do I=isc-1,iec ! zeta is already set to 0 over land. CS%str_s(I,J) = I_1pdt_T * ( CS%str_s(I,J) + (I_EC2 * dt_2Tdamp) * & - ( US%L_to_m**2*((G%areaT(i,j)*zeta(i,j) + G%areaT(i+1,j+1)*zeta(i+1,j+1)) + & - (G%areaT(i+1,j)*zeta(i+1,j) + G%areaT(i,j+1)*zeta(i,j+1))) * & + (((G%areaT(i,j)*zeta(i,j) + G%areaT(i+1,j+1)*zeta(i+1,j+1)) + & + (G%areaT(i+1,j)*zeta(i+1,j) + G%areaT(i,j+1)*zeta(i,j+1))) * & mi_ratio_A_q(I,J) * sh_Ds(I,J) ) ) enddo ; enddo - cdRho = CS%cdw * CS%Rho_ocean + cdRho = CS%cdw * US%L_to_m*CS%Rho_ocean ! Save the current values of u for later use in updating v. do I=isc-1,iec u_tmp(I,jsc-1) = ui(I,jsc-1) ; u_tmp(I,jec+1) = ui(I,jec+1) ; @@ -960,11 +982,11 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m x.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fxic_now = US%m_to_L*G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + US%m_to_L * & + fxic_now = US%m_s_to_L_T**2* (G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + & (G%IdyCu(I,j)*(dy2T(i+1,j)*CS%str_t(i+1,j) - & dy2T(i,j) *CS%str_t(i,j)) + & G%IdxCu(I,j)*(dx2B(I,J) *CS%str_s(I,J) - & - dx2B(I,J-1)*CS%str_s(I,J-1)) ) * G%IareaCu(I,j) + dx2B(I,J-1)*CS%str_s(I,J-1)) ) * G%IareaCu(I,j) ) v2_at_u = CS%drag_bg_vel2 + 0.25 * & (((vi(i,J)-vo(i,J))**2 + (vi(i+1,J-1)-vo(i+1,J-1))**2) + & ((vi(i+1,J)-vo(i+1,J))**2 + (vi(i,J-1)-vo(i,J-1))**2)) @@ -972,7 +994,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & uio_init = (ui(I,j)-uo(I,j)) ! Determine the Coriolis acceleration and sum for averages... - Cor_u(I,j) = Cor_u(I,j) + (Cor - f2dt_u(I,j) * ui(I,j)) * I1_f2dt2_u(I,j) + Cor_u(I,j) = Cor_u(I,j) + (Cor - f2dt_u(I,j) * ui(I,j)) * I1_f2dt2_u(I,j) if (CS%project_drag_vel) then ! Project the new u-velocity using a quasi-analytic implicit treatment for @@ -988,8 +1010,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & if (b_vel0**2 > 1e8*I_cdRhoDt*abs(m_uio_explicit)) then uio_pred = m_uio_explicit * I_cdRhoDt / b_vel0 else - uio_pred = 0.5 * (sqrt(b_vel0**2 + 4.0*I_cdRhoDt*abs(m_uio_explicit)) - & - b_vel0) + uio_pred = 0.5 * (sqrt(b_vel0**2 + 4.0*I_cdRhoDt*abs(m_uio_explicit)) - b_vel0) endif drag_u = cdRho * sqrt(max(uio_init**2, uio_pred**2) + v2_at_u ) endif @@ -1012,12 +1033,12 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! sum accelerations to take averages. fxic(I,j) = fxic(I,j) + fxic_now - if (CS%id_fix_d>0) fxic_d(I,j) = fxic_d(I,j) + G%mask2dCu(I,j) * US%m_to_L * & + if (CS%id_fix_d>0) fxic_d(I,j) = fxic_d(I,j) + G%mask2dCu(I,j) * US%m_s_to_L_T**2 * & G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) - if (CS%id_fix_t>0) fxic_t(I,j) = fxic_t(I,j) + G%mask2dCu(I,j) * US%m_to_L * & + if (CS%id_fix_t>0) fxic_t(I,j) = fxic_t(I,j) + G%mask2dCu(I,j) * US%m_s_to_L_T**2 * & G%IdyCu(I,j)*(dy2T(i+1,j)* CS%str_t(i+1,j) - & dy2T(i,j) * CS%str_t(i,j) ) * G%IareaCu(I,j) - if (CS%id_fix_s>0) fxic_s(I,j) = fxic_s(I,j) + G%mask2dCu(I,j) * US%m_to_L * & + if (CS%id_fix_s>0) fxic_s(I,j) = fxic_s(I,j) + G%mask2dCu(I,j) * US%m_s_to_L_T**2 * & G%IdxCu(I,j)*(dx2B(I,J) *CS%str_s(I,J) - & dx2B(I,J-1)*CS%str_s(I,J-1)) * G%IareaCu(I,j) @@ -1042,11 +1063,11 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m y.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fyic_now = US%m_to_L*G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + US%m_to_L * & + fyic_now = US%m_s_to_L_T**2 * (G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + & (-G%IdxCv(i,J)*(dx2T(i,j+1)*CS%str_t(i,j+1) - & dx2T(i,j) *CS%str_t(i,j)) + & G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & - dy2B(I-1,J)*CS%str_s(I-1,J)) )*G%IareaCv(i,J) + dy2B(I-1,J)*CS%str_s(I-1,J)) )*G%IareaCv(i,J) ) u2_at_v = CS%drag_bg_vel2 + 0.25 * & (((u_tmp(I,j)-uo(I,j))**2 + (u_tmp(I-1,j+1)-uo(I-1,j+1))**2) + & ((u_tmp(I,j+1)-uo(I,j+1))**2 + (u_tmp(I-1,j)-uo(I-1,j))**2)) @@ -1066,13 +1087,11 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & if (G%mask2dCv(i,J) > 0.0) then m_vio_explicit = vio_init*mi_v(i,J) + dt * & ((Cor + PFv(i,J))*mi_v(i,J) + (fyic_now + fyat(i,J))) - b_vel0 = mi_v(i,J) * I_cdRhoDt + & - (sqrt(vio_init**2 + u2_at_v) - abs(vio_init)) + b_vel0 = mi_v(i,J) * I_cdRhoDt + (sqrt(vio_init**2 + u2_at_v) - abs(vio_init)) if (b_vel0**2 > 1e8*I_cdRhoDt*abs(m_vio_explicit)) then vio_pred = m_vio_explicit * I_cdRhoDt / b_vel0 else - vio_pred = 0.5 * (sqrt(b_vel0**2 + 4.0*I_cdRhoDt*abs(m_vio_explicit)) - & - b_vel0) + vio_pred = 0.5 * (sqrt(b_vel0**2 + 4.0*I_cdRhoDt*abs(m_vio_explicit)) - b_vel0) endif drag_v = cdRho * sqrt(max(vio_init**2, vio_pred**2) + u2_at_v ) endif @@ -1095,12 +1114,12 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! sum accelerations to take averages. fyic(i,J) = fyic(i,J) + fyic_now - if (CS%id_fiy_d>0) fyic_d(i,J) = fyic_d(i,J) + G%mask2dCv(i,J) * & - US%m_to_L*G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) - if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * US%m_to_L * & + if (CS%id_fiy_d>0) fyic_d(i,J) = fyic_d(i,J) + G%mask2dCv(i,J) * US%m_s_to_L_T**2 * & + G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * US%m_s_to_L_T**2 * & (G%IdxCv(i,J)*(dx2T(i,j+1)*(-CS%str_t(i,j+1)) - & dx2T(i,j) *(-CS%str_t(i,j))) ) * G%IareaCv(i,J) - if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * US%m_to_L * & + if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * US%m_s_to_L_T**2 * & (G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & dy2B(I-1,J)*CS%str_s(I-1,J)) ) * G%IareaCv(i,J) @@ -1114,8 +1133,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & enddo ; enddo if (do_hifreq_output) then - time_step_end = time_it_start + real_to_time(n*dt) - call enable_SIS_averaging(dt, time_step_end, CS%diag) + time_step_end = time_it_start + real_to_time(n*US%T_to_s*dt) + call enable_SIS_averaging(US%T_to_s*dt, time_step_end, CS%diag) if (CS%id_ui_hifreq > 0) call post_SIS_data(CS%id_ui_hifreq, ui, CS%diag) if (CS%id_vi_hifreq > 0) call post_SIS_data(CS%id_vi_hifreq, vi, CS%diag) if (CS%id_str_d_hifreq > 0) call post_SIS_data(CS%id_str_d_hifreq, CS%str_d, CS%diag) @@ -1148,16 +1167,16 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & haloshift=0, symmetric=.true.) endif if (CS%debug_EVP .and. (CS%debug .or. CS%debug_redundant)) then - call uvchksum("f[xy]ic in SIS_C_dynamics", fxic, fyic, G) - call uvchksum("f[xy]oc in SIS_C_dynamics", fxoc, fyoc, G) - call uvchksum("Cor_[uv] in SIS_C_dynamics", Cor_u, Cor_v, G) - call uvchksum("[uv]i in SIS_C_dynamics", ui, vi, G) + call uvchksum("f[xy]ic in SIS_C_dynamics", fxic, fyic, G, scale=US%L_T_to_m_s*US%s_to_T) + call uvchksum("f[xy]oc in SIS_C_dynamics", fxoc, fyoc, G, scale=US%L_T_to_m_s*US%s_to_T) + call uvchksum("Cor_[uv] in SIS_C_dynamics", Cor_u, Cor_v, G, scale=US%L_T_to_m_s*US%s_to_T) + call uvchksum("[uv]i in SIS_C_dynamics", ui, vi, G, scale=US%L_T_to_m_s) endif enddo ! l=1,EVP_steps if (CS%debug .or. CS%debug_redundant) & - call uvchksum("[uv]i end SIS_C_dynamics", ui, vi, G) + call uvchksum("[uv]i end SIS_C_dynamics", ui, vi, G, scale=US%L_T_to_m_s) ! Reset the time information in the diag type. if (do_hifreq_output) call enable_SIS_averaging(time_int_in, time_end_in, CS%diag) @@ -1259,8 +1278,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & do J=jsc-1,jec ; do i=isc,iec ; diag_val_v(i,J) = Cor_v(i,J)*mi_v(i,J) ; enddo ; enddo call post_SIS_data(CS%id_fcy, diag_val_v, CS%diag) endif - if (CS%id_Coru>0) call post_SIS_data(CS%id_fcx, Cor_u, CS%diag) - if (CS%id_Corv>0) call post_SIS_data(CS%id_fcy, Cor_v, CS%diag) + if (CS%id_Coru>0) call post_SIS_data(CS%id_Coru, Cor_u, CS%diag) + if (CS%id_Corv>0) call post_SIS_data(CS%id_Corv, Cor_v, CS%diag) if (CS%id_PFu>0) call post_SIS_data(CS%id_PFu, PFu, CS%diag) if (CS%id_PFv>0) call post_SIS_data(CS%id_PFv, PFv, CS%diag) if (CS%id_fpx>0) then @@ -1327,7 +1346,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & enddo ; enddo call post_SIS_data(CS%id_del_sh_min, diag_val, CS%diag) endif - if (Cs%id_siu>0 .or. Cs%id_siv>0 .or. Cs%id_sispeed>0) then + if (CS%id_siu>0 .or. CS%id_siv>0 .or. CS%id_sispeed>0) then do j=jsc-1,jec+1 ; do i=isc-1,iec+1 if (mis(i,j) > 0.0) then @@ -1338,9 +1357,9 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & siu(i,j) = 0.0; siv(i,j) = 0.0; sispeed(i,j) = 0.0; endif enddo ; enddo - if (Cs%id_siu>0) call post_SIS_data(CS%id_siu, siu, CS%diag) - if (Cs%id_siv>0) call post_SIS_data(CS%id_siv, siv, CS%diag) - if (Cs%id_sispeed>0) call post_SIS_data(CS%id_sispeed, sispeed, CS%diag) + if (CS%id_siu>0) call post_SIS_data(CS%id_siu, siu, CS%diag) + if (CS%id_siv>0) call post_SIS_data(CS%id_siv, siv, CS%diag) + if (CS%id_sispeed>0) call post_SIS_data(CS%id_sispeed, sispeed, CS%diag) endif endif @@ -1509,7 +1528,7 @@ subroutine find_sigII(mi, ci, str_t, str_s, sigII, G, US, CS) real, dimension(SZI_(G),SZJ_(G)) :: & strength ! The ice strength [Pa m]. real, dimension(SZIB_(G),SZJB_(G)) :: & - str_s_ss ! Str_s divided by the sum of the neighboring ice strengths. + str_s_ss ! Str_s divided by the sum of the neighboring ice strengths [nondim]. real :: strength_sum ! The sum of the 4 neighboring strengths [L2 Pa m-1 ~> Pa m]. real :: sum_area ! The sum of ocean areas around a vorticity point [L2 ~> m2]. integer :: i, j, isc, iec, jsc, jec @@ -1655,20 +1674,20 @@ subroutine write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, PFu, fxat, integer, intent(in) :: I !< The i-index of the column to report on integer, intent(in) :: j !< The j-index of the column to report on type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: ui !< The zonal ice velicity [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u_IC !< The initial zonal ice velicity [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uo !< The zonal ocean velicity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: ui !< The zonal ice velicity [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u_IC !< The initial zonal ice velicity [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uo !< The zonal ocean velicity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mis !< The mass of ice an snow per unit ocean area [kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxoc !< The zonal ocean-to-ice force [Pa]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxic !< The ice internal force [Pa]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Cor_u !< The zonal Coriolis acceleration [m s-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: PFu !< The zonal Pressure force accleration [m s-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxat !< The zonal wind stress [Pa]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxoc !< The zonal ocean-to-ice force [kg m-2 L T-2 ~> Pa]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxic !< The ice internal force [kg m-2 L T-2 ~> Pa]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Cor_u !< The zonal Coriolis acceleration [L T-2 ~> m s-2]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: PFu !< The zonal Pressure force accleration [L T-2 ~> m s-2]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxat !< The zonal wind stress [kg m-2 L T-2 ~> Pa]. real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module - real :: dt_mi, CFL + real :: dt_mi, dt_usc, u_scale, CFL real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness [m], that ! can be cubed without underflow. integer :: file @@ -1690,11 +1709,13 @@ subroutine write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, PFu, fxat, file = CS%u_file if (ui(I,j) > 0.0) then - CFL = (ui(I,j) * (dt_slow*US%m_to_L*G%dy_Cu(I,j))) / G%areaT(i,j) + CFL = (ui(I,j) * (dt_slow*G%dy_Cu(I,j))) / G%areaT(i,j) else - CFL = (ui(I,j) * (dt_slow*US%m_to_L*G%dy_Cu(I,j))) / G%areaT(i+1,j) + CFL = (ui(I,j) * (dt_slow*G%dy_Cu(I,j))) / G%areaT(i+1,j) endif + u_scale = US%L_T_to_m_s + dt_usc = dt_slow * u_scale call get_date(CS%Time, yr, mo, day, hr, minute, sec) call get_time((CS%Time - set_date(yr, 1, 1, 0, 0, 0)), sec, yearday) @@ -1702,16 +1723,16 @@ subroutine write_u_trunc(I, j, ui, u_IC, uo, mis, fxoc, fxic, Cor_u, PFu, fxat, write (file,'("Time ",i5,i4,F6.2," U-trunc at ",I4,": ",2(I3), & & " (",F7.2," E "F7.2," N) u = ",ES10.3," (CFL ",ES9.2,") was ",ES10.3," dt = ",1PG10.4)') & yr, yearday, (REAL(sec)/3600.0), pe_here(), I, j, & - G%geoLonCu(I,j), G%geoLatCu(I,j), ui(I,j), CFL, u_IC(I,j), dt_slow + G%geoLonCu(I,j), G%geoLatCu(I,j), u_scale*ui(I,j), CFL, u_scale*u_IC(I,j), US%T_to_s*dt_slow - dt_mi = dt_slow / (0.5*(mis(i,j) + mis(i+1,j)) + H_subroundoff*CS%Rho_ice) + dt_mi = dt_usc / (0.5*(mis(i,j) + mis(i+1,j)) + H_subroundoff*CS%Rho_ice) write (file, '("ui, uo, dui = ", 3ES11.3, " ; mice+snow = ",2ES11.3)') & - ui(I,j), uo(I,j), ui(I,j) - u_IC(I,j), mis(i,j), mis(i+1,j) + u_scale*ui(I,j), u_scale*uo(I,j), u_scale*(ui(I,j) - u_IC(I,j)), mis(i,j), mis(i+1,j) write (file, '("U change due to fxat, fxoc, fxic, Cor_u, PFu = ", 5ES11.3, " sum = ",ES11.3)') & - fxat(I,j)*dt_mi, -fxoc(I,j)*dt_mi, fxic(I,j)*dt_mi, Cor_u(I,j)*dt_slow, PFu(I,j)*dt_slow, & - (fxat(I,j) - fxoc(I,j) + fxic(I,j))*dt_mi + (Cor_u(I,j) + PFu(I,j))*dt_slow + fxat(I,j)*dt_mi, -fxoc(I,j)*dt_mi, fxic(I,j)*dt_mi, Cor_u(I,j)*dt_usc, PFu(I,j)*dt_usc, & + (fxat(I,j) - fxoc(I,j) + fxic(I,j))*dt_mi + (Cor_u(I,j) + PFu(I,j))*dt_usc call flush(file) endif @@ -1739,7 +1760,7 @@ subroutine write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, PFv, fyat, type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module - real :: dt_mi, CFL + real :: dt_mi, dt_usc, u_scale, CFL real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness [m], that ! can be cubed without underflow. integer :: file @@ -1762,27 +1783,30 @@ subroutine write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, PFv, fyat, file = CS%v_file if (vi(i,J) > 0.0) then - CFL = (vi(i,J) * (dt_slow*US%m_to_L*G%dx_Cv(i,J))) / G%areaT(i,j) + CFL = (vi(i,J) * (dt_slow*G%dx_Cv(i,J))) / G%areaT(i,j) else - CFL = (vi(i,J) * (dt_slow*US%m_to_L*G%dx_Cv(i,J))) / G%areaT(i,j+1) + CFL = (vi(i,J) * (dt_slow*G%dx_Cv(i,J))) / G%areaT(i,j+1) endif + u_scale = US%L_T_to_m_s + dt_usc = dt_slow * u_scale + call get_date(CS%Time, yr, mo, day, hr, minute, sec) call get_time((CS%Time - set_date(yr, 1, 1, 0, 0, 0)), sec, yearday) write (file,'(/,"--------------------------")') write (file,'("Time ",i5,i4,F6.2," V-trunc at ",I4,": ",2(I3), & & " (",F7.2," E ",F7.2," N) v = ",ES10.3," (CFL ",ES9.2,") was ",ES10.3," dt = ",1PG10.4)') & yr, yearday, (REAL(sec)/3600.0), pe_here(), i, J, & - G%geoLonCv(i,J), G%geoLatCv(i,J), vi(i,J), CFL, v_IC(i,J), dt_slow + G%geoLonCv(i,J), G%geoLatCv(i,J), u_scale*vi(i,J), CFL, u_scale*v_IC(i,J), US%T_to_s*dt_slow - dt_mi = dt_slow / (0.5*(mis(i,j) + mis(i,j+1)) + H_subroundoff*CS%Rho_ice) + dt_mi = dt_usc / (0.5*(mis(i,j) + mis(i,j+1)) + H_subroundoff*CS%Rho_ice) write (file, '("vi, vo, dvi = ", 3ES11.3, " ; mice+snow = ",2ES11.3)') & - vi(i,J), vo(i,J), vi(i,J) - v_IC(i,J), mis(i,j), mis(i,j+1) + u_scale*vi(i,J), u_scale*vo(i,J), u_scale*(vi(i,J) - v_IC(i,J)), mis(i,j), mis(i,j+1) write (file, '("V change due to fyat, fyoc, fyic, Cor_v, PFv = ", 5ES11.3, " sum = ",ES11.3)') & - fyat(i,J)*dt_mi, -fyoc(i,J)*dt_mi, fyic(i,J)*dt_mi, Cor_v(i,J)*dt_slow, PFv(i,J)*dt_slow, & - (fyat(i,J) - fyoc(i,J) + fyic(i,J))*dt_mi + (Cor_v(i,J) + PFv(i,J))*dt_slow + fyat(i,J)*dt_mi, -fyoc(i,J)*dt_mi, fyic(i,J)*dt_mi, Cor_v(i,J)*dt_usc, PFv(i,J)*dt_usc, & + (fyat(i,J) - fyoc(i,J) + fyic(i,J))*dt_mi + (Cor_v(i,J) + PFv(i,J))*dt_usc call flush(file) endif diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index ab7a7177..90e4aa83 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -445,14 +445,30 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U !### Ridging needs to be added with C-grid dynamics. call mpp_clock_begin(iceClocka) if (CS%do_ridging) rdg_rate(:,:) = 0.0 + !### Remove this later. + if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then + IST%u_ice_C(:,:) = US%m_s_to_L_T*IST%u_ice_C + IST%v_ice_C(:,:) = US%m_s_to_L_T*IST%v_ice_C + endif if (CS%Warsaw_sum_order) then call SIS_C_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & - OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & + US%m_s_to_L_T*US%T_to_s*WindStr_x_Cu, US%m_s_to_L_T*US%T_to_s*WindStr_y_Cv, & + OSS%sea_lev, & + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) else call SIS_C_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & - OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & + US%m_s_to_L_T*US%T_to_s*WindStr_x_Cu, US%m_s_to_L_T*US%T_to_s*WindStr_y_Cv, & + OSS%sea_lev, & + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + endif + !### Remove this later. + if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then + IST%u_ice_C(:,:) = US%L_T_to_m_s*IST%u_ice_C + IST%v_ice_C(:,:) = US%L_T_to_m_s*IST%v_ice_C + str_x_ice_ocn_Cu(:,:) = US%L_T_to_m_s*US%s_to_T*str_x_ice_ocn_Cu(:,:) + str_y_ice_ocn_Cv(:,:) = US%L_T_to_m_s*US%s_to_T*str_y_ice_ocn_Cv(:,:) endif call mpp_clock_end(iceClocka) @@ -956,9 +972,21 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, call mpp_clock_begin(iceClocka) !### Ridging needs to be added with C-grid dynamics. if (CS%do_ridging) rdg_rate(:,:) = 0.0 + !### Remove this later. + DS2d%u_ice_C(:,:) = US%m_s_to_L_T*DS2d%u_ice_C + DS2d%v_ice_C(:,:) = US%m_s_to_L_T*DS2d%v_ice_C call SIS_C_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_C, DS2d%v_ice_C, & - OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & + US%m_s_to_L_T*US%T_to_s*WindStr_x_Cu, US%m_s_to_L_T*US%T_to_s*WindStr_y_Cv, OSS%sea_lev, & + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + !### Remove this later. + if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then + DS2d%u_ice_C(:,:) = US%L_T_to_m_s*DS2d%u_ice_C + DS2d%v_ice_C(:,:) = US%L_T_to_m_s*DS2d%v_ice_C + str_x_ice_ocn_Cu(:,:) = US%L_T_to_m_s*US%s_to_T*str_x_ice_ocn_Cu(:,:) + str_y_ice_ocn_Cv(:,:) = US%L_T_to_m_s*US%s_to_T*str_y_ice_ocn_Cv(:,:) + endif + call mpp_clock_end(iceClocka) if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) @@ -1280,8 +1308,8 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) call enable_SIS_averaging(dt_slow_dyn, CS%Time - real_to_time((ndyn_steps-nds)*dt_slow_dyn), CS%diag) - call slab_ice_advect(IST%u_ice_C, IST%v_ice_C, IST%mH_ice(:,:,1), 4.0*IG%kg_m2_to_H, & - dt_slow_dyn, G, US, IST%part_size(:,:,1), nsteps=CS%adv_substeps) + call slab_ice_advect(US%m_s_to_L_T*IST%u_ice_C, US%m_s_to_L_T*IST%v_ice_C, IST%mH_ice(:,:,1), 4.0*IG%kg_m2_to_H, & + US%s_to_T*dt_slow_dyn, G, US, IST%part_size(:,:,1), nsteps=CS%adv_substeps) call mpp_clock_end(iceClock8) if (CS%column_check) & @@ -2088,11 +2116,12 @@ end subroutine SIS_dyn_trans_read_alt_restarts !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_dyn_trans_init initializes ice model data, parameters and diagnostics !! associated with the SIS2 dynamics and transport modules. -subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Time_init, & +subroutine SIS_dyn_trans_init(Time, G, US, IG, param_file, diag, CS, output_dir, Time_init, & slab_ice) type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, !! set with the current model time. type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid structure + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice grid type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(SIS_diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output @@ -2211,7 +2240,7 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim if (.not.(do_slab_ice)) then CS%complete_ice_cover = 1.0 - 2.0*max(1,IG%CatIce)*epsilon(CS%complete_ice_cover) if (CS%Cgrid_dyn) then - call SIS_C_dyn_init(CS%Time, G, param_file, CS%diag, CS%SIS_C_dyn_CSp, CS%ntrunc) + call SIS_C_dyn_init(CS%Time, G, US, param_file, CS%diag, CS%SIS_C_dyn_CSp, CS%ntrunc) else call SIS_B_dyn_init(CS%Time, G, param_file, CS%diag, CS%SIS_B_dyn_CSp) endif diff --git a/src/ice_model.F90 b/src/ice_model.F90 index 32a61179..d087a33d 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -2579,7 +2579,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call SIS_slow_thermo_set_ptrs(Ice%sCS%slow_thermo_CSp, & sum_out_CSp=specified_ice_sum_output_CS(Ice%sCS%specified_ice_CSp)) else - call SIS_dyn_trans_init(Ice%sCS%Time, sG, sIG, param_file, Ice%sCS%diag, & + call SIS_dyn_trans_init(Ice%sCS%Time, sG, US, sIG, param_file, Ice%sCS%diag, & Ice%sCS%dyn_trans_CSp, dirs%output_directory, Time_Init, & slab_ice=slab_ice) call SIS_slow_thermo_set_ptrs(Ice%sCS%slow_thermo_CSp, & diff --git a/src/slab_ice.F90 b/src/slab_ice.F90 index 2d4b80ba..d853eb05 100644 --- a/src/slab_ice.F90 +++ b/src/slab_ice.F90 @@ -30,24 +30,24 @@ module slab_ice !! dating back to the Manabe model. subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, US, part_sz, nsteps) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type - real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uc !< x-face advecting velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vc !< y-face advecting velocity [m s-1] - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: trc !< Depth integrated amount of the tracer to - !! advect, in [kg Conc] or other units, or the - !! total ice mass [H ~> kg m-2]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uc !< x-face advecting velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vc !< y-face advecting velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: trc !< Depth integrated amount of the tracer to advect, + !! in [Conc H ~> Conc kg m-2] or other units, or + !! the total ice mass [H ~> kg m-2]. real, intent(in ) :: stop_lim !< A tracer amount below which to !! stop advection, in the same units as tr [Conc] - real, intent(in ) :: dt_slow !< The time covered by this call [s]. + real, intent(in ) :: dt_slow !< The time covered by this call [T ~> s]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: part_sz !< A part size that is set based on !! whether trc (which may be mass) exceeds 0. integer, optional, intent(in ) :: nsteps !< The number of advective substeps. ! Local variables - real, dimension(SZIB_(G),SZJ_(G)) :: uflx - real, dimension(SZI_(G),SZJB_(G)) :: vflx - real :: avg, dif - real :: dt_adv + real, dimension(SZIB_(G),SZJ_(G)) :: uflx ! Zonal tracer fluxes [Conc H L2 T-1 ~> Conc kg s-1] + real, dimension(SZI_(G),SZJB_(G)) :: vflx ! Meridional tracer fluxes [Conc H L2 T-1 ~> Conc kg s-1] + real :: avg, dif ! Average and forward difference of integrated tracer concentrations [Conc H ~> Conc kg m-2] + real :: dt_adv ! The advective timestep [T ~> s] integer :: i, j, n, isc, iec, jsc, jec, n_substeps isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -62,9 +62,9 @@ subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, US, part_sz, nstep if ( avg > stop_lim .and. uc(I,j) * dif > 0.0) then uflx(I,j) = 0.0 elseif ( uc(i,j) > 0.0 ) then - uflx(I,j) = uc(I,j) * trc(i,j) * US%L_to_m*G%dy_Cu(I,j) + uflx(I,j) = uc(I,j) * trc(i,j) * G%dy_Cu(I,j) else - uflx(I,j) = uc(I,j) * trc(i+1,j) * US%L_to_m*G%dy_Cu(I,j) + uflx(I,j) = uc(I,j) * trc(i+1,j) * G%dy_Cu(I,j) endif enddo ; enddo @@ -74,15 +74,15 @@ subroutine slab_ice_advect(uc, vc, trc, stop_lim, dt_slow, G, US, part_sz, nstep if (avg > stop_lim .and. vc(i,J) * dif > 0.0) then vflx(i,J) = 0.0 elseif ( vc(i,J) > 0.0 ) then - vflx(i,J) = vc(i,J) * trc(i,j) * US%L_to_m*G%dx_Cv(i,J) + vflx(i,J) = vc(i,J) * trc(i,j) * G%dx_Cv(i,J) else - vflx(i,J) = vc(i,J) * trc(i,j+1) * US%L_to_m*G%dx_Cv(i,J) + vflx(i,J) = vc(i,J) * trc(i,j+1) * G%dx_Cv(i,J) endif enddo ; enddo do j=jsc,jec ; do i=isc,iec trc(i,j) = trc(i,j) + dt_adv * ((uflx(I-1,j) - uflx(I,j)) + & - (vflx(i,J-1) - vflx(i,J)) ) * US%m_to_L**2*G%IareaT(i,j) + (vflx(i,J-1) - vflx(i,J)) ) * G%IareaT(i,j) enddo ; enddo call pass_var(trc, G%Domain) @@ -97,12 +97,12 @@ end subroutine slab_ice_advect !> slab_ice_dynamics updates the B-grid or C-grid ice velocities and ice-ocean stresses as in the !! very old slab-ice algorithm dating back to the Manabe model. This code works for either !! B-grid or C-grid discretiztions, but the velocity and stress variables must have consistent -!! array sizes. +!! array sizes and units. subroutine slab_ice_dynamics(ui, vi, uo, vo, fxat, fyat, fxoc, fyoc) - real, dimension(:,:), intent(inout) :: ui !< Zonal ice velocity [m s-1] - real, dimension(:,:), intent(inout) :: vi !< Meridional ice velocity [m s-1] - real, dimension(:,:), intent(in ) :: uo !< Zonal ocean velocity [m s-1] - real, dimension(:,:), intent(in ) :: vo !< Meridional ocean velocity [m s-1] + real, dimension(:,:), intent(inout) :: ui !< Zonal ice velocity [L T-1 ~> m s-1] + real, dimension(:,:), intent(inout) :: vi !< Meridional ice velocity [L T-1 ~> m s-1] + real, dimension(:,:), intent(in ) :: uo !< Zonal ocean velocity [L T-1 ~> m s-1] + real, dimension(:,:), intent(in ) :: vo !< Meridional ocean velocity [L T-1 ~> m s-1] real, dimension(:,:), intent(in ) :: fxat !< Zonal air stress on ice [Pa] real, dimension(:,:), intent(in ) :: fyat !< Meridional air stress on ice [Pa] real, dimension(:,:), intent( out) :: fxoc !< Zonal ice stress on ocean [Pa] From bedeace899664765c1b34bc41bb30093c1ace976 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 18 Oct 2019 19:14:08 -0400 Subject: [PATCH 07/24] +Added register_unit_conversion_restarts Added the new subroutine register_unit_conversion_restarts to store unit conversion factors in the SIS2 restart files, and call this new routine at appropriate spots in ice_model_init. The answers in the Baltic test case are bitwise identical. --- src/SIS_types.F90 | 26 +++++++++++++++++++++++++- src/ice_model.F90 | 4 ++++ 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/src/SIS_types.F90 b/src/SIS_types.F90 index 2f899f45..55220e5c 100644 --- a/src/SIS_types.F90 +++ b/src/SIS_types.F90 @@ -22,6 +22,7 @@ module SIS_types use MOM_file_parser, only : param_file_type use MOM_hor_index, only : hor_index_type use MOM_time_manager, only : time_type, time_type_to_real +use MOM_unit_scaling, only : unit_scale_type use SIS_diag_mediator, only : SIS_diag_ctrl, post_data=>post_SIS_data use SIS_diag_mediator, only : register_SIS_diag_field, register_static_field use SIS_debugging, only : chksum, Bchksum, Bchksum_pair, hchksum, uvchksum @@ -38,7 +39,7 @@ module SIS_types public :: ice_ocean_flux_type, alloc_ice_ocean_flux, dealloc_ice_ocean_flux public :: ocean_sfc_state_type, alloc_ocean_sfc_state, dealloc_ocean_sfc_state public :: fast_ice_avg_type, alloc_fast_ice_avg, dealloc_fast_ice_avg, copy_FIA_to_FIA -public :: IOF_chksum, FIA_chksum +public :: IOF_chksum, FIA_chksum, register_unit_conversion_restarts public :: ice_rad_type, ice_rad_register_restarts, dealloc_ice_rad public :: simple_OSS_type, alloc_simple_OSS, dealloc_simple_OSS, copy_sOSS_to_sOSS public :: redistribute_IST_to_IST, redistribute_FIA_to_FIA, redistribute_sOSS_to_sOSS @@ -542,6 +543,29 @@ subroutine ice_state_register_restarts(IST, G, IG, Ice_restart, restart_file) end subroutine ice_state_register_restarts +subroutine register_unit_conversion_restarts(US, Ice_restart, restart_file) + type(unit_scale_type), intent(inout) :: US !< A structure with unit conversion factors + type(restart_file_type), pointer :: Ice_restart !< A pointer to the restart type for the ice + character(len=*), intent(in) :: restart_file !< The name of the ice restart file + + integer :: idr + + ! Register scalar unit conversion factors. + idr = register_restart_field(Ice_restart, restart_file, "m_to_Z", US%m_to_Z_restart, & + longname="The conversion factor from m to SIS2 height units.", & + units= "Z meter-1", no_domain=.true., mandatory=.false.) + idr = register_restart_field(Ice_restart, restart_file, "m_to_L", US%m_to_L_restart, & + longname="The conversion factor from m to SIS2 length units.", & + units="L meter-1", no_domain=.true., mandatory=.false.) + idr = register_restart_field(Ice_restart, restart_file, "s_to_T", US%s_to_T_restart, & + longname="The conversion factor from s to SIS2 time units.", & + units="T second-1", no_domain=.true., mandatory=.false.) + idr = register_restart_field(Ice_restart, restart_file, "kg_m3_to_R", US%kg_m3_to_R_restart, & + longname="The conversion factor from kg m-3 to SIS2 density units.", & + units="R m3 kg-1", no_domain=.true., mandatory=.false.) + +end subroutine register_unit_conversion_restarts + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> ice_state_read_alt_restarts reads in alternative variables that might have !! been in the restart file, specifically dealing with changing between diff --git a/src/ice_model.F90 b/src/ice_model.F90 index d087a33d..4a6c2c5d 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -83,6 +83,7 @@ module ice_model_mod use SIS_types, only : ice_state_type, alloc_IST_arrays, dealloc_IST_arrays use SIS_types, only : IST_chksum, IST_bounds_check, ice_state_register_restarts use SIS_types, only : ice_state_read_alt_restarts, register_fast_to_slow_restarts +use SIS_types, only : register_unit_conversion_restarts use SIS_types, only : copy_IST_to_IST, copy_FIA_to_FIA, copy_sOSS_to_sOSS use SIS_types, only : copy_TSF_to_TSF, redistribute_TSF_to_TSF use SIS_types, only : copy_Rad_to_Rad, redistribute_Rad_to_Rad @@ -2081,6 +2082,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call alloc_IST_arrays(sHI, sIG, sIST, omit_tsurf=Eulerian_tsurf, do_ridging=do_ridging) call ice_state_register_restarts(sIST, sG, sIG, Ice%Ice_restart, restart_file) + call register_unit_conversion_restarts(Ice%sCS%US, Ice%Ice_restart, restart_file) call alloc_ocean_sfc_state(Ice%sCS%OSS, sHI, sIST%Cgrid_dyn, gas_fields_ocn) Ice%sCS%OSS%kmelt = kmelt @@ -2228,6 +2230,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! whether the Ice%Ice...restart types are associated. call ice_type_fast_reg_restarts(fGD%mpp_domain, CatIce, & param_file, Ice, Ice%Ice_fast_restart, fast_rest_file) + if (split_restart_files) & + call register_unit_conversion_restarts(Ice%fCS%US, Ice%Ice_fast_restart, fast_rest_file) if (redo_fast_update .or. .not.single_IST) then call alloc_IST_arrays(fHI, Ice%fCS%IG, Ice%fCS%IST, & From ce9d7574b0b0126a3829a45c4940ae909e4a822c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 18 Oct 2019 19:27:11 -0400 Subject: [PATCH 08/24] +Pass US to SIS_C_dyn_read_alt_restarts Pass a unit_scaling_type argument to SIS_C_dyn_read_alt_restarts and to its caller, SIS_dyn_trans_read_alt_restarts. Also call fix_restart_unit_scaling in ice_model_init. Answers in the Baltic test case are bitwise identical, but there are new arguments. --- src/SIS_dyn_cgrid.F90 | 3 ++- src/SIS_dyn_trans.F90 | 5 +++-- src/ice_model.F90 | 4 +++- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index 952ac78d..6546a301 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -1609,9 +1609,10 @@ end subroutine SIS_C_dyn_register_restarts !! SIS C-grid dynamics module that might have been in the restart file, !! specifically dealing with changing between symmetric and non-symmetric !! memory restart files. -subroutine SIS_C_dyn_read_alt_restarts(CS, G, Ice_restart, restart_file, restart_dir) +subroutine SIS_C_dyn_read_alt_restarts(CS, G, US, Ice_restart, restart_file, restart_dir) type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(restart_file_type), pointer :: Ice_restart !< The sea ice restart control structure character(len=*), intent(in) :: restart_file !< The ice restart file name character(len=*), intent(in) :: restart_dir !< The directory in which to find the restart files diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 90e4aa83..5333e526 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -2098,16 +2098,17 @@ end subroutine SIS_dyn_trans_register_restarts !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_dyn_trans_register_restarts allocates and registers any variables associated !! slow ice dynamics and transport that need to be included in the restart files. -subroutine SIS_dyn_trans_read_alt_restarts(CS, G, Ice_restart, & +subroutine SIS_dyn_trans_read_alt_restarts(CS, G, US, Ice_restart, & restart_file, restart_dir) type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type type(restart_file_type), pointer :: Ice_restart !< The sea ice restart control structure character(len=*), intent(in) :: restart_file !< The ice restart file name character(len=*), intent(in) :: restart_dir !< The directory in which to find the restart files if (CS%Cgrid_dyn) then - call SIS_C_dyn_read_alt_restarts(CS%SIS_C_dyn_CSp, G, Ice_restart, & + call SIS_C_dyn_read_alt_restarts(CS%SIS_C_dyn_CSp, G, US, Ice_restart, & restart_file, restart_dir) endif diff --git a/src/ice_model.F90 b/src/ice_model.F90 index 4a6c2c5d..cfff561f 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -2311,7 +2311,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call ice_state_read_alt_restarts(sIST, sG, sIG, Ice%Ice_restart, & restart_file, dirs%restart_input_dir) if (.not.specified_ice) & - call SIS_dyn_trans_read_alt_restarts(Ice%sCS%dyn_trans_CSp, sG, Ice%Ice_restart, & + call SIS_dyn_trans_read_alt_restarts(Ice%sCS%dyn_trans_CSp, sG, US, Ice%Ice_restart, & restart_file, dirs%restart_input_dir) ! Approximately initialize state fields that are not present @@ -2714,6 +2714,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, endif endif ! fast_ice_PE + call fix_restart_unit_scaling(US) + !nullify_domain perhaps could be called somewhere closer to set_domain !but it should be called after restore_state() otherwise it causes a restart mismatch call nullify_domain() From 588ffe128d1f4197cee499040b549658a9c00a75 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 25 Oct 2019 19:37:32 -0400 Subject: [PATCH 09/24] +Rescaled stresses in SIS_C_dynamics Rescaled the internal ice stress variables in SIS_syn_cgrid for expanded dimensional consistency testing, including redoing the scaling after reading from a restart file. Answers in the Baltic test case are bitwise identical. --- src/SIS_dyn_cgrid.F90 | 147 ++++++++++++++++++++++++------------------ 1 file changed, 84 insertions(+), 63 deletions(-) diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index 6546a301..25c08c45 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -43,13 +43,13 @@ module SIS_dyn_cgrid !> The control structure with parameters regulating C-grid ice dynamics type, public :: SIS_C_dyn_CS ; private real, allocatable, dimension(:,:) :: & - str_t, & !< The tension stress tensor component [Pa m] will become [kg m-2 L2 T-2 ~> Pa m]. - str_d, & !< The divergence stress tensor component [Pa m]. - str_s !< The shearing stress tensor component (cross term) [Pa m]. + str_t, & !< The tension stress tensor component [kg m-2 L2 T-2 ~> Pa m]. + str_d, & !< The divergence stress tensor component [kg m-2 L2 T-2 ~> Pa m]. + str_s !< The shearing stress tensor component (cross term) [kg m-2 L2 T-2 ~> Pa m]. ! parameters for calculating water drag and internal ice stresses real :: p0 = 2.75e4 !< Pressure constant in the Hibbler rheology [Pa] - real :: p0_rho !< The pressure constant divided by ice density [N m kg-1]. + real :: p0_rho !< The pressure constant divided by ice density [L2 T-2 ~> N m kg-1]. real :: c0 = 20.0 !< another pressure constant real :: cdw = 3.24e-3 !< ice/water drag coef. [nondim] real :: EC = 2.0 !< yield curve axis ratio @@ -200,7 +200,7 @@ subroutine SIS_C_dyn_init(Time, G, US, param_file, diag, CS, ntrunc) call get_param(param_file, mdl, "ICE_STRENGTH_PSTAR", CS%p0, & "A constant in the expression for the ice strength, \n"//& - "P* in Hunke & Dukowicz 1997.", units="Pa", default=2.75e4) + "P* in Hunke & Dukowicz 1997.", units="Pa", default=2.75e4, scale=US%m_s_to_L_T**2) call get_param(param_file, mdl, "ICE_STRENGTH_CSTAR", CS%c0, & "A constant in the exponent of the expression for the \n"//& "ice strength, c* in Hunke & Dukowicz 1997.", & @@ -278,9 +278,9 @@ subroutine SIS_C_dyn_init(Time, G, US, param_file, diag, CS, ntrunc) CS%id_sigii = register_diag_field('ice_model','SIGII' ,diag%axesT1, Time, & 'second stress invariant', 'none', missing_value=missing) CS%id_stren = register_diag_field('ice_model','STRENGTH' ,diag%axesT1, Time, & - 'ice strength', 'Pa*m', missing_value=missing) + 'ice strength', 'Pa*m', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_stren0 = register_diag_field('ice_model','STREN_0' ,diag%axesT1, Time, & - 'ice strength at start of rheology', 'Pa*m', missing_value=missing) + 'ice strength at start of rheology', 'Pa*m', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_fix = register_diag_field('ice_model', 'FI_X', diag%axesCu1, Time, & 'ice internal stress - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') @@ -372,11 +372,11 @@ subroutine SIS_C_dyn_init(Time, G, US, param_file, diag, CS, ntrunc) missing_value=missing, interp_method='none') CS%id_str_d = register_diag_field('ice_model', 'str_d', diag%axesT1, Time, & - 'ice divergence internal stress', 'Pa', missing_value=missing) + 'ice divergence internal stress', 'Pa', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_str_t = register_diag_field('ice_model', 'str_t', diag%axesT1, Time, & - 'ice tension internal stress', 'Pa', missing_value=missing) + 'ice tension internal stress', 'Pa', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_str_s = register_diag_field('ice_model', 'str_s', diag%axesB1, Time, & - 'ice shearing internal stress', 'Pa', missing_value=missing) + 'ice shearing internal stress', 'Pa', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_sh_d = register_diag_field('ice_model', 'sh_d', diag%axesT1, Time, & 'ice divergence strain rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_sh_t = register_diag_field('ice_model', 'sh_t', diag%axesT1, Time, & @@ -395,11 +395,11 @@ subroutine SIS_C_dyn_init(Time, G, US, param_file, diag, CS, ntrunc) 'ice velocity - y component', 'm/s', missing_value=missing, & interp_method='none, conversion=US%L_T_to_m_s') CS%id_str_d_hifreq = register_diag_field('ice_model', 'str_d_hf', diag%axesT1, Time, & - 'ice divergence internal stress', 'Pa', missing_value=missing) + 'ice divergence internal stress', 'Pa', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_str_t_hifreq = register_diag_field('ice_model', 'str_t_hf', diag%axesT1, Time, & - 'ice tension internal stress', 'Pa', missing_value=missing) + 'ice tension internal stress', 'Pa', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_str_s_hifreq = register_diag_field('ice_model', 'str_s_hf', diag%axesB1, Time, & - 'ice shearing internal stress', 'Pa', missing_value=missing) + 'ice shearing internal stress', 'Pa', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_sh_d_hifreq = register_diag_field('ice_model', 'sh_d_hf', diag%axesT1, Time, & 'ice divergence rate', 's-1', conversion=US%s_to_T, missing_value=missing) CS%id_sh_t_hifreq = register_diag_field('ice_model', 'sh_t_hf', diag%axesT1, Time, & @@ -413,7 +413,7 @@ subroutine SIS_C_dyn_init(Time, G, US, param_file, diag, CS, ntrunc) CS%id_ci_hifreq = register_diag_field('ice_model', 'CI_hf', diag%axesT1, Time, & 'Summed concentration of ice at t-points', 'nondim', missing_value=missing) CS%id_stren_hifreq = register_diag_field('ice_model','STRENGTH_hf' ,diag%axesT1, Time, & - 'ice strength', 'Pa*m', missing_value=missing) + 'ice strength', 'Pa*m', conversion=US%L_T_to_m_s**2, missing_value=missing) CS%id_siu = register_diag_field('ice_model', 'siu', diag%axesT1, Time, & 'ice velocity - x component', 'm/s', missing_value=missing, & @@ -429,12 +429,13 @@ end subroutine SIS_C_dyn_init !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> find_ice_strength returns the magnitude of force on ice in plastic deformation -subroutine find_ice_strength(mi, ci, ice_strength, G, CS, halo_sz) ! ??? may change to do loop +subroutine find_ice_strength(mi, ci, ice_strength, G, US, CS, halo_sz) ! ??? may change to do loop type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength !< The ice strength in N m-1. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength !< The ice strength [kg m-2 L2 T-2 ~> N m-1]. type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors integer, optional, intent(in) :: halo_sz !< The halo size to work on integer :: i, j, isc, iec, jsc, jec, halo halo = 0 ; if (present(halo_sz)) halo = halo_sz @@ -484,16 +485,16 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & real, dimension(SZI_(G),SZJ_(G)) :: & - pres_mice, & ! The ice internal pressure per unit column mass [N m kg-1]. + pres_mice, & ! The ice internal pressure per unit column mass [L2 T-2 ~> N m kg-1]. ci_proj, & ! The projected ice concentration [nondim]. - zeta, & ! The ice bulk viscosity [Pa m T ~> Pa m s] (i.e., [N s m-1]). + zeta, & ! The ice bulk viscosity [kg m-2 L2 T-1 ~> Pa m s] (i.e., [N s m-1]). del_sh, & ! The magnitude of the shear rates [T-1 ~> s-1]. diag_val, & ! A temporary diagnostic array. del_sh_min_pr, & ! When multiplied by pres_mice, this gives the minimum ! value of del_sh that is used in the calculation of zeta [T-1 ~> s-1]. ! This is set based on considerations of numerical stability, ! and varies with the grid spacing. - dx2T, dy2T, & ! dx^2 or dy^2 at T points [m2]. + dx2T, dy2T, & ! dx^2 or dy^2 at T points [L2 ~> m2]. dx_dyT, dy_dxT, & ! dx/dy or dy_dx at T points [nondim]. siu, siv, sispeed ! diagnostics on T points [L T-1 ~> m s-1]. @@ -715,7 +716,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! a maximum value of the effective lateral viscosities. ! I think that this is stable when CS%del_sh_min_scale >= 1. -RWH if (dxharm > 0.) then - del_sh_min_pr(i,j) = US%m_s_to_L_T**2*(2.0*CS%del_sh_min_scale * dt**2) / (Tdamp * dxharm**2) + del_sh_min_pr(i,j) = (2.0*CS%del_sh_min_scale * dt**2) / (Tdamp * dxharm**2) else del_sh_min_pr(i,j) = 0. endif @@ -982,7 +983,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m x.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fxic_now = US%m_s_to_L_T**2* (G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + & + fxic_now = (G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + & (G%IdyCu(I,j)*(dy2T(i+1,j)*CS%str_t(i+1,j) - & dy2T(i,j) *CS%str_t(i,j)) + & G%IdxCu(I,j)*(dx2B(I,J) *CS%str_s(I,J) - & @@ -1033,12 +1034,12 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! sum accelerations to take averages. fxic(I,j) = fxic(I,j) + fxic_now - if (CS%id_fix_d>0) fxic_d(I,j) = fxic_d(I,j) + G%mask2dCu(I,j) * US%m_s_to_L_T**2 * & + if (CS%id_fix_d>0) fxic_d(I,j) = fxic_d(I,j) + G%mask2dCu(I,j) * & G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) - if (CS%id_fix_t>0) fxic_t(I,j) = fxic_t(I,j) + G%mask2dCu(I,j) * US%m_s_to_L_T**2 * & + if (CS%id_fix_t>0) fxic_t(I,j) = fxic_t(I,j) + G%mask2dCu(I,j) * & G%IdyCu(I,j)*(dy2T(i+1,j)* CS%str_t(i+1,j) - & dy2T(i,j) * CS%str_t(i,j) ) * G%IareaCu(I,j) - if (CS%id_fix_s>0) fxic_s(I,j) = fxic_s(I,j) + G%mask2dCu(I,j) * US%m_s_to_L_T**2 * & + if (CS%id_fix_s>0) fxic_s(I,j) = fxic_s(I,j) + G%mask2dCu(I,j) * & G%IdxCu(I,j)*(dx2B(I,J) *CS%str_s(I,J) - & dx2B(I,J-1)*CS%str_s(I,J-1)) * G%IareaCu(I,j) @@ -1063,7 +1064,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m y.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fyic_now = US%m_s_to_L_T**2 * (G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + & + fyic_now = (G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + & (-G%IdxCv(i,J)*(dx2T(i,j+1)*CS%str_t(i,j+1) - & dx2T(i,j) *CS%str_t(i,j)) + & G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & @@ -1114,12 +1115,12 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! sum accelerations to take averages. fyic(i,J) = fyic(i,J) + fyic_now - if (CS%id_fiy_d>0) fyic_d(i,J) = fyic_d(i,J) + G%mask2dCv(i,J) * US%m_s_to_L_T**2 * & + if (CS%id_fiy_d>0) fyic_d(i,J) = fyic_d(i,J) + G%mask2dCv(i,J) * & G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) - if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * US%m_s_to_L_T**2 * & + if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * & (G%IdxCv(i,J)*(dx2T(i,j+1)*(-CS%str_t(i,j+1)) - & dx2T(i,j) *(-CS%str_t(i,j))) ) * G%IareaCv(i,J) - if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * US%m_s_to_L_T**2 * & + if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * & (G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & dy2B(I-1,J)*CS%str_s(I-1,J)) ) * G%IareaCv(i,J) @@ -1144,7 +1145,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & if (CS%id_sh_t_hifreq > 0) call post_SIS_data(CS%id_sh_t_hifreq, sh_Dt, CS%diag) if (CS%id_sh_s_hifreq > 0) call post_SIS_data(CS%id_sh_s_hifreq, sh_Ds, CS%diag) if (CS%id_sigi_hifreq>0) then - call find_sigI(mice, ci_proj, CS%str_d, diag_val, G, CS) + call find_sigI(mice, ci_proj, CS%str_d, diag_val, G, US, CS) call post_SIS_data(CS%id_sigi_hifreq, diag_val, CS%diag) endif if (CS%id_sigii_hifreq>0) then @@ -1161,10 +1162,10 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & endif if (CS%debug_EVP .and. CS%debug) then - call hchksum(CS%str_d, "str_d in SIS_C_dynamics", G%HI, haloshift=1) - call hchksum(CS%str_t, "str_t in SIS_C_dynamics", G%HI, haloshift=1) + call hchksum(CS%str_d, "str_d in SIS_C_dynamics", G%HI, haloshift=1, scale=US%L_T_to_m_s**2) + call hchksum(CS%str_t, "str_t in SIS_C_dynamics", G%HI, haloshift=1, scale=US%L_T_to_m_s**2) call Bchksum(CS%str_s, "str_s in SIS_C_dynamics", G%HI, & - haloshift=0, symmetric=.true.) + haloshift=0, symmetric=.true., scale=US%L_T_to_m_s**2) endif if (CS%debug_EVP .and. (CS%debug .or. CS%debug_redundant)) then call uvchksum("f[xy]ic in SIS_C_dynamics", fxic, fyic, G, scale=US%L_T_to_m_s*US%s_to_T) @@ -1303,7 +1304,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & if (CS%id_fiy_s>0) call post_SIS_data(CS%id_fiy_s, fyic_s, CS%diag) if (CS%id_sigi>0) then - call find_sigI(mice, ci, CS%str_d, diag_val, G, CS) + call find_sigI(mice, ci, CS%str_d, diag_val, G, US, CS) call post_SIS_data(CS%id_sigi, diag_val, CS%diag) endif if (CS%id_sigii>0) then @@ -1312,14 +1313,14 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & endif if (CS%id_stren>0) then if (CS%project_ci) then - call find_ice_strength(mice, ci_proj, diag_val, G, CS) + call find_ice_strength(mice, ci_proj, diag_val, G, US, CS) else - call find_ice_strength(mice, ci, diag_val, G, CS) + call find_ice_strength(mice, ci, diag_val, G, US, CS) endif call post_SIS_data(CS%id_stren, diag_val, CS%diag) endif if (CS%id_stren0>0) then - call find_ice_strength(mice, ci, diag_val, G, CS) + call find_ice_strength(mice, ci, diag_val, G, US, CS) call post_SIS_data(CS%id_stren0, diag_val, CS%diag) endif @@ -1372,12 +1373,15 @@ end subroutine SIS_C_dynamics subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, US, CS, limit) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: pres_mice !< The ice internal pressure per - !! unit column mass [N m kg-1]. + !! unit column mass [L2 T-2 ~> N m kg-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mice !< The mass per unit total area (ice !! covered and ice free) of the ice [kg m-2]. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_d !< The divergence stress tensor component [Pa m]. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_t !< The tension stress tensor component [Pa m]. - real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: str_s !< The shearing stress tensor component [Pa m]. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_d !< The divergence stress tensor component + !! [kg m-2 L2 T-2 ~> Pa m]. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_t !< The tension stress tensor component + !! [kg m-2 L2 T-2 ~> Pa m]. + real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: str_s !< The shearing stress tensor component + !! [kg m-2 L2 T-2 ~> Pa m]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, optional, intent(in) :: limit !< A factor by which the strength limits are changed. @@ -1388,17 +1392,17 @@ subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, US, CS, limit ! ice flow convergence or divergence may have altered the ice concentration. ! Local variables - real :: pressure ! The internal ice pressure at a point [Pa]. - real :: pres_avg ! The average of the internal ice pressures around a point [Pa]. + real :: pressure ! The internal ice pressure at a point [kg m-3 L2 T-2 ~> Pa]. + real :: pres_avg ! The average of the internal ice pressures around a point [kg m-3 L2 T-2 ~> Pa]. real :: sum_area ! The sum of ocean areas around a vorticity point [L2 ~> m2]. real :: I_2EC ! 1/(2*EC), where EC is the yield curve axis ratio. real :: lim ! A local copy of the factor by which the limits are changed. real :: lim_2 ! The limit divided by 2. ! real :: EC2 ! EC^2, where EC is the yield curve axis ratio. ! real :: rescale_str ! A factor by which to rescale the internal stresses [nondim]. -! real :: stress_mag ! The magnitude of the stress at a point. -! real :: str_d_q ! CS%str_d interpolated to a vorticity point [Pa m]. -! real :: str_t_q ! CS%str_t interpolated to a vorticity point [Pa m]. +! real :: stress_mag ! The magnitude of the stress at a point [kg m-2 L2 T-2 ~> Pa m]. +! real :: str_d_q ! CS%str_d interpolated to a vorticity point [kg m-2 L2 T-2 ~> Pa m]. +! real :: str_t_q ! CS%str_t interpolated to a vorticity point [kg m-2 L2 T-2 ~> Pa m]. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1491,20 +1495,22 @@ end subroutine limit_stresses !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> find_sigI finds the first stress invariant -subroutine find_sigI(mi, ci, str_d, sigI, G, CS) +subroutine find_sigI(mi, ci, str_d, sigI, G, US, CS) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: str_d !< The divergence stress tensor component [Pa m]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: str_d !< The divergence stress tensor component + !! [kg m-2 L2 T-2 ~> Pa m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigI !< The first stress invariant [nondim] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G)) :: & - strength ! The ice strength [Pa m]. + strength ! The ice strength [kg m-2 L2 T-2 ~> Pa m = N m-1]. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - call find_ice_strength(mi, ci, strength, G, CS) + call find_ice_strength(mi, ci, strength, G, US, CS) do j=jsc,jec ; do i=isc,iec sigI(i,j) = 0.0 @@ -1519,17 +1525,19 @@ subroutine find_sigII(mi, ci, str_t, str_s, sigII, G, US, CS) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: str_t !< The tension stress tensor component, [Pa m] - real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: str_s !< The shearing stress tensor component [Pa m]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: str_t !< The tension stress tensor component + !! [kg m-2 L2 T-2 ~> Pa m]. + real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: str_s !< The shearing stress tensor component + !! [kg m-2 L2 T-2 ~> Pa m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigII !< The second stress invariant [nondim]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G)) :: & - strength ! The ice strength [Pa m]. + strength ! The ice strength [kg m-2 L2 T-2 ~> Pa m]. real, dimension(SZIB_(G),SZJB_(G)) :: & str_s_ss ! Str_s divided by the sum of the neighboring ice strengths [nondim]. - real :: strength_sum ! The sum of the 4 neighboring strengths [L2 Pa m-1 ~> Pa m]. + real :: strength_sum ! The sum of the 4 neighboring strengths times areas [L2 Pa m ~> Pa m3]. real :: sum_area ! The sum of ocean areas around a vorticity point [L2 ~> m2]. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1605,10 +1613,11 @@ subroutine SIS_C_dyn_register_restarts(mpp_domain, HI, param_file, CS, & end subroutine SIS_C_dyn_register_restarts !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> SIS_C_dyn_read_alt_restarts reads in alternative variables for the -!! SIS C-grid dynamics module that might have been in the restart file, -!! specifically dealing with changing between symmetric and non-symmetric -!! memory restart files. +!> SIS_C_dyn_read_alt_restarts reads in alternative variables for the SIS C-grid dynamics module +!! that might have been in the restart file, specifically dealing with changing between symmetric +!! and non-symmetric memory restart files. It also handles any changes in dimensional rescaling +!! of these variables between what is stored in the restart file and what is done for the current +!! run segment. subroutine SIS_C_dyn_read_alt_restarts(CS, G, US, Ice_restart, restart_file, restart_dir) type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type @@ -1621,11 +1630,11 @@ subroutine SIS_C_dyn_read_alt_restarts(CS, G, US, Ice_restart, restart_file, res ! then discarded. real, allocatable, target, dimension(:,:) :: str_tmp type(MOM_domain_type), pointer :: domain_tmp => NULL() + real :: stress_rescale integer :: i, j, id if (.not.associated(Ice_restart)) return - if (G%symmetric) then - if (query_initialized(Ice_restart, 'sym_str_s')) return + if (G%symmetric .and. (.not.query_initialized(Ice_restart, 'sym_str_s'))) then call clone_MOM_domain(G%domain, domain_tmp, symmetric=.false., & domain_name="ice temporary domain") @@ -1643,8 +1652,7 @@ subroutine SIS_C_dyn_read_alt_restarts(CS, G, US, Ice_restart, restart_file, res enddo ; enddo endif - else ! .not. symmetric - if (query_initialized(Ice_restart, 'str_s')) return + elseif ((.not.G%symmetric) .and. (.not.query_initialized(Ice_restart, 'str_s'))) then call clone_MOM_domain(G%domain, domain_tmp, symmetric=.true., & domain_name="ice temporary domain") @@ -1662,8 +1670,21 @@ subroutine SIS_C_dyn_read_alt_restarts(CS, G, US, Ice_restart, restart_file, res endif endif - deallocate(str_tmp) - deallocate(domain_tmp%mpp_domain) ; deallocate(domain_tmp) + if (allocated(str_tmp)) deallocate(str_tmp) + if (associated(domain_tmp)) then ; deallocate(domain_tmp%mpp_domain) ; deallocate(domain_tmp) ; endif + + ! Now redo the dimionsal rescaling of the stresses if necessary. + if ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then + stress_rescale = (US%m_to_L*US%s_to_T_restart)**2 / (US%m_to_L_restart*US%s_to_T)**2 + do J=G%jsc-1,G%jec ; do I=G%isc-1,G%iec + CS%str_s(I,J) = stress_rescale * CS%str_s(I,J) + enddo ; enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%str_d(i,j) = stress_rescale * CS%str_d(i,j) + CS%str_t(i,j) = stress_rescale * CS%str_t(i,j) + enddo ; enddo + endif end subroutine SIS_C_dyn_read_alt_restarts From 2197d4a1c683002aca1e85a887691c367a29ba0f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 Oct 2019 14:31:38 -0400 Subject: [PATCH 10/24] +Rescaled C-grid stresses in SIS_dynamics_trans Rescaled the various C-grid stresses in SIS_dynamics_trans for expanded dimensional consistency testing. Answers in the Baltic test case are bitwise identical. --- src/SIS_dyn_trans.F90 | 168 ++++++++++++++++++++++-------------------- 1 file changed, 87 insertions(+), 81 deletions(-) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 5333e526..23f37f59 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -312,13 +312,13 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [Pa]. str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & - WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [Pa]. - WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [Pa]. - str_x_ice_ocn_Cu ! Zonal ice-ocean stress on C-grid u-points [Pa]. + WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [kg m-2 L T-2 ~> Pa]. + str_x_ice_ocn_Cu ! Zonal ice-ocean stress on C-grid u-points [kg m-2 L T-2 ~> Pa]. real, dimension(SZI_(G),SZJB_(G)) :: & - WindStr_y_Cv, & ! Meridional wind stress averaged over the ice categores on C-grid v-points [Pa]. - WindStr_y_ocn_Cv, & ! Meridional wind stress on the ice-free ocean on C-grid v-points [Pa]. - str_y_ice_ocn_Cv ! Meridional ice-ocean stress on C-grid v-points [Pa]. + WindStr_y_Cv, & ! Meridional wind stress averaged over the ice categores on C-grid v-points [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_Cv, & ! Meridional wind stress on the ice-free ocean on C-grid v-points [kg m-2 L T-2 ~> Pa]. + str_y_ice_ocn_Cv ! Meridional ice-ocean stress on C-grid v-points [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBx ! An temporary array for diagnostics. real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBy ! An temporary array for diagnostics. @@ -438,7 +438,8 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U call hchksum(OSS%sea_lev, "sea_lev before SIS_C_dynamics", G%HI, haloshift=1) call hchksum(ice_cover, "ice_cover before SIS_C_dynamics", G%HI, haloshift=1) call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1) - call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, halos=1) + call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, & + halos=1, scale=US%L_T_to_m_s*US%s_to_T) ! call hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) endif @@ -453,22 +454,18 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if (CS%Warsaw_sum_order) then call SIS_C_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & - US%m_s_to_L_T*US%T_to_s*WindStr_x_Cu, US%m_s_to_L_T*US%T_to_s*WindStr_y_Cv, & - OSS%sea_lev, & + WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) else call SIS_C_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & - US%m_s_to_L_T*US%T_to_s*WindStr_x_Cu, US%m_s_to_L_T*US%T_to_s*WindStr_y_Cv, & - OSS%sea_lev, & + WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) endif !### Remove this later. if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then IST%u_ice_C(:,:) = US%L_T_to_m_s*IST%u_ice_C IST%v_ice_C(:,:) = US%L_T_to_m_s*IST%v_ice_C - str_x_ice_ocn_Cu(:,:) = US%L_T_to_m_s*US%s_to_T*str_x_ice_ocn_Cu(:,:) - str_y_ice_ocn_Cv(:,:) = US%L_T_to_m_s*US%s_to_T*str_y_ice_ocn_Cv(:,:) endif call mpp_clock_end(iceClocka) @@ -484,15 +481,16 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if (CS%id_fax>0) call post_data(CS%id_fax, WindStr_x_Cu, CS%diag) if (CS%id_fay>0) call post_data(CS%id_fay, WindStr_y_Cv, CS%diag) - if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", & + IST%u_ice_C, IST%v_ice_C, G) !, scale=US%L_T_to_m_s) ! Store all mechanical ocean forcing. if (CS%Warsaw_sum_order) then call set_ocean_top_stress_Cgrid(IOF, WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, IST%part_size, G, IG) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, IST%part_size, G, US, IG) else call set_ocean_top_stress_C2(IOF, WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, ice_free, ice_cover, G) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, ice_free, ice_cover, G, US) endif call mpp_clock_end(iceClockc) @@ -906,13 +904,13 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [Pa]. str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & - WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [Pa]. - WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [Pa]. - str_x_ice_ocn_Cu ! Zonal ice-ocean stress on C-grid u-points [Pa]. + WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [kg m-2 L T-2 ~> Pa]. + str_x_ice_ocn_Cu ! Zonal ice-ocean stress on C-grid u-points [kg m-2 L T-2 ~> Pa]. real, dimension(SZI_(G),SZJB_(G)) :: & - WindStr_y_Cv, & ! Meridional wind stress averaged over the ice categores on C-grid v-points [Pa]. - WindStr_y_ocn_Cv, & ! Meridional wind stress on the ice-free ocean on C-grid v-points [Pa]. - str_y_ice_ocn_Cv ! Meridional ice-ocean stress on C-grid v-points [Pa]. + WindStr_y_Cv, & ! Meridional wind stress averaged over the ice categores on C-grid v-points [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_Cv, & ! Meridional wind stress on the ice-free ocean on C-grid v-points [kg m-2 L T-2 ~> Pa]. + str_y_ice_ocn_Cv ! Meridional ice-ocean stress on C-grid v-points [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBx ! An temporary array for diagnostics. real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBy ! An temporary array for diagnostics. @@ -965,7 +963,8 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, call hchksum(OSS%sea_lev, "sea_lev before SIS_C_dynamics", G%HI, haloshift=1) call hchksum(DS2d%ice_cover, "ice_cover before SIS_C_dynamics", G%HI, haloshift=1) call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1) - call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, halos=1) + call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, & + halos=1, scale=US%L_T_to_m_s*US%s_to_T) ! call hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) endif @@ -977,14 +976,12 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, DS2d%v_ice_C(:,:) = US%m_s_to_L_T*DS2d%v_ice_C call SIS_C_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_C, DS2d%v_ice_C, & US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & - US%m_s_to_L_T*US%T_to_s*WindStr_x_Cu, US%m_s_to_L_T*US%T_to_s*WindStr_y_Cv, OSS%sea_lev, & + WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) !### Remove this later. if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then DS2d%u_ice_C(:,:) = US%L_T_to_m_s*DS2d%u_ice_C DS2d%v_ice_C(:,:) = US%L_T_to_m_s*DS2d%v_ice_C - str_x_ice_ocn_Cu(:,:) = US%L_T_to_m_s*US%s_to_T*str_x_ice_ocn_Cu(:,:) - str_y_ice_ocn_Cv(:,:) = US%L_T_to_m_s*US%s_to_T*str_y_ice_ocn_Cv(:,:) endif call mpp_clock_end(iceClocka) @@ -1004,7 +1001,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, ! Store all mechanical ocean forcing. call set_ocean_top_stress_C2(IOF, WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, ice_free, DS2d%ice_cover, G) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, ice_free, DS2d%ice_cover, G, US) call mpp_clock_end(iceClockc) else ! B-grid dynamics. @@ -1140,12 +1137,12 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [Pa]. str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & - WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [Pa]. - WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [Pa]. + WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [kg m-2 L T-2 ~> Pa]. str_x_ice_ocn_Cu ! Zonal ice-ocean stress on C-grid u-points [Pa]. real, dimension(SZI_(G),SZJB_(G)) :: & - WindStr_y_Cv, & ! Meridional wind stress averaged over the ice categores on C-grid v-points [Pa]. - WindStr_y_ocn_Cv, & ! Meridional wind stress on the ice-free ocean on C-grid v-points [Pa]. + WindStr_y_Cv, & ! Meridional wind stress averaged over the ice categores on C-grid v-points [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_Cv, & ! Meridional wind stress on the ice-free ocean on C-grid v-points [kg m-2 L T-2 ~> Pa]. str_y_ice_ocn_Cv ! Meridional ice-ocean stress on C-grid v-points [Pa]. real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBx ! An temporary array for diagnostics. @@ -1206,7 +1203,8 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer call hchksum(OSS%sea_lev, "sea_lev before SIS_C_dynamics", G%HI, haloshift=1) call hchksum(IST%part_size(:,:,1), "ice_cover before SIS_C_dynamics", G%HI, haloshift=1) call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1) - call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, halos=1) + call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, & + halos=1, scale=US%L_T_to_m_s*US%s_to_T) ! call hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) endif @@ -1231,7 +1229,7 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer ! Store all mechanical ocean forcing. call set_ocean_top_stress_C2(IOF, WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, & - IST%part_size(:,:,0), IST%part_size(:,:,1), G) + IST%part_size(:,:,0), IST%part_size(:,:,1), G, US) call mpp_clock_end(iceClockc) call mpp_clock_end(iceClock4) @@ -1553,19 +1551,22 @@ end subroutine set_ocean_top_stress_Bgrid !! appropriate staggering, and store them in the public ice data type for use by the ocean !! model. This version of the routine uses wind and ice-ocean stresses on a C-grid. subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & - str_ice_oce_x, str_ice_oce_y, part_size, G, IG) + str_ice_oce_x, str_ice_oce_y, part_size, G, US, IG) type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: windstr_x_water !< The x-direction wind stress over open water [Pa]. + intent(in) :: windstr_x_water !< The x-direction wind stress over open water + !! [kg m-2 L T-2 ~> Pa]. real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. + intent(in) :: windstr_y_water !< The y-direction wind stress over open water + !! [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G),0:IG%CatIce), & intent(in) :: part_size !< The fractional area coverage of the ice !! thickness categories [nondim], 0-1 @@ -1586,16 +1587,16 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec do i=isc,iec ps_vel = G%mask2dT(i,j) * part_size(i,j,0) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.5 * & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & (windstr_x_water(I,j) + windstr_x_water(I-1,j)) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.5 * & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & (windstr_y_water(i,J) + windstr_y_water(i,J-1)) enddo !### SIMPLIFY THIS TO USE THAT sum(part_size(i,j,1:ncat)) = 1.0-part_size(i,j,0) ? do k=1,ncat ; do i=isc,iec ; if (G%mask2dT(i,j)>0.5) then - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.5 * & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.5 * US%L_T_to_m_s*US%s_to_T* & (str_ice_oce_x(I,j) + str_ice_oce_x(I-1,j)) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.5 * & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.5 * US%L_T_to_m_s*US%s_to_T* & (str_ice_oce_y(i,J) + str_ice_oce_y(i,J-1)) endif ; enddo ; enddo enddo @@ -1607,17 +1608,17 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & 0.25*((part_size(i+1,j+1,0) + part_size(i,j,0)) + & (part_size(i+1,j,0) + part_size(i,j+1,0)) ) !### Consider deleting the masks here? They probably do not change answers. - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * & + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * US%L_T_to_m_s*US%s_to_T* & (windstr_x_water(I,j) + windstr_x_water(I,j+1)) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * & + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * US%L_T_to_m_s*US%s_to_T* & (windstr_y_water(i,J) + windstr_y_water(i+1,J)) enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dBu(I,J)>0.5) then ps_vel = 0.25 * ((part_size(i+1,j+1,k) + part_size(i,j,k)) + & (part_size(i+1,j,k) + part_size(i,j+1,k)) ) - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * 0.5 * & + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & (str_ice_oce_x(I,j) + str_ice_oce_x(I,j+1)) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * 0.5 * & + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & (str_ice_oce_y(i,J) + str_ice_oce_y(i+1,J)) endif ; enddo ; enddo enddo @@ -1627,11 +1628,11 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & do I=Isc-1,iec ps_vel = 1.0 ; if (G%mask2dCu(I,j)>0.5) ps_vel = & 0.5*(part_size(i+1,j,0) + part_size(i,j,0)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * windstr_x_water(I,j) + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T*windstr_x_water(I,j) enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dCu(I,j)>0.5) then ps_vel = 0.5 * (part_size(i+1,j,k) + part_size(i,j,k)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * str_ice_oce_x(I,j) + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T*str_ice_oce_x(I,j) endif ; enddo ; enddo enddo !$OMP parallel do default(shared) private(ps_vel) @@ -1639,11 +1640,11 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & do i=isc,iec ps_vel = 1.0 ; if (G%mask2dCv(i,J)>0.5) ps_vel = & 0.5*(part_size(i,j+1,0) + part_size(i,j,0)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * windstr_y_water(i,J) + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T*windstr_y_water(i,J) enddo do k=1,ncat ; do i=isc,iec ; if (G%mask2dCv(i,J)>0.5) then ps_vel = 0.5 * (part_size(i,j+1,k) + part_size(i,j,k)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * str_ice_oce_y(i,J) + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T*str_ice_oce_y(i,J) endif ; enddo ; enddo enddo else @@ -1750,22 +1751,25 @@ end subroutine set_ocean_top_stress_B2 !! appropriate staggering, and store them in the public ice data type for use by the ocean !! model. This version of the routine uses wind and ice-ocean stresses on a C-grid. subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & - str_ice_oce_x, str_ice_oce_y, ice_free, ice_cover, G) + str_ice_oce_x, str_ice_oce_y, ice_free, ice_cover, G, US) type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: windstr_x_water !< The x-direction wind stress over open water [Pa]. + intent(in) :: windstr_x_water !< The x-direction wind stress over + !! open water [kg m-2 L T-2 ~> Pa]. real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. + intent(in) :: windstr_y_water !< The y-direction wind stress over + !! open water [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ice_free !< The fractional open water area coverage [nondim], 0-1 real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ice_cover !< The fractional ice area coverage [nondim], 0-1 + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real :: ps_ice, ps_ocn ! ice_free and ice_cover interpolated to a velocity point [nondim]. integer :: i, j, k, isc, iec, jsc, jec @@ -1783,10 +1787,10 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec ; do i=isc,iec ps_ocn = G%mask2dT(i,j) * ice_free(i,j) ps_ice = G%mask2dT(i,j) * ice_cover(i,j) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + US%L_T_to_m_s*US%s_to_T* & (ps_ocn * 0.5 * (windstr_x_water(I,j) + windstr_x_water(I-1,j)) + & ps_ice * 0.5 * (str_ice_oce_x(I,j) + str_ice_oce_x(I-1,j)) ) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + US%L_T_to_m_s*US%s_to_T* & (ps_ocn * 0.5 * (windstr_y_water(i,J) + windstr_y_water(i,J-1)) + & ps_ice * 0.5 * (str_ice_oce_y(i,J) + str_ice_oce_y(i,J-1)) ) enddo ; enddo @@ -1800,10 +1804,10 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & ps_ice = 0.25 * ((ice_cover(i+1,j+1) + ice_cover(i,j)) + & (ice_cover(i+1,j) + ice_cover(i,j+1)) ) endif - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + & + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & (ps_ocn * 0.5 * (windstr_x_water(I,j) + windstr_x_water(I,j+1)) + & ps_ice * 0.5 * (str_ice_oce_x(I,j) + str_ice_oce_x(I,j+1)) ) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + & + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & (ps_ocn * 0.5 * (windstr_y_water(i,J) + windstr_y_water(i+1,J)) + & ps_ice * 0.5 * (str_ice_oce_y(i,J) + str_ice_oce_y(i+1,J)) ) enddo ; enddo @@ -1815,7 +1819,7 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i+1,j) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i+1,j) + ice_cover(i,j)) endif - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + US%L_T_to_m_s*US%s_to_T* & (ps_ocn * windstr_x_water(I,j) + ps_ice * str_ice_oce_x(I,j)) enddo ; enddo !$OMP parallel do default(shared) private(ps_ocn, ps_ice) @@ -1825,7 +1829,7 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i,j+1) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i,j+1) + ice_cover(i,j)) endif - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + US%L_T_to_m_s*US%s_to_T* & (ps_ocn * windstr_y_water(i,J) + ps_ice * str_ice_oce_y(i,J)) enddo ; enddo else @@ -1849,11 +1853,13 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y !! thickness categories [nondim], between 0 & 1. ice_free !< The fractional open water [nondim], between 0 & 1. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: & - WindStr_x_Cu, & !< Zonal wind stress averaged over the ice categores on C-grid u-points [Pa]. - WindStr_x_ocn_Cu !< Zonal wind stress on the ice-free ocean on C-grid u-points [Pa]. + WindStr_x_Cu, & !< Zonal wind stress averaged over the ice categores on C-grid u-points + !! [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_Cu !< Zonal wind stress on the ice-free ocean on C-grid u-points [kg m-2 L T-2 ~> Pa]. real, dimension(SZI_(G),SZJB_(G)), intent(out) :: & - WindStr_y_Cv, & !< Meridional wind stress averaged over the ice categores on C-grid v-points [Pa]. - WindStr_y_ocn_Cv !< Meridional wind stress on the ice-free ocean on C-grid v-points [Pa]. + WindStr_y_Cv, & !< Meridional wind stress averaged over the ice categores on C-grid v-points + !! [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_Cv !< Meridional wind stress on the ice-free ocean on C-grid v-points [kg m-2 L T-2 ~> Pa]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, intent(in) :: max_ice_cover !< The fractional ice coverage !! that is close enough to 1 to be complete for the purpose of calculating @@ -1909,18 +1915,18 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y !$OMP parallel default(shared) private(weights,I_wts) !$OMP do do j=jsc-1,jec+1 ; do I=isc-1,iec - weights = US%L_to_m**2*(G%areaT(i,j)*ice_cover(i,j) + G%areaT(i+1,j)*ice_cover(i+1,j)) + weights = (G%areaT(i,j)*ice_cover(i,j) + G%areaT(i+1,j)*ice_cover(i+1,j)) if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_x_Cu(I,j) = G%mask2dCu(I,j) *US%L_to_m**2* & + WindStr_x_Cu(I,j) = G%mask2dCu(I,j) * US%m_s_to_L_T*US%T_to_s* & (G%areaT(i,j) * ice_cover(i,j) * WindStr_x_A(i,j) + & G%areaT(i+1,j)*ice_cover(i+1,j)*WindStr_x_A(i+1,j)) * I_wts else WindStr_x_Cu(I,j) = 0.0 endif - weights = US%L_to_m**2*(G%areaT(i,j)*ice_free(i,j) + G%areaT(i+1,j)*ice_free(i+1,j)) + weights = (G%areaT(i,j)*ice_free(i,j) + G%areaT(i+1,j)*ice_free(i+1,j)) if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_x_ocn_Cu(I,j) = G%mask2dCu(I,j) *US%L_to_m**2* & + WindStr_x_ocn_Cu(I,j) = G%mask2dCu(I,j) * US%m_s_to_L_T*US%T_to_s* & (G%areaT(i,j) * ice_free(i,j) * WindStr_x_ocn_A(i,j) + & G%areaT(i+1,j)*ice_free(i+1,j)*WindStr_x_ocn_A(i+1,j)) * I_wts else @@ -1930,18 +1936,18 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y !$OMP end do nowait !$OMP do do J=jsc-1,jec ; do i=isc-1,iec+1 - weights = US%L_to_m**2*(G%areaT(i,j)*ice_cover(i,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) + weights = (G%areaT(i,j)*ice_cover(i,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) if (G%mask2dCv(i,J) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_y_Cv(i,J) = G%mask2dCv(i,J) *US%L_to_m**2* & + WindStr_y_Cv(i,J) = G%mask2dCv(i,J) * US%m_s_to_L_T*US%T_to_s* & (G%areaT(i,j) * ice_cover(i,j) * WindStr_y_A(i,j) + & G%areaT(i,j+1)*ice_cover(i,j+1)*WindStr_y_A(i,j+1)) * I_wts else WindStr_y_Cv(i,J) = 0.0 endif - weights = US%L_to_m**2*(G%areaT(i,j)*ice_free(i,j) + G%areaT(i,j+1)*ice_free(i,j+1)) + weights = (G%areaT(i,j)*ice_free(i,j) + G%areaT(i,j+1)*ice_free(i,j+1)) if (weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_y_ocn_Cv(i,J) = G%mask2dCv(i,J) *US%L_to_m**2* & + WindStr_y_ocn_Cv(i,J) = G%mask2dCv(i,J) * US%m_s_to_L_T*US%T_to_s* & (G%areaT(i,j) * ice_free(i,j) * WindStr_y_ocn_A(i,j) + & G%areaT(i,j+1)*ice_free(i,j+1)*WindStr_y_ocn_A(i,j+1)) * I_wts else @@ -2022,30 +2028,30 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ !$OMP parallel do default(shared) private(weights,I_wts) do J=jsc-1,jec ; do I=isc-1,iec ; if (G%mask2dBu(I,J) > 0.0) then - weights = US%L_to_m**2*((G%areaT(i+1,j+1)*ice_cover(i+1,j+1) + G%areaT(i,j)*ice_cover(i,j)) + & + weights = ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1) + G%areaT(i,j)*ice_cover(i,j)) + & (G%areaT(i+1,j)*ice_cover(i+1,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_B(I,J) = G%mask2dBu(I,J) *US%L_to_m**2* & + WindStr_x_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_x_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_x_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_x_A(i+1,j) + & G%areaT(i,j+1) * ice_cover(i,j+1) * WindStr_x_A(i,j+1)) ) * I_wts - WindStr_y_B(I,J) = G%mask2dBu(I,J) *US%L_to_m**2* & + WindStr_y_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_y_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_y_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_y_A(i+1,j) + & G%areaT(i,j+1) * ice_cover(i,j+1) * WindStr_y_A(i,j+1)) ) * I_wts - weights = US%L_to_m**2*((G%areaT(i+1,j+1)*ice_free(i+1,j+1) + G%areaT(i,j)*ice_free(i,j)) + & + weights = ((G%areaT(i+1,j+1)*ice_free(i+1,j+1) + G%areaT(i,j)*ice_free(i,j)) + & (G%areaT(i+1,j)*ice_free(i+1,j) + G%areaT(i,j+1)*ice_free(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * US%L_to_m**2*& + WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_x_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_x_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_x_ocn_A(i+1,j) + & G%areaT(i,j+1) * ice_free(i,j+1) * WindStr_x_ocn_A(i,j+1)) ) * I_wts - WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) *US%L_to_m**2* & + WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_y_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_y_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_y_ocn_A(i+1,j) + & @@ -2287,10 +2293,10 @@ subroutine SIS_dyn_trans_init(Time, G, US, IG, param_file, diag, CS, output_dir, ! Stress dagnostics that are specific to the C-grid or B-grid dynamics of the ice model if (CS%Cgrid_dyn) then CS%id_fax = register_diag_field('ice_model', 'FA_X', diag%axesCu1, Time, & - 'Air stress on ice on C-grid - x component', 'Pa', & + 'Air stress on ice on C-grid - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') CS%id_fay = register_diag_field('ice_model', 'FA_Y', diag%axesCv1, Time, & - 'Air stress on ice on C-grid - y component', 'Pa', & + 'Air stress on ice on C-grid - y component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') else CS%id_fax = register_diag_field('ice_model', 'FA_X', diag%axesB1, Time, & From d8c52e34946d78a0a806266528676c0fb960e31e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 Oct 2019 14:33:03 -0400 Subject: [PATCH 11/24] Corrected an error message --- src/specified_ice.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/specified_ice.F90 b/src/specified_ice.F90 index 20ace05d..e861ce29 100644 --- a/src/specified_ice.F90 +++ b/src/specified_ice.F90 @@ -215,7 +215,7 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G) IOF%stress_mag(i,j) = wt_prev * IOF%stress_mag(i,j) + wt_now * sqrt(taux2 + tauy2) enddo ; enddo ; endif else - call SIS_error(FATAL, "set_ocean_top_stress_C2: Unrecognized flux_uv_stagger.") + call SIS_error(FATAL, "set_ocean_top_stress_FIA: Unrecognized flux_uv_stagger.") endif IOF%stress_count = IOF%stress_count + 1 From 9fa3cfedab6ae945ffb89717de778639b92aae1f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 Oct 2019 14:33:25 -0400 Subject: [PATCH 12/24] Generalized some comments documenting arguments --- src/slab_ice.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/slab_ice.F90 b/src/slab_ice.F90 index d853eb05..e0c81e62 100644 --- a/src/slab_ice.F90 +++ b/src/slab_ice.F90 @@ -103,10 +103,10 @@ subroutine slab_ice_dynamics(ui, vi, uo, vo, fxat, fyat, fxoc, fyoc) real, dimension(:,:), intent(inout) :: vi !< Meridional ice velocity [L T-1 ~> m s-1] real, dimension(:,:), intent(in ) :: uo !< Zonal ocean velocity [L T-1 ~> m s-1] real, dimension(:,:), intent(in ) :: vo !< Meridional ocean velocity [L T-1 ~> m s-1] - real, dimension(:,:), intent(in ) :: fxat !< Zonal air stress on ice [Pa] - real, dimension(:,:), intent(in ) :: fyat !< Meridional air stress on ice [Pa] - real, dimension(:,:), intent( out) :: fxoc !< Zonal ice stress on ocean [Pa] - real, dimension(:,:), intent( out) :: fyoc !< Meridional ice stress on ocean [Pa] + real, dimension(:,:), intent(in ) :: fxat !< Zonal air stress on ice [kg m-2 L T-2 ~> Pa] + real, dimension(:,:), intent(in ) :: fyat !< Meridional air stress on ice [kg m-2 L T-2 ~> Pa] + real, dimension(:,:), intent( out) :: fxoc !< Zonal ice stress on ocean [kg m-2 L T-2 ~> Pa] + real, dimension(:,:), intent( out) :: fyoc !< Meridional ice stress on ocean [kg m-2 L T-2 ~> Pa] ui(:,:) = uo(:,:) ; vi(:,:) = vo(:,:) fxoc(:,:) = fxat(:,:) ; fyoc(:,:) = fyat(:,:) From bb75a0a8ae7c057bd84903016a6f952136eee299 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 Oct 2019 17:14:24 -0400 Subject: [PATCH 13/24] +Rescaled C-grid velocities Rescaled the C-grid ice velocities to use units of [L T-1] throughout the SIS2 code, except whre it is being reported back to the atmosphere or ocean. The answers are bitwise identical in the Baltic test case, but there is a new unit_scale_type argument to IST_chksum. --- src/SIS_dyn_trans.F90 | 81 ++++++++++++++++++----------------------- src/SIS_fast_thermo.F90 | 8 ++-- src/SIS_slow_thermo.F90 | 2 +- src/SIS_sum_output.F90 | 8 ++-- src/SIS_types.F90 | 42 ++++++++++++++------- src/ice_model.F90 | 10 ++--- src/specified_ice.F90 | 2 +- 7 files changed, 79 insertions(+), 74 deletions(-) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 23f37f59..ca4d8dbd 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -167,10 +167,10 @@ module SIS_dyn_trans real, allocatable, dimension(:,:) :: v_ice_B !< The pseudo-meridional ice velocity along the !! along the grid directions on a B-grid [m s-1]. real, allocatable, dimension(:,:) :: u_ice_C !< The pseudo-zonal ice velocity along the - !! along the grid directions on a C-grid [m s-1]. + !! along the grid directions on a C-grid [L T-1 ~> m s-1]. !! All thickness categories are assumed to have the same velocities. real, allocatable, dimension(:,:) :: v_ice_C !< The pseudo-meridional ice velocity along the - !! along the grid directions on a C-grid [m s-1]. + !! along the grid directions on a C-grid [L T-1 ~> m s-1]. real, allocatable, dimension(:,:,:) :: mca_step !< The total mass per unit total area of snow, ice !! and pond water summed across thickness categories in a cell, after each !! transportation substep, with a 0 starting 3rd index [H ~> kg m-2]. @@ -243,8 +243,8 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, IG, CS) if (IST%Cgrid_dyn) then call icebergs_run( icebergs_CS, CS%Time, & FIA%calving(isc:iec,jsc:jec), OSS%u_ocn_C(isc-2:iec+1,jsc-1:jec+1), & - OSS%v_ocn_C(isc-1:iec+1,jsc-2:jec+1), IST%u_ice_C(isc-2:iec+1,jsc-1:jec+1), & - IST%v_ice_C(isc-1:iec+1,jsc-2:jec+1), windstr_x, windstr_y, & + OSS%v_ocn_C(isc-1:iec+1,jsc-2:jec+1), G%US%L_T_to_m_s*IST%u_ice_C(isc-2:iec+1,jsc-1:jec+1), & + G%US%L_T_to_m_s*IST%v_ice_C(isc-1:iec+1,jsc-2:jec+1), windstr_x, windstr_y, & OSS%sea_lev(isc-1:iec+1,jsc-1:jec+1), OSS%SST_C(isc:iec,jsc:jec), & FIA%calving_hflx(isc:iec,jsc:jec), FIA%ice_cover(isc-1:iec+1,jsc-1:jec+1), & hi_avg(isc-1:iec+1,jsc-1:jec+1), stagger=CGRID_NE, & @@ -431,7 +431,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if (CS%debug) then - call uvchksum("Before SIS_C_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + call uvchksum("Before SIS_C_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) call hchksum(ice_free, "ice_free before SIS_C_dynamics", G%HI) call hchksum(misp_sum, "misp_sum before SIS_C_dynamics", G%HI) call hchksum(mi_sum, "mi_sum before SIS_C_dynamics", G%HI) @@ -446,11 +446,6 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U !### Ridging needs to be added with C-grid dynamics. call mpp_clock_begin(iceClocka) if (CS%do_ridging) rdg_rate(:,:) = 0.0 - !### Remove this later. - if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then - IST%u_ice_C(:,:) = US%m_s_to_L_T*IST%u_ice_C - IST%v_ice_C(:,:) = US%m_s_to_L_T*IST%v_ice_C - endif if (CS%Warsaw_sum_order) then call SIS_C_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & @@ -462,14 +457,9 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) endif - !### Remove this later. - if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then - IST%u_ice_C(:,:) = US%L_T_to_m_s*IST%u_ice_C - IST%v_ice_C(:,:) = US%L_T_to_m_s*IST%v_ice_C - endif call mpp_clock_end(iceClocka) - if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) call mpp_clock_begin(iceClockb) call pass_vector(IST%u_ice_C, IST%v_ice_C, G%Domain, stagger=CGRID_NE) @@ -482,7 +472,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if (CS%id_fay>0) call post_data(CS%id_fay, WindStr_y_Cv, CS%diag) if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", & - IST%u_ice_C, IST%v_ice_C, G) !, scale=US%L_T_to_m_s) + IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) ! Store all mechanical ocean forcing. if (CS%Warsaw_sum_order) then @@ -564,10 +554,10 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U ! Convert the velocities to C-grid points for use in transport. do j=jsc,jec ; do I=isc-1,iec - IST%u_ice_C(I,j) = 0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) + IST%u_ice_C(I,j) = US%m_s_to_L_T*0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - IST%v_ice_C(i,J) = 0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) + IST%v_ice_C(i,J) = US%m_s_to_L_T*0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) enddo ; enddo endif ! End of B-grid dynamics @@ -586,11 +576,11 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U ! Do ice mass transport and related tracer transport. This updates the category-decomposed ice state. call mpp_clock_begin(iceClock8) ! The code timed by iceClock8 is the non-merged_cont equivalent to complete_IST_transport. - if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) call enable_SIS_averaging(dt_slow_dyn, Time_cycle_start + real_to_time(nds*dt_slow_dyn), CS%diag) call ice_cat_transport(CS%CAS, IST%TrReg, dt_slow_dyn, CS%adv_substeps, G, US, IG, CS%SIS_transport_CSp, & - uc=IST%u_ice_C, vc=IST%v_ice_C) + uc=US%L_T_to_m_s*IST%u_ice_C, vc=US%L_T_to_m_s*IST%v_ice_C) if (DS2d%nts==0) then if (CS%do_ridging) then @@ -792,7 +782,7 @@ subroutine ice_state_cleanup(IST, OSS, IOF, dt_slow, G, US, IG, CS, tracer_CSp) call disable_SIS_averaging(CS%diag) if (CS%verbose) call ice_line(CS%Time, IST%part_size(isc:iec,jsc:jec,0), OSS%SST_C(:,:), G) - if (CS%debug) call IST_chksum("End ice_state_cleanup", IST, G, IG) + if (CS%debug) call IST_chksum("End ice_state_cleanup", IST, G, US, IG) if (CS%bounds_check) call IST_bounds_check(IST, G, IG, "End of ice_state_cleanup", OSS=OSS) if (CS%Time + real_to_time(0.5*dt_slow) > CS%write_ice_stats_time) then @@ -956,7 +946,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, US, CS%complete_ice_cover) if (CS%debug) then - call uvchksum("Before SIS_C_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) + call uvchksum("Before SIS_C_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G, scale=US%L_T_to_m_s) call hchksum(ice_free, "ice_free before SIS_C_dynamics", G%HI) call hchksum(DS2d%mca_step(:,:,DS2d%nts), "misp_sum before SIS_C_dynamics", G%HI) call hchksum(DS2d%mi_sum, "mi_sum before SIS_C_dynamics", G%HI) @@ -971,22 +961,14 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, call mpp_clock_begin(iceClocka) !### Ridging needs to be added with C-grid dynamics. if (CS%do_ridging) rdg_rate(:,:) = 0.0 - !### Remove this later. - DS2d%u_ice_C(:,:) = US%m_s_to_L_T*DS2d%u_ice_C - DS2d%v_ice_C(:,:) = US%m_s_to_L_T*DS2d%v_ice_C call SIS_C_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_C, DS2d%v_ice_C, & US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) - !### Remove this later. - if ((US%L_to_m /= 1.0) .or. (US%T_to_s /= 1.0)) then - DS2d%u_ice_C(:,:) = US%L_T_to_m_s*DS2d%u_ice_C - DS2d%v_ice_C(:,:) = US%L_T_to_m_s*DS2d%v_ice_C - endif call mpp_clock_end(iceClocka) - if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) + if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G, scale=US%L_T_to_m_s) call mpp_clock_begin(iceClockb) call pass_vector(DS2d%u_ice_C, DS2d%v_ice_C, G%Domain, stagger=CGRID_NE) @@ -997,7 +979,8 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, call mpp_clock_begin(iceClockc) if (CS%id_fax>0) call post_data(CS%id_fax, WindStr_x_Cu, CS%diag) if (CS%id_fay>0) call post_data(CS%id_fay, WindStr_y_Cv, CS%diag) - if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) + if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", & + DS2d%u_ice_C, DS2d%v_ice_C, G, scale=US%L_T_to_m_s) ! Store all mechanical ocean forcing. call set_ocean_top_stress_C2(IOF, WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, & @@ -1062,10 +1045,10 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, ! Convert the velocities to C-grid points for use in transport. do j=jsc,jec ; do I=isc-1,iec - DS2d%u_ice_C(I,j) = 0.5 * ( DS2d%u_ice_B(I,J-1) + DS2d%u_ice_B(I,J) ) + DS2d%u_ice_C(I,j) = US%m_s_to_L_T*0.5 * ( DS2d%u_ice_B(I,J-1) + DS2d%u_ice_B(I,J) ) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - DS2d%v_ice_C(i,J) = 0.5 * ( DS2d%v_ice_B(I-1,J) + DS2d%v_ice_B(I,J) ) + DS2d%v_ice_C(i,J) = US%m_s_to_L_T*0.5 * ( DS2d%v_ice_B(I-1,J) + DS2d%v_ice_B(I,J) ) enddo ; enddo endif ! End of B-grid dynamics @@ -1077,7 +1060,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, enddo ; enddo endif - if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) + if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G, scale=US%L_T_to_m_s) call enable_SIS_averaging(dt_slow_dyn, Time_start + real_to_time(nds*dt_slow_dyn), CS%diag) ! Update the integrated ice mass and store the transports in each step. @@ -1087,15 +1070,18 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, do n = DS2d%nts+1, DS2d%nts+CS%adv_substeps if ((n < ndyn_steps*CS%adv_substeps) .or. continuing_call) then ! Some of the work is not needed for the last step before cat_ice_transport. - call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & + call summed_continuity(US%L_T_to_m_s*DS2d%u_ice_C, US%L_T_to_m_s*DS2d%v_ice_C, & + DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp, & h_ice=DS2d%mi_sum) - call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, dt_adv, G, US, IG, CS%cover_trans_CSp) + call ice_cover_transport(US%L_T_to_m_s*DS2d%u_ice_C, US%L_T_to_m_s*DS2d%v_ice_C, DS2d%ice_cover, dt_adv, & + G, US, IG, CS%cover_trans_CSp) call pass_var(DS2d%mi_sum, G%Domain, complete=.false.) call pass_var(DS2d%ice_cover, G%Domain, complete=.false.) call pass_var(DS2d%mca_step(:,:,n), G%Domain, complete=.true.) else - call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & + call summed_continuity(US%L_T_to_m_s*DS2d%u_ice_C, US%L_T_to_m_s*DS2d%v_ice_C, & + DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp) endif enddo @@ -1196,7 +1182,7 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, G, US, CS%complete_ice_cover) if (CS%debug) then - call uvchksum("Before SIS_C_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + call uvchksum("Before SIS_C_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) call hchksum(IST%part_size(:,:,0), "ice_free before SIS_C_dynamics", G%HI) call hchksum(misp_sum, "misp_sum before SIS_C_dynamics", G%HI) call hchksum(mi_sum, "mi_sum before SIS_C_dynamics", G%HI) @@ -1211,9 +1197,11 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer call mpp_clock_begin(iceClocka) call slab_ice_dynamics(IST%u_ice_C, IST%v_ice_C, OSS%u_ocn_C, OSS%v_ocn_C, & WindStr_x_Cu, WindStr_y_Cv, str_x_ice_ocn_Cu, str_y_ice_ocn_Cv) + IST%u_ice_C(:,:) = US%m_s_to_L_T*IST%u_ice_C(:,:) + IST%v_ice_C(:,:) = US%m_s_to_L_T*IST%v_ice_C(:,:) call mpp_clock_end(iceClocka) - if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) call mpp_clock_begin(iceClockb) call pass_vector(IST%u_ice_C, IST%v_ice_C, G%Domain, stagger=CGRID_NE) @@ -1225,7 +1213,8 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer if (CS%id_fax>0) call post_data(CS%id_fax, WindStr_x_Cu, CS%diag) if (CS%id_fay>0) call post_data(CS%id_fay, WindStr_y_Cv, CS%diag) - if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", & + IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) ! Store all mechanical ocean forcing. call set_ocean_top_stress_C2(IOF, WindStr_x_ocn_Cu, WindStr_y_ocn_Cv, str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, & @@ -1291,10 +1280,10 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer ! Convert the B-grid velocities to C-grid points for transport. if (CS%debug) call Bchksum_pair("Before ice_transport [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) do j=jsc,jec ; do I=isc-1,iec - IST%u_ice_C(I,j) = 0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) + IST%u_ice_C(I,j) = US%m_s_to_L_T*0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - IST%v_ice_C(i,J) = 0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) + IST%v_ice_C(i,J) = US%m_s_to_L_T*0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) enddo ; enddo call mpp_clock_end(iceClock4) @@ -1303,10 +1292,10 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer ! Do ice mass transport and related tracer transport. This updates the category-decomposed ice state. call mpp_clock_begin(iceClock8) - if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) call enable_SIS_averaging(dt_slow_dyn, CS%Time - real_to_time((ndyn_steps-nds)*dt_slow_dyn), CS%diag) - call slab_ice_advect(US%m_s_to_L_T*IST%u_ice_C, US%m_s_to_L_T*IST%v_ice_C, IST%mH_ice(:,:,1), 4.0*IG%kg_m2_to_H, & + call slab_ice_advect(IST%u_ice_C, IST%v_ice_C, IST%mH_ice(:,:,1), 4.0*IG%kg_m2_to_H, & US%s_to_T*dt_slow_dyn, G, US, IST%part_size(:,:,1), nsteps=CS%adv_substeps) call mpp_clock_end(iceClock8) diff --git a/src/SIS_fast_thermo.F90 b/src/SIS_fast_thermo.F90 index 04f6b210..5ccb785c 100644 --- a/src/SIS_fast_thermo.F90 +++ b/src/SIS_fast_thermo.F90 @@ -658,7 +658,7 @@ subroutine do_update_ice_model_fast(Atmos_boundary, IST, sOSS, Rad, FIA, & endif if (CS%debug_fast) & - call IST_chksum("Start do_update_ice_model_fast", IST, G, IG) + call IST_chksum("Start do_update_ice_model_fast", IST, G, G%US, IG) !$OMP parallel do default(shared) private(i2,j2,k2) do j=jsc,jec @@ -826,7 +826,7 @@ subroutine do_update_ice_model_fast(Atmos_boundary, IST, sOSS, Rad, FIA, & sh_T0, evap_T0, lw_T0, dshdt, devapdt, dlwdt, G, IG ) if (CS%debug_fast) & - call IST_chksum("End do_update_ice_model_fast", IST, G, IG) + call IST_chksum("End do_update_ice_model_fast", IST, G, G%US, IG) if (CS%bounds_check) & call IST_bounds_check(IST, G, IG, "End of update_ice_fast", Rad=Rad) !, OSS=sOSS) @@ -936,7 +936,7 @@ subroutine redo_update_ice_model_fast(IST, sOSS, Rad, FIA, TSF, optics_CSp, & T_bright = bright_ice_temp(optics_CSp, IST%ITV) if (CS%debug_slow) then - call IST_chksum("Start redo_update_ice_model_fast", IST, G, IG) + call IST_chksum("Start redo_update_ice_model_fast", IST, G, G%US, IG) endif call get_SIS2_thermo_coefs(IST%ITV, ice_salinity=S_col, enthalpy_units=enth_units, & @@ -1188,7 +1188,7 @@ subroutine redo_update_ice_model_fast(IST, sOSS, Rad, FIA, TSF, optics_CSp, & endif ; enddo if (CS%debug_slow) & - call IST_chksum("End redo_update_ice_model_fast", IST, G, IG) + call IST_chksum("End redo_update_ice_model_fast", IST, G, G%US, IG) if (CS%bounds_check) & call IST_bounds_check(IST, G, IG, "End of redo_update_ice_fast", Rad=Rad) !, OSS=sOSS) diff --git a/src/SIS_slow_thermo.F90 b/src/SIS_slow_thermo.F90 index c9ecfa06..e9a5bf53 100644 --- a/src/SIS_slow_thermo.F90 +++ b/src/SIS_slow_thermo.F90 @@ -346,7 +346,7 @@ subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, US, IG) CS%n_calls = CS%n_calls + 1 if (CS%debug) then - call IST_chksum("Start update_ice_model_slow", IST, G, IG) + call IST_chksum("Start update_ice_model_slow", IST, G, US, IG) endif if (CS%bounds_check) & diff --git a/src/SIS_sum_output.F90 b/src/SIS_sum_output.F90 index d6d0cb1e..5f1b9ad4 100644 --- a/src/SIS_sum_output.F90 +++ b/src/SIS_sum_output.F90 @@ -473,17 +473,17 @@ subroutine write_ice_statistics(IST, day, n, G, US, IG, CS, message, check_colum if (IST%Cgrid_dyn) then if (allocated(IST%u_ice_C)) then ; do j=js,je ; do I=is-1,ie if (IST%u_ice_C(I,j) < 0.0) then - CFL_trans = (-IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i+1,j)) + CFL_trans = (-IST%u_ice_C(I,j) * US%s_to_T*dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i,j)) + CFL_trans = (IST%u_ice_C(I,j) * US%s_to_T*dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif max_CFL = max(max_CFL, CFL_trans) enddo ; enddo ; endif if (allocated(IST%v_ice_C)) then ; do J=js-1,je ; do i=is,ie if (IST%v_ice_C(i,J) < 0.0) then - CFL_trans = (-IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j+1)) + CFL_trans = (-IST%v_ice_C(i,J) * US%s_to_T*dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j)) + CFL_trans = (IST%v_ice_C(i,J) * US%s_to_T*dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif max_CFL = max(max_CFL, CFL_trans) enddo ; enddo ; endif diff --git a/src/SIS_types.F90 b/src/SIS_types.F90 index 55220e5c..477ae431 100644 --- a/src/SIS_types.F90 +++ b/src/SIS_types.F90 @@ -67,10 +67,10 @@ module SIS_types real, allocatable, dimension(:,:) :: v_ice_B !< The pseudo-meridional ice velocity along the !! along the grid directions on a B-grid [m s-1]. real, allocatable, dimension(:,:) :: u_ice_C !< The pseudo-zonal ice velocity along the - !! along the grid directions on a C-grid [m s-1]. + !! along the grid directions on a C-grid [L T-1 ~> m s-1]. !! All thickness categories are assumed to have the same velocities. real, allocatable, dimension(:,:) :: v_ice_C !< The pseudo-meridional ice velocity along the - !! along the grid directions on a C-grid [m s-1]. + !! along the grid directions on a C-grid [L T-1 ~> m s-1]. real, allocatable, dimension(:,:,:) :: & mH_pond, & !< The mass per unit area of the pond in each category [H ~> kg m-2]. @@ -567,21 +567,23 @@ subroutine register_unit_conversion_restarts(US, Ice_restart, restart_file) end subroutine register_unit_conversion_restarts !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> ice_state_read_alt_restarts reads in alternative variables that might have -!! been in the restart file, specifically dealing with changing between -!! symmetric and non-symmetric memory restart files. -subroutine ice_state_read_alt_restarts(IST, G, IG, Ice_restart, & +!> ice_state_read_alt_restarts reads in alternative variables that might have been in the restart +!! file, specifically dealing with changing between symmetric and non-symmetric memory restart +!! files. It also handles any changes in dimensional rescaling of these variables between what is +!! stored in the restart file and what is done for the current run segment. +subroutine ice_state_read_alt_restarts(IST, G, US, IG, Ice_restart, & restart_file, restart_dir) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(restart_file_type), pointer :: Ice_restart !< A pointer to the restart type for the ice character(len=*), intent(in) :: restart_file !< The name of the ice restart file character(len=*), intent(in) :: restart_dir !< A directory in which to find the restart file - ! These are temporary variables that will be used only here for reading and - ! then discarded. + ! These are temporary variables that will be used only here for reading and then discarded. real, allocatable, target, dimension(:,:) :: u_tmp, v_tmp + real :: vel_rescale type(MOM_domain_type), pointer :: domain_tmp => NULL() logical :: u_set, v_set integer :: i, j, id_u, id_v @@ -713,6 +715,18 @@ subroutine ice_state_read_alt_restarts(IST, G, IG, Ice_restart, & deallocate(u_tmp, v_tmp) deallocate(domain_tmp%mpp_domain) ; deallocate(domain_tmp) + ! Now redo the dimensional rescaling of the velocities if necessary. + if (IST%Cgrid_dyn .and. (US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then + vel_rescale = (US%m_to_L*US%s_to_T_restart) / (US%m_to_L_restart*US%s_to_T) + do j=G%jsc,G%jec ; do I=G%isc-1,G%iec + IST%u_ice_C(I,j) = vel_rescale * IST%u_ice_C(I,j) + enddo ; enddo + do J=G%jsc-1,G%jec ; do i=G%isc,G%iec + IST%v_ice_C(i,J) = vel_rescale * IST%v_ice_C(i,J) + enddo ; enddo + endif + end subroutine ice_state_read_alt_restarts !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! @@ -1159,12 +1173,13 @@ end subroutine redistribute_IST_to_IST !> translate_OSS_to_sOSS translates the full ocean surface state, as seen by the slow !! ice processors into a simplified version with the fields that are shared with !! the atmosphere and the fast ice thermodynamics. -subroutine translate_OSS_to_sOSS(OSS, IST, sOSS, G) +subroutine translate_OSS_to_sOSS(OSS, IST, sOSS, G, US) type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. type(ice_state_type), intent(in) :: IST !< A type describing the state of the sea ice type(simple_OSS_type), intent(inout) :: sOSS !< The simple ocean surface state type that is being copied into type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors integer :: i, j, k, m, n, i2, j2, k2, isc, iec, jsc, jec, i_off, j_off integer :: isd, ied, jsd, jed @@ -1191,8 +1206,8 @@ subroutine translate_OSS_to_sOSS(OSS, IST, sOSS, G) (OSS%v_ocn_B(I,J-1) + OSS%v_ocn_B(I-1,J)) ) endif if (IST%Cgrid_dyn) then - sOSS%u_ice_A(i,j) = 0.5*(IST%u_ice_C(I,j) + IST%u_ice_C(I-1,j)) - sOSS%v_ice_A(i,j) = 0.5*(IST%v_ice_C(i,J) + IST%v_ice_C(i,J-1)) + sOSS%u_ice_A(i,j) = US%L_T_to_m_s*0.5*(IST%u_ice_C(I,j) + IST%u_ice_C(I-1,j)) + sOSS%v_ice_A(i,j) = US%L_T_to_m_s*0.5*(IST%v_ice_C(i,J) + IST%v_ice_C(i,J-1)) else sOSS%u_ice_A(i,j) = 0.25*((IST%u_ice_B(I,J) + IST%u_ice_B(I-1,J-1)) + & (IST%u_ice_B(I,J-1) + IST%u_ice_B(I-1,J)) ) @@ -2267,10 +2282,11 @@ end subroutine FIA_chksum !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Perform checksums on various arrays in an ice_state_type. -subroutine IST_chksum(mesg, IST, G, IG, haloshift) +subroutine IST_chksum(mesg, IST, G, US, IG, haloshift) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(ice_state_type), intent(in) :: IST !< The structure whose arrays are being checksummed. type(SIS_hor_grid_type), intent(inout) :: G !< The ice-model's horizonal grid type. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice grid type. integer, optional, intent(in) :: haloshift !< The width of halos to check, or 0 if missing. @@ -2300,7 +2316,7 @@ subroutine IST_chksum(mesg, IST, G, IG, haloshift) call check_redundant_B(mesg//" IST%u/v_ice", IST%u_ice_B, IST%v_ice_B, G) endif if (allocated(IST%u_ice_C) .and. allocated(IST%v_ice_C)) then - call uvchksum(mesg//" IST%[uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, halos=hs) + call uvchksum(mesg//" IST%[uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, halos=hs, scale=US%L_T_to_m_s) call check_redundant_C(mesg//" IST%u/v_ice_C", IST%u_ice_C, IST%v_ice_C, G) endif diff --git a/src/ice_model.F90 b/src/ice_model.F90 index cfff561f..f74e2b76 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -247,7 +247,7 @@ subroutine update_ice_slow_thermo(Ice) if (Ice%sCS%debug) then call Ice_public_type_chksum("Before set_ocean_top_fluxes", Ice, check_slow=.true.) call IOF_chksum("Before set_ocean_top_fluxes", Ice%sCS%IOF, sG) - call IST_chksum("Before set_ocean_top_fluxes", sIST, sG, sIG) + call IST_chksum("Before set_ocean_top_fluxes", sIST, sG, US, sIG) endif ! Set up the thermodynamic fluxes in the externally visible structure Ice. call set_ocean_top_fluxes(Ice, sIST, Ice%sCS%IOF, FIA, Ice%sCS%OSS, sG, sIG, Ice%sCS) @@ -811,7 +811,7 @@ subroutine unpack_ocean_ice_boundary(Ocean_boundary, Ice) call unpack_ocn_ice_bdry(Ocean_boundary, Ice%sCS%OSS, Ice%sCS%IST%ITV, Ice%sCS%G, & Ice%sCS%specified_ice, Ice%ocean_fields) - call translate_OSS_to_sOSS(Ice%sCS%OSS, Ice%sCS%IST, Ice%sCS%sOSS, Ice%sCS%G) + call translate_OSS_to_sOSS(Ice%sCS%OSS, Ice%sCS%IST, Ice%sCS%sOSS, Ice%sCS%G, Ice%sCS%US) end subroutine unpack_ocean_ice_boundary @@ -1012,7 +1012,7 @@ subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) call IST_bounds_check(IST, G, IG, "Start of set_ice_surface_state", Rad=Rad) !, OSS=OSS) if (fCS%debug) then - call IST_chksum("Start set_ice_surface_state", IST, G, IG) + call IST_chksum("Start set_ice_surface_state", IST, G, fCS%US, IG) call Ice_public_type_chksum("Start set_ice_surface_state", Ice, check_fast=.true.) endif @@ -1154,7 +1154,7 @@ subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) call coupler_type_copy_data(OSS%tr_fields, Ice%ocean_fields, ind3_start=1, ind3_end=1) if (fCS%debug) then - call IST_chksum("End set_ice_surface_state", IST, G, IG) + call IST_chksum("End set_ice_surface_state", IST, G, fCS%US, IG) call Ice_public_type_chksum("End set_ice_surface_state", Ice, check_fast=.true.) endif @@ -2308,7 +2308,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! If the velocity and other fields have not been initialized, check for ! the fields that would have been read if symmetric were toggled. - call ice_state_read_alt_restarts(sIST, sG, sIG, Ice%Ice_restart, & + call ice_state_read_alt_restarts(sIST, sG, US, sIG, Ice%Ice_restart, & restart_file, dirs%restart_input_dir) if (.not.specified_ice) & call SIS_dyn_trans_read_alt_restarts(Ice%sCS%dyn_trans_CSp, sG, US, Ice%Ice_restart, & diff --git a/src/specified_ice.F90 b/src/specified_ice.F90 index e861ce29..1e9263ca 100644 --- a/src/specified_ice.F90 +++ b/src/specified_ice.F90 @@ -97,7 +97,7 @@ subroutine specified_ice_dynamics(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG) call post_ice_state_diagnostics(CS%IDs, IST, OSS, IOF, dt_slow, CS%Time, G, IG, CS%diag) call disable_SIS_averaging(CS%diag) - if (CS%debug) call IST_chksum("End specified_ice_dynamics", IST, G, IG) + if (CS%debug) call IST_chksum("End specified_ice_dynamics", IST, G, US, IG) if (CS%bounds_check) call IST_bounds_check(IST, G, IG, "End of specified_ice_dynamics", OSS=OSS) if (CS%Time + real_to_time(0.5*dt_slow) > CS%write_ice_stats_time) then From 308c89ab3f18586bb140d4bcdacb7e00854ca89f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 Oct 2019 17:34:45 -0400 Subject: [PATCH 14/24] +Rescaled the timestep stored in SIS_sum_output Rescaled the timestep stored in SIS_sum_output to units of [T] for expanded dimensional consistency testing. New unit_scale_type arguments were added to two routines in SIS_sum_output.F90. The answers in the Baltic test case are bitwise identical. --- src/SIS_dyn_trans.F90 | 2 +- src/SIS_slow_thermo.F90 | 2 +- src/SIS_sum_output.F90 | 26 ++++++++++++++------------ src/specified_ice.F90 | 2 +- 4 files changed, 17 insertions(+), 15 deletions(-) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index ca4d8dbd..22ba0cdd 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -2273,7 +2273,7 @@ subroutine SIS_dyn_trans_init(Time, G, US, IG, param_file, diag, CS, output_dir, endif - call SIS_sum_output_init(G, param_file, output_dir, Time_Init, & + call SIS_sum_output_init(G, param_file, output_dir, Time_Init, US, & CS%sum_output_CSp, CS%ntrunc) CS%write_ice_stats_time = Time_Init + CS%ice_stats_interval * & diff --git a/src/SIS_slow_thermo.F90 b/src/SIS_slow_thermo.F90 index e9a5bf53..f0c986ea 100644 --- a/src/SIS_slow_thermo.F90 +++ b/src/SIS_slow_thermo.F90 @@ -463,7 +463,7 @@ subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, US, IG) call SIS_call_tracer_column_fns(dt_slow, G, IG, CS%tracer_flow_CSp, IST%mH_ice, mi_old) call disable_SIS_averaging(CS%diag) - call accumulate_bottom_input(IST, OSS, FIA, IOF, dt_slow, G, IG, CS%sum_output_CSp) + call accumulate_bottom_input(IST, OSS, FIA, IOF, dt_slow, G, US, IG, CS%sum_output_CSp) ! This needs to go after accumulate_bottom_input. if (associated(XSF)) call add_excess_fluxes(IOF, XSF, G) diff --git a/src/SIS_sum_output.F90 b/src/SIS_sum_output.F90 index 5f1b9ad4..cd28aa0f 100644 --- a/src/SIS_sum_output.F90 +++ b/src/SIS_sum_output.F90 @@ -81,7 +81,7 @@ module SIS_sum_output type(EFP_type) :: heat_prev_EFP !< An extended fixed point version of heat_prev type(EFP_type) :: salt_prev_EFP !< An extended fixed point version of salt_prev type(EFP_type) :: mass_prev_EFP !< An extended fixed point version of mass_prev - real :: dt !< The baroclinic dynamics time step [s]. + real :: dt !< The baroclinic dynamics time step [T ~> s]. real :: timeunit !< The length of the units for the time axis [s]. type(time_type) :: Start_time !< The start time of the simulation. !< Start_time is set in SIS_initialization.F90 @@ -110,11 +110,12 @@ module SIS_sum_output contains !> Initialize the SIS_sum_output control structure, allocate memory and store runtime parameters. -subroutine SIS_sum_output_init(G, param_file, directory, Input_start_time, CS, ntrunc) +subroutine SIS_sum_output_init(G, param_file, directory, Input_start_time, US, CS, ntrunc) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters character(len=*), intent(in) :: directory !< The directory where the statistics file goes type(time_type), intent(in) :: Input_start_time !< The start time of the simulation + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_sum_out_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module integer, target, optional,intent(inout) :: ntrunc !< The integer that stores the number of times @@ -148,7 +149,7 @@ subroutine SIS_sum_output_init(G, param_file, directory, Input_start_time, CS, n call get_param(param_file, mdl, "DT_ICE_DYNAMICS", CS%dt, & "The time step used for the slow ice dynamics, including "//& "stepping the continuity equation and interactions between "//& - "the ice mass field and velocities.", units="s", & + "the ice mass field and velocities.", units="s", scale=US%s_to_T, & default=-1.0, do_not_log=.true.) call get_param(param_file, mdl, "MAXTRUNC", CS%maxtrunc, & "The run will be stopped, and the day set to a very \n"//& @@ -288,7 +289,7 @@ subroutine write_ice_statistics(IST, day, n, G, US, IG, CS, message, check_colum real :: CFL_trans ! A transport-based definition of the CFL number [nondim]. real :: CFL_u, CFL_v ! Simple CFL numbers for u- and v- advection [nondim]. - real :: dt_CFL ! The timestep for calculating the CFL number [s]. + real :: dt_CFL ! The timestep for calculating the CFL number [T ~> s]. real :: max_CFL ! The maximum of the CFL numbers [nondim]. real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int @@ -473,24 +474,24 @@ subroutine write_ice_statistics(IST, day, n, G, US, IG, CS, message, check_colum if (IST%Cgrid_dyn) then if (allocated(IST%u_ice_C)) then ; do j=js,je ; do I=is-1,ie if (IST%u_ice_C(I,j) < 0.0) then - CFL_trans = (-IST%u_ice_C(I,j) * US%s_to_T*dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (IST%u_ice_C(I,j) * US%s_to_T*dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (IST%u_ice_C(I,j) * dt_CFL) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif max_CFL = max(max_CFL, CFL_trans) enddo ; enddo ; endif if (allocated(IST%v_ice_C)) then ; do J=js-1,je ; do i=is,ie if (IST%v_ice_C(i,J) < 0.0) then - CFL_trans = (-IST%v_ice_C(i,J) * US%s_to_T*dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (IST%v_ice_C(i,J) * US%s_to_T*dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (IST%v_ice_C(i,J) * dt_CFL) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif max_CFL = max(max_CFL, CFL_trans) enddo ; enddo ; endif elseif (allocated(IST%u_ice_B) .and. allocated(IST%v_ice_B)) then do J=js-1,je ; do I=is-1,ie - CFL_u = abs(IST%u_ice_B(I,J)) * dt_CFL * US%m_to_L * G%IdxBu(I,J) - CFL_v = abs(IST%v_ice_B(I,J)) * dt_CFL * US%m_to_L * G%IdyBu(I,J) + CFL_u = abs(US%m_s_to_L_T*IST%u_ice_B(I,J)) * dt_CFL * G%IdxBu(I,J) + CFL_v = abs(US%m_s_to_L_T*IST%v_ice_B(I,J)) * dt_CFL * G%IdyBu(I,J) max_CFL = max(max_CFL, CFL_u, CFL_v) enddo ; enddo endif @@ -716,7 +717,7 @@ end subroutine write_ice_statistics !> Accumulate the net input of fresh water and heat through the bottom of the !! sea-ice for conservation checks. -subroutine accumulate_bottom_input(IST, OSS, FIA, IOF, dt, G, IG, CS) +subroutine accumulate_bottom_input(IST, OSS, FIA, IOF, dt, G, US, IG, CS) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(ice_state_type), intent(in) :: IST !< A type describing the state of the sea ice @@ -727,6 +728,7 @@ subroutine accumulate_bottom_input(IST, OSS, FIA, IOF, dt, G, IG, CS) type(ice_ocean_flux_type), intent(in) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. real, intent(in) :: dt !< The amount of time over which to average. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_sum_out_CS), pointer :: CS !< The control structure returned by a previous call !! to SIS_sum_output_init. @@ -740,7 +742,7 @@ subroutine accumulate_bottom_input(IST, OSS, FIA, IOF, dt, G, IG, CS) call get_SIS2_thermo_coefs(IST%ITV, enthalpy_units=enth_units, Latent_fusion=LI) - if (CS%dt < 0.0) CS%dt = dt + if (CS%dt < 0.0) CS%dt = US%s_to_T*dt do j=jsc,jec ; do i=isc,iec CS%water_in_col(i,j) = CS%water_in_col(i,j) - dt * & diff --git a/src/specified_ice.F90 b/src/specified_ice.F90 index 1e9263ca..b3a9ef38 100644 --- a/src/specified_ice.F90 +++ b/src/specified_ice.F90 @@ -278,7 +278,7 @@ subroutine specified_ice_init(Time, G, IG, param_file, diag, CS, output_dir, Tim "does not change answers, but can increase model run time.", & default=.true.) - call SIS_sum_output_init(G, param_file, output_dir, Time_Init, & + call SIS_sum_output_init(G, param_file, output_dir, Time_Init, G%US, & CS%sum_output_CSp, CS%ntrunc) CS%write_ice_stats_time = Time_Init + CS%ice_stats_interval * & From 224a2aff16aa65613e973a3b3a50820f5a60d6de Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 Oct 2019 19:02:03 -0400 Subject: [PATCH 15/24] +Rescaled variables used in SIS_continuity Rescaled the velocities, timesteps, and transports passed back and forth to several routines in SIS_continuity. The answers in the Baltic test case are bitwise identical, but this test may not be fully testing these changes. --- src/SIS_continuity.F90 | 146 ++++++++++++++++++++--------------------- src/SIS_dyn_trans.F90 | 20 ++++-- src/SIS_transport.F90 | 23 ++++++- 3 files changed, 107 insertions(+), 82 deletions(-) diff --git a/src/SIS_continuity.F90 b/src/SIS_continuity.F90 index bafdde0c..ad483a4b 100644 --- a/src/SIS_continuity.F90 +++ b/src/SIS_continuity.F90 @@ -68,20 +68,20 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, US, IG, CS) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: u !< Zonal ice velocity [m s-1]. + intent(in) :: u !< Zonal ice velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: v !< Meridional ice velocity [m s-1]. + intent(in) :: v !< Meridional ice velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: hin !< Initial ice or snow thickness by category [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: h !< Final ice or snow thickness by category [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(out) :: vh !< Volume flux through meridional faces = v*h*dx - !! [H m2 s-1 ~> kg s-1]. - real, intent(in) :: dt !< Time increment [s] + !! [H L2 T-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. @@ -115,17 +115,17 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, US, IG, CS) do j=js,je ; do k=1,nCat ; do I=is-1,ie if (u(I,j) >= 0.0) then ; h_up = hin(i,j,k) else ; h_up = hin(i+1,j,k) ; endif - uh(I,j,k) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * h_up + uh(I,j,k) = G%dy_Cu(I,j) * u(I,j) * h_up enddo ; enddo ; enddo !$OMP do do J=js-1,je ; do k=1,nCat ; do i=is,ie if (v(i,J) >= 0.0) then ; h_up = hin(i,j,k) else ; h_up = hin(i,j+1,k) ; endif - vh(i,J,k) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * h_up + vh(i,J,k) = G%dx_Cv(i,J) * v(i,J) * h_up enddo ; enddo ; enddo !$OMP do do j=js,je ; do k=1,nCat ; do i=is,ie - h(i,j,k) = hin(i,j,k) - dt* US%m_to_L**2*G%IareaT(i,j) * & + h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * & ((uh(I,j,k) - uh(I-1,j,k)) + (vh(i,J,k) - vh(i,J-1,k))) if (h(i,j,k) < 0.0) then @@ -142,7 +142,7 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of ice_continuity().') @@ -159,7 +159,7 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of ice_continuity().') @@ -177,7 +177,7 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of ice_continuity().') @@ -193,7 +193,7 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) if (h(i,j,k) < 0.0) then call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of ice_continuity().') @@ -210,18 +210,18 @@ end subroutine ice_continuity subroutine ice_cover_transport(u, v, cvr, dt, G, US, IG, CS) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u !< Zonal ice velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v !< Meridional ice velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u !< Zonal ice velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v !< Meridional ice velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: cvr !< Fractional ice cover [nondim]. - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. ! Local variables type(loop_bounds_type) :: LB ! A structure with the active loop bounds. - real, dimension(SZIB_(G),SZJ_(G)) :: ucvr ! Ice cover flux through zonal faces = u*cvr*dy [m2 s-1]. - real, dimension(SZI_(G),SZJB_(G)) :: vcvr ! Ice cover flux through meridional faces = v*cvr*dx [m2 s-1]. + real, dimension(SZIB_(G),SZJ_(G)) :: ucvr ! Ice cover flux through zonal faces = u*cvr*dy [L2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZJB_(G)) :: vcvr ! Ice cover flux through meridional faces = v*cvr*dx [L2 T-1 ~> m2 s-1]. real :: cvr_up integer :: is, ie, js, je, stensil integer :: i, j @@ -246,17 +246,17 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, US, IG, CS) do j=js,je ; do I=is-1,ie if (u(I,j) >= 0.0) then ; cvr_up = cvr(i,j) else ; cvr_up = cvr(i+1,j) ; endif - ucvr(I,j) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * cvr_up + ucvr(I,j) = G%dy_Cu(I,j) * u(I,j) * cvr_up enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie if (v(i,J) >= 0.0) then ; cvr_up = cvr(i,j) else ; cvr_up = cvr(i,j+1) ; endif - vcvr(i,J) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * cvr_up + vcvr(i,J) = G%dx_Cv(i,J) * v(i,J) * cvr_up enddo ; enddo !$OMP do do j=js,je ; do i=is,ie - cvr(i,j) = cvr(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * & + cvr(i,j) = cvr(i,j) - dt * G%IareaT(i,j) * & ((ucvr(I,j) - ucvr(I-1,j)) + (vcvr(i,J) - vcvr(i,J-1))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in ice_cover_transport().') @@ -270,7 +270,7 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = cvr(i,j) - US%m_to_L**2*G%IareaT(i,j) * (dt*(ucvr(I,j) - ucvr(I-1,j))) + cvr(i,j) = cvr(i,j) - G%IareaT(i,j) * (dt*(ucvr(I,j) - ucvr(I-1,j))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in u-pass of ice_cover_transport().') enddo ; enddo @@ -283,7 +283,7 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = max(1.0, cvr(i,j) - dt*US%m_to_L**2*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1))) + cvr(i,j) = max(1.0, cvr(i,j) - dt*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in v-pass of ice_cover_transport().') enddo ; enddo @@ -297,7 +297,7 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = cvr(i,j) - dt*US%m_to_L**2*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1)) + cvr(i,j) = cvr(i,j) - dt*G%IareaT(i,j) * (vcvr(i,J) - vcvr(i,J-1)) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in v-pass of ice_cover_transport().') enddo ; enddo @@ -310,7 +310,7 @@ subroutine ice_cover_transport(u, v, cvr, dt, G, US, IG, CS) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - cvr(i,j) = max(1.0, cvr(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (ucvr(I,j) - ucvr(I-1,j))) + cvr(i,j) = max(1.0, cvr(i,j) - dt* G%IareaT(i,j) * (ucvr(I,j) - ucvr(I-1,j))) if (cvr(i,j) < 0.0) call SIS_error(FATAL, & 'Negative ice cover encountered in u-pass of ice_cover_transport().') enddo ; enddo @@ -328,17 +328,17 @@ end subroutine ice_cover_transport subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u !< Zonal ice velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v !< Meridional ice velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u !< Zonal ice velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v !< Meridional ice velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial total ice and snow mass per !! unit cell area [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h !< Total ice and snow mass per unit cell !! area [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uh !< Total mass flux through zonal faces - !! = u*h*dy [H m2 s-1 ~> kg s-1]. + !! = u*h*dy [H L2 T-1 ~> kg s-1] real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vh !< Total mass flux through meridional faces - !! = v*h*dx [H m2 s-1 ~> kg s-1]. - real, intent(in) :: dt !< Time increment [s] + !! = v*h*dx [H L2 T-1 ~> kg s-1] + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. @@ -349,9 +349,9 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) ! Local variables type(loop_bounds_type) :: LB ! A structure with the active loop bounds. real, dimension(SZIB_(G),SZJ_(G)) :: uh_ice ! Ice mass flux through zonal faces = u*h*dy - ! [H m2 s-1 ~> kg s-1]. + ! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G)) :: vh_ice ! Ice mass flux through meridional faces = v*h*dx - ! [H m2 s-1 ~> kg s-1]. + ! [H L2 T-1 ~> kg s-1]. real :: h_up integer :: is, ie, js, je, stensil integer :: i, j @@ -366,11 +366,11 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) stensil = 3 ; if (CS%simple_2nd) stensil = 2 ; if (CS%upwind_1st) stensil = 1 do j=js,je ; do i=is,ie ; if (h_in(i,j) < 0.0) then - call SIS_error(FATAL, 'Negative mass input to ice_total_continuity().') + call SIS_error(FATAL, 'Negative mass input to summed_continuity().') endif ; enddo ; enddo if (present(h_ice)) then ; do j=js,je ; do i=is,ie ; if (h_ice(i,j) > h_in(i,j)) then - call SIS_error(FATAL, 'ice mass exceeds total mass in ice_total_continuity().') + call SIS_error(FATAL, 'ice mass exceeds total mass in summed_continuity().') endif ; enddo ; enddo ; endif if (CS%use_upwind2d) then @@ -380,13 +380,13 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) do j=js,je ; do I=is-1,ie if (u(I,j) >= 0.0) then ; h_up = h_in(i,j) else ; h_up = h_in(i+1,j) ; endif - uh(I,j) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * h_up + uh(I,j) = G%dy_Cu(I,j) * u(I,j) * h_up enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie if (v(i,J) >= 0.0) then ; h_up = h_in(i,j) else ; h_up = h_in(i,j+1) ; endif - vh(i,J) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * h_up + vh(i,J) = G%dx_Cv(i,J) * v(i,J) * h_up enddo ; enddo if (present(h_ice)) then !$OMP do @@ -403,13 +403,13 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) enddo ; enddo !$OMP do do j=js,je ; do i=is,ie - h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * & + h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * & ((uh_ice(I,j) - uh_ice(I-1,j)) + (vh_ice(i,J) - vh_ice(i,J-1))) enddo ; enddo endif !$OMP do do j=js,je ; do i=is,ie - h(i,j) = h_in(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * & + h(i,j) = h_in(i,j) - (dt * G%IareaT(i,j)) * & ((uh(I,j) - uh(I-1,j)) + (vh(i,J) - vh(i,J-1))) ! if (h(i,j) < 0.0) call SIS_error(FATAL, & ! 'Negative thickness encountered in ice_total_continuity().') @@ -434,14 +434,14 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) else ; uh_ice(I,j) = 0.0 ; endif enddo do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) + h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) enddo enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h_in(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) + h(i,j) = h_in(i,j) - (dt * G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) ! if (h(i,j) < 0.0) call SIS_error(FATAL, & ! 'Negative thickness encountered in u-pass of ice_total_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then @@ -464,15 +464,15 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) enddo ; enddo !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) + h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) + h(i,j) = h(i,j) - (dt * G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) if (h(i,j) < 0.0) call SIS_error(FATAL, & - 'Negative thickness encountered in v-pass of ice_total_continuity().') + 'Negative thickness encountered in v-pass of summed_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then ! call SIS_error(FATAL, 'ice mass exceeds total mass in ice_total_continuity() x-2.') ! endif ; endif @@ -494,13 +494,13 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) enddo ; enddo !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) + h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (vh_ice(i,J) - vh_ice(i,J-1)) enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h_in(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) + h(i,j) = h_in(i,j) - (dt * G%IareaT(i,j)) * (vh(i,J) - vh(i,J-1)) ! if (h(i,j) < 0.0) call SIS_error(FATAL, & ! 'Negative thickness encountered in v-pass of ice_total_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then @@ -524,16 +524,16 @@ subroutine summed_continuity(u, v, h_in, h, uh, vh, dt, G, US, IG, CS, h_ice) else ; uh_ice(I,j) = 0.0 ; endif enddo do i=LB%ish,LB%ieh - h_ice(i,j) = h_ice(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) + h_ice(i,j) = h_ice(i,j) - (dt * G%IareaT(i,j)) * (uh_ice(I,j) - uh_ice(I-1,j)) enddo enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j) = h(i,j) - (dt * US%m_to_L**2*G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) + h(i,j) = h(i,j) - (dt * G%IareaT(i,j)) * (uh(I,j) - uh(I-1,j)) if (h(i,j) < 0.0) call SIS_error(FATAL, & - 'Negative thickness encountered in u-pass of ice_continuity().') + 'Negative thickness encountered in u-pass of summed_continuity().') ! if (present(h_ice)) then ; if (h_ice(i,j) > h(i,j)) then ! call SIS_error(FATAL, 'ice mass exceeds total mass in ice_total_continuity() y-2.') ! endif ; endif @@ -605,7 +605,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, x_first = (MOD(G%first_direction,2) == 0) do j=js,je ; do i=is,ie ; if (h_tot_in(i,j) < 0.0) then - call SIS_error(FATAL, 'Negative thickness input to ice_continuity().') + call SIS_error(FATAL, 'Negative thickness input to proportionate_continuity().') endif ; enddo ; enddo !$OMP parallel do default(shared) @@ -843,8 +843,8 @@ subroutine zonal_mass_flux(u, dt, G, US, IG, CS, LB, h_in, uh, htot_in, uh_tot) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: u !< Zonal ice velocity [m s-1]. - real, intent(in) :: dt !< Time increment [s] + intent(in) :: u !< Zonal ice velocity [L T-1 ~> m s-1]. + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. @@ -854,12 +854,12 @@ subroutine zonal_mass_flux(u, dt, G, US, IG, CS, LB, h_in, uh, htot_in, uh_tot) optional, intent(in) :: h_in !< Category thickness used to calculate the fluxes [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & optional, intent(out) :: uh !< Category volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: htot_in !< Total thicknesses used to calculate the fluxes [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(out) :: uh_tot !< Total mass flux through zonal faces = u*htot*dy - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. ! This subroutine calculates the mass or volume fluxes through the zonal ! faces, and other related quantities. @@ -876,7 +876,7 @@ subroutine zonal_mass_flux(u, dt, G, US, IG, CS, LB, h_in, uh, htot_in, uh_tot) real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. ! real :: h_marg ! The marginal thickness of a flux [H ~> kg m-2]. - real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. +! real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. integer :: i, j, k, ish, ieh, jsh, jeh, nz ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = IG%CatIce @@ -917,24 +917,24 @@ subroutine zonal_mass_flux(u, dt, G, US, IG, CS, LB, h_in, uh, htot_in, uh_tot) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I,j) > 0.0) then - if (CS%vol_CFL) then ; CFL = (u(I,j) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) - else ; CFL = u(I,j) * dt * US%m_to_L*G%IdxT(i,j) ; endif + if (CS%vol_CFL) then ; CFL = (u(I,j) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I,j) * dt * G%IdxT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*htot(i,j) - uhtot(I) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * & + uhtot(I) = G%dy_Cu(I,j) * u(I,j) * & (hR(i,j) + CFL * (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5))) ! h_marg = hR(i,j) + CFL * ((hL(i,j) - hR(i,j)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j) < 0.0) then - if (CS%vol_CFL) then ; CFL = (-u(I,j) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) - else ; CFL = -u(I,j) * dt * US%m_to_L*G%IdxT(i+1,j) ; endif + if (CS%vol_CFL) then ; CFL = (-u(I,j) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I,j) * dt * G%IdxT(i+1,j) ; endif curv_3 = hL(i+1,j) + hR(i+1,j) - 2.0*htot(i+1,j) - uhtot(I) = US%L_to_m*G%dy_Cu(I,j) * u(I,j) * & + uhtot(I) = G%dy_Cu(I,j) * u(I,j) * & (hL(i+1,j) + CFL * (0.5*(hR(i+1,j)-hL(i+1,j)) + curv_3*(CFL - 1.5))) ! h_marg = hL(i+1) + CFL * ((hR(i+1,j)-hL(i+1,j)) + 3.0*curv_3*(CFL - 1.0)) else uhtot(I) = 0.0 ! h_marg = 0.5 * (hl(i+1,j) + hr(i,j)) endif -! duhdu(I,j) = US%L_to_m*G%dy_Cu(I,j) * h_marg ! * visc_rem(I) +! duhdu(I,j) = G%dy_Cu(I,j) * h_marg ! * visc_rem(I) enddo ! Partition the transports by category in proportion to their relative masses. @@ -966,8 +966,8 @@ subroutine meridional_mass_flux(v, dt, G, US, IG, CS, LB, h_in, vh, htot_in, vh_ type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: v !< Meridional ice velocity [m s-1]. - real, intent(in) :: dt !< Time increment [s] + intent(in) :: v !< Meridional ice velocity [L T-1 ~> m s-1]. + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. @@ -976,12 +976,12 @@ subroutine meridional_mass_flux(v, dt, G, US, IG, CS, LB, h_in, vh, htot_in, vh_ optional, intent(in) :: h_in !< Category thickness used to calculate the fluxes [H ~> kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & optional, intent(out) :: vh !< Category volume flux through meridional faces = v*h*dx - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: htot_in !< Total thicknesses used to calculate the fluxes [H ~> kg m-2]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(out) :: vh_tot !< Total mass flux through meridional faces = v*htot*dx - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. ! This subroutine calculates the mass or volume fluxes through the meridional ! faces, and other related quantities. @@ -994,12 +994,12 @@ subroutine meridional_mass_flux(v, dt, G, US, IG, CS, LB, h_in, vh, htot_in, vh_ I_htot, & ! The inverse of htot or 0 [H-1 ~> m2 kg-1]. hl, hr ! Left and right face thicknesses [m]. real, dimension(SZI_(G)) :: & - vhtot ! The total transports [H m2 s-1 ~> kg s-1]. + vhtot ! The total transports [H L2 s-1 ~> kg s-1]. real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim]. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. real :: h_marg ! The marginal thickness of a flux [m]. - real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. +! real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. integer :: i, j, k, ish, ieh, jsh, jeh, nz ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = IG%CatIce @@ -1042,24 +1042,24 @@ subroutine meridional_mass_flux(v, dt, G, US, IG, CS, LB, h_in, vh, htot_in, vh_ ! This sets vh and dvhdv. do i=ish,ieh if (v(i,J) > 0.0) then - if (CS%vol_CFL) then ; CFL = US%m_to_L*(v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J) * dt * US%m_to_L*G%IdyT(i,j) ; endif + if (CS%vol_CFL) then ; CFL = (v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i,J) * dt * G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*htot(i,j) - vhtot(i) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * ( hR(i,j) + CFL * & + vhtot(i) = G%dx_Cv(i,J) * v(i,J) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) ! h_marg = hR(i,j) + CFL * ((hL(i,j) - hR(i,j)) + 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J) < 0.0) then - if (CS%vol_CFL) then ; CFL = US%m_to_L*(-v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J) * dt * US%m_to_L*G%IdyT(i,j+1) ; endif + if (CS%vol_CFL) then ; CFL = (-v(i,J) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i,J) * dt * G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*htot(i,j+1) - vhtot(i) = US%L_to_m*G%dx_Cv(i,J) * v(i,J) * ( hL(i,j+1) + CFL * & + vhtot(i) = G%dx_Cv(i,J) * v(i,J) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) ! h_marg = hL(i,j+1) + CFL * ((hR(i,j+1)-hL(i,j+1)) + 3.0*curv_3*(CFL - 1.0)) else vhtot(i) = 0.0 ! h_marg = 0.5 * (hl(i,j+1) + hr(i,j)) endif - ! dvhdv(i) = US%L_to_m*G%dx_Cv(i,J) * h_marg ! * visc_rem(i) + ! dvhdv(i) = G%dx_Cv(i,J) * h_marg ! * visc_rem(i) enddo ! Partition the transports by category in proportion to their relative masses. diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 22ba0cdd..baccc849 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -1070,19 +1070,27 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, do n = DS2d%nts+1, DS2d%nts+CS%adv_substeps if ((n < ndyn_steps*CS%adv_substeps) .or. continuing_call) then ! Some of the work is not needed for the last step before cat_ice_transport. - call summed_continuity(US%L_T_to_m_s*DS2d%u_ice_C, US%L_T_to_m_s*DS2d%v_ice_C, & + call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, & DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & - DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp, & - h_ice=DS2d%mi_sum) - call ice_cover_transport(US%L_T_to_m_s*DS2d%u_ice_C, US%L_T_to_m_s*DS2d%v_ice_C, DS2d%ice_cover, dt_adv, & + DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), US%s_to_T*dt_adv, G, US, IG, & + CS%continuity_CSp, h_ice=DS2d%mi_sum) + call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, US%s_to_T*dt_adv, & G, US, IG, CS%cover_trans_CSp) call pass_var(DS2d%mi_sum, G%Domain, complete=.false.) call pass_var(DS2d%ice_cover, G%Domain, complete=.false.) call pass_var(DS2d%mca_step(:,:,n), G%Domain, complete=.true.) else - call summed_continuity(US%L_T_to_m_s*DS2d%u_ice_C, US%L_T_to_m_s*DS2d%v_ice_C, & + call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, & DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & - DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp) + DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + endif + if (US%L_to_m**2*US%s_to_T /= 1.0 ) then + do j=jsc,jec ; do I=isc-1,iec + DS2d%uh_step(I,j,n) = US%L_to_m**2*US%s_to_T*DS2d%uh_step(I,j,n) + enddo ; enddo + do J=jsc-1,jec ; do i=isc,iec + DS2d%vh_step(i,J,n) = US%L_to_m**2*US%s_to_T*DS2d%vh_step(i,J,n) + enddo ; enddo endif enddo DS2d%nts = DS2d%nts + CS%adv_substeps diff --git a/src/SIS_transport.F90 b/src/SIS_transport.F90 index 3c69add0..138d29a0 100644 --- a/src/SIS_transport.F90 +++ b/src/SIS_transport.F90 @@ -186,9 +186,26 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, h2=CAS%m_snow, uh2=uh_snow, vh2=vh_snow, & h3=CAS%m_pond, uh3=uh_pond, vh3=vh_pond) else - call continuity(uc, vc, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, CS%continuity_CSp) - call continuity(uc, vc, mca0_snow, CAS%m_snow, uh_snow, vh_snow, dt_adv, G, US, IG, CS%continuity_CSp) - call continuity(uc, vc, mca0_pond, CAS%m_pond, uh_pond, vh_pond, dt_adv, G, US, IG, CS%continuity_CSp) + call continuity(US%m_s_to_L_T*uc, US%m_s_to_L_T*vc, mca0_ice, CAS%m_ice, uh_ice, vh_ice, & + US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + call continuity(US%m_s_to_L_T*uc, US%m_s_to_L_T*vc, mca0_snow, CAS%m_snow, uh_snow, vh_snow, & + US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + call continuity(US%m_s_to_L_T*uc, US%m_s_to_L_T*vc, mca0_pond, CAS%m_pond, uh_pond, vh_pond, & + US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + + if (US%L_to_m**2*US%s_to_T /= 1.0 ) then + do k=1,nCat ; do j=jsc,jec ; do I=isc-1,iec + uh_ice(I,j,k) = US%L_to_m**2*US%s_to_T*uh_ice(I,j,k) + uh_snow(I,j,k) = US%L_to_m**2*US%s_to_T*uh_snow(I,j,k) + uh_pond(I,j,k) = US%L_to_m**2*US%s_to_T*uh_pond(I,j,k) + enddo ; enddo ; enddo + do k=1,nCat ; do J=jsc-1,jec ; do i=isc,iec + vh_ice(i,J,k) = US%L_to_m**2*US%s_to_T*vh_ice(i,J,k) + vh_snow(i,J,k) = US%L_to_m**2*US%s_to_T*vh_snow(i,J,k) + vh_pond(i,J,k) = US%L_to_m**2*US%s_to_T*vh_pond(i,J,k) + enddo ; enddo ; enddo + endif + endif call advect_scalar(CAS%mH_ice, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, CS%SIS_thick_adv_CSp) From 9b55f7ff44a2c2aac59b353e38e290d876dcbd75 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 31 Oct 2019 11:46:55 -0400 Subject: [PATCH 16/24] +Rescaled transports in proportionate_continuity Rescaled transports in proportionate_continuity and velocities and transports passed to ice_cat_transport. The answers in the Baltic test case are bitwise identical, but this may not be fully testing these changes. --- src/SIS_continuity.F90 | 64 +++++++++++++++++++++--------------------- src/SIS_dyn_trans.F90 | 16 +++-------- src/SIS_transport.F90 | 43 ++++++++++++++-------------- 3 files changed, 57 insertions(+), 66 deletions(-) diff --git a/src/SIS_continuity.F90 b/src/SIS_continuity.F90 index ad483a4b..65563dc4 100644 --- a/src/SIS_continuity.F90 +++ b/src/SIS_continuity.F90 @@ -554,10 +554,10 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_tot_in !< Initial total ice and snow mass per unit !! cell area [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uh_tot !< Total mass flux through zonal faces - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vh_tot !< Total mass flux through meridional faces - !! [H m2 s-1 ~> kg s-1]. - real, intent(in) :: dt !< Time increment [s] + !! [H L2 T-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_continuity_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_continuity_init. @@ -566,28 +566,28 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, !! category [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & optional, intent(out) :: uh1 !< Zonal mass flux of medium 1 by category - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & optional, intent(out) :: vh1 !< Meridional mass flux of medium 1 by category - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & optional, intent(inout) :: h2 !< Updated mass of medium 2 (often snow) by !! category [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & optional, intent(out) :: uh2 !< Zonal mass flux of medium 2 by category - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & optional, intent(out) :: vh2 !< Meridional mass flux of medium 2 by category - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & optional, intent(inout) :: h3 !< Updated mass of medium 3 (pond water?) by !! category [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & optional, intent(out) :: uh3 !< Zonal mass flux of medium 3 by category - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & optional, intent(out) :: vh3 !< Meridional mass flux of medium 3 by category - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: h_tot ! Total thicknesses [H ~> kg m-2]. @@ -622,7 +622,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, call merid_proportionate_fluxes(vh_tot, I_htot, h1, vh1, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * & + h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * & ((uh1(I,j,k) - uh1(I-1,j,k)) + (vh1(i,J,k) - vh1(i,J-1,k)))) enddo ; enddo ; enddo endif @@ -631,7 +631,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, call merid_proportionate_fluxes(vh_tot, I_htot, h2, vh2, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * & + h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * & ((uh2(I,j,k) - uh2(I-1,j,k)) + (vh2(i,J,k) - vh2(i,J-1,k)))) enddo ; enddo ; enddo endif @@ -640,7 +640,7 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, call merid_proportionate_fluxes(vh_tot, I_htot, h3, vh3, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * & + h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * & ((uh3(I,j,k) - uh3(I-1,j,k)) + (vh3(i,J,k) - vh3(i,J-1,k)))) enddo ; enddo ; enddo endif @@ -652,27 +652,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, call zonal_proportionate_fluxes(uh_tot, I_htot, h1, uh1, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) + h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h2)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h2, uh2, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) + h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h3)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h3, uh3, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) + h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot_in(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) + h_tot(i,j) = h_tot_in(i,j) - dt* G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of proportionate_continuity().') I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -684,27 +684,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, call merid_proportionate_fluxes(vh_tot, I_htot, h1, vh1, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) + h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h2)) then call merid_proportionate_fluxes(vh_tot, I_htot, h2, vh2, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) + h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h3)) then call merid_proportionate_fluxes(vh_tot, I_htot, h3, vh3, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) + h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) + h_tot(i,j) = h_tot(i,j) - dt* G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of proportionate_continuity().') ! I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -718,27 +718,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, call merid_proportionate_fluxes(vh_tot, I_htot, h1, vh1, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) + h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (vh1(i,J,k) - vh1(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h2)) then call merid_proportionate_fluxes(vh_tot, I_htot, h2, vh2, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) + h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (vh2(i,J,k) - vh2(i,J-1,k)) ) enddo ; enddo ; enddo endif if (present(h3)) then call merid_proportionate_fluxes(vh_tot, I_htot, h3, vh3, G, IG, LB) !$OMP parallel do default(shared) do j=js,je ; do k=1,nCat ; do i=is,ie - h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) + h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (vh3(i,J,k) - vh3(i,J-1,k)) ) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) + h_tot(i,j) = h_tot(i,j) - dt* G%IareaT(i,j) * (vh_tot(i,J) - vh_tot(i,J-1)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in v-pass of proportionate_continuity().') I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -751,27 +751,27 @@ subroutine proportionate_continuity(h_tot_in, uh_tot, vh_tot, dt, G, US, IG, CS, call zonal_proportionate_fluxes(uh_tot, I_htot, h1, uh1, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h1(i,j,k) = h1(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) + h1(i,j,k) = h1(i,j,k) - G%IareaT(i,j) * (dt * (uh1(I,j,k) - uh1(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h2)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h2, uh2, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h2(i,j,k) = h2(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) + h2(i,j,k) = h2(i,j,k) - G%IareaT(i,j) * (dt * (uh2(I,j,k) - uh2(I-1,j,k))) enddo ; enddo ; enddo endif if (present(h3)) then call zonal_proportionate_fluxes(uh_tot, I_htot, h3, uh3, G, IG, LB) !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do k=1,nCat ; do i=LB%ish,LB%ieh - h3(i,j,k) = h3(i,j,k) - US%m_to_L**2*G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) + h3(i,j,k) = h3(i,j,k) - G%IareaT(i,j) * (dt * (uh3(I,j,k) - uh3(I-1,j,k))) enddo ; enddo ; enddo endif !$OMP parallel do default(shared) do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h_tot(i,j) = h_tot_in(i,j) - dt* US%m_to_L**2*G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) + h_tot(i,j) = h_tot_in(i,j) - dt* G%IareaT(i,j) * (uh_tot(I,j) - uh_tot(I-1,j)) if (h_tot(i,j) < 0.0) call SIS_error(FATAL, & 'Negative thickness encountered in u-pass of proportionate_continuity().') ! I_htot(i,j) = 0.0 ; if (h_tot(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot(i,j) @@ -786,14 +786,14 @@ subroutine zonal_proportionate_fluxes(uh_tot, I_htot, h, uh, G, IG, LB) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uh_tot !< Total mass flux through zonal faces - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_htot !< Adcroft reciprocal of the total mass per unit !! cell area [H-1 ~> m2 kg-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: h !< Mass per unit cell area by category [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(out) :: uh !< Category mass flux through zonal faces = u*h*dy. - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. ! Local variables @@ -814,14 +814,14 @@ subroutine merid_proportionate_fluxes(vh_tot, I_htot, h, vh, G, IG, LB) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vh_tot !< Total mass flux through meridional faces - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_htot !< Adcroft reciprocal of the total mass per unit !! cell area [H-1 ~> m2 kg-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: h !< Mass per unit cell area by category [H ~> kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(out) :: vh !< Category mass flux through meridional faces = v*h*dx - !! [H m2 s-1 ~> kg s-1]. + !! [H L2 T-1 ~> kg s-1]. type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. ! Local variables diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index baccc849..c28765c6 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -175,9 +175,9 @@ module SIS_dyn_trans !! and pond water summed across thickness categories in a cell, after each !! transportation substep, with a 0 starting 3rd index [H ~> kg m-2]. real, allocatable, dimension(:,:,:) :: uh_step !< The total zonal mass fluxes during each - !! transportation substep [H m2 s-1 ~> kg s-1]. + !! transportation substep [H L2 T-1 ~> kg s-1]. real, allocatable, dimension(:,:,:) :: vh_step !< The total meridional mass fluxes during each - !! transportation substep [H m2 s-1 ~> kg s-1]. + !! transportation substep [H L2 T-1 ~> kg s-1]. end type dyn_state_2d @@ -580,7 +580,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U call enable_SIS_averaging(dt_slow_dyn, Time_cycle_start + real_to_time(nds*dt_slow_dyn), CS%diag) call ice_cat_transport(CS%CAS, IST%TrReg, dt_slow_dyn, CS%adv_substeps, G, US, IG, CS%SIS_transport_CSp, & - uc=US%L_T_to_m_s*IST%u_ice_C, vc=US%L_T_to_m_s*IST%v_ice_C) + uc=IST%u_ice_C, vc=IST%v_ice_C) if (DS2d%nts==0) then if (CS%do_ridging) then @@ -703,7 +703,7 @@ subroutine complete_IST_transport(DS2d, CAS, IST, dt_adv_cycle, G, US, IG, CS) type(cell_average_state_type), intent(inout) :: CAS !< A structure with ocean-cell averaged masses. real, intent(in) :: dt_adv_cycle !< The time since the last IST transport [s]. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type - type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module @@ -1084,14 +1084,6 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) endif - if (US%L_to_m**2*US%s_to_T /= 1.0 ) then - do j=jsc,jec ; do I=isc-1,iec - DS2d%uh_step(I,j,n) = US%L_to_m**2*US%s_to_T*DS2d%uh_step(I,j,n) - enddo ; enddo - do J=jsc-1,jec ; do i=isc,iec - DS2d%vh_step(i,J,n) = US%L_to_m**2*US%s_to_T*DS2d%vh_step(i,J,n) - enddo ; enddo - endif enddo DS2d%nts = DS2d%nts + CS%adv_substeps call mpp_clock_end(iceClock4) diff --git a/src/SIS_transport.F90 b/src/SIS_transport.F90 index 138d29a0..0b45797d 100644 --- a/src/SIS_transport.F90 +++ b/src/SIS_transport.F90 @@ -118,15 +118,15 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, !! to use within this time step. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module - real, dimension(SZIB_(G),SZJ_(G)), optional, intent(in) :: uc !< The zonal ice velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vc !< The meridional ice velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G)), optional, intent(in) :: uc !< The zonal ice velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vc !< The meridional ice velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),0:max(nsteps,1)), optional, intent(in) :: & mca_tot !< The total mass per unit total area of snow and ice summed across thickness !! categories in a cell, after each substep [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),max(nsteps,1)), optional, intent(in) :: & - uh_tot !< Total zonal fluxes during each substep [H m2 s-1 ~> kg s-1]. + uh_tot !< Total zonal fluxes during each substep [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),max(nsteps,1)), optional, intent(in) :: & - vh_tot !< Total meridional fluxes during each substep [H m2 s-1 ~> kg s-1]. + vh_tot !< Total meridional fluxes during each substep [H L2 T-1 ~> kg s-1]. ! Local variables real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)) :: & @@ -142,7 +142,7 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, mca0_snow, & ! The initial mass of snow per unit ocean area in a cell [H ~> kg m-2]. mca0_pond ! The initial mass of melt pond water per unit ocean area ! in a cell [H ~> kg m-2]. - real :: dt_adv + real :: dt_adv ! An advective timestep [s] logical :: merged_cont character(len=200) :: mesg integer :: i, j, k, n, isc, iec, jsc, jec, isd, ied, jsd, jed, nCat @@ -181,31 +181,30 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, if (merged_cont) then call proportionate_continuity(mca_tot(:,:,n-1), uh_tot(:,:,n), vh_tot(:,:,n), & - dt_adv, G, US, IG, CS%continuity_CSp, & + US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp, & h1=CAS%m_ice, uh1=uh_ice, vh1=vh_ice, & h2=CAS%m_snow, uh2=uh_snow, vh2=vh_snow, & h3=CAS%m_pond, uh3=uh_pond, vh3=vh_pond) else - call continuity(US%m_s_to_L_T*uc, US%m_s_to_L_T*vc, mca0_ice, CAS%m_ice, uh_ice, vh_ice, & + call continuity(uc, vc, mca0_ice, CAS%m_ice, uh_ice, vh_ice, & US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) - call continuity(US%m_s_to_L_T*uc, US%m_s_to_L_T*vc, mca0_snow, CAS%m_snow, uh_snow, vh_snow, & + call continuity(uc, vc, mca0_snow, CAS%m_snow, uh_snow, vh_snow, & US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) - call continuity(US%m_s_to_L_T*uc, US%m_s_to_L_T*vc, mca0_pond, CAS%m_pond, uh_pond, vh_pond, & + call continuity(uc, vc, mca0_pond, CAS%m_pond, uh_pond, vh_pond, & US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + endif - if (US%L_to_m**2*US%s_to_T /= 1.0 ) then - do k=1,nCat ; do j=jsc,jec ; do I=isc-1,iec - uh_ice(I,j,k) = US%L_to_m**2*US%s_to_T*uh_ice(I,j,k) - uh_snow(I,j,k) = US%L_to_m**2*US%s_to_T*uh_snow(I,j,k) - uh_pond(I,j,k) = US%L_to_m**2*US%s_to_T*uh_pond(I,j,k) - enddo ; enddo ; enddo - do k=1,nCat ; do J=jsc-1,jec ; do i=isc,iec - vh_ice(i,J,k) = US%L_to_m**2*US%s_to_T*vh_ice(i,J,k) - vh_snow(i,J,k) = US%L_to_m**2*US%s_to_T*vh_snow(i,J,k) - vh_pond(i,J,k) = US%L_to_m**2*US%s_to_T*vh_pond(i,J,k) - enddo ; enddo ; enddo - endif - + if (US%L_to_m**2*US%s_to_T /= 1.0 ) then + do k=1,nCat ; do j=jsc,jec ; do I=isc-1,iec + uh_ice(I,j,k) = US%L_to_m**2*US%s_to_T*uh_ice(I,j,k) + uh_snow(I,j,k) = US%L_to_m**2*US%s_to_T*uh_snow(I,j,k) + uh_pond(I,j,k) = US%L_to_m**2*US%s_to_T*uh_pond(I,j,k) + enddo ; enddo ; enddo + do k=1,nCat ; do J=jsc-1,jec ; do i=isc,iec + vh_ice(i,J,k) = US%L_to_m**2*US%s_to_T*vh_ice(i,J,k) + vh_snow(i,J,k) = US%L_to_m**2*US%s_to_T*vh_snow(i,J,k) + vh_pond(i,J,k) = US%L_to_m**2*US%s_to_T*vh_pond(i,J,k) + enddo ; enddo ; enddo endif call advect_scalar(CAS%mH_ice, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, CS%SIS_thick_adv_CSp) From a79d8845c909cd989d982823b54aade794592c74 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 31 Oct 2019 13:33:10 -0400 Subject: [PATCH 17/24] +Rescaled OSS%u_ocn_C Changed the units of OSS%u_ocn_C to [L T-1]. Also added a unit_scale_type argument to update_icebergs. All answers are bitwise identical, but the dimensions of two elements in a public type have changed and a non-optional argument has been added to a routine. --- src/SIS_ctrl_types.F90 | 8 ++++---- src/SIS_dyn_trans.F90 | 28 ++++++++++++---------------- src/SIS_types.F90 | 8 ++++---- src/ice_model.F90 | 21 +++++++++++---------- 4 files changed, 31 insertions(+), 34 deletions(-) diff --git a/src/SIS_ctrl_types.F90 b/src/SIS_ctrl_types.F90 index a7772b1c..a35e1e68 100644 --- a/src/SIS_ctrl_types.F90 +++ b/src/SIS_ctrl_types.F90 @@ -324,11 +324,11 @@ subroutine ice_diagnostics_init(IOF, OSS, FIA, G, US, IG, diag, Time, Cgrid) if (Cgrid_dyn) then OSS%id_uo = register_SIS_diag_field('ice_model', 'UO', diag%axesCu1, Time, & - 'surface current - x component', 'm/s', missing_value=missing, & - interp_method='none') + 'surface current - x component', 'm/s', conversion=US%L_T_to_m_s, & + missing_value=missing, interp_method='none') OSS%id_vo = register_SIS_diag_field('ice_model', 'VO', diag%axesCv1, Time, & - 'surface current - y component', 'm/s', missing_value=missing, & - interp_method='none') + 'surface current - y component', 'm/s', conversion=US%L_T_to_m_s, & + missing_value=missing, interp_method='none') else OSS%id_uo = register_SIS_diag_field('ice_model', 'UO', diag%axesB1, Time, & 'surface current - x component', 'm/s', missing_value=missing, & diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index c28765c6..3856e97d 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -190,7 +190,7 @@ module SIS_dyn_trans !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> update_icebergs calls icebergs_run and offers diagnostics of some of the !! iceberg fields that might drive the sea ice or ocean -subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, IG, CS) +subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, US, IG, CS) type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. @@ -201,6 +201,7 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, IG, CS) real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(icebergs), pointer :: icebergs_CS !< A control structure for the iceberg model. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module @@ -242,13 +243,13 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, IG, CS) if (IST%Cgrid_dyn) then call icebergs_run( icebergs_CS, CS%Time, & - FIA%calving(isc:iec,jsc:jec), OSS%u_ocn_C(isc-2:iec+1,jsc-1:jec+1), & - OSS%v_ocn_C(isc-1:iec+1,jsc-2:jec+1), G%US%L_T_to_m_s*IST%u_ice_C(isc-2:iec+1,jsc-1:jec+1), & - G%US%L_T_to_m_s*IST%v_ice_C(isc-1:iec+1,jsc-2:jec+1), windstr_x, windstr_y, & + FIA%calving(isc:iec,jsc:jec), US%L_T_to_m_s*OSS%u_ocn_C(isc-2:iec+1,jsc-1:jec+1), & + US%L_T_to_m_s*OSS%v_ocn_C(isc-1:iec+1,jsc-2:jec+1), US%L_T_to_m_s*IST%u_ice_C(isc-2:iec+1,jsc-1:jec+1), & + US%L_T_to_m_s*IST%v_ice_C(isc-1:iec+1,jsc-2:jec+1), windstr_x, windstr_y, & OSS%sea_lev(isc-1:iec+1,jsc-1:jec+1), OSS%SST_C(isc:iec,jsc:jec), & FIA%calving_hflx(isc:iec,jsc:jec), FIA%ice_cover(isc-1:iec+1,jsc-1:jec+1), & hi_avg(isc-1:iec+1,jsc-1:jec+1), stagger=CGRID_NE, & - stress_stagger=stress_stagger,sss=OSS%s_surf(isc:iec,jsc:jec), & + stress_stagger=stress_stagger, sss=OSS%s_surf(isc:iec,jsc:jec), & mass_berg=IOF%mass_berg, ustar_berg=IOF%ustar_berg, & area_berg=IOF%area_berg ) else @@ -437,7 +438,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U call hchksum(mi_sum, "mi_sum before SIS_C_dynamics", G%HI) call hchksum(OSS%sea_lev, "sea_lev before SIS_C_dynamics", G%HI, haloshift=1) call hchksum(ice_cover, "ice_cover before SIS_C_dynamics", G%HI, haloshift=1) - call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1) + call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1, scale=US%L_T_to_m_s) call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, & halos=1, scale=US%L_T_to_m_s*US%s_to_T) ! call hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) @@ -448,13 +449,11 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if (CS%do_ridging) rdg_rate(:,:) = 0.0 if (CS%Warsaw_sum_order) then call SIS_C_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & - US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & - WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & + OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) else call SIS_C_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & - US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & - WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & + OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) endif call mpp_clock_end(iceClocka) @@ -952,7 +951,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, call hchksum(DS2d%mi_sum, "mi_sum before SIS_C_dynamics", G%HI) call hchksum(OSS%sea_lev, "sea_lev before SIS_C_dynamics", G%HI, haloshift=1) call hchksum(DS2d%ice_cover, "ice_cover before SIS_C_dynamics", G%HI, haloshift=1) - call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1) + call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1, scale=US%L_T_to_m_s) call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, & halos=1, scale=US%L_T_to_m_s*US%s_to_T) ! call hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) @@ -962,8 +961,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, !### Ridging needs to be added with C-grid dynamics. if (CS%do_ridging) rdg_rate(:,:) = 0.0 call SIS_C_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_C, DS2d%v_ice_C, & - US%m_s_to_L_T*OSS%u_ocn_C, US%m_s_to_L_T*OSS%v_ocn_C, & - WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & + OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) call mpp_clock_end(iceClocka) @@ -1188,7 +1186,7 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer call hchksum(mi_sum, "mi_sum before SIS_C_dynamics", G%HI) call hchksum(OSS%sea_lev, "sea_lev before SIS_C_dynamics", G%HI, haloshift=1) call hchksum(IST%part_size(:,:,1), "ice_cover before SIS_C_dynamics", G%HI, haloshift=1) - call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1) + call uvchksum("[uv]_ocn before SIS_C_dynamics", OSS%u_ocn_C, OSS%v_ocn_C, G, halos=1, scale=US%L_T_to_m_s) call uvchksum("WindStr_[xy] before SIS_C_dynamics", WindStr_x_Cu, WindStr_y_Cv, G, & halos=1, scale=US%L_T_to_m_s*US%s_to_T) ! call hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) @@ -1197,8 +1195,6 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer call mpp_clock_begin(iceClocka) call slab_ice_dynamics(IST%u_ice_C, IST%v_ice_C, OSS%u_ocn_C, OSS%v_ocn_C, & WindStr_x_Cu, WindStr_y_Cv, str_x_ice_ocn_Cu, str_y_ice_ocn_Cv) - IST%u_ice_C(:,:) = US%m_s_to_L_T*IST%u_ice_C(:,:) - IST%v_ice_C(:,:) = US%m_s_to_L_T*IST%v_ice_C(:,:) call mpp_clock_end(iceClocka) if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) diff --git a/src/SIS_types.F90 b/src/SIS_types.F90 index 477ae431..73874435 100644 --- a/src/SIS_types.F90 +++ b/src/SIS_types.F90 @@ -114,8 +114,8 @@ module SIS_types T_fr_ocn, & !< The freezing point temperature at the ocean's surface salinity [degC]. u_ocn_B, & !< The ocean's zonal velocity on B-grid points [m s-1]. v_ocn_B, & !< The ocean's meridional velocity on B-grid points [m s-1]. - u_ocn_C, & !< The ocean's zonal velocity on C-grid points [m s-1]. - v_ocn_C !< The ocean's meridional velocity on C-grid points [m s-1]. + u_ocn_C, & !< The ocean's zonal velocity on C-grid points [L T-1 ~> m s-1]. + v_ocn_C !< The ocean's meridional velocity on C-grid points [L T-1 ~> m s-1]. real, allocatable, dimension(:,:) :: bheat !< The upward diffusive heat flux from the ocean !! to the ice at the base of the ice [W m-2]. real, allocatable, dimension(:,:) :: frazil !< A downward heat flux from the ice into the ocean @@ -1197,8 +1197,8 @@ subroutine translate_OSS_to_sOSS(OSS, IST, sOSS, G, US) sOSS%bheat(i,j) = OSS%bheat(i,j) ! Interpolate the ocean and ice velocities onto tracer cells. if (OSS%Cgrid_dyn) then - sOSS%u_ocn_A(i,j) = 0.5*(OSS%u_ocn_C(I,j) + OSS%u_ocn_C(I-1,j)) - sOSS%v_ocn_A(i,j) = 0.5*(OSS%v_ocn_C(i,J) + OSS%v_ocn_C(i,J-1)) + sOSS%u_ocn_A(i,j) = US%L_T_to_m_s*0.5*(OSS%u_ocn_C(I,j) + OSS%u_ocn_C(I-1,j)) + sOSS%v_ocn_A(i,j) = US%L_T_to_m_s*0.5*(OSS%v_ocn_C(i,J) + OSS%v_ocn_C(i,J-1)) else sOSS%u_ocn_A(i,j) = 0.25*((OSS%u_ocn_B(I,J) + OSS%u_ocn_B(I-1,J-1)) + & (OSS%u_ocn_B(I,J-1) + OSS%u_ocn_B(I-1,J)) ) diff --git a/src/ice_model.F90 b/src/ice_model.F90 index f74e2b76..d6d7b4fa 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -229,7 +229,7 @@ subroutine update_ice_slow_thermo(Ice) call mpp_clock_end(ice_clock_slow) ; call mpp_clock_end(iceClock) call update_icebergs(sIST, Ice%sCS%OSS, Ice%sCS%IOF, FIA, Ice%icebergs, & - dt_slow, sG, sIG, Ice%sCS%dyn_trans_CSp) + dt_slow, sG, US, sIG, Ice%sCS%dyn_trans_CSp) call mpp_clock_begin(iceClock) ; call mpp_clock_begin(ice_clock_slow) if (Ice%sCS%debug) then @@ -808,7 +808,7 @@ subroutine unpack_ocean_ice_boundary(Ocean_boundary, Ice) if (.not.associated(Ice%sCS)) call SIS_error(FATAL, & "The pointer to Ice%sCS must be associated in unpack_ocean_ice_boundary.") - call unpack_ocn_ice_bdry(Ocean_boundary, Ice%sCS%OSS, Ice%sCS%IST%ITV, Ice%sCS%G, & + call unpack_ocn_ice_bdry(Ocean_boundary, Ice%sCS%OSS, Ice%sCS%IST%ITV, Ice%sCS%G, Ice%sCS%US, & Ice%sCS%specified_ice, Ice%ocean_fields) call translate_OSS_to_sOSS(Ice%sCS%OSS, Ice%sCS%IST, Ice%sCS%sOSS, Ice%sCS%G, Ice%sCS%US) @@ -819,13 +819,14 @@ end subroutine unpack_ocean_ice_boundary !> This subroutine converts the information in a publicly visible !! ocean_ice_boundary_type into an internally visible ocean_sfc_state_type !! variable. -subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, specified_ice, ocean_fields) +subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, US, specified_ice, ocean_fields) type(ocean_ice_boundary_type), intent(in) :: OIB !< A type containing ocean surface fields that !! aare used to drive the sea ice type(ocean_sfc_state_type), intent(inout) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. type(ice_thermo_type), intent(in) :: ITV !< The ice themodynamics parameter structure. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors logical, intent(in) :: specified_ice !< If true, use specified ice properties. type(coupler_3d_bc_type), intent(inout) :: ocean_fields !< A structure of ocean fields, often !! related to passive tracers. @@ -873,10 +874,10 @@ subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, specified_ice, ocean_fields) if (Cgrid_ocn) then do j=jsc,jec ; do I=isc-1,iec - OSS%u_ocn_C(I,j) = 0.5*(u_nonsym(i,j) + u_nonsym(i+1,j)) + OSS%u_ocn_C(I,j) = US%m_s_to_L_T*0.5*(u_nonsym(i,j) + u_nonsym(i+1,j)) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - OSS%v_ocn_C(i,J) = 0.5*(v_nonsym(i,j) + v_nonsym(i,j+1)) + OSS%v_ocn_C(i,J) = US%m_s_to_L_T*0.5*(v_nonsym(i,j) + v_nonsym(i,j+1)) enddo ; enddo else do J=jsc-1,jec ; do I=isc-1,iec @@ -896,10 +897,10 @@ subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, specified_ice, ocean_fields) call pass_vector(u_nonsym, v_nonsym, G%Domain_aux, stagger=BGRID_NE) do j=jsc,jec ; do I=isc-1,iec - OSS%u_ocn_C(I,j) = 0.5*(u_nonsym(I,J) + u_nonsym(I,J-1)) + OSS%u_ocn_C(I,j) = US%m_s_to_L_T*0.5*(u_nonsym(I,J) + u_nonsym(I,J-1)) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - OSS%v_ocn_C(i,J) = 0.5*(v_nonsym(I,J) + v_nonsym(I-1,J)) + OSS%v_ocn_C(i,J) = US%m_s_to_L_T*0.5*(v_nonsym(I,J) + v_nonsym(I-1,J)) enddo ; enddo else do J=jsc,jec ; do I=isc,iec ; i2 = i+i_off ; j2 = j+j_off @@ -913,10 +914,10 @@ subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, specified_ice, ocean_fields) elseif (OIB%stagger == CGRID_NE) then if (Cgrid_ocn) then do j=jsc,jec ; do I=isc,iec ; i2 = i+i_off ; j2 = j+j_off - OSS%u_ocn_C(I,j) = OIB%u(i2,j2) + OSS%u_ocn_C(I,j) = US%m_s_to_L_T*OIB%u(i2,j2) enddo ; enddo do J=jsc,jec ; do i=isc,iec ; i2 = i+i_off ; j2 = j+j_off - OSS%v_ocn_C(i,J) = OIB%v(i2,j2) + OSS%v_ocn_C(i,J) = US%m_s_to_L_T*OIB%v(i2,j2) enddo ; enddo if (G%symmetric) & call fill_symmetric_edges(OSS%u_ocn_C, OSS%v_ocn_C, G%Domain, stagger=CGRID_NE) @@ -1122,7 +1123,7 @@ subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) call chksum(G%mask2dT(isc:iec,jsc:jec), "Intermed G%mask2dT") ! if (allocated(OSS%u_ocn_C) .and. allocated(OSS%v_ocn_C)) & ! call uvchksum(OSS%u_ocn_C, "OSS%u_ocn_C", & -! OSS%v_ocn_C, "OSS%v_ocn_C", G%HI, haloshift=1) +! OSS%v_ocn_C, "OSS%v_ocn_C", G%HI, haloshift=1, scale=US%L_T_to_m_s) ! if (allocated(OSS%u_ocn_B)) & ! call Bchksum(OSS%u_ocn_B, "OSS%u_ocn_B", G%HI, haloshift=1) ! if (allocated(OSS%v_ocn_B)) & From ad86a462295685539a8cd4f938ed098a6a1dba88 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 1 Nov 2019 18:56:42 -0400 Subject: [PATCH 18/24] +Rescaled volume transports for tracer advection Dimensionally rescaled the timesteps and volume transports used in the SIS2 tracer advection cod, for expanded dimensional consistency testing and code simplification. Also rescaled some tracer transport diagnostics. All answers are bitwise identical, but there is a new unit_scale_type argument in one initialization routine. --- src/SIS_dyn_trans.F90 | 4 +- src/SIS_tracer_advect.F90 | 234 ++++++++++++++++++------------------ src/SIS_tracer_registry.F90 | 36 +++--- src/SIS_transport.F90 | 90 ++++++-------- 4 files changed, 177 insertions(+), 187 deletions(-) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 3856e97d..1f24e452 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -2237,10 +2237,10 @@ subroutine SIS_dyn_trans_init(Time, G, US, IG, param_file, diag, CS, output_dir, call SIS_B_dyn_init(CS%Time, G, param_file, CS%diag, CS%SIS_B_dyn_CSp) endif if (CS%merged_cont) then - call SIS_transport_init(CS%Time, G, param_file, CS%diag, CS%SIS_transport_CSp, & + call SIS_transport_init(CS%Time, G, US, param_file, CS%diag, CS%SIS_transport_CSp, & continuity_CSp=CS%continuity_CSp, cover_trans_CSp=CS%cover_trans_CSp) else - call SIS_transport_init(CS%Time, G, param_file, CS%diag, CS%SIS_transport_CSp, & + call SIS_transport_init(CS%Time, G, US, param_file, CS%diag, CS%SIS_transport_CSp, & continuity_CSp=CS%continuity_CSp) endif diff --git a/src/SIS_tracer_advect.F90 b/src/SIS_tracer_advect.F90 index 1a7afa66..7e34d9ab 100644 --- a/src/SIS_tracer_advect.F90 +++ b/src/SIS_tracer_advect.F90 @@ -24,7 +24,7 @@ module SIS_tracer_advect !> This control structure hold parameters that regulate tracer advection type, public :: SIS_tracer_advect_CS ; private - real :: dt !< The baroclinic dynamics time step [s]. + real :: dt !< The baroclinic dynamics time step [T ~> s]. type(SIS_diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -56,11 +56,11 @@ subroutine advect_SIS_tracers(h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS, TrRe !! coverage after advection [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: uhtr !< Accumulated volume or mass fluxes through - !! zonal faces [H m2 s-1 ~> kg s-1]. + !! zonal faces [H :2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces [H m2 s-1 ~> kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! meridional faces [H L2 T-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_tracer_advect_init. @@ -88,7 +88,7 @@ subroutine advect_SIS_tracers(h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS, TrRe endif else if (CS%use_upwind2d) then - call advect_upwind_2d(TrReg%Tr_ice, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) + call advect_upwind_2d(TrReg%Tr_ice, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) else call advect_tracer(TrReg%Tr_ice, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) endif @@ -112,11 +112,11 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) !! coverage after advection [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: uhtr !< Accumulated volume or mass fluxes through - !! zonal faces [H m2 s-1 ~> kg s-1]. + !! zonal faces [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces [H m2 s-1 ~> kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! meridional faces [H L2 T-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. integer, intent(in) :: ntr !< The number of tracers to advect type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous @@ -128,17 +128,17 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) ! This subroutine time steps the tracer concentrations using a monotonic, conservative, weakly diffusive scheme. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)) :: & - hprev ! The cell volume at the end of the previous tracer change [m3]. + hprev ! The cell volume at the end of the previous tracer change [H L2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)) :: & - uhr ! The remaining zonal thickness flux [m3]. + uhr ! The remaining zonal thickness flux [H L2 ~> kg]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)) :: & - vhr ! The remaining meridional thickness fluxes [m3]. + vhr ! The remaining meridional thickness fluxes [H L2 ~> kg]. real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that ! can be simply discarded [H m2 ~> kg]. - real :: landvolfill ! An arbitrary? nonzero cell volume, m3. - real :: Idt ! 1/dt [s-1]. + real :: landvolfill ! An arbitrary? nonzero cell volume [H L2 ~> kg]. + real :: Idt ! 1/dt [T-1 ~> s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> kg m-2]. logical :: domore_u(SZJ_(G),SZCAT_(IG)) ! domore__ indicate whether there is more @@ -156,7 +156,7 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ncat = IG%CatIce isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - landvolfill = 1.0e-20 ! This is arbitrary, but must be positive. + landvolfill = 1.0e-20*US%m_to_L**2 ! This is arbitrary, but must be positive. stensil = 2 ! The scheme's stensil; 2 for PLM. if (.not. associated(CS)) call SIS_error(FATAL, "SIS_tracer_advect: "// & @@ -195,10 +195,10 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) ! bit of extra mass to avoid nonsensical tracer concentrations. This will ! lead rarely to a very slight non-conservation of tracers, but not mass. do j=js,je; do i=is,ie - hprev(i,j,k) = US%L_to_m**2*G%areaT(i,j) * (h_prev(i,j,k) + & + hprev(i,j,k) = G%areaT(i,j) * (h_prev(i,j,k) + & max(0.0, 1.0e-13*h_prev(i,j,k) - h_end(i,j,k))) if (h_end(i,j,k) - h_prev(i,j,k) + ((uhr(I,j,k) - uhr(I-1,j,k)) + & - (vhr(i,J,k) - vhr(i,J-1,k))) * US%m_to_L**2*G%IareaT(i,j) > & + (vhr(i,J,k) - vhr(i,J-1,k))) * G%IareaT(i,j) > & 1e-10*(h_end(i,j,k) + h_prev(i,j,k))) then !$OMP critical call SIS_error(WARNING, "Apparently inconsistent h_prev, h_end, uhr and vhr in advect_tracer.") @@ -209,12 +209,12 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG, CS) !$OMP end do nowait !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect(I,j) = h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) enddo ; enddo !$OMP end do nowait !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect(i,J) = h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) enddo ; enddo !$OMP end do nowait !$OMP do @@ -365,27 +365,27 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS) ! !! coverage after advection [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: uhtr !< Accumulated volume or mass fluxes through - !! zonal faces [H m2 s-1 ~> kg s-1]. + !! zonal faces [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces [H m2 s-1 ~> kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! meridional faces [H L2 T-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_tracer_advect_init. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)) :: & - hprev ! The cell volume at the end of the previous tracer change [m3]. + hprev ! The cell volume at the end of the previous tracer change [H L2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)) :: & - uhr ! The remaining zonal thickness flux [m3]. + uhr ! The remaining zonal thickness flux [H L2 ~> kg]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)) :: & - vhr ! The remaining meridional thickness fluxes [m3]. + vhr ! The remaining meridional thickness fluxes [H L2 ~> kg]. real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that ! can be simply discarded [H m2 ~> kg]. - real :: landvolfill ! An arbitrary? nonzero cell volume, m3. - real :: Idt ! 1/dt [s-1]. + real :: landvolfill ! An arbitrary? nonzero cell mass [H L2 ~> kg]. + real :: Idt ! 1/dt [T-1 ~> s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> kg m-2]. logical :: domore_u(SZJ_(G),SZCAT_(IG)) ! domore__ indicate whether there is more @@ -397,7 +397,7 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS) ! real, dimension(SZIB_(G),SZJ_(G)) :: flux_U2d_x ! x-direction tracer fluxes [Conc kg] real, dimension(SZI_(G),SZJB_(G)) :: flux_U2d_y ! y-direction tracer fluxes [Conc kg] real :: tr_up ! Upwind tracer concentrations [Conc]. - real :: vol_end, Ivol_end ! Cell volume at the end of a step and its inverse. + real :: vol_end, Ivol_end ! Cell mass at the end of a step [H L2 ~> kg] and its inverse [H-1 L-2 ~> kg-1]. integer :: domore_k(SZCAT_(IG)) integer :: stensil ! The stensil of the advection scheme. @@ -408,7 +408,7 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS) ! is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ncat = IG%CatIce isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - landvolfill = 1.0e-20 ! This is arbitrary, but must be positive. + landvolfill = 1.0e-20*US%m_to_L**2 ! This is arbitrary, but must be positive. stensil = 2 ! The scheme's stensil; 2 for PLM. if (.not. associated(CS)) call SIS_error(FATAL, "advect_scalar: "// & @@ -432,9 +432,9 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS) ! enddo ; enddo do j=js,je ; do i=is,ie - vol_end = (US%L_to_m**2*G%areaT(i,j) * h_end(i,j,k)) + vol_end = (G%areaT(i,j) * h_end(i,j,k)) Ivol_end = 0.0 ; if (vol_end > 0.0) Ivol_end = 1.0 / vol_end - scalar(i,j,k) = ( (US%L_to_m**2*G%areaT(i,j)*h_prev(i,j,k))*scalar(i,j,k) - & + scalar(i,j,k) = ( (G%areaT(i,j)*h_prev(i,j,k))*scalar(i,j,k) - & ((flux_U2d_x(I,j) - flux_U2d_x(I-1,j)) + & (flux_U2d_y(i,J) - flux_U2d_y(i,J-1))) ) * Ivol_end enddo ; enddo @@ -476,10 +476,10 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS) ! ! bit of extra mass to avoid nonsensical tracer concentrations. This will ! lead rarely to a very slight non-conservation of tracers, but not mass. do i=is,ie ; do j=js,je - hprev(i,j,k) = US%L_to_m**2*G%areaT(i,j) * (h_prev(i,j,k) + & + hprev(i,j,k) = G%areaT(i,j) * (h_prev(i,j,k) + & max(0.0, 1.0e-13*h_prev(i,j,k) - h_end(i,j,k))) if (h_end(i,j,k) - h_prev(i,j,k) + ((uhr(I,j,k) - uhr(I-1,j,k)) + & - (vhr(i,J,k) - vhr(i,J-1,k))) * US%m_to_L**2*G%IareaT(i,j) > & + (vhr(i,J,k) - vhr(i,J-1,k))) * G%IareaT(i,j) > & 1e-10*(h_end(i,j,k) + h_prev(i,j,k))) then !$OMP critical call SIS_error(WARNING, "Apparently inconsistent h_prev, h_end, uhr and vhr in advect_tracer.") @@ -490,12 +490,12 @@ subroutine advect_scalar(scalar, h_prev, h_end, uhtr, vhtr, dt, G, US, IG, CS) ! !$OMP end do nowait !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect(I,j) = h_neglect*MIN(G%areaT(i,j),G%areaT(i+1,j)) enddo ; enddo !$OMP end do nowait !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = US%L_to_m**2*h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect(i,J) = h_neglect*MIN(G%areaT(i,j),G%areaT(i,j+1)) enddo ; enddo !$OMP end parallel @@ -609,18 +609,18 @@ subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & intent(inout) :: scalar !< Scalar tracer field to be advected, in arbitrary units [Conc] real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: hprev !< Category thickness times fractional coverage - !! before this step of advection [H ~> kg m-2]. + !! before this step of advection [H L2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: uhr !< Remaining volume or mass fluxes through - !! zonal faces [H m2 ~> kg]. + !! zonal faces [H L2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G)), & - intent(inout) :: uh_neglect !< A value of uhr that can be neglected [H m2 ~> kg]. + intent(inout) :: uh_neglect !< A value of uhr that can be neglected [H L2 ~> kg]. ! type(ocean_OBC_type), pointer :: OBC ! < This open boundary condition type specifies ! ! whether, where, and what open boundary ! ! conditions are used. logical, dimension(SZJ_(G),SZCAT_(IG)), & intent(inout) :: domore_u !< True in rows with more advection to be done - real, intent(in) :: Idt !< The inverse of the time increment [s-1] + real, intent(in) :: Idt !< The inverse of the time increment [T-1 ~> s-1] integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on integer, intent(in) :: js !< The starting tracer j-index to work on @@ -643,21 +643,21 @@ subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & ! with monotonicity [Conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the part of that volume ! that might be lost due to advection out the other side of - ! the grid box, both [H m2 ~> kg]. + ! the grid box, both [H L2 ~> kg]. real, dimension(SZIB_(G)) :: & - uhh, & ! The zonal flux that occurs during the current iteration [H m2 ~> kg]. + uhh, & ! The zonal flux that occurs during the current iteration [H L2 ~> kg]. CFL ! A nondimensional work variable [nondim]. real, dimension(SZI_(G)) :: & - hlst, Ihnew, & ! Work variables with units of m3 or kg and m-3 or kg-1. + hlst, Ihnew, & ! Work variables with units of [H L2 ~> kg] and [H-1 L-2 ~> kg-1]. haddE, haddW ! Tiny amounts of thickness that should be added to the ! tracer update with concentrations that match the average ! over the fluxes through the faces to the nominal east - ! and west of the present cell [H m2 ~> kg]. - real :: hnew ! The projected thickness [H m2 ~> kg]. + ! and west of the present cell [H L2 ~> kg]. + real :: hnew ! The projected thickness [H L2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers [H m2 ~> kg]. + ! well defined in the limit of vanishing layers [H L2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or - ! out of a cell [H m2 ~> kg]. + ! out of a cell [H L2 ~> kg]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> kg m-2]. logical :: do_i(SZI_(G)) ! If true, work on given points. @@ -687,7 +687,7 @@ subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & endif ! usePLMslope call kernel_uhh_CFL_x(G, is-1, ie, j, hprev(:,:,k), uhr(:,:,k), uhh, CFL, & - domore_u(j,k), h_neglect) + domore_u(j,k), h_neglect*US%m_to_L**2) if (usePPM) then call kernel_PPMH3_Tr_x(G, is-1, ie, j, & @@ -715,17 +715,17 @@ subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & haddW(i) = 0.0 ; haddE(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then + elseif (hnew < h_neglect*G%areaT(i,j)) then ! Add a bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew + h_add = h_neglect*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(uhh(I)) + abs(uhh(I-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddW(i) = h_add * (abs(uhh(I-1))*I_htot) haddE(i) = h_add * (abs(uhh(I))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -755,18 +755,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & intent(inout) :: Tr !< The tracers being advected real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: hprev !< Category thickness times fractional - !! coverage before advection [H ~> kg m-2]. + !! coverage before advection [H L2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: uhr !< Remaining volume or mass fluxes through - !! zonal faces [H m2 ~> kg]. + !! zonal faces [H L2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G)), & - intent(inout) :: uh_neglect !< A value of uhr that can be neglected [H m2 ~> kg]. + intent(inout) :: uh_neglect !< A value of uhr that can be neglected [H L2 ~> kg]. ! type(ocean_OBC_type), pointer :: OBC ! < This open boundary condition type specifies ! ! whether, where, and what open boundary ! ! conditions are used. logical, dimension(SZJ_(G),SZCAT_(IG)), & intent(inout) :: domore_u !< True in rows with more advection to be done - real, intent(in) :: Idt !< The inverse of the time increment [s-1] + real, intent(in) :: Idt !< The inverse of the time increment [T-1 ~> s-1] integer, intent(in) :: ntr !< The number of tracers to advect integer, intent(in) :: nL_max !< The maximum number of layers in the tracers integer, intent(in) :: is !< The starting tracer i-index to work on @@ -793,23 +793,23 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & ! with monotonicity [Conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the part of that volume ! that might be lost due to advection out the other side of - ! the grid box, both [H m2 ~> kg]. + ! the grid box, both [H L2 ~> kg]. real, dimension(SZIB_(G)) :: & - uhh, & ! The zonal flux that occurs during the current iteration [H m2 ~> kg]. + uhh, & ! The zonal flux that occurs during the current iteration [H L2 ~> kg]. CFL ! A nondimensional work variable [nondim]. real, dimension(SZI_(G)) :: & - hlst, Ihnew, & ! Work variables with units of m3 or kg and m-3 or kg-1. + hlst, Ihnew, & ! Work variables with units of [H L2 ~> kg] and [H-1 L-2 ~> kg-1]. haddE, haddW ! Tiny amounts of thickness that should be added to the ! tracer update with concentrations that match the average ! over the fluxes through the faces to the nominal east - ! and west of the present cell [H m2 ~> kg]. - real :: hnew ! The projected thickness [H m2 ~> kg]. + ! and west of the present cell [H L2 ~> kg]. + real :: hnew ! The projected thickness [H L2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers [H m2 ~> kg]. + ! well defined in the limit of vanishing layers [H L2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or ! out of a cell [H m2 ~> kg]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [m]. + ! in roundoff and can be neglected [H ~> kg m-2]. logical :: do_i(SZI_(G)) ! If true, work on given points. logical :: do_any_i integer :: i, j, l, m @@ -841,7 +841,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & endif ! usePLMslope call kernel_uhh_CFL_x(G, is-1, ie, j, hprev(:,:,k), uhr(:,:,k), uhh, CFL, & - domore_u(j,k), h_neglect) + domore_u(j,k), h_neglect*US%m_to_L**2) if (usePPM) then do m=1,ntr ; do l=1,Tr(m)%nL @@ -871,17 +871,17 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & haddW(i) = 0.0 ; haddE(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then + elseif (hnew < h_neglect*G%areaT(i,j)) then ! Add a bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew + h_add = h_neglect*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(uhh(I)) + abs(uhh(I-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddW(i) = h_add * (abs(uhh(I-1))*I_htot) haddE(i) = h_add * (abs(uhh(I))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -924,19 +924,19 @@ subroutine kernel_uhh_CFL_x(G, is, ie, j, hprev, uhr, uhh, CFL, domore_u, h_negl integer, intent(in) :: j !< The tracer j-index to work on real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: hprev !< Category thickness times fractional coverage - !! before this step of advection [H ~> kg m-2]. + !! before this step of advection [H L2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: uhr !< Remaining volume or mass fluxes through - !! zonal faces [H m2 ~> kg]. + !! zonal faces [H L2 ~> kg]. real, dimension(SZIB_(G)), intent(inout) :: uhh !< The volume or mass flux that can be accomodated - !! with this pass of advection [H m2 ~> kg]. + !! with this pass of advection [H L2 ~> kg]. real, dimension(SZIB_(G)), intent(inout) :: CFL !< The CFL number for this phase of advection logical, intent(inout) :: domore_u !< True in rows with more advection to be done real, intent(in) :: h_neglect !< A thickness that is so small it is usually lost - !! in roundoff and can be neglected [H ~> kg m-2]. + !! in roundoff and can be neglected [H L2 ~> kg]. ! Local integer :: i - real :: hup, hlos + real :: hup, hlos ! Volumes in [H L2 ~> kg] do I=is,ie if (uhr(I,j) == 0.0) then @@ -1003,7 +1003,7 @@ subroutine kernel_PPMH3_Tr_x(G, is, ie, j, scalar, uMask, uhh, CFL, Tr_x) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: scalar !< The tracer concentration to advect real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uMask !< A multiplicative mask at u-points real, dimension(SZIB_(G)), intent(in) :: uhh !< The volume or mass flux in this - !! pass of advection [H m2 ~> kg]. + !! pass of advection [H L2 ~> kg]. real, dimension(SZIB_(G)), intent(in) :: CFL !< The CFL number for this phase of advection real, dimension(SZIB_(G)), intent(inout) :: Tr_x !< The average tracer concentration in the flux [Conc] ! Local @@ -1084,18 +1084,18 @@ subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & intent(inout) :: scalar !< The tracer concentration to advect real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: hprev !< Category thickness times fractional coverage - !! before this step of advection [H ~> kg m-2]. + !! before this step of advection [H L2 ~> kg]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(inout) :: vhr !< Remaining volume or mass fluxes through - !! meridional faces [H m2 ~> kg]. + !! meridional faces [H L2 ~> kg]. real, dimension(SZI_(G),SZJB_(G)), & - intent(inout) :: vh_neglect !< A value of vhr that can be neglected [H m2 ~> kg]. + intent(inout) :: vh_neglect !< A value of vhr that can be neglected [H L2 ~> kg]. ! type(ocean_OBC_type), pointer :: OBC ! < This open boundary condition type specifies ! ! whether, where, and what open boundary ! ! conditions are used. logical, dimension(SZJB_(G),SZCAT_(IG)), & intent(inout) :: domore_v !< True in rows with more advection to be done - real, intent(in) :: Idt !< The inverse of the time increment [s-1] + real, intent(in) :: Idt !< The inverse of the time increment [T-1 ~> s-1] integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on integer, intent(in) :: js !< The starting tracer j-index to work on @@ -1116,26 +1116,26 @@ subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & mass_mask, & ! A multiplicative mask at velocity points that is 1 if ! both neighboring cells have any mass, and 0 otherwise. vhh ! The meridional flux that occurs during the current - ! iteration [H m2 ~> kg]. + ! iteration [H L2 ~> kg]. real :: maxslope ! The maximum concentration slope per grid point consistent ! with monotonicity [Conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the part of that volume ! that might be lost due to advection out the other side of - ! the grid box, both [H m2 ~> kg]. + ! the grid box, both [H L2 ~> kg]. real, dimension(SZI_(G)) :: & hlst, Ihnew, & ! Work variables with units of m3 or kg and m-3 or kg-1. haddN, haddS, & ! Tiny amounts of thickness that should be added to the ! tracer update with concentrations that match the average ! over the fluxes through the faces to the nominal north - ! and south of the present cell [H m2 ~> kg]. + ! and south of the present cell [H L2 ~> kg]. CFL ! A nondimensional work variable [nondim]. - real :: hnew ! The projected thickness [H m2 ~> kg]. + real :: hnew ! The projected thickness [H L2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers [H m2 ~> kg]. + ! well defined in the limit of vanishing layers [H L2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or - ! out of a cell [H m2 ~> kg]. + ! out of a cell [H L2 ~> kg]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [m]. + ! in roundoff and can be neglected [H ~> kg m-2]. logical :: do_j_tr(SZJ_(G)) ! If true, calculate the tracer profiles. logical :: do_i(SZI_(G)) ! If true, work on given points. logical :: do_any_i @@ -1166,7 +1166,7 @@ subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & do J=js-1,je ; if (domore_v(J,k)) then call kernel_vhh_CFL_y(G, is, ie, J, hprev(:,:,k), vhr(:,:,k), vhh, CFL, & - domore_v(:,k), h_neglect) + domore_v(:,k), h_neglect*US%m_to_L**2) if (usePPM) then call kernel_PPMH3_Tr_y(G, is, ie, J, & scalar(:,:,k), mass_mask, vhh, CFL, Tr_y(:,J)) @@ -1199,17 +1199,17 @@ subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & haddS(i) = 0.0 ; haddN(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then + elseif (hnew < h_neglect*G%areaT(i,j)) then ! Add a tiny bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew + h_add = h_neglect*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(vhh(i,J)) + abs(vhh(i,J-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddS(i) = h_add * (abs(vhh(i,J-1))*I_htot) haddN(i) = h_add * (abs(vhh(i,J))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -1241,15 +1241,15 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & !! before this step of advection [H ~> kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(inout) :: vhr !< Remaining volume or mass fluxes through - !! meridional faces [H m2 ~> kg]. + !! meridional faces [H L2 ~> kg]. real, dimension(SZI_(G),SZJB_(G)), & - intent(inout) :: vh_neglect !< A value of vhr that can be neglected [H m2 ~> kg]. + intent(inout) :: vh_neglect !< A value of vhr that can be neglected [H L2 ~> kg]. ! type(ocean_OBC_type), pointer :: OBC ! < This open boundary condition type specifies ! ! whether, where, and what open boundary ! ! conditions are used. logical, dimension(SZJB_(G),SZCAT_(IG)), & intent(inout) :: domore_v !< True in rows with more advection to be done - real, intent(in) :: Idt !< The inverse of the time increment [s-1] + real, intent(in) :: Idt !< The inverse of the time increment [T-1 ~> s-1] integer, intent(in) :: ntr !< The number of tracers to advect integer, intent(in) :: nL_max !< The maximum number of layers in the tracers integer, intent(in) :: is !< The starting tracer i-index to work on @@ -1271,24 +1271,24 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & mass_mask, & ! A multiplicative mask at velocity points that is 1 if ! both neighboring cells have any mass, and 0 otherwise. vhh ! The meridional flux that occurs during the current - ! iteration [H m2 ~> kg]. + ! iteration [H L2 ~> kg]. real :: maxslope ! The maximum concentration slope per grid point consistent ! with monotonicity [Conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the part of that volume ! that might be lost due to advection out the other side of - ! the grid box, both [H m2 ~> kg]. + ! the grid box, both [H L2 ~> kg]. real, dimension(SZI_(G)) :: & - hlst, Ihnew, & ! Work variables with units of m3 or kg and m-3 or kg-1. + hlst, Ihnew, & ! Work variables with units of [H L2 ~> kg] and [H-1 L-2 ~> kg-1]. haddN, haddS, & ! Tiny amounts of thickness that should be added to the ! tracer update with concentrations that match the average ! over the fluxes through the faces to the nominal north - ! and south of the present cell [H m2 ~> kg]. + ! and south of the present cell [H L2 ~> kg]. CFL ! A nondimensional work variable [nondim]. - real :: hnew ! The projected thickness [H m2 ~> kg]. + real :: hnew ! The projected thickness [H L2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers [H m2 ~> kg]. + ! well defined in the limit of vanishing layers [H L2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or - ! out of a cell [H m2 ~> kg]. + ! out of a cell [H L2 ~> kg]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> kg m-2]. logical :: do_j_tr(SZJ_(G)) ! If true, calculate the tracer profiles. @@ -1322,7 +1322,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & do J=js-1,je ; if (domore_v(J,k)) then call kernel_vhh_CFL_y(G, is, ie, J, hprev(:,:,k), vhr(:,:,k), vhh, CFL, & - domore_v(:,k), h_neglect) + domore_v(:,k), h_neglect*US%m_to_L**2) if (usePPM) then do m=1,ntr ; do l=1,Tr(m)%nL call kernel_PPMH3_Tr_y(G, is, ie, J, & @@ -1358,17 +1358,17 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & haddS(i) = 0.0 ; haddN(i) = 0.0 if (hnew <= 0.0) then hnew = 0.0 ; do_i(i) = .false. - elseif (hnew < h_neglect*US%L_to_m**2*G%areaT(i,j)) then + elseif (hnew < h_neglect*G%areaT(i,j)) then ! Add a tiny bit of thickness with tracer concentrations that are ! proportional to the mass associated with fluxes and the previous ! mass in the cell. - h_add = h_neglect*US%L_to_m**2*G%areaT(i,j) - hnew + h_add = h_neglect*G%areaT(i,j) - hnew I_htot = 1.0 / (hlst(i) + (abs(vhh(i,J)) + abs(vhh(i,J-1)))) hlst(i) = hlst(i) + h_add*(hlst(i)*I_htot) haddS(i) = h_add * (abs(vhh(i,J-1))*I_htot) haddN(i) = h_add * (abs(vhh(i,J))*I_htot) - Ihnew(i) = 1.0 / (h_neglect*US%L_to_m**2*G%areaT(i,j)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else Ihnew(i) = 1.0 / hnew endif @@ -1425,18 +1425,18 @@ subroutine kernel_vhh_CFL_y(G, is, ie, J, hprev, vhr, vhh, CFL, domore_v, h_negl integer, intent(in) :: J !< The j-index to work on real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: hprev !< Category thickness times fractional coverage - !! before this step of advection [H ~> kg m-2]. + !! before this step of advection [H L2 ~> kg m-2]. real, dimension(SZI_(G),SZJB_(G)), & intent(in) :: vhr !< Remaining volume or mass fluxes through - !! meridional faces [H m2 ~> kg]. + !! meridional faces [H L2 ~> kg]. real, dimension(SZI_(G),SZJB_(G)), & intent(inout) :: vhh !< The volume or mass flux that can be accomodated - !! with this pass of advection [H m2 ~> kg]. + !! with this pass of advection [H L2 ~> kg]. real, dimension(SZI_(G)), intent(inout) :: CFL !< The CFL number for this pass of advection logical, dimension(SZJB_(G)), & intent(inout) :: domore_v !< True in rows with more advection to be done real, intent(in) :: h_neglect !< A thickness that is so small it is usually lost - !! in roundoff and can be neglected [H ~> kg m-2]. + !! in roundoff and can be neglected [H L2 ~> kg m-2]. ! Local integer :: i real :: hup, hlos @@ -1593,19 +1593,19 @@ subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) !! coverage after advection [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: uhtr !< Accumulated volume or mass fluxes through - !! zonal faces [H m2 s-1 ~> kg s-1]. + !! zonal faces [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces [H m2 s-1 ~> kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! meridional faces [H L2 T-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. integer, intent(in) :: ntr !< The number of tracers to advect type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors - real, dimension(SZIB_(G),SZJ_(G)) :: flux_x ! x-direction tracer fluxes [Conc kg] - real, dimension(SZI_(G),SZJB_(G)) :: flux_y ! y-direction tracer fluxes [Conc kg] + real, dimension(SZIB_(G),SZJ_(G)) :: flux_x ! x-direction tracer fluxes [Conc H L2 ~> Conc kg] + real, dimension(SZI_(G),SZJB_(G)) :: flux_y ! y-direction tracer fluxes [Conc H L2 ~> Conc kg] real :: tr_up ! Upwind tracer concentrations [Conc]. - real :: Idt ! The inverse of the time increment [s-1] - real :: vol_end, Ivol_end ! Cell volume at the end of a step and its inverse. + real :: Idt ! The inverse of the time increment [T-1 ~> s-1] + real :: vol_end, Ivol_end ! Cell volume at the end of a step [H L2 ~> kg] and its inverse. integer :: i, j, k, l, m, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -1613,7 +1613,7 @@ subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) ! Reconstruct the old value of h ??? ! if (h_prev(i,j,k) > 0.0) then - ! h_last(i,j,k) = h_end(i,j,k) + dt * US%m_to_L**2*G%IareaT(i,j) * & + ! h_last(i,j,k) = h_end(i,j,k) + dt * G%IareaT(i,j) * & ! ((uh(I,j,k) - uh(I-1,j,k)) + (vh(i,J,k) - vh(i,J-1,k))) ! For now this is just non-directionally split upwind advection. @@ -1631,9 +1631,9 @@ subroutine advect_upwind_2d(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, US, IG) enddo ; enddo do j=js,je ; do i=is,ie - vol_end = (US%L_to_m**2*G%areaT(i,j) * h_end(i,j,k)) + vol_end = (G%areaT(i,j) * h_end(i,j,k)) Ivol_end = 0.0 ; if (vol_end > 0.0) Ivol_end = 1.0 / vol_end - Tr(m)%t(i,j,k,l) = ( (US%L_to_m**2*G%areaT(i,j)*h_prev(i,j,k))*Tr(m)%t(i,j,k,l) - & + Tr(m)%t(i,j,k,l) = ( (G%areaT(i,j)*h_prev(i,j,k))*Tr(m)%t(i,j,k,l) - & ((flux_x(I,j) - flux_x(I-1,j)) + & (flux_y(i,J) - flux_y(i,J-1))) ) * Ivol_end enddo ; enddo @@ -1667,9 +1667,9 @@ subroutine advect_tracers_thicker(vol_start, vol_trans, G, IG, CS, & type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZCAT_(IG)), & - intent(in) :: vol_start !< The category volume before advection [H m2 ~> kg]. + intent(in) :: vol_start !< The category mass before advection [H L2 ~> kg]. real, dimension(SZI_(G),SZCAT_(IG)),& - intent(in) :: vol_trans !< The category volume to transfer [H m2 ~> kg]. + intent(in) :: vol_trans !< The category mass to transfer [H L2 ~> kg]. type(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_tracer_advect_init. type(SIS_tracer_registry_type), pointer :: TrReg !< A pointer to the SIS tracer registry. @@ -1678,9 +1678,9 @@ subroutine advect_tracers_thicker(vol_start, vol_trans, G, IG, CS, & integer, intent(in) :: ie !< The ending tracer i-index to work on integer, intent(in) :: j !< The tracer j-index to work on - real, dimension(SZI_(G),SZCAT_(IG)) :: vol + real, dimension(SZI_(G),SZCAT_(IG)) :: vol ! The category mass at the start of a pass [H L2 ~> kg] type(SIS_tracer_type), dimension(:), pointer :: Tr=>NULL() - real :: Ivol_new + real :: Ivol_new ! The inverse of the new category mass [H-1 L-2 ~> kg-1] integer :: i, k, m, n, ncat if (.not. associated(CS)) call SIS_error(FATAL, "SIS_tracer_advect: "// & diff --git a/src/SIS_tracer_registry.F90 b/src/SIS_tracer_registry.F90 index 1fb345c8..fa126c79 100644 --- a/src/SIS_tracer_registry.F90 +++ b/src/SIS_tracer_registry.F90 @@ -50,20 +50,20 @@ module SIS_tracer_registry real :: massless_val = 0.0 !< A value to use in massless layers. real, dimension(:,:), & pointer :: ad2d_x => NULL() !< The x-direction advective flux summed vertically and across - !! ice category [Conc kg s-1]. + !! ice category [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:), & pointer :: ad2d_y => NULL() !< The y-direction advective flux summed vertically and across - !! ice category [Conc kg s-1]. + !! ice category [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:), & - pointer :: ad3d_x => NULL() !< The vertically summed x-direction advective flux [Conc kg s-1]. + pointer :: ad3d_x => NULL() !< The vertically summed x-direction advective flux [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:), & - pointer :: ad3d_y => NULL() !< The vertically summed y-direction advective flux [Conc kg s-1]. + pointer :: ad3d_y => NULL() !< The vertically summed y-direction advective flux [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:,:), & pointer :: ad4d_x => NULL() !< The x-direction advective flux by ice category and layer in - !! units of CONC m3 s-1. + !! units of [Conc H L2 T-1 ~> CONC kg s-1]. real, dimension(:,:,:,:), & pointer :: ad4d_y => NULL() !< The y-direction advective flux by ice category and layer in - !! units of CONC m3 s-1. + !! units of [Conc H L2 T-1 ~> CONC kg s-1]. ! real, dimension(:,:), & ! pointer :: snow_flux_tr => NULL() !< Concentration of the tracer in snow (for salinity = 0.0) real, dimension(:,:,:), & @@ -120,22 +120,22 @@ subroutine register_SIS_tracer(tr1, G, IG, nLtr, name, param_file, TrReg, snow_t real, optional, intent(in) :: massless_val !< The value to use to fill in massless categories. real, dimension(:,:), & optional, pointer :: ad_2d_x !< An array for the x-direction advective flux summed - !! vertically and across ice category [Conc kg s-1]. + !! vertically and across ice category [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:), & optional, pointer :: ad_2d_y !< An array for the Y-direction advective flux summed - !! vertically and across ice category [Conc kg s-1]. + !! vertically and across ice category [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_x !< An array for the vertically summed x-direction - !! advective flux [Conc kg s-1]. + !! advective flux [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_y !< An array for the vertically summed y-direction - !! advective flux [Conc kg s-1]. + !! advective flux [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_x !< An array for the x-direction advective flux by - !! ice category and layer [Conc kg s-1]. + !! ice category and layer [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_y !< An array for the x-direction advective flux by - !! ice category and layer [Conc kg s-1]. + !! ice category and layer [Conc H L2 T-1 ~> Conc kg s-1]. real, optional, intent(in) :: OBC_inflow !< The value of the tracer for all inflows via !! the open boundary conditions for which OBC_in_u or !! OBC_in_v are not specified, in the same units as tr [Conc]. @@ -544,22 +544,22 @@ subroutine add_SIS_tracer_diagnostics(name, TrReg, ad_2d_x, ad_2d_y, ad_3d_x, & pointer :: TrReg !< A pointer to the SIS tracer registry real, dimension(:,:), & optional, pointer :: ad_2d_x !< An array for the x-direction advective flux summed - !! vertically and across ice category [Conc kg s-1]. + !! vertically and across ice category [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:), & optional, pointer :: ad_2d_y !< An array for the Y-direction advective flux summed - !! vertically and across ice category [Conc kg s-1]. + !! vertically and across ice category [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_x !< An array for the vertically summed x-direction - !! advective flux [Conc kg s-1]. + !! advective flux [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_y !< An array for the vertically summed y-direction - !! advective flux [Conc kg s-1]. + !! advective flux [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_x !< An array for the x-direction advective flux by - !! ice category and layer [Conc kg s-1]. + !! ice category and layer [Conc H L2 T-1 ~> Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_y !< An array for the x-direction advective flux by - !! ice category and layer [Conc kg s-1]. + !! ice category and layer [Conc H L2 T-1 ~> Conc kg s-1]. ! This subroutine adds diagnostic arrays for a tracer that has previously been ! registered by a call to register_SIS_tracer. diff --git a/src/SIS_transport.F90 b/src/SIS_transport.F90 index 0b45797d..2ed3d035 100644 --- a/src/SIS_transport.F90 +++ b/src/SIS_transport.F90 @@ -88,15 +88,15 @@ module SIS_transport !! still are given plausible values of mH_ice. ! The following fields are used for diagnostics. - real :: dt_sum = 0.0 !< The accumulated time since the fields were populated from an ice state type. + real :: dt_sum = 0.0 !< The accumulated time since the fields were populated from an ice state type [T ~> s]. real, allocatable, dimension(:,:) :: mass0 !< The total mass of ice, snow and melt pond water !! when the fields were populated [H ~> kg m-2]. real, allocatable, dimension(:,:) :: uh_sum !< The accumulated zonal mass fluxes of ice, snow !! and melt pond water, summed acrosss categories, - !! since the fields were populated [H m2 ~> kg]. + !! since the fields were populated [H L2 ~> kg]. real, allocatable, dimension(:,:) :: vh_sum !< The accumulated meridional mass fluxes of ice, snow !! and melt pond water, summed acrosss categories, - !! since the fields were populated [H m2 ~> kg]. + !! since the fields were populated [H L2 ~> kg]. type(EFP_type) :: tot_ice !< The globally integrated mass of sea ice [kg]. type(EFP_type) :: tot_snow !< The globally integrated mass of snow [kg]. type(EFP_type) :: enth_ice !< The globally integrated sea ice enthalpy [J]. @@ -130,19 +130,19 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, ! Local variables real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)) :: & - uh_ice, & ! Zonal fluxes of ice [H m2 s-1 ~> kg s-1]. - uh_snow, & ! Zonal fluxes of snow [H m2 s-1 ~> kg s-1]. - uh_pond ! Zonal fluxes of melt pond water [H m2 s-1 ~> kg s-1]. + uh_ice, & ! Zonal fluxes of ice [H L2 T-1 ~> kg s-1]. + uh_snow, & ! Zonal fluxes of snow [H L2 T-1 ~> kg s-1]. + uh_pond ! Zonal fluxes of melt pond water [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)) :: & - vh_ice, & ! Meridional fluxes of ice [H m2 s-1 ~> kg s-1]. - vh_snow, & ! Meridional fluxes of snow [H m2 s-1 ~> kg s-1]. - vh_pond ! Meridional fluxes of melt pond water [H m2 s-1 ~> kg s-1]. + vh_ice, & ! Meridional fluxes of ice [H L2 T-1 ~> kg s-1]. + vh_snow, & ! Meridional fluxes of snow [H L2 T-1 ~> kg s-1]. + vh_pond ! Meridional fluxes of melt pond water [H L2 T-1 ~> kg s-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)) :: & mca0_ice, & ! The initial mass of ice per unit ocean area in a cell [H ~> kg m-2]. mca0_snow, & ! The initial mass of snow per unit ocean area in a cell [H ~> kg m-2]. mca0_pond ! The initial mass of melt pond water per unit ocean area ! in a cell [H ~> kg m-2]. - real :: dt_adv ! An advective timestep [s] + real :: dt_adv ! An advective timestep [T ~> s] logical :: merged_cont character(len=200) :: mesg integer :: i, j, k, n, isc, iec, jsc, jec, isd, ied, jsd, jed, nCat @@ -165,7 +165,7 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, ! Do the transport via the continuity equations and tracer conservation equations ! for CAS%mH_ice and tracers, inverting for the fractional size of each partition. - if (nsteps > 0) dt_adv = dt_slow / real(nsteps) + if (nsteps > 0) dt_adv = US%s_to_T*dt_slow / real(nsteps) do n = 1, nsteps call update_SIS_tracer_halos(TrReg, G, complete=.false.) call pass_var(CAS%m_ice, G%Domain, complete=.false.) @@ -181,37 +181,25 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, if (merged_cont) then call proportionate_continuity(mca_tot(:,:,n-1), uh_tot(:,:,n), vh_tot(:,:,n), & - US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp, & + dt_adv, G, US, IG, CS%continuity_CSp, & h1=CAS%m_ice, uh1=uh_ice, vh1=vh_ice, & h2=CAS%m_snow, uh2=uh_snow, vh2=vh_snow, & h3=CAS%m_pond, uh3=uh_pond, vh3=vh_pond) else call continuity(uc, vc, mca0_ice, CAS%m_ice, uh_ice, vh_ice, & - US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + dt_adv, G, US, IG, CS%continuity_CSp) call continuity(uc, vc, mca0_snow, CAS%m_snow, uh_snow, vh_snow, & - US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + dt_adv, G, US, IG, CS%continuity_CSp) call continuity(uc, vc, mca0_pond, CAS%m_pond, uh_pond, vh_pond, & - US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + dt_adv, G, US, IG, CS%continuity_CSp) endif - if (US%L_to_m**2*US%s_to_T /= 1.0 ) then - do k=1,nCat ; do j=jsc,jec ; do I=isc-1,iec - uh_ice(I,j,k) = US%L_to_m**2*US%s_to_T*uh_ice(I,j,k) - uh_snow(I,j,k) = US%L_to_m**2*US%s_to_T*uh_snow(I,j,k) - uh_pond(I,j,k) = US%L_to_m**2*US%s_to_T*uh_pond(I,j,k) - enddo ; enddo ; enddo - do k=1,nCat ; do J=jsc-1,jec ; do i=isc,iec - vh_ice(i,J,k) = US%L_to_m**2*US%s_to_T*vh_ice(i,J,k) - vh_snow(i,J,k) = US%L_to_m**2*US%s_to_T*vh_snow(i,J,k) - vh_pond(i,J,k) = US%L_to_m**2*US%s_to_T*vh_pond(i,J,k) - enddo ; enddo ; enddo - endif - - call advect_scalar(CAS%mH_ice, mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, CS%SIS_thick_adv_CSp) - call advect_SIS_tracers(mca0_ice, CAS%m_ice, uh_ice, vh_ice, dt_adv, G, US, IG, & - CS%SIS_tr_adv_CSp, TrReg, snow_tr=.false.) - call advect_SIS_tracers(mca0_snow, CAS%m_snow, uh_snow, vh_snow, dt_adv, G, US, IG, & - CS%SIS_tr_adv_CSp, TrReg, snow_tr=.true.) + call advect_scalar(CAS%mH_ice, mca0_ice, CAS%m_ice, uh_ice, vh_ice, & + dt_adv, G, US, IG, CS%SIS_thick_adv_CSp) + call advect_SIS_tracers(mca0_ice, CAS%m_ice, uh_ice, vh_ice, & + dt_adv, G, US, IG, CS%SIS_tr_adv_CSp, TrReg, snow_tr=.false.) + call advect_SIS_tracers(mca0_snow, CAS%m_snow, uh_snow, vh_snow, & + dt_adv, G, US, IG, CS%SIS_tr_adv_CSp, TrReg, snow_tr=.true.) ! Accumulated diagnostics CAS%dt_sum = CAS%dt_sum + dt_adv @@ -371,7 +359,7 @@ subroutine finish_ice_transport(CAS, IST, TrReg, G, US, IG, CS, rdg_rate) ! Calculate and send transport-related diagnostics. Idt = 0.0 ; if (CAS%dt_sum > 0.0) Idt = IG%H_to_kg_m2 / CAS%dt_sum if (CS%id_xprt>0) then - yr_dt = (8.64e4 * 365.0) * Idt + yr_dt = (8.64e4 * 365.0) * US%s_to_T * Idt call get_cell_mass(IST, G, IG, trans_conv) do j=jsc,jec ; do i=isc,iec trans_conv(i,j) = (trans_conv(i,j) - CAS%mass0(i,j)) * yr_dt @@ -392,7 +380,7 @@ subroutine finish_ice_transport(CAS, IST, TrReg, G, US, IG, CS, rdg_rate) ! if (CS%id_rdgo>0) call post_SIS_data(CS%id_rdgo, rdg_open, diag) ! if (CS%id_rdgv>0) then ! do j=jsc,jec ; do i=isc,iec -! tmp2d(i,j) = rdg_vosh(i,j) * US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) +! tmp2d(i,j) = rdg_vosh(i,j) * G%areaT(i,j) * G%mask2dT(i,j) ! enddo ; enddo ! call post_SIS_data(CS%id_rdgv, tmp2d, diag) ! endif @@ -510,8 +498,8 @@ subroutine cell_ave_state_to_ice_state(CAS, G, US, IG, CS, IST, TrReg) ! should probably be dumped into the ocean. Rolling makes the ice ! thinner so that it melts faster, but it should never be made thinner ! than IG%mH_cat_bound(1). - CAS%mH_ice(i,j,k) = max((CS%Rho_ice*IG%kg_m2_to_H) * & - sqrt((CAS%m_ice(i,j,k)*US%L_to_m**2*G%areaT(i,j)) / & + CAS%mH_ice(i,j,k) = max((CS%Rho_ice*IG%kg_m2_to_H) * US%L_to_m * & + sqrt((CAS%m_ice(i,j,k)*G%areaT(i,j)) / & (CS%roll_factor * CAS%mH_ice(i,j,k)) ), IG%mH_cat_bound(1)) endif @@ -1004,17 +992,17 @@ subroutine get_total_mass(IST, G, US, IG, tot_ice, tot_snow, tot_pond, scale) integer :: i, j, k, m, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - H_to_units = IG%H_to_kg_m2 ; if (present(scale)) H_to_units = scale + H_to_units = IG%H_to_kg_m2*US%L_to_m**2 ; if (present(scale)) H_to_units = scale*US%L_to_m**2 sum_ice(:,:) = 0.0 sum_snow(:,:) = 0.0 do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec - sum_ice(i,j) = sum_ice(i,j) + US%L_to_m**2*G%areaT(i,j) * & + sum_ice(i,j) = sum_ice(i,j) + G%areaT(i,j) * & (IST%part_size(i,j,k) * (H_to_units*IST%mH_ice(i,j,k))) - sum_snow(i,j) = sum_snow(i,j) + US%L_to_m**2*G%areaT(i,j) * & + sum_snow(i,j) = sum_snow(i,j) + G%areaT(i,j) * & (IST%part_size(i,j,k) * (H_to_units*IST%mH_snow(i,j,k))) if (present(tot_pond)) & - sum_pond(i,j) = sum_pond(i,j) + US%L_to_m**2*G%areaT(i,j) * & + sum_pond(i,j) = sum_pond(i,j) + G%areaT(i,j) * & (IST%part_size(i,j,k) * (H_to_units*IST%mH_pond(i,j,k))) enddo ; enddo ; enddo @@ -1093,7 +1081,7 @@ subroutine get_total_enthalpy(IST, G, US, IG, enth_ice, enth_snow, scale) integer :: i, j, k, m, isc, iec, jsc, jec, nLay isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - H_to_units = IG%H_to_kg_m2 ; if (present(scale)) H_to_units = scale + H_to_units = IG%H_to_kg_m2*US%L_to_m**2 ; if (present(scale)) H_to_units = scale*US%L_to_m**2 call get_SIS_tracer_pointer("enth_ice", IST%TrReg, heat_ice, nLay) call get_SIS_tracer_pointer("enth_snow", IST%TrReg, heat_snow, nLay) @@ -1101,11 +1089,11 @@ subroutine get_total_enthalpy(IST, G, US, IG, enth_ice, enth_snow, scale) I_Nk = 1.0 / IG%NkIce do m=1,IG%NkIce ; do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec - sum_enth_ice(i,j) = sum_enth_ice(i,j) + (US%L_to_m**2*G%areaT(i,j) * & + sum_enth_ice(i,j) = sum_enth_ice(i,j) + (G%areaT(i,j) * & (((H_to_units*IST%mH_ice(i,j,k))*IST%part_size(i,j,k))*I_Nk)) * heat_ice(i,j,k,m) enddo ; enddo ; enddo ; enddo do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec - sum_enth_snow(i,j) = sum_enth_snow(i,j) + (US%L_to_m**2*G%areaT(i,j) * & + sum_enth_snow(i,j) = sum_enth_snow(i,j) + (G%areaT(i,j) * & ((H_to_units*IST%mH_snow(i,j,k))*IST%part_size(i,j,k))) * heat_snow(i,j,k,1) enddo ; enddo ; enddo !### What about sum_enth_pond? @@ -1117,10 +1105,11 @@ end subroutine get_total_enthalpy !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_transport_init initializes the ice transport and sets parameters. -subroutine SIS_transport_init(Time, G, param_file, diag, CS, continuity_CSp, cover_trans_CSp) +subroutine SIS_transport_init(Time, G, US, param_file, diag, CS, continuity_CSp, cover_trans_CSp) type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, !! set with the current model time. type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(SIS_diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output type(SIS_transport_CS), pointer :: CS !< The control structure for this module @@ -1212,11 +1201,11 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS, continuity_CSp, cov call SIS_tracer_advect_init(Time, G, param_file, diag, CS%SIS_thick_adv_CSp, scheme=scheme) CS%id_ix_trans = register_diag_field('ice_model', 'IX_TRANS', diag%axesCu1, Time, & - 'x-direction ice transport', 'kg/s', missing_value=missing, & - interp_method='none') + 'x-direction ice transport', 'kg/s', conversion=US%L_to_m**2*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_iy_trans = register_diag_field('ice_model', 'IY_TRANS', diag%axesCv1, Time, & - 'y-direction ice transport', 'kg/s', missing_value=missing, & - interp_method='none') + 'y-direction ice transport', 'kg/s', conversion=US%L_to_m**2*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_xprt = register_diag_field('ice_model', 'XPRT', diag%axesT1, Time, & 'frozen water transport convergence', 'kg/(m^2*yr)', missing_value=missing) CS%id_rdgr = register_diag_field('ice_model', 'RDG_RATE', diag%axesT1, Time, & @@ -1225,7 +1214,8 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS, continuity_CSp, cov ! CS%id_rdgo = register_diag_field('ice_model','RDG_OPEN' ,diag%axesT1, Time, & ! 'rate of opening due to ridging', '1/s', missing_value=missing) ! CS%id_rdgv = register_diag_field('ice_model','RDG_VOSH' ,diag%axesT1, Time, & -! 'volume shifted from level to ridged ice', 'm^3/s', missing_value=missing) +! 'volume shifted from level to ridged ice', 'm^3/s', conversion=US%L_to_m**2, & +! missing_value=missing) end subroutine SIS_transport_init From 8481061e85d32867f4e5b031a969a5e9de9e58b4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 7 Nov 2019 11:49:02 -0500 Subject: [PATCH 19/24] +Rescaled variables used in SIS B-grid dynamics Rescaled variables used inside of the SIS B-grid dynamics code or passed to SIS_B_dynamics for expanded dimensional consistency testing. These changes include passing new unit_scale_type arguments to several subroutines. All answers are bitwise identical, but there are new arguments and the dimensions of some arguments have been rescaled. --- src/SIS_ctrl_types.F90 | 8 +- src/SIS_dyn_bgrid.F90 | 246 +++++++++++++++++++++-------------------- src/SIS_dyn_trans.F90 | 198 ++++++++++++++++++--------------- src/SIS_sum_output.F90 | 4 +- src/SIS_types.F90 | 26 +++-- src/ice_model.F90 | 22 ++-- 6 files changed, 270 insertions(+), 234 deletions(-) diff --git a/src/SIS_ctrl_types.F90 b/src/SIS_ctrl_types.F90 index a35e1e68..1b2e402a 100644 --- a/src/SIS_ctrl_types.F90 +++ b/src/SIS_ctrl_types.F90 @@ -331,11 +331,11 @@ subroutine ice_diagnostics_init(IOF, OSS, FIA, G, US, IG, diag, Time, Cgrid) missing_value=missing, interp_method='none') else OSS%id_uo = register_SIS_diag_field('ice_model', 'UO', diag%axesB1, Time, & - 'surface current - x component', 'm/s', missing_value=missing, & - interp_method='none') + 'surface current - x component', 'm/s', conversion=US%L_T_to_m_s, & + missing_value=missing, interp_method='none') OSS%id_vo = register_SIS_diag_field('ice_model', 'VO', diag%axesB1, Time, & - 'surface current - y component', 'm/s', missing_value=missing, & - interp_method='none') + 'surface current - y component', 'm/s', conversion=US%L_T_to_m_s, & + missing_value=missing, interp_method='none') endif OSS%id_frazil = register_SIS_diag_field('ice_model', 'FRAZIL', diag%axesT1, Time, & diff --git a/src/SIS_dyn_bgrid.F90 b/src/SIS_dyn_bgrid.F90 index ac683d6f..d8603597 100644 --- a/src/SIS_dyn_bgrid.F90 +++ b/src/SIS_dyn_bgrid.F90 @@ -33,17 +33,17 @@ module SIS_dyn_bgrid !> The control structure with parameters regulating B-grid ice dynamics type, public :: SIS_B_dyn_CS ; private real, dimension(:,:), pointer :: & - sig11 => NULL(), & !< The xx component of the stress tensor [Pa m] (or N m-1). - sig12 => NULL(), & !< The xy and yx component of the stress tensor [Pa m] (or N m-1). - sig22 => NULL() !< The yy component of the stress tensor [Pa m] (or N m-1). + sig11 => NULL(), & !< The xx component of the stress tensor [kg m-2 L2 T-2 ~> Pa m] (or N m-1). + sig12 => NULL(), & !< The xy and yx component of the stress tensor [kg m-2 L2 T-2 ~> Pa m] (or N m-1). + sig22 => NULL() !< The yy component of the stress tensor [kg m-2 L2 T-2 ~> Pa m] (or N m-1). ! parameters for calculating water drag and internal ice stresses - real :: p0 = 2.75e4 !< Hibbler rheology pressure constant [Pa] - real :: p0_rho !< The pressure constant divided by ice density [N m kg-1]. - real :: c0 = 20.0 !< another pressure constant + real :: p0 = 2.75e4 !< Hibbler rheology pressure constant [kg m-3 L2 T-2 ~> Pa] + real :: p0_rho !< The pressure constant divided by ice density [L2 T-2 ~> N m kg-1]. + real :: c0 = 20.0 !< another pressure constant [nondim] real :: cdw = 3.24e-3 !< ice/water drag coef. [nondim] real :: blturn = 0.0 !< air/water surf. turning angle (degrees) - real :: EC = 2.0 !< yield curve axis ratio + real :: EC = 2.0 !< yield curve axis ratio [nondim] real :: MIV_MIN = 1.0 !< min ice mass to do dynamics [kg m-2] real :: Rho_ocean = 1030.0 !< The nominal density of sea water [kg m-3]. real :: Rho_ice = 905.0 !< The nominal density of sea ice [kg m-3]. @@ -52,7 +52,7 @@ module SIS_dyn_bgrid integer :: evp_sub_steps !< The number of iterations in the EVP dynamics !! for each slow time step. real :: dt_Rheo !< The maximum sub-cycling time step for the rheology - !! and momentum equations. + !! and momentum equations [T ~> s]. type(time_type), pointer :: Time => NULL() !< A pointer to the ice model's clock. type(SIS_diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -67,10 +67,11 @@ module SIS_dyn_bgrid !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_B_dyn_init initializes the ice dynamics and sets parameters. -subroutine SIS_B_dyn_init(Time, G, param_file, diag, CS) +subroutine SIS_B_dyn_init(Time, G, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, !! set with the current model time. type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(SIS_diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module @@ -98,7 +99,7 @@ subroutine SIS_B_dyn_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "DT_RHEOLOGY", CS%dt_Rheo, & "The sub-cycling time step for iterating the rheology \n"//& "and ice momentum equations. If DT_RHEOLOGY is negative, \n"//& - "the time step is set via NSTEPS_DYN.", units="seconds", & + "the time step is set via NSTEPS_DYN.", units="seconds", scale=US%s_to_T, & default=-1.0) CS%evp_sub_steps = -1 if (CS%dt_Rheo <= 0.0) & @@ -108,7 +109,7 @@ subroutine SIS_B_dyn_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "ICE_STRENGTH_PSTAR", CS%p0, & "A constant in the expression for the ice strength, \n"//& - "P* in Hunke & Dukowicz 1997.", units="Pa", default=2.75e4) + "P* in Hunke & Dukowicz 1997.", units="Pa", scale=US%m_s_to_L_T**2, default=2.75e4) call get_param(param_file, mdl, "ICE_STRENGTH_CSTAR", CS%c0, & "A constant in the exponent of the expression for the \n"//& "ice strength, c* in Hunke & Dukowicz 1997.", & @@ -147,40 +148,41 @@ subroutine SIS_B_dyn_init(Time, G, param_file, diag, CS) CS%id_stren = register_diag_field('ice_model','STRENGTH' ,diag%axesT1, Time, & 'ice strength', 'Pa*m', missing_value=missing) CS%id_fix = register_diag_field('ice_model', 'FI_X', diag%axesB1, Time, & - 'ice internal stress - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice internal stress - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fiy = register_diag_field('ice_model', 'FI_Y', diag%axesB1, Time, & - 'ice internal stress - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'ice internal stress - y component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fcx = register_diag_field('ice_model', 'FC_X', diag%axesB1, Time, & - 'coriolis force - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'coriolis force - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fcy = register_diag_field('ice_model', 'FC_Y', diag%axesB1, Time, & - 'coriolis force - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'coriolis force - y component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fwx = register_diag_field('ice_model', 'FW_X', diag%axesB1, Time, & - 'water stress on ice - x component', 'Pa', missing_value=missing, & - interp_method='none') + 'water stress on ice - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_fwy = register_diag_field('ice_model', 'FW_Y', diag%axesB1, Time, & - 'water stress on ice - y component', 'Pa', missing_value=missing, & - interp_method='none') + 'water stress on ice - y component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & + missing_value=missing, interp_method='none') CS%id_ui = register_diag_field('ice_model', 'UI', diag%axesB1, Time, & - 'ice velocity - x component', 'm/s', missing_value=missing, & - interp_method='none') + 'ice velocity - x component', 'm/s', conversion=US%L_T_to_m_s, & + missing_value=missing, interp_method='none') CS%id_vi = register_diag_field('ice_model', 'VI', diag%axesB1, Time, & - 'ice velocity - y component', 'm/s', missing_value=missing, & - interp_method='none') + 'ice velocity - y component', 'm/s', conversion=US%L_T_to_m_s, & + missing_value=missing, interp_method='none') end subroutine SIS_B_dyn_init !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> find_ice_strength determines the magnitude of force on ice in plastic deformation -subroutine find_ice_strength(mi, ci, ice_strength, G, CS) !, nCat) +subroutine find_ice_strength(mi, ci, ice_strength, G, US, CS) !, nCat) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength !< The ice strength in N m-1 + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: ice_strength !< The ice strength [kg m-2 L2 T-2 ~> N m-1] type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module ! integer, intent(in) :: nCat !< The number of sea ice categories. @@ -245,7 +247,7 @@ end subroutine find_ice_strength !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_B_dynamics takes a single dynamics timestep with EVP subcycles -subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & +subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & fxat, fyat, sea_lev, fxoc, fyoc, do_ridging, rdg_rate, dt_slow, G, US, CS) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type @@ -253,37 +255,37 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: misp !< Mass per unit ocean area of sea ice, !! snow and melt pond water [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: mice !< Mass per unit ocean area of sea ice [kg m-2] - real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: ui !< Zonal ice velocity [m s-1] - real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity [m s-1] - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: uo !< Zonal ocean velocity [m s-1] - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity [m s-1] - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fxat !< Zonal air stress on ice [Pa] - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice [Pa] + real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: ui !< Zonal ice velocity [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: uo !< Zonal ocean velocity [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fxat !< Zonal air stress on ice [kg m-2 L T-2 ~> Pa] + real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: sea_lev !< The height of the sea level, including !! contributions from non-levitating ice from !! an earlier time step [m]. - real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean [Pa] - real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean [Pa] + real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean [kg m-2 L T-2 ~> Pa] + real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean [kg m-2 L T-2 ~> Pa] logical, intent(in ) :: do_ridging !< If true, the ice can ridge real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: rdg_rate !< ridging rate from drift state in UNITS? real, intent(in ) :: dt_slow !< The amount of time over which the ice - !! dynamics are to be advanced [s]. + !! dynamics are to be advanced [T ~> s]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module ! Local variables - real, dimension(SZIB_(G),SZJB_(G)) :: fxic, fyic ! ice int. stress - real, dimension(SZIB_(G),SZJB_(G)) :: fxco, fyco ! coriolis force + real, dimension(SZIB_(G),SZJB_(G)) :: fxic, fyic ! ice internal stresses [kg m-2 L2 T-2 ~> Pa m] + real, dimension(SZIB_(G),SZJB_(G)) :: fxco, fyco ! Coriolis force [kg m-2 L T-2 ~> kg m-1 s-2 = Pa] - real, dimension(SZI_(G),SZJ_(G)) :: prs ! ice internal pressure - real :: zeta, eta ! bulk/shear viscosities - real, dimension(SZI_(G),SZJ_(G)) :: strn11, strn12, strn22 ! strain tensor + real, dimension(SZI_(G),SZJ_(G)) :: prs ! Ice internal pressure [kg m-2 L2 T-2 ~> N m-1] + real :: zeta, eta ! bulk/shear viscosities [kg m-2 L2 T-1 ~> N m-1] + real, dimension(SZI_(G),SZJ_(G)) :: strn11, strn12, strn22 ! strain tensor [T-1 ~> s-1] real, dimension(SZIB_(G),SZJB_(G)) :: miv ! mass on v-points real, dimension(SZIB_(G),SZJB_(G)) :: civ ! conc. on v-points real, dimension(SZI_(G),SZJ_(G)) :: diag_val ! A temporary diagnostic array - complex :: rr ! linear drag coefficient - real :: fxic_now, fyic_now ! ice internal stress + complex :: rr ! linear drag rate [T-1 ~> s-1] + real :: fxic_now, fyic_now ! ice internal stresses [kg m-2 L2 T-2 ~> Pa m] logical, dimension(SZI_(G),SZJ_(G)) :: ice_present logical :: evp_new = .false. @@ -293,18 +295,23 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & grid_fac1, grid_fac2, grid_fac3, grid_fac4 ! temporaries for ice stress calculation - real :: del2, a, b, tmp - real, dimension(SZI_(G),SZJ_(G)) :: edt ! The elasticity (E) times a time-step [Pa m s]. - real, dimension(SZI_(G),SZJ_(G)) :: mp4z, t0, t1, It2 - real :: f11, f22 - real, dimension(SZIB_(G),SZJB_(G)) :: sldx, sldy - real, dimension(SZIB_(G),SZJB_(G)) :: dydx, dxdy + real :: del2 ! The squared magnitude of the strain rate ellipse [T-2 ~> s-2] + real, dimension(SZI_(G),SZJ_(G)) :: edt ! The elasticity (E) times a time-step [kg m-2 L2 T-1 ~> Pa m s] + real, dimension(SZI_(G),SZJ_(G)) :: mp4z ! [T-1 ~> s-1] + real, dimension(SZI_(G),SZJ_(G)) :: t0, t1 ! Ratios of viscosities [nondim] + real, dimension(SZI_(G),SZJ_(G)) :: It2 ! A scaled viscosity [kg L2 m-2 T-1 ~> Pa m s] + real :: a, b ! Temporary inverse elasticity variables [m2 kg-1 T L-2 ~> Pa-1 m-1 s-1] + real :: tmp ! An squared viscosity [kg2 m-4 L4 T-2 ~> m4 s-2] + real :: f11, f22 ! Temporary variables [T-1 ~> s-1] + real, dimension(SZIB_(G),SZJB_(G)) :: sldx, sldy ! Pressure accelerations due to the sloping + ! sea surface integrated over a timestep [L T-1 ~> m s-1] + real, dimension(SZIB_(G),SZJB_(G)) :: dydx, dxdy ! Differences in grid spacings between adjacent points [L ~> m]. real :: tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9 ! for velocity calculation - real, dimension(SZIB_(G),SZJB_(G)) :: dtmiv - real :: dt_Rheo ! The short timestep associated with the rheology [s]. - real :: I_2dt_Rheo ! 1.0 / (2*dt_Rheo) + real, dimension(SZIB_(G),SZJB_(G)) :: dtmiv ! The timestep divided by the ice mass [T m2 kg-1 ~> s m2 kg-1] + real :: dt_Rheo ! The short timestep associated with the rheology [T ~> s]. + real :: I_2dt_Rheo ! 1.0 / (2*dt_Rheo) [T-1 ~> s-1] integer :: EVP_steps ! The number of EVP sub-steps that will actually be taken. real :: I_sub_steps real :: EC2I ! 1/EC^2, where EC is the yield curve axis ratio. @@ -342,15 +349,15 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & dt_Rheo = dt_slow/EVP_steps do J=jsc-1,jec ; do I=isc-1,iec - dydx(I,J) = 0.5*US%L_to_m*((G%dyT(i+1,j+1) - G%dyT(i,j+1)) + (G%dyT(i+1,j) - G%dyT(i,j))) - dxdy(I,J) = 0.5*US%L_to_m*((G%dxT(i+1,j+1) - G%dxT(i+1,j)) + (G%dxT(i,j+1) - G%dxT(i,j))) + dydx(I,J) = 0.5*((G%dyT(i+1,j+1) - G%dyT(i,j+1)) + (G%dyT(i+1,j) - G%dyT(i,j))) + dxdy(I,J) = 0.5*((G%dxT(i+1,j+1) - G%dxT(i+1,j)) + (G%dxT(i,j+1) - G%dxT(i,j))) enddo ; enddo do j=jsc,jec ; do i=isc,iec - grid_fac1(i,j) = US%L_to_m*(G%dxCv(i,J)-G%dxCv(i,J-1))*US%m_to_L*G%IdyT(i,j) - grid_fac2(i,j) = US%L_to_m*(G%dyCu(I,j)-G%dyCu(I-1,j))*US%m_to_L*G%IdxT(i,j) - grid_fac3(i,j) = 0.5*US%L_to_m*G%dyT(i,j) * US%m_to_L*G%IdxT(i,j) - grid_fac4(i,j) = 0.5*US%L_to_m*G%dxT(i,j) * US%m_to_L*G%IdyT(i,j) + grid_fac1(i,j) = (G%dxCv(i,J)-G%dxCv(i,J-1))*G%IdyT(i,j) + grid_fac2(i,j) = (G%dyCu(I,j)-G%dyCu(I-1,j))*G%IdxT(i,j) + grid_fac3(i,j) = 0.5*G%dyT(i,j) * G%IdxT(i,j) + grid_fac4(i,j) = 0.5*G%dxT(i,j) * G%IdyT(i,j) enddo ; enddo !TOM> check where ice is present @@ -360,10 +367,10 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! sea level slope force do J=jsc-1,jec ; do I=isc-1,iec - sldx(I,J) = -dt_Rheo*G%g_Earth*(0.5*((sea_lev(i+1,j+1)-sea_lev(i,j+1)) & - + (sea_lev(i+1,j)-sea_lev(i,j)))) * US%m_to_L*G%IdxBu(i,J) - sldy(I,J) = -dt_Rheo*G%g_Earth*(0.5*((sea_lev(i+1,j+1)-sea_lev(i+1,j)) & - + (sea_lev(i,j+1)-sea_lev(i,j)))) * US%m_to_L*G%IdyBu(I,J) + sldx(I,J) = -dt_Rheo * US%m_s_to_L_T**2*G%g_Earth*(0.5*((sea_lev(i+1,j+1)-sea_lev(i,j+1)) & + + (sea_lev(i+1,j)-sea_lev(i,j)))) * G%IdxBu(i,J) + sldy(I,J) = -dt_Rheo * US%m_s_to_L_T**2*G%g_Earth*(0.5*((sea_lev(i+1,j+1)-sea_lev(i+1,j)) & + + (sea_lev(i,j+1)-sea_lev(i,j)))) * G%IdyBu(I,J) enddo ; enddo ! put ice/snow mass and concentration on v-grid, first finding mass on t-grid. @@ -376,7 +383,7 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! precompute prs, elastic timestep parameter, and linear drag coefficient ! - call find_ice_strength(mice, ci, prs, G, CS) + call find_ice_strength(mice, ci, prs, G, US, CS) !TOM> towards a leaner calculation of the ice stress if (evp_new) then @@ -388,10 +395,10 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! This is H&D97, Eq. 44, with their E_0 = 0.25. I_2dt_Rheo = 1.0 / (2.0*dt_Rheo) do j=jsc,jec ; do i=isc,iec - if (US%L_to_m*G%dxT(i,j) < US%L_to_m*G%dyT(i,j) ) then - edt(i,j) = I_2dt_Rheo * (US%L_to_m**2*G%dxT(i,j)**2 * mice(i,j)) + if (G%dxT(i,j) < G%dyT(i,j) ) then + edt(i,j) = I_2dt_Rheo * (G%dxT(i,j)**2 * mice(i,j)) else - edt(i,j) = I_2dt_Rheo * (US%L_to_m**2*G%dyT(i,j)**2 * mice(i,j)) + edt(i,j) = I_2dt_Rheo * (G%dyT(i,j)**2 * mice(i,j)) endif enddo ; enddo endif @@ -405,11 +412,11 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & enddo ; enddo if (CS%debug .or. CS%debug_redundant) then - call Bchksum_pair("sld[xy] in SIS_B_dynamics", sldx, sldy, G, symmetric=.true.) - call Bchksum_pair("f[xy]at in SIS_B_dynamics", fxat, fyat, G, symmetric=.true.) - call Bchksum_pair("[uv]i pre-steps SIS_B_dynamics", ui, vi, G, symmetric=.true.) - call Bchksum_pair("[uv]o in SIS_B_dynamics", uo, vo, G, symmetric=.true.) - call Bchksum_pair("d[yx]d[xy] in SIS_B_dynamics", dydx, dxdy, G, scalars=.true.) + call Bchksum_pair("sld[xy] in SIS_B_dynamics", sldx, sldy, G, symmetric=.true., scale=US%L_T_to_m_s) + call Bchksum_pair("f[xy]at in SIS_B_dynamics", fxat, fyat, G, symmetric=.true., scale=US%L_T_to_m_s*US%s_to_T) + call Bchksum_pair("[uv]i pre-steps SIS_B_dynamics", ui, vi, G, symmetric=.true., scale=US%L_T_to_m_s) + call Bchksum_pair("[uv]o in SIS_B_dynamics", uo, vo, G, symmetric=.true., scale=US%L_T_to_m_s) + call Bchksum_pair("d[yx]d[xy] in SIS_B_dynamics", dydx, dxdy, G, scalars=.true., scale=US%L_to_m) endif if (CS%debug_redundant) then call check_redundant_B("civ in SIS_B_dynamics", civ, G) @@ -427,14 +434,14 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & do j=jsc,jec ; do i=isc,iec strn11(i,j) = (0.5*((ui(I,J)-ui(I-1,J)) + (ui(I,J-1)-ui(I-1,J-1))) + & 0.25*((vi(I,J)+vi(I-1,J-1)) + (vi(I,J-1)+vi(I-1,J))) * & - grid_fac1(i,j)) * US%m_to_L*G%IdxT(i,j) + grid_fac1(i,j)) * G%IdxT(i,j) strn22(i,j) = (0.5*((vi(I,J)-vi(I,J-1)) + (vi(I-1,J)-vi(I-1,J-1))) + & 0.25*((ui(I,J)+ui(I,J-1)) + (ui(I-1,J)+ui(I-1,J-1))) * & - grid_fac2(i,j)) * US%m_to_L*G%IdyT(i,j) - strn12(i,j) = 0.5*grid_fac3(i,j) * US%m_to_L*& + grid_fac2(i,j)) * G%IdyT(i,j) + strn12(i,j) = 0.5*grid_fac3(i,j) * & ( (vi(I,J)*G%IdyBu(I,J) - vi(I-1,J)*G%IdyBu(I-1,J)) + & (vi(I,J-1)*G%IdyBu(I,J-1) - vi(I-1,J-1)*G%IdyBu(I-1,J-1)) ) + & - 0.5*grid_fac4(i,j) * US%m_to_L*& + 0.5*grid_fac4(i,j) * & ( (ui(I,J)*G%IdxBu(I,J) - ui(I,J-1)*G%IdxBu(I,J-1)) + & (ui(I-1,J)*G%IdxBu(I-1,J) - ui(I-1,J-1)*G%IdxBu(I-1,J-1)) ) enddo ; enddo @@ -445,13 +452,13 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & del2 = (strn11(i,j)*strn11(i,j) + strn22(i,j)*strn22(i,j)) * (1+EC2I) & + 4*EC2I*strn12(i,j)*strn12(i,j) + 2*strn11(i,j)*strn22(i,j)*(1-EC2I) ! H&D eqn 9 - if ( del2 > 4e-18 ) then - zeta = 0.5*prs(i,j)/sqrt(del2) + if ( del2 > 4e-18*US%T_to_s**2 ) then + zeta = 0.5*prs(i,j) / sqrt(del2) else - zeta = 2.5e8*prs(i,j) + zeta = 2.5e8*US%s_to_T * prs(i,j) endif - if (zeta<4e8) zeta = 4e8 ! Hibler uses to prevent nonlinear instability + zeta = max(zeta, 4e8*US%m_to_L**2*US%T_to_s) ! Hibler uses to prevent nonlinear instability eta = zeta*EC2I ! @@ -461,7 +468,7 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & mp4z(i,j) = -prs(i,j)/(4*zeta) t0(i,j) = 2*eta / (2*eta + edt(i,j)) tmp = 1/(4*eta*zeta) - a = 1/edt(i,j) + (zeta+eta)*tmp ! = 1/edt(i,j) + (1+EC2I)/(4*eta) + a = 1/(edt(i,j)) + (zeta+eta)*tmp ! = 1/edt(i,j) + (1+EC2I)/(4*eta) b = (zeta-eta)*tmp ! = (1-EC2I)/(4*eta) t1(i,j) = b/a ! = (1-EC2I)*edt(i,j) / (4*eta + (1+EC2I)*edt(i,j)) It2(i,j) = a / (a**2 - b**2) ! 1/t2 = a / (a*a - b*b) @@ -472,8 +479,8 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! timestep stress tensor (H&D eqn 21) do j=jsc,jec ; do i=isc,iec if( (G%mask2dT(i,j)>0.5) .and. (misp(i,j) > CS%MIV_MIN) ) then - f11 = mp4z(i,j) + CS%sig11(i,j)/edt(i,j) + strn11(i,j) - f22 = mp4z(i,j) + CS%sig22(i,j)/edt(i,j) + strn22(i,j) + f11 = mp4z(i,j) + CS%sig11(i,j)/(edt(i,j)) + strn11(i,j) + f22 = mp4z(i,j) + CS%sig22(i,j)/(edt(i,j)) + strn22(i,j) CS%sig11(i,j) = (t1(i,j)*f22 + f11) * It2(i,j) CS%sig22(i,j) = (t1(i,j)*f11 + f22) * It2(i,j) CS%sig12(i,j) = t0(i,j) * (CS%sig12(i,j) + edt(i,j)*strn12(i,j)) @@ -502,7 +509,6 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! - ! ### SIG11 and SIG22 SHOULD BE PAIRED ON A CUBED SPHERE. call pass_var(CS%sig11, G%Domain, complete=.false.) call pass_var(CS%sig22, G%Domain, complete=.false.) @@ -510,25 +516,25 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & do J=jsc-1,jec ; do I=isc-1,iec if( (G%mask2dBu(i,j)>0.5).and.(miv(i,j)>CS%MIV_MIN)) then ! timestep ice velocity (H&D eqn 22) - rr = CS%cdw*CS%Rho_ocean*abs(cmplx(ui(i,j)-uo(i,j),vi(i,j)-vo(i,j))) * & + rr = US%L_to_m*CS%cdw*CS%Rho_ocean*abs(cmplx(ui(i,j)-uo(i,j),vi(i,j)-vo(i,j))) * & exp(sign(CS%blturn*pi/180,US%s_to_T*G%CoriolisBu(i,j))*(0.0,1.0)) ! ! first, timestep explicit parts (ice, wind & ocean part of water stress) ! - tmp1 = 0.5*US%L_to_m*((CS%sig12(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig12(i+1,j)*G%dxT(i+1,j)) + & + tmp1 = 0.5*((CS%sig12(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig12(i+1,j)*G%dxT(i+1,j)) + & (CS%sig12(i,j+1)*G%dxT(i,j+1) - CS%sig12(i,j)*G%dxT(i,j)) ) - tmp2 = 0.5*US%L_to_m*((CS%sig11(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig11(i,j+1)*G%dyT(i,j+1)) + & + tmp2 = 0.5*((CS%sig11(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig11(i,j+1)*G%dyT(i,j+1)) + & (CS%sig11(i+1,j)*G%dyT(i+1,j) - CS%sig11(i,j)*G%dyT(i,j)) ) - tmp6 = 0.5*US%L_to_m*((CS%sig12(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig12(i,j+1)*G%dyT(i,j+1)) + & + tmp6 = 0.5*((CS%sig12(i+1,j+1)*G%dyT(i+1,j+1) - CS%sig12(i,j+1)*G%dyT(i,j+1)) + & (CS%sig12(i+1,j)*G%dyT(i+1,j) - CS%sig12(i,j)*G%dyT(i,j)) ) - tmp7 = 0.5*US%L_to_m*((CS%sig22(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig22(i+1,j)*G%dxT(i+1,j)) + & + tmp7 = 0.5*((CS%sig22(i+1,j+1)*G%dxT(i+1,j+1) - CS%sig22(i+1,j)*G%dxT(i+1,j)) + & (CS%sig22(i,j+1)*G%dxT(i,j+1) - CS%sig22(i,j)*G%dxT(i,j))) tmp3 = 0.25*((CS%sig12(i+1,j+1)+CS%sig12(i,j)) + (CS%sig12(i+1,j)+CS%sig12(i,j+1)) ) tmp4 = 0.25*((CS%sig22(i+1,j+1)+CS%sig22(i,j)) + (CS%sig22(i+1,j)+CS%sig22(i,j+1)) ) tmp5 = 0.25*((CS%sig11(i+1,j+1)+CS%sig11(i,j)) + (CS%sig11(i+1,j)+CS%sig11(i,j+1)) ) - fxic_now = ( (tmp1 + tmp2) + (tmp3*dxdy(I,J) - tmp4*dydx(I,J)) ) * US%m_to_L**2*G%IareaBu(I,J) - fyic_now = ( (tmp6 + tmp7) + (tmp3*dydx(I,J) - tmp5*dxdy(I,J)) ) * US%m_to_L**2*G%IareaBu(I,J) + fxic_now = ( (tmp1 + tmp2) + (tmp3*dxdy(I,J) - tmp4*dydx(I,J)) ) * G%IareaBu(I,J) + fyic_now = ( (tmp6 + tmp7) + (tmp3*dydx(I,J) - tmp5*dxdy(I,J)) ) * G%IareaBu(I,J) !### REWRITE TO AVOID COMPLEX EXPRESSIONS. ui(I,J) = ui(I,J) + (fxic_now + civ(I,J)*fxat(I,J) + & @@ -540,34 +546,34 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! second, timestep implicit parts (Coriolis and ice part of water stress) ! newuv = cmplx(ui(I,J),vi(I,J)) / & - (1 + dt_Rheo*(0.0,1.0)*US%s_to_T*G%CoriolisBu(I,J) + civ(I,J)*rr*dtmiv(I,J)) + (1 + dt_Rheo*(0.0,1.0)*G%CoriolisBu(I,J) + civ(I,J)*rr*dtmiv(I,J)) ui(I,J) = real(newuv); vi(I,J) = aimag(newuv) ! ! sum for averages ! fxic(I,J) = fxic(I,J) + fxic_now fyic(I,J) = fyic(I,J) + fyic_now - fxoc(I,J) = fxoc(I,J) + real(civ(I,J)*rr*cmplx(ui(I,J)-uo(I,J), vi(I,J)-vo(I,J))) + fxoc(I,J) = fxoc(I,J) + real( civ(I,J)*rr*cmplx(ui(I,J)-uo(I,J), vi(I,J)-vo(I,J))) fyoc(I,J) = fyoc(I,J) + aimag(civ(I,J)*rr*cmplx(ui(I,J)-uo(I,J), vi(I,J)-vo(I,J))) - fxco(I,J) = fxco(I,J) - miv(I,J)*real ((0.0,1.0)*US%s_to_T*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) - fyco(I,J) = fyco(I,J) - miv(I,J)*aimag((0.0,1.0)*US%s_to_T*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) + fxco(I,J) = fxco(I,J) - miv(I,J)*real ((0.0,1.0)*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) + fyco(I,J) = fyco(I,J) - miv(I,J)*aimag((0.0,1.0)*G%CoriolisBu(I,J) * cmplx(ui(I,J),vi(I,J))) endif enddo ; enddo if (CS%debug) then - call hchksum(CS%sig11, "sig11 in SIS_B_dynamics", G%HI, haloshift=1) - call hchksum(CS%sig22, "sig22 in SIS_B_dynamics", G%HI, haloshift=1) - call hchksum(CS%sig12, "sig12 in SIS_B_dynamics", G%HI, haloshift=1) - - call Bchksum(fxic, "fxic in SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(fyic, "fyic in SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(fxoc, "fxoc in SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(fyoc, "fyoc in SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(fxco, "fxco in SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(fyco, "fyco in SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(ui, "ui in SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(vi, "vi in SIS_B_dynamics", G%HI, symmetric=.true.) + call hchksum(CS%sig11, "sig11 in SIS_B_dynamics", G%HI, haloshift=1, scale=US%L_T_to_m_s**2) + call hchksum(CS%sig22, "sig22 in SIS_B_dynamics", G%HI, haloshift=1, scale=US%L_T_to_m_s**2) + call hchksum(CS%sig12, "sig12 in SIS_B_dynamics", G%HI, haloshift=1, scale=US%L_T_to_m_s**2) + + call Bchksum(fxic, "fxic in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s*US%s_to_T) + call Bchksum(fyic, "fyic in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s*US%s_to_T) + call Bchksum(fxoc, "fxoc in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s*US%s_to_T) + call Bchksum(fyoc, "fyoc in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s*US%s_to_T) + call Bchksum(fxco, "fxco in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s*US%s_to_T) + call Bchksum(fyco, "fyco in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s*US%s_to_T) + call Bchksum(ui, "ui in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s) + call Bchksum(vi, "vi in SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s) endif if (CS%debug_redundant) then call check_redundant_B("fxic/fyic in SIS_B_dynamics steps",fxic, fyic, G) @@ -579,8 +585,8 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & enddo ! l=1,EVP_steps if (CS%debug) then - call Bchksum(ui, "ui end SIS_B_dynamics", G%HI, symmetric=.true.) - call Bchksum(vi, "vi end SIS_B_dynamics", G%HI, symmetric=.true.) + call Bchksum(ui, "ui end SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s) + call Bchksum(vi, "vi end SIS_B_dynamics", G%HI, symmetric=.true., scale=US%L_T_to_m_s) endif if (CS%debug_redundant) & call check_redundant_B("ui/vi end SIS_B_dynamics", ui, vi, G) @@ -607,15 +613,15 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! (ocean & ice), whereas fxat and fyat here are only averaged over the ice. if (CS%id_sigi>0) then - diag_val(:,:) = sigI(mice, ci, CS%sig11, CS%sig22, CS%sig12, G, CS) + diag_val(:,:) = sigI(mice, ci, CS%sig11, CS%sig22, CS%sig12, G, US, CS) call post_SIS_data(CS%id_sigi, diag_val, CS%diag) endif if (CS%id_sigii>0) then - diag_val(:,:) = sigII(mice, ci, CS%sig11, CS%sig22, CS%sig12, G, CS) + diag_val(:,:) = sigII(mice, ci, CS%sig11, CS%sig22, CS%sig12, G, US, CS) call post_SIS_data(CS%id_sigii, diag_val, CS%diag) endif if (CS%id_stren>0) then - call find_ice_strength(mice, ci, diag_val, G, CS) + call find_ice_strength(mice, ci, diag_val, G, US, CS) call post_SIS_data(CS%id_stren, diag_val, CS%diag) endif @@ -631,7 +637,7 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & del2 = (strn11(i,j)*strn11(i,j) + strn22(i,j)*strn22(i,j)) * (1+EC2I) & + 4*EC2I*strn12(i,j)*strn12(i,j) + 2*strn11(i,j)*strn22(i,j)*(1-EC2I) ! H&D eqn 9 - rdg_rate(i,j)=ridge_rate(del2, strn11(i,j)+strn22(i,j)) + rdg_rate(i,j)=ridge_rate(US%s_to_T**2*del2, US%s_to_T*(strn11(i,j)+strn22(i,j))) else rdg_rate(i,j)=0.0 endif ; enddo ; enddo @@ -641,7 +647,7 @@ end subroutine SIS_B_dynamics !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> sigI evaluates the first stress invariant -function sigI(mi, ci, sig11, sig22, sig12, G, CS) +function sigI(mi, ci, sig11, sig22, sig12, G, US, CS) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration [nondim] @@ -649,12 +655,13 @@ function sigI(mi, ci, sig11, sig22, sig12, G, CS) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig22 !< The yy component of the stress tensor [N m-1] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig12 !< The xy & yx component of the stress tensor [N m-1] real, dimension(SZI_(G),SZJ_(G)) :: sigI !< The first stress invariant [nondim] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - call find_ice_strength(mi, ci, sigI, G, CS) + call find_ice_strength(mi, ci, sigI, G, US, CS) do j=jsc,jec ; do i=isc,iec if (sigI(i,j) > 0.0) sigI(i,j) = (sig11(i,j) + sig22(i,j)) / sigI(i,j) @@ -664,7 +671,7 @@ end function sigI !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> sigII evaluates the second stress invariant -function sigII(mi, ci, sig11, sig22, sig12, G, CS) +function sigII(mi, ci, sig11, sig22, sig12, G, US, CS) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mi !< Mass per unit ocean area of sea ice [kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ci !< Sea ice concentration [nondim] @@ -672,12 +679,13 @@ function sigII(mi, ci, sig11, sig22, sig12, G, CS) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig22 !< The yy component of the stress tensor [N m-1] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig12 !< The xy & yx component of the stress tensor [N m-1] real, dimension(SZI_(G),SZJ_(G)) :: sigII !< The second stress invariant [nondim] + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - call find_ice_strength(mi, ci, sigII, G, CS) + call find_ice_strength(mi, ci, sigII, G, US, CS) do j=jsc,jec ; do i=isc,iec if (sigII(i,j) > 0.0) sigII(i,j) = (((sig11(i,j)-sig22(i,j))**2+4*sig12(i,j)*sig12(i,j))/(sigII(i,j)**2))**0.5 diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 1f24e452..7abe7f98 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -162,10 +162,10 @@ module SIS_dyn_trans real, allocatable, dimension(:,:) :: ice_cover !< The fractional ice coverage, summed across all !! thickness categories [nondim], between 0 & 1. real, allocatable, dimension(:,:) :: u_ice_B !< The pseudo-zonal ice velocity along the - !! along the grid directions on a B-grid [m s-1]. + !! along the grid directions on a B-grid [L T-1 ~> m s-1]. !! All thickness categories are assumed to have the same velocities. real, allocatable, dimension(:,:) :: v_ice_B !< The pseudo-meridional ice velocity along the - !! along the grid directions on a B-grid [m s-1]. + !! along the grid directions on a B-grid [L T-1 ~> m s-1]. real, allocatable, dimension(:,:) :: u_ice_C !< The pseudo-zonal ice velocity along the !! along the grid directions on a C-grid [L T-1 ~> m s-1]. !! All thickness categories are assumed to have the same velocities. @@ -254,9 +254,9 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, US, IG, area_berg=IOF%area_berg ) else call icebergs_run( icebergs_CS, CS%Time, & - FIA%calving(isc:iec,jsc:jec), OSS%u_ocn_B(isc-1:iec+1,jsc-1:jec+1), & - OSS%v_ocn_B(isc-1:iec+1,jsc-1:jec+1), IST%u_ice_B(isc-1:iec+1,jsc-1:jec+1), & - IST%v_ice_B(isc-1:iec+1,jsc-1:jec+1), windstr_x, windstr_y, & + FIA%calving(isc:iec,jsc:jec), US%L_T_to_m_s*OSS%u_ocn_B(isc-1:iec+1,jsc-1:jec+1), & + US%L_T_to_m_s*OSS%v_ocn_B(isc-1:iec+1,jsc-1:jec+1), US%L_T_to_m_s*IST%u_ice_B(isc-1:iec+1,jsc-1:jec+1), & + US%L_T_to_m_s*IST%v_ice_B(isc-1:iec+1,jsc-1:jec+1), windstr_x, windstr_y, & OSS%sea_lev(isc-1:iec+1,jsc-1:jec+1), OSS%SST_C(isc:iec,jsc:jec), & FIA%calving_hflx(isc:iec,jsc:jec), FIA%ice_cover(isc-1:iec+1,jsc-1:jec+1), & hi_avg(isc-1:iec+1,jsc-1:jec+1), stagger=BGRID_NE, & @@ -307,11 +307,11 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U ! thickness categories [nondim], between 0 & 1. real, dimension(SZIB_(G),SZJB_(G)) :: & WindStr_x_B, & ! Zonal (_x_) and meridional (_y_) wind stresses - WindStr_y_B, & ! averaged over the ice categories on a B-grid [Pa]. - WindStr_x_ocn_B, & ! Zonal wind stress on the ice-free ocean on a B-grid [Pa]. - WindStr_y_ocn_B, & ! Meridional wind stress on the ice-free ocean on a B-grid [Pa]. - str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [Pa]. - str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [Pa]. + WindStr_y_B, & ! averaged over the ice categories on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_B, & ! Zonal wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_B, & ! Meridional wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. + str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [kg m-2 L T-2 ~> Pa]. + str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [kg m-2 L T-2 ~> Pa]. WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [kg m-2 L T-2 ~> Pa]. @@ -467,7 +467,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U ! Dynamics diagnostics call mpp_clock_begin(iceClockc) - if (CS%id_fax>0) call post_data(CS%id_fax, WindStr_x_Cu, CS%diag) + if (CS%ID_fax>0) call post_data(CS%id_fax, WindStr_x_Cu, CS%diag) if (CS%id_fay>0) call post_data(CS%id_fay, WindStr_y_Cv, CS%diag) if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", & @@ -494,13 +494,14 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U WindStr_x_ocn_B, WindStr_y_ocn_B, G, US, CS%complete_ice_cover) if (CS%debug) then - call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G) + call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G, scale=US%L_T_to_m_s) call hchksum(ice_free, "ice_free before ice_dynamics", G%HI) call hchksum(misp_sum, "misp_sum before ice_dynamics", G%HI) call hchksum(mi_sum, "mi_sum before ice_dynamics", G%HI) call hchksum(OSS%sea_lev, "sea_lev before ice_dynamics", G%HI, haloshift=1) - call Bchksum_pair("[uv]_ocn before ice_dynamics", OSS%u_ocn_B, OSS%v_ocn_B, G) - call Bchksum_pair("WindStr_[xy]_B before ice_dynamics", WindStr_x_B, WindStr_y_B, G, halos=1) + call Bchksum_pair("[uv]_ocn before ice_dynamics", OSS%u_ocn_B, OSS%v_ocn_B, G, scale=US%L_T_to_m_s) + call Bchksum_pair("WindStr_[xy]_B before ice_dynamics", WindStr_x_B, WindStr_y_B, G, halos=1, & + scale=US%L_T_to_m_s*US%s_to_T) endif call mpp_clock_begin(iceClocka) @@ -509,16 +510,16 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U call SIS_B_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_B, IST%v_ice_B, & OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), US%s_to_T*dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) else call SIS_B_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_B, IST%v_ice_B, & OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), US%s_to_T*dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) endif call mpp_clock_end(iceClocka) - if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) + if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G, scale=US%L_T_to_m_s) call mpp_clock_begin(iceClockb) call pass_vector(IST%u_ice_B, IST%v_ice_B, G%Domain, stagger=BGRID_NE) @@ -540,23 +541,24 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if (CS%id_fay>0) call post_data(CS%id_fay, diagVarBy, CS%diag) endif - if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) + if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, & + G, scale=US%L_T_to_m_s) ! Store all mechanical ocean forcing. if (CS%Warsaw_sum_order) then call set_ocean_top_stress_Bgrid(IOF, WindStr_x_ocn_B, WindStr_y_ocn_B, & - str_x_ice_ocn_B, str_y_ice_ocn_B, IST%part_size, G, IG) + str_x_ice_ocn_B, str_y_ice_ocn_B, IST%part_size, G, US, IG) else call set_ocean_top_stress_B2(IOF, WindStr_x_ocn_B, WindStr_y_ocn_B, & - str_x_ice_ocn_B, str_y_ice_ocn_B, ice_free, ice_cover, G) + str_x_ice_ocn_B, str_y_ice_ocn_B, ice_free, ice_cover, G, US) endif call mpp_clock_end(iceClockc) ! Convert the velocities to C-grid points for use in transport. do j=jsc,jec ; do I=isc-1,iec - IST%u_ice_C(I,j) = US%m_s_to_L_T*0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) + IST%u_ice_C(I,j) = 0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - IST%v_ice_C(i,J) = US%m_s_to_L_T*0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) + IST%v_ice_C(i,J) = 0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) enddo ; enddo endif ! End of B-grid dynamics @@ -887,11 +889,11 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, ! in the dynamics. real, dimension(SZIB_(G),SZJB_(G)) :: & WindStr_x_B, & ! Zonal (_x_) and meridional (_y_) wind stresses - WindStr_y_B, & ! averaged over the ice categories on a B-grid [Pa]. - WindStr_x_ocn_B, & ! Zonal wind stress on the ice-free ocean on a B-grid [Pa]. - WindStr_y_ocn_B, & ! Meridional wind stress on the ice-free ocean on a B-grid [Pa]. - str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [Pa]. - str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [Pa]. + WindStr_y_B, & ! averaged over the ice categories on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_B, & ! Zonal wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_B, & ! Meridional wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. + str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [kg m-2 L T-2 ~> Pa]. + str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [kg m-2 L T-2 ~> Pa]. WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [kg m-2 L T-2 ~> Pa]. @@ -996,24 +998,26 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, WindStr_x_ocn_B, WindStr_y_ocn_B, G, US, CS%complete_ice_cover) if (CS%debug) then - call Bchksum_pair("[uv]_ice_B before dynamics", DS2d%u_ice_B, DS2d%v_ice_B, G) + call Bchksum_pair("[uv]_ice_B before dynamics", DS2d%u_ice_B, DS2d%v_ice_B, G, scale=US%L_T_to_m_s) call hchksum(ice_free, "ice_free before ice_dynamics", G%HI) call hchksum(DS2d%mca_step(:,:,DS2d%nts), "misp_sum before ice_dynamics", G%HI) call hchksum(DS2d%mi_sum, "mi_sum before ice_dynamics", G%HI) call hchksum(OSS%sea_lev, "sea_lev before ice_dynamics", G%HI, haloshift=1) - call Bchksum_pair("[uv]_ocn before ice_dynamics", OSS%u_ocn_B, OSS%v_ocn_B, G) - call Bchksum_pair("WindStr_[xy]_B before ice_dynamics", WindStr_x_B, WindStr_y_B, G, halos=1) + call Bchksum_pair("[uv]_ocn before ice_dynamics", OSS%u_ocn_B, OSS%v_ocn_B, G, scale=US%L_T_to_m_s) + call Bchksum_pair("WindStr_[xy]_B before ice_dynamics", WindStr_x_B, WindStr_y_B, G, halos=1, & + scale=US%L_T_to_m_s*US%s_to_T) endif call mpp_clock_begin(iceClocka) if (CS%do_ridging) rdg_rate(:,:) = 0.0 call SIS_B_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_B, DS2d%v_ice_B, & - OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & + OSS%u_ocn_B, OSS%v_ocn_B, & + WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), US%s_to_T*dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) call mpp_clock_end(iceClocka) - if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, G) + if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, G, scale=US%L_T_to_m_s) call mpp_clock_begin(iceClockb) call pass_vector(DS2d%u_ice_B, DS2d%v_ice_B, G%Domain, stagger=BGRID_NE) @@ -1035,18 +1039,19 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, if (CS%id_fay>0) call post_data(CS%id_fay, diagVarBy, CS%diag) endif - if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, G) + if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, & + G, scale=US%L_T_to_m_s) ! Store all mechanical ocean forcing. call set_ocean_top_stress_B2(IOF, WindStr_x_ocn_B, WindStr_y_ocn_B, & - str_x_ice_ocn_B, str_y_ice_ocn_B, ice_free, DS2d%ice_cover, G) + str_x_ice_ocn_B, str_y_ice_ocn_B, ice_free, DS2d%ice_cover, G, US) call mpp_clock_end(iceClockc) ! Convert the velocities to C-grid points for use in transport. do j=jsc,jec ; do I=isc-1,iec - DS2d%u_ice_C(I,j) = US%m_s_to_L_T*0.5 * ( DS2d%u_ice_B(I,J-1) + DS2d%u_ice_B(I,J) ) + DS2d%u_ice_C(I,j) = 0.5 * ( DS2d%u_ice_B(I,J-1) + DS2d%u_ice_B(I,J) ) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - DS2d%v_ice_C(i,J) = US%m_s_to_L_T*0.5 * ( DS2d%v_ice_B(I-1,J) + DS2d%v_ice_B(I,J) ) + DS2d%v_ice_C(i,J) = 0.5 * ( DS2d%v_ice_B(I-1,J) + DS2d%v_ice_B(I,J) ) enddo ; enddo endif ! End of B-grid dynamics @@ -1115,11 +1120,11 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer misp_sum ! Combined mass of snow, ice and melt pond water per unit total area [kg m-2]. real, dimension(SZIB_(G),SZJB_(G)) :: & WindStr_x_B, & ! Zonal (_x_) and meridional (_y_) wind stresses - WindStr_y_B, & ! averaged over the ice categories on a B-grid [Pa]. - WindStr_x_ocn_B, & ! Zonal wind stress on the ice-free ocean on a B-grid [Pa]. - WindStr_y_ocn_B, & ! Meridional wind stress on the ice-free ocean on a B-grid [Pa]. - str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [Pa]. - str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [Pa]. + WindStr_y_B, & ! averaged over the ice categories on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_B, & ! Zonal wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_B, & ! Meridional wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. + str_x_ice_ocn_B, & ! Zonal ice-ocean stress on a B-grid [kg m-2 L T-2 ~> Pa]. + str_y_ice_ocn_B ! Meridional ice-ocean stress on a B-grid [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points [kg m-2 L T-2 ~> Pa]. WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points [kg m-2 L T-2 ~> Pa]. @@ -1231,13 +1236,14 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer WindStr_x_ocn_B, WindStr_y_ocn_B, G, US, CS%complete_ice_cover) if (CS%debug) then - call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G) + call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G, scale=US%L_T_to_m_s) call hchksum(IST%part_size(:,:,0), "ice_free before ice_dynamics", G%HI) call hchksum(misp_sum, "misp_sum before ice_dynamics", G%HI) call hchksum(mi_sum, "mi_sum before ice_dynamics", G%HI) call hchksum(OSS%sea_lev, "sea_lev before ice_dynamics", G%HI, haloshift=1) - call Bchksum_pair("[uv]_ocn before ice_dynamics", OSS%u_ocn_B, OSS%v_ocn_B, G) - call Bchksum_pair("WindStr_[xy]_B before ice_dynamics", WindStr_x_B, WindStr_y_B, G, halos=1) + call Bchksum_pair("[uv]_ocn before ice_dynamics", OSS%u_ocn_B, OSS%v_ocn_B, G, scale=US%L_T_to_m_s) + call Bchksum_pair("WindStr_[xy]_B before ice_dynamics", WindStr_x_B, WindStr_y_B, G, halos=1, & + scale=US%L_T_to_m_s*US%s_to_T) endif call mpp_clock_begin(iceClocka) @@ -1245,7 +1251,7 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer WindStr_x_B, WindStr_y_B, str_x_ice_ocn_B, str_y_ice_ocn_B) call mpp_clock_end(iceClocka) - if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) + if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G, scale=US%L_T_to_m_s) call mpp_clock_begin(iceClockb) call pass_vector(IST%u_ice_B, IST%v_ice_B, G%Domain, stagger=BGRID_NE) @@ -1267,19 +1273,21 @@ subroutine slab_ice_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG, tracer if (CS%id_fay>0) call post_data(CS%id_fay, diagVarBy, CS%diag) endif - if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) + if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G, & + scale=US%L_T_to_m_s) ! Store all mechanical ocean forcing. call set_ocean_top_stress_B2(IOF, WindStr_x_ocn_B, WindStr_y_ocn_B, str_x_ice_ocn_B, str_y_ice_ocn_B, & - IST%part_size(:,:,0), IST%part_size(:,:,1), G) + IST%part_size(:,:,0), IST%part_size(:,:,1), G, US) call mpp_clock_end(iceClockc) ! Convert the B-grid velocities to C-grid points for transport. - if (CS%debug) call Bchksum_pair("Before ice_transport [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) + if (CS%debug) call Bchksum_pair("Before ice_transport [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G, & + scale=US%L_T_to_m_s) do j=jsc,jec ; do I=isc-1,iec - IST%u_ice_C(I,j) = US%m_s_to_L_T*0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) + IST%u_ice_C(I,j) = 0.5 * ( IST%u_ice_B(I,J-1) + IST%u_ice_B(I,J) ) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - IST%v_ice_C(i,J) = US%m_s_to_L_T*0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) + IST%v_ice_C(i,J) = 0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) enddo ; enddo call mpp_clock_end(iceClock4) @@ -1429,22 +1437,27 @@ end subroutine stresses_to_stress_mag !! the appropriate staggering, and store them in the public ice data type for use by the !! ocean model. This version of the routine uses wind and ice-ocean stresses on a B-grid. subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & - str_ice_oce_x, str_ice_oce_y, part_size, G, IG) + str_ice_oce_x, str_ice_oce_y, part_size, G, US, IG) type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: windstr_x_water !< The x-direction wind stress over open water [Pa]. + intent(in) :: windstr_x_water !< The x-direction wind stress over + !! open water [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. + intent(in) :: windstr_y_water !< The y-direction wind stress over + !! open water [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean + !! stress [kg m-2 L T-2 ~> Pa] real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean + !! stress [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G),0:IG%CatIce), & intent(in) :: part_size !< The fractional area coverage of the ice !! thickness categories [nondim], 0-1 + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real :: ps_vel ! part_size interpolated to a velocity point [nondim]. integer :: i, j, k, isc, iec, jsc, jec, ncat @@ -1462,18 +1475,18 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec do i=isc,iec ps_vel = G%mask2dT(i,j) * part_size(i,j,0) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.25 * & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.25 * US%L_T_to_m_s*US%s_to_T* & ((windstr_x_water(I,J) + windstr_x_water(I-1,J-1)) + & (windstr_x_water(I-1,J) + windstr_x_water(I,J-1))) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.25 * & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.25 * US%L_T_to_m_s*US%s_to_T* & ((windstr_y_water(I,J) + windstr_y_water(I-1,J-1)) + & (windstr_y_water(I-1,J) + windstr_y_water(I,J-1))) enddo do k=1,ncat ; do i=isc,iec ; if (G%mask2dT(i,j)>0.5) then - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.25 * & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.25 * US%L_T_to_m_s*US%s_to_T* & ((str_ice_oce_x(I,J) + str_ice_oce_x(I-1,J-1)) + & (str_ice_oce_x(I-1,J) + str_ice_oce_x(I,J-1))) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.25 * & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.25 * US%L_T_to_m_s*US%s_to_T* & ((str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J-1)) + & (str_ice_oce_y(I-1,J) + str_ice_oce_y(I,J-1))) endif ; enddo ; enddo @@ -1485,14 +1498,14 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & ps_vel = 1.0 ; if (G%mask2dBu(I,J)>0.5) ps_vel = & 0.25*((part_size(i+1,j+1,0) + part_size(i,j,0)) + & (part_size(i+1,j,0) + part_size(i,j+1,0)) ) - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + windstr_x_water(I,J) * ps_vel - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + windstr_y_water(I,J) * ps_vel + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* windstr_x_water(I,J) * ps_vel + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* windstr_y_water(I,J) * ps_vel enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dBu(I,J)>0.5) then ps_vel = 0.25 * ((part_size(i+1,j+1,k) + part_size(i,j,k)) + & (part_size(i+1,j,k) + part_size(i,j+1,k)) ) - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + str_ice_oce_x(I,J) * ps_vel - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + str_ice_oce_y(I,J) * ps_vel + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* str_ice_oce_x(I,J) * ps_vel + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* str_ice_oce_y(I,J) * ps_vel endif ; enddo ; enddo enddo elseif (IOF%flux_uv_stagger == CGRID_NE) then @@ -1501,12 +1514,12 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & do I=isc-1,iec ps_vel = 1.0 ; if (G%mask2dCu(I,j)>0.5) ps_vel = & 0.5*(part_size(i+1,j,0) + part_size(i,j,0)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T* & 0.5 * (windstr_x_water(I,J) + windstr_x_water(I,J-1)) enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dCu(I,j)>0.5) then ps_vel = 0.5 * (part_size(i+1,j,k) + part_size(i,j,k)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T* & 0.5 * (str_ice_oce_x(I,J) + str_ice_oce_x(I,J-1)) endif ; enddo ; enddo enddo @@ -1515,12 +1528,12 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & do i=isc,iec ps_vel = 1.0 ; if (G%mask2dCv(i,J)>0.5) ps_vel = & 0.5*(part_size(i,j+1,0) + part_size(i,j,0)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T* & 0.5 * (windstr_y_water(I,J) + windstr_y_water(I-1,J)) enddo do k=1,ncat ; do i=isc,iec ; if (G%mask2dCv(i,J)>0.5) then ps_vel = 0.5 * (part_size(i,j+1,k) + part_size(i,j,k)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T* & 0.5 * (str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J)) endif ; enddo ; enddo enddo @@ -1645,18 +1658,23 @@ end subroutine set_ocean_top_stress_Cgrid !! the appropriate staggering, and store them in the public ice data type for use by the !! ocean model. This version of the routine uses wind and ice-ocean stresses on a B-grid. subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & - str_ice_oce_x, str_ice_oce_y, ice_free, ice_cover, G) + str_ice_oce_x, str_ice_oce_y, ice_free, ice_cover, G, Us) type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: windstr_x_water !< The x-direction wind stress over open water [Pa]. + intent(in) :: windstr_x_water !< The x-direction wind stress over + !! open water [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. + intent(in) :: windstr_y_water !< The y-direction wind stress over + !! open water [kg m-2 L T-2 ~> Pa]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean + !! stress [kg m-2 L T-2 ~> Pa] real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [Pa]. + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean + !! stress [kg m-2 L T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ice_free !< The fractional open water area coverage [nondim], 0-1 real, dimension(SZI_(G),SZJ_(G)), & @@ -1677,12 +1695,12 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec ; do i=isc,iec ps_ocn = G%mask2dT(i,j) * ice_free(i,j) ps_ice = G%mask2dT(i,j) * ice_cover(i,j) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + 0.25 * & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + 0.25 * US%L_T_to_m_s*US%s_to_T* & (ps_ocn * ((windstr_x_water(I,J) + windstr_x_water(I-1,J-1)) + & (windstr_x_water(I-1,J) + windstr_x_water(I,J-1))) + & ps_ice * ((str_ice_oce_x(I,J) + str_ice_oce_x(I-1,J-1)) + & (str_ice_oce_x(I-1,J) + str_ice_oce_x(I,J-1))) ) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + 0.25 * & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + 0.25 * US%L_T_to_m_s*US%s_to_T* & (ps_ocn * ((windstr_y_water(I,J) + windstr_y_water(I-1,J-1)) + & (windstr_y_water(I-1,J) + windstr_y_water(I,J-1))) + & ps_ice * ((str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J-1)) + & @@ -1698,8 +1716,10 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & ps_ice = 0.25 * ((ice_cover(i+1,j+1) + ice_cover(i,j)) + & (ice_cover(i+1,j) + ice_cover(i,j+1)) ) endif - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + (ps_ocn * windstr_x_water(I,J) + ps_ice * str_ice_oce_x(I,J)) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + (ps_ocn * windstr_y_water(I,J) + ps_ice * str_ice_oce_y(I,J)) + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & + (ps_ocn * windstr_x_water(I,J) + ps_ice * str_ice_oce_x(I,J)) + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & + (ps_ocn * windstr_y_water(I,J) + ps_ice * str_ice_oce_y(I,J)) enddo ; enddo elseif (IOF%flux_uv_stagger == CGRID_NE) then !$OMP parallel do default(shared) private(ps_ocn, ps_ice) @@ -1709,7 +1729,7 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i+1,j) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i+1,j) + ice_cover(i,j)) endif - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + 0.5 * & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + 0.5 * US%L_T_to_m_s*US%s_to_T* & (ps_ocn * (windstr_x_water(I,J) + windstr_x_water(I,J-1)) + & ps_ice * (str_ice_oce_x(I,J) + str_ice_oce_x(I,J-1)) ) enddo ; enddo @@ -1720,7 +1740,7 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i,j+1) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i,j+1) + ice_cover(i,j)) endif - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + 0.5 * & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + 0.5 * US%L_T_to_m_s*US%s_to_T* & (ps_ocn * (windstr_y_water(I,J) + windstr_y_water(I-1,J)) + & ps_ice * (str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J)) ) enddo ; enddo @@ -1958,9 +1978,9 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ ice_free !< The fractional open water [nondim], between 0 & 1. real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: & WindStr_x_B, & !< Zonal (_x_) and meridional (_y_) wind stresses - WindStr_y_B, & !< averaged over the ice categories on a B-grid [Pa]. - WindStr_x_ocn_B, & !< Zonal wind stress on the ice-free ocean on a B-grid [Pa]. - WindStr_y_ocn_B !< Meridional wind stress on the ice-free ocean on a B-grid [Pa]. + WindStr_y_B, & !< averaged over the ice categories on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_x_ocn_B, & !< Zonal wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. + WindStr_y_ocn_B !< Meridional wind stress on the ice-free ocean on a B-grid [kg m-2 L T-2 ~> Pa]. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real, intent(in) :: max_ice_cover !< The fractional ice coverage !! that is close enough to 1 to be complete for the purpose of calculating @@ -2016,12 +2036,12 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ weights = ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1) + G%areaT(i,j)*ice_cover(i,j)) + & (G%areaT(i+1,j)*ice_cover(i+1,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_B(I,J) = G%mask2dBu(I,J) * & + WindStr_x_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_x_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_x_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_x_A(i+1,j) + & G%areaT(i,j+1) * ice_cover(i,j+1) * WindStr_x_A(i,j+1)) ) * I_wts - WindStr_y_B(I,J) = G%mask2dBu(I,J) * & + WindStr_y_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_y_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_y_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_y_A(i+1,j) + & @@ -2031,12 +2051,12 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ weights = ((G%areaT(i+1,j+1)*ice_free(i+1,j+1) + G%areaT(i,j)*ice_free(i,j)) + & (G%areaT(i+1,j)*ice_free(i+1,j) + G%areaT(i,j+1)*ice_free(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * & + WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_x_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_x_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_x_ocn_A(i+1,j) + & G%areaT(i,j+1) * ice_free(i,j+1) * WindStr_x_ocn_A(i,j+1)) ) * I_wts - WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) * & + WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_y_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_y_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_y_ocn_A(i+1,j) + & @@ -2234,7 +2254,7 @@ subroutine SIS_dyn_trans_init(Time, G, US, IG, param_file, diag, CS, output_dir, if (CS%Cgrid_dyn) then call SIS_C_dyn_init(CS%Time, G, US, param_file, CS%diag, CS%SIS_C_dyn_CSp, CS%ntrunc) else - call SIS_B_dyn_init(CS%Time, G, param_file, CS%diag, CS%SIS_B_dyn_CSp) + call SIS_B_dyn_init(CS%Time, G, US, param_file, CS%diag, CS%SIS_B_dyn_CSp) endif if (CS%merged_cont) then call SIS_transport_init(CS%Time, G, US, param_file, CS%diag, CS%SIS_transport_CSp, & @@ -2285,10 +2305,10 @@ subroutine SIS_dyn_trans_init(Time, G, US, IG, param_file, diag, CS, output_dir, missing_value=missing, interp_method='none') else CS%id_fax = register_diag_field('ice_model', 'FA_X', diag%axesB1, Time, & - 'air stress on ice - x component', 'Pa', & + 'air stress on ice - x component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') CS%id_fay = register_diag_field('ice_model', 'FA_Y', diag%axesB1, Time, & - 'air stress on ice - y component', 'Pa', & + 'air stress on ice - y component', 'Pa', conversion=US%L_T_to_m_s*US%s_to_T, & missing_value=missing, interp_method='none') endif diff --git a/src/SIS_sum_output.F90 b/src/SIS_sum_output.F90 index cd28aa0f..9406f3b6 100644 --- a/src/SIS_sum_output.F90 +++ b/src/SIS_sum_output.F90 @@ -490,8 +490,8 @@ subroutine write_ice_statistics(IST, day, n, G, US, IG, CS, message, check_colum enddo ; enddo ; endif elseif (allocated(IST%u_ice_B) .and. allocated(IST%v_ice_B)) then do J=js-1,je ; do I=is-1,ie - CFL_u = abs(US%m_s_to_L_T*IST%u_ice_B(I,J)) * dt_CFL * G%IdxBu(I,J) - CFL_v = abs(US%m_s_to_L_T*IST%v_ice_B(I,J)) * dt_CFL * G%IdyBu(I,J) + CFL_u = abs(IST%u_ice_B(I,J)) * dt_CFL * G%IdxBu(I,J) + CFL_v = abs(IST%v_ice_B(I,J)) * dt_CFL * G%IdyBu(I,J) max_CFL = max(max_CFL, CFL_u, CFL_v) enddo ; enddo endif diff --git a/src/SIS_types.F90 b/src/SIS_types.F90 index 73874435..a117e03d 100644 --- a/src/SIS_types.F90 +++ b/src/SIS_types.F90 @@ -62,10 +62,10 @@ module SIS_types !! The sum of part_size is 1. ! These velocities are only used on the slow ice processors real, allocatable, dimension(:,:) :: u_ice_B !< The pseudo-zonal ice velocity along the - !! along the grid directions on a B-grid [m s-1]. + !! along the grid directions on a B-grid [L T-1 ~> m s-1]. !! All thickness categories are assumed to have the same velocities. real, allocatable, dimension(:,:) :: v_ice_B !< The pseudo-meridional ice velocity along the - !! along the grid directions on a B-grid [m s-1]. + !! along the grid directions on a B-grid [L T-1 ~> m s-1]. real, allocatable, dimension(:,:) :: u_ice_C !< The pseudo-zonal ice velocity along the !! along the grid directions on a C-grid [L T-1 ~> m s-1]. !! All thickness categories are assumed to have the same velocities. @@ -112,8 +112,8 @@ module SIS_types s_surf , & !< The ocean's surface salinity [gSalt kg-1]. SST_C , & !< The ocean's bulk surface temperature [degC]. T_fr_ocn, & !< The freezing point temperature at the ocean's surface salinity [degC]. - u_ocn_B, & !< The ocean's zonal velocity on B-grid points [m s-1]. - v_ocn_B, & !< The ocean's meridional velocity on B-grid points [m s-1]. + u_ocn_B, & !< The ocean's zonal velocity on B-grid points [L T-1 ~> m s-1]. + v_ocn_B, & !< The ocean's meridional velocity on B-grid points [L T-1 ~> m s-1]. u_ocn_C, & !< The ocean's zonal velocity on C-grid points [L T-1 ~> m s-1]. v_ocn_C !< The ocean's meridional velocity on C-grid points [L T-1 ~> m s-1]. real, allocatable, dimension(:,:) :: bheat !< The upward diffusive heat flux from the ocean @@ -726,6 +726,14 @@ subroutine ice_state_read_alt_restarts(IST, G, US, IG, Ice_restart, & IST%v_ice_C(i,J) = vel_rescale * IST%v_ice_C(i,J) enddo ; enddo endif + if (.not.IST%Cgrid_dyn .and. (US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then + vel_rescale = (US%m_to_L*US%s_to_T_restart) / (US%m_to_L_restart*US%s_to_T) + do J=G%jsc-1,G%jec ; do I=G%isc-1,G%iec + IST%u_ice_B(I,J) = vel_rescale * IST%u_ice_B(I,J) + IST%v_ice_B(I,J) = vel_rescale * IST%v_ice_B(I,J) + enddo ; enddo + endif end subroutine ice_state_read_alt_restarts @@ -1200,18 +1208,18 @@ subroutine translate_OSS_to_sOSS(OSS, IST, sOSS, G, US) sOSS%u_ocn_A(i,j) = US%L_T_to_m_s*0.5*(OSS%u_ocn_C(I,j) + OSS%u_ocn_C(I-1,j)) sOSS%v_ocn_A(i,j) = US%L_T_to_m_s*0.5*(OSS%v_ocn_C(i,J) + OSS%v_ocn_C(i,J-1)) else - sOSS%u_ocn_A(i,j) = 0.25*((OSS%u_ocn_B(I,J) + OSS%u_ocn_B(I-1,J-1)) + & + sOSS%u_ocn_A(i,j) = US%L_T_to_m_s*0.25*((OSS%u_ocn_B(I,J) + OSS%u_ocn_B(I-1,J-1)) + & (OSS%u_ocn_B(I,J-1) + OSS%u_ocn_B(I-1,J)) ) - sOSS%v_ocn_A(i,j) = 0.25*((OSS%v_ocn_B(I,J) + OSS%v_ocn_B(I-1,J-1)) + & + sOSS%v_ocn_A(i,j) = US%L_T_to_m_s*0.25*((OSS%v_ocn_B(I,J) + OSS%v_ocn_B(I-1,J-1)) + & (OSS%v_ocn_B(I,J-1) + OSS%v_ocn_B(I-1,J)) ) endif if (IST%Cgrid_dyn) then sOSS%u_ice_A(i,j) = US%L_T_to_m_s*0.5*(IST%u_ice_C(I,j) + IST%u_ice_C(I-1,j)) sOSS%v_ice_A(i,j) = US%L_T_to_m_s*0.5*(IST%v_ice_C(i,J) + IST%v_ice_C(i,J-1)) else - sOSS%u_ice_A(i,j) = 0.25*((IST%u_ice_B(I,J) + IST%u_ice_B(I-1,J-1)) + & + sOSS%u_ice_A(i,j) = US%L_T_to_m_s*0.25*((IST%u_ice_B(I,J) + IST%u_ice_B(I-1,J-1)) + & (IST%u_ice_B(I,J-1) + IST%u_ice_B(I-1,J)) ) - sOSS%v_ice_A(i,j) = 0.25*((IST%v_ice_B(I,J) + IST%v_ice_B(I-1,J-1)) + & + sOSS%v_ice_A(i,j) = US%L_T_to_m_s*0.25*((IST%v_ice_B(I,J) + IST%v_ice_B(I-1,J-1)) + & (IST%v_ice_B(I,J-1) + IST%v_ice_B(I-1,J)) ) endif else ! This is a land point. @@ -2312,7 +2320,7 @@ subroutine IST_chksum(mesg, IST, G, US, IG, haloshift) call hchksum(IST%mH_pond*IG%H_to_kg_m2, trim(mesg)//" IST%mH_pond", G%HI, haloshift=hs) if (allocated(IST%u_ice_B) .and. allocated(IST%v_ice_B)) then - call Bchksum_pair(mesg//" IST%[uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G, halos=hs) + call Bchksum_pair(mesg//" IST%[uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G, halos=hs, scale=US%L_T_to_m_s) call check_redundant_B(mesg//" IST%u/v_ice", IST%u_ice_B, IST%v_ice_B, G) endif if (allocated(IST%u_ice_C) .and. allocated(IST%v_ice_C)) then diff --git a/src/ice_model.F90 b/src/ice_model.F90 index d6d7b4fa..0b5a207a 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -831,7 +831,7 @@ subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, US, specified_ice, ocean_fields type(coupler_3d_bc_type), intent(inout) :: ocean_fields !< A structure of ocean fields, often !! related to passive tracers. - real, dimension(G%isd:G%ied, G%jsd:G%jed) :: u_nonsym, v_nonsym + real, dimension(G%isd:G%ied, G%jsd:G%jed) :: u_nonsym, v_nonsym ! Nonsymmetric velocities [L T-1 ~> m s-1] real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin logical :: Cgrid_ocn integer :: i, j, k, m, n, i2, j2, k2, isc, iec, jsc, jec, i_off, j_off, index @@ -868,16 +868,16 @@ subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, US, specified_ice, ocean_fields if (OIB%stagger == AGRID) then u_nonsym(:,:) = 0.0 ; v_nonsym(:,:) = 0.0 do j=jsc,jec ; do i=isc,iec ; i2 = i+i_off ; j2 = j+j_off - u_nonsym(i,j) = OIB%u(i2,j2) ; v_nonsym(i,j) = OIB%v(i2,j2) + u_nonsym(i,j) = US%m_s_to_L_T*OIB%u(i2,j2) ; v_nonsym(i,j) = US%m_s_to_L_T*OIB%v(i2,j2) enddo ; enddo call pass_vector(u_nonsym, v_nonsym, G%Domain_aux, stagger=AGRID) if (Cgrid_ocn) then do j=jsc,jec ; do I=isc-1,iec - OSS%u_ocn_C(I,j) = US%m_s_to_L_T*0.5*(u_nonsym(i,j) + u_nonsym(i+1,j)) + OSS%u_ocn_C(I,j) = 0.5*(u_nonsym(i,j) + u_nonsym(i+1,j)) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - OSS%v_ocn_C(i,J) = US%m_s_to_L_T*0.5*(v_nonsym(i,j) + v_nonsym(i,j+1)) + OSS%v_ocn_C(i,J) = 0.5*(v_nonsym(i,j) + v_nonsym(i,j+1)) enddo ; enddo else do J=jsc-1,jec ; do I=isc-1,iec @@ -892,20 +892,20 @@ subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, US, specified_ice, ocean_fields if (Cgrid_ocn) then u_nonsym(:,:) = 0.0 ; v_nonsym(:,:) = 0.0 do j=jsc,jec ; do i=isc,iec ; i2 = i+i_off ; j2 = j+j_off - u_nonsym(i,j) = OIB%u(i2,j2) ; v_nonsym(i,j) = OIB%v(i2,j2) + u_nonsym(i,j) = US%m_s_to_L_T*OIB%u(i2,j2) ; v_nonsym(i,j) = US%m_s_to_L_T*OIB%v(i2,j2) enddo ; enddo call pass_vector(u_nonsym, v_nonsym, G%Domain_aux, stagger=BGRID_NE) do j=jsc,jec ; do I=isc-1,iec - OSS%u_ocn_C(I,j) = US%m_s_to_L_T*0.5*(u_nonsym(I,J) + u_nonsym(I,J-1)) + OSS%u_ocn_C(I,j) = 0.5*(u_nonsym(I,J) + u_nonsym(I,J-1)) enddo ; enddo do J=jsc-1,jec ; do i=isc,iec - OSS%v_ocn_C(i,J) = US%m_s_to_L_T*0.5*(v_nonsym(I,J) + v_nonsym(I-1,J)) + OSS%v_ocn_C(i,J) = 0.5*(v_nonsym(I,J) + v_nonsym(I-1,J)) enddo ; enddo else do J=jsc,jec ; do I=isc,iec ; i2 = i+i_off ; j2 = j+j_off - OSS%u_ocn_B(I,J) = OIB%u(i2,j2) - OSS%v_ocn_B(I,J) = OIB%v(i2,j2) + OSS%u_ocn_B(I,J) = US%m_s_to_L_T*OIB%u(i2,j2) + OSS%v_ocn_B(I,J) = US%m_s_to_L_T*OIB%v(i2,j2) enddo ; enddo if (G%symmetric) & call fill_symmetric_edges(OSS%u_ocn_B, OSS%v_ocn_B, G%Domain, stagger=BGRID_NE) @@ -924,7 +924,7 @@ subroutine unpack_ocn_ice_bdry(OIB, OSS, ITV, G, US, specified_ice, ocean_fields else u_nonsym(:,:) = 0.0 ; v_nonsym(:,:) = 0.0 do j=jsc,jec ; do i=isc,iec ; i2 = i+i_off ; j2 = j+j_off - u_nonsym(I,j) = OIB%u(i2,j2) ; v_nonsym(i,J) = OIB%v(i2,j2) + u_nonsym(I,j) = US%m_s_to_L_T*OIB%u(i2,j2) ; v_nonsym(i,J) = US%m_s_to_L_T*OIB%v(i2,j2) enddo ; enddo call pass_vector(u_nonsym, v_nonsym, G%Domain_aux, stagger=CGRID_NE) do J=jsc-1,jec ; do I=isc-1,iec @@ -1125,7 +1125,7 @@ subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) ! call uvchksum(OSS%u_ocn_C, "OSS%u_ocn_C", & ! OSS%v_ocn_C, "OSS%v_ocn_C", G%HI, haloshift=1, scale=US%L_T_to_m_s) ! if (allocated(OSS%u_ocn_B)) & -! call Bchksum(OSS%u_ocn_B, "OSS%u_ocn_B", G%HI, haloshift=1) +! call Bchksum(OSS%u_ocn_B, "OSS%u_ocn_B", G%HI, haloshift=1, scale=US%L_T_to_m_s) ! if (allocated(OSS%v_ocn_B)) & ! call Bchksum(OSS%v_ocn_B, "OSS%v_ocn_B", G%HI, haloshift=1) call chksum(G%sin_rot(isc:iec,jsc:jec), "G%sin_rot") From 40ee0ec08aeb537035ae956811a2bba5092006b5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 7 Nov 2019 15:35:32 -0500 Subject: [PATCH 20/24] +Rescaled IOF%flux_u_ocn and IOF%stress_mag Rescaled IOF%flux_u_ocn, IOF%flux_v_ocn, and IOF%stress_mag for expanded dimensional consistency testing and code simplification. All answers are bitwise identical, but there are minor interface changes. --- src/SIS_dyn_trans.F90 | 76 +++++++++++++++++++++---------------------- src/SIS_types.F90 | 17 ++++++---- src/ice_model.F90 | 27 +++++++-------- src/specified_ice.F90 | 19 ++++++----- 4 files changed, 72 insertions(+), 67 deletions(-) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 7abe7f98..9ff182b5 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -229,8 +229,8 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, US, IG, ! This code reproduces a long-standing bug, in that the old ice-ocean ! stresses are being passed in place of the wind stresses on the icebergs. do j=jsc,jec ; do i=isc,iec - windstr_x(i,j) = IOF%flux_u_ocn(i,j) - windstr_y(i,j) = IOF%flux_v_ocn(i,j) + windstr_x(i,j) = US%L_T_to_m_s*US%s_to_T*IOF%flux_u_ocn(i,j) + windstr_y(i,j) = US%L_T_to_m_s*US%s_to_T*IOF%flux_v_ocn(i,j) enddo ; enddo stress_stagger = IOF%flux_uv_stagger else @@ -1475,18 +1475,18 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec do i=isc,iec ps_vel = G%mask2dT(i,j) * part_size(i,j,0) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.25 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.25 * & ((windstr_x_water(I,J) + windstr_x_water(I-1,J-1)) + & (windstr_x_water(I-1,J) + windstr_x_water(I,J-1))) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.25 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.25 * & ((windstr_y_water(I,J) + windstr_y_water(I-1,J-1)) + & (windstr_y_water(I-1,J) + windstr_y_water(I,J-1))) enddo do k=1,ncat ; do i=isc,iec ; if (G%mask2dT(i,j)>0.5) then - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.25 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.25 * & ((str_ice_oce_x(I,J) + str_ice_oce_x(I-1,J-1)) + & (str_ice_oce_x(I-1,J) + str_ice_oce_x(I,J-1))) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.25 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.25 * & ((str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J-1)) + & (str_ice_oce_y(I-1,J) + str_ice_oce_y(I,J-1))) endif ; enddo ; enddo @@ -1498,14 +1498,14 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & ps_vel = 1.0 ; if (G%mask2dBu(I,J)>0.5) ps_vel = & 0.25*((part_size(i+1,j+1,0) + part_size(i,j,0)) + & (part_size(i+1,j,0) + part_size(i,j+1,0)) ) - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* windstr_x_water(I,J) * ps_vel - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* windstr_y_water(I,J) * ps_vel + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + windstr_x_water(I,J) * ps_vel + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + windstr_y_water(I,J) * ps_vel enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dBu(I,J)>0.5) then ps_vel = 0.25 * ((part_size(i+1,j+1,k) + part_size(i,j,k)) + & (part_size(i+1,j,k) + part_size(i,j+1,k)) ) - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* str_ice_oce_x(I,J) * ps_vel - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* str_ice_oce_y(I,J) * ps_vel + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + str_ice_oce_x(I,J) * ps_vel + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + str_ice_oce_y(I,J) * ps_vel endif ; enddo ; enddo enddo elseif (IOF%flux_uv_stagger == CGRID_NE) then @@ -1514,12 +1514,12 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & do I=isc-1,iec ps_vel = 1.0 ; if (G%mask2dCu(I,j)>0.5) ps_vel = & 0.5*(part_size(i+1,j,0) + part_size(i,j,0)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * & 0.5 * (windstr_x_water(I,J) + windstr_x_water(I,J-1)) enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dCu(I,j)>0.5) then ps_vel = 0.5 * (part_size(i+1,j,k) + part_size(i,j,k)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * & 0.5 * (str_ice_oce_x(I,J) + str_ice_oce_x(I,J-1)) endif ; enddo ; enddo enddo @@ -1528,12 +1528,12 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & do i=isc,iec ps_vel = 1.0 ; if (G%mask2dCv(i,J)>0.5) ps_vel = & 0.5*(part_size(i,j+1,0) + part_size(i,j,0)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * & 0.5 * (windstr_y_water(I,J) + windstr_y_water(I-1,J)) enddo do k=1,ncat ; do i=isc,iec ; if (G%mask2dCv(i,J)>0.5) then ps_vel = 0.5 * (part_size(i,j+1,k) + part_size(i,j,k)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * & 0.5 * (str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J)) endif ; enddo ; enddo enddo @@ -1585,16 +1585,16 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec do i=isc,iec ps_vel = G%mask2dT(i,j) * part_size(i,j,0) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + ps_vel * 0.5 * & (windstr_x_water(I,j) + windstr_x_water(I-1,j)) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + ps_vel * 0.5 * & (windstr_y_water(i,J) + windstr_y_water(i,J-1)) enddo !### SIMPLIFY THIS TO USE THAT sum(part_size(i,j,1:ncat)) = 1.0-part_size(i,j,0) ? do k=1,ncat ; do i=isc,iec ; if (G%mask2dT(i,j)>0.5) then - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + part_size(i,j,k) * 0.5 * & (str_ice_oce_x(I,j) + str_ice_oce_x(I-1,j)) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + part_size(i,j,k) * 0.5 * & (str_ice_oce_y(i,J) + str_ice_oce_y(i,J-1)) endif ; enddo ; enddo enddo @@ -1606,17 +1606,17 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & 0.25*((part_size(i+1,j+1,0) + part_size(i,j,0)) + & (part_size(i+1,j,0) + part_size(i,j+1,0)) ) !### Consider deleting the masks here? They probably do not change answers. - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * & (windstr_x_water(I,j) + windstr_x_water(I,j+1)) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * G%mask2dBu(I,J) * 0.5 * & (windstr_y_water(i,J) + windstr_y_water(i+1,J)) enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dBu(I,J)>0.5) then ps_vel = 0.25 * ((part_size(i+1,j+1,k) + part_size(i,j,k)) + & (part_size(i+1,j,k) + part_size(i,j+1,k)) ) - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + ps_vel * 0.5 * & (str_ice_oce_x(I,j) + str_ice_oce_x(I,j+1)) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + ps_vel * 0.5 * & (str_ice_oce_y(i,J) + str_ice_oce_y(i+1,J)) endif ; enddo ; enddo enddo @@ -1626,11 +1626,11 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & do I=Isc-1,iec ps_vel = 1.0 ; if (G%mask2dCu(I,j)>0.5) ps_vel = & 0.5*(part_size(i+1,j,0) + part_size(i,j,0)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T*windstr_x_water(I,j) + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * windstr_x_water(I,j) enddo do k=1,ncat ; do I=isc-1,iec ; if (G%mask2dCu(I,j)>0.5) then ps_vel = 0.5 * (part_size(i+1,j,k) + part_size(i,j,k)) - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * US%L_T_to_m_s*US%s_to_T*str_ice_oce_x(I,j) + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + ps_vel * str_ice_oce_x(I,j) endif ; enddo ; enddo enddo !$OMP parallel do default(shared) private(ps_vel) @@ -1638,11 +1638,11 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & do i=isc,iec ps_vel = 1.0 ; if (G%mask2dCv(i,J)>0.5) ps_vel = & 0.5*(part_size(i,j+1,0) + part_size(i,j,0)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T*windstr_y_water(i,J) + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * windstr_y_water(i,J) enddo do k=1,ncat ; do i=isc,iec ; if (G%mask2dCv(i,J)>0.5) then ps_vel = 0.5 * (part_size(i,j+1,k) + part_size(i,j,k)) - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * US%L_T_to_m_s*US%s_to_T*str_ice_oce_y(i,J) + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + ps_vel * str_ice_oce_y(i,J) endif ; enddo ; enddo enddo else @@ -1695,12 +1695,12 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec ; do i=isc,iec ps_ocn = G%mask2dT(i,j) * ice_free(i,j) ps_ice = G%mask2dT(i,j) * ice_cover(i,j) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + 0.25 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + 0.25 * & (ps_ocn * ((windstr_x_water(I,J) + windstr_x_water(I-1,J-1)) + & (windstr_x_water(I-1,J) + windstr_x_water(I,J-1))) + & ps_ice * ((str_ice_oce_x(I,J) + str_ice_oce_x(I-1,J-1)) + & (str_ice_oce_x(I-1,J) + str_ice_oce_x(I,J-1))) ) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + 0.25 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + 0.25 * & (ps_ocn * ((windstr_y_water(I,J) + windstr_y_water(I-1,J-1)) + & (windstr_y_water(I-1,J) + windstr_y_water(I,J-1))) + & ps_ice * ((str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J-1)) + & @@ -1716,9 +1716,9 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & ps_ice = 0.25 * ((ice_cover(i+1,j+1) + ice_cover(i,j)) + & (ice_cover(i+1,j) + ice_cover(i,j+1)) ) endif - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + & (ps_ocn * windstr_x_water(I,J) + ps_ice * str_ice_oce_x(I,J)) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + & (ps_ocn * windstr_y_water(I,J) + ps_ice * str_ice_oce_y(I,J)) enddo ; enddo elseif (IOF%flux_uv_stagger == CGRID_NE) then @@ -1729,7 +1729,7 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i+1,j) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i+1,j) + ice_cover(i,j)) endif - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + 0.5 * & (ps_ocn * (windstr_x_water(I,J) + windstr_x_water(I,J-1)) + & ps_ice * (str_ice_oce_x(I,J) + str_ice_oce_x(I,J-1)) ) enddo ; enddo @@ -1740,7 +1740,7 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i,j+1) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i,j+1) + ice_cover(i,j)) endif - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + 0.5 * US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + 0.5 * & (ps_ocn * (windstr_y_water(I,J) + windstr_y_water(I-1,J)) + & ps_ice * (str_ice_oce_y(I,J) + str_ice_oce_y(I-1,J)) ) enddo ; enddo @@ -1792,10 +1792,10 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & do j=jsc,jec ; do i=isc,iec ps_ocn = G%mask2dT(i,j) * ice_free(i,j) ps_ice = G%mask2dT(i,j) * ice_cover(i,j) - IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(i,j) = IOF%flux_u_ocn(i,j) + & (ps_ocn * 0.5 * (windstr_x_water(I,j) + windstr_x_water(I-1,j)) + & ps_ice * 0.5 * (str_ice_oce_x(I,j) + str_ice_oce_x(I-1,j)) ) - IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,j) = IOF%flux_v_ocn(i,j) + & (ps_ocn * 0.5 * (windstr_y_water(i,J) + windstr_y_water(i,J-1)) + & ps_ice * 0.5 * (str_ice_oce_y(i,J) + str_ice_oce_y(i,J-1)) ) enddo ; enddo @@ -1809,10 +1809,10 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & ps_ice = 0.25 * ((ice_cover(i+1,j+1) + ice_cover(i,j)) + & (ice_cover(i+1,j) + ice_cover(i,j+1)) ) endif - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + & (ps_ocn * 0.5 * (windstr_x_water(I,j) + windstr_x_water(I,j+1)) + & ps_ice * 0.5 * (str_ice_oce_x(I,j) + str_ice_oce_x(I,j+1)) ) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + & (ps_ocn * 0.5 * (windstr_y_water(i,J) + windstr_y_water(i+1,J)) + & ps_ice * 0.5 * (str_ice_oce_y(i,J) + str_ice_oce_y(i+1,J)) ) enddo ; enddo @@ -1824,7 +1824,7 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i+1,j) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i+1,j) + ice_cover(i,j)) endif - IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_u_ocn(I,j) = IOF%flux_u_ocn(I,j) + & (ps_ocn * windstr_x_water(I,j) + ps_ice * str_ice_oce_x(I,j)) enddo ; enddo !$OMP parallel do default(shared) private(ps_ocn, ps_ice) @@ -1834,7 +1834,7 @@ subroutine set_ocean_top_stress_C2(IOF, windstr_x_water, windstr_y_water, & ps_ocn = 0.5*(ice_free(i,j+1) + ice_free(i,j)) ps_ice = 0.5*(ice_cover(i,j+1) + ice_cover(i,j)) endif - IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + US%L_T_to_m_s*US%s_to_T* & + IOF%flux_v_ocn(i,J) = IOF%flux_v_ocn(i,J) + & (ps_ocn * windstr_y_water(i,J) + ps_ice * str_ice_oce_y(i,J)) enddo ; enddo else diff --git a/src/SIS_types.F90 b/src/SIS_types.F90 index a117e03d..ae88e734 100644 --- a/src/SIS_types.F90 +++ b/src/SIS_types.F90 @@ -357,11 +357,13 @@ module SIS_types flux_lh_ocn_top, & !< The upward flux of latent heat at the ocean surface [W m-2]. lprec_ocn_top, & !< The downward flux of liquid precipitation at the ocean surface [kg m-2 s-1]. fprec_ocn_top, & !< The downward flux of frozen precipitation at the ocean surface [kg m-2 s-1]. - flux_u_ocn, & !< The flux of x-momentum into the ocean at locations given by flux_uv_stagger [Pa]. + flux_u_ocn, & !< The flux of x-momentum into the ocean at locations given by + !! flux_uv_stagger [kg m-2 L T-2 ~> Pa]. !! Note that regardless of the staggering, flux_u_ocn is allocated as though on an A-grid. - flux_v_ocn, & !< The flux of y-momentum into the ocean at locations given by flux_uv_stagger [Pa]. + flux_v_ocn, & !< The flux of y-momentum into the ocean at locations given by + !! flux_uv_stagger [kg m-2 L T-2 ~> Pa]. !! Note that regardless of the staggering, flux_v_ocn is allocated as though on an A-grid. - stress_mag, & !< The area-weighted time-mean of the magnitude of the stress on the ocean [Pa]. + stress_mag, & !< The area-weighted time-mean of the magnitude of the stress on the ocean [kg m-2 L T-2 ~> Pa]. melt_nudge, & !< A downward fresh water flux into the ocean that acts to nudge the ocean !! surface salinity to facilitate the retention of sea ice [kg m-2 s-1]. flux_salt, & !< The flux of salt out of the ocean [kg m-2]. @@ -2205,10 +2207,11 @@ end subroutine dealloc_ice_ocean_flux !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Perform checksums on various arrays in an ice_ocean_flux_type. -subroutine IOF_chksum(mesg, IOF, G) +subroutine IOF_chksum(mesg, IOF, G, US) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(ice_ocean_flux_type), intent(in) :: IOF !< The structure whose arrays are being checksummed. type(SIS_hor_grid_type), intent(inout) :: G !< The ice-model's horizonal grid type. + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors call hchksum(IOF%flux_salt, trim(mesg)//" IOF%flux_salt", G%HI) @@ -2219,12 +2222,12 @@ subroutine IOF_chksum(mesg, IOF, G) call hchksum(IOF%flux_sw_ocn, trim(mesg)//" IOF%flux_sw_ocn", G%HI) call hchksum(IOF%lprec_ocn_top, trim(mesg)//" IOF%lprec_ocn_top", G%HI) call hchksum(IOF%fprec_ocn_top, trim(mesg)//" IOF%fprec_ocn_top", G%HI) - call hchksum(IOF%flux_u_ocn, trim(mesg)//" IOF%flux_u_ocn", G%HI) - call hchksum(IOF%flux_v_ocn, trim(mesg)//" IOF%flux_v_ocn", G%HI) + call hchksum(IOF%flux_u_ocn, trim(mesg)//" IOF%flux_u_ocn", G%HI, scale=US%L_T_to_m_s*US%s_to_T) + call hchksum(IOF%flux_v_ocn, trim(mesg)//" IOF%flux_v_ocn", G%HI, scale=US%L_T_to_m_s*US%s_to_T) call hchksum(IOF%pres_ocn_top, trim(mesg)//" IOF%pres_ocn_top", G%HI) call hchksum(IOF%mass_ice_sn_p, trim(mesg)//" IOF%mass_ice_sn_p", G%HI) if (allocated(IOF%stress_mag)) & - call hchksum(IOF%stress_mag, trim(mesg)//" IOF%stress_mag", G%HI) + call hchksum(IOF%stress_mag, trim(mesg)//" IOF%stress_mag", G%HI, scale=US%L_T_to_m_s*US%s_to_T) call hchksum(IOF%Enth_Mass_in_atm, trim(mesg)//" IOF%Enth_Mass_in_atm", G%HI) call hchksum(IOF%Enth_Mass_out_atm, trim(mesg)//" IOF%Enth_Mass_out_atm", G%HI) diff --git a/src/ice_model.F90 b/src/ice_model.F90 index 0b5a207a..c46a8b6a 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -195,7 +195,7 @@ subroutine update_ice_slow_thermo(Ice) if (Ice%sCS%debug) then call Ice_public_type_chksum("Start update_ice_slow_thermo", Ice, check_slow=.true.) call FIA_chksum("Start update_ice_slow_thermo", FIA, sG) - call IOF_chksum("Start update_ice_slow_thermo", Ice%sCS%IOF, sG) + call IOF_chksum("Start update_ice_slow_thermo", Ice%sCS%IOF, sG, US) endif ! Store some diagnostic fluxes... @@ -222,8 +222,8 @@ subroutine update_ice_slow_thermo(Ice) !$OMP parallel do default(none) shared(Ice,sG,i_off,j_off) private(i2,j2) do j=sG%jsc,sG%jec ; do i=sG%isc,sG%iec i2 = i+i_off ; j2 = j+j_off - Ice%sCS%IOF%flux_u_ocn(i,j) = Ice%flux_u(i2,j2) - Ice%sCS%IOF%flux_v_ocn(i,j) = Ice%flux_v(i2,j2) + Ice%sCS%IOF%flux_u_ocn(i,j) = US%m_s_to_L_T*US%T_to_s*Ice%flux_u(i2,j2) + Ice%sCS%IOF%flux_v_ocn(i,j) = US%m_s_to_L_T*US%T_to_s*Ice%flux_v(i2,j2) enddo ; enddo endif @@ -239,14 +239,14 @@ subroutine update_ice_slow_thermo(Ice) if (Ice%sCS%debug) then call Ice_public_type_chksum("Before slow_thermodynamics", Ice, check_slow=.true.) - call IOF_chksum("Before slow_thermodynamics", Ice%sCS%IOF, sG) + call IOF_chksum("Before slow_thermodynamics", Ice%sCS%IOF, sG, US) endif call slow_thermodynamics(sIST, dt_slow, Ice%sCS%slow_thermo_CSp, Ice%sCS%OSS, FIA, & Ice%sCS%XSF, Ice%sCS%IOF, sG, US, sIG) if (Ice%sCS%debug) then call Ice_public_type_chksum("Before set_ocean_top_fluxes", Ice, check_slow=.true.) - call IOF_chksum("Before set_ocean_top_fluxes", Ice%sCS%IOF, sG) + call IOF_chksum("Before set_ocean_top_fluxes", Ice%sCS%IOF, sG, US) call IST_chksum("Before set_ocean_top_fluxes", sIST, sG, US, sIG) endif ! Set up the thermodynamic fluxes in the externally visible structure Ice. @@ -306,7 +306,7 @@ subroutine update_ice_dynamics_trans(Ice, time_step, start_cycle, end_cycle, cyc if (Ice%sCS%debug) then call Ice_public_type_chksum("Before SIS_dynamics_trans", Ice, check_slow=.true.) - call IOF_chksum("Before SIS_dynamics_trans", Ice%sCS%IOF, sG) + call IOF_chksum("Before SIS_dynamics_trans", Ice%sCS%IOF, sG, US) endif do_multi_trans = (present(start_cycle) .or. present(end_cycle) .or. present(cycle_length)) @@ -329,7 +329,7 @@ subroutine update_ice_dynamics_trans(Ice, time_step, start_cycle, end_cycle, cyc ! Set up the stresses and surface pressure in the externally visible structure Ice. if (sIST%valid_IST) call ice_mass_from_IST(sIST, Ice%sCS%IOF, sG, sIG) - call set_ocean_top_dyn_fluxes(Ice, Ice%sCS%IOF, FIA, sG, Ice%sCS) + call set_ocean_top_dyn_fluxes(Ice, Ice%sCS%IOF, FIA, sG, US, Ice%sCS) if (Ice%sCS%debug) then call Ice_public_type_chksum("End update_ice_dynamics_trans", Ice, check_slow=.true.) @@ -554,7 +554,7 @@ subroutine set_ocean_top_fluxes(Ice, IST, IOF, FIA, OSS, G, IG, sCS) if (sCS%debug) then call Ice_public_type_chksum("Start set_ocean_top_fluxes", Ice, check_slow=.true.) - call IOF_chksum("Start set_ocean_top_fluxes", IOF, G) + call IOF_chksum("Start set_ocean_top_fluxes", IOF, G, sCS%US) call FIA_chksum("Start set_ocean_top_fluxes", FIA, G) endif @@ -654,13 +654,14 @@ end subroutine ice_mass_from_IST !> set_ocean_top_dyn_fluxes translates ice-bottom stresses and massfrom the ice !! model's ice-ocean flux type and the fast-ice average type to the public !! ice data type for use by the ocean model. -subroutine set_ocean_top_dyn_fluxes(Ice, IOF, FIA, G, sCS) +subroutine set_ocean_top_dyn_fluxes(Ice, IOF, FIA, G, US, sCS) type(ice_data_type), intent(inout) :: Ice !< The publicly visible ice data type. type(ice_ocean_flux_type), intent(in) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(fast_ice_avg_type), intent(in) :: FIA !< A type containing averages of fields !! (mostly fluxes) over the fast updates type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(SIS_slow_CS), intent(in) :: sCS !< The slow ice control structure real :: I_count @@ -670,7 +671,7 @@ subroutine set_ocean_top_dyn_fluxes(Ice, IOF, FIA, G, sCS) if (sCS%debug) then call Ice_public_type_chksum("Start set_ocean_top_dyn_fluxes", Ice, check_slow=.true.) - call IOF_chksum("Start set_ocean_top_dyn_fluxes", IOF, G) + call IOF_chksum("Start set_ocean_top_dyn_fluxes", IOF, G, US) endif ! Sum the concentration weighted mass. @@ -697,8 +698,8 @@ subroutine set_ocean_top_dyn_fluxes(Ice, IOF, FIA, G, sCS) !$OMP parallel do default(shared) private(i2,j2) do j=jsc,jec ; do i=isc,iec i2 = i+i_off ; j2 = j+j_off! Use these to correct for indexing differences. - Ice%flux_u(i2,j2) = IOF%flux_u_ocn(i,j) - Ice%flux_v(i2,j2) = IOF%flux_v_ocn(i,j) + Ice%flux_u(i2,j2) = US%L_T_to_m_s*US%s_to_T*IOF%flux_u_ocn(i,j) + Ice%flux_v(i2,j2) = US%L_T_to_m_s*US%s_to_T*IOF%flux_v_ocn(i,j) if (IOF%slp2ocean) then Ice%p_surf(i2,j2) = FIA%p_atm_surf(i,j) - 1e5 ! SLP - 1 std. atmosphere [Pa]. @@ -711,7 +712,7 @@ subroutine set_ocean_top_dyn_fluxes(Ice, IOF, FIA, G, sCS) i_off = LBOUND(Ice%stress_mag,1) - G%isc ; j_off = LBOUND(Ice%stress_mag,2) - G%jsc !$OMP parallel do default(shared) private(i2,j2) do j=jsc,jec ; do i=isc,iec ; i2 = i+i_off ; j2 = j+j_off - Ice%stress_mag(i2,j2) = IOF%stress_mag(i,j) + Ice%stress_mag(i2,j2) = US%L_T_to_m_s*US%s_to_T*IOF%stress_mag(i,j) enddo ; enddo endif diff --git a/src/specified_ice.F90 b/src/specified_ice.F90 index b3a9ef38..a0153f51 100644 --- a/src/specified_ice.F90 +++ b/src/specified_ice.F90 @@ -83,7 +83,7 @@ subroutine specified_ice_dynamics(IST, OSS, FIA, IOF, dt_slow, CS, G, US, IG) CS%n_calls = CS%n_calls + 1 IOF%stress_count = 0 - call set_ocean_top_stress_FIA(FIA, IOF, G) + call set_ocean_top_stress_FIA(FIA, IOF, G, US) ! Set appropriate surface quantities in categories with no ice. if (allocated(IST%t_surf)) then @@ -111,16 +111,17 @@ end subroutine specified_ice_dynamics !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Calculate the stresses on the ocean integrated across all the thickness categories !! with the appropriate staggering, based on the information in a fast_ice_avg_type. -subroutine set_ocean_top_stress_FIA(FIA, IOF, G) +subroutine set_ocean_top_stress_FIA(FIA, IOF, G, US) type(fast_ice_avg_type), intent(inout) :: FIA !< A type containing averages of fields !! (mostly fluxes) over the fast updates type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to !! the ocean that are calculated by the ice model. type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors real :: ps_ice, ps_ocn ! ice_free and ice_cover interpolated to a velocity point [nondim]. real :: wt_prev, wt_now ! Relative weights of the previous average and the current step [nondim]. - real :: taux2, tauy2 ! squared wind stresses [Pa2] + real :: taux2, tauy2 ! squared wind stresses [kg2 m-4 L2 T-4 ~> Pa2] integer :: i, j, k, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -139,9 +140,9 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G) do j=jsc,jec ; do i=isc,iec ps_ocn = G%mask2dT(i,j) * FIA%ice_free(i,j) ps_ice = G%mask2dT(i,j) * FIA%ice_cover(i,j) - IOF%flux_u_ocn(i,j) = wt_prev * IOF%flux_u_ocn(i,j) + wt_now * & + IOF%flux_u_ocn(i,j) = wt_prev * IOF%flux_u_ocn(i,j) + wt_now * US%m_s_to_L_T*US%T_to_s* & (ps_ocn * FIA%WindStr_ocn_x(i,j) + ps_ice * FIA%WindStr_x(i,j)) - IOF%flux_v_ocn(i,j) = wt_prev * IOF%flux_v_ocn(i,j) + wt_now * & + IOF%flux_v_ocn(i,j) = wt_prev * IOF%flux_v_ocn(i,j) + wt_now * US%m_s_to_L_T*US%T_to_s* & (ps_ocn * FIA%WindStr_ocn_y(i,j) + ps_ice * FIA%WindStr_y(i,j)) if (allocated(IOF%stress_mag)) & IOF%stress_mag(i,j) = wt_prev * IOF%stress_mag(i,j) + wt_now * & @@ -157,12 +158,12 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G) ps_ice = 0.25 * ((FIA%ice_cover(i+1,j+1) + FIA%ice_cover(i,j)) + & (FIA%ice_cover(i+1,j) + FIA%ice_cover(i,j+1)) ) endif - IOF%flux_u_ocn(I,J) = wt_prev * IOF%flux_u_ocn(I,J) + wt_now * & + IOF%flux_u_ocn(I,J) = wt_prev * IOF%flux_u_ocn(I,J) + wt_now * US%m_s_to_L_T*US%T_to_s* & (ps_ocn * 0.25 * ((FIA%WindStr_ocn_x(i,j) + FIA%WindStr_ocn_x(i+1,j+1)) + & (FIA%WindStr_ocn_x(i,j+1) + FIA%WindStr_ocn_x(i+1,j))) + & ps_ice * 0.25 * ((FIA%WindStr_x(i,j) + FIA%WindStr_x(i+1,j+1)) + & (FIA%WindStr_x(i,j+1) + FIA%WindStr_x(i+1,J))) ) - IOF%flux_v_ocn(I,J) = wt_prev * IOF%flux_v_ocn(I,J) + wt_now * & + IOF%flux_v_ocn(I,J) = wt_prev * IOF%flux_v_ocn(I,J) + wt_now * US%m_s_to_L_T*US%T_to_s* & (ps_ocn * 0.25 * ((FIA%WindStr_ocn_y(i,j) + FIA%WindStr_ocn_y(i+1,j+1)) + & (FIA%WindStr_ocn_y(i,j+1) + FIA%WindStr_ocn_y(i+1,j))) + & ps_ice * 0.25 * ((FIA%WindStr_y(i,j) + FIA%WindStr_y(i+1,j+1)) + & @@ -189,7 +190,7 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G) ps_ocn = 0.5*(FIA%ice_free(i+1,j) + FIA%ice_free(i,j)) ps_ice = 0.5*(FIA%ice_cover(i+1,j) + FIA%ice_cover(i,j)) endif - IOF%flux_u_ocn(I,j) = wt_prev * IOF%flux_u_ocn(I,j) + wt_now * & + IOF%flux_u_ocn(I,j) = wt_prev * IOF%flux_u_ocn(I,j) + wt_now * US%m_s_to_L_T*US%T_to_s* & (ps_ocn * 0.5 * (FIA%WindStr_ocn_x(i+1,j) + FIA%WindStr_ocn_x(i,j)) + & ps_ice * 0.5 * (FIA%WindStr_x(i+1,j) + FIA%WindStr_x(i,j)) ) enddo ; enddo @@ -200,7 +201,7 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G) ps_ocn = 0.5*(FIA%ice_free(i,j+1) + FIA%ice_free(i,j)) ps_ice = 0.5*(FIA%ice_cover(i,j+1) + FIA%ice_cover(i,j)) endif - IOF%flux_v_ocn(i,J) = wt_prev * IOF%flux_v_ocn(i,J) + wt_now * & + IOF%flux_v_ocn(i,J) = wt_prev * IOF%flux_v_ocn(i,J) + wt_now * US%m_s_to_L_T*US%T_to_s* & (ps_ocn * 0.5 * (FIA%WindStr_ocn_y(i,j+1) + FIA%WindStr_ocn_y(i,j)) + & ps_ice * 0.5 * (FIA%WindStr_y(i,j+1) + FIA%WindStr_y(i,j)) ) enddo ; enddo From 53217dc0557d5748722936f78ed738d0089c9cf6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 7 Nov 2019 16:07:46 -0500 Subject: [PATCH 21/24] +Rescaled some internal timestep variables Rescaled some internal timestep variables for dimensional consistency testing and pass timesteps to ice_cat_transport in [T}. All answers are bitwise identical. --- src/SIS_dyn_trans.F90 | 44 ++++++++++++++++++++++--------------------- src/SIS_transport.F90 | 4 ++-- 2 files changed, 25 insertions(+), 23 deletions(-) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 9ff182b5..e90638ea 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -326,8 +326,8 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U real :: ps_vel ! The fractional thickness catetory coverage at a velocity point. type(time_type) :: Time_cycle_start ! The model's time at the start of an advective cycle. - real :: dt_slow_dyn ! The slow dynamics timestep [s]. - real :: dt_adv ! The advective timestep [s]. + real :: dt_slow_dyn ! The slow dynamics timestep [T ~> s]. + real :: dt_slow_dyn_sec ! The slow dynamics timestep [s]. real :: dt_adv_cycle ! The length of the advective cycle timestep [s]. real :: wt_new, wt_prev ! Weights in an average. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -360,8 +360,8 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if ((CS%dt_ice_dyn > 0.0) .and. (CS%dt_ice_dyn < dt_adv_cycle)) & ndyn_steps = max(CEILING(dt_adv_cycle/CS%dt_ice_dyn - 1e-6), 1) - dt_slow_dyn = dt_adv_cycle / real(ndyn_steps) - dt_adv = dt_slow_dyn / real(CS%adv_substeps) + dt_slow_dyn_sec = dt_adv_cycle / real(ndyn_steps) + dt_slow_dyn = US%s_to_T*dt_slow_dyn_sec do nac=1,nadv_cycle Time_cycle_start = CS%Time - real_to_time((nadv_cycle-(nac-1))*dt_adv_cycle) @@ -412,7 +412,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U ! Dynamics - update ice velocities. ! - call enable_SIS_averaging(dt_slow_dyn, Time_cycle_start + real_to_time(nds*dt_slow_dyn), CS%diag) + call enable_SIS_averaging(dt_slow_dyn_sec, Time_cycle_start + real_to_time(nds*dt_slow_dyn_sec), CS%diag) ! In the dynamics code, only the ice velocities are changed, and the ice-ocean ! stresses are calculated. The gravity wave dynamics (i.e. the continuity @@ -450,11 +450,11 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U if (CS%Warsaw_sum_order) then call SIS_C_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) else call SIS_C_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_C, IST%v_ice_C, & OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) endif call mpp_clock_end(iceClocka) @@ -510,12 +510,12 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U call SIS_B_dynamics(1.0-ice_free(:,:), misp_sum, mi_sum, IST%u_ice_B, IST%v_ice_B, & OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), US%s_to_T*dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) else call SIS_B_dynamics(ice_cover, misp_sum, mi_sum, IST%u_ice_B, IST%v_ice_B, & OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), US%s_to_T*dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) endif call mpp_clock_end(iceClocka) @@ -578,7 +578,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, U call mpp_clock_begin(iceClock8) ! The code timed by iceClock8 is the non-merged_cont equivalent to complete_IST_transport. if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G, scale=US%L_T_to_m_s) - call enable_SIS_averaging(dt_slow_dyn, Time_cycle_start + real_to_time(nds*dt_slow_dyn), CS%diag) + call enable_SIS_averaging(dt_slow_dyn_sec, Time_cycle_start + real_to_time(nds*dt_slow_dyn_sec), CS%diag) call ice_cat_transport(CS%CAS, IST%TrReg, dt_slow_dyn, CS%adv_substeps, G, US, IG, CS%SIS_transport_CSp, & uc=IST%u_ice_C, vc=IST%v_ice_C) @@ -717,7 +717,7 @@ subroutine complete_IST_transport(DS2d, CAS, IST, dt_adv_cycle, G, US, IG, CS) call mpp_clock_begin(iceClock8) ! Do the transport of mass and tracers by category and vertical layer. - call ice_cat_transport(CS%CAS, IST%TrReg, dt_adv_cycle, DS2d%nts, G, US, IG, & + call ice_cat_transport(CS%CAS, IST%TrReg, US%s_to_T*dt_adv_cycle, DS2d%nts, G, US, IG, & CS%SIS_transport_CSp, mca_tot=DS2d%mca_step(:,:,0:DS2d%nts), & uh_tot=DS2d%uh_step(:,:,1:DS2d%nts), vh_tot=DS2d%vh_step(:,:,1:DS2d%nts)) ! Convert the cell-averaged state back to the ice-state type, adjusting the @@ -908,8 +908,9 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, real :: ps_vel ! The fractional thickness catetory coverage at a velocity point. real :: wt_new, wt_prev ! Weights in an average. - real :: dt_slow_dyn ! The slow dynamics timestep [s]. - real :: dt_adv ! The advective subcycle timestep [s]. + real :: dt_slow_dyn ! The slow dynamics timestep [T ~> s]. + real :: dt_slow_dyn_sec ! The slow dynamics timestep [s]. + real :: dt_adv ! The advective subcycle timestep [T ~> s]. logical :: continuing_call ! If true, there are more in the series of advective updates ! after this call. integer :: ndyn_steps, nds ! The number of dynamic steps in this call. @@ -922,7 +923,8 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, ndyn_steps = 1 if ((CS%dt_ice_dyn > 0.0) .and. (CS%dt_ice_dyn < dt_cycle)) & ndyn_steps = max(CEILING(dt_cycle/CS%dt_ice_dyn - 1e-6), 1) - dt_slow_dyn = dt_cycle / ndyn_steps + dt_slow_dyn_sec = dt_cycle / ndyn_steps + dt_slow_dyn = US%s_to_T*dt_slow_dyn_sec dt_adv = dt_slow_dyn / real(CS%adv_substeps) if (ndyn_steps*CS%adv_substeps > DS2d%max_nts) & call increase_max_tracer_step_memory(DS2d, G, ndyn_steps*CS%adv_substeps) @@ -930,7 +932,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, do nds=1,ndyn_steps call mpp_clock_begin(iceClock4) - call enable_SIS_averaging(dt_slow_dyn, Time_start + real_to_time(nds*dt_slow_dyn), CS%diag) + call enable_SIS_averaging(dt_slow_dyn_sec, Time_start + real_to_time(nds*dt_slow_dyn_sec), CS%diag) do j=jsd,jed ; do i=isd,ied ; ice_free(i,j) = max(1.0 - DS2d%ice_cover(i,j), 0.0) ; enddo ; enddo ! In the dynamics code, only the ice velocities are changed, and the ice-ocean @@ -964,7 +966,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, if (CS%do_ridging) rdg_rate(:,:) = 0.0 call SIS_C_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_C, DS2d%v_ice_C, & OSS%u_ocn_C, OSS%v_ocn_C, WindStr_x_Cu, WindStr_y_Cv, OSS%sea_lev, & - str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, US%s_to_T*dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) + str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, dt_slow_dyn, G, US, CS%SIS_C_dyn_CSp) call mpp_clock_end(iceClocka) @@ -1014,7 +1016,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, OSS%u_ocn_B, OSS%v_ocn_B, & WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & - rdg_rate(isc:iec,jsc:jec), US%s_to_T*dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) + rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) call mpp_clock_end(iceClocka) if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, G, scale=US%L_T_to_m_s) @@ -1064,7 +1066,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, endif if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G, scale=US%L_T_to_m_s) - call enable_SIS_averaging(dt_slow_dyn, Time_start + real_to_time(nds*dt_slow_dyn), CS%diag) + call enable_SIS_averaging(dt_slow_dyn_sec, Time_start + real_to_time(nds*dt_slow_dyn_sec), CS%diag) ! Update the integrated ice mass and store the transports in each step. if (DS2d%nts+CS%adv_substeps > DS2d%max_nts) & @@ -1075,9 +1077,9 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, ! Some of the work is not needed for the last step before cat_ice_transport. call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, & DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & - DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), US%s_to_T*dt_adv, G, US, IG, & + DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, & CS%continuity_CSp, h_ice=DS2d%mi_sum) - call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, US%s_to_T*dt_adv, & + call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, dt_adv, & G, US, IG, CS%cover_trans_CSp) call pass_var(DS2d%mi_sum, G%Domain, complete=.false.) call pass_var(DS2d%ice_cover, G%Domain, complete=.false.) @@ -1085,7 +1087,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, else call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, & DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & - DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), US%s_to_T*dt_adv, G, US, IG, CS%continuity_CSp) + DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp) endif enddo DS2d%nts = DS2d%nts + CS%adv_substeps diff --git a/src/SIS_transport.F90 b/src/SIS_transport.F90 index 2ed3d035..488f4f95 100644 --- a/src/SIS_transport.F90 +++ b/src/SIS_transport.F90 @@ -113,7 +113,7 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type type(SIS_tracer_registry_type), pointer :: TrReg !< The registry of SIS ice and snow tracers. real, intent(in) :: dt_slow !< The amount of time over which the - !! ice dynamics are to be advanced [s]. + !! ice dynamics are to be advanced [T ~> s]. integer, intent(in) :: nsteps !< The number of advective iterations !! to use within this time step. type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors @@ -165,7 +165,7 @@ subroutine ice_cat_transport(CAS, TrReg, dt_slow, nsteps, G, US, IG, CS, uc, vc, ! Do the transport via the continuity equations and tracer conservation equations ! for CAS%mH_ice and tracers, inverting for the fractional size of each partition. - if (nsteps > 0) dt_adv = US%s_to_T*dt_slow / real(nsteps) + if (nsteps > 0) dt_adv = dt_slow / real(nsteps) do n = 1, nsteps call update_SIS_tracer_halos(TrReg, G, complete=.false.) call pass_var(CAS%m_ice, G%Domain, complete=.false.) From 132a1c646920706b31e70e73e684c80453a30c95 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Nov 2019 10:33:43 -0500 Subject: [PATCH 22/24] Code rescaling simplification and clean-up Rescaled the units of the local windstress variables in the set_wind_stresses routines. Simplified the sea-ice rolling expressions, including adding a commented out simpler alternative that could change answers at roundoff. Added a simpler scaling factor in set_ocean_top_stress_FIA. Added explicit variables to hold arguments to icebergs_run to avoid doing array syntax whole-array multiplication in arguments. All answers are bitwise identical. --- src/SIS_dyn_trans.F90 | 121 +++++++++++++++++++++++++----------------- src/SIS_transport.F90 | 22 ++++---- src/specified_ice.F90 | 18 ++++--- 3 files changed, 94 insertions(+), 67 deletions(-) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index e90638ea..ab05ce3f 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -210,6 +210,17 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, US, IG, real, dimension(G%isc:G%iec, G%jsc:G%jec) :: & windstr_x, & ! The area-weighted average ice thickness [Pa]. windstr_y ! The area-weighted average ice thickness [Pa]. + real, dimension(G%isc-2:G%iec+1, G%jsc-1:G%jec+1) :: & + u_ice_C, & ! The C-grid zonal ice velocity [m s-1]. + u_ocn_C ! The C-grid zonal ocean velocity [m s-1]. + real, dimension(G%isc-1:G%iec+1, G%jsc-2:G%jec+1) :: & + v_ice_C, & ! The C-grid meridional ice velocity [m s-1]. + v_ocn_C ! The C-grid meridional ocean velocity [m s-1]. + real, dimension(G%isc-1:G%iec+1, G%jsc-1:G%jec+1) :: & + u_ice_B, & ! The B-grid zonal ice velocity [m s-1]. + u_ocn_B, & ! The B-grid zonal ocean velocity [m s-1]. + v_ice_B, & ! The B-grid meridional ice velocity [m s-1]. + v_ocn_B ! The B-grid meridional ocean velocity [m s-1]. real :: rho_ice ! The nominal density of sea ice [kg m-3]. real :: H_to_m_ice ! The specific volume of ice times the conversion factor ! from thickness units [m H-1 ~> m3]. @@ -242,21 +253,27 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, US, IG, endif if (IST%Cgrid_dyn) then - call icebergs_run( icebergs_CS, CS%Time, & - FIA%calving(isc:iec,jsc:jec), US%L_T_to_m_s*OSS%u_ocn_C(isc-2:iec+1,jsc-1:jec+1), & - US%L_T_to_m_s*OSS%v_ocn_C(isc-1:iec+1,jsc-2:jec+1), US%L_T_to_m_s*IST%u_ice_C(isc-2:iec+1,jsc-1:jec+1), & - US%L_T_to_m_s*IST%v_ice_C(isc-1:iec+1,jsc-2:jec+1), windstr_x, windstr_y, & - OSS%sea_lev(isc-1:iec+1,jsc-1:jec+1), OSS%SST_C(isc:iec,jsc:jec), & + do j=jsc-1,jec+1 ; do I=isc-2,iec+1 + u_ice_C(I,j) = US%L_T_to_m_s*IST%u_ice_C(I,j) ; u_ocn_C(I,j) = US%L_T_to_m_s*OSS%u_ocn_C(I,j) + enddo ; enddo + do J=jsc-2,jec+1 ; do i=isc-1,iec+1 + v_ice_C(i,J) = US%L_T_to_m_s*IST%v_ice_C(i,J) ; v_ocn_C(i,J) = US%L_T_to_m_s*OSS%v_ocn_C(i,J) + enddo ; enddo + call icebergs_run( icebergs_CS, CS%Time, FIA%calving(isc:iec,jsc:jec), & + u_ocn_C, v_ocn_C, u_ice_C, v_ice_C, windstr_x, windstr_y, & + OSS%sea_lev(isc-1:iec+1,jsc-1:jec+1), OSS%SST_C(isc:iec,jsc:jec), & FIA%calving_hflx(isc:iec,jsc:jec), FIA%ice_cover(isc-1:iec+1,jsc-1:jec+1), & hi_avg(isc-1:iec+1,jsc-1:jec+1), stagger=CGRID_NE, & stress_stagger=stress_stagger, sss=OSS%s_surf(isc:iec,jsc:jec), & mass_berg=IOF%mass_berg, ustar_berg=IOF%ustar_berg, & area_berg=IOF%area_berg ) else - call icebergs_run( icebergs_CS, CS%Time, & - FIA%calving(isc:iec,jsc:jec), US%L_T_to_m_s*OSS%u_ocn_B(isc-1:iec+1,jsc-1:jec+1), & - US%L_T_to_m_s*OSS%v_ocn_B(isc-1:iec+1,jsc-1:jec+1), US%L_T_to_m_s*IST%u_ice_B(isc-1:iec+1,jsc-1:jec+1), & - US%L_T_to_m_s*IST%v_ice_B(isc-1:iec+1,jsc-1:jec+1), windstr_x, windstr_y, & + do J=jsc-1,jec+1 ; do I=isc-1,iec+1 + u_ice_B(I,J) = US%L_T_to_m_s*IST%u_ice_B(I,J) ; u_ocn_B(I,J) = US%L_T_to_m_s*OSS%u_ocn_B(I,J) + v_ice_B(I,J) = US%L_T_to_m_s*IST%v_ice_B(I,J) ; v_ocn_B(I,J) = US%L_T_to_m_s*OSS%v_ocn_B(I,J) + enddo ; enddo + call icebergs_run( icebergs_CS, CS%Time, FIA%calving(isc:iec,jsc:jec), & + u_ocn_B, v_ocn_B, u_ice_B, v_ice_B, windstr_x, windstr_y, & OSS%sea_lev(isc-1:iec+1,jsc-1:jec+1), OSS%SST_C(isc:iec,jsc:jec), & FIA%calving_hflx(isc:iec,jsc:jec), FIA%ice_cover(isc-1:iec+1,jsc-1:jec+1), & hi_avg(isc-1:iec+1,jsc-1:jec+1), stagger=BGRID_NE, & @@ -1875,11 +1892,12 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & WindStr_x_A, & ! Zonal (_x_) and meridional (_y_) wind stresses - WindStr_y_A, & ! averaged over the ice categories on an A-grid [Pa]. + WindStr_y_A, & ! averaged over the ice categories on an A-grid [kg m-2 L T-2 ~> Pa]. WindStr_x_ocn_A, & ! Zonal (_x_) and meridional (_y_) wind stresses on the - WindStr_y_ocn_A ! ice-free ocean on an A-grid [Pa]. - real :: weights ! A sum of the weights around a point. - real :: I_wts ! 1.0 / wts or 0 if wts is 0 [nondim]. + WindStr_y_ocn_A ! ice-free ocean on an A-grid [kg m-2 L T-2 ~> Pa]. + real :: weights ! A sum of the weights around a point. + real :: stress_scale ! A unit rescaling factor from the FIA stresses to the IOF stresses. + real :: I_wts ! 1.0 / wts or 0 if wts is 0 [nondim]. real :: FIA_ice_cover, ice_cover_now integer :: i, j, isc, iec, jsc, jec integer :: isd, ied, jsd, jed @@ -1887,6 +1905,8 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + stress_scale = US%m_s_to_L_T*US%T_to_s + !$OMP parallel do default(shared) private(FIA_ice_cover, ice_cover_now) do j=jsd,jed ; do i=isd,ied ! The use of these limits prevents the use of the ocean wind stresses if @@ -1897,23 +1917,23 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y FIA_ice_cover = min(FIA%ice_cover(i,j), max_ice_cover) if (ice_cover_now > FIA_ice_cover) then - WindStr_x_A(i,j) = ((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_x(i,j) + & - FIA_ice_cover*FIA%WindStr_x(i,j)) / ice_cover_now - WindStr_y_A(i,j) = ((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_y(i,j) + & - FIA_ice_cover*FIA%WindStr_y(i,j)) / ice_cover_now + WindStr_x_A(i,j) = stress_scale*((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_x(i,j) + & + FIA_ice_cover*FIA%WindStr_x(i,j)) / ice_cover_now + WindStr_y_A(i,j) = stress_scale*((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_y(i,j) + & + FIA_ice_cover*FIA%WindStr_y(i,j)) / ice_cover_now else - WindStr_x_A(i,j) = FIA%WindStr_x(i,j) - WindStr_y_A(i,j) = FIA%WindStr_y(i,j) + WindStr_x_A(i,j) = stress_scale*FIA%WindStr_x(i,j) + WindStr_y_A(i,j) = stress_scale*FIA%WindStr_y(i,j) endif if (ice_free(i,j) <= FIA%ice_free(i,j)) then - WindStr_x_ocn_A(i,j) = FIA%WindStr_ocn_x(i,j) - WindStr_y_ocn_A(i,j) = FIA%WindStr_ocn_y(i,j) + WindStr_x_ocn_A(i,j) = stress_scale*FIA%WindStr_ocn_x(i,j) + WindStr_y_ocn_A(i,j) = stress_scale*FIA%WindStr_ocn_y(i,j) else - WindStr_x_ocn_A(i,j) = ((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_x(i,j) + & - FIA%ice_free(i,j)*FIA%WindStr_ocn_x(i,j)) / ice_free(i,j) - WindStr_y_ocn_A(i,j) = ((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_y(i,j) + & - FIA%ice_free(i,j)*FIA%WindStr_ocn_y(i,j)) / ice_free(i,j) + WindStr_x_ocn_A(i,j) = stress_scale*((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_x(i,j) + & + FIA%ice_free(i,j)*FIA%WindStr_ocn_x(i,j)) / ice_free(i,j) + WindStr_y_ocn_A(i,j) = stress_scale*((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_y(i,j) + & + FIA%ice_free(i,j)*FIA%WindStr_ocn_y(i,j)) / ice_free(i,j) endif enddo ; enddo @@ -1924,7 +1944,7 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y do j=jsc-1,jec+1 ; do I=isc-1,iec weights = (G%areaT(i,j)*ice_cover(i,j) + G%areaT(i+1,j)*ice_cover(i+1,j)) if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_x_Cu(I,j) = G%mask2dCu(I,j) * US%m_s_to_L_T*US%T_to_s* & + WindStr_x_Cu(I,j) = G%mask2dCu(I,j) * & (G%areaT(i,j) * ice_cover(i,j) * WindStr_x_A(i,j) + & G%areaT(i+1,j)*ice_cover(i+1,j)*WindStr_x_A(i+1,j)) * I_wts else @@ -1933,7 +1953,7 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y weights = (G%areaT(i,j)*ice_free(i,j) + G%areaT(i+1,j)*ice_free(i+1,j)) if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_x_ocn_Cu(I,j) = G%mask2dCu(I,j) * US%m_s_to_L_T*US%T_to_s* & + WindStr_x_ocn_Cu(I,j) = G%mask2dCu(I,j) * & (G%areaT(i,j) * ice_free(i,j) * WindStr_x_ocn_A(i,j) + & G%areaT(i+1,j)*ice_free(i+1,j)*WindStr_x_ocn_A(i+1,j)) * I_wts else @@ -1945,7 +1965,7 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y do J=jsc-1,jec ; do i=isc-1,iec+1 weights = (G%areaT(i,j)*ice_cover(i,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) if (G%mask2dCv(i,J) * weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_y_Cv(i,J) = G%mask2dCv(i,J) * US%m_s_to_L_T*US%T_to_s* & + WindStr_y_Cv(i,J) = G%mask2dCv(i,J) * & (G%areaT(i,j) * ice_cover(i,j) * WindStr_y_A(i,j) + & G%areaT(i,j+1)*ice_cover(i,j+1)*WindStr_y_A(i,j+1)) * I_wts else @@ -1954,7 +1974,7 @@ subroutine set_wind_stresses_C(FIA, ice_cover, ice_free, WindStr_x_Cu, WindStr_y weights = (G%areaT(i,j)*ice_free(i,j) + G%areaT(i,j+1)*ice_free(i,j+1)) if (weights > 0.0) then ; I_wts = 1.0 / weights - WindStr_y_ocn_Cv(i,J) = G%mask2dCv(i,J) * US%m_s_to_L_T*US%T_to_s* & + WindStr_y_ocn_Cv(i,J) = G%mask2dCv(i,J) * & (G%areaT(i,j) * ice_free(i,j) * WindStr_y_ocn_A(i,j) + & G%areaT(i,j+1)*ice_free(i,j+1)*WindStr_y_ocn_A(i,j+1)) * I_wts else @@ -1991,11 +2011,12 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & WindStr_x_A, & ! Zonal (_x_) and meridional (_y_) wind stresses - WindStr_y_A, & ! averaged over the ice categories on an A-grid [Pa]. + WindStr_y_A, & ! averaged over the ice categories on an A-grid [kg m-2 L T-2 ~> Pa]. WindStr_x_ocn_A, & ! Zonal (_x_) and meridional (_y_) wind stresses on the - WindStr_y_ocn_A ! ice-free ocean on an A-grid [Pa]. - real :: weights ! A sum of the weights around a point. - real :: I_wts ! 1.0 / wts or 0 if wts is 0 [nondim]. + WindStr_y_ocn_A ! ice-free ocean on an A-grid [kg m-2 L T-2 ~> Pa]. + real :: weights ! A sum of the weights around a point. + real :: stress_scale ! A unit rescaling factor from the FIA stresses to the IOF stresses. + real :: I_wts ! 1.0 / wts or 0 if wts is 0 [nondim]. real :: FIA_ice_cover, ice_cover_now integer :: i, j, isc, iec, jsc, jec integer :: isd, ied, jsd, jed @@ -2003,6 +2024,8 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + stress_scale = US%m_s_to_L_T*US%T_to_s + !$OMP parallel do default(shared) private(FIA_ice_cover, ice_cover_now) do j=jsd,jed ; do i=isd,ied ! The use of these limits prevents the use of the ocean wind stresses if @@ -2013,23 +2036,23 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ FIA_ice_cover = min(FIA%ice_cover(i,j), max_ice_cover) if (ice_cover_now > FIA_ice_cover) then - WindStr_x_A(i,j) = ((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_x(i,j) + & - FIA_ice_cover*FIA%WindStr_x(i,j)) / ice_cover_now - WindStr_y_A(i,j) = ((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_y(i,j) + & - FIA_ice_cover*FIA%WindStr_y(i,j)) / ice_cover_now + WindStr_x_A(i,j) = stress_scale*((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_x(i,j) + & + FIA_ice_cover*FIA%WindStr_x(i,j)) / ice_cover_now + WindStr_y_A(i,j) = stress_scale*((ice_cover_now-FIA_ice_cover)*FIA%WindStr_ocn_y(i,j) + & + FIA_ice_cover*FIA%WindStr_y(i,j)) / ice_cover_now else - WindStr_x_A(i,j) = FIA%WindStr_x(i,j) - WindStr_y_A(i,j) = FIA%WindStr_y(i,j) + WindStr_x_A(i,j) = stress_scale*FIA%WindStr_x(i,j) + WindStr_y_A(i,j) = stress_scale*FIA%WindStr_y(i,j) endif if (ice_free(i,j) <= FIA%ice_free(i,j)) then - WindStr_x_ocn_A(i,j) = FIA%WindStr_ocn_x(i,j) - WindStr_y_ocn_A(i,j) = FIA%WindStr_ocn_y(i,j) + WindStr_x_ocn_A(i,j) = stress_scale*FIA%WindStr_ocn_x(i,j) + WindStr_y_ocn_A(i,j) = stress_scale*FIA%WindStr_ocn_y(i,j) else - WindStr_x_ocn_A(i,j) = ((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_x(i,j) + & - FIA%ice_free(i,j)*FIA%WindStr_ocn_x(i,j)) / ice_free(i,j) - WindStr_y_ocn_A(i,j) = ((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_y(i,j) + & - FIA%ice_free(i,j)*FIA%WindStr_ocn_y(i,j)) / ice_free(i,j) + WindStr_x_ocn_A(i,j) = stress_scale*((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_x(i,j) + & + FIA%ice_free(i,j)*FIA%WindStr_ocn_x(i,j)) / ice_free(i,j) + WindStr_y_ocn_A(i,j) = stress_scale*((ice_free(i,j)-FIA%ice_free(i,j))*FIA%WindStr_y(i,j) + & + FIA%ice_free(i,j)*FIA%WindStr_ocn_y(i,j)) / ice_free(i,j) endif enddo ; enddo @@ -2038,12 +2061,12 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ weights = ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1) + G%areaT(i,j)*ice_cover(i,j)) + & (G%areaT(i+1,j)*ice_cover(i+1,j) + G%areaT(i,j+1)*ice_cover(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & + WindStr_x_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_x_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_x_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_x_A(i+1,j) + & G%areaT(i,j+1) * ice_cover(i,j+1) * WindStr_x_A(i,j+1)) ) * I_wts - WindStr_y_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & + WindStr_y_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_cover(i+1,j+1)*WindStr_y_A(i+1,j+1) + & G%areaT(i,j) * ice_cover(i,j) * WindStr_y_A(i,j)) + & (G%areaT(i+1,j) * ice_cover(i+1,j) * WindStr_y_A(i+1,j) + & @@ -2053,12 +2076,12 @@ subroutine set_wind_stresses_B(FIA, ice_cover, ice_free, WindStr_x_B, WindStr_y_ weights = ((G%areaT(i+1,j+1)*ice_free(i+1,j+1) + G%areaT(i,j)*ice_free(i,j)) + & (G%areaT(i+1,j)*ice_free(i+1,j) + G%areaT(i,j+1)*ice_free(i,j+1)) ) I_wts = 0.0 ; if (weights > 0.0) I_wts = 1.0 / weights - WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & + WindStr_x_ocn_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_x_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_x_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_x_ocn_A(i+1,j) + & G%areaT(i,j+1) * ice_free(i,j+1) * WindStr_x_ocn_A(i,j+1)) ) * I_wts - WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) * US%m_s_to_L_T*US%T_to_s* & + WindStr_y_ocn_B(I,J) = G%mask2dBu(I,J) * & ((G%areaT(i+1,j+1)*ice_free(i+1,j+1)*WindStr_y_ocn_A(i+1,j+1) + & G%areaT(i,j) * ice_free(i,j) * WindStr_y_ocn_A(i,j)) + & (G%areaT(i+1,j) * ice_free(i+1,j) * WindStr_y_ocn_A(i+1,j) + & diff --git a/src/SIS_transport.F90 b/src/SIS_transport.F90 index 488f4f95..c266b5ae 100644 --- a/src/SIS_transport.F90 +++ b/src/SIS_transport.F90 @@ -474,6 +474,7 @@ subroutine cell_ave_state_to_ice_state(CAS, G, US, IG, CS, IST, TrReg) ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: ice_cover ! The summed fractional ice concentration [nondim]. real :: mass_neglect ! A negligible mass per unit area [H ~> kg m-2]. + real :: L_to_H integer :: i, j, k, isc, iec, jsc, jec, nCat isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nCat = IG%CatIce @@ -487,20 +488,21 @@ subroutine cell_ave_state_to_ice_state(CAS, G, US, IG, CS, IST, TrReg) ! Convert CAS%m_ice and CAS%m_snow back to IST%part_size and IST%mH_snow. ice_cover(:,:) = 0.0 + L_to_H = US%L_to_m * CS%Rho_ice * IG%kg_m2_to_H !$OMP parallel do default(shared) do j=jsc,jec ; do k=1,nCat ; do i=isc,iec if (CAS%m_ice(i,j,k) > 0.0) then - if (CS%roll_factor * (CAS%mH_ice(i,j,k)*IG%H_to_kg_m2/CS%Rho_Ice)**3 > & - (CAS%m_ice(i,j,k)*IG%H_to_kg_m2/CS%Rho_Ice)*US%L_to_m**2*G%areaT(i,j)) then - ! This ice is thicker than it is wide even if all the ice in a grid - ! cell is collected into a single cube, so it will roll. Any snow on - ! top will simply be redistributed into a thinner layer, although it - ! should probably be dumped into the ocean. Rolling makes the ice - ! thinner so that it melts faster, but it should never be made thinner + !### This is a simplified version of the test, but it could rarely change answers at roundoff. + ! if (CS%roll_factor * CAS%mH_ice(i,j,k)**3 > L_to_H**2 * (CAS%m_ice(i,j,k)*G%areaT(i,j))) then + if (CS%roll_factor * (CAS%mH_ice(i,j,k)*IG%H_to_kg_m2/(US%L_to_m*CS%Rho_Ice))**3 > & + (CAS%m_ice(i,j,k)*IG%H_to_kg_m2/(US%L_to_m*CS%Rho_Ice))*G%areaT(i,j)) then + ! This ice is thicker than it is wide even if all the ice in a grid cell is collected + ! into a single cube, so it will roll. Any snow on top will simply be redistributed + ! into a thinner layer, although it should probably be dumped into the ocean. Rolling + ! makes the ice thinner so that it melts faster, but it should never be made thinner ! than IG%mH_cat_bound(1). - CAS%mH_ice(i,j,k) = max((CS%Rho_ice*IG%kg_m2_to_H) * US%L_to_m * & - sqrt((CAS%m_ice(i,j,k)*G%areaT(i,j)) / & - (CS%roll_factor * CAS%mH_ice(i,j,k)) ), IG%mH_cat_bound(1)) + CAS%mH_ice(i,j,k) = max(IG%mH_cat_bound(1), L_to_H * & + sqrt((CAS%m_ice(i,j,k)*G%areaT(i,j)) / (CS%roll_factor * CAS%mH_ice(i,j,k)) )) endif ! Make sure that CAS%mH_ice(i,j,k) > IG%mH_cat_bound(1). diff --git a/src/specified_ice.F90 b/src/specified_ice.F90 index a0153f51..65bf3f31 100644 --- a/src/specified_ice.F90 +++ b/src/specified_ice.F90 @@ -119,9 +119,10 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G, US) type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors - real :: ps_ice, ps_ocn ! ice_free and ice_cover interpolated to a velocity point [nondim]. + real :: ps_ice, ps_ocn ! ice_free and ice_cover interpolated to a velocity point [nondim]. real :: wt_prev, wt_now ! Relative weights of the previous average and the current step [nondim]. - real :: taux2, tauy2 ! squared wind stresses [kg2 m-4 L2 T-4 ~> Pa2] + real :: taux2, tauy2 ! Squared wind stresses [kg2 m-4 L2 T-4 ~> Pa2] + real :: stress_scale ! A unit rescaling factor from the FIA stresses to the IOF stresses. integer :: i, j, k, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -131,6 +132,7 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G, US) endif wt_now = 1.0 / (real(IOF%stress_count) + 1.0) ; wt_prev = 1.0 - wt_now + stress_scale = US%m_s_to_L_T*US%T_to_s ! Copy and interpolate the ice-ocean stress_Cgrid. This code is slightly ! complicated because there are 3 different staggering options supported. @@ -140,9 +142,9 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G, US) do j=jsc,jec ; do i=isc,iec ps_ocn = G%mask2dT(i,j) * FIA%ice_free(i,j) ps_ice = G%mask2dT(i,j) * FIA%ice_cover(i,j) - IOF%flux_u_ocn(i,j) = wt_prev * IOF%flux_u_ocn(i,j) + wt_now * US%m_s_to_L_T*US%T_to_s* & + IOF%flux_u_ocn(i,j) = wt_prev * IOF%flux_u_ocn(i,j) + wt_now * stress_scale * & (ps_ocn * FIA%WindStr_ocn_x(i,j) + ps_ice * FIA%WindStr_x(i,j)) - IOF%flux_v_ocn(i,j) = wt_prev * IOF%flux_v_ocn(i,j) + wt_now * US%m_s_to_L_T*US%T_to_s* & + IOF%flux_v_ocn(i,j) = wt_prev * IOF%flux_v_ocn(i,j) + wt_now * stress_scale * & (ps_ocn * FIA%WindStr_ocn_y(i,j) + ps_ice * FIA%WindStr_y(i,j)) if (allocated(IOF%stress_mag)) & IOF%stress_mag(i,j) = wt_prev * IOF%stress_mag(i,j) + wt_now * & @@ -158,12 +160,12 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G, US) ps_ice = 0.25 * ((FIA%ice_cover(i+1,j+1) + FIA%ice_cover(i,j)) + & (FIA%ice_cover(i+1,j) + FIA%ice_cover(i,j+1)) ) endif - IOF%flux_u_ocn(I,J) = wt_prev * IOF%flux_u_ocn(I,J) + wt_now * US%m_s_to_L_T*US%T_to_s* & + IOF%flux_u_ocn(I,J) = wt_prev * IOF%flux_u_ocn(I,J) + wt_now * stress_scale * & (ps_ocn * 0.25 * ((FIA%WindStr_ocn_x(i,j) + FIA%WindStr_ocn_x(i+1,j+1)) + & (FIA%WindStr_ocn_x(i,j+1) + FIA%WindStr_ocn_x(i+1,j))) + & ps_ice * 0.25 * ((FIA%WindStr_x(i,j) + FIA%WindStr_x(i+1,j+1)) + & (FIA%WindStr_x(i,j+1) + FIA%WindStr_x(i+1,J))) ) - IOF%flux_v_ocn(I,J) = wt_prev * IOF%flux_v_ocn(I,J) + wt_now * US%m_s_to_L_T*US%T_to_s* & + IOF%flux_v_ocn(I,J) = wt_prev * IOF%flux_v_ocn(I,J) + wt_now * stress_scale * & (ps_ocn * 0.25 * ((FIA%WindStr_ocn_y(i,j) + FIA%WindStr_ocn_y(i+1,j+1)) + & (FIA%WindStr_ocn_y(i,j+1) + FIA%WindStr_ocn_y(i+1,j))) + & ps_ice * 0.25 * ((FIA%WindStr_y(i,j) + FIA%WindStr_y(i+1,j+1)) + & @@ -190,7 +192,7 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G, US) ps_ocn = 0.5*(FIA%ice_free(i+1,j) + FIA%ice_free(i,j)) ps_ice = 0.5*(FIA%ice_cover(i+1,j) + FIA%ice_cover(i,j)) endif - IOF%flux_u_ocn(I,j) = wt_prev * IOF%flux_u_ocn(I,j) + wt_now * US%m_s_to_L_T*US%T_to_s* & + IOF%flux_u_ocn(I,j) = wt_prev * IOF%flux_u_ocn(I,j) + wt_now * stress_scale * & (ps_ocn * 0.5 * (FIA%WindStr_ocn_x(i+1,j) + FIA%WindStr_ocn_x(i,j)) + & ps_ice * 0.5 * (FIA%WindStr_x(i+1,j) + FIA%WindStr_x(i,j)) ) enddo ; enddo @@ -201,7 +203,7 @@ subroutine set_ocean_top_stress_FIA(FIA, IOF, G, US) ps_ocn = 0.5*(FIA%ice_free(i,j+1) + FIA%ice_free(i,j)) ps_ice = 0.5*(FIA%ice_cover(i,j+1) + FIA%ice_cover(i,j)) endif - IOF%flux_v_ocn(i,J) = wt_prev * IOF%flux_v_ocn(i,J) + wt_now * US%m_s_to_L_T*US%T_to_s* & + IOF%flux_v_ocn(i,J) = wt_prev * IOF%flux_v_ocn(i,J) + wt_now * stress_scale * & (ps_ocn * 0.5 * (FIA%WindStr_ocn_y(i,j+1) + FIA%WindStr_ocn_y(i,j)) + & ps_ice * 0.5 * (FIA%WindStr_y(i,j+1) + FIA%WindStr_y(i,j)) ) enddo ; enddo From 4fdb2a4e56453d2315b2decf4b037bcff0ce7307 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Nov 2019 10:34:31 -0500 Subject: [PATCH 23/24] +Rescaled velocities in the simple_OSS_type Rescaled the dimensions of the A-grid ice and ocean velocities in the simple_OSS_type so that any dimensional conversion occurs when the internal sea-ice variables are copied into the publicly visible ice_data_type. All answers are bitwise identical. --- src/SIS_types.F90 | 24 ++++++++++++------------ src/ice_model.F90 | 14 ++++++++------ 2 files changed, 20 insertions(+), 18 deletions(-) diff --git a/src/SIS_types.F90 b/src/SIS_types.F90 index ae88e734..e9d8cbb8 100644 --- a/src/SIS_types.F90 +++ b/src/SIS_types.F90 @@ -152,10 +152,10 @@ module SIS_types s_surf , & !< The ocean's surface salinity [gSalt kg-1]. SST_C , & !< The ocean's bulk surface temperature [degC]. T_fr_ocn, & !< The freezing point temperature at the ocean's surface salinity [degC]. - u_ocn_A, & !< The ocean's zonal surface velocity on A-grid points [m s-1]. - v_ocn_A, & !< The ocean's meridional surface velocity on A-grid points [m s-1]. - u_ice_A, & !< The sea ice's zonal velocity on A-grid points [m s-1]. - v_ice_A !< The sea ice's meridional velocity on A-grid points [m s-1]. + u_ocn_A, & !< The ocean's zonal surface velocity on A-grid points [L T-1 ~> m s-1]. + v_ocn_A, & !< The ocean's meridional surface velocity on A-grid points [L T-1 ~> m s-1]. + u_ice_A, & !< The sea ice's zonal velocity on A-grid points [L T-1 ~> m s-1]. + v_ice_A !< The sea ice's meridional velocity on A-grid points [L T-1 ~> m s-1]. real, allocatable, dimension(:,:) :: bheat !< The upward diffusive heat flux !! from the ocean to the ice at the base of the ice [W m-2]. @@ -1207,21 +1207,21 @@ subroutine translate_OSS_to_sOSS(OSS, IST, sOSS, G, US) sOSS%bheat(i,j) = OSS%bheat(i,j) ! Interpolate the ocean and ice velocities onto tracer cells. if (OSS%Cgrid_dyn) then - sOSS%u_ocn_A(i,j) = US%L_T_to_m_s*0.5*(OSS%u_ocn_C(I,j) + OSS%u_ocn_C(I-1,j)) - sOSS%v_ocn_A(i,j) = US%L_T_to_m_s*0.5*(OSS%v_ocn_C(i,J) + OSS%v_ocn_C(i,J-1)) + sOSS%u_ocn_A(i,j) = 0.5*(OSS%u_ocn_C(I,j) + OSS%u_ocn_C(I-1,j)) + sOSS%v_ocn_A(i,j) = 0.5*(OSS%v_ocn_C(i,J) + OSS%v_ocn_C(i,J-1)) else - sOSS%u_ocn_A(i,j) = US%L_T_to_m_s*0.25*((OSS%u_ocn_B(I,J) + OSS%u_ocn_B(I-1,J-1)) + & + sOSS%u_ocn_A(i,j) = 0.25*((OSS%u_ocn_B(I,J) + OSS%u_ocn_B(I-1,J-1)) + & (OSS%u_ocn_B(I,J-1) + OSS%u_ocn_B(I-1,J)) ) - sOSS%v_ocn_A(i,j) = US%L_T_to_m_s*0.25*((OSS%v_ocn_B(I,J) + OSS%v_ocn_B(I-1,J-1)) + & + sOSS%v_ocn_A(i,j) = 0.25*((OSS%v_ocn_B(I,J) + OSS%v_ocn_B(I-1,J-1)) + & (OSS%v_ocn_B(I,J-1) + OSS%v_ocn_B(I-1,J)) ) endif if (IST%Cgrid_dyn) then - sOSS%u_ice_A(i,j) = US%L_T_to_m_s*0.5*(IST%u_ice_C(I,j) + IST%u_ice_C(I-1,j)) - sOSS%v_ice_A(i,j) = US%L_T_to_m_s*0.5*(IST%v_ice_C(i,J) + IST%v_ice_C(i,J-1)) + sOSS%u_ice_A(i,j) = 0.5*(IST%u_ice_C(I,j) + IST%u_ice_C(I-1,j)) + sOSS%v_ice_A(i,j) = 0.5*(IST%v_ice_C(i,J) + IST%v_ice_C(i,J-1)) else - sOSS%u_ice_A(i,j) = US%L_T_to_m_s*0.25*((IST%u_ice_B(I,J) + IST%u_ice_B(I-1,J-1)) + & + sOSS%u_ice_A(i,j) = 0.25*((IST%u_ice_B(I,J) + IST%u_ice_B(I-1,J-1)) + & (IST%u_ice_B(I,J-1) + IST%u_ice_B(I-1,J)) ) - sOSS%v_ice_A(i,j) = US%L_T_to_m_s*0.25*((IST%v_ice_B(I,J) + IST%v_ice_B(I-1,J-1)) + & + sOSS%v_ice_A(i,j) = 0.25*((IST%v_ice_B(I,J) + IST%v_ice_B(I-1,J-1)) + & (IST%v_ice_B(I,J-1) + IST%v_ice_B(I-1,J)) ) endif else ! This is a land point. diff --git a/src/ice_model.F90 b/src/ice_model.F90 index c46a8b6a..644eaefd 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -966,14 +966,14 @@ subroutine set_ice_surface_fields(Ice) "The pointer to Ice%fCS must be associated in set_ice_surface_fields.") call set_ice_surface_state(Ice, Ice%fCS%IST, Ice%fCS%sOSS, Ice%fCS%Rad, & - Ice%fCS%FIA, Ice%fCS%G, Ice%fCS%IG, Ice%fCS ) + Ice%fCS%FIA, Ice%fCS%G, Ice%fCS%US, Ice%fCS%IG, Ice%fCS ) call mpp_clock_end(ice_clock_fast) ; call mpp_clock_end(iceClock) end subroutine set_ice_surface_fields !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> set_ice_surface_state prepares the surface state for atmosphere fast physics -subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) +subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, US, IG, fCS) type(ice_data_type), intent(inout) :: Ice !< The publicly visible ice data type. type(ice_state_type), intent(in) :: IST !< A type describing the state of the sea ice type(simple_OSS_type), intent(in) :: OSS !< A structure containing the arrays that describe @@ -983,6 +983,7 @@ subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) type(fast_ice_avg_type), intent(inout) :: FIA !< A type containing averages of fields !! (mostly fluxes) over the fast updates type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(unit_scale_type), intent(in) :: US !< A structure with unit conversion factors type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_fast_CS), intent(inout) :: fCS !< The fast ice thermodynamics control structure @@ -1108,11 +1109,12 @@ subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) enddo ! Put ocean salinity and ocean and ice velocities into Ice%u_surf/v_surf on t-cells. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,IST,Ice,G,i_off,j_off,OSS) & -!$OMP private(i2,j2) + !$OMP parallel do default(shared) private(i2,j2) do j=jsc,jec ; do i=isc,iec ; i2 = i+i_off ; j2 = j+j_off - Ice%u_surf(i2,j2,1) = OSS%u_ocn_A(i,j) ; Ice%v_surf(i2,j2,1) = OSS%v_ocn_A(i,j) - Ice%u_surf(i2,j2,2) = OSS%u_ice_A(i,j) ; Ice%v_surf(i2,j2,2) = OSS%v_ice_A(i,j) + Ice%u_surf(i2,j2,1) = US%L_T_to_m_s*OSS%u_ocn_A(i,j) + Ice%v_surf(i2,j2,1) = US%L_T_to_m_s*OSS%v_ocn_A(i,j) + Ice%u_surf(i2,j2,2) = US%L_T_to_m_s*OSS%u_ice_A(i,j) + Ice%v_surf(i2,j2,2) = US%L_T_to_m_s*OSS%v_ice_A(i,j) Ice%s_surf(i2,j2) = OSS%s_surf(i,j) enddo ; enddo From f803d26c77df048c98c78003c96daf422b0a75a1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Nov 2019 13:56:36 -0500 Subject: [PATCH 24/24] Minor changes to increase similarity to dev/gfdl Minor code clean-up to reduce differences from the current dev/gfdl code, including removing unnecessary parentheses and rearranging line breaks. All answers are bitwise identical. --- src/SIS_dyn_bgrid.F90 | 10 +++++----- src/SIS_dyn_cgrid.F90 | 36 ++++++++++++++++++------------------ src/SIS_dyn_trans.F90 | 18 ++++++------------ 3 files changed, 29 insertions(+), 35 deletions(-) diff --git a/src/SIS_dyn_bgrid.F90 b/src/SIS_dyn_bgrid.F90 index d8603597..cc4b3536 100644 --- a/src/SIS_dyn_bgrid.F90 +++ b/src/SIS_dyn_bgrid.F90 @@ -468,7 +468,7 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & mp4z(i,j) = -prs(i,j)/(4*zeta) t0(i,j) = 2*eta / (2*eta + edt(i,j)) tmp = 1/(4*eta*zeta) - a = 1/(edt(i,j)) + (zeta+eta)*tmp ! = 1/edt(i,j) + (1+EC2I)/(4*eta) + a = 1/edt(i,j) + (zeta+eta)*tmp ! = 1/edt(i,j) + (1+EC2I)/(4*eta) b = (zeta-eta)*tmp ! = (1-EC2I)/(4*eta) t1(i,j) = b/a ! = (1-EC2I)*edt(i,j) / (4*eta + (1+EC2I)*edt(i,j)) It2(i,j) = a / (a**2 - b**2) ! 1/t2 = a / (a*a - b*b) @@ -479,8 +479,8 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! timestep stress tensor (H&D eqn 21) do j=jsc,jec ; do i=isc,iec if( (G%mask2dT(i,j)>0.5) .and. (misp(i,j) > CS%MIV_MIN) ) then - f11 = mp4z(i,j) + CS%sig11(i,j)/(edt(i,j)) + strn11(i,j) - f22 = mp4z(i,j) + CS%sig22(i,j)/(edt(i,j)) + strn22(i,j) + f11 = mp4z(i,j) + CS%sig11(i,j)/edt(i,j) + strn11(i,j) + f22 = mp4z(i,j) + CS%sig22(i,j)/edt(i,j) + strn22(i,j) CS%sig11(i,j) = (t1(i,j)*f22 + f11) * It2(i,j) CS%sig22(i,j) = (t1(i,j)*f11 + f22) * It2(i,j) CS%sig12(i,j) = t0(i,j) * (CS%sig12(i,j) + edt(i,j)*strn12(i,j)) @@ -509,14 +509,14 @@ subroutine SIS_B_dynamics(ci, misp, mice, ui, vi, uo, vo, & ! - ! ### SIG11 and SIG22 SHOULD BE PAIRED ON A CUBED SPHERE. + ! ### SIG11 and SIG22 SHOULD BE PAIRED ON A CUBED SPHERE. call pass_var(CS%sig11, G%Domain, complete=.false.) call pass_var(CS%sig22, G%Domain, complete=.false.) call pass_var(CS%sig12, G%Domain, complete=.true.) do J=jsc-1,jec ; do I=isc-1,iec if( (G%mask2dBu(i,j)>0.5).and.(miv(i,j)>CS%MIV_MIN)) then ! timestep ice velocity (H&D eqn 22) - rr = US%L_to_m*CS%cdw*CS%Rho_ocean*abs(cmplx(ui(i,j)-uo(i,j),vi(i,j)-vo(i,j))) * & + rr = CS%cdw*US%L_to_m*CS%Rho_ocean*abs(cmplx(ui(i,j)-uo(i,j),vi(i,j)-vo(i,j))) * & exp(sign(CS%blturn*pi/180,US%s_to_T*G%CoriolisBu(i,j))*(0.0,1.0)) ! ! first, timestep explicit parts (ice, wind & ocean part of water stress) diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index 25c08c45..73aa944f 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -757,10 +757,10 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP do do J=jsc-1,jec ; do I=isc-1,iec if (CS%weak_coast_stress) then - sum_area = ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i,j+1) + G%areaT(i+1,j))) + sum_area = (G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i,j+1) + G%areaT(i+1,j)) else - sum_area = ((G%mask2dT(i,j)*G%areaT(i,j) + G%mask2dT(i+1,j+1)*G%areaT(i+1,j+1)) + & - (G%mask2dT(i,j+1)*G%areaT(i,j+1) + G%mask2dT(i+1,j)*G%areaT(i+1,j))) + sum_area = (G%mask2dT(i,j)*G%areaT(i,j) + G%mask2dT(i+1,j+1)*G%areaT(i+1,j+1)) + & + (G%mask2dT(i,j+1)*G%areaT(i,j+1) + G%mask2dT(i+1,j)*G%areaT(i+1,j)) endif if (sum_area <= 0.0) then ! This is a land point. @@ -792,7 +792,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & else ! This is a straight coastline or all neighboring velocity points are ! masked out. In any case, with just 1 point, the ratio is always 1. - mi_ratio_A_q(I,J) = 1.0 / (sum_area) + mi_ratio_A_q(I,J) = 1.0 / sum_area endif enddo ; enddo !$OMP end do nowait @@ -808,7 +808,7 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP end do nowait !$OMP do do J=jsc-1,jec ; do I=isc-1,iec - tot_area = ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) + tot_area = (G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1)) q(I,J) = G%CoriolisBu(I,J) * tot_area / & (((G%areaT(i,j) * mis(i,j) + G%areaT(i+1,j+1) * mis(i+1,j+1)) + & (G%areaT(i+1,j) * mis(i+1,j) + G%areaT(i,j+1) * mis(i,j+1))) + tot_area * m_neglect) @@ -885,13 +885,13 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & !$OMP parallel do default(none) shared(isc,iec,jsc,jec,sh_Dt,sh_Dd,dy_dxT,dx_dyT,G,ui,vi) do j=jsc-1,jec+1 ; do i=isc-1,iec+1 sh_Dt(i,j) = (dy_dxT(i,j)*(G%IdyCu(I,j) * ui(I,j) - & - G%IdyCu(I-1,j)*ui(I-1,j)) - & + G%IdyCu(I-1,j)*ui(I-1,j)) - & dx_dyT(i,j)*(G%IdxCv(i,J) * vi(i,J) - & G%IdxCv(i,J-1)*vi(i,J-1))) sh_Dd(i,j) = (G%IareaT(i,j)*(G%dyCu(I,j) * ui(I,j) - & - G%dyCu(I-1,j)*ui(I-1,j)) + & - G%IareaT(i,j)*(G%dxCv(i,J) * vi(i,J) - & - G%dxCv(i,J-1)*vi(i,J-1))) + G%dyCu(I-1,j)*ui(I-1,j)) + & + G%IareaT(i,j)*(G%dxCv(i,J) * vi(i,J) - & + G%dxCv(i,J-1)*vi(i,J-1))) enddo ; enddo if (CS%project_ci) then @@ -956,8 +956,8 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & do J=jsc-1,jec ; do I=isc-1,iec ! zeta is already set to 0 over land. CS%str_s(I,J) = I_1pdt_T * ( CS%str_s(I,J) + (I_EC2 * dt_2Tdamp) * & - (((G%areaT(i,j)*zeta(i,j) + G%areaT(i+1,j+1)*zeta(i+1,j+1)) + & - (G%areaT(i+1,j)*zeta(i+1,j) + G%areaT(i,j+1)*zeta(i,j+1))) * & + ( ((G%areaT(i,j)*zeta(i,j) + G%areaT(i+1,j+1)*zeta(i+1,j+1)) + & + (G%areaT(i+1,j)*zeta(i+1,j) + G%areaT(i,j+1)*zeta(i,j+1))) * & mi_ratio_A_q(I,J) * sh_Ds(I,J) ) ) enddo ; enddo @@ -983,11 +983,11 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m x.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fxic_now = (G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + & + fxic_now = G%IdxCu(I,j) * (CS%str_d(i+1,j) - CS%str_d(i,j)) + & (G%IdyCu(I,j)*(dy2T(i+1,j)*CS%str_t(i+1,j) - & dy2T(i,j) *CS%str_t(i,j)) + & G%IdxCu(I,j)*(dx2B(I,J) *CS%str_s(I,J) - & - dx2B(I,J-1)*CS%str_s(I,J-1)) ) * G%IareaCu(I,j) ) + dx2B(I,J-1)*CS%str_s(I,J-1)) ) * G%IareaCu(I,j) v2_at_u = CS%drag_bg_vel2 + 0.25 * & (((vi(i,J)-vo(i,J))**2 + (vi(i+1,J-1)-vo(i+1,J-1))**2) + & ((vi(i+1,J)-vo(i+1,J))**2 + (vi(i,J-1)-vo(i,J-1))**2)) @@ -1064,11 +1064,11 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! Evaluate 1/m y.Div(m strain). This expressions include all metric terms ! for an orthogonal grid. The str_d term integrates out to no curl, while ! str_s & str_t terms impose no divergence and do not act on solid body rotation. - fyic_now = (G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + & + fyic_now = G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) + & (-G%IdxCv(i,J)*(dx2T(i,j+1)*CS%str_t(i,j+1) - & dx2T(i,j) *CS%str_t(i,j)) + & G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & - dy2B(I-1,J)*CS%str_s(I-1,J)) )*G%IareaCv(i,J) ) + dy2B(I-1,J)*CS%str_s(I-1,J)) )*G%IareaCv(i,J) u2_at_v = CS%drag_bg_vel2 + 0.25 * & (((u_tmp(I,j)-uo(I,j))**2 + (u_tmp(I-1,j+1)-uo(I-1,j+1))**2) + & ((u_tmp(I,j+1)-uo(I,j+1))**2 + (u_tmp(I-1,j)-uo(I-1,j))**2)) @@ -1115,12 +1115,12 @@ subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & ! sum accelerations to take averages. fyic(i,J) = fyic(i,J) + fyic_now - if (CS%id_fiy_d>0) fyic_d(i,J) = fyic_d(i,J) + G%mask2dCv(i,J) * & + if (CS%id_fiy_d>0) fyic_d(i,J) = fyic_d(i,J) + G%mask2dCv(i,J) * & G%IdyCv(i,J) * (CS%str_d(i,j+1)-CS%str_d(i,j)) - if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * & + if (CS%id_fiy_t>0) fyic_t(i,J) = fyic_t(i,J) + G%mask2dCv(i,J) * & (G%IdxCv(i,J)*(dx2T(i,j+1)*(-CS%str_t(i,j+1)) - & dx2T(i,j) *(-CS%str_t(i,j))) ) * G%IareaCv(i,J) - if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * & + if (CS%id_fiy_s>0) fyic_s(i,J) = fyic_s(i,J) + G%mask2dCv(i,J) * & (G%IdyCv(i,J)*(dy2B(I,J) *CS%str_s(I,J) - & dy2B(I-1,J)*CS%str_s(I-1,J)) ) * G%IareaCv(i,J) diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index ab05ce3f..8c0b0fc0 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -1030,8 +1030,7 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, call mpp_clock_begin(iceClocka) if (CS%do_ridging) rdg_rate(:,:) = 0.0 call SIS_B_dynamics(DS2d%ice_cover, DS2d%mca_step(:,:,DS2d%nts), DS2d%mi_sum, DS2d%u_ice_B, DS2d%v_ice_B, & - OSS%u_ocn_B, OSS%v_ocn_B, & - WindStr_x_B, WindStr_y_B, OSS%sea_lev, & + OSS%u_ocn_B, OSS%v_ocn_B, WindStr_x_B, WindStr_y_B, OSS%sea_lev, & str_x_ice_ocn_B, str_y_ice_ocn_B, CS%do_ridging, & rdg_rate(isc:iec,jsc:jec), dt_slow_dyn, G, US, CS%SIS_B_dyn_CSp) call mpp_clock_end(iceClocka) @@ -1092,18 +1091,15 @@ subroutine SIS_merged_dyn_cont(OSS, FIA, IOF, DS2d, dt_cycle, Time_start, G, US, do n = DS2d%nts+1, DS2d%nts+CS%adv_substeps if ((n < ndyn_steps*CS%adv_substeps) .or. continuing_call) then ! Some of the work is not needed for the last step before cat_ice_transport. - call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, & - DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & + call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, & CS%continuity_CSp, h_ice=DS2d%mi_sum) - call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, dt_adv, & - G, US, IG, CS%cover_trans_CSp) + call ice_cover_transport(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%ice_cover, dt_adv, G, US, IG, CS%cover_trans_CSp) call pass_var(DS2d%mi_sum, G%Domain, complete=.false.) call pass_var(DS2d%ice_cover, G%Domain, complete=.false.) call pass_var(DS2d%mca_step(:,:,n), G%Domain, complete=.true.) else - call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, & - DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & + call summed_continuity(DS2d%u_ice_C, DS2d%v_ice_C, DS2d%mca_step(:,:,n-1), DS2d%mca_step(:,:,n), & DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, US, IG, CS%continuity_CSp) endif enddo @@ -1735,10 +1731,8 @@ subroutine set_ocean_top_stress_B2(IOF, windstr_x_water, windstr_y_water, & ps_ice = 0.25 * ((ice_cover(i+1,j+1) + ice_cover(i,j)) + & (ice_cover(i+1,j) + ice_cover(i,j+1)) ) endif - IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + & - (ps_ocn * windstr_x_water(I,J) + ps_ice * str_ice_oce_x(I,J)) - IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + & - (ps_ocn * windstr_y_water(I,J) + ps_ice * str_ice_oce_y(I,J)) + IOF%flux_u_ocn(I,J) = IOF%flux_u_ocn(I,J) + (ps_ocn * windstr_x_water(I,J) + ps_ice * str_ice_oce_x(I,J)) + IOF%flux_v_ocn(I,J) = IOF%flux_v_ocn(I,J) + (ps_ocn * windstr_y_water(I,J) + ps_ice * str_ice_oce_y(I,J)) enddo ; enddo elseif (IOF%flux_uv_stagger == CGRID_NE) then !$OMP parallel do default(shared) private(ps_ocn, ps_ice)