From a79d8845c909cd989d982823b54aade794592c74 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 31 Oct 2019 13:33:10 -0400 Subject: [PATCH] +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)) &