diff --git a/src/SIS2_ice_thm.F90 b/src/SIS2_ice_thm.F90 index 220f043f..d5eb287f 100644 --- a/src/SIS2_ice_thm.F90 +++ b/src/SIS2_ice_thm.F90 @@ -21,24 +21,24 @@ module SIS2_ice_thm !> This type contains the parameters regulating sea-ice thermodyanmics type, public :: ice_thermo_type ; private - real :: Cp_ice !< The heat capacity of ice, in J kg-1 K-1. + real :: Cp_ice !< The heat capacity of ice [J kg-1 degC-1]. real :: Cp_water !< The heat capacity of liquid water in the ice model, - !! but not in the brine pockets, in J/(kg K). + !! but not in the brine pockets [J kg-1 degC-1]. real :: Cp_brine !< The heat capacity of liquid water in the brine - !! pockets within the ice, in J/(kg K). Cp_brine + !! pockets within the ice [J kg-1 degC-1]. Cp_brine !! should be set equal to Cp_Water, but for !! algorithmic convenience can be set equal to Cp_ice. - real :: rho_ice !< The nominal density of ice in kg m-3. - real :: rho_snow !< The nominal density of snow in kg m-3. - real :: rho_water !< The nominal density of water in kg m-3. - real :: LI !< The latent heat of fusion, in J kg-1. - real :: Lat_Vapor !< The latent heat of vaporization, in J kg-1. + real :: rho_ice !< The nominal density of ice [kg m-3]. + real :: rho_snow !< The nominal density of snow [kg m-3]. + real :: rho_water !< The nominal density of water [kg m-3]. + real :: LI !< The latent heat of fusion [J kg-1]. + real :: Lat_Vapor !< The latent heat of vaporization [J kg-1]. real :: dTf_dS !< The derivative of the freezing point with salinity, - !! in degC per PSU. (dTf_dS is negative.) + !! [degC kg gSalt-1]. (dTf_dS is negative.) - real :: enth_liq_0 = 0.0 !< The value of enthalpy for liquid fresh water at 0 C, in J kg-1. - real :: enth_unit = 1.0 !< A conversion factor for enthalpy from Joules kg-1. - real :: I_enth_unit = 1.0 !< A conversion factor for enthalpy back to Joules kg-1. + real :: enth_liq_0 = 0.0 !< The value of enthalpy for liquid fresh water at 0 degC [J kg-1]. + real :: enth_unit = 1.0 !< A conversion factor for enthalpy from Joules kg-1 [Enth kg J-1 ~> 1]. + real :: I_enth_unit = 1.0 !< A conversion factor for enthalpy back to Joules kg-1 [J kg-1 Enth-1 ~> 1]. logical :: slab_ice = .false. !< If true use the very old slab ice thermodynamics, !! with effectively zero heat capacity of ice and snow. logical :: sublimation_bug = .false. !< If true use an older calculation that omits the @@ -53,10 +53,10 @@ module SIS2_ice_thm !> The control structure for the SIS2 ice thermodynamics type, public :: SIS2_ice_thm_CS ; private ! properties of ice, snow, and seawater (NCAR CSM values) - real :: KS !< Thermal conductivity of snow, often 0.31 W/(mK) - real :: KI !< Thermalconductivity of ice, often 2.03 W/(mK) + real :: KS !< Thermal conductivity of snow, often 0.31 [W m-1 degC-1] + real :: KI !< Thermalconductivity of ice, often 2.03 [W m-1 degC-1] - real :: temp_ice_freeze !< The freezing temperature of the top ice layer, in C. + real :: temp_ice_freeze !< The freezing temperature of the top ice layer [degC]. real :: temp_range_est !< An estimate of the range of snow and ice temperatures !! that is used to evaluate whether an explicit !! diffusive form of the heat fluxes or an inversion @@ -157,25 +157,25 @@ end subroutine SIS2_ice_thm_init subroutine ice_temp_SIS2(m_pond, m_snow, m_ice, enthalpy, sice, SF_0, dSF_dT, sol, tfw, fb, & tsurf, dtt, NkIce, tmelt, bmelt, CS, ITV, check_conserve) - real, intent(in ) :: m_pond !< pond mass per unit area (kg m-2) - real, intent(in ) :: m_snow !< snow mass per unit area (H, usually kg m-2) - real, intent(in ) :: m_ice !< ice mass per unit area (H, usually kg m-2) + real, intent(in ) :: m_pond !< pond mass per unit area [H ~> kg m-2] + real, intent(in ) :: m_snow !< snow mass per unit area [H ~> kg m-2] + real, intent(in ) :: m_ice !< ice mass per unit area [H ~> kg m-2] real, dimension(0:NkIce) , & intent(inout) :: enthalpy !< The enthalpy of each layer in a column of - !! snow and ice, in enth_unit (J kg-1). + !! snow and ice [Enth ~> J kg-1]. real, dimension(NkIce), & - intent(in) :: Sice !< ice salinity by layer (g/kg) - real, intent(in ) :: SF_0 !< net upward surface heat flux at ts=0 (W/m^2) - real, intent(in ) :: dSF_dT !< d(sfc heat flux)/d(ts) [W/(m^2 deg-C)] + intent(in) :: Sice !< ice salinity by layer [gSalt kg-1] + real, intent(in ) :: SF_0 !< net upward surface heat flux at ts=0 [W m-2] + real, intent(in ) :: dSF_dT !< d(sfc heat flux)/d(ts) [W m-2 degC-1] real, dimension(0:NkIce), & - intent(in) :: sol !< Solar heating of the snow and ice layers (W m-2) - real, intent(in ) :: tfw !< seawater freezing temperature (deg-C) - real, intent(in ) :: fb !< heat flux upward from ocean to ice bottom (W/m^2) - real, intent( out) :: tsurf !< surface temperature (deg-C) - real, intent(in ) :: dtt !< timestep (sec) + intent(in) :: sol !< Solar heating of the snow and ice layers [W m-2] + real, intent(in ) :: tfw !< seawater freezing temperature [degC] + real, intent(in ) :: fb !< heat flux upward from ocean to ice bottom [W m-2] + real, intent( out) :: tsurf !< surface temperature [degC] + real, intent(in ) :: dtt !< timestep [s] integer, intent(in ) :: NkIce !< The number of ice layers. - real, intent(inout) :: tmelt !< accumulated top melting energy (J/m^2) - real, intent(inout) :: bmelt !< accumulated bottom melting energy (J/m^2) + real, intent(inout) :: tmelt !< accumulated top melting energy [J m-2] + real, intent(inout) :: bmelt !< accumulated bottom melting energy [J m-2] type(SIS2_ice_thm_CS), intent(in) :: CS !< The SIS2 ice thermodynamics control structure type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. logical, optional, intent(in) :: check_conserve !< If true, check for local heat conservation. @@ -183,40 +183,40 @@ subroutine ice_temp_SIS2(m_pond, m_snow, m_ice, enthalpy, sice, SF_0, dSF_dT, so ! variables for temperature calculation [see Winton (1999) section II.A.] ! note: here equations are multiplied by hi to improve thin ice accuracy ! -! real :: A ! Net downward surface heat flux from the atmosphere at 0C (W/m^2) +! real :: A ! Net downward surface heat flux from the atmosphere at 0C [W m-2] ! real, dimension(0:NkIce) :: & -! temp_est, & ! An estimated snow and ice temperature, in degC. +! temp_est, & ! An estimated snow and ice temperature [degC]. ! temp_IC, & ! The temperatures of the snow and ice based on the initial -! ! enthalpy, in degC. -! temp_new ! The updated temperatures, in degC. - real, dimension(0:NkIce) :: temp_est ! An estimated snow and ice temperature, in degC. +! ! enthalpy [degC]. +! temp_new ! The updated temperatures [degC]. + real, dimension(0:NkIce) :: temp_est ! An estimated snow and ice temperature [degC]. real, dimension(0:NkIce) :: temp_IC ! The temperatures of the snow and ice based on the initial - ! enthalpy, in degC. - real, dimension(0:NkIce) :: temp_new ! The updated temperatures, in degC. - real, dimension(NkIce) :: tfi ! The ice freezing temperatures, in degC. - real :: mL_ice ! The mass-per-unit-area of each ice layer in kg m-2 (not H). - real :: mL_snow ! The mass-per-unit-area of each snow layer in kg m-2 (not H). + ! enthalpy [degC]. + real, dimension(0:NkIce) :: temp_new ! The updated temperatures [degC]. + real, dimension(NkIce) :: tfi ! The ice freezing temperatures [degC]. + real :: mL_ice ! The mass-per-unit-area of each ice layer [kg m-2] (not H). + real :: mL_snow ! The mass-per-unit-area of each snow layer [kg m-2] (not H). real :: e_extra - real, dimension(0:NkIce) :: m_lay ! Masses of all layers in kg m-2. + real, dimension(0:NkIce) :: m_lay ! Masses of all layers [kg m-2]. real :: enth_fp ! The enthalpy at the freezing point (solid for fresh ice). real :: kk ! The conductive thermal coupling coefficient between adjacent - ! ice sublayers, in W m-2 K-1. + ! ice sublayers [W m-2 degC-1]. real :: k10 ! The conductive thermal coupling coefficient between the - ! snow and the topmost ice sublayer, in W m-2 K-1. + ! snow and the topmost ice sublayer [W m-2 degC-1]. real :: k0a ! The implicit conductive thermal coupling coefficient between - ! the snow and the skin temperature, in W m-2 K-1. + ! the snow and the skin temperature [W m-2 degC-1]. real :: k0skin ! The conductive thermal coupling coefficient between the - ! snow and the skin temperature, in W m-2 K-1. + ! snow and the skin temperature [W m-2 degC-1]. real :: I_bb, b_denom_1 real :: comp_rat ! The complement of cc_bb, going from 0 to 1. - real :: tsf ! The surface freezing temperature in degC. + real :: tsf ! The surface freezing temperature [degC]. real :: k0a_x_ta, tsno_est, salt_part ! , rat - real :: tsurf_est ! An estimate of the surface temperature in degC. + real :: tsurf_est ! An estimate of the surface temperature [degC]. real, dimension(0:NkIce+1) :: cc ! Interfacial coupling coefficients. real, dimension(0:NkIce) :: bb ! Effective layer heat capacities. real, dimension(0:NkIce) :: cc_bb ! Remaining coupling ratios. real, dimension(-1:NkIce) :: heat_flux_int ! The downward heat fluxes at the - ! interfaces between layers, in W m-2. + ! interfaces between layers [W m-2]. ! heat_flux_int uses the index convention from ! MOM6 that interface K is below layer k. real :: I_liq_lim ! The inverse of CS%liq_lim. @@ -231,15 +231,15 @@ subroutine ice_temp_SIS2(m_pond, m_snow, m_ice, enthalpy, sice, SF_0, dSF_dT, so real :: hL_ice_eff real :: enth_liq_lim ! The enthalpy at the point where the ice or snow stops ! acting as a solid, and all extra heat goes into - ! melting, in enth_units. + ! melting [Enth ~> J kg-1]. real :: enth_prev - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. - real :: Cp_ice ! The heat capacity of ice, in J kg-1 K-1. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. + real :: Cp_ice ! The heat capacity of ice [J kg-1 degC-1]. real :: Cp_brine ! The heat capacity of liquid water in the brine pockets, - ! in J kg-1 K-1. - real :: Lat_fus ! The latent heat of fusion, in J kg-1. - real :: enth_unit ! A conversion factor for enthalpy from Joules kg-1. + ! [J kg-1 degC-1]. + real :: Lat_fus ! The latent heat of fusion [J kg-1]. + real :: enth_unit ! A conversion factor for enthalpy [Enth J-1 kg ~> 1]. real :: I_enth_unit ! The inverse of enth_unit. logical :: col_check integer :: k @@ -254,7 +254,7 @@ subroutine ice_temp_SIS2(m_pond, m_snow, m_ice, enthalpy, sice, SF_0, dSF_dT, so I_enth_unit = 1.0 / enth_unit mL_ice = m_ice / NkIce ! ice mass per unit area of each layer - mL_snow = m_snow ! snow mass per unit area (in kg m-2). + mL_snow = m_snow ! snow mass per unit area [kg m-2]. call calculate_T_Freeze(sice, tfi, ITV) ! freezing temperature of ice layers ! Set the effective thickness of each ice and snow layer, limited to avoid @@ -474,7 +474,7 @@ subroutine ice_temp_SIS2(m_pond, m_snow, m_ice, enthalpy, sice, SF_0, dSF_dT, so tflux_bot_diff = -heat_flux_int(NkIce)*dtt ! Estimate the errors with these two expressions from 64-bit roundoff. - tfb_diff_err = 1e-15*2.0*kk*dtt * sqrt(tfw**2 + 10.0**2) ! The -10 deg is arbitrary but good enough? + tfb_diff_err = 1e-15*2.0*kk*dtt * sqrt(tfw**2 + 10.0**2) ! The -10 degC is arbitrary but good enough? tfb_resid_err = 1e-15*sqrt(col_enth2**2 + col_enth1**2 + sum_sol**2 + tflux_sfc**2) d_tflux_bot = tflux_bot_diff - tflux_bot_resid @@ -538,21 +538,21 @@ end subroutine ice_temp_SIS2 subroutine estimate_tsurf(m_pond, m_snow, m_ice, enthalpy, sice, SF_0, dSF_dT, & sol, tfw, tsurf, dtt, NkIce, CS, ITV) - real, intent(in ) :: m_pond !< pond mass per unit area (kg m-2) - real, intent(in ) :: m_snow !< snow mass per unit area (H, usually kg m-2) - real, intent(in ) :: m_ice !< ice mass per unit area (H, usually kg m-2) + real, intent(in ) :: m_pond !< pond mass per unit area [H ~> kg m-2] + real, intent(in ) :: m_snow !< snow mass per unit area [H ~> kg m-2] + real, intent(in ) :: m_ice !< ice mass per unit area [H ~> kg m-2] real, dimension(0:NkIce) , & intent(in ) :: enthalpy !< The enthalpy of each layer in a column of - !! snow and ice, in enth_unit (J kg-1). + !! snow and ice, in enthalpy units [Enth ~> J kg-1]. real, dimension(NkIce), & - intent(in) :: Sice !< ice salinity by layer (g/kg) - real, intent(in ) :: SF_0 !< net upward surface heat flux when Tsurf=0 (W/m^2) - real, intent(in ) :: dSF_dT !< d(sfc heat flux)/d(ts) [W/(m^2 deg-C)] + intent(in) :: Sice !< ice salinity by layer [gSalt kg-1] + real, intent(in ) :: SF_0 !< net upward surface heat flux when Tsurf=0 [W m-2] + real, intent(in ) :: dSF_dT !< d(sfc heat flux)/d(ts) [W m-2 degC-1] real, dimension(0:NkIce), & - intent(in) :: sol !< Solar heating of the snow and ice layers (W m-2) - real, intent(in ) :: tfw !< seawater freezing temperature (deg-C) - real, intent( out) :: tsurf !< surface temperature (deg-C) - real, intent(in ) :: dtt !< timestep (sec) + intent(in) :: sol !< Solar heating of the snow and ice layers [W m-2] + real, intent(in ) :: tfw !< seawater freezing temperature [degC] + real, intent( out) :: tsurf !< surface temperature [degC] + real, intent(in ) :: dtt !< timestep [s] integer, intent(in ) :: NkIce !< The number of ice layers. type(SIS2_ice_thm_CS), intent(in) :: CS !< The SIS2 ice thermodynamics control structure type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. @@ -561,38 +561,38 @@ subroutine estimate_tsurf(m_pond, m_snow, m_ice, enthalpy, sice, SF_0, dSF_dT, & ! variables for temperature calculation [see Winton (1999) section II.A.] ! note: here equations are multiplied by hi to improve thin ice accuracy ! - real, dimension(0:NkIce) :: temp_est ! An estimated snow and ice temperature, in degC. + real, dimension(0:NkIce) :: temp_est ! An estimated snow and ice temperature [degC]. real, dimension(0:NkIce) :: temp_IC ! The temperatures of the snow and ice based on the initial - ! enthalpy, in degC. - real, dimension(NkIce) :: tfi ! The ice freezing temperatures, in degC. - real :: mL_ice ! The mass-per-unit-area of each ice layer in kg m-2 (not H). - real :: mL_snow ! The mass-per-unit-area of each snow layer in kg m-2 (not H). - real, dimension(0:NkIce) :: m_lay ! Masses of all layers in kg m-2. + ! enthalpy [degC]. + real, dimension(NkIce) :: tfi ! The ice freezing temperatures [degC]. + real :: mL_ice ! The mass-per-unit-area of each ice layer [kg m-2] (not H). + real :: mL_snow ! The mass-per-unit-area of each snow layer [kg m-2] (not H). + real, dimension(0:NkIce) :: m_lay ! Masses of all layers [kg m-2]. real :: kk ! The conductive thermal coupling coefficient between adjacent - ! ice sublayers, in W m-2 K-1. + ! ice sublayers [W m-2 degC-1]. real :: k10 ! The conductive thermal coupling coefficient between the - ! snow and the topmost ice sublayer, in W m-2 K-1. + ! snow and the topmost ice sublayer [W m-2 degC-1]. real :: k0a ! The implicit conductive thermal coupling coefficient between - ! the snow and the skin temperature, in W m-2 K-1. + ! the snow and the skin temperature [W m-2 degC-1]. real :: k0skin ! The conductive thermal coupling coefficient between the - ! snow and the skin temperature, in W m-2 K-1. + ! snow and the skin temperature [W m-2 degC-1]. real :: I_bb, b_denom_1 real :: comp_rat ! The complement of cc_bb, going from 0 to 1. - real :: tsf ! The surface freezing temperature in degC. + real :: tsf ! The surface freezing temperature [degC]. real :: k0a_x_ta ! The surface heat flux times normalized by 1 + the ratio ! of the temperature feedback on surface fluces to the - ! skin-snow conductive sensitivity, in W m-2. - real :: tsurf_est ! An estimate of the surface temperature in degC. + ! skin-snow conductive sensitivity [W m-2]. + real :: tsurf_est ! An estimate of the surface temperature [degC]. real, dimension(0:NkIce+1) :: cc ! Interfacial coupling coefficients. real, dimension(0:NkIce) :: bb ! Effective layer heat capacities. - real :: hsnow_eff ! The effective thickness of the snow layer, in m. - real :: hL_ice_eff ! The effective thickness of each ice sub-layer, in m. - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. - real :: Cp_ice ! The heat capacity of ice, in J kg-1 K-1. + real :: hsnow_eff ! The effective thickness of the snow layer [m]. + real :: hL_ice_eff ! The effective thickness of each ice sub-layer [m]. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. + real :: Cp_ice ! The heat capacity of ice [J kg-1 degC-1]. real :: Cp_brine ! The heat capacity of liquid water in the brine pockets, - ! in J kg-1 K-1. - real :: Lat_fus ! The latent heat of fusion, in J kg-1. + ! [J kg-1 degC-1]. + real :: Lat_fus ! The latent heat of fusion [J kg-1]. integer :: k temp_IC(0) = temp_from_En_S(enthalpy(0), 0.0, ITV) @@ -702,35 +702,35 @@ end subroutine estimate_tsurf !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> laytemp_SIS2 does an implicit calculation of new layer temperature function laytemp_SIS2(m, T_fr, f, b, tp, enth, salin, dtt, ITV) result (new_temp) - real :: new_temp !< The new temperature of the ice layer, in deg C - real, intent(in) :: m !< mass of ice - kg/m2 + real :: new_temp !< The new temperature of the ice layer [degC] + real, intent(in) :: m !< mass of ice [kg m-2] real, intent(in) :: T_fr !< ice freezing temp. (determined by salinity) - real, intent(in) :: f !< Inward forcing - W/m2 - real, intent(in) :: b !< response of outward heat flux to local temperature - W/m2/K - real, intent(in) :: tp !< prior step temperature in deg C + real, intent(in) :: f !< Inward forcing [W m-2] + real, intent(in) :: b !< response of outward heat flux to local temperature [W m-2 degC] + real, intent(in) :: tp !< prior step temperature [degC] real, intent(in) :: enth !< prior step enthalpy - real, intent(in) :: salin !< ice salinity in ppt. - real, intent(in) :: dtt !< timestep in s. + real, intent(in) :: salin !< ice salinity [gSalg kg-1]. + real, intent(in) :: dtt !< timestep [s] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real :: T_g ! The latest best guess at Temp, in deg C. - real :: T_deriv ! The value of Temp at which to evaluate dErr_dT, in deg C. - real :: T_max, T_min ! Bracketing temperatures, in deg C. - real :: Err ! The enthalpy at T_guess, in J kg-1. - real :: Err_Tmin, Err_Tmax ! The errors at T_max and T_min, in J m-2. - real :: T_prev ! The previous value of T_g, in deg C. - real :: dErr_dT ! The partial derivative of Err with T_g, in J m-2 C-1. + real :: T_g ! The latest best guess at Temp [degC]. + real :: T_deriv ! The value of Temp at which to evaluate dErr_dT [degC]. + real :: T_max, T_min ! Bracketing temperatures [degC]. + real :: Err ! The enthalpy at T_guess [J kg-1]. + real :: Err_Tmin, Err_Tmax ! The errors at T_max and T_min [J m-2]. + real :: T_prev ! The previous value of T_g [degC]. + real :: dErr_dT ! The partial derivative of Err with T_g [J m-2 degC-1]. real :: Enth_tol = 1.0e-15 ! The fractional Enthalpy difference tolerance for convergence. real :: TfmxdCp_BI real :: E0 ! Starting heat relative to salinity dependent freezing. real :: AA, BB, CC - real :: Cp_ice ! The heat capacity of ice, in J kg-1 K-1. + real :: Cp_ice ! The heat capacity of ice [J kg-1 degC-1]. real :: Cp_brine ! The heat capacity of liquid water in the brine pockets, - ! in J kg-1 K-1. + ! [J kg-1 degC-1]. real :: Cp_water ! The heat capacity of liquid water in the ice model, - ! but not in the brine pockets, in J kg-1 K-1. - real :: LI ! The latent heat of fusion, in J kg-1. + ! but not in the brine pockets [J kg-1 degC-1]. + real :: LI ! The latent heat of fusion [J kg-1]. integer :: itt ! real :: T_itt(20), dTemp(20), Err_itt(20) @@ -859,57 +859,57 @@ end function laytemp_SIS2 !> update_lay_enth does an implicit calculation of new layer enthalpy subroutine update_lay_enth(m_lay, sice, enth, ftop, ht_body, fbot, dftop_dT, & dfbot_dT, dtt, hf_err_rat, ITV, extra_heat, temp_new, temp_max) - real, intent(in) :: m_lay !< This layers mass of ice in kg/m2 - real, intent(in) :: sice !< ice salinity in g/kg - real, intent(inout) :: enth !< ice enthalpy in enth_units (proportional to J kg-1). - real, intent(inout) :: ftop !< Downward heat flux atop the layer in W/m2 at T = 0 C, or - !! the prescribed heat flux if dftop_dT = 0. - real, intent(in) :: ht_body !< Body forcing to layer in W/m2 - real, intent(inout) :: fbot !< Downward heat below the layer in W/m2 at T = 0 C. - real, intent(in) :: dftop_dT !< The linearization of ftop with layer temperature in W m-2 K-1. - real, intent(in) :: dfbot_dT !< The linearization of fbot with layer temperature in W m-2 K-1. - real, intent(in) :: dtt !< The timestep in s. + real, intent(in) :: m_lay !< This layers mass of ice [kg m-2] + real, intent(in) :: sice !< ice salinity [gSalt kg-1] + real, intent(inout) :: enth !< ice enthalpy in enthaly units [Enth ~> J kg-1]. + real, intent(inout) :: ftop !< Downward heat flux atop the layer at T = 0 degC, or + !! the prescribed heat flux if dftop_dT = 0 [W m-2]. + real, intent(in) :: ht_body !< Body heating to layer [W m-2] + real, intent(inout) :: fbot !< Downward heat below the layer at T = 0 degC [W m-2]. + real, intent(in) :: dftop_dT !< The linearization of ftop with layer temperature [W m-2 degC-1]. + real, intent(in) :: dfbot_dT !< The linearization of fbot with layer temperature [W m-2 degC-1]. + real, intent(in) :: dtt !< The timestep [s] real, intent(in) :: hf_err_rat !< A conversion factor for comparing the errors !! in explicit and implicit estimates of the updated - !! heat fluxes, in (kg m-2) / (W m-2 K-1). + !! heat fluxes [kg degC W-1]. type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real, intent(out) :: extra_heat !< The heat above the melt point, in J. - real, optional, intent(out) :: temp_new !< The new temperature, in degC. - real, optional, intent(in) :: temp_max !< The maximum new temperature, in degC. - - real :: htg ! The rate of heating of the layer in W m-2. - real :: new_temp ! The new layer temperature, in degC. - real :: max_temp ! The maximum new layer temperature, in degC. - real :: max_enth ! The maximum new layer enthalpy, in degC. + real, intent(out) :: extra_heat !< The heat above the melt point [J]. + real, optional, intent(out) :: temp_new !< The new temperature [degC]. + real, optional, intent(in) :: temp_max !< The maximum new temperature [degC]. + + real :: htg ! The rate of heating of the layer [W m-2]. + real :: new_temp ! The new layer temperature [degC]. + real :: max_temp ! The maximum new layer temperature [degC]. + real :: max_enth ! The maximum new layer enthalpy [degC]. real :: fb ! The negative of the dependence of layer heating on - ! temperature, in W m-2 K-1. fb > 0. - real :: extra_enth ! Excess enthalpy above the melt point, in kg enth_units. - real :: enth_in ! The initial enthalpy, in enth_units. - real :: enth_fp ! The enthalpy at the freezing point, in enth_units. + ! temperature [W m-2 degC-1]. fb > 0. + real :: extra_enth ! Excess enthalpy above the melt point [kg Enth ~> J]. + real :: enth_in ! The initial enthalpy [Enth ~> J kg-1]. + real :: enth_fp ! The enthalpy at the freezing point [Enth ~> J kg-1]. real :: AA, BB, CC ! Temporary variables used to solve a quadratic equation. - real :: dtEU ! The timestep times the unit conversion from J to Enth_units, in s? - real :: dT_dEnth ! The partial derivative of temperature with enthalpy, - ! in units of K / Enth_unit. - real :: En_J ! The enthalpy in Joules with 0 offset for liquid at 0 C. - real :: T_fr ! Ice freezing temperature (determined by bulk salinity) in deg C. - real :: fbot_in, ftop_in ! Input values of fbot and ftop in W m-2. - real :: dflux_dtot_dT ! A temporary work array in units of degC. - - real :: T_g ! The latest best guess at Temp, in deg C. - real :: T_deriv ! The value of Temp at which to evaluate dErr_dT, in deg C. - real :: T_max, T_min ! Bracketing temperatures, in deg C. - real :: Err ! The enthalpy at T_guess, in J kg-1. - real :: Err_Tmin, Err_Tmax ! The errors at T_max and T_min, in J m-2. - real :: T_prev ! The previous value of T_g, in deg C. - real :: dErr_dT ! The partial derivative of Err with T_g, in J m-2 C-1. - real :: Enth_tol = 1.0e-15 ! The fractional Enthalpy difference tolerance for convergence. + real :: dtEU ! The timestep times the unit conversion from J to Enth_units [s]? + real :: dT_dEnth ! The partial derivative of temperature with enthalpy + ! [degC Enth-1 ~> degC kg J-1]. + real :: En_J ! The enthalpy [J] with 0 offset for liquid at 0 degC. + real :: T_fr ! Ice freezing temperature (determined by bulk salinity) [degC]. + real :: fbot_in, ftop_in ! Input values of fbot and ftop [W m-2]. + real :: dflux_dtot_dT ! A temporary work array [degC]. + + real :: T_g ! The latest best guess at Temp [degC]. + real :: T_deriv ! The value of Temp at which to evaluate dErr_dT [degC]. + real :: T_max, T_min ! Bracketing temperatures [degC]. + real :: Err ! The enthalpy at T_guess [J kg-1]. + real :: Err_Tmin, Err_Tmax ! The errors at T_max and T_min [J m-2]. + real :: T_prev ! The previous value of T_g [degC]. + real :: dErr_dT ! The partial derivative of Err with T_g [J m-2 degC-1]. + real :: Enth_tol = 1.0e-15 ! The fractional Enthalpy difference tolerance for convergence [nondim]. real :: TfxdCp_WI, TfxdCp_BI, Err_Tind - real :: Cp_ice ! The heat capacity of ice, in J kg-1 K-1. + real :: Cp_ice ! The heat capacity of ice [J kg-1 degC-1]. real :: Cp_brine ! The heat capacity of liquid water in the brine pockets, - ! in J kg-1 K-1. + ! [J kg-1 degC-1]. real :: Cp_water ! The heat capacity of liquid water in the ice model, - ! but not in the brine pockets, in J kg-1 K-1. - real :: LI ! The latent heat of fusion, in J kg-1. + ! but not in the brine pockets [J kg-1 degC-1]. + real :: LI ! The latent heat of fusion [J kg-1]. real :: enth_unit ! A conversion factor for enthalpy from Joules kg-1. ! real :: Enth_liq_0 ! The enthalpy of liquid water at 0C. integer :: itt @@ -1113,17 +1113,17 @@ end subroutine update_lay_enth !! and writes messages about any offending columns. subroutine ice_check(ms, mi, enthalpy, s_ice, NkIce, msg_part, ITV, & bmelt, tmelt, t_sfc) - real, intent(in) :: ms !< The mass of snow in kg m-2 - real, intent(in) :: mi !< The mass of ice in kg m-2 + real, intent(in) :: ms !< The mass of snow [kg m-2] + real, intent(in) :: mi !< The mass of ice [kg m-2] real, dimension(0:NkIce), & - intent(in) :: enthalpy !< The ice enthalpy, in enthalpy units (often J/kg) - real, dimension(NkIce), intent(in) :: s_ice !< The ice bulk salinity in g/kg + intent(in) :: enthalpy !< The ice enthalpy, in enthalpy units [Enth ~> J kg-1] + real, dimension(NkIce), intent(in) :: s_ice !< The ice bulk salinity [gSalt kg-1] integer, intent(in) :: NkIce !< The number of vertical temperature layers in the ice character(len=*), intent(in) :: msg_part !< An identifying message type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real, optional, intent(in) :: bmelt !< The heat flux assocated with bottom melt in W m-2 - real, optional, intent(in) :: tmelt !< The heat flux assocated with top melt in W m-2 - real, optional, intent(in) :: t_sfc !< The ice surface temperature, in deg C + real, optional, intent(in) :: bmelt !< The heat flux assocated with bottom melt [W m-2] + real, optional, intent(in) :: tmelt !< The heat flux assocated with top melt [W m-2] + real, optional, intent(in) :: t_sfc !< The ice surface temperature [degC] character(len=300) :: mesg character(len=80) :: msg2 @@ -1172,63 +1172,61 @@ subroutine ice_resize_SIS2(a_ice, m_pond, m_lay, Enthalpy, Sice_therm, Salin, & enthalpy_evap, enthalpy_melt, enthalpy_freeze) ! mw/new - melt pond - added first two arguments & rain real, intent(in ) :: a_ice !< area of ice (1-open_water_frac) for pond retention - real, intent(inout) :: m_pond !< melt pond mass (kg/m2) + real, intent(inout) :: m_pond !< melt pond mass [kg m-2] real, dimension(0:NkIce), & - intent(inout) :: m_lay !< Snow and ice mass per unit area by layer in kg m-2. + intent(inout) :: m_lay !< Snow and ice mass per unit area by layer [kg m-2]. real, dimension(0:NkIce+1), & - intent(inout) :: Enthalpy !< Snow, ice, and ocean enthalpy by layer in enth_units - !! (which might be J/kg). + intent(inout) :: Enthalpy !< Snow, ice, and ocean enthalpy by layer [Enth ~> J kg-1]. real, dimension(NkIce), & - intent(in) :: Sice_therm !< ice salinity by layer, as used for thermodynamics (g/kg) + intent(in) :: Sice_therm !< ice salinity by layer, as used for thermodynamics [gSalt kg-1] real, dimension(NkIce+1), & - intent(inout) :: Salin !< Conserved ice bulk salinity by layer (g/kg) - real, intent(in ) :: snow !< new snow (kg/m^2-snow) - real, intent(in ) :: rain !< rain for pond source (kg/m^2-rain) - not yet active - real, intent(in ) :: evap !< ice evaporation/sublimation (kg/m^2) - real, intent(in ) :: tmlt !< top melting energy (J/m^2) - real, intent(in ) :: bmlt !< bottom melting energy (J/m^2) + intent(inout) :: Salin !< Conserved ice bulk salinity by layer [gSalt kg-1] + real, intent(in ) :: snow !< new snow [kg m-2] + real, intent(in ) :: rain !< rain for pond source [kg m-2] - not yet active + real, intent(in ) :: evap !< ice evaporation/sublimation [kg m-2] + real, intent(in ) :: tmlt !< top melting energy [J m-2] + real, intent(in ) :: bmlt !< bottom melting energy [J m-2] integer, intent(in) :: NkIce !< The number of ice layers. integer, intent(in) :: npassive !< Number of passive tracers real, dimension(0:NkIce+1,npassive), & intent(inout) :: TrLay !< Passive tracer slice - real, intent( out) :: heat_to_ocn !< energy left after ice all melted (J/m^2) - real, intent( out) :: h2o_ice_to_ocn !< liquid water flux to ocean (kg/m^2) - real, intent( out) :: h2o_ocn_to_ice !< liquid water flux from ocean (kg/m^2) - real, intent( out) :: evap_from_ocn!< evaporation flux from ocean (kg/m^2) - real, intent( out) :: snow_to_ice !< snow below waterline becomes ice - real, intent( out) :: salt_to_ice !< Net flux of salt to the ice, in g m-2. + real, intent( out) :: heat_to_ocn !< energy left after ice all melted [J m-2] + real, intent( out) :: h2o_ice_to_ocn !< liquid water flux to ocean [kg m-2] + real, intent( out) :: h2o_ocn_to_ice !< liquid water flux from ocean [kg m-2] + real, intent( out) :: evap_from_ocn!< evaporation flux from ocean [kg m-2] + real, intent( out) :: snow_to_ice !< snow below waterline becomes ice [kg m-2] + real, intent( out) :: salt_to_ice !< Net flux of salt to the ice [g m-2]. type(SIS2_ice_thm_CS), intent(in) :: CS !< The SIS2_ice_thm control structure. type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real, intent( out) :: ablation !< The mass loss from bottom melt, in kg m-2. + real, intent( out) :: ablation !< The mass loss from bottom melt [kg m-2]. real, intent( out) :: enthalpy_evap !< The enthalpy loss due to the mass loss !! by evaporation / sublimation. real, intent( out) :: enthalpy_melt !< The enthalpy loss due to the mass loss - !! by melting, in J m-2. + !! by melting [J m-2]. real, intent( out) :: enthalpy_freeze !< The enthalpy gain due to the mass gain - !! by freezing, in J m-2. + !! by freezing [J m-2]. real :: top_melt, bot_melt, melt_left ! Heating amounts, all in melt_unit. - real :: mtot_ice ! The summed ice mass in kg m-2. - real :: enth_freeze ! The enthalpy of newly formed congelation ice, in enth_unit. + real :: mtot_ice ! The summed ice mass [kg m-2]. + real :: enth_freeze ! The enthalpy of newly formed congelation ice [Enth ~> J kg-1]. real, dimension(0:NkIce) :: enth_fr ! The snow and ice layers' freezing point - ! enthalpy, in units of enth_unit. - real :: min_dEnth_freeze ! The minimum enthalpy change that must occur when - ! freezing water, usually enough to account for - ! the latent heat of fusion in a small fraction of - ! the water, in Enth_unit kg-1 (perhaps J kg-1). - real :: m_freeze ! The newly formed ice from freezing, in kg m-2. - real :: M_melt ! The ice mass lost to melting, in kg m-2. - real :: evap_left ! The remaining evaporation, in kg m-2. - real :: evap_here ! The evaporation from the current layer, in kg m-2. - real :: m_submerged ! The submerged mass of ice, in kg m-2. - real :: salin_freeze ! The salinity of newly frozen ice, in g kg-1. + ! enthalpy [Enth ~> J kg-1]. + real :: min_dEnth_freeze ! The minimum enthalpy change that must occur when freezing water, + ! usually enough to account for the latent heat of fusion + ! in a small fraction of the water [Enth ~> J kg-2]. + real :: m_freeze ! The newly formed ice from freezing [kg m-2]. + real :: M_melt ! The ice mass lost to melting [kg m-2]. + real :: evap_left ! The remaining evaporation [kg m-2]. + real :: evap_here ! The evaporation from the current layer [kg m-2]. + real :: m_submerged ! The submerged mass of ice [kg m-2]. + real :: salin_freeze ! The salinity of newly frozen ice [gSalt kg-1]. real :: enthM_evap, enthM_melt, enthM_freezing, enthM_snowfall real :: enth_unit ! A conversion factor for enthalpy from Joules kg-1. - real :: LI ! The latent heat of fusion, in J kg-1. - real :: Lat_vapor ! The latent heat of vaporization, in J kg-1. - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_water ! The nominal density of seawater in kg m-3. + real :: LI ! The latent heat of fusion [J kg-1]. + real :: Lat_vapor ! The latent heat of vaporization [J kg-1]. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_water ! The nominal density of seawater [kg m-3]. real :: h2o_to_ocn, h2o_orig, h2o_imb real :: pond_rate, h2o_to_pond, h2o_from_pond, tavg, mp_min, mp_max ! mw/new integer :: k, tr @@ -1486,45 +1484,43 @@ subroutine add_frazil_SIS2(m_lay, Enthalpy, Sice_therm, Salin, npassive, TrLay, frazil, tfw, NkIce, h2o_ocn_to_ice, & salt_to_ice, ITV, CS, enthalpy_freeze) real, dimension(0:NkIce), & - intent(inout) :: m_lay !< Snow and ice mass per unit area by layer in kg m-2. + intent(inout) :: m_lay !< Snow and ice mass per unit area by layer [kg m-2]. real, dimension(0:NkIce+1), & - intent(inout) :: Enthalpy !< Snow, ice, and ocean enthalpy by layer in enth_units - !! (which might be J/kg). + intent(inout) :: Enthalpy !< Snow, ice, and ocean enthalpy by layer [Enth ~> J kg-1]. real, dimension(NkIce), & - intent(in) :: Sice_therm !< ice salinity by layer, as used for thermodynamics (g/kg) + intent(in) :: Sice_therm !< ice salinity by layer, as used for thermodynamics [gSalt kg-1] real, dimension(NkIce+1), & - intent(inout) :: Salin !< Conserved ice bulk salinity by layer (g/kg) + intent(inout) :: Salin !< Conserved ice bulk salinity by layer [gSalt kg-1] integer, intent(in) :: npassive !< Number of passive tracers real, dimension(NkIce+1,npassive), & - intent(inout) :: TrLay !< Passive tracer in the column layer - real, intent(in ) :: frazil !< frazil in energy units - real, intent(in ) :: tfw !< seawater freezing temperature (deg-C) + intent(inout) :: TrLay !< Passive tracer in the column layer [Conc] + real, intent(in ) :: frazil !< frazil in energy units [J m-2] + real, intent(in ) :: tfw !< seawater freezing temperature [degC] integer, intent(in) :: NkIce !< The number of ice layers. - real, intent( out) :: h2o_ocn_to_ice !< liquid water flux from ocean (kg/m^2) - real, intent( out) :: salt_to_ice !< Net flux of salt to the ice, in g m-2. + real, intent( out) :: h2o_ocn_to_ice !< liquid water flux from ocean [kg m-2] + real, intent( out) :: salt_to_ice !< Net flux of salt to the ice [gSalt m-2]. type(SIS2_ice_thm_CS), intent(in) :: CS !< The SIS2_ice_thm control structure. type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real, intent( out) :: enthalpy_freeze !< The enthalpy gain due to the - !! mass gain by freezing, in J m-2. + !! mass gain by freezing [J m-2]. - real :: enth_frazil ! The enthalpy of newly formed frazil ice, in enth_unit. + real :: enth_frazil ! The enthalpy of newly formed frazil ice [Enth ~> J kg-1]. real :: frazil_per_layer ! The frazil heat sink from each of the sublayers of - ! of the ice, in units of enth_unit. - real :: t_frazil ! The temperature which with the frazil-ice is created, in C. - real :: m_frazil ! The newly-formed mass per unit area of frazil ice, in kg m-2. - real :: min_dEnth_freeze ! The minimum enthalpy change that must occur when - ! freezing water, usually enough to account for - ! the latent heat of fusion in a small fraction of - ! the water, in Enth_unit kg-1 (perhaps J kg-1). - real :: m_freeze ! The newly formed ice from freezing, in kg m-2. - real :: salin_freeze ! The salinity of newly frozen ice, in g kg-1. + ! of the ice [Enth ~> J kg-1]. + real :: t_frazil ! The temperature which with the frazil-ice is created [degC]. + real :: m_frazil ! The newly-formed mass per unit area of frazil ice [kg m-2]. + real :: min_dEnth_freeze ! The minimum enthalpy change that must occur when freezing water, + ! usually enough to account for the latent heat of fusion + ! in a small fraction of the water [Enth ~> J kg-2]. + real :: m_freeze ! The newly formed ice from freezing [kg m-2]. + real :: salin_freeze ! The salinity of newly frozen ice [gSalt kg-1]. real :: enthM_freezing ! The enthalpy gain due to the mass gain by - ! freezing, in enth_unit kg m-2 (often J m-2). - real :: enth_unit ! The units for enthalpy (often J kg-1). - real :: LI ! The latent heat of fusion, in J kg-1. + ! freezing [Enth ~> J kg-1]. + real :: enth_unit ! Converts from [J kg-1] to units for enthalpy [Enth kg J-1 ~> 1]. + real :: LI ! The latent heat of fusion [J kg-1]. ! These variables are used only for debugging. - real :: mtot_ice ! The summed ice mass in kg m-2. + real :: mtot_ice ! The summed ice mass [kg m-2]. real :: h2o_to_ocn, h2o_orig, h2o_imb integer :: k, tr logical :: debug = .false. @@ -1596,10 +1592,10 @@ end subroutine add_frazil_SIS2 !> Adjust the mass of the various ice layers to give the prescribed relative thicknesses. subroutine rebalance_ice_layers(m_lay, mtot_ice, Enthalpy, Salin, NkIce, npassive, TrLay) - real, dimension(0:NkIce), intent(inout) :: m_lay !< The ice mass by layer, in kg m-2. - real, intent(out) :: mtot_ice !< The summed ice mass in kg m-2. - real, dimension(0:NkIce+1), intent(inout) :: Enthalpy !< Snow, ice, and ocean enthalpy by layer in enth_units. - real, dimension(NkIce+1), intent(inout) :: Salin !< Conserved ice bulk salinity by layer (g/kg) + real, dimension(0:NkIce), intent(inout) :: m_lay !< The ice mass by layer [kg m-2]. + real, intent(out) :: mtot_ice !< The summed ice mass [kg m-2]. + real, dimension(0:NkIce+1), intent(inout) :: Enthalpy !< Snow, ice, and ocean enthalpy by layer [Enth ~> J kg-1]. + real, dimension(NkIce+1), intent(inout) :: Salin !< Conserved ice bulk salinity by layer [gSalt kg-1] integer, intent(in) :: NkIce !< The number of ice layers. integer, intent(in) :: npassive !< Number of passive tracers real, dimension(0:NkIce+1,npassive), & @@ -1768,9 +1764,9 @@ end subroutine ice_thermo_init !> T_Freeze returns the freezing temperature as a function of salinity. !### (and possibly later pressure). function T_Freeze(S, ITV) - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real :: T_Freeze !< The freezing point temperature in deg C + real :: T_Freeze !< The freezing point temperature [degC] T_Freeze = 0.0 + ITV%dTf_dS * S @@ -1780,8 +1776,8 @@ end function T_Freeze !> calculate_T_Freeze calculates an array of freezing temperatures for an !! an array of salinities (and maybe later pressures). subroutine calculate_T_Freeze(S, T_Freeze, ITV) - real, dimension(:), intent(in) :: S !< The ice bulk salinity in g/kg - real, dimension(:), intent(out) :: T_Freeze !< The freezing point temperature in deg C + real, dimension(:), intent(in) :: S !< The ice bulk salinity [gSalt kg-1] + real, dimension(:), intent(out) :: T_Freeze !< The freezing point temperature [degC] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. integer :: k, nk_ice @@ -1794,9 +1790,9 @@ end subroutine calculate_T_Freeze !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> enthalpy_from_TS sets a column of enthalpies from temperature and salinity. subroutine enthalpy_from_TS(T, S, enthalpy, ITV) - real, dimension(:), intent(in) :: T !< The ice temperature in deg C - real, dimension(:), intent(in) :: S !< The ice bulk salinity in g/kg - real, dimension(:), intent(out) :: enthalpy !< The ice enthalpy, in enthalpy units (often J/kg) + real, dimension(:), intent(in) :: T !< The ice temperature [degC] + real, dimension(:), intent(in) :: S !< The ice bulk salinity [gSalt kg-1] + real, dimension(:), intent(out) :: enthalpy !< The ice enthalpy, in enthalpy units [Enth ~> J kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. integer :: k, nk_ice @@ -1808,12 +1804,12 @@ end subroutine enthalpy_from_TS !> enth_from_TS returns an ice enthalpy given temperature and salinity. function enth_from_TS(T, S, ITV) result(enthalpy) - real, intent(in) :: T !< The ice temperature in deg C - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: T !< The ice temperature [degC] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real :: enthalpy !< The ice enthalpy, in enthalpy units (often J/kg) + real :: enthalpy !< The ice enthalpy, in enthalpy units [Enth ~> J kg-1] - real :: T_fr ! The freezing temperature in deg C. + real :: T_fr ! The freezing temperature [degC]. real :: Cp_Ice, Enth_liq_0, LI, enth_unit Cp_Ice = ITV%Cp_Ice ; LI = ITV%LI Enth_liq_0 = ITV%Enth_liq_0 ; enth_unit = ITV%enth_unit @@ -1825,7 +1821,7 @@ function enth_from_TS(T, S, ITV) result(enthalpy) ! due to the degeneracy in inverting temperature for enthalpy. enthalpy = enth_unit * ((ENTH_LIQ_0 - LI) + Cp_Ice*T) elseif (T >= T_fr) then ! This layer is already melted, so the enthalpy is - ! just what is required to warm or cool it to 0 C. + ! just what is required to warm or cool it to 0 degC. enthalpy = enth_unit * (ENTH_LIQ_0 + ITV%Cp_Water*T) elseif (ITV%Cp_Ice == ITV%Cp_Brine) then enthalpy = enth_unit * ((ENTH_LIQ_0 - LI * (1.0 - T_fr/T)) + & @@ -1843,7 +1839,7 @@ end function enth_from_TS !> enthalpy_liquid_freeze returns the enthalpy of liquid water at the freezing !! point for a given salinity. function enthalpy_liquid_freeze(S, ITV) - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real :: enthalpy_liquid_freeze @@ -1854,10 +1850,10 @@ end function enthalpy_liquid_freeze !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> enthalpy_liquid returns the enthalpy of liquid water at the given -!! temperature and salinity, in enth_unit. +!! temperature and salinity, in enthalpy units [Enth ~> J kg-1] function enthalpy_liquid(T, S, ITV) - real, intent(in) :: T !< The ice temperature in deg C - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: T !< The ice temperature [degC] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real :: enthalpy_liquid @@ -1867,10 +1863,10 @@ end function enthalpy_liquid !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> enth_melt returns the enthalpy change associated with melting water of -!! a given temperature (T, in C) and salinity (S), in enth_unit. +!! a given temperature (T) and salinity (S), in enthalpy units [Enth ~> J kg-1]. function enth_melt(T, S, ITV) result (emelt) - real, intent(in) :: T !< The ice temperature in deg C - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: T !< The ice temperature [degC] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real :: emelt @@ -1878,19 +1874,18 @@ function enth_melt(T, S, ITV) result (emelt) end function enth_melt !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> latent_sublimation returns the latent heat of sublimation as vapor at 0 C +!> latent_sublimation returns the latent heat of sublimation as vapor at 0 degC !! for a given ice and snow enthalpy (in enth_units), and a weighting factor !! for the sublimation between the snow and ice. function latent_sublimation(enth_snow, enth_ice, wt_snow, ITV) result (latent) - real, intent(in) :: enth_snow !< The enthalpy of the snow in enth_units. - real, intent(in) :: enth_ice !< The enthalpy of the ice surface in enth_units. + real, intent(in) :: enth_snow !< The enthalpy of the snow [Enth ~> J kg-1]. + real, intent(in) :: enth_ice !< The enthalpy of the ice surface [Enth ~> J kg-1]. real, intent(in) :: wt_snow !< A weighting factor (0-1) for the snow areal !! coverage; the complement is for the ice. type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real :: latent !< The latent heat of sublimation in J kg-1. + real :: latent !< The latent heat of sublimation [J kg-1]. - real :: enth_liq_0 ! The value of enthalpy for liquid fresh water at 0 C, in - ! enthalpy units (sometimes J kg-1). + real :: enth_liq_0 ! The value of enthalpy for liquid fresh water at 0 degC [Enth ~> J kg-1]. ! This should become ITV%Enth_liq_0, but it is not due to ! a bug in how this is calculated. @@ -1913,9 +1908,9 @@ end function latent_sublimation !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Temp_from_Enth_S sets a column of temperatures from enthalpy and salinity. subroutine Temp_from_Enth_S(En, S, Temp, ITV) - real, dimension(:), intent(in) :: En !< The ice enthalpy, in enthalpy units (often J/kg) - real, dimension(:), intent(in) :: S !< The ice bulk salinity in g/kg - real, dimension(:), intent(out) :: Temp !< The ice temperature in deg C + real, dimension(:), intent(in) :: En !< The ice enthalpy, in enthalpy units [Enth ~> J kg-1] + real, dimension(:), intent(in) :: S !< The ice bulk salinity [gSalt kg-1] + real, dimension(:), intent(out) :: Temp !< The ice temperature [degC] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. integer :: k, nk_ice @@ -1932,16 +1927,16 @@ end subroutine Temp_from_Enth_S !> dTemp_dEnth_EnS returns the partial deriative of sea ice temperature with enthalpy !! for ice of a given enthalpy and salinity. function dTemp_dEnth_EnS(En, S, ITV) result(dT_dE) - real, intent(in) :: En !< The ice enthalpy, in enthalpy units (often J/kg) - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: En !< The ice enthalpy, in enthalpy units [Enth_unit ~> J kg-1] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real :: dT_dE !< Partial derivative of temperature with enthalpy in degC/Enth_unit. + real :: dT_dE !< Partial derivative of temperature with enthalpy [degC Enth_unit-1 ~> degC kg J-1]. real :: I_Cp_Ice, BB, I_CpI_Eu, I_CpW_Eu real :: I_enth_unit real :: Cp_Ice, LI, Mu_TS - real :: T_fr ! The freezing temperature in deg C. - real :: En_J ! Enthalpy in Joules with 0 offset. + real :: T_fr ! The freezing temperature [degC]. + real :: En_J ! Enthalpy with 0 offset at 0 degC [J kg-1]. Cp_Ice = ITV%Cp_Ice ; LI = ITV%LI ; Mu_TS = -ITV%dTf_dS I_Cp_Ice = 1.0 / Cp_Ice ; I_enth_unit = 1.0 / ITV%enth_unit @@ -1962,7 +1957,7 @@ function dTemp_dEnth_EnS(En, S, ITV) result(dT_dE) if (En_J < T_fr * ITV%Cp_water) then BB = 0.5*((En_J - T_fr*(ITV%Cp_water-ITV%Cp_ice)) + LI) dT_dE = I_Cp_Ice * 0.5 * (1.0 - BB / sqrt(BB**2 - T_fr*Cp_Ice*LI)) - else ! This layer is already melted, so just warm it to 0 C. + else ! This layer is already melted, so just warm it to 0 degC. dT_dE = I_CpW_Eu endif else @@ -1975,15 +1970,15 @@ end function dTemp_dEnth_EnS !> dTemp_dEnth_TS returns the partial deriative of sea ice temperature with enthalpy !! for ice of a given temperature and salinity. function dTemp_dEnth_TS(Temp, S, ITV) result(dT_dE) - real, intent(in) :: Temp !< The ice temperature in deg C - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: Temp !< The ice temperature [degC] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real :: dT_dE !< Partial derivative of temperature with enthalpy in degC/Enth_unit. + real :: dT_dE !< Partial derivative of temperature with enthalpy [degC Enth_unit-1 ~> degC kg J-1]. real :: I_CpI_Eu, I_CpW_Eu ! real :: I_enth_unit ! real :: Cp_Ice, LI, Mu_TS - real :: T_fr ! The freezing temperature in deg C. + real :: T_fr ! The freezing temperature [degC]. ! Cp_Ice = ITV%Cp_Ice ; LI = ITV%LI ; Mu_TS = -ITV%dTf_dS I_CpI_Eu = 1.0 / (ITV%Cp_Ice * ITV%enth_unit) @@ -2004,7 +1999,7 @@ function dTemp_dEnth_TS(Temp, S, ITV) result(dT_dE) ! Cp_Ice + (ITV%Cp_Brine - Cp_Ice) * (T_fr/Temp) dT_dE = (-Temp) / (ITV%enth_unit * (ITV%LI * (T_fr / Temp) + & (ITV%Cp_Ice*(-Temp) + (ITV%Cp_Brine - ITV%Cp_Ice) * (-T_Fr)))) - else ! This layer is already melted, so just warm it to 0 C. + else ! This layer is already melted, so just warm it to 0 degC. dT_dE = I_CpW_Eu endif endif @@ -2015,24 +2010,24 @@ end function dTemp_dEnth_TS !> Temp_from_En_S returns the sea ice temperature for ice of a given enthalpy !! and salinity. function Temp_from_En_S(En, S, ITV) result(Temp) - real, intent(in) :: En !< The ice enthalpy, in enthalpy units (often J/kg) - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: En !< The ice enthalpy, in enthalpy units [Enth ~> J kg-1] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real :: Temp !< Temperature in deg C. + real :: Temp !< Temperature [degC]. - real :: I_Cp_Ice, I_Cp_Water ! Inverse heat capacities, in kg K J-1. + real :: I_Cp_Ice, I_Cp_Water ! Inverse heat capacities [kg degC J-1]. real :: BB real :: I_enth_unit - real :: T_fr ! The freezing temperature in deg C. + real :: T_fr ! The freezing temperature [degC]. real :: Cp_Ice, Cp_Water, LI, Mu_TS - real :: En_J ! Enthalpy in Joules with 0 offset. - real :: T_guess ! The latest best guess at Temp, in deg C. - real :: T_deriv ! The value of Temp at which to evaluate dT_dEn, in deg C. - real :: T_next ! The tentative next value for T_guess, in deg C. - real :: T_max, T_min ! Bracketing temperatures, in deg C. - real :: En_Tg ! The enthalpy at T_guess, in J kg-1. - real :: En_Tmin, En_Tmax ! The enthalpies at T_max and T_min, in J kg-1. - real :: dT_dEn ! The partial derivative of temperature with enthalpy, in degC kg / J. + real :: En_J ! Enthalpy with 0 offset [J kg-1]. + real :: T_guess ! The latest best guess at Temp [degC]. + real :: T_deriv ! The value of Temp at which to evaluate dT_dEn [degC]. + real :: T_next ! The tentative next value for T_guess [degC]. + real :: T_max, T_min ! Bracketing temperatures [degC]. + real :: En_Tg ! The enthalpy at T_guess [J kg-1]. + real :: En_Tmin, En_Tmax ! The enthalpies at T_max and T_min [J kg-1]. + real :: dT_dEn ! The partial derivative of temperature with enthalpy [degC kg J-1]. real :: Enth_tol = 1.0e-15 ! The fractional Enthalpy difference tolerance for convergence. ! real :: dTemp(20), T_itt(20) @@ -2128,16 +2123,16 @@ end function Temp_from_En_S !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> e_to_melt_TS - return the energy needed to melt a given snow/ice -!! configuration, in J kg-1. +!! configuration [J kg-1]. function e_to_melt_TS(T, S, ITV) result(e_to_melt) - real, intent(in) :: T !< The ice temperature in deg C - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: T !< The ice temperature [degC] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real :: e_to_melt !< The energy required to melt this mixture of ice and brine - !! and warm it to its bulk freezing temperature, in J kg-1. + !! and warm it to its bulk freezing temperature [J kg-1]. - real :: T_fr ! The freezing temperature in deg C. + real :: T_fr ! The freezing temperature [degC]. T_fr = ITV%dTf_dS*S if (T >= T_Fr) then ! This layer is already melted and has excess heat. @@ -2154,14 +2149,14 @@ end function e_to_melt_TS !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> energy_melt_enthS returns the energy needed to melt a given snow/ice -!! configuration, in J kg-1. +!! configuration [J kg-1]. function energy_melt_enthS(En, S, ITV) result(e_to_melt) - real, intent(in) :: En !< The ice enthalpy, in enthalpy units (often J/kg) - real, intent(in) :: S !< The ice bulk salinity in g/kg + real, intent(in) :: En !< The ice enthalpy, in enthalpy units [Enth ~> J kg-1] + real, intent(in) :: S !< The ice bulk salinity [gSalt kg-1] type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real :: e_to_melt !< The energy required to melt this mixture of ice and brine - !! and warm it to its bulk freezing temperature, in J kg-1. + !! and warm it to its bulk freezing temperature [J kg-1]. e_to_melt = ITV%enth_unit * (enthalpy_liquid_freeze(S, ITV) - En) @@ -2177,19 +2172,19 @@ subroutine get_SIS2_thermo_coefs(ITV, ice_salinity, enthalpy_units, & type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real, dimension(:), & optional, intent(out) :: ice_salinity !< The specified salinity of each layer when the - !! thermodynamic salinities are pre-specified, in g kg-1. + !! thermodynamic salinities are pre-specified [gSalt kg-1]. real, optional, intent(out) :: enthalpy_units !< A unit conversion factor for enthalpy from its !! internal representation to Joules kg-1. - real, optional, intent(out) :: Cp_Ice !< The heat capacity of ice in J kg-1 K-1. - real, optional, intent(out) :: Cp_Water !< The heat capacity of seawater in J kg-1 K-1. + real, optional, intent(out) :: Cp_Ice !< The heat capacity of ice [J kg-1 degC-1]. + real, optional, intent(out) :: Cp_Water !< The heat capacity of seawater [J kg-1 degC-1]. real, optional, intent(out) :: Cp_Brine !< The heat capacity of liquid water in brine pockets - !! within the sea-ice, in J kg-1 K-1. Cp_Brine and Cp_Water should be equal, + !! within the sea-ice [J kg-1 degC-1]. Cp_Brine and Cp_Water should be equal, !! but for computational convenience Cp_Brine has often been set equal to Cp_Ice instead. - real, optional, intent(out) :: rho_ice !< A nominal density of ice in kg m-3. - real, optional, intent(out) :: rho_snow !< A nominal density of snow in kg m-3. - real, optional, intent(out) :: rho_water !< A nominal density of water in kg m-3. - real, optional, intent(out) :: Latent_fusion !< The latent heat of fusion, in J kg-1. - real, optional, intent(out) :: Latent_vapor !< The latent heat of vaporization, in J kg-1. + real, optional, intent(out) :: rho_ice !< A nominal density of ice [kg m-3]. + real, optional, intent(out) :: rho_snow !< A nominal density of snow [kg m-3]. + real, optional, intent(out) :: rho_water !< A nominal density of water [kg m-3]. + real, optional, intent(out) :: Latent_fusion !< The latent heat of fusion [J kg-1]. + real, optional, intent(out) :: Latent_vapor !< The latent heat of vaporization [J kg-1]. type(EOS_type), & optional, pointer :: EOS !< A pointer to the MOM6/SIS2 ocean equation-of-state type. logical, optional, intent(out) :: specified_thermo_salinity !< If true, all thermodynamic calculations diff --git a/src/SIS_continuity.F90 b/src/SIS_continuity.F90 index 6f139989..6a0f8e73 100644 --- a/src/SIS_continuity.F90 +++ b/src/SIS_continuity.F90 @@ -28,6 +28,7 @@ module SIS_continuity #include public ice_continuity, SIS_continuity_init, SIS_continuity_end +public summed_continuity, proportionate_continuity, ice_cover_transport integer :: id_clock_update !< A CPU time clock ID integer :: id_clock_correct !< A CPU time clock ID @@ -66,18 +67,20 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, 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, in m s-1. + intent(in) :: u !< Zonal ice velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: v !< Meridional ice velocity, in m s-1. + intent(in) :: v !< Meridional ice velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: hin !< Initial ice or snow thickness by category, in H. + 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, in H. + 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. + intent(out) :: uh !< Volume flux through zonal faces = u*h*dy + !! [H m2 s-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & - intent(out) :: vh !< Volume flux through meridional faces = v*h*dx, in H m2 s-1. - real, intent(in) :: dt !< Time increment in s. + 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(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 @@ -85,8 +88,6 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) ! documentation, H is used for the units of thickness (usually m or kg m-2.) ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)) :: & - h_input ! Left and right face thicknesses, in H. type(loop_bounds_type) :: LB ! A structure with the active loop bounds. real :: h_up integer :: is, ie, js, je, nCat, stensil @@ -107,21 +108,20 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) if (CS%use_upwind2d) then ! This reproduces the scheme that was originally used in SIS1. -!$OMP parallel default(none) shared(G,is,ie,js,je,u,v,hin,uh,vh,h,dt,nCat) & -!$OMP private(h_up) -!$OMP do + !$OMP parallel default(shared) private(h_up) + !$OMP do 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 enddo ; enddo ; enddo -!$OMP do + !$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 enddo ; enddo ; enddo -!$OMP do + !$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) * & ((uh(I,j,k) - uh(I-1,j,k)) + (vh(i,J,k) - vh(i,J-1,k))) @@ -130,15 +130,15 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) call SIS_error(FATAL, 'Negative thickness encountered in ice_continuity().') endif enddo ; enddo ; enddo -!$OMP end parallel + !$OMP end parallel 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, hin, uh, dt, G, IG, CS, LB) + call zonal_mass_flux(u, dt, G, IG, CS, LB, hin, uh) call cpu_clock_begin(id_clock_update) -!$OMP parallel do default(none) shared(LB,nCat,G,uh,hin,dt,h) + !$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)) if (h(i,j,k) < 0.0) then @@ -152,10 +152,10 @@ 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, h, vh, dt, G, IG, CS, LB) + call meridional_mass_flux(v, dt, G, IG, CS, LB, h, vh) call cpu_clock_begin(id_clock_update) -!$OMP parallel do default(none) shared(nCat,LB,h,dt,G,vh) + !$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)) if (h(i,j,k) < 0.0) then @@ -170,10 +170,10 @@ 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, hin, vh, dt, G, IG, CS, LB) + call meridional_mass_flux(v, dt, G, IG, CS, LB, hin, vh) call cpu_clock_begin(id_clock_update) -!$OMP parallel do default(none) shared(nCat,LB,h,hin,dt,G,vh) + !$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)) if (h(i,j,k) < 0.0) then @@ -186,10 +186,10 @@ 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, h, uh, dt, G, IG, CS, LB) + call zonal_mass_flux(u, dt, G, IG, CS, LB, h, uh) call cpu_clock_begin(id_clock_update) -!$OMP parallel do default(none) shared(nCat,LB,h,dt,G,uh) + !$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)) if (h(i,j,k) < 0.0) then @@ -203,38 +203,674 @@ subroutine ice_continuity(u, v, hin, h, uh, vh, dt, G, IG, CS) 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) + 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(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 :: cvr_up + integer :: is, ie, js, je, stensil + integer :: i, j + + logical :: x_first + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + if (.not.associated(CS)) call SIS_error(FATAL, & + "SIS_continuity: Module must be initialized before it is used.") + x_first = (MOD(G%first_direction,2) == 0) + + stensil = 3 ; if (CS%simple_2nd) stensil = 2 ; if (CS%upwind_1st) stensil = 1 + + do j=js,je ; do i=is,ie ; if (cvr(i,j) < 0.0) then + call SIS_error(FATAL, 'Negative mass input to ice_cover_transport().') + endif ; enddo ; enddo + + if (CS%use_upwind2d) then + ! This reproduces the scheme that was originally used in SIS1. + !$OMP parallel default(shared) private(cvr_up) + !$OMP do + 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 + 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 + enddo ; enddo + !$OMP do + do j=js,je ; do i=is,ie + 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().') + enddo ; enddo + !$OMP end parallel + 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 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))) + if (cvr(i,j) < 0.0) call SIS_error(FATAL, & + 'Negative ice cover encountered in u-pass of ice_cover_transport().') + enddo ; enddo + call cpu_clock_end(id_clock_update) + + 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 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))) + if (cvr(i,j) < 0.0) call SIS_error(FATAL, & + 'Negative ice cover encountered in v-pass of ice_cover_transport().') + enddo ; enddo + call cpu_clock_end(id_clock_update) + + 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 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)) + if (cvr(i,j) < 0.0) call SIS_error(FATAL, & + 'Negative ice cover encountered in v-pass of ice_cover_transport().') + enddo ; enddo + call cpu_clock_end(id_clock_update) + + ! 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 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))) + if (cvr(i,j) < 0.0) call SIS_error(FATAL, & + 'Negative ice cover encountered in u-pass of ice_cover_transport().') + enddo ; enddo + call cpu_clock_end(id_clock_update) + + endif ! End of x_first block. + +end subroutine ice_cover_transport + + +!> summed_continuity time steps the total ice, water, and snow mass changes summed across all the +!! 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) + 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(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]. + 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(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 + !! area [H ~> kg m-2]. h_ice must not exceed h. + + + ! 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]. + real, dimension(SZI_(G),SZJB_(G)) :: vh_ice ! Ice mass flux through meridional faces = v*h*dx + ! [H m2 s-1 ~> kg s-1]. + real :: h_up + integer :: is, ie, js, je, stensil + integer :: i, j + + logical :: x_first + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + if (.not.associated(CS)) call SIS_error(FATAL, & + "SIS_continuity: Module must be initialized before it is used.") + x_first = (MOD(G%first_direction,2) == 0) + + 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().') + 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().') + endif ; enddo ; enddo ; endif + + if (CS%use_upwind2d) then + ! This reproduces the scheme that was originally used in SIS1. + !$OMP parallel default(shared) private(h_up) + !$OMP do + 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 + 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 + enddo ; enddo + if (present(h_ice)) then + !$OMP do + do j=js,je ; do I=is-1,ie + if (uh(I,j) < 0.0) then ; uh_ice(I,j) = uh(I,j) * (h_ice(i+1,j) / h_in(i+1,j)) + elseif (uh(I,j) > 0.0) then ; uh_ice(I,j) = uh(I,j) * (h_ice(i,j) / h_in(i,j)) + else ; uh_ice(I,j) = 0.0 ; endif + enddo ; enddo + !$OMP do + do J=js-1,je ; do i=is,ie + if (vh(i,J) < 0.0) then ; vh_ice(i,J) = vh(i,J) * (h_ice(i,j+1) / h_in(i,j+1)) + elseif (vh(i,J) > 0.0) then ; vh_ice(i,J) = vh(i,J) * (h_ice(i,j) / h_in(i,j)) + else ; vh_ice(i,J) = 0.0 ; endif + 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)) * & + ((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)) * & + ((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().') + ! 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() 2d.') + ! endif ; endif + enddo ; enddo + !$OMP end parallel + 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 cpu_clock_begin(id_clock_update) + + if (present(h_ice)) then + !$OMP parallel do default(shared) + do j=LB%jsh,LB%jeh + do I=LB%ish-1,LB%ieh + if (uh(I,j) < 0.0) then ; uh_ice(I,j) = uh(I,j) * (h_ice(i+1,j) / h_in(i+1,j)) + elseif (uh(I,j) > 0.0) then ; uh_ice(I,j) = uh(I,j) * (h_ice(i,j) / h_in(i,j)) + 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)) + 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)) + ! 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 + ! call SIS_error(FATAL, 'ice mass exceeds total mass in ice_total_continuity() x-1.') + ! endif ; endif + enddo ; enddo + call cpu_clock_end(id_clock_update) + + 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 cpu_clock_begin(id_clock_update) + if (present(h_ice)) then + !$OMP parallel do default(shared) + do J=LB%jsh-1,LB%jeh ; do i=LB%ish,LB%ieh + if (vh(i,J) < 0.0) then ; vh_ice(i,J) = vh(i,J) * (h_ice(i,j+1) / h(i,j+1)) + elseif (vh(i,J) > 0.0) then ; vh_ice(i,J) = vh(i,J) * (h_ice(i,j) / h(i,j)) + else ; vh_ice(i,J) = 0.0 ; endif + 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)) + 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)) + 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 + ! call SIS_error(FATAL, 'ice mass exceeds total mass in ice_total_continuity() x-2.') + ! endif ; endif + enddo ; enddo + call cpu_clock_end(id_clock_update) + + 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 cpu_clock_begin(id_clock_update) + if (present(h_ice)) then + !$OMP parallel do default(shared) + do J=LB%jsh-1,LB%jeh ; do i=LB%ish,LB%ieh + if (vh(i,J) < 0.0) then ; vh_ice(i,J) = vh(i,J) * (h_ice(i,j+1) / h_in(i,j+1)) + elseif (vh(i,J) > 0.0) then ; vh_ice(i,J) = vh(i,J) * (h_ice(i,j) / h_in(i,j)) + else ; vh_ice(i,J) = 0.0 ; endif + 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)) + 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)) + ! 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 + ! call SIS_error(FATAL, 'ice mass exceeds total mass in ice_total_continuity() y-1.') + ! endif ; endif + enddo ; enddo + call cpu_clock_end(id_clock_update) + + ! 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 cpu_clock_begin(id_clock_update) + + if (present(h_ice)) then + !$OMP parallel do default(shared) + do j=LB%jsh,LB%jeh + do I=LB%ish-1,LB%ieh + if (uh(I,j) < 0.0) then ; uh_ice(I,j) = uh(I,j) * (h_ice(i+1,j) / h(i+1,j)) + elseif (uh(I,j) > 0.0) then ; uh_ice(I,j) = uh(I,j) * (h_ice(i,j) / h(i,j)) + 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)) + 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)) + 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 + ! call SIS_error(FATAL, 'ice mass exceeds total mass in ice_total_continuity() y-2.') + ! endif ; endif + enddo ; enddo + call cpu_clock_end(id_clock_update) + + endif ! End of x_first block. + +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, & + 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 + 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]. + 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(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)), & + optional, intent(inout) :: h1 !< Updated mass of medium 1 (often ice) by + !! 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]. + 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]. + 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]. + 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]. + 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]. + 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]. + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: h_tot ! Total thicknesses [H ~> kg m-2]. + real, dimension(SZI_(G),SZJ_(G)) :: I_htot ! The Adcroft reciprocal of the total thicknesses [H-1 ~> m2 kg-1]. + type(loop_bounds_type) :: LB ! A structure with the active loop bounds. + real :: h_up + integer :: is, ie, js, je, nCat, stensil + integer :: i, j, k + + logical :: x_first + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nCat = IG%CatIce + + if (.not.associated(CS)) call SIS_error(FATAL, & + "SIS_continuity: Module must be initialized before it is used.") + 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().') + endif ; enddo ; enddo + + !$OMP parallel do default(shared) + do j=js-1,je+1 ; do i=is-1,ie+1 + I_htot(i,j) = 0.0 ; if (h_tot_in(i,j) > 0.0) I_htot(i,j) = 1.0 / h_tot_in(i,j) + enddo ; enddo + + if (CS%use_upwind2d) then + ! Both directions are updated based on the original thicknesses. + LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec + + if (present(h1)) then + call zonal_proportionate_fluxes(uh_tot, I_htot, h1, uh1, G, IG, LB) + 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 * & + ((uh1(I,j,k) - uh1(I-1,j,k)) + (vh1(i,J,k) - vh1(i,J-1,k)))) + enddo ; enddo ; enddo + endif + if (present(h2)) then + call zonal_proportionate_fluxes(uh_tot, I_htot, h2, uh2, G, IG, LB) + 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 * & + ((uh2(I,j,k) - uh2(I-1,j,k)) + (vh2(i,J,k) - vh2(i,J-1,k)))) + enddo ; enddo ; enddo + endif + if (present(h3)) then + call zonal_proportionate_fluxes(uh_tot, I_htot, h3, uh3, G, IG, LB) + 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 * & + ((uh3(I,j,k) - uh3(I-1,j,k)) + (vh3(i,J,k) - vh3(i,J-1,k)))) + enddo ; enddo ; enddo + endif + + elseif (x_first) then + ! First, advect zonally. + LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc-1 ; LB%jeh = G%jec+1 + if (present(h1)) then + 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))) + 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))) + 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))) + 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)) + 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) + enddo ; enddo + + ! Now advect meridionally, using the updated thicknesses to determine the fluxes. + LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec + if (present(h1)) then + 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)) ) + 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)) ) + 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)) ) + 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)) + 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) + enddo ; enddo + + else ! .not. x_first + ! First, advect meridionally, so set the loop bounds accordingly. + LB%ish = G%isc-1 ; LB%ieh = G%iec+1 ; LB%jsh = G%jsc ; LB%jeh = G%jec + + if (present(h1)) then + 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)) ) + 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)) ) + 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)) ) + 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)) + 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) + enddo ; enddo + + + ! 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 + if (present(h1)) then + 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))) + 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))) + 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))) + 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)) + 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) + enddo ; enddo + + endif ! End of x_first block. + +end subroutine proportionate_continuity + +!> Calculate zonal fluxes by category that are proportionate to the relative masses in the upwind cell. +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]. + 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]. + type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. + + ! Local variables + integer :: i, j, k, ish, ieh, jsh, jeh, nCat + + ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nCat = IG%CatIce + !$OMP parallel do default(shared) + do j=jsh,jeh ; do k=1,nCat ; do I=ish-1,ieh + if (uh_tot(I,j) < 0.0) then ; uh(I,j,k) = (h(i+1,j,k) * I_htot(i+1,j)) * uh_tot(I,j) + elseif (uh_tot(I,j) > 0.0) then ; uh(I,j,k) = (h(i,j,k) * I_htot(i,j)) * uh_tot(I,j) + else ; uh(i,j,k) = 0.0 ; endif + enddo ; enddo ; enddo + +end subroutine zonal_proportionate_fluxes + +!> Calculate meridional mass fluxes by category that are proportionate to the relative masses in the upwind cell. +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]. + 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]. + type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. + + ! Local variables + integer :: i, j, k, ish, ieh, jsh, jeh, nCat + + ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nCat = IG%CatIce + !$OMP parallel do default(shared) + do J=jsh-1,jeh ; do k=1,nCat ; do i=ish,ieh + if (vh_tot(i,J) < 0.0) then ; vh(i,J,k) = (h(i,J+1,k) * I_htot(i,J+1)) * vh_tot(i,J) + elseif (vh_tot(i,J) > 0.0) then ; vh(i,J,k) = (h(i,j,k) * I_htot(i,j)) * vh_tot(i,J) + else ; vh(i,j,k) = 0.0 ; endif + enddo ; enddo ; enddo + +end subroutine merid_proportionate_fluxes + !> Calculates the mass or volume fluxes through the zonal !! faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt, G, IG, CS, LB) +subroutine zonal_mass_flux(u, dt, G, 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, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: h_in !< Category thickness used to calculate the fluxes, in H. - real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & - intent(out) :: uh !< Volume flux through zonal faces = u*h*dy, H m2 s-1. - real, intent(in) :: dt !< Time increment in s + intent(in) :: u !< Zonal ice velocity [m s-1]. + real, intent(in) :: dt !< Time increment [s] 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. + + real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & + 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]. + 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]. ! This subroutine calculates the mass or volume fluxes through the zonal ! faces, and other related quantities. ! Local variables ! real, dimension(SZIB_(G)) :: & -! duhdu ! Partial derivative of uh with u, in H m. +! duhdu ! Partial derivative of uh with u [H m ~> kg m-1]. real, dimension(SZI_(G),SZJ_(G)) :: & - htot, & ! The total thickness summed across categories, in H. - I_htot, & ! The inverse of htot or 0, in H-1. - hl, hr ! Left and right face thicknesses, in H. + htot, & ! The total thickness summed across categories [H ~> kg m-2]. + I_htot, & ! The inverse of htot or 0 [H-1 ~> m2 kg-1]. + hl, hr ! Left and right face thicknesses [H ~> kg m-2]. real, dimension(SZIB_(G)) :: & - uhtot ! The total transports in H m2 s-1. - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + uhtot ! The total transports [H m2 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, in H. - real :: dx_E, dx_W ! Effective x-grid spacings to the east and west, in m. +! 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]. integer :: i, j, k, ish, ieh, jsh, jeh, nz ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = IG%CatIce @@ -242,15 +878,19 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, IG, CS, LB) call cpu_clock_begin(id_clock_update) htot(:,:) = 0.0 -!$OMP parallel do default(none) shared(jsh,jeh,nz,G,htot,h_in,I_htot) - do j=jsh,jeh - do k=1,nz ; do i=G%isd,G%ied - htot(i,j) = htot(i,j) + h_in(i,j,k) + if (present(htot_in)) then + !$OMP parallel do default(shared) + do j=jsh,jeh ; do i=G%isd,G%ied + htot(i,j) = htot(i,j) + htot_in(i,j) enddo ; enddo - do i=G%isd,G%ied - I_htot(i,j) = 0.0 ; if (htot(i,j) > 0.0) I_htot(i,j) = 1.0 / htot(i,j) - enddo - enddo + elseif (present(h_in)) then + !$OMP parallel do default(shared) + do j=jsh,jeh ; do k=1,nz ; do i=G%isd,G%ied + htot(i,j) = htot(i,j) + h_in(i,j,k) + enddo ; enddo ; enddo + else + call SIS_error(FATAL, "Either h_in or htot_in must be present in call to zonal_mass_flux.") + endif ! This sets hl and hr. if (CS%upwind_1st) then @@ -292,13 +932,22 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, IG, CS, LB) enddo ! Partition the transports by category in proportion to their relative masses. - do k=1,nz ; do I=ish-1,ieh - if (u(I,j) >= 0.0) then - uh(I,j,k) = uhtot(I) * (h_in(i,j,k) * I_htot(i,j)) - else - uh(I,j,k) = uhtot(I) * (h_in(i+1,j,k) * I_htot(i+1,j)) - endif - enddo ; enddo + if (present(uh)) then + do i=ish-1,ieh+1 + I_htot(i,j) = 0.0 ; if (htot(i,j) > 0.0) I_htot(i,j) = 1.0 / htot(i,j) + enddo + do k=1,nz ; do I=ish-1,ieh + if (u(I,j) >= 0.0) then + uh(I,j,k) = uhtot(I) * (h_in(i,j,k) * I_htot(i,j)) + else + uh(I,j,k) = uhtot(I) * (h_in(i+1,j,k) * I_htot(i+1,j)) + endif + enddo ; enddo + endif + + if (present(uh_tot)) then ; do I=ish-1,ieh + uh_tot(I,j) = uhtot(I) + enddo ; endif enddo ! j-loop call cpu_clock_end(id_clock_correct) @@ -307,37 +956,43 @@ end subroutine zonal_mass_flux !> Calculates the mass or volume fluxes through the meridional !! faces, and other related quantities. -subroutine meridional_mass_flux(v, h_in, vh, dt, G, IG, CS, LB) +subroutine meridional_mass_flux(v, dt, G, 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, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: h_in !< Category thickness used to calculate the fluxes, in H. - real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & - intent(out) :: vh !< Volume flux through meridional faces = u*h*dy, H m2 s-1. - real, intent(in) :: dt !< Time increment in s + intent(in) :: v !< Meridional ice velocity [m s-1]. + real, intent(in) :: dt !< Time increment [s] 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. + real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & + 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]. + 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]. ! This subroutine calculates the mass or volume fluxes through the meridional ! faces, and other related quantities. ! Local variables real, dimension(SZI_(G)) :: & - dvhdv ! Partial derivative of vh with v, in m2. + dvhdv ! Partial derivative of vh with v [H m ~> kg m-1]. real, dimension(SZI_(G),SZJ_(G)) :: & - htot, & ! The total thickness summed across categories, in H. - I_htot, & ! The inverse of htot or 0, in H-1. - hl, hr ! Left and right face thicknesses, in m. + htot, & ! The total thickness summed across categories [H ~> kg m-2]. + 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 in H m2 s-1. - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + vhtot ! The total transports [H m2 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, in m. - real :: dy_N, dy_S ! Effective y-grid spacings to the north and south, in m. + 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]. integer :: i, j, k, ish, ieh, jsh, jeh, nz ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = IG%CatIce @@ -346,15 +1001,22 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, IG, CS, LB) htot(:,:) = 0.0 -!$OMP parallel do default(none) shared(ish,ieh,G,nz,htot,h_in,I_htot) - do j=G%jsd,G%jed - do k=1,nz ; do i=ish,ieh - htot(i,j) = htot(i,j) + h_in(i,j,k) + if (present(htot_in)) then + !$OMP parallel do default(shared) + do j=G%jsd,G%jed ; do i=ish,ieh + htot(i,j) = htot(i,j) + htot_in(i,j) enddo ; enddo - do i=ish,ieh - I_htot(i,j) = 0.0 ; if (htot(i,j) > 0.0) I_htot(i,j) = 1.0 / htot(i,j) - enddo - enddo + elseif (present(h_in)) then + !$OMP parallel do default(shared) + do j=G%jsd,G%jed ; do k=1,nz ; do i=ish,ieh + htot(i,j) = htot(i,j) + h_in(i,j,k) + enddo ; enddo ; enddo + else + call SIS_error(FATAL, "Either h_in or htot_in must be present in call to meridional_mass_flux.") + endif + if (present(vh)) then ; do j=jsh-1,jeh+1 ; do i=ish,ieh + I_htot(i,j) = 0.0 ; if (htot(i,j) > 0.0) I_htot(i,j) = 1.0 / htot(i,j) + enddo ; enddo ; endif ! This sets hl and hr. if (CS%upwind_1st) then @@ -394,13 +1056,17 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, IG, CS, LB) enddo ! Partition the transports by category in proportion to their relative masses. - do k=1,nz ; do i=ish,ieh + if (present(vh)) then ; do k=1,nz ; do i=ish,ieh if (v(i,J) >= 0.0) then vh(i,J,k) = vhtot(i) * (h_in(i,j,k) * I_htot(i,j)) else vh(i,J,k) = vhtot(i) * (h_in(i,j+1,k) * I_htot(i,j+1)) endif - enddo ; enddo + enddo ; enddo ; endif + + if (present(vh_tot)) then ; do i=ish,ieh + vh_tot(i,J) = vhtot(i) + enddo ; endif enddo ! j-loop call cpu_clock_end(id_clock_correct) @@ -410,12 +1076,12 @@ end subroutine meridional_mass_flux !> Calculate a piecewise parabolic thickness reconstruction in the x-direction. subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, h_min, monotonic, simple_2nd) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category, in H - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of thickness reconstruction, in H - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of thickness reconstruction, in H + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of thickness reconstruction [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of thickness reconstruction [H ~> kg m-2] type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. real, intent(in) :: h_min !< The minimum thickness that can be - !! obtained by a concave parabolic fit, in H. + !! obtained by a concave parabolic fit [H ~> kg m-2]. logical, optional, intent(in) :: monotonic !< If true, use the Colella & Woodward monotonic limiter. !! Otherwise use a simple positive-definite limiter. logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean thicknesses as the @@ -452,8 +1118,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, h_min, monotonic, simple_ endif if (use_2nd) then -!$OMP parallel do default(none) shared(isl,iel,jsl,jel,G,h_in,h_l,h_r) & -!$OMP private(h_im1,h_ip1) + !$OMP parallel do default(shared) private(h_im1,h_ip1) do j=jsl,jel ; do i=isl,iel h_im1 = G%mask2dT(i-1,j) * h_in(i-1,j) + (1.0-G%mask2dT(i-1,j)) * h_in(i,j) h_ip1 = G%mask2dT(i+1,j) * h_in(i+1,j) + (1.0-G%mask2dT(i+1,j)) * h_in(i,j) @@ -461,8 +1126,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, h_min, monotonic, simple_ h_r(i,j) = 0.5*( h_ip1 + h_in(i,j) ) enddo ; enddo else -!$OMP parallel do default(none) shared(isl,iel,jsl,jel,G,h_in,h_l,h_r,slp) & -!$OMP private(dMx,dMn,h_im1,h_ip1) + !$OMP parallel do default(shared) private(dMx,dMn,h_im1,h_ip1) do j=jsl,jel do i=isl-1,iel+1 if ((G%mask2dT(i-1,j) * G%mask2dT(i,j) * G%mask2dT(i+1,j)) == 0.0) then @@ -504,12 +1168,12 @@ end subroutine PPM_reconstruction_x !> Calculate a piecewise parabolic thickness reconstruction in the y-direction. subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, h_min, monotonic, simple_2nd) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category, in H - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of thickness reconstruction, in H - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of thickness reconstruction, in H + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of thickness reconstruction [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of thickness reconstruction [H ~> kg m-2] type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. real, intent(in) :: h_min !< The minimum thickness that can be - !! obtained by a concave parabolic fit, in H. + !! obtained by a concave parabolic fit [H ~> kg m-2]. logical, optional, intent(in) :: monotonic !< If true, use the Colella & Woodward monotonic limiter. !! Otherwise use a simple positive-definite limiter. logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean thicknesses as the @@ -546,8 +1210,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, h_min, monotonic, simple_ endif if (use_2nd) then -!$OMP parallel do default(none) shared(isl,iel,jsl,jel,G,h_in,h_l,h_r) & -!$OMP private(h_jm1,h_jp1) + !$OMP parallel do default(shared) private(h_jm1,h_jp1) do j=jsl,jel ; do i=isl,iel h_jm1 = G%mask2dT(i,j-1) * h_in(i,j-1) + (1.0-G%mask2dT(i,j-1)) * h_in(i,j) h_jp1 = G%mask2dT(i,j+1) * h_in(i,j+1) + (1.0-G%mask2dT(i,j+1)) * h_in(i,j) @@ -555,8 +1218,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, h_min, monotonic, simple_ h_r(i,j) = 0.5*( h_jp1 + h_in(i,j) ) enddo ; enddo else -!$OMP parallel do default(none) shared(isl,iel,jsl,jel,G,h_in,slp) & -!$OMP private(dMx,dMn) + !$OMP parallel do default(shared) private(dMx,dMn) do j=jsl-1,jel+1 ; do i=isl,iel if ((G%mask2dT(i,j-1) * G%mask2dT(i,j) * G%mask2dT(i,j+1)) == 0.0) then slp(i,j) = 0.0 @@ -570,8 +1232,7 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, h_min, monotonic, simple_ ! * (G%mask2dT(i,j-1) * G%mask2dT(i,j) * G%mask2dT(i,j+1)) endif enddo ; enddo -!$OMP parallel do default(none) shared(isl,iel,jsl,jel,G,h_in,h_l,h_r,slp) & -!$OMP private(h_jm1,h_jp1) + !$OMP parallel do default(shared) private(h_jm1,h_jp1) do j=jsl,jel ; do i=isl,iel ! Neighboring values should take into account any boundaries. h_jm1 = G%mask2dT(i,j-1) * h_in(i,j-1) + (1.0-G%mask2dT(i,j-1)) * h_in(i,j) @@ -595,11 +1256,11 @@ end subroutine PPM_reconstruction_y !! reconstruction that is positive-definite. subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category, in H - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value of thickness reconstruction, in H - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value of thickness reconstruction, in H + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value of thickness reconstruction [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value of thickness reconstruction [H ~> kg m-2] real, intent(in) :: h_min !< The minimum thickness that can be - !! obtained by a concave parabolic fit, in H. + !! obtained by a concave parabolic fit [H ~> kg m-2]. integer, intent(in) :: iis !< The starting i-index to work on integer, intent(in) :: iie !< The ending i-index to work on integer, intent(in) :: jis !< The starting j-index to work on @@ -640,9 +1301,9 @@ end subroutine PPM_limit_pos !! using prescription of Colella and Woodward, 1984. subroutine PPM_limit_CW84(h_in, h_l, h_r, G, iis, iie, jis, jie) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category, in H - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value of thickness reconstruction, in H - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value of thickness reconstruction, in H + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Initial thickness of a category [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value of thickness reconstruction [H ~> kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value of thickness reconstruction [H ~> kg m-2] integer, intent(in) :: iis !< The starting i-index to work on integer, intent(in) :: iie !< The ending i-index to work on integer, intent(in) :: jis !< The starting j-index to work on @@ -675,14 +1336,17 @@ subroutine PPM_limit_CW84(h_in, h_l, h_r, G, iis, iie, jis, jie) end subroutine PPM_limit_CW84 !> Initializes the sea ice continuity module -subroutine SIS_continuity_init(Time, G, param_file, diag, CS) - type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, - !! set with the current model time. +subroutine SIS_continuity_init(Time, G, param_file, diag, CS, CS_cvr) + 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(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_continuity_CS), pointer :: CS !< The control structure for this module that - !! is allocated and populated here. + type(SIS_continuity_CS), pointer :: CS !< The control structure for mass transport that + !! is carried out by this module; it is allocated + !! and populated here. + type(SIS_continuity_CS), optional, pointer :: CS_cvr !< A secondary control structure for the + !! transport of ice cover. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -707,17 +1371,11 @@ subroutine SIS_continuity_init(Time, G, param_file, diag, CS) CS%use_upwind2d = .false. ; CS%upwind_1st = .false. ; CS%simple_2nd = .false. CS%monotonic = .false. select case (trim(mesg)) - case ("UPWIND_2D") - CS%use_upwind2d = .true. - case ("PCM") - CS%upwind_1st = .true. - case ("PPM:C2PD") - CS%simple_2nd = .true. - case ("PPM:C2MO") - CS%simple_2nd = .true. - CS%monotonic = .true. - case default - call SIS_error(FATAL, "SIS_continuity, SIS_continuity_init: "//& + case ("UPWIND_2D") ; CS%use_upwind2d = .true. + case ("PCM") ; CS%upwind_1st = .true. + case ("PPM:C2PD") ; CS%simple_2nd = .true. + case ("PPM:C2MO") ; CS%simple_2nd = .true. ; CS%monotonic = .true. + case default ; call SIS_error(FATAL, "SIS_continuity, SIS_continuity_init: "//& "Unknown SIS_CONTINUITY_SCHEME = "//trim(mesg)) end select call obsolete_logical(param_file, "MONOTONIC_CONTINUITY", & @@ -736,6 +1394,33 @@ subroutine SIS_continuity_init(Time, G, param_file, diag, CS) CS%diag => diag + if (present(CS_cvr)) then + allocate(CS_cvr) + + call get_param(param_file, mdl, "SIS_COVER_TRANSPORT_SCHEME", mesg, & + desc="The horizontal transport scheme used for projections of ice cover:\n"//& + " UPWIND_2D - Non-directionally split upwind\n"//& + " PCM - Directionally split piecewise constant\n"//& + " PPM:C2PD - Positive definite PPM with 2nd order edge values\n"//& + " PPM:C2MO - Monotonic PPM with 2nd order edge values\n", & + default='UPWIND_2D') + CS_cvr%use_upwind2d = .false. ; CS_cvr%upwind_1st = .false. ; CS_cvr%simple_2nd = .false. + CS_cvr%monotonic = .false. + select case (trim(mesg)) + case ("UPWIND_2D") ; CS_cvr%use_upwind2d = .true. + case ("PCM") ; CS_cvr%upwind_1st = .true. + case ("PPM:C2PD") ; CS_cvr%simple_2nd = .true. + case ("PPM:C2MO") ; CS_cvr%simple_2nd = .true. ; CS_cvr%monotonic = .true. + case default ; call SIS_error(FATAL, "SIS_continuity, SIS_continuity_init: "//& + "Unknown SIS_COVER_TRANSPORT_SCHEME = "//trim(mesg)) + end select + + call get_param(param_file, mdl, "COVER_PPM_VOLUME_BASED_CFL", CS_cvr%vol_CFL, & + "If true, use the ratio of the open face lengths to the cell\n"//& + "areas when estimating CFL numbers in ice cover transport.", & + default=.false.) + endif + id_clock_update = cpu_clock_id('(Ocean continuity update)', grain=CLOCK_ROUTINE) id_clock_correct = cpu_clock_id('(Ocean continuity correction)', grain=CLOCK_ROUTINE) diff --git a/src/SIS_ctrl_types.F90 b/src/SIS_ctrl_types.F90 index 10222975..974efa48 100644 --- a/src/SIS_ctrl_types.F90 +++ b/src/SIS_ctrl_types.F90 @@ -4,14 +4,15 @@ module SIS_ctrl_types ! use mpp_mod, only: mpp_sum, stdout, input_nml_file, PE_here => mpp_pe ! use mpp_domains_mod, only: domain2D, mpp_get_compute_domain, CORNER, EAST, NORTH -use mpp_domains_mod, only: domain2D, CORNER, EAST, NORTH -! use mpp_parameter_mod, only: CGRID_NE, BGRID_NE, AGRID -use coupler_types_mod,only: coupler_2d_bc_type, coupler_3d_bc_type -use coupler_types_mod,only: coupler_type_initialized, coupler_type_set_diags +use mpp_domains_mod, only : domain2D, CORNER, EAST, NORTH +! use mpp_parameter_mod, only : CGRID_NE, BGRID_NE, AGRID +use coupler_types_mod, only : coupler_2d_bc_type, coupler_3d_bc_type +use coupler_types_mod, only : coupler_type_initialized, coupler_type_set_diags use SIS_dyn_trans, only : dyn_trans_CS use SIS_fast_thermo, only : fast_thermo_CS use SIS_slow_thermo, only : slow_thermo_CS +use specified_ice, only : specified_ice_CS use SIS_hor_grid, only : SIS_hor_grid_type use ice_grid, only : ice_grid_type @@ -99,6 +100,7 @@ module SIS_ctrl_types logical :: Cgrid_dyn !< If true use a C-grid discretization of the !! sea-ice dynamics. + logical :: slab_ice !< If true, use the archaic GFDL slab ice. logical :: specified_ice !< If true, the sea ice is specified and there is !! no need for ice dynamics. logical :: pass_stress_mag !< If true, calculate the time-mean magnitude of the @@ -127,6 +129,8 @@ module SIS_ctrl_types !! structure for the slow ice thermodynamics. type(dyn_trans_CS), pointer :: dyn_trans_CSp => NULL() !< A pointer to the control !! structure for the ice dynamics and transport. + type(specified_ice_CS), pointer :: specified_ice_CSp => NULL() !< A pointer to the control + !! structure for the specified ice. type(fast_thermo_CS), pointer :: fast_thermo_CSp => NULL() !< A pointer to the control !! structure for the fast ice thermodynamics. type(SIS_optics_CS), pointer :: optics_CSp => NULL() !< A pointer to the control @@ -187,7 +191,7 @@ subroutine ice_diagnostics_init(IOF, OSS, FIA, G, IG, diag, Time, Cgrid) !! sea ice velocities. The default is true. real, dimension(G%isc:G%iec,G%jsc:G%jec) :: tmp_diag ! A temporary diagnostic array - real :: I_area_Earth ! The inverse of the area of the sphere, in m-2. + real :: I_area_Earth ! The inverse of the area of the sphere [m-2]. real, parameter :: missing = -1e34 ! The fill value for missing data. integer :: id_geo_lon, id_geo_lat, id_sin_rot, id_cos_rot, id_cell_area logical :: Cgrid_dyn diff --git a/src/SIS_debugging.F90 b/src/SIS_debugging.F90 index 6d548aa8..c76f889b 100644 --- a/src/SIS_debugging.F90 +++ b/src/SIS_debugging.F90 @@ -115,12 +115,6 @@ subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & integer, optional, intent(in) :: js !< The starting j-index to work on integer, optional, intent(in) :: je !< The ending j-index to work on integer, optional, intent(in) :: direction !< The direction flag to pass to pass_vector -! Arguments: u_comp - The u-component of the vector being checked. -! (in) v_comp - The v-component of the vector being checked. -! (in) mesg - A message indicating what is being checked. -! (in) G - The ocean's grid structure. -! (in/opt) is, ie, js, je - the i- and j- range of indices to check. -! (in/opt) direction - the direction flag to be passed to pass_vector. character(len=24) :: mesg_k integer :: k diff --git a/src/SIS_diag_mediator.F90 b/src/SIS_diag_mediator.F90 index 1c3d2739..86accbed 100644 --- a/src/SIS_diag_mediator.F90 +++ b/src/SIS_diag_mediator.F90 @@ -478,8 +478,8 @@ end subroutine post_data_3d !> Enable the accumulation of time averages over the specified time interval. subroutine enable_SIS_averaging(time_int_in, time_end_in, diag_cs) - real, intent(in) :: time_int_in !< The time interval in s over which any -! !! values that are offered are valid. + real, intent(in) :: time_int_in !< The time interval over which any values +! !! that are offered are valid [s]. type(time_type), intent(in) :: time_end_in !< The end time of the valid interval. type(SIS_diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output ! This subroutine enables the accumulation of time averages over the @@ -503,7 +503,7 @@ end subroutine disable_SIS_averaging !> Indicate whether averaging diagnostics is currently enabled logical function query_SIS_averaging_enabled(diag_cs, time_int, time_end) type(SIS_diag_ctrl), intent(in) :: diag_cs !< A structure that is used to regulate diagnostic output - real, optional, intent(out) :: time_int !< The current setting of diag_cs%time_int, in s. + real, optional, intent(out) :: time_int !< The current setting of diag_cs%time_int [s]. type(time_type), optional, intent(out) :: time_end !< The current setting of diag_cs%time_end. if (present(time_int)) time_int = diag_cs%time_int diff --git a/src/SIS_dyn_bgrid.F90 b/src/SIS_dyn_bgrid.F90 index c599d115..153a88ad 100644 --- a/src/SIS_dyn_bgrid.F90 +++ b/src/SIS_dyn_bgrid.F90 @@ -32,23 +32,20 @@ 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 in Pa m (or N m-1). - sig12 => NULL(), & !< The xy and yx component of the stress tensor in Pa m (or N m-1). - sig22 => NULL() !< The yy component of the stress tensor in Pa m (or N m-1). + 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). ! parameters for calculating water drag and internal ice stresses - logical :: SLAB_ICE = .false. !< should we do old style GFDL slab ice? - real :: p0 = 2.75e4 !< Hibbler rheology pressure constant (Pa) - real :: p0_rho !< The pressure constant divided by ice density, N m kg-1. + 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 :: cdw = 3.24e-3 !< ice/water drag coef. (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 :: MIV_MIN = 1.0 !< min ice mass to do dynamics (kg/m^2) - real :: Rho_ocean = 1030.0 !< The nominal density of sea water, in kg m-3. - real :: Rho_ice = 905.0 !< The nominal density of sea ice, in kg m-3. - logical :: specified_ice !< If true, the sea ice is specified and there is - !! no need for ice dynamics. + 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]. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_redundant !< If true, debug redundant points integer :: evp_sub_steps !< The number of iterations in the EVP dynamics @@ -97,26 +94,16 @@ subroutine SIS_B_dyn_init(Time, G, param_file, diag, CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version) - call get_param(param_file, mdl, "SPECIFIED_ICE", CS%specified_ice, & - "If true, the ice is specified and there is no dynamics.", & - default=.false.) - if ( CS%specified_ice ) then - CS%evp_sub_steps = 0 ; CS%dt_Rheo = -1.0 - call log_param(param_file, mdl, "NSTEPS_DYN", CS%evp_sub_steps, & - "The number of iterations in the EVP dynamics for each \n"//& - "slow time step. With SPECIFIED_ICE this is always 0.") - else - call get_param(param_file, mdl, "DT_RHEOLOGY", CS%dt_Rheo, & + 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", & default=-1.0) - CS%evp_sub_steps = -1 - if (CS%dt_Rheo <= 0.0) & - call get_param(param_file, mdl, "NSTEPS_DYN", CS%evp_sub_steps, & + CS%evp_sub_steps = -1 + if (CS%dt_Rheo <= 0.0) & + call get_param(param_file, mdl, "NSTEPS_DYN", CS%evp_sub_steps, & "The number of iterations of the rheology and ice \n"//& "momentum equations for each slow ice time step.", default=432) - endif call get_param(param_file, mdl, "ICE_STRENGTH_PSTAR", CS%p0, & "A constant in the expression for the ice strength, \n"//& @@ -146,15 +133,6 @@ subroutine SIS_B_dyn_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "DEBUG_REDUNDANT", CS%debug_redundant, & "If true, debug redundant data points.", default=CS%debug, & debuggingParam=.true.) - if ( CS%specified_ice ) then - CS%slab_ice = .true. - call log_param(param_file, mdl, "USE_SLAB_ICE", CS%slab_ice, & - "Use the very old slab-style ice. With SPECIFIED_ICE, \n"//& - "USE_SLAB_ICE is always true.") - else - call get_param(param_file, mdl, "USE_SLAB_ICE", CS%slab_ice, & - "If true, use the very old slab-style ice.", default=.false.) - endif call get_param(param_file, mdl, "AIR_WATER_STRESS_TURN_ANGLE", CS%blturn, & "An angle by which to rotate the velocities at the air- \n"//& "water boundary in calculating stresses.", units="degrees", & @@ -199,8 +177,8 @@ 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) 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) :: 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 type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module ! integer, intent(in) :: nCat !< The number of sea ice categories. @@ -266,28 +244,29 @@ end subroutine find_ice_strength !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_B_dynamics takes a single dynamics timestep with EVP subcycles -subroutine SIS_B_dynamics(ci, msnow, 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, 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) - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: msnow !< Mass per unit ocean area of snow (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 in m s-1 - real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity in m s-1 - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: uo !< Zonal ocean velocity in m s-1 - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity in m s-1 - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fxat !< Zonal air stress on ice in Pa - real, dimension(SZIB_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice in Pa + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci !< Sea ice concentration [nondim] + 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(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, in m. - real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean in Pa - real, dimension(SZIB_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean in Pa + !! 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] 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, in s. + !! dynamics are to be advanced [s]. type(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module ! Local variables @@ -298,7 +277,6 @@ subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & real :: zeta, eta ! bulk/shear viscosities real, dimension(SZI_(G),SZJ_(G)) :: strn11, strn12, strn22 ! strain tensor - real, dimension(SZI_(G),SZJ_(G)) :: mit ! mass on t-points 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 @@ -314,7 +292,7 @@ subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & ! temporaries for ice stress calculation real :: del2, a, b, tmp - real, dimension(SZI_(G),SZJ_(G)) :: edt ! The elasticity (E) times a time-step, in Pa m s. + 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 @@ -323,7 +301,7 @@ subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & ! for velocity calculation real, dimension(SZIB_(G),SZJB_(G)) :: dtmiv - real :: dt_Rheo ! The short timestep associated with the rheology, in s. + real :: dt_Rheo ! The short timestep associated with the rheology [s]. real :: I_2dt_Rheo ! 1.0 / (2*dt_Rheo) integer :: EVP_steps ! The number of EVP sub-steps that will actually be taken. real :: I_sub_steps @@ -352,12 +330,6 @@ subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & fxic(:,:) = 0.0 ; fyic(:,:) = 0.0 fxco(:,:) = 0.0 ; fyco(:,:) = 0.0 - if (CS%SLAB_ICE) then - ui(:,:) = uo(:,:) ; vi(:,:) = vo(:,:) - fxoc(:,:) = fxat(:,:) ; fyoc(:,:) = fyat(:,:) - return - end if - if ((CS%evp_sub_steps<=0) .and. (CS%dt_Rheo<=0.0)) return if (CS%dt_Rheo > 0.0) then @@ -381,8 +353,7 @@ subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & !TOM> check where ice is present do j=jsc,jec ; do i=isc,iec - ice_present(i,j) = ( (G%mask2dT(i,j)>0.5) .and. & - (mice(i,j) + msnow(i,j) > CS%MIV_MIN) ) + ice_present(i,j) = ( (G%mask2dT(i,j)>0.5) .and. (misp(i,j) > CS%MIV_MIN) ) enddo ; enddo ! sea level slope force @@ -394,11 +365,8 @@ subroutine SIS_B_dynamics(ci, msnow, mice, ui, vi, uo, vo, & enddo ; enddo ! put ice/snow mass and concentration on v-grid, first finding mass on t-grid. - do j=jsc-1,jec+1 ; do i=isc-1,iec+1 - mit(i,j) = mice(i,j) + msnow(i,j) - enddo ; enddo do J=jsc-1,jec ; do I=isc-1,iec ; if (G%mask2dBu(i,j) > 0.5 ) then - miv(I,J) = 0.25*( (mit(i+1,j+1) + mit(i,j)) + (mit(i+1,j) + mit(i,j+1)) ) + miv(I,J) = 0.25*( (misp(i+1,j+1) + misp(i,j)) + (misp(i+1,j) + misp(i,j+1)) ) civ(I,J) = 0.25*( (ci(i+1,j+1) + ci(i,j)) + (ci(i+1,j) + ci(i,j+1)) ) else miv(I,J) = 0.0 ; civ(I,J) = 0.0 @@ -501,8 +469,7 @@ subroutine SIS_B_dynamics(ci, msnow, 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. & - ((mice(i,j)+msnow(i,j)) > CS%MIV_MIN) ) then + 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) CS%sig11(i,j) = (t1(i,j)*f22 + f11) * It2(i,j) @@ -674,12 +641,12 @@ end subroutine SIS_B_dynamics !> sigI evaluates the first stress invariant function sigI(mi, ci, sig11, sig22, sig12, G, 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) :: sig11 !< The xx component of the stress tensor, in N m-1 - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig22 !< The yy component of the stress tensor, in N m-1 - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig12 !< The xy & yx component of the stress tensor, in N m-1 - real, dimension(SZI_(G),SZJ_(G)) :: sigI !< The first stress invariant, nondim + 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) :: sig11 !< The xx component of the stress tensor [N m-1] + 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(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module integer :: i, j, isc, iec, jsc, jec @@ -697,12 +664,12 @@ end function sigI !> sigII evaluates the second stress invariant function sigII(mi, ci, sig11, sig22, sig12, G, 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) :: sig11 !< The xx component of the stress tensor, in N m-1 - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig22 !< The yy component of the stress tensor, in N m-1 - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: sig12 !< The xy & yx component of the stress tensor, in N m-1 - real, dimension(SZI_(G),SZJ_(G)) :: sigII !< The second stress invariant, nondim + 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) :: sig11 !< The xx component of the stress tensor [N m-1] + 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(SIS_B_dyn_CS), pointer :: CS !< The control structure for this module integer :: i, j, isc, iec, jsc, jec @@ -773,17 +740,17 @@ subroutine ice_stress_old(isc,iec,jsc,jec,prs,strn11,strn22,strn12,edt,EC, & integer, intent(in ) :: iec !< The ending i-index to work on integer, intent(in ) :: jsc !< The starting i-index to work on integer, intent(in ) :: jec !< The ending j-index to work on - real, dimension(isc:iec,jsc:jec), intent(in ) :: prs !< The internal ice pressure in Pa m. - real, dimension(isc:iec,jsc:jec), intent(in ) :: strn11 !< The xx component of the strain rate, in s-1 - real, dimension(isc:iec,jsc:jec), intent(in ) :: strn22 !< The yy component of the strain rate, in s-1 - real, dimension(isc:iec,jsc:jec), intent(in ) :: strn12 !< The xy & yx component of the strain rate, in s-1 - real, dimension(isc:iec,jsc:jec), intent(in ) :: edt !< The ice elasticity times a time-step, in Pa m s. + real, dimension(isc:iec,jsc:jec), intent(in ) :: prs !< The internal ice pressure [Pa m]. + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn11 !< The xx component of the strain rate [s-1] + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn22 !< The yy component of the strain rate [s-1] + real, dimension(isc:iec,jsc:jec), intent(in ) :: strn12 !< The xy & yx component of the strain rate [s-1] + real, dimension(isc:iec,jsc:jec), intent(in ) :: edt !< The ice elasticity times a time-step [Pa m s]. real, intent(in ) :: EC !< The yeild curve axis ratio - real, dimension(isc:iec,jsc:jec), intent(inout) :: sig11 !< The xx component of the stress tensor, in N m-1 - real, dimension(isc:iec,jsc:jec), intent(inout) :: sig22 !< The yy component of the stress tensor, in N m-1 - real, dimension(isc:iec,jsc:jec), intent(inout) :: sig12 !< The xy & yx component of the stress tensor, in N m-1 + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig11 !< The xx component of the stress tensor [N m-1] + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig22 !< The yy component of the stress tensor [N m-1] + real, dimension(isc:iec,jsc:jec), intent(inout) :: sig12 !< The xy & yx component of the stress tensor [N m-1] real, dimension(isc:iec,jsc:jec), intent( out) :: del2 !< An elipticity modulated estimate of - !! the squared strain rate, in s-2. + !! the squared strain rate [s-2]. logical, dimension(isc:iec,jsc:jec), intent(in) :: ice_present !< True where there is any ice present in a cell ! integer :: i, j @@ -846,17 +813,17 @@ subroutine ice_stress_new(isc,iec,jsc,jec,prs,strn11,strn22,strn12,edt, EC, & integer, intent(in ) :: iec !< The ending i-index to work on integer, intent(in ) :: jsc !< The starting i-index to work on integer, intent(in ) :: jec !< The ending j-index to work on - real, dimension(isc:iec,jsc:jec), intent(in ) :: prs !< The internal ice pressure in Pa m. + real, dimension(isc:iec,jsc:jec), intent(in ) :: prs !< The internal ice pressure [Pa m]. real, dimension(isc:iec,jsc:jec), intent(in ) :: strn11 !< The xx component of the strain rate real, dimension(isc:iec,jsc:jec), intent(in ) :: strn22 !< The yy component of the strain rate real, dimension(isc:iec,jsc:jec), intent(in ) :: strn12 !< The xy & yx component of the strain rate - real, intent(in ) :: edt !< The ice elasticity times a time-step, in Pa m s. + real, intent(in ) :: edt !< The ice elasticity times a time-step [Pa m s]. real, intent(in ) :: EC !< The yeild curve axis ratio real, dimension(isc:iec,jsc:jec), intent(inout) :: sig11 !< The xx component of the stress tensor real, dimension(isc:iec,jsc:jec), intent(inout) :: sig22 !< The yy component of the stress tensor real, dimension(isc:iec,jsc:jec), intent(inout) :: sig12 !< The xy & yx component of the stress tensor real, dimension(isc:iec,jsc:jec), intent( out) :: del2 !< An elipticity modulated estimate of - !! the squared strain rate, in s-2. + !! the squared strain rate [s-2]. logical, dimension(isc:iec,jsc:jec), intent(in) :: ice_present !< True where there is any ice present in a cell ! integer :: i, j diff --git a/src/SIS_dyn_cgrid.F90 b/src/SIS_dyn_cgrid.F90 index a97a0a0a..e1f96d1e 100644 --- a/src/SIS_dyn_cgrid.F90 +++ b/src/SIS_dyn_cgrid.F90 @@ -42,35 +42,32 @@ 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, in Pa m. - str_d, & !< The divergence stress tensor component, in Pa m. - str_s !< The shearing stress tensor component (cross term), in Pa m. + str_t, & !< The tension stress tensor component [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 - logical :: SLAB_ICE = .false. !< If true do ancient GFDL slab ice that drifts with the ocean 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 :: 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, in kg m-3. - real :: Rho_ice = 905.0 !< The nominal density of sea ice, in kg m-3. + 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, in m2 s-2. + !< with the ocean squared [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 - !! their equilibrium solution due to the elastic terms, in s. + !! their equilibrium solution due to the elastic terms [s]. real :: del_sh_min_scale = 2.0 !< A scaling factor for the minimum permitted value of minimum - !! shears used in the denominator of the stress equations, nondim. + !! shears used in the denominator of the stress equations [nondim]. ! I suspect that this needs to be greater than 1. -RWH real :: CFL_trunc !< Velocity components will be truncated when they are large enough - !! that the corresponding CFL number exceeds this value, nondim. + !! that the corresponding CFL number exceeds this value [nondim]. logical :: CFL_check_its !< If true, check the CFL number for every iteration !! of the rheology solver; otherwise only check the !! final velocities that are used for transport. - logical :: specified_ice !< If true, the sea ice is specified and there is - !! no need for ice dynamics. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_EVP !< If true, write out verbose debugging data for each of !! the steps within the EVP solver. @@ -167,26 +164,16 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version) - call get_param(param_file, mdl, "SPECIFIED_ICE", CS%specified_ice, & - "If true, the ice is specified and there is no dynamics.", & - default=.false.) - if ( CS%specified_ice ) then - CS%evp_sub_steps = 0 ; CS%dt_Rheo = -1.0 - call log_param(param_file, mdl, "NSTEPS_DYN", CS%evp_sub_steps, & - "The number of iterations in the EVP dynamics for each \n"//& - "slow time step. With SPECIFIED_ICE this is always 0.") - else - call get_param(param_file, mdl, "DT_RHEOLOGY", CS%dt_Rheo, & + 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", & default=-1.0) - CS%evp_sub_steps = -1 - if (CS%dt_Rheo <= 0.0) & - call get_param(param_file, mdl, "NSTEPS_DYN", CS%evp_sub_steps, & + CS%evp_sub_steps = -1 + if (CS%dt_Rheo <= 0.0) & + call get_param(param_file, mdl, "NSTEPS_DYN", CS%evp_sub_steps, & "The number of iterations of the rheology and ice \n"//& "momentum equations for each slow ice time step.", default=432) - endif call get_param(param_file, mdl, "ICE_TDAMP_ELASTIC", CS%Tdamp, & "The damping timescale associated with the elastic terms \n"//& "in the sea-ice dynamics equations (if positive) or the \n"//& @@ -260,15 +247,6 @@ subroutine SIS_C_dyn_init(Time, G, param_file, diag, CS, ntrunc) call get_param(param_file, mdl, "DEBUG_REDUNDANT", CS%debug_redundant, & "If true, debug redundant data points.", default=CS%debug, & debuggingParam=.true.) - if ( CS%specified_ice ) then - CS%slab_ice = .true. - call log_param(param_file, mdl, "USE_SLAB_ICE", CS%slab_ice, & - "Use the very old slab-style ice. With SPECIFIED_ICE, \n"//& - "USE_SLAB_ICE is always true.") - else - call get_param(param_file, mdl, "USE_SLAB_ICE", CS%slab_ice, & - "If true, use the very old slab-style ice.", default=.false.) - endif call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & "The absolute path to the file where the accelerations \n"//& "leading to zonal velocity truncations are written. \n"//& @@ -437,8 +415,8 @@ 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 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) :: 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. type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module integer, optional, intent(in) :: halo_sz !< The halo size to work on @@ -454,91 +432,90 @@ end subroutine find_ice_strength !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_C_dynamics takes a single dynamics timestep with EVP subcycles -subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & +subroutine SIS_C_dynamics(ci, mis, mice, ui, vi, uo, vo, & fxat, fyat, sea_lev, fxoc, fyoc, dt_slow, G, 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) - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: msnow !< Mass per unit ocean area of snow (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 in m s-1 - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vi !< Meridional ice velocity in m s-1 - real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: uo !< Zonal ocean velocity in m s-1 - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vo !< Meridional ocean velocity in m s-1 - real, dimension(SZIB_(G),SZJ_(G)), intent(in ) :: fxat !< Zonal air stress on ice in Pa - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: fyat !< Meridional air stress on ice in Pa + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: ci !< Sea ice concentration [nondim] + 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(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, in m. - real, dimension(SZIB_(G),SZJ_(G)), intent( out) :: fxoc !< Zonal ice stress on ocean in Pa - real, dimension(SZI_(G),SZJB_(G)), intent( out) :: fyoc !< Meridional ice stress on ocean in Pa + !! 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, intent(in ) :: dt_slow !< The amount of time over which the ice - !! dynamics are to be advanced, in s. + !! dynamics are to be advanced [s]. 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, in s-1. + ! all metric terms [s-1]. sh_Dd ! sh_Dd is the flow divergence (du/dx + dv/dy) including all - ! metric terms, in s-1. + ! metric terms [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, in s-1. + ! including all metric terms [s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & - mis, & ! Total snow and ice mass per unit area, in kg m-2. - pres_mice, & ! The ice internal pressure per unit column mass, in N m / kg. - ci_proj, & ! The projected ice concentration, nondim. - zeta, & ! The ice bulk viscosity, in Pa m s or N s / m. - del_sh, & ! The magnitude of the shear rates, in s-1. + 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]. 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, - ! in 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, in m2. - dx_dyT, dy_dxT, & ! dx/dy or dy_dx at T points, nondim. - siu, siv, sispeed ! diagnostics on T points, m/s + ! value of del_sh that is used in the calculation of zeta [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]. real, dimension(SZIB_(G),SZJ_(G)) :: & - fxic, & ! Zonal force due to internal stresses, in Pa. + fxic, & ! Zonal force due to internal stresses [Pa]. fxic_d, fxic_t, fxic_s, & ui_min_trunc, & ! The range of v-velocities beyond which the velocities - ui_max_trunc, & ! are truncated, in m s-1, or 0 for land cells. - Cor_u, & ! Zonal Coriolis acceleration, in m s-2. - PFu, & ! Zonal hydrostatic pressure driven acceleration, in m s-2. + 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]. diag_val_u, & ! A temporary diagnostic array. - u_tmp, & ! A temporary copy of the old values of ui, in m s-1. - u_IC, & ! The initial zonal ice velocities, in m s-1. - mi_u, & ! The total ice and snow mass interpolated to u points, in kg m-2. + u_tmp, & ! A temporary copy of the old values of ui [m s-1]. + u_IC, & ! The initial zonal ice velocities [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, in s-1. - I1_f2dt2_u ! 1 / ( 1 + f^2 dt^2) at u-points, nondimensional. + ! time step [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, in Pa. + fyic, & ! Meridional force due to internal stresses [Pa]. fyic_d, fyic_t, fyic_s, & vi_min_trunc, & ! The range of v-velocities beyond which the velocities - vi_max_trunc, & ! are truncated, in m s-1, or 0 for land cells. - Cor_v, & ! Meridional Coriolis acceleration, in m s-2. - PFv, & ! Meridional hydrostatic pressure driven acceleration, in m s-2. + 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]. diag_val_v, & ! A temporary diagnostic array. - v_IC, & ! The initial meridional ice velocities, in m s-1. - mi_v, & ! The total ice and snow mass interpolated to v points, in kg m-2. + v_IC, & ! The initial meridional ice velocities [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, in s-1. - I1_f2dt2_v ! 1 / ( 1 + f^2 dt^2) at v-points, nondimensional. + ! time step [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, in m-2. - q, & ! A potential-vorticity-like field for the ice, the Coriolis - ! parameter divided by a spatially averaged mass per unit area, - ! in s-1 m2 kg-1. - dx2B, dy2B, & ! dx^2 or dy^2 at B points, in m2. - dx_dyB, dy_dxB ! dx/dy or dy_dx at B points, nondim. + ! 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]. + 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, @@ -547,39 +524,38 @@ subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & ! velocities, but with the influence going in opposite ! directions. - real :: Cor ! A Coriolis accleration, in m s-2. - real :: fxic_now, fyic_now ! ice internal stress convergence, in kg m-1 s-2. - real :: drag_u, drag_v ! Drag rates with the ocean at u & v points, in kg m-2 s-1. - real :: drag_max ! A maximum drag rate allowed in the ocean, in kg m-2 s-1. - real :: tot_area ! The sum of the area of the four neighboring cells, in m2. - real :: dxharm ! The harmonic mean of the x- and y- grid spacings, in m. + 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 :: tot_area ! The sum of the area of the four neighboring cells [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, in kg2 m-4. + ! area surrounding a vorticity point [kg2 m-4]. real :: muq, mvq ! The u- and v-face masses per unit cell area extrapolated - ! to a vorticity point on the coast, in kg m-2. - real :: pres_sum ! The sum of the internal ice pressures aroung a point, in Pa. - real :: min_rescale ! The smallest of the 4 surrounding values of rescale, ND. - real :: I_1pdt_T ! 1.0 / (1.0 + dt_2Tdamp) - real :: I_1pE2dt_T ! 1.0 / (1.0 + EC^2 * dt_2Tdamp) - - real :: v2_at_u ! The squared v-velocity interpolated to u points, in m s-1. - real :: u2_at_v ! The squared u-velocity interpolated to v points, in m s-1. + ! to a vorticity point on the coast [kg m-2]. + real :: pres_sum ! The sum of the internal ice pressures aroung a point [Pa]. + real :: min_rescale ! The smallest of the 4 surrounding values of rescale [nondim]. + 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 :: 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, all in m s-1. - real :: uio_C ! A u-velocity difference between the ocean and ice, in m s-1. - real :: vio_C ! A v-velocity difference between the ocean and ice, in m s-1. + ! 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]. real :: Tdamp ! The damping timescale of the stress tensor components - ! toward their equilibrium solution due to the elastic terms, - ! in s. - real :: dt ! The short timestep associated with the EVP dynamics, in s. + ! 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, in s. + real :: dt_cumulative ! The elapsed time within this call to EVP dynamics [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. @@ -587,12 +563,12 @@ subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & real :: I_EC2 ! 1/EC^2, where EC is the yield curve axis ratio. real :: I_EC ! 1/EC, where EC is the yield curve axis ratio. real :: I_2EC ! 1/(2*EC), where EC is the yield curve axis ratio. - real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness, in m, that + real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness [m], that ! can be cubed without underflow. - real :: m_neglect ! A tiny mass per unit area, in kg m-2. - real :: m_neglect2 ! A tiny mass per unit area squared, in kg2 m-4. - real :: m_neglect4 ! A tiny mass per unit area to the 4th power, in kg4 m-8. - real :: sum_area ! The sum of ocean areas around a vorticity point, in m2. + 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]. type(time_type) :: & time_it_start, & ! The starting time of the iteratve steps. @@ -620,12 +596,6 @@ subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & fxic_d(:,:) = 0.0 ; fyic_d(:,:) = 0.0 ; fxic_t(:,:) = 0.0 ; fyic_t(:,:) = 0.0 fxic_s(:,:) = 0.0 ; fyic_s(:,:) = 0.0 - if (CS%SLAB_ICE) then - ui(:,:) = uo(:,:) ; vi(:,:) = vo(:,:) - fxoc(:,:) = fxat(:,:) ; fyoc(:,:) = fyat(:,:) - return - end if - if ((CS%evp_sub_steps<=0) .and. (CS%dt_Rheo<=0.0)) return if (CS%FirstCall) then @@ -665,9 +635,8 @@ subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & Tdamp = 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. + ! 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. Tdamp = max(0.2*dt_slow, 3.0*dt) elseif (CS%Tdamp < 0.0) then Tdamp = max(-CS%Tdamp*dt_slow, 3.0*dt) @@ -681,7 +650,7 @@ subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & m_neglect2 = m_neglect**2 ; m_neglect4 = m_neglect**4 !$OMP parallel default(none) shared(isc,iec,jsc,jec,G,CS,dt_slow,ui_min_trunc,u_IC,ui, & !$OMP ui_max_trunc,vi_min_trunc,vi_max_trunc,v_IC,vi,mice, & -!$OMP msnow,ci,dt,Tdamp,I_2EC,mis,ci_proj,pres_mice, & +!$OMP mis,ci,dt,Tdamp,I_2EC,ci_proj,pres_mice, & !$OMP dx2B,dy2B,dx_dyB,dy_dxB,dx2T,dy2T,dx_dyT,dy_dxT, & !$OMP mi_ratio_A_q,m_neglect4,m_neglect2,mi_u,mi_v,q, & !$OMP m_neglect,azon,bzon,czon,dzon,f2dt_u,I1_f2dt2_u,PFu, & @@ -710,8 +679,6 @@ subroutine SIS_C_dynamics(ci, msnow, mice, ui, vi, uo, vo, & endif !$OMP do do j=jsc-1,jec+1 ; do i=isc-1,iec+1 - ! Store the total snow and ice mass. - mis(i,j) = mice(i,j) + msnow(i,j) ci_proj(i,j) = ci(i,j) ! Precompute pres_mice and the minimum value of del_sh for stability. @@ -1384,12 +1351,12 @@ end subroutine SIS_C_dynamics subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, 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, in N m / kg. + !! unit column mass [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, in kg m-2. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_d !< The divergence stress tensor component, in Pa m. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: str_t !< The tension stress tensor component, in Pa m. - real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: str_s !< The shearing stress tensor component, in Pa m. + !! 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]. 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. @@ -1399,17 +1366,17 @@ subroutine limit_stresses(pres_mice, mice, str_d, str_t, str_s, G, CS, limit) ! ice flow convergence or divergence may have altered the ice concentration. ! Local variables - real :: pressure ! The internal ice pressure at a point, in Pa. - real :: pres_avg ! The average of the internal ice pressures around a point, in Pa. - real :: sum_area ! The sum of ocean areas around a vorticity point, in m2. + 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 :: 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, ND. +! 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, in Pa m. -! real :: str_t_q ! CS%str_t interpolated to a vorticity point, in Pa m. +! 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]. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1504,14 +1471,14 @@ end subroutine limit_stresses !> find_sigI finds the first stress invariant subroutine find_sigI(mi, ci, str_d, sigI, G, 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, in Pa m. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigI !< The first stress invariant, nondim + 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(out) :: sigI !< The first stress invariant [nondim] type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G)) :: & - strength ! The ice strength, in Pa m. + strength ! The ice strength [Pa m]. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1528,19 +1495,19 @@ end subroutine find_sigI !> find_sigII finds the second stress invariant subroutine find_sigII(mi, ci, str_t, str_s, sigII, G, 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, in Pa m - real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: str_s !< The shearing stress tensor component, in Pa m. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: sigII !< The second stress invariant, nondim. + 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(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G)) :: & - strength ! The ice strength, in Pa m. + 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, in Pa m. - real :: sum_area ! The sum of ocean areas around a vorticity point, in m2. + 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]. integer :: i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -1684,20 +1651,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 in m s-1. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u_IC !< The initial zonal ice velicity in m s-1. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uo !< The zonal ocean velicity in m s-1. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mis !< The mass of ice an snow per unit ocean area, in kg m-2 - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxoc !< The zonal ocean-to-ice force, in Pa. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxic !< The ice internal force, in Pa. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Cor_u !< The zonal Coriolis acceleration, in m s-2. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: PFu !< The zonal Pressure force accleration, in m s-2. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: fxat !< The zonal wind stress, in Pa. - real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + 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(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, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. type(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real :: dt_mi, CFL - real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness, in m, that + real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness [m], that ! can be cubed without underflow. integer :: file integer :: yr, mo, day, hr, minute, sec, yearday @@ -1754,20 +1721,20 @@ subroutine write_v_trunc(i, J, vi, v_IC, vo, mis, fyoc, fyic, Cor_v, PFv, fyat, 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(SZI_(G),SZJB_(G)), intent(in) :: vi !< The meridional ice velicity in m s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v_IC !< The initial meridional ice velicity in m s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vo !< The meridional ocean velicity in m s-1. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mis !< The mass of ice an snow per unit ocean area, in kg m-2 - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyoc !< The meridional ocean-to-ice force, in Pa. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyic !< The ice internal force, in Pa. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Cor_v !< The meridional Coriolis acceleration, in m s-2. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: PFv !< The meridional pressure force accleration, in m s-2. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyat !< The meridional wind stress, in Pa. - real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vi !< The meridional ice velicity [m s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v_IC !< The initial meridional ice velicity [m s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vo !< The meridional ocean velicity [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(SZI_(G),SZJB_(G)), intent(in) :: fyoc !< The meridional ocean-to-ice force [Pa]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: fyic !< The ice internal force [Pa]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Cor_v !< The meridional Coriolis acceleration [m s-2]. + 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(SIS_C_dyn_CS), pointer :: CS !< The control structure for this module real :: dt_mi, CFL - real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness, in m, that + real, parameter :: H_subroundoff = 1e-30 ! A negligible thickness [m], that ! can be cubed without underflow. integer :: file integer :: yr, mo, day, hr, minute, sec, yearday diff --git a/src/SIS_dyn_trans.F90 b/src/SIS_dyn_trans.F90 index 150577a8..a86092d1 100644 --- a/src/SIS_dyn_trans.F90 +++ b/src/SIS_dyn_trans.F90 @@ -16,90 +16,96 @@ module SIS_dyn_trans ! and lateral transport. ! !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -use SIS_diag_mediator, only : enable_SIS_averaging, disable_SIS_averaging -use SIS_diag_mediator, only : post_SIS_data, post_data=>post_SIS_data -use SIS_diag_mediator, only : query_SIS_averaging_enabled, SIS_diag_ctrl -use SIS_diag_mediator, only : register_diag_field=>register_SIS_diag_field -use SIS_debugging, only : chksum, Bchksum, hchksum -use SIS_debugging, only : hchksum_pair, Bchksum_pair, uvchksum -use SIS_sum_output, only : write_ice_statistics, SIS_sum_output_init, SIS_sum_out_CS - -use mpp_domains_mod, only : domain2D use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : fill_symmetric_edges !, MOM_domains_init, clone_MOM_domain -! use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid 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_hor_index, only : hor_index_type ! , hor_index_init -! use MOM_string_functions, only : uppercase +use MOM_hor_index, only : hor_index_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_EOS, only : EOS_type, calculate_density_derivs +use coupler_types_mod, only: coupler_type_initialized, coupler_type_send_data use fms_mod, only : clock_flag_default -! use fms_io_mod, only : restore_state, query_initialized -use fms_io_mod, only : register_restart_field, restart_file_type +use fms_io_mod, only : restart_file_type +use mpp_domains_mod, only : domain2D use mpp_mod, only : mpp_clock_id, mpp_clock_begin, mpp_clock_end use mpp_mod, only : CLOCK_COMPONENT, CLOCK_LOOP, CLOCK_ROUTINE -use coupler_types_mod, only: coupler_type_initialized, coupler_type_send_data - -use MOM_time_manager, only : time_type, time_type_to_real, real_to_time -use MOM_time_manager, only : get_date, get_time, set_date, operator(+), operator(-) -use MOM_time_manager, only : operator(>), operator(*), operator(/), operator(/=) -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_types, only : IST_chksum, IST_bounds_check -use SIS_utils, only : get_avg, post_avg, ice_line !, ice_grid_chksum -use SIS_hor_grid, only : SIS_hor_grid_type - -use ice_grid, only : ice_grid_type - -use SIS2_ice_thm, only: get_SIS2_thermo_coefs, enthalpy_liquid_freeze -use SIS2_ice_thm, only: enth_from_TS, Temp_from_En_S -use SIS_dyn_bgrid, only: SIS_B_dyn_CS, SIS_B_dynamics, SIS_B_dyn_init -use SIS_dyn_bgrid, only: SIS_B_dyn_register_restarts, SIS_B_dyn_end -use SIS_dyn_cgrid, only: SIS_C_dyn_CS, SIS_C_dynamics, SIS_C_dyn_init -use SIS_dyn_cgrid, only: SIS_C_dyn_register_restarts, SIS_C_dyn_end -use SIS_dyn_cgrid, only: SIS_C_dyn_read_alt_restarts +use SIS_continuity, only : SIS_continuity_CS, summed_continuity, ice_cover_transport +use SIS_debugging, only : chksum, Bchksum, hchksum +use SIS_debugging, only : hchksum_pair, Bchksum_pair, uvchksum +use SIS_diag_mediator, only : enable_SIS_averaging, disable_SIS_averaging +use SIS_diag_mediator, only : post_SIS_data, post_data=>post_SIS_data +use SIS_diag_mediator, only : query_SIS_averaging_enabled, SIS_diag_ctrl, safe_alloc_alloc +use SIS_diag_mediator, only : register_diag_field=>register_SIS_diag_field +use SIS_dyn_bgrid, only : SIS_B_dyn_CS, SIS_B_dynamics, SIS_B_dyn_init +use SIS_dyn_bgrid, only : SIS_B_dyn_register_restarts, SIS_B_dyn_end +use SIS_dyn_cgrid, only : SIS_C_dyn_CS, SIS_C_dynamics, SIS_C_dyn_init +use SIS_dyn_cgrid, only : SIS_C_dyn_register_restarts, SIS_C_dyn_end +use SIS_dyn_cgrid, only : SIS_C_dyn_read_alt_restarts +use SIS_hor_grid, only : SIS_hor_grid_type +use SIS_ice_diags, only : ice_state_diags_type, register_ice_state_diagnostics +use SIS_ice_diags, only : post_ocean_sfc_diagnostics, post_ice_state_diagnostics +use SIS_sum_output, only : write_ice_statistics, SIS_sum_output_init, SIS_sum_out_CS use SIS_tracer_flow_control, only : SIS_tracer_flow_control_CS -use SIS_transport, only : ice_transport, SIS_transport_init, SIS_transport_end -use SIS_transport, only : SIS_transport_CS - -use ice_bergs, only: icebergs, icebergs_run, icebergs_init, icebergs_end +use SIS_transport, only : SIS_transport_init, SIS_transport_end +use SIS_transport, only : SIS_transport_CS, adjust_ice_categories, cell_average_state_type +use SIS_transport, only : alloc_cell_average_state_type, dealloc_cell_average_state_type +use SIS_transport, only : cell_ave_state_to_ice_state, ice_state_to_cell_ave_state +use SIS_transport, only : ice_cat_transport, finish_ice_transport +use SIS_types, only : ocean_sfc_state_type, ice_ocean_flux_type, fast_ice_avg_type +use SIS_types, only : ice_state_type, IST_chksum, IST_bounds_check +use SIS_utils, only : get_avg, post_avg, ice_line !, ice_grid_chksum +use SIS2_ice_thm, only : get_SIS2_thermo_coefs, enthalpy_liquid_freeze +use SIS2_ice_thm, only : enth_from_TS, Temp_from_En_S +use slab_ice, only : slab_ice_advect, slab_ice_dynamics +use ice_bergs, only : icebergs, icebergs_run, icebergs_init, icebergs_end +use ice_grid, only : ice_grid_type implicit none ; private #include -public :: SIS_dynamics_trans, update_icebergs, dyn_trans_CS +public :: SIS_dynamics_trans, SIS_multi_dyn_trans, update_icebergs, dyn_trans_CS +public :: slab_ice_dyn_trans public :: SIS_dyn_trans_register_restarts, SIS_dyn_trans_init, SIS_dyn_trans_end public :: SIS_dyn_trans_read_alt_restarts, stresses_to_stress_mag public :: SIS_dyn_trans_transport_CS, SIS_dyn_trans_sum_output_CS -public :: post_ocean_sfc_diagnostics, post_ice_state_diagnostics !> The control structure for the SIS_dyn_trans module type dyn_trans_CS ; private - logical :: Cgrid_dyn !< If true use a C-grid discretization of the - !! sea-ice dynamics. - logical :: specified_ice !< If true, the sea ice is specified and there is - !! no need for ice dynamics. + logical :: Cgrid_dyn !< If true use a C-grid discretization of the sea-ice dynamics. real :: dt_ice_dyn !< The time step used for the slow ice dynamics, including !! stepping the continuity equation and interactions - !! between the ice mass field and velocities, in s. If + !! between the ice mass field and velocities [s]. If !! 0 or negative, the coupling time step will be used. + logical :: merged_cont !< If true, update the continuity equations for the ice, snow, + !! and melt pond water together with proportionate fluxes. + !! Otherwise the three media are updated separately. + real :: dt_advect !< The time step used for the advecting tracers and masses as + !! partitioned by thickness categories when merged_cont it true [s]. + !! If 0 or negative, the coupling time step will be used. logical :: do_ridging !< If true, apply a ridging scheme to the convergent !! ice. The original SIS2 implementation is based on !! work by Torge Martin. Otherwise, ice is compressed !! proportionately if the concentration exceeds 1. + integer :: adv_substeps !< The number of advective iterations for each slow time step. logical :: berg_windstress_bug !< If true, use older code that applied an old !! ice-ocean stress to the icebergs in place of the !! current air-ice stress. This option is here for !! backward compatibility, but should be avoided. + logical :: Warsaw_sum_order !< If true, use the order of sums in the Warsaw version + !! of SIS2. This option exists for backward compatibilty + !! but may eventually be obsoleted. + real :: complete_ice_cover !< The fractional ice coverage that is close enough to 1 to be + !! complete for the purpose of calculating wind stresses [nondim]. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: column_check !< If true, enable the heat check column by column. real :: imb_tol !< The tolerance for imbalances to be flagged by - !! column_check, nondim. + !! column_check [nondim]. logical :: bounds_check !< If true, check for sensible values of thicknesses !! temperatures, fluxes, etc. logical :: verbose !< A flag to control the printing of an ice-diagnostic @@ -110,38 +116,70 @@ module SIS_dyn_trans integer :: n_calls = 0 !< The number of times SIS_dynamics_trans has been called. type(time_type) :: ice_stats_interval !< The interval between writes of the - !< globally summed ice statistics and conservation checks. + !! globally summed ice statistics and conservation checks. type(time_type) :: write_ice_stats_time !< The next time to write out the ice statistics. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(SIS_diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the - ! timing of diagnostic output. + !! timing of diagnostic output. !>@{ Diagnostic IDs - integer :: id_fax=-1, id_fay=-1, id_xprt=-1, id_mib=-1, id_mi=-1 - - ! These are the diagnostic ids for describing the ice state. - integer, dimension(:), allocatable :: id_t, id_sal - integer :: id_cn=-1, id_hi=-1, id_hp=-1, id_hs=-1, id_tsn=-1, id_ext=-1 ! id_hp mw/new - integer :: id_t_iceav=-1, id_s_iceav=-1, id_e2m=-1 - integer :: id_rdgr=-1 ! These do not exist yet: id_rdgf=-1, id_rdgo=-1, id_rdgv=-1 - - integer :: id_simass=-1, id_sisnmass=-1, id_sivol=-1 - integer :: id_siconc=-1, id_sithick=-1, id_sisnconc=-1, id_sisnthick=-1 - integer :: id_siu=-1, id_siv=-1, id_sispeed=-1, id_sitimefrac=-1 + integer :: id_fax=-1, id_fay=-1 !!@} + type(dyn_state_2d), pointer :: DS2d => NULL() + !< A simplified 2-d description of the ice state integrated across thickness categories and layers. + type(cell_average_state_type), pointer :: CAS => NULL() + !< A structure with ocean-cell averaged masses. + type(ice_state_diags_type), pointer :: IDs => NULL() + !< A structure for regulating sea ice state diagnostics type(SIS_B_dyn_CS), pointer :: SIS_B_dyn_CSp => NULL() !< Pointer to the control structure for the B-grid dynamics module type(SIS_C_dyn_CS), pointer :: SIS_C_dyn_CSp => NULL() !< Pointer to the control structure for the C-grid dynamics module type(SIS_transport_CS), pointer :: SIS_transport_CSp => NULL() !< Pointer to the control structure for the ice transport module + type(SIS_continuity_CS), pointer :: continuity_CSp => NULL() + !< The control structure for the SIS continuity module + type(SIS_continuity_CS), pointer :: cover_trans_CSp => NULL() + !< The control structure for ice cover transport by the SIS continuity module type(SIS_sum_out_CS), pointer :: sum_output_CSp => NULL() !< Pointer to the control structure for the summed diagnostics module logical :: module_is_initialized = .false. !< If true, this module has been initialized. end type dyn_trans_CS +!> A simplified 2-d description of the ice state integrated across thickness categories and layers. +type, public :: dyn_state_2d ; private + integer :: max_nts !< The maximum number of transport steps that can be stored + !! before they are carried out. + integer :: nts = 0 !< The number of accumulated transport steps since the last update. + real :: ridge_rate_count !< The number of contributions to av_ridge_rate + + real, allocatable, dimension(:,:) :: avg_ridge_rate !< The time average ridging rate in [s-1]. + + real, allocatable, dimension(:,:) :: mi_sum !< The total mass of ice per unit total area [kg m-2]. + 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]. + !! 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]. + real, allocatable, dimension(:,:) :: u_ice_C !< The pseudo-zonal ice velocity along the + !! along the grid directions on a C-grid [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]. + 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]. + real, allocatable, dimension(:,:,:) :: uh_step !< The total zonal mass fluxes during each + !! transportation substep [H m2 s-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]. + +end type dyn_state_2d + !>@{ CPU time clock IDs integer :: iceClock4, iceClock8, iceClock9, iceClocka, iceClockb, iceClockc !!@} @@ -159,20 +197,20 @@ subroutine update_icebergs(IST, OSS, IOF, FIA, icebergs_CS, dt_slow, G, IG, CS) !! (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. - real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + 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(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 real, dimension(SZI_(G),SZJ_(G)) :: & - hi_avg ! The area-weighted average ice thickness, in m. + hi_avg ! The area-weighted average ice thickness [m]. real, dimension(G%isc:G%iec, G%jsc:G%jec) :: & - windstr_x, & ! The area-weighted average ice thickness, in Pa. - windstr_y ! The area-weighted average ice thickness, in Pa. - real :: rho_ice ! The nominal density of sea ice in kg m-3. + windstr_x, & ! The area-weighted average ice thickness [Pa]. + windstr_y ! The area-weighted average ice thickness [Pa]. + 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, in m H-1. + ! from thickness units [m H-1 ~> m3]. integer :: stress_stagger integer :: i, j, isc, iec, jsc, jec @@ -242,7 +280,6 @@ 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) - 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. @@ -250,7 +287,7 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I !! (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. - real, intent(in) :: dt_slow !< The slow ice dynamics timestep, in s. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. 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(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module @@ -258,725 +295,1011 @@ subroutine SIS_dynamics_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, I type(SIS_tracer_flow_control_CS), pointer :: tracer_CSp !< The structure for controlling calls to !! auxiliary ice tracer packages - real, dimension(G%isc:G%iec,G%jsc:G%jec) :: h2o_chg_xprt, mass, mass_ice, mass_snow, tmp2d - real, dimension(SZI_(G),SZJ_(G),IG%CatIce,IG%NkIce) :: & - temp_ice ! A diagnostic array with the ice temperature in degC. - real, dimension(SZI_(G),SZJ_(G),IG%CatIce) :: & - temp_snow ! A diagnostic array with the snow temperature in degC. + ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - ms_sum, mi_sum, & ! Masses of snow and ice per unit total area, in kg m-2. - ice_free, & ! The fractional open water; nondimensional, between 0 & 1. - ice_cover, & ! The fractional ice coverage, summed across all - ! thickness categories; nondimensional, between 0 & 1. - WindStr_x_A, & ! Zonal (_x_) and meridional (_y_) wind stresses - WindStr_y_A, & ! averaged over the ice categories on an A-grid, in 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, in Pa. -real, dimension(SZIB_(G),SZJB_(G)) :: & + mi_sum, & ! Masses of ice per unit total area [kg m-2]. + misp_sum, & ! Combined mass of snow, ice and melt pond water per unit total area [kg m-2]. + ice_free, & ! The fractional open water [nondim], between 0 & 1. + ice_cover ! The fractional ice coverage, summed across all + ! 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, in Pa. - WindStr_x_ocn_B, WindStr_y_ocn_B, & ! Wind stresses on the ice-free ocean on a B-grid, in Pa. - str_x_ice_ocn_B, str_y_ice_ocn_B ! Ice-ocean stresses on a B-grid, in Pa. + 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]. real, dimension(SZIB_(G),SZJ_(G)) :: & - WindStr_x_Cu, & ! Zonal wind stress averaged over the ice categores on C-grid u-points, in Pa. - WindStr_x_ocn_Cu, & ! Zonal wind stress on the ice-free ocean on C-grid u-points, in Pa. - str_x_ice_ocn_Cu ! Zonal ice-ocean stress on C-grid u-points, in Pa. + 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]. real, dimension(SZI_(G),SZJB_(G)) :: & - WindStr_y_Cv, & ! Meridional wind stress averaged over the ice categores on C-grid v-points, in Pa. - WindStr_y_ocn_Cv, & ! Meridional wind stress on the ice-free ocean on C-grid v-points, in Pa. - str_y_ice_ocn_Cv ! Meridional ice-ocean stress on C-grid v-points, in Pa. - real, dimension(SZIB_(G),SZJ_(G)) :: uc ! Ice velocities interpolated onto - real, dimension(SZI_(G),SZJB_(G)) :: vc ! a C-grid, in m s-1. + 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]. real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBx ! An temporary array for diagnostics. real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBy ! An temporary array for diagnostics. - - real :: weights ! A sum of the weights around a point. - real :: I_wts ! 1.0 / wts or 0 if wts is 0, nondim. real :: ps_vel ! The fractional thickness catetory coverage at a velocity point. - real :: dt_slow_dyn - real :: max_ice_cover, FIA_ice_cover, ice_cover_now - integer :: ndyn_steps - real :: Idt_slow - integer :: i, j, k, l, m, isc, iec, jsc, jec, ncat, NkIce, nds + 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_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)) :: & + rdg_rate ! A ridging rate [s-1], this will be calculated from the strain rates in the dynamics. + type(dyn_state_2d), pointer :: DS2d => NULL() ! A simplified 2-d description of the ice state + ! integrated across thickness categories and layers. + integer :: i, j, k, n, isc, iec, jsc, jec, ncat integer :: isd, ied, jsd, jed - integer :: iyr, imon, iday, ihr, imin, isec + integer :: ndyn_steps, nds ! The number of dynamic steps. + integer :: nadv_cycle, nac ! The number of tracer advective cycles in this call. - real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - real, dimension(SZI_(G),SZJ_(G),IG%CatIce) :: & - rdg_frac ! fraction of ridged ice per category - real, dimension(SZI_(G),SZJ_(G)) :: & - rdg_open, & ! formation rate of open water due to ridging - rdg_vosh, & ! rate of ice mass shifted from level to ridged ice -!! rdg_s2o, & ! snow mass [kg m-2] dumped into ocean during ridging - rdg_rate, & ! Niki: Where should this come from? - snow2ocn - real :: tmp3 ! This is a bad name - make it more descriptive! + !### if (CS%merged_cont) then !### This is here for debugging only. Delete it later. + ! call SIS_multi_dyn_trans(IST, OSS, FIA, IOF, dt_slow, CS, icebergs_CS, G, IG, tracer_CSp, & + ! .true., .true., dt_slow) + ! return + !endif - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; NkIce = IG%NkIce - Idt_slow = 0.0 ; if (dt_slow > 0.0) Idt_slow = 1.0/dt_slow - - if (CS%specified_ice) then - ndyn_steps = 0 ; dt_slow_dyn = 0.0 -!$OMP parallel do default(none) shared(isd,ied,jsd,jed,WindStr_x_A,WindStr_y_A, & -!$OMP ice_cover,ice_free,WindStr_x_ocn_A, & -!$OMP WindStr_y_ocn_A,FIA) - do j=jsd,jed - do i=isd,ied - WindStr_x_ocn_A(i,j) = FIA%WindStr_ocn_x(i,j) - WindStr_y_ocn_A(i,j) = FIA%WindStr_ocn_y(i,j) - ice_cover(i,j) = FIA%ice_cover(i,j) ; ice_free(i,j) = FIA%ice_free(i,j) - WindStr_x_A(i,j) = FIA%WindStr_x(i,j) ; WindStr_y_A(i,j) = FIA%WindStr_y(i,j) - enddo - enddo - else - ndyn_steps = 1 - if ((CS%dt_ice_dyn > 0.0) .and. (CS%dt_ice_dyn < dt_slow)) & - ndyn_steps = max(CEILING(dt_slow/CS%dt_ice_dyn - 0.000001), 1) - dt_slow_dyn = dt_slow / ndyn_steps - endif + CS%n_calls = CS%n_calls + 1 IOF%stress_count = 0 - CS%n_calls = CS%n_calls + 1 + DS2d => CS%DS2d + + ndyn_steps = 1 ; nadv_cycle = 1 + if ((CS%dt_advect > 0.0) .and. (CS%dt_advect < dt_slow)) & + nadv_cycle = max(CEILING(dt_slow/CS%dt_advect - 1e-9), 1) + dt_adv_cycle = dt_slow / real(nadv_cycle) + + 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) + + do nac=1,nadv_cycle + Time_cycle_start = CS%Time - real_to_time((nadv_cycle-(nac-1))*dt_adv_cycle) + + 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) + + ! 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) + + ! 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) + + else ! (.not.CS%merged_cont) + + do nds=1,ndyn_steps + + call mpp_clock_begin(iceClock4) + ! The code timed by iceClock4 is the non-merged-cont equivalent of convert_IST_to_simple_state. + + ! 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 (DS2d%nts == 0) then ! (This is always true.) + misp_sum(:,:) = 0.0 ; mi_sum(:,:) = 0.0 ; ice_cover(:,:) = 0.0 + !$OMP parallel do default(shared) + do j=jsd,jed ; do k=1,ncat ; do i=isd,ied + misp_sum(i,j) = misp_sum(i,j) + IST%part_size(i,j,k) * & + (IG%H_to_kg_m2 * (IST%mH_snow(i,j,k) + IST%mH_pond(i,j,k))) + mi_sum(i,j) = mi_sum(i,j) + (IG%H_to_kg_m2 * IST%mH_ice(i,j,k)) * IST%part_size(i,j,k) + ice_cover(i,j) = ice_cover(i,j) + IST%part_size(i,j,k) + enddo ; enddo ; enddo + do j=jsd,jed ; do i=isd,ied + misp_sum(i,j) = misp_sum(i,j) + mi_sum(i,j) + ice_free(i,j) = IST%part_size(i,j,0) + 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) + 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 + endif + call mpp_clock_end(iceClock4) + + ! + ! Dynamics - update ice velocities. + ! + + call enable_SIS_averaging(dt_slow_dyn, Time_cycle_start + real_to_time(nds*dt_slow_dyn), 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 + ! equation) are not included in the dynamics. All of the thickness categories + ! are merged together. + + call mpp_clock_begin(iceClock4) + ! The code timed by iceClock4 is the non-merged-cont equivalent of SIS_merged_dyn_cont. + if (CS%Cgrid_dyn) then + + ! Correct the wind stresses for changes in the fractional ice-coverage and set + ! the wind stresses on the ice and the open ocean for a C-grid staggering. + ! 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) + + + if (CS%debug) then + call uvchksum("Before SIS_C_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + 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) + 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 hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) + endif + + !### Ridging needs to be added with C-grid dynamics. + call mpp_clock_begin(iceClocka) + 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, & + 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) + 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) + 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) + + call mpp_clock_begin(iceClockb) + call pass_vector(IST%u_ice_C, IST%v_ice_C, G%Domain, stagger=CGRID_NE) + call pass_vector(str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, G%Domain, stagger=CGRID_NE) + call mpp_clock_end(iceClockb) + + ! 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_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) + + ! 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) + 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) + endif + + call mpp_clock_end(iceClockc) + + else ! B-grid dynamics. + + ! Correct the wind stresses for changes in the fractional ice-coverage and set + ! the wind stresses on the ice and the open ocean for a C-grid staggering. + ! 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) + + if (CS%debug) then + call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G) + 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) + endif + + call mpp_clock_begin(iceClocka) + if (CS%do_ridging) rdg_rate(:,:) = 0.0 + if (CS%Warsaw_sum_order) then + 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) + 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) + 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) + + call mpp_clock_begin(iceClockb) + call pass_vector(IST%u_ice_B, IST%v_ice_B, G%Domain, stagger=BGRID_NE) + call mpp_clock_end(iceClockb) + + ! Dynamics diagnostics + call mpp_clock_begin(iceClockc) + if ((CS%id_fax>0) .or. (CS%id_fay>0)) then + !$OMP parallel do default(shared) private(ps_vel) + do J=jsc-1,jec ; do I=isc-1,iec + ps_vel = (1.0 - G%mask2dBu(I,J)) + 0.25*G%mask2dBu(I,J) * & + ((ice_free(i+1,j+1) + ice_free(i,j)) + & + (ice_free(i+1,j) + ice_free(i,j+1)) ) + diagVarBx(I,J) = ps_vel * WindStr_x_ocn_B(I,J) + (1.0-ps_vel) * WindStr_x_B(I,J) + diagVarBy(I,J) = ps_vel * WindStr_y_ocn_B(I,J) + (1.0-ps_vel) * WindStr_y_B(I,J) + enddo ; enddo + + if (CS%id_fax>0) call post_data(CS%id_fax, diagVarBx, CS%diag) + 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) + ! 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) + 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) + 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) = 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) ) + enddo ; enddo + endif ! End of B-grid dynamics + + if (CS%do_ridging) then ! Accumulate the time-average ridging rate. + DS2d%ridge_rate_count = DS2d%ridge_rate_count + 1. + wt_new = 1.0 / DS2d%ridge_rate_count ; wt_prev = 1.0 - wt_new + do j=jsc,jec ; do i=isc,iec + DS2d%avg_ridge_rate(i,j) = wt_new * rdg_rate(i,j) + wt_prev * DS2d%avg_ridge_rate(i,j) + enddo ; enddo + endif - if (CS%id_xprt>0) then - ! Store values to determine the ice and snow mass change due to transport. - h2o_chg_xprt(:,:) = 0.0 - endif + call mpp_clock_begin(iceClock4) - do nds=1,ndyn_steps + enddo ! nds=1,ndyn_steps - call enable_SIS_averaging(dt_slow_dyn, CS%Time - real_to_time((ndyn_steps-nds)*dt_slow_dyn), CS%diag) + ! 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) + call enable_SIS_averaging(dt_slow_dyn, Time_cycle_start + real_to_time(nds*dt_slow_dyn), CS%diag) - ! Correct the wind stresses for changes in the fractional ice-coverage. - ice_cover(:,:) = 0.0 - max_ice_cover = 1.0 - 2.0*ncat*epsilon(max_ice_cover) -!$OMP parallel do default(none) shared(isd,ied,jsd,jed,ncat,ice_cover,IST,FIA,ice_free, & -!$OMP WindStr_x_A,WindStr_y_A,WindStr_x_ocn_A, & -!$OMP max_ice_cover, WindStr_y_ocn_A) & -!$OMP private(FIA_ice_cover, ice_cover_now) - do j=jsd,jed - do k=1,ncat ; do i=isd,ied - ice_cover(i,j) = ice_cover(i,j) + IST%part_size(i,j,k) - enddo ; enddo - do i=isd,ied - ! The use of these limits prevents the use of the ocean wind stresses - ! there is actually no open ocean and hence there may be no valid ocean - ! stresses. This can occur when ice_cover ~= 1 for both states, but - ! they are not exactly 1.0 due to roundoff in the sum above. - ice_cover_now = min(ice_cover(i,j), max_ice_cover) - 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 - else - WindStr_x_A(i,j) = FIA%WindStr_x(i,j) - WindStr_y_A(i,j) = FIA%WindStr_y(i,j) - endif + call ice_cat_transport(CS%CAS, IST%TrReg, dt_slow_dyn, CS%adv_substeps, G, IG, CS%SIS_transport_CSp, & + uc=IST%u_ice_C, vc=IST%v_ice_C) - ice_free(i,j) = IST%part_size(i,j,0) - 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) + 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, & + rdg_rate=DS2d%avg_ridge_rate) + DS2d%ridge_rate_count = 0. ; DS2d%avg_ridge_rate(:,:) = 0.0 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) + call finish_ice_transport(CS%CAS, IST, IST%TrReg, G, IG, CS%SIS_transport_CSp) endif - enddo - enddo + endif + call mpp_clock_end(iceClock8) - ! - ! Dynamics - update ice velocities. - ! - call mpp_clock_begin(iceClock4) + 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, & + message=" Post_transport")! , check_column=.true.) + + enddo ! nac = 1,nadv_cycle + + ! Finalized the streses for use by the ocean. + 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) + +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, & + 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 + !! the ocean's surface state for the ice model. + 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. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. + 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(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. + type(SIS_tracer_flow_control_CS), pointer :: tracer_CSp !< The structure for controlling calls to + !! auxiliary ice tracer packages + logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be + !! treated as the first call to SIS_multi_dyn_trans + !! in a time-stepping cycle; missing is like true. + logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be + !! treated as the last call to SIS_multi_dyn_trans + !! in a time-stepping cycle; missing is like true. + real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle [s]. + + + ! Local variables + real :: dt_adv_cycle ! The length of the advective cycle timestep [s]. + real :: dt_diags ! The length of time over which the diagnostics are valid [s]. + type(time_type) :: Time_cycle_start ! The model's time at the start of an advective cycle. + integer :: nadv_cycle, nac ! The number of tracer advective cycles within this call. + logical :: cycle_start, cycle_end, end_of_cycle + + CS%n_calls = CS%n_calls + 1 + IOF%stress_count = 0 + + cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle + cycle_end = .true. ; if (present(end_cycle)) cycle_end = end_cycle + dt_diags = dt_slow ; if (present(cycle_length)) dt_diags = cycle_length + + if (.not.CS%merged_cont) call SIS_error(FATAL, & + "SIS_multi_dyn_trans should not be called unless MERGED_CONTINUITY=True.") + + nadv_cycle = 1 + if ((CS%dt_advect > 0.0) .and. (CS%dt_advect < dt_slow)) & + nadv_cycle = max(CEILING(dt_slow/CS%dt_advect - 1e-9), 1) + dt_adv_cycle = dt_slow / real(nadv_cycle) + + do nac=1,nadv_cycle + ! 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) + + ! 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, & + 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) + + 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, & + message=" Post_transport")! , check_column=.true.) + + enddo ! nac=0,nadv_cycle-1 + ! This must be done before returning control to the ocean, but it does not require + ! that complete_IST_transport be called. + call finish_ocean_top_stresses(IOF, G, CS%DS2d) + + ! 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) + +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) + 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(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 + + integer :: i, j, k, isc, iec, jsc, jec + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + 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, & + 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, & + 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) + endif + DS2d%nts = 0 ! There is no outstanding transport to be done and IST is up-to-date. + + ! Copy the velocities back to the ice state type + if (CS%Cgrid_dyn) then + do j=jsd,jed ; do I=IsdB,IedB ; IST%u_ice_C(I,j) = DS2d%u_ice_C(I,j) ; enddo ; enddo + do J=JsdB,JedB ; do i=isd,ied ; IST%v_ice_C(i,J) = DS2d%v_ice_C(i,J) ; enddo ; enddo + else + do J=JsdB,JedB ; do I=IsdB,IedB + IST%u_ice_B(I,J) = DS2d%u_ice_B(I,J) ; IST%v_ice_B(I,J) = DS2d%v_ice_B(I,J) + enddo ; enddo + endif + + IST%valid_IST = .true. + call mpp_clock_end(iceClock8) + +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) + 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. + 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. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. + 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(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 + !! calls to auxiliary ice tracer packages - ms_sum(:,:) = 0.0 ; mi_sum(:,:) = 0.0 -!$OMP parallel do default(none) shared(isd,ied,jsd,jed,ncat,ms_sum,mi_sum,G,IST,IG) - do j=jsd,jed ; do k=1,ncat ; do i=isd,ied - ms_sum(i,j) = ms_sum(i,j) + (IG%H_to_kg_m2 * IST%mH_snow(i,j,k)) * IST%part_size(i,j,k) - mi_sum(i,j) = mi_sum(i,j) + (IG%H_to_kg_m2 * IST%mH_ice(i,j,k)) * IST%part_size(i,j,k) + ! Local variables + real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin + integer :: i, j, k, n, isc, iec, jsc, jec, ncat + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce + + ! Set appropriate surface quantities in categories with no ice. + if (allocated(IST%t_surf)) then + !$OMP parallel do default(shared) + do j=jsc,jec ; do k=1,ncat ; do i=isc,iec ; if (IST%part_size(i,j,k)<=0.0) & + IST%t_surf(i,j,k) = T_0degC + OSS%T_fr_ocn(i,j) enddo ; enddo ; enddo + endif + + ! Calculate and output various diagnostics of the ice state. + call mpp_clock_begin(iceClock9) + + call enable_SIS_averaging(dt_slow, CS%Time, CS%diag) + 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%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%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, & + 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) + endif + + call mpp_clock_end(iceClock9) + +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) + 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(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 + + ! Local variables + integer :: i, j, k, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + if (DS2d%nts /= 0) then + call SIS_error(WARNING, "convert_IST_to_simple_state called with incomplete transport.") + return + endif + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + call mpp_clock_begin(iceClock4) + + DS2d%mca_step(:,:,0) = 0.0 ; DS2d%mi_sum(:,:) = 0.0 ; DS2d%ice_cover(:,:) = 0.0 + !$OMP parallel do default(shared) + do j=jsd,jed ; do k=1,IG%CatIce ; do i=isd,ied + DS2d%mca_step(i,j,0) = DS2d%mca_step(i,j,0) + IST%part_size(i,j,k) * & + (IG%H_to_kg_m2 * (IST%mH_snow(i,j,k) + IST%mH_pond(i,j,k))) + DS2d%mi_sum(i,j) = DS2d%mi_sum(i,j) + (IG%H_to_kg_m2 * IST%mH_ice(i,j,k)) * IST%part_size(i,j,k) + DS2d%ice_cover(i,j) = DS2d%ice_cover(i,j) + IST%part_size(i,j,k) + enddo ; enddo ; enddo + do j=jsd,jed ; do i=isd,ied + DS2d%mca_step(i,j,0) = DS2d%mca_step(i,j,0) + DS2d%mi_sum(i,j) +! if ((abs(max(1.0-DS2d%ice_cover(i,j),0.0) - IST%part_size(i,j,0)) > 5.0e-15) .and. (G%mask2dT(i,j)>0.5)) then +! write(mesg, '(3(ES13.5))') max(1.0 - DS2d%ice_cover(i,j), 0.0) - IST%part_size(i,j,0), & +! max(1.0 - DS2d%ice_cover(i,j), 0.0), IST%part_size(i,j,0) +! call SIS_error(FATAL, "Mismatch in ice_free values exceeding roundoff: "//trim(mesg)) +! endif + enddo ; enddo + if (CS%Cgrid_dyn) then + do j=jsd,jed ; do I=IsdB,IedB ; DS2d%u_ice_C(I,j) = IST%u_ice_C(I,j) ; enddo ; enddo + do J=JsdB,JedB ; do i=isd,ied ; DS2d%v_ice_C(i,J) = IST%v_ice_C(i,J) ; enddo ; enddo + else + do J=JsdB,JedB ; do I=IsdB,IedB + DS2d%u_ice_B(I,J) = IST%u_ice_B(I,J) ; DS2d%v_ice_B(I,J) = IST%v_ice_B(I,J) + enddo ; enddo + 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) + + IST%valid_IST = .false. + + call mpp_clock_end(iceClock4) + +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) + 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 + !! (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(dyn_state_2d), intent(inout) :: DS2d !< A simplified 2-d description of the ice state + !! integrated across thickness categories and layers. + 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(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 + !! the last in the series of advective updates. + + ! This subroutine updates the 2-d sea-ice dynamics. + ! Variables updated here: DS2d%ice_cover, DS2d%[uv]_ice_[BC], DS2d%mca_step, DS2d%mi_sum, + ! CS%[uv]h_step, DS2d%nts, CS%SIS_[BC]_dyn_CSp, IOF (stresses) + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: & + ice_free, & ! The fractional open water [nondim], between 0 & 1. + rdg_rate ! A ridging rate [s-1], this will be calculated from the strain rates + ! 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]. + 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]. + 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]. + + real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBx ! An temporary array for diagnostics. + real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBy ! An temporary array for diagnostics. + + 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]. + 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. + integer :: i, j, k, n, isc, iec, jsc, jec + integer :: isd, ied, jsd, jed !, IsdB, IedB, JsdB, JedB + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + 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_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) + continuing_call = .false. ; if (present(end_call)) continuing_call = .not.end_call + + 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) + 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 ! stresses are calculated. The gravity wave dynamics (i.e. the continuity - ! equation) are not included in the dynamics. All of the thickness categories + ! equation) are not included in the dynamics (yet). All of the thickness categories ! are merged together. if (CS%Cgrid_dyn) then - ! The j-loop extents here are larger than they would normally be in case - ! the stresses are being passed to the ocean on a B-grid. -!$OMP parallel default(none) shared(isc,iec,jsc,jec,G,ice_cover,WindStr_x_Cu,ice_free, & -!$OMP WindStr_x_A,WindStr_x_ocn_Cu,WindStr_x_ocn_A, & -!$OMP WindStr_y_Cv,WindStr_y_A,WindStr_y_ocn_Cv, & -!$OMP WindStr_y_ocn_A) & -!$OMP 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)) - if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - 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 - 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)) - if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights - 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 - WindStr_x_ocn_Cu(I,j) = 0.0 - endif - enddo ; enddo -!$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)) - if (G%mask2dCv(i,J) * weights > 0.0) then ; I_wts = 1.0 / weights - 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 - 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)) - if (weights > 0.0) then ; I_wts = 1.0 / weights - 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 - WindStr_y_ocn_Cv(i,J) = 0.0 - endif - enddo ; enddo -!$OMP end parallel + ! Correct the wind stresses for changes in the fractional ice-coverage and set + ! the wind stresses on the ice and the open ocean for a C-grid staggering. + ! 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) if (CS%debug) then - call IST_chksum("Before SIS_C_dynamics", IST, G, IG) - call hchksum(IST%part_size(:,:,0), "ps(0) before SIS_C_dynamics", G%HI) - call hchksum(ms_sum, "ms_sum before SIS_C_dynamics", G%HI) - call hchksum(mi_sum, "mi_sum before SIS_C_dynamics", G%HI) + call uvchksum("Before SIS_C_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) + 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) 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 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 hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) - endif +! call hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) + endif call mpp_clock_begin(iceClocka) !### Ridging needs to be added with C-grid dynamics. - call SIS_C_dynamics(1.0-IST%part_size(:,:,0), ms_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) + 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) call mpp_clock_end(iceClocka) - if (CS%debug) then - call IST_chksum("After ice_dynamics", IST, G, IG) - endif + if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) call mpp_clock_begin(iceClockb) - call pass_vector(IST%u_ice_C, IST%v_ice_C, G%Domain, stagger=CGRID_NE) + call pass_vector(DS2d%u_ice_C, DS2d%v_ice_C, G%Domain, stagger=CGRID_NE) call pass_vector(str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, G%Domain, stagger=CGRID_NE) call mpp_clock_end(iceClockb) - ! + ! 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_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 IST_chksum("Before set_ocean_top_stress_Cgrid", IST, G, IG) - - 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) - if (CS%debug) call IST_chksum("After set_ocean_top_stress_Cgrid", IST, G, IG) + ! 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) call mpp_clock_end(iceClockc) else ! B-grid dynamics. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,ice_cover,WindStr_x_B,ice_free, & -!$OMP WindStr_x_A,WindStr_x_ocn_B,WindStr_x_ocn_A, & -!$OMP WindStr_y_ocn_B,WindStr_y_ocn_A,WindStr_y_B, & -!$OMP WindStr_y_A) & -!$OMP 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)) + & - (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) * & - ((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) * & - ((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)) + & - (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) * & - ((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) * & - ((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) + & - G%areaT(i,j+1) * ice_free(i,j+1) * WindStr_y_ocn_A(i,j+1)) ) * I_wts - else - WindStr_x_B(I,J) = 0.0 ; WindStr_y_B(I,J) = 0.0 - WindStr_x_ocn_B(I,J) = 0.0 ; WindStr_y_ocn_B(I,J) = 0.0 - endif ; enddo ; enddo + ! Correct the wind stresses for changes in the fractional ice-coverage and set + ! the wind stresses on the ice and the open ocean for a C-grid staggering. + ! 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, DS2d%ice_cover, ice_free, WindStr_x_B, WindStr_y_B, & + WindStr_x_ocn_B, WindStr_y_ocn_B, G, CS%complete_ice_cover) if (CS%debug) then - call IST_chksum("Before ice_dynamics", IST, G, IG) - call hchksum(IST%part_size(:,:,0), "ps(0) before ice_dynamics", G%HI) - call hchksum(ms_sum, "ms_sum before ice_dynamics", G%HI) - call hchksum(mi_sum, "mi_sum before ice_dynamics", G%HI) + call Bchksum_pair("[uv]_ice_B before dynamics", DS2d%u_ice_B, DS2d%v_ice_B, G) + 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) endif - rdg_rate(:,:) = 0.0 call mpp_clock_begin(iceClocka) - call SIS_B_dynamics(1.0-IST%part_size(:,:,0), ms_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) + 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, & + 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) call mpp_clock_end(iceClocka) - if (CS%debug) then - call IST_chksum("After ice_dynamics", IST, G, IG) - endif + if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, G) call mpp_clock_begin(iceClockb) - call pass_vector(IST%u_ice_B, IST%v_ice_B, G%Domain, stagger=BGRID_NE) + call pass_vector(DS2d%u_ice_B, DS2d%v_ice_B, G%Domain, stagger=BGRID_NE) call mpp_clock_end(iceClockb) - call mpp_clock_begin(iceClockc) - ! ! Dynamics diagnostics - ! + call mpp_clock_begin(iceClockc) if ((CS%id_fax>0) .or. (CS%id_fay>0)) then -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,IST,diagVarBx,diagVarBy, & -!$OMP WindStr_x_ocn_B,WindStr_y_ocn_B, & -!$OMP WindStr_x_B,WindStr_y_B) & -!$OMP private(ps_vel) + !$OMP parallel do default(shared) private(ps_vel) do J=jsc-1,jec ; do I=isc-1,iec ps_vel = (1.0 - G%mask2dBu(I,J)) + 0.25*G%mask2dBu(I,J) * & - ((IST%part_size(i+1,j+1,0) + IST%part_size(i,j,0)) + & - (IST%part_size(i+1,j,0) + IST%part_size(i,j+1,0)) ) - diagVarBx(I,J) = ps_vel * WindStr_x_ocn_B(I,J) + & - (1.0-ps_vel) * WindStr_x_B(I,J) - diagVarBy(I,J) = ps_vel * WindStr_y_ocn_B(I,J) + & - (1.0-ps_vel) * WindStr_y_B(I,J) + ((ice_free(i+1,j+1) + ice_free(i,j)) + & + (ice_free(i+1,j) + ice_free(i,j+1)) ) + diagVarBx(I,J) = ps_vel * WindStr_x_ocn_B(I,J) + (1.0-ps_vel) * WindStr_x_B(I,J) + diagVarBy(I,J) = ps_vel * WindStr_y_ocn_B(I,J) + (1.0-ps_vel) * WindStr_y_B(I,J) enddo ; enddo if (CS%id_fax>0) call post_data(CS%id_fax, diagVarBx, CS%diag) if (CS%id_fay>0) call post_data(CS%id_fay, diagVarBy, CS%diag) endif - if (CS%debug) call IST_chksum("Before set_ocean_top_stress_Bgrid", IST, G, IG) - 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) - if (CS%debug) call IST_chksum("After set_ocean_top_stress_Bgrid", IST, G, IG) + if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", DS2d%u_ice_B, DS2d%v_ice_B, G) + ! 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) 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) = 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) ) + enddo ; enddo endif ! End of B-grid dynamics + if (CS%do_ridging) then ! Accumulate the time-average ridging rate. + DS2d%ridge_rate_count = DS2d%ridge_rate_count + 1. + wt_new = 1.0 / DS2d%ridge_rate_count ; wt_prev = 1.0 - wt_new + do j=jsc,jec ; do i=isc,iec + DS2d%avg_ridge_rate(i,j) = wt_new * rdg_rate(i,j) + wt_prev * DS2d%avg_ridge_rate(i,j) + enddo ; enddo + endif + if (CS%debug) call uvchksum("Before ice_transport [uv]_ice_C", DS2d%u_ice_C, DS2d%v_ice_C, G) + 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. + if (DS2d%nts+CS%adv_substeps > DS2d%max_nts) & + call increase_max_tracer_step_memory(DS2d, G, DS2d%nts+CS%adv_substeps) + + 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), & + DS2d%uh_step(:,:,n), DS2d%vh_step(:,:,n), dt_adv, G, 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 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) + endif + enddo + DS2d%nts = DS2d%nts + CS%adv_substeps call mpp_clock_end(iceClock4) + enddo ! nds=1,ndyn_steps + +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) + + 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. + 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. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. + 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(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 + !! auxiliary ice tracer packages + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: & + mi_sum, & ! Masses of ice per unit total area [kg m-2]. + 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]. + 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]. + 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]. + + real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBx ! An temporary array for diagnostics. + real, dimension(SZIB_(G),SZJB_(G)) :: diagVarBy ! An temporary array for diagnostics. + real :: ps_vel ! The fractional thickness catetory coverage at a velocity point. + real :: dt_slow_dyn ! The slow dynamics timestep [s]. + integer :: i, j, k, n, isc, iec, jsc, jec, ncat + integer :: isd, ied, jsd, jed + integer :: ndyn_steps, nds ! The number of dynamic steps. + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = 1 + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + CS%n_calls = CS%n_calls + 1 + IOF%stress_count = 0 + + ndyn_steps = 1 + if ((CS%dt_ice_dyn > 0.0) .and. (CS%dt_ice_dyn < dt_slow)) & + ndyn_steps = max(CEILING(dt_slow/CS%dt_ice_dyn - 0.000001), 1) + dt_slow_dyn = dt_slow / ndyn_steps + + do nds=1,ndyn_steps + call enable_SIS_averaging(dt_slow_dyn, CS%Time - real_to_time((ndyn_steps-nds)*dt_slow_dyn), CS%diag) - ! - ! Do ice transport ... all ocean fluxes have been calculated by now. - ! - call mpp_clock_begin(iceClock8) - if (CS%id_xprt>0) then -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,ncat,h2o_chg_xprt,IST,G,IG) - do j=jsc,jec ; do k=1,ncat ; do i=isc,iec - h2o_chg_xprt(i,j) = h2o_chg_xprt(i,j) - IST%part_size(i,j,k) * & - IG%H_to_kg_m2 * (IST%mH_snow(i,j,k) + IST%mH_ice(i,j,k)) - enddo ; enddo ; enddo - endif + call mpp_clock_begin(iceClock4) + !$OMP parallel do default(shared) + do j=jsd,jed ; do i=isd,ied + mi_sum(i,j) = (IG%H_to_kg_m2 * IST%mH_ice(i,j,1)) * IST%part_size(i,j,1) + misp_sum(i,j) = mi_sum(i,j) + IST%part_size(i,j,1) * & + (IG%H_to_kg_m2 * (IST%mH_snow(i,j,1) + IST%mH_pond(i,j,1))) + enddo ; enddo + call mpp_clock_end(iceClock4) - if (CS%debug) then - call IST_chksum("Before ice_transport", IST, G, IG) - endif + ! + ! Dynamics - update ice velocities. + ! + ! 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 + ! equation) are not included in the dynamics. All of the thickness categories + ! are merged together. if (CS%Cgrid_dyn) then - call ice_transport(IST%part_size, IST%mH_ice, IST%mH_snow, IST%mH_pond, & - IST%u_ice_C, IST%v_ice_C, IST%TrReg, & - dt_slow_dyn, G, IG, CS%SIS_transport_CSp,& - IST%rdg_mice, snow2ocn, rdg_rate, & - rdg_open, rdg_vosh) - else - ! B-grid transport - ! Convert the velocities to C-grid points for transport. - uc(:,:) = 0.0; vc(:,:) = 0.0 - do j=jsc,jec ; do I=isc-1,iec - uc(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 - vc(i,J) = 0.5 * ( IST%v_ice_B(I-1,J) + IST%v_ice_B(I,J) ) - enddo ; enddo - - call ice_transport(IST%part_size, IST%mH_ice, IST%mH_snow, IST%mH_pond, & - uc, vc, IST%TrReg, & - dt_slow_dyn, G, IG, CS%SIS_transport_CSp, & - IST%rdg_mice, snow2ocn, rdg_rate, rdg_open, rdg_vosh) - endif - if (CS%column_check) & - call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & - message=" Post_transport")! , check_column=.true.) - if (CS%id_xprt>0) then -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,ncat,h2o_chg_xprt,IST,G,IG) - do j=jsc,jec ; do k=1,ncat ; do i=isc,iec - h2o_chg_xprt(i,j) = h2o_chg_xprt(i,j) + IST%part_size(i,j,k) * & - IG%H_to_kg_m2 * (IST%mH_snow(i,j,k) + IST%mH_ice(i,j,k)) - enddo ; enddo ; enddo ; endif + call mpp_clock_begin(iceClock4) + ! Correct the wind stresses for changes in the fractional ice-coverage and set + ! the wind stresses on the ice and the open ocean for a C-grid staggering. + ! 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) - call mpp_clock_end(iceClock8) + if (CS%debug) then + call uvchksum("Before SIS_C_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) + 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) + 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 hchksum_pair("WindStr_[xy]_A before SIS_C_dynamics", WindStr_x_A, WindStr_y_A, G, halos=1) + endif - enddo ! nds=1,ndyn_steps - call finish_ocean_top_stresses(IOF, G) + 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) + call mpp_clock_end(iceClocka) - ! Add snow mass dumped into ocean to flux of frozen precipitation: - !### WARNING - rdg_s2o is never calculated!!! -! if (CS%do_ridging) then ; do k=1,ncat ; do j=jsc,jec ; do i=isc,iec -! FIA%fprec_top(i,j,k) = FIA%fprec_top(i,j,k) + rdg_s2o(i,j)/dt_slow -! enddo ; enddo ; enddo ; endif + if (CS%debug) call uvchksum("After ice_dynamics [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) - call mpp_clock_begin(iceClock9) + call mpp_clock_begin(iceClockb) + call pass_vector(IST%u_ice_C, IST%v_ice_C, G%Domain, stagger=CGRID_NE) + call pass_vector(str_x_ice_ocn_Cu, str_y_ice_ocn_Cv, G%Domain, stagger=CGRID_NE) + call mpp_clock_end(iceClockb) - ! Set appropriate surface quantities in categories with no ice. - if (allocated(IST%t_surf)) then -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,ncat,IST,OSS) - do j=jsc,jec ; do k=1,ncat ; do i=isc,iec ; if (IST%part_size(i,j,k)<=0.0) & - IST%t_surf(i,j,k) = T_0degC + OSS%T_fr_ocn(i,j) - enddo ; enddo ; enddo - endif + ! 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_fay>0) call post_data(CS%id_fay, WindStr_y_Cv, CS%diag) - if (CS%bounds_check) call IST_bounds_check(IST, G, IG, "After ice_transport", OSS=OSS) - if (CS%debug) call IST_chksum("After ice_transport", IST, G, IG) + if (CS%debug) call uvchksum("Before set_ocean_top_stress_Cgrid [uv]_ice_C", IST%u_ice_C, IST%v_ice_C, G) - call enable_SIS_averaging(dt_slow, CS%Time, CS%diag) + ! 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) + call mpp_clock_end(iceClockc) - call post_ice_state_diagnostics(CS, IST, OSS, IOF, dt_slow, CS%Time, G, IG, CS%diag, & - h2o_chg_xprt=h2o_chg_xprt, rdg_rate=rdg_rate) + call mpp_clock_end(iceClock4) - call disable_SIS_averaging(CS%diag) + else ! B-grid dynamics. - if (CS%verbose) then - call get_date(CS%Time, iyr, imon, iday, ihr, imin, isec) - call get_time(CS%Time-set_date(iyr,1,1,0,0,0),isec,iday) - call ice_line(iyr, iday+1, isec, IST%part_size(isc:iec,jsc:jec,0), & - OSS%SST_C(:,:), G) - endif + call mpp_clock_begin(iceClock4) + ! Correct the wind stresses for changes in the fractional ice-coverage and set + ! the wind stresses on the ice and the open ocean for a C-grid staggering. + ! This block of code must be executed if ice_cover and ice_free or the various wind + ! stresses were updated. - call mpp_clock_end(iceClock9) + 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) - if (CS%debug) then - call IST_chksum("End SIS_dynamics_trans", IST, G, IG) - endif + if (CS%debug) then + call Bchksum_pair("[uv]_ice_B before dynamics", IST%u_ice_B, IST%v_ice_B, G) + 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) + endif - if (CS%bounds_check) then - call IST_bounds_check(IST, G, IG, "End of SIS_dynamics_trans", OSS=OSS) - endif + call mpp_clock_begin(iceClocka) + call slab_ice_dynamics(IST%u_ice_B, IST%v_ice_B, OSS%u_ocn_B, OSS%v_ocn_B, & + WindStr_x_B, WindStr_y_B, str_x_ice_ocn_B, str_y_ice_ocn_B) + call mpp_clock_end(iceClocka) - 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, & - 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) - endif + if (CS%debug) call Bchksum_pair("After dynamics [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) -end subroutine SIS_dynamics_trans + call mpp_clock_begin(iceClockb) + call pass_vector(IST%u_ice_B, IST%v_ice_B, G%Domain, stagger=BGRID_NE) + call mpp_clock_end(iceClockb) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> Offer diagnostics of the slowly evolving sea ice state. -subroutine post_ice_state_diagnostics(CS, IST, OSS, IOF, dt_slow, Time, G, IG, diag, & - h2o_chg_xprt, rdg_rate) - 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. -! 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(in) :: IOF !< A structure containing fluxes from the ice to - !! the ocean that are calculated by the ice model. - real, intent(in) :: dt_slow !< The time interval of these diagnostics - type(time_type), intent(in) :: Time !< The ending time of these diagnostics - 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(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module - type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate diagnostic output - real, dimension(G%isc:G%iec,G%jsc:G%jec), & - optional, intent(in) :: h2o_chg_xprt !< The total ice and snow mass change due to - !! transport within a dynamics timestep, in kg m-2 - real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: rdg_rate !< The ice ridging rate in s-1. + ! Dynamics diagnostics + call mpp_clock_begin(iceClockc) + if ((CS%id_fax>0) .or. (CS%id_fay>0)) then + !$OMP parallel do default(shared) private(ps_vel) + do J=jsc-1,jec ; do I=isc-1,iec + ps_vel = (1.0 - G%mask2dBu(I,J)) + 0.25*G%mask2dBu(I,J) * & + ((IST%part_size(i+1,j+1,0) + IST%part_size(i,j,0)) + & + (IST%part_size(i+1,j,0) + IST%part_size(i,j+1,0)) ) + diagVarBx(I,J) = ps_vel * WindStr_x_ocn_B(I,J) + (1.0-ps_vel) * WindStr_x_B(I,J) + diagVarBy(I,J) = ps_vel * WindStr_y_ocn_B(I,J) + (1.0-ps_vel) * WindStr_y_B(I,J) + enddo ; enddo - ! Local variables - real, dimension(G%isc:G%iec,G%jsc:G%jec) :: mass, mass_ice, mass_snow, tmp2d - real, dimension(SZI_(G),SZJ_(G),IG%CatIce,IG%NkIce) :: & - temp_ice ! A diagnostic array with the ice temperature in degC. - real, dimension(SZI_(G),SZJ_(G),IG%CatIce) :: & - temp_snow ! A diagnostic array with the snow temperature in degC. - real, dimension(SZI_(G),SZJ_(G)) :: diagVar ! An temporary array for diagnostics. - real, dimension(IG%NkIce) :: S_col ! Specified thermodynamic salinity of each - ! ice layer if spec_thermo_sal is true. - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. - real :: enth_units, I_enth_units - real :: I_Nk ! The inverse of the number of layers in the ice. - real :: Idt_slow ! The inverse of the thermodynamic step, in s-1. - logical :: spec_thermo_sal - logical :: do_temp_diags - integer :: i, j, k, l, m, isc, iec, jsc, jec, ncat, NkIce ! , nds - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce -! isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; - NkIce = IG%NkIce - I_Nk = 1.0 / NkIce - Idt_slow = 0.0 ; if (dt_slow > 0.0) Idt_slow = 1.0/dt_slow - - ! Sum the concentration weighted mass for diagnostics. - if (CS%id_mi>0 .or. CS%id_mib>0) then - mass_ice(:,:) = 0.0 - mass_snow(:,:) = 0.0 - mass(:,:) = 0.0 -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,ncat,mass,mass_ice,mass_snow,G,IST,IG) - do j=jsc,jec ; do k=1,ncat ; do i=isc,iec - mass_ice(i,j) = mass_ice(i,j) + IG%H_to_kg_m2*IST%mH_ice(i,j,k)*IST%part_size(i,j,k) - mass_snow(i,j) = mass_snow(i,j) + IG%H_to_kg_m2*IST%mH_snow(i,j,k)*IST%part_size(i,j,k) - mass(i,j) = mass_ice(i,j) + mass_snow(i,j) - enddo ; enddo ; enddo + if (CS%id_fax>0) call post_data(CS%id_fax, diagVarBx, CS%diag) + if (CS%id_fay>0) call post_data(CS%id_fay, diagVarBy, CS%diag) + endif - if (CS%id_simass>0) call post_data(CS%id_simass, mass_ice(isc:iec,jsc:jec), diag) - if (CS%id_sisnmass>0) call post_data(CS%id_sisnmass, mass_snow(isc:iec,jsc:jec), diag) - if (CS%id_mi>0) call post_data(CS%id_mi, mass(isc:iec,jsc:jec), diag) + if (CS%debug) call Bchksum_pair("Before set_ocean_top_stress_Bgrid [uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G) + ! 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) + call mpp_clock_end(iceClockc) - if (CS%id_mib>0) then - if (associated(IOF%mass_berg)) then - do j=jsc,jec ; do i=isc,iec - mass(i,j) = (mass(i,j) + IOF%mass_berg(i,j)) ! Add icebergs mass in kg/m^2 - enddo ; enddo - endif - call post_data(CS%id_mib, mass(isc:iec,jsc:jec), diag) - endif - endif + ! 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) ) + 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) ) + enddo ; enddo - ! - ! Thermodynamic state diagnostics - ! - if (CS%id_cn>0) call post_data(CS%id_cn, IST%part_size(:,:,1:ncat), diag) - if (CS%id_siconc>0) call post_data(CS%id_siconc, sum(IST%part_size(:,:,1:ncat),3), diag) - - ! TK Mod: 10/18/02 - ! if (CS%id_obs_cn>0) call post_data(CS%id_obs_cn, Obs_cn_ice(:,:,2), diag) - ! TK Mod: 10/18/02: (commented out...does not compile yet... add later) - ! if (CS%id_obs_hi>0) & - ! call post_avg(CS%id_obs_hi, Obs_h_ice(isc:iec,jsc:jec), IST%part_size(isc:iec,jsc:jec,1:), & - ! diag, G=G, wtd=.true.) - - ! Convert from ice and snow enthalpy back to temperature for diagnostic purposes. - do_temp_diags = (CS%id_tsn > 0) - do m=1,NkIce ; if (CS%id_t(m)>0) do_temp_diags = .true. ; enddo - call get_SIS2_thermo_coefs(IST%ITV, ice_salinity=S_col, enthalpy_units=enth_units, & - rho_ice=rho_ice, rho_snow=rho_snow, & - specified_thermo_salinity=spec_thermo_sal) - I_enth_units = 1.0 / enth_units - - if (do_temp_diags) then -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,IST,spec_thermo_sal,temp_ice, & -!$OMP S_col,temp_snow,ncat,NkIce) - do j=jsc,jec ; do k=1,ncat ; do i=isc,iec - if (IST%part_size(i,j,k)*IST%mH_ice(i,j,k) > 0.0) then - if (spec_thermo_sal) then ; do m=1,NkIce - temp_ice(i,j,k,m) = temp_from_En_S(IST%enth_ice(i,j,k,m), S_col(m), IST%ITV) - enddo ; else ; do m=1,NkIce - temp_ice(i,j,k,m) = temp_from_En_S(IST%enth_ice(i,j,k,m), & - IST%sal_ice(i,j,k,m), IST%ITV) - enddo ; endif - else - do m=1,NkIce ; temp_ice(i,j,k,m) = 0.0 ; enddo - endif - if (IST%part_size(i,j,k)*IST%mH_snow(i,j,k) > 0.0) then - temp_snow(i,j,k) = temp_from_En_S(IST%enth_snow(i,j,k,1), 0.0, IST%ITV) - else - temp_snow(i,j,k) = 0.0 ! ### Should this be = temp_ice(i,j,k,1)? - endif - enddo ; enddo ; enddo - endif + call mpp_clock_end(iceClock4) - if (CS%id_ext>0) then - diagVar(:,:) = 0.0 - do j=jsc,jec ; do i=isc,iec - if (IST%part_size(i,j,0) < 0.85) diagVar(i,j) = 1.0 - enddo ; enddo - call post_data(CS%id_ext, diagVar, diag) - endif - if (CS%id_hp>0) call post_avg(CS%id_hp, IST%mH_pond, IST%part_size(:,:,1:), & ! mw/new - diag, G=G, & - scale=IG%H_to_kg_m2/1e3, wtd=.true.) ! rho_water=1e3 - if (CS%id_hs>0) call post_avg(CS%id_hs, IST%mH_snow, IST%part_size(:,:,1:), & - diag, G=G, scale=IG%H_to_kg_m2/Rho_snow, wtd=.true.) - if (CS%id_sisnthick>0) call post_avg(CS%id_sisnthick, IST%mH_snow, IST%part_size(:,:,1:), & - diag, G=G, scale=IG%H_to_kg_m2/Rho_snow, wtd=.true.) - if (CS%id_hi>0) call post_avg(CS%id_hi, IST%mH_ice, IST%part_size(:,:,1:), & - diag, G=G, scale=IG%H_to_kg_m2/Rho_ice, wtd=.true.) - if (CS%id_sithick>0) call post_avg(CS%id_sithick, IST%mH_ice, IST%part_size(:,:,1:), & - diag, G=G, scale=IG%H_to_kg_m2/Rho_ice, wtd=.true.) - if (CS%id_sivol>0) call post_avg(CS%id_sivol, IST%mH_ice, IST%part_size(:,:,1:), & - diag, G=G, scale=IG%H_to_kg_m2/Rho_ice, wtd=.true.) - if (CS%id_tsn>0) call post_avg(CS%id_tsn, temp_snow, IST%part_size(:,:,1:), & - diag, G=G, wtd=.true.) - if (CS%id_sitimefrac>0) then - diagVar(:,:) = 0.0 - do j=jsc,jec ; do i=isc,iec - if (IST%part_size(i,j,0) < 1.0) diagVar(i,j) = 1.0 - enddo ; enddo - call post_data(CS%id_sitimefrac, diagVar, diag) - endif - if (CS%id_sisnconc>0) then - diagVar(:,:) = 0.0 - do j=jsc,jec ; do i=isc,iec; do k=1,ncat - if (IST%part_size(i,j,k) > 0.0 .and. IST%mH_snow(i,j,k) > 0.0) then - diagVar(i,j) = diagVar(i,j) + IST%part_size(i,j,k) - endif - enddo ; enddo ; enddo - call post_data(CS%id_sisnconc, diagVar, diag) - endif + endif ! End of B-grid dynamics - do m=1,NkIce - if (CS%id_t(m)>0) call post_avg(CS%id_t(m), temp_ice(:,:,:,m), IST%part_size(:,:,1:), & - diag, G=G, wtd=.true.) - if (CS%id_sal(m)>0) call post_avg(CS%id_sal(m), IST%sal_ice(:,:,:,m), IST%part_size(:,:,1:), & - diag, G=G, wtd=.true.) - enddo - if (CS%id_t_iceav>0) call post_avg(CS%id_t_iceav, temp_ice, IST%part_size(:,:,1:), & - diag, G=G, wtd=.true.) - if (CS%id_S_iceav>0) call post_avg(CS%id_S_iceav, IST%sal_ice, IST%part_size(:,:,1:), & - diag, G=G, wtd=.true.) - - ! Write out diagnostics of the ocean surface state, as seen by the slow sea ice. - ! These fields do not change over the course of the sea-ice time stepping. - call post_ocean_sfc_diagnostics(OSS, dt_slow, Time, G, diag) - - if (CS%id_xprt>0 .and. present(h2o_chg_xprt)) then - call post_data(CS%id_xprt, h2o_chg_xprt(isc:iec,jsc:jec)*864e2*365/dt_slow, & - diag) - endif - if (CS%id_e2m>0) then - tmp2d(:,:) = 0.0 -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,ncat,IST,G,tmp2d,I_enth_units, & -!$OMP spec_thermo_sal,NkIce,I_Nk,S_col,IG) - do j=jsc,jec ; do k=1,ncat ; do i=isc,iec ; if (IST%part_size(i,j,k)*IST%mH_ice(i,j,k)>0.0) then - tmp2d(i,j) = tmp2d(i,j) + IST%part_size(i,j,k)*IST%mH_snow(i,j,k)*IG%H_to_kg_m2 * & - ((enthalpy_liquid_freeze(0.0, IST%ITV) - & - IST%enth_snow(i,j,k,1)) * I_enth_units) - if (spec_thermo_sal) then ; do m=1,NkIce - tmp2d(i,j) = tmp2d(i,j) + (IST%part_size(i,j,k)*IST%mH_ice(i,j,k)*IG%H_to_kg_m2*I_Nk) * & - ((enthalpy_liquid_freeze(S_col(m), IST%ITV) - & - IST%enth_ice(i,j,k,m)) * I_enth_units) - enddo ; else ; do m=1,NkIce - tmp2d(i,j) = tmp2d(i,j) + (IST%part_size(i,j,k)*IST%mH_ice(i,j,k)*IG%H_to_kg_m2*I_Nk) * & - ((enthalpy_liquid_freeze(IST%sal_ice(i,j,k,m), IST%ITV) - & - IST%enth_ice(i,j,k,m)) * I_enth_units) - enddo ; endif - endif ; enddo ; enddo ; enddo - call post_data(CS%id_e2m, tmp2d(:,:), diag) - endif + ! 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) + call enable_SIS_averaging(dt_slow_dyn, CS%Time - real_to_time((ndyn_steps-nds)*dt_slow_dyn), CS%diag) - if (CS%do_ridging) then - !TOM> preparing output field fraction of ridged ice rdg_frac = (ridged ice volume) / (total ice volume) - ! in each category; IST%rdg_mice is ridged ice mass per unit total area throughout the code. -! if (CS%id_rdgf>0) then -! !$OMP parallel do default(none) shared(isc,iec,jsc,jec,ncat,IST,G,rdg_frac,IG) & -! !$OMP private(tmp3) -! do j=jsc,jec ; do k=1,ncat ; do i=isc,iec -! tmp3 = IST%mH_ice(i,j,k)*IST%part_size(i,j,k) -! if (tmp3*IG%H_to_kg_m2 > Rho_Ice*1.e-5) then ! 1 mm ice thickness x 1% ice concentration -! rdg_frac(i,j,k) = IST%rdg_mice(i,j,k) / tmp3 -! else -! rdg_frac(i,j,k) = 0.0 -! endif -! enddo ; enddo ; enddo -! call post_data(CS%id_rdgf, rdg_frac(isc:iec,jsc:jec), diag) -! endif - - if (CS%id_rdgr>0 .and. present(rdg_rate)) & - call post_data(CS%id_rdgr, rdg_rate(isc:iec,jsc:jec), diag) -! if (CS%id_rdgo>0) call post_data(CS%id_rdgo, rdg_open(isc:iec,jsc:jec), 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) -! enddo ; enddo -! call post_data(CS%id_rdgv, tmp2d, diag) -! endif - endif + 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) + call mpp_clock_end(iceClock8) -end subroutine post_ice_state_diagnostics + if (CS%column_check) & + call write_ice_statistics(IST, CS%Time, CS%n_calls, G, IG, CS%sum_output_CSp, & + message=" Post_transport")! , check_column=.true.) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> Offer diagnostics of the ocean surface field, as seen by the sea ice. -subroutine post_ocean_sfc_diagnostics(OSS, dt_slow, Time, G, diag) - type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe - !! the ocean's surface state for the ice model. - real, intent(in) :: dt_slow !< The time interval of these diagnostics - type(time_type), intent(in) :: Time !< The ending time of these diagnostics - type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type - type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate diagnostic output - - real :: Idt_slow ! The inverse of the thermodynamic step, in s-1. - Idt_slow = 0.0 ; if (dt_slow > 0.0) Idt_slow = 1.0/dt_slow - - ! Write out diagnostics of the ocean surface state, as seen by the slow sea ice. - ! These fields do not change over the course of the sea-ice time stepping. - if (OSS%id_sst>0) call post_data(OSS%id_sst, OSS%SST_C, diag) - if (OSS%id_sss>0) call post_data(OSS%id_sss, OSS%s_surf, diag) - if (OSS%id_ssh>0) call post_data(OSS%id_ssh, OSS%sea_lev, diag) - if (allocated(OSS%u_ocn_C)) then - if (OSS%id_uo>0) call post_data(OSS%id_uo, OSS%u_ocn_C, diag) - if (OSS%id_vo>0) call post_data(OSS%id_vo, OSS%v_ocn_C, diag) - else - if (OSS%id_uo>0) call post_data(OSS%id_uo, OSS%u_ocn_B, diag) - if (OSS%id_vo>0) call post_data(OSS%id_vo, OSS%v_ocn_B, diag) - endif - if (OSS%id_frazil>0) & - call post_data(OSS%id_frazil, OSS%frazil*Idt_slow, diag) + enddo ! nds=1,ndyn_steps + call finish_ocean_top_stresses(IOF, G) - if (coupler_type_initialized(OSS%tr_fields)) & - call coupler_type_send_data(OSS%tr_fields, Time) + call ice_state_cleanup(IST, OSS, IOF, dt_slow, G, IG, CS, tracer_CSp) + +end subroutine slab_ice_dyn_trans -end subroutine post_ocean_sfc_diagnostics !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Finish setting the ice-ocean stresses by dividing the running sums of the -!! stresses by the number of times they have been augmented. -subroutine finish_ocean_top_stresses(IOF, G) - type(ice_ocean_flux_type), intent(inout) :: IOF !< A structure containing fluxes from the ice to +!! stresses by the number of times they have been augmented. It may also record +!! the current ocean-cell averaged ice, snow and pond mass. +subroutine finish_ocean_top_stresses(IOF, G, DS2d) + 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(in) :: G !< The horizontal grid type + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type + type(dyn_state_2d), optional, intent(in) :: DS2d !< A simplified 2-d description of the ice state + !! integrated across thickness categories and layers. - real :: taux2, tauy2 ! squared wind stresses (Pa^2) + real :: taux2, tauy2 ! squared wind stresses [Pa2] real :: I_count ! The number of times IOF has been incremented. integer :: i, j, isc, iec, jsc, jec @@ -1006,6 +1329,10 @@ subroutine finish_ocean_top_stresses(IOF, G) endif endif + if (present(DS2d)) then ; if (DS2d%nts > 0) then ; do j=jsc,jec ; do i=isc,iec + IOF%mass_ice_sn_p(i,j) = DS2d%mca_step(i, j, DS2d%nts) + enddo ; enddo ; endif ; endif + if (allocated(IOF%stress_mag)) then ! if (IOF%simple_mag) then ! Determine the magnitude of the time and area mean stresses. @@ -1027,16 +1354,16 @@ end subroutine finish_ocean_top_stresses subroutine stresses_to_stress_mag(G, str_x, str_y, stagger, stress_mag) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: str_x !< The x-direction ice to ocean stress, in Pa. + intent(in) :: str_x !< The x-direction ice to ocean stress [Pa]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: str_y !< The y-direction ice to ocean stress, in Pa. + intent(in) :: str_y !< The y-direction ice to ocean stress [Pa]. integer, intent(in) :: stagger !< The staggering relative to the tracer points of the !! two wind stress components. Valid entries include AGRID, !! BGRID_NE, and CGRID_NE, following the Arakawa !! grid-staggering notation. BGRID_SW and CGRID_SW are !! possibilties that have not been implemented yet. real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: stress_mag !< The magnitude of the stress at tracer points, in Pa. + intent(inout) :: stress_mag !< The magnitude of the stress at tracer points [Pa]. ! Local variables real :: taux2, tauy2 ! squared wind stress components (Pa^2) @@ -1079,8 +1406,8 @@ subroutine stresses_to_stress_mag(G, str_x, str_y, stagger, stress_mag) end subroutine stresses_to_stress_mag !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> Calculate the stresses on the ocean integrated across all the thickness categories with -!! the appropriate staggering, and store them in the public ice data type for use by the +!> Calculate the stresses on the ocean integrated across all the thickness categories with +!! 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) @@ -1089,18 +1416,18 @@ subroutine set_ocean_top_stress_Bgrid(IOF, windstr_x_water, windstr_y_water, & 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, in Pa. + intent(in) :: windstr_x_water !< The x-direction wind stress over open water [Pa]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: windstr_y_water !< The y-direction wind stress over open water, in Pa. + intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress, in Pa. + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress, in Pa. + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [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 + !! thickness categories [nondim], 0-1 - real :: ps_vel ! part_size interpolated to a velocity point, nondim. + real :: ps_vel ! part_size interpolated to a velocity point [nondim]. integer :: i, j, k, isc, iec, jsc, jec, ncat isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce @@ -1196,18 +1523,18 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & 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) :: windstr_x_water !< The x-direction wind stress over open water, in Pa. + intent(in) :: windstr_x_water !< The x-direction wind stress over open water [Pa]. real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: windstr_y_water !< The y-direction wind stress over open water, in Pa. + intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress, in Pa. + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. real, dimension(SZI_(G),SZJB_(G)), & - intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress, in Pa. + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [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 + !! thickness categories [nondim], 0-1 - real :: ps_vel ! part_size interpolated to a velocity point, nondim. + real :: ps_vel ! part_size interpolated to a velocity point [nondim]. integer :: i, j, k, isc, iec, jsc, jec, ncat isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce @@ -1244,9 +1571,9 @@ 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 * & (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 * & (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 @@ -1291,6 +1618,408 @@ subroutine set_ocean_top_stress_Cgrid(IOF, windstr_x_water, windstr_y_water, & end subroutine set_ocean_top_stress_Cgrid +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Calculate the stresses on the ocean integrated across all the thickness categories with +!! 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) + 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),SZJB_(G)), & + intent(in) :: windstr_x_water !< The x-direction wind stress over open water [Pa]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [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 + + real :: ps_ice, ps_ocn ! ice_free and ice_cover interpolated to a velocity point [nondim]. + integer :: i, j, k, isc, iec, jsc, jec + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + + if (IOF%stress_count == 0) then + IOF%flux_u_ocn(:,:) = 0.0 ; IOF%flux_v_ocn(:,:) = 0.0 + endif + + ! Copy and interpolate the ice-ocean stress_Bgrid. This code is slightly + ! complicated because there are 3 different staggering options supported. + if (IOF%flux_uv_stagger == AGRID) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + 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 * & + (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 * & + (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)) + & + (str_ice_oce_y(I-1,J) + str_ice_oce_y(I,J-1))) ) + enddo ; enddo + elseif (IOF%flux_uv_stagger == BGRID_NE) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do J=jsc-1,jec ; do I=isc-1,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dBu(I,J)>0.5) then + ps_ocn = 0.25 * ((ice_free(i+1,j+1) + ice_free(i,j)) + & + (ice_free(i+1,j) + ice_free(i,j+1)) ) + 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)) + enddo ; enddo + elseif (IOF%flux_uv_stagger == CGRID_NE) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do j=jsc,jec ; do I=isc-1,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dCu(I,j)>0.5) then + 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 * & + (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 + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do J=jsc-1,jec ; do i=isc,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dCv(i,J)>0.5) then + 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 * & + (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 + else + call SIS_error(FATAL, "set_ocean_top_stress_B2: Unrecognized flux_uv_stagger.") + endif + IOF%stress_count = IOF%stress_count + 1 + +end subroutine set_ocean_top_stress_B2 + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Calculate the stresses on the ocean integrated across all the thickness categories with 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 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) + 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]. + real, dimension(SZI_(G),SZJB_(G)), & + intent(in) :: windstr_y_water !< The y-direction wind stress over open water [Pa]. + real, dimension(SZIB_(G),SZJ_(G)), & + intent(in) :: str_ice_oce_x !< The x-direction ice to ocean stress [Pa]. + real, dimension(SZI_(G),SZJB_(G)), & + intent(in) :: str_ice_oce_y !< The y-direction ice to ocean stress [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 + + real :: ps_ice, ps_ocn ! ice_free and ice_cover interpolated to a velocity point [nondim]. + integer :: i, j, k, isc, iec, jsc, jec + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + + if (IOF%stress_count == 0) then + IOF%flux_u_ocn(:,:) = 0.0 ; IOF%flux_v_ocn(:,:) = 0.0 + endif + + ! Copy and interpolate the ice-ocean stress_Cgrid. This code is slightly + ! complicated because there are 3 different staggering options supported. + + if (IOF%flux_uv_stagger == AGRID) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + 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) + & + (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) + & + (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 + elseif (IOF%flux_uv_stagger == BGRID_NE) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do J=jsc-1,jec ; do I=isc-1,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dBu(I,J)>0.5) then + ps_ocn = 0.25 * ((ice_free(i+1,j+1) + ice_free(i,j)) + & + (ice_free(i+1,j) + ice_free(i,j+1)) ) + 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 * 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) + & + (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 + elseif (IOF%flux_uv_stagger == CGRID_NE) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do j=jsc,jec ; do I=Isc-1,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dCu(I,j)>0.5) then + 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) + & + (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) + do J=jsc-1,jec ; do i=isc,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dCv(i,J)>0.5) then + 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) + & + (ps_ocn * windstr_y_water(i,J) + ps_ice * str_ice_oce_y(i,J)) + enddo ; enddo + else + call SIS_error(FATAL, "set_ocean_top_stress_C2: Unrecognized flux_uv_stagger.") + endif + + IOF%stress_count = IOF%stress_count + 1 + +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) + 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 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: & + ice_cover, & !< The fractional ice coverage, summed across all + !! 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]. + 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]. + 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]. + + ! 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_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]. + real :: FIA_ice_cover, ice_cover_now + integer :: i, j, isc, iec, jsc, jec + integer :: isd, ied, jsd, jed + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + !$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 + ! there is actually no open ocean and hence there may be no valid ocean + ! stresses. This can occur when ice_cover ~= 1 for both states, but + ! they are not exactly 1.0 due to roundoff in the sum across categories above. + ice_cover_now = min(ice_cover(i,j), max_ice_cover) + 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 + else + WindStr_x_A(i,j) = FIA%WindStr_x(i,j) + WindStr_y_A(i,j) = 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) + 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) + endif + enddo ; enddo + + ! The j-loop extents here are larger than they would normally be in case + ! the stresses are being passed to the ocean on a B-grid. + !$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)) + if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights + 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 + 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)) + if (G%mask2dCu(I,j) * weights > 0.0) then ; I_wts = 1.0 / weights + 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 + WindStr_x_ocn_Cu(I,j) = 0.0 + endif + enddo ; enddo + !$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)) + if (G%mask2dCv(i,J) * weights > 0.0) then ; I_wts = 1.0 / weights + 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 + 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)) + if (weights > 0.0) then ; I_wts = 1.0 / weights + 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 + WindStr_y_ocn_Cv(i,J) = 0.0 + endif + enddo ; enddo + !$OMP end parallel + +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) + 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 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: & + ice_cover, & !< The fractional ice coverage, summed across all + !! thickness categories [nondim], between 0 & 1. + 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]. + 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]. + + ! 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_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]. + real :: FIA_ice_cover, ice_cover_now + integer :: i, j, isc, iec, jsc, jec + integer :: isd, ied, jsd, jed + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + !$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 + ! there is actually no open ocean and hence there may be no valid ocean + ! stresses. This can occur when ice_cover ~= 1 for both states, but + ! they are not exactly 1.0 due to roundoff in the sum across categories above. + ice_cover_now = min(ice_cover(i,j), max_ice_cover) + 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 + else + WindStr_x_A(i,j) = FIA%WindStr_x(i,j) + WindStr_y_A(i,j) = 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) + 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) + endif + enddo ; enddo + + !$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)) + & + (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) * & + ((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) * & + ((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)) + & + (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) * & + ((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) * & + ((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) + & + G%areaT(i,j+1) * ice_free(i,j+1) * WindStr_y_ocn_A(i,j+1)) ) * I_wts + else + WindStr_x_B(I,J) = 0.0 ; WindStr_y_B(I,J) = 0.0 + WindStr_x_ocn_B(I,J) = 0.0 ; WindStr_y_ocn_B(I,J) = 0.0 + endif ; enddo ; enddo + +end subroutine set_wind_stresses_B + + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> 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. @@ -1349,9 +2078,10 @@ 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, 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. + !! set with the current model time. type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid structure 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 @@ -1359,17 +2089,19 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module character(len=*), intent(in) :: output_dir !< The directory to use for writing output type(time_type), intent(in) :: Time_Init !< Starting time of the model integration + logical, optional, intent(in) :: slab_ice !< If true, use the archaic GFDL slab ice dynamics + !! and transport. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "SIS_dyn_trans" ! This module's name. - real :: Time_unit ! The time unit in seconds for ICE_STATS_INTERVAL. - character(len=8) :: nstr - integer :: n, nLay + real :: Time_unit ! The time unit for ICE_STATS_INTERVAL [s]. + integer :: max_nts + logical :: do_slab_ice logical :: debug real, parameter :: missing = -1e34 - nLay = IG%NkIce + do_slab_ice = .false. ; if (present(slab_ice)) do_slab_ice = slab_ice call callTree_enter("SIS_dyn_trans_init(), SIS_dyn_trans.F90") @@ -1387,9 +2119,6 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, & "This module updates the ice momentum and does ice transport.") - call get_param(param_file, mdl, "SPECIFIED_ICE", CS%specified_ice, & - "If true, the ice is specified and there is no dynamics.", & - default=.false.) call get_param(param_file, mdl, "CGRID_ICE_DYNAMICS", CS%Cgrid_dyn, & "If true, use a C-grid discretization of the sea-ice \n"//& "dynamics; if false use a B-grid discretization.", & @@ -1400,17 +2129,40 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim "between the ice mass field and velocities. If 0 or \n"//& "negative the coupling time step will be used.", & units="seconds", default=-1.0) + call get_param(param_file, mdl, "MERGED_CONTINUITY", CS%merged_cont, & + "If true, update the continuity equations for the ice, snow, \n"//& + "and melt pond water together summed across categories, with \n"//& + "proportionate fluxes for each part. Otherwise the media are \n"//& + "updated separately.", default=.false.) + call get_param(param_file, mdl, "DT_ICE_ADVECT", CS%dt_advect, & + "The time step used for the advecting tracers and masses as \n"//& + "partitioned by thickness categories when merged_cont it true. \n"//& + "If 0 or negative, the coupling time step will be used.", & + units="seconds", default=-1.0, do_not_log=.not.CS%merged_cont) + if (.not.CS%merged_cont) CS%dt_advect = CS%dt_ice_dyn call get_param(param_file, mdl, "DO_RIDGING", CS%do_ridging, & "If true, apply a ridging scheme to the convergent ice. \n"//& "Otherwise, ice is compressed proportionately if the \n"//& "concentration exceeds 1. The original SIS2 implementation \n"//& "is based on work by Torge Martin.", default=.false.) + call get_param(param_file, mdl, "NSTEPS_ADV", CS%adv_substeps, & + "The number of advective iterations for each slow dynamics \n"//& + "time step.", default=1) + if (CS%adv_substeps < 1) CS%adv_substeps = 1 call get_param(param_file, mdl, "ICEBERG_WINDSTRESS_BUG", CS%berg_windstress_bug, & "If true, use older code that applied an old ice-ocean \n"//& "stress to the icebergs in place of the current air-ocean \n"//& "stress. This option is here for backward compatibility, \n"//& "but should be avoided.", default=.false.) + call get_param(param_file, mdl, "WARSAW_SUM_ORDER", CS%Warsaw_sum_order, & + "If true, use the order of sums in the Warsaw version of SIS2. \n"//& + "The default is the opposite of MERGED_CONTINUITY. \n"//& + "This option exists for backward compatibilty but may \n"//& + "eventually be obsoleted.", & + default=.not.CS%merged_cont, do_not_log=CS%merged_cont) + if (CS%merged_cont .and. CS%Warsaw_sum_order) & + call SIS_error(FATAL, "WARSAW_SUM_ORDER can not be true if MERGED_CONTINUITY=True.") call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & "The time unit for ICE_STATS_INTERVAL.", & @@ -1444,12 +2196,47 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim "If true, write out verbose diagnostics.", default=.false., & debuggingParam=.true.) - if (CS%Cgrid_dyn) then - call SIS_C_dyn_init(CS%Time, G, 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) + CS%complete_ice_cover = 1.0 - 2.0*epsilon(CS%complete_ice_cover) + + 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) + else + 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, & + 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, & + continuity_CSp=CS%continuity_CSp) + endif + + call alloc_cell_average_state_type(CS%CAS, G%HI, IG, CS%SIS_transport_CSp) + + if (.not.associated(CS%DS2d)) allocate(CS%DS2d) + CS%DS2d%ridge_rate_count = 0. + if (CS%do_ridging) call safe_alloc_alloc(CS%DS2d%avg_ridge_rate, G%isd, G%ied, G%jsd, G%jed) + + if (CS%merged_cont) then + CS%DS2d%nts = 0 ; CS%DS2d%max_nts = 0 + call safe_alloc_alloc(CS%DS2d%mi_sum, G%isd, G%ied, G%jsd, G%jed) + call safe_alloc_alloc(CS%DS2d%ice_cover, G%isd, G%ied, G%jsd, G%jed) + max_nts = CS%adv_substeps + if ((CS%dt_ice_dyn > 0.0) .and. (CS%dt_advect > CS%dt_ice_dyn)) & + max_nts = CS%adv_substeps * max(CEILING(CS%dt_advect/CS%dt_ice_dyn - 1e-6), 1) + call increase_max_tracer_step_memory(CS%DS2d, G, max_nts) + + call safe_alloc_alloc(CS%DS2d%u_ice_C, G%IsdB, G%IedB, G%jsd, G%jed) + call safe_alloc_alloc(CS%DS2d%v_ice_C, G%isd, G%ied, G%JsdB, G%JedB) + if (.not.CS%Cgrid_dyn) then + call safe_alloc_alloc(CS%DS2d%u_ice_B, G%IsdB, G%IedB, G%JsdB, G%JedB) + call safe_alloc_alloc(CS%DS2d%v_ice_B, G%IsdB, G%IedB, G%JsdB, G%JedB) + endif + endif + endif - call SIS_transport_init(CS%Time, G, param_file, CS%diag, CS%SIS_transport_CSp) call SIS_sum_output_init(G, param_file, output_dir, Time_Init, & CS%sum_output_CSp, CS%ntrunc) @@ -1457,50 +2244,7 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim CS%write_ice_stats_time = Time_Init + CS%ice_stats_interval * & (1 + (Time - Time_init) / CS%ice_stats_interval) - - ! Ice state diagnostics. - CS%id_ext = register_diag_field('ice_model', 'EXT', diag%axesT1, Time, & - 'ice modeled', '0 or 1', missing_value=missing) - CS%id_cn = register_diag_field('ice_model', 'CN', diag%axesTc, Time, & - 'ice concentration', '0-1', missing_value=missing) - CS%id_hp = register_diag_field('ice_model', 'HP', diag%axesT1, Time, & - 'pond thickness', 'm-pond', missing_value=missing) ! mw/new - CS%id_hs = register_diag_field('ice_model', 'HS', diag%axesT1, Time, & - 'snow thickness', 'm-snow', missing_value=missing) - CS%id_tsn = register_diag_field('ice_model', 'TSN', diag%axesT1, Time, & - 'snow layer temperature', 'C', missing_value=missing) - CS%id_hi = register_diag_field('ice_model', 'HI', diag%axesT1, Time, & - 'ice thickness', 'm-ice', missing_value=missing) - CS%id_sitimefrac = register_diag_field('ice_model', 'sitimefrac', diag%axesT1, Time, & - 'time fraction of ice cover', '0-1', missing_value=missing) - CS%id_siconc = register_diag_field('ice_model', 'siconc', diag%axesT1, Time, & - 'ice concentration', '0-1', missing_value=missing) - CS%id_sithick = register_diag_field('ice_model', 'sithick', diag%axesT1, Time, & - 'ice thickness', 'm-ice', missing_value=missing) - CS%id_sivol = register_diag_field('ice_model', 'sivol', diag%axesT1, Time, & - 'ice volume', 'm-ice', missing_value=missing) - CS%id_sisnconc = register_diag_field('ice_model', 'sisnconc', diag%axesT1, Time, & - 'snow concentration', '0-1', missing_value=missing) - CS%id_sisnthick= register_diag_field('ice_model', 'sisnthick', diag%axesT1, Time, & - 'snow thickness', 'm-snow', missing_value=missing) - - CS%id_t_iceav = register_diag_field('ice_model', 'T_bulkice', diag%axesT1, Time, & - 'Volume-averaged ice temperature', 'C', missing_value=missing) - CS%id_s_iceav = register_diag_field('ice_model', 'S_bulkice', diag%axesT1, Time, & - 'Volume-averaged ice salinity', 'g/kg', missing_value=missing) - call safe_alloc_ids_1d(CS%id_t, nLay) - call safe_alloc_ids_1d(CS%id_sal, nLay) - do n=1,nLay - write(nstr, '(I4)') n ; nstr = adjustl(nstr) - CS%id_t(n) = register_diag_field('ice_model', 'T'//trim(nstr), & - diag%axesT1, Time, 'ice layer '//trim(nstr)//' temperature', & - 'C', missing_value=missing) - CS%id_sal(n) = register_diag_field('ice_model', 'Sal'//trim(nstr), & - diag%axesT1, Time, 'ice layer '//trim(nstr)//' salinity', & - 'g/kg', missing_value=missing) - enddo - - ! Diagnostics that are specific to C-grid dynamics of the ice model + ! 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', & @@ -1516,30 +2260,8 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim 'air stress on ice - y component', 'Pa', & missing_value=missing, interp_method='none') endif - 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_mi = register_diag_field('ice_model', 'MI', diag%axesT1, Time, & - 'ice + snow mass', 'kg/m^2', missing_value=missing) - CS%id_simass = register_diag_field('ice_model', 'simass', diag%axesT1, Time, & - 'ice mass', 'kg/m^2', missing_value=missing) - CS%id_sisnmass = register_diag_field('ice_model', 'sisnmass', diag%axesT1, Time, & - 'snow mass', 'kg/m^2', missing_value=missing) - CS%id_mib = register_diag_field('ice_model', 'MIB', diag%axesT1, Time, & - 'ice + snow + bergs mass', 'kg/m^2', missing_value=missing) - CS%id_e2m = register_diag_field('ice_model','E2MELT' ,diag%axesT1, Time, & - 'heat needed to melt ice', 'J/m^2', missing_value=missing) - CS%id_rdgr = register_diag_field('ice_model','RDG_RATE' ,diag%axesT1, Time, & - 'ice ridging rate', '1/sec', missing_value=missing) -!### THESE DIAGNOSTICS DO NOT EXIST YET. -! CS%id_rdgf = register_diag_field('ice_model','RDG_FRAC' ,diag%axesT1, Time, & -! 'ridged ice fraction', '0-1', missing_value=missing) -! CS%id_rdgo = register_diag_field('ice_model','RDG_OPEN' ,diag%axesT1, Time, & -! '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) -!### THIS DIAGNOSTIC IS MISSING. -! CS%id_ta = register_diag_field('ice_model', 'TA', diag%axesT1, Time, & -! 'surface air temperature', 'C', missing_value=missing) + + call register_ice_state_diagnostics(Time, IG, param_file, diag, CS%IDs) iceClock4 = mpp_clock_id( ' Ice: slow: dynamics', flags=clock_flag_default, grain=CLOCK_LOOP ) iceClocka = mpp_clock_id( ' slow: ice_dynamics', flags=clock_flag_default, grain=CLOCK_LOOP ) @@ -1552,16 +2274,68 @@ subroutine SIS_dyn_trans_init(Time, G, IG, param_file, diag, CS, output_dir, Tim end subroutine SIS_dyn_trans_init -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> Allocate an array of integer diagnostic arrays and set them to -1, if they are not already allocated -subroutine safe_alloc_ids_1d(ids, nids) - integer, allocatable, intent(inout) :: ids(:) !< An array of diagnostic IDs to allocate - integer, intent(in) :: nids !< The number of IDs to allocate - if (.not.ALLOCATED(ids)) then - allocate(ids(nids)) ; ids(:) = -1 - endif; -end subroutine safe_alloc_ids_1d +!> Increase the memory available to store total ice and snow masses and mass fluxes for tracer advection. +!! Any data already stored in the fluxes is copied over to the new arrays. +subroutine increase_max_tracer_step_memory(DS2d, G, max_nts) + type(dyn_state_2d), intent(inout) :: DS2d !< The control structure for the SIS_dyn_trans module + type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid structure + integer, intent(in) :: max_nts !< The new maximum number of masses and mass fluxes + !! that can be stored for tracer advection. + + real, allocatable :: tmp_array(:,:,:) + integer :: nts_prev + + if (DS2d%max_nts >= max(max_nts,1)) return + + nts_prev = DS2d%nts + DS2d%max_nts = max(max_nts,1) + + if (allocated(DS2d%mca_step)) then + allocate(tmp_array(G%isd:G%ied, G%jsd:G%jed, 0:nts_prev)) + tmp_array(:,:,0:nts_prev) = DS2d%mca_step(:,:,0:nts_prev) + deallocate(DS2d%mca_step) + allocate(DS2d%mca_step(G%isd:G%ied, G%jsd:G%jed, 0:DS2d%max_nts)) ; DS2d%mca_step(:,:,:) = 0.0 + ! Copy over the data that had been set before. + DS2d%mca_step(:,:,0:nts_prev) = tmp_array(:,:,0:nts_prev) + deallocate(tmp_array) + else + allocate(DS2d%mca_step(G%isd:G%ied, G%jsd:G%jed, 0:DS2d%max_nts)) ; DS2d%mca_step(:,:,:) = 0.0 + ! This is the equivalent for when the 6 argument version of safe_alloc_alloc is available. + ! call safe_alloc_alloc(DS2d%mca_step, G%isd, G%ied, G%jsd, G%jed, 0, DS2d%max_nts) + endif + + if (allocated(DS2d%uh_step)) then + if (nts_prev > 0) then + allocate(tmp_array(G%IsdB:G%IedB, G%jsd:G%jed, nts_prev)) + if (nts_prev > 0) tmp_array(:,:,1:nts_prev) = DS2d%uh_step(:,:,1:nts_prev) + endif + deallocate(DS2d%uh_step) + call safe_alloc_alloc(DS2d%uh_step, G%IsdB, G%IedB, G%jsd, G%jed, DS2d%max_nts) + if (nts_prev > 0) then ! Copy over the data that had been set before. + DS2d%uh_step(:,:,1:nts_prev) = tmp_array(:,:,1:nts_prev) + deallocate(tmp_array) + endif + else + call safe_alloc_alloc(DS2d%uh_step, G%IsdB, G%IedB, G%jsd, G%jed, DS2d%max_nts) + endif + + if (allocated(DS2d%vh_step)) then + if (nts_prev > 0) then + allocate(tmp_array(G%isd:G%ied, G%JsdB:G%JedB, nts_prev)) + if (nts_prev > 0) tmp_array(:,:,1:nts_prev) = DS2d%vh_step(:,:,1:nts_prev) + endif + deallocate(DS2d%vh_step) + call safe_alloc_alloc(DS2d%vh_step, G%isd, G%ied, G%JsdB, G%JedB, DS2d%max_nts) + if (nts_prev > 0) then ! Copy over the data that had been set before. + DS2d%vh_step(:,:,1:nts_prev) = tmp_array(:,:,1:nts_prev) + deallocate(tmp_array) + endif + else + call safe_alloc_alloc(DS2d%vh_step, G%isd, G%ied, G%JsdB, G%JedB, DS2d%max_nts) + endif + +end subroutine increase_max_tracer_step_memory !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_dyn_trans_transport_CS returns a pointer to the SIS_transport_CS type that @@ -1574,7 +2348,7 @@ function SIS_dyn_trans_transport_CS(CS) result(transport_CSp) end function SIS_dyn_trans_transport_CS !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> SIS_dyn_trans_transport_CS returns a pointer to the sum_out_CS type that +!> SIS_dyn_trans_sum_output_CS returns a pointer to the sum_out_CS type that !! the dyn_trans_CS points to. function SIS_dyn_trans_sum_output_CS(CS) result(sum_out_CSp) type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module @@ -1590,12 +2364,27 @@ subroutine SIS_dyn_trans_end(CS) type(dyn_trans_CS), pointer :: CS !< The control structure for the SIS_dyn_trans module that !! is dellocated here + if (associated(CS%DS2d)) then + if (allocated(CS%DS2d%mi_sum)) deallocate(CS%DS2d%mi_sum) + if (allocated(CS%DS2d%ice_cover)) deallocate(CS%DS2d%ice_cover) + if (allocated(CS%DS2d%mca_step)) deallocate(CS%DS2d%mca_step) + if (allocated(CS%DS2d%uh_step)) deallocate(CS%DS2d%uh_step) + if (allocated(CS%DS2d%vh_step)) deallocate(CS%DS2d%vh_step) + if (allocated(CS%DS2d%u_ice_B)) deallocate(CS%DS2d%u_ice_B) + if (allocated(CS%DS2d%v_ice_B)) deallocate(CS%DS2d%v_ice_B) + if (allocated(CS%DS2d%u_ice_C)) deallocate(CS%DS2d%u_ice_C) + if (allocated(CS%DS2d%v_ice_C)) deallocate(CS%DS2d%v_ice_C) + if (allocated(CS%DS2d%avg_ridge_rate)) deallocate(CS%DS2d%avg_ridge_rate) + deallocate(CS%DS2d) + endif + if (CS%Cgrid_dyn) then call SIS_C_dyn_end(CS%SIS_C_dyn_CSp) else call SIS_B_dyn_end(CS%SIS_B_dyn_CSp) endif call SIS_transport_end(CS%SIS_transport_CSp) + call dealloc_cell_average_state_type(CS%CAS) deallocate(CS) diff --git a/src/SIS_fast_thermo.F90 b/src/SIS_fast_thermo.F90 index 7f404377..04f6b210 100644 --- a/src/SIS_fast_thermo.F90 +++ b/src/SIS_fast_thermo.F90 @@ -60,10 +60,10 @@ module SIS_fast_thermo type fast_thermo_CS ; private ! These two arrarys are used with column_check when evaluating the enthalpy ! conservation with the fast thermodynamics code. - real, pointer, dimension(:,:,:) :: enth_prev => NULL() !< The previous enthalpy in J, used with + real, pointer, dimension(:,:,:) :: enth_prev => NULL() !< The previous enthalpy [J m-2], used with !! column_check when evaluating the enthalpy conservation !! with the fast thermodynamics code - real, pointer, dimension(:,:,:) :: heat_in => NULL() !< The heat input in J, used with + real, pointer, dimension(:,:,:) :: heat_in => NULL() !< The heat input [J m-2], used with !! column_check when evaluating the enthalpy conservation !! with the fast thermodynamics code @@ -73,7 +73,7 @@ module SIS_fast_thermo !! executed on slow ice PEs for debugging purposes. logical :: column_check !< If true, enable the heat check column by column. real :: imb_tol !< The tolerance for imbalances to be flagged by - !! column_check, nondim. + !! column_check [nondim]. logical :: bounds_check !< If true, check for sensible values of thicknesses !! temperatures, fluxes, etc. @@ -105,50 +105,50 @@ subroutine sum_top_quantities (FIA, ABT, flux_u, flux_v, flux_sh, evap, & 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(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & - intent(in) :: flux_u !< The grid-wise quasi-zonal wind stress on the ice in Pa. + intent(in) :: flux_u !< The grid-wise quasi-zonal wind stress on the ice [Pa]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & - intent(in) :: flux_v !< The grid-wise quasi-meridional wind stress on the ice in Pa. + intent(in) :: flux_v !< The grid-wise quasi-meridional wind stress on the ice [Pa]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: flux_sh !< The upward sensible heat flux from the top of the ice into - !! the atmosphere in W m-2. + !! the atmosphere [W m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: evap !< The upward flux of water due to sublimation or evaporation - !! from the top of the ice to the atmosphere, in kg m-2 s-1. + !! from the top of the ice to the atmosphere [kg m-2 s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: flux_lw !< The net longwave heat flux from the atmosphere into the - !! ice or ocean, in W m-2. + !! ice or ocean [W m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & - intent(in) :: lprec !< The liquid precipitation onto the ice in kg m-2 s-1. + intent(in) :: lprec !< The liquid precipitation onto the ice [kg m-2 s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & - intent(in) :: fprec !< The frozen precipitation onto the ice in kg m-2 s-1. + intent(in) :: fprec !< The frozen precipitation onto the ice [kg m-2 s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: flux_lh !< The upward latent heat flux associated with sublimation or - !! evaporation, in W m-2. + !! evaporation [W m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: sh_T0 !< The upward sensible heat flux from the top of the ice into - !! the atmosphere when the skin temperature is 0 C, in W m-2. + !! the atmosphere when the skin temperature is 0 degC [W m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & - intent(in) :: evap_T0 !< The sublimation rate when the skin temperature is 0 C, - !! in kg m-2 s-1. + intent(in) :: evap_T0 !< The sublimation rate when the skin temperature is 0 degC, + !! [kg m-2 s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: lw_T0 !< The downward longwave heat flux from the atmosphere into the - !! ice or ocean when the skin temperature is 0 C, in W m-2. + !! ice or ocean when the skin temperature is 0 degC [W m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: dshdt !< The derivative of the upward sensible heat flux from the !! the top of the ice into the atmosphere with ice skin - !! temperature in W m-2 K-1. + !! temperature [W m-2 degC-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: devapdt !< The derivative of the sublimation rate with the surface - !! temperature, in kg m-2 s-1 K-1. + !! temperature [kg m-2 s-1 degC-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: dlwdt !< The derivative of the longwave heat flux from the atmosphere - !! into the ice or ocean with ice skin temperature, in W m-2 K-1. + !! into the ice or ocean with ice skin temperature [W m-2 degC-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,IG%CatIce), & - intent(in) :: t_skin !< The sea ice surface skin temperature in deg C. + intent(in) :: t_skin !< The sea ice surface skin temperature [degC]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: SST !< The sea surface temperature in deg C. + intent(in) :: SST !< The sea surface temperature [degC]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce,size(FIA%flux_sw_top,4)), & - intent(in) :: flux_sw !< The downward shortwave heat fluxes in W m-2. The 4th + intent(in) :: flux_sw !< The downward shortwave heat fluxes [W m-2]. The 4th !! dimension is a combination of angular orientation & frequency. real :: t_sfc @@ -233,7 +233,7 @@ subroutine avg_top_quantities(FIA, Rad, IST, G, IG) real :: u, v, divid, sign real :: I_avc ! The inverse of the number of contributions. - real :: I_wts ! 1.0 / ice_cover or 0 if ice_cover is 0, nondim. + real :: I_wts ! 1.0 / ice_cover or 0 if ice_cover is 0 [nondim]. integer :: i, j, k, m, n, b, nb, isc, iec, jsc, jec, ncat integer :: isd, ied, jsd, jed @@ -364,7 +364,7 @@ subroutine total_top_quantities(FIA, TSF, part_size, G, IG) type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: part_size !< The fractional area coverage of the ice - !! thickness categories, nondim, 0-1 + !! thickness categories [nondim], 0-1 integer :: i, j, k, m, n, b, nb, isc, iec, jsc, jec, ncat integer :: isd, ied, jsd, jed @@ -420,7 +420,7 @@ subroutine find_excess_fluxes(FIA, TSF, XSF, part_size, G, IG) type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce), & intent(in) :: part_size !< The fractional area coverage of the ice - !! thickness categories, nondim, 0-1 + !! thickness categories [nondim], 0-1 integer :: i, j, k, m, n, b, nb, isc, iec, jsc, jec, ncat integer :: isd, ied, jsd, jed @@ -588,44 +588,44 @@ subroutine do_update_ice_model_fast(Atmos_boundary, IST, sOSS, Rad, FIA, & real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce) :: & flux_sh, & ! The upward sensible heat flux from the ice to the atmosphere - ! at the surface of the ice, in W m-2. + ! at the surface of the ice [W m-2]. evap, & ! The upward flux of water due to sublimation or evaporation - ! from the top of the ice to the atmosphere, in kg m-2 s-1. + ! from the top of the ice to the atmosphere [kg m-2 s-1]. flux_lh, & ! The upward latent heat flux associated with sublimation or - ! evaporation, in W m-2. - flux_lw, & ! The net downward longwave heat flux into the ice, in W m-2. + ! evaporation [W m-2]. + flux_lw, & ! The net downward longwave heat flux into the ice [W m-2]. flux_u, flux_v, lprec, fprec, & sh_T0, & ! The upward sensible heat flux from the top of the ice into - ! the atmosphere when the skin temperature is 0 C, in W m-2. - evap_T0, & ! The sublimation rate when the skin temperature is 0 C, - ! in kg m-2 s-1. + ! the atmosphere when the skin temperature is 0 degC [W m-2]. + evap_T0, & ! The sublimation rate when the skin temperature is 0 degC, + ! [kg m-2 s-1]. lw_T0, & ! The downward longwave heat flux from the atmosphere into the - ! ice or ocean when the skin temperature is 0 C, in W m-2. + ! ice or ocean when the skin temperature is 0 degC [W m-2]. dshdt, & ! The derivative of the upward sensible heat flux with the surface - ! temperature in W m-2 K-1. + ! temperature [W m-2 degC-1]. devapdt, & ! The derivative of the sublimation rate with the surface - ! temperature, in kg m-2 s-1 K-1. + ! temperature [kg m-2 s-1 degC-1]. dlwdt ! The derivative of the downward radiative heat flux with surface - ! temperature (i.e. d(flux_lw)/d(surf_temp)) in W m-2 K-1. + ! temperature (i.e. d(flux_lw)/d(surf_temp)) [W m-2 degC-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,0:IG%CatIce,size(FIA%flux_sw_top,4)) :: & - flux_sw ! The downward shortwave heat fluxes in W m-2. The fourth + flux_sw ! The downward shortwave heat fluxes [W m-2]. The fourth ! dimension is a combination of angular orientation and frequency. - real, dimension(0:IG%NkIce) :: T_col ! The temperature of a column of ice and snow in degC. - real, dimension(IG%NkIce) :: S_col ! The thermodynamic salinity of a column of ice, in g/kg. - real, dimension(0:IG%NkIce) :: enth_col ! The enthalpy of a column of snow and ice, in enth_unit (J/kg?). - real, dimension(0:IG%NkIce) :: SW_abs_col ! The shortwave absorption within a column of snow and ice, in W m-2. - real :: dt_fast ! The fast thermodynamic time step, in s. - real :: Tskin ! The new skin temperature in deg C. - real :: dTskin ! The change in the skin temperatue in deg C. - real :: latent ! The latent heat of sublimation of ice or snow, in J kg. - real :: hf_0 ! The positive upward surface heat flux when T_sfc = 0 C, in W m-2. - real :: dhf_dt ! The deriviative of the upward surface heat flux with Ts, in W m-2 C-1. + real, dimension(0:IG%NkIce) :: T_col ! The temperature of a column of ice and snow [degC]. + real, dimension(IG%NkIce) :: S_col ! The thermodynamic salinity of a column of ice [gSalt kg-1]. + real, dimension(0:IG%NkIce) :: enth_col ! The enthalpy of a column of snow and ice [Enth ~> J kg-1]. + real, dimension(0:IG%NkIce) :: SW_abs_col ! The shortwave absorption within a column of snow and ice [W m-2]. + real :: dt_fast ! The fast thermodynamic time step [s]. + real :: Tskin ! The new skin temperature [degC]. + real :: dTskin ! The change in the skin temperatue [degC]. + real :: latent ! The latent heat of sublimation of ice or snow [J kg-1]. + real :: hf_0 ! The positive upward surface heat flux when T_sfc = 0 degC [W m-2]. + real :: dhf_dt ! The deriviative of the upward surface heat flux with Ts [W m-2 degC-1]. real :: sw_tot ! sum over all shortwave (dir/dif and vis/nir) components real :: snow_wt ! A fractional weighting of snow in the category surface area. - real :: LatHtVap ! The latent heat of vaporization of water at 0C in J/kg. + real :: LatHtVap ! The latent heat of vaporization of water at 0C [J kg-1]. real :: H_to_m_ice ! The specific volumes of ice and snow times the - real :: H_to_m_snow ! conversion factor from thickness units, in m H-1. + real :: H_to_m_snow ! conversion factor from thickness units [m H-1 ~> m3]. integer :: i, j, k, m, i2, j2, k2, isc, iec, jsc, jec, ncat, i_off, j_off, NkIce, b, nb character(len=8) :: nstr @@ -734,7 +734,7 @@ subroutine do_update_ice_model_fast(Atmos_boundary, IST, sOSS, Rad, FIA, & enth_col(0) = IST%enth_snow(i,j,k,1) do m=1,NkIce ; enth_col(m) = IST%enth_ice(i,j,k,m) ; enddo - ! This is for sublimation into water vapor at 0 C; if the vapor should be + ! This is for sublimation into water vapor at 0 degC; if the vapor should be ! at a different temperature, a correction would be made here. snow_wt = 0.0 ; if (IST%mH_snow(i,j,k)>0.0) snow_wt = 1.0 latent = latent_sublimation(IST%enth_snow(i,j,k,1), IST%enth_ice(i,j,k,1), snow_wt, IST%ITV) @@ -873,42 +873,41 @@ subroutine redo_update_ice_model_fast(IST, sOSS, Rad, FIA, TSF, optics_CSp, & type(ice_grid_type), intent(in) :: IG !< The ice vertical grid type real, dimension(IG%NkIce) :: & - S_col ! The thermodynamic salinity of a column of ice, in g/kg. + S_col ! The thermodynamic salinity of a column of ice [gSalt kg-1]. real, dimension(0:IG%NkIce) :: & - T_col, & ! The temperature of a column of ice and snow in degC. - SW_abs_col, & ! The shortwave absorption within a column of snow and ice, in W m-2. - enth_col, & ! The enthalpy of a column of snow and ice, in enth_unit (J/kg?). - enth_col_in ! The initial enthalpy of a column of snow and ice, - ! in enth_unit (J/kg?). - - real :: dt_here ! The time step here, in s. - real :: Tskin ! The new skin temperature in deg C. - real :: latent ! The latent heat of sublimation of ice or snow, in J kg. - real :: hf_0 ! The positive upward surface heat flux when T_sfc = 0 C, in W m-2. - real :: dhf_dt ! The deriviative of the upward surface heat flux with Ts, in W m-2 C-1. + T_col, & ! The temperature of a column of ice and snow [degC]. + SW_abs_col, & ! The shortwave absorption within a column of snow and ice [W m-2]. + enth_col, & ! The enthalpy of a column of snow and ice [Enth ~> J kg-1]. + enth_col_in ! The initial enthalpy of a column of snow and ice [Enth ~> J kg-1]. + + real :: dt_here ! The time step here [s]. + real :: Tskin ! The new skin temperature [degC]. + real :: latent ! The latent heat of sublimation of ice or snow [J kg-1]. + real :: hf_0 ! The positive upward surface heat flux when T_sfc = 0 degC [W m-2]. + real :: dhf_dt ! The deriviative of the upward surface heat flux with Ts [W m-2 degC-1]. real :: sw_tot ! sum over dir/dif vis/nir components - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. real, dimension(size(FIA%flux_sw_top,4)) :: & albedos ! The ice albedos by directional and wavelength band. real, dimension(IG%NkIce) :: & sw_abs_lay ! The fractional shortwave absorption by each ice layer. real :: H_to_m_ice ! The specific volumes of ice and snow times the - real :: H_to_m_snow ! conversion factor from thickness units, in m H-1. + real :: H_to_m_snow ! conversion factor from thickness units [m H-1 ~> m3]. real :: snow_wt ! A fractional weighting of snow in the category surface area. real, dimension(G%isd:G%ied,size(FIA%flux_sw_top,4)) :: & sw_tot_ice_band ! The total shortwave radiation by band, integrated ! across the ice thickness partitions, but not the open - ! ocean partition, in W m-2. + ! ocean partition [W m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,IG%CatIce,size(FIA%flux_sw_top,4)) :: & sw_top_chg ! The change in the shortwave down due to the new albedos. - real :: flux_sw_prev ! The previous value of flux_sw_top, in W m-2. + real :: flux_sw_prev ! The previous value of flux_sw_top [W m-2]. real :: rescale ! A rescaling factor between 0 and 1. - real :: bmelt_tmp, tmelt_tmp ! Temporary arrays, in J m-2. - real :: dSWt_dt ! The derivative of SW_tot with skin temperature, in W m-2 C-1. + real :: bmelt_tmp, tmelt_tmp ! Temporary arrays [J m-2]. + real :: dSWt_dt ! The derivative of SW_tot with skin temperature [W m-2 degC-1]. real :: Tskin_prev ! The previous value of Tskin real :: T_bright ! A skin temperature below which the snow and ice attain - ! their greatest brightness and albedo no longer varies, in deg C. + ! their greatest brightness and albedo no longer varies [degC]. ! real :: Tskin_itt(0:max(1,CS%max_tskin_itt)) ! real :: SW_tot_itt(max(1,CS%max_tskin_itt)) logical :: do_optics(G%isd:G%ied,G%jsd:G%jed) @@ -919,9 +918,9 @@ subroutine redo_update_ice_model_fast(IST, sOSS, Rad, FIA, TSF, optics_CSp, & integer :: b, b2, nb, nbmerge, itt, max_itt real :: ice_sw_tot ! The sum of shortwave fluxes into the ice and snow, but - ! excluding the fluxes transmitted to the ocean, in W m-2. + ! excluding the fluxes transmitted to the ocean [W m-2]. real :: TSF_sw_tot ! The total of all shortwave fluxes into the snow, ice, - ! and ocean that were previouslly stored in TSF, in W m-2. + ! and ocean that were previouslly stored in TSF [W m-2]. real :: enth_units ! A conversion factor from Joules kg-1 to enthalpy units. real :: I_Nk @@ -1023,7 +1022,7 @@ subroutine redo_update_ice_model_fast(IST, sOSS, Rad, FIA, TSF, optics_CSp, & enth_col_in(0) = IST%enth_snow(i,j,k,1) do m=1,NkIce ; enth_col_in(m) = IST%enth_ice(i,j,k,m) ; enddo - ! This is for sublimation into water vapor at 0 C; if the vapor should be + ! This is for sublimation into water vapor at 0 degC; if the vapor should be ! at a different temperature, a correction would be made here. snow_wt = 0.0 ; if (IST%mH_snow(i,j,k)>0.0) snow_wt = 1.0 latent = latent_sublimation(IST%enth_snow(i,j,k,1), IST%enth_ice(i,j,k,1), snow_wt, IST%ITV) @@ -1148,7 +1147,7 @@ subroutine redo_update_ice_model_fast(IST, sOSS, Rad, FIA, TSF, optics_CSp, & enth_col(0) = IST%enth_snow(i,j,k,1) do m=1,NkIce ; enth_col(m) = IST%enth_ice(i,j,k,m) ; enddo - ! This is for sublimation into water vapor at 0 C; if the vapor should be + ! This is for sublimation into water vapor at 0 degC; if the vapor should be ! at a different temperature, a correction would be made here. snow_wt = 0.0 ; if (IST%mH_snow(i,j,k)>0.0) snow_wt = 1.0 latent = latent_sublimation(IST%enth_snow(i,j,k,1), IST%enth_ice(i,j,k,1), snow_wt, IST%ITV) diff --git a/src/SIS_fixed_initialization.F90 b/src/SIS_fixed_initialization.F90 index 096cae85..d377a609 100644 --- a/src/SIS_fixed_initialization.F90 +++ b/src/SIS_fixed_initialization.F90 @@ -104,7 +104,7 @@ subroutine SIS_initialize_fixed(G, PF, write_geom, output_dir) ! Calculate the value of the Coriolis parameter at the latitude ! -! of the q grid points, in s-1. +! of the q grid points [s-1]. call MOM_initialize_rotation(G%CoriolisBu, G, PF) ! Calculate the components of grad f (beta) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G) diff --git a/src/SIS_hor_grid.F90 b/src/SIS_hor_grid.F90 index ef931002..fa296aeb 100644 --- a/src/SIS_hor_grid.F90 +++ b/src/SIS_hor_grid.F90 @@ -72,15 +72,15 @@ module SIS_hor_grid !! during the course of the run via calls to set_first_direction. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. + 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, in m. - IdxT, & !< 1/dxT in m-1. - dyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1. - IdyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1. - areaT, & !< The area of an h-cell, in m2. - IareaT !< 1/areaT, in m-2. + 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]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: sin_rot !< The sine of the angular rotation between the local model grid northward !! and the true northward directions. @@ -89,39 +89,39 @@ module SIS_hor_grid !! and the true northward directions. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. + 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, in m. - IdxCu, & !< 1/dxCu in m-1. - dyCu, & !< dyCu is delta y at u points, in m. - IdyCu, & !< 1/dyCu in m-1. + 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 in m2. - areaCu !< The areas of the u-grid cells in m2. + IareaCu, & !< The masked inverse areas of u-grid cells [m2]. + areaCu !< The areas of the u-grid cells [m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. + 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, in m. - IdxCv, & !< 1/dxCv in m-1. - dyCv, & !< dyCv is delta y at v points, in m. - IdyCv, & !< 1/dyCv in m-1. + 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 in m2. - areaCv !< The areas of the v-grid cells in m2. + IareaCv, & !< The masked inverse areas of v-grid cells [m2]. + areaCv !< The areas of the v-grid cells [m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim. + 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, in m. - IdxBu, & !< 1/dxBu in m-1. - dyBu, & !< dyBu is delta y at q points, in m. - IdyBu, & !< 1/dyBu in m-1. - areaBu, & !< areaBu is the area of a q-cell, in m2 - IareaBu !< IareaBu = 1/areaBu in m-2. + 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]. real, pointer, dimension(:) :: gridLatT => NULL() !< The latitude of T points for the purpose of labeling the output axes. @@ -141,13 +141,13 @@ 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, in m. + bathyT !< Ocean bottom depth at tracer points [m]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - CoriolisBu !< The Coriolis parameter at corner points, in s-1. + 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, in s-1 m-1. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points, in s-1 m-1. - real :: g_Earth !< The gravitational acceleration in m s-2. + 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]. + real :: g_Earth !< The gravitational acceleration [m s-2]. ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE @@ -159,8 +159,8 @@ module SIS_hor_grid real :: west_lon !< The longitude (or x-coordinate) of the first u-line real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain - real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in meters. + real :: Rad_Earth = 6.378e6 !< The radius of the planet [m]. + real :: max_depth !< The maximum depth of the ocean [m]. end type SIS_hor_grid_type contains diff --git a/src/SIS_ice_diags.F90 b/src/SIS_ice_diags.F90 new file mode 100644 index 00000000..bbca2940 --- /dev/null +++ b/src/SIS_ice_diags.F90 @@ -0,0 +1,392 @@ +!> Handles the diagnostics of the ice state. +module SIS_ice_diags + +! This file is part of SIS2. See LICENSE.md for the license. + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +! SIS2 is a SEA ICE MODEL for coupling through the GFDL exchange grid. SIS2 ! +! is a revision of the original SIS with have extended capabilities, including ! +! the option of using a B-grid or C-grid spatial discretization. The SIS2 ! +! software has been extensively reformulated from SIS for greater consistency ! +! with the Modular Ocean Model, version 6 (MOM6), and to permit might tighter ! +! dynamical coupling between the ocean and sea-ice. ! +! This module handles diagnostics of the sea-ice state. ! +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! + +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_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 coupler_types_mod, only: coupler_type_initialized, coupler_type_send_data + +use SIS_continuity, only : SIS_continuity_CS, summed_continuity, ice_cover_transport +use SIS_diag_mediator, only : enable_SIS_averaging, disable_SIS_averaging +use SIS_diag_mediator, only : post_SIS_data, post_data=>post_SIS_data +use SIS_diag_mediator, only : query_SIS_averaging_enabled, SIS_diag_ctrl, safe_alloc_alloc +use SIS_diag_mediator, only : register_diag_field=>register_SIS_diag_field +use SIS_hor_grid, only : SIS_hor_grid_type +use SIS_types, only : ocean_sfc_state_type, ice_ocean_flux_type, fast_ice_avg_type +use SIS_types, only : ice_state_type, IST_chksum, IST_bounds_check +use SIS_utils, only : get_avg, post_avg +use SIS2_ice_thm, only : get_SIS2_thermo_coefs, enthalpy_liquid_freeze, Temp_from_En_S +use ice_grid, only : ice_grid_type + +implicit none ; private + +#include + +public :: post_ocean_sfc_diagnostics, post_ice_state_diagnostics, register_ice_state_diagnostics + +!> This structure has the IDs used for sea-ice state diagnostics. +type, public :: ice_state_diags_type ; private + type(SIS_diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the + !! timing of diagnostic output. + + !>@{ Diagnostic IDs + integer :: id_fax=-1, id_fay=-1 + + ! These are the diagnostic ids for describing the ice state. + integer :: id_mib=-1, id_mi=-1 + integer, dimension(:), allocatable :: id_t, id_sal + integer :: id_cn=-1, id_hi=-1, id_hp=-1, id_hs=-1, id_tsn=-1, id_ext=-1 ! id_hp mw/new + integer :: id_t_iceav=-1, id_s_iceav=-1, id_e2m=-1 + + integer :: id_simass=-1, id_sisnmass=-1, id_sivol=-1 + integer :: id_siconc=-1, id_sithick=-1, id_sisnconc=-1, id_sisnthick=-1 + integer :: id_siu=-1, id_siv=-1, id_sispeed=-1, id_sitimefrac=-1 + !!@} +end type ice_state_diags_type + +contains + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Offer diagnostics of the slowly evolving sea ice state. +subroutine post_ice_state_diagnostics(IDs, IST, OSS, IOF, dt_slow, Time, G, IG, diag) + type(ice_state_diags_type), pointer :: IDs !< The control structure for the SIS_dyn_trans module + 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. + 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_slow !< The time interval of these diagnostics + type(time_type), intent(in) :: Time !< The ending time of these diagnostics + 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_diag_ctrl), pointer :: diag !< A structure that is used to regulate diagnostic output + + ! Local variables + real, dimension(G%isc:G%iec,G%jsc:G%jec) :: mass, mass_ice, mass_snow, tmp2d + real, dimension(SZI_(G),SZJ_(G),IG%CatIce,IG%NkIce) :: & + temp_ice ! A diagnostic array with the ice temperature [degC]. + real, dimension(SZI_(G),SZJ_(G),IG%CatIce) :: & + temp_snow ! A diagnostic array with the snow temperature [degC]. + ! ### This diagnostic does not exist yet. + ! real, dimension(SZI_(G),SZJ_(G),IG%CatIce) :: & + ! rdg_frac ! fraction of ridged ice per category + real, dimension(SZI_(G),SZJ_(G)) :: diagVar ! An temporary array for diagnostics. + real, dimension(IG%NkIce) :: S_col ! Specified thermodynamic salinity of each + ! ice layer if spec_thermo_sal is true. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. + real :: enth_units, I_enth_units + real :: tmp_mca ! A temporary cell averaged mass [H ~> kg m-2]. + real :: I_Nk ! The inverse of the number of layers in the ice. + logical :: spec_thermo_sal + logical :: do_temp_diags + integer :: i, j, k, l, m, isc, iec, jsc, jec, ncat, NkIce + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce + NkIce = IG%NkIce + I_Nk = 1.0 / NkIce + + ! Sum the concentration weighted mass for diagnostics. + if ((IDs%id_mi>0) .or. (IDs%id_mib>0) .or. (IDs%id_simass>0) .or. (IDs%id_sisnmass>0)) then + mass_ice(:,:) = 0.0 + mass_snow(:,:) = 0.0 + mass(:,:) = 0.0 + !$OMP parallel do default(shared) + do j=jsc,jec ; do k=1,ncat ; do i=isc,iec + mass_ice(i,j) = mass_ice(i,j) + IG%H_to_kg_m2*IST%mH_ice(i,j,k)*IST%part_size(i,j,k) + mass_snow(i,j) = mass_snow(i,j) + IG%H_to_kg_m2*IST%mH_snow(i,j,k)*IST%part_size(i,j,k) + mass(i,j) = mass_ice(i,j) + mass_snow(i,j) + enddo ; enddo ; enddo + + if (IDs%id_simass>0) call post_data(IDs%id_simass, mass_ice(isc:iec,jsc:jec), diag) + if (IDs%id_sisnmass>0) call post_data(IDs%id_sisnmass, mass_snow(isc:iec,jsc:jec), diag) + if (IDs%id_mi>0) call post_data(IDs%id_mi, mass(isc:iec,jsc:jec), diag) + + if (IDs%id_mib>0) then + if (associated(IOF%mass_berg)) then ; do j=jsc,jec ; do i=isc,iec + mass(i,j) = (mass(i,j) + IOF%mass_berg(i,j)) ! Add icebergs mass [kg m-2] + enddo ; enddo ; endif + call post_data(IDs%id_mib, mass(isc:iec,jsc:jec), diag) + endif + endif + + ! + ! Thermodynamic state diagnostics + ! + if (IDs%id_cn>0) call post_data(IDs%id_cn, IST%part_size(:,:,1:ncat), diag) + if (IDs%id_siconc>0) call post_data(IDs%id_siconc, sum(IST%part_size(:,:,1:ncat),3), diag) + + ! TK Mod: 10/18/02 + ! if (IDs%id_obs_cn>0) call post_data(IDs%id_obs_cn, Obs_cn_ice(:,:,2), diag) + ! TK Mod: 10/18/02: (commented out...does not compile yet... add later) + ! if (IDs%id_obs_hi>0) & + ! call post_avg(IDs%id_obs_hi, Obs_h_ice(isc:iec,jsc:jec), IST%part_size(isc:iec,jsc:jec,1:), & + ! diag, G=G, wtd=.true.) + + ! Convert from ice and snow enthalpy back to temperature for diagnostic purposes. + do_temp_diags = (IDs%id_tsn > 0) + do m=1,NkIce ; if (IDs%id_t(m)>0) do_temp_diags = .true. ; enddo + call get_SIS2_thermo_coefs(IST%ITV, ice_salinity=S_col, enthalpy_units=enth_units, & + rho_ice=rho_ice, rho_snow=rho_snow, & + specified_thermo_salinity=spec_thermo_sal) + I_enth_units = 1.0 / enth_units + + if (do_temp_diags) then + !$OMP parallel do default(shared) + do j=jsc,jec ; do k=1,ncat ; do i=isc,iec + if (IST%part_size(i,j,k)*IST%mH_ice(i,j,k) > 0.0) then + if (spec_thermo_sal) then ; do m=1,NkIce + temp_ice(i,j,k,m) = temp_from_En_S(IST%enth_ice(i,j,k,m), S_col(m), IST%ITV) + enddo ; else ; do m=1,NkIce + temp_ice(i,j,k,m) = temp_from_En_S(IST%enth_ice(i,j,k,m), & + IST%sal_ice(i,j,k,m), IST%ITV) + enddo ; endif + else + do m=1,NkIce ; temp_ice(i,j,k,m) = 0.0 ; enddo + endif + if (IST%part_size(i,j,k)*IST%mH_snow(i,j,k) > 0.0) then + temp_snow(i,j,k) = temp_from_En_S(IST%enth_snow(i,j,k,1), 0.0, IST%ITV) + else + temp_snow(i,j,k) = 0.0 ! ### Should this be = temp_ice(i,j,k,1)? + endif + enddo ; enddo ; enddo + endif + + if (IDs%id_ext>0) then + diagVar(:,:) = 0.0 + do j=jsc,jec ; do i=isc,iec + if (IST%part_size(i,j,0) < 0.85) diagVar(i,j) = 1.0 + enddo ; enddo + call post_data(IDs%id_ext, diagVar, diag) + endif + if (IDs%id_hp>0) call post_avg(IDs%id_hp, IST%mH_pond, IST%part_size(:,:,1:), & ! mw/new + diag, G=G, & + scale=IG%H_to_kg_m2/1e3, wtd=.true.) ! rho_water=1e3 + if (IDs%id_hs>0) call post_avg(IDs%id_hs, IST%mH_snow, IST%part_size(:,:,1:), & + diag, G=G, scale=IG%H_to_kg_m2/Rho_snow, wtd=.true.) + if (IDs%id_sisnthick>0) call post_avg(IDs%id_sisnthick, IST%mH_snow, IST%part_size(:,:,1:), & + diag, G=G, scale=IG%H_to_kg_m2/Rho_snow, wtd=.true.) + if (IDs%id_hi>0) call post_avg(IDs%id_hi, IST%mH_ice, IST%part_size(:,:,1:), & + diag, G=G, scale=IG%H_to_kg_m2/Rho_ice, wtd=.true.) + if (IDs%id_sithick>0) call post_avg(IDs%id_sithick, IST%mH_ice, IST%part_size(:,:,1:), & + diag, G=G, scale=IG%H_to_kg_m2/Rho_ice, wtd=.true.) + if (IDs%id_sivol>0) call post_avg(IDs%id_sivol, IST%mH_ice, IST%part_size(:,:,1:), & + diag, G=G, scale=IG%H_to_kg_m2/Rho_ice, wtd=.true.) + if (IDs%id_tsn>0) call post_avg(IDs%id_tsn, temp_snow, IST%part_size(:,:,1:), & + diag, G=G, wtd=.true.) + if (IDs%id_sitimefrac>0) then + diagVar(:,:) = 0.0 + do j=jsc,jec ; do i=isc,iec + if (IST%part_size(i,j,0) < 1.0) diagVar(i,j) = 1.0 + enddo ; enddo + call post_data(IDs%id_sitimefrac, diagVar, diag) + endif + if (IDs%id_sisnconc>0) then + diagVar(:,:) = 0.0 + do j=jsc,jec ; do i=isc,iec; do k=1,ncat + if (IST%part_size(i,j,k) > 0.0 .and. IST%mH_snow(i,j,k) > 0.0) then + diagVar(i,j) = diagVar(i,j) + IST%part_size(i,j,k) + endif + enddo ; enddo ; enddo + call post_data(IDs%id_sisnconc, diagVar, diag) + endif + + do m=1,NkIce + if (IDs%id_t(m)>0) call post_avg(IDs%id_t(m), temp_ice(:,:,:,m), IST%part_size(:,:,1:), & + diag, G=G, wtd=.true.) + if (IDs%id_sal(m)>0) call post_avg(IDs%id_sal(m), IST%sal_ice(:,:,:,m), IST%part_size(:,:,1:), & + diag, G=G, wtd=.true.) + enddo + if (IDs%id_t_iceav>0) call post_avg(IDs%id_t_iceav, temp_ice, IST%part_size(:,:,1:), & + diag, G=G, wtd=.true.) + if (IDs%id_S_iceav>0) call post_avg(IDs%id_S_iceav, IST%sal_ice, IST%part_size(:,:,1:), & + diag, G=G, wtd=.true.) + + ! Write out diagnostics of the ocean surface state, as seen by the slow sea ice. + ! These fields do not change over the course of the sea-ice time stepping. + call post_ocean_sfc_diagnostics(OSS, dt_slow, Time, G, diag) + + if (IDs%id_e2m>0) then + tmp2d(:,:) = 0.0 + !$OMP parallel do default(shared) + do j=jsc,jec ; do k=1,ncat ; do i=isc,iec ; if (IST%part_size(i,j,k)*IST%mH_ice(i,j,k)>0.0) then + tmp2d(i,j) = tmp2d(i,j) + IST%part_size(i,j,k)*IST%mH_snow(i,j,k)*IG%H_to_kg_m2 * & + ((enthalpy_liquid_freeze(0.0, IST%ITV) - & + IST%enth_snow(i,j,k,1)) * I_enth_units) + if (spec_thermo_sal) then ; do m=1,NkIce + tmp2d(i,j) = tmp2d(i,j) + (IST%part_size(i,j,k)*IST%mH_ice(i,j,k)*IG%H_to_kg_m2*I_Nk) * & + ((enthalpy_liquid_freeze(S_col(m), IST%ITV) - & + IST%enth_ice(i,j,k,m)) * I_enth_units) + enddo ; else ; do m=1,NkIce + tmp2d(i,j) = tmp2d(i,j) + (IST%part_size(i,j,k)*IST%mH_ice(i,j,k)*IG%H_to_kg_m2*I_Nk) * & + ((enthalpy_liquid_freeze(IST%sal_ice(i,j,k,m), IST%ITV) - & + IST%enth_ice(i,j,k,m)) * I_enth_units) + enddo ; endif + endif ; enddo ; enddo ; enddo + call post_data(IDs%id_e2m, tmp2d(:,:), diag) + endif + + !TOM> preparing output field fraction of ridged ice rdg_frac = (ridged ice volume) / (total ice volume) + ! in each category; IST%rdg_mice is ridged ice mass per unit total area throughout the code. +! if (IDs%id_rdgf>0) then +! !$OMP parallel do default(shared) private(tmp_mca) +! do j=jsc,jec ; do k=1,ncat ; do i=isc,iec +! tmp_mca = IST%mH_ice(i,j,k)*IST%part_size(i,j,k) +! if (tmp_mca > Rho_Ice*1.e-5*IG%kg_m2_to_H) then ! 1 mm ice thickness x 1% ice concentration +! rdg_frac(i,j,k) = IST%rdg_mice(i,j,k) / tmp_mca +! else +! rdg_frac(i,j,k) = 0.0 +! endif +! enddo ; enddo ; enddo +! call post_data(IDs%id_rdgf, rdg_frac(isc:iec,jsc:jec), diag) +! endif + +end subroutine post_ice_state_diagnostics + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Offer diagnostics of the ocean surface field, as seen by the sea ice. +subroutine post_ocean_sfc_diagnostics(OSS, dt_slow, Time, G, diag) + type(ocean_sfc_state_type), intent(in) :: OSS !< A structure containing the arrays that describe + !! the ocean's surface state for the ice model. + real, intent(in) :: dt_slow !< The time interval of these diagnostics + type(time_type), intent(in) :: Time !< The ending time of these diagnostics + type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type + type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate diagnostic output + + real :: Idt_slow ! The inverse of the thermodynamic step [s-1]. + Idt_slow = 0.0 ; if (dt_slow > 0.0) Idt_slow = 1.0/dt_slow + + ! Write out diagnostics of the ocean surface state, as seen by the slow sea ice. + ! These fields do not change over the course of the sea-ice time stepping. + if (OSS%id_sst>0) call post_data(OSS%id_sst, OSS%SST_C, diag) + if (OSS%id_sss>0) call post_data(OSS%id_sss, OSS%s_surf, diag) + if (OSS%id_ssh>0) call post_data(OSS%id_ssh, OSS%sea_lev, diag) + if (allocated(OSS%u_ocn_C)) then + if (OSS%id_uo>0) call post_data(OSS%id_uo, OSS%u_ocn_C, diag) + if (OSS%id_vo>0) call post_data(OSS%id_vo, OSS%v_ocn_C, diag) + else + if (OSS%id_uo>0) call post_data(OSS%id_uo, OSS%u_ocn_B, diag) + if (OSS%id_vo>0) call post_data(OSS%id_vo, OSS%v_ocn_B, diag) + endif + if (OSS%id_frazil>0) & + call post_data(OSS%id_frazil, OSS%frazil*Idt_slow, diag) + + if (coupler_type_initialized(OSS%tr_fields)) & + call coupler_type_send_data(OSS%tr_fields, Time) + +end subroutine post_ocean_sfc_diagnostics + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Do the registration calls for diagnostics of the ice state. +subroutine register_ice_state_diagnostics(Time, IG, param_file, diag, IDs) + type(time_type), target, intent(in) :: Time !< The sea-ice model's clock, + !! set with the current model time. + 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 + type(ice_state_diags_type), pointer :: IDs !< A structure for regulating sea ice state diagnostics. + + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=8) :: nstr + integer :: n, nLay + real, parameter :: missing = -1e34 + + nLay = IG%NkIce + + if (.not.associated(IDs)) allocate(IDs) + call log_version(param_file, "SIS_ice_diagnostics", version, & + "This module handles sea-ice state diagnostics.") + + IDs%diag => diag + + ! Ice state diagnostics. + IDs%id_ext = register_diag_field('ice_model', 'EXT', diag%axesT1, Time, & + 'ice modeled', '0 or 1', missing_value=missing) + IDs%id_cn = register_diag_field('ice_model', 'CN', diag%axesTc, Time, & + 'ice concentration', '0-1', missing_value=missing) + IDs%id_hp = register_diag_field('ice_model', 'HP', diag%axesT1, Time, & + 'pond thickness', 'm-pond', missing_value=missing) ! mw/new + IDs%id_hs = register_diag_field('ice_model', 'HS', diag%axesT1, Time, & + 'snow thickness', 'm-snow', missing_value=missing) + IDs%id_tsn = register_diag_field('ice_model', 'TSN', diag%axesT1, Time, & + 'snow layer temperature', 'C', missing_value=missing) + IDs%id_hi = register_diag_field('ice_model', 'HI', diag%axesT1, Time, & + 'ice thickness', 'm-ice', missing_value=missing) + IDs%id_sitimefrac = register_diag_field('ice_model', 'sitimefrac', diag%axesT1, Time, & + 'time fraction of ice cover', '0-1', missing_value=missing) + IDs%id_siconc = register_diag_field('ice_model', 'siconc', diag%axesT1, Time, & + 'ice concentration', '0-1', missing_value=missing) + IDs%id_sithick = register_diag_field('ice_model', 'sithick', diag%axesT1, Time, & + 'ice thickness', 'm-ice', missing_value=missing) + IDs%id_sivol = register_diag_field('ice_model', 'sivol', diag%axesT1, Time, & + 'ice volume', 'm-ice', missing_value=missing) + IDs%id_sisnconc = register_diag_field('ice_model', 'sisnconc', diag%axesT1, Time, & + 'snow concentration', '0-1', missing_value=missing) + IDs%id_sisnthick= register_diag_field('ice_model', 'sisnthick', diag%axesT1, Time, & + 'snow thickness', 'm-snow', missing_value=missing) + + IDs%id_t_iceav = register_diag_field('ice_model', 'T_bulkice', diag%axesT1, Time, & + 'Volume-averaged ice temperature', 'C', missing_value=missing) + IDs%id_s_iceav = register_diag_field('ice_model', 'S_bulkice', diag%axesT1, Time, & + 'Volume-averaged ice salinity', 'g/kg', missing_value=missing) + call safe_alloc_ids_1d(IDs%id_t, nLay) + call safe_alloc_ids_1d(IDs%id_sal, nLay) + do n=1,nLay + write(nstr, '(I4)') n ; nstr = adjustl(nstr) + IDs%id_t(n) = register_diag_field('ice_model', 'T'//trim(nstr), & + diag%axesT1, Time, 'ice layer '//trim(nstr)//' temperature', & + 'C', missing_value=missing) + IDs%id_sal(n) = register_diag_field('ice_model', 'Sal'//trim(nstr), & + diag%axesT1, Time, 'ice layer '//trim(nstr)//' salinity', & + 'g/kg', missing_value=missing) + enddo + + IDs%id_mi = register_diag_field('ice_model', 'MI', diag%axesT1, Time, & + 'ice + snow mass', 'kg/m^2', missing_value=missing) + IDs%id_simass = register_diag_field('ice_model', 'simass', diag%axesT1, Time, & + 'ice mass', 'kg/m^2', missing_value=missing) + IDs%id_sisnmass = register_diag_field('ice_model', 'sisnmass', diag%axesT1, Time, & + 'snow mass', 'kg/m^2', missing_value=missing) + IDs%id_mib = register_diag_field('ice_model', 'MIB', diag%axesT1, Time, & + 'ice + snow + bergs mass', 'kg/m^2', missing_value=missing) + IDs%id_e2m = register_diag_field('ice_model','E2MELT' ,diag%axesT1, Time, & + 'heat needed to melt ice', 'J/m^2', missing_value=missing) + +!### THIS DIAGNOSTIC IS MISSING. +! IDs%id_ta = register_diag_field('ice_model', 'TA', diag%axesT1, Time, & +! 'surface air temperature', 'C', missing_value=missing) +!### THESE DIAGNOSTICS DO NOT EXIST YET. +! IDs%id_rdgf = register_diag_field('ice_model','RDG_FRAC' ,diag%axesT1, Time, & +! 'ridged ice fraction', '0-1', missing_value=missing) +end subroutine register_ice_state_diagnostics + + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> Allocate an array of integer diagnostic arrays and set them to -1, if they are not already allocated +subroutine safe_alloc_ids_1d(ids, nids) + integer, allocatable, intent(inout) :: ids(:) !< An array of diagnostic IDs to allocate + integer, intent(in) :: nids !< The number of IDs to allocate + + if (.not.ALLOCATED(ids)) then + allocate(ids(nids)) ; ids(:) = -1 + endif; +end subroutine safe_alloc_ids_1d + + +end module SIS_ice_diags diff --git a/src/SIS_optics.F90 b/src/SIS_optics.F90 index 7859cdf3..da678ae5 100644 --- a/src/SIS_optics.F90 +++ b/src/SIS_optics.F90 @@ -28,26 +28,26 @@ module SIS_optics type, public :: SIS_optics_CS ; private ! albedos are from CSIM4 assumming 0.53 visible and 0.47 near-ir insolation - real :: alb_snow !< albedo of snow (not melting) - real :: alb_ice !< albedo of ice (not melting) - real :: pen_ice !< ice surface penetrating solar fraction - real :: opt_dep_ice !< ice optical depth (m) - real :: t_range_melt !< melt albedos scaled in below melting T + real :: alb_snow !< albedo of snow (not melting) [nondim] + real :: alb_ice !< albedo of ice (not melting) [nondim] + real :: pen_ice !< ice surface penetrating solar fraction [nondim] + real :: opt_dep_ice !< ice optical depth [m] + real :: t_range_melt !< melt albedos scaled in below melting T [degC] logical :: do_deltaEdd = .true. !< If true, use a delta-Eddington radiative ! transfer calculation for the shortwave radiation ! within the sea-ice and snow. logical :: do_pond = .false. !< activate melt pond scheme - mw/new - real :: max_pond_frac = 0.5 !< pond water beyond this is dumped - real :: min_pond_frac = 0.2 !< ponds below sea level don't drain + real :: max_pond_frac = 0.5 !< pond water beyond this is dumped [nondim] + real :: min_pond_frac = 0.2 !< ponds below sea level don't drain [nondim] logical :: slab_optics = .false. !< If true use the very old slab ice optics !! from the supersource model. real :: slab_crit_thick !< The thickness beyond which the slab ice optics no - !! longer exhibits a thickness dependencs on albedo, in m. - real :: slab_alb_ocean !< The ocean albedo as used in the slab ice optics. - real :: slab_min_ice_alb !< The minimum thick ice albedo with the slab ice optics. + !! longer exhibits a thickness dependencs on albedo [m]. + real :: slab_alb_ocean !< The ocean albedo as used in the slab ice optics [nondim]. + real :: slab_min_ice_alb !< The minimum thick ice albedo with the slab ice optics [nondim]. end type SIS_optics_CS @@ -159,39 +159,39 @@ end subroutine SIS_optics_init !> ice_optics_SIS2 sets albedo, penetrating solar, and ice/snow transmissivity subroutine ice_optics_SIS2(mp, hs, hi, ts, tfw, NkIce, albedos, abs_sfc, & abs_snow, abs_ice_lay, abs_ocn, abs_int, CS, ITV, coszen_in) - real, intent(in ) :: mp !< pond mass (kg/m2) - real, intent(in ) :: hs !< snow thickness (m-snow) - real, intent(in ) :: hi !< ice thickness (m-ice) - real, intent(in ) :: ts !< surface temperature in deg C. - real, intent(in ) :: tfw !< seawater freezing temperature + real, intent(in ) :: mp !< pond mass [kg m-2] + real, intent(in ) :: hs !< snow thickness [m] + real, intent(in ) :: hi !< ice thickness [m] + real, intent(in ) :: ts !< surface temperature [degC]. + real, intent(in ) :: tfw !< seawater freezing temperature [degC] integer, intent(in) :: NkIce !< The number of sublayers in the ice - real, dimension(:), intent( out) :: albedos !< ice surface albedos (0-1) - real, intent( out) :: abs_sfc !< fraction of absorbed SW that is absorbed at surface - real, intent( out) :: abs_snow !< fraction of absorbed SW that is absorbed in snow - real, intent( out) :: abs_ice_lay(NkIce) !< fraction of absorbed SW that is absorbed by each ice layer - real, intent( out) :: abs_ocn !< fraction of absorbed SW that is absorbed in ocean - real, intent( out) :: abs_int !< fraction of absorbed SW that is absorbed in ice interior + real, dimension(:), intent( out) :: albedos !< ice surface albedos (0-1) [nondim] + real, intent( out) :: abs_sfc !< fraction of absorbed SW that is absorbed at surface [nondim] + real, intent( out) :: abs_snow !< fraction of absorbed SW that is absorbed in snow [nondim] + real, intent( out) :: abs_ice_lay(NkIce) !< fraction of absorbed SW that is absorbed by each ice layer [nondim] + real, intent( out) :: abs_ocn !< fraction of absorbed SW that is absorbed in ocean [nondim] + real, intent( out) :: abs_int !< fraction of absorbed SW that is absorbed in ice interior [nondim] type(SIS_optics_CS), intent(in) :: CS !< The ice optics control structure. type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. - real, intent(in),optional :: coszen_in !< The cosine of the solar zenith angle. + real, intent(in),optional :: coszen_in !< The cosine of the solar zenith angle [nondim]. - real :: alb ! The albedo for all bands, 0-1, nondimensional. - real :: as ! A snow albedo, 0-1, nondimensional. - real :: ai ! The ice albedo, 0-1, nondimensional. - real :: snow_cover ! The fraction of the area covered by snow, 0-1, ND. + real :: alb ! The albedo for all bands, 0-1 [nondim]. + real :: as ! A snow albedo, 0-1 [nondim]. + real :: ai ! The ice albedo, 0-1 [nondim]. + real :: snow_cover ! The fraction of the area covered by snow, 0-1 [nondim]. real :: fh ! A weighting fraction of the ice albedo (as compared - ! with the albedo of water) when ice is thin, 0-1, ND. + ! with the albedo of water) when ice is thin, 0-1 [nondim]. real :: coalb, I_coalb ! The coalbedo (0-1) and its reciprocal. real :: SW_frac_top ! The fraction of the SW at the top of the snow that - ! is still present at the top of each ice layer (ND). - real :: opt_decay_lay ! The optical extinction in each ice layer (ND). - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. - real :: rho_water ! The nominal density of sea water in kg m-3. - real :: pen ! The fraction of the shortwave flux that will pass - ! below the surface (frac 1-pen absorbed at the surface) - real :: sal_ice_top(1) ! A specified surface salinity of ice. - real :: temp_ice_freeze ! The freezing temperature of the top ice layer, in C. + ! is still present at the top of each ice layer [nondim]. + real :: opt_decay_lay ! The optical extinction in each ice layer [nondim]. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. + real :: rho_water ! The nominal density of sea water [kg m-3]. + real :: pen ! The fraction of the shortwave flux that will pass below + ! the surface (frac 1-pen absorbed at the surface) [nondim] + real :: sal_ice_top(1) ! A specified surface salinity of ice [gSalt kg-1]. + real :: temp_ice_freeze ! The freezing temperature of the top ice layer [degC]. integer :: m, b, nb character(len=200) :: mesg @@ -213,43 +213,43 @@ subroutine ice_optics_SIS2(mp, hs, hi, ts, tfw, NkIce, albedos, abs_sfc, & Tsfc , & ! surface temperature coszen , & ! cosine of solar zenith angle tarea , & ! cell area - not used - swvdr , & ! sw down, visible, direct (W/m^2) - swvdf , & ! sw down, visible, diffuse (W/m^2) - swidr , & ! sw down, near IR, direct (W/m^2) - swidf ! sw down, near IR, diffuse (W/m^2) + swvdr , & ! sw down, visible, direct [W m-2] + swvdf , & ! sw down, visible, diffuse [W m-2] + swidr , & ! sw down, near IR, direct [W m-2] + swidf ! sw down, near IR, diffuse [W m-2] ! outputs real (kind=dbl_kind), dimension (1,1) :: & fs , & ! horizontal coverage of snow - fp , & ! pond fractional coverage (0 to 1) - hprad ! pond depth (m) for radiation code - may be diagnosed + fp , & ! pond fractional coverage (0 to 1) [nondim] + hprad ! pond depth [m] for radiation code - may be diagnosed real (kind=dbl_kind), dimension (1,1,1) :: & - rhosnw , & ! density in snow layer (kg/m3) - rsnw ! grain radius in snow layer (micro-meters) + rhosnw , & ! density in snow layer [kg m-3] + rsnw ! grain radius in snow layer [micro-meters] real (kind=dbl_kind), dimension (1,1,18) :: & trcr ! aerosol tracers real (kind=dbl_kind), dimension (1,1) :: & - alvdr , & ! visible, direct, albedo (fraction) - alvdf , & ! visible, diffuse, albedo (fraction) - alidr , & ! near-ir, direct, albedo (fraction) - alidf , & ! near-ir, diffuse, albedo (fraction) - fswsfc , & ! SW absorbed at snow/bare ice/pondedi ice surface (W m-2) + alvdr , & ! visible, direct, albedo [nondim] + alvdf , & ! visible, diffuse, albedo [nondim] + alidr , & ! near-ir, direct, albedo [nondim] + alidf , & ! near-ir, diffuse, albedo [nondim] + fswsfc , & ! SW absorbed at snow/bare ice/pondedi ice surface [W m-2] fswint , & ! SW interior absorption (below surface, above ocean,W m-2) - fswthru ! SW through snow/bare ice/ponded ice into ocean (W m-2) + fswthru ! SW through snow/bare ice/ponded ice into ocean [W m-2] real (kind=dbl_kind), dimension (1,1,1) :: & - Sswabs ! SW absorbed in snow layer (W m-2) + Sswabs ! SW absorbed in snow layer [W m-2] real (kind=dbl_kind), dimension (1,1,NkIce) :: & - Iswabs ! SW absorbed in ice layer (W m-2) + Iswabs ! SW absorbed in ice layer [W m-2] real (kind=dbl_kind), dimension (1,1) :: & - albice , & ! bare ice albedo, for history - albsno , & ! snow albedo, for history - albpnd ! pond albedo, for history + albice , & ! bare ice albedo, for history [nondim] + albsno , & ! snow albedo, for history [nondim] + albpnd ! pond albedo, for history [nondim] real (kind=dbl_kind) :: max_mp, hs_mask_pond, pond_decr @@ -394,7 +394,7 @@ subroutine ice_optics_SIS2(mp, hs, hi, ts, tfw, NkIce, albedos, abs_sfc, & end subroutine ice_optics_SIS2 -!> bright_ice_temp returns the skin temperature (in deg C) below which the snow +!> bright_ice_temp returns the skin temperature (in degC) below which the snow !! and ice attain their greatest brightness and albedo no longer varies, for !! the highest attainable salinity. function bright_ice_temp(CS, ITV) result(bright_temp) @@ -402,8 +402,8 @@ function bright_ice_temp(CS, ITV) result(bright_temp) type(ice_thermo_type), intent(in) :: ITV !< The ice thermodynamic parameter structure. real :: bright_temp - real :: salin_max ! The maximum attainable salinity, in PSU. - real :: temp_freeze_min ! The freezing temperature of water at salin_max, in C. + real :: salin_max ! The maximum attainable salinity [gSalt kg-1]. + real :: temp_freeze_min ! The freezing temperature of water at salin_max [degC]. salin_max = 40.0 diff --git a/src/SIS_slow_thermo.F90 b/src/SIS_slow_thermo.F90 index 48d27385..ac29f68b 100644 --- a/src/SIS_slow_thermo.F90 +++ b/src/SIS_slow_thermo.F90 @@ -81,10 +81,10 @@ module SIS_slow_thermo type slow_thermo_CS ; private logical :: specified_ice !< If true, the sea ice is specified and there is !! no need for ice dynamics. - real :: ice_bulk_salin !< The globally constant sea ice bulk salinity, in g/kg + real :: ice_bulk_salin !< The globally constant sea ice bulk salinity [gSalt kg-1] !! that is used to calculate the ocean salt flux. real :: ice_rel_salin !< The initial bulk salinity of sea-ice relative to the - !! salinity of the water from which it formed, nondim. + !! salinity of the water from which it formed [nondim]. logical :: filling_frazil !< If true, apply frazil to fill as many categories !! as possible to fill in a uniform (minimum) amount @@ -94,7 +94,7 @@ module SIS_slow_thermo real :: fraz_fill_time !< A timescale with which the filling frazil causes !! the thinest cells to attain similar thicknesses, !! or a negative number to apply the frazil flux - !! uniformly, in s. + !! uniformly [s]. logical :: do_ridging !< If true, apply a ridging scheme to the convergent !! ice. The original SIS2 implementation is based on @@ -104,10 +104,10 @@ module SIS_slow_thermo logical :: do_ice_restore !< If true, restore the sea-ice toward climatology !! by applying a restorative heat flux. real :: ice_restore_timescale !< The time scale for restoring ice when - !! do_ice_restore is true, in days. + !! do_ice_restore is true [days]. logical :: do_ice_limit !< Limit the sea ice thickness to max_ice_limit. - real :: max_ice_limit !< The maximum sea ice thickness, in m, when do_ice_limit is true. + real :: max_ice_limit !< The maximum sea ice thickness [m], when do_ice_limit is true. logical :: nudge_sea_ice = .false. !< If true, nudge sea ice concentrations towards observations. real :: nudge_sea_ice_rate = 0.0 !< The rate of cooling of ice-free water that should be ice @@ -122,10 +122,10 @@ module SIS_slow_thermo logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: column_check !< If true, enable the heat check column by column. - real :: imb_tol !< The tolerance for imbalances to be flagged by column_check, nondim. + real :: imb_tol !< The tolerance for imbalances to be flagged by column_check [nondim]. logical :: bounds_check !< If true, check for sensible values of thicknesses temperatures, fluxes, etc. - integer :: n_calls = 0 !< The number of times update_ice_model_slow_down has been called. + integer :: n_calls = 0 !< The number of times slow_thermodynamics has been called. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(SIS_diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -164,7 +164,7 @@ subroutine post_flux_diagnostics(IST, FIA, IOF, CS, G, IG, Idt_slow) 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, intent(in) :: Idt_slow !< The inverse of the slow thermodynamic - !! time step, in s-1 + !! time step [s-1] real, dimension(G%isd:G%ied,G%jsd:G%jed) :: tmp2d, net_sw, sw_dn real :: sw_cat @@ -306,7 +306,7 @@ end subroutine post_flux_diagnostics subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, 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, in s. + real, intent(in) :: dt_slow !< The thermodynamic step [s]. type(slow_thermo_CS), pointer :: CS !< The control structure for the SIS_slow_thermo module type(ocean_sfc_state_type), intent(inout) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. @@ -322,10 +322,10 @@ subroutine slow_thermodynamics(IST, dt_slow, CS, OSS, FIA, XSF, IOF, G, IG) ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - h_ice_input ! The specified ice thickness, with specified_ice, in m. + h_ice_input ! The specified ice thickness, with specified_ice [m]. - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: Idt_slow ! The inverse of the slow thermodynamic time step, in s-1 + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: Idt_slow ! The inverse of the slow thermodynamic time step [s-1] integer :: i, j, k, l, m, b, nb, isc, iec, jsc, jec, ncat, NkIce integer :: isd, ied, jsd, jed @@ -488,7 +488,7 @@ subroutine add_excess_fluxes(IOF, XSF, G) !! those stored in TSF type(SIS_hor_grid_type), intent(inout) :: G !< The horizontal grid type - real :: sw_comb ! A combination of two downward shortwave fluxes, in W m-2. + real :: sw_comb ! A combination of two downward shortwave fluxes [W m-2]. integer :: i, j, k, m, n, b, nb, isc, iec, jsc, jec integer :: isd, ied, jsd, jed @@ -560,7 +560,7 @@ end subroutine add_excess_fluxes !! including freezing or melting, and the accumulation of snow and frazil ice. subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, 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, in s. + real, intent(in) :: dt_slow !< The thermodynamic step [s]. type(slow_thermo_CS), pointer :: CS !< The control structure for the SIS_slow_thermo module type(ocean_sfc_state_type), intent(inout) :: OSS !< A structure containing the arrays that describe !! the ocean's surface state for the ice model. @@ -582,30 +582,30 @@ subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, IG) real, dimension(SZI_(G),SZJ_(G)) :: & qflx_lim_ice, qflx_res_ice, & cool_nudge, & ! A heat flux out of the sea ice that - ! acts to create sea-ice, in W m-2. + ! acts to create sea-ice [W m-2]. net_melt ! The net mass flux from the ice and snow into the ! ocean due to melting and freezing integrated - ! across all categories, in kg m-2 s-1. + ! across all categories [kg m-2 s-1]. real, dimension(SZI_(G),SZJ_(G),1:IG%CatIce) :: heat_in, enth_prev, enth real, dimension(SZI_(G),SZJ_(G)) :: heat_in_col, enth_prev_col, enth_col, enth_mass_in_col - real, dimension(IG%NkIce) :: S_col ! The salinity of a column of ice, in g/kg. + real, dimension(IG%NkIce) :: S_col ! The salinity of a column of ice [gSalt kg-1]. real, dimension(IG%NkIce+1) :: Salin ! The conserved bulk salinity of each - ! layer in g/kg, with the salinity of + ! layer [gSalt kg-1], with the salinity of ! newly formed ice in layer NkIce+1. - real, dimension(0:IG%NkIce) :: m_lay ! The masses of a column of ice and snow, in kg m-2. - real, dimension(0:IG%NkIce) :: Tcol0 ! The temperature of a column of ice and snow, in degC. - real, dimension(0:IG%NkIce) :: S_col0 ! The salinity of a column of ice and snow, in g/kg. - real, dimension(0:IG%NkIce) :: Tfr_col0 ! The freezing temperature of a column of ice and snow, in degC. + real, dimension(0:IG%NkIce) :: m_lay ! The masses of a column of ice and snow [kg m-2]. + real, dimension(0:IG%NkIce) :: Tcol0 ! The temperature of a column of ice and snow [degC]. + real, dimension(0:IG%NkIce) :: S_col0 ! The salinity of a column of ice and snow [gSalt kg-1]. + real, dimension(0:IG%NkIce) :: Tfr_col0 ! The freezing temperature of a column of ice and snow [degC]. real, dimension(0:IG%NkIce+1) :: & enthalpy ! The initial enthalpy of a column of ice and snow - ! and the surface ocean, in enth_units (often J/kg). + ! and the surface ocean [Enth ~> J kg-1]. real, dimension(IG%CatIce) :: frazil_cat ! The frazil heating applied to each thickness - ! category, averaged over the area of that category in J m-2. - real :: enthalpy_ocean ! The enthalpy of the ocean surface waters, in Enth_units. - real :: heat_fill_val ! An enthalpy to use for massless categories, in enth_units. + ! category, averaged over the area of that category [J m-2]. + real :: enthalpy_ocean ! The enthalpy of the ocean surface waters [Enth ~> J kg-1]. + real :: heat_fill_val ! An enthalpy to use for massless categories [Enth ~> J kg-1]. - real :: I_part ! The inverse of a part_size, nondim. + real :: I_part ! The inverse of a part_size [nondim]. logical :: spec_thermo_sal ! If true, use the specified salinities of the ! various sub-layers of the ice for all thermodynamic ! calculations; otherwise use the prognostic @@ -619,40 +619,40 @@ subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, IG) type(EOS_type), pointer :: EOS => NULL() real :: Cp_water real :: drho_dT(1), drho_dS(1), pres_0(1) - real :: rho_ice ! The nominal density of sea ice in kg m-3. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. - real :: Idt_slow ! The inverse of the thermodynamic step, in s-1. + real :: Idt_slow ! The inverse of the thermodynamic step [s-1]. real :: yr_dtslow ! The ratio of 1 year to the thermodyamic time step, used ! to change the units of several diagnostics to rate yr-1 real :: heat_to_ocn, h2o_ice_to_ocn, h2o_ocn_to_ice, evap_from_ocn, sn2ic, bablt - real :: salt_to_ice ! The flux of salt from the ocean to the ice, in kg m-2 s-1. + real :: salt_to_ice ! The flux of salt from the ocean to the ice [kg m-2 s-1]. ! This may be of either sign; in some places it is an ! average over the whole cell, while in others just a partition. - real :: mtot_ice ! The total mass of ice and snow in a cell, in kg m-2. - real :: e2m_tot ! The total enthalpy required to melt all ice and snow, in J m-2. + real :: mtot_ice ! The total mass of ice and snow in a cell [kg m-2]. + real :: e2m_tot ! The total enthalpy required to melt all ice and snow [J m-2]. real :: enth_evap, enth_ice_to_ocn, enth_ocn_to_ice, enth_snowfall real :: tot_heat, heating, tot_frazil, heat_mass_in, heat_input real :: mass_in, mass_here, mass_prev, mass_imb real :: enth_units, I_enth_units ! The units of enthaply and their inverse. - real :: frac_keep, frac_melt ! The fraction of ice and snow to keep or remove, nd. - real :: ice_melt_lay ! The amount of excess ice removed from each layer in kg/m2. - real :: snow_melt ! The amount of excess snow that is melted, in kg/m2. - real :: enth_freeze ! The freezing point enthalpy of a layer, in enth_units. + real :: frac_keep, frac_melt ! The fraction of ice and snow to keep or remove [nondim]. + real :: ice_melt_lay ! The amount of excess ice removed from each layer [kg m-2]. + real :: snow_melt ! The amount of excess snow that is melted [kg m-2]. + real :: enth_freeze ! The freezing point enthalpy of a layer [Enth ~> J kg-1]. real :: enth_to_melt ! The enthalpy addition required to melt the excess ice - ! and snow in enth_unit kg/m2. - real :: I_Nk ! The inverse of the number of layers in the ice, nondim. + ! and snow [Enth kg m-2 ~> J m-2]. + real :: I_Nk ! The inverse of the number of layers in the ice [nondim]. real :: kg_H_Nk ! The conversion factor from units of H to kg/m2 over Nk. real :: part_sum ! A running sum of partition sizes. real :: part_ocn ! A slightly modified ocean part size. - real :: d_enth ! The change in enthalpy between categories. + real :: d_enth ! The change in enthalpy between categories [Enth ~> J kg-1]. real :: fill_frac ! The fraction of the difference between the thicknesses ! in thin categories that will be removed within a single ! timestep with filling_frazil. - real :: sw_tot ! The total shortwave radiation incident on a category, in W m-2. + real :: sw_tot ! The total shortwave radiation incident on a category [W m-2]. integer :: i, j, k, l, m, n, b, nb, isc, iec, jsc, jec, ncat, NkIce, tr, npassive integer :: k_merge - real :: LatHtFus ! The latent heat of fusion of ice in J/kg. - real :: LatHtVap ! The latent heat of vaporization of water at 0C in J/kg. + real :: LatHtFus ! The latent heat of fusion of ice [J kg-1]. + real :: LatHtVap ! The latent heat of vaporization of water at 0C [J kg-1]. real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin real :: tot_heat_in, enth_here, enth_imb, norm_enth_imb, emic2, tot_heat_in2, enth_imb2 @@ -742,9 +742,24 @@ subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, IG) qflx_res_ice(i,j) = -(LatHtFus*Rho_ice*Obs_h_ice(i,j)*Obs_cn_ice(i,j,2)-e2m_tot) / & (86400.0*CS%ice_restore_timescale) if (qflx_res_ice(i,j) < 0.0) then + !There is less ice in model than Obs, + !so make some ice by increasing frazil heat FIA%frazil_left(i,j) = FIA%frazil_left(i,j) - qflx_res_ice(i,j)*dt_slow + !Note that ice should grow when frazil heat is positive elseif (qflx_res_ice(i,j) > 0.0) then - OSS%bheat(i,j) = OSS%bheat(i,j) + qflx_res_ice(i,j) + !There is more ice in model than Obs, + !so melt ice by increasing heat input to ice from ocean (bheat), + ! OSS%bheat(i,j) = OSS%bheat(i,j) + qflx_res_ice(i,j) + !Note that ice should melt when bheat increases. + !BUT, here it's too late for the bheat to have a negative feedback on the ice thickness + !since thickness is determined by the melting energies calculated in the fast ice + !module call ice_temp_SIS2() before this point. + !So, we should rather change the bottom melt energy directly here + !(as prescribed in ice_temp_SIS2) to have a restoring effect on the ice thickness + !later in the call ice_resize_SIS2() in this module. + do k=1,ncat + FIA%bmelt(i,j,k) = FIA%bmelt(i,j,k) + dt_slow*qflx_res_ice(i,j) + enddo endif enddo ; enddo endif @@ -791,9 +806,7 @@ subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, IG) bsnk(:,:) = 0.0 salt_change(:,:) = 0.0 h2o_change(:,:) = 0.0 -!$OMP parallel default(none) shared(isc,iec,jsc,jec,ncat,nb,G,IST,salt_change, & -!$OMP kg_H_Nk,h2o_change,NkIce,IG,CS,IOF,FIA) & -!$OMP private(part_ocn) + !$OMP parallel default(shared) private(part_ocn) if (CS%ice_rel_salin <= 0.0) then !$OMP do do j=jsc,jec ; do m=1,NkIce ; do k=1,ncat ; do i=isc,iec @@ -821,12 +834,25 @@ subroutine SIS2_thermodynamics(IST, dt_slow, CS, OSS, FIA, IOF, G, IG) IOF%lprec_ocn_top(i,j) = part_ocn * FIA%lprec_top(i,j,0) IOF%fprec_ocn_top(i,j) = part_ocn * FIA%fprec_top(i,j,0) enddo ; enddo + ! mw/new precip will eventually be intercepted by pond eliminating need for next 3 lines !$OMP do do j=jsc,jec ; do k=1,ncat ; do i=isc,iec IOF%lprec_ocn_top(i,j) = IOF%lprec_ocn_top(i,j) + & IST%part_size(i,j,k) * FIA%lprec_top(i,j,k) enddo ; enddo ; enddo + + ! Add fluxes of snow and other properties to the ocean due to recent ridging or drifting events. + if (allocated(IST%snow_to_ocn)) then + !$OMP do + do j=jsc,jec ; do i=isc,iec ; if (IST%snow_to_ocn(i,j) > 0.0) then + IOF%fprec_ocn_top(i,j) = IOF%fprec_ocn_top(i,j) + IST%snow_to_ocn(i,j) * Idt_slow + IOF%Enth_Mass_out_ocn(i,j) = IOF%Enth_Mass_out_ocn(i,j) - & + IST%snow_to_ocn(i,j) * IST%enth_snow_to_ocn(i,j) + ! h2o_change(i,j) = h2o_change(i,j) - IST%snow_to_ocn(i,j) + IST%snow_to_ocn(i,j) = 0.0 ; IST%enth_snow_to_ocn(i,j) = 0.0 + endif ; enddo ; enddo + endif !$OMP end parallel ! Set up temporary tracer array diff --git a/src/SIS_sum_output.F90 b/src/SIS_sum_output.F90 index c602a592..8648cc0b 100644 --- a/src/SIS_sum_output.F90 +++ b/src/SIS_sum_output.F90 @@ -49,30 +49,30 @@ module SIS_sum_output type, public :: SIS_sum_out_CS ; private real :: mass_prev !< The total sea ice mass the last time that - !! write_ice_statistics was called, in kg. + !! write_ice_statistics was called [kg]. real :: fresh_water_input !< The total mass of fresh water added by !! surface fluxes since the last time that real :: salt_prev !< The total amount of salt in the sea ice the last - !! time that write_ice_statistics was called, in PSU kg. + !! time that write_ice_statistics was called [gSalt]. real :: net_salt_input !< The total salt added by surface fluxes since the last - !! time that write_ice_statistics was called, in PSU kg. + !! time that write_ice_statistics was called [gSalt]. real :: heat_prev !< The total amount of heat in the sea ice the last - !! time that write_ice_statistics was called, in Joules. + !! time that write_ice_statistics was called [J]. real :: net_heat_input !< The total heat added by surface fluxes since the last - !! time that write_ice_statistics was called, in Joules. + !! time that write_ice_statistics was called [J]. real, dimension(:,:), allocatable :: & water_in_col, & !< The water that has been input to the ice and snow in a column since - !! the last time that write_ice_statistics was called, in kg m-2. + !! the last time that write_ice_statistics was called [kg m-2]. heat_in_col, & !< The heat that has been input to the ice and snow in a column since - !! the last time that write_ice_statistics was called, in J m-2. + !! the last time that write_ice_statistics was called [J m-2]. salt_in_col, & !< The salt that has been input to the ice and snow in a column since - !! the last time that write_ice_statistics was called, in kg m-2. + !! the last time that write_ice_statistics was called [kg m-2]. water_col_prev, & !< The column integrated water that was in the ice and snow the last - !! time that write_ice_statistics was called, in kg m-2. + !! time that write_ice_statistics was called [kg m-2]. heat_col_prev, & !< The column integrated heat that was in the ice and snow the last - !! time that write_ice_statistics was called, in J m-2. + !! time that write_ice_statistics was called [J m-2]. salt_col_prev !< The column integrated salt that was in the ice and snow the last - !! time that write_ice_statistics was called, in kg m-2. + !! time that write_ice_statistics was called [kg m-2]. type(EFP_type) :: fresh_water_in_EFP !< An extended fixed point version of fresh_water_in type(EFP_type) :: net_salt_in_EFP !< An extended fixed point version of net_salt_in @@ -80,14 +80,14 @@ 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, in s. - real :: timeunit !< The length of the units for the time axis, in s. + real :: dt !< The baroclinic dynamics time step [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 logical :: column_check !< If true, enable the column by column heat and !! mass conservation check real :: imb_tol !< The tolerance for imbalances to be flagged by - !! column_check, nondim. + !! column_check [nondim]. integer :: maxtrunc !< The number of truncations per ice statistics !! save interval at which the run is stopped. logical :: write_stdout !< If true, periodically write sea ice statistics @@ -226,57 +226,57 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t ! Local variables real, dimension(SZI_(G),SZJ_(G), 2) :: & - ice_area, & ! The area of ice in each cell and hemisphere, in m2. + ice_area, & ! The area of ice in each cell and hemisphere [m2]. ice_extent, & ! The extent (cells with >10% coverage) of ice in each - ! cell and hemisphere, in m2. + ! cell and hemisphere [m2]. col_mass, & ! The column integrated ice and snow mass in each cell and - ! hemisphere, in kg. + ! hemisphere [kg]. col_heat, & ! The column integrated ice and snow heat in each cell and - ! hemisphere, in J. + ! hemisphere [J]. col_salt ! The column integrated salt in the ice in each cell and - ! hemisphere in kg. + ! hemisphere [kg]. real, dimension(2) :: & - Area_NS, & ! The total sea-ice area in the two hemispheres, in m2. - Extent_NS, & ! The total sea-ice extent in the two hemispheres, in m2. - Heat_NS, & ! The total sea-ice enthalpy in the two hemispheres, in J. - mass_NS, & ! The total sea-ice mass in the two hemispheres, in kg. - salt_NS, & ! The total sea-ice salt in the two hemispheres, in kg. - salinity_NS ! The average sea-ice salinity in the two hemispheres, in g/kg. - - real :: Mass ! The total mass of the sea ice and snow atop it in kg. + Area_NS, & ! The total sea-ice area in the two hemispheres [m2]. + Extent_NS, & ! The total sea-ice extent in the two hemispheres [m2]. + Heat_NS, & ! The total sea-ice enthalpy in the two hemispheres [J]. + mass_NS, & ! The total sea-ice mass in the two hemispheres [kg]. + salt_NS, & ! The total sea-ice salt in the two hemispheres [kg]. + salinity_NS ! The average sea-ice salinity in the two hemispheres [gSalt kg-1]. + + real :: Mass ! The total mass of the sea ice and snow atop it [kg]. real :: mass_chg ! The change in total sea ice mass of fresh water since - ! the last call to this subroutine, in kg. + ! the last call to this subroutine [kg]. real :: mass_anom ! The change in fresh water that cannot be accounted for - ! by the surface fluxes, in kg. - real :: I_Mass ! Adcroft's rule reciprocal of mass: 1/Mass or 0, in kg-1. - real :: Salt ! The total amount of salt in the ocean, in PSU kg. + ! by the surface fluxes [kg]. + real :: I_Mass ! Adcroft's rule reciprocal of mass: 1/Mass or 0 [kg-1]. + real :: Salt ! The total amount of salt in the ocean [gSalt]. real :: Salt_chg ! The change in total sea ice salt since the last call - ! to this subroutine, in PSU kg. + ! to this subroutine [gSalt]. real :: Salt_anom ! The change in salt that cannot be accounted for by - ! the surface fluxes, in PSU kg. + ! the surface fluxes [gSalt]. real :: Salt_anom_norm ! The salt anomaly normalized by salt (if it is nonzero). - real :: salin ! The mean salinity of the ocean, in PSU. + real :: salin ! The mean salinity of the ocean [gSalt kg-1]. real :: salin_chg ! The change in total salt since the last call - ! to this subroutine divided by total mass, in PSU. + ! to this subroutine divided by total mass [gSalt kg-1]. real :: salin_anom ! The change in total salt that cannot be accounted for by - ! the surface fluxes divided by total mass in PSU. - real :: salin_mass_in ! The mass of salt input since the last call, kg. - real :: Heat ! The total amount of Heat in the ocean, in Joules. + ! the surface fluxes divided by total mass [gSalt kg-1]. + real :: salin_mass_in ! The mass of salt input since the last call [kg]. + real :: Heat ! The total amount of Heat in the ocean [J]. real :: Heat_chg ! The change in total sea ice heat since the last call - ! to this subroutine, in Joules. + ! to this subroutine [J]. real :: Heat_anom ! The change in heat that cannot be accounted for by - ! the surface fluxes, in Joules. + ! the surface fluxes [J]. real :: Heat_anom_norm ! The heat anomaly normalized by heat (if it is nonzero). - real :: temp ! The mean potential temperature of the ocean, in C. + real :: temp ! The mean potential temperature of the ocean [degC]. real :: temp_anom ! The change in total heat that cannot be accounted for ! by the surface fluxes, divided by the total heat - ! capacity of the ocean, in C. - real :: Area ! The total area of the sea ice in m2. - real :: Extent ! The total extent of the sea ice in m2. - real :: heat_imb ! The column integrated heat imbalance in enth_unit kg m-2. - real :: mass_imb ! The column integrated mass imbalance in kg. - real :: enth_liq_0 ! The enthalpy of liquid water at the freezing point, in enth_unit. + ! capacity of the ocean [degC]. + real :: Area ! The total area of the sea ice [m2]. + real :: Extent ! The total extent of the sea ice [m2]. + real :: heat_imb ! The column integrated heat imbalance [Enth kg m-2 ~> J m-2]. + real :: mass_imb ! The column integrated mass imbalance [kg]. + real :: enth_liq_0 ! The enthalpy of liquid water at the freezing point [Enth ~> J kg-1]. real :: I_nlay, kg_H_nlay, area_pt real :: area_h ! The masked area of a column. type(EFP_type) :: & @@ -284,10 +284,10 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t salt_EFP, heat_EFP, salt_chg_EFP, heat_chg_EFP, mass_chg_EFP, & mass_anom_EFP, salt_anom_EFP, heat_anom_EFP - 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, in s. - real :: max_CFL ! The maximum of the CFL numbers, nondim. + 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 :: max_CFL ! The maximum of the CFL numbers [nondim]. real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int logical :: check_col @@ -445,6 +445,11 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t ((0.001*IST%mH_ice(i,j,k)*kg_H_nlay) * IST%sal_ice(i,j,k,L)) 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) + 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) enddo ; enddo @@ -463,24 +468,24 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t ! Calculate the maximum CFL numbers. max_CFL = 0.0 dt_CFL = max(CS%dt, 0.) - 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)) - else - 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) * 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) * G%IareaT(i,j)) - endif - max_CFL = max(max_CFL, CFL_trans) - enddo ; enddo ; endif - if ( .not.(allocated(IST%u_ice_C) .or. allocated(IST%v_ice_C)) .and. & - (allocated(IST%u_ice_B) .and. allocated(IST%v_ice_B)) ) then + 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)) + else + 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) * 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) * 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) @@ -525,8 +530,8 @@ subroutine write_ice_statistics(IST, day, n, G, IG, CS, message, check_column, t ! if (G%Boussinesq) then mass_anom_EFP = mass_chg_EFP - CS%fresh_water_in_EFP ! else - ! net_salt_input needs to be converted from psu m s-1 to kg m-2 s-1. ! mass_anom_EFP = mass_chg_EFP - CS%fresh_water_in_EFP + ! net_salt_input needs to be converted from gSalt kg-1 m s-1 to kg m-2 s-1. ! salin_mass_in = 0.001*EFP_to_real(CS%net_salt_in_EFP) ! endif mass_chg = EFP_to_real(mass_chg_EFP) @@ -773,23 +778,23 @@ subroutine accumulate_input_1(IST, FIA, OSS, dt, G, IG, CS) ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - FW_in, & ! The net fresh water input, integrated over a timestep in kg. + FW_in, & ! The net fresh water input, integrated over a timestep [kg]. salt_in, & ! The total salt added by surface fluxes, integrated - ! over a time step in PSU kg. + ! over a time step [gSalt]. heat_in ! The total heat added by surface fluxes, integrated - ! over a time step in Joules. + ! over a time step [J]. real :: FW_input ! The net fresh water input, integrated over a timestep - ! and summed over space, in kg. + ! and summed over space [kg]. real :: salt_input ! The total salt added by surface fluxes, integrated - ! over a time step and summed over space, in kg. + ! over a time step and summed over space [kg]. real :: heat_input ! The total heat added by surface fluxes, integrated - ! over a time step and summed over space, in Joules. + ! over a time step and summed over space [J]. real :: area_h, area_pt, Flux_SW real :: enth_units type(EFP_type) :: & - FW_in_EFP, & ! Extended fixed point versions of FW_input, salt_input, and - salt_in_EFP, & ! heat_input, in kg, PSU kg, and Joules. - heat_in_EFP ! + FW_in_EFP, & ! Extended fixed point version of FW_input [kg] + salt_in_EFP, & ! Extended fixed point version of salt_input [gSalt] + heat_in_EFP ! Extended fixed point version of heat_input [J] integer :: i, j, k, isc, iec, jsc, jec, ncat, b, nb isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce @@ -830,7 +835,7 @@ subroutine accumulate_input_2(IST, FIA, IOF, OSS, part_size, dt, G, IG, CS) !! the ocean's surface state for the ice model. real, dimension(SZI_(G),SZJ_(G),SZCAT0_(IG)), & intent(in) :: part_size !< The fractional ice concentration within a - !! cell in each thickness category, nondimensional, 0-1. + !! cell in each thickness category [nondim], 0-1. real, intent(in) :: dt !< The amount of time over which to average. type(SIS_sum_out_CS), pointer :: CS !< The control structure returned by a previous call !! to SIS_sum_output_init. diff --git a/src/SIS_tracer_advect.F90 b/src/SIS_tracer_advect.F90 index 461fc281..fd530512 100644 --- a/src/SIS_tracer_advect.F90 +++ b/src/SIS_tracer_advect.F90 @@ -23,7 +23,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, in s. + real :: dt !< The baroclinic dynamics time step [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. @@ -46,20 +46,20 @@ module SIS_tracer_advect !> 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) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_prev !< Category thickness times fractional - !! coverage before advection, in m or kg m-2. + !! coverage before advection [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_end !< Layer thickness times fractional - !! coverage after advection, in m or kg m-2. + !! 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, in m3 s-1 or kg s-1. + !! zonal faces [H m2 s-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces, in m3 s-1 or kg s-1. - real, intent(in) :: dt !< Time increment in s. + !! meridional faces [H m2 s-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [s]. 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. @@ -101,20 +101,20 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, IG, CS) ! (, 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 - type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type + type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_prev !< Category thickness times fractional - !! coverage before advection, in m or kg m-2. + !! coverage before advection [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_end !< Layer thickness times fractional - !! coverage after advection, in m or kg m-2. + !! 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, in m3 s-1 or kg s-1. + !! zonal faces [H m2 s-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces, in m3 s-1 or kg s-1. - real, intent(in) :: dt !< Time increment in s. + !! 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(SIS_tracer_advect_CS), pointer :: CS !< The control structure returned by a previous !! call to SIS_tracer_advect_init. @@ -125,19 +125,19 @@ subroutine advect_tracer(Tr, h_prev, h_end, uhtr, vhtr, ntr, dt, G, 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, in m3. + hprev ! The cell volume at the end of the previous tracer change [m3]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)) :: & - uhr ! The remaining zonal thickness flux, in m3. + uhr ! The remaining zonal thickness flux [m3]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)) :: & - vhr ! The remaining meridional thickness fluxes, in m3. + vhr ! The remaining meridional thickness fluxes [m3]. 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, in m3 or kg. + ! can be simply discarded [H m2 ~> kg]. real :: landvolfill ! An arbitrary? nonzero cell volume, m3. - real :: Idt ! 1/dt in s-1. + real :: Idt ! 1/dt [s-1]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m or kg m-2. + ! in roundoff and can be neglected [H ~> kg m-2]. logical :: domore_u(SZJ_(G),SZCAT_(IG)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZCAT_(IG)) ! advection to be done in the corresponding ! row or column. @@ -351,48 +351,48 @@ 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) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: scalar !< Scalar tracer field to be advected, in arbitrary units + intent(inout) :: scalar !< Scalar tracer field to be advected, in arbitrary units [Conc] real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_prev !< Category thickness times fractional - !! coverage before advection, in m or kg m-2. + !! coverage before advection [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_end !< Layer thickness times fractional - !! coverage after advection, in m or kg m-2. + !! 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, in m3 s-1 or kg s-1. + !! zonal faces [H m2 s-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces, in m3 s-1 or kg s-1. - real, intent(in) :: dt !< Time increment in s. + !! meridional faces [H m2 s-1 ~> kg s-1]. + real, intent(in) :: dt !< Time increment [s]. 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, in m3. + hprev ! The cell volume at the end of the previous tracer change [m3]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)) :: & - uhr ! The remaining zonal thickness flux, in m3. + uhr ! The remaining zonal thickness flux [m3]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)) :: & - vhr ! The remaining meridional thickness fluxes, in m3. + vhr ! The remaining meridional thickness fluxes [m3]. 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, in m3 or kg. + ! can be simply discarded [H m2 ~> kg]. real :: landvolfill ! An arbitrary? nonzero cell volume, m3. - real :: Idt ! 1/dt in s-1. + real :: Idt ! 1/dt [s-1]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m or kg m-2. + ! in roundoff and can be neglected [H ~> kg m-2]. logical :: domore_u(SZJ_(G),SZCAT_(IG)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZCAT_(IG)) ! advection to be done in the corresponding ! row or column. logical :: x_first ! If true, advect in the x-direction first. integer :: max_iter ! The maximum number of iterations in each layer. - real, dimension(SZIB_(G),SZJ_(G)) :: flux_U2d_x ! x-direction tracer fluxes, in conc * kg - real, dimension(SZI_(G),SZJB_(G)) :: flux_U2d_y ! y-direction tracer fluxes, in conc * kg - real :: tr_up ! Upwind tracer concentrations, in conc. + 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. integer :: domore_k(SZCAT_(IG)) @@ -600,23 +600,23 @@ end subroutine advect_scalar subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: scalar !< Scalar tracer field to be advected, in arbitrary units + 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, in m or kg m-2. + !! before this step of advection [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: uhr !< Remaining volume or mass fluxes through - !! zonal faces, in m3 or kg. + !! zonal faces [H m2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G)), & - intent(inout) :: uh_neglect !< A value of uhr that can be neglected, in m3 or kg. + intent(inout) :: uh_neglect !< A value of uhr that can be neglected [H m2 ~> 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, in s-1 + real, intent(in) :: Idt !< The inverse of the time increment [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 @@ -627,35 +627,34 @@ subroutine advect_scalar_x(scalar, hprev, uhr, uh_neglect, domore_u, Idt, & ! This subroutine does 1-d flux-form advection in the zonal direction using ! a monotonic piecewise linear scheme. real, dimension(SZI_(G)) :: & - slope_x ! The concentration slope per grid point in units of - ! concentration (nondim.). + slope_x ! The concentration slope per grid point [Conc]. real, dimension(SZIB_(G)) :: & Tr_x ! The tracer concentration averaged over the water flux - ! across a zonal boundary in conc. + ! across a zonal boundary [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & mass_mask ! A multiplicative mask at velocity points that is 1 if ! both neighboring cells have any mass, and 0 otherwise. real :: maxslope ! The maximum concentration slope per grid point consistent - ! with monotonicity, in conc. (nondim.). + ! 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 in m3 or kg. + ! the grid box, both [H m2 ~> kg]. real, dimension(SZIB_(G)) :: & - uhh, & ! The zonal flux that occurs during the current iteration, in m3 or kg. - CFL ! A nondimensional work variable. + uhh, & ! The zonal flux that occurs during the current iteration [H m2 ~> 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. 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, in m3 or kg. - real :: hnew ! The projected thickness, in m3 or kg. + ! and west of the present cell [H m2 ~> kg]. + real :: hnew ! The projected thickness [H m2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers in m3 or kg. + ! well defined in the limit of vanishing layers [H m2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or - ! out of a cell, in m3 or kg. + ! 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, in m or kg m-2. + ! 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 @@ -746,23 +745,23 @@ end subroutine advect_scalar_x subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_tracer_type), dimension(ntr), & 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, in m or kg m-2. + !! coverage before advection [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: uhr !< Remaining volume or mass fluxes through - !! zonal faces, in m3 or kg. + !! zonal faces [H m2 ~> kg]. real, dimension(SZIB_(G),SZJ_(G)), & - intent(inout) :: uh_neglect !< A value of uhr that can be neglected, in m3 or kg. + intent(inout) :: uh_neglect !< A value of uhr that can be neglected [H m2 ~> 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, in s-1 + real, intent(in) :: Idt !< The inverse of the time increment [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 @@ -777,35 +776,34 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, domore_u, ntr, nL_max, Idt, & ! Local variables real, dimension(SZI_(G),nL_max,ntr) :: & - slope_x ! The concentration slope per grid point in units of - ! concentration (nondim.). + slope_x ! The concentration slope per grid point [Conc]. real, dimension(SZIB_(G),nL_max,ntr) :: & Tr_x ! The tracer concentration averaged over the water flux - ! across a zonal boundary in conc. + ! across a zonal boundary [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & mass_mask ! A multiplicative mask at velocity points that is 1 if ! both neighboring cells have any mass, and 0 otherwise. real :: maxslope ! The maximum concentration slope per grid point consistent - ! with monotonicity, in conc. (nondim.). + ! 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 in m3 or kg. + ! the grid box, both [H m2 ~> kg]. real, dimension(SZIB_(G)) :: & - uhh, & ! The zonal flux that occurs during the current iteration, in m3 or kg. - CFL ! A nondimensional work variable. + uhh, & ! The zonal flux that occurs during the current iteration [H m2 ~> 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. 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, in m3 or kg. - real :: hnew ! The projected thickness, in m3 or kg. + ! and west of the present cell [H m2 ~> kg]. + real :: hnew ! The projected thickness [H m2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers in m3 or kg. + ! well defined in the limit of vanishing layers [H m2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or - ! out of a cell, in m3 or kg. + ! 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, in m. + ! in roundoff and can be neglected [m]. logical :: do_i(SZI_(G)) ! If true, work on given points. logical :: do_any_i integer :: i, j, l, m @@ -920,16 +918,16 @@ 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, in m or kg m-2. + !! before this step of advection [H ~> kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: uhr !< Remaining volume or mass fluxes through - !! zonal faces, in m3 or kg. + !! zonal faces [H m2 ~> kg]. real, dimension(SZIB_(G)), intent(inout) :: uhh !< The volume or mass flux that can be accomodated - !! with this pass of advection, in m3 or kg. + !! with this pass of advection [H m2 ~> 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, in m or kg m-2. + !! in roundoff and can be neglected [H ~> kg m-2]. ! Local integer :: i real :: hup, hlos @@ -972,10 +970,10 @@ subroutine kernel_PLM_slope_x(G, is, ie, j, scalar, uMask, slope_x) 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),SZJ_(G)), intent(in) :: scalar !< The tracer concentration to advect, - !! in arbitrary units of CONC + !! in arbitrary units [Conc] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uMask !< A multiplicative mask at u-points real, dimension(SZI_(G)), intent(inout) :: slope_x !< The x-slope in tracer concentration - !! times the grid spacing, in units of CONC. + !! times the grid spacing [Conc]. ! Local integer :: i real :: Tp, Tc, Tm, dMx, dMn @@ -999,9 +997,9 @@ 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, in m3 or kg. + !! pass of advection [H m2 ~> 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 + real, dimension(SZIB_(G)), intent(inout) :: Tr_x !< The average tracer concentration in the flux [Conc] ! Local integer :: i real :: Tp, Tc, Tm, aL, aR, dA, a6, mA @@ -1075,23 +1073,23 @@ end subroutine kernel_PPMH3_Tr_x subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & 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, in m or kg m-2. + !! 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, in m3 or kg. + !! meridional faces [H m2 ~> kg]. real, dimension(SZI_(G),SZJB_(G)), & - intent(inout) :: vh_neglect !< A value of vhr that can be neglected, in m3 or kg. + intent(inout) :: vh_neglect !< A value of vhr that can be neglected [H m2 ~> 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, in s-1 + real, intent(in) :: Idt !< The inverse of the time increment [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 @@ -1103,35 +1101,34 @@ subroutine advect_scalar_y(scalar, hprev, vhr, vh_neglect, domore_v, Idt, & ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - slope_y ! The concentration slope per grid point in units of - ! concentration (nondim.). + slope_y ! The concentration slope per grid point [Conc]. real, dimension(SZI_(G),SZJB_(G)) :: & Tr_y ! The tracer concentration averaged over the water flux - ! across a meridional boundary in conc. + ! across a meridional boundary [Conc]. real, dimension(SZI_(G),SZJB_(G)) :: & 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, in m3 or kg. + ! iteration [H m2 ~> kg]. real :: maxslope ! The maximum concentration slope per grid point consistent - ! with monotonicity, in conc. (nondim.). + ! 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 in m3 or kg. + ! the grid box, both [H m2 ~> 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, in m3 or kg. - CFL ! A nondimensional work variable. - real :: hnew ! The projected thickness, in m3 or kg. + ! and south of the present cell [H m2 ~> kg]. + CFL ! A nondimensional work variable [nondim]. + real :: hnew ! The projected thickness [H m2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers in m3 or kg. + ! well defined in the limit of vanishing layers [H m2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or - ! out of a cell, in m3 or kg. + ! 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, in m. + ! in roundoff and can be neglected [m]. 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 @@ -1229,23 +1226,23 @@ end subroutine advect_scalar_y subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & is, ie, js, je, k, G, IG, usePPM, usePCM) ! (, OBC) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_tracer_type), dimension(ntr), & intent(inout) :: Tr !< The tracers being advected real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: hprev !< Category thickness times fractional coverage - !! before this step of advection, in m or kg m-2. + !! 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, in m3 or kg. + !! meridional faces [H m2 ~> kg]. real, dimension(SZI_(G),SZJB_(G)), & - intent(inout) :: vh_neglect !< A value of vhr that can be neglected, in m3 or kg. + intent(inout) :: vh_neglect !< A value of vhr that can be neglected [H m2 ~> 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, in s-1 + real, intent(in) :: Idt !< The inverse of the time increment [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 @@ -1258,35 +1255,34 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, domore_v, ntr, nL_max, Idt, & ! This subroutine does 1-d flux-form advection using a monotonic piecewise ! linear scheme. real, dimension(SZI_(G),SZJ_(G),nL_max,ntr) :: & - slope_y ! The concentration slope per grid point in units of - ! concentration (nondim.). + slope_y ! The concentration slope per grid point [Conc]. real, dimension(SZI_(G),SZJB_(G),nL_max,ntr) :: & Tr_y ! The tracer concentration averaged over the water flux - ! across a meridional boundary in conc. + ! across a meridional boundary [Conc]. real, dimension(SZI_(G),SZJB_(G)) :: & 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, in m3 or kg. + ! iteration [H m2 ~> kg]. real :: maxslope ! The maximum concentration slope per grid point consistent - ! with monotonicity, in conc. (nondim.). + ! 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 in m3 or kg. + ! the grid box, both [H m2 ~> 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, in m3 or kg. - CFL ! A nondimensional work variable. - real :: hnew ! The projected thickness, in m3 or kg. + ! and south of the present cell [H m2 ~> kg]. + CFL ! A nondimensional work variable [nondim]. + real :: hnew ! The projected thickness [H m2 ~> kg]. real :: h_add ! A tiny thickness to add to keep the new tracer calculation - ! well defined in the limit of vanishing layers in m3 or kg. + ! well defined in the limit of vanishing layers [H m2 ~> kg]. real :: I_htot ! The inverse of the sum of thickness within or passing or - ! out of a cell, in m3 or kg. + ! 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, in m or kg m-2. + ! 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 @@ -1421,18 +1417,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, in m or kg m-2. + !! before this step of advection [H ~> kg m-2]. real, dimension(SZI_(G),SZJB_(G)), & intent(in) :: vhr !< Remaining volume or mass fluxes through - !! meridional faces, in m3 or kg. + !! meridional faces [H m2 ~> kg]. real, dimension(SZI_(G),SZJB_(G)), & intent(inout) :: vhh !< The volume or mass flux that can be accomodated - !! with this pass of advection, in m3 or kg. + !! with this pass of advection [H m2 ~> 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, in m or kg m-2. + !! in roundoff and can be neglected [H ~> kg m-2]. ! Local integer :: i real :: hup, hlos @@ -1476,10 +1472,10 @@ subroutine kernel_PLM_slope_y(G, is, ie, j, scalar, vMask, slope_y) 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),SZJ_(G)), intent(in) :: scalar !< The tracer concentration to advect, - !! in arbitrary units of CONC + !! in arbitrary units [Conc] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vMask !< A multiplicative mask at v-points real, dimension(SZI_(G)), intent(inout) :: slope_y !< The y-slope in tracer concentration - !! times the grid spacing, in units of CONC. + !! times the grid spacing [Conc]. ! Local integer :: i real :: Tp, Tc, Tm, dMx, dMn @@ -1503,7 +1499,7 @@ subroutine kernel_PPMH3_Tr_y(G, is, ie, J, scalar, vMask, vhh, CFL, Tr_y) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: scalar !< The tracer concentration to advect real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vMask !< A multiplicative mask at v-points real, dimension(SZI_(G),SZJB_(G)), intent(in) :: vhh !< The volume or mass flux in this pass of - !! advection, in m3 or kg. + !! advection [H m2 ~> kg]. real, dimension(SZI_(G)), intent(in) :: CFL !< The CFL number for this phase of advection real, dimension(SZI_(G)), intent(inout) :: Tr_y !< The average tracer concentration in the flux ! Local variables, all with the same units as scalar. @@ -1578,28 +1574,28 @@ 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) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_tracer_type), dimension(ntr), & intent(inout) :: Tr !< The tracer concentrations being advected real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_prev !< Category thickness times fractional - !! coverage before advection, in m or kg m-2. + !! coverage before advection [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(in) :: h_end !< Layer thickness times fractional - !! coverage after advection, in m or kg m-2. + !! 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, in m3 s-1 or kg s-1. + !! zonal faces [H m2 s-1 ~> kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)), & intent(in) :: vhtr !< Accumulated volume or mass fluxes through - !! meridional faces, in m3 s-1 or kg s-1. - real, intent(in) :: dt !< Time increment in s. + !! 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 - real, dimension(SZIB_(G),SZJ_(G)) :: flux_x ! x-direction tracer fluxes, in conc * kg - real, dimension(SZI_(G),SZJB_(G)) :: flux_y ! y-direction tracer fluxes, in conc * kg - real :: tr_up ! Upwind tracer concentrations, in conc. - real :: Idt ! The inverse of the time increment, in s-1 + 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 :: 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. integer :: i, j, k, l, m, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -1660,11 +1656,11 @@ end subroutine advect_upwind_2d subroutine advect_tracers_thicker(vol_start, vol_trans, G, IG, CS, & TrReg, snow_tr, j, is, ie) type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type - type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific 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, in kg or m3. + intent(in) :: vol_start !< The category volume before advection [H m2 ~> kg]. real, dimension(SZI_(G),SZCAT_(IG)),& - intent(in) :: vol_trans !< The category volume to transfer, in kg or m3. + intent(in) :: vol_trans !< The category volume to transfer [H m2 ~> 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. @@ -1729,17 +1725,11 @@ subroutine SIS_tracer_advect_init(Time, G, param_file, diag, CS, scheme) !! call to SIS_tracer_advect_init. character(len=*), optional, intent(in) :: scheme !< A character string describing the tracer !! advection scheme. Valid entries include PCM, PLM, and PPM -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer to the control structure for this module - -! integer, save :: init_calls = 0 + + ! Local variables logical :: debug -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "SIS_tracer_advect" ! This module's name. character(len=256) :: mesg ! Message for error messages. diff --git a/src/SIS_tracer_flow_control.F90 b/src/SIS_tracer_flow_control.F90 index 886b7f01..41bad55a 100644 --- a/src/SIS_tracer_flow_control.F90 +++ b/src/SIS_tracer_flow_control.F90 @@ -95,19 +95,6 @@ subroutine SIS_call_tracer_register(G, IG, param_file, CS, diag, TrReg, & type(restart_file_type), intent(inout) :: Ice_restart !< The SIS restart structure character(len=*), intent(in) :: restart_file !< The full path to the restart file. - ! Argument: G - The ice model's horizontal grid structure. - ! (in) IG - The ice model's grid structure. - ! (in) param_file - A structure indicating the open file to parse for - ! model parameter values. - ! - ! (in/out) CS - A pointer that is set to point to the control structure - ! for the tracer flow control - ! (in) diag - A structure that is used to regulate diagnostic output. - ! (in/out) TrReg - A pointer that is set to point to the control structure - ! for the tracer advection and diffusion module. - ! (in/out) Ice model restart file to be written to - ! (in) Path to the restart file - ! ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "SIS_tracer_flow_control" ! This module's name. @@ -147,13 +134,6 @@ subroutine SIS_tracer_flow_control_init(day, G, IG, param_file, CS, is_restart) !! segment is being initialized from a restart file ! This subroutine calls all registered tracer initialization subroutines. - ! Arguments: - ! (in) day - Time of the start of the run. - ! (in) G - The ice model's horizontal grid structure. - ! (in) IG - The ice model's vertical grid structure. - ! (in) CS - The control structure returned by a previous call to - ! call_tracer_register. - ! (in) is_restart - flag for whether tracer should be initialized from restart if (.not. associated(CS)) call SIS_error(FATAL, "tracer_flow_control_init: "// & "Module must be initialized via call_tracer_register before it is used.") @@ -165,17 +145,17 @@ end subroutine SIS_tracer_flow_control_init !> Call all registered ice-tracer column physics subroutines subroutine SIS_call_tracer_column_fns(dt, G, IG, CS, mi, mi_old) - real, intent(in) :: dt !< The amount of time covered by this call, in s. + real, intent(in) :: dt !< The amount of time covered by this call [s]. 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(SIS_tracer_flow_control_CS), & pointer :: CS !< The control structure returned by a !! previous call to SIS_call_tracer_register. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mi !< Mass of ice in a given category in kg m-2 at the + intent(in) :: mi !< Mass of ice in a given category [kg m-2] at the !! end of the timestep real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mi_old !< Mass of ice in a given category in kg m-2 at the + intent(in) :: mi_old !< Mass of ice in a given category [kg m-2] at the !! beginning of the timestep ! This subroutine calls all registered ice-tracer column physics subroutines. @@ -196,7 +176,7 @@ subroutine SIS_call_tracer_stocks(G, IG, CS, mi, stock_values, stock_names, & type(SIS_tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to SIS_call_tracer_register. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mi !< Mass of ice in a given category in kg m-2, used for summing + intent(in) :: mi !< Mass of ice in a given category [kg m-2], used for summing real, dimension(:), intent(out) :: stock_values !< The values of the summed tracer stocks. character(len=*), dimension(:), & optional, intent(out) :: stock_names !< The names of the summed tracer stocks. @@ -204,15 +184,7 @@ subroutine SIS_call_tracer_stocks(G, IG, CS, mi, stock_values, stock_names, & optional, intent(out) :: stock_units !< The units of the tracer stocks integer, optional, intent(out) :: num_stocks !< The number of summed tracer stocks. - ! Arguments: - ! (in) G - The ocean's grid structure. - ! (in) IG - The ocean's vertical grid structure. - ! (in) CS - The control structure returned by a previous call to - ! call_tracer_register. - ! (in) mi - mass of ice in a given category, used for summing - ! (out) stocks - Global integral of tracer - ! (out) nstocks - Number of passive tracer stocks - + ! Local variables character(len=200), dimension(MAX_FIELDS_) :: names, units character(len=200) :: set_pkg_name real, dimension(MAX_FIELDS_) :: values diff --git a/src/SIS_tracer_registry.F90 b/src/SIS_tracer_registry.F90 index bc174928..1fb345c8 100644 --- a/src/SIS_tracer_registry.F90 +++ b/src/SIS_tracer_registry.F90 @@ -50,14 +50,14 @@ 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 in units of CONC m3 s-1. + !! ice category [Conc kg s-1]. real, dimension(:,:), & pointer :: ad2d_y => NULL() !< The y-direction advective flux summed vertically and across - !! ice category in units of CONC m3 s-1. + !! ice category [Conc kg s-1]. real, dimension(:,:,:), & - pointer :: ad3d_x => NULL() !< The vertically summed x-direction advective flux in units of CONC m3 s-1. + pointer :: ad3d_x => NULL() !< The vertically summed x-direction advective flux [Conc kg s-1]. real, dimension(:,:,:), & - pointer :: ad3d_y => NULL() !< The vertically summed y-direction advective flux in units of CONC m3 s-1. + pointer :: ad3d_y => NULL() !< The vertically summed y-direction advective flux [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. @@ -110,7 +110,7 @@ subroutine register_SIS_tracer(tr1, G, IG, nLtr, name, param_file, TrReg, snow_t type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG),nLtr), & target, intent(in) :: tr1 !< The pointer to the tracer, in arbitrary - !! concentration units (CONC), and dimensions of + !! concentration units [Conc], and dimensions of !! i-, j-, category, and layer. character(len=*), intent(in) :: name !< The name to be used in messages about the tracer. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -120,31 +120,31 @@ 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 in units of CONC m3 s-1. + !! vertically and across ice category [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 in units of CONC m3 s-1. + !! vertically and across ice category [Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_x !< An array for the vertically summed x-direction - !! advective flux in units of CONC m3 s-1. + !! advective flux [Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_y !< An array for the vertically summed y-direction - !! advective flux in units of CONC m3 s-1. + !! advective flux [Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_x !< An array for the x-direction advective flux by - !! ice category and layer in units of CONC m3 s-1. + !! ice category and layer [Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_y !< An array for the x-direction advective flux by - !! ice category and layer in units of CONC m3 s-1. + !! ice category and layer [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). + !! OBC_in_v are not specified, in the same units as tr [Conc]. real, dimension(:,:,:), & optional, pointer :: OBC_in_u !< The value of the tracer at inflows through u-faces - !! of tracer cells, in the same units as tr (CONC). + !! of tracer cells, in the same units as tr [Conc]. real, dimension(:,:,:), & optional, pointer :: OBC_in_v !< The value of the tracer at inflows through v-faces - !! of tracer cells, in the same units as tr (CONC). + !! of tracer cells, in the same units as tr [Conc]. logical, optional, intent(in) :: nonnegative !< If true, this tracer should never be negative. real, dimension(:,:,:), & optional, pointer :: ocean_BC !< Value of the tracer at the ice-ocean boundary @@ -228,11 +228,11 @@ subroutine register_SIS_tracer_pair(ice_tr, nL_ice, name_ice, snow_tr, nL_snow, type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG),nL_ice), & target, intent(in) :: ice_tr !< The pointer to the ice tracer, in arbitrary - !! concentration units (CONC), and dimensions + !! concentration units [Conc], and dimensions !! of i-, j-, category, and layer. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG),nL_snow), & target, intent(in) :: snow_tr !< The pointer to the snow tracer, in arbitrary - !! concentration units (CONC), and dimensions + !! concentration units [Conc], and dimensions !! of i-, j-, category, and layer. character(len=*), intent(in) :: name_ice !< The name to be used in messages about the tracer. character(len=*), intent(in) :: name_snow !< The name to be used in messages about the tracer. @@ -416,7 +416,7 @@ subroutine set_massless_SIS_tracers(mass, TrReg, G, IG, compute_domain, do_snow, 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),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mass !< The ice or snow mass in H units. + intent(in) :: mass !< The ice or snow mass [H ~> kg m-2]. type(SIS_tracer_registry_type), intent(inout) :: TrReg !< A pointer to the SIS tracer registry logical, optional, intent(in) :: compute_domain !< If true, work over the whole data domain logical, optional, intent(in) :: do_snow !< If true, work on snow tracers; the default is true. @@ -500,13 +500,13 @@ subroutine add_SIS_tracer_OBC_values(name, TrReg, OBC_inflow, OBC_in_u, OBC_in_v pointer :: TrReg !< A pointer to the SIS tracer registry 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). + !! OBC_in_v are not specified, in the same units as tr [Conc]. real, dimension(:,:,:), & optional, pointer :: OBC_in_u !< The value of the tracer at inflows through u-faces - !! of tracer cells, in the same units as tr (CONC). + !! of tracer cells, in the same units as tr [Conc]. real, dimension(:,:,:), & optional, pointer :: OBC_in_v !< The value of the tracer at inflows through v-faces - !! of tracer cells, in the same units as tr (CONC). + !! of tracer cells, in the same units as tr [Conc]. ! This subroutine adds open boundary condition concentrations for a tracer that ! has previously been registered by a call to register_SIS_tracer. @@ -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 in units of CONC m3 s-1. + !! vertically and across ice category [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 in units of CONC m3 s-1. + !! vertically and across ice category [Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_x !< An array for the vertically summed x-direction - !! advective flux in units of CONC m3 s-1. + !! advective flux [Conc kg s-1]. real, dimension(:,:,:), & optional, pointer :: ad_3d_y !< An array for the vertically summed y-direction - !! advective flux in units of CONC m3 s-1. + !! advective flux [Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_x !< An array for the x-direction advective flux by - !! ice category and layer in units of CONC m3 s-1. + !! ice category and layer [Conc kg s-1]. real, dimension(:,:,:,:), & optional, pointer :: ad_4d_y !< An array for the x-direction advective flux by - !! ice category and layer in units of CONC m3 s-1. + !! ice category and layer [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 01b4c606..a94b5850 100644 --- a/src/SIS_transport.F90 +++ b/src/SIS_transport.F90 @@ -3,24 +3,27 @@ module SIS_transport ! This file is a part of SIS2. See LICENSE.md for the licnese. -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 MOM_coms, only : reproducing_sum, EFP_type, EFP_to_real, EFP_real_diff use MOM_domains, only : pass_var, pass_vector, BGRID_NE, CGRID_NE use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING use MOM_error_handler, only : SIS_mesg=>MOM_mesg, is_root_pe 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 SIS_tracer_registry, only : SIS_tracer_registry_type, get_SIS_tracer_pointer -use SIS_tracer_registry, only : update_SIS_tracer_halos, set_massless_SIS_tracers -use SIS_tracer_registry, only : check_SIS_tracer_bounds +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 +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 +use SIS_hor_grid, only : SIS_hor_grid_type use SIS_tracer_advect, only : advect_tracers_thicker, SIS_tracer_advect_CS use SIS_tracer_advect, only : advect_SIS_tracers, SIS_tracer_advect_init, SIS_tracer_advect_end use SIS_tracer_advect, only : advect_scalar -use SIS_continuity, only : SIS_continuity_init, SIS_continuity_end -use SIS_continuity, only : continuity=>ice_continuity, SIS_continuity_CS - -use SIS_hor_grid, only : SIS_hor_grid_type +use SIS_tracer_registry, only : SIS_tracer_registry_type, get_SIS_tracer_pointer +use SIS_tracer_registry, only : update_SIS_tracer_halos, set_massless_SIS_tracers +use SIS_tracer_registry, only : check_SIS_tracer_bounds +use SIS_types, only : ice_state_type use ice_grid, only : ice_grid_type use ice_ridging_mod, only : ice_ridging @@ -28,27 +31,27 @@ module SIS_transport #include -public :: SIS_transport_init, ice_transport, SIS_transport_end -public :: adjust_ice_categories +public :: SIS_transport_init, SIS_transport_end, adjust_ice_categories +public :: alloc_cell_average_state_type, dealloc_cell_average_state_type +public :: cell_ave_state_to_ice_state, ice_state_to_cell_ave_state, cell_mass_from_CAS +public :: ice_cat_transport, finish_ice_transport !> The SIS_transport_CS contains parameters for doing advective and parameterized advection. type, public :: SIS_transport_CS ; private - logical :: SLAB_ICE = .false. !< If true, do old style GFDL slab ice? - real :: Rho_ice = 905.0 !< The nominal density of sea ice, in kg m-3. - real :: Rho_snow = 330.0 !< The nominal density of snow on sea ice, in kg m-3. + real :: Rho_ice = 905.0 !< The nominal density of sea ice [kg m-3], used here only in rolling. real :: Roll_factor !< A factor by which the propensity of small amounts of thick sea-ice !! to become thinner by rolling is increased, or 0 to disable rolling. !! Sensible values are 0 or larger than 1. logical :: readjust_categories !< If true, readjust the distribution into !! ice thickness categories after advection. - logical :: specified_ice !< If true, the sea ice is specified and there is - !! no need for ice dynamics. logical :: check_conservation !< If true, write out verbose diagnostics of conservation. logical :: bounds_check !< If true, check for sensible values of thicknesses, !! temperatures, salinities, tracers, etc. - integer :: adv_sub_steps !< The number of advective iterations for each slow time step. + logical :: inconsistent_cover_bug !< If true, omit a recalculation of the fractional ice-free + !! areal coverage after the adjustment of the ice categories. + !! The default should be changed to false and then this option obsoleted. type(time_type), pointer :: Time !< A pointer to the ice model's clock. type(SIS_diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -60,151 +63,363 @@ module SIS_transport type(SIS_tracer_advect_CS), pointer :: SIS_thick_adv_CSp => NULL() !< The control structure for the SIS thickness advection module - !>@{ Diagnsotic IDs - integer :: id_ix_trans = -1, id_iy_trans = -1 + !>@{ Diagnostic IDs + integer :: id_ix_trans = -1, id_iy_trans = -1, id_xprt = -1, id_rdgr = -1 + ! integer :: id_rdgo=-1, id_rdgv=-1 ! These do not exist yet !!@} + end type SIS_transport_CS +!> This structure contains a variation of the ice model state where the variables are in +!! mass per unit ocean cell area (not per unit ice area). These are useful for conservative +!! advection, but not so useful for diagnosing ice thickness. +type, public :: cell_average_state_type ; private + real, allocatable, dimension(:,:,:) :: m_ice !< The mass of ice in each thickness category + !! per unit total area in a cell [H ~> kg m-2]. + real, allocatable, dimension(:,:,:) :: m_snow !< The mass of ice in each thickness category + !! per unit total area in a cell [H ~> kg m-2]. + real, allocatable, dimension(:,:,:) :: m_pond !< The mass of melt pond water in each thickness + !! category per unit total area in a cell [H ~> kg m-2]. + real, allocatable, dimension(:,:,:) :: mH_ice !< The mass of ice in each thickness category + !! per unit of ice area in a cell [H ~> kg m-2]. The + !! ratio of m_ice / mH_ice gives the fractional + !! ice coverage of each category. Massless cells + !! 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, 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]. + 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]. + 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]. + type(EFP_type) :: enth_snow !< The globally integrated snow enthalpy [J]. +end type cell_average_state_type + contains !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> ice_transport - does ice transport and thickness class redistribution -subroutine ice_transport(part_sz, mH_ice, mH_snow, mH_pond, uc, vc, TrReg, & - dt_slow, G, IG, CS, rdg_hice, snow2ocn, & - rdg_rate, rdg_open, rdg_vosh) +!> 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) + 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 - real, dimension(SZI_(G),SZJ_(G),0:SZCAT_(IG)), & - intent(inout) :: part_sz !< The fractional ice concentration - !! within a cell in each thickness - !! category, nondimensional, 0-1. - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: mH_ice !< The mass per unit area of the ice - !! in each category in H (often kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: mH_snow !< The mass per unit area of the snow - !! atop the ice in each category in H. - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: mH_pond !< The mass per unit area of the pond - !! on the ice in each category in H. type(SIS_tracer_registry_type), pointer :: TrReg !< The registry of SIS ice and snow tracers. - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uc !< The zonal ice velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vc !< The meridional ice velocity, in m s-1. real, intent(in) :: dt_slow !< The amount of time over which the - !! ice dynamics are to be advanced, in s. + !! ice dynamics are to be advanced [s]. + integer, intent(in) :: nsteps !< The number of advective iterations + !! to use within this time step. type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: rdg_hice !< The thickness of ridged ice, in kg m-2. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: snow2ocn !< snow volume [m] dumped into ocean during ridging - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: rdg_rate !< The ice ridging rate in s-1. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: rdg_open !< formation rate of open water due to ridging - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: rdg_vosh !< rate of ice volume shifted from level to ridged ice + 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(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]. + 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]. ! Local variables - real, dimension(:,:,:,:), & - pointer :: heat_ice=>NULL() ! Pointer to the enth_ice array from the SIS tracer registry. - ! Enth_ice is the enthalpy of the ice in each category and layer, in - ! enth_units (J or rescaled). - real, dimension(:,:,:,:), & - pointer :: heat_snow=>NULL() ! Pointer to the enth_snow array from the SIS tracer registry. - ! Enth_snow is the enthalpy of the snow atop the ice in each category, in - ! enth_units (J or rescaled). real, dimension(SZIB_(G),SZJ_(G),SZCAT_(IG)) :: & - uh_ice, & ! Zonal fluxes of ice in H m2 s-1. - uh_snow, & ! Zonal fluxes of snow in H m2 s-1. - uh_pond ! Zonal fluxes of melt pond water in H m2 s-1. - real, dimension(SZIB_(G),SZJ_(G)) :: & - uf ! Total zonal fluxes in kg s-1. + 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]. real, dimension(SZI_(G),SZJB_(G),SZCAT_(IG)) :: & - vh_ice, & ! Meridional fluxes of ice in H m2 s-1. - vh_snow, & ! Meridional fluxes of snow in H m2 s-1. - vh_pond ! Meridional fluxes of melt pond water in H m2 s-1. + 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]. + 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 + logical :: merged_cont + character(len=200) :: mesg + integer :: i, j, k, n, isc, iec, jsc, jec, isd, ied, jsd, jed, nCat + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nCat = IG%CatIce + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + if (CAS%dt_sum <= 0.0) then + call set_massless_SIS_tracers(CAS%m_snow, TrReg, G, IG, compute_domain=.true., do_ice=.false.) + call set_massless_SIS_tracers(CAS%m_ice, TrReg, G, IG, compute_domain=.true., do_snow=.false.) + + if (CS%bounds_check) call check_SIS_tracer_bounds(TrReg, G, IG, "SIS_transport set massless 1") + endif + + merged_cont = (present(mca_tot) .and. present(uh_tot) .and. present(vh_tot)) + if (merged_cont .and. (present(uc) .or. present(vc))) call SIS_error(WARNING, & + "Velocities should not be provided to ice_cat_transport when mass fluxes are provided.") + if ((.not. merged_cont) .and. .not.(present(uc) .and. present(vc))) call SIS_error(FATAL, & + "Either velocities or masses and mass fluxes must appear in a call to ice_cat_transport.") + + ! 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) + do n = 1, nsteps + call update_SIS_tracer_halos(TrReg, G, complete=.false.) + call pass_var(CAS%m_ice, G%Domain, complete=.false.) + call pass_var(CAS%m_snow, G%Domain, complete=.false.) + call pass_var(CAS%m_pond, G%Domain, complete=.false.) + call pass_var(CAS%mH_ice, G%Domain, complete=.true.) + + do k=1,nCat ; do j=jsd,jed ; do i=isd,ied + mca0_ice(i,j,k) = CAS%m_ice(i,j,k) + mca0_snow(i,j,k) = CAS%m_snow(i,j,k) + mca0_pond(i,j,k) = CAS%m_pond(i,j,k) + enddo ; enddo ; enddo + + if (merged_cont) then + call proportionate_continuity(mca_tot(:,:,n-1), uh_tot(:,:,n), vh_tot(:,:,n), & + dt_adv, G, 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) + 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, & + 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, & + CS%SIS_tr_adv_CSp, TrReg, snow_tr=.true.) + + ! Accumulated diagnostics + CAS%dt_sum = CAS%dt_sum + dt_adv + if (allocated(CAS%uh_sum)) then ; do k=1,nCat ; do j=jsc,jec ; do I=isc-1,iec + CAS%uh_sum(I,j) = CAS%uh_sum(I,j) + dt_adv * ((uh_pond(I,j,k) + uh_snow(I,j,k)) + uh_ice(I,j,k)) + enddo ; enddo ; enddo ; endif + if (allocated(CAS%vh_sum)) then ; do k=1,nCat ; do J=jsc-1,jec ; do i=isc,iec + CAS%vh_sum(i,J) = CAS%vh_sum(i,J) + dt_adv * ((vh_pond(i,J,k) + vh_snow(i,J,k)) + vh_ice(i,J,k)) + enddo ; enddo ; enddo ; endif + + if (CS%bounds_check) then + write(mesg,'(i4)') n + call check_SIS_tracer_bounds(TrReg, G, IG, "After advect_SIS_tracers "//trim(mesg)) + endif + enddo + +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) + 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(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]. + + ! Local variables + real, dimension(SZIB_(G),SZJ_(G)) :: & + uf ! Total zonal fluxes [kg s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - vf ! Total meridional fluxes in kg s-1. + vf ! Total meridional fluxes [kg s-1]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)) :: & - mca_ice, mca_snow, & ! The mass of snow and ice per unit total area in a - ! cell, in units of H (often kg m-2). "mca" stands - ! for "mass cell averaged" - mca0_ice, mca0_snow,& ! The initial mass of snow and ice per unit total - ! area in a cell, in units of H (often kg m-2). - mca_pond, mca0_pond ! As for ice and snow above but for melt ponds, in H. - real :: h_in_m ! The ice thickness in m. - real :: hca_in_m ! The ice thickness averaged over the whole cell in m. - real, dimension(SZI_(G),SZJ_(G)) :: opnwtr - real, dimension(SZI_(G),SZJ_(G)) :: ice_cover ! The summed fractional ice concentration, ND. - real, dimension(SZI_(G),SZJ_(G)) :: mHi_avg ! The average ice mass-thickness in kg m-2. - - real :: I_mca_ice - - type(EFP_type) :: tot_ice(2), tot_snow(2), enth_ice(2), enth_snow(2) + 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]. +!### These will be needed when the ice ridging is properly implemented. +! real :: snow2ocn !< Snow dumped into ocean during ridging [kg m-2] +! real :: enth_snow2ocn !< Mass-averaged enthalpy of the now dumped into ocean during ridging [J kg-1] +! real, dimension(SZI_(G),SZJ_(G)) :: & +! rdg_open, & ! formation rate of open water due to ridging +! rdg_vosh ! rate of ice mass shifted from level to ridged ice + real :: yr_dt ! Tne number of timesteps in a year. + real, dimension(SZI_(G),SZJ_(G)) :: trans_conv ! The convergence of frozen water transport [kg m-2]. + real, dimension(SZI_(G),SZJ_(G)) :: ice_cover ! The summed fractional ice concentration [nondim]. + type(EFP_type) :: tot_ice, tot_snow, enth_ice, enth_snow real :: I_tot_ice, I_tot_snow + real :: Idt ! The reciprocal of the accumulated time, times a unit conversion factor, in + ! [kg H-1 m-2 s-1 ~> kg m-3 s-1 or s-1] + integer :: i, j, k, isc, iec, jsc, jec, nCat - real :: dt_adv - character(len=200) :: mesg - integer :: i, j, k, m, bad, isc, iec, jsc, jec, isd, ied, jsd, jed, nL, nCat - integer :: iTransportSubcycles ! For transport sub-cycling + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nCat = IG%CatIce - real :: mass_neglect + ! 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) - ! 1.0e-40 kg/m2 is roughly the mass of one molecule of water divided by the surface area of the Earth. - mass_neglect = IG%kg_m2_to_H*1.0e-60 + ! 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 + ! ridging scheme. A more complete ridging scheme would also compress + ! thicker ice and allow the fractional ice coverage to drop below 1. + call compress_ice(IST%part_size, IST%mH_ice, IST%mH_snow, IST%mH_pond, TrReg, G, IG, CS, CAS) - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - nCat = IG%CatIce + if (CS%bounds_check) call check_SIS_tracer_bounds(TrReg, G, IG, "After compress_ice") - if (CS%slab_ice) then - call pass_vector(uc, vc, G%Domain, stagger=CGRID_NE) - call slab_ice_advect(uc, vc, mH_ice(:,:,1), 4.0*IG%kg_m2_to_H, dt_slow, G, CS) - call pass_var(mH_ice(:,:,2), G%Domain) - do j=G%jsd,G%jed ; do i=G%isd,G%ied - if (mH_ice(i,j,1) > 0.0) then - part_sz(i,j,1) = 1.0 - else - part_sz(i,j,1) = 0.0 - endif - enddo ; enddo - return + if (CS%readjust_categories) then + call adjust_ice_categories(IST%mH_ice, IST%mH_snow, IST%mH_pond, IST%part_size, & + TrReg, G, IG, CS) + if (CS%bounds_check) call check_SIS_tracer_bounds(TrReg, G, IG, "After adjust_ice_categories") endif - if (CS%bounds_check) & - call check_SIS_tracer_bounds(TrReg, G, IG, "Start of SIS_transport") + ! Recalculating m_ice and m_snow for consistency when handling tracer + ! concentrations in massless categories. + do k=1,nCat ; do j=jsc,jec ; do i=isc,iec + mca0_ice(i,j,k) = IST%part_size(i,j,k)*IST%mH_ice(i,j,k) + mca0_snow(i,j,k) = IST%part_size(i,j,k)*IST%mH_snow(i,j,k) + enddo ; enddo ; enddo + call set_massless_SIS_tracers(mca0_snow, TrReg, G, IG, compute_domain=.true., do_ice=.false.) + call set_massless_SIS_tracers(mca0_ice, TrReg, G, IG, compute_domain=.true., do_snow=.false.) + + if (CS%bounds_check) call check_SIS_tracer_bounds(TrReg, G, IG, "SIS_transport set massless 2") + +! Niki: TOM does the ridging after redistribute which would need age_ice and IST%rgd_mice below. +! ! ### THIS IS HARD-CODED ONLY TO WORK WITH 2 LAYERS. +! ! ### heat_snow AND OTHER TRACERS ARE OMITTED. +! if (CS%do_ridging) then +! do j=jsc,jec ; do i=isc,iec +! if (sum(IST%mH_ice(i,j,:)) > 1.e-10*CS%Rho_ice .and. & +! sum(IST%part_size(i,j,1:nCat)) > 0.01) then +! call ice_ridging(nCat, IST%part_size(i,j,:), IST%mH_ice(i,j,:), & +! IST%mH_snow(i,j,:), & +! heat_ice(i,j,:,1), heat_ice(i,j,:,2), & !Niki: Is this correct? Bob: No, 2-layers hard-coded. +! age_ice(i,j,:), snow2ocn, enth_snow2ocn, rdg_rate(i,j), IST%rgd_mice(i,j,:), & +! CAS%dt_sum, IG%mH_cat_bound, rdg_open(i,j), rdg_vosh(i,j)) +! ! Store the snow mass (and related properties?) that will be passed to the ocean at the +! ! next opportunity. +! if (snow2ocn > 0.0) then +! IST%enth_snow_to_ocn(i,j) = (IST%enth_snow_to_ocn(i,j) * IST%snow_to_ocn(i,j) + & +! enth_snow2ocn * snow2ocn) / & +! (IST%snow_to_ocn(i,j) + snow2ocn) +! IST%snow_to_ocn(i,j) = IST%snow_to_ocn(i,j) + snow2ocn +! endif +! endif +! enddo ; enddo +! endif ! do_ridging + + ! Recalculate IST%part_size(:,:,0) to ensure that the sum of IST%part_size adds up to 1. + ! Compress_ice should already have taken care of this within the computational + ! domain, but with a slightly different order of arithmetic. The max is here + ! to avoid tiny negative values of order -1e-16 from round-off in the + ! difference between ice_cover and 1, or to set the fractional open ocean area + ! to a miniscule positive value so that the ocean-air fluxes are always + ! calculated. + ice_cover(:,:) = 0.0 + do k=1,nCat ; do j=jsc,jec ; do i=isc,iec + ice_cover(i,j) = ice_cover(i,j) + IST%part_size(i,j,k) + enddo ; enddo ; enddo + do j=jsc,jec ; do i=isc,iec + IST%part_size(i,j,0) = max(1.0 - ice_cover(i,j), IG%ocean_part_min) + enddo ; enddo - ! Make sure that ice is in the right thickness category before advection. -! call adjust_ice_categories(mH_ice, mH_snow, part_sz, TrReg, G, CS) !Niki: add ridging? + call pass_var(IST%part_size, G%Domain) ! cannot be combined with the three updates below + call pass_var(IST%mH_pond, G%Domain, complete=.false.) + call pass_var(IST%mH_snow, G%Domain, complete=.false.) + call pass_var(IST%mH_ice, G%Domain, complete=.true.) - call pass_vector(uc, vc, G%Domain, stagger=CGRID_NE) + 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) - if (CS%check_conservation) then ! mw/new - need to update this for pond ? - call get_total_amounts(mH_ice, mH_snow, part_sz, G, IG, tot_ice(1), tot_snow(1)) - call get_total_enthalpy(mH_ice, mH_snow, part_sz, TrReg, G, IG, enth_ice(1), & - enth_snow(1)) + if (is_root_pe()) then + I_tot_ice = abs(EFP_to_real(CAS%tot_ice)) + if (I_tot_ice > 0.0) I_tot_ice = 1.0 / I_tot_ice ! Adcroft's rule inverse. + I_tot_snow = abs(EFP_to_real(CAS%tot_snow)) + if (I_tot_snow > 0.0) I_tot_snow = 1.0 / I_tot_snow ! Adcroft's rule inverse. + write(*,'(" Total Ice mass: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & + EFP_to_real(tot_ice), EFP_real_diff(tot_ice, CAS%tot_ice), & + EFP_real_diff(tot_ice, CAS%tot_ice) * I_tot_ice + write(*,'(" Total Snow mass: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & + EFP_to_real(tot_snow), EFP_real_diff(tot_snow, CAS%tot_snow), & + EFP_real_diff(tot_snow, CAS%tot_snow) * I_tot_snow + + I_tot_ice = abs(EFP_to_real(CAS%enth_ice)) + if (I_tot_ice > 0.0) I_tot_ice = 1.0 / I_tot_ice ! Adcroft's rule inverse. + I_tot_snow = abs(EFP_to_real(CAS%enth_snow)) + if (I_tot_snow > 0.0) I_tot_snow = 1.0 / I_tot_snow ! Adcroft's rule inverse. + write(*,'(" Enthalpy Ice: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & + EFP_to_real(enth_ice), EFP_real_diff(enth_ice, CAS%enth_ice), & + EFP_real_diff(enth_ice, CAS%enth_ice) * I_tot_ice + write(*,'(" Enthalpy Snow: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & + EFP_to_real(enth_snow), EFP_real_diff(enth_snow, CAS%enth_snow), & + EFP_real_diff(enth_snow, CAS%enth_snow) * I_tot_snow + endif endif - ! Determine the whole-cell averaged mass of snow and ice. - mca_ice(:,:,:) = 0.0 ; mca_snow(:,:,:) = 0.0 ; mca_pond(:,:,:) = 0.0 + ! 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 + 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 + enddo ; enddo + call post_SIS_data(CS%id_xprt, trans_conv, CS%diag) + endif + if (CS%id_ix_trans>0) then + do j=jsc,jec ; do I=isc-1,iec ; uf(I,j) = Idt * CAS%uh_sum(I,j) ; enddo ; enddo + call post_SIS_data(CS%id_ix_trans, uf, CS%diag) + endif + if (CS%id_iy_trans>0) then + do J=jsc-1,jec ; do i=isc,iec ; vf(i,J) = Idt * CAS%vh_sum(i,J) ; enddo ; enddo + call post_SIS_data(CS%id_iy_trans, vf, CS%diag) + endif + if (CS%do_ridging) then + if (CS%id_rdgr>0 .and. present(rdg_rate)) & + call post_SIS_data(CS%id_rdgr, rdg_rate, CS%diag) +! 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) +! enddo ; enddo +! call post_SIS_data(CS%id_rdgv, tmp2d, diag) +! endif + endif + + if (CS%bounds_check) call check_SIS_tracer_bounds(TrReg, G, IG, "At end of SIS_transport") + +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) + 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(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. + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: ice_cover ! The summed fractional ice concentration [nondim]. + real, dimension(SZI_(G),SZJ_(G)) :: mHi_avg ! The average ice mass-thickness [kg m-2]. + integer :: i, j, k, isc, iec, jsc, jec, nCat + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nCat = IG%CatIce + + CAS%m_ice(:,:,:) = 0.0 ; CAS%m_snow(:,:,:) = 0.0 ; CAS%m_pond(:,:,:) = 0.0 ; CAS%mH_ice(:,:,:) = 0.0 ice_cover(:,:) = 0.0 ; mHi_avg(:,:) = 0.0 -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,IG,mH_ice,mca_ice,part_sz, & -!$OMP mca_snow,mH_snow,mca_pond,mH_pond,ice_cover, & -!$OMP mHi_avg,nCat) + !$OMP parallel do default(shared) do j=jsc,jec do k=1,nCat ; do i=isc,iec - if (mH_ice(i,j,k)>0.0) then - mca_ice(i,j,k) = part_sz(i,j,k)*mH_ice(i,j,k) - mca_snow(i,j,k) = part_sz(i,j,k)*mH_snow(i,j,k) - mca_pond(i,j,k) = part_sz(i,j,k)*mH_pond(i,j,k) - ice_cover(i,j) = ice_cover(i,j) + part_sz(i,j,k) - mHi_avg(i,j) = mHi_avg(i,j) + mca_ice(i,j,k) + if (IST%mH_ice(i,j,k)>0.0) then + CAS%m_ice(i,j,k) = IST%part_size(i,j,k) * IST%mH_ice(i,j,k) + CAS%m_snow(i,j,k) = IST%part_size(i,j,k) * IST%mH_snow(i,j,k) + CAS%m_pond(i,j,k) = IST%part_size(i,j,k) * IST%mH_pond(i,j,k) + CAS%mH_ice(i,j,k) = IST%mH_ice(i,j,k) + ice_cover(i,j) = ice_cover(i,j) + IST%part_size(i,j,k) + mHi_avg(i,j) = mHi_avg(i,j) + CAS%m_ice(i,j,k) else - if (part_sz(i,j,k)*mH_snow(i,j,k) > 0.0) then + if (IST%part_size(i,j,k)*IST%mH_snow(i,j,k) > 0.0) then call SIS_error(FATAL, "Input to SIS_transport, non-zero snow mass rests atop no ice.") endif - if (part_sz(i,j,k)*mH_pond(i,j,k) > 0.0) then + if (IST%part_size(i,j,k)*IST%mH_pond(i,j,k) > 0.0) then call SIS_error(FATAL, "Input to SIS_transport, non-zero pond mass rests atop no ice.") endif - part_sz(i,j,k) = 0.0 ; mca_ice(i,j,k) = 0.0 - mca_snow(i,j,k) = 0.0 - mca_pond(i,j,k) = 0.0 + CAS%m_ice(i,j,k) = 0.0 ; CAS%m_snow(i,j,k) = 0.0 ; CAS%m_pond(i,j,k) = 0.0 endif enddo ; enddo do i=isc,iec ; if (ice_cover(i,j) > 0.0) then @@ -213,248 +428,115 @@ subroutine ice_transport(part_sz, mH_ice, mH_snow, mH_pond, uc, vc, TrReg, & ! Handle massless categories. do k=1,nCat ; do i=isc,iec - if (mca_ice(i,j,k)<=0.0 .and. (G%mask2dT(i,j) > 0.0)) then + if (CAS%m_ice(i,j,k)<=0.0 .and. (G%mask2dT(i,j) > 0.0)) then if (mHi_avg(i,j) <= IG%mH_cat_bound(k)) then - mH_ice(i,j,k) = IG%mH_cat_bound(k) + CAS%mH_ice(i,j,k) = IG%mH_cat_bound(k) elseif (mHi_avg(i,j) >= IG%mH_cat_bound(k+1)) then - mH_ice(i,j,k) = IG%mH_cat_bound(k+1) + CAS%mH_ice(i,j,k) = IG%mH_cat_bound(k+1) else - mH_ice(i,j,k) = mHi_avg(i,j) + CAS%mH_ice(i,j,k) = mHi_avg(i,j) endif endif enddo ; enddo enddo - call set_massless_SIS_tracers(mca_snow, TrReg, G, IG, compute_domain=.true., do_ice=.false.) - call set_massless_SIS_tracers(mca_ice, TrReg, G, IG, compute_domain=.true., do_snow=.false.) - - if (CS%bounds_check) & - call check_SIS_tracer_bounds(TrReg, G, IG, "SIS_transport set massless 1") - - ! Do the transport via the continuity equations and tracer conservation - ! equations for mH_ice and tracers, inverting for the fractional size of - ! each partition. - call pass_var(part_sz, G%Domain) ! cannot be combined with updates below - call update_SIS_tracer_halos(TrReg, G, complete=.false.) - call pass_var(mca_ice, G%Domain, complete=.false.) - call pass_var(mca_snow, G%Domain, complete=.false.) - call pass_var(mca_pond, G%Domain, complete=.false.) - call pass_var(mH_ice, G%Domain, complete=.true.) - - - dt_adv = dt_slow / real(CS%adv_sub_steps) - do iTransportSubcycles = 1, CS%adv_sub_steps - if (iTransportSubcycles>1) then ! Do not need to update on first iteration - call update_SIS_tracer_halos(TrReg, G, complete=.false.) - call pass_var(mca_ice, G%Domain, complete=.false.) - call pass_var(mca_snow, G%Domain, complete=.false.) - call pass_var(mca_pond, G%Domain, complete=.false.) - call pass_var(mH_ice, G%Domain, complete=.true.) - endif + ! Handle diagnostics + CAS%dt_sum = 0.0 + if (allocated(CAS%mass0)) call get_cell_mass(IST, G, IG, CAS%mass0) + if (allocated(CAS%uh_sum)) CAS%uh_sum(:,:) = 0.0 + if (allocated(CAS%vh_sum)) CAS%vh_sum(:,:) = 0.0 - do k=1,nCat ; do j=jsd,jed ; do i=isd,ied - mca0_ice(i,j,k) = mca_ice(i,j,k) - mca0_snow(i,j,k) = mca_snow(i,j,k) - mca0_pond(i,j,k) = mca_pond(i,j,k) - enddo ; enddo ; enddo - call continuity(uc, vc, mca0_ice, mca_ice, uh_ice, vh_ice, dt_adv, G, IG, CS%continuity_CSp) - call continuity(uc, vc, mca0_snow, mca_snow, uh_snow, vh_snow, dt_adv, G, IG, CS%continuity_CSp) - call continuity(uc, vc, mca0_pond, mca_pond, uh_pond, vh_pond, dt_adv, G, IG, CS%continuity_CSp) + 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) + endif - call advect_scalar(mH_ice, mca0_ice, mca_ice, uh_ice, vh_ice, dt_adv, G, IG, CS%SIS_thick_adv_CSp) +end subroutine ice_state_to_cell_ave_state - call advect_SIS_tracers(mca0_ice, mca_ice, uh_ice, vh_ice, dt_adv, G, IG, & - CS%SIS_tr_adv_CSp, TrReg, snow_tr=.false.) - call advect_SIS_tracers(mca0_snow, mca_snow, uh_snow, vh_snow, dt_adv, G, IG, & - CS%SIS_tr_adv_CSp, TrReg, snow_tr=.true.) +!> 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) + 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(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 + type(SIS_tracer_registry_type), pointer :: TrReg !< The registry of SIS ice and snow tracers. - if (CS%bounds_check) then - write(mesg,'(i4)') iTransportSubcycles - call check_SIS_tracer_bounds(TrReg, G, IG, "After advect_SIS_tracers "//trim(mesg)) - endif - enddo ! iTransportSubcycles + ! 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]. + integer :: i, j, k, isc, iec, jsc, jec, nCat - ! Add code to make sure that mH_ice(i,j,1) > IG%mH_cat_bound(1). + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nCat = IG%CatIce + mass_neglect = IG%kg_m2_to_H*1.0e-60 + + ! Ensure that CAS%mH_ice(i,j,1) >= IG%mH_cat_bound(1). do j=jsc,jec ; do i=isc,iec - if ((mca_ice(i,j,1) > 0.0) .and. (mH_ice(i,j,1) < IG%mH_cat_bound(1))) then - mH_ice(i,j,1) = IG%mH_cat_bound(1) - endif + if ((CAS%m_ice(i,j,1) > 0.0) .and. (CAS%mH_ice(i,j,1) < IG%mH_cat_bound(1))) & + CAS%mH_ice(i,j,1) = IG%mH_cat_bound(1) enddo ; enddo - ! Convert mca_ice and mca_snow back to part_sz and mH_snow. + ! Convert CAS%m_ice and CAS%m_snow back to IST%part_size and IST%mH_snow. ice_cover(:,:) = 0.0 !$OMP parallel do default(shared) do j=jsc,jec ; do k=1,nCat ; do i=isc,iec - if (mca_ice(i,j,k) > 0.0) then - if (CS%roll_factor * (mH_ice(i,j,k)*IG%H_to_kg_m2/CS%Rho_Ice)**3 > & - (mca_ice(i,j,k)*IG%H_to_kg_m2/CS%Rho_Ice)*G%areaT(i,j)) then + 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 ! 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). - mH_ice(i,j,k) = max((CS%Rho_ice*IG%kg_m2_to_H) * & - sqrt((mca_ice(i,j,k)*G%areaT(i,j)) / & - (CS%roll_factor * mH_ice(i,j,k)) ), 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)) / & + (CS%roll_factor * CAS%mH_ice(i,j,k)) ), IG%mH_cat_bound(1)) endif - ! Make sure that mH_ice(i,j,k) > IG%mH_cat_bound(1). - if (mH_ice(i,j,k) < IG%mH_cat_bound(1)) mH_ice(i,j,k) = IG%mH_cat_bound(1) + ! Make sure that CAS%mH_ice(i,j,k) > IG%mH_cat_bound(1). + if (CAS%mH_ice(i,j,k) < IG%mH_cat_bound(1)) CAS%mH_ice(i,j,k) = IG%mH_cat_bound(1) - part_sz(i,j,k) = mca_ice(i,j,k) / mH_ice(i,j,k) - mH_snow(i,j,k) = mH_ice(i,j,k) * (mca_snow(i,j,k) / mca_ice(i,j,k)) - mH_pond(i,j,k) = mH_ice(i,j,k) * (mca_pond(i,j,k) / mca_ice(i,j,k)) - ice_cover(i,j) = ice_cover(i,j) + part_sz(i,j,k) + IST%part_size(i,j,k) = CAS%m_ice(i,j,k) / CAS%mH_ice(i,j,k) + IST%mH_snow(i,j,k) = CAS%mH_ice(i,j,k) * (CAS%m_snow(i,j,k) / CAS%m_ice(i,j,k)) + IST%mH_pond(i,j,k) = CAS%mH_ice(i,j,k) * (CAS%m_pond(i,j,k) / CAS%m_ice(i,j,k)) + IST%mH_ice(i,j,k) = CAS%mH_ice(i,j,k) + ice_cover(i,j) = ice_cover(i,j) + IST%part_size(i,j,k) else - part_sz(i,j,k) = 0.0 ; mH_ice(i,j,k) = 0.0 - if (mca_snow(i,j,k) > mass_neglect) & + IST%part_size(i,j,k) = 0.0 ; IST%mH_ice(i,j,k) = 0.0 + if (CAS%m_snow(i,j,k) > mass_neglect) & call SIS_error(FATAL, & - "Positive mca_snow values should not exist without ice.") - if (mca_pond(i,j,k) > mass_neglect ) & + "Positive CAS%m_snow values should not exist without ice.") + if (CAS%m_pond(i,j,k) > mass_neglect ) & call SIS_error(FATAL, & - "Something needs to be done with positive mca_pond values without ice.") - mH_snow(i,j,k) = 0.0 ; mH_pond(i,j,k) = 0.0 + "Something needs to be done with positive CAS%m_pond values without ice.") + IST%mH_snow(i,j,k) = 0.0 ; IST%mH_pond(i,j,k) = 0.0 endif enddo ; enddo ; enddo do j=jsc,jec ; do i=isc,iec - part_sz(i,j,0) = 1.0-ice_cover(i,j) + IST%part_size(i,j,0) = 1.0-ice_cover(i,j) enddo ; enddo - ! Compress the ice where the fractional coverage exceeds 1, starting with - ! ridging scheme. A more complete ridging scheme would also compress - ! thicker ice and allow the fractional ice coverage to drop below 1. - call compress_ice(part_sz, mca_ice, mca_snow, mca_pond, & - mH_ice, mH_snow, mH_pond, TrReg, G, IG, CS) - - if (CS%bounds_check) & - call check_SIS_tracer_bounds(TrReg, G, IG, "After compress_ice") - - if (CS%readjust_categories) then - call adjust_ice_categories(mH_ice, mH_snow, mH_pond, part_sz, & - TrReg, G, IG, CS) - if (CS%bounds_check) & - call check_SIS_tracer_bounds(TrReg, G, IG, "After adjust_ice_categories") - endif - - ! Recalculating mca_ice and mca_snow for consistency when handling tracer - ! concentrations in massless categories. - do k=1,nCat ; do j=jsc,jec ; do i=isc,iec - mca_ice(i,j,k) = part_sz(i,j,k)*mH_ice(i,j,k) - mca_snow(i,j,k) = part_sz(i,j,k)*mH_snow(i,j,k) - enddo ; enddo ; enddo - call set_massless_SIS_tracers(mca_snow, TrReg, G, IG, compute_domain=.true., do_ice=.false.) - call set_massless_SIS_tracers(mca_ice, TrReg, G, IG, compute_domain=.true., do_snow=.false.) - - if (CS%bounds_check) & - call check_SIS_tracer_bounds(TrReg, G, IG, "SIS_transport set massless 2") - -! Niki: TOM does the ridging after redistribute which would need age_ice and rdg_hice below. -! ! ### THIS IS HARD-CODED ONLY TO WORK WITH 2 LAYERS. -! ! ### heat_snow AND OTHER TRACERS ARE OMITTED. -! if (CS%do_ridging) then -! do j=jsc,jec ; do i=isc,iec -! snow2ocn(i,j) = 0.0 !TOM> initializing snow2ocean -! if (sum(mH_ice(i,j,:)) > 1.e-10*CS%Rho_ice .and. & -! sum(part_sz(i,j,1:nCat)) > 0.01) & -! call ice_ridging(nCat, part_sz(i,j,:), mH_ice(i,j,:), & -! mH_snow(i,j,:), & -! heat_ice(i,j,:,1), heat_ice(i,j,:,2), & !Niki: Is this correct? Bob: No, 2-layers hard-coded. -! age_ice(i,j,:), snow2ocn(i,j), rdg_rate(i,j), rdg_hice(i,j,:), & -! dt_slow, IG%mH_cat_bound, rdg_open(i,j), rdg_vosh(i,j)) -! enddo ; enddo -! endif ! do_ridging - - if ((CS%id_ix_trans>0) .or. (CS%id_iy_trans>0)) then - uf(:,:) = 0.0; vf(:,:) = 0.0 - do k=1,nCat - do j=jsc,jec ; do I=isc-1,iec - uf(I,j) = uf(I,j) + IG%H_to_kg_m2 * ((uh_pond(I,j,k) + uh_snow(I,j,k)) + uh_ice(I,j,k)) - enddo ; enddo - do J=jsc-1,jec ; do i=isc,iec - vf(i,J) = vf(i,J) + IG%H_to_kg_m2 * ((vh_pond(i,J,k) + vh_snow(i,J,k)) + vh_ice(i,J,k)) - enddo ; enddo - enddo - endif - - ! Recalculate part_sz(:,:,0) to ensure that the sum of part_sz adds up to 1. - ! Compress_ice should already have taken care of this within the computational - ! domain, but with a slightly different order of arithmetic. The max is here - ! to avoid tiny negative values of order -1e-16 from round-off in the - ! difference between ice_cover and 1, or to set the fractional open ocean area - ! to a miniscule positive value so that the ocean-air fluxes are always - ! calculated. - ice_cover(:,:) = 0.0 - do k=1,nCat ; do j=jsc,jec ; do i=isc,iec - ice_cover(i,j) = ice_cover(i,j) + part_sz(i,j,k) - enddo ; enddo ; enddo - do j=jsc,jec ; do i=isc,iec - part_sz(i,j,0) = max(1.0 - ice_cover(i,j), IG%ocean_part_min) - enddo ; enddo - - call pass_var(part_sz, G%Domain) ! cannot be combined with the two updates below - call pass_var(mH_pond, G%Domain, complete=.false.) - call pass_var(mH_snow, G%Domain, complete=.false.) - call pass_var(mH_ice, G%Domain, complete=.true.) - - if (CS%check_conservation) then - call get_total_amounts(mH_ice, mH_snow, part_sz, G, IG, tot_ice(2), tot_snow(2)) - - call get_total_enthalpy(mH_ice, mH_snow, part_sz, TrReg, G, IG, enth_ice(2), & - enth_snow(2)) - - if (is_root_pe()) then - I_tot_ice = abs(EFP_to_real(tot_ice(1))) - if (I_tot_ice > 0.0) I_tot_ice = 1.0 / I_tot_ice ! Adcroft's rule inverse. - I_tot_snow = abs(EFP_to_real(tot_snow(1))) - if (I_tot_snow > 0.0) I_tot_snow = 1.0 / I_tot_snow ! Adcroft's rule inverse. - write(*,'(" Total Ice mass: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & - EFP_to_real(tot_ice(2)), EFP_real_diff(tot_ice(2),tot_ice(1)), & - EFP_real_diff(tot_ice(2),tot_ice(1)) * I_tot_ice - write(*,'(" Total Snow mass: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & - EFP_to_real(tot_snow(2)), EFP_real_diff(tot_snow(2),tot_snow(1)), & - EFP_real_diff(tot_snow(2),tot_snow(1)) * I_tot_snow - - - I_tot_ice = abs(EFP_to_real(enth_ice(1))) - if (I_tot_ice > 0.0) I_tot_ice = 1.0 / I_tot_ice ! Adcroft's rule inverse. - I_tot_snow = abs(EFP_to_real(enth_snow(1))) - if (I_tot_snow > 0.0) I_tot_snow = 1.0 / I_tot_snow ! Adcroft's rule inverse. - write(*,'(" Enthalpy Ice: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & - EFP_to_real(enth_ice(2)), EFP_real_diff(enth_ice(2),enth_ice(1)), & - EFP_real_diff(enth_ice(2),enth_ice(1)) * I_tot_ice - write(*,'(" Enthalpy Snow: ",ES24.16,", Error: ",ES12.5," (",ES8.1,")")') & - EFP_to_real(enth_snow(2)), EFP_real_diff(enth_snow(2),enth_snow(1)), & - EFP_real_diff(enth_snow(2),enth_snow(1)) * I_tot_snow - endif - endif - - if (CS%id_ix_trans>0) call post_SIS_data(CS%id_ix_trans, uf, CS%diag) - if (CS%id_iy_trans>0) call post_SIS_data(CS%id_iy_trans, vf, CS%diag) - - if (CS%bounds_check) & - call check_SIS_tracer_bounds(TrReg, G, IG, "At end of SIS_transport") - -end subroutine ice_transport +end subroutine cell_ave_state_to_ice_state !> adjust_ice_categories moves mass between thickness categories if it is thinner or !! thicker than the bounding limits of each category. subroutine adjust_ice_categories(mH_ice, mH_snow, mH_pond, part_sz, TrReg, G, 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 + type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: mH_ice !< The mass per unit area of the ice - !! in each category in H (often kg m-2). + !! in each category [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: mH_snow !< The mass per unit area of the snow - !! atop the ice in each category in H (often kg m-2). + !! atop the ice in each category [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: mH_pond !< The mass per unit area of the pond - !! on the ice in each category in H (often kg m-2). + !! on the ice in each category [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),0:SZCAT_(IG)), & intent(inout) :: part_sz !< The fractional ice concentration !! within a cell in each thickness - !! category, nondimensional, 0-1. + !! category [nondim], 0-1. type(SIS_tracer_registry_type), & pointer :: TrReg !< The registry of SIS ice and snow tracers. type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module @@ -463,26 +545,29 @@ subroutine adjust_ice_categories(mH_ice, mH_snow, mH_pond, part_sz, TrReg, G, IG ! thicker than the bounding limits of each category. ! Local variables - real :: mca_trans ! The cell-averaged ice mass transfered between categories, in kg m-2. - real :: part_trans ! The fractional area transfered between categories, nondim. - real :: snow_trans ! The cell-averaged snow transfered between categories, in kg m-2. - real :: pond_trans ! The cell-averaged pond transfered between categories, in kg m-2. - real :: I_mH_lim1 ! The inverse of the lower thickness limit, in m2 kg-1. + real :: mca_trans ! The cell-averaged ice mass transfered between categories [kg m-2]. + real :: part_trans ! The fractional area transfered between categories [nondim]. + real :: snow_trans ! The cell-averaged snow transfered between categories [kg m-2]. + real :: pond_trans ! The cell-averaged pond transfered between categories [kg m-2]. + real :: I_mH_lim1 ! The inverse of the lower thickness limit [m2 kg-1]. real, dimension(SZI_(G),SZCAT_(IG)) :: & - ! The mass of snow, pond and ice per unit total area in a cell, in units of H - ! (often kg m-2). "mca" stands for "mass cell averaged" + ! The mass of snow, pond and ice per unit total area in a cell [H ~> kg m-2]. + ! "mca" stands for "mass cell averaged" mca_ice, mca_snow, mca_pond, & - ! Initial ice, snow and pond masses per unit cell area, in kg m-2. + ! Initial ice, snow and pond masses per unit cell area [kg m-2]. mca0_ice, mca0_snow, mca0_pond, & - ! Cross-catagory transfers of ice, snow and pond mass, in kg m-2. + ! Cross-catagory transfers of ice, snow and pond mass [kg m-2]. trans_ice, trans_snow, trans_pond - logical :: do_any, do_j(SZJ_(G)) + real, dimension(SZI_(G)) :: ice_cover ! The summed fractional ice coverage [nondim]. + logical :: do_any, do_j(SZJ_(G)), resum_cat(SZI_(G), SZJ_(G)) integer :: i, j, k, m, is, ie, js, je, nCat is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec nCat = IG%CatIce I_mH_lim1 = 1.0 / IG%mH_cat_bound(1) + resum_cat(:,:) = .false. + ! Zero out the part_size of any massless categories. do k=1,nCat ; do j=js,je ; do i=is,ie ; if (mH_ice(i,j,k) <= 0.0) then if (mH_ice(i,j,k) < 0.0) then @@ -494,6 +579,7 @@ subroutine adjust_ice_categories(mH_ice, mH_snow, mH_pond, part_sz, TrReg, G, IG if (mH_pond(i,j,k) > 0.0) then call SIS_error(FATAL, "Input to adjust_ice_categories, non-zero pond mass rests atop no ice.") endif + if (part_sz(i,j,k) > 0.0) resum_cat(i,j) = .true. part_sz(i,j,k) = 0.0 endif ; enddo ; enddo ; enddo @@ -647,12 +733,30 @@ subroutine adjust_ice_categories(mH_ice, mH_snow, mH_pond, part_sz, TrReg, G, IG mH_pond(i,j,1) = mH_pond(i,j,1) * (IG%mH_cat_bound(1) / mH_ice(i,j,1)) ! This is equivalent to mH_snow(i,j,1) = mca_snow(i,1) / part_sz(i,j,1) mH_ice(i,j,1) = IG%mH_cat_bound(1) + resum_cat(i,j) = .true. endif enddo endif endif ; enddo ! j-loop and do_j + if (.not.CS%inconsistent_cover_bug) then + do j=js,je + do_any = .false. + do i=is,ie + ice_cover(i) = 0.0 + if (resum_cat(i,j)) do_any = .true. + enddo + if (.not.do_any) cycle + do k=1,nCat ; do i=is,ie + ice_cover(i) = ice_cover(i) + part_sz(i,j,k) + enddo ; enddo + do i=is,ie ; if (resum_cat(i,j)) then + part_sz(i,j,0) = max(1.0 - ice_cover(i), IG%ocean_part_min) + endif ; enddo + enddo + endif + end subroutine adjust_ice_categories !> compress_ice compresses the ice, starting with the thinnest category, if the total fractional @@ -660,34 +764,25 @@ end subroutine adjust_ice_categories !! ice free) of part_sz is 1, but that the part_sz of the ice free category may be negative to make !! this so. In this routine, the mass (volume) is conserved, while the fractional coverage is !! solved for, while the new thicknesses are diagnosed. -subroutine compress_ice(part_sz, mca_ice, mca_snow, mca_pond, & - mH_ice, mH_snow, mH_pond, TrReg, G, IG, CS) +subroutine compress_ice(part_sz, mH_ice, mH_snow, mH_pond, TrReg, G, IG, CS, CAS) 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type real, dimension(SZI_(G),SZJ_(G),0:SZCAT_(IG)), & intent(inout) :: part_sz !< The fractional ice concentration !! within a cell in each thickness - !! category, nondimensional, 0-1. - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: mca_ice !< The mass per unit grid-cell area - !! of the ice in each category in H (often kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: mca_snow !< The mass per unit grid-cell area - !! of the snow atop the ice in each category in H. - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(inout) :: mca_pond !< The mass per unit grid-cell area - !! of the melt ponds atop the ice in each category in H. + !! category [nondim], 0-1. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: mH_ice !< The mass per unit area of the ice - !! in each category in H (often kg m-2). + !! in each category [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: mH_snow !< The mass per unit area of the snow - !! atop the ice in each category in H (often kg m-2). + !! atop the ice in each category [H ~> kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & intent(inout) :: mH_pond !< The mass per unit area of the pond - !! on the ice in each category in H (often kg m-2). + !! on the ice in each category [H ~> kg m-2]. type(SIS_tracer_registry_type), pointer :: TrReg !< The registry of SIS ice and snow tracers. type(SIS_transport_CS), pointer :: CS !< A pointer to the control structure for this module + type(cell_average_state_type), optional, intent(in) :: CAS !< A structure with ocean-cell averaged masses. ! This subroutine compresses the ice, starting with the thinnest category, if ! the total fractional ice coverage exceeds 1. It is assumed at the start that ! the sum over all categories (including ice free) of part_sz is 1, but that the @@ -703,31 +798,40 @@ subroutine compress_ice(part_sz, mca_ice, mca_snow, mca_pond, & real, dimension(SZI_(G),SZJ_(G)) :: excess_cover real :: compression_ratio real :: Icompress_here - real :: mca_trans, mca_old - real :: snow_trans, snow_old - real :: pond_trans, pond_old + real :: mca_old ! real :: Imca_new real :: mass_neglect - real :: part_trans ! The fractional area transfered into a thicker category, nondim. + real :: part_trans ! The fractional area transfered into a thicker category [nondim]. + real, dimension(SZI_(G),SZCAT_(IG)) :: & + m0_ice, & ! The initial mass per unit grid-cell area of ice in each category [H ~> kg m-2]. + m0_snow, & ! The initial mass per unit grid-cell area of snow in each category [H ~> kg m-2]. + m0_pond ! The initial mass per unit grid-cell pond melt water in each category [H ~> kg m-2]. real, dimension(SZI_(G),SZCAT_(IG)) :: & - mca0_ice, mca0_snow, mca0_pond, trans_ice, trans_snow, trans_pond + trans_ice, trans_snow, trans_pond ! The masses tranferred into the next thicker category [H ~> kg m-2]. + real, dimension(SZI_(G),SZCAT_(IG)) :: mca_ice ! The mass per unit grid-cell area + ! of the ice in each category [H ~> kg m-2]. + real, dimension(SZI_(G),SZCAT_(IG)) :: mca_snow ! The mass per unit grid-cell area + ! of the snow atop the ice in each category [H ~> kg m-2]. + real, dimension(SZI_(G),SZCAT_(IG)) :: mca_pond ! The mass per unit grid-cell area of the melt + ! ponds atop the ice in each category [H ~> kg m-2]. logical :: do_any, do_j(SZJ_(G)) character(len=200) :: mesg integer :: i, j, k, m, isc, iec, jsc, jec, nCat isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec nCat = IG%CatIce + !### Consider recalculating mca_ice and mca_snow here, as it is not reused again outside. + ! 1.0e-40 kg/m2 is roughly the mass of one molecule of water divided by the surface area of the Earth. mass_neglect = IG%kg_m2_to_H*1.0e-60 do_j(:) = .false. !$OMP parallel do default(none) shared(isc,iec,jsc,jec,do_j,G,IG,part_sz,excess_cover, & -!$OMP mca_ice,mca_snow,mca_pond,mH_ice,mH_snow,mH_pond,& -!$OMP mass_neglect,CS,TrReg,nCat) & -!$OMP private(mca0_ice,do_any,mca0_snow,trans_ice,trans_snow, & -!$OMP mca0_pond,trans_pond,compression_ratio,Icompress_here, & -!$OMP mca_old,mca_trans,snow_trans,snow_old, & -!$OMP pond_trans,pond_old,part_trans) +!$OMP mH_ice,mH_snow,mH_pond,& +!$OMP mass_neglect,CS,CAS,TrReg,nCat) & +!$OMP private(m0_ice,do_any,m0_snow,trans_ice,trans_snow, & +!$OMP m0_pond,trans_pond,compression_ratio,Icompress_here, & +!$OMP mca_ice,mca_snow,mca_pond,mca_old,part_trans) do j=jsc,jec do i=isc,iec if (part_sz(i,j,0) < 0.0) then @@ -739,16 +843,26 @@ subroutine compress_ice(part_sz, mca_ice, mca_snow, mca_pond, & enddo if (do_j(j)) then - do k=1,nCat ; do i=isc,iec - mca0_ice(i,k) = mca_ice(i,j,k) - mca0_snow(i,k) = mca_snow(i,j,k) - mca0_pond(i,k) = mca_pond(i,j,k) - enddo ; enddo + if (present(CAS)) then + do k=1,nCat ; do i=isc,iec + m0_ice(i,k) = CAS%m_ice(i,j,k) + m0_snow(i,k) = CAS%m_snow(i,j,k) + m0_pond(i,k) = CAS%m_pond(i,j,k) + mca_ice(i,k) = m0_ice(i,k) ; mca_snow(i,k) = m0_snow(i,k) ; mca_pond(i,k) = m0_pond(i,k) + enddo ; enddo + else ! This is mathematically equivalent ot the code above, but can differ at roundoff. + do k=1,nCat ; do i=isc,iec + m0_ice(i,k) = part_sz(i,j,k) * mH_ice(i,j,k) + m0_snow(i,k) = part_sz(i,j,k) * mH_snow(i,j,k) + m0_pond(i,k) = part_sz(i,j,k) * mH_pond(i,j,k) + mca_ice(i,k) = m0_ice(i,k) ; mca_snow(i,k) = m0_snow(i,k) ; mca_pond(i,k) = m0_pond(i,k) + enddo ; enddo + endif + trans_ice(:,:) = 0.0 ; trans_snow(:,:) = 0.0 ; trans_pond(:,:) = 0.0 do_any = .false. - do k=1,nCat-1 ; do i=isc,iec - if ((excess_cover(i,j) > 0.0) .and. (mca_ice(i,j,k) > 0.0)) then + if ((excess_cover(i,j) > 0.0) .and. (mca_ice(i,k) > 0.0)) then compression_ratio = mH_ice(i,j,k) / IG%mH_cat_bound(k+1) if (part_sz(i,j,k)*(1.0-compression_ratio) >= excess_cover(i,j)) then ! This category is compacted, but not to the point that it needs to @@ -764,40 +878,38 @@ subroutine compress_ice(part_sz, mca_ice, mca_snow, mca_pond, & ! category after being compacted to thickness IG%mH_cat_bound(k+1). excess_cover(i,j) = excess_cover(i,j) - part_sz(i,j,k)*(1.0-compression_ratio) - if (mca_ice(i,j,k) > mass_neglect) then + if (mca_ice(i,k) > mass_neglect) then part_sz(i,j,k+1) = part_sz(i,j,k+1) + part_sz(i,j,k)*compression_ratio - mca_trans = mca_ice(i,j,k) ; mca_old = mca_ice(i,j,k+1) - trans_ice(i,K) = mca_trans ; do_any = .true. - mca_ice(i,j,k+1) = mca_ice(i,j,k+1) + mca_trans + mca_old = mca_ice(i,k+1) + trans_ice(i,K) = mca_ice(i,k) ; do_any = .true. + mca_ice(i,k+1) = mca_ice(i,k+1) + mca_ice(i,k) if (part_sz(i,j,k+1) > 1.0e-60) then ! For 32-bit reals this should be 1.0e-30. ! This is the usual case, and underflow is no problem. - mH_ice(i,j,k+1) = mca_ice(i,j,k+1) / part_sz(i,j,k+1) - elseif (mca_trans > mca_old) then + mH_ice(i,j,k+1) = mca_ice(i,k+1) / part_sz(i,j,k+1) + elseif (trans_ice(i,K) > mca_old) then ! Set the ice category's thickness to its lower bound. - part_sz(i,j,k+1) = mca_ice(i,j,k+1) / IG%mH_cat_bound(k+1) + part_sz(i,j,k+1) = mca_ice(i,k+1) / IG%mH_cat_bound(k+1) mH_ice(i,j,k+1) = IG%mH_cat_bound(k+1) else ! Keep the ice category's thickness at its previous value. - part_sz(i,j,k+1) = mca_ice(i,j,k+1) / mH_ice(i,j,k+1) + part_sz(i,j,k+1) = mca_ice(i,k+1) / mH_ice(i,j,k+1) endif - if (mca_snow(i,j,k) > 0.0) then - snow_trans = mca_snow(i,j,k) ; snow_old = mca_snow(i,j,k+1) - trans_snow(i,K) = snow_trans - mca_snow(i,j,k+1) = mca_snow(i,j,k+1) + mca_snow(i,j,k) + if (mca_snow(i,k) > 0.0) then + trans_snow(i,K) = mca_snow(i,k) + mca_snow(i,k+1) = mca_snow(i,k+1) + mca_snow(i,k) endif - mH_snow(i,j,k+1) = mca_snow(i,j,k+1) / part_sz(i,j,k+1) + mH_snow(i,j,k+1) = mca_snow(i,k+1) / part_sz(i,j,k+1) - if (mca_pond(i,j,k) > 0.0) then - pond_trans = mca_pond(i,j,k) ; pond_old = mca_pond(i,j,k+1) - trans_pond(i,K) = pond_trans - mca_pond(i,j,k+1) = mca_pond(i,j,k+1) + mca_pond(i,j,k) + if (mca_pond(i,k) > 0.0) then + trans_pond(i,K) = mca_pond(i,k) + mca_pond(i,k+1) = mca_pond(i,k+1) + mca_pond(i,k) endif - mH_pond(i,j,k+1) = mca_pond(i,j,k+1) / part_sz(i,j,k+1) + mH_pond(i,j,k+1) = mca_pond(i,k+1) / part_sz(i,j,k+1) endif - mca_ice(i,j,k) = 0.0 ; mca_snow(i,j,k) = 0.0 ; mca_pond(i,j,k) = 0.0 + mca_ice(i,k) = 0.0 ; mca_snow(i,k) = 0.0 ; mca_pond(i,k) = 0.0 mH_ice(i,j,k) = 0.0 ; mH_snow(i,j,k) = 0.0 ; mH_pond(i,j,k) = 0.0 part_sz(i,j,k) = 0.0 endif @@ -805,22 +917,22 @@ subroutine compress_ice(part_sz, mca_ice, mca_snow, mca_pond, & enddo ; enddo if (do_any) then -!The following subroutine calls are not thread-safe. There is a pointer in the subroutine -!(Tr) that could be redirected from underneath a thread when another goes in. -!$OMP CRITICAL (safepointer) - call advect_tracers_thicker(mca0_ice, trans_ice, G, IG, CS%SIS_tr_adv_CSp, & + ! The following subroutine calls are not thread-safe. There is a pointer in the subroutine + ! (Tr) that could be redirected from underneath a thread when another goes in. + !$OMP CRITICAL (safepointer) + call advect_tracers_thicker(m0_ice, trans_ice, G, IG, CS%SIS_tr_adv_CSp, & TrReg, .false., j, isc, iec) - call advect_tracers_thicker(mca0_snow, trans_snow, G, IG, CS%SIS_tr_adv_CSp, & + call advect_tracers_thicker(m0_snow, trans_snow, G, IG, CS%SIS_tr_adv_CSp, & TrReg, .true., j, isc, iec) -!$OMP END CRITICAL (safepointer) + !$OMP END CRITICAL (safepointer) endif k=nCat do i=isc,iec if (excess_cover(i,j) > 0.0) then - if (part_sz(i,j,k) <= 1.0 .and. & - (excess_cover(i,j) > 2.0*nCat*epsilon(Icompress_here))) then - call SIS_error(FATAL, & + if ((part_sz(i,j,k) <= 1.0) .and. & + (excess_cover(i,j) > 2.0*nCat*epsilon(Icompress_here))) then + call SIS_error(FATAL, & "Category CatIce part_sz inconsistent with excess cover.") endif Icompress_here = part_sz(i,j,k) / (part_sz(i,j,k) - excess_cover(i,j)) @@ -831,149 +943,117 @@ subroutine compress_ice(part_sz, mca_ice, mca_snow, mca_pond, & excess_cover(i,j) = 0.0 endif enddo - endif - enddo - if (CS%check_conservation) then - ! Check for consistency between mca_ice, mH_ice, and part_sz. - do k=1,nCat ; do j=jsc,jec ; do i=isc,iec - if ((mca_ice(i,j,k) == 0.0) .and. (mH_ice(i,j,k)*part_sz(i,j,k) /= 0.0)) then - write(mesg,'("Compress mismatch at ",3(i8),": mca, h, part, hxp = zero, ",3(1pe15.6))') & - i, j, k, mH_ice(i,j,k), part_sz(i,j,k), mH_ice(i,j,k)*part_sz(i,j,k) - call SIS_error(WARNING, mesg, all_print=.true.) - endif - if (abs(mca_ice(i,j,k) - mH_ice(i,j,k)*part_sz(i,j,k)) > 1e-12*mca_ice(i,j,k)) then - write(mesg,'("Compress mismatch at ",3(i8),": mca, h, part, hxp = ",4(1pe15.6))') & - i, j, k, mca_ice(i,j,k), mH_ice(i,j,k), part_sz(i,j,k), mH_ice(i,j,k)*part_sz(i,j,k) - call SIS_error(WARNING, mesg, all_print=.true.) - endif - enddo ; enddo ; enddo - endif + ! if (CS%check_conservation) then + ! ! Check for consistency between mca_ice, mH_ice, and part_sz. + ! do k=1,nCat ; do i=isc,iec + ! if ((mca_ice(i,k) == 0.0) .and. (mH_ice(i,j,k)*part_sz(i,j,k) /= 0.0)) then + ! write(mesg,'("Compress mismatch at ",3(i8),": mca, h, part, hxp = zero, ",3(1pe15.6))') & + ! i, j, k, mH_ice(i,j,k), part_sz(i,j,k), mH_ice(i,j,k)*part_sz(i,j,k) + ! call SIS_error(WARNING, mesg, all_print=.true.) + ! endif + ! if (abs(mca_ice(i,k) - mH_ice(i,j,k)*part_sz(i,j,k)) > 1e-12*mca_ice(i,k)) then + ! write(mesg,'("Compress mismatch at ",3(i8),": mca, h, part, hxp = ",4(1pe15.6))') & + ! i, j, k, mca_ice(i,k), mH_ice(i,j,k), part_sz(i,j,k), mH_ice(i,j,k)*part_sz(i,j,k) + ! call SIS_error(WARNING, mesg, all_print=.true.) + ! endif + ! enddo ; enddo + ! endif + + endif ! Any compression occurs in this j-loop. + enddo ! j-loop -end subroutine compress_ice +end subroutine compress_ice -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> Advect the ice tracers 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, CS) - 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 in m s-1 - real, dimension(SZI_(G),SZJB_(G)), intent(in ) :: vc !< y-face advecting velocity in m s-1 - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: trc !< Depth integrated amount of the tracer to - !! advect, in m kg kg-1 or other units - real, intent(in ) :: stop_lim !< A tracer amount below which to - !! stop advection, in the same units as tr - real, intent(in ) :: dt_slow !< The time covered by this call, in s. - type(SIS_transport_CS), pointer :: CS !< The control structure for this module -! Arguments: uc - The zonal ice velocity, in m s-1. -! (in) vc - The meridional ice velocity, in m s-1. -! (inout) trc - A tracer concentration times thickness, in m kg kg-1 or -! other units. -! (in) stop_lim - ? -! (in) dt_slow - The amount of time over which the ice dynamics are to be -! advanced, in s. -! (in) G - The ocean's grid structure. -! (in/out) CS - A pointer to the control structure for this module. - - real, dimension(SZIB_(G),SZJ_(G)) :: uflx - real, dimension(SZI_(G),SZJB_(G)) :: vflx - real :: avg, dif - real :: dt_adv - integer :: l, i, j, isc, iec, jsc, jec +!> 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) + 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(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]. + type(EFP_type),optional, intent(out) :: tot_pond !< The globally integrated total snow [kg]. + real, optional, intent(in) :: scale !< A scaling factor from H to the desired units. + + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: sum_ice, sum_snow, sum_pond + real :: H_to_units ! A conversion factor from H to the desired output units. + real :: total + 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 - if (CS%adv_sub_steps==0) return; - dt_adv = dt_slow/CS%adv_sub_steps + 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) * & + (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) * & + (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) * & + (IST%part_size(i,j,k) * (H_to_units*IST%mH_pond(i,j,k))) + enddo ; enddo ; enddo + total = reproducing_sum(sum_ice, EFP_sum=tot_ice) + total = reproducing_sum(sum_snow, EFP_sum=tot_snow) + if (present(tot_pond)) total = reproducing_sum(sum_pond, EFP_sum=tot_pond) - do l=1,CS%adv_sub_steps - do j=jsc,jec ; do I=isc-1,iec - avg = ( trc(i,j) + trc(i+1,j) )/2 - dif = trc(i+1,j) - trc(i,j) - if( avg > stop_lim .and. uc(I,j) * dif > 0.0) then - uflx(I,j) = 0.0 - else if( uc(i,j) > 0.0 ) then - 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) * G%dy_Cu(I,j) - endif - enddo ; enddo +end subroutine get_total_mass - do J=jsc-1,jec ; do i=isc,iec - avg = ( trc(i,j) + trc(i,j+1) )/2 - dif = trc(i,j+1) - trc(i,j) - if( avg > stop_lim .and. vc(i,J) * dif > 0.0) then - vflx(i,J) = 0.0 - else if( vc(i,J) > 0.0 ) then - 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) * G%dx_Cv(i,J) - endif - enddo ; enddo +!> get_cell_mass determines the integrated mass of snow and ice in each cell +subroutine get_cell_mass(IST, G, IG, cell_mass, 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cell_mass !< The total amount of ice and snow [H ~> kg m-2]. + real, optional, intent(in) :: scale !< A scaling factor from H to the desired units. - 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) - enddo ; enddo + real :: H_to_units ! A conversion factor from H to the desired output units. + integer :: i, j, k, isc, iec, jsc, jec + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - call pass_var(trc, G%Domain) - enddo + H_to_units = 1.0 ; if (present(scale)) H_to_units = scale -end subroutine slab_ice_advect + cell_mass(:,:) = 0.0 + do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec + cell_mass(i,j) = cell_mass(i,j) + IST%part_size(i,j,k) * H_to_units * & + ((IST%mH_snow(i,j,k) + IST%mH_pond(i,j,k)) + IST%mH_ice(i,j,k)) + enddo ; enddo ; enddo -!> get_total_amounts determines the globally integrated mass of snow and ice -subroutine get_total_amounts(mH_ice, mH_snow, part_sz, G, IG, tot_ice, tot_snow) - 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),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mH_ice !< The mass per unit area of the ice - !! in each category in H (often kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mH_snow !< The mass per unit area of the snow - !! atop the ice in each category in H. - real, dimension(SZI_(G),SZJ_(G),0:SZCAT_(IG)), & - intent(in) :: part_sz !< The fractional ice concentration - !! within a cell in each thickness - !! category, nondimensional, 0-1. - type(EFP_type), intent(out) :: tot_ice !< The globally integrated total ice, in kg. - type(EFP_type), intent(out) :: tot_snow !< The globally integrated total snow, in kg. +end subroutine get_cell_mass - real, dimension(G%isc:G%iec, G%jsc:G%jec) :: sum_mca_ice, sum_mca_snow - real :: total - integer :: i, j, k, m, isc, iec, jsc, jec - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec +subroutine cell_mass_from_CAS(CAS, G, IG, mca, scale) + type(cell_average_state_type), intent(in) :: CAS !< A structure with ocean-cell averaged masses by + !! category and phase of water. + 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),SZJ_(G)), intent(out) :: mca !< The combined mass of ice, snow, and + !! melt pond water in each cell [H ~> kg m-2]. + real, optional, intent(in) :: scale !< A scaling factor from H to the desired units. - sum_mca_ice(:,:) = 0.0 - sum_mca_snow(:,:) = 0.0 - do k=1,IG%CatIce ; do j=jsc,jec ; do i=isc,iec - sum_mca_ice(i,j) = sum_mca_ice(i,j) + G%areaT(i,j) * (part_sz(i,j,k)*mH_ice(i,j,k)) - sum_mca_snow(i,j) = sum_mca_snow(i,j) + G%areaT(i,j) * (part_sz(i,j,k)*mH_snow(i,j,k)) - enddo ; enddo ; enddo + real :: H_to_units ! A conversion factor from H to the desired output units. + integer :: i, j, k, isc, iec, jsc, jec, nCat + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nCat = IG%CatIce - total = reproducing_sum(sum_mca_ice, EFP_sum=tot_ice) - total = reproducing_sum(sum_mca_snow, EFP_sum=tot_snow) + H_to_units = 1.0 ; if (present(scale)) H_to_units = scale -end subroutine get_total_amounts + do j=jsc,jec ; do i=isc,iec ; mca(i,j) = 0.0 ; enddo ; enddo + do k=1,nCat ; do j=jsc,jec ; do i=isc,iec + mca(i,j) = mca(i,j) + H_to_units * (CAS%m_ice(i,j,k) + (CAS%m_snow(i,j,k) + CAS%m_pond(i,j,k))) + enddo ; enddo ; enddo -!> get_total_amounts determines the globally integrated enthalpy of snow and ice -subroutine get_total_enthalpy(mH_ice, mH_snow, part_sz, TrReg, & - G, IG, enth_ice, enth_snow) - 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),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mH_ice !< The mass per unit area of the ice - !! in each category in H (often kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mH_snow !< The mass per unit area of the snow - !! atop the ice in each category in H. - real, dimension(SZI_(G),SZJ_(G),0:SZCAT_(IG)), & - intent(in) :: part_sz !< The fractional ice concentration - !! within a cell in each thickness - !! category, nondimensional, 0-1. - type(SIS_tracer_registry_type), pointer :: TrReg !< The registry of SIS ice and snow tracers. - type(EFP_type), intent(out) :: enth_ice !< The globally integrated total ice enthalpy in J. - type(EFP_type), intent(out) :: enth_snow !< The globally integrated total snow enthalpy in J. +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) + 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(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]. + real, optional, intent(in) :: scale !< A scaling factor from H to the desired units. ! Local variables real, dimension(:,:,:,:), & @@ -985,23 +1065,27 @@ subroutine get_total_enthalpy(mH_ice, mH_snow, part_sz, TrReg, & ! Enth_snow is the enthalpy of the snow atop the ice in each category, in ! enth_units (J or rescaled). real, dimension(G%isc:G%iec, G%jsc:G%jec) :: sum_enth_ice, sum_enth_snow + real :: H_to_units ! A conversion factor from H to the desired output units. real :: total, I_Nk integer :: i, j, k, m, isc, iec, jsc, jec, nLay isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - call get_SIS_tracer_pointer("enth_ice", TrReg, heat_ice, nLay) - call get_SIS_tracer_pointer("enth_snow", TrReg, heat_snow, nLay) + H_to_units = IG%H_to_kg_m2 ; if (present(scale)) H_to_units = scale + + call get_SIS_tracer_pointer("enth_ice", IST%TrReg, heat_ice, nLay) + call get_SIS_tracer_pointer("enth_snow", IST%TrReg, heat_snow, nLay) sum_enth_ice(:,:) = 0.0 ; sum_enth_snow(:,:) = 0.0 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) * & - ((mH_ice(i,j,k)*part_sz(i,j,k))*I_Nk)) * heat_ice(i,j,k,m) + (((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) * & - (mH_snow(i,j,k)*part_sz(i,j,k))) * heat_snow(i,j,k,1) + ((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? total = reproducing_sum(sum_enth_ice, EFP_sum=enth_ice) total = reproducing_sum(sum_enth_snow, EFP_sum=enth_snow) @@ -1010,7 +1094,7 @@ 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) +subroutine SIS_transport_init(Time, G, 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 @@ -1018,7 +1102,10 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS) 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 !! that is allocated and populated here - + type(SIS_continuity_CS), optional, pointer :: continuity_CSp !< The control structure for the + !! SIS continuity module + type(SIS_continuity_CS), optional, pointer :: cover_trans_CSp !< The control structure for ice cover + !! transport by the SIS continuity module ! This subroutine sets the parameters and registers the diagnostics associated ! with the ice dynamics. @@ -1026,6 +1113,7 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS) #include "version_variable.h" character(len=40) :: mdl = "SIS_transport" ! This module's name. character(len=80) :: scheme ! A string for identifying an advection scheme. + logical :: merged_cont real, parameter :: missing = -1e34 if (associated(CS)) then @@ -1039,48 +1127,19 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version) - call get_param(param_file, mdl, "SPECIFIED_ICE", CS%specified_ice, & - "If true, the ice is specified and there is no dynamics.", & - default=.false.) - if ( CS%specified_ice ) then - CS%adv_sub_steps = 0 - call log_param(param_file, mdl, "NSTEPS_ADV", CS%adv_sub_steps, & - "The number of advective iterations for each slow time \n"//& - "step. With SPECIFIED_ICE this is always 0.") - CS%slab_ice = .true. - call log_param(param_file, mdl, "USE_SLAB_ICE", CS%slab_ice, & - "Use the very old slab-style ice. With SPECIFIED_ICE, \n"//& - "USE_SLAB_ICE is always true.") - else - call get_param(param_file, mdl, "NSTEPS_ADV", CS%adv_sub_steps, & - "The number of advective iterations for each slow time \n"//& - "step.", default=1) - call get_param(param_file, mdl, "USE_SLAB_ICE", CS%SLAB_ICE, & - "If true, use the very old slab-style ice.", default=.false.) - endif - call obsolete_logical(param_file, "ADVECT_TSURF", warning_val=.false.) call get_param(param_file, mdl, "RECATEGORIZE_ICE", CS%readjust_categories, & "If true, readjust the distribution into ice thickness \n"//& "categories after advection.", default=.true.) - - call obsolete_real(param_file, "ICE_CHANNEL_VISCOSITY", warning_val=0.0) - call obsolete_real(param_file, "ICE_CHANNEL_VISCOSITY", warning_val=0.15) - call obsolete_real(param_file, "ICE_CHANNEL_CFL_LIMIT", warning_val=0.25) - call get_param(param_file, mdl, "RHO_ICE", CS%Rho_ice, & "The nominal density of sea ice as used by SIS.", & units="kg m-3", default=905.0) - call get_param(param_file, mdl, "RHO_SNOW", CS%Rho_snow, & - "The nominal density of snow as used by SIS.", & - units="kg m-3", default=330.0) - call get_param(param_file, mdl, "SEA_ICE_ROLL_FACTOR", CS%Roll_factor, & "A factor by which the propensity of small amounts of \n"//& "thick sea-ice to become thinner by rolling is increased \n"//& "or 0 to disable rolling. This can be thought of as the \n"//& "minimum number of ice floes in a grid cell divided by \n"//& "the horizontal floe aspect ratio. Sensible values are \n"//& - "0 (no rolling) or larger than 1.", units="Nondim",default=1.0) + "0 (no rolling) or larger than 1.", units="Nondim", default=1.0) call get_param(param_file, mdl, "CHECK_ICE_TRANSPORT_CONSERVATION", CS%check_conservation, & "If true, use add multiple diagnostics of ice and snow \n"//& @@ -1092,8 +1151,6 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS) "Otherwise, ice is compressed proportionately if the \n"//& "concentration exceeds 1. The original SIS2 implementation \n"//& "is based on work by Torge Martin.", default=.false.) - call obsolete_logical(param_file, "USE_SIS_CONTINUITY", .true.) - call obsolete_logical(param_file, "USE_SIS_THICKNESS_ADVECTION", .true.) call get_param(param_file, mdl, "SIS_THICKNESS_ADVECTION_SCHEME", scheme, & desc="The horizontal transport scheme for thickness:\n"//& " UPWIND_2D - Non-directionally split upwind\n"//& @@ -1107,10 +1164,28 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS) "sensible, and issue warnings if they are not. This \n"//& "does not change answers, but can increase model run time.", & default=.true.) + call get_param(param_file, mdl, "MERGED_CONTINUITY", merged_cont, & + "If true, update the continuity equations for the ice, snow, \n"//& + "and melt pond water together summed across categories, with \n"//& + "proportionate fluxes for each part. Otherwise the media are \n"//& + "updated separately.", default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "INCONSISTENT_COVER_BUG", CS%inconsistent_cover_bug, & + "If true, omit a recalculation of the fractional ice-free \n"//& + "areal coverage after the adjustment of the ice categories.", & + default=.true., do_not_log=merged_cont) + if (merged_cont) CS%inconsistent_cover_bug = .false. + call obsolete_logical(param_file, "ADVECT_TSURF", warning_val=.false.) + call obsolete_real(param_file, "ICE_CHANNEL_VISCOSITY", warning_val=0.0) + call obsolete_real(param_file, "ICE_CHANNEL_CFL_LIMIT", warning_val=0.25) + call obsolete_logical(param_file, "USE_SIS_CONTINUITY", .true.) + call obsolete_logical(param_file, "USE_SIS_THICKNESS_ADVECTION", .true.) - call SIS_continuity_init(Time, G, param_file, diag, CS%continuity_CSp) + call SIS_continuity_init(Time, G, param_file, diag, CS%continuity_CSp, & + CS_cvr=cover_trans_CSp) call SIS_tracer_advect_init(Time, G, param_file, diag, CS%SIS_tr_adv_CSp) + if (present(continuity_CSp)) continuity_CSp => CS%continuity_CSp + 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, & @@ -1119,9 +1194,58 @@ subroutine SIS_transport_init(Time, G, param_file, diag, CS) 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') + 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, & + 'ice ridging rate', '1/sec', missing_value=missing) +!### THESE DIAGNOSTICS DO NOT EXIST YET. +! 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) end subroutine SIS_transport_init +!> Allocate a cell_average_state_type and its elements +subroutine alloc_cell_average_state_type(CAS, HI, IG, CS) + type(cell_average_state_type), pointer :: CAS !< A structure with ocean-cell averaged masses + !! that is being allocated here. + type(hor_index_type), intent(in) :: HI !< The horizontal index type describing the domain + type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type + type(SIS_transport_CS), optional, pointer :: CS !< A pointer to the control structure for this module + + integer :: isd, ied, jsd, jed, nCat + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nCat = IG%CatIce + + if (.not.associated(CAS)) allocate(CAS) + call safe_alloc_alloc(CAS%m_ice, isd, ied, jsd, jed, ncat) + call safe_alloc_alloc(CAS%m_snow, isd, ied, jsd, jed, ncat) + call safe_alloc_alloc(CAS%m_pond, isd, ied, jsd, jed, ncat) + call safe_alloc_alloc(CAS%mH_ice, isd, ied, jsd, jed, ncat) + + if (present(CS)) then + if (CS%id_xprt>0) & + call safe_alloc_alloc(CAS%mass0, isd, ied, jsd, jed) + if (CS%id_ix_trans>0) & + call safe_alloc_alloc(CAS%uh_sum, HI%IsdB, HI%IedB, jsd, jed) + if (CS%id_iy_trans>0) & + call safe_alloc_alloc(CAS%vh_sum, isd, ied, HI%JsdB, HI%JedB) + endif +end subroutine alloc_cell_average_state_type + +!> Allocate a cell_average_state_type and its elements +subroutine dealloc_cell_average_state_type(CAS) + type(cell_average_state_type), pointer :: CAS !< A structure with ocean-cell averaged masses + !! that is being allocated here. + if (.not.associated(CAS)) return + deallocate(CAS%m_ice, CAS%m_snow, CAS%m_pond, CAS%mH_ice) + if (allocated(CAS%mass0)) deallocate(CAS%mass0) + if (allocated(CAS%uh_sum)) deallocate(CAS%uh_sum) + if (allocated(CAS%vh_sum)) deallocate(CAS%vh_sum) + deallocate(CAS) + +end subroutine dealloc_cell_average_state_type + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> SIS_transport_end deallocates the memory associated with this module. subroutine SIS_transport_end(CS) diff --git a/src/SIS_types.F90 b/src/SIS_types.F90 index 28f7a9d1..2f899f45 100644 --- a/src/SIS_types.F90 +++ b/src/SIS_types.F90 @@ -24,7 +24,7 @@ module SIS_types use MOM_time_manager, only : time_type, time_type_to_real 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, hchksum, uvchksum +use SIS_debugging, only : chksum, Bchksum, Bchksum_pair, hchksum, uvchksum use SIS_debugging, only : check_redundant_B, check_redundant_C use SIS_tracer_registry, only : SIS_tracer_registry_type @@ -57,37 +57,46 @@ module SIS_types type ice_state_type ! The 8 of the following 10 variables constitute the sea-ice state. real, allocatable, dimension(:,:,:) :: part_size !< The fractional coverage of a grid cell by - !! each ice thickness category, nondim, 0 to 1. Category 0 is open ocean. + !! each ice thickness category [nondim], 0 to 1. Category 0 is open ocean. !! 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, in m s-1. + !! along the grid directions on a B-grid [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, in m s-1. + !! 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, in m s-1. + !! along the grid directions on a C-grid [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, in m s-1. + !! along the grid directions on a C-grid [m s-1]. real, allocatable, dimension(:,:,:) :: & - mH_pond, & !< The mass per unit area of the pond in each category, in units of H (usually kg m-2). - mH_snow, & !< The mass per unit area of the snow in each category, in units of H (usually kg m-2). - mH_ice, & !< The mass per unit area of the ice in each category, in units of H (usually kg m-2). - t_surf !< The surface temperature, in Kelvin. + mH_pond, & !< The mass per unit area of the pond in each category [H ~> kg m-2]. + mH_snow, & !< The mass per unit area of the snow in each category [H ~> kg m-2]. + mH_ice, & !< The mass per unit area of the ice in each category [H ~> kg m-2]. + t_surf !< The surface temperature [Kelvin]. + + real, allocatable, dimension(:,:) :: & + snow_to_ocn, & !< The mass per unit ocean area of snow that will be dumped into the + !! ocean due to recent mechanical activities like ridging or drifting [kg m-2]. + enth_snow_to_ocn !< The average enthalpy of the snow that will be dumped into the + !! ocean due to recent mechanical activities like ridging or drifting [Enth ~> J kg-1]. real, allocatable, dimension(:,:,:,:) :: sal_ice !< The salinity of the sea ice - !! in each category and fractional thickness layer, in g/kg. + !! in each category and fractional thickness layer [gSalt kg-1]. real, allocatable, dimension(:,:,:,:) :: enth_ice !< The enthalpy of the sea ice - !! in each category and fractional thickness layer, in enth_unit (J/kg or rescaled). + !! in each category and fractional thickness layer [Enth ~> J kg-1]. real, allocatable, dimension(:,:,:,:) :: enth_snow !< The enthalpy of the snow - !! in each category and snow thickness layer, in enth_unit. + !! in each category and snow thickness layer [Enth ~> J kg-1]. real, allocatable, dimension(:,:,:) :: & - rdg_mice !< A diagnostic of the ice load that was formed by ridging, in H (usually kg m-2). + rdg_mice !< A diagnostic of the ice load that was formed by ridging [H ~> kg m-2]. logical :: Cgrid_dyn !< If true use a C-grid discretization of the sea-ice dynamics. + logical :: valid_IST !< If true, this is currently the valid state of the ice. Otherwise the ice + !! is in the midst of a dynamics cycle where the evolving state has changes + !! that are not yet reflected here. type(SIS_tracer_registry_type), pointer :: TrReg => NULL() !< A pointer to the SIS tracer registry @@ -99,20 +108,20 @@ module SIS_types type ocean_sfc_state_type ! 7 of the following 9 variables describe the ocean state as seen by the sea ice. real, allocatable, dimension(:,:) :: & - s_surf , & !< The ocean's surface salinity in g/kg. - SST_C , & !< The ocean's bulk surface temperature in degC. - T_fr_ocn, & !< The freezing point temperature in degC at the ocean's surface salinity. - u_ocn_B, & !< The ocean's zonal velocity on B-grid points in m s-1. - v_ocn_B, & !< The ocean's meridional velocity on B-grid points in m s-1. - u_ocn_C, & !< The ocean's zonal velocity on C-grid points, in m s-1. - v_ocn_C !< The ocean's meridional velocity on C-grid points, in m s-1. + 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_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]. real, allocatable, dimension(:,:) :: bheat !< The upward diffusive heat flux from the ocean - !! to the ice at the base of the ice, in W m-2. + !! 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 !! associated with the formation of frazil ice in the ocean integrated over a - !! timestep, in J m-2. This is the input value and is not changed by the ice. + !! timestep [J m-2]. This is the input value and is not changed by the ice. real, allocatable, dimension(:,:) :: sea_lev !< The equivalent sea-level, after any non-levitating - !! ice has been converted to sea-water, as determined by the ocean, in m. + !! ice has been converted to sea-water, as determined by the ocean [m]. !! Sea-ice only contributes by applying pressure to the ocean that is then !! (partially) converted back to its equivalent by the ocean. @@ -122,7 +131,7 @@ module SIS_types ! type(coupler_3d_bc_type) :: ocean_fields ! array of fields used for additional tracers real :: kmelt !< A constant that is used in the calculation of the ocean/ice basal heat flux, - !! in W m-2 K-1. This could be replaced with an array reflecting the turbulence + !! [W m-2 degC-1]. This could be replaced with an array reflecting the turbulence !! in the under-ice ocean boundary layer and the effective depth of the reported !! value of t_ocn. @@ -139,15 +148,15 @@ module SIS_types ! The following 5 variables describe the ocean state as seen by the ! atmosphere and use for the rapid thermodynamic sea ice changes. real, allocatable, dimension(:,:) :: & - s_surf , & !< The ocean's surface salinity in g/kg. - SST_C , & !< The ocean's bulk surface temperature in degC. - T_fr_ocn, & !< The freezing point temperature in degC at the ocean's surface salinity. - u_ocn_A, & !< The ocean's zonal surface velocity on A-grid points in m s-1. - v_ocn_A, & !< The ocean's meridional surface velocity on A-grid points in m s-1. - u_ice_A, & !< The sea ice's zonal velocity on A-grid points in m s-1. - v_ice_A !< The sea ice's meridional velocity on A-grid points in m s-1. + 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]. real, allocatable, dimension(:,:) :: bheat !< The upward diffusive heat flux - !! from the ocean to the ice at the base of the ice, in W m-2. + !! from the ocean to the ice at the base of the ice [W m-2]. type (coupler_2d_bc_type) :: & tr_fields !< A structure of fields related to properties for additional tracers. @@ -169,52 +178,52 @@ module SIS_types ! both. real, allocatable, dimension(:,:,:) :: & ! The 3rd dimension in each of the following is ice thickness category. - flux_u_top , & !< The downward flux of zonal momentum on an A-grid in Pa. - flux_v_top , & !< The downward flux of meridional momentum on an A-grid in Pa. - flux_sh_top , & !< The upward sensible heat flux at the ice top in W m-2. - evap_top , & !< The upward evaporative moisture flux at top of the ice, in kg m-2 s-1. - flux_lw_top , & !< The net downward flux of longwave radiation at the top of the ice, in W m-2. - flux_lh_top , & !< The upward flux of latent heat at the top of the ice, in W m-2. - lprec_top , & !< The downward flux of liquid precipitation at the top of the ice, in kg m-2 s-1. - fprec_top , & !< The downward flux of frozen precipitation at the top of the ice, in kg m-2 s-1. - tmelt , & !< Ice-top melt energy into the ice/snow in J m-2. - bmelt , & !< Ice-bottom melting energy into the ice in J m-2. - Tskin_cat !< The ice skin temperature by category, in degC. + flux_u_top , & !< The downward flux of zonal momentum on an A-grid [Pa]. + flux_v_top , & !< The downward flux of meridional momentum on an A-grid [Pa]. + flux_sh_top , & !< The upward sensible heat flux at the ice top [W m-2]. + evap_top , & !< The upward evaporative moisture flux at top of the ice [kg m-2 s-1]. + flux_lw_top , & !< The net downward flux of longwave radiation at the top of the ice [W m-2]. + flux_lh_top , & !< The upward flux of latent heat at the top of the ice [W m-2]. + lprec_top , & !< The downward flux of liquid precipitation at the top of the ice [kg m-2 s-1]. + fprec_top , & !< The downward flux of frozen precipitation at the top of the ice [kg m-2 s-1]. + tmelt , & !< Ice-top melt energy into the ice/snow [J m-2]. + bmelt , & !< Ice-bottom melting energy into the ice [J m-2]. + Tskin_cat !< The ice skin temperature by category [degC]. real, allocatable, dimension(:,:,:) :: sw_abs_ocn !< The fraction of the absorbed - !! shortwave radiation that is absorbed in the ocean, nondim and <=1. + !! shortwave radiation that is absorbed in the ocean, <=1, [nondim]. !! Equivalent sw_abs_ocn fields are in both the fast_ice_avg_type and the !! ice_rad_type because it is used as a part of the slow thermodynamic updates. ! The last dimension in each of the following is angular and frequency radiation band. real, allocatable, dimension(:,:,:,:) :: flux_sw_top - !< The downward flux of shortwave radiation at the top of the sea-ice in W m-2. + !< The downward flux of shortwave radiation at the top of the sea-ice [W m-2]. !! The fourth dimension combines angular orientation (direct or diffuse) and !! frequency (visible or near-IR) bands, with the integer parameters !! from this module helping to distinguish them. real, allocatable, dimension(:,:,:) :: flux_sw_dn !< The total downward shortwave flux - !! by wavelength band, averaged across all thickness categories, in W m-2. + !! by wavelength band, averaged across all thickness categories [W m-2]. real, allocatable, dimension(:,:) :: & - WindStr_x , & !< The zonal wind stress averaged over the ice categories on an A-grid, in Pa. - WindStr_y , & !< The meridional wind stress averaged over the ice categories on an A-grid, in Pa. - WindStr_ocn_x, & !< The zonal wind stress on open water on an A-grid, in Pa. - WindStr_ocn_y, & !< The meridional wind stress on open water on an A-grid, in Pa. - p_atm_surf , & !< The atmospheric pressure at the top of the ice, in Pa. - runoff, & !< Liquid runoff into the ocean, in kg m-2. - calving !< Calving of ice or runoff of frozen fresh water into the ocean, in kg m-2. + WindStr_x , & !< The zonal wind stress averaged over the ice categories on an A-grid [Pa]. + WindStr_y , & !< The meridional wind stress averaged over the ice categories on an A-grid [Pa]. + WindStr_ocn_x, & !< The zonal wind stress on open water on an A-grid [Pa]. + WindStr_ocn_y, & !< The meridional wind stress on open water on an A-grid [Pa]. + p_atm_surf , & !< The atmospheric pressure at the top of the ice [Pa]. + runoff, & !< Liquid runoff into the ocean [kg m-2]. + calving !< Calving of ice or runoff of frozen fresh water into the ocean [kg m-2]. real, allocatable, dimension(:,:) :: runoff_hflx !< The heat flux associated with runoff, based !! on the temperature difference relative to a reference temperature, in ???. real, allocatable, dimension(:,:) :: calving_hflx !< The heat flux associated with calving, based !! on the temperature difference relative to a reference temperature, in ???. real, allocatable, dimension(:,:) :: calving_preberg !< Calving of ice or runoff of frozen fresh - !! water into the ocean, exclusive of any iceberg contributions, in kg m-2. + !! water into the ocean, exclusive of any iceberg contributions [kg m-2]. real, allocatable, dimension(:,:) :: calving_hflx_preberg !< The heat flux associated with calving !! exclusive of any iceberg contributions, based on the temperature difference !! relative to a reference temperature, in ???. real, allocatable, dimension(:,:) :: Tskin_avg !< The area-weighted average skin temperature - !! across all ice thickness categories, in deg C, or 0 if there is no ice. + !! across all ice thickness categories [degC], or 0 if there is no ice. real, allocatable, dimension(:,:) :: ice_free !< The fractional open water used in calculating - !! WindStr_[xy]_A; nondimensional, between 0 & 1. + !! WindStr_[xy]_A, between 0 & 1 [nondim]. real, allocatable, dimension(:,:) :: ice_cover !< The fractional ice coverage, summed across all - !! thickness categories, used in calculating WindStr_[xy]_A; nondimensional, between 0 & 1. + !! thickness categories, used in calculating WindStr_[xy]_A, between 0 & 1 [nondim].q integer :: copy_calls = 0 !< The number of times this structure has been !! copied from the fast ice to the slow ice. @@ -225,19 +234,19 @@ module SIS_types ! then interpolated into unoccupied categories for the purpose of redoing ! the application of the fast thermodynamics real, allocatable, dimension(:,:,:) :: flux_sh0 !< The upward sensible heat flux at the ice top - !! extrapolated to a skin temperature of 0 deg C, in W m-2. + !! extrapolated to a skin temperature of 0 degC [W m-2]. real, allocatable, dimension(:,:,:) :: evap0 !< The upward evaporative moisture flux - !! at the top of the ice extrapolated to a skin temperature of 0 deg C, in kg m-2 s-1. + !! at the top of the ice extrapolated to a skin temperature of 0 degC [kg m-2 s-1]. real, allocatable, dimension(:,:,:) :: flux_lw0 !< The net downward flux of longwave radiation - !! at the top of the ice extrapolated to a skin temperature of 0 deg C, in W m-2. + !! at the top of the ice extrapolated to a skin temperature of 0 degC [W m-2]. real, allocatable, dimension(:,:,:) :: & - dshdt, & !< The partial derivative of flux_sh0 with ice skin temperature in W m-2 K-1. - devapdt, & !< The partial derivative of evap0 with ice skin temperature in kg m-2 s-1 K-1. - dlwdt !< The partial derivative of flux_lw0 with ice skin temperature in W m-2 K-1. + dshdt, & !< The partial derivative of flux_sh0 with ice skin temperature [W m-2 degC-1]. + devapdt, & !< The partial derivative of evap0 with ice skin temperature [kg m-2 s-1 degC-1]. + dlwdt !< The partial derivative of flux_lw0 with ice skin temperature [W m-2 degC-1]. !SLOW ONLY real, allocatable, dimension(:,:) :: frazil_left !< The frazil heat flux that has not yet been - !! consumed in making ice, in J m-2. This array is decremented by the ice + !! consumed in making ice [J m-2]. This array is decremented by the ice !! model as the heat flux is used up. !SLOW ONLY !!@{ Diagnostic IDs @@ -263,16 +272,16 @@ module SIS_types ! These are the arrays that are averaged over the categories and in time over ! the fast thermodynamics. real, allocatable, dimension(:,:) :: & - flux_u , & !< The downward flux of zonal momentum on an A-grid in Pa. - flux_v , & !< The downward flux of meridional momentum on an A-grid in Pa. - flux_sh , & !< The upward sensible heat flux at the ice top in W m-2. - evap , & !< The upward evaporative moisture flux at top of the ice, in kg m-2 s-1. - flux_lw , & !< The downward flux of longwave radiation at the top of the ice, in W m-2. - flux_lh , & !< The upward flux of latent heat at the top of the ice, in W m-2. - lprec , & !< The downward flux of liquid precipitation at the top of the ice, in kg m-2 s-1. - fprec !< The downward flux of frozen precipitation at the top of the ice, in kg m-2 s-1. + flux_u , & !< The downward flux of zonal momentum on an A-grid [Pa]. + flux_v , & !< The downward flux of meridional momentum on an A-grid [Pa]. + flux_sh , & !< The upward sensible heat flux at the ice top [W m-2]. + evap , & !< The upward evaporative moisture flux at top of the ice [kg m-2 s-1]. + flux_lw , & !< The downward flux of longwave radiation at the top of the ice [W m-2]. + flux_lh , & !< The upward flux of latent heat at the top of the ice [W m-2]. + lprec , & !< The downward flux of liquid precipitation at the top of the ice [kg m-2 s-1]. + fprec !< The downward flux of frozen precipitation at the top of the ice [kg m-2 s-1]. real, allocatable, dimension(:,:,:) :: flux_sw - !< The downward flux of shortwave radiation at the top of the sea-ice in W m-2. + !< The downward flux of shortwave radiation at the top of the sea-ice [W m-2]. !! The third dimension combines angular orientation (direct or diffuse) and !! frequency (visible or near-IR) bands, with the integer parameters !! from this module helping to distinguish them. @@ -292,30 +301,30 @@ module SIS_types t_skin, & !< The surface skin temperature as calculated by the most !! recent fast atmospheric timestep, or a value filled in !! from other ice categories or the local freezing point of - !! seawater when there is no ice at all, in degrees Celsius. + !! seawater when there is no ice at all [degC]. Tskin_Rad !< The surface skin temperature that was most recently used in - !! ice optics calculations, in degrees Celsius. + !! ice optics calculations [degC]. ! Shortwave absorption parameters that are set in ice_optics. real, allocatable, dimension(:,:,:) :: & sw_abs_sfc , & !< The fraction of the absorbed shortwave radiation that is - !! absorbed in a surface skin layer, nondim and <=1. + !! absorbed in a surface skin layer, <=1, [nondim]. sw_abs_snow, & !< The fraction of the absorbed shortwave radiation that is - !! absorbed in the snow, nondim and <=1. + !! absorbed in the snow, <=1, [nondim]. sw_abs_ocn , & !< The fraction of the absorbed shortwave radiation that is - !! absorbed in the ocean, nondim and <=1. + !! absorbed in the ocean, <=1, [nondim]. ! Only sw_abs_ocn is used in the slow step. sw_abs_int !< The fraction of the absorbed shortwave radiation that is - !! absorbed by all ice layers in aggregate, nondim and <=1. + !! absorbed by all ice layers in aggregate, <=1, [nondim]. ! sw_abs_int is only used for diagnostics. real, allocatable, dimension(:,:,:,:) :: & sw_abs_ice !< The fraction of the absorbed shortwave that is - !! absorbed in each of the ice layers, nondim, <=1. + !! absorbed in each of the ice layers, <=1, [nondim]. real, allocatable, dimension(:,:) :: & coszen_lastrad, & !< Cosine of the solar zenith angle averaged - !! over the last radiation timestep, nondim. + !! over the last radiation timestep [nondim]. coszen_nextrad !< Cosine of the solar zenith angle averaged - !! over the next radiation timestep, nondim. + !! over the next radiation timestep [nondim]. logical :: add_diurnal_sw !< If true, apply a synthetic diurnal cycle to !! the shortwave radiation. @@ -341,31 +350,35 @@ module SIS_types type ice_ocean_flux_type ! These variables describe the fluxes between ice or atmosphere and the ocean. real, allocatable, dimension(:,:) :: & - flux_sh_ocn_top, & !< The upward sensible heat flux from the ocean to the ice or atmosphere, in W m-2. - evap_ocn_top, & !< The upward evaporative moisture flux at the ocean surface, in kg m-2 s-1. - flux_lw_ocn_top, & !< The downward flux of longwave radiation at the ocean surface, in W m-2. - flux_lh_ocn_top, & !< The upward flux of latent heat at the ocean surface, in W m-2. - lprec_ocn_top, & !< The downward flux of liquid precipitation at the ocean surface, in kg m-2 s-1. - fprec_ocn_top, & !< The downward flux of frozen precipitation at the ocean surface, in kg m-2 s-1. - flux_u_ocn, & !< The flux of x-momentum into the ocean, in Pa at locations given by flux_uv_stagger. + flux_sh_ocn_top, & !< The upward sensible heat flux from the ocean to the ice or atmosphere [W m-2]. + evap_ocn_top, & !< The upward evaporative moisture flux at the ocean surface [kg m-2 s-1]. + flux_lw_ocn_top, & !< The downward flux of longwave radiation at the ocean surface [W m-2]. + 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]. !! 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, in Pa at locations given by flux_uv_stagger. + flux_v_ocn, & !< The flux of y-momentum into the ocean at locations given by flux_uv_stagger [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, in Pa. + stress_mag, & !< The area-weighted time-mean of the magnitude of the stress on the ocean [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, in kg m-2 s-1. - flux_salt !< The flux of salt out of the ocean in kg m-2. + !! 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]. + mass_ice_sn_p, & !< The combined mass per unit ocean area of ice, snow and pond water [kg m-2]. + pres_ocn_top !< The hydrostatic pressure at the ocean surface due to the weight of ice, + !! snow and ponds, exclusive of atmospheric pressure [Pa]. + !### What about pressure from bergs? real, allocatable, dimension(:,:,:) :: flux_sw_ocn !< The downward flux of shortwave radiation - !! at the ocean surface in W m-2. The third dimension combines + !! at the ocean surface [W m-2]. The third dimension combines !! angular orientation (direct or diffuse) and frequency !! (visible or near-IR) bands, with the integer parameters !! from this module helping to distinguish them. !Iceberg fields real, pointer, dimension(:,:) :: & - ustar_berg =>NULL(), & !< ustar contribution below icebergs in m/s - area_berg =>NULL(), & !< fraction of grid cell covered by icebergs in m2/m2 - mass_berg =>NULL() !< mass of icebergs in km/m^2 + ustar_berg =>NULL(), & !< ustar contribution below icebergs [m s-1] + area_berg =>NULL(), & !< fraction of grid cell covered by icebergs [m2 m-2] + mass_berg =>NULL() !< mass of icebergs [kg m-2] ! These arrays are used for enthalpy change diagnostics in the slow thermodynamics. real, allocatable, dimension(:,:) :: & @@ -373,10 +386,10 @@ module SIS_types ! removal of water mass (liquid or frozen) from the ice model are required ! to close the enthalpy budget. Ice enthalpy is generally negative, so terms ! that add mass to the ice are generally negative. - Enth_Mass_in_atm , & !< The enthalpy introduced to the ice by water fluxes from the atmosphere, in J m-2. - Enth_Mass_out_atm, & !< Negative of the enthalpy extracted from the ice by water fluxes to the atmosphere, in J m-2. - Enth_Mass_in_ocn , & !< The enthalpy introduced to the ice by water fluxes from the ocean, in J m-2. - Enth_Mass_out_ocn !< Negative of the enthalpy extracted from the ice by water fluxes to the ocean, in J m-2. + Enth_Mass_in_atm , & !< The enthalpy introduced to the ice by water fluxes from the atmosphere [J m-2]. + Enth_Mass_out_atm, & !< Negative of the enthalpy extracted from the ice by water fluxes to the atmosphere [J m-2]. + Enth_Mass_in_ocn , & !< The enthalpy introduced to the ice by water fluxes from the ocean [J m-2]. + Enth_Mass_out_ocn !< Negative of the enthalpy extracted from the ice by water fluxes to the ocean [J m-2]. integer :: stress_count !< The number of times that the stresses from the ice to the ocean have been incremented. integer :: flux_uv_stagger = -999 !< The staggering relative to the tracer points of the two wind @@ -403,12 +416,13 @@ module SIS_types !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> alloc_IST_arrays allocates the arrays in an ice_state_type. -subroutine alloc_IST_arrays(HI, IG, IST, omit_velocities, omit_Tsurf) +subroutine alloc_IST_arrays(HI, IG, IST, omit_velocities, omit_Tsurf, do_ridging) type(hor_index_type), intent(in) :: HI !< The horizontal index type describing the domain type(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice logical, optional, intent(in) :: omit_velocities !< If true, do not allocate velocity arrays logical, optional, intent(in) :: omit_Tsurf !< If true, do not allocate the surface temperature array + logical, optional, intent(in) :: do_ridging !< If true, allocate arrays related to ridging integer :: isd, ied, jsd, jed, CatIce, NkIce, idr logical :: do_vel, do_Tsurf @@ -419,6 +433,7 @@ subroutine alloc_IST_arrays(HI, IG, IST, omit_velocities, omit_Tsurf) CatIce = IG%CatIce ; NkIce = IG%NkIce isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed + IST%valid_IST = .true. allocate(IST%part_size(isd:ied, jsd:jed, 0:CatIce)) ; IST%part_size(:,:,:) = 0.0 allocate(IST%mH_pond( isd:ied, jsd:jed, CatIce)) ; IST%mH_pond(:,:,:) = 0.0 allocate(IST%mH_snow( isd:ied, jsd:jed, CatIce)) ; IST%mH_snow(:,:,:) = 0.0 @@ -427,13 +442,17 @@ subroutine alloc_IST_arrays(HI, IG, IST, omit_velocities, omit_Tsurf) allocate(IST%enth_ice( isd:ied, jsd:jed, CatIce, NkIce)) ; IST%enth_ice(:,:,:,:) = 0.0 allocate(IST%sal_ice( isd:ied, jsd:jed, CatIce, NkIce)) ; IST%sal_ice(:,:,:,:) = 0.0 + if (present(do_ridging)) then ; if (do_ridging) then + allocate(IST%snow_to_ocn(isd:ied, jsd:jed)) ; IST%snow_to_ocn(:,:) = 0.0 + allocate(IST%enth_snow_to_ocn(isd:ied, jsd:jed)) ; IST%enth_snow_to_ocn(:,:) = 0.0 + endif ; endif + if (do_vel) then ! These velocities are only required for the slow ice processes, and hence ! can use the memory macros. - if (IST%Cgrid_dyn) then - allocate(IST%u_ice_C(SZIB_(HI), SZJ_(HI))) ; IST%u_ice_C(:,:) = 0.0 - allocate(IST%v_ice_C(SZI_(HI), SZJB_(HI))) ; IST%v_ice_C(:,:) = 0.0 - else + allocate(IST%u_ice_C(SZIB_(HI), SZJ_(HI))) ; IST%u_ice_C(:,:) = 0.0 + allocate(IST%v_ice_C(SZI_(HI), SZJB_(HI))) ; IST%v_ice_C(:,:) = 0.0 + if (.not.IST%Cgrid_dyn) then allocate(IST%u_ice_B(SZIB_(HI), SZJB_(HI))) ; IST%u_ice_B(:,:) = 0.0 allocate(IST%v_ice_B(SZIB_(HI), SZJB_(HI))) ; IST%v_ice_B(:,:) = 0.0 endif @@ -487,6 +506,13 @@ subroutine ice_state_register_restarts(IST, G, IG, Ice_restart, restart_file) idr = register_restart_field(Ice_restart, restart_file, 'sal_ice', IST%sal_ice, & domain=mpp_domain, mandatory=.false., units="kg/kg") + if (allocated(IST%snow_to_ocn)) then + idr = register_restart_field(Ice_restart, restart_file, 'snow_to_ocn', IST%snow_to_ocn, & + domain=mpp_domain, mandatory=.false., units="kg m-2") + idr = register_restart_field(Ice_restart, restart_file, 'enth_snow_to_ocn', IST%enth_snow_to_ocn, & + domain=mpp_domain, mandatory=.false., units="J kg-1") + endif + if (IST%Cgrid_dyn) then if (G%symmetric) then idr = register_restart_field(Ice_restart, restart_file, 'sym_u_ice_C', IST%u_ice_C, & @@ -867,6 +893,8 @@ subroutine alloc_ice_ocean_flux(IOF, HI, do_stress_mag, do_iceberg_fields) if (alloc_stress_mag) then allocate(IOF%stress_mag(SZI_(HI), SZJ_(HI))) ; IOF%stress_mag(:,:) = 0.0 endif + allocate(IOF%pres_ocn_top(SZI_(HI), SZJ_(HI))) ; IOF%pres_ocn_top(:,:) = 0.0 + allocate(IOF%mass_ice_sn_p(SZI_(HI), SZJ_(HI))) ; IOF%mass_ice_sn_p(:,:) = 0.0 allocate(IOF%Enth_Mass_in_atm(SZI_(HI), SZJ_(HI))) ; IOF%Enth_Mass_in_atm(:,:) = 0.0 allocate(IOF%Enth_Mass_out_atm(SZI_(HI), SZJ_(HI))) ; IOF%Enth_Mass_out_atm(:,:) = 0.0 @@ -1979,6 +2007,8 @@ subroutine dealloc_IST_arrays(IST) deallocate(IST%part_size, IST%mH_snow, IST%mH_ice) deallocate(IST%mH_pond) ! mw/new deallocate(IST%enth_snow, IST%enth_ice, IST%sal_ice) + if (allocated(IST%snow_to_ocn)) deallocate(IST%snow_to_ocn) + if (allocated(IST%enth_snow_to_ocn)) deallocate(IST%enth_snow_to_ocn) if (allocated(IST%t_surf)) deallocate(IST%t_surf) if (allocated(IST%u_ice_C)) deallocate(IST%u_ice_C) @@ -2111,8 +2141,8 @@ subroutine dealloc_ice_ocean_flux(IOF) deallocate(IOF%flux_sh_ocn_top, IOF%evap_ocn_top) deallocate(IOF%flux_lw_ocn_top, IOF%flux_lh_ocn_top) deallocate(IOF%flux_sw_ocn) - deallocate(IOF%lprec_ocn_top, IOF%fprec_ocn_top) - deallocate(IOF%flux_u_ocn, IOF%flux_v_ocn, IOF%flux_salt) + deallocate(IOF%lprec_ocn_top, IOF%fprec_ocn_top, IOF%flux_salt) + deallocate(IOF%flux_u_ocn, IOF%flux_v_ocn, IOF%pres_ocn_top, IOF%mass_ice_sn_p) if (allocated(IOF%stress_mag)) deallocate(IOF%stress_mag) deallocate(IOF%Enth_Mass_in_atm, IOF%Enth_Mass_out_atm) @@ -2144,6 +2174,8 @@ subroutine IOF_chksum(mesg, IOF, G) 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%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) @@ -2217,11 +2249,8 @@ subroutine IST_chksum(mesg, IST, G, IG, haloshift) type(SIS_hor_grid_type), intent(inout) :: G !< The ice-model's horizonal grid type. 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. -! This subroutine writes out chksums for the model's basic state variables. -! Arguments: mesg - A message that appears on the chksum lines. -! (in) IST - The ice state type variable to be checked. -! (in) G - The ocean's grid structure. (Inout due to halo updates.) -! (in,opt) haloshift - If present, check halo points out this far. + + ! Local variables character(len=20) :: k_str1, k_str integer :: hs, k @@ -2240,10 +2269,10 @@ subroutine IST_chksum(mesg, IST, G, IG, haloshift) enddo call hchksum(IST%mH_snow*IG%H_to_kg_m2, trim(mesg)//" IST%mH_snow", G%HI, haloshift=hs) call hchksum(IST%enth_snow(:,:,:,1), trim(mesg)//" IST%enth_snow", G%HI, haloshift=hs) + 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 - if (allocated(IST%u_ice_B)) call Bchksum(IST%u_ice_B, mesg//" IST%u_ice_B", G%HI, haloshift=hs) - if (allocated(IST%v_ice_B)) call Bchksum(IST%v_ice_B, mesg//" IST%v_ice_B", G%HI, haloshift=hs) + call Bchksum_pair(mesg//" IST%[uv]_ice_B", IST%u_ice_B, IST%v_ice_B, G, halos=hs) 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 @@ -2299,7 +2328,7 @@ subroutine IST_bounds_check(IST, G, IG, msg, OSS, Rad) enddo ; enddo endif do j=jsc,jec ; do i=isc,iec - if (abs(sum_part_sz(i,j) - 1.0) > 1.0e-5) then + if (abs(sum_part_sz(i,j) - 1.0) > 2.0*(ncat+1)*epsilon(sum_part_sz(i,j))) then n_bad = n_bad + 1 if (n_bad == 1) then ; i_bad = i ; j_bad = j ; err = "sum_part_sz" ; endif endif @@ -2351,10 +2380,19 @@ subroutine IST_bounds_check(IST, G, IG, msg, OSS, Rad) write(mesg2,'("part_size = ",1pe12.4)') IST%part_size(i,j,k) endif elseif (present(OSS)) then - write(mesg2,'("T_ocn = ",1pe12.4,", S_sfc = ",1pe12.4,", sum_ps = ",1pe12.4)') & - OSS%SST_C(i,j), OSS%s_surf(i,j), sum_part_sz(i,j) + if (sum_part_sz(i,j) < 0.9999) then + write(mesg2,'("T_ocn = ",1pe12.4,", S_sfc = ",1pe12.4,", sum_ps = ",1pe12.4)') & + OSS%SST_C(i,j), OSS%s_surf(i,j), sum_part_sz(i,j) + else + write(mesg2,'("T_ocn = ",1pe12.4,", S_sfc = ",1pe12.4,", sum_ps = 1 - ",1pe12.4)') & + OSS%SST_C(i,j), OSS%s_surf(i,j), 1.0-sum_part_sz(i,j) + endif else - write(mesg2,'("sum_part_sz = ",1pe12.4)') sum_part_sz(i,j) + if (sum_part_sz(i,j) < 0.9999) then + write(mesg2,'("sum_part_sz = ",1pe12.4)') sum_part_sz(i,j) + else + write(mesg2,'("sum_part_sz = 1 - ",1pe12.4)') 1.0-sum_part_sz(i,j) + endif endif call SIS_error(WARNING, "Bad ice state "//trim(err)//" "//trim(msg)//" ; "//trim(mesg1)//& " ; "//trim(mesg2), all_print=.true.) diff --git a/src/SIS_utils.F90 b/src/SIS_utils.F90 index e6a432a6..67ff9751 100644 --- a/src/SIS_utils.F90 +++ b/src/SIS_utils.F90 @@ -7,6 +7,7 @@ module SIS_utils use MOM_domains, only : SCALAR_PAIR, CGRID_NE, BGRID_NE, To_All 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 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 @@ -77,21 +78,26 @@ end subroutine get_avg !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> ice_line writes out a line with the northern and southern hemisphere ice !! extents and global mean sea surface temperature. -subroutine ice_line(year, day, second, cn_ocn, sst, G) - integer, intent(in) :: year !< The current model year - integer, intent(in) :: day !< The current model year-day - integer, intent(in) :: second !< The second of the day +subroutine ice_line(Time, cn_ocn, sst, G) + type(time_type), intent(in) :: Time !< The ending time of these diagnostics type(SIS_hor_grid_type), intent(in) :: G !< The horizontal grid type real, dimension(G%isc:G%iec,G%jsc:G%jec), & - intent(in) :: cn_ocn !< The concentration of ocean in each cell, nondim, 0-1. + intent(in) :: cn_ocn !< The concentration of ocean in each cell [nondim], 0-1. real, dimension(G%isc:G%iec,G%jsc:G%jec), & - intent(in) :: sst !< The sea surface temperature in degC. + intent(in) :: sst !< The sea surface temperature [degC]. real, dimension(G%isc:G%iec,G%jsc:G%jec) :: x real :: gx(3) + integer :: year !< The current model year + integer :: day !< The current model year-day + integer :: second !< The second of the day + integer :: mon, hr, min integer :: n, i, j, isc, iec, jsc, jec isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + call get_date(Time, year, mon, day, hr, min, second) + call get_time(Time-set_date(year,1,1,0,0,0), second, day) + if (.not.(second==0 .and. mod(day,5)==0) ) return do n=-1,1,2 diff --git a/src/combined_ice_ocean_driver.F90 b/src/combined_ice_ocean_driver.F90 index d8e2515f..8a533970 100644 --- a/src/combined_ice_ocean_driver.F90 +++ b/src/combined_ice_ocean_driver.F90 @@ -16,7 +16,8 @@ module combined_ice_ocean_driver use MOM_file_parser, only : read_param, get_param, log_param, log_version use MOM_io, only : file_exists, close_file, slasher, ensembler use MOM_io, only : open_namelist_file, check_nml_error -use MOM_time_manager, only : time_type, time_type_to_real !, operator(>) +use MOM_time_manager, only : time_type, time_type_to_real, real_to_time_type +use MOM_time_manager, only : operator(+), operator(-), operator(>) use ice_model_mod, only : ice_data_type, ice_model_end use ice_model_mod, only : update_ice_slow_thermo, update_ice_dynamics_trans @@ -39,6 +40,12 @@ module combined_ice_ocean_driver !! step including both dynamics and thermodynamics. !! If false, the two phases are advanced with !! separate calls. The default is true. + logical :: intersperse_ice_ocn !< If true, intersperse the ice and ocean thermodynamic and + !! dynamic updates. This requires the update ocean (MOM6) interfaces + !! used with single_MOM_call=.false. The default is false. + real :: dt_coupled_dyn !< The time step for coupling the ice and ocean dynamics when + !! INTERSPERSE_ICE_OCEAN is true, or <0 to use the coupled timestep. + !! The default is -1. end type ice_ocean_driver_type contains @@ -59,7 +66,7 @@ subroutine ice_ocean_driver_init(CS, Time_init, Time_in) ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "ice_ocean_driver_init" ! This module's name. -! real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS. +! real :: Time_unit ! The time unit for ENERGYSAVEDAYS [s]. ! character(len=48) :: stagger type(param_file_type) :: param_file !< A structure to parse for run-time parameters integer :: unit, io, ierr, valid_param_files @@ -91,7 +98,7 @@ subroutine ice_ocean_driver_init(CS, Time_init, Time_in) valid_param_files = 0 do io=1,npf ; if (len_trim(trim(parameter_filename(io))) > 0) then call open_param_file(trim(parameter_filename(io)), param_file, & - component="Ice_Ocean_driver", doc_file_dir=output_dir) + component="CIOD", doc_file_dir=output_dir) valid_param_files = valid_param_files + 1 endif ; enddo if (valid_param_files == 0) call MOM_error(FATAL, "There must be at least "//& @@ -104,6 +111,13 @@ subroutine ice_ocean_driver_init(CS, Time_init, Time_in) "If true, advance the state of MOM with a single step \n"//& "including both dynamics and thermodynamics. If false, \n"//& "the two phases are advanced with separate calls.", default=.true.) + call get_param(param_file, mdl, "INTERSPERSE_ICE_OCEAN", CS%intersperse_ice_ocn, & + "If true, intersperse the ice and ocean thermodynamic and \n"//& + "and dynamic updates.", default=.false.) + call get_param(param_file, mdl, "DT_COUPLED_ICE_OCEAN_DYN", CS%dt_coupled_dyn, & + "The time step for coupling the ice and ocean dynamics when \n"//& + "INTERSPERSE_ICE_OCEAN is true, or <0 to use the coupled timestep.", & + units="seconds", default=-1.0, do_not_log=.not.CS%intersperse_ice_ocn) ! OS%is_ocean_pe = Ocean_sfc%is_ocean_pe ! if (.not.OS%is_ocean_pe) return @@ -121,7 +135,7 @@ end subroutine ice_ocean_driver_init !> The subroutine update_slow_ice_and_ocean uses the forcing already stored in !! the ice_data_type to advance both the sea-ice (and icebergs) and ocean states !! for a time interval coupling_time_step. -subroutine update_slow_ice_and_ocean(CS, Ice, Ocn, Ocean_sfc, Ice_ocean_boundary, & +subroutine update_slow_ice_and_ocean(CS, Ice, Ocn, Ocean_sfc, IOB, & time_start_update, coupling_time_step) type(ice_ocean_driver_type), & pointer :: CS !< The control structure for this driver @@ -129,17 +143,22 @@ subroutine update_slow_ice_and_ocean(CS, Ice, Ocn, Ocean_sfc, Ice_ocean_boundary type(ocean_state_type), pointer :: Ocn !< The internal ocean state and control structures type(ocean_public_type), intent(inout) :: Ocean_sfc !< The publicly visible ocean surface state type type(ice_ocean_boundary_type), & - intent(inout) :: Ice_ocean_boundary !< A structure containing the various forcing - !! fields going from the ice to the ocean - !! The arrays of this type are intent out. + intent(inout) :: IOB !< A structure containing the various forcing + !! fields going from the ice to the ocean + !! The arrays of this type are intent out; they are + !! used externally for stocks and other diagnostics. type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step type(time_type), intent(in) :: coupling_time_step !< The amount of time over which to advance !! the ocean and ice - real :: time_step ! The time step of a call to step_MOM in seconds. + ! Local variables + type(time_type) :: time_start_step ! The start time within an iterative update cycle. + real :: dt_coupling ! The time step of the thermodynamic update calls [s]. + type(time_type) :: dyn_time_step ! The length of the dynamic call update calls. + integer :: ns, nstep call callTree_enter("update_ice_and_ocean(), combined_ice_ocean_driver.F90") - time_step = time_type_to_real(coupling_time_step) + dt_coupling = time_type_to_real(coupling_time_step) ! if (time_start_update /= CS%Time) then ! call MOM_error(WARNING, "update_ice_and_ocean: internal clock does not "//& @@ -165,30 +184,59 @@ subroutine update_slow_ice_and_ocean(CS, Ice, Ocn, Ocean_sfc, Ice_ocean_boundary "ocean and slow ice layouts and domain sizes are identical.") !### Add clocks of the various calls. + if (CS%intersperse_ice_ocn) then + ! First step the ice, then ocean thermodynamics. + call update_ice_slow_thermo(Ice) + + call direct_flux_ice_to_IOB(time_start_update, Ice, IOB, do_thermo=.true.) + + call update_ocean_model(IOB, Ocn, Ocean_sfc, time_start_update, coupling_time_step, & + update_dyn=.false., update_thermo=.true., & + start_cycle=.true., end_cycle=.false., cycle_length=dt_coupling) + + ! Now step the ice and ocean dynamics. This part can have multiple shorter-cycle iterations + ! and the fastest parts of these updates of the ice and ocean could eventually be fused. + nstep = 1 + if ((CS%dt_coupled_dyn > 0.0) .and. (CS%dt_coupled_dyn < dt_coupling))& + nstep = max(CEILING(dt_coupling/CS%dt_coupled_dyn - 1e-6), 1) + dyn_time_step = real_to_time_type(dt_coupling / real(nstep)) + time_start_step = time_start_update + do ns=1,nstep + if (ns==nstep) then ! Adjust the dyn_time_step to cover uneven fractions of a tick or second. + dyn_time_step = coupling_time_step - (time_start_step - time_start_update) + endif + + call update_ice_dynamics_trans(Ice, time_step=dyn_time_step, & + start_cycle=(ns==1), end_cycle=(ns==nstep), cycle_length=dt_coupling) + + call direct_flux_ice_to_IOB(time_start_step, Ice, IOB, do_thermo=.false.) + + call update_ocean_model(IOB, Ocn, Ocean_sfc, time_start_step, dyn_time_step, & + update_dyn=.true., update_thermo=.false., & + start_cycle=.false., end_cycle=(ns==nstep), cycle_length=dt_coupling) + time_start_step = time_start_step + dyn_time_step + enddo + else + call update_ice_slow_thermo(Ice) - call update_ice_slow_thermo(Ice) - - call update_ice_dynamics_trans(Ice) + call update_ice_dynamics_trans(Ice) ! call mpp_clock_begin(fluxIceOceanClock) - call direct_flux_ice_to_IOB( time_start_update, Ice, Ice_ocean_boundary ) + call direct_flux_ice_to_IOB(time_start_update, Ice, IOB) ! call mpp_clock_end(fluxIceOceanClock) - if (CS%single_MOM_call) then - call update_ocean_model(Ice_ocean_boundary, Ocn, Ocean_sfc, & - time_start_update, coupling_time_step ) - else - !### This is here as a temporary measure to avoid using newer arguments - !### to update_ocean_model. - call update_ocean_model(Ice_ocean_boundary, Ocn, Ocean_sfc, & - time_start_update, coupling_time_step ) -!### This pair of calls works properly with MOM6 in place of the single call above. -! call update_ocean_model(Ice_ocean_boundary, Ocn, Ocean_sfc, time_start_update, & -! coupling_time_step, update_dyn=.true., update_thermo=.false., & -! start_cycle=.true., end_cycle=.false., cycle_length=time_step) -! call update_ocean_model(Ice_ocean_boundary, Ocn, Ocean_sfc, time_start_update, & -! coupling_time_step, update_dyn=.false., update_thermo=.true., & -! start_cycle=.false., end_cycle=.true., cycle_length=time_step) + if (CS%single_MOM_call) then + call update_ocean_model(IOB, Ocn, Ocean_sfc, time_start_update, coupling_time_step ) + else + !### This line could be a temporary measure to avoid using newer arguments to update_ocean_model. + ! call update_ocean_model(IOB, Ocn, Ocean_sfc, time_start_update, coupling_time_step ) + call update_ocean_model(IOB, Ocn, Ocean_sfc, time_start_update, coupling_time_step, & + update_dyn=.true., update_thermo=.false., & + start_cycle=.true., end_cycle=.false., cycle_length=dt_coupling) + call update_ocean_model(IOB, Ocn, Ocean_sfc, time_start_update, coupling_time_step, & + update_dyn=.false., update_thermo=.true., & + start_cycle=.false., end_cycle=.true., cycle_length=dt_coupling) + endif endif call callTree_leave("update_ice_and_ocean()") @@ -219,61 +267,71 @@ end function same_domain !> This subroutine does a direct copy of the fluxes from the ice data type into !! a ice-ocean boundary type on the same grid. -subroutine direct_flux_ice_to_IOB( Time, Ice, IOB ) +subroutine direct_flux_ice_to_IOB(Time, Ice, IOB, do_thermo) type(time_type), intent(in) :: Time !< Current time type(ice_data_type),intent(in) :: Ice !< A derived data type to specify ice boundary data type(ice_ocean_boundary_type), & - intent(inout) :: IOB !< A derived data type to specify - !! properties and fluxes passed from ice to ocean + intent(inout) :: IOB !< A derived data type to specify properties + !! and fluxes passed from ice to ocean + logical, optional, intent(in) :: do_thermo !< If present and false, do not update the + !! thermodynamic or tracer fluxes. integer :: i, j, is, ie, js, je, i_off, j_off, n, m - logical :: used + logical :: used, do_therm + + do_therm = .true. ; if (present(do_thermo)) do_therm = do_thermo ! Do a direct copy of the ice surface fluxes into the Ice-ocean-boundary type. + ! It is inefficient, but there is not a problem if fields are copied more than once. if (ASSOCIATED(IOB%u_flux)) IOB%u_flux(:,:) = Ice%flux_u(:,:) if (ASSOCIATED(IOB%v_flux)) IOB%v_flux(:,:) = Ice%flux_v(:,:) if (ASSOCIATED(IOB%p )) IOB%p(:,:) = Ice%p_surf(:,:) if (ASSOCIATED(IOB%mi )) IOB%mi(:,:) = Ice%mi(:,:) - if (ASSOCIATED(IOB%t_flux)) IOB%t_flux(:,:) = Ice%flux_t(:,:) - if (ASSOCIATED(IOB%salt_flux)) IOB%salt_flux(:,:) = Ice%flux_salt(:,:) - if (ASSOCIATED(IOB%sw_flux_nir_dir)) IOB%sw_flux_nir_dir(:,:) = Ice%flux_sw_nir_dir(:,:) - if (ASSOCIATED(IOB%sw_flux_nir_dif)) IOB%sw_flux_nir_dif (:,:) = Ice%flux_sw_nir_dif (:,:) - if (ASSOCIATED(IOB%sw_flux_vis_dir)) IOB%sw_flux_vis_dir(:,:) = Ice%flux_sw_vis_dir(:,:) - if (ASSOCIATED(IOB%sw_flux_vis_dif)) IOB%sw_flux_vis_dif (:,:) = Ice%flux_sw_vis_dif (:,:) - if (ASSOCIATED(IOB%lw_flux)) IOB%lw_flux(:,:) = Ice%flux_lw(:,:) - if (ASSOCIATED(IOB%lprec)) IOB%lprec(:,:) = Ice%lprec(:,:) - if (ASSOCIATED(IOB%fprec)) IOB%fprec(:,:) = Ice%fprec(:,:) - if (ASSOCIATED(IOB%runoff)) IOB%runoff(:,:) = Ice%runoff(:,:) - if (ASSOCIATED(IOB%calving)) IOB%calving(:,:) = Ice%calving if (ASSOCIATED(IOB%stress_mag)) IOB%stress_mag(:,:) = Ice%stress_mag(:,:) if (ASSOCIATED(IOB%ustar_berg)) IOB%ustar_berg(:,:) = Ice%ustar_berg(:,:) if (ASSOCIATED(IOB%area_berg)) IOB%area_berg(:,:) = Ice%area_berg(:,:) if (ASSOCIATED(IOB%mass_berg)) IOB%mass_berg(:,:) = Ice%mass_berg(:,:) - if (ASSOCIATED(IOB%runoff_hflx)) IOB%runoff_hflx(:,:) = Ice%runoff_hflx(:,:) - if (ASSOCIATED(IOB%calving_hflx)) IOB%calving_hflx(:,:) = Ice%calving_hflx(:,:) - if (ASSOCIATED(IOB%q_flux)) IOB%q_flux(:,:) = Ice%flux_q(:,:) - ! Extra fluxes - call coupler_type_copy_data(Ice%ocean_fluxes, IOB%fluxes) + if (do_therm) then + if (ASSOCIATED(IOB%t_flux)) IOB%t_flux(:,:) = Ice%flux_t(:,:) + if (ASSOCIATED(IOB%salt_flux)) IOB%salt_flux(:,:) = Ice%flux_salt(:,:) + if (ASSOCIATED(IOB%sw_flux_nir_dir)) IOB%sw_flux_nir_dir(:,:) = Ice%flux_sw_nir_dir(:,:) + if (ASSOCIATED(IOB%sw_flux_nir_dif)) IOB%sw_flux_nir_dif (:,:) = Ice%flux_sw_nir_dif (:,:) + if (ASSOCIATED(IOB%sw_flux_vis_dir)) IOB%sw_flux_vis_dir(:,:) = Ice%flux_sw_vis_dir(:,:) + if (ASSOCIATED(IOB%sw_flux_vis_dif)) IOB%sw_flux_vis_dif (:,:) = Ice%flux_sw_vis_dif (:,:) + if (ASSOCIATED(IOB%lw_flux)) IOB%lw_flux(:,:) = Ice%flux_lw(:,:) + if (ASSOCIATED(IOB%lprec)) IOB%lprec(:,:) = Ice%lprec(:,:) + if (ASSOCIATED(IOB%fprec)) IOB%fprec(:,:) = Ice%fprec(:,:) + if (ASSOCIATED(IOB%runoff)) IOB%runoff(:,:) = Ice%runoff(:,:) + if (ASSOCIATED(IOB%calving)) IOB%calving(:,:) = Ice%calving + if (ASSOCIATED(IOB%runoff_hflx)) IOB%runoff_hflx(:,:) = Ice%runoff_hflx(:,:) + if (ASSOCIATED(IOB%calving_hflx)) IOB%calving_hflx(:,:) = Ice%calving_hflx(:,:) + if (ASSOCIATED(IOB%q_flux)) IOB%q_flux(:,:) = Ice%flux_q(:,:) + + ! Extra fluxes + call coupler_type_copy_data(Ice%ocean_fluxes, IOB%fluxes) + endif ! These lines allow the data override code to reset the fluxes to the ocean. call data_override('OCN', 'u_flux', IOB%u_flux , Time ) call data_override('OCN', 'v_flux', IOB%v_flux , Time) - call data_override('OCN', 't_flux', IOB%t_flux , Time) - call data_override('OCN', 'q_flux', IOB%q_flux , Time) - call data_override('OCN', 'salt_flux', IOB%salt_flux, Time) - call data_override('OCN', 'lw_flux', IOB%lw_flux , Time) - call data_override('OCN', 'sw_flux_nir_dir', IOB%sw_flux_nir_dir, Time) - call data_override('OCN', 'sw_flux_nir_dif', IOB%sw_flux_nir_dif, Time) - call data_override('OCN', 'sw_flux_vis_dir', IOB%sw_flux_vis_dir, Time) - call data_override('OCN', 'sw_flux_vis_dif', IOB%sw_flux_vis_dif, Time) - call data_override('OCN', 'lprec', IOB%lprec , Time) - call data_override('OCN', 'fprec', IOB%fprec , Time) - call data_override('OCN', 'runoff', IOB%runoff , Time) - call data_override('OCN', 'calving', IOB%calving , Time) - call data_override('OCN', 'runoff_hflx', IOB%runoff_hflx , Time) - call data_override('OCN', 'calving_hflx', IOB%calving_hflx , Time) + if (do_therm) then + call data_override('OCN', 't_flux', IOB%t_flux , Time) + call data_override('OCN', 'q_flux', IOB%q_flux , Time) + call data_override('OCN', 'salt_flux', IOB%salt_flux, Time) + call data_override('OCN', 'lw_flux', IOB%lw_flux , Time) + call data_override('OCN', 'sw_flux_nir_dir', IOB%sw_flux_nir_dir, Time) + call data_override('OCN', 'sw_flux_nir_dif', IOB%sw_flux_nir_dif, Time) + call data_override('OCN', 'sw_flux_vis_dir', IOB%sw_flux_vis_dir, Time) + call data_override('OCN', 'sw_flux_vis_dif', IOB%sw_flux_vis_dif, Time) + call data_override('OCN', 'lprec', IOB%lprec , Time) + call data_override('OCN', 'fprec', IOB%fprec , Time) + call data_override('OCN', 'runoff', IOB%runoff , Time) + call data_override('OCN', 'calving', IOB%calving , Time) + call data_override('OCN', 'runoff_hflx', IOB%runoff_hflx , Time) + call data_override('OCN', 'calving_hflx', IOB%calving_hflx , Time) + endif call data_override('OCN', 'p', IOB%p , Time) call data_override('OCN', 'mi', IOB%mi , Time) if (ASSOCIATED(IOB%stress_mag) ) & @@ -287,9 +345,11 @@ subroutine direct_flux_ice_to_IOB( Time, Ice, IOB ) call data_override('OCN', 'mass_berg', IOB%mass_berg , Time) ! Override and output extra fluxes of tracers or gasses - call coupler_type_data_override('OCN', IOB%fluxes, Time ) - - call coupler_type_send_data(IOB%fluxes, Time ) + if (do_therm) then + call coupler_type_data_override('OCN', IOB%fluxes, Time ) + ! Offer the extra fluxes for diagnostics. (###Why is this here, unlike other fluxes?) + call coupler_type_send_data(IOB%fluxes, Time ) + endif end subroutine direct_flux_ice_to_IOB diff --git a/src/ice_age_tracer.F90 b/src/ice_age_tracer.F90 index 76f87043..df256100 100644 --- a/src/ice_age_tracer.F90 +++ b/src/ice_age_tracer.F90 @@ -50,11 +50,11 @@ module ice_age_tracer ! can be found, or an empty string for internal initialization. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(SIS_tracer_registry_type), pointer :: TrReg => NULL() !< A pointer to the tracer registry - real, pointer :: tr(:,:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? - real, pointer :: tr_aux(:,:,:,:,:) => NULL() !< The masked tracer concentration for output, in g m-3. + real, pointer :: tr(:,:,:,:,:) => NULL() !< The array of tracers used in this subroutine [g kg-1]. + real, pointer :: tr_aux(:,:,:,:,:) => NULL() !< The masked tracer concentration for output [g kg-1]. type(p3d), dimension(NTR_MAX) :: & - tr_adx, & !< Tracer zonal advective fluxes in g m-3 m3 s-1. - tr_ady !< Tracer meridional advective fluxes in g m-3 m3 s-1. + tr_adx, & !< Tracer zonal advective fluxes [g s-1]. + tr_ady !< Tracer meridional advective fluxes [g s-1]. real, pointer :: ocean_BC(:,:,:,:)=>NULL() !< Ocean boundary value of the tracer by category real, pointer :: snow_BC(:,:,:,:)=>NULL() !< Snow boundary value of the tracer by category @@ -64,7 +64,7 @@ module ice_age_tracer young_val = 0.0, & !< The value assigned to tr at the surface. land_val = -1.0 !< The value of tr used where land is masked out. real, dimension(NTR_MAX) :: tracer_start_year = 0.0 !< The year in which tracers start aging, or at which the - !! surface value equals young_val, in years. + !! surface value equals young_val [year]. logical :: mask_tracers !< If true, tracers are masked out in massless layers. logical :: tracers_may_reinit !< If true, tracers may go through the initialization code !! if they are not found in the restart files. @@ -285,16 +285,16 @@ end subroutine initialize_ice_age_tracer !> Change the ice age tracers due to ice column physics like melting and freezing subroutine ice_age_tracer_column_physics(dt, G, IG, CS, mi, mi_old) - real, intent(in) :: dt !< The amount of time covered by this call, in s. + real, intent(in) :: dt !< The amount of time covered by this call [s]. 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_age_tracer_CS), pointer :: CS !< The control structure returned by a !! previous call to register_ideal_age_tracer. real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mi !< Mass of ice in a given category in kg m-2 at the + intent(in) :: mi !< Mass of ice in a given category [kg m-2] at the !! end of the timestep real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mi_old !< Mass of ice in a given category in kg m-2 at the + intent(in) :: mi_old !< Mass of ice in a given category [kg m-2] at the !! beginning of the timestep ! Local variables @@ -302,7 +302,7 @@ subroutine ice_age_tracer_column_physics(dt, G, IG, CS, mi, mi_old) real :: year ! The time in years. real :: dt_year ! Timestep in units of years real :: min_age ! Minimum age of ice to avoid being set to 0 - real :: mi_min ! Minimum mass in ice category + real :: mi_min ! Minimum mass in ice category [kg m-2] real :: max_age ! Maximum age at a grid point real, dimension(SZI_(G),SZJ_(G)) :: vertsum_mi, vertsum_mi_old real, dimension(SZI_(G),SZJ_(G),SZCAT_(IG)) :: tr_avg @@ -386,7 +386,7 @@ function ice_age_stock(mi, stocks, G, IG, CS, names, units) 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),SZJ_(G),SZCAT_(IG)), & - intent(in) :: mi !< Mass of ice in a given category in kg m-2, used for summing + intent(in) :: mi !< Mass of ice in a given category [kg m-2], used for summing type(ice_age_tracer_CS), pointer :: CS !< The control structure returned by a !! previous call to register_ideal_age_tracer. character(len=*), dimension(:), intent(out) :: names !< The names of the summed tracer stocks. diff --git a/src/ice_boundary_types.F90 b/src/ice_boundary_types.F90 index 05df3cc1..9ad4eb52 100644 --- a/src/ice_boundary_types.F90 +++ b/src/ice_boundary_types.F90 @@ -28,14 +28,14 @@ module ice_boundary_types type ocean_ice_boundary_type real, dimension(:,:), pointer :: & u => NULL(), & !< The x-direction ocean velocity at a position - !! determined by stagger, in m s-1. + !! determined by stagger [m s-1]. v => NULL(), & !< The y-direction ocean velocity at a position - !! determined by stagger, in m s-1. - t => NULL(), & !< The ocean's surface temperature in Kelvin. - s => NULL(), & !< The ocean's surface temperature in g/kg. - frazil => NULL(), & !< The frazil heat rejected by the ocean, in J m-2. + !! determined by stagger [m s-1]. + t => NULL(), & !< The ocean's surface temperature [Kelvin]. + s => NULL(), & !< The ocean's surface salinity [gSalt kg-1]. + frazil => NULL(), & !< The frazil heat rejected by the ocean [J m-2]. sea_level => NULL() !< The sea level after adjustment for any surface - !! pressure that the ocean allows to be expressed, in m. + !! pressure that the ocean allows to be expressed [m]. real, dimension(:,:,:), pointer :: data =>NULL() !< S collective field for "named" fields above integer :: stagger = BGRID_NE !< A flag indicating how the velocities are staggered. integer :: xtype !< A flag indicating the exchange type, which may be set to @@ -48,47 +48,47 @@ module ice_boundary_types real, dimension(:,:,:), pointer :: & u_flux => NULL(), & !< The true-eastward stresses (momentum fluxes) from the atmosphere !! to the ocean or ice in each category, discretized on an A-grid, - !! and _not_ rotated to align with the model grid, in Pa. + !! and _not_ rotated to align with the model grid [Pa]. v_flux => NULL(), & !< The true-northward stresses (momentum fluxes) from the atmosphere !! to the ocean or ice in each category, discretized on an A-grid, - !! and _not_ rotated to align with the model grid, in Pa. - u_star => NULL(), & !< The atmospheric friction velocity on an A-grid, in Pa. + !! and _not_ rotated to align with the model grid [Pa]. + u_star => NULL(), & !< The atmospheric friction velocity on an A-grid [Pa]. t_flux => NULL(), & !< The net sensible heat flux flux from the ocean or ice into the - !! atmosphere at the surface, in W m-2. + !! atmosphere at the surface [W m-2]. q_flux => NULL(), & !< The flux of moisture from the ice or ocean to the - !! atmosphere due to evaporation or sublimation, in kg m-2 s-1. + !! atmosphere due to evaporation or sublimation [kg m-2 s-1]. lw_flux => NULL(), & !< The net flux of longwave radiation from the atmosphere into the - !! ice or ocean, in W m-2. + !! ice or ocean [W m-2]. !! sw_flux_tot_down => NULL(), & !< The total downward flux of shortwave radiation - !! !! at the surface of the ice or ocean, in W m-2. + !! !! at the surface of the ice or ocean [W m-2]. sw_flux_vis_dir => NULL(), & !< The visible (_vis) or near-infrared (_nir), sw_flux_vis_dif => NULL(), & !< direct (_dir) or diffuse (_dif) net shortwave sw_flux_nir_dir => NULL(), & !< radiation fluxes from the atmosphere into - sw_flux_nir_dif => NULL(), & !< the ice or ocean, in W m-2. + sw_flux_nir_dif => NULL(), & !< the ice or ocean [W m-2]. sw_down_vis_dir => NULL(), & !< The visible (_vis) or near-infrared (_nir), sw_down_vis_dif => NULL(), & !< direct (_dir) or diffuse (_dif) downward sw_down_nir_dir => NULL(), & !< shortwave radiation fluxes from the atmosphere - sw_down_nir_dif => NULL(), & !< into the ice or ocean, in W m-2. + sw_down_nir_dif => NULL(), & !< into the ice or ocean [W m-2]. lprec => NULL(), & !< The liquid precipitation from the atmosphere onto the - !! atmosphere or ice in each thickness category, in kg m-2 s-1. + !! atmosphere or ice in each thickness category [kg m-2 s-1]. !! Rain falling on snow is currently assumed to pass or drain !! directly through the ice into the ocean; this should be !! revisited! fprec => NULL(), & !< The frozen precipitation (snowfall) from the atmosphere - !! to the ice or ocean, in kg m-2 s-1. Currently in SIS2 + !! to the ice or ocean [kg m-2 s-1]. Currently in SIS2 !! all frozen precipitation, including snow, sleet, hail !! and graupel, are all treated as snow. dhdt => NULL(), & !< The derivative of the upward sensible heat flux with the - !! surface temperature in W m-2 K-1. + !! surface temperature [W m-2 degC-1]. dedt => NULL(), & !< The derivative of the sublimation and evaporation rate - !! with the surface temperature, in kg m-2 s-1 K-1. + !! with the surface temperature [kg m-2 s-1 degC-1]. drdt => NULL(), & !< The derivative of the net UPWARD longwave radiative - !! heat flux (-lw_flux) with surface temperature, in W m-2 K-1. + !! heat flux (-lw_flux) with surface temperature [W m-2 degC-1]. coszen => NULL(), & !< The cosine of the solar zenith angle averged over the !! next radiation timestep (not the one that was used to !! calculate the sw_flux fields), nondim and <=1. - p => NULL() !< The atmospheric surface pressure, in Pa, often ~1e5 Pa. + p => NULL() !< The atmospheric surface pressure [Pa], often ~1e5 Pa. ! data => NULL() ! This can probably be removed. integer :: xtype !< A flag indicating the exchange type, which may be set to !! REGRID, REDIST or DIRECT and isused by coupler @@ -98,17 +98,16 @@ module ice_boundary_types !> A type for exchange between the land and the sea ice type land_ice_boundary_type real, dimension(:,:), pointer :: & - runoff =>NULL(), & !< The liquid runoff into the ocean, in kg m-2. + runoff =>NULL(), & !< The liquid runoff into the ocean [kg m-2]. calving =>NULL(), & !< The frozen runoff into each cell, that is offered !! first to the icebergs (if any), where it might be - !! used or modified before being passed to the ocean, - !! in kg m-2. + !! used or modified before being passed to the ocean [kg m-2]. runoff_hflx =>NULL(), & !< The heat flux associated with the temperature of !! of the liquid runoff, relative to liquid water - !! at 0 deg C, in W m-2. + !! at 0 degC [W m-2]. calving_hflx =>NULL() !< The heat flux associated with the temperature of !! of the frozen runoff, relative to liquid? (or frozen?) water - !! at 0 deg C, in W m-2. + !! at 0 degC [W m-2]. real, dimension(:,:,:), pointer :: data => NULL() !< A collective field for "named" fields above integer :: xtype !< A flag indicating the exchange type, which may be set to !! REGRID, REDIST or DIRECT and isused by coupler diff --git a/src/ice_grid.F90 b/src/ice_grid.F90 index 04005932..73d7e359 100644 --- a/src/ice_grid.F90 +++ b/src/ice_grid.F90 @@ -30,14 +30,14 @@ module ice_grid !! the internal units of thickness. real :: H_subroundoff !< A thickness that is so small that it can be added to !! any physically meaningful positive thickness without - !! changing it at the bit level, in thickness units. + !! changing it at the bit level [H ~> kg m-2]. real :: ocean_part_min !< The minimum value for the fractional open-ocean area. This can be 0, !! but for some purposes it may be useful to set this to a miniscule value !! (like 1e-40) that will be lost to roundoff during any sums so that the !! open ocean fluxes can be used in interpolation across categories. real, allocatable, dimension(:) :: & - cat_thick_lim, & !< The lower thickness limits for each ice category, in m. - mH_cat_bound !< The lower mass-per-unit area limits for each ice category, in units of H (often kg m-2). + cat_thick_lim, & !< The lower thickness limits for each ice category [m]. + mH_cat_bound !< The lower mass-per-unit area limits for each ice category [H ~> kg m-2]. end type ice_grid_type diff --git a/src/ice_model.F90 b/src/ice_model.F90 index 264b7a53..c4b65be1 100644 --- a/src/ice_model.F90 +++ b/src/ice_model.F90 @@ -97,7 +97,8 @@ module ice_model_mod use SIS_tracer_flow_control, only : SIS_call_tracer_register, SIS_tracer_flow_control_init use SIS_tracer_flow_control, only : SIS_tracer_flow_control_end -use SIS_dyn_trans, only : SIS_dynamics_trans, update_icebergs +use SIS_dyn_trans, only : SIS_dynamics_trans, SIS_multi_dyn_trans, update_icebergs +use SIS_dyn_trans, only : slab_ice_dyn_trans use SIS_dyn_trans, only : SIS_dyn_trans_register_restarts, SIS_dyn_trans_init, SIS_dyn_trans_end use SIS_dyn_trans, only : SIS_dyn_trans_read_alt_restarts, stresses_to_stress_mag use SIS_dyn_trans, only : SIS_dyn_trans_transport_CS, SIS_dyn_trans_sum_output_CS @@ -109,10 +110,12 @@ module ice_model_mod use SIS_fast_thermo, only : infill_array, SIS_fast_thermo_init, SIS_fast_thermo_end use SIS_optics, only : ice_optics_SIS2, SIS_optics_init, SIS_optics_end, SIS_optics_CS use SIS_optics, only : VIS_DIR, VIS_DIF, NIR_DIR, NIR_DIF -use SIS2_ice_thm, only : ice_temp_SIS2, SIS2_ice_thm_init, SIS2_ice_thm_end -use SIS2_ice_thm, only : ice_thermo_init, ice_thermo_end, get_SIS2_thermo_coefs -use SIS2_ice_thm, only : enth_from_TS, Temp_from_En_S, T_freeze, ice_thermo_type -use ice_bergs, only : icebergs, icebergs_run, icebergs_init, icebergs_end +use SIS2_ice_thm, only : ice_temp_SIS2, SIS2_ice_thm_init, SIS2_ice_thm_end +use SIS2_ice_thm, only : ice_thermo_init, ice_thermo_end, get_SIS2_thermo_coefs +use SIS2_ice_thm, only : enth_from_TS, Temp_from_En_S, T_freeze, ice_thermo_type +use specified_ice, only : specified_ice_dynamics, specified_ice_init, specified_ice_CS +use specified_ice, only : specified_ice_end, specified_ice_sum_output_CS +use ice_bergs, only : icebergs, icebergs_run, icebergs_init, icebergs_end implicit none ; private @@ -121,7 +124,6 @@ module ice_model_mod public :: ice_data_type, ocean_ice_boundary_type, atmos_ice_boundary_type, land_ice_boundary_type public :: ice_model_init, share_ice_domains, ice_model_end, ice_stock_pe public :: update_ice_model_fast -public :: update_ice_model_slow_up, update_ice_model_slow_dn ! The old Verona interfaces. public :: ice_model_restart ! for intermediate restarts public :: ocn_ice_bnd_type_chksum, atm_ice_bnd_type_chksum public :: lnd_ice_bnd_type_chksum, ice_data_type_chksum @@ -141,40 +143,6 @@ module ice_model_mod contains -!----------------------------------------------------------------------- -!> Update the sea-ice state due to slow processes, including dynamics, -!! freezing and melting, precipitation, and transport. -subroutine update_ice_model_slow_dn ( Atmos_boundary, Land_boundary, Ice ) - type(atmos_ice_boundary_type), & - intent(in) :: Atmos_boundary !< Atmos_boundary is not actually used, and - !! is still here only for backward compatibilty with the - !! interface to Verona and earlier couplers. - type(land_ice_boundary_type), & - intent(in) :: Land_boundary !< A structure containing information about - !! the fluxes from the land that is being shared with the - !! sea-ice. If this argument is not present, it is assumed - !! that this information has already been exchanged. - type(ice_data_type), & - intent(inout) :: Ice !< The publicly visible ice data type; this must always be - !! present, but is optional because of an unfortunate - !! order of arguments. - - if (.not.associated(Ice%sCS)) call SIS_error(FATAL, & - "The pointer to Ice%sCS must be associated in update_ice_model_slow_dn.") - - call mpp_clock_begin(iceClock) ; call mpp_clock_begin(ice_clock_slow) - - call ice_model_fast_cleanup(Ice) - - call unpack_land_ice_boundary(Ice, Land_boundary) - - call exchange_fast_to_slow_ice(Ice) - - call mpp_clock_end(ice_clock_slow) ; call mpp_clock_end(iceClock) - - call update_ice_model_slow(Ice) - -end subroutine update_ice_model_slow_dn !----------------------------------------------------------------------- !> Update the sea-ice state due to slow processes, including dynamics, @@ -234,12 +202,10 @@ subroutine update_ice_slow_thermo(Ice) enddo ; enddo if (Ice%sCS%redo_fast_update) then - call redo_update_ice_model_fast(sIST, Ice%sCS%sOSS, Ice%sCS%Rad, & - FIA, Ice%sCS%TSF, Ice%sCS%optics_CSp, Ice%sCS%Time_step_slow, & - Ice%sCS%fast_thermo_CSp, sG, sIG) + call redo_update_ice_model_fast(sIST, Ice%sCS%sOSS, Ice%sCS%Rad, FIA, Ice%sCS%TSF, & + Ice%sCS%optics_CSp, Ice%sCS%Time_step_slow, Ice%sCS%fast_thermo_CSp, sG, sIG) - call find_excess_fluxes(FIA, Ice%sCS%TSF, Ice%sCS%XSF, sIST%part_size, & - sG, sIG) + call find_excess_fluxes(FIA, Ice%sCS%TSF, Ice%sCS%XSF, sIST%part_size, sG, sIG) endif call convert_frost_to_snow(FIA, sG, sIG) @@ -272,17 +238,15 @@ subroutine update_ice_slow_thermo(Ice) call IOF_chksum("Before slow_thermodynamics", Ice%sCS%IOF, sG) endif - call slow_thermodynamics(sIST, dt_slow, Ice%sCS%slow_thermo_CSp, & - Ice%sCS%OSS, FIA, Ice%sCS%XSF, Ice%sCS%IOF, & - sG, sIG) + call slow_thermodynamics(sIST, dt_slow, Ice%sCS%slow_thermo_CSp, Ice%sCS%OSS, FIA, & + Ice%sCS%XSF, Ice%sCS%IOF, sG, 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 IST_chksum("Before set_ocean_top_fluxes", sIST, sG, 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) + call set_ocean_top_fluxes(Ice, sIST, Ice%sCS%IOF, FIA, Ice%sCS%OSS, sG, sIG, Ice%sCS) call mpp_clock_end(ice_clock_slow) ; call mpp_clock_end(iceClock) @@ -290,8 +254,16 @@ end subroutine update_ice_slow_thermo !----------------------------------------------------------------------- !> Update the sea-ice state due to dynamics and ice transport. -subroutine update_ice_dynamics_trans(Ice) - type(ice_data_type), intent(inout) :: Ice !< The publicly visible ice data type. +subroutine update_ice_dynamics_trans(Ice, time_step, start_cycle, end_cycle, cycle_length) + type(ice_data_type), intent(inout) :: Ice !< The publicly visible ice data type. + type(time_type), optional, intent(in) :: time_step !< The amount of time to cover in this update. + logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be + !! treated as the first call to update_ice_dynamics_trans + !! in a time-stepping cycle; missing is like true. + logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be + !! treated as the last call to update_ice_dynamics_trans + !! in a time-stepping cycle; missing is like true. + real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle [s]. ! These pointers are used to simplify the code below. type(ice_grid_type), pointer :: sIG => NULL() @@ -299,40 +271,60 @@ subroutine update_ice_dynamics_trans(Ice) type(ice_state_type), pointer :: sIST => NULL() type(fast_ice_avg_type), pointer :: FIA => 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 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 call mpp_clock_begin(iceClock) ; call mpp_clock_begin(ice_clock_slow) ! Do halo updates on the forcing fields, as necessary. This must occur before ! the call to SIS_dynamics_trans, because update_icebergs does its own halo ! updates, and slow_thermodynamics only works on the computational domain. - call pass_vector(FIA%WindStr_x, FIA%WindStr_y, & - sG%Domain, stagger=AGRID, complete=.false.) - call pass_vector(FIA%WindStr_ocn_x, FIA%WindStr_ocn_y, & - sG%Domain, stagger=AGRID) - call pass_var(FIA%ice_cover, sG%Domain, complete=.false.) - call pass_var(FIA%ice_free, sG%Domain, complete=.true.) - call pass_var(sIST%part_size, sG%Domain) - call pass_var(sIST%mH_ice, sG%Domain, complete=.false.) - call pass_var(sIST%mH_pond, sG%Domain, complete=.false.) - call pass_var(sIST%mH_snow, sG%Domain, complete=.true.) + if (cycle_start) then + call pass_vector(FIA%WindStr_x, FIA%WindStr_y, sG%Domain, stagger=AGRID, complete=.false.) + call pass_vector(FIA%WindStr_ocn_x, FIA%WindStr_ocn_y, sG%Domain, stagger=AGRID) + call pass_var(FIA%ice_cover, sG%Domain, complete=.false.) + call pass_var(FIA%ice_free, sG%Domain, complete=.true.) + endif + if (sIST%valid_IST) then + call pass_var(sIST%part_size, sG%Domain) + call pass_var(sIST%mH_ice, sG%Domain, complete=.false.) + call pass_var(sIST%mH_pond, sG%Domain, complete=.false.) + call pass_var(sIST%mH_snow, sG%Domain, complete=.true.) + endif 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) endif - 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) + do_multi_trans = (present(start_cycle) .or. present(end_cycle) .or. present(cycle_length)) + + 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) + 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, & + 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) + 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) + endif ! Set up the stresses and surface pressure in the externally visible structure Ice. - call set_ocean_top_dyn_fluxes(Ice, sIST, Ice%sCS%IOF, FIA, sG, sIG, Ice%sCS) + 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) if (Ice%sCS%debug) then call Ice_public_type_chksum("End update_ice_dynamics_trans", Ice, check_slow=.true.) @@ -360,16 +352,13 @@ subroutine ice_model_fast_cleanup(Ice) "The pointer to Ice%fCS must be associated in ice_model_fast_cleanup.") ! average fluxes from update_ice_model_fast - call avg_top_quantities(Ice%fCS%FIA, Ice%fCS%Rad, Ice%fCS%IST, & - Ice%fCS%G, Ice%fCS%IG) + call avg_top_quantities(Ice%fCS%FIA, Ice%fCS%Rad, Ice%fCS%IST, Ice%fCS%G, Ice%fCS%IG) - call total_top_quantities(Ice%fCS%FIA, Ice%fCS%TSF, Ice%fCS%IST%part_size, & - Ice%fCS%G, Ice%fCS%IG) + call total_top_quantities(Ice%fCS%FIA, Ice%fCS%TSF, Ice%fCS%IST%part_size, Ice%fCS%G, Ice%fCS%IG) if (allocated(Ice%fCS%IST%t_surf)) & Ice%fCS%IST%t_surf(:,:,1:) = Ice%fCS%Rad%T_skin(:,:,:) + T_0degC - call infill_array(Ice%fCS%IST, Ice%fCS%sOSS%T_fr_ocn, Ice%fCS%Rad%T_skin, & - Ice%fCS%G, Ice%fCS%IG) + call infill_array(Ice%fCS%IST, Ice%fCS%sOSS%T_fr_ocn, Ice%fCS%Rad%T_skin, Ice%fCS%G, Ice%fCS%IG) end subroutine ice_model_fast_cleanup @@ -476,20 +465,17 @@ subroutine exchange_fast_to_slow_ice(Ice) "associated (although perhaps not with each other) in exchange_fast_to_slow_ice.") if (.not.associated(Ice%fCS%FIA, Ice%sCS%FIA)) then - call copy_FIA_to_FIA(Ice%fCS%FIA, Ice%sCS%FIA, Ice%fCS%G%HI, Ice%sCS%G%HI, & - Ice%sCS%IG) + call copy_FIA_to_FIA(Ice%fCS%FIA, Ice%sCS%FIA, Ice%fCS%G%HI, Ice%sCS%G%HI, Ice%sCS%IG) endif if (redo_fast_update) then if (.not.associated(Ice%fCS%TSF, Ice%sCS%TSF)) & call copy_TSF_to_TSF(Ice%fCS%TSF, Ice%sCS%TSF, Ice%fCS%G%HI, Ice%sCS%G%HI) if (.not.associated(Ice%fCS%Rad, Ice%sCS%Rad)) & - call copy_Rad_to_Rad(Ice%fCS%Rad, Ice%sCS%Rad, Ice%fCS%G%HI, & - Ice%sCS%G%HI, Ice%fCS%IG) + call copy_Rad_to_Rad(Ice%fCS%Rad, Ice%sCS%Rad, Ice%fCS%G%HI, Ice%sCS%G%HI, Ice%fCS%IG) else if (.not.associated(Ice%fCS%IST, Ice%sCS%IST)) & - call copy_IST_to_IST(Ice%fCS%IST, Ice%sCS%IST, Ice%fCS%G%HI, Ice%sCS%G%HI, & - Ice%fCS%IG) + call copy_IST_to_IST(Ice%fCS%IST, Ice%sCS%IST, Ice%fCS%G%HI, Ice%sCS%G%HI, Ice%fCS%IG) endif elseif (Ice%xtype == REDIST) then if (.not.associated(Ice%fCS) .and. .not.associated(Ice%sCS)) call SIS_error(FATAL, & @@ -504,24 +490,18 @@ subroutine exchange_fast_to_slow_ice(Ice) if (redo_fast_update) then call redistribute_TSF_to_TSF(Ice%fCS%TSF, Ice%sCS%TSF, Ice%fast_domain, & Ice%slow_domain, Ice%sCS%G%HI) - call redistribute_Rad_to_Rad(Ice%fCS%Rad, Ice%sCS%Rad, Ice%fast_domain, & - Ice%slow_domain) + call redistribute_Rad_to_Rad(Ice%fCS%Rad, Ice%sCS%Rad, Ice%fast_domain, Ice%slow_domain) else if (.not.associated(Ice%fCS%IST, Ice%sCS%IST)) & - call redistribute_IST_to_IST(Ice%fCS%IST, Ice%sCS%IST, Ice%fast_domain, & - Ice%slow_domain) + call redistribute_IST_to_IST(Ice%fCS%IST, Ice%sCS%IST, Ice%fast_domain, Ice%slow_domain) endif elseif (associated(Ice%fCS)) then - call redistribute_FIA_to_FIA(Ice%fCS%FIA, FIA_null, Ice%fast_domain, & - Ice%slow_domain) + call redistribute_FIA_to_FIA(Ice%fCS%FIA, FIA_null, Ice%fast_domain, Ice%slow_domain) if (redo_fast_update) then - call redistribute_TSF_to_TSF(Ice%fCS%TSF, TSF_null, Ice%fast_domain, & - Ice%slow_domain) - call redistribute_Rad_to_Rad(Ice%fCS%Rad, Rad_null, Ice%fast_domain, & - Ice%slow_domain) + call redistribute_TSF_to_TSF(Ice%fCS%TSF, TSF_null, Ice%fast_domain, Ice%slow_domain) + call redistribute_Rad_to_Rad(Ice%fCS%Rad, Rad_null, Ice%fast_domain, Ice%slow_domain) else - call redistribute_IST_to_IST(Ice%fCS%IST, IST_null, Ice%fast_domain, & - Ice%slow_domain) + call redistribute_IST_to_IST(Ice%fCS%IST, IST_null, Ice%fast_domain, Ice%slow_domain) endif elseif (associated(Ice%sCS)) then call redistribute_FIA_to_FIA(FIA_null, Ice%sCS%FIA, Ice%fast_domain, & @@ -529,11 +509,9 @@ subroutine exchange_fast_to_slow_ice(Ice) if (redo_fast_update) then call redistribute_TSF_to_TSF(TSF_null, Ice%sCS%TSF, Ice%fast_domain, & Ice%slow_domain, Ice%sCS%G%HI) - call redistribute_Rad_to_Rad(Rad_null, Ice%sCS%Rad, Ice%fast_domain, & - Ice%slow_domain) + call redistribute_Rad_to_Rad(Rad_null, Ice%sCS%Rad, Ice%fast_domain, Ice%slow_domain) else - call redistribute_IST_to_IST(IST_null, Ice%sCS%IST, Ice%fast_domain, & - Ice%slow_domain) + call redistribute_IST_to_IST(IST_null, Ice%sCS%IST, Ice%fast_domain, Ice%slow_domain) endif else call SIS_error(FATAL, "Either the pointer to Ice%sCS or the pointer to "//& @@ -584,7 +562,7 @@ subroutine set_ocean_top_fluxes(Ice, IST, IOF, FIA, OSS, G, IG, sCS) ! do j=jsc,jec ; do k=1,ncat ; do i=isc,iec ! i2 = i+i_off ; j2 = j+j_off! Use these to correct for indexing differences. ! Ice%mi(i2,j2) = Ice%mi(i2,j2) + IST%part_size(i,j,k) * & -! (IG%H_to_kg_m2 * (IST%mH_snow(i,j,k) + IST%mH_ice(i,j,k))) +! (IG%H_to_kg_m2 * ((IST%mH_snow(i,j,k) + IST%mH_pond(i,j,k)) + IST%mH_ice(i,j,k))) ! enddo ; enddo ; enddo ! This block of code is probably unneccessary. @@ -620,7 +598,7 @@ subroutine set_ocean_top_fluxes(Ice, IST, IOF, FIA, OSS, G, IG, sCS) ! It is possible that the ice mass and surface pressure will be needed after ! the themodynamic step, in which case this should be uncommented. ! if (IOF%slp2ocean) then -! Ice%p_surf(i2,j2) = FIA%p_atm_surf(i,j) - 1e5 ! SLP - 1 std. atmosphere, in Pa. +! Ice%p_surf(i2,j2) = FIA%p_atm_surf(i,j) - 1e5 ! SLP - 1 std. atmosphere [Pa]. ! else ! Ice%p_surf(i2,j2) = 0.0 ! endif @@ -644,43 +622,60 @@ subroutine set_ocean_top_fluxes(Ice, IST, IOF, FIA, OSS, G, IG, sCS) end subroutine set_ocean_top_fluxes +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> ice_mass_from_IST stores the total ice mass determined from IST in the IOF type. +subroutine ice_mass_from_IST(IST, IOF, G, IG) + type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice + 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(in) :: IG !< The sea-ice specific grid type + + integer :: i, j, k, isc, iec, jsc, jec, ncat + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce + + ! Sum the concentration weighted mass. + IOF%mass_ice_sn_p(:,:) = 0.0 + !$OMP parallel do default(shared) + do j=jsc,jec ; do k=1,ncat ; do i=isc,iec + IOF%mass_ice_sn_p(i,j) = IOF%mass_ice_sn_p(i,j) + IST%part_size(i,j,k) * & + (IG%H_to_kg_m2 * ((IST%mH_snow(i,j,k) + IST%mH_pond(i,j,k)) + IST%mH_ice(i,j,k))) + enddo ; enddo ; enddo + +end subroutine ice_mass_from_IST + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> set_ocean_top_dyn_fluxes translates ice-bottom stresses and mass -!! from the ice model's internal state to the public ice data type -!! for use by the ocean model. -subroutine set_ocean_top_dyn_fluxes(Ice, IST, IOF, FIA, G, IG, sCS) +!> 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) type(ice_data_type), intent(inout) :: Ice !< The publicly visible ice data type. - type(ice_state_type), intent(inout) :: IST !< A type describing the state of the sea ice 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(ice_grid_type), intent(in) :: IG !< The sea-ice specific grid type type(SIS_slow_CS), intent(in) :: sCS !< The slow ice control structure real :: I_count integer :: i, j, k, isc, iec, jsc, jec - integer :: i2, j2, i_off, j_off, ind, ncat, NkIce + integer :: i2, j2, i_off, j_off, ind isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - ncat = IG%CatIce ; NkIce = IG%NkIce 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 IST_chksum("Start set_ocean_top_dyn_fluxes", IST, G, IG) endif ! Sum the concentration weighted mass. Ice%mi(:,:) = 0.0 i_off = LBOUND(Ice%mi,1) - G%isc ; j_off = LBOUND(Ice%mi,2) - G%jsc !$OMP parallel do default(shared) private(i2,j2) - do j=jsc,jec ; do k=1,ncat ; do i=isc,iec + do j=jsc,jec ; do i=isc,iec i2 = i+i_off ; j2 = j+j_off! Use these to correct for indexing differences. - Ice%mi(i2,j2) = Ice%mi(i2,j2) + IST%part_size(i,j,k) * & - (IG%H_to_kg_m2 * (IST%mH_snow(i,j,k) + IST%mH_ice(i,j,k))) - enddo ; enddo ; enddo + Ice%mi(i2,j2) = Ice%mi(i2,j2) + IOF%mass_ice_sn_p(i,j) + enddo ; enddo if (sCS%do_icebergs .and. associated(IOF%mass_berg)) then ! Note that the IOF berg fields and Ice fields are only allocated on the @@ -701,7 +696,7 @@ subroutine set_ocean_top_dyn_fluxes(Ice, IST, IOF, FIA, G, IG, sCS) Ice%flux_v(i2,j2) = 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, in Pa. + Ice%p_surf(i2,j2) = FIA%p_atm_surf(i,j) - 1e5 ! SLP - 1 std. atmosphere [Pa]. else Ice%p_surf(i2,j2) = 0.0 endif @@ -715,54 +710,12 @@ subroutine set_ocean_top_dyn_fluxes(Ice, IST, IOF, FIA, G, IG, sCS) enddo ; enddo endif -! This extra block is required with the Verona and earlier versions of the coupler. - i_off = LBOUND(Ice%part_size,1) - G%isc ; j_off = LBOUND(Ice%part_size,2) - G%jsc - if (Ice%shared_slow_fast_PEs) then - if ((Ice%fCS%G%iec-Ice%fCS%G%isc==iec-isc) .and. & - (Ice%fCS%G%jec-Ice%fCS%G%jsc==jec-jsc)) then - ! The fast and slow ice PEs are using the same PEs and layout, so the - ! part_size arrays can be copied directly from the fast ice PEs. - !$OMP parallel do default(shared) private(i2,j2) - do j=jsc,jec ; do k=0,ncat ; do i=isc,iec - i2 = i+i_off ; j2 = j+j_off! Use these to correct for indexing differences. - Ice%part_size(i2,j2,k+1) = IST%part_size(i,j,k) - enddo ; enddo ; enddo - endif - endif - if (sCS%debug) then call Ice_public_type_chksum("End set_ocean_top_dyn_fluxes", Ice, check_slow=.true.) endif end subroutine set_ocean_top_dyn_fluxes -! Coupler interface to provide ocean surface data to atmosphere. -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -!> update_ice_model_slow_up prepares the ice surface data for forcing the atmosphere -!! and also unpacks the data from the ocean and shares it between the fast and -!! slow ice structures. -subroutine update_ice_model_slow_up ( Ocean_boundary, Ice ) - type(ocean_ice_boundary_type), & - intent(inout) :: Ocean_boundary !< A structure containing information about - !! the ocean that is being shared with the sea-ice. - type(ice_data_type), & - intent(inout) :: Ice !< The publicly visible ice data type. - - if (.not.associated(Ice%fCS)) call SIS_error(FATAL, & - "The pointer to Ice%fCS must be associated in update_ice_model_slow_up.") - if (.not.associated(Ice%sCS)) call SIS_error(FATAL, & - "The pointer to Ice%sCS must be associated in update_ice_model_slow_up.") - - 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 exchange_slow_to_fast_ice(Ice) - - call set_ice_surface_fields(Ice) - -end subroutine update_ice_model_slow_up !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> This subroutine copies information from the slow part of the sea-ice to the @@ -1033,14 +986,14 @@ subroutine set_ice_surface_state(Ice, IST, OSS, Rad, FIA, G, IG, fCS) ! for the current partition, non-dimensional and 0 to 1. real :: u, v real :: area_pt - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. type(time_type) :: dt_r ! A temporary radiation timestep. integer :: i, j, k, m, n, i2, j2, k2, isc, iec, jsc, jec, ncat, i_off, j_off integer :: index real :: H_to_m_ice ! The specific volumes of ice and snow times the - real :: H_to_m_snow ! conversion factor from thickness units, in m H-1. + real :: H_to_m_snow ! conversion factor from thickness units [m H-1 ~> m3]. real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce @@ -1215,7 +1168,7 @@ subroutine set_ice_optics(IST, OSS, Tskin_ice, coszen, Rad, G, IG, optics_CSp) 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(G%isd:G%ied, G%jsd:G%jed, IG%CatIce), & - intent(in) :: Tskin_ice !< The sea ice skin temperature in deg C. + intent(in) :: Tskin_ice !< The sea ice skin temperature [degC]. real, dimension(G%isd:G%ied, G%jsd:G%jed), & intent(in) :: coszen !< Cosine of the solar zenith angle for this step type(ice_rad_type), intent(inout) :: Rad !< A structure with fields related to the absorption, @@ -1223,12 +1176,12 @@ subroutine set_ice_optics(IST, OSS, Tskin_ice, coszen, Rad, G, IG, optics_CSp) type(SIS_optics_CS), intent(in) :: optics_CSp !< The control structure for optics calculations real, dimension(IG%NkIce) :: sw_abs_lay - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. real :: albedos(4) ! The albedos for the various wavelenth and direction bands ! for the current partition, non-dimensional and 0 to 1. real :: H_to_m_ice ! The specific volumes of ice and snow times the - real :: H_to_m_snow ! conversion factor from thickness units, in m H-1. + real :: H_to_m_snow ! conversion factor from thickness units [m H-1 ~> m3]. integer :: i, j, k, m, isc, iec, jsc, jec, ncat isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce @@ -1369,7 +1322,7 @@ subroutine set_ocean_albedo(Ice, recalc_sun_angle, G, Time_start, Time_end, cosz real, dimension(G%isc:G%iec,G%jsc:G%jec) :: & dummy, & ! A dummy array that is not used again. - cosz_alb ! The cosine of the solar zenith angle for calculating albedo, ND. + cosz_alb ! The cosine of the solar zenith angle for calculating albedo [nondim]. real :: rad real :: rrsun_dt_ice type(time_type) :: dT_ice ! The time interval for this update. @@ -1416,10 +1369,10 @@ subroutine fast_radiation_diagnostics(ABT, Ice, IST, Rad, FIA, G, IG, CS, & real, dimension(G%isd:G%ied, G%jsd:G%jed) :: tmp_diag, sw_dn, net_sw, avg_alb real, dimension(G%isd:G%ied, G%jsd:G%jed,size(FIA%flux_sw_dn,3)) :: & sw_dn_bnd ! The downward shortwave radiation by frequency and angular band - ! averaged over all of the ice thickness categories, in W m-2. + ! averaged over all of the ice thickness categories [W m-2]. real, dimension(G%isd:G%ied) :: Tskin_avg, ice_conc real :: dt_diag - real :: Stefan ! The Stefan-Boltzmann constant in W m-2 K-4 as used for + real :: Stefan ! The Stefan-Boltzmann constant [W m-2 degK-4] as used for ! strictly diagnostic purposes. real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin integer :: i, j, k, m, i2, j2, k2, i3, j3, isc, iec, jsc, jec, ncat, NkIce @@ -1474,7 +1427,7 @@ subroutine fast_radiation_diagnostics(ABT, Ice, IST, Rad, FIA, G, IG, CS, & if (Rad%id_lwdn > 0) then tmp_diag(:,:) = 0.0 - Stefan = 5.6734e-8 ! Set the Stefan-Bolzmann constant, in W m-2 K-4. + Stefan = 5.6734e-8 ! Set the Stefan-Bolzmann constant [W m-2 degK-4]. do k=0,ncat ; do j=jsc,jec ; do i=isc,iec ; if (G%mask2dT(i,j)>0.5) then i3 = i+io_A ; j3 = j+jo_A ; k2 = k+1 tmp_diag(i,j) = tmp_diag(i,j) + IST%part_size(i,j,k) * & @@ -1639,13 +1592,10 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, type(time_type) , intent(in) :: Time !< The current time type(time_type) , intent(in) :: Time_step_fast !< The time step for the ice_model_fast type(time_type) , intent(in) :: Time_step_slow !< The time step for the ice_model_slow - logical, optional, intent(in) :: Verona_coupler !< If present and false, use the input values + logical, optional, intent(in) :: Verona_coupler !< If false or not present, use the input values !! in Ice to determine whether this is a fast or slow - !! ice processor or both. Otherwise, carry out all of - !! the sea ice iniatialization calls so that SIS2 will - !! work with the Verona and earlier releases of the FMS - !! coupler code in configurations that use the exchange - !! grid to communicate with the atmosphere or land. + !! ice processor or both. SIS2 will now throw a fatal + !! error if this is present and true. logical, optional, intent(in) :: Concurrent_ice !< If present and true, use sea ice model !! settings appropriate for running the atmosphere and !! slow ice simultaneously, including embedding the @@ -1693,16 +1643,16 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! Parameters that are read in and used to initialize other modules. If those ! other modules had control states, these would be moved to those modules. - real :: mom_rough_ice ! momentum same, cd10=(von_k/ln(10/z0))^2, in m. - real :: heat_rough_ice ! heat roughness length, in m. - real :: dt_Rad_real ! The radiation timestep, in s. + real :: mom_rough_ice ! momentum same, cd10=(von_k/ln(10/z0))^2 [m]. + real :: heat_rough_ice ! heat roughness length [m]. + real :: dt_Rad_real ! The radiation timestep [s]. type(time_type) :: dt_Rad ! The radiation timestep, used initializing albedos. real :: rad ! The conversion factor from degrees to radians. real :: rrsun ! An unused temporary factor related to the Earth-sun distance. ! Parameters that properly belong exclusively to ice_thm. - real :: k_snow ! snow conductivity (W/mK) - real :: h_lo_lim ! The min ice thickness for temp. calc, in m. + real :: k_snow ! snow conductivity [W m degC-1] + real :: h_lo_lim ! The min ice thickness for temp. calc [m]. real :: H_to_kg_m2_tmp ! A temporary variable for holding the intended value ! of the thickness to mass-per-unit-area conversion ! factor. @@ -1720,19 +1670,19 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, real, allocatable, target, dimension(:,:,:,:) :: t_ice_tmp, sal_ice_tmp real, allocatable, target, dimension(:,:,:) :: t_snow_tmp real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin - real :: g_Earth ! The gravitational acceleration in m s-2. - real :: ice_bulk_salin ! The globally constant sea ice bulk salinity, in g/kg + real :: g_Earth ! The gravitational acceleration [m s-2]. + real :: ice_bulk_salin ! The globally constant sea ice bulk salinity [gSalt kg-1] = [ppt] ! that is used to calculate the ocean salt flux. real :: ice_rel_salin ! The initial bulk salinity of sea-ice relative to the - ! salinity of the water from which it formed, nondim. + ! salinity of the water from which it formed [nondim]. real :: coszen_IC ! A constant value that is used to initialize ! coszen if it is not read from a restart file, or a ! negative number to use the time and geometry. - real :: rho_ice ! The nominal density of sea ice in kg m-3. - real :: rho_snow ! The nominal density of snow in kg m-3. - real :: rho_Ocean ! The nominal density of seawater, in kg m-3. + real :: rho_ice ! The nominal density of sea ice [kg m-3]. + real :: rho_snow ! The nominal density of snow [kg m-3]. + real :: rho_Ocean ! The nominal density of seawater [kg m-3]. real :: kmelt ! A constant that is used in the calculation of the - ! ocean/ice basal heat flux, in W m-2 K-1. This could + ! ocean/ice basal heat flux [W m-2 degC-1]. This could ! be changed to reflect the turbulence in the under-ice ! ocean boundary layer and the effective depth of the ! reported value of t_ocn. @@ -1782,6 +1732,9 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, logical :: redo_fast_update ! If true, recalculate the thermal updates from the fast ! dynamics on the slowly evolving ice state, rather than ! copying over the slow ice state to the fast ice state. + logical :: do_mask_restart ! If true, apply the scaling and masks to mH_snow, mH_ice and part_size + ! after a restart. However this may cause answers to diverge + ! after a restart.Provide a switch to turn this option off. logical :: Verona logical :: Concurrent logical :: read_aux_restart @@ -1801,10 +1754,9 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! For now, both fast and slow processes occur on all sea-ice PEs. fast_ice_PE = .true. ; slow_ice_PE = .true. - if (present(Verona_coupler)) then ; if (.not.Verona_coupler) then - fast_ice_PE = Ice%fast_ice_pe ; slow_ice_PE = Ice%slow_ice_pe - endif ; endif - Verona = .true. ; if (present(Verona_coupler)) Verona = Verona_coupler + Verona = .false. ; if (present(Verona_coupler)) Verona = Verona_coupler + if (Verona) call SIS_error(FATAL, "SIS2 no longer works with pre-Warsaw couplers.") + fast_ice_PE = Ice%fast_ice_pe ; slow_ice_PE = Ice%slow_ice_pe Concurrent = .false. ; if (present(Concurrent_ice)) Concurrent = Concurrent_ice ! Open the parameter file. @@ -1938,12 +1890,6 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, "in parts of the code that use directionally split \n"//& "updates, with even numbers (or 0) used for x- first \n"//& "and odd numbers used for y-first.", default=0) - call log_param(param_file, mdl, "! VERONA_COUPLER", Verona, & - "If true, carry out all of the sea ice calls so that SIS2 \n"//& - "will work with the Verona and earlier releases of the \n"//& - "FMS coupler code in configurations that use the exchange \n"//& - "grid to communicate with the atmosphere or land.", & - layoutParam=.true.) call get_param(param_file, mdl, "ICE_SEES_ATMOS_WINDS", atmos_winds, & "If true, the sea ice is being given wind stresses with \n"//& @@ -1996,6 +1942,9 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, "the sea ice that are handled by the fast ice PEs.", & default="ice_model_fast.res.nc") endif + call get_param(param_file, mdl, "APPLY_MASKS_AFTER_RESTART", do_mask_restart, & + "If true, applies masks to mH_ice,mH_snow and part_size after a restart.",& + default=.true.) call get_param(param_file, mdl, "MASSLESS_ICE_ENTH", massless_ice_enth, & "The ice enthalpy fill value for massless categories.", & @@ -2067,6 +2016,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, Ice%sCS%do_icebergs = do_icebergs Ice%sCS%pass_iceberg_area_to_ocean = pass_iceberg_area_to_ocean Ice%sCS%pass_stress_mag = pass_stress_mag + Ice%sCS%slab_ice = slab_ice Ice%sCS%specified_ice = specified_ice Ice%sCS%Cgrid_dyn = Cgrid_dyn Ice%sCS%redo_fast_update = redo_fast_update @@ -2118,7 +2068,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call ice_type_slow_reg_restarts(sGD%mpp_domain, CatIce, & param_file, Ice, Ice%Ice_restart, restart_file) - call alloc_IST_arrays(sHI, sIG, sIST, omit_tsurf=Eulerian_tsurf) + 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 alloc_ocean_sfc_state(Ice%sCS%OSS, sHI, sIST%Cgrid_dyn, gas_fields_ocn) @@ -2138,8 +2088,9 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call alloc_ice_rad(Ice%sCS%Rad, sHI, sIG) endif - call SIS_dyn_trans_register_restarts(sGD%mpp_domain, sHI, sIG, param_file,& - Ice%sCS%dyn_trans_CSp, Ice%Ice_restart, restart_file) + if (.not.specified_ice) & + call SIS_dyn_trans_register_restarts(sGD%mpp_domain, sHI, sIG, param_file, & + Ice%sCS%dyn_trans_CSp, Ice%Ice_restart, restart_file) call SIS_diag_mediator_init(sG, sIG, param_file, Ice%sCS%diag, component="SIS", & doc_file_dir = dirs%output_directory) @@ -2341,7 +2292,8 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! the fields that would have been read if symmetric were toggled. call ice_state_read_alt_restarts(sIST, sG, sIG, Ice%Ice_restart, & restart_file, dirs%restart_input_dir) - call SIS_dyn_trans_read_alt_restarts(Ice%sCS%dyn_trans_CSp, sG, Ice%Ice_restart, & + if (.not.specified_ice) & + call SIS_dyn_trans_read_alt_restarts(Ice%sCS%dyn_trans_CSp, sG, Ice%Ice_restart, & restart_file, dirs%restart_input_dir) ! Approximately initialize state fields that are not present @@ -2472,10 +2424,21 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, ! Deal with any ice masses or thicknesses over land, and rescale to ! account for differences between the current thickness units and whatever ! thickness units were in the input restart file. - do k=1,CatIce - sIST%mH_snow(:,:,k) = sIST%mH_snow(:,:,k) * H_rescale_snow * sG%mask2dT(:,:) - sIST%mH_ice(:,:,k) = sIST%mH_ice(:,:,k) * H_rescale_ice * sG%mask2dT(:,:) - enddo + ! However, in some model this causes answers to change after a restart + ! because these state variables are changed only after a restart and + ! not at each timestep. Provide a switch to turn this option off. + if (do_mask_restart) then + do k=1,CatIce + sIST%mH_snow(:,:,k) = sIST%mH_snow(:,:,k) * H_rescale_snow * sG%mask2dT(:,:) + sIST%mH_ice(:,:,k) = sIST%mH_ice(:,:,k) * H_rescale_ice * sG%mask2dT(:,:) + sIST%part_size(:,:,k) = sIST%part_size(:,:,k) * sG%mask2dT(:,:) + enddo + ! Since we masked out the part_size on land we should set + ! part_size(:,:,0) = 1. on land to satisfy the summation check + do j=jsc,jec ; do i=isc,iec + if (sG%mask2dT(i,j) < 0.5) sIST%part_size(i,j,0) = 1. + enddo ; enddo + endif if (sIG%ocean_part_min > 0.0) then ; do j=jsc,jec ; do i=isc,iec sIST%part_size(i,j,0) = max(sIST%part_size(i,j,0), sIG%ocean_part_min) @@ -2485,6 +2448,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call pass_var(sIST%part_size, sGD) call pass_var(sIST%mH_ice, sGD, complete=.false.) call pass_var(sIST%mH_snow, sGD, complete=.false.) + call pass_var(sIST%mH_pond, sGD, complete=.false.) do l=1,NkIce call pass_var(sIST%enth_ice(:,:,:,l), sGD, complete=.false.) enddo @@ -2561,6 +2525,7 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, sIST%part_size(i,j,1) = 0.0 sIST%mH_ice(i,j,k) = sIST%mH_ice(i,j,1) ; sIST%mH_ice(i,j,1) = 0.0 ! sIST%mH_snow(i,j,k) = sIST%mH_snow(i,j,1) ; sIST%mH_snow(i,j,1) = 0.0 + ! sIST%mH_pond(i,j,k) = sIST%mH_pond(i,j,1) ; sIST%mH_pond(i,j,1) = 0.0 exit ! from k-loop endif ; enddo endif ; enddo ; enddo @@ -2594,8 +2559,19 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call SIS_slow_thermo_init(Ice%sCS%Time, sG, sIG, param_file, Ice%sCS%diag, & Ice%sCS%slow_thermo_CSp, Ice%sCS%SIS_tracer_flow_CSp) - call SIS_dyn_trans_init(Ice%sCS%Time, sG, sIG, param_file, Ice%sCS%diag, & - Ice%sCS%dyn_trans_CSp, dirs%output_directory, Time_Init) + if (specified_ice) then + call specified_ice_init(Ice%sCS%Time, sG, sIG, param_file, Ice%sCS%diag, & + Ice%sCS%specified_ice_CSp, dirs%output_directory, Time_Init) + 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, & + 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, & + transport_CSp=SIS_dyn_trans_transport_CS(Ice%sCS%dyn_trans_CSp), & + sum_out_CSp=SIS_dyn_trans_sum_output_CS(Ice%sCS%dyn_trans_CSp)) + endif if (Ice%sCS%redo_fast_update) then call SIS_fast_thermo_init(Ice%sCS%Time, sG, sIG, param_file, Ice%sCS%diag, & @@ -2603,10 +2579,6 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call SIS_optics_init(param_file, Ice%sCS%optics_CSp, slab_optics=slab_ice) endif - call SIS_slow_thermo_set_ptrs(Ice%sCS%slow_thermo_CSp, & - transport_CSp=SIS_dyn_trans_transport_CS(Ice%sCS%dyn_trans_CSp), & - sum_out_CSp=SIS_dyn_trans_sum_output_CS(Ice%sCS%dyn_trans_CSp)) - ! Initialize any tracers that will be handled via tracer flow control. call SIS_tracer_flow_control_init(Ice%sCS%Time, sG, sIG, param_file, & Ice%sCS%SIS_tracer_flow_CSp, is_restart) @@ -2642,37 +2614,16 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, endif endif - if (Verona) then - ! The Verona and earlier versions of the coupler code make calls to set - ! up the exchange grid right at the start of the coupled timestep, before - ! information about the part_size distribution can be copied from the slow - ! processors to the fast processors. This will cause coupled models with - - if (fast_ice_PE) then - write_error_mesg = .not.((sHI%iec-sHI%isc==fHI%iec-fHI%isc) .and. & - (sHI%jec-sHI%jsc==fHI%jec-fHI%jsc)) - else ; write_error_mesg = .true. - endif - - if (write_error_mesg) call SIS_error(FATAL, & - "The Verona coupler will not work unless the fast and slow portions "//& - "of SIS2 use the same PEs and layout.") - - ! Set the computational domain sizes using the ice model's indexing convention. - isc = sHI%isc ; iec = sHI%iec ; jsc = sHI%jsc ; jec = sHI%jec - i_off = LBOUND(Ice%part_size,1) - sHI%isc ; j_off = LBOUND(Ice%part_size,2) - sHI%jsc - do k=0,CatIce ; do j=jsc,jec ; do i=isc,iec - i2 = i+i_off ; j2 = j+j_off ; k2 = k+1 - Ice%part_size(i2,j2,k2) = sIST%part_size(i,j,k) - enddo ; enddo ; enddo - - endif - ! Do any error checking here. if (Ice%sCS%debug) call ice_grid_chksum(sG, haloshift=1) - call write_ice_statistics(sIST, Ice%sCS%Time, 0, sG, sIG, & - SIS_dyn_trans_sum_output_CS(Ice%sCS%dyn_trans_CSp)) + if (specified_ice) then + call write_ice_statistics(sIST, Ice%sCS%Time, 0, sG, sIG, & + specified_ice_sum_output_CS(Ice%sCS%specified_ice_CSp)) + else + call write_ice_statistics(sIST, Ice%sCS%Time, 0, sG, sIG, & + SIS_dyn_trans_sum_output_CS(Ice%sCS%dyn_trans_CSp)) + endif endif ! slow_ice_PE @@ -2751,10 +2702,6 @@ subroutine ice_model_init(Ice, Time_Init, Time, Time_step_fast, Time_step_slow, call close_param_file(param_file) - ! In the post-Verona coupler, share_ice_domains is called by the coupler - ! after it switches the current PE_list to the one with all ice PEs. - if (Verona) call share_ice_domains(Ice) - ! Ice%xtype can be REDIST or DIRECT, depending on the relationship between ! the fast and slow ice PEs. REDIST should always work but may be slower. if (fast_ice_PE .neqv. slow_ice_PE) then @@ -2818,9 +2765,9 @@ end subroutine share_ice_domains !> initialize_ice_categories sets the bounds of the ice thickness categories. subroutine initialize_ice_categories(IG, Rho_ice, param_file, hLim_vals) type(ice_grid_type), intent(inout) :: IG !< The sea-ice specific grid type - real, intent(in) :: Rho_ice !< The nominal ice density, in kg m-3. + real, intent(in) :: Rho_ice !< The nominal ice density [kg m-3]. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - real, dimension(:), optional, intent(in) :: hLim_vals !< The ice category thickness limits, in m. + real, dimension(:), optional, intent(in) :: hLim_vals !< The ice category thickness limits [m]. ! Initialize IG%cat_thick_lim and IG%mH_cat_bound here. ! ###This subroutine should be extended to add more options. @@ -2918,7 +2865,12 @@ subroutine ice_model_end(Ice) endif if (slow_ice_PE) then - call SIS_dyn_trans_end(Ice%sCS%dyn_trans_CSp) + + if (associated(Ice%sCS%dyn_trans_CSp)) & + call SIS_dyn_trans_end(Ice%sCS%dyn_trans_CSp) + + if (associated(Ice%sCS%specified_ice_CSp)) & + call specified_ice_end(Ice%sCS%specified_ice_CSp) call SIS_slow_thermo_end(Ice%sCS%slow_thermo_CSp) diff --git a/src/ice_ridge.F90 b/src/ice_ridge.F90 index e611d3d5..e4b026a0 100644 --- a/src/ice_ridge.F90 +++ b/src/ice_ridge.F90 @@ -37,7 +37,7 @@ subroutine ice_ridging_init(km, cn, hi, part_undef, part_undef_sum, & integer, intent(in) :: km !< The number of ice thickness categories real, dimension(0: ), intent(in) :: cn !< Fractional concentration of each thickness category, !! including open water fraction - real, dimension(1: ), intent(in) :: hi !< ice volume in each category, in m3 + real, dimension(1: ), intent(in) :: hi !< ice volume in each category [m3] real, dimension(1:km), intent(out) :: hmin !< minimum ice thickness involved in Hibler's ridged ice distribution real, dimension(1:km), intent(out) :: hmax !< maximum ice thickness involved in Hibler's ridged ice distribution real, dimension(1:km), intent(out) :: efold !< e-folding scale lambda of Lipscomb's ridged ice distribution @@ -174,8 +174,8 @@ end subroutine ice_ridging_init !! to ridging (Flato and Hibler, 1995, JGR) or the net area loss in riding !! (CICE documentation) depending on the state of the ice drift ! function ridge_rate(del2, div) result (rnet) - real, intent(in) :: del2 !< The magnitude of the shear rates, in s-1. - real, intent(in) :: div !< The ice flow divergence, in s-1 + real, intent(in) :: del2 !< The magnitude of the shear rates [s-1]. + real, intent(in) :: div !< The ice flow divergence [s-1] ! Local variables real :: del, rnet, rconv, rshear @@ -196,19 +196,22 @@ end function ridge_rate !TOM>~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> ice_ridging parameterizes mechanical redistribution of thin (undeformed) ice !! into thicker (deformed/ridged) ice categories -subroutine ice_ridging(km, cn, hi, hs, t1, t2, age, snow_to_ocn, rdg_rate, hi_rdg, & +subroutine ice_ridging(km, cn, hi, hs, t1, t2, age, snow_to_ocn, enth_snow_to_ocn, rdg_rate, hi_rdg, & dt, hlim_in, rdg_open, vlev) ! Subroutine written by T. Martin, 2008 integer, intent(in) :: km !< The number of ice thickness categories real, dimension(0:), intent(inout) :: cn !< Fractional concentration of each thickness category, !! including open water fraction - real, dimension(1:), intent(inout) :: hi !< ice volume in each category, in m3 - real, dimension(1:), intent(inout) :: hs !< snow volume in each category, in m3 + real, dimension(1:), intent(inout) :: hi !< ice volume in each category [m3] + real, dimension(1:), intent(inout) :: hs !< snow volume in each category [m3] ! CAUTION: these quantities are extensive here, - real, dimension(1:), intent(inout) :: t1 !< Volume integrated upper layer temperature, in degC m3? - real, dimension(1:), intent(inout) :: t2 !< Volume integrated upper layer temperature, in degC m3? - real, dimension(1:), intent(inout) :: age !< Volume integrated ice age in m3 years? - real, intent(out) :: snow_to_ocn !< total snow volume dumped into ocean during ridging + real, dimension(1:), intent(inout) :: t1 !< Volume integrated upper layer temperature [degC m3]? + real, dimension(1:), intent(inout) :: t2 !< Volume integrated upper layer temperature [degC m3]? + real, dimension(1:), intent(inout) :: age !< Volume integrated ice age [m3 years]? + real, intent(out) :: enth_snow_to_ocn !< average of enthalpy of the snow dumped into + !! ocean due to this ridging event [J kg-1] + real, intent(out) :: snow_to_ocn !< total snow mass dumped into ocean due to this + !! ridging event [kg m-2] real, intent(in) :: rdg_rate !< Ridging rate from subroutine ridge_rate real, dimension(1:), intent(inout) :: hi_rdg !< A diagnostic of the ridged ice volume in each category. real, intent(in) :: dt !< time step dt has units seconds @@ -232,6 +235,7 @@ subroutine ice_ridging(km, cn, hi, hs, t1, t2, age, snow_to_ocn, rdg_rate, hi_rd real :: ardg, vrdg ! area and volume of newly formed rdiged (vlev=vrdg!!!) real, dimension(1:km) :: hmin, hmax, efold, rdg_ratio, hlim real :: hl, hr + real :: snow_dump, enth_dump real :: cn_tot, part_undef_sum real :: div_adv, Rnet, Rdiv, Rtot, rdg_area, rdgtmp, hlimtmp real :: area_frac @@ -244,7 +248,7 @@ subroutine ice_ridging(km, cn, hi, hs, t1, t2, age, snow_to_ocn, rdg_rate, hi_rd hlimtmp = hlim_in(km) hlim(km) = hlim_unlim ! ensures all ridged ice is smaller than thickest ice allowed frac_hs_rdg = 1.0-s2o_frac - !snow_to_ocn = 0.0 -> done in subroutine transport + snow_to_ocn = 0.0 ; enth_snow_to_ocn = 0.0 alev=0.0; ardg=0.0; vlev=0.0; vrdg=0.0 ! call ice_ridging_init(km, cn, hi, part_undef, part_undef_sum, & @@ -346,7 +350,12 @@ subroutine ice_ridging(km, cn, hi, hs, t1, t2, age, snow_to_ocn, rdg_rate, hi_rd hi_rdg(kd) = max(hi_rdg(kd),0.0) ! ensure hi_rdg >= 0 ! dump part of the snow in ocean (here, sum volume, transformed to flux in update_ice_model_slow) - snow_to_ocn = snow_to_ocn + frac_hs(kd)*(1.0-frac_hs_rdg) + snow_dump = frac_hs(kd)*(1.0-frac_hs_rdg) + if (snow_to_ocn > 0.0) then + enth_dump = t1(kd) !### THIS IS WRONG, BUT IS A PLACEHOLDER FOR NOW. + enth_snow_to_ocn = (enth_snow_to_ocn*snow_to_ocn + enth_dump*snow_dump) / (snow_to_ocn + snow_dump) + snow_to_ocn = snow_to_ocn + snow_dump + endif enddo diff --git a/src/ice_shortwave_dEdd.F90 b/src/ice_shortwave_dEdd.F90 index ddfb2f67..dc6745be 100644 --- a/src/ice_shortwave_dEdd.F90 +++ b/src/ice_shortwave_dEdd.F90 @@ -68,8 +68,8 @@ module ice_shortwave_dEdd awtidf = 0.36218_dbl_kind !< near IR, diffuse band weight for history and diagnostics real (kind=dbl_kind), parameter :: & - Timelt = 0.0_dbl_kind,& !< melting temperature, ice top surface (C) - rhos = 330.0_dbl_kind !< density of snow (kg/m^3) + Timelt = 0.0_dbl_kind,& !< melting temperature, ice top surface [degC] + rhos = 330.0_dbl_kind !< density of snow [kg m-3] real (kind=dbl_kind), parameter :: & @@ -177,7 +177,7 @@ subroutine shortwave_dEdd0( nx_block, ny_block, & indxj !< compressed j-index for ice-covered cells real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - coszen !< cosine of solar zenith angle + coszen !< cosine of solar zenith angle [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & aice !< concentration of ice real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & @@ -188,50 +188,50 @@ subroutine shortwave_dEdd0( nx_block, ny_block, & fs !< horizontal coverage of snow real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(in) :: & - rhosnw !< density in snow layer (kg/m3) + rhosnw !< density in snow layer [kg m-3] real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(in) :: & - rsnw !< grain radius in snow layer (m) + rsnw !< grain radius in snow layer [m] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - fp !< pond fractional coverage (0 to 1) + fp !< pond fractional coverage (0 to 1) [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - hp !< pond depth (m) + hp !< pond depth [m] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swvdr !< sw down, visible, direct (W/m^2) + swvdr !< sw down, visible, direct [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swvdf !< sw down, visible, diffuse (W/m^2) + swvdf !< sw down, visible, diffuse [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swidr !< sw down, near IR, direct (W/m^2) + swidr !< sw down, near IR, direct [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swidf !< sw down, near IR, diffuse (W/m^2) + swidf !< sw down, near IR, diffuse [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - alvdr !< visible, direct, albedo (fraction) + alvdr !< visible, direct, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - alvdf !< visible, diffuse, albedo (fraction) + alvdf !< visible, diffuse, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - alidr !< near-ir, direct, albedo (fraction) + alidr !< near-ir, direct, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - alidf !< near-ir, diffuse, albedo (fraction) + alidf !< near-ir, diffuse, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - fswsfc !< SW absorbed at snow/bare ice/pondedi ice surface (W m-2) + fswsfc !< SW absorbed at snow/bare ice/pondedi ice surface [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - fswint !< SW interior absorption (below surface, above ocean,W m-2) + fswint !< SW interior absorption (below surface, above ocean [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - fswthru !< SW through snow/bare ice/ponded ice into ocean (W m-2) + fswthru !< SW through snow/bare ice/ponded ice into ocean [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(out) :: & - Sswabs !< SW absorbed in snow layer (W m-2) + Sswabs !< SW absorbed in snow layer [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block,nilyr), intent(out) :: & - Iswabs !< SW absorbed in ice layer (W m-2) + Iswabs !< SW absorbed in ice layer [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - albice !< bare ice albedo, for history + albice !< bare ice albedo, for history [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - albsno !< snow albedo, for history + albsno !< snow albedo, for history [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - albpnd !< pond albedo, for history + albpnd !< pond albedo, for history [nondim] ! !EOP ! @@ -241,9 +241,9 @@ subroutine shortwave_dEdd0( nx_block, ny_block, & fnidr ! fraction of direct to total down surface flux in nir real (kind=dbl_kind), dimension(nx_block,ny_block) :: & - hs , & ! snow thickness (all snow layers, m) - hi , & ! ice thickness (all sea ice layers, m) - fi ! snow/bare ice fractional coverage (0 to 1) + hs , & ! snow thickness (all snow layers) [m] + hi , & ! ice thickness (all sea ice layers) [m] + fi ! snow/bare ice fractional coverage (0 to 1) [nondim] integer (kind=int_kind), dimension(nx_block,ny_block) :: & srftyp ! surface type over ice: (0=air, 1=snow, 2=pond) @@ -280,10 +280,10 @@ subroutine shortwave_dEdd0( nx_block, ny_block, & ! for history real (kind=dbl_kind), dimension (nx_block,ny_block) :: & - avdrl , & ! visible, direct, albedo (fraction) - avdfl , & ! visible, diffuse, albedo (fraction) - aidrl , & ! near-ir, direct, albedo (fraction) - aidfl ! near-ir, diffuse, albedo (fraction) + avdrl , & ! visible, direct, albedo [nondim] + avdfl , & ! visible, diffuse, albedo [nondim] + aidrl , & ! near-ir, direct, albedo [nondim] + aidfl ! near-ir, diffuse, albedo [nondim] !----------------------------------------------------------------------- @@ -531,52 +531,52 @@ subroutine compute_dEdd0(nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & coszen !< cosine solar zenith angle real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swvdr !< shortwave down at surface, visible, direct (W/m^2) + swvdr !< shortwave down at surface, visible, direct [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swvdf !< shortwave down at surface, visible, diffuse (W/m^2) + swvdf !< shortwave down at surface, visible, diffuse [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swidr !< shortwave down at surface, near IR, direct (W/m^2) + swidr !< shortwave down at surface, near IR, direct [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - swidf !< shortwave down at surface, near IR, diffuse (W/m^2) + swidf !< shortwave down at surface, near IR, diffuse [W m-2] integer (kind=int_kind), dimension(nx_block,ny_block), intent(in) :: & srftyp !< surface type over ice: (0=air, 1=snow, 2=pond) real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in) :: & - hs !< snow thickness (m) + hs !< snow thickness [m] real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(in) :: & - rhosnw !< snow density in snow layer (kg/m3) + rhosnw !< snow density in snow layer [kg m-3] real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(in) :: & - rsnw !< snow grain radius in snow layer (m) + rsnw !< snow grain radius in snow layer [m] real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in) :: & - hi !< ice thickness (m) + hi !< ice thickness [m] real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in) :: & - hp !< pond depth (m) + hp !< pond depth [m] real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in) :: & fi !< snow/bare ice fractional coverage (0 to 1) real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - alvdr !< visible, direct, albedo (fraction) + alvdr !< visible, direct, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - alvdf !< visible, diffuse, albedo (fraction) + alvdf !< visible, diffuse, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - alidr !< near-ir, direct, albedo (fraction) + alidr !< near-ir, direct, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - alidf !< near-ir, diffuse, albedo (fraction) + alidf !< near-ir, diffuse, albedo [nondim] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - fswsfc !< SW absorbed at snow/bare ice/pondedi ice surface (W m-2) + fswsfc !< SW absorbed at snow/bare ice/pondedi ice surface [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & fswint !< SW interior absorption (below surface, above ocean,W m-2) real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - fswthru !< SW through snow/bare ice/ponded ice into ocean (W m-2) + fswthru !< SW through snow/bare ice/ponded ice into ocean [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(inout) :: & - Sswabs !< SW absorbed in snow layer (W m-2) + Sswabs !< SW absorbed in snow layer [W m-2] real (kind=dbl_kind), dimension (nx_block,ny_block,nilyr), intent(inout) :: & - Iswabs !< SW absorbed in ice layer (W m-2) + Iswabs !< SW absorbed in ice layer [W m-2] ! !EOP !----------------------------------------------------------------------- @@ -708,21 +708,21 @@ subroutine compute_dEdd0(nx_block, ny_block, & nmbrad = 32 ! number of snow grain radii in tables real (kind=dbl_kind), dimension(icells_DE) :: & - avdr , & ! visible albedo, direct (fraction) - avdf , & ! visible albedo, diffuse (fraction) - aidr , & ! near-ir albedo, direct (fraction) - aidf ! near-ir albedo, diffuse (fraction) + avdr , & ! visible albedo, direct [nondim] + avdf , & ! visible albedo, diffuse [nondim] + aidr , & ! near-ir albedo, direct [nondim] + aidf ! near-ir albedo, diffuse [nondim] real (kind=dbl_kind), dimension(icells_DE) :: & - fsfc , & ! shortwave absorbed at snow/bare ice/ponded ice surface (W m-2) - fint , & ! shortwave absorbed in interior (below surface but above ocean, W m-2) - fthru ! shortwave through snow/bare ice/ponded ice to ocean (W/m^2) + fsfc , & ! shortwave absorbed at snow/bare ice/ponded ice surface [W m-2] + fint , & ! shortwave absorbed in interior (below surface but above ocean) [W m-2] + fthru ! shortwave through snow/bare ice/ponded ice to ocean [W m-2] real (kind=dbl_kind), dimension(icells_DE,nslyr) :: & - Sabs ! shortwave absorbed in snow layer (W m-2) + Sabs ! shortwave absorbed in snow layer [W m-2] real (kind=dbl_kind), dimension(icells_DE,nilyr) :: & - Iabs ! shortwave absorbed in ice layer (W m-2) + Iabs ! shortwave absorbed in ice layer [W m-2] real (kind=dbl_kind), dimension (icells_DE,nspint) :: & wghtns ! spectral weights @@ -774,7 +774,7 @@ subroutine compute_dEdd0(nx_block, ny_block, & gs_tab ! assymetry parameter for each snow grain radius real (kind=dbl_kind) :: & delr , & ! snow grain radius interpolation parameter - rhoi , & ! pure ice density (kg/m3) + rhoi , & ! pure ice density [kg m-3] fr , & ! snow grain adjustment factor fr_max , & ! snow grain adjustment factor max fr_min ! snow grain adjustment factor min @@ -818,8 +818,8 @@ subroutine compute_dEdd0(nx_block, ny_block, & gi_p_int ! Ice under pond asymmetry parameter real (kind=dbl_kind) :: & - hi_ssl , & ! sea ice surface scattering layer thickness (m) - hs_ssl , & ! snow surface scattering layer thickness (m) + hi_ssl , & ! sea ice surface scattering layer thickness [m] + hs_ssl , & ! snow surface scattering layer thickness [m] dz , & ! snow, sea ice or pond water layer thickness dz_ssl , & ! snow or sea ice surface scattering layer thickness fs ! scaling factor to reduce (nilyr<4) or increase (nilyr>4) DL @@ -851,8 +851,8 @@ subroutine compute_dEdd0(nx_block, ny_block, & ! for melt pond transition to bare sea ice for small pond depths real (kind=dbl_kind) :: & - hpmin , & ! minimum allowed melt pond depth (m) - hp0 , & ! melt pond depth below which iops are weighted bare ice + pond (m) + hpmin , & ! minimum allowed melt pond depth [m] + hp0 , & ! melt pond depth below which iops are weighted bare ice + pond [m] sig_i , & ! ice scattering coefficient (/m) sig_p , & ! pond scattering coefficient (/m) kext ! weighted extinction coefficient (/m) @@ -1004,13 +1004,13 @@ subroutine compute_dEdd0(nx_block, ny_block, & data gw / 0.00_dbl_kind, 0.00_dbl_kind, 0.00_dbl_kind / ! snow data - data hs_ssl / 0.040_dbl_kind / ! snow surface scattering layer thickness (m) - data rhoi /917.0_dbl_kind / ! snow mass density (kg/m3) + data hs_ssl / 0.040_dbl_kind / ! snow surface scattering layer thickness [m] + data rhoi /917.0_dbl_kind / ! snow mass density [kg m-3] data fr_max / 1.00_dbl_kind / ! snow grain adjustment factor max data fr_min / 0.80_dbl_kind / ! snow grain adjustment factor min ! ice data - data hi_ssl / 0.050_dbl_kind / ! sea ice surface scattering layer thickness (m) + data hi_ssl / 0.050_dbl_kind / ! sea ice surface scattering layer thickness [m] data kalg / 0.60_dbl_kind / ! for 0.5 m path of 75 mg Chl a / m2 ! ice and pond scat coeff fractional change for +- one-sigma in albedo @@ -1020,8 +1020,8 @@ subroutine compute_dEdd0(nx_block, ny_block, & data fm_pnd / 0.50_dbl_kind / ! ice to pond parameters - data hpmin / .005_dbl_kind / ! minimum allowable pond depth (m) - data hp0 / .200_dbl_kind / ! pond depth below which transition to bare sea ice + data hpmin / .005_dbl_kind / ! minimum allowable pond depth [m] + data hp0 / .200_dbl_kind / ! pond depth below which transition to bare sea ice [m] !----------------------------------------------------------------------- ! Initialize and tune bare ice/ponded ice iops @@ -2215,7 +2215,7 @@ subroutine shortwave_dEdd0_set_snow(nx_block, ny_block, & fs !< horizontal coverage of snow real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(out) :: & - rhosnw !< density in snow layer (kg/m3) + rhosnw !< density in snow layer [kg m-3] real (kind=dbl_kind), dimension (nx_block,ny_block,nslyr), intent(out) :: & rsnw !< grain radius in snow layer (micro-meters) ! @@ -2231,13 +2231,13 @@ subroutine shortwave_dEdd0_set_snow(nx_block, ny_block, & ks ! snow vertical index real (kind=dbl_kind) :: & - hs , & ! snow depth (m) + hs , & ! snow depth [m] fT , & ! piecewise linear function of surface temperature dTs , & ! difference of Tsfc and Timelt rsnw_nm ! actual used nonmelt snow grain radius (micro-meters) real (kind=dbl_kind), parameter :: & - hsmin = .0001_dbl_kind, & ! minimum allowed snow depth (m) for DE + hsmin = .0001_dbl_kind, & ! minimum allowed snow depth [m] for DE hs0 = .0300_dbl_kind, & ! snow depth for transition to bare sea ice dT_mlt = c1, & ! change in temp to give non-melt to melt change ! in snow grain radius @@ -2347,7 +2347,7 @@ subroutine shortwave_dEdd0_set_pond(nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & fp !< pond fractional coverage (0 to 1) real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - hp !< pond depth (m) + hp !< pond depth [m] ! !EOP diff --git a/src/ice_spec.F90 b/src/ice_spec.F90 index 4cd9c4da..166f3a8d 100644 --- a/src/ice_spec.F90 +++ b/src/ice_spec.F90 @@ -18,10 +18,10 @@ module ice_spec_mod logical :: module_is_initialized = .false. !< If true, this module has been called before. logical :: mcm_ice = .false. !< When mcm_ice=.true., ice is handled as in supersource -real :: sst_pert = 0. !< global temperature perturbation used for sensitivity experiments +real :: sst_pert = 0. !< global temperature perturbation used for sensitivity experiments [degC] -real :: minimum_ice_concentration = 0.2 !< A minimum ice concentration, nondim. -real :: minimum_ice_thickness = 1.0 !< A minimum ice thickness, in m +real :: minimum_ice_concentration = 0.2 !< A minimum ice concentration [nondim] +real :: minimum_ice_thickness = 1.0 !< A minimum ice thickness [m] logical :: do_leads = .true. !< when do_leads=false there is no fractional ice concentration !! also you should set the minimum_ice_concentration = 0.5 logical :: sst_degk = .false. !< when sst_degk=true the input sst data is in degrees Kelvin @@ -38,15 +38,15 @@ module ice_spec_mod !> get_sea_surface obtains SST, ice concentration and thickness from data subroutine get_sea_surface(Time, ts, cn, iceh, ice_domain, ice_domain_end, ts_in_K) type (time_type), intent(in) :: Time !< The current model time - real, dimension(:, :), intent(out) :: ts !< The surface temperature in degC or degK + real, dimension(:, :), intent(out) :: ts !< The surface temperature [degC] or [degK] real, dimension(size(ts,1),size(ts,2),2), & - intent(out) :: cn !< The fractional ocean and ice concentration + intent(out) :: cn !< The fractional ocean and ice concentration [nondim] real, dimension(size(ts,1),size(ts,2)), & - intent(out) :: iceh !< The ice thickness in m + intent(out) :: iceh !< The ice thickness [m] type(domain2d), optional, intent(in) :: ice_domain !< The domain used to read this data type(domain2d), optional, intent(in) :: ice_domain_end !< If present reset the data override ice !! domain back to this one at the end of this routine - logical, optional, intent(in) :: ts_in_K !< If true, return the surface temperature in deg K. + logical, optional, intent(in) :: ts_in_K !< If true, return the surface temperature in [degK]. !! The default is true. real, dimension(size(ts,1),size(ts,2)) :: sst, icec @@ -155,9 +155,9 @@ subroutine get_sea_surface(Time, ts, cn, iceh, ice_domain, ice_domain_end, ts_in if (sst_degk .eqv. ts_in_degK) then ! ts and sst have the same units. ts(:,:) = sst(:,:) - elseif (ts_in_degK) then ! ts is in K and sst in C. + elseif (ts_in_degK) then ! ts is in Kelvin and sst is in Celsius. ts(:,:) = sst(:,:) + T_0degC - else ! ts is in C and sst in K. + else ! ts is in Celsius and sst in Kelvin. ts(:,:) = sst(:,:) - T_0degC endif diff --git a/src/ice_type.F90 b/src/ice_type.F90 index 30fe3930..7dd5bd2a 100644 --- a/src/ice_type.F90 +++ b/src/ice_type.F90 @@ -63,68 +63,68 @@ module ice_type_mod ! atmosphere, and contain separate values for each ice thickness category. real, pointer, dimension(:,:,:) :: & part_size => NULL(), & !< The fractional coverage of a grid cell by each ice - !! thickness category, nondim, 0 to 1. Category 1 is + !! thickness category [nondim], 0 to 1. Category 1 is !! open ocean. The sum of part_size is 1. albedo => NULL(), & !< The surface albedo averaged across all wavelength !! and orientation bands within each ice-thickness - !! category. Nondimensional, between 0 and 1. + !! category [nondim], between 0 and 1. albedo_vis_dir => NULL(), & !< The surface albedo for direct visible shortwave radiation - !! in each ice-thickness category. Nondim, between 0 and 1. + !! in each ice-thickness category [nondim], between 0 and 1. albedo_nir_dir => NULL(), & !< The surface albedo for diffuse visible shortwave radiation - !! in each ice-thickness category. Nondim, between 0 and 1. + !! in each ice-thickness category [nondim], between 0 and 1. albedo_vis_dif => NULL(), & !< The surface albedo for direct near-infrared shortwave radiation - !! in each ice-thickness category. Nondim, between 0 and 1. + !! in each ice-thickness category [nondim], between 0 and 1. albedo_nir_dif => NULL(), & !< The surface albedo for diffuse near-infrared shortwave radiation - !! in each ice-thickness category. Nondim, between 0 and 1. + !! in each ice-thickness category [nondim], between 0 and 1. rough_mom => NULL(), & !< The roughness for momentum at the ocean surface, as provided by - !! ocean_rough_mod, apparently in m. + !! ocean_rough_mod, apparently [m]. rough_heat => NULL(), & !< The roughness for heat at the ocean surface, as provided by - !! ocean_rough_mod, apparently in m. + !! ocean_rough_mod, apparently [m]. rough_moist => NULL(), & !< The roughness for moisture at the ocean surface, as provided by - !! ocean_rough_mod, apparently in m. + !! ocean_rough_mod, apparently [m]. t_surf => NULL(), & !< The surface temperature for the ocean or for - !! each ice-thickness category, in Kelvin. - u_surf => NULL(), & !< The eastward surface velocities of the ocean (:,:,1) or sea-ice, in m s-1. - v_surf => NULL() !< The northward surface elocities of the ocean (:,:,1) or sea-ice, in m s-1. + !! each ice-thickness category [Kelvin]. + u_surf => NULL(), & !< The eastward surface velocities of the ocean (:,:,1) or sea-ice [m s-1]. + v_surf => NULL() !< The northward surface elocities of the ocean (:,:,1) or sea-ice [m s-1]. real, pointer, dimension(:,:) :: & - s_surf =>NULL() !< The ocean's surface salinity, in g/kg. + s_surf =>NULL() !< The ocean's surface salinity [gSalt kg-1]. ! These arrays will be used to set the forcing for the ocean. real, pointer, dimension(:,:) :: & - SST_C => NULL(), & !< The ocean surface temperature, in deg C. - flux_u => NULL(), & !< The flux of x-momentum into the ocean, in Pa. - flux_v => NULL(), & !< The flux of y-momentum into the ocean, in Pa. - flux_t => NULL(), & !< The flux of sensible heat out of the ocean, in W m-2. - flux_q => NULL(), & !< The evaporative moisture flux out of the ocean, in kg m-2 s-1. - flux_lw => NULL(), & !< The longwave flux out of the ocean, in W m-2. - flux_sw_vis_dir => NULL(), & !< The direct visible shortwave heat flux into the ocean in W m-2. - flux_sw_vis_dif => NULL(), & !< The diffuse visible shortwave heat flux into the ocean in W m-2. - flux_sw_nir_dir => NULL(), & !< The direct near-infrared heat flux into the ocean in W m-2. - flux_sw_nir_dif => NULL(), & !< The diffuse near-infrared heat flux into the ocean in W m-2. - flux_lh => NULL(), & !< The latent heat flux out of the ocean, in W m-2. - lprec => NULL(), & !< The liquid precipitation flux into the ocean, in kg m-2. - fprec => NULL(), & !< The frozen precipitation flux into the ocean, in kg m-2. - p_surf => NULL(), & !< The pressure at the ocean surface, in Pa. This may + SST_C => NULL(), & !< The ocean surface temperature [degC]. + flux_u => NULL(), & !< The flux of x-momentum into the ocean [Pa]. + flux_v => NULL(), & !< The flux of y-momentum into the ocean [Pa]. + flux_t => NULL(), & !< The flux of sensible heat out of the ocean [W m-2]. + flux_q => NULL(), & !< The evaporative moisture flux out of the ocean [kg m-2 s-1]. + flux_lw => NULL(), & !< The longwave flux out of the ocean [W m-2]. + flux_sw_vis_dir => NULL(), & !< The direct visible shortwave heat flux into the ocean [W m-2]. + flux_sw_vis_dif => NULL(), & !< The diffuse visible shortwave heat flux into the ocean [W m-2]. + flux_sw_nir_dir => NULL(), & !< The direct near-infrared heat flux into the ocean [W m-2]. + flux_sw_nir_dif => NULL(), & !< The diffuse near-infrared heat flux into the ocean [W m-2]. + flux_lh => NULL(), & !< The latent heat flux out of the ocean [W m-2]. + lprec => NULL(), & !< The liquid precipitation flux into the ocean [kg m-2]. + fprec => NULL(), & !< The frozen precipitation flux into the ocean [kg m-2]. + p_surf => NULL(), & !< The pressure at the ocean surface [Pa]. This may !! or may not include atmospheric pressure. - runoff => NULL(), & !< Liquid runoff into the ocean, in kg m-2. + runoff => NULL(), & !< Liquid runoff into the ocean [kg m-2]. calving => NULL(), & !< Calving of ice or runoff of frozen fresh water into - !! the ocean, in kg m-2. - stress_mag => NULL(), & !< The time-mean magnitude of the stress on the ocean, in Pa. - ustar_berg => NULL(), & !< ustar contribution below icebergs in m/s - area_berg => NULL(), & !< fraction of grid cell covered by icebergs in m2/m2 - mass_berg => NULL(), & !< mass of icebergs in kg/m^2 + !! the ocean [kg m-2]. + stress_mag => NULL(), & !< The time-mean magnitude of the stress on the ocean [Pa]. + ustar_berg => NULL(), & !< ustar contribution below icebergs [m s-1] + area_berg => NULL(), & !< fraction of grid cell covered by icebergs in [m2 m-2] + mass_berg => NULL(), & !< mass of icebergs in [kg m-2] runoff_hflx => NULL(), & !< The heat flux associated with runoff, based on !! the temperature difference relative to a !! reference temperature, in ???. calving_hflx => NULL(), & !< The heat flux associated with calving, based on !! the temperature difference relative to a !! reference temperature, in ???. - flux_salt => NULL() !< The flux of salt out of the ocean in kg m-2. + flux_salt => NULL() !< The flux of salt out of the ocean [kg m-2]. real, pointer, dimension(:,:) :: & - area => NULL() , & !< The area of ocean cells, in m2. Land cells have + area => NULL() , & !< The area of ocean cells [m2]. Land cells have !! a value of 0, so this could also be used as a mask. - mi => NULL() !< The total ice+snow mass, in kg m-2. + mi => NULL() !< The total ice+snow mass [kg m-2]. ! mi is needed for the wave model. It is introduced here, ! because flux_ice_to_ocean cannot handle 3D fields. This may be ! removed, if the information on ice thickness can be derived from @@ -570,7 +570,7 @@ subroutine ice_stock_pe(Ice, index, value) case (ISTOCK_WATER) 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)) * & + 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)) enddo ; enddo ; enddo @@ -583,7 +583,7 @@ subroutine ice_stock_pe(Ice, index, value) (kg_H * IST%mH_ice(i,j,k)) * LI endif enddo ; enddo ; enddo - else + 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) if (part_wt*IST%mH_ice(i,j,k) > 0.0) then diff --git a/src/slab_ice.F90 b/src/slab_ice.F90 new file mode 100644 index 00000000..e30dd958 --- /dev/null +++ b/src/slab_ice.F90 @@ -0,0 +1,114 @@ +!> Does the transport and redistribution between thickness categories for the SIS2 sea ice model. +module slab_ice + +! This file is a part of SIS2. See LICENSE.md for the licnese. + +! use MOM_coms, only : reproducing_sum, EFP_type, EFP_to_real, EFP_real_diff +use MOM_domains, only : pass_var, pass_vector, BGRID_NE, CGRID_NE +use MOM_error_handler, only : SIS_error=>MOM_error, FATAL, WARNING +use MOM_error_handler, only : SIS_mesg=>MOM_mesg, is_root_pe +! 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 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 +use SIS_hor_grid, only : SIS_hor_grid_type +use ice_grid, only : ice_grid_type + +implicit none ; private + +#include + +public :: slab_ice_advect, slab_ice_dynamics + +contains + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> 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) + 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, 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, 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 + integer :: i, j, n, isc, iec, jsc, jec, n_substeps + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + + n_substeps = 1 ; if (present(nsteps)) n_substeps = nsteps + if (n_substeps==0) return + dt_adv = dt_slow / n_substeps + + do n=1,n_substeps + do j=jsc,jec ; do I=isc-1,iec + avg = 0.5*( trc(i,j) + trc(i+1,j) ) + dif = trc(i+1,j) - trc(i,j) + 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) + else + uflx(I,j) = uc(I,j) * trc(i+1,j) * G%dy_Cu(I,j) + endif + enddo ; enddo + + do J=jsc-1,jec ; do i=isc,iec + avg = 0.5*( trc(i,j) + trc(i,j+1) ) + dif = trc(i,j+1) - trc(i,j) + 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) + else + 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)) ) * G%IareaT(i,j) + enddo ; enddo + + call pass_var(trc, G%Domain) + enddo + + if (present(part_sz)) then ; do j=G%jsd,G%jed ; do i=G%isd,G%ied + part_sz(i,j) = 0.0 ; if (trc(i,j) > 0.0) part_sz(i,j) = 1.0 + enddo ; enddo ; endif + +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. +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(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] + + ui(:,:) = uo(:,:) ; vi(:,:) = vo(:,:) + fxoc(:,:) = fxat(:,:) ; fyoc(:,:) = fyat(:,:) + +end subroutine slab_ice_dynamics + +end module slab_ice diff --git a/src/specified_ice.F90 b/src/specified_ice.F90 new file mode 100644 index 00000000..a8eeb96a --- /dev/null +++ b/src/specified_ice.F90 @@ -0,0 +1,312 @@ +!> Handles the stresses for specified ice. +module specified_ice + +! This file is part of SIS2. See LICENSE.md for the license. + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +! This module handles the specified ice using SIS2 types and interfaces. ! +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! + +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_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 SIS_diag_mediator, only : enable_SIS_averaging, disable_SIS_averaging +use SIS_diag_mediator, only : query_SIS_averaging_enabled, SIS_diag_ctrl +use SIS_hor_grid, only : SIS_hor_grid_type +use SIS_ice_diags, only : ice_state_diags_type, register_ice_state_diagnostics +use SIS_ice_diags, only : post_ice_state_diagnostics +use SIS_sum_output, only : write_ice_statistics, SIS_sum_output_init, SIS_sum_out_CS +use SIS_types, only : ocean_sfc_state_type, ice_ocean_flux_type, fast_ice_avg_type +use SIS_types, only : ice_state_type, IST_chksum, IST_bounds_check +use ice_grid, only : ice_grid_type + +implicit none ; private + +#include + +public :: specified_ice_dynamics, specified_ice_init, specified_ice_end, specified_ice_sum_output_CS + +!> The control structure for the specified_ice module +type, public :: specified_ice_CS ; private + logical :: debug !< If true, write verbose checksums for debugging purposes. + logical :: bounds_check !< If true, check for sensible values of thicknesses + !! temperatures, fluxes, etc. + integer :: ntrunc = 0 !< The number of times the velocity has been truncated + !! since the last call to write_ice_statistics. + integer :: n_calls = 0 !< The number of times specified_ice_dynamics has been called. + type(time_type) :: ice_stats_interval !< The interval between writes of the + !! globally summed ice statistics and conservation checks. + type(time_type) :: write_ice_stats_time !< The next time to write out the ice statistics. + + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(SIS_diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the + !! timing of diagnostic output. + + type(ice_state_diags_type), pointer :: IDs => NULL() + !< A structure for regulating sea ice state diagnostics + type(SIS_sum_out_CS), pointer :: sum_output_CSp => NULL() + !< Pointer to the control structure for the summed diagnostics module +end type specified_ice_CS + +contains + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> 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) + + 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. + 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. + real, intent(in) :: dt_slow !< The slow ice dynamics timestep [s]. + 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(specified_ice_CS), pointer :: CS !< The control structure for the specified_ice module + + ! Local variables + integer :: i, j, k, isc, iec, jsc, jec, ncat + + real, parameter :: T_0degC = 273.15 ! 0 degrees C in Kelvin + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; ncat = IG%CatIce + + CS%n_calls = CS%n_calls + 1 + + IOF%stress_count = 0 + call set_ocean_top_stress_FIA(FIA, IOF, G) + + ! Set appropriate surface quantities in categories with no ice. + if (allocated(IST%t_surf)) then + !$OMP parallel do default(shared) + do j=jsc,jec ; do k=1,ncat ; do i=isc,iec ; if (IST%part_size(i,j,k)<=0.0) & + IST%t_surf(i,j,k) = T_0degC + OSS%T_fr_ocn(i,j) + enddo ; enddo ; enddo + endif + + call enable_SIS_averaging(dt_slow, CS%Time, CS%diag) + 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%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) + CS%write_ice_stats_time = CS%write_ice_stats_time + CS%ice_stats_interval + endif + +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) + 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 + + 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] + integer :: i, j, k, isc, iec, jsc, jec + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + + if (IOF%stress_count == 0) then + IOF%flux_u_ocn(:,:) = 0.0 ; IOF%flux_v_ocn(:,:) = 0.0 + if (allocated(IOF%stress_mag)) IOF%stress_mag(:,:) = 0.0 + endif + + wt_now = 1.0 / (real(IOF%stress_count) + 1.0) ; wt_prev = 1.0 - wt_now + + ! Copy and interpolate the ice-ocean stress_Cgrid. This code is slightly + ! complicated because there are 3 different staggering options supported. + + if (IOF%flux_uv_stagger == AGRID) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + 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 * & + (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 * & + (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 * & + sqrt(IOF%flux_u_ocn(i,j)**2 + IOF%flux_v_ocn(i,j)**2) + enddo ; enddo + elseif (IOF%flux_uv_stagger == BGRID_NE) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do J=jsc-1,jec ; do I=isc-1,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dBu(I,J)>0.5) then + ps_ocn = 0.25 * ((FIA%ice_free(i+1,j+1) + FIA%ice_free(i,j)) + & + (FIA%ice_free(i+1,j) + FIA%ice_free(i,j+1)) ) + 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 * & + (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 * & + (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)) + & + (FIA%WindStr_y(i,j+1) + FIA%WindStr_y(i+1,J))) ) + enddo ; enddo + if (allocated(IOF%stress_mag)) then ; do j=jsc,jec ; do i=isc,iec + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + IOF%stress_mag(i,j) = wt_prev * IOF%stress_mag(i,j) + wt_now * sqrt( & + ((G%mask2dBu(I,J)*(IOF%flux_u_ocn(I,J)**2 + IOF%flux_v_ocn(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(IOF%flux_u_ocn(I-1,J-1)**2 + IOF%flux_v_ocn(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(IOF%flux_u_ocn(I,J-1)**2 + IOF%flux_v_ocn(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(IOF%flux_u_ocn(I-1,J)**2 + IOF%flux_v_ocn(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + else + IOF%stress_mag(i,j) = 0.0 + endif + enddo ; enddo ; endif + elseif (IOF%flux_uv_stagger == CGRID_NE) then + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do j=jsc,jec ; do I=Isc-1,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dCu(I,j)>0.5) then + 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 * & + (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 + !$OMP parallel do default(shared) private(ps_ocn, ps_ice) + do J=jsc-1,jec ; do i=isc,iec + ps_ocn = 1.0 ; ps_ice = 0.0 + if (G%mask2dCv(i,J)>0.5) then + 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 * & + (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 + if (allocated(IOF%stress_mag)) then ; do j=jsc,jec ; do i=isc,iec + taux2 = 0.0 ; tauy2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*IOF%flux_u_ocn(I-1,j)**2 + & + G%mask2dCu(I,j)*IOF%flux_u_ocn(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*IOF%flux_v_ocn(i,J-1)**2 + & + G%mask2dCv(i,J)*IOF%flux_v_ocn(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + 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.") + endif + + IOF%stress_count = IOF%stress_count + 1 + +end subroutine set_ocean_top_stress_FIA + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> specified_ice_init initializes ice model data, parameters and diagnostics +!! associated with the SIS2 dynamics and transport modules. +subroutine specified_ice_init(Time, G, IG, param_file, diag, CS, output_dir, Time_init) + 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(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 + type(specified_ice_CS), pointer :: CS !< The control structure for the specified_ice module + character(len=*), intent(in) :: output_dir !< The directory to use for writing output + type(time_type), intent(in) :: Time_Init !< Starting time of the model integration + + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "specified_ice" ! This module's name. + real :: Time_unit ! The time unit for ICE_STATS_INTERVAL [s]. + logical :: debug + + call callTree_enter("specified_ice_init(), specified_ice.F90") + + if (associated(CS)) then + call SIS_error(WARNING, "specified_ice_init called with an "//& + "associated control structure.") + return + endif + allocate(CS) + + CS%diag => diag ; CS%Time => Time + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, & + "This module updates the ice momentum and does ice transport.") + + call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & + "The time unit for ICE_STATS_INTERVAL.", & + units="s", default=86400.0) + call get_param(param_file, mdl, "ICE_STATS_INTERVAL", CS%ice_stats_interval, & + "The interval in units of TIMEUNIT between writes of the \n"//& + "globally summed ice statistics and conservation checks.", & + default=real_to_time(86400.0), timeunit=Time_unit) + + call get_param(param_file, mdl, "DEBUG", debug, & + "If true, write out verbose debugging data.", & + default=.false., debuggingParam=.true.) + call get_param(param_file, mdl, "DEBUG_SLOW_ICE", CS%debug, & + "If true, write out verbose debugging data on the slow ice PEs.", & + default=debug, debuggingParam=.true.) + call get_param(param_file, mdl, "ICE_BOUNDS_CHECK", CS%bounds_check, & + "If true, periodically check the values of ice and snow \n"//& + "temperatures and thicknesses to ensure that they are \n"//& + "sensible, and issue warnings if they are not. This \n"//& + "does not change answers, but can increase model run time.", & + default=.true.) + + call SIS_sum_output_init(G, param_file, output_dir, Time_Init, & + CS%sum_output_CSp, CS%ntrunc) + + CS%write_ice_stats_time = Time_Init + CS%ice_stats_interval * & + (1 + (Time - Time_init) / CS%ice_stats_interval) + + call register_ice_state_diagnostics(Time, IG, param_file, diag, CS%IDs) + + call callTree_leave("specified_ice_init()") + +end subroutine specified_ice_init + + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> specified_ice_sum_output_CS returns a pointer to the sum_out_CS type that +!! the specified_ice_CS points to. +function specified_ice_sum_output_CS(CS) result(sum_out_CSp) + type(specified_ice_CS), pointer :: CS !< The control structure for the specified_ice module + type(SIS_sum_out_CS), pointer :: sum_out_CSp !< The SIS_sum_out_CS type used by specified_ice + + sum_out_CSp => CS%sum_output_CSp +end function specified_ice_sum_output_CS + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! +!> specified_ice_end deallocates memory associated with the specified_ice_CS type. +subroutine specified_ice_end(CS) + type(specified_ice_CS), pointer :: CS !< The control structure for the specified_ice module that + !! is dellocated here + + deallocate(CS) + +end subroutine specified_ice_end + +end module specified_ice