diff --git a/cfgs/SHARED/axis_def_nemo.xml b/cfgs/SHARED/axis_def_nemo.xml index 374d193e2047ae6a0145725fb947a032a527ba9a..b83f1c381905cbd69026cdc242b5e2208a047150 100644 --- a/cfgs/SHARED/axis_def_nemo.xml +++ b/cfgs/SHARED/axis_def_nemo.xml @@ -6,22 +6,23 @@ <axis_definition> <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> - <!-- Vertical zoom for a 31-levels ORCA2 grid for eORCA1 300m corresponds to n=35 --> + <!-- Vertical zoom for a 31-levels ORCA2 grid. For eORCA1 300m corresponds to n=35 --> <axis id="deptht300" axis_ref="deptht" > <zoom_axis begin="0" n="19" /> </axis> - <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" /> - <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> - <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> - <axis id="depthf" long_name="Vertical F levels" unit="m" positive="down" /> - <axis id="nfloat" long_name="Float number" unit="-" /> - <axis id="icbcla" long_name="Iceberg class" unit="1" /> - <axis id="ncatice" long_name="Ice category" unit="1" /> - <axis id="iax_20C" long_name="20 degC isotherm" unit="degC" /> - <axis id="iax_26C" long_name="26 degC isotherm" unit="degC" /> - <axis id="iax_28C" long_name="28 degC isotherm" unit="degC" /> + <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" /> + <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> + <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> + <axis id="depthf" long_name="Vertical F levels" unit="m" positive="down" /> + <axis id="nfloat" long_name="Float number" unit="-" /> + <axis id="icbcla" long_name="Iceberg class" unit="1" /> + <axis id="ncatice" long_name="Ice category" unit="1" /> + <axis id="nlayice" long_name="Ice layer" unit="1" /> + <axis id="iax_20C" long_name="20 degC isotherm" unit="degC" /> + <axis id="iax_26C" long_name="26 degC isotherm" unit="degC" /> + <axis id="iax_28C" long_name="28 degC isotherm" unit="degC" /> <axis id="basin" long_name="Sub-basin mask (1=Global 2=Atlantic 3=Indo-Pacific 4=Indian, 5=Pacific)" unit="1" /> - <axis id="nstrait" long_name="Number of straits" unit="1" /> + <axis id="nstrait" long_name="Number of straits" unit="1" /> <!-- ABL vertical axis definition --> <axis id="ght_abl" long_name="ABL Vertical T levels" unit="m" positive="up" /> <axis id="ghw_abl" long_name="ABL Vertical W levels" unit="m" positive="up" /> diff --git a/cfgs/SHARED/field_def_nemo-ice.xml b/cfgs/SHARED/field_def_nemo-ice.xml index 2768a8905a5f6ba1d13a688444aa1268a03d89b5..14fd6ef2f8f6252c03d84ccdfffa1dd846ad93da 100644 --- a/cfgs/SHARED/field_def_nemo-ice.xml +++ b/cfgs/SHARED/field_def_nemo-ice.xml @@ -342,8 +342,31 @@ <field id="tice_cvgerr" long_name="sea ice temperature convergence error" standard_name="sea_ice_temperature_convergence_err" unit="K" /> <field id="tice_cvgstp" long_name="sea ice temperature convergence iterations" standard_name="sea_ice_temperature_convergence_stp" unit="" /> + <!-- salt drainage and flushing sanity checks --> + <field id="cfl_flush" long_name="max CFL during flushing" unit="" /> + <field id="cfl_drain" long_name="max CFL during drainage" unit="" /> + <field id="sice_flush_dserr" long_name="positive sea ice salinity derivative during flushing" detect_missing_value="true" unit="g/kg" /> + <field id="sice_drain_dserr" long_name="positive sea ice salinity derivative during drainage" detect_missing_value="true" unit="g/kg" /> + <field id="sice_flush_serr" long_name="negative sea ice salinity during flushing" detect_missing_value="true" unit="g/kg" /> + <field id="sice_drain_serr" long_name="negative sea ice salinity during drainage" detect_missing_value="true" unit="g/kg" /> + </field_group> <!-- SBC_3D --> + <!-- layers --> + <field_group id="SBC_4D" grid_ref="grid_T_nlayice_inner" > + + <!-- standard ice fields --> + <field id="icesalt_lay" long_name="Sea-Ice salinity per layer" unit="g/kg" detect_missing_value="true" /> + <field id="icetemp_lay" long_name="Ice temperature per layer" unit="degC" detect_missing_value="true" /> + + <!-- salt drainage and flushing sanity checks --> + <field id="tice_flush_dserr" long_name="temperature when positive sea ice salinity derivative during flushing" detect_missing_value="true" unit="degC" /> + <field id="tice_drain_dserr" long_name="temperature when positive sea ice salinity derivative during drainage" detect_missing_value="true" unit="degC" /> + <field id="tice_flush_serr" long_name="temperature when negative sea ice salinity during flushing" detect_missing_value="true" unit="degC" /> + <field id="tice_drain_serr" long_name="temperature when negative sea ice salinity during drainage" detect_missing_value="true" unit="degC" /> + + </field_group> <!-- SBC_4D --> + <!-- scalar variables --> <field_group id="SBC_scalar" grid_ref="grid_scalar" > <field id="NH_iceextt" long_name="Sea ice extent North" standard_name="sea_ice_extent_n" unit="1e6_km2" /> diff --git a/cfgs/SHARED/grid_def_nemo.xml b/cfgs/SHARED/grid_def_nemo.xml index eb0aab010e849c268be2121a104e42c29673a4f1..1fe20b0c37b96680f76a01fbebbacd892537d4ec 100644 --- a/cfgs/SHARED/grid_def_nemo.xml +++ b/cfgs/SHARED/grid_def_nemo.xml @@ -24,6 +24,17 @@ <axis axis_ref="ncatice" /> </grid> <!-- --> + <grid id="grid_T_nlayice" > + <domain domain_ref="grid_T" /> + <axis axis_ref="nlayice" /> + <axis axis_ref="ncatice" /> + </grid> + <grid id="grid_T_nlayice_inner" > + <domain domain_ref="grid_T_inner" name="grid_T" /> + <axis axis_ref="nlayice" /> + <axis axis_ref="ncatice" /> + </grid> + <!-- --> <grid id="grid_T_3D" > <domain domain_ref="grid_T" /> <axis axis_ref="deptht" /> diff --git a/cfgs/SHARED/namelist_ice_ref b/cfgs/SHARED/namelist_ice_ref index 886aa1635ce584109dea8b1285c1c255bfdf105c..02cb0a908374275a0dc75b6369a3d58db0c7b371 100644 --- a/cfgs/SHARED/namelist_ice_ref +++ b/cfgs/SHARED/namelist_ice_ref @@ -22,8 +22,8 @@ &nampar ! Generic parameters !------------------------------------------------------------------------------ jpl = 5 ! number of ice categories - nlay_i = 2 ! number of ice layers - nlay_s = 2 ! number of snow layers + nlay_i = 5 ! number of ice layers + nlay_s = 3 ! number of snow layers ln_virtual_itd = .false. ! virtual ITD mono-category parameterization (jpl=1 only) ! i.e. enhanced thermal conductivity & virtual thin ice melting ln_icedyn = .true. ! ice dynamics (T) or not (F) @@ -156,8 +156,6 @@ ln_icedH = .true. ! activate ice thickness change from growing/melting (T) or not (F) ln_icedA = .true. ! activate lateral melting param. (T) or not (F) ln_icedO = .true. ! activate ice growth in open-water (T) or not (F) - ln_icedS = .true. ! activate brine drainage (T) or not (F) - ! ln_leadhfx = .true. ! heat in the leads is used to melt sea-ice before warming the ocean / !------------------------------------------------------------------------------ @@ -201,13 +199,46 @@ ! 1: constant ice salinity (S=rn_icesal) ! 2: varying salinity parameterization S(z,t) ! 3: prescribed salinity profile S(z) (Schwarzacher 1959) - rn_icesal = 4. ! (nn_icesal=1) ice salinity (g/kg) - rn_sal_gd = 5. ! (nn_icesal=2) restoring ice salinity, gravity drainage (g/kg) - rn_time_gd = 1.73e+6 ! (nn_icesal=2) restoring time scale, gravity drainage (s) - rn_sal_fl = 2. ! (nn_icesal=2) restoring ice salinity, flushing (g/kg) - rn_time_fl = 8.64e+5 ! (nn_icesal=2) restoring time scale, flushing (s) - rn_simax = 20. ! maximum tolerated ice salinity (g/kg) + ! 4: Gravity Drainage and Flushing + ln_flushing = .true. ! activate ice salt flushing + ln_drainage = .true. ! activate ice salt gravity drainage rn_simin = 0.1 ! minimum tolerated ice salinity (g/kg) + rn_sinew = 0.75 ! fraction of sss that is entrapped in new ice + ! -- nn_icesal=1 -- ! + rn_icesal = 4. ! ice salinity (g/kg) + ! -- nn_icesal=2 -- ! + rn_sal_gd = 5. ! restoring ice salinity, gravity drainage (g/kg) + rn_time_gd = 1.73e+6 ! restoring time scale, gravity drainage (s) + rn_sal_fl = 2. ! restoring ice salinity, flushing (g/kg) + rn_time_fl = 8.64e+5 ! restoring time scale, flushing (s) + ! -- nn_icesal=4 -- ! + rn_sal_himin = 0.1 ! min ice thickness for gravity drainage and flushing calculation + nn_liquidus = 2 ! formulation of liquidus (also used for outputs) + ! 1 = linear liquidus + ! 2 = Vancopenolle et al (2019) formulation + ! 3 = Weast 71 (used in RJW2014) + nn_drainage = 20 ! number of subcycles for gravity drainage + nn_flushing = 2 ! number of subcycles for flushing + rn_flushrate = 0.3 ! rate of flushing (fraction of melt water used for flushing) + rn_vbrc = 0.05 ! critical brines volume above which flushing can occur + ! ** drainage convection scheme ** + nn_sal_scheme = 2 ! 1 = Rees Jones and Worster (2014) => RJW2014 !!! be carfeul: this one gives wrong results for now + ! 2 = Griewank and Notz (2013) => GN2013 + ! 3 = Cox and Weeks (1988) => CW1988 + ! ** parameters for each scheme ** + rn_alpha_RJW = 0.037 ! 1: Intensity of the Brine flow ==> 0.13 from Thomas 2020 + ! ==> 0.037 from Martin pers. com. + rn_Rc_RJW = 2.7 ! 1: Critical Rayleigh number ==> 2.9 from Thomas 2020 + ! ==> 2.7 from Martin pers. com. + rn_alpha_GN = 0.681e-3 ! 2: Intensity of the Brine flow ==> 6.7e-3 from Thomas 2020 + ! ==> [0.510e-3 ; 0.681e-3] from Griewank and Notz 2015 + ! ==> 1.56e-3 from Martin pers. com. + rn_Rc_GN = 3.23 ! 2: Critical Rayleigh number ==> 2.4 from Thomas 2020 + ! ! ==> [7.10 ; 3.23] from Griewank and Notz 2015 + ! ! ==> 1.01 from Martin pers. com. + rn_alpha_CW = 7.2e-7 ! 3: Intensity of the Brine flow + ! + ln_sal_chk = .FALSE. ! sanity checks for drainage and flushing / !------------------------------------------------------------------------------ &namthd_pnd ! Melt ponds diff --git a/src/ICE/ice.F90 b/src/ICE/ice.F90 index 1eb9d9943214f7a294fb9381f440d996ee0b059b..c3dfd2ba18a2abc902955b7c56f4664ef06b51df 100644 --- a/src/ICE/ice.F90 +++ b/src/ICE/ice.F90 @@ -61,7 +61,8 @@ MODULE ice !! a_i | a_i_1d | Ice concentration | | !! v_i | - | Ice volume per unit area | m | !! v_s | - | Snow volume per unit area | m | - !! sv_i | - | Sea ice salt content | pss.m | + !! sv_i | - | Sea ice salt content (3D) | g/kg.m| + !! szv_i | - | Sea ice salt content (4D) | g/kg.m| !! oa_i | - | Sea ice areal age content | s | !! e_i | | Ice enthalpy | J/m2 | !! | e_i_1d | Ice enthalpy per unit vol. | J/m3 | @@ -78,12 +79,12 @@ MODULE ice !! | !! h_i | h_i_1d | Ice thickness | m | !! h_s ! h_s_1d | Snow depth | m | - !! s_i ! s_i_1d | Sea ice bulk salinity ! pss | - !! sz_i ! sz_i_1d | Sea ice salinity profile ! pss | - !! o_i ! - | Sea ice Age ! s | - !! t_i ! t_i_1d | Sea ice temperature ! K | - !! t_s ! t_s_1d | Snow temperature ! K | - !! t_su ! t_su_1d | Sea ice surface temperature ! K | + !! s_i ! s_i_1d | Sea ice bulk salinity | g/kg | + !! sz_i ! sz_i_1d | Sea ice salinity profile | g/kg | + !! o_i ! - | Sea ice Age | s | + !! t_i ! t_i_1d | Sea ice temperature | K | + !! t_s ! t_s_1d | Snow temperature | K | + !! t_su ! t_su_1d | Sea ice surface temperature | K | !! h_ip | h_ip_1d | Ice pond thickness | m | !! h_il | h_il_1d | Ice pond lid thickness | m | !! | @@ -103,13 +104,13 @@ MODULE ice !! at_i | at_i_1d | Total ice concentration | | !! vt_i | - | Total ice vol. per unit area | m | !! vt_s | - | Total snow vol. per unit ar. | m | - !! st_i | - | Total Sea ice salt content | pss.m | - !! sm_i | - | Mean sea ice salinity | pss | + !! st_i | - | Total Sea ice salt content | g/kg.m| + !! sm_i | - | Mean sea ice salinity | g/kg | !! tm_i | - | Mean sea ice temperature | K | !! tm_s | - | Mean snow temperature | K | !! et_i | - | Total ice enthalpy | J/m2 | !! et_s | - | Total snow enthalpy | J/m2 | - !! bv_i | - | relative brine volume | ??? | + !! v_ibr | - | relative brine volume | ??? | !! at_ip | - | Total ice pond concentration | | !! hm_ip | - | Mean ice pond depth | m | !! vt_ip | - | Total ice pond vol. per unit area| m | @@ -200,7 +201,6 @@ MODULE ice LOGICAL , PUBLIC :: ln_icedH ! activate ice thickness change from growing/melting (T) or not (F) LOGICAL , PUBLIC :: ln_icedA ! activate lateral melting param. (T) or not (F) LOGICAL , PUBLIC :: ln_icedO ! activate ice growth in open-water (T) or not (F) - LOGICAL , PUBLIC :: ln_icedS ! activate gravity drainage and flushing (T) or not (F) LOGICAL , PUBLIC :: ln_leadhfx ! heat in the leads is used to melt sea-ice before warming the ocean ! ! !!** namelist (namthd_do) ** @@ -226,8 +226,13 @@ MODULE ice ! ! 2 - prognostic salinity (s(z,t)) ! ! 3 - salinity profile, constant in time REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity - REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU] + REAL(wp), PUBLIC :: rn_sinew !: fraction of sss that is kept in new ice REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU] + LOGICAL , PUBLIC :: ln_sal_chk !: sanity checks for salt drainage and flushing + INTEGER , PUBLIC :: nn_liquidus !: formulation of liquidus + ! 1 = linear liquidus + ! 2 = Vancopenolle et al (2019) formulation + ! 3 = Weast formulation (used in RJW2014) ! !!** ice-ponds namelist (namthd_pnd) LOGICAL , PUBLIC :: ln_pnd !: Melt ponds (T) or not (F) @@ -301,16 +306,16 @@ MODULE ice REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: mass flux from residual component of wfx_ice [kg.m-2.s-1] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice bottom growth [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice bottom melt [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice lateral melt [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice surface melt [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to snow-ice growth [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to growth in open water [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation [pss.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice bottom growth [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice bottom melt [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice lateral melt [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice surface melt [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to snow-ice growth [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to growth in open water [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: salt flux due to correction on ice thick. (residual) [g/kg.kg.m-2.s-1 => g.m-2.s-1] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation [g/kg.kg.m-2.s-1 => g.m-2.s-1] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth [W.m-2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt [W.m-2] @@ -346,23 +351,23 @@ MODULE ice REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area (m) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_s !: Snow thickness (m) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K) - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (pss) - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity * volume per area (pss.m) + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (g/kg) + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity * volume per area (g/kg.m) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (s) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (s) - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ibr !: brine volume !! Variables summed over all categories, or associated to all the ice in a single grid cell REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (pss.m) + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (g/kg.m) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content (J/m2) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories (K) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_s !: mean snw temperature over all categories (K) - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories (pss) + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vm_ibr !: brine volume averaged over all categories + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories (g/kg) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories (K) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_i !: mean ice thickness over all categories (m) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_s !: mean snow thickness over all categories (m) @@ -374,7 +379,8 @@ MODULE ice REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow enthalpy [J/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice enthalpy [J/m2] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSS] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [g/kg] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: szv_i !: ice salinity content [g/kg] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond concentration REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] @@ -392,7 +398,7 @@ MODULE ice ! meltwater arrays to save for melt ponds (mv - could be grouped in a single meltwater volume array) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_i_sum_2d !: surface melt (2d arrays for ponds) [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_s_mlt_2d !: snow surf melt (2d arrays for ponds) [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_s_sum_2d !: snow surf melt (2d arrays for ponds) [m] !!---------------------------------------------------------------------- !! * Global variables at before time step @@ -401,7 +407,7 @@ MODULE ice REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip_b, v_il_b !: ponds and lids volumes REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, sv_i_b !: REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b, szv_i_b !: ice temperatures and salt REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total) @@ -478,16 +484,15 @@ CONTAINS ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , STAT=ierr(ii) ) ii = ii + 1 - ALLOCATE( h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & - & v_s (jpi,jpj,jpl) , h_s (jpi,jpj,jpl) , & - & s_i (jpi,jpj,jpl) , sv_i(jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl) , & - & a_ip (jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl), & - & v_il (jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , & - & t_su (jpi,jpj,jpl) , t_s (jpi,jpj,nlay_s,jpl) , t_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , & + ALLOCATE( h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , v_s(jpi,jpj,jpl) , & + & h_s (jpi,jpj,jpl) , s_i (jpi,jpj,jpl) , sv_i(jpi,jpj,jpl) , o_i(jpi,jpj,jpl) , oa_i(jpi,jpj,jpl) , & + & h_ip (jpi,jpj,jpl) , a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , & + & h_il (jpi,jpj,jpl) , v_il(jpi,jpj,jpl) , t_su(jpi,jpj,jpl) , & + & t_s (jpi,jpj,nlay_s,jpl) , t_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , & & ato_i(jpi,jpj) , STAT = ierr(ii) ) ii = ii + 1 - ALLOCATE( e_s(jpi,jpj,nlay_s,jpl) , e_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) + ALLOCATE( e_s(jpi,jpj,nlay_s,jpl) , e_i(jpi,jpj,nlay_i,jpl) , szv_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) ! * Before values of global variables ii = ii + 1 @@ -515,14 +520,14 @@ CONTAINS ! -------------------- ! ! * Ice global state variables ii = ii + 1 - ALLOCATE( bv_i(A2D(0),jpl) , a_ip_frac(A2D(0),jpl) , a_ip_eff(A2D(0),jpl) , STAT=ierr(ii) ) + ALLOCATE( v_ibr(A2D(0),jpl) , a_ip_frac(A2D(0),jpl) , a_ip_eff(A2D(0),jpl) , STAT=ierr(ii) ) ! * Before values of global variables ii = ii + 1 ALLOCATE( at_i_b(A2D(0)) , h_i_b (A2D(0),jpl) , a_i_b(A2D(0),jpl) , v_i_b(A2D(0),jpl) , & & v_s_b (A2D(0),jpl) , h_s_b (A2D(0),jpl) , & - & v_ip_b(A2D(0),jpl) , v_il_b(A2D(0),jpl) , & - & sv_i_b(A2D(0),jpl) , e_i_b (A2D(0),nlay_i,jpl) , e_s_b(A2D(0),nlay_s,jpl) , STAT=ierr(ii) ) + & v_ip_b(A2D(0),jpl) , v_il_b(A2D(0),jpl) , sv_i_b(A2D(0),jpl) , & + & e_i_b (A2D(0),nlay_i,jpl) , e_s_b(A2D(0),nlay_s,jpl) , szv_i_b (A2D(0),nlay_i,jpl) , STAT=ierr(ii) ) ! * fluxes ii = ii + 1 @@ -548,14 +553,14 @@ CONTAINS ! * mean and total ii = ii + 1 - ALLOCATE( t_bo (A2D(0)) , st_i (A2D(0)) , et_i(A2D(0)) , et_s (A2D(0)) , hm_i (A2D(0)) , & - & hm_ip(A2D(0)) , hm_il(A2D(0)) , tm_i(A2D(0)) , tm_s (A2D(0)) , & - & sm_i (A2D(0)) , hm_s (A2D(0)) , om_i(A2D(0)) , bvm_i(A2D(0)) , & + ALLOCATE( t_bo (A2D(0)) , st_i (A2D(0)) , et_i(A2D(0)) , et_s (A2D(0)) , hm_i (A2D(0)) , & + & hm_ip(A2D(0)) , hm_il(A2D(0)) , tm_i(A2D(0)) , tm_s (A2D(0)) , & + & sm_i (A2D(0)) , hm_s (A2D(0)) , om_i(A2D(0)) , vm_ibr(A2D(0)) , & & tm_su(A2D(0)) , STAT=ierr(ii) ) ! * others ii = ii + 1 - ALLOCATE( tau_icebfr(A2D(0)) , dh_i_sum_2d(A2D(0),jpl) , dh_s_mlt_2d(A2D(0),jpl) , STAT=ierr(ii) ) + ALLOCATE( tau_icebfr(A2D(0)) , dh_i_sum_2d(A2D(0),jpl) , dh_s_sum_2d(A2D(0),jpl) , STAT=ierr(ii) ) ii = 1 ALLOCATE( ht_i_new (A2D(0)) , fraz_frac (A2D(0)) , STAT=ierr(ii) ) diff --git a/src/ICE/ice1d.F90 b/src/ICE/ice1d.F90 index a0afce7e48e2f62ed193087c2c4f508f91de5dd7..351cad6968031f31f805e445b9f1f846a259654d 100644 --- a/src/ICE/ice1d.F90 +++ b/src/ICE/ice1d.F90 @@ -10,7 +10,7 @@ MODULE ice1D !!---------------------------------------------------------------------- !! 'key_si3' SI3 sea-ice model !!---------------------------------------------------------------------- - USE ice , ONLY : nlay_i, nlay_s, jpl ! number of ice/snow layers and categories + USE ice , ONLY : nlay_i, nlay_s, jpl, ln_zdf_chkcvg, ln_sal_chk ! number of ice/snow layers and categories ! USE in_out_manager ! I/O manager USE lib_mpp ! MPP library @@ -113,10 +113,10 @@ MODULE ice1D REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bom !: Ice bottom ablation [m] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bog !: Ice bottom accretion [m] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_sub !: Ice surface sublimation [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_mlt !: Snow melt [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_sum !: Snow surface melt [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_itm !: Snow internal melt [m] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_snowice !: Snow ice formation [m of ice] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_1d !: Ice bulk salinity [ppt] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: v_i_1d !: REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: v_s_1d !: REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sv_i_1d !: @@ -131,6 +131,7 @@ MODULE ice1D REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_1d !: corresponding to the 2D var t_s REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_1d !: corresponding to the 2D var t_i REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sz_i_1d !: profiled ice salinity + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: szv_i_1d !: profiled ice salinity content REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e_i_1d !: Ice enthalpy per unit volume REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e_s_1d !: Snow enthalpy per unit volume @@ -146,6 +147,13 @@ MODULE ice1D ! convergence check REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tice_cvgerr_1d !: convergence of ice/snow temp (dT) [K] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tice_cvgstp_1d !: convergence of ice/snow temp (subtimestep) [-] + + ! sanity checks for salinity + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_drain_dserr_1d, s_flush_dserr_1d + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_drain_dserr_1d, t_flush_dserr_1d + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_drain_serr_1d , s_flush_serr_1d + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_drain_serr_1d , t_flush_serr_1d + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cfl_drain_1d , cfl_flush_1d ! !!---------------------- !! * 2D Module variables @@ -167,6 +175,7 @@ MODULE ice1D REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_i_2d REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_s_2d + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: szv_i_2d !!---------------------------------------------------------------------- !! NEMO/ICE 4.0 , NEMO Consortium (2018) @@ -180,7 +189,7 @@ CONTAINS !! *** ROUTINE ice1D_alloc *** !!---------------------------------------------------------------------! INTEGER :: ice1D_alloc ! return value - INTEGER :: ierr(12), ii + INTEGER :: ierr(15), ii !!---------------------------------------------------------------------! ierr(:) = 0 ii = 0 @@ -193,7 +202,7 @@ CONTAINS & s_i_1d (jpij) , sv_i_1d(jpij) , o_i_1d (jpij) , oa_i_1d (jpij) , & & a_ip_1d (jpij) , v_ip_1d(jpij) , h_ip_1d (jpij) , & & v_il_1d (jpij) , h_il_1d(jpij) , & - & t_su_1d (jpij) , t_s_1d (jpij,nlay_s) , t_i_1d (jpij,nlay_i), sz_i_1d(jpij,nlay_i) , & + & t_su_1d (jpij) , t_s_1d (jpij,nlay_s) , t_i_1d (jpij,nlay_i), sz_i_1d(jpij,nlay_i) , szv_i_1d(jpij,nlay_i) , & & ato_i_1d(jpij) , STAT=ierr(ii) ) ii = ii + 1 ALLOCATE( e_i_1d(jpij,nlay_i) , e_s_1d(jpij,nlay_s) , STAT=ierr(ii) ) @@ -233,15 +242,13 @@ CONTAINS ! * thermo tickness change ii = ii + 1 - ALLOCATE( dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) , & - & dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , STAT=ierr(ii) ) + ALLOCATE( dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm(jpij) , dh_i_bom (jpij) , dh_i_bog(jpij) , & + & dh_i_sub(jpij) , dh_s_sum(jpij) , dh_s_itm(jpij) , dh_snowice(jpij) , STAT=ierr(ii) ) ! * other ii = ii + 1 - ALLOCATE( at_i_1d(jpij) , rn_amax_1d(jpij) , t_si_1d(jpij) , t_bo_1d (jpij) , & - & s_i_new(jpij) , sst_1d (jpij) , sss_1d (jpij) , frq_m_1d(jpij) , STAT=ierr(ii) ) - ii = ii + 1 - ALLOCATE( tice_cvgerr_1d(jpij) , tice_cvgstp_1d(jpij) , STAT=ierr(ii) ) + ALLOCATE( at_i_1d(jpij) , rn_amax_1d(jpij) , t_si_1d (jpij) , t_bo_1d (jpij) , & + & sst_1d (jpij) , sss_1d (jpij) , frq_m_1d(jpij) , STAT=ierr(ii) ) ! ! * 2d arrays ii = ii + 1 @@ -252,8 +259,22 @@ CONTAINS ! ! * 3d arrays ii = ii + 1 - ALLOCATE( e_i_2d(jpij,nlay_i,jpl) , e_s_2d(jpij,nlay_s,jpl) , STAT=ierr(ii) ) + ALLOCATE( e_i_2d(jpij,nlay_i,jpl) , e_s_2d(jpij,nlay_s,jpl) , szv_i_2d(jpij,nlay_i,jpl) , STAT=ierr(ii) ) + ! * checks + IF( ln_zdf_chkcvg ) THEN + ii = ii + 1 + ALLOCATE( tice_cvgerr_1d (jpij) , tice_cvgstp_1d (jpij) , STAT=ierr(ii) ) + ENDIF + IF( ln_sal_chk ) THEN + ii = ii + 1 + ALLOCATE( s_drain_dserr_1d(jpij), s_flush_dserr_1d(jpij), & + & s_drain_serr_1d (jpij), s_flush_serr_1d (jpij), cfl_drain_1d(jpij), cfl_flush_1d(jpij), STAT=ierr(ii) ) + ii = ii + 1 + ALLOCATE( t_drain_dserr_1d(jpij,nlay_i), t_flush_dserr_1d(jpij,nlay_i), & + & t_drain_serr_1d (jpij,nlay_i), t_flush_serr_1d (jpij,nlay_i), STAT=ierr(ii) ) + ENDIF + ice1D_alloc = MAXVAL( ierr(:) ) IF( ice1D_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice1D_alloc: failed to allocate arrays.' ) ! diff --git a/src/ICE/icecor.F90 b/src/ICE/icecor.F90 index d208956073a61380341c2e2c43dfd49d49d5f946..d164e472f807c629c39641436f5e89fe25204e72 100644 --- a/src/ICE/icecor.F90 +++ b/src/ICE/icecor.F90 @@ -20,6 +20,7 @@ MODULE icecor USE iceitd ! sea-ice: rebining USE icevar ! sea-ice: operations USE icectl ! sea-ice: control prints + USE sbc_oce, ONLY : sss_m ! USE in_out_manager ! I/O manager USE iom ! I/O manager library @@ -51,8 +52,8 @@ CONTAINS INTEGER, INTENT(in) :: kt ! number of iteration INTEGER, INTENT(in) :: kn ! 1 = after dyn ; 2 = after thermo ! - INTEGER :: ji, jj, jl ! dummy loop indices - REAL(wp) :: zsal, zzc + INTEGER :: ji, jj, jk, jl ! dummy loop indices + REAL(wp) :: zsal !!---------------------------------------------------------------------- ! controls IF( ln_timing ) CALL timing_start('icecor') ! timing @@ -88,17 +89,27 @@ CONTAINS IF( jpl > 1 ) CALL ice_itd_reb( kt ) ! ! !----------------------------------------------------- - IF ( nn_icesal == 2 ) THEN ! salinity must stay in bounds [Simin,Simax] ! - ! !----------------------------------------------------- - zzc = rhoi * r1_Dt_ice + ! ! salinity must stay in bounds [Simin,Simax] ! + ! !----------------------------------------------------- + IF ( nn_icesal == 2 ) THEN DO jl = 1, jpl DO_2D( 0, 0, 0, 0 ) zsal = sv_i(ji,jj,jl) - sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl) ) + sv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_sinew*sss_m(ji,jj)*v_i(ji,jj,jl) ) IF( kn /= 0 ) & ! no ice-ocean exchanges if kn=0 (for bdy for instance) otherwise conservation diags will fail - & sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc ! associated salt flux + & sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * rhoi * r1_Dt_ice ! associated salt flux END_2D END DO + ELSEIF ( nn_icesal == 4 ) THEN + DO jl = 1, jpl + DO_3D( 0, 0, 0, 0, 1, nlay_i ) + zsal = szv_i(ji,jj,jk,jl) + szv_i(ji,jj,jk,jl) = MIN( MAX( szv_i(ji,jj,jk,jl) , rn_simin * v_i(ji,jj,jl) * r1_nlay_i ) , & + & rn_sinew*sss_m(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i ) + IF( kn /= 0 ) & ! no ice-ocean exchanges if kn=0 (for bdy for instance) otherwise conservation diags will fail + & sfx_res(ji,jj) = sfx_res(ji,jj) - ( szv_i(ji,jj,jk,jl) - zsal ) * rhoi * r1_Dt_ice ! associated salt flux + END_3D + END DO ENDIF ! IF( kn /= 0 ) THEN ! no zapsmall if kn=0 (for bdy for instance) because we do not want ice-ocean exchanges (wfx,sfx,hfx) diff --git a/src/ICE/icectl.F90 b/src/ICE/icectl.F90 index a235e05626a3fbf91f8f58d664fd4ee1e268c396..67f7b5e27ce1e51f84205c11ae085a6b35c87982 100644 --- a/src/ICE/icectl.F90 +++ b/src/ICE/icectl.F90 @@ -89,21 +89,26 @@ CONTAINS REAL(wp), DIMENSION(A2D(0),jpl,8) :: ztmp4 REAL(wp), DIMENSION(10) :: zchk3 REAL(wp), DIMENSION(8) :: zchk4 + REAL(wp), DIMENSION(A2D(0),jpl) :: zsv_i !!------------------------------------------------------------------- + IF( nn_icesal == 4 ) THEN + zsv_i(:,:,:) = SUM( szv_i(A2D(0),:,:), dim=3 ) + ELSE + zsv_i(:,:,:) = sv_i(A2D(0),:) + ENDIF ! DO_2D( 0, 0, 0, 0 ) ! -- quantities -- ! - ztmp3(ji,jj,1) = SUM( v_i(ji,jj,:) * rhoi + v_s(ji,jj,:) * rhos + & - & ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow ) * e1e2t(ji,jj) ! volume - ztmp3(ji,jj,2) = SUM( sv_i(ji,jj,:) * rhoi ) * e1e2t(ji,jj) ! salt - ztmp3(ji,jj,3) = ( SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + & ! heat - & SUM( SUM( e_s(ji,jj,:,:), dim=2 ) ) ) * e1e2t(ji,jj) + ztmp3(ji,jj,1) = SUM( v_i (ji,jj,:) * rhoi + v_s (ji,jj,:) * rhos + & + & ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow ) * e1e2t(ji,jj) ! mass + ztmp3(ji,jj,2) = SUM( zsv_i(ji,jj,:) ) * rhoi * e1e2t(ji,jj) ! salt + ztmp3(ji,jj,3) = ( SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + SUM( SUM( e_s(ji,jj,:,:), dim=2 ) ) ) * e1e2t(ji,jj) ! heat ! ! -- fluxes -- ! ztmp3(ji,jj,4) = ( wfx_bog (ji,jj) + wfx_bom (ji,jj) + wfx_sum (ji,jj) + wfx_sni (ji,jj) & ! mass & + wfx_opw (ji,jj) + wfx_res (ji,jj) + wfx_dyn (ji,jj) + wfx_lam (ji,jj) + wfx_pnd(ji,jj) & & + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sub(ji,jj) & - & + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj) ) * e1e2t(ji,jj) + & + wfx_ice_sub(ji,jj) + wfx_spr (ji,jj) ) * e1e2t(ji,jj) ztmp3(ji,jj,5) = ( sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj) & ! salt & + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) ) * e1e2t(ji,jj) ztmp3(ji,jj,6) = ( hfx_sum(ji,jj) + hfx_bom(ji,jj) + hfx_bog(ji,jj) + hfx_dif(ji,jj) + hfx_opw(ji,jj) + hfx_snw(ji,jj) & ! heat @@ -147,12 +152,12 @@ CONTAINS ! -- min diags -- ! DO jl = 1, jpl DO_2D( 0, 0, 0, 0 ) - ztmp4(ji,jj,jl,1) = v_i(ji,jj,jl) - ztmp4(ji,jj,jl,2) = v_s(ji,jj,jl) - ztmp4(ji,jj,jl,3) = v_ip(ji,jj,jl) - ztmp4(ji,jj,jl,4) = v_il(ji,jj,jl) - ztmp4(ji,jj,jl,5) = a_i(ji,jj,jl) - ztmp4(ji,jj,jl,6) = sv_i(ji,jj,jl) + ztmp4(ji,jj,jl,1) = v_i (ji,jj,jl) + ztmp4(ji,jj,jl,2) = v_s (ji,jj,jl) + ztmp4(ji,jj,jl,3) = v_ip (ji,jj,jl) + ztmp4(ji,jj,jl,4) = v_il (ji,jj,jl) + ztmp4(ji,jj,jl,5) = a_i (ji,jj,jl) + ztmp4(ji,jj,jl,6) = zsv_i(ji,jj,jl) ztmp4(ji,jj,jl,7) = SUM( e_i(ji,jj,:,jl) ) ztmp4(ji,jj,jl,8) = SUM( e_s(ji,jj,:,jl) ) END_2D @@ -208,6 +213,7 @@ CONTAINS REAL(wp), DIMENSION(A2D(0),4) :: ztmp REAL(wp), DIMENSION(4) :: zchk !!------------------------------------------------------------------- + DO_2D( 0, 0, 0, 0 ) ! ztmp(ji,jj,1) = ( wfx_ice (ji,jj) + wfx_snw (ji,jj) + wfx_pnd (ji,jj) + wfx_spr(ji,jj) + wfx_sub(ji,jj) & @@ -255,20 +261,26 @@ CONTAINS LOGICAL :: ll_stop_s = .FALSE. LOGICAL :: ll_stop_t = .FALSE. CHARACTER(len=120) :: clnam ! filename for the output + REAL(wp), DIMENSION(A2D(0)) :: zsv_i !!------------------------------------------------------------------- + IF( nn_icesal == 4 ) THEN + zsv_i(:,:) = SUM( SUM( szv_i(A2D(0),:,:), dim=4 ), dim=3 ) + ELSE + zsv_i(:,:) = SUM( sv_i(A2D(0),:), dim=3 ) + ENDIF ! IF( icount == 0 ) THEN DO_2D( 0, 0, 0, 0 ) pdiag_v(ji,jj) = SUM( v_i(ji,jj,:) * rhoi + v_s(ji,jj,:) * rhos + ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow ) - pdiag_s(ji,jj) = SUM( sv_i(ji,jj,:) * rhoi ) + pdiag_s(ji,jj) = zsv_i(ji,jj) * rhoi pdiag_t(ji,jj) = SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + SUM( SUM( e_s(ji,jj,:,:), dim=2 ) ) ! mass flux pdiag_fv(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & & + wfx_opw(ji,jj) + wfx_res(ji,jj) + wfx_dyn(ji,jj) + wfx_lam(ji,jj) + wfx_pnd (ji,jj) & & + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) & - & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj) + & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr (ji,jj) ! salt flux pdiag_fs(ji,jj) = sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) & & + sfx_opw(ji,jj) + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) @@ -286,14 +298,14 @@ CONTAINS & + ( wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) & & + wfx_res(ji,jj) + wfx_dyn(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) & & + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) & - & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj) ) & + & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr (ji,jj) ) & & - pdiag_fv(ji,jj) END_2D IF( MAXVAL( ABS(zdiag_mass) ) > rchk_m * rn_icechk_cel ) ll_stop_m = .TRUE. ! ! -- salt diag -- ! DO_2D( 0, 0, 0, 0 ) - zdiag_salt(ji,jj) = ( SUM( sv_i(ji,jj,:) * rhoi ) - pdiag_s(ji,jj) ) * r1_Dt_ice & + zdiag_salt(ji,jj) = ( zsv_i (ji,jj) * rhoi - pdiag_s(ji,jj) ) * r1_Dt_ice & & + ( sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) & & + sfx_opw(ji,jj) + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) ) & & - pdiag_fs(ji,jj) @@ -406,7 +418,14 @@ CONTAINS REAL(wp) :: ztmelts ! ice layer melting point CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive + REAL(wp), DIMENSION(A2D(0),jpl) :: zsv_i !!------------------------------------------------------------------- + IF( nn_icesal == 4 ) THEN + zsv_i(:,:,:) = SUM( szv_i(A2D(0),:,:), dim=3 ) + ELSE + zsv_i(:,:,:) = sv_i(A2D(0),:) + ENDIF + ! inb_alp(:) = 0 ialert_id = 0 @@ -416,8 +435,8 @@ CONTAINS DO jl = 1, jpl DO_2D( 0, 0, 0, 0 ) IF( v_i(ji,jj,jl) > epsi10 ) THEN - IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN - WRITE(numout,*) ' ALERTE : Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) + IF( zsv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_sinew * sss_m(ji,jj) ) THEN + WRITE(numout,*) ' ALERTE : Very high salinity ',zsv_i(ji,jj,jl)/v_i(ji,jj,jl) WRITE(numout,*) ' at i,j,l = ',ji,jj,jl inb_alp(ialert_id) = inb_alp(ialert_id) + 1 ENDIF @@ -431,8 +450,8 @@ CONTAINS DO jl = 1, jpl DO_2D( 0, 0, 0, 0 ) IF( v_i(ji,jj,jl) > epsi10 ) THEN - IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN - WRITE(numout,*) ' ALERTE : Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) + IF( zsv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN + WRITE(numout,*) ' ALERTE : Very low salinity ',zsv_i(ji,jj,jl),v_i(ji,jj,jl) WRITE(numout,*) ' at i,j,l = ',ji,jj,jl inb_alp(ialert_id) = inb_alp(ialert_id) + 1 ENDIF diff --git a/src/ICE/icedyn.F90 b/src/ICE/icedyn.F90 index 8ea874d6f968762021ab3a56812e14b0ad2b6b26..63450e697eb04cf402b5cef925d6a52f6d9a383f 100644 --- a/src/ICE/icedyn.F90 +++ b/src/ICE/icedyn.F90 @@ -186,7 +186,7 @@ CONTAINS CALL lbc_lnk( 'icedyn', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, & & t_su, 'T', 1._wp, ldfull = .TRUE. ) ENDIF - CALL lbc_lnk( 'icedyn', e_i, 'T', 1._wp, e_s, 'T', 1._wp, ldfull = .TRUE. ) + CALL lbc_lnk( 'icedyn', e_i, 'T', 1._wp, e_s, 'T', 1._wp, szv_i, 'T', 1._wp, ldfull = .TRUE. ) ! controls IF( ln_timing ) CALL timing_stop ('ice_dyn') diff --git a/src/ICE/icedyn_adv.F90 b/src/ICE/icedyn_adv.F90 index 6afabac00bcf4adc66c8cbd98cfb577df3151843..252d13099b1733015f5e1f5986d959ff644296d7 100644 --- a/src/ICE/icedyn_adv.F90 +++ b/src/ICE/icedyn_adv.F90 @@ -82,12 +82,12 @@ CONTAINS CASE( np_advUMx ) ! ULTIMATE-MACHO scheme ! ! !-----------------------! CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, & - & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) + & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i, szv_i ) ! !-----------------------! CASE( np_advPRA ) ! PRATHER scheme ! ! !-----------------------! CALL ice_dyn_adv_pra( kt, u_ice, v_ice, h_i, h_s, h_ip, & - & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) + & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i, szv_i ) END SELECT !------------ diff --git a/src/ICE/icedyn_adv_pra.F90 b/src/ICE/icedyn_adv_pra.F90 index 7ad39b053816aeb5f6d3e879b0de8ee93e323ece..8f9bf15ed1a2b65167fe04e9b5f21f6b9fdc91dc 100644 --- a/src/ICE/icedyn_adv_pra.F90 +++ b/src/ICE/icedyn_adv_pra.F90 @@ -41,6 +41,7 @@ MODULE icedyn_adv_pra REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage ! ice age REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxc0 , syc0 , sxxc0 , syyc0 , sxyc0 ! snow layers heat content REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye ! ice layers heat content + REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxsi , sysi , sxxsi , syysi , sxysi ! ice layers salt content REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxap , syap , sxxap , syyap , sxyap ! melt pond fraction REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvp , syvp , sxxvp , syyvp , sxyvp ! melt pond volume REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvl , syvl , sxxvl , syyvl , sxyvl ! melt pond lid volume @@ -55,7 +56,7 @@ MODULE icedyn_adv_pra CONTAINS SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, & - & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) + & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i ) !!---------------------------------------------------------------------- !! ** routine ice_dyn_adv_pra ** !! @@ -84,6 +85,7 @@ CONTAINS REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid thickness REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content + REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i ! ice salt content ! INTEGER :: ji, jj, jk, jl, jt, ihls ! dummy loop indices INTEGER :: icycle ! number of sub-timestep for the advection @@ -92,20 +94,27 @@ CONTAINS REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication REAL(wp), DIMENSION(jpi,jpj) :: zati1 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx - REAL(wp), DIMENSION(jpi,jpj) :: zh_i, zh_s, zh_ip, zs_i, zhi_max, zhs_max, zhip_max, zsi_max - REAL(wp), DIMENSION(jpi,jpj,nlay_i) :: ze_i, zei_max + REAL(wp), DIMENSION(jpi,jpj) :: zh_i, zh_s, zhi_max, zhs_max, zhip_max, zsi_max + REAL(wp), DIMENSION(jpi,jpj,nlay_i) :: ze_i, zei_max, zszi_max REAL(wp), DIMENSION(jpi,jpj,nlay_s) :: ze_s, zes_max REAL(wp), DIMENSION(jpi,jpj) :: zarea - REAL(wp), DIMENSION(jpi,jpj) :: z0ice, z0snw, z0ai, z0smi, z0oi - REAL(wp), DIMENSION(jpi,jpj) :: z0ap , z0vp, z0vl + REAL(wp), DIMENSION(jpi,jpj) :: z0ice, z0snw, z0ai, z0oi REAL(wp), DIMENSION(jpi,jpj,nlay_s) :: z0es REAL(wp), DIMENSION(jpi,jpj,nlay_i) :: z0ei + REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z0ap , z0vp, z0vl, zh_ip + REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z0smi, zs_i + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0si , zsz_i !! diagnostics REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat !!---------------------------------------------------------------------- ! IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' ! + IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) ALLOCATE( z0ap(jpi,jpj), z0vp(jpi,jpj), z0vl(jpi,jpj), zh_ip(jpi,jpj) ) + IF( nn_icesal == 4 ) THEN ; ALLOCATE( z0si (jpi,jpj,nlay_i), zsz_i(jpi,jpj,nlay_i) ) + ELSE ; ALLOCATE( z0smi(jpi,jpj) , zs_i (jpi,jpj) ) + ENDIF + ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! ! Note: the advection split is applied at the next time-step in order to avoid blocking global comm. ! this should not affect too much the stability @@ -149,17 +158,16 @@ CONTAINS DO jl = 1, jpl ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! - ! thickness and salinity + ! thickness zh_i (:,:) = ph_i (:,:,jl) zh_s (:,:) = ph_s (:,:,jl) - zh_ip(:,:) = ph_ip(:,:,jl) - WHERE( pv_i(:,:,jl) >= epsi10 ) ; zs_i(:,:) = psv_i(:,:,jl) / pv_i(:,:,jl) - ELSEWHERE ; zs_i(:,:) = 0._wp - END WHERE CALL icemax2D_pra( ihls, zh_i , zhi_max ) CALL icemax2D_pra( ihls, zh_s , zhs_max ) - CALL icemax2D_pra( ihls, zh_ip, zhip_max) - CALL icemax2D_pra( ihls, zs_i , zsi_max ) + + IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN + zh_ip(:,:) = ph_ip(:,:,jl) + CALL icemax2D_pra( ihls, zh_ip, zhip_max) + ENDIF ! ! enthalpies DO jk = 1, nlay_i @@ -174,41 +182,72 @@ CONTAINS END DO CALL icemax3D_pra( ihls, ze_i , zei_max ) CALL icemax3D_pra( ihls, ze_s , zes_max ) - + ! + ! salt content + IF( nn_icesal == 4 ) THEN + ! + DO jk = 1, nlay_i + WHERE( pv_i(:,:,jl) >= epsi10 ) ; zsz_i(:,:,jk) = pszv_i(:,:,jk,jl) / pv_i(:,:,jl) + ELSEWHERE ; zsz_i(:,:,jk) = 0._wp + END WHERE + END DO + CALL icemax3D_pra( ihls, zsz_i , zszi_max ) + ! + ELSE + ! + WHERE( pv_i(:,:,jl) >= epsi10 ) ; zs_i(:,:) = psv_i(:,:,jl) / pv_i(:,:,jl) + ELSEWHERE ; zs_i(:,:) = 0._wp + END WHERE + CALL icemax2D_pra( ihls, zs_i , zsi_max ) + ! + ENDIF + ! diagnostics DO_2D( 0, 0, 0, 0 ) zdiag_adv_mass(ji,jj) = pv_i (ji,jj,jl) * rhoi + pv_s (ji,jj,jl) * rhos & & + pv_ip(ji,jj,jl) * rhow + pv_il(ji,jj,jl) * rhow - zdiag_adv_salt(ji,jj) = psv_i(ji,jj,jl) * rhoi zdiag_adv_heat(ji,jj) = - SUM( pe_i(ji,jj,1:nlay_i,jl) ) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) END_2D + IF( nn_icesal == 4 ) THEN + DO_2D( 0, 0, 0, 0 ) + zdiag_adv_salt(ji,jj) = SUM( pszv_i(ji,jj,1:nlay_i,jl) ) * rhoi + END_2D + ELSE + DO_2D( 0, 0, 0, 0 ) + zdiag_adv_salt(ji,jj) = psv_i(ji,jj,jl) * rhoi + END_2D + ENDIF ! ! --- transported fields --- ! DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 ) zarea(ji,jj) = e1e2t(ji,jj) - z0snw(ji,jj) = pv_s (ji,jj,jl) * e1e2t(ji,jj) ! Snow volume - z0ice(ji,jj) = pv_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice volume - z0ai (ji,jj) = pa_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice area - z0smi(ji,jj) = psv_i(ji,jj,jl) * e1e2t(ji,jj) ! Salt content - z0oi (ji,jj) = poa_i(ji,jj,jl) * e1e2t(ji,jj) ! Age content - DO jk = 1, nlay_s - z0es(ji,jj,jk) = pe_s(ji,jj,jk,jl) * e1e2t(ji,jj) ! Snow heat content - END DO - DO jk = 1, nlay_i - z0ei(ji,jj,jk) = pe_i(ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice heat content - END DO + z0snw(ji,jj) = pv_s (ji,jj,jl) * e1e2t(ji,jj) ! Snow volume + z0ice(ji,jj) = pv_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice volume + z0ai (ji,jj) = pa_i (ji,jj,jl) * e1e2t(ji,jj) ! Ice area + z0oi (ji,jj) = poa_i(ji,jj,jl) * e1e2t(ji,jj) ! Age content END_2D + DO_3D( ihls+1, ihls+1, ihls+1, ihls+1, 1, nlay_s ) + z0es(ji,jj,jk) = pe_s(ji,jj,jk,jl) * e1e2t(ji,jj) ! Snow heat content + END_3D + DO_3D( ihls+1, ihls+1, ihls+1, ihls+1, 1, nlay_i ) + z0ei(ji,jj,jk) = pe_i (ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice heat content + END_3D + IF( nn_icesal == 4 ) THEN + DO_3D( ihls+1, ihls+1, ihls+1, ihls+1, 1, nlay_i ) + z0si(ji,jj,jk) = pszv_i(ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice salt content + END_3D + ELSE + DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 ) + z0smi(ji,jj) = psv_i(ji,jj,jl) * e1e2t(ji,jj) + END_2D + ENDIF IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 ) - z0ap(ji,jj) = pa_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond fraction - z0vp(ji,jj) = pv_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond volume + z0ap(ji,jj) = pa_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond fraction + z0vp(ji,jj) = pv_ip(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond volume + z0vl(ji,jj) = pv_il(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond lid volume END_2D - IF ( ln_pnd_lids ) THEN - DO_2D( ihls+1, ihls+1, ihls+1, ihls+1 ) - z0vl(ji,jj) = pv_il(ji,jj,jl) * e1e2t(ji,jj) ! Melt pond lid volume - END_2D - ENDIF ENDIF ! ! ----------------------- ! @@ -217,74 +256,102 @@ CONTAINS ! !--------------------------------------------! IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! ! !--------------------------------------------! - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume + ! ---------------------- ! + ! == mandatory fields == ! + ! ---------------------- ! + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity - CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) ! - DO jk = 1, nlay_s !--- snow heat content + DO jk = 1, nlay_s !--- snow heat content CALL adv_x( ihls, jl, zdt, zudy, 1._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), & & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) CALL adv_y( ihls, jl, zdt, zvdx, 0._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), & & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) END DO - DO jk = 1, nlay_i !--- ice heat content + DO jk = 1, nlay_i !--- ice heat content CALL adv_x( ihls, jl, zdt, zudy, 1._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), & & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) CALL adv_y( ihls, jl, zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), & & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) END DO + ! --------------------- ! + ! == optional fields == ! + ! --------------------- ! + IF( nn_icesal == 4 ) THEN + DO jk = 1, nlay_i !--- ice salt content + CALL adv_x( ihls, jl, zdt, zudy, 1._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), & + & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) ) + CALL adv_y( ihls, jl, zdt, zvdx, 0._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), & + & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) ) + END DO + ELSE + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity + CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) + ENDIF ! IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) - IF ( ln_pnd_lids ) THEN - CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume - CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) - ENDIF + CALL adv_x( ihls, jl, zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume + CALL adv_y( ihls, jl, zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) ENDIF ! !--------------------------------------------! ELSE !== even ice time step: adv_y then adv_x ==! ! !--------------------------------------------! - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume + ! ---------------------- ! + ! == mandatory fields == ! + ! ---------------------- ! + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity - CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) - DO jk = 1, nlay_s !--- snow heat content + ! + DO jk = 1, nlay_s !--- snow heat content CALL adv_y( ihls, jl, zdt, zvdx, 1._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), & & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) CALL adv_x( ihls, jl, zdt, zudy, 0._wp, zarea, z0es (:,:,jk) , sxc0(:,:,jk,:), & & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) END DO - DO jk = 1, nlay_i !--- ice heat content + DO jk = 1, nlay_i !--- ice heat content CALL adv_y( ihls, jl, zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), & & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) CALL adv_x( ihls, jl, zdt, zudy, 0._wp, zarea, z0ei(:,:,jk) , sxe(:,:,jk,:), & & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) END DO + ! --------------------- ! + ! == optional fields == ! + ! --------------------- ! + IF( nn_icesal == 4 ) THEN + DO jk = 1, nlay_i !--- ice salt content + CALL adv_y( ihls, jl, zdt, zvdx, 1._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), & + & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) ) + CALL adv_x( ihls, jl, zdt, zudy, 0._wp, zarea, z0si(:,:,jk) , sxsi (:,:,jk,:), & + & sxxsi(:,:,jk,:), sysi(:,:,jk,:), syysi(:,:,jk,:), sxysi(:,:,jk,:) ) + END DO + ELSE + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity + CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) + ENDIF + ! IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) - IF ( ln_pnd_lids ) THEN - CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume - CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) - ENDIF + CALL adv_y( ihls, jl, zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume + CALL adv_x( ihls, jl, zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) ENDIF ! ENDIF @@ -293,26 +360,30 @@ CONTAINS DO_2D( ihls, ihls, ihls, ihls ) pv_i (ji,jj,jl) = z0ice(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) pv_s (ji,jj,jl) = z0snw(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) - psv_i(ji,jj,jl) = z0smi(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) poa_i(ji,jj,jl) = z0oi (ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) pa_i (ji,jj,jl) = z0ai (ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) - DO jk = 1, nlay_s - pe_s(ji,jj,jk,jl) = z0es(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) - END DO - DO jk = 1, nlay_i - pe_i(ji,jj,jk,jl) = z0ei(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) - END DO END_2D + DO_3D( ihls, ihls, ihls, ihls, 1, nlay_s ) + pe_s(ji,jj,jk,jl) = z0es(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) + END_3D + DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i ) + pe_i(ji,jj,jk,jl) = z0ei(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) + END_3D + IF( nn_icesal == 4 ) THEN + DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i ) + pszv_i(ji,jj,jk,jl) = z0si(ji,jj,jk) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) + END_3D + ELSE + DO_2D( ihls, ihls, ihls, ihls ) + psv_i(ji,jj,jl) = z0smi(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) + END_2D + ENDIF IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN DO_2D( ihls, ihls, ihls, ihls ) pa_ip(ji,jj,jl) = z0ap(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) pv_ip(ji,jj,jl) = z0vp(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) + pv_il(ji,jj,jl) = z0vl(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) END_2D - IF ( ln_pnd_lids ) THEN - DO_2D( ihls, ihls, ihls, ihls ) - pv_il(ji,jj,jl) = z0vl(ji,jj) * r1_e1e2t(ji,jj) * tmask(ji,jj,1) - END_2D - ENDIF ENDIF ! --- diagnostics --- ! @@ -320,16 +391,25 @@ CONTAINS diag_adv_mass(ji,jj) = diag_adv_mass(ji,jj) + ( pv_i (ji,jj,jl) * rhoi + pv_s (ji,jj,jl) * rhos & & + pv_ip(ji,jj,jl) * rhow + pv_il(ji,jj,jl) * rhow & & - zdiag_adv_mass(ji,jj) ) * z1_dt - diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( psv_i(ji,jj,jl) * rhoi & - & - zdiag_adv_salt(ji,jj) ) * z1_dt diag_adv_heat(ji,jj) = diag_adv_heat(ji,jj) + ( -SUM( pe_i(ji,jj,1:nlay_i,jl) ) -SUM( pe_s(ji,jj,1:nlay_s,jl) ) & & - zdiag_adv_heat(ji,jj) ) * z1_dt END_2D + IF( nn_icesal == 4 ) THEN + DO_2D( 0, 0, 0, 0 ) + diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( pszv_i(ji,jj,1:nlay_i,jl) ) * rhoi & + & - zdiag_adv_salt(ji,jj) ) * z1_dt + END_2D + ELSE + DO_2D( 0, 0, 0, 0 ) + diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( psv_i(ji,jj,jl) * rhoi & + & - zdiag_adv_salt(ji,jj) ) * z1_dt + END_2D + ENDIF ! --- Make sure ice thickness is not too big --- ! ! (because ice thickness can be too large where ice concentration is very small) - CALL Hbig_pra( ihls, jl, zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & - & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) + CALL Hbig_pra( ihls, jl, zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, zszi_max, & + & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i ) ! ! --- Ensure snow load is not too big --- ! CALL Hsnow_pra( ihls, jl, zdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) @@ -350,36 +430,56 @@ CONTAINS ! --- Ensure non-negative fields --- ! ! Remove negative values (conservation is ensured) ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) - CALL ice_var_zapneg( ihls, zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) + CALL ice_var_zapneg( ihls, zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i ) ! ! --- Lateral boundary conditions --- ! ! caution: for gradients (sx and sy) the sign changes ! plus, one needs ldfull=T to deal with the NorthFold IF( ihls == 0 .AND. jt /= icycle ) THEN ! comm. on all fields if ihls=0 and we are only at the 1st iteration (jt=1) over 2 (icycle=2) ! - CALL lbc_lnk( 'icedyn_adv_pra', pv_i , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume - & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp & - & , pv_s , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume - & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp & - & , psv_i , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity - & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp & - & , pa_i , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration - & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp & - & , poa_i , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age - & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp, ldfull = .TRUE. ) - CALL lbc_lnk( 'icedyn_adv_pra', pe_s , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy - & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp & - & , pe_i , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy - & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. ) IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN - CALL lbc_lnk( 'icedyn_adv_pra', pa_ip, 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction - & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp & - & , pv_ip, 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume - & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp & - & , pv_il, 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp & ! melt pond lid volume - & , sxxvl, 'T', 1._wp, syyvl, 'T', 1._wp, sxyvl, 'T', 1._wp, ldfull = .TRUE. ) + CALL lbc_lnk( 'icedyn_adv_pra', pv_i , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume + & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp & + & , pv_s , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume + & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp & + & , psv_i , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity + & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp & + & , pa_i , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration + & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp & + & , poa_i , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age + & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp & + & , pa_ip , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction + & , sxxap , 'T', 1._wp, syyap , 'T', 1._wp, sxyap , 'T', 1._wp & + & , pv_ip , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume + & , sxxvp , 'T', 1._wp, syyvp , 'T', 1._wp, sxyvp , 'T', 1._wp & + & , pv_il , 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp & ! melt pond lid volume + & , sxxvl , 'T', 1._wp, syyvl , 'T', 1._wp, sxyvl, 'T', 1._wp, ldfull = .TRUE. ) + ELSE + CALL lbc_lnk( 'icedyn_adv_pra', pv_i , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume + & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp & + & , pv_s , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume + & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp & + & , psv_i , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity + & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp & + & , pa_i , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration + & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp & + & , poa_i , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age + & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp, ldfull = .TRUE. ) + ENDIF + IF( nn_icesal == 4 ) THEN + CALL lbc_lnk( 'icedyn_adv_pra', pe_s , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy + & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp & + & , pe_i , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy + & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp & + & , pszv_i, 'T', 1._wp, sxsi , 'T', -1._wp, sysi , 'T', -1._wp & ! ice salt content + & , sxxsi , 'T', 1._wp, syysi , 'T', 1._wp, sxysi , 'T', 1._wp, ldfull = .TRUE. ) + ELSE + CALL lbc_lnk( 'icedyn_adv_pra', pe_s , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy + & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp & + & , pe_i , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy + & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. ) ENDIF - CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1.0_wp, ldfull = .TRUE. ) + CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1._wp, ldfull = .TRUE. ) ! ELSEIF( jt == icycle ) THEN ! comm. on the moments at the end of advection ! ! comm. on the other fields are gathered in icedyn.F90 @@ -412,10 +512,19 @@ CONTAINS & , sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp, ldfull = .TRUE. ) ENDIF - CALL lbc_lnk( 'icedyn_adv_pra', sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy - & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp & - & , sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy - & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. ) + IF( nn_icesal == 4 ) THEN + CALL lbc_lnk( 'icedyn_adv_pra', sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy + & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp & + & , sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy + & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp & + & , sxsi , 'T', -1._wp, sysi , 'T', -1._wp & ! ice salt content + & , sxxsi , 'T', 1._wp, syysi , 'T', 1._wp, sxysi , 'T', 1._wp, ldfull = .TRUE. ) + ELSE + CALL lbc_lnk( 'icedyn_adv_pra', sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy + & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp & + & , sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy + & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp, ldfull = .TRUE. ) + ENDIF ! ENDIF ! @@ -423,6 +532,12 @@ CONTAINS ! IF( lrst_ice ) CALL adv_pra_rst( 'WRITE', kt ) !* write Prather fields in the restart file ! + ! + IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) DEALLOCATE( z0ap , z0vp, z0vl, zh_ip ) + IF( nn_icesal == 4 ) THEN ; DEALLOCATE( z0si , zsz_i ) + ELSE ; DEALLOCATE( z0smi, zs_i ) + ENDIF + ! END SUBROUTINE ice_dyn_adv_pra @@ -446,6 +561,7 @@ CONTAINS !! INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji0, jj0 ! dummy loop indices + REAL(wp) :: z1_3 REAL(wp) :: zs1max, zslpmax ! local scalars REAL(wp) :: zs1new, zalf , zalf2, zalf3 ! - - REAL(wp) :: zs2new, z1malf, z1malf2, z1malf3 ! - - @@ -460,6 +576,7 @@ CONTAINS ji0 = 1 + ihls jj0 = NINT(pcrh) + ihls ! + z1_3 = 1._wp / 3._wp ! Limitation of moments. DO_2D( ji0, ji0, jj0, jj0 ) ! @@ -480,7 +597,7 @@ CONTAINS IF( zslpmax > 0._wp ) THEN zs1max = 1.5_wp * zslpmax zs1new = MIN( zs1max, MAX( -zs1max, zpsx ) ) - zs2new = MIN( 2._wp * zslpmax - 0.3334_wp * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsxx ) ) + zs2new = MIN( 2._wp * zslpmax - z1_3 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsxx ) ) ! zpsx = zs1new * tmask(ji,jj,1) zpsxx = zs2new * tmask(ji,jj,1) @@ -506,7 +623,7 @@ CONTAINS zalf3 = zalf2 * zalf z1malf2 = z1malf * z1malf z1malf3 = z1malf2 * z1malf - + ! zfm (ji,jj) = zalf * zpsm zf0 (ji,jj) = zalf * ( zps0 + z1malf * ( zpsx + (z1malf - zalf) * zpsxx ) ) zfx (ji,jj) = zalf2 * ( zpsx + 3._wp * z1malf * zpsxx ) @@ -514,6 +631,7 @@ CONTAINS zfy (ji,jj) = zalf * ( zpsy + z1malf * zpsxy ) zfyy(ji,jj) = zalf * zpsyy zfxy(ji,jj) = zalf2 * zpsxy + ! ! ! Readjust moments remaining in the box. zpsm = zpsm - zfm (ji,jj) zps0 = zps0 - zf0 (ji,jj) @@ -666,6 +784,7 @@ CONTAINS !! INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji0, jj0 ! dummy loop indices + REAL(wp) :: z1_3 REAL(wp) :: zs1max, zslpmax ! local scalars REAL(wp) :: zs1new, zalf , zalf2, zalf3 ! - - REAL(wp) :: zs2new, z1malf, z1malf2, z1malf3 ! - - @@ -680,6 +799,7 @@ CONTAINS ji0 = NINT(pcrh) + ihls jj0 = 1 + ihls ! + z1_3 = 1._wp / 3._wp ! Limitation of moments. DO_2D( ji0, ji0, jj0, jj0 ) ! @@ -698,9 +818,9 @@ CONTAINS zps0 = zslpmax ! IF( zslpmax > 0._wp ) THEN - zs1max = 1.5_wp * zslpmax - zs1new = MIN( zs1max, MAX( -zs1max, zpsy ) ) - zs2new = MIN( 2._wp * zslpmax - 0.3334_wp * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsyy ) ) + zs1max = 1.5_wp * zslpmax + zs1new = MIN( zs1max, MAX( -zs1max, zpsy ) ) + zs2new = MIN( 2._wp * zslpmax - z1_3 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsyy ) ) ! zpsx = zpsx * tmask(ji,jj,1) zpsxx = zpsxx * tmask(ji,jj,1) @@ -727,18 +847,18 @@ CONTAINS z1malf2 = z1malf * z1malf z1malf3 = z1malf2 * z1malf ! - zfm (ji,jj) = zalf * zpsm - zf0 (ji,jj) = zalf * ( zps0 + z1malf * ( zpsy + (z1malf - zalf) * zpsyy ) ) - zfy (ji,jj) = zalf2 * ( zpsy + 3._wp * z1malf * zpsyy ) - zfyy(ji,jj) = zalf3 * zpsyy - zfx (ji,jj) = zalf * ( zpsx + z1malf * zpsxy ) - zfxx(ji,jj) = zalf * zpsxx - zfxy(ji,jj) = zalf2 * zpsxy + zfm (ji,jj) = zalf * zpsm + zf0 (ji,jj) = zalf * ( zps0 + z1malf * ( zpsy + (z1malf - zalf) * zpsyy ) ) + zfy (ji,jj) = zalf2 * ( zpsy + 3._wp * z1malf * zpsyy ) + zfyy(ji,jj) = zalf3 * zpsyy + zfx (ji,jj) = zalf * ( zpsx + z1malf * zpsxy ) + zfxx(ji,jj) = zalf * zpsxx + zfxy(ji,jj) = zalf2 * zpsxy ! ! ! Readjust moments remaining in the box. zpsm = zpsm - zfm (ji,jj) zps0 = zps0 - zf0 (ji,jj) - zpsy = z1malf2 * ( zpsy -3._wp * zalf * zpsyy ) + zpsy = z1malf2 * ( zpsy - 3._wp * zalf * zpsyy ) zpsyy = z1malf3 * zpsyy zpsx = zpsx - zfx (ji,jj) zpsxx = zpsxx - zfxx(ji,jj) @@ -868,8 +988,8 @@ CONTAINS END SUBROUTINE adv_y - SUBROUTINE Hbig_pra( ihls, jcat, pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & - & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) + SUBROUTINE Hbig_pra( ihls, jcat, pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, pszi_max, & + & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i ) !!------------------------------------------------------------------- !! *** ROUTINE Hbig_pra *** !! @@ -888,10 +1008,11 @@ CONTAINS REAL(wp) , INTENT(in ) :: pdt ! tracer time-step REAL(wp), DIMENSION(:,:) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pes_max - REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pei_max + REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pei_max, pszi_max REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i + REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i ! INTEGER :: ji, jj, jk ! dummy loop indices REAL(wp) :: z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra @@ -938,18 +1059,36 @@ CONTAINS pv_s(ji,jj,jcat) = pa_i(ji,jj,jcat) * phs_max(ji,jj) ENDIF ! - ! ! -- check s_i -- ! - ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean - zsi = psv_i(ji,jj,jcat) / pv_i(ji,jj,jcat) - IF( zsi > psi_max(ji,jj) .AND. pa_i(ji,jj,jcat) < 0.15 ) THEN - zfra = psi_max(ji,jj) / zsi - zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jcat) * ( 1._wp - zfra ) * rhoi * z1_dt - psv_i(ji,jj,jcat) = psv_i(ji,jj,jcat) * zfra - ENDIF - ! ENDIF END_2D ! + ! ! -- check s_i -- ! + IF( nn_icesal == 4 ) THEN + DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i ) + IF ( pv_i(ji,jj,jcat) > 0._wp ) THEN + ! if szv_i/v_i is larger than the surrounding 9 pts => put the salt excess in the ocean + zsi = pszv_i(ji,jj,jk,jcat) / pv_i(ji,jj,jcat) + IF( zsi > pszi_max(ji,jj,jk) .AND. pa_i(ji,jj,jcat) < 0.15 ) THEN + zfra = pszi_max(ji,jj,jk) / zsi + zsfx_res(ji,jj) = zsfx_res(ji,jj) + pszv_i(ji,jj,jk,jcat) * ( 1._wp - zfra ) * rhoi * z1_dt + pszv_i(ji,jj,jk,jcat) = pszv_i(ji,jj,jk,jcat) * zfra + ENDIF + ENDIF + END_3D + ELSE + DO_2D( ihls, ihls, ihls, ihls ) + IF ( pv_i(ji,jj,jcat) > 0._wp ) THEN + ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean + zsi = psv_i(ji,jj,jcat) / pv_i(ji,jj,jcat) + IF( zsi > psi_max(ji,jj) .AND. pa_i(ji,jj,jcat) < 0.15 ) THEN + zfra = psi_max(ji,jj) / zsi + zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jcat) * ( 1._wp - zfra ) * rhoi * z1_dt + psv_i(ji,jj,jcat) = psv_i(ji,jj,jcat) * zfra + ENDIF + ! + ENDIF + END_2D + ENDIF ! ! -- check e_i/v_i -- ! DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i ) IF ( pv_i(ji,jj,jcat) > 0._wp ) THEN @@ -1054,28 +1193,52 @@ CONTAINS !! !! ** Purpose : allocate and initialize arrays for Prather advection !!------------------------------------------------------------------- - INTEGER :: ierr + INTEGER :: ierr(4), ii, ierr_max !!------------------------------------------------------------------- ! + ierr(:) = 0 + ii = 0 ! !* allocate prather fields - ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & - & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , & - & sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , & - & sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) , & - & sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) , & - & sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) , & - & sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) , & - & sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) , & - ! + ! ---------------------- ! + ! == mandatory fields == ! + ! ---------------------- ! + ii = ii + 1 + ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & + & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , & + & sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , & + & sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) , & & sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , & & syyc0(jpi,jpj,nlay_s,jpl) , sxyc0(jpi,jpj,nlay_s,jpl) , & - ! & sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe (jpi,jpj,nlay_i,jpl) , & & syye (jpi,jpj,nlay_i,jpl) , sxye (jpi,jpj,nlay_i,jpl) , & - & STAT = ierr ) + & STAT = ierr(ii) ) + ! + ! --------------------- ! + ! == optional fields == ! + ! --------------------- ! + ii = ii + 1 ! sxsal etc must be allocated for conveniency + ALLOCATE( sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) , & + & STAT = ierr(ii) ) + ! + ii = ii + 1 + IF( nn_icesal == 4 ) THEN + ALLOCATE( sxsi (jpi,jpj,nlay_i,jpl) , sysi (jpi,jpj,nlay_i,jpl) , sxxsi(jpi,jpj,nlay_i,jpl) , & + & syysi(jpi,jpj,nlay_i,jpl) , sxysi(jpi,jpj,nlay_i,jpl) , & + & STAT = ierr(ii) ) + ENDIF + ! + ii = ii + 1 + IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN + ALLOCATE( sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) , & + & sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) , & + & sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) , & + & STAT = ierr(ii) ) + ENDIF + ! + ierr_max = MAXVAL( ierr(:) ) ! - CALL mpp_sum( 'icedyn_adv_pra', ierr ) - IF( ierr /= 0 ) CALL ctl_stop('STOP', 'adv_pra_init : unable to allocate ice arrays for Prather advection scheme') + CALL mpp_sum( 'icedyn_adv_pra', ierr_max ) + IF( ierr_max /= 0 ) CALL ctl_stop('STOP', 'adv_pra_init : unable to allocate ice arrays for Prather advection scheme') ! CALL adv_pra_rst( 'READ' ) !* read or initialize all required files ! @@ -1111,6 +1274,9 @@ CONTAINS ! IF( id1 > 0 ) THEN !** Read the restart file **! ! + ! ---------------------- ! + ! == mandatory fields == ! + ! ---------------------- ! ! ! ice thickness CALL iom_get( numrir, jpdom_auto, 'sxice' , sxice , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'syice' , syice , psgn = -1._wp ) @@ -1129,12 +1295,6 @@ CONTAINS CALL iom_get( numrir, jpdom_auto, 'sxxa' , sxxa ) CALL iom_get( numrir, jpdom_auto, 'syya' , syya ) CALL iom_get( numrir, jpdom_auto, 'sxya' , sxya ) - ! ! ice salinity - CALL iom_get( numrir, jpdom_auto, 'sxsal' , sxsal , psgn = -1._wp ) - CALL iom_get( numrir, jpdom_auto, 'sysal' , sysal , psgn = -1._wp ) - CALL iom_get( numrir, jpdom_auto, 'sxxsal', sxxsal ) - CALL iom_get( numrir, jpdom_auto, 'syysal', syysal ) - CALL iom_get( numrir, jpdom_auto, 'sxysal', sxysal ) ! ! ice age CALL iom_get( numrir, jpdom_auto, 'sxage' , sxage , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'syage' , syage , psgn = -1._wp ) @@ -1149,11 +1309,11 @@ CONTAINS znam = 'syc0'//'_l'//zchar1 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; syc0 (:,:,jk,:) = z3d(:,:,:) znam = 'sxxc0'//'_l'//zchar1 - CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxc0(:,:,jk,:) = z3d(:,:,:) + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxc0(:,:,jk,:) = z3d(:,:,:) znam = 'syyc0'//'_l'//zchar1 - CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syyc0(:,:,jk,:) = z3d(:,:,:) + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syyc0(:,:,jk,:) = z3d(:,:,:) znam = 'sxyc0'//'_l'//zchar1 - CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxyc0(:,:,jk,:) = z3d(:,:,:) + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxyc0(:,:,jk,:) = z3d(:,:,:) END DO ! ! ice layers heat content DO jk = 1, nlay_i @@ -1163,39 +1323,73 @@ CONTAINS znam = 'sye'//'_l'//zchar1 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sye (:,:,jk,:) = z3d(:,:,:) znam = 'sxxe'//'_l'//zchar1 - CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:) + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:) znam = 'syye'//'_l'//zchar1 - CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:) + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:) znam = 'sxye'//'_l'//zchar1 - CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:) + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:) END DO ! - IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction + ! --------------------- ! + ! == optional fields == ! + ! --------------------- ! + ! ! ice salinity + IF( iom_varid( numrir, 'sxsal', ldstop = .FALSE. ) > 0 ) THEN + CALL iom_get( numrir, jpdom_auto, 'sxsal' , sxsal , psgn = -1._wp ) + CALL iom_get( numrir, jpdom_auto, 'sysal' , sysal , psgn = -1._wp ) + CALL iom_get( numrir, jpdom_auto, 'sxxsal', sxxsal ) + CALL iom_get( numrir, jpdom_auto, 'syysal', syysal ) + CALL iom_get( numrir, jpdom_auto, 'sxysal', sxysal ) + ELSE + sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp + ENDIF + ! ! ice layers salt content + IF( nn_icesal == 4 ) THEN + IF( iom_varid( numrir, 'sxsi_l01' , ldstop = .FALSE. ) > 0 ) THEN + DO jk = 1, nlay_i + WRITE(zchar1,'(I2.2)') jk + znam = 'sxsi'//'_l'//zchar1 + CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxsi (:,:,jk,:) = z3d(:,:,:) + znam = 'sysi'//'_l'//zchar1 + CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sysi (:,:,jk,:) = z3d(:,:,:) + znam = 'sxxsi'//'_l'//zchar1 + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxsi(:,:,jk,:) = z3d(:,:,:) + znam = 'syysi'//'_l'//zchar1 + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syysi(:,:,jk,:) = z3d(:,:,:) + znam = 'sxysi'//'_l'//zchar1 + CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxysi(:,:,jk,:) = z3d(:,:,:) + END DO + ELSE + sxsi = 0._wp ; sysi = 0._wp ; sxxsi = 0._wp ; syysi = 0._wp ; sxysi = 0._wp + ENDIF + ENDIF + ! + IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction IF( iom_varid( numrir, 'sxap', ldstop = .FALSE. ) > 0 ) THEN CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'syap' , syap , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap ) CALL iom_get( numrir, jpdom_auto, 'syyap', syyap ) CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap ) - ! ! melt pond volume + ! ! melt pond volume CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp ) CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp ) CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp ) ELSE - sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction - sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume + sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp + sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ENDIF - ! - IF( iom_varid( numrir, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN ! melt pond lid volume + ! ! melt pond lid volume + IF( iom_varid( numrir, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN CALL iom_get( numrir, jpdom_auto, 'sxvl' , sxvl , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'syvl' , syvl , psgn = -1._wp ) CALL iom_get( numrir, jpdom_auto, 'sxxvl', sxxvl ) CALL iom_get( numrir, jpdom_auto, 'syyvl', syyvl ) CALL iom_get( numrir, jpdom_auto, 'sxyvl', sxyvl ) ELSE - sxvl = 0._wp ; syvl = 0._wp ; sxxvl = 0._wp ; syyvl = 0._wp ; sxyvl = 0._wp ! melt pond lid volume + sxvl = 0._wp ; syvl = 0._wp ; sxxvl = 0._wp ; syyvl = 0._wp ; sxyvl = 0._wp ENDIF ENDIF ! @@ -1206,10 +1400,14 @@ CONTAINS sxice = 0._wp ; syice = 0._wp ; sxxice = 0._wp ; syyice = 0._wp ; sxyice = 0._wp ! ice thickness sxsn = 0._wp ; sysn = 0._wp ; sxxsn = 0._wp ; syysn = 0._wp ; sxysn = 0._wp ! snow thickness sxa = 0._wp ; sya = 0._wp ; sxxa = 0._wp ; syya = 0._wp ; sxya = 0._wp ! ice concentration - sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity sxage = 0._wp ; syage = 0._wp ; sxxage = 0._wp ; syyage = 0._wp ; sxyage = 0._wp ! ice age sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow layers heat content sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content + ! + sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity + IF( nn_icesal == 4 ) THEN + sxsi = 0._wp ; sysi = 0._wp ; sxxsi = 0._wp ; syysi = 0._wp ; sxysi = 0._wp ! ice layers salt content + ENDIF IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume @@ -1227,6 +1425,9 @@ CONTAINS ! In case Prather scheme is used for advection, write second order moments ! ------------------------------------------------------------------------ ! + ! ---------------------- ! + ! == mandatory fields == ! + ! ---------------------- ! ! ! ice thickness CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice ) CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice ) @@ -1245,12 +1446,6 @@ CONTAINS CALL iom_rstput( iter, nitrst, numriw, 'sxxa' , sxxa ) CALL iom_rstput( iter, nitrst, numriw, 'syya' , syya ) CALL iom_rstput( iter, nitrst, numriw, 'sxya' , sxya ) - ! ! ice salinity - CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal ) - CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal ) - CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal ) - CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal ) - CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal ) ! ! ice age CALL iom_rstput( iter, nitrst, numriw, 'sxage' , sxage ) CALL iom_rstput( iter, nitrst, numriw, 'syage' , syage ) @@ -1286,7 +1481,38 @@ CONTAINS CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) END DO ! - IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction + ! --------------------- ! + ! == optional fields == ! + ! --------------------- ! + ! + IF( nn_icesal == 4 ) THEN + ! ! ice layers salt content + DO jk = 1, nlay_i + WRITE(zchar1,'(I2.2)') jk + znam = 'sxsi'//'_l'//zchar1 ; z3d(:,:,:) = sxsi (:,:,jk,:) + CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) + znam = 'sysi'//'_l'//zchar1 ; z3d(:,:,:) = sysi (:,:,jk,:) + CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) + znam = 'sxxsi'//'_l'//zchar1 ; z3d(:,:,:) = sxxsi(:,:,jk,:) + CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) + znam = 'syysi'//'_l'//zchar1 ; z3d(:,:,:) = syysi(:,:,jk,:) + CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) + znam = 'sxysi'//'_l'//zchar1 ; z3d(:,:,:) = sxysi(:,:,jk,:) + CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) + END DO + ! + ELSE + ! ! ice salinity + CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal ) + CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal ) + CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal ) + CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal ) + CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal ) + ! + ENDIF + ! + IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN + ! ! melt pond fraction CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap ) CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap ) CALL iom_rstput( iter, nitrst, numriw, 'sxxap', sxxap ) @@ -1298,14 +1524,13 @@ CONTAINS CALL iom_rstput( iter, nitrst, numriw, 'sxxvp', sxxvp ) CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) + ! ! melt pond lid volume + CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl ) + CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl ) + CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl ) + CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl ) + CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl ) ! - IF ( ln_pnd_lids ) THEN ! melt pond lid volume - CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl ) - CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl ) - CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl ) - CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl ) - CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl ) - ENDIF ENDIF ! ENDIF diff --git a/src/ICE/icedyn_adv_umx.F90 b/src/ICE/icedyn_adv_umx.F90 index 755c002cb80be72346220f854dc0c99ce8d5d8ae..510de0bb2c6ea408c32293102add37ef1f16635c 100644 --- a/src/ICE/icedyn_adv_umx.F90 +++ b/src/ICE/icedyn_adv_umx.F90 @@ -59,7 +59,7 @@ MODULE icedyn_adv_umx CONTAINS SUBROUTINE ice_dyn_adv_umx( kn_umx, kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, & - & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) + & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i ) !!---------------------------------------------------------------------- !! *** ROUTINE ice_dyn_adv_umx *** !! @@ -87,6 +87,7 @@ CONTAINS REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content + REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i ! ice salt content ! INTEGER :: ji, jj, jk, jl, jt ! dummy loop indices INTEGER :: icycle ! number of sub-timestep for the advection @@ -98,28 +99,37 @@ CONTAINS REAL(wp), DIMENSION(jpi,jpj) :: zati1 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups - REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar - REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max, zs_i, zsi_max - REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i, zei_max - REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s, zes_max + REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , zhvar ! - REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs + REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i + REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s + REAL(wp), DIMENSION(A2D(0),jpl) :: zhi_max, zhs_max, zhip_max, zsi_max + REAL(wp), DIMENSION(A2D(0),nlay_i,jpl) :: zei_max, zszi_max + REAL(wp), DIMENSION(A2D(0),nlay_s,jpl) :: zes_max + ! + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z1_aip + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zs_i + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsz_i + ! + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs !! diagnostics - REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat + REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat !!---------------------------------------------------------------------- ! IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' ! + IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) ALLOCATE( z1_aip(jpi,jpj,jpl) ) + IF( nn_icesal == 4 ) THEN ; ALLOCATE( zsz_i (jpi,jpj,nlay_i,jpl) ) + ELSE ; ALLOCATE( zs_i (jpi,jpj,jpl) ) + ENDIF + ! ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! - ! thickness and salinity - WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) - ELSEWHERE ; zs_i(:,:,:) = 0._wp - END WHERE + ! thickness CALL icemax3D_umx( ph_i , zhi_max ) CALL icemax3D_umx( ph_s , zhs_max ) - CALL icemax3D_umx( ph_ip, zhip_max) - CALL icemax3D_umx( zs_i , zsi_max ) - CALL lbc_lnk( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) + IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN + CALL icemax3D_umx( ph_ip, zhip_max) + ENDIF ! ! enthalpies DO jk = 1, nlay_i @@ -134,7 +144,25 @@ CONTAINS END DO CALL icemax4D_umx( ze_i , zei_max ) CALL icemax4D_umx( ze_s , zes_max ) - CALL lbc_lnk( 'icedyn_adv_umx', zei_max, 'T', 1._wp, zes_max, 'T', 1._wp ) + ! + ! salt content + IF( nn_icesal == 4 ) THEN + ! + DO jk = 1, nlay_i + WHERE( pv_i(:,:,:) >= epsi10 ) ; zsz_i(:,:,jk,:) = pszv_i(:,:,jk,:) / pv_i(:,:,:) + ELSEWHERE ; zsz_i(:,:,jk,:) = 0._wp + END WHERE + END DO + CALL icemax4D_umx( zsz_i , zszi_max ) + ! + ELSE + ! + WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) + ELSEWHERE ; zs_i(:,:,:) = 0._wp + END WHERE + CALL icemax3D_umx( zs_i , zsi_max ) + ! + ENDIF ! ! ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! @@ -192,9 +220,11 @@ CONTAINS WHERE( pa_i(:,:,:) >= epsi20 ) ; z1_ai(:,:,:) = 1._wp / pa_i(:,:,:) ELSEWHERE ; z1_ai(:,:,:) = 0. END WHERE - WHERE( pa_ip(:,:,:) >= epsi20 ) ; z1_aip(:,:,:) = 1._wp / pa_ip(:,:,:) - ELSEWHERE ; z1_aip(:,:,:) = 0. - END WHERE + IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN + WHERE( pa_ip(:,:,:) >= epsi20 ) ; z1_aip(:,:,:) = 1._wp / pa_ip(:,:,:) + ELSEWHERE ; z1_aip(:,:,:) = 0. + END WHERE + ENDIF ! ! setup a mask where advection will be upstream IF( ll_neg ) THEN @@ -218,9 +248,17 @@ CONTAINS DO_2D( 0, 0, 0, 0 ) zdiag_adv_mass(ji,jj) = SUM( pv_i (ji,jj,:) ) * rhoi + SUM( pv_s (ji,jj,:) ) * rhos & & + SUM( pv_ip(ji,jj,:) ) * rhow + SUM( pv_il(ji,jj,:) ) * rhow - zdiag_adv_salt(ji,jj) = SUM( psv_i(ji,jj,:) ) * rhoi zdiag_adv_heat(ji,jj) = - SUM( SUM( pe_i(ji,jj,1:nlay_i,:), dim=2 ) ) - SUM( SUM( pe_s(ji,jj,1:nlay_s,:), dim=2 ) ) END_2D + IF( nn_icesal == 4 ) THEN + DO_2D( 0, 0, 0, 0 ) + zdiag_adv_salt(ji,jj) = SUM( SUM( pszv_i(ji,jj,:,:), dim=2 ) ) * rhoi + END_2D + ELSE + DO_2D( 0, 0, 0, 0 ) + zdiag_adv_salt(ji,jj) = SUM( psv_i(ji,jj,:) ) * rhoi + END_2D + ENDIF ! ! ----------------------- ! ! ==> start advection <== ! @@ -245,9 +283,6 @@ CONTAINS & zhvar, pv_s, zua_ups, zva_ups ) ! zamsk = 1._wp - !== Salt content ==! - CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & - & psv_i, psv_i ) !== Ice heat content ==! DO jk = 1, nlay_i CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & @@ -258,6 +293,16 @@ CONTAINS CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & & pe_s(:,:,jk,:), pe_s(:,:,jk,:) ) END DO + !== Ice salt content ==! + IF( nn_icesal == 4 ) THEN + DO jk = 1, nlay_i + CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & + & pszv_i(:,:,jk,:), pszv_i(:,:,jk,:) ) + END DO + ELSE + CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & + & psv_i, psv_i ) + ENDIF ! ! ! ------------------------------------------ ! ELSEIF( np_advS == 2 ) THEN ! -- advection form: -div( uA * uHS / u ) -- ! @@ -271,10 +316,6 @@ CONTAINS zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & & zhvar, pv_s, zua_ups, zva_ups ) - !== Salt content ==! - zhvar(:,:,:) = psv_i(:,:,:) * z1_ai(:,:,:) - CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & - & zhvar, psv_i, zua_ups, zva_ups ) !== Ice heat content ==! DO jk = 1, nlay_i zhvar(:,:,:) = pe_i(:,:,jk,:) * z1_ai(:,:,:) @@ -287,6 +328,18 @@ CONTAINS CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho, zva_ho, zcu_box, zcv_box, & & zhvar, pe_s(:,:,jk,:), zua_ups, zva_ups ) END DO + !== Ice salt content ==! + IF( nn_icesal == 4 ) THEN + DO jk = 1, nlay_i + zhvar(:,:,:) = pszv_i(:,:,jk,:) * z1_ai(:,:,:) + CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho, zva_ho, zcu_box, zcv_box, & + & zhvar, pszv_i(:,:,jk,:), zua_ups, zva_ups ) + END DO + ELSE + zhvar(:,:,:) = psv_i(:,:,:) * z1_ai(:,:,:) + CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & + & zhvar, psv_i, zua_ups, zva_ups ) + ENDIF ! ! ! ----------------------------------------- ! ELSEIF( np_advS == 3 ) THEN ! -- advection form: -div( uV * uS / u ) -- ! @@ -313,16 +366,24 @@ CONTAINS zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:) CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & & zhvar, pv_i, zuv_ups, zvv_ups, zuv_ho , zvv_ho ) - !== Salt content ==! - zhvar(:,:,:) = psv_i(:,:,:) * z1_vi(:,:,:) - CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zuv_ho , zvv_ho , zcu_box, zcv_box, & - & zhvar, psv_i, zuv_ups, zvv_ups ) !== Ice heat content ==! DO jk = 1, nlay_i zhvar(:,:,:) = pe_i(:,:,jk,:) * z1_vi(:,:,:) CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, & & zhvar, pe_i(:,:,jk,:), zuv_ups, zvv_ups ) END DO + !== Ice salt content ==! + IF( nn_icesal == 4 ) THEN + DO jk = 1, nlay_i + zhvar(:,:,:) = pszv_i(:,:,jk,:) * z1_vi(:,:,:) + CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, & + & zhvar, pszv_i(:,:,jk,:), zuv_ups, zvv_ups ) + END DO + ELSE + zhvar(:,:,:) = psv_i(:,:,:) * z1_vi(:,:,:) + CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zuv_ho , zvv_ho , zcu_box, zcv_box, & + & zhvar, psv_i, zuv_ups, zvv_ups ) + ENDIF !== Snow volume ==! zuv_ups = zua_ups zvv_ups = zva_ups @@ -357,12 +418,10 @@ CONTAINS CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & & zhvar, pv_ip, zua_ups, zva_ups ) ! lid - IF ( ln_pnd_lids ) THEN - zamsk = 0._wp - zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) - CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & - & zhvar, pv_il, zua_ups, zva_ups ) - ENDIF + zamsk = 0._wp + zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) + CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & + & zhvar, pv_il, zua_ups, zva_ups ) ENDIF !== Open water area ==! @@ -378,28 +437,38 @@ CONTAINS diag_adv_mass(ji,jj) = diag_adv_mass(ji,jj) + ( SUM( pv_i (ji,jj,:) ) * rhoi + SUM( pv_s (ji,jj,:) ) * rhos & & + SUM( pv_ip(ji,jj,:) ) * rhow + SUM( pv_il(ji,jj,:) ) * rhow & & - zdiag_adv_mass(ji,jj) ) * z1_dt - diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( psv_i(ji,jj,:) ) * rhoi & - & - zdiag_adv_salt(ji,jj) ) * z1_dt diag_adv_heat(ji,jj) = diag_adv_heat(ji,jj) + ( - SUM(SUM( pe_i(ji,jj,1:nlay_i,:) , dim=2 ) ) & & - SUM(SUM( pe_s(ji,jj,1:nlay_s,:) , dim=2 ) ) & & - zdiag_adv_heat(ji,jj) ) * z1_dt END_2D + IF( nn_icesal == 4 ) THEN + DO_2D( 0, 0, 0, 0 ) + diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( SUM( pszv_i(ji,jj,:,:), dim=2 ) ) * rhoi & + & - zdiag_adv_salt(ji,jj) ) * z1_dt + END_2D + ELSE + DO_2D( 0, 0, 0, 0 ) + diag_adv_salt(ji,jj) = diag_adv_salt(ji,jj) + ( SUM( psv_i(ji,jj,:) ) * rhoi & + & - zdiag_adv_salt(ji,jj) ) * z1_dt + END_2D + ENDIF ! --- Ensure non-negative fields and in-bound thicknesses --- ! ! Remove negative values (conservation is ensured) ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) - CALL ice_var_zapneg( 0, zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) + CALL ice_var_zapneg( 0, zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i ) ! ! --- Make sure ice thickness is not too big --- ! ! (because ice thickness can be too large where ice concentration is very small) - CALL Hbig_umx( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & - & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) + CALL Hbig_umx( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, zszi_max, & + & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i ) ! ! --- Ensure snow load is not too big --- ! CALL Hsnow_umx( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) ! ! --- Lateral boundary conditions --- ! IF( jt /= icycle ) THEN ! only if we have 2 cycles and we are at the 1st one + ! IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN CALL lbc_lnk( 'icedyn_adv_umx', pa_i , 'T', 1._wp, pv_i , 'T', 1._wp, pv_s , 'T', 1._wp, & & psv_i, 'T', 1._wp, poa_i, 'T', 1._wp, & @@ -408,13 +477,22 @@ CONTAINS CALL lbc_lnk( 'icedyn_adv_umx', pa_i , 'T', 1._wp, pv_i , 'T', 1._wp, pv_s , 'T', 1._wp, & & psv_i, 'T', 1._wp, poa_i, 'T', 1._wp ) ENDIF - CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp, pe_s, 'T', 1._wp ) + IF( nn_icesal == 4 ) THEN + CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp, pe_s, 'T', 1._wp, pszv_i, 'T', 1._wp ) + ELSE + CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp, pe_s, 'T', 1._wp ) + ENDIF CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1._wp ) + ! ENDIF ! - ! END DO ! + IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) DEALLOCATE( z1_aip ) + IF( nn_icesal == 4 ) THEN ; DEALLOCATE( zsz_i ) + ELSE ; DEALLOCATE( zs_i ) + ENDIF + ! END SUBROUTINE ice_dyn_adv_umx @@ -884,15 +962,6 @@ CONTAINS DO_2D( nn_hls-1, nn_hls-1, kloop, kloop ) ! Second derivative (Laplacian) ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) END_2D -!!$ DO jj = 2, jpjm1 ! First derivative (gradient) -!!$ DO ji = 1, jpim1 -!!$ ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) -!!$ END DO -!!$ ! ! Second derivative (Laplacian) -!!$ DO ji = 2, jpim1 -!!$ ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) -!!$ END DO -!!$ END DO END DO ! ! !-- BiLaplacian in i-direction --! @@ -903,15 +972,6 @@ CONTAINS DO_2D( 0, 0, kloop, kloop ) ! Fourth derivative ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) END_2D -!!$ DO jj = 2, jpjm1 ! Third derivative -!!$ DO ji = 1, jpim1 -!!$ ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) -!!$ END DO -!!$ ! ! Fourth derivative -!!$ DO ji = 2, jpim1 -!!$ ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) -!!$ END DO -!!$ END DO END DO ! ! @@ -1485,8 +1545,8 @@ CONTAINS END SUBROUTINE limiter_y - SUBROUTINE Hbig_umx( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & - & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) + SUBROUTINE Hbig_umx( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, pszi_max, & + & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i, pszv_i ) !!------------------------------------------------------------------- !! *** ROUTINE Hbig_umx *** !! @@ -1500,13 +1560,13 @@ CONTAINS !! !! ** input : Max thickness of the surrounding 9-points !!------------------------------------------------------------------- - REAL(wp) , INTENT(in ) :: pdt ! tracer time-step - REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts - REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pes_max - REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pei_max - REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i - REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s - REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i + REAL(wp) , INTENT(in ) :: pdt ! tracer time-step + REAL(wp), DIMENSION(A2D(0),jpl) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts + REAL(wp), DIMENSION(A2D(0),nlay_s,jpl), INTENT(in ) :: pes_max + REAL(wp), DIMENSION(A2D(0),nlay_i,jpl), INTENT(in ) :: pei_max, pszi_max + REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i + REAL(wp), DIMENSION(:,:,:,:) , INTENT(inout) :: pe_s + REAL(wp), DIMENSION(:,:,:,:) , INTENT(inout) :: pe_i, pszv_i ! INTEGER :: ji, jj, jk, jl ! dummy loop indices REAL(wp) :: z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra @@ -1547,19 +1607,42 @@ CONTAINS pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ENDIF ! - ! ! -- check s_i -- ! - ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean - zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) - IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN - zfra = psi_max(ji,jj,jl) / zsi - sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt - psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra - ENDIF - ! ENDIF END_2D END DO ! + ! ! -- check s_i -- ! + IF( nn_icesal == 4 ) THEN + DO jl = 1, jpl + DO_3D( 0, 0, 0, 0, 1, nlay_i ) + IF ( pv_i(ji,jj,jl) > 0._wp ) THEN + ! if szv_i/v_i is larger than the surrounding 9 pts => put the salt excess in the ocean + zsi = pszv_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) + IF( zsi > pszi_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN + zfra = pszi_max(ji,jj,jk,jl) / zsi + sfx_res(ji,jj) = sfx_res(ji,jj) + pszv_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * rhoi * z1_dt + pszv_i(ji,jj,jk,jl) = pszv_i(ji,jj,jk,jl) * zfra + ENDIF + ENDIF + END_3D + END DO + ELSE + DO jl = 1, jpl + DO_2D( 0, 0, 0, 0 ) + IF ( pv_i(ji,jj,jl) > 0._wp ) THEN + ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean + zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) + IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN + zfra = psi_max(ji,jj,jl) / zsi + sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt + psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra + ENDIF + ! + ENDIF + END_2D + END DO + ENDIF + ! ! ! -- check e_i/v_i -- ! DO jl = 1, jpl DO_3D( 0, 0, 0, 0, 1, nlay_i ) @@ -1648,8 +1731,8 @@ CONTAINS !! *** ROUTINE icemax3D_umx *** !! ** Purpose : compute the max of the 9 points around !!---------------------------------------------------------------------- - REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pice ! input - REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pmax ! output + REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pice ! input + REAL(wp), DIMENSION(A2D(0),jpl), INTENT(out) :: pmax ! output ! REAL(wp), DIMENSION(Nis0:Nie0) :: zmax1, zmax2 REAL(wp) :: zmax3 @@ -1688,9 +1771,15 @@ CONTAINS ! REAL(wp), DIMENSION(Nis0:Nie0) :: zmax1, zmax2 REAL(wp) :: zmax3 - INTEGER :: jlay, ji, jj, jk, jl ! dummy loop indices + INTEGER :: ihls, jlay, ji, jj, jk, jl ! dummy loop indices !!---------------------------------------------------------------------- jlay = SIZE( pice , 3 ) ! size of input arrays + + ! pmax is A2D(0), so it needs to be shifted by nn_hls in the loops below + IF( SIZE( pmax , 1 ) == jpi ) THEN ; ihls = 0 + ELSE ; ihls = nn_hls + ENDIF + ! basic version: get the max of epsi20 + 9 neighbours !!$ DO jl = 1, jpl !!$ DO jk = 1, jlay @@ -1710,7 +1799,7 @@ CONTAINS END DO DO_2D( 0, 0, 0, 0 ) zmax3 = MAX( epsi20, pice(ji,jj+1,jk,jl), pice(ji-1,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) - pmax(ji,jj,jk,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) + pmax(ji-ihls,jj-ihls,jk,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) zmax1(ji) = zmax2(ji) zmax2(ji) = zmax3 END_2D diff --git a/src/ICE/icedyn_rdgrft.F90 b/src/ICE/icedyn_rdgrft.F90 index ad7d1de81c22ea810c7dc50eb8257aa2b7da1db2..ffd5c0fcf49689414a267f7abb7af79175acbd5e 100644 --- a/src/ICE/icedyn_rdgrft.F90 +++ b/src/ICE/icedyn_rdgrft.F90 @@ -278,7 +278,7 @@ CONTAINS CALL ice_dyn_1d2d( 2 ) ! --- Move to 2D arrays --- ! ENDIF - ! clem: those fields must be updated on the halos: ato_i, a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, e_i, e_s + ! clem: those fields must be updated on the halos: ato_i, a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, e_i, e_s, szv_i ! clem: I think we can comment this line but I am not sure it does not change results !!$ CALL ice_var_agg( 1 ) @@ -561,10 +561,10 @@ CONTAINS REAL(wp) :: expL, expR ! exponentials involving hL, hR REAL(wp) :: vsw ! vol of water trapped into ridges REAL(wp) :: afrdg, afrft ! fraction of category area ridged/rafted - REAL(wp) :: airdg1, oirdg1, aprdg1, virdg1, sirdg1 - REAL(wp) :: airft1, oirft1, aprft1 - REAL(wp), DIMENSION(jpij) :: airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg ! area etc of new ridges - REAL(wp), DIMENSION(jpij) :: airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft ! area etc of rafted ice + REAL(wp) :: airdg1, airft1 + REAL(wp), DIMENSION(jpij) :: airdg2, oirdg, aprdg, virdg, vsrdg, vprdg, vlrdg ! area etc of new ridges + REAL(wp), DIMENSION(jpij) :: airft2, oirft, aprft, virft, vsrft, vprft, vlrft ! area etc of rafted ice + REAL(wp), DIMENSION(jpij,nlay_i) :: sirdg, sirft ! REAL(wp) :: ersw ! enthalpy of water trapped into ridges REAL(wp) :: zswitch, fvol ! new ridge volume going to jl2 @@ -590,7 +590,7 @@ CONTAINS ! 2) compute categories in which ice is removed (jl1) !---------------------------------------------------- - IF( nn_icesal /= 2 ) THEN + IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN CALL tab_3d_2d( npti, nptidx(1:npti), s_i_2d(1:npti,:), s_i(:,:,:) ) ENDIF @@ -628,42 +628,38 @@ CONTAINS ersw = -rhoi * vsw * rcp * sst_1d(ji) ! clem: if sst>0, then ersw <0 (is that possible?) ! volume etc of ridging / rafting ice and new ridges (vi, vs, sm, oi, es, ei) - virdg1 = v_i_2d (ji,jl1) * afrdg - virdg2(ji) = v_i_2d (ji,jl1) * afrdg + vsw - vsrdg(ji) = v_s_2d (ji,jl1) * afrdg - sirdg1 = sv_i_2d(ji,jl1) * afrdg - sirdg2(ji) = sv_i_2d(ji,jl1) * afrdg + vsw * sss_1d(ji) - oirdg1 = oa_i_2d(ji,jl1) * afrdg - oirdg2(ji) = oa_i_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) - - virft(ji) = v_i_2d (ji,jl1) * afrft - vsrft(ji) = v_s_2d (ji,jl1) * afrft - sirft(ji) = sv_i_2d(ji,jl1) * afrft - oirft1 = oa_i_2d(ji,jl1) * afrft - oirft2(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft + virdg(ji) = v_i_2d (ji,jl1) * afrdg + vsw + vsrdg(ji) = v_s_2d (ji,jl1) * afrdg + oirdg(ji) = oa_i_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) + + virft(ji) = v_i_2d (ji,jl1) * afrft + vsrft(ji) = v_s_2d (ji,jl1) * afrft + oirft(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN - aprdg1 = a_ip_2d(ji,jl1) * afrdg - aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) - vprdg (ji) = v_ip_2d(ji,jl1) * afrdg - aprft1 = a_ip_2d(ji,jl1) * afrft - aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft - vprft (ji) = v_ip_2d(ji,jl1) * afrft + aprdg(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) + vprdg(ji) = v_ip_2d(ji,jl1) * afrdg + aprft(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft + vprft(ji) = v_ip_2d(ji,jl1) * afrft IF ( ln_pnd_lids ) THEN - vlrdg (ji) = v_il_2d(ji,jl1) * afrdg - vlrft (ji) = v_il_2d(ji,jl1) * afrft + vlrdg(ji) = v_il_2d(ji,jl1) * afrdg + vlrft(ji) = v_il_2d(ji,jl1) * afrft ENDIF ENDIF - DO jk = 1, nlay_s - esrdg(ji,jk) = e_s_2d (ji,jk,jl1) * afrdg - esrft(ji,jk) = e_s_2d (ji,jk,jl1) * afrft - END DO - DO jk = 1, nlay_i - eirdg(ji,jk) = e_i_2d (ji,jk,jl1) * afrdg + ersw * r1_nlay_i - eirft(ji,jk) = e_i_2d (ji,jk,jl1) * afrft - END DO - + esrdg(ji,:) = e_s_2d (ji,:,jl1) * afrdg + esrft(ji,:) = e_s_2d (ji,:,jl1) * afrft + eirdg(ji,:) = e_i_2d (ji,:,jl1) * afrdg + ersw * r1_nlay_i + eirft(ji,:) = e_i_2d (ji,:,jl1) * afrft + + IF( nn_icesal == 4 ) THEN + sirdg(ji,:) = szv_i_2d(ji,:,jl1) * afrdg + vsw * sss_1d(ji) * r1_nlay_i + sirft(ji,:) = szv_i_2d(ji,:,jl1) * afrft + ELSE + sirdg(ji,1) = sv_i_2d (ji, jl1) * afrdg + vsw * sss_1d(ji) + sirft(ji,1) = sv_i_2d (ji, jl1) * afrft + ENDIF + ! Ice-ocean exchanges associated with ice porosity wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw * rhoi * r1_Dt_ice ! increase in ice volume due to seawater frozen in voids sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoi * r1_Dt_ice @@ -679,32 +675,30 @@ CONTAINS END DO ! virtual salt flux to keep salinity constant - IF( nn_icesal /= 2 ) THEN - sirdg2(ji) = sirdg2(ji) - ( sss_1d(ji) - s_i_2d(ji,jl1) ) * vsw ! ridge salinity = s_i + IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN + sirdg(ji,1) = sirdg(ji,1) - ( sss_1d(ji) - s_i_2d(ji,jl1) ) * vsw ! ridge salinity = s_i sfx_bri_1d(ji) = sfx_bri_1d(ji) + ( sss_1d(ji) - s_i_2d(ji,jl1) ) * vsw * rhoi * r1_Dt_ice ! put back sss_m into the ocean ! ! and get s_i from the ocean ENDIF ! Remove area, volume of new ridge to each category jl1 !------------------------------------------------------ - a_i_2d (ji,jl1) = a_i_2d (ji,jl1) - airdg1 - airft1 - v_i_2d (ji,jl1) = v_i_2d (ji,jl1) - virdg1 - virft(ji) - v_s_2d (ji,jl1) = v_s_2d (ji,jl1) - vsrdg(ji) - vsrft(ji) - sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1 - sirft(ji) - oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1 - oirft1 + a_i_2d (ji,jl1) = a_i_2d (ji,jl1) - airdg1 - airft1 + v_i_2d (ji,jl1) = v_i_2d (ji,jl1) * ( 1._wp - afrdg - afrft ) + v_s_2d (ji,jl1) = v_s_2d (ji,jl1) * ( 1._wp - afrdg - afrft ) + oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) * ( 1._wp - afrdg - afrft ) IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN - a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1 - aprft1 - v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) - IF ( ln_pnd_lids ) THEN - v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) - ENDIF + a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) * ( 1._wp - afrdg - afrft ) + v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) * ( 1._wp - afrdg - afrft ) + IF ( ln_pnd_lids ) v_il_2d(ji,jl1) = v_il_2d(ji,jl1) * ( 1._wp - afrdg - afrft ) + ENDIF + ! + e_s_2d(ji,:,jl1) = e_s_2d(ji,:,jl1) * ( 1._wp - afrdg - afrft ) + e_i_2d(ji,:,jl1) = e_i_2d(ji,:,jl1) * ( 1._wp - afrdg - afrft ) + ! + IF( nn_icesal == 4 ) THEN ; szv_i_2d(ji,:,jl1) = szv_i_2d(ji,:,jl1) * ( 1._wp - afrdg - afrft ) + ELSE ; sv_i_2d (ji, jl1) = sv_i_2d (ji, jl1) * ( 1._wp - afrdg - afrft ) ENDIF - DO jk = 1, nlay_s - e_s_2d(ji,jk,jl1) = e_s_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft ) - END DO - DO jk = 1, nlay_i - e_i_2d(ji,jk,jl1) = e_i_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft ) - END DO ENDIF @@ -784,30 +778,24 @@ CONTAINS ! ! Add area, volume of new ridge to category jl2 !---------------------------------------------- - a_i_2d (ji,jl2) = a_i_2d (ji,jl2) + ( airdg2(ji) * farea + airft2(ji) * zswitch ) - oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ( oirdg2(ji) * farea + oirft2(ji) * zswitch ) - v_i_2d (ji,jl2) = v_i_2d (ji,jl2) + ( virdg2(ji) * fvol + virft (ji) * zswitch ) - sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ( sirdg2(ji) * fvol + sirft (ji) * zswitch ) - v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol + & - & vsrft (ji) * rn_fsnwrft * zswitch ) + a_i_2d (ji,jl2) = a_i_2d (ji,jl2) + ( airdg2(ji) * farea + airft2(ji) * zswitch ) + oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ( oirdg (ji) * farea + oirft (ji) * zswitch ) + v_i_2d (ji,jl2) = v_i_2d (ji,jl2) + ( virdg (ji) * fvol + virft (ji) * zswitch ) + v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol + vsrft (ji) * rn_fsnwrft * zswitch ) IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN - v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg (ji) * rn_fpndrdg * fvol & - & + vprft (ji) * rn_fpndrft * zswitch ) - a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + ( aprdg2(ji) * rn_fpndrdg * farea & - & + aprft2(ji) * rn_fpndrft * zswitch ) + v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg(ji) * rn_fpndrdg * fvol + vprft(ji) * rn_fpndrft * zswitch ) + a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + ( aprdg(ji) * rn_fpndrdg * farea + aprft(ji) * rn_fpndrft * zswitch ) IF ( ln_pnd_lids ) THEN - v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + ( vlrdg(ji) * rn_fpndrdg * fvol & - & + vlrft(ji) * rn_fpndrft * zswitch ) + v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + ( vlrdg(ji) * rn_fpndrdg * fvol + vlrft(ji) * rn_fpndrft * zswitch ) ENDIF ENDIF - DO jk = 1, nlay_s - e_s_2d(ji,jk,jl2) = e_s_2d(ji,jk,jl2) + ( esrdg(ji,jk) * rn_fsnwrdg * fvol + & - & esrft(ji,jk) * rn_fsnwrft * zswitch ) - END DO - DO jk = 1, nlay_i - e_i_2d(ji,jk,jl2) = e_i_2d(ji,jk,jl2) + eirdg(ji,jk) * fvol + eirft(ji,jk) * zswitch - END DO - + e_s_2d(ji,:,jl2) = e_s_2d(ji,:,jl2) + ( esrdg(ji,:) * rn_fsnwrdg * fvol + esrft(ji,:) * rn_fsnwrft * zswitch ) + e_i_2d(ji,:,jl2) = e_i_2d(ji,:,jl2) + ( eirdg(ji,:) * fvol + eirft(ji,:) * zswitch ) + IF( nn_icesal == 4 ) THEN + szv_i_2d(ji,:,jl2) = szv_i_2d(ji,:,jl2) + ( sirdg(ji,:) * fvol + sirft(ji,:) * zswitch ) + ELSE + sv_i_2d (ji, jl2) = sv_i_2d (ji, jl2) + ( sirdg(ji,1) * fvol + sirft(ji,1) * zswitch ) + ENDIF ENDIF END DO @@ -819,7 +807,7 @@ CONTAINS ! roundoff errors !---------------- ! In case ridging/rafting lead to very small negative values (sometimes it happens) - CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d ) + CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d, szv_i_2d ) ! END SUBROUTINE rdgrft_shift @@ -999,14 +987,15 @@ CONTAINS !!CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti), ato_i(:,:) ) !!CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d(1:npti,:), a_i(:,:,:) ) !!CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:), v_i (:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i(:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i(:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip(:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip(:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il(:,:,:) ) - CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) - CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) ) + CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) ) + CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i(:,:,:) ) + CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip(:,:,:) ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip(:,:,:) ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il(:,:,:) ) + CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) + CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_4d_3d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i ) CALL tab_2d_1d( npti, nptidx(1:npti), sfx_dyn_1d (1:npti), sfx_dyn (:,:) ) CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bri_1d (1:npti), sfx_bri (:,:) ) CALL tab_2d_1d( npti, nptidx(1:npti), wfx_dyn_1d (1:npti), wfx_dyn (:,:) ) @@ -1018,16 +1007,17 @@ CONTAINS CASE( 2 ) !== from 1D to 2D ==! ! !---------------------! CALL tab_1d_2d( npti, nptidx(1:npti), ato_i_1d(1:npti) , ato_i(:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i(:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i(:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip(:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip(:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il(:,:,:) ) - CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) - CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s (:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i(:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip(:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip(:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il(:,:,:) ) + CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) + CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_3d_4d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i ) CALL tab_1d_2d( npti, nptidx(1:npti), sfx_dyn_1d (1:npti), sfx_dyn (:,:) ) CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bri_1d (1:npti), sfx_bri (:,:) ) CALL tab_1d_2d( npti, nptidx(1:npti), wfx_dyn_1d (1:npti), wfx_dyn (:,:) ) diff --git a/src/ICE/iceistate.F90 b/src/ICE/iceistate.F90 index dfba3873bfadde6c3c11c8de860642bdcc5d361b..9f72fda344be71d66bac77f23a2e6e47e282d671 100644 --- a/src/ICE/iceistate.F90 +++ b/src/ICE/iceistate.F90 @@ -109,15 +109,13 @@ CONTAINS ! INTEGER :: ji, jj, jk, jl ! dummy loop indices REAL(wp) :: ztmelts, zsshadj, area - INTEGER , DIMENSION(4) :: itest - REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator - REAL(wp), DIMENSION(A2D(0)) :: zmsk ! ice indicator - REAL(wp), DIMENSION(A2D(0)) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file - REAL(wp), DIMENSION(A2D(0)) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file - REAL(wp), DIMENSION(A2D(0)) :: zapnd_ini, zhpnd_ini, zhlid_ini !data from namelist or nc file - REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !temporary arrays - !! - REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d + INTEGER , DIMENSION(4) :: itest + REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing temperature (degC) + REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator + REAL(wp), DIMENSION(jpi,jpj) :: zmsk ! ice indicator + REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file + REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file + REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini, zhlid_ini !data from namelist or nc file !-------------------------------------------------------------------- IF(lwp) WRITE(numout,*) @@ -132,8 +130,8 @@ CONTAINS CALL eos_fzp( sss_m(:,:), t_bo(:,:), kbnd=0 ) t_bo(:,:) = ( t_bo(:,:) + rt0 ) * smask0(:,:) ! + ! == reduced arrays == ! DO jl = 1, jpl - ! == reduced arrays == ! DO_2D( 0, 0, 0, 0 ) ! cnd_ice(ji,jj,jl) = 0._wp ! conductivity at the ice top @@ -144,19 +142,27 @@ CONTAINS a_ip_eff(ji,jj,jl) = 0._wp ! melt pond effective fraction END_2D ! - ! == full arrays == ! + ENDDO + + ! == full arrays == ! + DO jl = 1, jpl + ! + DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) + ! heat + e_i(ji,jj,jk,jl) = 0._wp + t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! ice temp + ! salt + szv_i(ji,jj,jk,jl) = 0._wp + sz_i (ji,jj,jk,jl) = rn_simin * tmask(ji,jj,1) + END_3D + + DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) + ! heat + e_s(ji,jj,jk,jl) = 0._wp + t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! snw temp + END_3D + ! DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) - ! - ! heat contents - DO jk = 1, nlay_i - e_i(ji,jj,jk,jl) = 0._wp - t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! ice temp - ENDDO - DO jk = 1, nlay_s - e_s(ji,jj,jk,jl) = 0._wp - t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! snw temp - ENDDO - ! ! general fields a_i (ji,jj,jl) = 0._wp v_i (ji,jj,jl) = 0._wp @@ -197,30 +203,30 @@ CONTAINS ! !---------------! IF( nn_iceini_file == 1 )THEN ! Read a file ! ! !---------------! - WHERE( ff_t(A2D(0)) >= 0._wp ) ; zmsk(:,:) = 1._wp - ELSEWHERE ; zmsk(:,:) = 0._wp + WHERE( ff_t(:,:) >= 0._wp ) ; zmsk(:,:) = 1._wp + ELSEWHERE ; zmsk(:,:) = 0._wp END WHERE ! CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step ! ! -- mandatory fields -- ! - zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * smask0(:,:) - zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * smask0(:,:) - zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * smask0(:,:) + zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) + zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) + zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) ! -- optional fields -- ! ! if fields do not exist then set them to the values present in the namelist (except for temperatures) ! ! ice salinity IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & - & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zmsk + rn_smi_ini_s * (1._wp - zmsk) ) * smask0(:,:) + & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zmsk + rn_smi_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) ! ! temperatures IF ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & & TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN - si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zmsk + rn_tmi_ini_s * (1._wp - zmsk) ) * smask0(:,:) - si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zmsk + rn_tsu_ini_s * (1._wp - zmsk) ) * smask0(:,:) - si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zmsk + rn_tms_ini_s * (1._wp - zmsk) ) * smask0(:,:) + si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zmsk + rn_tmi_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) + si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zmsk + rn_tsu_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) + si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zmsk + rn_tms_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) ENDIF IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 & si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) @@ -237,35 +243,36 @@ CONTAINS ! ! pond concentration IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & - & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zmsk + rn_apd_ini_s * (1._wp - zmsk) ) * smask0(:,:) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. + & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zmsk + rn_apd_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. & * si(jp_ati)%fnow(:,:,1) ! ! pond depth IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & - & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zmsk + rn_hpd_ini_s * (1._wp - zmsk) ) * smask0(:,:) + & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zmsk + rn_hpd_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) ! ! pond lid depth IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) & - & si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zmsk + rn_hld_ini_s * (1._wp - zmsk) ) * smask0(:,:) + & si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zmsk + rn_hld_ini_s * (1._wp - zmsk) ) * tmask(:,:,1) ! - zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * smask0(:,:) - ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * smask0(:,:) - zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * smask0(:,:) - ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * smask0(:,:) - zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * smask0(:,:) - zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * smask0(:,:) - zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * smask0(:,:) + zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) + ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) + zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) + ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) + zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) + zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) + zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * tmask(:,:,1) ! ! !---------------! ELSE ! Read namelist ! ! !---------------! ! no ice if (sst - Tfreez) >= thresold - WHERE( ( sst_m(A2D(0)) - (t_bo(:,:) - rt0) ) * smask0(:,:) >= rn_thres_sst ) ; zmsk(:,:) = 0._wp - ELSEWHERE ; zmsk(:,:) = smask0(:,:) + CALL eos_fzp( sss_m(:,:), ztfrz(:,:), kbnd=nn_hls ) + WHERE( ( sst_m(:,:) - ztfrz(:,:) ) * tmask(:,:,1) >= rn_thres_sst ) ; zmsk(:,:) = 0._wp + ELSEWHERE ; zmsk(:,:) = tmask(:,:,1) END WHERE ! ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array - WHERE( ff_t(A2D(0)) >= 0._wp ) + WHERE( ff_t(:,:) >= 0._wp ) zht_i_ini(:,:) = rn_hti_ini_n * zmsk(:,:) zht_s_ini(:,:) = rn_hts_ini_n * zmsk(:,:) zat_i_ini(:,:) = rn_ati_ini_n * zmsk(:,:) @@ -305,64 +312,25 @@ CONTAINS !----------------! ! 3) fill fields ! !----------------! - ! select ice covered grid points - npti = 0 ; nptidx(:) = 0 - DO_2D( 0, 0, 0, 0 ) - IF ( zht_i_ini(ji,jj) > 0._wp ) THEN - npti = npti + 1 - nptidx(npti) = (jj - 1) * jpi + ji - ENDIF - END_2D - - ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) - CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) - CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti) , zhlid_ini ) - - ! allocate temporary arrays - ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & - & zti_2d (npti,jpl), zts_2d (npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), & - & zaip_2d(npti,jpl), zhip_2d(npti,jpl), zhil_2d(npti,jpl) ) - ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) - CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & - & zhi_2d , zhs_2d , zai_2d , & - & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), & - & s_i_1d(1:npti) , a_ip_1d(1:npti) , h_ip_1d(1:npti), h_il_1d(1:npti), & - & zti_2d , zts_2d , ztsu_2d , & - & zsi_2d , zaip_2d , zhip_2d , zhil_2d ) - - ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) + DO jj = 1, jpj + CALL ice_var_itd( zht_i_ini(:,jj) , zht_s_ini(:,jj) , zat_i_ini(:,jj) , & ! <<= in + & h_i (:,jj,:) , h_s (:,jj,:) , a_i (:,jj,:) , & ! =>> out + & ztm_i_ini(:,jj) , ztm_s_ini(:,jj) , zt_su_ini(:,jj) , zsm_i_ini(:,jj) , & ! <<= in + & zapnd_ini(:,jj) , zhpnd_ini(:,jj) , zhlid_ini(:,jj) , & ! <<= in + & t_i (:,jj,1,:) , t_s (:,jj,1,:) , t_su (:,jj,:) , s_i(:,jj,:) , & ! =>> out + & a_ip (:,jj,:) , h_ip (:,jj,:) , h_il (:,jj,:) ) ! =>> out + ENDDO DO jl = 1, jpl - zti_3d(:,:,jl) = rt0 * tmask(:,:,1) - zts_3d(:,:,jl) = rt0 * tmask(:,:,1) - END DO - CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) - CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) - CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) - CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) - CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) - CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) - CALL tab_2d_3d( npti, nptidx(1:npti), zhil_2d , h_il ) - - ! deallocate temporary arrays - DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & - & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d ) - - ! this call is needed because of the calculations above that are done only in the interior - CALL lbc_lnk( 'iceistate', a_i , 'T', 1._wp, h_i , 'T', 1._wp, h_s , 'T', 1._wp, & - & zti_3d, 'T', 1._wp, zts_3d, 'T', 1._wp, t_su, 'T', 1._wp, & - & s_i , 'T', 1._wp, a_ip , 'T', 1._wp, h_ip, 'T', 1._wp, h_il, 'T', 1._wp ) + DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nlay_s ) + t_s(ji,jj,jk,jl) = t_s(ji,jj,1,jl) + END_3D + ENDDO + DO jl = 1, jpl + DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nlay_i ) + t_i(ji,jj,jk,jl) = t_i(ji,jj,1,jl) + END_3D + ENDDO ! switch for the following WHERE( SUM(a_i(:,:,:),dim=3) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) @@ -370,18 +338,23 @@ CONTAINS END WHERE ! calculate extensive and intensive variables + DO jl = 1, jpl + DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) + s_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_sinew * sss_m(ji,jj) ) + END_2D + END DO CALL ice_var_salprof ! for sz_i + DO jl = 1, jpl DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) - sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) + sv_i(ji,jj,jl) = s_i(ji,jj,jl) * v_i(ji,jj,jl) END_2D END DO ! DO jl = 1, jpl DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) - t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) END_3D @@ -389,7 +362,9 @@ CONTAINS ! DO jl = 1, jpl DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) - t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) + ! salt + szv_i(ji,jj,jk,jl) = sz_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i + ! heat ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & @@ -543,8 +518,8 @@ CONTAINS ENDIF ! DO ifpr = 1, jpfldi - ALLOCATE( si(ifpr)%fnow(A2D(0),1) ) - IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(A2D(0),1,2) ) + ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) ) + IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) ) END DO ! ! fill si with slf_i and control print diff --git a/src/ICE/iceitd.F90 b/src/ICE/iceitd.F90 index 796c0bf03dfa2bea8254d26994a17c0fb252c11a..bef5ab878917b6ca3786733f20f9bb4849cfb40f 100644 --- a/src/ICE/iceitd.F90 +++ b/src/ICE/iceitd.F90 @@ -400,18 +400,19 @@ CONTAINS REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - - !!------------------------------------------------------------------ - CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i ) - CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s ) - CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i ) - CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i ) - CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il ) - CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,:) , t_su ) - CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) - CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s ) + CALL tab_3d_2d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il ) + CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d (1:npti,:) , t_su ) + CALL tab_4d_3d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) + CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_4d_3d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i ) ! to correct roundoff errors on a_i CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti), rn_amax_2d ) @@ -459,10 +460,6 @@ CONTAINS oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - ztrans oa_i_2d(ji,jl2) = oa_i_2d(ji,jl2) + ztrans ! - ztrans = sv_i_2d(ji,jl1) * zworkv ! Ice salinity - sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - ztrans - sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ztrans - ! ztrans = zaTsfn(ji,jl1) * zworka ! Surface temperature zaTsfn(ji,jl1) = zaTsfn(ji,jl1) - ztrans zaTsfn(ji,jl2) = zaTsfn(ji,jl2) + ztrans @@ -493,6 +490,18 @@ CONTAINS e_i_2d(ji,jk,jl1) = e_i_2d(ji,jk,jl1) - ztrans e_i_2d(ji,jk,jl2) = e_i_2d(ji,jk,jl2) + ztrans ENDDO + ! ! Ice salinity + IF( nn_icesal == 4 ) THEN + DO jk = 1, nlay_i + ztrans = szv_i_2d(ji,jk,jl1) * zworkv + szv_i_2d(ji,jk,jl1) = szv_i_2d(ji,jk,jl1) - ztrans + szv_i_2d(ji,jk,jl2) = szv_i_2d(ji,jk,jl2) + ztrans + ENDDO + ELSE + ztrans = sv_i_2d(ji,jl1) * zworkv + sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - ztrans + sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ztrans + ENDIF ! ENDIF ! jl1 >0 END DO @@ -504,7 +513,7 @@ CONTAINS !------------------- ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) ! because of truncation error ( i.e. 1. - 1. /= 0 ) - CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d ) + CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, e_s_2d, e_i_2d, szv_i_2d ) ! at_i must be <= rn_amax ztmp(1:npti) = SUM( a_i_2d(1:npti,:), dim=2 ) @@ -528,18 +537,19 @@ CONTAINS t_su_2d(1:npti,:) = rt0 END WHERE ! - CALL tab_2d_3d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s ) - CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d(1:npti,:) , oa_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,:) , sv_i ) - CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,:) , a_ip ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,:) , v_ip ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,:) , v_il ) - CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,:) , t_su ) - CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) - CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), h_i_2d (1:npti,:) , h_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_s_2d (1:npti,:) , v_s ) + CALL tab_2d_3d( npti, nptidx(1:npti), oa_i_2d (1:npti,:) , oa_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d (1:npti,:) , a_ip ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d (1:npti,:) , v_ip ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d (1:npti,:) , v_il ) + CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d (1:npti,:) , t_su ) + CALL tab_3d_4d( npti, nptidx(1:npti), e_s_2d (1:npti,:,:), e_s ) + CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_3d_4d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i ) ! END SUBROUTINE itd_shiftice diff --git a/src/ICE/icerst.F90 b/src/ICE/icerst.F90 index 5fb37070f6213f17a94c3d95129d1653ec40aacb..29c451d2e0d48ac00e035f171ae8add0d5f4c745 100644 --- a/src/ICE/icerst.F90 +++ b/src/ICE/icerst.F90 @@ -145,7 +145,6 @@ CONTAINS ! Prognostic variables CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i ) CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s ) - CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i ) CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i ) CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su ) CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) @@ -168,6 +167,16 @@ CONTAINS z3d(:,:,:) = e_i(:,:,jk,:) CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) END DO + ! Ice salt content + CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i ) + ! + DO jk = 1, nlay_i + WRITE(zchar1,'(I2.2)') jk + znam = 'szv_i'//'_l'//zchar1 + z3d(:,:,:) = szv_i(:,:,jk,:) + CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) + END DO + ! ! fields needed for Met Office (Jules) coupling IF( ln_cpl ) THEN CALL iom_rstput( iter, nitrst, numriw, 'cnd_ice', cnd_ice ) @@ -200,7 +209,7 @@ CONTAINS INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices INTEGER :: jk LOGICAL :: llok - INTEGER :: id0, id1, id2, id3, id4, id5 ! local integer + INTEGER :: id0, id1, id2, id3, id4, id5, id6 ! local integer CHARACTER(len=25) :: znam CHARACTER(len=2) :: zchar, zchar1 REAL(wp) :: zfice, ziter @@ -312,6 +321,21 @@ CONTAINS t1_ice (:,:,:) = rt0 ENDIF ENDIF + ! Ice salt content + id6 = iom_varid( numrir, 'szv_i_l01' , ldstop = .FALSE. ) + IF( id6 > 0 ) THEN ! fields exist + DO jk = 1, nlay_i + WRITE(zchar1,'(I2.2)') jk + znam = 'szv_i'//'_l'//zchar1 + CALL iom_get( numrir, jpdom_auto, znam , z3d ) + szv_i(:,:,jk,:) = z3d(:,:,:) + END DO + ELSE ! start from rest + IF(lwp) WRITE(numout,*) ' ==>> previous run without ice salt content per layer output then set it to bulk value' + DO jk = 1, nlay_i + szv_i(:,:,jk,:) = sv_i(:,:,:) * r1_nlay_i + ENDDO + ENDIF IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables ! ! ---------------------------------- ! diff --git a/src/ICE/icestp.F90 b/src/ICE/icestp.F90 index 5b4074175d55d544f6c3a0586dba864af8552bda..1103a1125f8103d7effbacd444a7c3f988756b7d 100644 --- a/src/ICE/icestp.F90 +++ b/src/ICE/icestp.F90 @@ -261,13 +261,12 @@ CONTAINS CALL Agrif_Declare_Var_ice ! " " " " " Sea ice #endif ! - ! ! Allocate the ice arrays (sbc_ice already allocated in sbc_init) + ! ! Allocate the 2D ice arrays (sbc_ice already allocated in sbc_init) ierr = ice_alloc () ! ice variables ierr = ierr + sbc_ice_alloc () ! surface boundary conditions - ierr = ierr + ice1D_alloc () ! thermodynamics ! CALL mpp_sum( 'icestp', ierr ) - IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays') + IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate 2D ice arrays') ! ! ! set max concentration in both hemispheres WHERE( gphit(:,:) > 0._wp ) ; rn_amax_2d(:,:) = rn_amax_n ! NH @@ -309,6 +308,12 @@ CONTAINS IF(lrxios) CALL iom_context_finalize( cr_icerst_cxt ) ENDIF ! + ! ! Allocate the 1D ice arrays + ierr = ice1D_alloc () ! thermodynamics + ! + CALL mpp_sum( 'icestp', ierr ) + IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate 1D ice arrays') + ! END SUBROUTINE ice_init @@ -398,8 +403,9 @@ CONTAINS h_i_b(ji,jj,jl) = 0._wp h_s_b(ji,jj,jl) = 0._wp ENDIF - e_s_b (ji,jj,:,jl) = e_s (ji,jj,:,jl) ! snow thermal energy - e_i_b (ji,jj,:,jl) = e_i (ji,jj,:,jl) ! ice thermal energy + e_s_b (ji,jj,:,jl) = e_s (ji,jj,:,jl) ! snow thermal energy + e_i_b (ji,jj,:,jl) = e_i (ji,jj,:,jl) ! ice thermal energy + szv_i_b(ji,jj,:,jl) = szv_i(ji,jj,:,jl) ! ice salt content END_2D ENDDO ! total concentration @@ -482,7 +488,7 @@ CONTAINS qml_ice (ji,jj,jl) = 0._wp ! surface melt heat flux ! Melt pond surface melt diagnostics (mv - more efficient: grouped into one water volume flux) dh_i_sum_2d(ji,jj,jl) = 0._wp - dh_s_mlt_2d(ji,jj,jl) = 0._wp + dh_s_sum_2d(ji,jj,jl) = 0._wp END_2D ENDDO @@ -505,17 +511,26 @@ CONTAINS ! DO_2D( 0, 0, 0, 0 ) diag_heat(ji,jj) = diag_heat(ji,jj) & - & - SUM(SUM( e_i (ji,jj,1:nlay_i,:) - e_i_b (ji,jj,1:nlay_i,:), dim=2 ) ) * r1_Dt_ice & - & - SUM(SUM( e_s (ji,jj,1:nlay_s,:) - e_s_b (ji,jj,1:nlay_s,:), dim=2 ) ) * r1_Dt_ice - diag_sice(ji,jj) = diag_sice(ji,jj) & - & + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * r1_Dt_ice * rhoi + & - SUM(SUM( e_i (ji,jj,1:nlay_i,:) - e_i_b (ji,jj,1:nlay_i,:), dim=2 ) ) * r1_Dt_ice & + & - SUM(SUM( e_s (ji,jj,1:nlay_s,:) - e_s_b (ji,jj,1:nlay_s,:), dim=2 ) ) * r1_Dt_ice diag_vice(ji,jj) = diag_vice(ji,jj) & - & + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * r1_Dt_ice * rhoi + & + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * r1_Dt_ice * rhoi diag_vsnw(ji,jj) = diag_vsnw(ji,jj) & - & + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * r1_Dt_ice * rhos + & + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * r1_Dt_ice * rhos diag_vpnd(ji,jj) = diag_vpnd(ji,jj) & - & + SUM( v_ip(ji,jj,:)+v_il(ji,jj,:) - v_ip_b(ji,jj,:)-v_il_b(ji,jj,:) ) * r1_Dt_ice * rhow + & + SUM( v_ip(ji,jj,:)+v_il(ji,jj,:) - v_ip_b(ji,jj,:)-v_il_b(ji,jj,:) ) * r1_Dt_ice * rhow END_2D + IF( nn_icesal == 4 ) THEN + DO_2D( 0, 0, 0, 0 ) + diag_sice(ji,jj) = diag_sice(ji,jj) & + & + SUM(SUM( szv_i(ji,jj,:,:) - szv_i_b(ji,jj,:,:) , dim=2 ) ) * r1_Dt_ice * rhoi + END_2D + ELSE + DO_2D( 0, 0, 0, 0 ) + diag_sice(ji,jj) = diag_sice(ji,jj) & + & + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * r1_Dt_ice * rhoi + END_2D + ENDIF ! IF( kn == 2 ) CALL iom_put ( 'hfxdhc' , diag_heat ) ! output of heat trend ! diff --git a/src/ICE/icethd.F90 b/src/ICE/icethd.F90 index 8408ab9891c9e055cb94a327629ef66a588e2461..739167a1661b5bb670e63a757e4af58c40e771ec 100644 --- a/src/ICE/icethd.F90 +++ b/src/ICE/icethd.F90 @@ -48,6 +48,10 @@ MODULE icethd !! for convergence tests REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztice_cvgerr, ztice_cvgstp + !! for sanity checks in drainage and flushing + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zcfl_flush, zcfl_drain + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zs_flush_dserr, zs_drain_dserr, zs_flush_serr, zs_drain_serr + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zt_flush_dserr, zt_drain_dserr, zt_flush_serr, zt_drain_serr !! * Substitutions # include "do_loop_substitute.h90" @@ -79,9 +83,10 @@ CONTAINS !! - call ice_thd_rem for remapping thickness distribution !! - call ice_thd_do for ice growth in leads !!------------------------------------------------------------------- - INTEGER, INTENT(in) :: kt ! number of iteration + INTEGER, INTENT(in) :: kt ! number of iteration ! - INTEGER :: ji, jj, jk, jl ! dummy loop indices + INTEGER :: ji, jj, jk, jl ! dummy loop indices + REAL(wp) :: zmiss !!------------------------------------------------------------------- ! controls @@ -101,11 +106,29 @@ CONTAINS ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp ENDIF ! - CALL ice_thd_frazil !--- frazil ice: collection thickness (ht_i_new) & fraction of frazil (fraz_frac) + ! sanity checks for salt flushing and drainage + IF( ln_sal_chk ) THEN + CALL iom_miss_val( 'icetemp', zmiss ) ! get missing value from xml + ! + ALLOCATE( zcfl_flush(A2D(0),jpl), zcfl_drain(A2D(0),jpl) ) + ! + ALLOCATE( zs_flush_dserr(A2D(0),jpl), zs_drain_dserr(A2D(0),jpl), & + & zs_flush_serr (A2D(0),jpl), zs_drain_serr (A2D(0),jpl) ) + ! + ALLOCATE( zt_flush_dserr(A2D(0),nlay_i,jpl), zt_drain_dserr(A2D(0),nlay_i,jpl), & + & zt_flush_serr (A2D(0),nlay_i,jpl), zt_drain_serr (A2D(0),nlay_i,jpl) ) + ! + zcfl_flush = 0._wp ; zcfl_drain = 0._wp + zs_flush_dserr = zmiss ; zs_drain_dserr = zmiss ; zs_flush_serr = zmiss ; zs_drain_serr = zmiss + zt_flush_dserr = zmiss ; zt_drain_dserr = zmiss ; zt_flush_serr = zmiss ; zt_drain_serr = zmiss + ENDIF ! !-------------------------------------------------------------------------------------------! ! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories !-------------------------------------------------------------------------------------------! + ! + CALL ice_thd_frazil !--- frazil ice: collection thickness (ht_i_new) & fraction of frazil (fraz_frac) + ! DO jl = 1, jpl ! select ice covered grid points @@ -122,17 +145,18 @@ CONTAINS CALL ice_thd_1d2d( jl, 1 ) ! --- Move to 1D arrays --- ! ! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! ! - s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) - dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp + dh_s_tot (1:npti) = 0._wp ! --- some init --- ! (important to have them here) + dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm(1:npti) = 0._wp dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp - dh_snowice(1:npti) = 0._wp ; dh_s_mlt(1:npti) = 0._wp + dh_snowice(1:npti) = 0._wp ; dh_s_sum(1:npti) = 0._wp ; dh_s_itm(1:npti) = 0._wp ! CALL ice_thd_zdf ! --- Ice-Snow temperature --- ! ! - IF( ln_icedH ) THEN ! --- Growing/Melting --- ! - CALL ice_thd_dh - ENDIF - CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- ! + IF( ln_icedH ) CALL ice_thd_dh ! --- Growing/Melting --- ! + ! + CALL ice_thd_temp ! --- Temperature update --- ! + ! + CALL ice_thd_sal ! --- Ice salinity --- ! ! CALL ice_thd_temp ! --- Temperature update --- ! ! @@ -164,7 +188,7 @@ CONTAINS ! ! --- LBC for the halos --- ! CALL lbc_lnk( 'icethd', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, & & t_su, 'T', 1._wp, a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp ) - CALL lbc_lnk( 'icethd', e_i , 'T', 1._wp, e_s , 'T', 1._wp ) + CALL lbc_lnk( 'icethd', e_i , 'T', 1._wp, e_s , 'T', 1._wp, szv_i , 'T', 1._wp ) ! at_i(:,:) = SUM( a_i, dim=3 ) DO_2D( 0, 0, 0, 0 ) ! --- Ice velocity corrections @@ -183,6 +207,22 @@ CONTAINS CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp ) ENDIF ! + ! sanity checks for salt drainage and flushing + IF( ln_sal_chk ) THEN + CALL iom_put( 'sice_flush_dserr', zs_flush_dserr ) ; DEALLOCATE( zs_flush_dserr ) + CALL iom_put( 'sice_drain_dserr', zs_drain_dserr ) ; DEALLOCATE( zs_drain_dserr ) + CALL iom_put( 'tice_flush_dserr', zt_flush_dserr ) ; DEALLOCATE( zt_flush_dserr ) + CALL iom_put( 'tice_drain_dserr', zt_drain_dserr ) ; DEALLOCATE( zt_drain_dserr ) + ! + CALL iom_put( 'sice_flush_serr', zs_flush_serr ) ; DEALLOCATE( zs_flush_serr ) + CALL iom_put( 'sice_drain_serr', zs_drain_serr ) ; DEALLOCATE( zs_drain_serr ) + CALL iom_put( 'tice_flush_serr', zt_flush_serr ) ; DEALLOCATE( zt_flush_serr ) + CALL iom_put( 'tice_drain_serr', zt_drain_serr ) ; DEALLOCATE( zt_drain_serr ) + ! + CALL iom_put( 'cfl_flush', zcfl_flush ) ; DEALLOCATE( zcfl_flush ) + CALL iom_put( 'cfl_drain', zcfl_drain ) ; DEALLOCATE( zcfl_drain ) + ENDIF + ! controls IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints IF( sn_cfctl%l_prtctl ) & @@ -280,9 +320,9 @@ CONTAINS CALL tab_2d_1d( npti, nptidx(1:npti), e_s_1d(1:npti,jk), e_s(:,:,jk,kl) ) END DO DO jk = 1, nlay_i - CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) ) - CALL tab_2d_1d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) ) - CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl) ) + CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) ) + CALL tab_2d_1d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) ) + CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d (1:npti,jk), sz_i (:,:,jk,kl) ) END DO ! CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d (1:npti), qprec_ice ) @@ -375,11 +415,13 @@ CONTAINS END DO ! ! Change thickness to volume (replaces routine ice_var_eqv2glo) - v_i_1d (1:npti) = h_i_1d (1:npti) * a_i_1d (1:npti) - v_s_1d (1:npti) = h_s_1d (1:npti) * a_i_1d (1:npti) - sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) - oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) - + v_i_1d (1:npti) = h_i_1d (1:npti) * a_i_1d (1:npti) + v_s_1d (1:npti) = h_s_1d (1:npti) * a_i_1d (1:npti) + sv_i_1d (1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) + oa_i_1d (1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) + DO jk = 1, nlay_i + szv_i_1d(1:npti,jk) = sz_i_1d(1:npti,jk) * v_i_1d (1:npti) * r1_nlay_i + ENDDO CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i ) CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl) ) CALL tab_1d_2d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i (:,:,kl) ) @@ -391,9 +433,10 @@ CONTAINS CALL tab_1d_2d( npti, nptidx(1:npti), e_s_1d(1:npti,jk), e_s(:,:,jk,kl) ) END DO DO jk = 1, nlay_i - CALL tab_1d_2d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) ) - CALL tab_1d_2d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) ) - CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), e_i_1d (1:npti,jk), e_i (:,:,jk,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d (1:npti,jk), sz_i (:,:,jk,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), szv_i_1d(1:npti,jk), szv_i(:,:,jk,kl) ) END DO ! CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) @@ -439,7 +482,7 @@ CONTAINS CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_ice (:,:,kl) ) ! Melt ponds CALL tab_1d_2d( npti, nptidx(1:npti), dh_i_sum (1:npti) , dh_i_sum_2d(:,:,kl) ) - CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_mlt (1:npti) , dh_s_mlt_2d(:,:,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_sum (1:npti) , dh_s_sum_2d(:,:,kl) ) ! SIMIP diagnostics CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d (1:npti), t_si (:,:,kl) ) CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) ) @@ -455,6 +498,21 @@ CONTAINS CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) ) CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) ) ENDIF + ! sanity check for salt scheme + IF( ln_sal_chk ) THEN + CALL tab_1d_2d( npti, nptidx(1:npti), s_flush_dserr_1d(1:npti), zs_flush_dserr(:,:,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), s_drain_dserr_1d(1:npti), zs_drain_dserr(:,:,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), s_flush_serr_1d (1:npti), zs_flush_serr (:,:,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), s_drain_serr_1d (1:npti), zs_drain_serr (:,:,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), cfl_flush_1d(1:npti), zcfl_flush(:,:,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), cfl_drain_1d(1:npti), zcfl_drain(:,:,kl) ) + DO jk = 1, nlay_i + CALL tab_1d_2d( npti, nptidx(1:npti), t_flush_dserr_1d(1:npti,jk), zt_flush_dserr(:,:,jk,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), t_drain_dserr_1d(1:npti,jk), zt_drain_dserr(:,:,jk,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), t_flush_serr_1d (1:npti,jk), zt_flush_serr (:,:,jk,kl) ) + CALL tab_1d_2d( npti, nptidx(1:npti), t_drain_serr_1d (1:npti,jk), zt_drain_serr (:,:,jk,kl) ) + END DO + ENDIF ! END SELECT ! @@ -475,7 +533,7 @@ CONTAINS !!------------------------------------------------------------------- INTEGER :: ios ! Local integer output status for namelist read !! - NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx + NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_leadhfx !!------------------------------------------------------------------- ! READ ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) @@ -492,7 +550,6 @@ CONTAINS WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO - WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS WRITE(numout,*) ' heat in the leads is used to melt sea-ice before warming the ocean ln_leadhfx = ', ln_leadhfx ENDIF ! diff --git a/src/ICE/icethd_da.F90 b/src/ICE/icethd_da.F90 index 69896c5112d7cfe1e56b3bc6d1de986fdb9f1455..47e83f26f74f8c90adfbc370a765b99668f2526c 100644 --- a/src/ICE/icethd_da.F90 +++ b/src/ICE/icethd_da.F90 @@ -113,11 +113,17 @@ CONTAINS REAL(wp), PARAMETER :: zcs = 0.66_wp REAL(wp), PARAMETER :: zm1 = 3.e-6_wp REAL(wp), PARAMETER :: zm2 = 1.36_wp + REAL(wp), DIMENSION(nlay_i) :: zs_i ! ice salinity !!--------------------------------------------------------------------- ! zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) ! DO ji = 1, npti + ! + IF( nn_icesal == 4 ) THEN ; zs_i(:) = sz_i_1d(ji,:) ! use layer salinity if nn_icesal=4 + ELSE ; zs_i(:) = s_i_1d (ji) ! bulk salinity otherwise (for conservation purpose) + ENDIF + ! ! --- Calculate reduction of total sea ice concentration --- ! zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta ! Mean floe caliper diameter [m] ! @@ -134,7 +140,7 @@ CONTAINS zda = MIN( a_i_1d(ji), zda_tot * a_i_1d(ji) / at_i_1d(ji) ) ! Contribution to salt flux - sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi * h_i_1d(ji) * zda * s_i_1d(ji) * r1_Dt_ice + sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi * zda * r1_Dt_ice * h_i_1d(ji) * r1_nlay_i * SUM( zs_i(:) ) ! Contribution to heat flux into the ocean [W.m-2], (<0) hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_Dt_ice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) ) & diff --git a/src/ICE/icethd_dh.F90 b/src/ICE/icethd_dh.F90 index 5264b7566aef2a99676495afece415a797844e41..bfc110cf78a5b34a498f2b6c587a71b12399048a 100644 --- a/src/ICE/icethd_dh.F90 +++ b/src/ICE/icethd_dh.F90 @@ -63,45 +63,41 @@ CONTAINS !! Vancoppenolle et al.,2009, Ocean Modelling !!------------------------------------------------------------------ INTEGER :: ji, jk ! dummy loop indices - INTEGER :: iter ! local integer - + ! REAL(wp) :: ztmelts ! local scalar REAL(wp) :: zdum - REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment - REAL(wp) :: zgrr ! bottom growth rate REAL(wp) :: zt_i_new ! bottom formation temperature REAL(wp) :: z1_rho ! 1/(rhos+rho0-rhoi) - + ! REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean REAL(wp) :: zEi ! specific enthalpy of sea ice (J/kg) REAL(wp) :: zEw ! specific enthalpy of exchanged water (J/kg) REAL(wp) :: zdE ! specific enthalpy difference (J/kg) REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean - + REAL(wp) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2) + REAL(wp) :: zdeltah, zs_i_new, zds, zs_sni + REAL(wp) :: zswitch_sal + ! REAL(wp), DIMENSION(jpij) :: zq_top ! heat for surface ablation (J.m-2) REAL(wp), DIMENSION(jpij) :: zq_bot ! heat for bottom ablation (J.m-2) REAL(wp), DIMENSION(jpij) :: zq_rema ! remaining heat at the end of the routine (J.m-2) REAL(wp), DIMENSION(jpij) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) - REAL(wp) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2) - REAL(wp) :: zdeltah REAL(wp), DIMENSION(jpij) :: zsnw ! distribution of snow after wind blowing - + ! INTEGER , DIMENSION(nlay_i) :: icount ! number of layers vanishing by melting + REAL(wp), DIMENSION(nlay_i) :: zs_i ! ice salinity REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i ! ice layer thickness (m) REAL(wp), DIMENSION(0:nlay_s ) :: zh_s ! snw layer thickness (m) REAL(wp), DIMENSION(0:nlay_s ) :: ze_s ! snw layer enthalpy (J.m-3) REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i_old ! old thickness REAL(wp), DIMENSION(0:nlay_i+1) :: ze_i_old ! old enthalpy - - REAL(wp) :: zswitch_sal - - INTEGER :: num_iter_max ! Heat conservation + REAL(wp), DIMENSION(0:nlay_i+1) :: zs_i_old ! old salt content !!------------------------------------------------------------------ ! Discriminate between time varying salinity and constant SELECT CASE( nn_icesal ) ! varying salinity or not CASE( 1 , 3 ) ; zswitch_sal = 0._wp ! prescribed salinity profile - CASE( 2 ) ; zswitch_sal = 1._wp ! varying salinity profile + CASE( 2 , 4 ) ; zswitch_sal = 1._wp ! varying salinity profile END SELECT ! ! ! ============================================== ! @@ -136,20 +132,22 @@ CONTAINS ! for snw-ice formation z1_rho = 1._wp / ( rhos+rho0-rhoi ) ! - ! number of iterations for new sea ice - IF( nn_icesal == 2 ) THEN ; num_iter_max = 5 ! salinity varying in time - ELSE ; num_iter_max = 1 - ENDIF ! ! ==================== ! ! ! Start main loop here ! ! ! ==================== ! DO ji = 1, npti - + ! + IF( nn_icesal == 4 ) THEN ; zs_i(:) = sz_i_1d(ji,:) ! use layer salinity if nn_icesal=4 + ELSE ; zs_i(:) = s_i_1d (ji) ! bulk salinity otherwise (for conservation purpose) + ENDIF + ! ! initialize ice layer thicknesses and enthalpies + zs_i_old(0:nlay_i+1) = 0._wp ze_i_old(0:nlay_i+1) = 0._wp zh_i_old(0:nlay_i+1) = 0._wp zh_i (0:nlay_i+1) = 0._wp DO jk = 1, nlay_i + zs_i_old(jk) = h_i_1d(ji) * r1_nlay_i * zs_i (jk) ze_i_old(jk) = h_i_1d(ji) * r1_nlay_i * e_i_1d(ji,jk) zh_i_old(jk) = h_i_1d(ji) * r1_nlay_i zh_i (jk) = h_i_1d(ji) * r1_nlay_i @@ -175,7 +173,7 @@ CONTAINS hfx_res_1d (ji) = hfx_res_1d (ji) - ze_s(jk) * zh_s(jk) * a_i_1d(ji) * r1_Dt_ice ! heat flux to the ocean [W.m-2], < 0 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos * zh_s(jk) * a_i_1d(ji) * r1_Dt_ice ! mass flux ! updates - dh_s_mlt(ji) = dh_s_mlt(ji) - zh_s(jk) + dh_s_itm(ji) = dh_s_itm(ji) - zh_s(jk) h_s_1d (ji) = MAX( 0._wp, h_s_1d (ji) - zh_s(jk) ) zh_s (jk) = 0._wp ze_s (jk) = 0._wp @@ -209,7 +207,7 @@ CONTAINS wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * zdum * a_i_1d(ji) * r1_Dt_ice ! snow melting only = water into the ocean ! updates available heat + thickness - dh_s_mlt(ji) = dh_s_mlt(ji) + zdum + dh_s_sum(ji) = dh_s_sum(ji) + zdum zq_top (ji) = MAX( 0._wp , zq_top (ji) + zdum * ze_s(jk) ) h_s_1d (ji) = MAX( 0._wp , h_s_1d (ji) + zdum ) zh_s (jk) = MAX( 0._wp , zh_s (jk) + zdum ) @@ -260,11 +258,11 @@ CONTAINS ! dh_i_itm(ji) = dh_i_itm(ji) + zdum ! Cumulate internal melting ! - hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 - ! ice enthalpy zEi is "sent" to the ocean - wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux - sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux - ! using s_i_1d and not sz_i_1d(jk) is ok + hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 + ! ice enthalpy zEi is "sent" to the ocean + wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux + sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux + ! ELSE !-- Surface melting zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of layer k [J/kg, <0] @@ -285,17 +283,18 @@ CONTAINS zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] - hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 - hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], > 0 - wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux - sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 - ! using s_i_1d and not sz_i_1d(jk) is ok) + hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 + hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], > 0 + wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux + sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 + ! END IF ! update thickness zh_i (jk) = MAX( 0._wp, zh_i (jk) + zdum ) h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum ) ! - ! update heat content (J.m-2) and layer thickness + ! update heat content (J.m-2), salt content and layer thickness + zs_i_old(jk) = zs_i_old(jk) + zdum * zs_i(jk) ze_i_old(jk) = ze_i_old(jk) + zdum * e_i_1d(ji,jk) zh_i_old(jk) = zh_i_old(jk) + zdum ! @@ -304,19 +303,20 @@ CONTAINS ! --------------- zdum = MAX( - zh_i(jk) , - zevap_rema * r1_rhoi ) ! - hfx_sub_1d(ji) = hfx_sub_1d(ji) + e_i_1d(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 - wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0 - sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 - ! clem: flux is sent to the ocean for simplicity - ! but salt should remain in the ice except - ! if all ice is melted. => must be corrected + hfx_sub_1d(ji) = hfx_sub_1d(ji) + e_i_1d(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 + wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0 + sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 + ! clem: flux is sent to the ocean for simplicity + ! but salt should remain in the ice except + ! if all ice is melted. => must be corrected ! update remaining mass flux and thickness zevap_rema = zevap_rema + zdum * rhoi zh_i (jk) = MAX( 0._wp, zh_i (jk) + zdum ) h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum ) dh_i_sub(ji) = dh_i_sub(ji) + zdum - ! update heat content (J.m-2) and layer thickness + ! update heat content (J.m-2), salt content and layer thickness + zs_i_old(jk) = zs_i_old(jk) + zdum * zs_i(jk) ze_i_old(jk) = ze_i_old(jk) + zdum * e_i_1d(ji,jk) zh_i_old(jk) = zh_i_old(jk) + zdum @@ -338,53 +338,40 @@ CONTAINS ! between the inner conductive flux (qcn_ice_bot), from the open water heat flux ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot). ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice - - ! If salinity varies in time, an iterative procedure is required, because - ! the involved quantities are inter-dependent. - ! Basal growth (dh_i_bog) depends upon new ice specific enthalpy (zEi), - ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bog) - ! -> need for an iterative procedure, which converges quickly - + ! + zs_i_new = 0._wp + ! IF( zf_tt(ji) < 0._wp ) THEN - DO iter = 1, num_iter_max ! iterations - - ! New bottom ice salinity (Cox & Weeks, JGR88 ) - zgrr = MIN( 1.0e-3_wp, MAX ( dh_i_bog(ji) * r1_Dt_ice , epsi10 ) ) - ! - IF ( zgrr < 2.0e-8_wp ) THEN ; zfracs = 0.12_wp - ELSEIF( zgrr >= 3.6e-7_wp ) THEN ; zfracs = MIN( 0.26_wp / ( 0.26_wp + 0.74_wp * EXP(-724300._wp*zgrr) ) , 0.5_wp ) - ELSE ; zfracs = MIN( 0.8925_wp + 0.0568_wp * LOG(100._wp*zgrr), 0.5_wp ) - ENDIF - - s_i_new(ji) = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji) ! New ice salinity - - ztmelts = - rTmlt * s_i_new(ji) ! New ice melting point (C) - - zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) - - zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0) - & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts - - zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) - - zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) - dh_i_bog(ji) = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) + zs_i_new = zswitch_sal * rn_sinew * sss_1d(ji) + ( 1. - zswitch_sal ) * zs_i(1) ! New ice salinity + + ztmelts = - rTmlt * zs_i_new ! New ice melting point (C) + + zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) + + zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0) + & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts + + zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) + + zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) + + dh_i_bog(ji) = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) - END DO ! Contribution to Energy and Salt Fluxes - zfmdt = - rhoi * dh_i_bog(ji) ! Mass flux x time step (kg/m2, < 0) + zfmdt = - rhoi * dh_i_bog(ji) ! Mass flux x time step (kg/m2, < 0) - hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], >0 - hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], <0 - wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * a_i_1d(ji) * r1_Dt_ice ! Mass flux, <0 - sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * s_i_new(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux, <0 + hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], >0 + hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], <0 + wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * a_i_1d(ji) * r1_Dt_ice ! Mass flux, <0 + sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * zs_i_new * a_i_1d(ji) * r1_Dt_ice ! Salt flux, <0 ! update thickness zh_i(nlay_i+1) = zh_i(nlay_i+1) + dh_i_bog(ji) h_i_1d(ji) = h_i_1d(ji) + dh_i_bog(ji) - ! update heat content (J.m-2) and layer thickness + ! update heat content (J.m-2), salt content and layer thickness + zs_i_old(nlay_i+1) = zs_i_old(nlay_i+1) + dh_i_bog(ji) * zs_i_new ze_i_old(nlay_i+1) = ze_i_old(nlay_i+1) + dh_i_bog(ji) * (-zEi * rhoi) zh_i_old(nlay_i+1) = zh_i_old(nlay_i+1) + dh_i_bog(ji) @@ -408,11 +395,11 @@ CONTAINS ! zfmdt = - zdum * rhoi ! Mass flux x time step > 0 ! - hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 - ! ice enthalpy zEi is "sent" to the ocean - wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux - sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux - ! using s_i_1d and not sz_i_1d(jk) is ok + hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 + ! ice enthalpy zEi is "sent" to the ocean + wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux + sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux + ! ELSE !-- Basal melting zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of melting ice (J/kg, <0) @@ -433,17 +420,18 @@ CONTAINS zQm = zfmdt * zEw ! Heat exchanged with ocean - hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 - hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat used in this process [W.m-2], >0 - wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux - sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux - ! using s_i_1d and not sz_i_1d(jk) is ok + hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 + hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat used in this process [W.m-2], >0 + wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux + sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * zdum * zs_i(jk) * a_i_1d(ji) * r1_Dt_ice ! Salt flux + ! ENDIF ! update thickness zh_i (jk) = MAX( 0._wp, zh_i (jk) + zdum ) h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum ) ! - ! update heat content (J.m-2) and layer thickness + ! update heat content (J.m-2), salt content and layer thickness + zs_i_old(jk) = zs_i_old(jk) + zdum * zs_i(jk) ze_i_old(jk) = ze_i_old(jk) + zdum * e_i_1d(ji,jk) zh_i_old(jk) = zh_i_old(jk) + zdum ENDIF @@ -504,9 +492,9 @@ CONTAINS sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Salt flux ! Case constant salinity in time: virtual salt flux to keep salinity constant - IF( nn_icesal /= 2 ) THEN - sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice & ! put back sss_m into the ocean - & - s_i_1d(ji) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice ! and get rn_icesal from the ocean + IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN + sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice & ! put back sss_m into the ocean + & - zs_i(1) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice ! and get rn_icesal from the ocean ENDIF ! Mass flux: All snow is thrown in the ocean, and seawater is taken to replace the volume @@ -517,7 +505,8 @@ CONTAINS zh_i(0) = zh_i(0) + dh_snowice(ji) zdeltah = dh_snowice(ji) - ! update heat content (J.m-2) and layer thickness + ! update heat content (J.m-2), salt content and layer thickness + zs_i_old(0) = zs_i_old(0) - zfmdt * sss_1d(ji) * r1_rhoi ! clem: s(0) could be > rn_sinew*sss zh_i_old(0) = zh_i_old(0) + dh_snowice(ji) ze_i_old(0) = ze_i_old(0) + zfmdt * zEw ! 1st part (sea water enthalpy) @@ -534,12 +523,12 @@ CONTAINS !!$ ! --- Update snow diags --- ! !!$ !!clem: this is wrong. dh_s_tot is not used anyway !!$ DO ji = 1, npti -!!$ dh_s_tot(ji) = dh_s_tot(ji) + dh_s_mlt(ji) + zdeltah + zdh_s_sub(ji) - dh_snowice(ji) +!!$ dh_s_tot(ji) = dh_s_tot(ji) + dh_s_sum(ji) + zdeltah + zdh_s_sub(ji) - dh_snowice(ji) !!$ END DO ! ! Remapping of snw enthalpy on a regular grid !-------------------------------------------- - e_s_1d(ji,:) = snw_ent( zh_s(:), ze_s(:) ) + e_s_1d(ji,:) = snw_ent( zh_s, ze_s ) ! recalculate t_s_1d from e_s_1d IF( h_s_1d(ji) > 0._wp ) THEN @@ -552,10 +541,18 @@ CONTAINS END DO ENDIF - ! Remapping of ice enthalpy on a regular grid - !-------------------------------------------- - e_i_1d(ji,:) = ice_ent1( zh_i_old(:), ze_i_old(:) ) - + ! Remapping of ice enthalpy/salt on a regular grid + !------------------------------------------------- + CALL ice_var_vremap( zh_i_old, ze_i_old, e_i_1d (ji,:) ) + IF( nn_icesal == 4 ) CALL ice_var_vremap( zh_i_old, zs_i_old, sz_i_1d(ji,:) ) + IF( nn_icesal == 2 ) THEN ! Update ice salinity from snow-ice and bottom growth + zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi ! salinity of snow ice + zds = ( zs_sni - s_i_1d(ji) ) * dh_snowice(ji) / MAX( epsi10, h_i_1d(ji) ) ! snow-ice + zds = zds + ( zs_i_new - s_i_1d(ji) ) * dh_i_bog (ji) / MAX( epsi10, h_i_1d(ji) ) ! bottom growth + ! + s_i_1d(ji) = s_i_1d(ji) + zds + ENDIF + END DO ! npti ! ! ================== ! ! ! End main loop here ! @@ -573,7 +570,6 @@ CONTAINS FUNCTION snw_ent( ph_old, pe_old ) !!------------------------------------------------------------------- !! *** ROUTINE snw_ent *** - !! !! ** Purpose : !! This routine computes new vertical grids in the snow, !! and consistently redistributes temperatures. @@ -650,92 +646,6 @@ CONTAINS END FUNCTION snw_ent - - FUNCTION ice_ent1( ph_old, pe_old ) - !!------------------------------------------------------------------- - !! *** ROUTINE ice_ent1 *** - !! - !! ** Purpose : - !! This routine computes new vertical grids in the ice, - !! and consistently redistributes temperatures. - !! Redistribution is made so as to ensure to energy conservation - !! - !! - !! ** Method : linear conservative remapping - !! - !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses - !! 2) linear remapping on the new layers - !! - !! ------------ cum0(0) ------------- cum1(0) - !! NEW ------------- - !! ------------ cum0(1) ==> ------------- - !! ... ------------- - !! ------------ ------------- - !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i) - !! - !! - !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 - !!------------------------------------------------------------------- - REAL(wp), DIMENSION(0:nlay_i+1), INTENT(in) :: ph_old, pe_old ! old tickness and enthlapy - REAL(wp), DIMENSION(1:nlay_i) :: ice_ent1 ! new enthlapies (J.m-3, remapped) - ! - INTEGER :: ji ! dummy loop indices - INTEGER :: jk0, jk1 ! old/new layer indices - ! - REAL(wp), DIMENSION(0:nlay_i+2) :: zeh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces - REAL(wp), DIMENSION(0:nlay_i) :: zeh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces - REAL(wp) :: zhnew ! new layers thicknesses - !!------------------------------------------------------------------- - - !-------------------------------------------------------------------------- - ! 1) Cumulative integral of old enthalpy * thickness and layers interfaces - !-------------------------------------------------------------------------- - zeh_cum0(0) = 0._wp - zh_cum0 (0) = 0._wp - DO jk0 = 1, nlay_i+2 - zeh_cum0(jk0) = zeh_cum0(jk0-1) + pe_old(jk0-1) - zh_cum0 (jk0) = zh_cum0 (jk0-1) + ph_old(jk0-1) - END DO - - !------------------------------------ - ! 2) Interpolation on the new layers - !------------------------------------ - ! new layer thickesses - zhnew = SUM( ph_old(0:nlay_i+1) ) * r1_nlay_i - - ! new layers interfaces - zh_cum1(0) = 0._wp - DO jk1 = 1, nlay_i - zh_cum1(jk1) = zh_cum1(jk1-1) + zhnew - END DO - - zeh_cum1(0:nlay_i) = 0._wp - ! new cumulative q*h => linear interpolation - DO jk0 = 1, nlay_i+2 - DO jk1 = 1, nlay_i-1 - IF( zh_cum1(jk1) <= zh_cum0(jk0) .AND. zh_cum1(jk1) > zh_cum0(jk0-1) ) THEN - zeh_cum1(jk1) = ( zeh_cum0(jk0-1) * ( zh_cum0(jk0) - zh_cum1(jk1 ) ) + & - & zeh_cum0(jk0 ) * ( zh_cum1(jk1) - zh_cum0(jk0-1) ) ) & - & / ( zh_cum0(jk0) - zh_cum0(jk0-1) ) - ENDIF - END DO - END DO - ! to ensure that total heat content is strictly conserved, set: - zeh_cum1(nlay_i) = zeh_cum0(nlay_i+2) - - ! new enthalpies - DO jk1 = 1, nlay_i - ice_ent1(jk1) = MAX( 0._wp, zeh_cum1(jk1) - zeh_cum1(jk1-1) ) / MAX( zhnew, epsi20 ) ! max for roundoff error - END DO - - ! --- diag error on heat remapping --- ! - ! comment: if input h_old and eh_old are already multiplied by a_i (as in icethd_do), - ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 - ! hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * & - ! & ( SUM( pe_new(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_old(ji,0:nlay_i+1) ) ) - - - END FUNCTION ice_ent1 #else !!---------------------------------------------------------------------- diff --git a/src/ICE/icethd_do.F90 b/src/ICE/icethd_do.F90 index 90e0cee2bfb606cab3ddbe26d7184071ccee394c..4ed314350a6bb2ad0616747a382df193e40fd6ec 100644 --- a/src/ICE/icethd_do.F90 +++ b/src/ICE/icethd_do.F90 @@ -95,7 +95,7 @@ CONTAINS REAL(wp), DIMENSION(jpij) :: zh_newice ! thickness of accreted ice REAL(wp), DIMENSION(jpij) :: zfraz_frac_1d ! relative ice / frazil velocity (1D vector) ! - REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i_old, ze_i_old + REAL(wp), DIMENSION(0:nlay_i+1) :: zh_i_old, ze_i_old, zs_i_old !!-----------------------------------------------------------------------! IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft ) @@ -119,11 +119,12 @@ CONTAINS ! Move from 2-D to 1-D vectors IF ( npti > 0 ) THEN - CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , at_i ) - CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:), a_i (:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:), v_i (:,:,:) ) - CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,:), sv_i(:,:,:) ) - CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d (1:npti) , at_i ) + CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) ) + CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) ) + CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) ) + CALL tab_4d_3d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_4d_3d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i ) CALL tab_2d_1d( npti, nptidx(1:npti), qlead_1d (1:npti), qlead ) CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d (1:npti), t_bo ) CALL tab_2d_1d( npti, nptidx(1:npti), sfx_opw_1d (1:npti), sfx_opw ) @@ -136,13 +137,15 @@ CONTAINS CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti), rn_amax_2d ) CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d (1:npti), sss_m ) - ! Convert units for ice internal energy + ! Convert units for ice internal energy and salt content DO jl = 1, jpl DO jk = 1, nlay_i WHERE( v_i_2d(1:npti,jl) > 0._wp ) - e_i_2d(1:npti,jk,jl) = e_i_2d(1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i ) + e_i_2d (1:npti,jk,jl) = e_i_2d (1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i ) + szv_i_2d(1:npti,jk,jl) = szv_i_2d(1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i ) ELSEWHERE - e_i_2d(1:npti,jk,jl) = 0._wp + e_i_2d (1:npti,jk,jl) = 0._wp + szv_i_2d(1:npti,jk,jl) = 0._wp END WHERE END DO END DO @@ -151,10 +154,8 @@ CONTAINS SELECT CASE ( nn_icesal ) CASE ( 1 ) ! Sice = constant zs_newice(1:npti) = rn_icesal - CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)] - DO ji = 1, npti - zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_1d(ji) ) - END DO + CASE ( 2 , 4 ) ! Sice = F(z,t) [Griewank and Notz 2013 ; Rees Jones and Worster 2014] + zs_newice(1:npti) = rn_sinew * sss_1d(1:npti) CASE ( 3 ) ! Sice = F(z) [multiyear ice] zs_newice(1:npti) = 2.3 END SELECT @@ -243,9 +244,11 @@ CONTAINS ! Heat content jl = jcat ! categroy in which new ice is put IF( za_b(jl) > 0._wp ) THEN - e_i_2d(ji,:,jl) = ( ze_newice * zv_newice + e_i_2d(ji,:,jl) * zv_b(jl) ) / MAX( v_i_2d(ji,jl), epsi20 ) + e_i_2d (ji,:,jl) = ( ze_newice * zv_newice + e_i_2d (ji,:,jl) * zv_b(jl) ) / MAX( v_i_2d(ji,jl), epsi20 ) + szv_i_2d(ji,:,jl) = ( zs_newice(ji) * zv_newice + szv_i_2d(ji,:,jl) * zv_b(jl) ) / MAX( v_i_2d(ji,jl), epsi20 ) ELSE - e_i_2d(ji,:,jl) = ze_newice + e_i_2d (ji,:,jl) = ze_newice + szv_i_2d(ji,:,jl) = zs_newice(ji) ENDIF ! --- bottom ice growth + ice enthalpy remapping --- ! @@ -254,9 +257,11 @@ CONTAINS ! for remapping zh_i_old(0:nlay_i+1) = 0._wp ze_i_old(0:nlay_i+1) = 0._wp + zs_i_old(0:nlay_i+1) = 0._wp DO jk = 1, nlay_i - zh_i_old(jk) = v_i_2d(ji,jl) * r1_nlay_i - ze_i_old(jk) = e_i_2d(ji,jk,jl) * v_i_2d(ji,jl) * r1_nlay_i + zh_i_old(jk) = v_i_2d(ji,jl) * r1_nlay_i + ze_i_old(jk) = e_i_2d (ji,jk,jl) * v_i_2d(ji,jl) * r1_nlay_i + zs_i_old(jk) = szv_i_2d(ji,jk,jl) * v_i_2d(ji,jl) * r1_nlay_i END DO ! new volumes including lateral/bottom accretion + residual @@ -269,13 +274,16 @@ CONTAINS v_i_2d(ji,jl) = v_i_2d(ji,jl) + zv_newfra ! for remapping zh_i_old(nlay_i+1) = zv_newfra - ze_i_old(nlay_i+1) = ze_newice * zv_newfra + ze_i_old(nlay_i+1) = ze_newice * zv_newfra + zs_i_old(nlay_i+1) = zs_newice(ji) * zv_newfra - ! --- Update salinity --- ! + ! --- Update bulk salinity --- ! sv_i_2d(ji,jl) = sv_i_2d(ji,jl) + zs_newice(ji) * ( v_i_2d(ji,jl) - zv_b(jl) ) - - ! --- Ice enthalpy remapping --- ! - e_i_2d(ji,:,jl) = ice_ent2( zh_i_old(:), ze_i_old(:) ) + + ! --- Ice enthalpy and salt remapping --- ! + CALL ice_var_vremap( zh_i_old, ze_i_old, e_i_2d (ji,:,jl) ) + IF( nn_icesal == 4 ) CALL ice_var_vremap( zh_i_old, zs_i_old, szv_i_2d(ji,:,jl) ) + ! END DO END DO ! npti @@ -283,18 +291,20 @@ CONTAINS ! ! End main loop here ! ! ! ================== ! ! - ! Change units for e_i + ! Change units for e_i/szv_i DO jl = 1, jpl DO jk = 1, nlay_i - e_i_2d(1:npti,jk,jl) = e_i_2d(1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i + e_i_2d (1:npti,jk,jl) = e_i_2d (1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i + szv_i_2d(1:npti,jk,jl) = szv_i_2d(1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i END DO END DO ! Move 2D vectors to 1D vectors - CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:), a_i (:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:), v_i (:,:,:) ) - CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,:), sv_i(:,:,:) ) - CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,:) , a_i (:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,:) , v_i (:,:,:) ) + CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d (1:npti,:) , sv_i(:,:,:) ) + CALL tab_3d_4d( npti, nptidx(1:npti), e_i_2d (1:npti,:,:), e_i ) + CALL tab_3d_4d( npti, nptidx(1:npti), szv_i_2d(1:npti,:,:), szv_i ) CALL tab_1d_2d( npti, nptidx(1:npti), sfx_opw_1d(1:npti), sfx_opw ) CALL tab_1d_2d( npti, nptidx(1:npti), wfx_opw_1d(1:npti), wfx_opw ) CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d(1:npti), hfx_thd ) @@ -402,93 +412,6 @@ CONTAINS ENDIF END SUBROUTINE ice_thd_frazil - FUNCTION ice_ent2( ph_old, pe_old ) - !!------------------------------------------------------------------- - !! *** ROUTINE ice_ent2 *** - !! - !! ** Purpose : - !! This routine computes new vertical grids in the ice, - !! and consistently redistributes temperatures. - !! Redistribution is made so as to ensure to energy conservation - !! - !! - !! ** Method : linear conservative remapping - !! - !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses - !! 2) linear remapping on the new layers - !! - !! ------------ cum0(0) ------------- cum1(0) - !! NEW ------------- - !! ------------ cum0(1) ==> ------------- - !! ... ------------- - !! ------------ ------------- - !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i) - !! - !! - !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 - !!------------------------------------------------------------------- - REAL(wp), DIMENSION(0:nlay_i+1), INTENT(in) :: ph_old, pe_old ! old tickness and enthlapy - REAL(wp), DIMENSION(1:nlay_i) :: ice_ent2 ! new enthlapies (J.m-3, remapped) - ! - INTEGER :: ji ! dummy loop indices - INTEGER :: jk0, jk1 ! old/new layer indices - ! - REAL(wp), DIMENSION(0:nlay_i+2) :: zeh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces - REAL(wp), DIMENSION(0:nlay_i) :: zeh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces - REAL(wp) :: zhnew ! new layers thicknesses - !!------------------------------------------------------------------- - - !-------------------------------------------------------------------------- - ! 1) Cumulative integral of old enthalpy * thickness and layers interfaces - !-------------------------------------------------------------------------- - zeh_cum0(0) = 0._wp - zh_cum0 (0) = 0._wp - DO jk0 = 1, nlay_i+2 - zeh_cum0(jk0) = zeh_cum0(jk0-1) + pe_old(jk0-1) - zh_cum0 (jk0) = zh_cum0 (jk0-1) + ph_old(jk0-1) - END DO - - !------------------------------------ - ! 2) Interpolation on the new layers - !------------------------------------ - ! new layer thickesses - zhnew = SUM( ph_old(0:nlay_i+1) ) * r1_nlay_i - - ! new layers interfaces - zh_cum1(0) = 0._wp - DO jk1 = 1, nlay_i - zh_cum1(jk1) = zh_cum1(jk1-1) + zhnew - END DO - - zeh_cum1(0:nlay_i) = 0._wp - ! new cumulative q*h => linear interpolation - DO jk0 = 1, nlay_i+2 - DO jk1 = 1, nlay_i-1 - IF( zh_cum1(jk1) <= zh_cum0(jk0) .AND. zh_cum1(jk1) > zh_cum0(jk0-1) ) THEN - zeh_cum1(jk1) = ( zeh_cum0(jk0-1) * ( zh_cum0(jk0) - zh_cum1(jk1 ) ) + & - & zeh_cum0(jk0 ) * ( zh_cum1(jk1) - zh_cum0(jk0-1) ) ) & - & / ( zh_cum0(jk0) - zh_cum0(jk0-1) ) - ENDIF - END DO - END DO - ! to ensure that total heat content is strictly conserved, set: - zeh_cum1(nlay_i) = zeh_cum0(nlay_i+2) - - ! new enthalpies - DO jk1 = 1, nlay_i - ice_ent2(jk1) = MAX( 0._wp, zeh_cum1(jk1) - zeh_cum1(jk1-1) ) / MAX( zhnew, epsi20 ) ! max for roundoff error - END DO - - ! --- diag error on heat remapping --- ! - ! comment: if input h_old and eh_old are already multiplied by a_i (as in icethd_do), - ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 - ! hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * & - ! & ( SUM( pe_new(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_old(ji,0:nlay_i+1) ) ) - - - END FUNCTION ice_ent2 - - SUBROUTINE ice_thd_do_init !!----------------------------------------------------------------------- !! *** ROUTINE ice_thd_do_init *** diff --git a/src/ICE/icethd_pnd.F90 b/src/ICE/icethd_pnd.F90 index 8f5b63df6fafe2d57bee60219d80aa32321082f9..81d55238139dc0bdb01a4dd5ce5961c6e6e0757d 100644 --- a/src/ICE/icethd_pnd.F90 +++ b/src/ICE/icethd_pnd.F90 @@ -310,7 +310,7 @@ CONTAINS CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il(:,:,jl) ) CALL tab_2d_1d( npti, nptidx(1:npti), dh_i_sum(1:npti), dh_i_sum_2d(:,:,jl) ) - CALL tab_2d_1d( npti, nptidx(1:npti), dh_s_mlt(1:npti), dh_s_mlt_2d(:,:,jl) ) + CALL tab_2d_1d( npti, nptidx(1:npti), dh_s_sum(1:npti), dh_s_sum_2d(:,:,jl) ) DO jk = 1, nlay_i CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,jl) ) @@ -341,7 +341,7 @@ CONTAINS !------------------! ! !--- available meltwater for melt ponding (zdv_avail) ---! - zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0 + zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_sum(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0 zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) ! = ( 1 - r ) = fraction of melt water that is not flushed zdv_mlt = MAX( 0._wp, zfr_mlt * zdv_avail ) ! max for roundoff errors? ! @@ -596,7 +596,7 @@ CONTAINS IF ( a_i(ji,jj,jl) > epsi10 ) THEN !--- Available and contributing meltwater for melt ponding ---! - zv_mlt = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_mlt_2d(ji,jj,jl) * rhos ) & ! available volume of surface melt water per grid area + zv_mlt = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_sum_2d(ji,jj,jl) * rhos ) & ! available volume of surface melt water per grid area & * z1_rhow * a_i(ji,jj,jl) ! MV -> could move this directly in ice_thd_dh and get an array (ji,jj,jl) for surface melt water volume per grid area zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i(ji,jj) ! fraction of surface meltwater going to ponds diff --git a/src/ICE/icethd_sal.F90 b/src/ICE/icethd_sal.F90 index 11ca64e3e16cee1e36be5fd640635274ffd7fdf2..bb6e726cb7725f122f03abbe2e382e613988eb5d 100644 --- a/src/ICE/icethd_sal.F90 +++ b/src/ICE/icethd_sal.F90 @@ -23,6 +23,7 @@ MODULE icethd_sal USE in_out_manager ! I/O manager USE lib_mpp ! MPP library USE lib_fortran ! fortran utilities (glob_sum + no signed zero) + USE iom ! I/O manager library IMPLICIT NONE PRIVATE @@ -35,7 +36,20 @@ MODULE icethd_sal REAL(wp) :: rn_time_gd ! restoring time constant for gravity drainage (= 20 days) [s] REAL(wp) :: rn_sal_fl ! restoring salinity for flushing [PSU] REAL(wp) :: rn_time_fl ! restoring time constant for gravity drainage (= 10 days) [s] - + INTEGER :: nn_sal_scheme ! convection scheme + LOGICAL :: ln_flushing ! activate flushing + LOGICAL :: ln_drainage ! activate gravity drainage + INTEGER :: nn_drainage ! number of subcycles for gravity drainage + INTEGER :: nn_flushing ! number of subcycles for flushing + REAL(wp) :: rn_flushrate ! rate of flushing (fraction of melt water used for flushing) + REAL(wp) :: rn_alpha_CW ! Brine flow for CW1988 + REAL(wp) :: rn_alpha_RJW ! Brine flow for RJW2014 + REAL(wp) :: rn_alpha_GN ! Brine flow for GN2013 (kg/m3/s) + REAL(wp) :: rn_Rc_RJW ! critical Rayleigh number for RJW + REAL(wp) :: rn_Rc_GN ! for GN + REAL(wp) :: rn_sal_himin ! min ice thickness for gravity drainage and flushing calculation + REAL(wp) :: rn_vbrc ! critical brines volume above which flushing can occur + !!---------------------------------------------------------------------- !! NEMO/ICE 4.0 , NEMO Consortium (2018) !! $Id: icethd_sal.F90 13472 2020-09-16 13:05:19Z smasson $ @@ -43,71 +57,193 @@ MODULE icethd_sal !!---------------------------------------------------------------------- CONTAINS - SUBROUTINE ice_thd_sal( ld_sal ) + SUBROUTINE ice_thd_sal !!------------------------------------------------------------------- !! *** ROUTINE ice_thd_sal *** !! !! ** Purpose : computes new salinities in the ice !! - !! ** Method : 3 possibilities + !! ** Method : 4 possibilities !! -> nn_icesal = 1 -> Sice = cst [ice salinity constant in both time & space] !! -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005] !! -> nn_icesal = 3 -> Sice = S(z) [multiyear ice] + !! -> nn_icesal = 4 -> Sice = S(z,t) [Gravity Drainage and Flushing parameterizations] + !! + !! ** Case 4 details : + !! + !! For both gravity drainage and flushing, brines are calculated depending on ice temperature (liquidus formulation): + !! Sbr = - T / mu [linear liquidus] ( nn_liquidus == 1 ) + !! Sbr = -18.7 * T - 0.519 * T2 - 0.00535 * T3 [VC2019] ( nn_liquidus == 2 ) + !! Sbr = -17.6 * T - 0.389 * T2 - 0.00362 * T3 [Weast] ( nn_liquidus == 3 ) + !! + !! **************** + !! Gravity Drainage + !! **************** + !! + !! we want to solve this equation: + !! ============================== + !! dS/dt = -w dSbr/dz + !! + !! with S = sea ice salinity + !! Sbr = brine salinity + !! w = upwelling Darcy velocity of the return flow (i.e. vertical velocity of the brines, positive downward => >0) + !! + !! discrete form is solved using upward scheme (such as in CICE): + !! (S(t+dt)-S(t))/dt = -w(k) * (Sbr(k+1)-Sbr(k))/dz + !! + !! 3 schemes are proposed based on the paper from Thomas et al. (2020): + !! ====================== + !! 0 | ----------------------------------- surface + !! | + !! | ----------------------------------- zc + !! z | + !! | Ra > Rac => brine convection + !! | + !! h | ------------------------------------ bottom + !! v + !! + !! Ra = cp_br * g * beta * (Sbr(z) - Sw) * perm * (h-z) / (cnd_br*visc) [RWJ2014 formulation] + !! + !! with Ra : Rayleigh number + !! cp_br : brine heat capacity (J/m3/K) + !! g : gravity (m/s2) + !! beta : saline density coefficient (g/kg)-1 + !! cnd_br : brine thermal conductivity (W/m/K) + !! visc : brine kinematic viscosity (m2/s) + !! Sw : ocean salinity (g/kg) + !! zc : critical depth below which convection occurs (m) + !! h : total ice thickness (m) + !! perm : effective permeability (m2) + !! = 3.e-8 * (S/Sbr)^3 [SI3] ( np_perm_for == 0 ) + !! = 1.995e-8 * (S/Sbr)^3.1 [Freitag] ( np_perm_for == 1 ) + !! = 1.0e-8 * (S/Sbr)^3. [RJW2014] ( np_perm_for == 2 ) + !! + !! 1) === Reese Jones & Worster 2014 (refer to as RJW2014) === + !! + !! w(z) = - alpha_rjw * cnd_br / cp_br * max(Ra(z)-Rac) * (z-zc)/(h-zc)^2 + !! with alpha_rjw : intensity parameter + !! + !! 2) === Griewank & Notz 2013 (refer to as GN2013) === + !! + !! w(k) = - alpha_gn/rho * sum( (Ra(kk)-Rac) * dz(kk), [from kk=1 to k] ) + !! with rho : brine density (kg/m3) + !! alpha_gn : intensity parameter (kg/m3/s) + !! + !! 3) === Cox and Weeks 1988 (refer to as CW1988) === + !! + !! w(k) = - alpha_cw * 0.0589_wp * MAX( 0._wp, zv_br(z)/rn_vbrc - 1._wp ) + !! with alpha_cw : intensity parameter + !! rn_vbrc : critical brines volume (for permeability) + !! + !! ******** + !! Flushing + !! ******** + !! + !! we want to solve this equation: + !! ============================== + !! dS/dt = -w dSbr/dz + !! + !! with Sbr = brine salinity + !! w = upwelling velocity (i.e. vertical velocity of the brines, negative upward => < 0) + !! + !! w = Fmass / rhob if v_br > v_brc (= 5%) + !! = 0 otherwise + !! + !! with Fmass = -Flush * rhoi * dh / dt : mass flux (kg/m2/s, >0 since dh<0) + !! rhob = rhow * ( 1 + c*Sbr ) : brine density + !! v_br = S / Sbr : brine volume fraction + !! rhoi : ice density + !! rhow : fresh water density (kg/m3) + !! c : empirical coef (0.8e-3 ‰-1) + !! tuning parameters: + !! Flush : fraction of melt water allowed to percolate thru the ice (30%) + !! v_brc : critical brine volume above which there is flushing (5%) + !! + !! discrete form is solved using upward scheme (such as in CICE): + !! (S(t+dt)-S(t))/dt = -w(k) * (Sbr(k-1)-Sbr(k))/dz + !! + !! + !! ** References + !! Thomas, M., Vancoppenolle, M., France, J. L., Sturges, W. T., Bakker, D. C. E., Kaiser, J., & von Glasow, R. (2020). + !! Tracer measurements in growing sea ice support convective gravity drainage parameterizations. + ! Journal of Geophysical Research: Oceans, 125, e2019JC015791. https://doi.org/10. 1029/2019JC015791 !!--------------------------------------------------------------------- - LOGICAL, INTENT(in) :: ld_sal ! gravity drainage and flushing or not - ! - INTEGER :: ji ! dummy loop indices - REAL(wp) :: zs_sni, zds ! local scalars + INTEGER :: ji, jk, jk1, jk2 ! dummy loop indices REAL(wp) :: z1_time_gd, z1_time_fl + ! + ! for gravity drainage and flushing + INTEGER :: iter + REAL(wp) :: zh_i, z1_h_i, zhmelt, zc, zcfl, zperm, ztmp, zdt + REAL(wp), DIMENSION(nlay_i) :: z_mid + REAL(wp), DIMENSION(nlay_i+1) :: z_edge + REAL(wp), DIMENSION(nlay_i) :: zds, zperm_eff, zv_br, zRa, zRae, zw_br + REAL(wp), DIMENSION(0:nlay_i+1) :: zs_br + ! + ! permeability + REAL(wp), PARAMETER :: np_perm_eff = 2 ! 1 = vertical minimum + ! 2 = harmonic mean + REAL(wp), PARAMETER :: np_perm_for = 1 ! 0 = SI3 + ! 1 = Freitag 99 + ! 2 = RJW 2014 + ! Rayleigh + REAL(wp), PARAMETER :: zcp_br = 4.e6 ! heat capacity of brine (J/m3) + REAL(wp), PARAMETER :: zbeta = 7.5e-4 ! saline density coefficient (g/kg)-1 + REAL(wp), PARAMETER :: zcnd_br = 0.523 ! thermal conductivity of brine W/m/K + REAL(wp), PARAMETER :: zvisc = 1.8e-6 ! Kinematic viscosity of brine + ! GN scheme constant + REAL(wp), PARAMETER :: zrhob_GN = 1020. ! Brine density (kg/m3) + ! + ! for sanity checks + REAL(wp) :: zmiss, zs_min, zds_max, zcfl_max !!--------------------------------------------------------------------- - + ! + ! sanity check + IF( ln_sal_chk) CALL iom_miss_val( 'icetemp', zmiss ) ! get missing value from xml + ! SELECT CASE ( nn_icesal ) ! ! !---------------------------------------------! CASE( 2 ) ! time varying salinity with linear profile ! ! !---------------------------------------------! - z1_time_gd = rDt_ice / rn_time_gd - z1_time_fl = rDt_ice / rn_time_fl - ! + IF( ln_drainage ) THEN ; z1_time_gd = rDt_ice / rn_time_gd + ELSE ; z1_time_gd = 0._wp + ENDIF + IF( ln_flushing ) THEN ; z1_time_fl = rDt_ice / rn_time_fl + ELSE ; z1_time_fl = 0._wp + ENDIF + ! DO ji = 1, npti ! - IF( h_i_1d(ji) > 0._wp ) THEN - ! - ! --- Update ice salinity from snow-ice and bottom growth --- ! - zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi ! salinity of snow ice - zds = ( zs_sni - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice - zds = zds + ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog (ji) / h_i_1d(ji) ! bottom growth - ! update salinity (nb: salt flux already included in icethd_dh) - s_i_1d(ji) = s_i_1d(ji) + zds + IF( h_i_1d(ji) > rn_sal_himin ) THEN ! ! --- Update ice salinity from brine drainage and flushing --- ! - IF( ld_sal ) THEN - IF( t_su_1d(ji) >= rt0 ) THEN ! flushing (summer time) - zds = - MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl - ELSEIF( t_su_1d(ji) <= t_bo_1d(ji) ) THEN ! gravity drainage - zds = - MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd - ELSE - zds = 0._wp - ENDIF - ! update salinity - s_i_1d(ji) = s_i_1d(ji) + zds - ! salt flux - sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice + IF( t_su_1d(ji) >= rt0 ) THEN ! flushing (summer time) + zds(1) = - MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl + ELSEIF( t_su_1d(ji) <= t_bo_1d(ji) ) THEN ! gravity drainage + zds(1) = - MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd + ELSE + zds(1) = 0._wp ENDIF - ! - ! --- salinity must stay inbounds --- ! - zds = MAX( 0._wp, rn_simin - s_i_1d(ji) ) ! > 0 if s_i < simin - zds = zds + MIN( 0._wp, rn_simax - s_i_1d(ji) ) ! < 0 if s_i > simax ! update salinity - s_i_1d(ji) = s_i_1d(ji) + zds + s_i_1d(ji) = s_i_1d(ji) + zds(1) ! salt flux - sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice + sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds(1) * r1_Dt_ice + ! + ! --- salinity must stay inbounds --- ! + IF( ln_drainage .OR. ln_flushing ) THEN + zds(1) = MAX( 0._wp, rn_simin - s_i_1d(ji) ) ! > 0 if s_i < simin + zds(1) = zds(1) + MIN( 0._wp, rn_sinew*sss_1d(ji) - s_i_1d(ji) ) ! < 0 if s_i > simax + ! update salinity + s_i_1d(ji) = s_i_1d(ji) + zds(1) + ! salt flux + sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds(1) * r1_Dt_ice + ENDIF ! ENDIF ! END DO ! - ! Salinity profile + ! Salinity profile (gives sz_i) CALL ice_var_salprof1d ! ! !----------------------------------------! @@ -115,11 +251,294 @@ CONTAINS ! !----------------------------------------! CALL ice_var_salprof1d ! + ! !--------------------------------! + CASE( 4 ) ! Gravity Drainage and Flushing ! + ! !--------------------------------! + + ! Initialization + ! ============== + DO jk = 1, nlay_i + z_mid(jk) = ( REAL( jk ) - 0.5_wp ) * r1_nlay_i + END DO + DO jk = 1, nlay_i+1 + z_edge(jk) = ( REAL( jk ) - 1._wp ) * r1_nlay_i + END DO + + ! Gravity Drainage + ! ================ + IF( ln_drainage ) THEN + ! + zdt = rDt_ice / REAL( nn_drainage ) + ! + DO ji = 1, npti + ! ice thickness ( we do not want to do anything for salt when ice is thinner than the minimum allowed ) + IF( h_i_1d(ji) >= rn_sal_himin ) THEN ; z1_h_i = 1._wp / ( h_i_1d(ji) * r1_nlay_i ) + ELSE ; z1_h_i = 0._wp + ENDIF + ! + ! surface melting (m) + zhmelt = dh_s_sum(ji) + dh_i_sum(ji) ! =0 if no melt, <0 otherwise + ! + ! iteration to converge (usually 10 is ok) + zcfl_max = 0._wp + zds_max = 0._wp + zs_min = 0._wp + DO iter = 1, nn_drainage + ! + CALL ice_brine( sss_1d(ji), t_i_1d(ji,:), sz_i_1d(ji,:), zs_br, zv_br ) + + IF( h_i_1d(ji) >= rn_sal_himin .AND. MAXVAL( zs_br(:) ) > sss_1d(ji) .AND. zhmelt >= 0._wp ) THEN + ! during melting season, salt flux can turn upward with these schemes + ! Effective permeability + ! ---------------------- + IF( np_perm_eff == 1 ) THEN ! Minimum + + DO jk = 1, nlay_i + IF ( np_perm_for == 0 ) THEN ; zperm_eff(jk) = 3.e-8_wp * ( MINVAL( zv_br(jk:nlay_i) ) )**3. ! SI3 + ELSEIF( np_perm_for == 1 ) THEN ; zperm_eff(jk) = 1.995e-8_wp * ( MINVAL( zv_br(jk:nlay_i) ) )**3.1 ! Freitag + ELSEIF( np_perm_for == 2 ) THEN ; zperm_eff(jk) = 1.e-8_wp * ( MINVAL( zv_br(jk:nlay_i) ) )**3. ! Rees Jones and Worster + END IF ! -> this case leads to bizarre results + END DO + + ELSEIF( np_perm_eff == 2 ) THEN ! Harmonic Mean + + DO jk1 = 1, nlay_i + ztmp = 0._wp + DO jk2 = jk1, nlay_i + IF ( np_perm_for == 0 ) THEN ; zperm = 3.e-8_wp * zv_br(jk2)**3. ! SI3 + ELSEIF( np_perm_for == 1 ) THEN ; zperm = 1.995e-8_wp * zv_br(jk2)**3.1 ! Freitag + ELSEIF( np_perm_for == 2 ) THEN ; zperm = 1.e-8_wp * zv_br(jk2)**3. ! Rees Jones and Worster + END IF + ztmp = ztmp + 1._wp / zperm + END DO + zperm_eff(jk1) = REAL( nlay_i - jk1 + 1 ) / ztmp + END DO + + END IF + + ! Rayleigh number + ! --------------- + ! Ra = cp_br * g * beta * (Sbr(z) - Sw) * perm * (h-z) / (cnd_br*visc) [RWJ2014 formulation] + DO jk = 1, nlay_i + zRa(jk) = zcp_br * grav * zbeta * MAX( 0., zs_br(jk) - sss_1d(ji)) * zperm_eff(jk) & + & * h_i_1d(ji) * ( 1._wp - z_mid(jk) ) / ( zcnd_br * zvisc ) + END DO + + ! Vertical velocity + ! ----------------- + IF ( nn_sal_scheme == 1 ) THEN ! *** RJW 2014 *** + ! + ! if Ra is everywhere < Rc : no convection => Rae =0 + ! else : convection until zc => Rae /= 0 + zc = 0._wp + ztmp = 0._wp + DO jk = nlay_i,1,-1 + IF ( zRa(jk) >= rn_Rc_RJW ) THEN + ztmp = MAX( ztmp , zRa(jk) - rn_Rc_RJW ) + zc = z_edge(jk) + END IF + zRae(jk) = ztmp + END DO + + DO jk = 1, nlay_i + zw_br(jk) = - rn_alpha_RJW * zRae(jk) * ( zcnd_br / zcp_br ) * & + & ( z_mid(jk) - zc ) / ( h_i_1d(ji) * ( 1 - zc )**2 ) + END DO + + ELSEIF ( nn_sal_scheme == 2 ) THEN ! *** GN 2013 *** + DO jk = 1, nlay_i + zw_br(jk) = - rn_alpha_GN / zrhob_GN * SUM ( ( zRa(1:jk) - rn_Rc_GN ) * h_i_1d(ji) * r1_nlay_i ) + END DO + + ELSEIF ( nn_sal_scheme == 3 ) THEN ! *** CW 1988 *** + DO jk = 1, nlay_i + zw_br(jk) = - rn_alpha_CW * 0.0589_wp * MAX( 0._wp, zv_br(jk)/rn_vbrc - 1._wp ) + END DO + + END IF + + ! Salinity + ! -------- + ! upstream scheme as in CICE: ds = -w(k)*dt/dz * ( s_br(k+1) - s_br(k) ), w > 0 or < 0 + DO jk = 1, nlay_i + ! + zcfl = zw_br(jk) * zdt * z1_h_i + zds(jk) = - zcfl * ( zs_br(jk+1) - zs_br(jk) ) + ! + zcfl_max = MAX( zcfl_max, ABS(zcfl) ) + zs_min = MIN( zs_min , sz_i_1d(ji,jk) + zds(jk) ) ! record what salinity would be without the trick below + ENDDO + IF( ln_sal_chk) zds_max = MAX( zds_max, MAX( 0._wp, SUM( zds(:) ) * r1_nlay_i )*REAL(nn_drainage) ) + + DO jk = 1, nlay_i + ! + !!clem trick + zds(jk) = MAX( zds(jk), -sz_i_1d(ji,jk)+rn_simin ) + ! + ! new salinity + sz_i_1d(ji,jk) = sz_i_1d(ji,jk) + zds(jk) + ! + ! salt flux + sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * r1_nlay_i * zds(jk) * r1_Dt_ice ! r1_Dt_ice is ok + ! + END DO + + ENDIF + + END DO + + ! sanity check + IF( ln_sal_chk) THEN + cfl_drain_1d(ji) = zcfl_max + IF( zds_max > 0._wp ) THEN ; s_drain_dserr_1d(ji) = zds_max ; t_drain_dserr_1d(ji,:) = t_i_1d(ji,:)-rt0 + ELSE ; s_drain_dserr_1d(ji) = zmiss ; t_drain_dserr_1d(ji,:) = zmiss + ENDIF + IF( zs_min < 0._wp ) THEN ; s_drain_serr_1d(ji) = zs_min ; t_drain_serr_1d(ji,:) = t_i_1d(ji,:)-rt0 + ELSE ; s_drain_serr_1d(ji) = zmiss ; t_drain_serr_1d(ji,:) = zmiss + ENDIF + ENDIF + + ENDDO + ENDIF + + ! Flushing + ! ======== + IF( ln_flushing ) THEN + + zdt = rDt_ice / REAL( nn_flushing ) + ! + DO ji = 1, npti + ! ice thickness ( we do not want to do anything for salt when ice is thinner than the minimum allowed ) + IF( h_i_1d(ji) >= rn_sal_himin ) THEN ; z1_h_i = 1._wp / ( h_i_1d(ji) * r1_nlay_i ) + ELSE ; z1_h_i = 0._wp + ENDIF + ! + ! surface melting (m) + zhmelt = dh_s_sum(ji) + dh_i_sum(ji) ! =0 if no melt, <0 otherwise + ! + ! iteration to converge (usually 1 is ok) + zcfl_max = 0._wp + zds_max = 0._wp + zs_min = 0._wp + DO iter = 1, nn_flushing + ! + CALL ice_brine( sss_1d(ji), t_i_1d(ji,:), sz_i_1d(ji,:), zs_br, zv_br ) + ! + IF( zhmelt < 0._wp & ! Flushing if surface melting + !& .AND. t_i_1d(ji,1) >= t_i_1d(ji,nlay_i) & ! and surface temperature is warmer than bottom temperature + & .AND. MINVAL(zv_br(:)) >= rn_vbrc ) THEN ! and brine volume fraction exceeds a certain treshold + ! + ! Vertical velocity + ! ----------------- + DO jk = 1, nlay_i + zw_br(jk) = -rn_flushrate * ( dh_i_sum(ji)*rhoi + dh_s_sum(ji)*rhos ) & + & / ( rhow * ( 1._wp + 0.8e-3_wp * zs_br(jk) ) ) * r1_Dt_ice ! r1_Dt_ice is ok + ! can be replaced by rhow but in theory rhow should be rho_br = (rho0*(1+c*S_br)), with c = 0.8e-3 + ENDDO + + ! Salinity + ! -------- + DO jk = 1, nlay_i + ! upstream scheme as in CICE: ds = -w*dt/dz * ( s_br(k) - s_br(k-1) ), w > 0 + ! zcfl = w*dt/dz + zcfl = zw_br(jk) * zdt * z1_h_i + ! + zcfl_max = MAX( zcfl_max, ABS(zcfl) ) + ! + zds(jk) = - zcfl * ( zs_br(jk) - zs_br(jk-1) ) + ! + zs_min = MIN( zs_min , sz_i_1d(ji,jk) + zds(jk) ) ! record what salinity would be without the trick below + ! + ENDDO + IF( ln_sal_chk) zds_max = MAX( zds_max, MAX( 0._wp, SUM( zds(:) ) * r1_nlay_i )*REAL(nn_flushing) ) + + DO jk = 1, nlay_i +!!$ zds(jk) = MIN( 0._wp, zds(jk) ) ! min to block flushing when temperature profile is not ok + ! + ! new salinity + sz_i_1d(ji,jk) = sz_i_1d(ji,jk) + zds(jk) + ! + ! salt flux + sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * r1_nlay_i * zds(jk) * r1_Dt_ice ! r1_Dt_ice is ok + + ENDDO + ENDIF + + END DO + + ! sanity check + IF( ln_sal_chk) THEN + cfl_flush_1d(ji) = zcfl_max + IF( zds_max > 0._wp ) THEN ; s_flush_dserr_1d(ji) = zds_max ; t_flush_dserr_1d(ji,:) = t_i_1d(ji,:)-rt0 + ELSE ; s_flush_dserr_1d(ji) = zmiss ; t_flush_dserr_1d(ji,:) = zmiss + ENDIF + IF( zs_min < 0._wp ) THEN ; s_flush_serr_1d(ji) = zs_min ; t_flush_serr_1d(ji,:) = t_i_1d(ji,:)-rt0 + ELSE ; s_flush_serr_1d(ji) = zmiss ; t_flush_serr_1d(ji,:) = zmiss + ENDIF + ENDIF + + ENDDO + ENDIF + + ! --- salinity must stay inbounds --- ! + IF( ln_drainage .OR. ln_flushing ) THEN + DO ji = 1, npti + DO jk = 1, nlay_i + zds(jk) = MAX( 0._wp, rn_simin - sz_i_1d(ji,jk) ) ! > 0 if s_i < simin + zds(jk) = zds(jk) + MIN( 0._wp, rn_sinew*sss_1d(ji) - sz_i_1d(ji,jk) ) ! < 0 if s_i > simax + ! update salinity + sz_i_1d(ji,jk) = sz_i_1d(ji,jk) + zds(jk) + ! salt flux + sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * r1_nlay_i * zds(jk) * r1_Dt_ice + END DO + ENDDO + ENDIF + END SELECT ! END SUBROUTINE ice_thd_sal + SUBROUTINE ice_brine( zsss, pt_i, ps_i, ps_br, pv_br ) + !!------------------------------------------------------------------- + !! *** ROUTINE ice_brine *** + !! + !! ** Purpose : computes brine volume fraction (%) + !! and salinity of the brine in sea ice + !! + !!------------------------------------------------------------------- + INTEGER :: ji, jk ! dummy loop indices + REAL(wp) :: zt1, zt2, zt3 + REAL(wp), INTENT(in ) :: zsss + REAL(wp), DIMENSION(1:nlay_i) , INTENT(in ) :: pt_i, ps_i + REAL(wp), DIMENSION(0:nlay_i+1), INTENT( out) :: ps_br + REAL(wp), DIMENSION(1:nlay_i) , INTENT( out) :: pv_br + !!------------------------------------------------------------------- + ! + ! brines + DO jk = 1, nlay_i + ! brine salinity + zt1 = pt_i(jk) - rt0 + zt2 = zt1 * zt1 + zt3 = zt2 * zt1 + IF ( nn_liquidus == 1 ) THEN ; ps_br(jk) = - zt1 / rTmlt ! --- Linear liquidus + ELSEIF( nn_liquidus == 2 ) THEN ; ps_br(jk) = -18.7_wp * zt1 - 0.519_wp * zt2 - 0.00535_wp * zt3 ! --- 3rd order liquidus, VC19 + ELSEIF( nn_liquidus == 3 ) THEN ; ps_br(jk) = -17.6_wp * zt1 - 0.389_wp * zt2 - 0.00362_wp * zt3 ! --- Weast 71 liquidus in RJW14 + ENDIF + ! brine volume fraction + IF( zt1 < - epsi06 ) THEN + pv_br(jk) = ps_i(jk) / ps_br(jk) + ELSE + pv_br(jk) = 0._wp + ENDIF + ENDDO + ! brine salinity at the interfaces + ps_br(0) = 0._wp + ps_br(nlay_i+1) = zsss + ! + END SUBROUTINE ice_brine + + SUBROUTINE ice_thd_sal_init !!------------------------------------------------------------------- !! *** ROUTINE ice_thd_sal_init *** @@ -133,8 +552,10 @@ CONTAINS !!------------------------------------------------------------------- INTEGER :: ios ! Local integer !! - NAMELIST/namthd_sal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, & - & rn_sal_fl, rn_time_fl, rn_simax , rn_simin + NAMELIST/namthd_sal/ nn_icesal, ln_flushing, ln_drainage, rn_sinew, rn_simin, & + & rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl, & + & rn_sal_himin, nn_liquidus, nn_drainage, nn_flushing, rn_flushrate, rn_vbrc, & + & nn_sal_scheme, rn_alpha_RJW, rn_Rc_RJW, rn_alpha_GN, rn_Rc_GN, rn_alpha_CW, ln_sal_chk !!------------------------------------------------------------------- ! READ ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901) @@ -148,16 +569,36 @@ CONTAINS WRITE(numout,*) 'ice_thd_sal_init : Ice parameters for salinity ' WRITE(numout,*) '~~~~~~~~~~~~~~~~' WRITE(numout,*) ' Namelist namthd_sal:' - WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal - WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 rn_icesal = ', rn_icesal - WRITE(numout,*) ' restoring salinity for gravity drainage rn_sal_gd = ', rn_sal_gd - WRITE(numout,*) ' restoring time for for gravity drainage rn_time_gd = ', rn_time_gd - WRITE(numout,*) ' restoring salinity for flushing rn_sal_fl = ', rn_sal_fl - WRITE(numout,*) ' restoring time for flushing rn_time_fl = ', rn_time_fl - WRITE(numout,*) ' Maximum tolerated ice salinity rn_simax = ', rn_simax - WRITE(numout,*) ' Minimum tolerated ice salinity rn_simin = ', rn_simin + WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal + WRITE(numout,*) ' activate flushing ln_flushing = ', ln_flushing + WRITE(numout,*) ' activate gravity drainage ln_drainage = ', ln_drainage + WRITE(numout,*) ' New ice salinity (fraction of sss) rn_sinew = ', rn_sinew + WRITE(numout,*) ' Minimum tolerated ice salinity rn_simin = ', rn_simin + ! -- nn_icesal=1 -- ! + WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 rn_icesal = ', rn_icesal + ! -- nn_icesal=2 -- ! + WRITE(numout,*) ' restoring salinity for gravity drainage rn_sal_gd = ', rn_sal_gd + WRITE(numout,*) ' restoring time for for gravity drainage rn_time_gd = ', rn_time_gd + WRITE(numout,*) ' restoring salinity for flushing rn_sal_fl = ', rn_sal_fl + WRITE(numout,*) ' restoring time for flushing rn_time_fl = ', rn_time_fl + ! -- nn_icesal=4 -- ! + WRITE(numout,*) ' min ice thickness for drainage and flushing rn_sal_himin = ', rn_sal_himin + WRITE(numout,*) ' liquidous formulation (1=linear, 2=VC2019, 3=Weast71) nn_liquidus = ', nn_liquidus + WRITE(numout,*) ' number of subcycles for gravity drainage nn_drainage = ', nn_drainage + WRITE(numout,*) ' number of subcycles for flushing nn_flushing = ', nn_flushing + WRITE(numout,*) ' fraction of melt water used for flushing rn_flushrate = ', rn_flushrate + WRITE(numout,*) ' critical brines volume above which flushing can occur rn_vbrc = ', rn_vbrc + WRITE(numout,*) ' convection scheme (1=RJW2014, 2=GN2013, 3=CW88) nn_sal_scheme = ', nn_sal_scheme + WRITE(numout,*) ' brine flow for RJW2014 scheme rn_alpha_RJW = ', rn_alpha_RJW + WRITE(numout,*) ' critical Rayleigh number for RJW2014 scheme rn_Rc_RJW = ', rn_Rc_RJW + WRITE(numout,*) ' brine flow for GN2013 scheme (kg/m3/s) rn_alpha_GN = ', rn_alpha_GN + WRITE(numout,*) ' critical Rayleigh number for GN2013 scheme rn_Rc_GN = ', rn_Rc_GN + WRITE(numout,*) ' brine flow for CW1988 scheme rn_alpha_CW = ', rn_alpha_CW + WRITE(numout,*) ' sanity checks (output diags) ln_sal_chk = ', ln_sal_chk ENDIF ! + IF( nn_icesal /= 4 ) ln_sal_chk=.FALSE. ! option only valid for nn_icesal = 4 + ! END SUBROUTINE ice_thd_sal_init #else diff --git a/src/ICE/icevar.F90 b/src/ICE/icevar.F90 index 03d1fd6d28e5c7f8f1c1a2047f03237a0f56ee1f..731a761706e590928436a52921cd5361fd1ca903 100644 --- a/src/ICE/icevar.F90 +++ b/src/ICE/icevar.F90 @@ -46,7 +46,7 @@ MODULE icevar !! ice_var_zapsmall : remove very small area and volume !! ice_var_zapneg : remove negative ice fields !! ice_var_roundoff : remove negative values arising from roundoff erros - !! ice_var_bv : brine volume + !! ice_var_brine : brine volume !! ice_var_enthalpy : compute ice and snow enthalpies from temperature !! ice_var_sshdyn : compute equivalent ssh in lead !! ice_var_itd : convert N-cat to M-cat @@ -68,14 +68,15 @@ MODULE icevar PUBLIC ice_var_agg PUBLIC ice_var_glo2eqv - PUBLIC ice_var_eqv2glo +!!$ PUBLIC ice_var_eqv2glo PUBLIC ice_var_salprof PUBLIC ice_var_salprof1d PUBLIC ice_var_zapsmall PUBLIC ice_var_zapneg PUBLIC ice_var_roundoff - PUBLIC ice_var_bv + PUBLIC ice_var_brine PUBLIC ice_var_enthalpy + PUBLIC ice_var_vremap PUBLIC ice_var_sshdyn PUBLIC ice_var_itd PUBLIC ice_var_snwfra @@ -134,7 +135,6 @@ CONTAINS END_2D ! DO_2D( 0, 0, 0, 0 ) - st_i(ji,jj) = SUM( sv_i(ji,jj,:) ) et_s(ji,jj) = SUM( SUM( e_s (ji,jj,:,:), dim=2 ) ) et_i(ji,jj) = SUM( SUM( e_i (ji,jj,:,:), dim=2 ) ) ! @@ -146,6 +146,16 @@ CONTAINS ENDIF END_2D ! + IF( nn_icesal == 4 ) THEN + DO_2D( 0, 0, 0, 0 ) + st_i(ji,jj) = SUM( SUM( szv_i (ji,jj,:,:), dim=2 ) ) + END_2D + ELSE + DO_2D( 0, 0, 0, 0 ) + st_i(ji,jj) = SUM( sv_i(ji,jj,:) ) + END_2D + ENDIF + ! The following fields are calculated for diagnostics and outputs only ! ==> Do not use them for other purposes IF( kn > 1 ) THEN @@ -252,9 +262,9 @@ CONTAINS INTEGER, INTENT( in ) :: kn ! =1 everything including ponds (necessary for init) ! ! =2 excluding ponds if ln_pnd=F INTEGER :: ji, jj, jk, jl ! dummy loop indices - REAL(wp) :: ze_i ! local scalars + REAL(wp) :: ze_i, zs_i ! local scalars REAL(wp) :: ze_s, ztmelts, zbbb, zccc ! - - - REAL(wp) :: zhmax, z1_hmax ! - - + REAL(wp) :: zhmax, z1_hmax ! - - REAL(wp) :: zlay_i, zlay_s ! - - REAL(wp), PARAMETER :: zhl_max = 0.015_wp ! pond lid thickness above which the ponds disappear from the albedo calculation REAL(wp), PARAMETER :: zhl_min = 0.005_wp ! pond lid thickness below which the full pond area is used in the albedo calculation @@ -294,14 +304,7 @@ CONTAINS ! END_2D ENDDO - ! !--- salinity (with a minimum value imposed everywhere) - IF( nn_icesal == 2 ) THEN - WHERE( v_i(:,:,:) > epsi20 ) ; s_i(:,:,:) = MAX( rn_simin , MIN( rn_simax, sv_i(:,:,:) / v_i(:,:,:) ) ) - ELSEWHERE ; s_i(:,:,:) = rn_simin - END WHERE - ENDIF - CALL ice_var_salprof ! salinity profile - + ! IF( kn == 1 .OR. ln_pnd ) THEN ALLOCATE( za_s_fra(A2D(0),jpl) ) ! @@ -334,6 +337,46 @@ CONTAINS ! DEALLOCATE( za_s_fra ) ENDIF + ! + !------------------- + ! Ice salinity (with a min value rn_simin and a max value rn_sinew*sss) + !------------------- + IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN + ! + CALL ice_var_salprof ! salinity profile + ! + ELSEIF( nn_icesal == 2 ) THEN + ! + DO jl = 1, jpl + DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) + IF( v_i(ji,jj,jl) > epsi20 ) THEN +!!clem test s_i(ji,jj,jl) = MAX( rn_simin , MIN( rn_sinew * sss_m(ji,jj), sv_i(ji,jj,jl) / v_i(ji,jj,jl) ) ) + s_i(ji,jj,jl) = sv_i(ji,jj,jl) / v_i(ji,jj,jl) + ELSE + s_i(ji,jj,jl) = rn_simin + ENDIF + END_2D + ENDDO + CALL ice_var_salprof ! salinity profile + ! + ELSEIF( nn_icesal == 4 ) THEN + ! + s_i(:,:,:) = 0._wp + zlay_i = REAL( nlay_i , wp ) ! number of layers + DO jl = 1, jpl + DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) + IF ( v_i(ji,jj,jl) > epsi20 ) THEN !--- icy area + zs_i = szv_i(ji,jj,jk,jl) / ( v_i(ji,jj,jl) * r1_nlay_i ) +!!clem test sz_i(ji,jj,jk,jl) = MAX( rn_simin , MIN( rn_sinew * sss_m(ji,jj), zs_i ) ) + sz_i(ji,jj,jk,jl) = zs_i + ELSE !--- no ice + sz_i(ji,jj,jk,jl) = rn_simin + ENDIF + s_i(ji,jj,jl) = s_i(ji,jj,jl) + sz_i(ji,jj,jk,jl) * r1_nlay_i + END_3D + END DO + ! + ENDIF !------------------- ! Ice temperature [K] (with a minimum value (rt0 - 100.)) @@ -383,27 +426,27 @@ CONTAINS END SUBROUTINE ice_var_glo2eqv - SUBROUTINE ice_var_eqv2glo - !!------------------------------------------------------------------- - !! *** ROUTINE ice_var_eqv2glo *** - !! - !! ** Purpose : computes global variables as function of - !! equivalent variables, i.e. it turns VEQV into VGLO - !!------------------------------------------------------------------- - INTEGER :: ji, jj, jl ! dummy loop indices - !!------------------------------------------------------------------- - ! - DO jl = 1, jpl - DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) - v_i (ji,jj,jl) = h_i (ji,jj,jl) * a_i (ji,jj,jl) - v_s (ji,jj,jl) = h_s (ji,jj,jl) * a_i (ji,jj,jl) - sv_i(ji,jj,jl) = s_i (ji,jj,jl) * v_i (ji,jj,jl) - v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) - v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) - END_2D - ENDDO - ! - END SUBROUTINE ice_var_eqv2glo +!!$ SUBROUTINE ice_var_eqv2glo +!!$ !!------------------------------------------------------------------- +!!$ !! *** ROUTINE ice_var_eqv2glo *** +!!$ !! +!!$ !! ** Purpose : computes global variables as function of +!!$ !! equivalent variables, i.e. it turns VEQV into VGLO +!!$ !!------------------------------------------------------------------- +!!$ INTEGER :: ji, jj, jl ! dummy loop indices +!!$ !!------------------------------------------------------------------- +!!$ ! +!!$ DO jl = 1, jpl +!!$ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) +!!$ v_i (ji,jj,jl) = h_i (ji,jj,jl) * a_i (ji,jj,jl) +!!$ v_s (ji,jj,jl) = h_s (ji,jj,jl) * a_i (ji,jj,jl) +!!$ sv_i(ji,jj,jl) = s_i (ji,jj,jl) * v_i (ji,jj,jl) +!!$ v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) +!!$ v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) +!!$ END_2D +!!$ ENDDO +!!$ ! +!!$ END SUBROUTINE ice_var_eqv2glo SUBROUTINE ice_var_salprof @@ -422,11 +465,9 @@ CONTAINS !! ** References : Vancoppenolle et al., 2007 !!------------------------------------------------------------------- INTEGER :: ji, jj, jk, jl ! dummy loop index - REAL(wp) :: z1_dS - REAL(wp) :: ztmp1, ztmp2, zs0, zs - REAL(wp) :: z_slope_s, zalpha ! case 2 only - REAL(wp), PARAMETER :: zsi0 = 3.5_wp - REAL(wp), PARAMETER :: zsi1 = 4.5_wp + REAL(wp) :: z1_dS, ztmp1, ztmp2, zalpha + REAL(wp), PARAMETER :: zsi0 = 3.5_wp + REAL(wp), PARAMETER :: zsi1 = 4.5_wp !!------------------------------------------------------------------- !!gm Question: Remove the option 3 ? How many years since it last use ? @@ -440,27 +481,27 @@ CONTAINS s_i (:,:,:) = rn_icesal ! ! !---------------------------------------------! - CASE( 2 ) ! time varying salinity with linear profile ! + CASE( 2 , 4 ) ! time varying salinity with linear profile ! ! !---------------------------------------------! z1_dS = 1._wp / ( zsi1 - zsi0 ) ! DO jl = 1, jpl DO jk = 1, nlay_i DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) - ! ! Slope of the linear profile - IF( h_i(ji,jj,jl) > epsi20 ) THEN ; z_slope_s = 2._wp * s_i(ji,jj,jl) / h_i(ji,jj,jl) - ELSE ; z_slope_s = 0._wp + ! + IF ( s_i(ji,jj,jl) >= zsi1 ) THEN ; zalpha = 0._wp + ELSEIF( s_i(ji,jj,jl) <= zsi0 ) THEN ; zalpha = 1._wp + ELSE ; zalpha = ( zsi1 - s_i(ji,jj,jl) ) * z1_dS ENDIF ! - zalpha = MAX( 0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp ) ) - ! ! force a constant profile when SSS too low (Baltic Sea) - IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) ) zalpha = 0._wp + IF( s_i(ji,jj,jl) >= ( 0.5_wp * rn_sinew * sss_m(ji,jj) ) ) zalpha = 0._wp ! force constant profile when SSS too low (Baltic Sea) + IF( s_i(ji,jj,jl) <= ( REAL( nlay_i , wp ) * rn_simin ) ) zalpha = 0._wp ! force constant profile when ice surface salinity too small + ! ! it depends on nlay_i which is not ideal ! - ! Computation of the profile - ! ! linear profile with 0 surface value - zs0 = z_slope_s * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i - zs = zalpha * zs0 + ( 1._wp - zalpha ) * s_i(ji,jj,jl) ! weighting the profile - sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) + ! linear profile with 0 surface value + sz_i(ji,jj,jk,jl) = zalpha * s_i(ji,jj,jl) * 2._wp * ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i & + & + ( 1._wp - zalpha ) * s_i(ji,jj,jl) + ! => mean(sz_i(jk)) = s_i END_2D ENDDO ENDDO @@ -499,12 +540,9 @@ CONTAINS !! Works with 1d vectors and is used by thermodynamic modules !!------------------------------------------------------------------- INTEGER :: ji, jk ! dummy loop indices - REAL(wp) :: ztmp1, ztmp2, z1_dS ! local scalars - REAL(wp) :: zs, zs0 ! - - - ! - REAL(wp) :: z_slope_s, zalpha ! - REAL(wp), PARAMETER :: zsi0 = 3.5_wp - REAL(wp), PARAMETER :: zsi1 = 4.5_wp + REAL(wp) :: z1_dS, ztmp1, ztmp2, zalpha + REAL(wp), PARAMETER :: zsi0 = 3.5_wp + REAL(wp), PARAMETER :: zsi1 = 4.5_wp !!------------------------------------------------------------------- ! SELECT CASE ( nn_icesal ) @@ -515,27 +553,26 @@ CONTAINS sz_i_1d(1:npti,:) = rn_icesal ! ! !---------------------------------------------! - CASE( 2 ) ! time varying salinity with linear profile ! + CASE( 2 , 4 ) ! time varying salinity with linear profile ! ! !---------------------------------------------! z1_dS = 1._wp / ( zsi1 - zsi0 ) ! DO jk = 1, nlay_i DO ji = 1, npti - ! ! Slope of the linear profile - IF( h_i_1d(ji) > epsi20 ) THEN ; z_slope_s = 2._wp * s_i_1d(ji) / h_i_1d(ji) - ELSE ; z_slope_s = 0._wp - ENDIF ! - zalpha = MAX( 0._wp , MIN( ( zsi1 - s_i_1d(ji) ) * z1_dS , 1._wp ) ) - ! ! force a constant profile when SSS too low (Baltic Sea) - IF( 2._wp * s_i_1d(ji) >= sss_1d(ji) ) zalpha = 0._wp + IF ( s_i_1d(ji) >= zsi1 ) THEN ; zalpha = 0._wp + ELSEIF( s_i_1d(ji) <= zsi0 ) THEN ; zalpha = 1._wp + ELSE ; zalpha = ( zsi1 - s_i_1d(ji) ) * z1_dS + ENDIF ! + IF( s_i_1d(ji) >= ( 0.5_wp * rn_sinew * sss_1d(ji) ) ) zalpha = 0._wp ! force constant profile when SSS too low (Baltic Sea) + IF( s_i_1d(ji) <= ( REAL( nlay_i , wp ) * rn_simin ) ) zalpha = 0._wp ! force constant profile when ice surface salinity too small + ! ! it depends on nlay_i which is not ideal ! - ! Computation of the profile - ! ! linear profile with 0 surface value - zs0 = z_slope_s * ( REAL(jk,wp) - 0.5_wp ) * h_i_1d(ji) * r1_nlay_i - zs = zalpha * zs0 + ( 1._wp - zalpha ) * s_i_1d(ji) - sz_i_1d(ji,jk) = MIN( rn_simax , MAX( zs , rn_simin ) ) + ! linear profile with 0 surface value + sz_i_1d(ji,jk) = zalpha * s_i_1d(ji) * 2._wp * ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i & + & + ( 1._wp - zalpha ) * s_i_1d(ji) + ! => mean(sz_i(jk)) = s_i END DO END DO ! @@ -573,6 +610,38 @@ CONTAINS ELSEWHERE ; h_i(A2D(0),:) = 0._wp END WHERE ! + !----------------------------------------------------------------- + ! Zap ice volume, add salt to ocean + !----------------------------------------------------------------- + IF( nn_icesal == 4 ) THEN + DO jl = 1, jpl + DO_3D( 0, 0, 0, 0, 1, nlay_i ) + ! + zsmall = MIN( a_i(ji,jj,jl), v_i(ji,jj,jl), h_i(ji,jj,jl) ) + ! + IF( zsmall < epsi10 ) THEN + ! update exchanges with ocean + sfx_res(ji,jj) = sfx_res(ji,jj) + szv_i(ji,jj,jk,jl) * rhoi * r1_Dt_ice + szv_i(ji,jj,jk,jl) = 0._wp + sz_i (ji,jj,jk,jl) = rn_simin + ENDIF + END_3D + ENDDO + ELSE + DO jl = 1, jpl + DO_2D( 0, 0, 0, 0 ) + ! + zsmall = MIN( a_i(ji,jj,jl), v_i(ji,jj,jl), h_i(ji,jj,jl) ) + ! + IF( zsmall < epsi10 ) THEN + ! update exchanges with ocean + sfx_res(ji,jj) = sfx_res(ji,jj) + sv_i(ji,jj,jl) * rhoi * r1_Dt_ice + sv_i (ji,jj,jl) = 0._wp + ENDIF + END_2D + END DO + ENDIF + !----------------------------------------------------------------- ! Zap ice energy and use ocean heat to melt ice !----------------------------------------------------------------- @@ -605,7 +674,7 @@ CONTAINS ENDDO ! !----------------------------------------------------------------- - ! zap ice and snow volume, add water and salt to ocean + ! zap ice and snow volume, add water to ocean !----------------------------------------------------------------- DO jl = 1, jpl DO_2D( 0, 0, 0, 0 ) @@ -614,7 +683,6 @@ CONTAINS ! IF( zsmall < epsi10 ) THEN ! update exchanges with ocean - sfx_res(ji,jj) = sfx_res(ji,jj) + sv_i(ji,jj,jl) * rhoi * r1_Dt_ice wfx_res(ji,jj) = wfx_res(ji,jj) + v_i (ji,jj,jl) * rhoi * r1_Dt_ice wfx_res(ji,jj) = wfx_res(ji,jj) + v_s (ji,jj,jl) * rhos * r1_Dt_ice wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice @@ -624,7 +692,6 @@ CONTAINS v_s (ji,jj,jl) = 0._wp t_su (ji,jj,jl) = sst_m(ji,jj) + rt0 oa_i (ji,jj,jl) = 0._wp - sv_i (ji,jj,jl) = 0._wp ! h_i (ji,jj,jl) = 0._wp h_s (ji,jj,jl) = 0._wp @@ -654,7 +721,7 @@ CONTAINS END SUBROUTINE ice_var_zapsmall - SUBROUTINE ice_var_zapneg( ihls, pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) + SUBROUTINE ice_var_zapneg( ihls, pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i ) !!------------------------------------------------------------------- !! *** ROUTINE ice_var_zapneg *** !! @@ -673,6 +740,7 @@ CONTAINS REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content + REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pszv_i ! ice salt content ! INTEGER :: ji, jj, jl, jk ! dummy loop indices REAL(wp) :: z1_dt @@ -690,30 +758,51 @@ CONTAINS ! make sure a_i=0 where v_i<=0 WHERE( pv_i(:,:,:) <= 0._wp ) pa_i(:,:,:) = 0._wp + !-------------------------------------- + ! zap ice salt and send it to the ocean + !-------------------------------------- + IF( nn_icesal == 4 ) THEN + DO jl = 1, jpl + DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i ) + IF( pszv_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN + zsfx_res(ji,jj) = zsfx_res(ji,jj) + pszv_i(ji,jj,jk,jl) * rhoi * z1_dt + pszv_i(ji,jj,jk,jl) = 0._wp + ENDIF + END_3D + ENDDO + ELSE + DO jl = 1, jpl + DO_2D( ihls, ihls, ihls, ihls ) + IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN + zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt + psv_i (ji,jj,jl) = 0._wp + ENDIF + END_2D + END DO + ENDIF + ! !---------------------------------------- ! zap ice energy and send it to the ocean !---------------------------------------- DO jl = 1, jpl DO_3D( ihls, ihls, ihls, ihls, 1, nlay_i ) - IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN + IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN zhfx_res(ji,jj) = zhfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 pe_i(ji,jj,jk,jl) = 0._wp ENDIF END_3D - ENDDO - ! - DO jl = 1, jpl + ! DO_3D( ihls, ihls, ihls, ihls, 1, nlay_s ) - IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN + IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_s(ji,jj,jl) <= 0._wp ) THEN zhfx_res(ji,jj) = zhfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 pe_s(ji,jj,jk,jl) = 0._wp ENDIF END_3D ENDDO ! - !----------------------------------------------------- - ! zap ice and snow volume, add water and salt to ocean - !----------------------------------------------------- + !-------------------------------------------- + ! zap ice and snow volume, add water to ocean + !-------------------------------------------- DO jl = 1, jpl DO_2D( ihls, ihls, ihls, ihls ) IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN @@ -724,10 +813,6 @@ CONTAINS zwfx_res(ji,jj) = zwfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt pv_s (ji,jj,jl) = 0._wp ENDIF - IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN - zsfx_res(ji,jj) = zsfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt - psv_i (ji,jj,jl) = 0._wp - ENDIF IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN zwfx_res(ji,jj) = zwfx_res(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt pv_il (ji,jj,jl) = 0._wp @@ -754,7 +839,7 @@ CONTAINS END SUBROUTINE ice_var_zapneg - SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) + SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i, pszv_i ) !!------------------------------------------------------------------- !! *** ROUTINE ice_var_roundoff *** !! @@ -770,59 +855,74 @@ CONTAINS REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_il ! melt pond lid volume REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_s ! snw heat content REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_i ! ice heat content + REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pszv_i ! ice salt content !!------------------------------------------------------------------- WHERE( pa_i (1:npti,:) < 0._wp ) pa_i (1:npti,:) = 0._wp ! a_i must be >= 0 WHERE( pv_i (1:npti,:) < 0._wp ) pv_i (1:npti,:) = 0._wp ! v_i must be >= 0 WHERE( pv_s (1:npti,:) < 0._wp ) pv_s (1:npti,:) = 0._wp ! v_s must be >= 0 - WHERE( psv_i(1:npti,:) < 0._wp ) psv_i(1:npti,:) = 0._wp ! sv_i must be >= 0 WHERE( poa_i(1:npti,:) < 0._wp ) poa_i(1:npti,:) = 0._wp ! oa_i must be >= 0 WHERE( pe_i (1:npti,:,:) < 0._wp ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 WHERE( pe_s (1:npti,:,:) < 0._wp ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN - WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 - WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 + WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 + WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 IF( ln_pnd_lids ) THEN - WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:) = 0._wp ! v_il must be >= 0 + WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:) = 0._wp ! v_il must be >= 0 ENDIF ENDIF + IF( nn_icesal == 4 ) THEN + WHERE( pszv_i(1:npti,:,:) < 0._wp ) pszv_i(1:npti,:,:) = 0._wp ! szv_i must be >= 0 + ELSE + WHERE( psv_i (1:npti,:) < 0._wp ) psv_i (1:npti,:) = 0._wp ! sv_i must be >= 0 + ENDIF ! END SUBROUTINE ice_var_roundoff - SUBROUTINE ice_var_bv + SUBROUTINE ice_var_brine !!------------------------------------------------------------------- - !! *** ROUTINE ice_var_bv *** + !! *** ROUTINE ice_var_brine *** !! - !! ** Purpose : computes mean brine volume (%) in sea ice + !! ** Purpose : computes brine volume fraction (%) + !! and salinity of the brine in sea ice !! !! ** Method : e = - 0.054 * S (ppt) / T (C) !! !! References : Vancoppenolle et al., JGR, 2007 !!------------------------------------------------------------------- INTEGER :: ji, jj, jk, jl ! dummy loop indices + REAL(wp) :: zt1, zt2, zt3, zs_br !!------------------------------------------------------------------- ! - bv_i (:,:,:) = 0._wp + v_ibr(:,:,:) = 0._wp DO jl = 1, jpl DO_3D( 0, 0, 0, 0, 1, nlay_i ) - IF( t_i(ji,jj,jk,jl) < rt0 - epsi10 ) THEN - bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rTmlt * sz_i(ji,jj,jk,jl) * r1_nlay_i / ( t_i(ji,jj,jk,jl) - rt0 ) + ! brine salinity + zt1 = t_i(ji,jj,jk,jl) - rt0 + zt2 = zt1 * zt1 + zt3 = zt2 * zt1 + IF ( nn_liquidus == 1 ) THEN ; zs_br = - zt1 / rTmlt ! --- Linear liquidus + ELSEIF( nn_liquidus == 2 ) THEN ; zs_br = -18.7_wp * zt1 - 0.519_wp * zt2 - 0.00535_wp * zt3 ! --- 3rd order liquidus, VC19 + ELSEIF( nn_liquidus == 3 ) THEN ; zs_br = -17.6_wp * zt1 - 0.389_wp * zt2 - 0.00362_wp * zt3 ! --- Weast 71 liquidus in RJW14 ENDIF + ! brine volume fraction + IF( zt1 < - epsi10 ) v_ibr(ji,jj,jl) = v_ibr(ji,jj,jl) + r1_nlay_i * sz_i(ji,jj,jk,jl) / zs_br END_3D ENDDO ! + ! mean brine volume fraction DO_2D( 0, 0, 0, 0 ) IF( vt_i(ji,jj) > epsi20 ) THEN - bvm_i(ji,jj) = SUM( bv_i(ji,jj,:) * v_i(ji,jj,:) ) / vt_i(ji,jj) + vm_ibr(ji,jj) = SUM( v_ibr(ji,jj,:) * v_i(ji,jj,:) ) / vt_i(ji,jj) ELSE - bvm_i(ji,jj) = 0._wp + vm_ibr(ji,jj) = 0._wp ENDIF END_2D ! - END SUBROUTINE ice_var_bv - + END SUBROUTINE ice_var_brine + SUBROUTINE ice_var_enthalpy !!------------------------------------------------------------------- !! *** ROUTINE ice_var_enthalpy *** @@ -854,6 +954,84 @@ CONTAINS ! END SUBROUTINE ice_var_enthalpy + SUBROUTINE ice_var_vremap( ph_old, pts_old, pts_i ) + !!------------------------------------------------------------------- + !! *** ROUTINE ice_var_vremap *** + !! + !! ** Purpose : + !! This routine computes new vertical grids in the ice, + !! and consistently redistributes temperatures and salinities + !! Redistribution is made so as to ensure energy/salt conservation + !! + !! + !! ** Method : linear conservative remapping + !! + !! ** Steps : 1) cumulative integrals of old enthalpies/salinities/thicknesses + !! 2) linear remapping on the new layers + !! + !! ------------ cum0(0) ------------- cum1(0) + !! NEW ------------- + !! ------------ cum0(1) ==> ------------- + !! ... ------------- + !! ------------ ------------- + !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i) + !! + !! + !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 + !!------------------------------------------------------------------- + REAL(wp), DIMENSION(0:nlay_i+1), INTENT(in) :: ph_old, pts_old ! old tickness (m), enthlapy (J.m-2) or salt (m.g/kg) + REAL(wp), DIMENSION(1:nlay_i) , INTENT(inout) :: pts_i ! new enthlapies (J.m-3, remapped) or salt (g/kg) + ! + INTEGER :: ji ! dummy loop indices + INTEGER :: jk0, jk1 ! old/new layer indices + ! + REAL(wp), DIMENSION(0:nlay_i+2) :: zts_cum0, zh_cum0 ! old cumulative enthlapies/salinities and layers interfaces + REAL(wp), DIMENSION(0:nlay_i) :: zts_cum1, zh_cum1 ! new cumulative enthlapies/salinities and layers interfaces + REAL(wp) :: zhnew ! new layers thicknesses + !!------------------------------------------------------------------- + + !------------------------------------------------------------------------------- + ! 1) Cumulative integral of old enthalpy/salt * thickness and layers interfaces + !------------------------------------------------------------------------------- + zts_cum0(0) = 0._wp + zh_cum0 (0) = 0._wp + DO jk0 = 1, nlay_i+2 + zts_cum0(jk0) = zts_cum0(jk0-1) + pts_old(jk0-1) + zh_cum0 (jk0) = zh_cum0 (jk0-1) + ph_old(jk0-1) + END DO + + !------------------------------------ + ! 2) Interpolation on the new layers + !------------------------------------ + ! new layer thickesses + zhnew = SUM( ph_old(0:nlay_i+1) ) * r1_nlay_i + + ! new layers interfaces + zh_cum1(0) = 0._wp + DO jk1 = 1, nlay_i + zh_cum1(jk1) = zh_cum1(jk1-1) + zhnew + END DO + + zts_cum1(0:nlay_i) = 0._wp + ! new cumulative q*h => linear interpolation + DO jk0 = 1, nlay_i+2 + DO jk1 = 1, nlay_i-1 + IF( zh_cum1(jk1) <= zh_cum0(jk0) .AND. zh_cum1(jk1) > zh_cum0(jk0-1) ) THEN + zts_cum1(jk1) = ( zts_cum0(jk0-1) * ( zh_cum0(jk0) - zh_cum1(jk1 ) ) + & + & zts_cum0(jk0 ) * ( zh_cum1(jk1) - zh_cum0(jk0-1) ) ) & + & / ( zh_cum0(jk0) - zh_cum0(jk0-1) ) + ENDIF + END DO + END DO + ! to ensure that total heat/salt content is strictly conserved, set: + zts_cum1(nlay_i) = zts_cum0(nlay_i+2) + + ! new enthalpies/salinities + DO jk1 = 1, nlay_i + pts_i(jk1) = MAX( 0._wp, zts_cum1(jk1) - zts_cum1(jk1-1) ) / MAX( zhnew, epsi20 ) ! max for roundoff error + END DO + + END SUBROUTINE ice_var_vremap FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b) !!--------------------------------------------------------------------- diff --git a/src/ICE/icewri.F90 b/src/ICE/icewri.F90 index d72fd7d807fd1174fd3b6c5a8506889531769dfd..2e66ee1d699925b019fdd01e4bc3bb9fc035a47e 100644 --- a/src/ICE/icewri.F90 +++ b/src/ICE/icewri.F90 @@ -51,11 +51,12 @@ CONTAINS ! INTEGER :: ji, jj, jk, jl ! dummy loop indices REAL(wp) :: z2da, z2db, zrho1, zrho2 - REAL(wp) :: zmiss_val ! missing value retrieved from xios - REAL(wp), DIMENSION(A2D(0)) :: z2d ! 2D workspace - REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask - REAL(wp), DIMENSION(A2D(0),jpl) :: zmsk00l, zmsksnl ! cat masks - REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace + REAL(wp) :: zmiss ! missing value retrieved from xios + REAL(wp), DIMENSION(A2D(0)) :: z2d ! 2D workspace + REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask + REAL(wp), DIMENSION(A2D(0),jpl) :: zmsk00c, zmsksnc ! categories masks + REAL(wp), DIMENSION(A2D(0),nlay_i,jpl) :: zmsk00l ! layers masks + REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace ! ! Global ice diagnostics (SIMIP) REAL(wp) :: zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh ! area, extent, volume @@ -65,10 +66,10 @@ CONTAINS IF( ln_timing ) CALL timing_start('icewri') ! get missing value from xml - CALL iom_miss_val( 'icetemp', zmiss_val ) + CALL iom_miss_val( 'icetemp', zmiss ) ! brine volume - IF( iom_use('icebrv') .OR. iom_use('icebrv_cat') ) CALL ice_var_bv + IF( iom_use('icebrv') .OR. iom_use('icebrv_cat') ) CALL ice_var_brine ! tresholds for outputs DO_2D( 0, 0, 0, 0 ) @@ -87,13 +88,16 @@ CONTAINS END_2D DO jl = 1, jpl DO_2D( 0, 0, 0, 0 ) - IF( a_i(ji,jj,jl) >= epsi06 ) THEN ; zmsk00l(ji,jj,jl) = 1._wp ! 1 if ice , 0 if no ice - ELSE ; zmsk00l(ji,jj,jl) = 0._wp + IF( a_i(ji,jj,jl) >= epsi06 ) THEN ; zmsk00c(ji,jj,jl) = 1._wp ! 1 if ice , 0 if no ice + ELSE ; zmsk00c(ji,jj,jl) = 0._wp ENDIF - IF( v_s(ji,jj,jl) >= epsi06 ) THEN ; zmsksnl(ji,jj,jl) = 1._wp ! 1 if snow , 0 if no snow - ELSE ; zmsksnl(ji,jj,jl) = 0._wp + IF( v_s(ji,jj,jl) >= epsi06 ) THEN ; zmsksnc(ji,jj,jl) = 1._wp ! 1 if snow , 0 if no snow + ELSE ; zmsksnc(ji,jj,jl) = 0._wp ENDIF END_2D + DO_3D( 0, 0, 0, 0, 1, nlay_i ) + zmsk00l(ji,jj,jk,jl) = zmsk00c(ji,jj,jl) + END_3D ENDDO !----------------- @@ -107,43 +111,43 @@ CONTAINS CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0) ! ! general fields - IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i(A2D(0)) * rhoi * zmsk00 ) ! Ice mass per cell area - IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s(A2D(0)) * rhos * zmsksn ) ! Snow mass per cell area - IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i(A2D(0)) * zmsk00 ) ! ice concentration - IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i(A2D(0)) * zmsk00 ) ! ice volume = mean ice thickness over the cell - IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i(:,:) * zmsk00 ) ! ice thickness - IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s(:,:) * zmsk00 ) ! snw thickness - IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i(:,:)* 100. * zmsk00 ) ! brine volume - IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i(:,:) / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age - IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new(:,:) ) ! new ice thickness formed in the leads - IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s(A2D(0)) * zmsksn ) ! snow volume - IF( iom_use('icefrb' ) ) THEN ! Ice freeboard + IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i(A2D(0)) * rhoi * zmsk00 ) ! Ice mass per cell area + IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s(A2D(0)) * rhos * zmsksn ) ! Snow mass per cell area + IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i(A2D(0)) * zmsk00 ) ! ice concentration + IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i(A2D(0)) * zmsk00 ) ! ice volume = mean ice thickness over the cell + IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i(:,:) * zmsk00 ) ! ice thickness + IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s(:,:) * zmsk00 ) ! snw thickness + IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , vm_ibr(:,:)* 100. * zmsk00 ) ! brine volume + IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i(:,:) / rday * zmsk15 + zmiss * ( 1._wp - zmsk15 ) ) ! ice age + IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new(:,:) ) ! new ice thickness formed in the leads + IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s(A2D(0)) * zmsksn ) ! snow volume + IF( iom_use('icefrb' ) ) THEN ! Ice freeboard z2d(:,:) = zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) WHERE( z2d < 0._wp ) z2d = 0._wp CALL iom_put( 'icefrb' , z2d * zmsk00 ) ENDIF ! melt ponds - IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip(A2D(0)) * zmsk00 ) ! melt pond total fraction - IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip(:,:) * zmsk00 ) ! melt pond depth - IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip(A2D(0)) * zmsk00 ) ! melt pond total volume per unit area - IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il(:,:) * zmsk00 ) ! melt pond lid depth - IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il(A2D(0)) * zmsk00 ) ! melt pond lid total volume per unit area + IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip(A2D(0)) * zmsk00 ) ! melt pond total fraction + IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip(:,:) * zmsk00 ) ! melt pond depth + IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip(A2D(0)) * zmsk00 ) ! melt pond total volume per unit area + IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il(:,:) * zmsk00 ) ! melt pond lid depth + IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il(A2D(0)) * zmsk00 ) ! melt pond lid total volume per unit area ! salt - IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i(:,:) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity - IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i(:,:) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area + IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i(:,:) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! mean ice salinity + IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i(:,:) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area ! heat - IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i (:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature - IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s (:,:) - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature - IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface - IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo (:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom - IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface - IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i (:,:) * zmsk00 ) ! ice heat content - IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s (:,:) * zmsksn ) ! snow heat content + IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i (:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! ice mean temperature + IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s (:,:) - rt0 ) * zmsksn + zmiss * ( 1._wp - zmsksn ) ) ! snw mean temperature + IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su(:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface + IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo (:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom + IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si(:,:) - rt0 ) * zmsk00 + zmiss * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface + IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i (:,:) * zmsk00 ) ! ice heat content + IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s (:,:) * zmsksn ) ! snow heat content ! momentum - IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice(:,:) ) ! ice velocity u - IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice(:,:) ) ! ice velocity v + IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice(:,:) ) ! ice velocity u + IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice(:,:) ) ! ice velocity v ! - IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice + IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice ALLOCATE( zfast(A2D(0)) ) DO_2D( 0, 0, 0, 0 ) z2da = u_ice(ji,jj) + u_ice(ji-1,jj) @@ -152,14 +156,14 @@ CONTAINS END_2D CALL iom_put( 'icevel', z2d ) - WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice + WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice ELSEWHERE ; zfast(:,:) = 0._wp END WHERE CALL iom_put( 'fasticepres', zfast ) DEALLOCATE( zfast ) ENDIF ! - IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo + IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo ALLOCATE( zalb(A2D(0)), zmskalb(A2D(0)) ) ! ice albedo WHERE( at_i_b(:,:) < 1.e-03 ) @@ -169,7 +173,7 @@ CONTAINS zmskalb(:,:) = 1._wp zalb (:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) / at_i_b(:,:) END WHERE - CALL iom_put( 'icealb' , zalb * zmskalb + zmiss_val * ( 1._wp - zmskalb ) ) + CALL iom_put( 'icealb' , zalb * zmskalb + zmiss * ( 1._wp - zmskalb ) ) ! ice+ocean albedo zalb(:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b(:,:) ) CALL iom_put( 'albedo' , zalb ) @@ -177,55 +181,50 @@ CONTAINS ENDIF ! ! --- category-dependent fields --- ! - IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0% - IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i(A2D(0),:) * zmsk00l ) ! area for categories - IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i(A2D(0),:) * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! thickness for categories - IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s(A2D(0),:) * zmsksnl + zmiss_val & - & * ( 1._wp - zmsksnl ) ) ! snow depth for categories - IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i(A2D(0),:) * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! salinity for categories - IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i(A2D(0),:) / rday * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! ice age - IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i(A2D(0),:,:), dim=3 ) * r1_nlay_i - rt0 ) & - & * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature - IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s(A2D(0),:,:), dim=3 ) * r1_nlay_s - rt0 ) & - & * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature - IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su(A2D(0),:) - rt0 ) * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! surface temperature - IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i(:,:,:) * 100. * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! brine volume - IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip(A2D(0),:) * zmsk00l ) ! melt pond frac for categories - IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip(A2D(0),:) * zmsk00l ) ! melt pond volume for categories - IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip(A2D(0),:) * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories - IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il(A2D(0),:) * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories - IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac(:,:,:) * zmsk00l ) ! melt pond frac per ice area for categories - IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff(:,:,:) * zmsk00l ) ! melt pond effective frac for categories - IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice(:,:,:) * zmsk00l + zmiss_val & - & * ( 1._wp - zmsk00l ) ) ! ice albedo for categories + IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00c ) ! ice mask 0% + IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i(A2D(0),:) * zmsk00c ) ! area for categories + IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! thickness for categories + IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s(A2D(0),:) * zmsksnc + zmiss * ( 1._wp - zmsksnc ) ) ! snow depth for categories + IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! salinity for categories + IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i(A2D(0),:) / rday * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! ice age + IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , v_ibr(:,:,:) * 100. * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! brine volume + IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip(A2D(0),:) * zmsk00c ) ! melt pond frac for categories + IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip(A2D(0),:) * zmsk00c ) ! melt pond volume for categories + IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! melt pond thickness for categories + IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il(A2D(0),:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! melt pond lid thickness for categories + IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac(:,:,:) * zmsk00c ) ! melt pond frac per ice area for categories + IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff(:,:,:) * zmsk00c ) ! melt pond effective frac for categories + IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice(:,:,:) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! ice albedo for categories + IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , (t_su(A2D(0),:)-rt0) * zmsk00c + zmiss * ( 1._wp - zmsk00c ) ) ! surface temperature + IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , (SUM( t_i(A2D(0),:,:), dim=3 ) * r1_nlay_i - rt0) * zmsk00c & + & + zmiss * ( 1._wp - zmsk00c ) ) ! ice temperature + IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , (SUM( t_s(A2D(0),:,:), dim=3 ) * r1_nlay_s - rt0) * zmsksnc & + & + zmiss * ( 1._wp - zmsksnc ) ) ! snow temperature + + ! --- layer-dependent fields --- ! + IF( iom_use('icetemp_lay' ) ) CALL iom_put( 'icetemp_lay' , (t_i(A2D(0),:,:)-rt0) * zmsk00l + zmiss * ( 1._wp - zmsk00l ) ) ! ice temperature + IF( iom_use('icesalt_lay' ) ) CALL iom_put( 'icesalt_lay' , sz_i(A2D(0),:,:) * zmsk00l + zmiss * ( 1._wp - zmsk00l ) ) ! ice salinity !------------------ ! Add-ons for SIMIP !------------------ ! trends IF( iom_use('dmithd') ) CALL iom_put( 'dmithd', - wfx_bog(:,:) - wfx_bom(:,:) - wfx_sum(:,:) - wfx_sni(:,:) & - & - wfx_opw(:,:) - wfx_lam(:,:) - wfx_res(:,:) ) ! Sea-ice mass change from thermodynamics - IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s) - IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water - IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth - IF( iom_use('dmisni') ) CALL iom_put( 'dmisni', - wfx_sni ) ! Sea-ice mass change through snow-to-ice conversion - IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting - IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting - IF( iom_use('dmilam') ) CALL iom_put( 'dmilam', - wfx_lam ) ! Sea-ice mass change through lateral melting - IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation - IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation - IF( iom_use('dmisub') ) CALL iom_put( 'dmisub', - wfx_ice_sub ) ! Sea-ice mass change through sublimation - IF( iom_use('dmsspr') ) CALL iom_put( 'dmsspr', - wfx_spr ) ! Snow mass change through snow fall - IF( iom_use('dmsssi') ) CALL iom_put( 'dmsssi', wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion - IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt - IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s) + & - wfx_opw(:,:) - wfx_lam(:,:) - wfx_res(:,:) ) ! Sea-ice mass change from thermodynamics + IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s) + IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water + IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth + IF( iom_use('dmisni') ) CALL iom_put( 'dmisni', - wfx_sni ) ! Sea-ice mass change through snow-to-ice conversion + IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting + IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting + IF( iom_use('dmilam') ) CALL iom_put( 'dmilam', - wfx_lam ) ! Sea-ice mass change through lateral melting + IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation + IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation + IF( iom_use('dmisub') ) CALL iom_put( 'dmisub', - wfx_ice_sub ) ! Sea-ice mass change through sublimation + IF( iom_use('dmsspr') ) CALL iom_put( 'dmsspr', - wfx_spr ) ! Snow mass change through snow fall + IF( iom_use('dmsssi') ) CALL iom_put( 'dmsssi', wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion + IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt + IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s) ! Global ice diagnostics IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & diff --git a/src/NST/agrif_all_update.F90 b/src/NST/agrif_all_update.F90 index b8573fd98908162982b179f9891e8cce1eb15c84..e6e888ebb7481294557ea1fa94e2cdcee7b2b9a9 100644 --- a/src/NST/agrif_all_update.F90 +++ b/src/NST/agrif_all_update.F90 @@ -120,7 +120,7 @@ CONTAINS CALL lbc_lnk( 'finalize_lbc_for_agrif', a_i, 'T',1._wp, v_i,'T',1._wp, & & v_s, 'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, & & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp ) - CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp, e_s,'T',1._wp ) + CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp, e_s,'T',1._wp, szv_i,'T',1._wp ) CALL lbc_lnk( 'finalize_lbc_for_agrif', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp ) #endif #if defined key_top diff --git a/src/NST/agrif_ice_interp.F90 b/src/NST/agrif_ice_interp.F90 index 9bc3d8aa8bd08f892b10b2d29b346d868b9f7d3b..7475a435df4faf8c9176ebc324ea64391ecafc6f 100644 --- a/src/NST/agrif_ice_interp.F90 +++ b/src/NST/agrif_ice_interp.F90 @@ -58,7 +58,7 @@ CONTAINS IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' IF(lwp) WRITE(numout,*) ' ' - ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i: + ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i, szv_i: Agrif_SpecialValue = -9999. Agrif_UseSpecialValue = .TRUE. CALL Agrif_Set_MaskMaxSearch(10) @@ -67,7 +67,7 @@ CONTAINS CALL lbc_lnk( 'agrif_istate_ice', a_i,'T',1._wp, v_i,'T',1._wp, & & v_s,'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, & & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp ) - CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp, e_s,'T',1._wp ) + CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp, e_s,'T',1._wp, szv_i,'T',1._wp ) ! ! Set u_ice, v_ice: use_sign_north = .TRUE. @@ -288,6 +288,9 @@ CONTAINS DO jk = 1, nlay_i ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 END DO + DO jk = 1, nlay_i + ptab(i1:i2,j1:j2,jm) = szv_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 + END DO END DO DO jk = k1, k2 @@ -325,6 +328,10 @@ CONTAINS e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) jm = jm + 1 END DO + DO jk = 1, nlay_i + szv_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) + jm = jm + 1 + END DO ! END DO ! @@ -355,6 +362,10 @@ CONTAINS ! ztab(:,:,jm) = e_i(:,:,jk,jl) ! jm = jm + 1 ! END DO +! DO jk = 1, nlay_i +! ztab(:,:,jm) = szv_i(:,:,jk,jl) +! jm = jm + 1 +! END DO ! ! ! END DO ! ! @@ -466,6 +477,10 @@ CONTAINS ! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ! jm = jm + 1 ! END DO +! DO jk = 1, nlay_i +! szv_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) +! jm = jm + 1 +! END DO ! ! ! END DO ! diff --git a/src/NST/agrif_ice_update.F90 b/src/NST/agrif_ice_update.F90 index 4557ef513ef4fa52c4f0e9bef05b97039c5ac8a4..21b2fdee13b5c3b7a3830d29ac54f35b719b6dd1 100644 --- a/src/NST/agrif_ice_update.F90 +++ b/src/NST/agrif_ice_update.F90 @@ -118,6 +118,9 @@ CONTAINS DO jk = 1, nlay_i ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) * e1e2t_frac(i1:i2,j1:j2) ; jm = jm + 1 END DO + DO jk = 1, nlay_i + ptab(i1:i2,j1:j2,jm) = szv_i(i1:i2,j1:j2,jk,jl) * e1e2t_frac(i1:i2,j1:j2) ; jm = jm + 1 + END DO END DO ! DO jk = k1, k2 @@ -160,6 +163,13 @@ CONTAINS jm = jm + 1 END DO ! + DO jk = 1, nlay_i + WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) + szv_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) + ENDWHERE + jm = jm + 1 + END DO + ! END DO ! DO jl = 1, jpl diff --git a/src/NST/agrif_user.F90 b/src/NST/agrif_user.F90 index bfe0ec9e14abd195c7ac2e1aeb249ce5f2e49c04..5f547049e8739c05c617d2bde85b6e101c621265 100644 --- a/src/NST/agrif_user.F90 +++ b/src/NST/agrif_user.F90 @@ -724,7 +724,7 @@ ind1 = nbghostcells - 1 ! Remove one land cell in ghosts ind2 = nn_hls + 1 + nbghostcells_x_w ind3 = nn_hls + 1 + nbghostcells_y_s - ipl = jpl*(9+nlay_s+nlay_i) + ipl = jpl*(9+nlay_s+2*nlay_i) CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id) CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id) diff --git a/src/OCE/BDY/bdydta.F90 b/src/OCE/BDY/bdydta.F90 index 062b70526f684fecb4ca4095f5f93e1bf36e0e83..aa4e30eff4dc43efaa2beb465f71d73f79e07345 100644 --- a/src/OCE/BDY/bdydta.F90 +++ b/src/OCE/BDY/bdydta.F90 @@ -183,7 +183,7 @@ CONTAINS dta_bdy(jbdy)%t_i(ib,jl) = SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1) dta_bdy(jbdy)%t_s(ib,jl) = SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1) dta_bdy(jbdy)%tsu(ib,jl) = t_su(ii,ij,jl) * tmask(ii,ij,1) - dta_bdy(jbdy)%s_i(ib,jl) = s_i (ii,ij,jl) * tmask(ii,ij,1) + dta_bdy(jbdy)%s_i(ib,jl) = SUM(sz_i(ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1) ! melt ponds dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1) dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1) diff --git a/src/OCE/BDY/bdyice.F90 b/src/OCE/BDY/bdyice.F90 index c5357c3bf8994fe2503f5b2dd1f90aed36c5632f..072417f91d742278acd45b1bb82eea7974adcd2b 100644 --- a/src/OCE/BDY/bdyice.F90 +++ b/src/OCE/BDY/bdyice.F90 @@ -95,7 +95,7 @@ CONTAINS & , a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp & & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) ! exchange 4d arrays : third dimension = 1 and then third dimension = jpk - CALL lbc_lnk('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, t_i , 'T', 1._wp, e_i , 'T', 1._wp, & + CALL lbc_lnk('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, t_i , 'T', 1._wp, e_i , 'T', 1._wp, szv_i , 'T', 1._wp, & & kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) END IF END DO ! ir @@ -104,9 +104,9 @@ CONTAINS ! ! i.e. inputs have not the same ice thickness distribution (set by rn_himean) ! ! than the regional simulation ! ! -- lbc_lnk needed because of iceitd_reb that is called in icecor.F90 - CALL lbc_lnk( 'bdyice', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, & - & t_su, 'T', 1._wp, a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp ) - CALL lbc_lnk( 'bdyice', e_i , 'T', 1._wp, e_s , 'T', 1._wp ) + CALL lbc_lnk( 'bdyice', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, & + & t_su, 'T', 1._wp, a_ip, 'T', 1._wp, v_ip , 'T', 1._wp, v_il, 'T', 1._wp ) + CALL lbc_lnk( 'bdyice', e_i , 'T', 1._wp, e_s , 'T', 1._wp, szv_i, 'T', 1._wp ) ! CALL ice_var_agg(1) ! @@ -251,11 +251,14 @@ CONTAINS s_i (ji,jj ,jl) = rn_icesal sz_i(ji,jj,:,jl) = rn_icesal ENDIF + IF( nn_icesal == 2 .OR. nn_icesal == 4 ) THEN + s_i (ji,jj ,jl) = MAX( rn_simin, MIN( s_i (ji,jj ,jl), rn_sinew*sss_m(ji,jj) ) ) + sz_i(ji,jj,:,jl) = MAX( rn_simin, MIN( sz_i(ji,jj,:,jl), rn_sinew*sss_m(ji,jj) ) ) + ENDIF ! ! global fields v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) ! volume ice v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) ! volume snw - sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content DO jk = 1, nlay_s t_s(ji,jj,jk,jl) = MIN( t_s(ji,jj,jk,jl), -0.15_wp + rt0 ) ! Force t_s to be lower than -0.15deg (arbitrary) => likely conservation issue ! ! otherwise instant melting can occur @@ -272,6 +275,9 @@ CONTAINS & - rcp * ztmelts ) e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i ! enthalpy in J/m2 END DO + ! salt content + sv_i (ji,jj, jl) = s_i (ji,jj, jl) * v_i(ji,jj,jl) + szv_i(ji,jj,:,jl) = sz_i(ji,jj,:,jl) * v_i(ji,jj,jl) * r1_nlay_i ! ! melt ponds v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) @@ -300,13 +306,14 @@ CONTAINS ENDIF ! ! global fields - v_i (ji,jj, jl) = 0._wp - v_s (ji,jj, jl) = 0._wp - sv_i(ji,jj, jl) = 0._wp - e_s (ji,jj,:,jl) = 0._wp - e_i (ji,jj,:,jl) = 0._wp - v_ip(ji,jj, jl) = 0._wp - v_il(ji,jj, jl) = 0._wp + v_i (ji,jj, jl) = 0._wp + v_s (ji,jj, jl) = 0._wp + sv_i (ji,jj, jl) = 0._wp + e_s (ji,jj,:,jl) = 0._wp + e_i (ji,jj,:,jl) = 0._wp + szv_i(ji,jj,:,jl) = 0._wp + v_ip (ji,jj, jl) = 0._wp + v_il (ji,jj, jl) = 0._wp ENDIF diff --git a/src/OCE/DOM/phycst.F90 b/src/OCE/DOM/phycst.F90 index 779e0b00388ece39a41e39e430d657cadef3311f..4cac5bcf289020b47f02064243fe9a947557906e 100644 --- a/src/OCE/DOM/phycst.F90 +++ b/src/OCE/DOM/phycst.F90 @@ -26,46 +26,46 @@ MODULE phycst REAL(wp), PUBLIC :: rad = 3.141592653589793_wp / 180._wp !: conversion from degre into radian REAL(wp), PUBLIC :: rsmall = 0.5 * EPSILON( 1.e0 ) !: smallest real computer value - REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day [s] - REAL(wp), PUBLIC :: rsiyea !: sideral year [s] - REAL(wp), PUBLIC :: rsiday !: sideral day [s] - REAL(wp), PUBLIC :: raamo = 12._wp !: number of months in one year - REAL(wp), PUBLIC :: rjjhh = 24._wp !: number of hours in one day - REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour - REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute - REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1] - REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m] - REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2] - REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin] - - REAL(wp), PUBLIC :: rho0 !: volumic mass of reference [kg/m3] - REAL(wp), PUBLIC :: r1_rho0 !: = 1. / rho0 [m3/kg] - REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] - REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] - REAL(wp), PUBLIC :: rho0_rcp !: = rho0 * rcp - REAL(wp), PUBLIC :: r1_rho0_rcp !: = 1. / ( rho0 * rcp ) - - REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice (not used?) - - REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice (for pisces) [psu] - REAL(wp), PUBLIC :: soce = 34.7_wp !: salinity of sea (for pisces and isf) [psu] - REAL(wp), PUBLIC :: rLevap = 2.5e+6_wp !: latent heat of evaporation (water) - REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant - REAL(wp), PUBLIC :: vkarmn2 = 0.4_wp*0.4_wp !: square of von Karman constant - REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant - - REAL(wp), PUBLIC :: rhos = 330._wp !: volumic mass of snow [kg/m3] - REAL(wp), PUBLIC :: rhoi = 917._wp !: volumic mass of sea ice [kg/m3] - REAL(wp), PUBLIC :: rhow = 1000._wp !: volumic mass of freshwater in melt ponds [kg/m3] - REAL(wp), PUBLIC :: rcnd_i = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K] - REAL(wp), PUBLIC :: rcpi = 2067.0_wp !: specific heat of fresh ice [J/kg/K] - REAL(wp), PUBLIC :: rLsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg] - REAL(wp), PUBLIC :: rLfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg] - REAL(wp), PUBLIC :: rTmlt = 0.054_wp !: decrease of seawater meltpoint with salinity - - REAL(wp), PUBLIC :: r1_rhoi !: 1 / rhoi - REAL(wp), PUBLIC :: r1_rhos !: 1 / rhos - REAL(wp), PUBLIC :: r1_rcpi !: 1 / rcpi + REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day [s] + REAL(wp), PUBLIC :: rsiyea !: sideral year [s] + REAL(wp), PUBLIC :: rsiday !: sideral day [s] + REAL(wp), PUBLIC :: raamo = 12._wp !: number of months in one year + REAL(wp), PUBLIC :: rjjhh = 24._wp !: number of hours in one day + REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour + REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute + REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1] + REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m] + REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2] + REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin] + + REAL(wp), PUBLIC :: rho0 !: volumic mass of reference [kg/m3] + REAL(wp), PUBLIC :: r1_rho0 !: = 1. / rho0 [m3/kg] + REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] + REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] + REAL(wp), PUBLIC :: rho0_rcp !: = rho0 * rcp + REAL(wp), PUBLIC :: r1_rho0_rcp !: = 1. / ( rho0 * rcp ) + + REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice (not used?) + + REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice (for pisces) [psu] + REAL(wp), PUBLIC :: soce = 34.7_wp !: salinity of sea (for pisces and isf) [psu] + REAL(wp), PUBLIC :: rLevap = 2.5e+6_wp !: latent heat of evaporation (water) + REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant + REAL(wp), PUBLIC :: vkarmn2 = 0.4_wp*0.4_wp !: square of von Karman constant + REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant + + REAL(wp), PUBLIC :: rhos = 330._wp !: volumic mass of snow [kg/m3] + REAL(wp), PUBLIC :: rhoi = 917._wp !: volumic mass of sea ice (Pounder, 1965) [kg/m3] + REAL(wp), PUBLIC :: rhow = 1000._wp !: volumic mass of freshwater in melt ponds [kg/m3] + REAL(wp), PUBLIC :: rcnd_i = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K] + REAL(wp), PUBLIC :: rcpi = 2096.7_wp !: specific heat of fresh ice (Feistel and Wagner, 2006) (previously 2067.0) [J/kg/K] + REAL(wp), PUBLIC :: rLsub = 2.8344e+6_wp !: pure ice latent heat of sublimation (Feistel and Wagner, 2006) [J/kg] + REAL(wp), PUBLIC :: rLfus = 0.3333601e+06_wp !: latent heat of fusion of fresh ice (Feistel and Wagner, 2006) (previously 0.334e+6) [J/kg] + REAL(wp), PUBLIC :: rTmlt = 0.054_wp !: decrease of seawater meltpoint with salinity + + REAL(wp), PUBLIC :: r1_rhoi !: 1 / rhoi + REAL(wp), PUBLIC :: r1_rhos !: 1 / rhos + REAL(wp), PUBLIC :: r1_rcpi !: 1 / rcpi !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) diff --git a/src/OCE/IOM/iom.F90 b/src/OCE/IOM/iom.F90 index 382e158778991789c23b4adb1d0ab732ad4e975e..88ddf990607c68abcb515671e332022ac8bf6b41 100644 --- a/src/OCE/IOM/iom.F90 +++ b/src/OCE/IOM/iom.F90 @@ -30,7 +30,7 @@ MODULE iom USE sbc_oce , ONLY : nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes #if defined key_si3 - USE ice , ONLY : jpl + USE ice , ONLY : jpl, nlay_i #endif USE phycst ! physical constants USE dianam ! build name of file @@ -263,6 +263,7 @@ CONTAINS CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) # if defined key_si3 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) + CALL iom_set_axis_attr( "nlayice", (/ (REAL(ji,wp), ji=1,nlay_i) /) ) ! SIMIP diagnostics (4 main arctic straits) CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) # endif diff --git a/src/OCE/LBC/lbc_lnk_call_generic.h90 b/src/OCE/LBC/lbc_lnk_call_generic.h90 index b48047de6f9542871df7bbd1fd4dd167c21f65ec..d13ac2a03810d70f82c1720343a75dd235d4c919 100644 --- a/src/OCE/LBC/lbc_lnk_call_generic.h90 +++ b/src/OCE/LBC/lbc_lnk_call_generic.h90 @@ -29,6 +29,8 @@ & , pt29, cdna29, psgn29, pt30, cdna30, psgn30, pt31, cdna31, psgn31, pt32, cdna32, psgn32 & & , pt33, cdna33, psgn33, pt34, cdna34, psgn34, pt35, cdna35, psgn35, pt36, cdna36, psgn36 & & , pt37, cdna37, psgn37, pt38, cdna38, psgn38, pt39, cdna39, psgn39, pt40, cdna40, psgn40 & + & , pt41, cdna41, psgn41, pt42, cdna42, psgn42, pt43, cdna43, psgn43, pt44, cdna44, psgn44 & + & , pt45, cdna45, psgn45, pt46, cdna46, psgn46, pt47, cdna47, psgn47, pt48, cdna48, psgn48 & & , kfillmode, pfillval, lsend, lrecv, ld4only, ldfull ) !!--------------------------------------------------------------------- CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine @@ -38,21 +40,24 @@ & pt16, pt17, pt18, pt19, pt20, pt21, pt22, & & pt23, pt24, pt25, pt26, pt27, pt28, pt29, & & pt30, pt31, pt32, pt33, pt34, pt35, pt36, & - & pt37, pt38, pt39, pt40 + & pt37, pt38, pt39, pt40, pt41, pt42, pt43, & + & pt44, pt45, pt46, pt47, pt48 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , & & cdna9 , cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, & & cdna16, cdna17, cdna18, cdna19, cdna20, cdna21, cdna22, & & cdna23, cdna24, cdna25, cdna26, cdna27, cdna28, cdna29, & & cdna30, cdna31, cdna32, cdna33, cdna34, cdna35, cdna36, & - & cdna37, cdna38, cdna39, cdna40 + & cdna37, cdna38, cdna39, cdna40, cdna41, cdna42, cdna43, & + & cdna44, cdna45, cdna46, cdna47, cdna48 REAL(PRECISION) , INTENT(in ) :: psgn1 ! sign used across the north fold REAL(PRECISION) , OPTIONAL , INTENT(in ) :: psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , & & psgn9 , psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, & & psgn16, psgn17, psgn18, psgn19, psgn20, psgn21, psgn22, & & psgn23, psgn24, psgn25, psgn26, psgn27, psgn28, psgn29, & & psgn30, psgn31, psgn32, psgn33, psgn34, psgn35, psgn36, & - & psgn37, psgn38, psgn39, psgn40 + & psgn37, psgn38, psgn39, psgn40, psgn41, psgn42, psgn43, & + & psgn44, psgn45, psgn46, psgn47, psgn48 INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) LOGICAL, DIMENSION(8), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out @@ -60,9 +65,9 @@ LOGICAL , OPTIONAL , INTENT(in ) :: ldfull ! .true. if we also update the last line of the inner domain !! INTEGER :: kfld ! number of elements that will be attributed - TYPE(PTR_4d_/**/PRECISION), DIMENSION(40) :: ptab_ptr ! pointer array - CHARACTER(len=1) , DIMENSION(40) :: cdna_ptr ! nature of ptab_ptr grid-points - REAL(PRECISION) , DIMENSION(40) :: psgn_ptr ! sign used across the north fold boundary + TYPE(PTR_4d_/**/PRECISION), DIMENSION(48) :: ptab_ptr ! pointer array + CHARACTER(len=1) , DIMENSION(48) :: cdna_ptr ! nature of ptab_ptr grid-points + REAL(PRECISION) , DIMENSION(48) :: psgn_ptr ! sign used across the north fold boundary !!--------------------------------------------------------------------- ! kfld = 0 ! initial array of pointer size @@ -110,6 +115,14 @@ IF( PRESENT(psgn38) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt38, cdna38, psgn38, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) IF( PRESENT(psgn39) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt39, cdna39, psgn39, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) IF( PRESENT(psgn40) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt40, cdna40, psgn40, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn41) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt41, cdna41, psgn41, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn42) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt42, cdna42, psgn42, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn43) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt43, cdna43, psgn43, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn44) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt44, cdna44, psgn44, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn45) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt45, cdna45, psgn45, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn46) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt46, cdna46, psgn46, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn47) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt47, cdna47, psgn47, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) + IF( PRESENT(psgn48) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt48, cdna48, psgn48, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) ! IF( nn_comm == 1 ) THEN CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only, ldfull )