Changeset 11822 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE
- Timestamp:
- 2019-10-29T11:41:36+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE
- Files:
-
- 29 edited
-
ice.F90 (modified) (20 diffs)
-
ice1d.F90 (modified) (2 diffs)
-
icealb.F90 (modified) (1 diff)
-
icecor.F90 (modified) (9 diffs)
-
icectl.F90 (modified) (23 diffs)
-
icedia.F90 (modified) (6 diffs)
-
icedyn.F90 (modified) (9 diffs)
-
icedyn_adv.F90 (modified) (4 diffs)
-
icedyn_adv_pra.F90 (modified) (17 diffs)
-
icedyn_adv_umx.F90 (modified) (38 diffs)
-
icedyn_rdgrft.F90 (modified) (21 diffs)
-
icedyn_rhg.F90 (modified) (4 diffs)
-
icedyn_rhg_evp.F90 (modified) (23 diffs)
-
iceistate.F90 (modified) (12 diffs)
-
iceitd.F90 (modified) (20 diffs)
-
icerst.F90 (modified) (8 diffs)
-
icesbc.F90 (modified) (4 diffs)
-
icestp.F90 (modified) (6 diffs)
-
icethd.F90 (modified) (9 diffs)
-
icethd_da.F90 (modified) (1 diff)
-
icethd_dh.F90 (modified) (2 diffs)
-
icethd_do.F90 (modified) (6 diffs)
-
icethd_pnd.F90 (modified) (2 diffs)
-
icethd_sal.F90 (modified) (1 diff)
-
icethd_zdf.F90 (modified) (1 diff)
-
icethd_zdf_bl99.F90 (modified) (3 diffs)
-
iceupdate.F90 (modified) (2 diffs)
-
icevar.F90 (modified) (19 diffs)
-
icewri.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/ice.F90
r10535 r11822 50 50 !! ******************************************************************* | 51 51 !! | 52 !! u_ice | - | Comp. U of the ice velocity| m/s |53 !! v_ice | - | Comp. V of the ice velocity| m/s |52 !! u_ice | - | ice velocity in i-direction | m/s | 53 !! v_ice | - | ice velocity in j-direction | m/s | 54 54 !! | 55 55 !! ******************************************************************* | … … 59 59 !! ** Global variables | 60 60 !!-------------|-------------|---------------------------------|-------| 61 !! a_i | a_i_1d| Ice concentration | |61 !! a_i | a_i_1d | Ice concentration | | 62 62 !! v_i | - | Ice volume per unit area | m | 63 63 !! v_s | - | Snow volume per unit area | m | 64 !! sv_i | - | Sea ice salt content | ppt.m | 65 !! oa_i ! - ! Sea ice areal age content | s | 66 !! e_i ! - ! Ice enthalpy | J/m2 | 67 !! - ! e_i_1d ! Ice enthalpy per unit vol. | J/m3 | 68 !! e_s ! - ! Snow enthalpy | J/m2 | 69 !! - ! e_s_1d ! Snow enthalpy per unit vol. | J/m3 | 64 !! sv_i | - | Sea ice salt content | pss.m | 65 !! oa_i | - | Sea ice areal age content | s | 66 !! e_i | | Ice enthalpy | J/m2 | 67 !! | e_i_1d | Ice enthalpy per unit vol. | J/m3 | 68 !! e_s | | Snow enthalpy | J/m2 | 69 !! | e_s_1d | Snow enthalpy per unit vol. | J/m3 | 70 !! a_ip | - | Ice pond concentration | | 71 !! v_ip | - | Ice pond volume per unit area| m | 70 72 !! | 71 73 !!-------------|-------------|---------------------------------|-------| … … 76 78 !! h_i | h_i_1d | Ice thickness | m | 77 79 !! h_s ! h_s_1d | Snow depth | m | 78 !! s_i ! s_i_1d | Sea ice bulk salinity ! p pt|79 !! sz_i ! sz_i_1d | Sea ice salinity profile ! p pt|80 !! s_i ! s_i_1d | Sea ice bulk salinity ! pss | 81 !! sz_i ! sz_i_1d | Sea ice salinity profile ! pss | 80 82 !! o_i ! - | Sea ice Age ! s | 81 83 !! t_i ! t_i_1d | Sea ice temperature ! K | 82 84 !! t_s ! t_s_1d | Snow temperature ! K | 83 85 !! t_su ! t_su_1d | Sea ice surface temperature ! K | 86 !! h_ip | h_ip_1d | Ice pond thickness | m | 84 87 !! | 85 88 !! notes: the ice model only sees a bulk (i.e., vertically averaged) | … … 99 102 !! vt_i | - | Total ice vol. per unit area | m | 100 103 !! vt_s | - | Total snow vol. per unit ar. | m | 101 !! sm_i | - | Mean sea ice salinity | ppt | 104 !! st_i | - | Total Sea ice salt content | pss.m | 105 !! sm_i | - | Mean sea ice salinity | pss | 102 106 !! tm_i | - | Mean sea ice temperature | K | 103 107 !! tm_s | - | Mean snow temperature | K | 104 !! et_i ! - ! Total ice enthalpy | J/m2 | 105 !! et_s ! - ! Total snow enthalpy | J/m2 | 106 !! bv_i ! - ! relative brine volume | ??? | 108 !! et_i | - | Total ice enthalpy | J/m2 | 109 !! et_s | - | Total snow enthalpy | J/m2 | 110 !! bv_i | - | relative brine volume | ??? | 111 !! at_ip | - | Total ice pond concentration | | 112 !! hm_ip | - | Mean ice pond depth | m | 113 !! vt_ip | - | Total ice pond vol. per unit area| m | 107 114 !!===================================================================== 108 115 … … 130 137 REAL(wp), PUBLIC :: rn_ishlat !: lateral boundary condition for sea-ice 131 138 LOGICAL , PUBLIC :: ln_landfast_L16 !: landfast ice parameterizationfrom lemieux2016 132 LOGICAL , PUBLIC :: ln_landfast_home !: landfast ice parameterizationfrom home made133 139 REAL(wp), PUBLIC :: rn_depfra !: fraction of ocean depth that ice must reach to initiate landfast ice 134 140 REAL(wp), PUBLIC :: rn_icebfr !: maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home) … … 183 189 184 190 ! !!** ice-ponds namelist (namthd_pnd) 191 LOGICAL , PUBLIC :: ln_pnd !: Melt ponds (T) or not (F) 185 192 LOGICAL , PUBLIC :: ln_pnd_H12 !: Melt ponds scheme from Holland et al 2012 186 193 LOGICAL , PUBLIC :: ln_pnd_CST !: Melt ponds scheme with constant fraction and depth … … 191 198 ! !!** ice-diagnostics namelist (namdia) ** 192 199 LOGICAL , PUBLIC :: ln_icediachk !: flag for ice diag (T) or not (F) 200 REAL(wp), PUBLIC :: rn_icechk_cel !: rate of ice spuriously gained/lost (at any gridcell) 201 REAL(wp), PUBLIC :: rn_icechk_glo !: rate of ice spuriously gained/lost (globally) 193 202 LOGICAL , PUBLIC :: ln_icediahsb !: flag for ice diag (T) or not (F) 194 203 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F) … … 208 217 REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number 209 218 210 ! !!** some other parameters for advection using the ULTIMATE-MACHO scheme211 LOGICAL, PUBLIC, DIMENSION(2) :: l_split_advumx = .FALSE. ! force one iteration at the first time-step212 213 219 ! !!** define arrays 214 220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce,v_oce !: surface ocean velocity used in ice dynamics … … 225 231 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 226 232 227 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 228 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sni !: snow ice growth component of wfx_snw [kg.m-2.s-1] 229 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sum !: surface melt component of wfx_snw [kg.m-2.s-1] 230 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_pnd !: melt pond-ocean mass exchange [kg.m-2.s-1] 231 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 232 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: sublimation of snow/ice [kg.m-2.s-1] 233 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sub !: snow sublimation [kg.m-2.s-1] 234 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice_sub !: ice sublimation [kg.m-2.s-1] 235 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_dyn !: dynamical component of wfx_snw [kg.m-2.s-1] 237 238 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange [kg.m-2.s-1] 239 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg.m-2.s-1] 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg.m-2.s-1] 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg.m-2.s-1] 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 243 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg.m-2.s-1] 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg.m-2.s-1] 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_lam !: lateral melt component of wfx_ice [kg.m-2.s-1] 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg.m-2.s-1] 247 248 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1] 249 250 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s] 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice growth/melt [PSU/m2/s] 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice growth/melt [PSU/m2/s] 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to ice growth/melt [PSU/m2/s] 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to ice growth/melt [PSU/m2/s] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [PSU/m2/s] 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [PSU/m2/s] 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: residual salt flux due to correction of ice thickness [PSU/m2/s] 259 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation 233 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: mass flux from snow-ocean mass exchange [kg.m-2.s-1] 234 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sni !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sum !: mass flux from surface melt component of wfx_snw [kg.m-2.s-1] 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_pnd !: mass flux from melt pond-ocean mass exchange [kg.m-2.s-1] 237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: mass flux from snow precipitation on ice [kg.m-2.s-1] 238 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: mass flux from sublimation of snow/ice [kg.m-2.s-1] 239 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sub !: mass flux from snow sublimation [kg.m-2.s-1] 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice_sub !: mass flux from ice sublimation [kg.m-2.s-1] 241 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_dyn !: mass flux from dynamical component of wfx_snw [kg.m-2.s-1] 243 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: mass flux from ice-ocean mass exchange [kg.m-2.s-1] 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: mass flux from snow ice growth component of wfx_ice [kg.m-2.s-1] 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: mass flux from lateral ice growth component of wfx_ice [kg.m-2.s-1] 247 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: mass flux from bottom ice growth component of wfx_ice [kg.m-2.s-1] 248 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 249 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: mass flux from bottom melt component of wfx_ice [kg.m-2.s-1] 250 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: mass flux from surface melt component of wfx_ice [kg.m-2.s-1] 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_lam !: mass flux from lateral melt component of wfx_ice [kg.m-2.s-1] 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: mass flux from residual component of wfx_ice [kg.m-2.s-1] 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 254 255 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] 256 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] 257 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] 258 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] 259 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] 260 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] 261 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] 262 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] 263 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] 264 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] 261 265 262 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth [W.m-2] … … 267 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt [W.m-2] 268 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping [W.m-2] 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_atm_oi !: heat flux available for thermo transformations [W.m-2] 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_oce_ai !: heat flux remaining at the end of thermo transformations [W.m-2] 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping => must be 0 [W.m-2] 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_atm_oi !: heat flux at the interface atm-[oce+ice] [W.m-2] 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_oce_ai !: heat flux at the interface oce-[atm+ice] [W.m-2] 273 276 274 277 ! heat flux associated with ice-atmosphere mass exchange … … 279 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 280 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from ridging [W.m-2] 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness[W.m-2]284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: heat flux due to correction on ice thick. (residual) [W.m-2] 282 285 283 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array … … 290 293 !!---------------------------------------------------------------------- 291 294 !! Variables defined for each ice category 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i !: Ice thickness (m)295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i !: Ice thickness (m) 293 296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 294 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m)295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area (m)296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_s !: Snow thickness (m)297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K)298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (ppt)299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m)300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (s)301 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (s)297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area (m) 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_s !: Snow thickness (m) 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K) 301 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (pss) 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity * volume per area (pss.m) 303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (s) 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (s) 302 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume 303 306 304 307 !! Variables summed over all categories, or associated to all the ice in a single grid cell 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 306 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 308 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 310 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (pss.m) 307 311 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 308 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content 310 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 311 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_s !: mean snw temperature over all categories 313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content (J/m2) 314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories (K) 315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_s !: mean snw temperature over all categories (K) 312 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories 313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories [PSU]314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories 315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_i !: mean ice thickness over all categories 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_s !: mean snow thickness over all categories 317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories 318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction with bathy(landfast param activated)317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories (pss) 318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories (K) 319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_i !: mean ice thickness over all categories (m) 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_s !: mean snow thickness over all categories (m) 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories (s) 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction on ocean bottom (landfast param activated) 319 323 320 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] … … 322 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 323 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice enthalpy [J/m2] 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSU] 325 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond fraction per grid cell area 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond volume per ice area 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond thickness [m] 330 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond fraction 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per unit area [m] 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSS] 329 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond concentration 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond fraction (a_ip/a_i) 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond depth [m] 334 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond concentration 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_ip !: mean melt pond depth [m] 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per gridcell area [m] 333 338 334 339 !!---------------------------------------------------------------------- … … 351 356 !! * Ice diagnostics 352 357 !!---------------------------------------------------------------------- 353 ! thd refers to changes induced by thermodynamics354 ! trp '' '' '' advection (transport of ice)355 !356 358 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 357 359 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume 358 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2)359 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2)360 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy [W/m2] 361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy [W/m2] 360 362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_sv !: transport of salt content 361 363 ! … … 365 367 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s] 366 368 369 !!---------------------------------------------------------------------- 370 !! * Ice conservation 371 !!---------------------------------------------------------------------- 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_v !: conservation of ice volume 373 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_s !: conservation of ice salt 374 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_t !: conservation of ice heat 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fv !: conservation of ice volume 376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fs !: conservation of ice salt 377 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_ft !: conservation of ice heat 367 378 ! 368 379 !!---------------------------------------------------------------------- … … 389 400 INTEGER :: ice_alloc 390 401 ! 391 INTEGER :: ierr(1 5), ii402 INTEGER :: ierr(16), ii 392 403 !!----------------------------------------------------------------- 393 404 ierr(:) = 0 … … 405 416 & wfx_bog (jpi,jpj) , wfx_dyn (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 406 417 & wfx_res (jpi,jpj) , wfx_sni (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 407 & afx_tot (jpi,jpj) , rn_amax_2d(jpi,jpj),&418 & rn_amax_2d (jpi,jpj) , & 408 419 & qsb_ice_bot(jpi,jpj) , qlead (jpi,jpj) , & 409 420 & sfx_res (jpi,jpj) , sfx_bri (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , & … … 425 436 ii = ii + 1 426 437 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , & 427 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) , &428 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s 429 & sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s 438 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) , & 439 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) , & 440 & sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) , & 430 441 & om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj) , STAT=ierr(ii) ) 431 442 … … 440 451 441 452 ii = ii + 1 442 ALLOCATE( at_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) )453 ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 443 454 444 455 ! * Old values of global variables … … 461 472 & diag_sice (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), STAT=ierr(ii) ) 462 473 474 ! * Ice conservation 475 ii = ii + 1 476 ALLOCATE( diag_v (jpi,jpj) , diag_s (jpi,jpj) , diag_t (jpi,jpj), & 477 & diag_fv(jpi,jpj) , diag_fs(jpi,jpj) , diag_ft(jpi,jpj), STAT=ierr(ii) ) 478 463 479 ! * SIMIP diagnostics 464 480 ii = ii + 1 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/ice1d.F90
r10534 r11822 123 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sv_i_1d !: 124 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: oa_i_1d !: 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: o_i_1d !: 125 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_ip_1d !: 126 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: v_ip_1d !: … … 209 210 & a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d (jpij) , v_s_1d (jpij) , & 210 211 & h_ip_1d (jpij) , a_ip_frac_1d(jpij) , & 211 & sv_i_1d (jpij) , oa_i_1d (jpij) , STAT=ierr(ii) )212 & sv_i_1d (jpij) , oa_i_1d (jpij) , o_i_1d (jpij) , STAT=ierr(ii) ) 212 213 ! 213 214 ii = ii + 1 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icealb.F90
r10535 r11822 192 192 REWIND( numnam_ice_ref ) ! Namelist namalb in reference namelist : Albedo parameters 193 193 READ ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901) 194 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist' , lwp)194 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namalb in reference namelist' ) 195 195 REWIND( numnam_ice_cfg ) ! Namelist namalb in configuration namelist : Albedo parameters 196 196 READ ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 ) 197 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namalb in configuration namelist' , lwp)197 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namalb in configuration namelist' ) 198 198 IF(lwm) WRITE( numoni, namalb ) 199 199 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icecor.F90
r10425 r11822 17 17 USE phycst ! physical constants 18 18 USE ice ! sea-ice: variable 19 USE ice1D ! sea-ice: thermodynamic sea-icevariables19 USE ice1D ! sea-ice: thermodynamic variables 20 20 USE iceitd ! sea-ice: rebining 21 21 USE icevar ! sea-ice: operations … … 60 60 IF( ln_timing ) CALL timing_start('icecor') ! timing 61 61 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 62 IF( ln_icediachk ) CALL ice_cons2D (0, 'icecor', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 62 63 ! 63 64 IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN … … 66 67 WRITE(numout,*) '~~~~~~~' 67 68 ENDIF 68 !69 69 ! !----------------------------------------------------- 70 ! ! ice thickness must exceed himin (for ice diff)!70 ! ! ice thickness must exceed himin (for temp. diff.) ! 71 71 ! !----------------------------------------------------- 72 72 WHERE( a_i(:,:,:) >= epsi20 ) ; h_i(:,:,:) = v_i(:,:,:) / a_i(:,:,:) … … 79 79 ! !----------------------------------------------------- 80 80 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 81 DO jl 81 DO jl = 1, jpl 82 82 WHERE( at_i(:,:) > rn_amax_2d(:,:) ) a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 83 83 END DO … … 85 85 ! !----------------------------------------------------- 86 86 IF ( nn_icesal == 2 ) THEN ! salinity must stay in bounds [Simin,Simax] ! 87 !!-----------------------------------------------------87 ! !----------------------------------------------------- 88 88 zzc = rhoi * r1_rdtice 89 89 DO jl = 1, jpl … … 97 97 END DO 98 98 ENDIF 99 100 99 ! !----------------------------------------------------- 101 100 ! ! Rebin categories with thickness out of bounds ! … … 119 118 END DO 120 119 END DO 121 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) ! lateral boundary conditions120 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 122 121 ENDIF 123 122 124 !!gm I guess the trends are only out on demand125 !! So please, only do this is it exite an iom_use of on a these variables126 !! furthermore, only allocate the diag_ arrays in this case127 !! and do the iom_put here so that it is only a local allocation128 !!gm129 123 ! !----------------------------------------------------- 130 124 SELECT CASE( kn ) ! Diagnostics ! … … 132 126 CASE( 1 ) !--- dyn trend diagnostics 133 127 ! 134 !!gm here I think the number of ice cat is too small to use a SUM instruction... 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 ! ! heat content variation (W.m-2) 138 diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) & 139 & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice 140 ! ! salt, volume 141 diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice 142 diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice 143 diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice 144 END DO 145 END DO 128 IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 129 diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice & ! W.m-2 130 & - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 131 diag_sice(:,:) = SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_rdtice * rhoi 132 diag_vice(:,:) = SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_rdtice * rhoi 133 diag_vsnw(:,:) = SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_rdtice * rhos 134 ENDIF 146 135 ! ! concentration tendency (dynamics) 147 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 148 afx_tot(:,:) = zafx(:,:) 149 IF( iom_use('afxdyn') ) CALL iom_put( 'afxdyn' , zafx(:,:) ) 136 IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 137 zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 138 CALL iom_put( 'afxdyn' , zafx ) 139 ENDIF 150 140 ! 151 141 CASE( 2 ) !--- thermo trend diagnostics & ice aging … … 153 143 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice ! ice natural aging incrementation 154 144 ! 155 !!gm here I think the number of ice cat is too small to use a SUM instruction... 156 DO jj = 1, jpj157 DO ji = 1, jpi158 ! ! heat content variation (W.m-2)159 diag_heat(ji,jj) = diag_heat(ji,jj) - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) &160 & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice161 ! ! salt, volume162 diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice163 diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice164 diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice165 END DO166 END DO145 IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 146 diag_heat(:,:) = diag_heat(:,:) & 147 & - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice & 148 & - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 149 diag_sice(:,:) = diag_sice(:,:) & 150 & + SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_rdtice * rhoi 151 diag_vice(:,:) = diag_vice(:,:) & 152 & + SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_rdtice * rhoi 153 diag_vsnw(:,:) = diag_vsnw(:,:) & 154 & + SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_rdtice * rhos 155 CALL iom_put ( 'hfxdhc' , diag_heat ) 156 ENDIF 167 157 ! ! concentration tendency (total + thermo) 168 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 169 afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) 170 IF( iom_use('afxthd') ) CALL iom_put( 'afxthd' , zafx(:,:) ) 171 IF( iom_use('afxtot') ) CALL iom_put( 'afxtot' , afx_tot(:,:) ) 158 IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 159 zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 160 CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice ) 161 CALL iom_put( 'afxtot' , zafx ) 162 ENDIF 172 163 ! 173 164 END SELECT 174 165 ! 175 166 ! controls 176 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 177 IF( ln_ctl ) CALL ice_prt3D ('icecor') ! prints 178 IF( ln_icectl .AND. kn == 2 ) CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! prints 179 IF( ln_timing ) CALL timing_stop ('icecor') ! timing 167 IF( ln_ctl ) CALL ice_prt3D ('icecor') ! prints 168 IF( ln_icectl .AND. kn == 2 ) & 169 & CALL ice_prt ( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! prints 170 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 171 IF( ln_icediachk ) CALL ice_cons2D (1, 'icecor', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 172 IF( ln_timing ) CALL timing_stop ('icecor') ! timing 180 173 ! 181 174 END SUBROUTINE ice_cor -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icectl.F90
r10581 r11822 12 12 !! 'key_si3' SI3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! ice_cons_hsm : conservation tests on heat, salt and mass 15 !! ice_cons_final : conservation tests on heat, salt and mass at end of time step 14 !! ice_cons_hsm : conservation tests on heat, salt and mass during a time step (global) 15 !! ice_cons_final : conservation tests on heat, salt and mass at end of time step (global) 16 !! ice_cons2D : conservation tests on heat, salt and mass at each gridcell 16 17 !! ice_ctl : control prints in case of crash 17 18 !! ice_prt : control prints at a given grid point … … 27 28 ! 28 29 USE in_out_manager ! I/O manager 30 USE iom ! I/O manager library 29 31 USE lib_mpp ! MPP library 30 32 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) … … 37 39 PUBLIC ice_cons_hsm 38 40 PUBLIC ice_cons_final 41 PUBLIC ice_cons2D 39 42 PUBLIC ice_ctl 40 43 PUBLIC ice_prt 41 44 PUBLIC ice_prt3D 42 45 46 ! thresold rates for conservation 47 ! these values are changed by the namelist parameter rn_icechk, so that threshold = zchk * rn_icechk 48 REAL(wp), PARAMETER :: zchk_m = 2.5e-7 ! kg/m2/s <=> 1e-6 m of ice per hour spuriously gained/lost 49 REAL(wp), PARAMETER :: zchk_s = 2.5e-6 ! g/m2/s <=> 1e-6 m of ice per hour spuriously gained/lost (considering s=10g/kg) 50 REAL(wp), PARAMETER :: zchk_t = 7.5e-2 ! W/m2 <=> 1e-6 m of ice per hour spuriously gained/lost (considering Lf=3e5J/kg) 51 43 52 !! * Substitutions 44 53 # include "vectopt_loop_substitute.h90" … … 59 68 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 60 69 !! It prints in ocean.output if there is a violation of conservation at each time-step 61 !! The thresholds (zv_sill, zs_sill, zt_sill) which determine violations are set to 62 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 70 !! The thresholds (zchk_m, zchk_s, zchk_t) determine violations 63 71 !! For salt and heat thresholds, ice is considered to have a salinity of 10 64 72 !! and a heat content of 3e5 J/kg (=latent heat of fusion) … … 68 76 REAL(wp) , INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 69 77 !! 70 REAL(wp) :: z v, zs, zt, zfs, zfv, zft71 REAL(wp) :: zvmin, zamin, zamax78 REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat, & 79 & zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 72 80 REAL(wp) :: zvtrp, zetrp 73 REAL(wp) :: zarea, zv_sill, zs_sill, zt_sill 74 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 81 REAL(wp) :: zarea 75 82 !!------------------------------------------------------------------- 76 83 ! 77 84 IF( icount == 0 ) THEN 78 ! ! water flux 79 pdiag_fv = glob_sum( 'icectl', & 80 & -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + & 81 & wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_pnd(:,:) + & 82 & wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + & 83 & wfx_ice_sub(:,:) + wfx_spr(:,:) & 84 & ) * e1e2t(:,:) ) * zconv 85 86 pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) 87 pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) 88 pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 89 90 ! mass flux 91 pdiag_fv = glob_sum( 'icectl', & 92 & ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 93 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) 94 ! salt flux 95 pdiag_fs = glob_sum( 'icectl', & 96 & ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 97 & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) 98 ! heat flux 99 pdiag_ft = glob_sum( 'icectl', & 100 & ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 101 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) 102 103 ELSEIF( icount == 1 ) THEN 104 105 ! -- mass diag -- ! 106 zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_rdtice & 107 & + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + & 108 & wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 109 & wfx_ice_sub + wfx_spr ) * e1e2t ) & 110 & - pdiag_fv 85 111 ! 86 ! ! salt flux87 pdiag_fs = glob_sum( 'icectl',&88 & ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +&89 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)&90 & ) * e1e2t(:,:) ) * zconv112 ! -- salt diag -- ! 113 zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice & 114 & + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 115 & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & 116 & - pdiag_fs 91 117 ! 92 ! ! heat flux 93 pdiag_ft = glob_sum( 'icectl', & 94 & ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 95 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 96 & ) * e1e2t(:,:) ) * zconv 97 98 pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t * zconv ) 99 100 pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t * zconv ) 101 102 pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & 103 & + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv 104 105 ELSEIF( icount == 1 ) THEN 106 107 ! water flux 108 zfv = glob_sum( 'icectl', & 109 & -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + & 110 & wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_pnd(:,:) + & 111 & wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + & 112 & wfx_ice_sub(:,:) + wfx_spr(:,:) & 113 & ) * e1e2t(:,:) ) * zconv - pdiag_fv 114 115 ! salt flux 116 zfs = glob_sum( 'icectl', & 117 & ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 118 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 119 & ) * e1e2t(:,:) ) * zconv - pdiag_fs 120 121 ! heat flux 122 zft = glob_sum( 'icectl', & 123 & ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 124 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 125 & ) * e1e2t(:,:) ) * zconv - pdiag_ft 126 127 ! outputs 128 zv = ( ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) * zconv & 129 & - pdiag_v ) * r1_rdtice - zfv ) * rday 130 131 zs = ( ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) * zconv & 132 & - pdiag_s ) * r1_rdtice + zfs ) * rday 133 134 zt = ( glob_sum( 'icectl', & 135 & ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & 136 & + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv & 137 & - pdiag_t ) * r1_rdtice + zft 138 139 ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 140 zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) * zconv * rday 141 zetrp = glob_sum( 'icectl', ( diag_trp_ei + diag_trp_es ) * e1e2t ) * zconv 142 143 zvmin = glob_min( 'icectl', v_i ) 144 zamax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 145 zamin = glob_min( 'icectl', a_i ) 146 147 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 148 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 149 zv_sill = zarea * 2.5e-5 150 zs_sill = zarea * 25.e-5 151 zt_sill = zarea * 10.e-5 152 153 IF(lwp) THEN 154 IF ( ABS( zv ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day] (',cd_routine,') = ',zv 155 IF ( ABS( zs ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zs 156 IF ( ABS( zt ) > zt_sill ) WRITE(numout,*) 'violation enthalpy [GW] (',cd_routine,') = ',zt 157 IF ( zvmin < -epsi10 ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',zvmin 158 IF ( zamax > MAX( rn_amax_n, rn_amax_s ) + epsi10 & 159 & .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' .AND. cd_routine /= 'Hbig' ) & 160 & WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 161 IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 162 !clem: the following check fails when using UMx advection scheme (see comments in icedyn_adv.F90) 163 ! IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'icedyn_adv' ) THEN 164 ! WRITE(numout,*) 'violation vtrp [Mt/day] (',cd_routine,') = ',zvtrp 165 ! WRITE(numout,*) 'violation etrp [GW] (',cd_routine,') = ',zetrp 166 ! ENDIF 118 ! -- heat diag -- ! 119 zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & 120 & ) * r1_rdtice & 121 & + glob_sum( 'icectl', ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 122 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) & 123 & - pdiag_ft 124 125 ! -- min/max diag -- ! 126 zdiag_amax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 127 zdiag_vmin = glob_min( 'icectl', v_i ) 128 zdiag_amin = glob_min( 'icectl', a_i ) 129 zdiag_smin = glob_min( 'icectl', sv_i ) 130 zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 131 zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 132 133 ! -- advection scheme is conservative? -- ! 134 zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 (only for Prather) 135 zetrp = glob_sum( 'icectl', ( diag_trp_ei + diag_trp_es ) * e1e2t ) ! must be close to 0 (only for Prather) 136 137 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 138 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 139 140 IF( lwp ) THEN 141 ! check conservation issues 142 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 143 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 144 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 145 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rdt_ice 146 IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 147 & WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rdt_ice 148 ! check negative values 149 IF( zdiag_vmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_i < 0 = ',zdiag_vmin 150 IF( zdiag_amin < 0. ) WRITE(numout,*) cd_routine,' : violation a_i < 0 = ',zdiag_amin 151 IF( zdiag_smin < 0. ) WRITE(numout,*) cd_routine,' : violation s_i < 0 = ',zdiag_smin 152 IF( zdiag_eimin < 0. ) WRITE(numout,*) cd_routine,' : violation e_i < 0 = ',zdiag_eimin 153 IF( zdiag_esmin < 0. ) WRITE(numout,*) cd_routine,' : violation e_s < 0 = ',zdiag_esmin 154 ! check maximum ice concentration 155 IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 156 & WRITE(numout,*) cd_routine,' : violation a_i > amax = ',zdiag_amax 157 ! check if advection scheme is conservative 158 ! only check for Prather because Ultimate-Macho uses corrective fluxes (wfx etc) 159 ! so the formulation for conservation is different (and not coded) 160 ! it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now 161 !IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 162 ! & WRITE(numout,*) cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 167 163 ENDIF 168 164 ! … … 171 167 END SUBROUTINE ice_cons_hsm 172 168 173 174 169 SUBROUTINE ice_cons_final( cd_routine ) 175 170 !!------------------------------------------------------------------- … … 180 175 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 181 176 !! It prints in ocean.output if there is a violation of conservation at each time-step 182 !! The thresholds (zv_sill, zs_sill, zt_sill) which determine the violation are set to 183 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 177 !! The thresholds (zchk_m, zchk_s, zchk_t) determine the violations 184 178 !! For salt and heat thresholds, ice is considered to have a salinity of 10 185 179 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 186 180 !!------------------------------------------------------------------- 187 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 188 REAL(wp) :: zqmass, zhfx, zsfx, zvfx 189 REAL(wp) :: zarea, zv_sill, zs_sill, zt_sill 190 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 181 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 182 REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat 183 REAL(wp) :: zarea 191 184 !!------------------------------------------------------------------- 192 185 193 186 ! water flux 194 zvfx = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) * zconv * rday 195 196 ! salt flux 197 zsfx = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) * zconv * rday 198 199 ! heat flux 187 ! -- mass diag -- ! 188 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) 189 190 ! -- salt diag -- ! 191 zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) 192 193 ! -- heat diag -- ! 200 194 ! clem: not the good formulation 201 !!zhfx = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr & 202 !! & ) * e1e2t ) * zconv 203 204 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 205 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 206 zv_sill = zarea * 2.5e-5 207 zs_sill = zarea * 25.e-5 208 zt_sill = zarea * 10.e-5 209 210 IF(lwp) THEN 211 IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx [Mt/day] (',cd_routine,') = ',zvfx 212 IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx [psu*Mt/day] (',cd_routine,') = ',zsfx 213 !!IF( ABS( zhfx ) > zt_sill ) WRITE(numout,*) 'violation hfx [GW] (',cd_routine,') = ',zhfx 195 !!zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr & 196 !! & ) * e1e2t ) 197 198 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 199 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 200 201 IF( lwp ) THEN 202 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 203 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 204 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 205 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rdt_ice 206 !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rdt_ice 214 207 ENDIF 215 208 ! 216 209 END SUBROUTINE ice_cons_final 217 210 211 SUBROUTINE ice_cons2D( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft ) 212 !!------------------------------------------------------------------- 213 !! *** ROUTINE ice_cons2D *** 214 !! 215 !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 216 !! + test if ice concentration and volume are > 0 217 !! 218 !! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true 219 !! It stops the code if there is a violation of conservation at any gridcell 220 !!------------------------------------------------------------------- 221 INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end 222 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 223 REAL(wp) , DIMENSION(jpi,jpj), INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 224 !! 225 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_mass, zdiag_salt, zdiag_heat, & 226 & zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax 227 INTEGER :: jl, jk 228 LOGICAL :: ll_stop_m = .FALSE. 229 LOGICAL :: ll_stop_s = .FALSE. 230 LOGICAL :: ll_stop_t = .FALSE. 231 CHARACTER(len=120) :: clnam ! filename for the output 232 !!------------------------------------------------------------------- 233 ! 234 IF( icount == 0 ) THEN 235 236 pdiag_v = SUM( v_i * rhoi + v_s * rhos, dim=3 ) 237 pdiag_s = SUM( sv_i * rhoi , dim=3 ) 238 pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 239 240 ! mass flux 241 pdiag_fv = wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 242 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr 243 ! salt flux 244 pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam 245 ! heat flux 246 pdiag_ft = hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 247 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr 248 249 ELSEIF( icount == 1 ) THEN 250 251 ! -- mass diag -- ! 252 zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_rdtice & 253 & + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 254 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) & 255 & - pdiag_fv 256 IF( MAXVAL( ABS(zdiag_mass) ) > zchk_m * rn_icechk_cel ) ll_stop_m = .TRUE. 257 ! 258 ! -- salt diag -- ! 259 zdiag_salt = ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_rdtice & 260 & + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) & 261 & - pdiag_fs 262 IF( MAXVAL( ABS(zdiag_salt) ) > zchk_s * rn_icechk_cel ) ll_stop_s = .TRUE. 263 ! 264 ! -- heat diag -- ! 265 zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_rdtice & 266 & + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 267 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) & 268 & - pdiag_ft 269 IF( MAXVAL( ABS(zdiag_heat) ) > zchk_t * rn_icechk_cel ) ll_stop_t = .TRUE. 270 ! 271 ! -- other diags -- ! 272 ! a_i < 0 273 zdiag_amin(:,:) = 0._wp 274 DO jl = 1, jpl 275 WHERE( a_i(:,:,jl) < 0._wp ) zdiag_amin(:,:) = 1._wp 276 ENDDO 277 ! v_i < 0 278 zdiag_vmin(:,:) = 0._wp 279 DO jl = 1, jpl 280 WHERE( v_i(:,:,jl) < 0._wp ) zdiag_vmin(:,:) = 1._wp 281 ENDDO 282 ! s_i < 0 283 zdiag_smin(:,:) = 0._wp 284 DO jl = 1, jpl 285 WHERE( s_i(:,:,jl) < 0._wp ) zdiag_smin(:,:) = 1._wp 286 ENDDO 287 ! e_i < 0 288 zdiag_emin(:,:) = 0._wp 289 DO jl = 1, jpl 290 DO jk = 1, nlay_i 291 WHERE( e_i(:,:,jk,jl) < 0._wp ) zdiag_emin(:,:) = 1._wp 292 ENDDO 293 ENDDO 294 ! a_i > amax 295 !WHERE( SUM( a_i, dim=3 ) > ( MAX( rn_amax_n, rn_amax_s ) + epsi10 ) ; zdiag_amax(:,:) = 1._wp 296 !ELSEWHERE ; zdiag_amax(:,:) = 0._wp 297 !END WHERE 298 299 IF( ll_stop_m .OR. ll_stop_s .OR. ll_stop_t ) THEN 300 clnam = 'diag_ice_conservation_'//cd_routine 301 CALL ice_cons_wri( clnam, zdiag_mass, zdiag_salt, zdiag_heat, zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin ) 302 ENDIF 303 304 IF( ll_stop_m ) CALL ctl_stop( 'STOP', cd_routine//': ice mass conservation issue' ) 305 IF( ll_stop_s ) CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' ) 306 IF( ll_stop_t ) CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' ) 307 308 ENDIF 309 310 END SUBROUTINE ice_cons2D 311 312 SUBROUTINE ice_cons_wri( cdfile_name, pdiag_mass, pdiag_salt, pdiag_heat, pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin ) 313 !!--------------------------------------------------------------------- 314 !! *** ROUTINE ice_cons_wri *** 315 !! 316 !! ** Purpose : create a NetCDF file named cdfile_name which contains 317 !! the instantaneous fields when conservation issue occurs 318 !! 319 !! ** Method : NetCDF files using ioipsl 320 !!---------------------------------------------------------------------- 321 CHARACTER(len=*), INTENT( in ) :: cdfile_name ! name of the file created 322 REAL(wp), DIMENSION(:,:), INTENT( in ) :: pdiag_mass, pdiag_salt, pdiag_heat, & 323 & pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax 324 !! 325 INTEGER :: inum 326 !!---------------------------------------------------------------------- 327 ! 328 IF(lwp) WRITE(numout,*) 329 IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state' 330 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ named :', cdfile_name, '...nc' 331 IF(lwp) WRITE(numout,*) 332 333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 334 335 CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain 336 CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 ) ! ice salt spurious lost/gain 337 CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 ) ! ice heat spurious lost/gain 338 ! other diags 339 CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 ) ! 340 CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 ) ! 341 CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 ) ! 342 CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 ) ! 343 344 CALL iom_close( inum ) 345 346 END SUBROUTINE ice_cons_wri 218 347 219 348 SUBROUTINE ice_ctl( kt ) … … 238 367 ialert_id = 2 ! reference number of this alert 239 368 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 240 241 369 DO jl = 1, jpl 242 370 DO jj = 1, jpj 243 371 DO ji = 1, jpi 244 372 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 245 !WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 246 !WRITE(numout,*) ' at_i ', at_i(ji,jj) 247 !WRITE(numout,*) ' Point - category', ji, jj, jl 248 !WRITE(numout,*) ' a_i *** a_i_b ', a_i (ji,jj,jl), a_i_b (ji,jj,jl) 249 !WRITE(numout,*) ' v_i *** v_i_b ', v_i (ji,jj,jl), v_i_b (ji,jj,jl) 373 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 250 374 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 251 375 ENDIF … … 261 385 DO ji = 1, jpi 262 386 IF( h_i(ji,jj,jl) > 50._wp ) THEN 387 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 263 388 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 264 389 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 272 397 DO jj = 1, jpj 273 398 DO ji = 1, jpi 274 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5.AND. &399 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 275 400 & at_i(ji,jj) > 0._wp ) THEN 401 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 276 402 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 277 !WRITE(numout,*) ' ice strength : ', strength(ji,jj) 278 !WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj) 279 !WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj) 280 !WRITE(numout,*) ' sea-ice stress utau_ice : ', utau_ice(ji,jj) 281 !WRITE(numout,*) ' sea-ice stress vtau_ice : ', vtau_ice(ji,jj) 282 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 283 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 284 !WRITE(numout,*) 403 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 404 ENDIF 405 END DO 406 END DO 407 408 ! Alert on salt flux 409 ialert_id = 5 ! reference number of this alert 410 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 411 DO jj = 1, jpj 412 DO ji = 1, jpi 413 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 414 WRITE(numout,*) ' ALERTE 5 : High salt flux' 415 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 285 416 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 286 417 ENDIF … … 294 425 DO ji = 1, jpi 295 426 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 427 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 296 428 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 297 !WRITE(numout,*) ' masks s, u, v : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)298 !WRITE(numout,*) ' sst : ', sst_m(ji,jj)299 !WRITE(numout,*) ' sss : ', sss_m(ji,jj)300 !WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj)301 !WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj)302 !WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1)303 !WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj)304 !WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj)305 !306 429 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 307 430 ENDIF … … 317 440 DO ji = 1, jpi 318 441 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 442 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 319 443 ! CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 320 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj)321 ! WRITE(numout,*) ' sss : ', sss_m(ji,jj)322 ! WRITE(numout,*)323 444 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 324 445 ENDIF … … 327 448 END DO 328 449 ! 450 ! Alert if qns very big 451 ialert_id = 8 ! reference number of this alert 452 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 453 DO jj = 1, jpj 454 DO ji = 1, jpi 455 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 456 ! 457 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 458 !CALL ice_prt( kt, ji, jj, 2, ' ') 459 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 460 ! 461 ENDIF 462 END DO 463 END DO 464 !+++++ 329 465 330 466 ! ! Alert if too old ice … … 337 473 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 338 474 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 475 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 339 476 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 340 477 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 343 480 END DO 344 481 END DO 345 346 ! Alert on salt flux 347 ialert_id = 5 ! reference number of this alert 348 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 349 DO jj = 1, jpj 350 DO ji = 1, jpi 351 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 352 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 353 !DO jl = 1, jpl 354 !WRITE(numout,*) ' Category no: ', jl 355 !WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' a_i_b : ', a_i_b (ji,jj,jl) 356 !WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' v_i_b : ', v_i_b (ji,jj,jl) 357 !WRITE(numout,*) ' ' 358 !END DO 359 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 360 ENDIF 361 END DO 362 END DO 363 364 ! Alert if qns very big 365 ialert_id = 8 ! reference number of this alert 366 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 367 DO jj = 1, jpj 368 DO ji = 1, jpi 369 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 370 ! 371 !WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 372 !WRITE(numout,*) ' ji, jj : ', ji, jj 373 !WRITE(numout,*) ' qns : ', qns(ji,jj) 374 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 375 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 376 ! 377 !CALL ice_prt( kt, ji, jj, 2, ' ') 378 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 379 ! 380 ENDIF 381 END DO 382 END DO 383 !+++++ 384 482 385 483 ! Alert if very warm ice 386 484 ialert_id = 10 ! reference number of this alert … … 392 490 DO ji = 1, jpi 393 491 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 394 IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 395 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 396 !WRITE(numout,*) ' ALERTE 10 : Very warm ice' 397 !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 398 !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 399 !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 400 !WRITE(numout,*) ' sz_i: ', sz_i(ji,jj,jk,jl) 401 !WRITE(numout,*) ' ztmelts : ', ztmelts 402 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 492 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 493 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 494 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 495 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 403 496 ENDIF 404 497 END DO … … 427 520 END SUBROUTINE ice_ctl 428 521 429 430 522 SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 ) 431 523 !!------------------------------------------------------------------- … … 435 527 !! in ocean.ouput 436 528 !! 3 possibilities exist 437 !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1)529 !! n = 1/-1 -> simple ice state 438 530 !! n = 2 -> exhaustive state 439 531 !! n = 3 -> ice/ocean salt fluxes … … 474 566 WRITE(numout,*) ' - Cell values ' 475 567 WRITE(numout,*) ' ~~~~~~~~~~~ ' 476 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj)477 568 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 569 WRITE(numout,*) ' ato_i : ', ato_i(ji,jj) 478 570 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 479 571 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) … … 495 587 END DO 496 588 ENDIF 497 IF( kn == -1 ) THEN498 WRITE(numout,*) ' Mechanical Check ************** '499 WRITE(numout,*) ' Check what means ice divergence '500 WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)501 WRITE(numout,*) ' Total lead fraction ', ato_i(ji,jj)502 WRITE(numout,*) ' Sum of both ', ato_i(ji,jj) + at_i(ji,jj)503 WRITE(numout,*) ' Sum of both minus 1 ', ato_i(ji,jj) + at_i(ji,jj) - 1.00504 ENDIF505 506 589 507 590 !-------------------- … … 517 600 WRITE(numout,*) ' - Cell values ' 518 601 WRITE(numout,*) ' ~~~~~~~~~~~ ' 519 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj)520 602 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 521 603 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) … … 616 698 !! 617 699 !!------------------------------------------------------------------- 618 CHARACTER(len=*), INTENT(in) ::cd_routine ! name of the routine619 INTEGER ::jk, jl ! dummy loop indices700 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 701 INTEGER :: jk, jl ! dummy loop indices 620 702 621 703 CALL prt_ctl_info(' ========== ') … … 676 758 677 759 END SUBROUTINE ice_prt3D 678 760 679 761 #else 680 762 !!---------------------------------------------------------------------- -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedia.F90
r10425 r11822 34 34 PUBLIC ice_dia_init ! called in icestp.F90 35 35 36 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 36 REAL(wp), SAVE :: z1_e1e2 ! inverse of the ocean area 37 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 37 38 REAL(wp) :: frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot ! global forcing trends 38 39 … … 80 81 ENDIF 81 82 82 !!gm glob_sum includes a " * tmask_i ", so remove " * tmask(:,:,1) " 83 83 IF( kt == nit000 ) THEN 84 z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) ) 85 ENDIF 86 84 87 ! ----------------------- ! 85 ! 1 - Contents !88 ! 1 - Contents ! 86 89 ! ----------------------- ! 87 zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9 ! ice volume (km3) 88 zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9 ! snow volume (km3) 89 zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6 ! area (km2) 90 zbg_isal = glob_sum( 'icedia', SUM( sv_i(:,:,:), dim=3 ) * e1e2t(:,:) ) * 1.e-9 ! salt content (pss*km3) 91 zbg_item = glob_sum( 'icedia', et_i * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 92 zbg_stem = glob_sum( 'icedia', et_s * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 93 90 IF( iom_use('ibgvol_tot' ) .OR. iom_use('sbgvol_tot' ) .OR. iom_use('ibgarea_tot') .OR. & 91 & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') ) THEN 92 93 zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9 ! ice volume (km3) 94 zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9 ! snow volume (km3) 95 zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6 ! area (km2) 96 zbg_isal = glob_sum( 'icedia', st_i(:,:) * e1e2t(:,:) ) * 1.e-9 ! salt content (pss*km3) 97 zbg_item = glob_sum( 'icedia', et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 98 zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 99 100 CALL iom_put( 'ibgvol_tot' , zbg_ivol ) 101 CALL iom_put( 'sbgvol_tot' , zbg_svol ) 102 CALL iom_put( 'ibgarea_tot' , zbg_area ) 103 CALL iom_put( 'ibgsalt_tot' , zbg_isal ) 104 CALL iom_put( 'ibgheat_tot' , zbg_item ) 105 CALL iom_put( 'sbgheat_tot' , zbg_stem ) 106 107 ENDIF 108 94 109 ! ---------------------------! 95 110 ! 2 - Trends due to forcing ! 96 111 ! ---------------------------! 112 ! they must be kept outside an IF(iom_use) because of the call to dia_rst below 97 113 z_frc_volbot = r1_rau0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-ocean 98 114 z_frc_voltop = r1_rau0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-atm … … 106 122 frc_temtop = frc_temtop + z_frc_temtop * rdt_ice ! 1.e20 J 107 123 frc_tembot = frc_tembot + z_frc_tembot * rdt_ice ! 1.e20 J 124 125 CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) 126 CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water) 127 CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal - forcing (psu*km3 equivalent ocean water) 128 CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J) 129 CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 130 131 IF( iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN 132 CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ice/snw/ocean (W/m2) 133 CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ocean(below ice) (W/m2) 134 ENDIF 135 136 ! ---------------------------------- ! 137 ! 3 - Content variations and drifts ! 138 ! ---------------------------------- ! 139 IF( iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN 108 140 109 ! ----------------------- ! 110 ! 3 - Content variations ! 111 ! ----------------------- ! 112 zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3) 113 zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 114 zdiff_tem = glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 115 ! + SUM( qevap_ice * a_i_b, dim=3 ) !! clem: I think this term should not be there (but needs a check) 116 117 ! ----------------------- ! 118 ! 4 - Drifts ! 119 ! ----------------------- ! 120 zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 121 zdiff_sal = zdiff_sal - frc_sal 122 zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 123 124 ! ----------------------- ! 125 ! 5 - Diagnostics writing ! 126 ! ----------------------- ! 127 !!gm I don't understand the division by the ocean surface (i.e. glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 128 !! and its multiplication bu kt ! is it really what we want ? what is this quantity ? 129 !! IF it is really what we want, compute it at kt=nit000, not 3 time by time-step ! 130 !! kt*rdt : you mean rdtice ? 131 !!gm 132 ! 133 IF( iom_use('ibgvolume') ) CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) 134 IF( iom_use('ibgsaltco') ) CALL iom_put( 'ibgsaltco' , zdiff_sal ) ! ice salt content drift (psu*km3 equivalent ocean water) 135 IF( iom_use('ibgheatco') ) CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 136 IF( iom_use('ibgheatfx') ) CALL iom_put( 'ibgheatfx' , & ! ice/snow heat flux drift (W/m2) 137 & zdiff_tem /glob_sum( 'icedia', e1e2t(:,:) * 1.e-20 * kt*rdt ) ) 138 139 IF( iom_use('ibgfrcvoltop') ) CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) 140 IF( iom_use('ibgfrcvolbot') ) CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water) 141 IF( iom_use('ibgfrcsal') ) CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal - forcing (psu*km3 equivalent ocean water) 142 IF( iom_use('ibgfrctemtop') ) CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J) 143 IF( iom_use('ibgfrctembot') ) CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 144 IF( iom_use('ibgfrchfxtop') ) CALL iom_put( 'ibgfrchfxtop' , & ! heat on top of ice/snw/ocean (W/m2) 145 & frc_temtop / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 146 IF( iom_use('ibgfrchfxbot') ) CALL iom_put( 'ibgfrchfxbot' , & ! heat on top of ocean(below ice) (W/m2) 147 & frc_tembot / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 148 149 IF( iom_use('ibgvol_tot' ) ) CALL iom_put( 'ibgvol_tot' , zbg_ivol ) ! ice volume (km3) 150 IF( iom_use('sbgvol_tot' ) ) CALL iom_put( 'sbgvol_tot' , zbg_svol ) ! snow volume (km3) 151 IF( iom_use('ibgarea_tot') ) CALL iom_put( 'ibgarea_tot' , zbg_area ) ! ice area (km2) 152 IF( iom_use('ibgsalt_tot') ) CALL iom_put( 'ibgsalt_tot' , zbg_isal ) ! ice salinity content (pss*km3) 153 IF( iom_use('ibgheat_tot') ) CALL iom_put( 'ibgheat_tot' , zbg_item ) ! ice heat content (1.e20 J) 154 IF( iom_use('sbgheat_tot') ) CALL iom_put( 'sbgheat_tot' , zbg_stem ) ! snow heat content (1.e20 J) 155 ! 141 zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3) 142 zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi*st_i(:,:) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 143 zdiff_tem = glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 144 ! + SUM( qevap_ice * a_i_b, dim=3 ) !! clem: I think this term should not be there (but needs a check) 145 146 zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 147 zdiff_sal = zdiff_sal - frc_sal 148 zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 149 150 CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) 151 CALL iom_put( 'ibgsaltco' , zdiff_sal ) ! ice salt content drift (psu*km3 equivalent ocean water) 152 CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 153 ! 154 ENDIF 155 156 156 IF( lrst_ice ) CALL ice_dia_rst( 'WRITE', kt_ice ) 157 157 ! … … 175 175 INTEGER :: ios, ierror ! local integer 176 176 !! 177 NAMELIST/namdia/ ln_icediachk, ln_icediahsb, ln_icectl, iiceprt, jiceprt177 NAMELIST/namdia/ ln_icediachk, rn_icechk_cel, rn_icechk_glo, ln_icediahsb, ln_icectl, iiceprt, jiceprt 178 178 !!---------------------------------------------------------------------- 179 179 ! 180 180 REWIND( numnam_ice_ref ) ! Namelist namdia in reference namelist : Parameters for ice 181 181 READ ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901) 182 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist' , lwp)182 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist' ) 183 183 REWIND( numnam_ice_cfg ) ! Namelist namdia in configuration namelist : Parameters for ice 184 184 READ ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 ) 185 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist' , lwp)185 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist' ) 186 186 IF(lwm) WRITE ( numoni, namdia ) 187 187 ! … … 191 191 WRITE(numout,*) ' ~~~~~~~~~~~' 192 192 WRITE(numout,*) ' Namelist namdia:' 193 WRITE(numout,*) ' Diagnose online heat/mass/salt budget ln_icediachk = ', ln_icediachk 194 WRITE(numout,*) ' Output heat/mass/salt budget ln_icediahsb = ', ln_icediahsb 195 WRITE(numout,*) ' control prints for a given grid point ln_icectl = ', ln_icectl 196 WRITE(numout,*) ' chosen grid point position (iiceprt,jiceprt) = (', iiceprt,',', jiceprt,')' 193 WRITE(numout,*) ' Diagnose online heat/mass/salt conservation ln_icediachk = ', ln_icediachk 194 WRITE(numout,*) ' threshold for conservation (gridcell) rn_icechk_cel = ', rn_icechk_cel 195 WRITE(numout,*) ' threshold for conservation (global) rn_icechk_glo = ', rn_icechk_glo 196 WRITE(numout,*) ' Output heat/mass/salt budget ln_icediahsb = ', ln_icediahsb 197 WRITE(numout,*) ' control prints for a given grid point ln_icectl = ', ln_icectl 198 WRITE(numout,*) ' chosen grid point position (iiceprt,jiceprt) = (', iiceprt,',', jiceprt,')' 197 199 ENDIF 198 200 ! … … 248 250 vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:) ! ice/snow volume (kg/m2) 249 251 tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J) 250 sal_loc_ini(:,:) = rhoi * SUM( sv_i(:,:,:), dim=3 )! ice salt content (pss*kg/m2)252 sal_loc_ini(:,:) = rhoi * st_i(:,:) ! ice salt content (pss*kg/m2) 251 253 ENDIF 252 254 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedyn.F90
r11480 r11822 75 75 INTEGER, INTENT(in) :: Kmm ! ocean time level index 76 76 !! 77 INTEGER :: ji, jj , jl! dummy loop indices77 INTEGER :: ji, jj ! dummy loop indices 78 78 REAL(wp) :: zcoefu, zcoefv 79 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdivu_i 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdivu_i 81 80 !!-------------------------------------------------------------------- 82 81 ! … … 90 89 ENDIF 91 90 ! 92 IF( ln_landfast_home ) THEN !-- Landfast ice parameterization 93 tau_icebfr(:,:) = 0._wp 94 DO jl = 1, jpl 95 WHERE( h_i_b(:,:,jl) > ht(:,:) * rn_depfra ) tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 96 END DO 97 ENDIF 98 ! 99 ! !-- Record max of the surrounding 9-pts ice thick. (for CALL Hbig) 100 DO jl = 1, jpl 101 DO jj = 2, jpjm1 102 DO ji = fs_2, fs_jpim1 103 zhip_max(ji,jj,jl) = MAX( epsi20, h_ip_b(ji,jj,jl), h_ip_b(ji+1,jj ,jl), h_ip_b(ji ,jj+1,jl), & 104 & h_ip_b(ji-1,jj ,jl), h_ip_b(ji ,jj-1,jl), & 105 & h_ip_b(ji+1,jj+1,jl), h_ip_b(ji-1,jj-1,jl), & 106 & h_ip_b(ji+1,jj-1,jl), h_ip_b(ji-1,jj+1,jl) ) 107 zhi_max (ji,jj,jl) = MAX( epsi20, h_i_b (ji,jj,jl), h_i_b (ji+1,jj ,jl), h_i_b (ji ,jj+1,jl), & 108 & h_i_b (ji-1,jj ,jl), h_i_b (ji ,jj-1,jl), & 109 & h_i_b (ji+1,jj+1,jl), h_i_b (ji-1,jj-1,jl), & 110 & h_i_b (ji+1,jj-1,jl), h_i_b (ji-1,jj+1,jl) ) 111 zhs_max (ji,jj,jl) = MAX( epsi20, h_s_b (ji,jj,jl), h_s_b (ji+1,jj ,jl), h_s_b (ji ,jj+1,jl), & 112 & h_s_b (ji-1,jj ,jl), h_s_b (ji ,jj-1,jl), & 113 & h_s_b (ji+1,jj+1,jl), h_s_b (ji-1,jj-1,jl), & 114 & h_s_b (ji+1,jj-1,jl), h_s_b (ji-1,jj+1,jl) ) 115 END DO 116 END DO 117 END DO 118 CALL lbc_lnk_multi( 'icedyn', zhi_max(:,:,:), 'T', 1., zhs_max(:,:,:), 'T', 1., zhip_max(:,:,:), 'T', 1. ) 119 ! 120 ! 121 SELECT CASE( nice_dyn ) !-- Set which dynamics is running 91 ! retrieve thickness from volume for landfast param. and UMx advection scheme 92 WHERE( a_i(:,:,:) >= epsi20 ) 93 h_i(:,:,:) = v_i(:,:,:) / a_i_b(:,:,:) 94 h_s(:,:,:) = v_s(:,:,:) / a_i_b(:,:,:) 95 ELSEWHERE 96 h_i(:,:,:) = 0._wp 97 h_s(:,:,:) = 0._wp 98 END WHERE 99 ! 100 WHERE( a_ip(:,:,:) >= epsi20 ) 101 h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 102 ELSEWHERE 103 h_ip(:,:,:) = 0._wp 104 END WHERE 105 ! 106 ! 107 SELECT CASE( nice_dyn ) !-- Set which dynamics is running 122 108 123 109 CASE ( np_dynALL ) !== all dynamical processes ==! 124 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 125 CALL ice_dyn_adv ( kt ) ; CALL Hbig( zhi_max, zhs_max, zhip_max ) ! -- advection of ice + correction on ice thickness 126 CALL ice_dyn_rdgrft( kt ) ! -- ridging/rafting 127 CALL ice_cor ( kt , 1 ) ! -- Corrections 128 110 ! 111 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 112 CALL ice_dyn_adv ( kt ) ! -- advection of ice 113 CALL ice_dyn_rdgrft( kt ) ! -- ridging/rafting 114 CALL ice_cor ( kt , 1 ) ! -- Corrections 115 ! 129 116 CASE ( np_dynRHGADV ) !== no ridge/raft & no corrections ==! 130 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 131 CALL ice_dyn_adv ( kt ) ; CALL Hbig( zhi_max, zhs_max, zhip_max ) ! -- advection of ice + correction on ice thickness 132 CALL Hpiling ! -- simple pile-up (replaces ridging/rafting) 133 117 ! 118 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 119 CALL ice_dyn_adv ( kt ) ! -- advection of ice 120 CALL Hpiling ! -- simple pile-up (replaces ridging/rafting) 121 CALL ice_var_zapsmall ! -- zap small areas 122 ! 134 123 CASE ( np_dynADV1D ) !== pure advection ==! (1D) 135 ALLOCATE( zdivu_i(jpi,jpj) )124 ! 136 125 ! --- monotonicity test from Schar & Smolarkiewicz 1996 --- ! 137 126 ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length … … 146 135 END DO 147 136 ! --- 148 CALL ice_dyn_adv ( kt ) ! -- advection of ice 149 150 ! diagnostics: divergence at T points 151 DO jj = 2, jpjm1 152 DO ji = 2, jpim1 153 zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 154 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 155 END DO 156 END DO 157 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 158 IF( iom_use('icediv') ) CALL iom_put( "icediv" , zdivu_i(:,:) ) 159 160 DEALLOCATE( zdivu_i ) 161 137 CALL ice_dyn_adv ( kt ) ! -- advection of ice 138 ! 162 139 CASE ( np_dynADV2D ) !== pure advection ==! (2D w prescribed velocities) 163 ALLOCATE( zdivu_i(jpi,jpj) )140 ! 164 141 u_ice(:,:) = rn_uice * umask(:,:,1) 165 142 v_ice(:,:) = rn_vice * vmask(:,:,1) … … 167 144 !CALL RANDOM_NUMBER(v_ice(:,:)) ; v_ice(:,:) = v_ice(:,:) * 0.1 + rn_vice * 0.9 * vmask(:,:,1) 168 145 ! --- 169 CALL ice_dyn_adv ( kt ) ! -- advection of ice 170 171 ! diagnostics: divergence at T points 172 DO jj = 2, jpjm1 173 DO ji = 2, jpim1 174 zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 175 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 146 CALL ice_dyn_adv ( kt ) ! -- advection of ice 147 148 END SELECT 149 ! 150 ! 151 ! diagnostics: divergence at T points 152 IF( iom_use('icediv') ) THEN 153 ! 154 SELECT CASE( nice_dyn ) 155 156 CASE ( np_dynADV1D , np_dynADV2D ) 157 158 ALLOCATE( zdivu_i(jpi,jpj) ) 159 DO jj = 2, jpjm1 160 DO ji = 2, jpim1 161 zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 162 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 163 END DO 176 164 END DO 177 END DO 178 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 179 IF( iom_use('icediv') ) CALL iom_put( "icediv" , zdivu_i(:,:) ) 180 181 DEALLOCATE( zdivu_i ) 182 183 END SELECT 165 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 166 ! output 167 CALL iom_put( 'icediv' , zdivu_i ) 168 169 DEALLOCATE( zdivu_i ) 170 171 END SELECT 172 ! 173 ENDIF 184 174 ! 185 175 ! controls … … 189 179 190 180 191 SUBROUTINE Hbig( phi_max, phs_max, phip_max )192 !!-------------------------------------------------------------------193 !! *** ROUTINE Hbig ***194 !!195 !! ** Purpose : Thickness correction in case advection scheme creates196 !! abnormally tick ice or snow197 !!198 !! ** Method : 1- check whether ice thickness is larger than the surrounding 9-points199 !! (before advection) and reduce it by adapting ice concentration200 !! 2- check whether snow thickness is larger than the surrounding 9-points201 !! (before advection) and reduce it by sending the excess in the ocean202 !! 3- check whether snow load deplets the snow-ice interface below sea level$203 !! and reduce it by sending the excess in the ocean204 !! 4- correct pond fraction to avoid a_ip > a_i205 !!206 !! ** input : Max thickness of the surrounding 9-points207 !!-------------------------------------------------------------------208 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi_max, phs_max, phip_max ! max ice thick from surrounding 9-pts209 !210 INTEGER :: ji, jj, jl ! dummy loop indices211 REAL(wp) :: zhip, zhi, zhs, zvs_excess, zfra212 !!-------------------------------------------------------------------213 ! controls214 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'Hbig', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation215 !216 CALL ice_var_zapsmall !-- zap small areas217 !218 DO jl = 1, jpl219 DO jj = 1, jpj220 DO ji = 1, jpi221 IF ( v_i(ji,jj,jl) > 0._wp ) THEN222 !223 ! ! -- check h_ip -- !224 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip225 IF( ln_pnd_H12 .AND. v_ip(ji,jj,jl) > 0._wp ) THEN226 zhip = v_ip(ji,jj,jl) / MAX( epsi20, a_ip(ji,jj,jl) )227 IF( zhip > phip_max(ji,jj,jl) .AND. a_ip(ji,jj,jl) < 0.15 ) THEN228 a_ip(ji,jj,jl) = v_ip(ji,jj,jl) / phip_max(ji,jj,jl)229 ENDIF230 ENDIF231 !232 ! ! -- check h_i -- !233 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i234 zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)235 IF( zhi > phi_max(ji,jj,jl) .AND. a_i(ji,jj,jl) < 0.15 ) THEN236 a_i(ji,jj,jl) = v_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m)237 ENDIF238 !239 ! ! -- check h_s -- !240 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean241 zhs = v_s(ji,jj,jl) / a_i(ji,jj,jl)242 IF( v_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. a_i(ji,jj,jl) < 0.15 ) THEN243 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 )244 !245 wfx_res(ji,jj) = wfx_res(ji,jj) + ( v_s(ji,jj,jl) - a_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * r1_rdtice246 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( e_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * r1_rdtice ! W.m-2 <0247 !248 e_s(ji,jj,1:nlay_s,jl) = e_s(ji,jj,1:nlay_s,jl) * zfra249 v_s(ji,jj,jl) = a_i(ji,jj,jl) * phs_max(ji,jj,jl)250 ENDIF251 !252 ! ! -- check snow load -- !253 ! if snow load makes snow-ice interface to deplet below the ocean surface => put the snow excess in the ocean254 ! this correction is crucial because of the call to routine icecor afterwards which imposes a mini of ice thick. (rn_himin)255 ! this imposed mini can artificially make the snow very thick (if concentration decreases drastically)256 zvs_excess = MAX( 0._wp, v_s(ji,jj,jl) - v_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos )257 IF( zvs_excess > 0._wp ) THEN258 zfra = ( v_s(ji,jj,jl) - zvs_excess ) / MAX( v_s(ji,jj,jl), epsi20 )259 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * r1_rdtice260 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( e_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * r1_rdtice ! W.m-2 <0261 !262 e_s(ji,jj,1:nlay_s,jl) = e_s(ji,jj,1:nlay_s,jl) * zfra263 v_s(ji,jj,jl) = v_s(ji,jj,jl) - zvs_excess264 ENDIF265 266 ENDIF267 END DO268 END DO269 END DO270 ! !-- correct pond fraction to avoid a_ip > a_i271 WHERE( a_ip(:,:,:) > a_i(:,:,:) ) a_ip(:,:,:) = a_i(:,:,:)272 !273 ! controls274 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'Hbig', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation275 !276 END SUBROUTINE Hbig277 278 279 181 SUBROUTINE Hpiling 280 182 !!------------------------------------------------------------------- … … 291 193 ! controls 292 194 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'Hpiling', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 293 !294 CALL ice_var_zapsmall !-- zap small areas295 195 ! 296 196 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) … … 322 222 NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice, & 323 223 & rn_ishlat , & 324 & ln_landfast_L16, ln_landfast_home,rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile224 & ln_landfast_L16, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 325 225 !!------------------------------------------------------------------- 326 226 ! 327 227 REWIND( numnam_ice_ref ) ! Namelist namdyn in reference namelist : Ice dynamics 328 228 READ ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901) 329 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist' , lwp)229 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn in reference namelist' ) 330 230 REWIND( numnam_ice_cfg ) ! Namelist namdyn in configuration namelist : Ice dynamics 331 231 READ ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 ) 332 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist' , lwp)232 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn in configuration namelist' ) 333 233 IF(lwm) WRITE( numoni, namdyn ) 334 234 ! … … 338 238 WRITE(numout,*) '~~~~~~~~~~~~' 339 239 WRITE(numout,*) ' Namelist namdyn:' 340 WRITE(numout,*) ' Full ice dynamics (rhg + adv + ridge/raft + corr) ln_dynALL = ', ln_dynALL 341 WRITE(numout,*) ' No ridge/raft & No cor (rhg + adv) ln_dynRHGADV = ', ln_dynRHGADV 342 WRITE(numout,*) ' Advection 1D only (Schar & Smolarkiewicz 1996) ln_dynADV1D = ', ln_dynADV1D 343 WRITE(numout,*) ' Advection 2D only (rn_uvice + adv) ln_dynADV2D = ', ln_dynADV2D 344 WRITE(numout,*) ' with prescribed velocity given by (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',', rn_vice,')' 345 WRITE(numout,*) ' lateral boundary condition for sea ice dynamics rn_ishlat = ', rn_ishlat 346 WRITE(numout,*) ' Landfast: param from Lemieux 2016 ln_landfast_L16 = ', ln_landfast_L16 347 WRITE(numout,*) ' Landfast: param from home made ln_landfast_home= ', ln_landfast_home 348 WRITE(numout,*) ' fraction of ocean depth that ice must reach rn_depfra = ', rn_depfra 349 WRITE(numout,*) ' maximum bottom stress per unit area of contact rn_icebfr = ', rn_icebfr 350 WRITE(numout,*) ' relax time scale (s-1) to reach static friction rn_lfrelax = ', rn_lfrelax 351 WRITE(numout,*) ' isotropic tensile strength rn_tensile = ', rn_tensile 240 WRITE(numout,*) ' Full ice dynamics (rhg + adv + ridge/raft + corr) ln_dynALL = ', ln_dynALL 241 WRITE(numout,*) ' No ridge/raft & No cor (rhg + adv) ln_dynRHGADV = ', ln_dynRHGADV 242 WRITE(numout,*) ' Advection 1D only (Schar & Smolarkiewicz 1996) ln_dynADV1D = ', ln_dynADV1D 243 WRITE(numout,*) ' Advection 2D only (rn_uvice + adv) ln_dynADV2D = ', ln_dynADV2D 244 WRITE(numout,*) ' with prescribed velocity given by (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',',rn_vice,')' 245 WRITE(numout,*) ' lateral boundary condition for sea ice dynamics rn_ishlat = ', rn_ishlat 246 WRITE(numout,*) ' Landfast: param from Lemieux 2016 ln_landfast_L16 = ', ln_landfast_L16 247 WRITE(numout,*) ' fraction of ocean depth that ice must reach rn_depfra = ', rn_depfra 248 WRITE(numout,*) ' maximum bottom stress per unit area of contact rn_icebfr = ', rn_icebfr 249 WRITE(numout,*) ' relax time scale (s-1) to reach static friction rn_lfrelax = ', rn_lfrelax 250 WRITE(numout,*) ' isotropic tensile strength rn_tensile = ', rn_tensile 352 251 WRITE(numout,*) 353 252 ENDIF … … 372 271 ENDIF 373 272 ! !--- Landfast ice 374 IF( .NOT.ln_landfast_L16 .AND. .NOT.ln_landfast_home ) tau_icebfr(:,:) = 0._wp 375 ! 376 IF ( ln_landfast_L16 .AND. ln_landfast_home ) THEN 377 CALL ctl_stop( 'ice_dyn_init: choose one and only one landfast parameterization (ln_landfast_L16 or ln_landfast_home)' ) 378 ENDIF 273 IF( .NOT.ln_landfast_L16 ) tau_icebfr(:,:) = 0._wp 379 274 ! 380 275 CALL ice_dyn_rdgrft_init ! set ice ridging/rafting parameters -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedyn_adv.F90
r10413 r11822 64 64 !!---------------------------------------------------------------------- 65 65 INTEGER, INTENT(in) :: kt ! number of iteration 66 !67 INTEGER :: jl ! dummy loop indice68 REAL(wp), DIMENSION(jpi,jpj) :: zmask ! fraction of time step with v_i < 069 66 !!--------------------------------------------------------------------- 70 67 ! 71 IF( ln_timing ) CALL timing_start('icedyn_adv') 68 ! controls 69 IF( ln_timing ) CALL timing_start('icedyn_adv') ! timing 70 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 72 71 ! 73 72 IF( kt == nit000 .AND. lwp ) THEN … … 76 75 WRITE(numout,*) '~~~~~~~~~~~' 77 76 ENDIF 78 79 ! conservation test 80 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 81 82 !---------- 83 ! Advection 84 !---------- 77 ! 78 !---------------! 79 !== Advection ==! 80 !---------------! 85 81 SELECT CASE( nice_adv ) 86 82 ! !-----------------------! 87 83 CASE( np_advUMx ) ! ULTIMATE-MACHO scheme ! 88 84 ! !-----------------------! 89 CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 90 ! !-----------------------! 85 CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, & 86 & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 87 ! !-----------------------! 91 88 CASE( np_advPRA ) ! PRATHER scheme ! 92 89 ! !-----------------------! 93 CALL ice_dyn_adv_pra( kt, u_ice, v_ice, ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 90 CALL ice_dyn_adv_pra( kt, u_ice, v_ice, & 91 & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 94 92 END SELECT 95 96 !----------------------------97 ! Debug the advection schemes98 !----------------------------99 ! clem: At least one advection scheme above is not strictly positive => UMx100 ! In Prather, I am not sure if the fields are bounded by 0 or not (it seems yes)101 ! In UMx , advected fields are not perfectly bounded and negative values can appear.102 ! These values are usually very small but in some occasions they can also be non-negligible103 ! Therefore one needs to bound the advected fields by 0 (though this is not a clean fix)104 !105 ! record the negative values resulting from UMx106 zmask(:,:) = 0._wp ! keep the init to 0 here107 DO jl = 1, jpl108 WHERE( v_i(:,:,jl) < 0._wp ) zmask(:,:) = 1._wp109 END DO110 IF( iom_use('iceneg_pres') ) CALL iom_put("iceneg_pres", zmask ) ! fraction of time step with v_i < 0111 IF( iom_use('iceneg_volu') ) CALL iom_put("iceneg_volu", SUM(MIN( v_i, 0. ), dim=3 ) ) ! negative ice volume (only)112 IF( iom_use('iceneg_hfx' ) ) CALL iom_put("iceneg_hfx" , ( SUM(SUM( MIN( e_i(:,:,1:nlay_i,:), 0. ) & ! negative ice heat content (only)113 & , dim=4 ), dim=3 ) )* r1_rdtice ) ! -- eq. heat flux [W/m2]114 !115 ! ==> conservation is ensured by calling this routine below,116 ! however the global ice volume is then changed by advection (but errors are small)117 CALL ice_var_zapneg( ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )118 93 119 94 !------------ … … 125 100 diag_trp_vi(:,:) = SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_rdtice 126 101 diag_trp_vs(:,:) = SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_rdtice 127 IF( iom_use('icemtrp') ) CALL iom_put( "icemtrp" ,diag_trp_vi * rhoi ) ! ice mass transport128 IF( iom_use('snwmtrp') ) CALL iom_put( "snwmtrp" ,diag_trp_vs * rhos ) ! snw mass transport129 IF( iom_use('salmtrp') ) CALL iom_put( "salmtrp" ,diag_trp_sv * rhoi * 1.e-03 ) ! salt mass transport (kg/m2/s)130 IF( iom_use('dihctrp') ) CALL iom_put( "dihctrp" , -diag_trp_ei) ! advected ice heat content (W/m2)131 IF( iom_use('dshctrp') ) CALL iom_put( "dshctrp" , -diag_trp_es) ! advected snw heat content (W/m2)102 IF( iom_use('icemtrp') ) CALL iom_put( 'icemtrp' , diag_trp_vi * rhoi ) ! ice mass transport 103 IF( iom_use('snwmtrp') ) CALL iom_put( 'snwmtrp' , diag_trp_vs * rhos ) ! snw mass transport 104 IF( iom_use('salmtrp') ) CALL iom_put( 'salmtrp' , diag_trp_sv * rhoi * 1.e-03 ) ! salt mass transport (kg/m2/s) 105 IF( iom_use('dihctrp') ) CALL iom_put( 'dihctrp' , -diag_trp_ei ) ! advected ice heat content (W/m2) 106 IF( iom_use('dshctrp') ) CALL iom_put( 'dshctrp' , -diag_trp_es ) ! advected snw heat content (W/m2) 132 107 133 108 ! controls … … 158 133 REWIND( numnam_ice_ref ) ! Namelist namdyn_adv in reference namelist : Ice dynamics 159 134 READ ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 160 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' , lwp)135 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' ) 161 136 REWIND( numnam_ice_cfg ) ! Namelist namdyn_adv in configuration namelist : Ice dynamics 162 137 READ ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 163 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' , lwp)138 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' ) 164 139 IF(lwm) WRITE( numoni, namdyn_adv ) 165 140 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedyn_adv_pra.F90
r10425 r11822 19 19 USE ice ! sea-ice variables 20 20 USE sbc_oce , ONLY : nn_fsbc ! frequency of sea-ice call 21 USE icevar ! sea-ice: operations 21 22 ! 22 23 USE in_out_manager ! I/O manager … … 25 26 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 26 27 USE lbclnk ! lateral boundary conditions (or mpp links) 27 USE prtctl ! Print control28 28 29 29 IMPLICIT NONE … … 36 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxice, syice, sxxice, syyice, sxyice ! ice thickness 37 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsn , sysn , sxxsn , syysn , sxysn ! snow thickness 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxa , sya , sxxa , syya , sxya ! lead fraction38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxa , sya , sxxa , syya , sxya ! ice concentration 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsal, sysal, sxxsal, syysal, sxysal ! ice salinity 40 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage ! ice age 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxopw, syopw, sxxopw, syyopw, sxyopw ! open water in sea ice42 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxc0 , syc0 , sxxc0 , syyc0 , sxyc0 ! snow layers heat content 43 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye ! ice layers heat content … … 81 80 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content 82 81 ! 83 INTEGER :: jk, jl, jt ! dummy loop indices 84 INTEGER :: initad ! number of sub-timestep for the advection 85 REAL(wp) :: zcfl , zusnit ! - - 86 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0opw 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0smi, z0oi 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z0ap , z0vp 90 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z0es 91 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z0ei 82 INTEGER :: ji,jj, jk, jl, jt ! dummy loop indices 83 INTEGER :: icycle ! number of sub-timestep for the advection 84 REAL(wp) :: zdt ! - - 85 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 86 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 87 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx 88 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zarea 89 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ice, z0snw, z0ai, z0smi, z0oi 90 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ap , z0vp 91 REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: z0es 92 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: z0ei 92 93 !!---------------------------------------------------------------------- 93 94 ! 94 95 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 95 96 ! 96 ALLOCATE( zarea(jpi,jpj) , z0opw(jpi,jpj, 1 ) , z0ice(jpi,jpj,jpl) , z0snw(jpi,jpj,jpl) , & 97 & z0ai(jpi,jpj,jpl) , z0smi(jpi,jpj,jpl) , z0oi (jpi,jpj,jpl) , z0ap (jpi,jpj,jpl) , z0vp(jpi,jpj,jpl) , & 98 & z0es (jpi,jpj,nlay_s,jpl), z0ei(jpi,jpj,nlay_i,jpl) ) 99 ! 100 ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- ! 101 zcfl = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 102 zcfl = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 103 CALL mpp_max( 'icedyn_adv_pra', zcfl ) 97 ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! 98 ! Note: the advection split is applied at the next time-step in order to avoid blocking global comm. 99 ! this should not affect too much the stability 100 zcflnow(1) = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 101 zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 104 102 105 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 106 ELSE ; initad = 1 ; zusnit = 1.0_wp 103 ! non-blocking global communication send zcflnow and receive zcflprv 104 CALL mpp_delay_max( 'icedyn_adv_pra', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 ) 105 106 IF( zcflprv(1) > .5 ) THEN ; icycle = 2 107 ELSE ; icycle = 1 107 108 ENDIF 109 zdt = rdt_ice / REAL(icycle) 108 110 109 zarea(:,:) = e1e2t(:,:) 110 !------------------------- 111 ! transported fields 112 !------------------------- 113 z0opw(:,:,1) = pato_i(:,:) * e1e2t(:,:) ! Open water area 114 DO jl = 1, jpl 115 z0snw(:,:,jl) = pv_s (:,:, jl) * e1e2t(:,:) ! Snow volume 116 z0ice(:,:,jl) = pv_i (:,:, jl) * e1e2t(:,:) ! Ice volume 117 z0ai (:,:,jl) = pa_i (:,:, jl) * e1e2t(:,:) ! Ice area 118 z0smi(:,:,jl) = psv_i(:,:, jl) * e1e2t(:,:) ! Salt content 119 z0oi (:,:,jl) = poa_i(:,:, jl) * e1e2t(:,:) ! Age content 120 DO jk = 1, nlay_s 121 z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content 122 END DO 123 DO jk = 1, nlay_i 124 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 125 END DO 126 IF ( ln_pnd_H12 ) THEN 127 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 128 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 111 ! --- transport --- ! 112 zudy(:,:) = pu_ice(:,:) * e2u(:,:) 113 zvdx(:,:) = pv_ice(:,:) * e1v(:,:) 114 115 DO jt = 1, icycle 116 117 ! record at_i before advection (for open water) 118 zati1(:,:) = SUM( pa_i(:,:,:), dim=3 ) 119 120 ! --- transported fields --- ! 121 DO jl = 1, jpl 122 zarea(:,:,jl) = e1e2t(:,:) 123 z0snw(:,:,jl) = pv_s (:,:,jl) * e1e2t(:,:) ! Snow volume 124 z0ice(:,:,jl) = pv_i (:,:,jl) * e1e2t(:,:) ! Ice volume 125 z0ai (:,:,jl) = pa_i (:,:,jl) * e1e2t(:,:) ! Ice area 126 z0smi(:,:,jl) = psv_i(:,:,jl) * e1e2t(:,:) ! Salt content 127 z0oi (:,:,jl) = poa_i(:,:,jl) * e1e2t(:,:) ! Age content 128 DO jk = 1, nlay_s 129 z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content 130 END DO 131 DO jk = 1, nlay_i 132 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 133 END DO 134 IF ( ln_pnd_H12 ) THEN 135 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 136 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 137 ENDIF 138 END DO 139 ! 140 ! !--------------------------------------------! 141 IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! 142 ! !--------------------------------------------! 143 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 144 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 145 CALL adv_x( zdt , zudy , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 146 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 147 CALL adv_x( zdt , zudy , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 148 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 149 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 150 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 151 CALL adv_x( zdt , zudy , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 152 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 153 ! 154 DO jk = 1, nlay_s !--- snow heat content 155 CALL adv_x( zdt, zudy, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 156 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 157 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 158 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 159 END DO 160 DO jk = 1, nlay_i !--- ice heat content 161 CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 162 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 163 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 164 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 165 END DO 166 ! 167 IF ( ln_pnd_H12 ) THEN 168 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 169 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 170 CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 171 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 172 ENDIF 173 ! !--------------------------------------------! 174 ELSE !== even ice time step: adv_y then adv_x ==! 175 ! !--------------------------------------------! 176 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 177 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 178 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) !--- snow volume 179 CALL adv_x( zdt , zudy , 0._wp , zarea , z0snw , sxsn , sxxsn , sysn , syysn , sxysn ) 180 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 181 CALL adv_x( zdt , zudy , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 182 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) !--- ice concentration 183 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ai , sxa , sxxa , sya , syya , sxya ) 184 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 185 CALL adv_x( zdt , zudy , 0._wp , zarea , z0oi , sxage , sxxage , syage , syyage , sxyage ) 186 DO jk = 1, nlay_s !--- snow heat content 187 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 188 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 189 CALL adv_x( zdt, zudy, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:), & 190 & sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 191 END DO 192 DO jk = 1, nlay_i !--- ice heat content 193 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 194 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 195 CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 196 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 197 END DO 198 IF ( ln_pnd_H12 ) THEN 199 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 200 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 201 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 202 CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 203 ENDIF 204 ! 129 205 ENDIF 206 207 ! --- Recover the properties from their contents --- ! 208 DO jl = 1, jpl 209 pv_i (:,:,jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 210 pv_s (:,:,jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 211 psv_i(:,:,jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 212 poa_i(:,:,jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 213 pa_i (:,:,jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 214 DO jk = 1, nlay_s 215 pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 216 END DO 217 DO jk = 1, nlay_i 218 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 219 END DO 220 IF ( ln_pnd_H12 ) THEN 221 pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 222 pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 223 ENDIF 224 END DO 225 ! 226 ! derive open water from ice concentration 227 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 228 DO jj = 2, jpjm1 229 DO ji = fs_2, fs_jpim1 230 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water 231 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 232 END DO 233 END DO 234 CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1. ) 235 ! 236 ! --- Ensure non-negative fields --- ! 237 ! Remove negative values (conservation is ensured) 238 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 239 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 240 ! 241 ! --- Ensure snow load is not too big --- ! 242 CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 243 ! 130 244 END DO 131 132 ! !--------------------------------------------!133 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==!134 ! !--------------------------------------------!135 DO jt = 1, initad136 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area137 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )138 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), &139 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )140 DO jl = 1, jpl141 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---142 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )143 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), &144 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )145 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---146 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )147 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), &148 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )149 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---150 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )151 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), &152 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )153 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---154 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )155 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), &156 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )157 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---158 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )159 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), &160 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )161 DO jk = 1, nlay_s !--- snow heat contents ---162 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &163 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )164 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &165 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )166 END DO167 DO jk = 1, nlay_i !--- ice heat contents ---168 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &169 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )170 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &171 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )172 END DO173 IF ( ln_pnd_H12 ) THEN174 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & !--- melt pond fraction --175 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )176 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), &177 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )178 CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & !--- melt pond volume --179 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )180 CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), &181 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )182 ENDIF183 END DO184 END DO185 ! !--------------------------------------------!186 ELSE !== even ice time step: adv_y then adv_x ==!187 ! !--------------------------------------------!188 DO jt = 1, initad189 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area190 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )191 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), &192 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )193 DO jl = 1, jpl194 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---195 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )196 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), &197 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )198 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---199 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )200 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), &201 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )202 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---203 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )204 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), &205 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )206 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---207 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )208 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), &209 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )210 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---211 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )212 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), &213 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )214 DO jk = 1, nlay_s !--- snow heat contents ---215 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &216 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )217 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl), &218 & sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) )219 END DO220 DO jk = 1, nlay_i !--- ice heat contents ---221 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &222 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )223 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl), &224 & sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) )225 END DO226 IF ( ln_pnd_H12 ) THEN227 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), & !--- melt pond fraction ---228 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )229 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ap (:,:,jl), sxap (:,:,jl), &230 & sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl) )231 CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), & !--- melt pond volume ---232 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )233 CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0vp (:,:,jl), sxvp (:,:,jl), &234 & sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl) )235 ENDIF236 END DO237 END DO238 ENDIF239 240 !-------------------------------------------241 ! Recover the properties from their contents242 !-------------------------------------------243 pato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) * tmask(:,:,1)244 DO jl = 1, jpl245 pv_i (:,:, jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)246 pv_s (:,:, jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)247 psv_i(:,:, jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)248 poa_i(:,:, jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)249 pa_i (:,:, jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)250 DO jk = 1, nlay_s251 pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)252 END DO253 DO jk = 1, nlay_i254 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1)255 END DO256 IF ( ln_pnd_H12 ) THEN257 pa_ip (:,:,jl) = z0ap (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)258 pv_ip (:,:,jl) = z0vp (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1)259 ENDIF260 END DO261 !262 DEALLOCATE( zarea , z0opw , z0ice, z0snw , z0ai , z0smi , z0oi , z0ap , z0vp , z0es, z0ei )263 245 ! 264 246 IF( lrst_ice ) CALL adv_pra_rst( 'WRITE', kt ) !* write Prather fields in the restart file … … 267 249 268 250 269 SUBROUTINE adv_x( pd f, put , pcrh, psm , ps0 , &251 SUBROUTINE adv_x( pdt, put , pcrh, psm , ps0 , & 270 252 & psx, psxx, psy , psyy, psxy ) 271 253 !!---------------------------------------------------------------------- … … 275 257 !! variable on x axis 276 258 !!---------------------------------------------------------------------- 277 REAL(wp) , INTENT(in ) :: pdf ! reduction factor forthe time step278 REAL(wp) 279 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: put ! i-direction ice velocity at U-point [m/s]280 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psm ! area281 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: ps0 ! field to be advected282 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psx , psy ! 1st moments283 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments259 REAL(wp) , INTENT(in ) :: pdt ! the time step 260 REAL(wp) , INTENT(in ) :: pcrh ! call adv_x then adv_y (=1) or the opposite (=0) 261 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: put ! i-direction ice velocity at U-point [m/s] 262 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psm ! area 263 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ps0 ! field to be advected 264 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 265 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 284 266 !! 285 INTEGER :: ji, jj 286 REAL(wp) :: zs1max, z rdt, zslpmax, ztemp! local scalars267 INTEGER :: ji, jj, jl, jcat ! dummy loop indices 268 REAL(wp) :: zs1max, zslpmax, ztemp ! local scalars 287 269 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 288 270 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - … … 291 273 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 292 274 !----------------------------------------------------------------------- 293 294 ! Limitation of moments. 295 296 zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection. 297 298 DO jj = 1, jpj 299 DO ji = 1, jpi 300 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 301 zs1max = 1.5 * zslpmax 302 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 303 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 304 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) ) 305 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 306 307 ps0 (ji,jj) = zslpmax 308 psx (ji,jj) = zs1new * rswitch 309 psxx(ji,jj) = zs2new * rswitch 310 psy (ji,jj) = psy (ji,jj) * rswitch 311 psyy(ji,jj) = psyy(ji,jj) * rswitch 312 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 313 END DO 275 ! 276 jcat = SIZE( ps0 , 3 ) ! size of input arrays 277 ! 278 DO jl = 1, jcat ! loop on categories 279 ! 280 ! Limitation of moments. 281 DO jj = 2, jpjm1 282 DO ji = 1, jpi 283 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 284 psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 285 ! 286 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 287 zs1max = 1.5 * zslpmax 288 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 289 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 290 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 291 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 292 293 ps0 (ji,jj,jl) = zslpmax 294 psx (ji,jj,jl) = zs1new * rswitch 295 psxx(ji,jj,jl) = zs2new * rswitch 296 psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 297 psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 298 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 299 END DO 300 END DO 301 302 ! Calculate fluxes and moments between boxes i<-->i+1 303 DO jj = 2, jpjm1 ! Flux from i to i+1 WHEN u GT 0 304 DO ji = 1, jpi 305 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 306 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 307 zalfq = zalf * zalf 308 zalf1 = 1.0 - zalf 309 zalf1q = zalf1 * zalf1 310 ! 311 zfm (ji,jj) = zalf * psm (ji,jj,jl) 312 zf0 (ji,jj) = zalf * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 313 zfx (ji,jj) = zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 314 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) * zalfq 315 zfy (ji,jj) = zalf * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 316 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 317 zfyy(ji,jj) = zalf * psyy(ji,jj,jl) 318 319 ! Readjust moments remaining in the box. 320 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 321 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 322 psx (ji,jj,jl) = zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 323 psxx(ji,jj,jl) = zalf1 * zalf1q * psxx(ji,jj,jl) 324 psy (ji,jj,jl) = psy (ji,jj,jl) - zfy(ji,jj) 325 psyy(ji,jj,jl) = psyy(ji,jj,jl) - zfyy(ji,jj) 326 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 327 END DO 328 END DO 329 330 DO jj = 2, jpjm1 ! Flux from i+1 to i when u LT 0. 331 DO ji = 1, fs_jpim1 332 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 333 zalg (ji,jj) = zalf 334 zalfq = zalf * zalf 335 zalf1 = 1.0 - zalf 336 zalg1 (ji,jj) = zalf1 337 zalf1q = zalf1 * zalf1 338 zalg1q(ji,jj) = zalf1q 339 ! 340 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj,jl) 341 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj,jl) & 342 & - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 343 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 344 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj,jl) * zalfq 345 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 346 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj,jl) 347 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj,jl) 348 END DO 349 END DO 350 351 DO jj = 2, jpjm1 ! Readjust moments remaining in the box. 352 DO ji = fs_2, fs_jpim1 353 zbt = zbet(ji-1,jj) 354 zbt1 = 1.0 - zbet(ji-1,jj) 355 ! 356 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 357 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 358 psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 359 psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 360 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 361 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 362 psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 363 END DO 364 END DO 365 366 ! Put the temporary moments into appropriate neighboring boxes. 367 DO jj = 2, jpjm1 ! Flux from i to i+1 IF u GT 0. 368 DO ji = fs_2, fs_jpim1 369 zbt = zbet(ji-1,jj) 370 zbt1 = 1.0 - zbet(ji-1,jj) 371 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 372 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 373 zalf1 = 1.0 - zalf 374 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 375 ! 376 ps0 (ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 377 psx (ji,jj,jl) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 378 psxx(ji,jj,jl) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 379 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & 380 & + zbt1 * psxx(ji,jj,jl) 381 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl) & 382 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj,jl) ) ) & 383 & + zbt1 * psxy(ji,jj,jl) 384 psy (ji,jj,jl) = zbt * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 385 psyy(ji,jj,jl) = zbt * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 386 END DO 387 END DO 388 389 DO jj = 2, jpjm1 ! Flux from i+1 to i IF u LT 0. 390 DO ji = fs_2, fs_jpim1 391 zbt = zbet(ji,jj) 392 zbt1 = 1.0 - zbet(ji,jj) 393 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 394 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 395 zalf1 = 1.0 - zalf 396 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 397 ! 398 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 399 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 400 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 401 & + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) ) & 402 & + ( zalf1 - zalf ) * ztemp ) ) 403 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 404 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 405 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 406 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 407 END DO 408 END DO 409 314 410 END DO 315 411 316 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)317 psm (:,:) = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )318 319 ! Calculate fluxes and moments between boxes i<-->i+1320 DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0321 DO ji = 1, jpi322 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )323 zalf = MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)324 zalfq = zalf * zalf325 zalf1 = 1.0 - zalf326 zalf1q = zalf1 * zalf1327 !328 zfm (ji,jj) = zalf * psm (ji,jj)329 zf0 (ji,jj) = zalf * ( ps0 (ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj) ) )330 zfx (ji,jj) = zalfq * ( psx (ji,jj) + 3.0 * zalf1 * psxx(ji,jj) )331 zfxx(ji,jj) = zalf * psxx(ji,jj) * zalfq332 zfy (ji,jj) = zalf * ( psy (ji,jj) + zalf1 * psxy(ji,jj) )333 zfxy(ji,jj) = zalfq * psxy(ji,jj)334 zfyy(ji,jj) = zalf * psyy(ji,jj)335 336 ! Readjust moments remaining in the box.337 psm (ji,jj) = psm (ji,jj) - zfm(ji,jj)338 ps0 (ji,jj) = ps0 (ji,jj) - zf0(ji,jj)339 psx (ji,jj) = zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) )340 psxx(ji,jj) = zalf1 * zalf1q * psxx(ji,jj)341 psy (ji,jj) = psy (ji,jj) - zfy(ji,jj)342 psyy(ji,jj) = psyy(ji,jj) - zfyy(ji,jj)343 psxy(ji,jj) = zalf1q * psxy(ji,jj)344 END DO345 END DO346 347 DO jj = 1, jpjm1 ! Flux from i+1 to i when u LT 0.348 DO ji = 1, fs_jpim1349 zalf = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)350 zalg (ji,jj) = zalf351 zalfq = zalf * zalf352 zalf1 = 1.0 - zalf353 zalg1 (ji,jj) = zalf1354 zalf1q = zalf1 * zalf1355 zalg1q(ji,jj) = zalf1q356 !357 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj)358 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) )359 zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) )360 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj) * zalfq361 zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj) - zalf1 * psxy(ji+1,jj) )362 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj)363 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj)364 END DO365 END DO366 367 DO jj = 2, jpjm1 ! Readjust moments remaining in the box.368 DO ji = fs_2, fs_jpim1369 zbt = zbet(ji-1,jj)370 zbt1 = 1.0 - zbet(ji-1,jj)371 !372 psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) )373 ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) )374 psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) )375 psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj)376 psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) )377 psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) )378 psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj)379 END DO380 END DO381 382 ! Put the temporary moments into appropriate neighboring boxes.383 DO jj = 2, jpjm1 ! Flux from i to i+1 IF u GT 0.384 DO ji = fs_2, fs_jpim1385 zbt = zbet(ji-1,jj)386 zbt1 = 1.0 - zbet(ji-1,jj)387 psm(ji,jj) = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj)388 zalf = zbt * zfm(ji-1,jj) / psm(ji,jj)389 zalf1 = 1.0 - zalf390 ztemp = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj)391 !392 ps0 (ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj)393 psx (ji,jj) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj)394 psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj) &395 & + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) &396 & + zbt1 * psxx(ji,jj)397 psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj) &398 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * psy(ji,jj) ) ) &399 & + zbt1 * psxy(ji,jj)400 psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj)401 psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj)402 END DO403 END DO404 405 DO jj = 2, jpjm1 ! Flux from i+1 to i IF u LT 0.406 DO ji = fs_2, fs_jpim1407 zbt = zbet(ji,jj)408 zbt1 = 1.0 - zbet(ji,jj)409 psm(ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )410 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj)411 zalf1 = 1.0 - zalf412 ztemp = - zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)413 !414 ps0(ji,jj) = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )415 psx(ji,jj) = zbt * psx (ji,jj) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp )416 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj) &417 & + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) ) &418 & + ( zalf1 - zalf ) * ztemp ) )419 psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj) &420 & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) ) )421 psy(ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) + zfy (ji,jj) )422 psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) )423 END DO424 END DO425 426 412 !-- Lateral boundary conditions 427 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm , 'T', 1., ps0 , 'T', 1. & 428 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 429 & , psxx, 'T', 1., psyy, 'T', 1. & 430 & , psxy, 'T', 1. ) 431 432 IF(ln_ctl) THEN 433 CALL prt_ctl(tab2d_1=psm , clinfo1=' adv_x: psm :', tab2d_2=ps0 , clinfo2=' ps0 : ') 434 CALL prt_ctl(tab2d_1=psx , clinfo1=' adv_x: psx :', tab2d_2=psxx, clinfo2=' psxx : ') 435 CALL prt_ctl(tab2d_1=psy , clinfo1=' adv_x: psy :', tab2d_2=psyy, clinfo2=' psyy : ') 436 CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_x: psxy :') 437 ENDIF 413 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 414 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 415 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 438 416 ! 439 417 END SUBROUTINE adv_x 440 418 441 419 442 SUBROUTINE adv_y( pd f, pvt , pcrh, psm , ps0 , &420 SUBROUTINE adv_y( pdt, pvt , pcrh, psm , ps0 , & 443 421 & psx, psxx, psy , psyy, psxy ) 444 422 !!--------------------------------------------------------------------- … … 448 426 !! variable on y axis 449 427 !!--------------------------------------------------------------------- 450 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for thetime step451 REAL(wp) 452 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: pvt ! j-direction ice velocity at V-point [m/s]453 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psm ! area454 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: ps0 ! field to be advected455 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psx , psy ! 1st moments456 REAL(wp), DIMENSION( jpi,jpj), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments428 REAL(wp) , INTENT(in ) :: pdt ! time step 429 REAL(wp) , INTENT(in ) :: pcrh ! call adv_x then adv_y (=1) or the opposite (=0) 430 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvt ! j-direction ice velocity at V-point [m/s] 431 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psm ! area 432 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ps0 ! field to be advected 433 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 434 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 457 435 !! 458 INTEGER :: ji, jj 459 REAL(wp) :: zs1max, z rdt, zslpmax, ztemp! temporary scalars436 INTEGER :: ji, jj, jl, jcat ! dummy loop indices 437 REAL(wp) :: zs1max, zslpmax, ztemp ! temporary scalars 460 438 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 461 439 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - … … 464 442 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 465 443 !--------------------------------------------------------------------- 466 467 ! Limitation of moments. 468 469 zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection. 470 471 DO jj = 1, jpj 472 DO ji = 1, jpi 473 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 474 zs1max = 1.5 * zslpmax 475 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 476 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 477 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 478 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 479 ! 480 ps0 (ji,jj) = zslpmax 481 psx (ji,jj) = psx (ji,jj) * rswitch 482 psxx(ji,jj) = psxx(ji,jj) * rswitch 483 psy (ji,jj) = zs1new * rswitch 484 psyy(ji,jj) = zs2new * rswitch 485 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 486 END DO 444 ! 445 jcat = SIZE( ps0 , 3 ) ! size of input arrays 446 ! 447 DO jl = 1, jcat ! loop on categories 448 ! 449 ! Limitation of moments. 450 DO jj = 1, jpj 451 DO ji = fs_2, fs_jpim1 452 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 453 psm(ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 454 ! 455 zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 456 zs1max = 1.5 * zslpmax 457 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 458 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 459 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 460 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 461 ! 462 ps0 (ji,jj,jl) = zslpmax 463 psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 464 psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 465 psy (ji,jj,jl) = zs1new * rswitch 466 psyy(ji,jj,jl) = zs2new * rswitch 467 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 468 END DO 469 END DO 470 471 ! Calculate fluxes and moments between boxes j<-->j+1 472 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 473 DO ji = fs_2, fs_jpim1 474 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 475 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 476 zalfq = zalf * zalf 477 zalf1 = 1.0 - zalf 478 zalf1q = zalf1 * zalf1 479 ! 480 zfm (ji,jj) = zalf * psm(ji,jj,jl) 481 zf0 (ji,jj) = zalf * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl) + (zalf1-zalf) * psyy(ji,jj,jl) ) ) 482 zfy (ji,jj) = zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 483 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj,jl) 484 zfx (ji,jj) = zalf * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 485 zfxy(ji,jj) = zalfq * psxy(ji,jj,jl) 486 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) 487 ! 488 ! Readjust moments remaining in the box. 489 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 490 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) 491 psy (ji,jj,jl) = zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 492 psyy(ji,jj,jl) = zalf1 * zalf1q * psyy(ji,jj,jl) 493 psx (ji,jj,jl) = psx (ji,jj,jl) - zfx(ji,jj) 494 psxx(ji,jj,jl) = psxx(ji,jj,jl) - zfxx(ji,jj) 495 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 496 END DO 497 END DO 498 ! 499 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 500 DO ji = fs_2, fs_jpim1 501 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 502 zalg (ji,jj) = zalf 503 zalfq = zalf * zalf 504 zalf1 = 1.0 - zalf 505 zalg1 (ji,jj) = zalf1 506 zalf1q = zalf1 * zalf1 507 zalg1q(ji,jj) = zalf1q 508 ! 509 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1,jl) 510 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1,jl) & 511 & - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 512 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 513 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1,jl) * zalfq 514 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 515 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1,jl) 516 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1,jl) 517 END DO 518 END DO 519 520 ! Readjust moments remaining in the box. 521 DO jj = 2, jpjm1 522 DO ji = fs_2, fs_jpim1 523 zbt = zbet(ji,jj-1) 524 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 525 ! 526 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 527 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 528 psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 529 psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 530 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 531 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 532 psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 533 END DO 534 END DO 535 536 ! Put the temporary moments into appropriate neighboring boxes. 537 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 538 DO ji = fs_2, fs_jpim1 539 zbt = zbet(ji,jj-1) 540 zbt1 = 1.0 - zbet(ji,jj-1) 541 psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl) 542 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj,jl) 543 zalf1 = 1.0 - zalf 544 ztemp = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 545 ! 546 ps0(ji,jj,jl) = zbt * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 547 psy(ji,jj,jl) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) & 548 & + zbt1 * psy(ji,jj,jl) 549 psyy(ji,jj,jl) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl) & 550 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 551 & + zbt1 * psyy(ji,jj,jl) 552 psxy(ji,jj,jl) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl) & 553 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) ) & 554 & + zbt1 * psxy(ji,jj,jl) 555 psx (ji,jj,jl) = zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 556 psxx(ji,jj,jl) = zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 557 END DO 558 END DO 559 560 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 561 DO ji = fs_2, fs_jpim1 562 zbt = zbet(ji,jj) 563 zbt1 = 1.0 - zbet(ji,jj) 564 psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 565 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 566 zalf1 = 1.0 - zalf 567 ztemp = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 568 ! 569 ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 570 psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 571 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 572 & + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) ) & 573 & + ( zalf1 - zalf ) * ztemp ) ) 574 psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl) & 575 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 576 psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 577 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 578 END DO 579 END DO 580 487 581 END DO 488 582 489 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 490 psm(:,:) = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 491 492 ! Calculate fluxes and moments between boxes j<-->j+1 493 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 494 DO ji = 1, jpi 495 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 496 zalf = MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 497 zalfq = zalf * zalf 498 zalf1 = 1.0 - zalf 499 zalf1q = zalf1 * zalf1 500 ! 501 zfm (ji,jj) = zalf * psm(ji,jj) 502 zf0 (ji,jj) = zalf * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj) + (zalf1-zalf) * psyy(ji,jj) ) ) 503 zfy (ji,jj) = zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) ) 504 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj) 505 zfx (ji,jj) = zalf * ( psx(ji,jj) + zalf1 * psxy(ji,jj) ) 506 zfxy(ji,jj) = zalfq * psxy(ji,jj) 507 zfxx(ji,jj) = zalf * psxx(ji,jj) 508 ! 509 ! Readjust moments remaining in the box. 510 psm (ji,jj) = psm (ji,jj) - zfm(ji,jj) 511 ps0 (ji,jj) = ps0 (ji,jj) - zf0(ji,jj) 512 psy (ji,jj) = zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) ) 513 psyy(ji,jj) = zalf1 * zalf1q * psyy(ji,jj) 514 psx (ji,jj) = psx (ji,jj) - zfx(ji,jj) 515 psxx(ji,jj) = psxx(ji,jj) - zfxx(ji,jj) 516 psxy(ji,jj) = zalf1q * psxy(ji,jj) 583 !-- Lateral boundary conditions 584 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 585 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 586 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 587 ! 588 END SUBROUTINE adv_y 589 590 591 SUBROUTINE Hsnow( pdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 592 !!------------------------------------------------------------------- 593 !! *** ROUTINE Hsnow *** 594 !! 595 !! ** Purpose : 1- Check snow load after advection 596 !! 2- Correct pond concentration to avoid a_ip > a_i 597 !! 598 !! ** Method : If snow load makes snow-ice interface to deplet below the ocean surface 599 !! then put the snow excess in the ocean 600 !! 601 !! ** Notes : This correction is crucial because of the call to routine icecor afterwards 602 !! which imposes a mini of ice thick. (rn_himin). This imposed mini can artificially 603 !! make the snow very thick (if concentration decreases drastically) 604 !! This behavior has been seen in Ultimate-Macho and supposedly it can also be true for Prather 605 !!------------------------------------------------------------------- 606 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 607 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip 608 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 609 ! 610 INTEGER :: ji, jj, jl ! dummy loop indices 611 REAL(wp) :: z1_dt, zvs_excess, zfra 612 !!------------------------------------------------------------------- 613 ! 614 z1_dt = 1._wp / pdt 615 ! 616 ! -- check snow load -- ! 617 DO jl = 1, jpl 618 DO jj = 1, jpj 619 DO ji = 1, jpi 620 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 621 ! 622 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 623 ! 624 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 625 ! put snow excess in the ocean 626 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 627 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 628 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 629 ! correct snow volume and heat content 630 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 631 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 632 ENDIF 633 ! 634 ENDIF 635 END DO 517 636 END DO 518 637 END DO 519 638 ! 520 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 521 DO ji = 1, jpi 522 zalf = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 523 zalg (ji,jj) = zalf 524 zalfq = zalf * zalf 525 zalf1 = 1.0 - zalf 526 zalg1 (ji,jj) = zalf1 527 zalf1q = zalf1 * zalf1 528 zalg1q(ji,jj) = zalf1q 529 ! 530 zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1) 531 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) ) 532 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) ) 533 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1) * zalfq 534 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1) - zalf1 * psxy(ji,jj+1) ) 535 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1) 536 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1) 537 END DO 538 END DO 539 540 ! Readjust moments remaining in the box. 541 DO jj = 2, jpj 542 DO ji = 1, jpi 543 zbt = zbet(ji,jj-1) 544 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 545 ! 546 psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) ) 547 ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) ) 548 psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) ) 549 psyy(ji,jj) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj) 550 psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) ) 551 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) ) 552 psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj) 553 END DO 554 END DO 555 556 ! Put the temporary moments into appropriate neighboring boxes. 557 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 558 DO ji = 1, jpi 559 zbt = zbet(ji,jj-1) 560 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 561 psm(ji,jj) = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 562 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj) 563 zalf1 = 1.0 - zalf 564 ztemp = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1) 565 ! 566 ps0(ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj) 567 psy(ji,jj) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) & 568 & + zbt1 * psy(ji,jj) 569 psyy(ji,jj) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj) & 570 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 571 & + zbt1 * psyy(ji,jj) 572 psxy(ji,jj) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj) & 573 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) ) ) & 574 & + zbt1 * psxy(ji,jj) 575 psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj) 576 psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj) 577 END DO 578 END DO 579 580 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 581 DO ji = 1, jpi 582 zbt = zbet(ji,jj) 583 zbt1 = ( 1.0 - zbet(ji,jj) ) 584 psm(ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) ) 585 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj) 586 zalf1 = 1.0 - zalf 587 ztemp = - zalf * ps0 (ji,jj) + zalf1 * zf0(ji,jj) 588 ps0 (ji,jj) = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) ) 589 psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) 590 psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj) & 591 & + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) ) & 592 & + ( zalf1 - zalf ) * ztemp ) ) 593 psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj) & 594 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) ) ) 595 psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) ) 596 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) ) 597 END DO 598 END DO 599 600 !-- Lateral boundary conditions 601 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm , 'T', 1., ps0 , 'T', 1. & 602 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 603 & , psxx, 'T', 1., psyy, 'T', 1. & 604 & , psxy, 'T', 1. ) 605 606 IF(ln_ctl) THEN 607 CALL prt_ctl(tab2d_1=psm , clinfo1=' adv_y: psm :', tab2d_2=ps0 , clinfo2=' ps0 : ') 608 CALL prt_ctl(tab2d_1=psx , clinfo1=' adv_y: psx :', tab2d_2=psxx, clinfo2=' psxx : ') 609 CALL prt_ctl(tab2d_1=psy , clinfo1=' adv_y: psy :', tab2d_2=psyy, clinfo2=' psyy : ') 610 CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_y: psxy :') 611 ENDIF 612 ! 613 END SUBROUTINE adv_y 639 !-- correct pond concentration to avoid a_ip > a_i -- ! 640 WHERE( pa_ip(:,:,:) > pa_i(:,:,:) ) pa_ip(:,:,:) = pa_i(:,:,:) 641 ! 642 END SUBROUTINE Hsnow 614 643 615 644 … … 624 653 ! 625 654 ! !* allocate prather fields 626 ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , & 627 & sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 655 ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 628 656 & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , & 629 657 & sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , & … … 652 680 !! *** ROUTINE adv_pra_rst *** 653 681 !! 654 !! ** Purpose : Read or write RHGfile in restart file682 !! ** Purpose : Read or write file in restart file 655 683 !! 656 684 !! ** Method : use of IOM library … … 671 699 ! !==========================! 672 700 ! 673 IF( ln_rstart ) THEN ; id1 = iom_varid( numrir, 'sx opw' , ldstop = .FALSE. ) ! file exist: id1>0701 IF( ln_rstart ) THEN ; id1 = iom_varid( numrir, 'sxice' , ldstop = .FALSE. ) ! file exist: id1>0 674 702 ELSE ; id1 = 0 ! no restart: id1=0 675 703 ENDIF … … 689 717 CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn ) 690 718 CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn ) 691 ! ! lead fraction719 ! ! ice concentration 692 720 CALL iom_get( numrir, jpdom_autoglo, 'sxa' , sxa ) 693 721 CALL iom_get( numrir, jpdom_autoglo, 'sya' , sya ) … … 707 735 CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage ) 708 736 CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage ) 709 ! ! open water in sea ice710 CALL iom_get( numrir, jpdom_autoglo, 'sxopw' , sxopw )711 CALL iom_get( numrir, jpdom_autoglo, 'syopw' , syopw )712 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw', sxxopw )713 CALL iom_get( numrir, jpdom_autoglo, 'syyopw', syyopw )714 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw', sxyopw )715 737 ! ! snow layers heat content 716 738 DO jk = 1, nlay_s … … 752 774 sxice = 0._wp ; syice = 0._wp ; sxxice = 0._wp ; syyice = 0._wp ; sxyice = 0._wp ! ice thickness 753 775 sxsn = 0._wp ; sysn = 0._wp ; sxxsn = 0._wp ; syysn = 0._wp ; sxysn = 0._wp ! snow thickness 754 sxa = 0._wp ; sya = 0._wp ; sxxa = 0._wp ; syya = 0._wp ; sxya = 0._wp ! lead fraction776 sxa = 0._wp ; sya = 0._wp ; sxxa = 0._wp ; syya = 0._wp ; sxya = 0._wp ! ice concentration 755 777 sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity 756 778 sxage = 0._wp ; syage = 0._wp ; sxxage = 0._wp ; syyage = 0._wp ; sxyage = 0._wp ! ice age 757 sxopw = 0._wp ; syopw = 0._wp ; sxxopw = 0._wp ; syyopw = 0._wp ; sxyopw = 0._wp ! open water in sea ice758 779 sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow layers heat content 759 780 sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content … … 786 807 CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn ) 787 808 CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn ) 788 ! ! lead fraction809 ! ! ice concentration 789 810 CALL iom_rstput( iter, nitrst, numriw, 'sxa' , sxa ) 790 811 CALL iom_rstput( iter, nitrst, numriw, 'sya' , sya ) … … 804 825 CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage ) 805 826 CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage ) 806 ! ! open water in sea ice807 CALL iom_rstput( iter, nitrst, numriw, 'sxopw' , sxopw )808 CALL iom_rstput( iter, nitrst, numriw, 'syopw' , syopw )809 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw', sxxopw )810 CALL iom_rstput( iter, nitrst, numriw, 'syyopw', syyopw )811 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw', sxyopw )812 827 ! ! snow layers heat content 813 828 DO jk = 1, nlay_s -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedyn_adv_umx.F90
r10579 r11822 11 11 !! 'key_si3' SI3 sea-ice model 12 12 !!---------------------------------------------------------------------- 13 !! ice_dyn_adv_umx : update the tracer trend with the 3D advection trends using a TVD scheme13 !! ice_dyn_adv_umx : update the tracer fields 14 14 !! ultimate_x(_y) : compute a tracer value at velocity points using ULTIMATE scheme at various orders 15 !! macho : ???16 !! nonosc_ice : compute monotonic tracer fluxes bya non-oscillatory algorithm15 !! macho : compute the fluxes 16 !! nonosc_ice : limit the fluxes using a non-oscillatory algorithm 17 17 !!---------------------------------------------------------------------- 18 18 USE phycst ! physical constant … … 23 23 ! 24 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O manager library 25 26 USE lib_mpp ! MPP library 26 27 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) … … 31 32 32 33 PUBLIC ice_dyn_adv_umx ! called by icedyn_adv.F90 33 34 REAL(wp) :: z1_6 = 1._wp / 6._wp ! =1/6 35 REAL(wp) :: z1_120 = 1._wp / 120._wp ! =1/120 36 37 ! limiter: 1=nonosc_ice, 2=superbee, 3=h3(rachid) 38 INTEGER :: kn_limiter = 1 39 40 ! if T interpolated at u/v points is negative, then interpolate T at u/v points using the upstream scheme 41 ! clem: if set to true, the 2D test case "diagonal advection" does not work (I do not understand why) 42 ! but in realistic cases, it avoids having very negative ice temperature (-50) at low ice concentration 43 LOGICAL :: ll_neg = .TRUE. 44 45 ! alternate directions for upstream 46 LOGICAL :: ll_upsxy = .TRUE. 47 48 ! alternate directions for high order 49 LOGICAL :: ll_hoxy = .TRUE. 50 51 ! prelimiter: use it to avoid overshoot in H 52 ! clem: if set to true, the 2D test case "diagnoal advection" does not work (I do not understand why) 53 LOGICAL :: ll_prelimiter_zalesak = .FALSE. ! from: Zalesak(1979) eq. 14 => better for 1D. Not well defined in 2D 54 55 34 ! 35 INTEGER, PARAMETER :: np_advS = 1 ! advection for S and T: dVS/dt = -div( uVS ) => np_advS = 1 36 ! or dVS/dt = -div( uA * uHS / u ) => np_advS = 2 37 ! or dVS/dt = -div( uV * uS / u ) => np_advS = 3 38 INTEGER, PARAMETER :: np_limiter = 1 ! limiter: 1 = nonosc 39 ! 2 = superbee 40 ! 3 = h3 41 LOGICAL :: ll_upsxy = .TRUE. ! alternate directions for upstream 42 LOGICAL :: ll_hoxy = .TRUE. ! alternate directions for high order 43 LOGICAL :: ll_neg = .TRUE. ! if T interpolated at u/v points is negative or v_i < 1.e-6 44 ! then interpolate T at u/v points using the upstream scheme 45 LOGICAL :: ll_prelim = .FALSE. ! prelimiter from: Zalesak(1979) eq. 14 => not well defined in 2D 46 ! 47 REAL(wp) :: z1_6 = 1._wp / 6._wp ! =1/6 48 REAL(wp) :: z1_120 = 1._wp / 120._wp ! =1/120 49 ! 50 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: imsk_small, jmsk_small 51 ! 56 52 !! * Substitutions 57 53 # include "vectopt_loop_substitute.h90" … … 63 59 CONTAINS 64 60 65 SUBROUTINE ice_dyn_adv_umx( kn_umx, kt, pu_ice, pv_ice, &61 SUBROUTINE ice_dyn_adv_umx( kn_umx, kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, & 66 62 & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 67 63 !!---------------------------------------------------------------------- … … 78 74 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pu_ice ! ice i-velocity 79 75 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pv_ice ! ice j-velocity 76 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: ph_i ! ice thickness 77 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: ph_s ! snw thickness 78 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: ph_ip ! ice pond thickness 80 79 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pato_i ! open water area 81 80 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i ! ice volume … … 84 83 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: poa_i ! age content 85 84 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_i ! ice concentration 86 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond fraction85 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond concentration 87 86 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 88 87 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content … … 92 91 INTEGER :: icycle ! number of sub-timestep for the advection 93 92 REAL(wp) :: zamsk ! 1 if advection of concentration, 0 if advection of other tracers 94 REAL(wp) :: zdt 95 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! send zcflnow and receive zcflprv96 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 93 REAL(wp) :: zdt, zvi_cen 94 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 95 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 97 96 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho 99 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai, z1_aip 100 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhvar 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups 99 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar 100 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 101 ! 102 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 101 103 !!---------------------------------------------------------------------- 102 104 ! 103 105 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' 104 106 ! 105 ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- ! 106 ! When needed, the advection split is applied at the next time-step in order to avoid blocking global comm. 107 ! ...this should not affect too much the stability... Was ok on the tests we did... 107 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 108 DO jl = 1, jpl 109 DO jj = 2, jpjm1 110 DO ji = fs_2, fs_jpim1 111 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 112 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 113 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 114 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 115 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 116 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 117 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 118 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 119 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 120 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 121 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 122 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 123 END DO 124 END DO 125 END DO 126 CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 127 ! 128 ! 129 ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! 130 ! Note: the advection split is applied at the next time-step in order to avoid blocking global comm. 131 ! this should not affect too much the stability 108 132 zcflnow(1) = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 109 133 zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) … … 115 139 ELSE ; icycle = 1 116 140 ENDIF 117 118 141 zdt = rdt_ice / REAL(icycle) 119 142 … … 121 144 zudy(:,:) = pu_ice(:,:) * e2u(:,:) 122 145 zvdx(:,:) = pv_ice(:,:) * e1v(:,:) 123 146 ! 147 ! setup transport for each ice cat 148 DO jl = 1, jpl 149 zu_cat(:,:,jl) = zudy(:,:) 150 zv_cat(:,:,jl) = zvdx(:,:) 151 END DO 152 ! 124 153 ! --- define velocity for advection: u*grad(H) --- ! 125 154 DO jj = 2, jpjm1 … … 153 182 END WHERE 154 183 ! 155 ! set u*a=u for advection of A only 156 DO jl = 1, jpl 157 zua_ho(:,:,jl) = zudy(:,:) 158 zva_ho(:,:,jl) = zvdx(:,:) 159 END DO 160 184 ! setup a mask where advection will be upstream 185 IF( ll_neg ) THEN 186 IF( .NOT. ALLOCATED(imsk_small) ) ALLOCATE( imsk_small(jpi,jpj,jpl) ) 187 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 188 DO jl = 1, jpl 189 DO jj = 1, jpjm1 190 DO ji = 1, jpim1 191 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 192 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 193 ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF 194 zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 195 IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0 196 ELSE ; jmsk_small(ji,jj,jl) = 1 ; ENDIF 197 END DO 198 END DO 199 END DO 200 ENDIF 201 ! 202 ! ----------------------- ! 203 ! ==> start advection <== ! 204 ! ----------------------- ! 205 ! 206 !== Ice area ==! 161 207 zamsk = 1._wp 162 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, pa_i, pa_i, zua_ho, zva_ho ) ! Ice area 163 zamsk = 0._wp 164 ! 165 zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:) 166 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, pv_i ) ! Ice volume 167 ! 168 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 169 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, pv_s ) ! Snw volume 170 ! 171 zhvar(:,:,:) = psv_i(:,:,:) * z1_ai(:,:,:) 172 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, psv_i ) ! Salt content 173 ! 174 zhvar(:,:,:) = poa_i(:,:,:) * z1_ai(:,:,:) 175 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, poa_i ) ! Age content 176 ! 177 DO jk = 1, nlay_i 178 zhvar(:,:,:) = pe_i(:,:,jk,:) * z1_ai(:,:,:) 179 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, pe_i(:,:,jk,:) ) ! Ice heat content 180 END DO 181 ! 182 DO jk = 1, nlay_s 183 zhvar(:,:,:) = pe_s(:,:,jk,:) * z1_ai(:,:,:) 184 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, pe_s(:,:,jk,:) ) ! Snw heat content 185 END DO 186 ! 208 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zu_cat , zv_cat , zcu_box, zcv_box, & 209 & pa_i, pa_i, zua_ups, zva_ups, zua_ho , zva_ho ) 210 ! 211 ! ! --------------------------------- ! 212 IF( np_advS == 1 ) THEN ! -- advection form: -div( uVS ) -- ! 213 ! ! --------------------------------- ! 214 zamsk = 0._wp 215 !== Ice volume ==! 216 zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:) 217 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 218 & zhvar, pv_i, zua_ups, zva_ups ) 219 !== Snw volume ==! 220 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 221 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 222 & zhvar, pv_s, zua_ups, zva_ups ) 223 ! 224 zamsk = 1._wp 225 !== Salt content ==! 226 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 227 & psv_i, psv_i ) 228 !== Ice heat content ==! 229 DO jk = 1, nlay_i 230 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 231 & pe_i(:,:,jk,:), pe_i(:,:,jk,:) ) 232 END DO 233 !== Snw heat content ==! 234 DO jk = 1, nlay_s 235 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 236 & pe_s(:,:,jk,:), pe_s(:,:,jk,:) ) 237 END DO 238 ! 239 ! ! ------------------------------------------ ! 240 ELSEIF( np_advS == 2 ) THEN ! -- advection form: -div( uA * uHS / u ) -- ! 241 ! ! ------------------------------------------ ! 242 zamsk = 0._wp 243 !== Ice volume ==! 244 zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:) 245 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 246 & zhvar, pv_i, zua_ups, zva_ups ) 247 !== Snw volume ==! 248 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 249 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 250 & zhvar, pv_s, zua_ups, zva_ups ) 251 !== Salt content ==! 252 zhvar(:,:,:) = psv_i(:,:,:) * z1_ai(:,:,:) 253 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 254 & zhvar, psv_i, zua_ups, zva_ups ) 255 !== Ice heat content ==! 256 DO jk = 1, nlay_i 257 zhvar(:,:,:) = pe_i(:,:,jk,:) * z1_ai(:,:,:) 258 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho, zva_ho, zcu_box, zcv_box, & 259 & zhvar, pe_i(:,:,jk,:), zua_ups, zva_ups ) 260 END DO 261 !== Snw heat content ==! 262 DO jk = 1, nlay_s 263 zhvar(:,:,:) = pe_s(:,:,jk,:) * z1_ai(:,:,:) 264 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho, zva_ho, zcu_box, zcv_box, & 265 & zhvar, pe_s(:,:,jk,:), zua_ups, zva_ups ) 266 END DO 267 ! 268 ! ! ----------------------------------------- ! 269 ELSEIF( np_advS == 3 ) THEN ! -- advection form: -div( uV * uS / u ) -- ! 270 ! ! ----------------------------------------- ! 271 zamsk = 0._wp 272 ! 273 ALLOCATE( zuv_ho (jpi,jpj,jpl), zvv_ho (jpi,jpj,jpl), & 274 & zuv_ups(jpi,jpj,jpl), zvv_ups(jpi,jpj,jpl), z1_vi(jpi,jpj,jpl), z1_vs(jpi,jpj,jpl) ) 275 ! 276 ! inverse of Vi 277 WHERE( pv_i(:,:,:) >= epsi20 ) ; z1_vi(:,:,:) = 1._wp / pv_i(:,:,:) 278 ELSEWHERE ; z1_vi(:,:,:) = 0. 279 END WHERE 280 ! inverse of Vs 281 WHERE( pv_s(:,:,:) >= epsi20 ) ; z1_vs(:,:,:) = 1._wp / pv_s(:,:,:) 282 ELSEWHERE ; z1_vs(:,:,:) = 0. 283 END WHERE 284 ! 285 ! It is important to first calculate the ice fields and then the snow fields (because we use the same arrays) 286 ! 287 !== Ice volume ==! 288 zuv_ups = zua_ups 289 zvv_ups = zva_ups 290 zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:) 291 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 292 & zhvar, pv_i, zuv_ups, zvv_ups, zuv_ho , zvv_ho ) 293 !== Salt content ==! 294 zhvar(:,:,:) = psv_i(:,:,:) * z1_vi(:,:,:) 295 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zuv_ho , zvv_ho , zcu_box, zcv_box, & 296 & zhvar, psv_i, zuv_ups, zvv_ups ) 297 !== Ice heat content ==! 298 DO jk = 1, nlay_i 299 zhvar(:,:,:) = pe_i(:,:,jk,:) * z1_vi(:,:,:) 300 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, & 301 & zhvar, pe_i(:,:,jk,:), zuv_ups, zvv_ups ) 302 END DO 303 !== Snow volume ==! 304 zuv_ups = zua_ups 305 zvv_ups = zva_ups 306 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 307 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 308 & zhvar, pv_s, zuv_ups, zvv_ups, zuv_ho , zvv_ho ) 309 !== Snw heat content ==! 310 DO jk = 1, nlay_s 311 zhvar(:,:,:) = pe_s(:,:,jk,:) * z1_vs(:,:,:) 312 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zuv_ho, zvv_ho, zcu_box, zcv_box, & 313 & zhvar, pe_s(:,:,jk,:), zuv_ups, zvv_ups ) 314 END DO 315 ! 316 DEALLOCATE( zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs ) 317 ! 318 ENDIF 319 ! 320 !== Ice age ==! 321 zamsk = 1._wp 322 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 323 & poa_i, poa_i ) 324 ! 325 !== melt ponds ==! 187 326 IF ( ln_pnd_H12 ) THEN 188 ! set u*a=u for advection of Ap only 189 DO jl = 1, jpl 190 zua_ho(:,:,jl) = zudy(:,:) 191 zva_ho(:,:,jl) = zvdx(:,:) 192 END DO 193 327 ! concentration 194 328 zamsk = 1._wp 195 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, pa_ip, pa_ip, zua_ho, zva_ho ) ! mp fraction 329 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat , zv_cat , zcu_box, zcv_box, & 330 & pa_ip, pa_ip, zua_ups, zva_ups, zua_ho , zva_ho ) 331 ! volume 196 332 zamsk = 0._wp 197 !198 333 zhvar(:,:,:) = pv_ip(:,:,:) * z1_aip(:,:,:) 199 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, pv_ip ) ! mp volume 334 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 335 & zhvar, pv_ip, zua_ups, zva_ups ) 200 336 ENDIF 201 337 ! 338 !== Open water area ==! 202 339 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 203 340 DO jj = 2, jpjm1 204 341 DO ji = fs_2, fs_jpim1 205 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & ! Open water area342 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 206 343 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 207 344 END DO 208 345 END DO 209 CALL lbc_lnk( 'icedyn_adv_umx', pato_i(:,:), 'T', 1. ) 210 ! 346 CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1. ) 347 ! 348 ! 349 ! --- Ensure non-negative fields and in-bound thicknesses --- ! 350 ! Remove negative values (conservation is ensured) 351 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 352 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 353 ! 354 ! Make sure ice thickness is not too big 355 ! (because ice thickness can be too large where ice concentration is very small) 356 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 357 211 358 END DO 212 359 ! … … 214 361 215 362 216 SUBROUTINE adv_umx( pamsk, kn_umx, jt, kt, pdt, pu, pv, puc, pvc, pubox, pvbox, pt, ptc, pua_ho, pva_ho ) 363 SUBROUTINE adv_umx( pamsk, kn_umx, jt, kt, pdt, pu, pv, puc, pvc, pubox, pvbox, & 364 & pt, ptc, pua_ups, pva_ups, pua_ho, pva_ho ) 217 365 !!---------------------------------------------------------------------- 218 366 !! *** ROUTINE adv_umx *** … … 221 369 !! tracers and add it to the general trend of tracer equations 222 370 !! 223 !! ** Method : - calculate upstream fluxes and upstream solution for tracer H371 !! ** Method : - calculate upstream fluxes and upstream solution for tracers V/A(=H) etc 224 372 !! - calculate tracer H at u and v points (Ultimate) 225 !! - calculate the high order fluxes using alterning directions (Macho ?)373 !! - calculate the high order fluxes using alterning directions (Macho) 226 374 !! - apply a limiter on the fluxes (nonosc_ice) 227 !! - convert this tracer flux to a tracer content flux (uH -> uV) 228 !! - calculate the high order solution for tracer content V 375 !! - convert this tracer flux to a "volume" flux (uH -> uV) 376 !! - apply a limiter a second time on the volumes fluxes (nonosc_ice) 377 !! - calculate the high order solution for V 229 378 !! 230 !! ** Action : solve 2 equations => a) da/dt = -div(ua) 231 !! b) dV/dt = -div(uV) using dH/dt = -u.grad(H) 232 !! in eq. b), - fluxes uH are evaluated (with UMx) and limited (with nonosc_ice). This step is necessary to get a good H. 233 !! - then we convert this flux to a "volume" flux this way => uH*ua/u 234 !! where ua is the flux from eq. a) 235 !! - at last we estimate dV/dt = -div(uH*ua/u) 379 !! ** Action : solve 3 equations => a) dA/dt = -div(uA) 380 !! b) dV/dt = -div(uV) using dH/dt = -u.grad(H) 381 !! c) dVS/dt = -div(uVS) using either dHS/dt = -u.grad(HS) or dS/dt = -u.grad(S) 236 382 !! 237 !! ** Note : - this method can lead to small negative V (since we only limit H) => corrected in icedyn_adv.F90 conserving mass etc. 238 !! - negative tracers at u-v points can also occur from the Ultimate scheme (usually at the ice edge) and the solution for now 239 !! is to apply an upstream scheme when it occurs. A better solution would be to degrade the order of 240 !! the scheme automatically by applying a mask of the ice cover inside Ultimate (not done). 383 !! in eq. b), - fluxes uH are evaluated (with UMx) and limited with nonosc_ice. This step is necessary to get a good H. 384 !! - then we convert this flux to a "volume" flux this way => uH * uA / u 385 !! where uA is the flux from eq. a) 386 !! this "volume" flux is also limited with nonosc_ice (otherwise overshoots can occur) 387 !! - at last we estimate dV/dt = -div(uH * uA / u) 388 !! 389 !! in eq. c), one can solve the equation for S (ln_advS=T), then dVS/dt = -div(uV * uS / u) 390 !! or for HS (ln_advS=F), then dVS/dt = -div(uA * uHS / u) 391 !! 392 !! ** Note : - this method can lead to tiny negative V (-1.e-20) => set it to 0 while conserving mass etc. 393 !! - At the ice edge, Ultimate scheme can lead to: 394 !! 1) negative interpolated tracers at u-v points 395 !! 2) non-zero interpolated tracers at u-v points eventhough there is no ice and velocity is outward 396 !! Solution for 1): apply an upstream scheme when it occurs. A better solution would be to degrade the order of 397 !! the scheme automatically by applying a mask of the ice cover inside Ultimate (not done). 398 !! Solution for 2): we set it to 0 in this case 241 399 !! - Eventhough 1D tests give very good results (typically the one from Schar & Smolarkiewiecz), the 2D is less good. 242 400 !! Large values of H can appear for very small ice concentration, and when it does it messes the things up since we 243 !! work on H (and not V). It probably comes from the prelimiter of zalesak which is coded for 1D and not 2D.401 !! work on H (and not V). It is partly related to the multi-category approach 244 402 !! Therefore, after advection we limit the thickness to the largest value of the 9-points around (only if ice 245 !! concentration is small). 246 !! To-do: expand the prelimiter from zalesak to make it work in 2D 247 !!---------------------------------------------------------------------- 248 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) 249 INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2) 250 INTEGER , INTENT(in ) :: jt ! number of sub-iteration 251 INTEGER , INTENT(in ) :: kt ! number of iteration 252 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 253 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu , pv ! 2 ice velocity components => u*e2 254 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: puc , pvc ! 2 ice velocity components => u*e2 or u*a*e2u 255 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pubox, pvbox ! upstream velocity 256 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt ! tracer field 257 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: ptc ! tracer content field 258 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out), OPTIONAL :: pua_ho, pva_ho ! high order u*a fluxes 403 !! concentration is small). Since we do not limit S and T, large values can occur at the edge but it does not really matter 404 !! since sv_i and e_i are still good. 405 !!---------------------------------------------------------------------- 406 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) 407 INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2) 408 INTEGER , INTENT(in ) :: jt ! number of sub-iteration 409 INTEGER , INTENT(in ) :: kt ! number of iteration 410 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 411 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu , pv ! 2 ice velocity components => u*e2 412 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: puc , pvc ! 2 ice velocity components => u*e2 or u*a*e2u 413 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pubox, pvbox ! upstream velocity 414 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt ! tracer field 415 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: ptc ! tracer content field 416 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(inout), OPTIONAL :: pua_ups, pva_ups ! upstream u*a fluxes 417 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out), OPTIONAL :: pua_ho, pva_ho ! high order u*a fluxes 259 418 ! 260 419 INTEGER :: ji, jj, jl ! dummy loop indices … … 289 448 DO jj = 1, jpjm1 290 449 DO ji = 1, fs_jpim1 291 IF( ABS( pu c(ji,jj,jl) ) > 0._wp .AND. ABS( pu(ji,jj) ) > 0._wp) THEN292 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj)293 zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pu c(ji,jj,jl) / pu(ji,jj)450 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 451 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj) 452 zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj) 294 453 ELSE 295 454 zfu_ho (ji,jj,jl) = 0._wp … … 297 456 ENDIF 298 457 ! 299 IF( ABS( pv c(ji,jj,jl) ) > 0._wp .AND. ABS( pv(ji,jj) ) > 0._wp) THEN300 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj)301 zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pv c(ji,jj,jl) / pv(ji,jj)458 IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 459 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj) 460 zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 302 461 ELSE 303 462 zfv_ho (ji,jj,jl) = 0._wp … … 307 466 END DO 308 467 END DO 468 469 ! the new "volume" fluxes must also be "flux corrected" 470 ! thus we calculate the upstream solution and apply a limiter again 471 DO jl = 1, jpl 472 DO jj = 2, jpjm1 473 DO ji = fs_2, fs_jpim1 474 ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 475 ! 476 zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 477 END DO 478 END DO 479 END DO 480 CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1. ) 481 ! 482 IF ( np_limiter == 1 ) THEN 483 CALL nonosc_ice( 1._wp, pdt, pu, pv, ptc, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho ) 484 ELSEIF( np_limiter == 2 .OR. np_limiter == 3 ) THEN 485 CALL limiter_x( pdt, pu, ptc, zfu_ups, zfu_ho ) 486 CALL limiter_y( pdt, pv, ptc, zfv_ups, zfv_ho ) 487 ENDIF 488 ! 309 489 ENDIF 310 ! --ho 311 ! in case of advection of A: output u*a 312 ! ------------------------------------- 490 ! --ho --ups 491 ! in case of advection of A: output u*a and u*a 492 ! ----------------------------------------------- 313 493 IF( PRESENT( pua_ho ) ) THEN 314 494 DO jl = 1, jpl 315 495 DO jj = 1, jpjm1 316 496 DO ji = 1, fs_jpim1 317 pua_ho (ji,jj,jl) = zfu_ho(ji,jj,jl)318 p va_ho(ji,jj,jl) = zfv_ho(ji,jj,jl)319 497 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 498 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 499 END DO 320 500 END DO 321 501 END DO … … 485 665 END DO 486 666 ! 487 IF ( kn_limiter == 1 ) THEN667 IF ( np_limiter == 1 ) THEN 488 668 CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 489 ELSEIF( kn_limiter == 2 .OR. kn_limiter == 3 ) THEN669 ELSEIF( np_limiter == 2 .OR. np_limiter == 3 ) THEN 490 670 CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 491 671 CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) … … 503 683 END DO 504 684 END DO 505 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )685 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 506 686 507 687 DO jl = 1, jpl !-- first guess of tracer from u-flux … … 524 704 END DO 525 705 END DO 526 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )706 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 527 707 528 708 ELSE !== even ice time step: adv_y then adv_x ==! … … 535 715 END DO 536 716 END DO 537 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )717 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 538 718 ! 539 719 DO jl = 1, jpl !-- first guess of tracer from v-flux … … 556 736 END DO 557 737 END DO 558 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )738 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 559 739 560 740 ENDIF 561 IF( kn_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )741 IF( np_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 562 742 563 743 ENDIF … … 595 775 ! 596 776 ! !-- ultimate interpolation of pt at u-point --! 597 CALL ultimate_x( kn_umx, pdt, pt, pu, zt_u, pfu_ho )777 CALL ultimate_x( pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho ) 598 778 ! !-- limiter in x --! 599 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )779 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 600 780 ! !-- advective form update in zpt --! 601 781 DO jl = 1, jpl … … 605 785 & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) & 606 786 & * pamsk & 607 & ) * pdt ) * tmask(ji,jj,1) 787 & ) * pdt ) * tmask(ji,jj,1) 608 788 END DO 609 789 END DO … … 613 793 ! !-- ultimate interpolation of pt at v-point --! 614 794 IF( ll_hoxy ) THEN 615 CALL ultimate_y( kn_umx, pdt, zpt, pv, zt_v, pfv_ho )795 CALL ultimate_y( pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho ) 616 796 ELSE 617 CALL ultimate_y( kn_umx, pdt, pt , pv, zt_v, pfv_ho )797 CALL ultimate_y( pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho ) 618 798 ENDIF 619 799 ! !-- limiter in y --! 620 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )800 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 621 801 ! 622 802 ! … … 624 804 ! 625 805 ! !-- ultimate interpolation of pt at v-point --! 626 CALL ultimate_y( kn_umx, pdt, pt, pv, zt_v, pfv_ho )806 CALL ultimate_y( pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho ) 627 807 ! !-- limiter in y --! 628 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )808 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 629 809 ! !-- advective form update in zpt --! 630 810 DO jl = 1, jpl … … 642 822 ! !-- ultimate interpolation of pt at u-point --! 643 823 IF( ll_hoxy ) THEN 644 CALL ultimate_x( kn_umx, pdt, zpt, pu, zt_u, pfu_ho )824 CALL ultimate_x( pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho ) 645 825 ELSE 646 CALL ultimate_x( kn_umx, pdt, pt , pu, zt_u, pfu_ho )826 CALL ultimate_x( pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho ) 647 827 ENDIF 648 828 ! !-- limiter in x --! 649 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )829 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 650 830 ! 651 831 ENDIF 652 832 653 IF( kn_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )833 IF( np_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 654 834 ! 655 835 END SUBROUTINE macho 656 836 657 837 658 SUBROUTINE ultimate_x( kn_umx, pdt, pt, pu, pt_u, pfu_ho )838 SUBROUTINE ultimate_x( pamsk, kn_umx, pdt, pt, pu, pt_u, pfu_ho ) 659 839 !!--------------------------------------------------------------------- 660 840 !! *** ROUTINE ultimate_x *** … … 666 846 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 667 847 !!---------------------------------------------------------------------- 848 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) 668 849 INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2) 669 850 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step … … 792 973 DO jj = 1, jpjm1 793 974 DO ji = 1, fs_jpim1 794 IF( pt_u(ji,jj,jl) < 0._wp ) THEN975 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 795 976 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 796 977 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) … … 812 993 813 994 814 SUBROUTINE ultimate_y( kn_umx, pdt, pt, pv, pt_v, pfv_ho )995 SUBROUTINE ultimate_y( pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 815 996 !!--------------------------------------------------------------------- 816 997 !! *** ROUTINE ultimate_y *** … … 822 1003 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 823 1004 !!---------------------------------------------------------------------- 1005 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) 824 1006 INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2) 825 1007 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step … … 945 1127 DO jj = 1, jpjm1 946 1128 DO ji = 1, fs_jpim1 947 IF( pt_v(ji,jj,jl) < 0._wp ) THEN1129 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 948 1130 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & 949 1131 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) … … 1009 1191 ! | | | | * 1010 1192 ! t_ups : i-1 i i+1 i+2 1011 IF( ll_prelim iter_zalesak) THEN1193 IF( ll_prelim ) THEN 1012 1194 1013 1195 DO jl = 1, jpl … … 1088 1270 ! 1089 1271 ! ! up & down beta terms 1090 IF( zpos > 0._wp ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 1091 ELSE ; zbetup(ji,jj,jl) = 0._wp ! zbig 1272 ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!) 1273 IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 1274 ELSE ; zbetup(ji,jj,jl) = 0._wp ! zbig 1092 1275 ENDIF 1093 1276 ! 1094 IF( zneg > 0._wp) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt1095 ELSE ; zbetdo(ji,jj,jl) = 0._wp ! zbig1277 IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 1278 ELSE ; zbetdo(ji,jj,jl) = 0._wp ! zbig 1096 1279 ENDIF 1097 1280 ! … … 1135 1318 END DO 1136 1319 1137 ! clem test1138 !! DO jj = 2, jpjm11139 !! DO ji = 2, fs_jpim1 ! vector opt.1140 !! zzt = ( pt(ji,jj,jl) - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) * pdt * r1_e1e2t(ji,jj) &1141 !! & - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) * pdt * r1_e1e2t(ji,jj) &1142 !! & + pt(ji,jj,jl) * pdt * ( pu(ji,jj) - pu(ji-1,jj) ) * r1_e1e2t(ji,jj) * (1.-pamsk) &1143 !! & + pt(ji,jj,jl) * pdt * ( pv(ji,jj) - pv(ji,jj-1) ) * r1_e1e2t(ji,jj) * (1.-pamsk) &1144 !! & ) * tmask(ji,jj,1)1145 !! IF( zzt < -epsi20 ) THEN1146 !! WRITE(numout,*) 'T<0 nonosc_ice',zzt1147 !! ENDIF1148 !! END DO1149 !! END DO1150 1151 1320 END DO 1152 1321 ! … … 1189 1358 Rjp = zslpx(ji+1,jj,jl) 1190 1359 1191 IF( kn_limiter == 3 ) THEN1360 IF( np_limiter == 3 ) THEN 1192 1361 1193 1362 IF( pu(ji,jj) > 0. ) THEN ; Rr = Rjm … … 1205 1374 pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 1206 1375 1207 ELSEIF( kn_limiter == 2 ) THEN1376 ELSEIF( np_limiter == 2 ) THEN 1208 1377 IF( Rj /= 0. ) THEN 1209 1378 IF( pu(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj … … 1284 1453 Rjp = zslpy(ji,jj+1,jl) 1285 1454 1286 IF( kn_limiter == 3 ) THEN1455 IF( np_limiter == 3 ) THEN 1287 1456 1288 1457 IF( pv(ji,jj) > 0. ) THEN ; Rr = Rjm … … 1300 1469 pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 1301 1470 1302 ELSEIF( kn_limiter == 2 ) THEN1471 ELSEIF( np_limiter == 2 ) THEN 1303 1472 1304 1473 IF( Rj /= 0. ) THEN … … 1344 1513 END SUBROUTINE limiter_y 1345 1514 1515 1516 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 1517 !!------------------------------------------------------------------- 1518 !! *** ROUTINE Hbig *** 1519 !! 1520 !! ** Purpose : Thickness correction in case advection scheme creates 1521 !! abnormally tick ice or snow 1522 !! 1523 !! ** Method : 1- check whether ice thickness is larger than the surrounding 9-points 1524 !! (before advection) and reduce it by adapting ice concentration 1525 !! 2- check whether snow thickness is larger than the surrounding 9-points 1526 !! (before advection) and reduce it by sending the excess in the ocean 1527 !! 3- check whether snow load deplets the snow-ice interface below sea level$ 1528 !! and reduce it by sending the excess in the ocean 1529 !! 4- correct pond concentration to avoid a_ip > a_i 1530 !! 1531 !! ** input : Max thickness of the surrounding 9-points 1532 !!------------------------------------------------------------------- 1533 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 1534 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max ! max ice thick from surrounding 9-pts 1535 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip 1536 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 1537 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i 1538 ! 1539 INTEGER :: ji, jj, jk, jl ! dummy loop indices 1540 REAL(wp) :: z1_dt, zhip, zhi, zhs, zvs_excess, zfra 1541 REAL(wp), DIMENSION(jpi,jpj) :: zswitch 1542 !!------------------------------------------------------------------- 1543 ! 1544 z1_dt = 1._wp / pdt 1545 ! 1546 DO jl = 1, jpl 1547 1548 DO jj = 1, jpj 1549 DO ji = 1, jpi 1550 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1551 ! 1552 ! ! -- check h_ip -- ! 1553 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 1554 IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 1555 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 1556 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 1557 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 1558 ENDIF 1559 ENDIF 1560 ! 1561 ! ! -- check h_i -- ! 1562 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 1563 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 1564 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1565 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 1566 ENDIF 1567 ! 1568 ! ! -- check h_s -- ! 1569 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 1570 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 1571 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1572 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 1573 ! 1574 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 1575 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1576 ! 1577 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1578 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 1579 ENDIF 1580 ! 1581 ! ! -- check snow load -- ! 1582 ! if snow load makes snow-ice interface to deplet below the ocean surface => put the snow excess in the ocean 1583 ! this correction is crucial because of the call to routine icecor afterwards which imposes a mini of ice thick. (rn_himin) 1584 ! this imposed mini can artificially make the snow very thick (if concentration decreases drastically) 1585 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 1586 IF( zvs_excess > 0._wp ) THEN 1587 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 1588 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 1589 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1590 ! 1591 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1592 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 1593 ENDIF 1594 1595 ENDIF 1596 END DO 1597 END DO 1598 END DO 1599 ! !-- correct pond concentration to avoid a_ip > a_i 1600 WHERE( pa_ip(:,:,:) > pa_i(:,:,:) ) pa_ip(:,:,:) = pa_i(:,:,:) 1601 ! 1602 ! 1603 END SUBROUTINE Hbig 1604 1346 1605 #else 1347 1606 !!---------------------------------------------------------------------- -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedyn_rdgrft.F90
r10531 r11822 86 86 !! *** ROUTINE ice_dyn_rdgrft_alloc *** 87 87 !!------------------------------------------------------------------- 88 ALLOCATE( closing_net(jpij) , opning(jpij) , closing_gross(jpij),&89 & apartf(jpij,0:jpl) , hrmin(jpij,jpl), hraft(jpij,jpl) , aridge(jpij,jpl),&90 & hrmax (jpij,jpl), hi_hrdg(jpij,jpl) , araft (jpij,jpl),&88 ALLOCATE( closing_net(jpij) , opning(jpij) , closing_gross(jpij) , & 89 & apartf(jpij,0:jpl) , hrmin (jpij,jpl) , hraft(jpij,jpl) , aridge(jpij,jpl), & 90 & hrmax (jpij,jpl) , hi_hrdg(jpij,jpl) , araft(jpij,jpl) , & 91 91 & ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), STAT=ice_dyn_rdgrft_alloc ) 92 92 … … 137 137 REAL(wp) :: zfac ! local scalar 138 138 INTEGER , DIMENSION(jpij) :: iptidx ! compute ridge/raft or not 139 REAL(wp), DIMENSION(jpij) :: zdivu_adv ! divu as implied by transport scheme (1/s)140 139 REAL(wp), DIMENSION(jpij) :: zdivu, zdelt ! 1D divu_i & delta_i 141 140 ! 142 141 INTEGER, PARAMETER :: jp_itermax = 20 143 142 !!------------------------------------------------------------------- 144 ! clem: The redistribution of ice between categories can lead to small negative values (as for the remapping in ice_itd_rem)145 ! likely due to truncation error ( i.e. 1. - 1. /= 0 )146 ! I do not think it should be a concern since small areas and volumes are erased (in ice_var_zapsmall.F90)147 148 143 ! controls 149 144 IF( ln_timing ) CALL timing_start('icedyn_rdgrft') ! timing 150 145 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 146 IF( ln_icediachk ) CALL ice_cons2D (0, 'icedyn_rdgrft', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 151 147 152 148 IF( kt == nit000 ) THEN … … 156 152 ENDIF 157 153 158 CALL ice_var_zapsmall ! Zero out categories with very small areas159 160 154 !-------------------------------- 161 155 ! 0) Identify grid cells with ice 162 156 !-------------------------------- 157 at_i(:,:) = SUM( a_i, dim=3 ) 158 ! 163 159 npti = 0 ; nptidx(:) = 0 164 160 ipti = 0 ; iptidx(:) = 0 165 161 DO jj = 1, jpj 166 162 DO ji = 1, jpi 167 IF ( at_i(ji,jj) > 0._wp) THEN163 IF ( at_i(ji,jj) > epsi10 ) THEN 168 164 npti = npti + 1 169 165 nptidx( npti ) = (jj - 1) * jpi + ji … … 178 174 179 175 ! just needed here 180 CALL tab_2d_1d( npti, nptidx(1:npti), zdivu(1:npti), divu_i(:,:) ) 181 CALL tab_2d_1d( npti, nptidx(1:npti), zdelt(1:npti), delta_i(:,:) ) 176 CALL tab_2d_1d( npti, nptidx(1:npti), zdelt (1:npti) , delta_i ) 182 177 ! needed here and in the iteration loop 183 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i(:,:,:) ) 184 CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i(:,:,:) ) 185 CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti) , ato_i(:,:) ) 178 CALL tab_2d_1d( npti, nptidx(1:npti), zdivu (1:npti) , divu_i) ! zdivu is used as a work array here (no change in divu_i) 179 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) 180 CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i ) 181 CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti) , ato_i ) 186 182 187 183 DO ji = 1, npti … … 190 186 closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 191 187 ! 192 ! divergence given by the advection scheme 193 ! (which may not be equal to divu as computed from the velocity field) 194 IF ( ln_adv_Pra ) THEN 195 zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_rdtice 196 ELSEIF( ln_adv_UMx ) THEN 197 zdivu_adv(ji) = zdivu(ji) 198 ENDIF 199 ! 200 IF( zdivu_adv(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) ) ! make sure the closing rate is large enough 201 ! ! to give asum = 1.0 after ridging 188 IF( zdivu(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) ) ! make sure the closing rate is large enough 189 ! ! to give asum = 1.0 after ridging 202 190 ! Opening rate (non-negative) that will give asum = 1.0 after ridging. 203 opning(ji) = closing_net(ji) + zdivu _adv(ji)191 opning(ji) = closing_net(ji) + zdivu(ji) 204 192 END DO 205 193 ! … … 218 206 ato_i_1d (ipti) = ato_i_1d (ji) 219 207 closing_net(ipti) = closing_net(ji) 220 zdivu _adv (ipti) = zdivu_adv(ji)208 zdivu (ipti) = zdivu (ji) 221 209 opning (ipti) = opning (ji) 222 210 ENDIF … … 262 250 ELSE 263 251 iterate_ridging = 1 264 zdivu _adv(ji) = zfac * r1_rdtice265 closing_net(ji) = MAX( 0._wp, -zdivu _adv(ji) )266 opning (ji) = MAX( 0._wp, zdivu _adv(ji) )252 zdivu (ji) = zfac * r1_rdtice 253 closing_net(ji) = MAX( 0._wp, -zdivu(ji) ) 254 opning (ji) = MAX( 0._wp, zdivu(ji) ) 267 255 ENDIF 268 256 END DO … … 280 268 281 269 ! controls 270 IF( ln_ctl ) CALL ice_prt3D ('icedyn_rdgrft') ! prints 271 IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt,-1, ' - ice dyn rdgrft - ') ! prints 282 272 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 283 IF( ln_ ctl ) CALL ice_prt3D ('icedyn_rdgrft') ! prints273 IF( ln_icediachk ) CALL ice_cons2D (1, 'icedyn_rdgrft', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 284 274 IF( ln_timing ) CALL timing_stop ('icedyn_rdgrft') ! timing 285 275 ! … … 310 300 311 301 ! ! Ice thickness needed for rafting 312 WHERE( pa_i(1:npti,:) > 0._wp) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:)313 ELSEWHERE ; zhi(1:npti,:) = 0._wp302 WHERE( pa_i(1:npti,:) > epsi10 ) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 303 ELSEWHERE ; zhi(1:npti,:) = 0._wp 314 304 END WHERE 315 305 … … 329 319 zasum(1:npti) = pato_i(1:npti) + SUM( pa_i(1:npti,:), dim=2 ) 330 320 ! 331 WHERE( zasum(1:npti) > 0._wp) ; z1_asum(1:npti) = 1._wp / zasum(1:npti)332 ELSEWHERE ; z1_asum(1:npti) = 0._wp321 WHERE( zasum(1:npti) > epsi10 ) ; z1_asum(1:npti) = 1._wp / zasum(1:npti) 322 ELSEWHERE ; z1_asum(1:npti) = 0._wp 333 323 END WHERE 334 324 ! … … 455 445 ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate. 456 446 ! NOTE: 0 < aksum <= 1 457 WHERE( zaksum(1:npti) > 0._wp) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)458 ELSEWHERE ; closing_gross(1:npti) = 0._wp447 WHERE( zaksum(1:npti) > epsi10 ) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti) 448 ELSEWHERE ; closing_gross(1:npti) = 0._wp 459 449 END WHERE 460 450 … … 466 456 DO ji = 1, npti 467 457 zfac = apartf(ji,jl) * closing_gross(ji) * rdt_ice 468 IF( zfac > pa_i(ji,jl) ) THEN458 IF( zfac > pa_i(ji,jl) .AND. apartf(ji,jl) /= 0._wp ) THEN 469 459 closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_rdtice 470 460 ENDIF … … 510 500 REAL(wp), DIMENSION(jpij) :: zswitch, fvol ! new ridge volume going to jl2 511 501 REAL(wp), DIMENSION(jpij) :: z1_ai ! 1 / a 502 REAL(wp), DIMENSION(jpij) :: zvti ! sum(v_i) 512 503 ! 513 504 REAL(wp), DIMENSION(jpij,nlay_s) :: esrft ! snow energy of rafting ice … … 518 509 INTEGER , DIMENSION(jpij) :: itest_rdg, itest_rft ! test for conservation 519 510 !!------------------------------------------------------------------- 520 511 ! 512 zvti(1:npti) = SUM( v_i_2d(1:npti,:), dim=2 ) ! total ice volume 513 ! 521 514 ! 1) Change in open water area due to closing and opening 522 515 !-------------------------------------------------------- … … 535 528 IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN ! only if ice is ridging 536 529 537 z1_ai(ji) = 1._wp / a_i_2d(ji,jl1) 538 530 IF( a_i_2d(ji,jl1) > epsi10 ) THEN ; z1_ai(ji) = 1._wp / a_i_2d(ji,jl1) 531 ELSE ; z1_ai(ji) = 0._wp 532 ENDIF 533 539 534 ! area of ridging / rafting ice (airdg1) and of new ridge (airdg2) 540 535 airdg1 = aridge(ji,jl1) * closing_gross(ji) * rdt_ice … … 549 544 550 545 ! volume and enthalpy (J/m2, >0) of seawater trapped into ridges 551 vsw = v_i_2d(ji,jl1) * afrdg * rn_porordg 546 IF ( zvti(ji) <= 10. ) THEN ; vsw = v_i_2d(ji,jl1) * afrdg * rn_porordg ! v <= 10m then porosity = rn_porordg 547 ELSEIF( zvti(ji) >= 20. ) THEN ; vsw = 0._wp ! v >= 20m then porosity = 0 548 ELSE ; vsw = v_i_2d(ji,jl1) * afrdg * rn_porordg * MAX( 0._wp, 2._wp - 0.1_wp * zvti(ji) ) ! v > 10m and v < 20m then porosity = linear transition to 0 549 ENDIF 552 550 ersw(ji) = -rhoi * vsw * rcp * sst_1d(ji) ! clem: if sst>0, then ersw <0 (is that possible?) 553 551 554 552 ! volume etc of ridging / rafting ice and new ridges (vi, vs, sm, oi, es, ei) 555 553 virdg1 = v_i_2d (ji,jl1) * afrdg 556 virdg2(ji) = v_i_2d (ji,jl1) * afrdg * ( 1. + rn_porordg )554 virdg2(ji) = v_i_2d (ji,jl1) * afrdg + vsw 557 555 vsrdg(ji) = v_s_2d (ji,jl1) * afrdg 558 556 sirdg1 = sv_i_2d(ji,jl1) * afrdg … … 588 586 ! virtual salt flux to keep salinity constant 589 587 IF( nn_icesal /= 2 ) THEN 590 sirdg2(ji) = sirdg2(ji) - vsw * ( sss_1d(ji) - s_i_1d(ji) ) 588 sirdg2(ji) = sirdg2(ji) - vsw * ( sss_1d(ji) - s_i_1d(ji) ) ! ridge salinity = s_i 591 589 sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_rdtice & ! put back sss_m into the ocean 592 590 & - s_i_1d(ji) * vsw * rhoi * r1_rdtice ! and get s_i from the ocean … … 726 724 END DO ! jl1 727 725 ! 726 ! roundoff errors 727 !---------------- 728 728 ! In case ridging/rafting lead to very small negative values (sometimes it happens) 729 WHERE( a_i_2d(1:npti,:) < 0._wp ) a_i_2d(1:npti,:) = 0._wp 730 WHERE( v_i_2d(1:npti,:) < 0._wp ) v_i_2d(1:npti,:) = 0._wp 729 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, ze_s_2d, ze_i_2d ) 731 730 ! 732 731 END SUBROUTINE rdgrft_shift … … 854 853 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_dyn_1d(1:npti), wfx_snw_dyn(:,:) ) 855 854 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd (:,:) ) 856 855 ! 857 856 ! !---------------------! 858 857 CASE( 2 ) !== from 1D to 2D ==! … … 911 910 REWIND( numnam_ice_ref ) ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 912 911 READ ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 913 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' , lwp)912 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' ) 914 913 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 915 914 READ ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 916 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' , lwp)915 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' ) 917 916 IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 918 917 ! … … 945 944 CALL ctl_stop( 'ice_dyn_rdgrft_init: choose one and only one participation function (ln_partf_lin or ln_partf_exp)' ) 946 945 ENDIF 947 ! ! allocate tke arrays 946 ! 947 IF( .NOT. ln_icethd ) THEN 948 rn_porordg = 0._wp 949 rn_fsnwrdg = 1._wp ; rn_fsnwrft = 1._wp 950 rn_fpndrdg = 1._wp ; rn_fpndrft = 1._wp 951 IF( lwp ) THEN 952 WRITE(numout,*) ' ==> only ice dynamics is activated, thus some parameters must be changed' 953 WRITE(numout,*) ' rn_porordg = ', rn_porordg 954 WRITE(numout,*) ' rn_fsnwrdg = ', rn_fsnwrdg 955 WRITE(numout,*) ' rn_fpndrdg = ', rn_fpndrdg 956 WRITE(numout,*) ' rn_fsnwrft = ', rn_fsnwrft 957 WRITE(numout,*) ' rn_fpndrft = ', rn_fpndrft 958 ENDIF 959 ENDIF 960 ! ! allocate arrays 948 961 IF( ice_dyn_rdgrft_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'ice_dyn_rdgrft_init: unable to allocate arrays' ) 949 962 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedyn_rhg.F90
r11480 r11822 63 63 IF( ln_timing ) CALL timing_start('icedyn_rhg') ! timing 64 64 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 65 IF( ln_icediachk ) CALL ice_cons2D (0, 'icedyn_rhg', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 65 66 ! 66 67 IF( kt == nit000 .AND. lwp ) THEN … … 69 70 WRITE(numout,*)'~~~~~~~~~~~' 70 71 ENDIF 71 72 ! --------73 ! Rheology74 ! --------72 ! 73 !--------------! 74 !== Rheology ==! 75 !--------------! 75 76 SELECT CASE( nice_rhg ) 76 77 ! !------------------------! … … 86 87 ! 87 88 ! controls 89 IF( ln_ctl ) CALL ice_prt3D ('icedyn_rhg') ! prints 88 90 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 89 IF( ln_ ctl ) CALL ice_prt3D ('icedyn_rhg') ! prints91 IF( ln_icediachk ) CALL ice_cons2D (1, 'icedyn_rhg', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 90 92 IF( ln_timing ) CALL timing_stop ('icedyn_rhg') ! timing 91 93 ! … … 112 114 REWIND( numnam_ice_ref ) ! Namelist namdyn_rhg in reference namelist : Ice dynamics 113 115 READ ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901) 114 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist' , lwp)116 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist' ) 115 117 REWIND( numnam_ice_cfg ) ! Namelist namdyn_rhg in configuration namelist : Ice dynamics 116 118 READ ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 ) 117 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist' , lwp)119 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist' ) 118 120 IF(lwm) WRITE ( numoni, namdyn_rhg ) 119 121 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icedyn_rhg_evp.F90
r11480 r11822 113 113 REAL(wp), DIMENSION(:,:), INTENT( out) :: pshear_i , pdivu_i , pdelta_i ! 114 114 !! 115 LOGICAL, PARAMETER :: ll_bdy_substep = .FALSE. ! temporary option to call bdy at each sub-time step (T)116 ! or only at the main time step (F)117 115 INTEGER :: ji, jj ! dummy loop indices 118 116 INTEGER :: jter ! local integers … … 124 122 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV, zvU, zvV ! ice/snow mass and volume 125 123 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 126 REAL(wp) :: zTauO, zTauB, z TauE, zvel! temporary scalars124 REAL(wp) :: zTauO, zTauB, zRHS, zvel ! temporary scalars 127 125 REAL(wp) :: zkt ! isotropic tensile strength for landfast ice 128 126 REAL(wp) :: zvCr ! critical ice volume above which ice is landfast … … 133 131 REAL(wp) :: zshear, zdum1, zdum2 134 132 ! 135 REAL(wp), DIMENSION(jpi,jpj) :: z1_e1t0, z1_e2t0 ! scale factors136 133 REAL(wp), DIMENSION(jpi,jpj) :: zp_delt ! P/delta at T points 137 134 REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017 138 135 ! 139 136 REAL(wp), DIMENSION(jpi,jpj) :: zdt_m ! (dt / ice-snow_mass) on T points 140 REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV! ice fraction on U/V points137 REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV ! ice fraction on U/V points 141 138 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! (ice-snow_mass / dt) on U/V points 142 139 REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points 143 REAL(wp), DIMENSION(jpi,jpj) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points144 REAL(wp), DIMENSION(jpi,jpj) :: zTauU_ib , ztauV_ib ! ice-bottom stress at U-V points (landfast param)145 REAL(wp), DIMENSION(jpi,jpj) :: zspgU , zspgV ! surface pressure gradient at U/V points146 140 REAL(wp), DIMENSION(jpi,jpj) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 147 REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses148 141 ! 149 142 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear … … 153 146 ! ! ocean surface (ssh_m) if ice is not embedded 154 147 ! ! ice bottom surface if ice is embedded 155 REAL(wp), DIMENSION(jpi,jpj) :: zCorx, zCory ! Coriolis stress array 156 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_oi, ztauy_oi ! Ocean-to-ice stress array 157 ! 158 REAL(wp), DIMENSION(jpi,jpj) :: zswitchU, zswitchV ! dummy arrays 159 REAL(wp), DIMENSION(jpi,jpj) :: zmaskU, zmaskV ! mask for ice presence 148 REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses 149 REAL(wp), DIMENSION(jpi,jpj) :: zspgU, zspgV ! surface pressure gradient at U/V points 150 REAL(wp), DIMENSION(jpi,jpj) :: zCorU, zCorV ! Coriolis stress array 151 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_ai, ztauy_ai ! ice-atm. stress at U-V points 152 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_oi, ztauy_oi ! ice-ocean stress at U-V points 153 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_bi, ztauy_bi ! ice-OceanBottom stress at U-V points (landfast) 154 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast) 155 ! 156 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 157 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 160 158 REAL(wp), DIMENSION(jpi,jpj) :: zfmask, zwf ! mask at F points for the ice 161 159 162 160 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 163 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity equals ocean velocity 161 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity becomes very small 162 REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small 164 163 !! --- diags 165 REAL(wp), DIMENSION(jpi,jpj) :: z swi164 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00 166 165 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig1, zsig2, zsig3 167 166 !! --- SIMIP diags 168 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_sig1 ! Average normal stress in sea ice169 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_sig2 ! Maximum shear stress in sea ice170 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_dssh_dx ! X-direction sea-surface tilt term (N/m2)171 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_dssh_dy ! X-direction sea-surface tilt term (N/m2)172 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_corstrx ! X-direction coriolis stress (N/m2)173 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_corstry ! Y-direction coriolis stress (N/m2)174 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_intstrx ! X-direction internal stress (N/m2)175 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_intstry ! Y-direction internal stress (N/m2)176 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_utau_oi ! X-direction ocean-ice stress177 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_vtau_oi ! Y-direction ocean-ice stress178 167 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s) 179 168 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_ymtrp_ice ! Y-component of ice mass transport (kg/s) … … 255 244 CALL ice_strength 256 245 257 ! scale factors258 DO jj = 2, jpjm1259 DO ji = fs_2, fs_jpim1260 z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj ) + e1t(ji,jj ) )261 z1_e2t0(ji,jj) = 1._wp / ( e2t(ji ,jj+1) + e2t(ji,jj ) )262 END DO263 END DO264 265 246 ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 266 IF( ln_landfast_L16 .OR. ln_landfast_home) THEN ; zkt = rn_tensile267 ELSE 247 IF( ln_landfast_L16 ) THEN ; zkt = rn_tensile 248 ELSE ; zkt = 0._wp 268 249 ENDIF 269 250 ! … … 291 272 292 273 ! Ocean currents at U-V points 293 v_oceU(ji,jj) = 0.5_wp * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji+1,jj) & 294 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 295 296 u_oceV(ji,jj) = 0.5_wp * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj+1) & 297 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 274 v_oceU(ji,jj) = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 275 u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 298 276 299 277 ! Coriolis at T points (m*f) … … 308 286 309 287 ! Drag ice-atm. 310 z TauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)311 z TauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)288 ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 289 ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 312 290 313 291 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points … … 316 294 317 295 ! masks 318 zm askU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice319 zm askV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice296 zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 297 zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 320 298 321 299 ! switches 322 zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin 323 zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin 300 IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN ; zmsk01x(ji,jj) = 0._wp 301 ELSE ; zmsk01x(ji,jj) = 1._wp ; ENDIF 302 IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN ; zmsk01y(ji,jj) = 0._wp 303 ELSE ; zmsk01y(ji,jj) = 1._wp ; ENDIF 324 304 325 305 END DO … … 337 317 ! ice-bottom stress at U points 338 318 zvCr = zaU(ji,jj) * rn_depfra * hu(ji,jj,Kmm) 339 z TauU_ib(ji,jj) =rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )319 ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 340 320 ! ice-bottom stress at V points 341 321 zvCr = zaV(ji,jj) * rn_depfra * hv(ji,jj,Kmm) 342 z TauV_ib(ji,jj) =rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )322 ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 343 323 ! ice_bottom stress at T points 344 324 zvCr = at_i(ji,jj) * rn_depfra * ht(ji,jj) 345 tau_icebfr(ji,jj) = rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )325 tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 346 326 END DO 347 327 END DO 348 328 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 349 329 ! 350 ELSE IF( ln_landfast_home ) THEN !-- Home made330 ELSE !-- no landfast 351 331 DO jj = 2, jpjm1 352 332 DO ji = fs_2, fs_jpim1 353 zTauU_ib(ji,jj) = tau_icebfr(ji,jj) 354 zTauV_ib(ji,jj) = tau_icebfr(ji,jj) 355 END DO 356 END DO 357 ! 358 ELSE !-- no landfast 359 DO jj = 2, jpjm1 360 DO ji = fs_2, fs_jpim1 361 zTauU_ib(ji,jj) = 0._wp 362 zTauV_ib(ji,jj) = 0._wp 333 ztaux_base(ji,jj) = 0._wp 334 ztauy_base(ji,jj) = 0._wp 363 335 END DO 364 336 END DO 365 337 ENDIF 366 IF( iom_use('tau_icebfr') ) CALL iom_put( 'tau_icebfr', tau_icebfr(:,:) )367 338 368 339 !------------------------------------------------------------------------------! … … 370 341 !------------------------------------------------------------------------------! 371 342 ! 372 ! ! ----------------------!343 ! ! ==================== ! 373 344 DO jter = 1 , nn_nevp ! loop over jter ! 374 ! ! ----------------------!345 ! ! ==================== ! 375 346 l_full_nf_update = jter == nn_nevp ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 376 347 ! … … 477 448 & ) * r1_e1e2v(ji,jj) 478 449 ! 479 ! !--- u_ice atV point480 u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) &481 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)450 ! !--- ice currents at U-V point 451 v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 452 u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 482 453 ! 483 ! !--- v_ice at U point484 v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) &485 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)486 454 END DO 487 455 END DO … … 502 470 ! !--- tau_bottom/v_ice 503 471 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 504 zTauB = - zTauV_ib(ji,jj) / zvel 472 zTauB = ztauy_base(ji,jj) / zvel 473 ! !--- OceanBottom-to-Ice stress 474 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 505 475 ! 506 476 ! !--- Coriolis at V-points (energy conserving formulation) 507 zCor y(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * &477 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 508 478 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 509 479 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 510 480 ! 511 481 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 512 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 513 ! 514 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 515 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 482 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 483 ! 484 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 485 ! 1 = sliding friction : TauB < RHS 486 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 516 487 ! 517 488 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 518 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )& ! previous velocity519 & + zTauE + zTauO * v_ice(ji,jj)& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)520 & )/ MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast521 &+ ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0522 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin523 & ) * zmaskV(ji,jj)489 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 490 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 491 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 492 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 493 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 494 & ) * zmsk00y(ji,jj) 524 495 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 525 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) &! previous velocity526 & + zTauE + zTauO * v_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)527 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast528 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0529 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin530 & ) * zmaskV(ji,jj)496 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 497 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 498 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 499 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 500 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 501 & ) * zmsk00y(ji,jj) 531 502 ENDIF 532 503 END DO … … 538 509 CALL agrif_interp_ice( 'V' ) 539 510 #endif 540 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'V' )511 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 541 512 ! 542 513 DO jj = 2, jpjm1 … … 550 521 ! !--- tau_bottom/u_ice 551 522 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 552 zTauB = - zTauU_ib(ji,jj) / zvel 523 zTauB = ztaux_base(ji,jj) / zvel 524 ! !--- OceanBottom-to-Ice stress 525 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 553 526 ! 554 527 ! !--- Coriolis at U-points (energy conserving formulation) 555 zCor x(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * &528 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 556 529 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 557 530 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 558 531 ! 559 532 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 560 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 561 ! 562 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 563 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 533 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 534 ! 535 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 536 ! 1 = sliding friction : TauB < RHS 537 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 564 538 ! 565 539 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 566 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )& ! previous velocity567 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)568 & )/ MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast569 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0570 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin571 & ) * zmaskU(ji,jj)540 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 541 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 542 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 543 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 544 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 545 & ) * zmsk00x(ji,jj) 572 546 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 573 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) &! previous velocity574 & + zTauE + zTauO * u_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)575 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast576 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0577 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin578 & ) * zmaskU(ji,jj)547 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 548 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 549 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 550 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 551 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 552 & ) * zmsk00x(ji,jj) 579 553 ENDIF 580 554 END DO … … 586 560 CALL agrif_interp_ice( 'U' ) 587 561 #endif 588 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'U' )562 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 589 563 ! 590 564 ELSE ! odd iterations … … 600 574 ! !--- tau_bottom/u_ice 601 575 zvel = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 602 zTauB = - zTauU_ib(ji,jj) / zvel 576 zTauB = ztaux_base(ji,jj) / zvel 577 ! !--- OceanBottom-to-Ice stress 578 ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 603 579 ! 604 580 ! !--- Coriolis at U-points (energy conserving formulation) 605 zCor x(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * &581 zCorU(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 606 582 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 607 583 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 608 584 ! 609 585 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 610 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 611 ! 612 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 613 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 586 zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 587 ! 588 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 589 ! 1 = sliding friction : TauB < RHS 590 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 614 591 ! 615 592 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 616 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )& ! previous velocity617 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)618 & )/ MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast619 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0620 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin621 & ) * zmaskU(ji,jj)593 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 594 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 595 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 596 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 597 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 598 & ) * zmsk00x(ji,jj) 622 599 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 623 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) &! previous velocity624 & + zTauE + zTauO * u_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)625 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast626 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0627 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin628 & ) * zmaskU(ji,jj)600 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 601 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 602 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 603 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 604 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 605 & ) * zmsk00x(ji,jj) 629 606 ENDIF 630 607 END DO … … 636 613 CALL agrif_interp_ice( 'U' ) 637 614 #endif 638 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'U' )615 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 639 616 ! 640 617 DO jj = 2, jpjm1 … … 648 625 ! !--- tau_bottom/v_ice 649 626 zvel = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 650 zTauB = - zTauV_ib(ji,jj) / zvel 627 zTauB = ztauy_base(ji,jj) / zvel 628 ! !--- OceanBottom-to-Ice stress 629 ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 651 630 ! 652 631 ! !--- Coriolis at v-points (energy conserving formulation) 653 zCor y(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * &632 zCorV(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 654 633 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 655 634 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 656 635 ! 657 636 ! !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 658 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 659 ! 660 ! !--- landfast switch => 0 = static friction ; 1 = sliding friction 661 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 637 zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 638 ! 639 ! !--- landfast switch => 0 = static friction : TauB > RHS & sign(TauB) /= sign(RHS) 640 ! 1 = sliding friction : TauB < RHS 641 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 662 642 ! 663 643 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 664 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )& ! previous velocity665 & + zTauE + zTauO * v_ice(ji,jj)& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)666 & )/ MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast667 &+ ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0668 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin669 & ) * zmaskV(ji,jj)644 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 645 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 646 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 647 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 648 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 649 & ) * zmsk00y(ji,jj) 670 650 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 671 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) &! previous velocity672 & + zTauE + zTauO * v_ice(ji,jj) &! F + tau_ia + Coriolis + spg + tau_io(only ocean part)673 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) &! m/dt + tau_io(only ice part) + landfast674 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) &! static friction => slow decrease to v=0675 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin676 & ) * zmaskV(ji,jj)651 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 652 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 653 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 654 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 655 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 656 & ) * zmsk00y(ji,jj) 677 657 ENDIF 678 658 END DO … … 684 664 CALL agrif_interp_ice( 'V' ) 685 665 #endif 686 IF( ln_bdy .AND. ll_bdy_substep )CALL bdy_ice_dyn( 'V' )666 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 687 667 ! 688 668 ENDIF … … 699 679 END DO ! end loop over jter ! 700 680 ! ! ==================== ! 701 !702 IF( ln_bdy .AND. .NOT.ll_bdy_substep ) THEN703 CALL bdy_ice_dyn( 'U' )704 CALL bdy_ice_dyn( 'V' )705 ENDIF706 681 ! 707 682 !------------------------------------------------------------------------------! … … 762 737 DO jj = 1, jpj 763 738 DO ji = 1, jpi 764 z swi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice739 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 765 740 END DO 766 741 END DO 767 742 743 ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 744 IF( iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 745 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 746 ! 747 CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., & 748 & ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 749 ! 750 CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 751 CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 752 CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 753 CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 754 CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 755 CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 756 ENDIF 757 768 758 ! --- divergence, shear and strength --- ! 769 IF( iom_use('icediv') ) CALL iom_put( "icediv" , pdivu_i (:,:) * zswi(:,:)) ! divergence770 IF( iom_use('iceshe') ) CALL iom_put( "iceshe" , pshear_i(:,:) * zswi(:,:)) ! shear771 IF( iom_use('icestr') ) CALL iom_put( "icestr" , strength(:,:) * zswi(:,:) ) ! Icestrength772 773 ! --- charge ellipse--- !774 IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') ) THEN759 IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * zmsk00 ) ! divergence 760 IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * zmsk00 ) ! shear 761 IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * zmsk00 ) ! strength 762 763 ! --- stress tensor --- ! 764 IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN 775 765 ! 776 766 ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) … … 778 768 DO jj = 2, jpjm1 779 769 DO ji = 2, jpim1 780 zdum1 = ( z swi(ji-1,jj) * pstress12_i(ji-1,jj) + zswi(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point781 & z swi(ji ,jj) * pstress12_i(ji ,jj) + zswi(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) &782 & / MAX( 1._wp, z swi(ji-1,jj) + zswi(ji,jj-1) + zswi(ji,jj) + zswi(ji-1,jj-1) )770 zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point 771 & zmsk00(ji ,jj) * pstress12_i(ji ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) & 772 & / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 783 773 784 774 zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 785 775 786 zdum2 = z swi(ji,jj) / MAX( 1._wp, strength(ji,jj) )776 zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 787 777 788 778 !! zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) … … 797 787 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 798 788 ! 799 IF( iom_use('isig1') ) CALL iom_put( "isig1" , zsig1 ) 800 IF( iom_use('isig2') ) CALL iom_put( "isig2" , zsig2 ) 801 IF( iom_use('isig3') ) CALL iom_put( "isig3" , zsig3 ) 802 ! 789 CALL iom_put( 'isig1' , zsig1 ) 790 CALL iom_put( 'isig2' , zsig2 ) 791 CALL iom_put( 'isig3' , zsig3 ) 792 ! 793 ! Stress tensor invariants (normal and shear stress N/m) 794 IF( iom_use('normstr') ) CALL iom_put( 'normstr' , ( zs1(:,:) + zs2(:,:) ) * zmsk00(:,:) ) ! Normal stress 795 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress 796 803 797 DEALLOCATE( zsig1 , zsig2 , zsig3 ) 804 798 ENDIF 805 799 806 800 ! --- SIMIP --- ! 807 IF ( iom_use( 'normstr' ) .OR. iom_use( 'sheastr' ) .OR. iom_use( 'dssh_dx' ) .OR. iom_use( 'dssh_dy' ) .OR. & 808 & iom_use( 'corstrx' ) .OR. iom_use( 'corstry' ) .OR. iom_use( 'intstrx' ) .OR. iom_use( 'intstry' ) .OR. & 809 & iom_use( 'utau_oi' ) .OR. iom_use( 'vtau_oi' ) .OR. iom_use( 'xmtrpice' ) .OR. iom_use( 'ymtrpice' ) .OR. & 810 & iom_use( 'xmtrpsnw' ) .OR. iom_use( 'ymtrpsnw' ) .OR. iom_use( 'xatrp' ) .OR. iom_use( 'yatrp' ) ) THEN 811 812 ALLOCATE( zdiag_sig1 (jpi,jpj) , zdiag_sig2 (jpi,jpj) , zdiag_dssh_dx (jpi,jpj) , zdiag_dssh_dy (jpi,jpj) , & 813 & zdiag_corstrx (jpi,jpj) , zdiag_corstry (jpi,jpj) , zdiag_intstrx (jpi,jpj) , zdiag_intstry (jpi,jpj) , & 814 & zdiag_utau_oi (jpi,jpj) , zdiag_vtau_oi (jpi,jpj) , zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , & 815 & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp (jpi,jpj) , zdiag_yatrp (jpi,jpj) ) 816 801 IF( iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 802 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 803 ! 804 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1., zspgV, 'V', -1., & 805 & zCorU, 'U', -1., zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1. ) 806 807 CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x) 808 CALL iom_put( 'dssh_dy' , zspgV * zmsk00 ) ! Sea-surface tilt term in force balance (y) 809 CALL iom_put( 'corstrx' , zCorU * zmsk00 ) ! Coriolis force term in force balance (x) 810 CALL iom_put( 'corstry' , zCorV * zmsk00 ) ! Coriolis force term in force balance (y) 811 CALL iom_put( 'intstrx' , zfU * zmsk00 ) ! Internal force term in force balance (x) 812 CALL iom_put( 'intstry' , zfV * zmsk00 ) ! Internal force term in force balance (y) 813 ENDIF 814 815 IF( iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. & 816 & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN 817 ! 818 ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , & 819 & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 820 ! 817 821 DO jj = 2, jpjm1 818 822 DO ji = 2, jpim1 819 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice820 821 ! Stress tensor invariants (normal and shear stress N/m)822 zdiag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * rswitch ! normal stress823 zdiag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * rswitch ! shear stress824 825 ! Stress terms of the momentum equation (N/m2)826 zdiag_dssh_dx(ji,jj) = zspgU(ji,jj) * rswitch ! sea surface slope stress term827 zdiag_dssh_dy(ji,jj) = zspgV(ji,jj) * rswitch828 829 zdiag_corstrx(ji,jj) = zCorx(ji,jj) * rswitch ! Coriolis stress term830 zdiag_corstry(ji,jj) = zCory(ji,jj) * rswitch831 832 zdiag_intstrx(ji,jj) = zfU(ji,jj) * rswitch ! internal stress term833 zdiag_intstry(ji,jj) = zfV(ji,jj) * rswitch834 835 zdiag_utau_oi(ji,jj) = ztaux_oi(ji,jj) * rswitch ! oceanic stress836 zdiag_vtau_oi(ji,jj) = ztauy_oi(ji,jj) * rswitch837 838 823 ! 2D ice mass, snow mass, area transport arrays (X, Y) 839 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * rswitch840 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch841 824 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 825 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 826 842 827 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 843 828 zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) ! '' Y- '' 844 829 845 830 zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 846 831 zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) ! '' Y- '' 847 832 848 833 zdiag_xatrp(ji,jj) = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) ) ! area transport, X-component 849 834 zdiag_yatrp(ji,jj) = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) ) ! '' Y- '' 850 851 END DO 852 END DO 853 854 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_sig1 , 'T', 1., zdiag_sig2 , 'T', 1., & 855 & zdiag_dssh_dx, 'U', -1., zdiag_dssh_dy, 'V', -1., & 856 & zdiag_corstrx, 'U', -1., zdiag_corstry, 'V', -1., & 857 & zdiag_intstrx, 'U', -1., zdiag_intstry, 'V', -1. ) 858 859 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_utau_oi , 'U', -1., zdiag_vtau_oi , 'V', -1., & 860 & zdiag_xmtrp_ice, 'U', -1., zdiag_xmtrp_snw, 'U', -1., & 861 & zdiag_xatrp , 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 862 & zdiag_ymtrp_snw, 'V', -1., zdiag_yatrp , 'V', -1. ) 863 864 IF( iom_use('normstr' ) ) CALL iom_put( 'normstr' , zdiag_sig1(:,:) ) ! Normal stress 865 IF( iom_use('sheastr' ) ) CALL iom_put( 'sheastr' , zdiag_sig2(:,:) ) ! Shear stress 866 IF( iom_use('dssh_dx' ) ) CALL iom_put( 'dssh_dx' , zdiag_dssh_dx(:,:) ) ! Sea-surface tilt term in force balance (x) 867 IF( iom_use('dssh_dy' ) ) CALL iom_put( 'dssh_dy' , zdiag_dssh_dy(:,:) ) ! Sea-surface tilt term in force balance (y) 868 IF( iom_use('corstrx' ) ) CALL iom_put( 'corstrx' , zdiag_corstrx(:,:) ) ! Coriolis force term in force balance (x) 869 IF( iom_use('corstry' ) ) CALL iom_put( 'corstry' , zdiag_corstry(:,:) ) ! Coriolis force term in force balance (y) 870 IF( iom_use('intstrx' ) ) CALL iom_put( 'intstrx' , zdiag_intstrx(:,:) ) ! Internal force term in force balance (x) 871 IF( iom_use('intstry' ) ) CALL iom_put( 'intstry' , zdiag_intstry(:,:) ) ! Internal force term in force balance (y) 872 IF( iom_use('utau_oi' ) ) CALL iom_put( 'utau_oi' , zdiag_utau_oi(:,:) ) ! Ocean stress term in force balance (x) 873 IF( iom_use('vtau_oi' ) ) CALL iom_put( 'vtau_oi' , zdiag_vtau_oi(:,:) ) ! Ocean stress term in force balance (y) 874 IF( iom_use('xmtrpice') ) CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice(:,:) ) ! X-component of sea-ice mass transport (kg/s) 875 IF( iom_use('ymtrpice') ) CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice(:,:) ) ! Y-component of sea-ice mass transport 876 IF( iom_use('xmtrpsnw') ) CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw(:,:) ) ! X-component of snow mass transport (kg/s) 877 IF( iom_use('ymtrpsnw') ) CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw(:,:) ) ! Y-component of snow mass transport 878 IF( iom_use('xatrp' ) ) CALL iom_put( 'xatrp' , zdiag_xatrp(:,:) ) ! X-component of ice area transport 879 IF( iom_use('yatrp' ) ) CALL iom_put( 'yatrp' , zdiag_yatrp(:,:) ) ! Y-component of ice area transport 880 881 DEALLOCATE( zdiag_sig1 , zdiag_sig2 , zdiag_dssh_dx , zdiag_dssh_dy , & 882 & zdiag_corstrx , zdiag_corstry , zdiag_intstrx , zdiag_intstry , & 883 & zdiag_utau_oi , zdiag_vtau_oi , zdiag_xmtrp_ice , zdiag_ymtrp_ice , & 884 & zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp ) 835 836 END DO 837 END DO 838 839 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 840 & zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 841 & zdiag_xatrp , 'U', -1., zdiag_yatrp , 'V', -1. ) 842 843 CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice ) ! X-component of sea-ice mass transport (kg/s) 844 CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice ) ! Y-component of sea-ice mass transport 845 CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw ) ! X-component of snow mass transport (kg/s) 846 CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw ) ! Y-component of snow mass transport 847 CALL iom_put( 'xatrp' , zdiag_xatrp ) ! X-component of ice area transport 848 CALL iom_put( 'yatrp' , zdiag_yatrp ) ! Y-component of ice area transport 849 850 DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , & 851 & zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp ) 885 852 886 853 ENDIF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/iceistate.F90
r10998 r11822 22 22 USE eosbn2 ! equation of state 23 23 USE domvvl ! Variable volume 24 USE ice ! sea-ice variables 25 USE icevar ! ice_var_salprof 24 USE ice ! sea-ice: variables 25 USE ice1D ! sea-ice: thermodynamics variables 26 USE icetab ! sea-ice: 1D <==> 2D transformation 27 USE icevar ! sea-ice: operations 26 28 ! 27 29 USE in_out_manager ! I/O manager … … 36 38 PUBLIC ice_istate ! called by icestp.F90 37 39 PUBLIC ice_istate_init ! called by icestp.F90 38 39 INTEGER , PARAMETER :: jpfldi = 6 ! maximum number of files to read40 INTEGER , PARAMETER :: jp_hti = 1 ! index of ice thickness (m) at T-point41 INTEGER , PARAMETER :: jp_hts = 2 ! index of snow thicknes (m) at T-point42 INTEGER , PARAMETER :: jp_ati = 3 ! index of ice fraction (%) at T-point43 INTEGER , PARAMETER :: jp_tsu = 4 ! index of ice surface temp (K) at T-point44 INTEGER , PARAMETER :: jp_tmi = 5 ! index of ice temp at T-point45 INTEGER , PARAMETER :: jp_smi = 6 ! index of ice sali at T-point46 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read)47 40 ! 48 41 ! !! ** namelist (namini) ** 49 LOGICAL :: ln_iceini ! initialization or not 50 LOGICAL :: ln_iceini_file ! Ice initialization state from 2D netcdf file 51 REAL(wp) :: rn_thres_sst ! threshold water temperature for initial sea ice 52 REAL(wp) :: rn_hts_ini_n ! initial snow thickness in the north 53 REAL(wp) :: rn_hts_ini_s ! initial snow thickness in the south 54 REAL(wp) :: rn_hti_ini_n ! initial ice thickness in the north 55 REAL(wp) :: rn_hti_ini_s ! initial ice thickness in the south 56 REAL(wp) :: rn_ati_ini_n ! initial leads area in the north 57 REAL(wp) :: rn_ati_ini_s ! initial leads area in the south 58 REAL(wp) :: rn_smi_ini_n ! initial salinity 59 REAL(wp) :: rn_smi_ini_s ! initial salinity 60 REAL(wp) :: rn_tmi_ini_n ! initial temperature 61 REAL(wp) :: rn_tmi_ini_s ! initial temperature 62 42 LOGICAL, PUBLIC :: ln_iceini !: Ice initialization or not 43 LOGICAL, PUBLIC :: ln_iceini_file !: Ice initialization from 2D netcdf file 44 REAL(wp) :: rn_thres_sst 45 REAL(wp) :: rn_hti_ini_n, rn_hts_ini_n, rn_ati_ini_n, rn_smi_ini_n, rn_tmi_ini_n, rn_tsu_ini_n, rn_tms_ini_n 46 REAL(wp) :: rn_hti_ini_s, rn_hts_ini_s, rn_ati_ini_s, rn_smi_ini_s, rn_tmi_ini_s, rn_tsu_ini_s, rn_tms_ini_s 47 REAL(wp) :: rn_apd_ini_n, rn_hpd_ini_n 48 REAL(wp) :: rn_apd_ini_s, rn_hpd_ini_s 49 ! 50 ! ! if ln_iceini_file = T 51 INTEGER , PARAMETER :: jpfldi = 9 ! maximum number of files to read 52 INTEGER , PARAMETER :: jp_hti = 1 ! index of ice thickness (m) 53 INTEGER , PARAMETER :: jp_hts = 2 ! index of snw thickness (m) 54 INTEGER , PARAMETER :: jp_ati = 3 ! index of ice fraction (-) 55 INTEGER , PARAMETER :: jp_smi = 4 ! index of ice salinity (g/kg) 56 INTEGER , PARAMETER :: jp_tmi = 5 ! index of ice temperature (K) 57 INTEGER , PARAMETER :: jp_tsu = 6 ! index of ice surface temp (K) 58 INTEGER , PARAMETER :: jp_tms = 7 ! index of snw temperature (K) 59 INTEGER , PARAMETER :: jp_apd = 8 ! index of pnd fraction (-) 60 INTEGER , PARAMETER :: jp_hpd = 9 ! index of pnd depth (m) 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 62 ! 63 63 !!---------------------------------------------------------------------- 64 64 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 68 68 CONTAINS 69 69 70 SUBROUTINE ice_istate( Kbb, Kmm, Kaa )70 SUBROUTINE ice_istate( kt, Kbb, Kmm, Kaa ) 71 71 !!------------------------------------------------------------------- 72 72 !! *** ROUTINE ice_istate *** … … 87 87 !! 88 88 !! ** Notes : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even 89 !! where there is no ice (clem: I do not know why, is it mandatory?)89 !! where there is no ice 90 90 !!-------------------------------------------------------------------- 91 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 91 INTEGER, INTENT(in) :: kt ! time step 92 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 92 93 ! 93 94 INTEGER :: ji, jj, jk, jl ! dummy loop indices 94 INTEGER :: i_hemis, i_fill, jl0 ! local integers 95 REAL(wp) :: ztmelts, zdh 96 REAL(wp) :: zarg, zV, zconv, zdv, zfac 95 REAL(wp) :: ztmelts 97 96 INTEGER , DIMENSION(4) :: itest 98 97 REAL(wp), DIMENSION(jpi,jpj) :: z2d 99 98 REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator 100 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 101 REAL(wp), DIMENSION(jpi,jpj) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 102 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zh_i_ini , za_i_ini !data by cattegories to fill 99 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file 100 REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 101 REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini !data from namelist or nc file 102 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !temporary arrays 103 !! 104 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 103 105 !-------------------------------------------------------------------- 104 106 … … 107 109 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 108 110 109 !-------------------------------------------------------------------- 110 ! 1) Set surface and bottom temperatures to initial values 111 !-------------------------------------------------------------------- 112 ! 113 ! init surface temperature 111 !--------------------------- 112 ! 1) 1st init. of the fields 113 !--------------------------- 114 ! 115 ! basal temperature (considered at freezing point) [Kelvin] 116 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 117 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 118 ! 119 ! surface temperature and conductivity 114 120 DO jl = 1, jpl 115 121 t_su (:,:,jl) = rt0 * tmask(:,:,1) ! temp at the surface … … 117 123 END DO 118 124 ! 119 ! init basal temperature (considered at freezing point) [Kelvin] 120 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 121 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 122 125 ! ice and snw temperatures 126 DO jl = 1, jpl 127 DO jk = 1, nlay_i 128 t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 129 END DO 130 DO jk = 1, nlay_s 131 t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 132 END DO 133 END DO 134 ! 135 ! specific temperatures for coupled runs 136 tn_ice (:,:,:) = t_i (:,:,1,:) 137 t1_ice (:,:,:) = t_i (:,:,1,:) 138 139 ! heat contents 140 e_i (:,:,:,:) = 0._wp 141 e_s (:,:,:,:) = 0._wp 142 143 ! general fields 144 a_i (:,:,:) = 0._wp 145 v_i (:,:,:) = 0._wp 146 v_s (:,:,:) = 0._wp 147 sv_i(:,:,:) = 0._wp 148 oa_i(:,:,:) = 0._wp 149 ! 150 h_i (:,:,:) = 0._wp 151 h_s (:,:,:) = 0._wp 152 s_i (:,:,:) = 0._wp 153 o_i (:,:,:) = 0._wp 154 ! 155 ! melt ponds 156 a_ip (:,:,:) = 0._wp 157 v_ip (:,:,:) = 0._wp 158 a_ip_frac(:,:,:) = 0._wp 159 h_ip (:,:,:) = 0._wp 160 ! 161 ! ice velocities 162 u_ice (:,:) = 0._wp 163 v_ice (:,:) = 0._wp 164 ! 165 !------------------------------------------------------------------------ 166 ! 2) overwrite some of the fields with namelist parameters or netcdf file 167 !------------------------------------------------------------------------ 123 168 IF( ln_iceini ) THEN 124 !-----------------------------------------------------------125 ! 2) Compute or read sea ice variables ===> single category126 !-----------------------------------------------------------127 !128 169 ! !---------------! 129 170 IF( ln_iceini_file )THEN ! Read a file ! 130 171 ! !---------------! 131 ! 132 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 133 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 134 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 135 zts_u_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 136 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 137 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 138 ! 139 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 140 ELSEWHERE ; zswitch(:,:) = 0._wp 172 WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp 173 ELSEWHERE ; zswitch(:,:) = 0._wp 141 174 END WHERE 142 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) 143 ! 175 ! 176 CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 177 ! 178 ! -- mandatory fields -- ! 179 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 180 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 181 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 182 183 ! -- optional fields -- ! 184 ! if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 185 ! 186 ! ice salinity 187 IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 188 & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 189 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 190 ! 191 ! ice temperature 192 IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) & 193 & si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 194 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 195 ! 196 ! surface temperature => set to ice temperature if it exists 197 IF ( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN 198 si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 199 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN 200 si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 201 ENDIF 202 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 203 ! 204 ! snow temperature => set to ice temperature if it exists 205 IF ( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN 206 si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 207 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN 208 si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 209 ENDIF 210 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 211 ! 212 ! pond concentration 213 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 214 & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 215 & * si(jp_ati)%fnow(:,:,1) 216 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 217 ! 218 ! pond depth 219 IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 220 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 221 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 222 ! 223 ! change the switch for the following 224 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 225 ELSEWHERE ; zswitch(:,:) = 0._wp 226 END WHERE 144 227 ! !---------------! 145 228 ELSE ! Read namelist ! 146 229 ! !---------------! 147 ! no ice if sst <= t-freez + ttest230 ! no ice if (sst - Tfreez) >= thresold 148 231 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 149 232 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) … … 155 238 zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 156 239 zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 157 zts_u_ini(:,:) = rn_tmi_ini_n * zswitch(:,:)158 240 zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 159 241 ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 242 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 243 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 244 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 245 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 160 246 ELSEWHERE 161 247 zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 162 248 zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 163 249 zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 164 zts_u_ini(:,:) = rn_tmi_ini_s * zswitch(:,:)165 250 zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 166 251 ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 252 zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 253 ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 254 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 255 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 167 256 END WHERE 168 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) 169 ! 257 ! 258 ENDIF 259 260 ! make sure ponds = 0 if no ponds scheme 261 IF ( .NOT.ln_pnd ) THEN 262 zapnd_ini(:,:) = 0._wp 263 zhpnd_ini(:,:) = 0._wp 170 264 ENDIF 171 265 172 !------------------------------------------------------------------ 173 ! 3) Distribute ice concentration and thickness into the categories 174 !------------------------------------------------------------------ 175 ! a gaussian distribution for ice concentration is used 176 ! then we check whether the distribution fullfills 177 ! volume and area conservation, positivity and ice categories bounds 178 179 IF( jpl == 1 ) THEN 180 ! 181 zh_i_ini(:,:,1) = zht_i_ini(:,:) 182 za_i_ini(:,:,1) = zat_i_ini(:,:) 183 ! 184 ELSE 185 zh_i_ini(:,:,:) = 0._wp 186 za_i_ini(:,:,:) = 0._wp 187 ! 266 !-------------! 267 ! fill fields ! 268 !-------------! 269 ! select ice covered grid points 270 npti = 0 ; nptidx(:) = 0 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 274 npti = npti + 1 275 nptidx(npti) = (jj - 1) * jpi + ji 276 ENDIF 277 END DO 278 END DO 279 280 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 281 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini ) 282 CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini ) 283 CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini ) 284 CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 285 CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 286 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) 287 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini ) 288 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) 289 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 290 291 ! allocate temporary arrays 292 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 293 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 294 295 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 296 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 297 & zhi_2d , zhs_2d , zai_2d , & 298 & 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), & 299 & zti_2d , zts_2d , ztsu_2d , zsi_2d , zaip_2d , zhip_2d ) 300 301 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 302 DO jl = 1, jpl 303 zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 304 zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 305 END DO 306 CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) 307 CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) 308 CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) 309 CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) 310 CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) 311 CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 312 CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) 313 CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) 314 CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) 315 316 ! deallocate temporary arrays 317 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 318 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 319 320 ! calculate extensive and intensive variables 321 CALL ice_var_salprof ! for sz_i 322 DO jl = 1, jpl 188 323 DO jj = 1, jpj 189 324 DO ji = 1, jpi 190 ! 191 IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 192 193 ! find which category (jl0) the input ice thickness falls into 194 jl0 = jpl 195 DO jl = 1, jpl 196 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 197 jl0 = jl 198 CYCLE 199 ENDIF 200 END DO 201 ! 202 itest(:) = 0 203 i_fill = jpl + 1 !------------------------------------ 204 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 205 ! !------------------------------------ 206 i_fill = i_fill - 1 207 ! 208 zh_i_ini(ji,jj,:) = 0._wp 209 za_i_ini(ji,jj,:) = 0._wp 210 itest(:) = 0 211 ! 212 IF ( i_fill == 1 ) THEN !-- case very thin ice: fill only category 1 213 zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 214 za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 215 ELSE !-- case ice is thicker: fill categories >1 216 ! thickness 217 DO jl = 1, i_fill-1 218 zh_i_ini(ji,jj,jl) = hi_mean(jl) 219 END DO 220 ! 221 ! concentration 222 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 223 DO jl = 1, i_fill - 1 224 IF( jl /= jl0 )THEN 225 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 226 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 227 ENDIF 228 END DO 229 230 ! last category 231 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 232 zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 233 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 234 235 ! correction if concentration of upper cat is greater than lower cat 236 ! (it should be a gaussian around jl0 but sometimes it is not) 237 IF ( jl0 /= jpl ) THEN 238 DO jl = jpl, jl0+1, -1 239 IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 240 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 241 zh_i_ini(ji,jj,jl ) = 0._wp 242 za_i_ini(ji,jj,jl ) = 0._wp 243 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1) & 244 & + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 245 END IF 246 ENDDO 247 ENDIF 248 ! 249 ENDIF 250 ! 251 ! Compatibility tests 252 zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) ! Test 1: area conservation 253 IF ( zconv < epsi06 ) itest(1) = 1 254 ! 255 zconv = ABS( zat_i_ini(ji,jj) * zht_i_ini(ji,jj) & ! Test 2: volume conservation 256 & - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 257 IF ( zconv < epsi06 ) itest(2) = 1 258 ! 259 IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 ! Test 3: thickness of the last category is in-bounds ? 260 ! 261 itest(4) = 1 262 DO jl = 1, i_fill 263 IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0 ! Test 4: positivity of ice concentrations 264 END DO 265 ! !---------------------------- 266 END DO ! end iteration on categories 267 ! !---------------------------- 268 IF( lwp .AND. SUM(itest) /= 4 ) THEN 269 WRITE(numout,*) 270 WRITE(numout,*) ' !!!! ALERT itest is not equal to 4 !!! ' 271 WRITE(numout,*) ' !!!! Something is wrong in the SI3 initialization procedure ' 272 WRITE(numout,*) 273 WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 274 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 275 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 276 ENDIF 277 ! 278 ENDIF 279 ! 325 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 326 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 327 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 280 328 END DO 281 329 END DO 282 ENDIF 283 284 !--------------------------------------------------------------------- 285 ! 4) Fill in sea ice arrays 286 !--------------------------------------------------------------------- 287 ! 288 ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 289 DO jl = 1, jpl ! loop over categories 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 a_i(ji,jj,jl) = zswitch(ji,jj) * za_i_ini(ji,jj,jl) ! concentration 293 h_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(ji,jj,jl) ! ice thickness 294 s_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) ! salinity 295 o_i(ji,jj,jl) = 0._wp ! age (0 day) 296 t_su(ji,jj,jl) = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 297 ! 298 IF( zht_i_ini(ji,jj) > 0._wp )THEN 299 h_s(ji,jj,jl)= h_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) ) ! snow depth 300 ELSE 301 h_s(ji,jj,jl)= 0._wp 302 ENDIF 303 ! 304 ! This case below should not be used if (h_s/h_i) is ok in namelist 305 ! In case snow load is in excess that would lead to transformation from snow to ice 306 ! Then, transfer the snow excess into the ice (different from icethd_dh) 307 zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 ) 308 ! recompute h_i, h_s avoiding out of bounds values 309 h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 310 h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi * r1_rhos ) 311 ! 312 ! ice volume, salt content, age content 313 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) ! ice volume 314 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) ! snow volume 315 sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 316 oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl) ! age content 317 END DO 318 END DO 319 END DO 320 ! 321 IF( nn_icesal /= 2 ) THEN ! for constant salinity in time 322 CALL ice_var_salprof 323 sv_i = s_i * v_i 324 ENDIF 325 ! 326 ! Snow temperature and heat content 327 DO jk = 1, nlay_s 328 DO jl = 1, jpl ! loop over categories 330 END DO 331 ! 332 DO jl = 1, jpl 333 DO jk = 1, nlay_s 329 334 DO jj = 1, jpj 330 335 DO ji = 1, jpi 331 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 332 ! Snow energy of melting 333 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 334 ! 335 ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 336 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 336 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 337 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 338 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 337 339 END DO 338 340 END DO … … 340 342 END DO 341 343 ! 342 ! Ice salinity, temperature and heat content 343 DO jk = 1, nlay_i 344 DO jl = 1, jpl ! loop over categories 344 DO jl = 1, jpl 345 DO jk = 1, nlay_i 345 346 DO jj = 1, jpj 346 347 DO ji = 1, jpi 347 t_i (ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 348 sz_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin 349 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 350 ! 351 ! heat content per unit volume 352 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) & 353 & + rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0) , -epsi20 ) ) & 354 & - rcp * ( ztmelts - rt0 ) ) 355 ! 356 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 357 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 348 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 349 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 350 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 351 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 352 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 353 & - rcp * ( ztmelts - rt0 ) ) 358 354 END DO 359 355 END DO 360 356 END DO 361 357 END DO 362 ! 363 tn_ice (:,:,:) = t_su (:,:,:) 364 t1_ice (:,:,:) = t_i (:,:,1,:) ! initialisation of 1st layer temp for coupled simu 365 366 ! Melt pond volume and fraction 367 IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN ; zfac = 1._wp 368 ELSE ; zfac = 0._wp 369 ENDIF 370 DO jl = 1, jpl 371 a_ip_frac(:,:,jl) = rn_apnd * zswitch(:,:) * zfac 372 h_ip (:,:,jl) = rn_hpnd * zswitch(:,:) * zfac 373 END DO 374 a_ip(:,:,:) = a_ip_frac(:,:,:) * a_i (:,:,:) 375 v_ip(:,:,:) = h_ip (:,:,:) * a_ip(:,:,:) 376 ! 377 ELSE ! if ln_iceini=false 378 a_i (:,:,:) = 0._wp 379 v_i (:,:,:) = 0._wp 380 v_s (:,:,:) = 0._wp 381 sv_i (:,:,:) = 0._wp 382 oa_i (:,:,:) = 0._wp 383 h_i (:,:,:) = 0._wp 384 h_s (:,:,:) = 0._wp 385 s_i (:,:,:) = 0._wp 386 o_i (:,:,:) = 0._wp 387 ! 388 e_i(:,:,:,:) = 0._wp 389 e_s(:,:,:,:) = 0._wp 390 ! 391 DO jl = 1, jpl 392 DO jk = 1, nlay_i 393 t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 394 END DO 395 DO jk = 1, nlay_s 396 t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 397 END DO 398 END DO 399 400 tn_ice (:,:,:) = t_i (:,:,1,:) 401 t1_ice (:,:,:) = t_i (:,:,1,:) ! initialisation of 1st layer temp for coupled simu 402 403 a_ip(:,:,:) = 0._wp 404 v_ip(:,:,:) = 0._wp 405 a_ip_frac(:,:,:) = 0._wp 406 h_ip (:,:,:) = 0._wp 358 359 ! Melt ponds 360 WHERE( a_i > epsi10 ) 361 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 362 ELSEWHERE 363 a_ip_frac(:,:,:) = 0._wp 364 END WHERE 365 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 366 367 ! specific temperatures for coupled runs 368 tn_ice(:,:,:) = t_su(:,:,:) 369 t1_ice(:,:,:) = t_i (:,:,1,:) 407 370 ! 408 371 ENDIF ! ln_iceini 409 372 ! 410 at_i (:,:) = 0.0_wp 411 DO jl = 1, jpl 412 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 413 END DO 414 ! 415 ! --- set ice velocities --- ! 416 u_ice (:,:) = 0._wp 417 v_ice (:,:) = 0._wp 418 ! fields needed for ice_dyn_adv_umx 419 l_split_advumx(1) = .FALSE. 373 at_i(:,:) = SUM( a_i, dim=3 ) 420 374 ! 421 375 !---------------------------------------------- 422 ! 5) Snow-ice mass (case ice is fully embedded)376 ! 3) Snow-ice mass (case ice is fully embedded) 423 377 !---------------------------------------------- 424 378 snwice_mass (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3 ) ! snow+ice mass … … 472 426 473 427 !------------------------------------ 474 ! 6) store fields at before time-step428 ! 4) store fields at before time-step 475 429 !------------------------------------ 476 430 ! it is only necessary for the 1st interpolation by Agrif … … 506 460 !! 507 461 !!----------------------------------------------------------------------------- 508 INTEGER :: ji, jj 509 INTEGER :: ios, ierr, inum_ice ! Local integer output status for namelist read 462 INTEGER :: ios ! Local integer output status for namelist read 510 463 INTEGER :: ifpr, ierror 511 464 ! 512 465 CHARACTER(len=256) :: cn_dir ! Root directory for location of ice files 513 TYPE(FLD_N) :: sn_hti, sn_hts, sn_ati, sn_ tsu, sn_tmi, sn_smi466 TYPE(FLD_N) :: sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd 514 467 TYPE(FLD_N), DIMENSION(jpfldi) :: slf_i ! array of namelist informations on the fields to read 515 468 ! 516 NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, & 517 & rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 518 & rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s, & 519 & sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir 469 NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, & 470 & rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 471 & rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 472 & rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 473 & rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 474 & sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, cn_dir 520 475 !!----------------------------------------------------------------------------- 521 476 ! 522 477 REWIND( numnam_ice_ref ) ! Namelist namini in reference namelist : Ice initial state 523 478 READ ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 524 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist' , lwp)479 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namini in reference namelist' ) 525 480 REWIND( numnam_ice_cfg ) ! Namelist namini in configuration namelist : Ice initial state 526 481 READ ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 527 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist' , lwp)482 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namini in configuration namelist' ) 528 483 IF(lwm) WRITE ( numoni, namini ) 529 484 ! 530 485 slf_i(jp_hti) = sn_hti ; slf_i(jp_hts) = sn_hts 531 slf_i(jp_ati) = sn_ati ; slf_i(jp_tsu) = sn_tsu 532 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_smi) = sn_smi 486 slf_i(jp_ati) = sn_ati ; slf_i(jp_smi) = sn_smi 487 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_tsu) = sn_tsu ; slf_i(jp_tms) = sn_tms 488 slf_i(jp_apd) = sn_apd ; slf_i(jp_hpd) = sn_hpd 533 489 ! 534 490 IF(lwp) THEN ! control print … … 537 493 WRITE(numout,*) '~~~~~~~~~~~~~~~' 538 494 WRITE(numout,*) ' Namelist namini:' 539 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_iceini = ', ln_iceini 540 WRITE(numout,*) ' ice initialization from a netcdf file ln_iceini_file = ', ln_iceini_file 541 WRITE(numout,*) ' max delta ocean temp. above Tfreeze with initial ice rn_thres_sst = ', rn_thres_sst 542 WRITE(numout,*) ' initial snow thickness in the north rn_hts_ini_n = ', rn_hts_ini_n 543 WRITE(numout,*) ' initial snow thickness in the south rn_hts_ini_s = ', rn_hts_ini_s 544 WRITE(numout,*) ' initial ice thickness in the north rn_hti_ini_n = ', rn_hti_ini_n 545 WRITE(numout,*) ' initial ice thickness in the south rn_hti_ini_s = ', rn_hti_ini_s 546 WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_n = ', rn_ati_ini_n 547 WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_s = ', rn_ati_ini_s 548 WRITE(numout,*) ' initial ice salinity in the north rn_smi_ini_n = ', rn_smi_ini_n 549 WRITE(numout,*) ' initial ice salinity in the south rn_smi_ini_s = ', rn_smi_ini_s 550 WRITE(numout,*) ' initial ice/snw temp in the north rn_tmi_ini_n = ', rn_tmi_ini_n 551 WRITE(numout,*) ' initial ice/snw temp in the south rn_tmi_ini_s = ', rn_tmi_ini_s 495 WRITE(numout,*) ' ice initialization (T) or not (F) ln_iceini = ', ln_iceini 496 WRITE(numout,*) ' ice initialization from a netcdf file ln_iceini_file = ', ln_iceini_file 497 WRITE(numout,*) ' max ocean temp. above Tfreeze with initial ice rn_thres_sst = ', rn_thres_sst 498 IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 499 WRITE(numout,*) ' initial snw thickness in the north-south rn_hts_ini = ', rn_hts_ini_n,rn_hts_ini_s 500 WRITE(numout,*) ' initial ice thickness in the north-south rn_hti_ini = ', rn_hti_ini_n,rn_hti_ini_s 501 WRITE(numout,*) ' initial ice concentr in the north-south rn_ati_ini = ', rn_ati_ini_n,rn_ati_ini_s 502 WRITE(numout,*) ' initial ice salinity in the north-south rn_smi_ini = ', rn_smi_ini_n,rn_smi_ini_s 503 WRITE(numout,*) ' initial surf temperat in the north-south rn_tsu_ini = ', rn_tsu_ini_n,rn_tsu_ini_s 504 WRITE(numout,*) ' initial ice temperat in the north-south rn_tmi_ini = ', rn_tmi_ini_n,rn_tmi_ini_s 505 WRITE(numout,*) ' initial snw temperat in the north-south rn_tms_ini = ', rn_tms_ini_n,rn_tms_ini_s 506 WRITE(numout,*) ' initial pnd fraction in the north-south rn_apd_ini = ', rn_apd_ini_n,rn_apd_ini_s 507 WRITE(numout,*) ' initial pnd depth in the north-south rn_hpd_ini = ', rn_hpd_ini_n,rn_hpd_ini_s 508 ENDIF 552 509 ENDIF 553 510 ! … … 557 514 ALLOCATE( si(jpfldi), STAT=ierror ) 558 515 IF( ierror > 0 ) THEN 559 CALL ctl_stop( ' Ice_ini in iceistate: unable to allocate si structure' ) ; RETURN516 CALL ctl_stop( 'ice_istate_ini in iceistate: unable to allocate si structure' ) ; RETURN 560 517 ENDIF 561 518 ! 562 519 DO ifpr = 1, jpfldi 563 520 ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) ) 564 ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )521 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) ) 565 522 END DO 566 523 ! 567 524 ! fill si with slf_i and control print 568 CALL fld_fill( si, slf_i, cn_dir, 'ice_istate', 'ice istate ini', 'numnam_ice' ) 569 ! 570 CALL fld_read( nit000, 1, si ) ! input fields provided at the current time-step 571 ! 525 CALL fld_fill( si, slf_i, cn_dir, 'ice_istate_ini', 'initialization of sea ice fields', 'numnam_ice' ) 526 ! 527 ENDIF 528 ! 529 IF( .NOT.ln_pnd ) THEN 530 rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 531 rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 532 CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 572 533 ENDIF 573 534 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/iceitd.F90
r10069 r11822 21 21 USE ice1D ! sea-ice: thermodynamic variables 22 22 USE ice ! sea-ice: variables 23 USE icevar ! sea-ice: operations 23 24 USE icectl ! sea-ice: conservation tests 24 25 USE icetab ! sea-ice: convert 1D<=>2D … … 87 88 88 89 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 90 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 89 91 90 92 !----------------------------------------------------------------------------------------------- 91 93 ! 1) Identify grid cells with ice 92 94 !----------------------------------------------------------------------------------------------- 95 at_i(:,:) = SUM( a_i, dim=3 ) 96 ! 93 97 npti = 0 ; nptidx(:) = 0 94 98 DO jj = 1, jpj … … 207 211 CALL itd_glinear( zhb0(1:npti) , zhb1(1:npti) , h_ib_1d(1:npti) , a_i_1d(1:npti) , & ! in 208 212 & g0 (1:npti,1), g1 (1:npti,1), hL (1:npti,1), hR (1:npti,1) ) ! out 209 213 ! 210 214 ! Area lost due to melting of thin ice 211 215 DO ji = 1, npti … … 214 218 ! 215 219 zdh0 = h_i_1d(ji) - h_ib_1d(ji) 216 IF( zdh0 < 0.0 ) THEN ! remove area from category 1220 IF( zdh0 < 0.0 ) THEN ! remove area from category 1 217 221 zdh0 = MIN( -zdh0, hi_max(1) ) 218 222 !Integrate g(1) from 0 to dh0 to estimate area melted … … 222 226 zx1 = zetamax 223 227 zx2 = 0.5 * zetamax * zetamax 224 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 228 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 ! ice area removed 225 229 zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i 226 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting 227 ! of thin ice (zdamax > 0) 230 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting of thin ice (zdamax > 0) 228 231 ! Remove area, conserving volume 229 232 h_i_1d(ji) = h_i_1d(ji) * a_i_1d(ji) / ( a_i_1d(ji) - zda0 ) … … 249 252 ! --- g(h) for each thickness category --- ! 250 253 CALL itd_glinear( zhbnew(1:npti,jl-1), zhbnew(1:npti,jl), h_i_1d(1:npti) , a_i_1d(1:npti) , & ! in 251 & g0 (1:npti,jl ), g1 (1:npti,jl), hL (1:npti,jl), hR(1:npti,jl) ) ! out254 & g0 (1:npti,jl ), g1 (1:npti,jl), hL (1:npti,jl), hR (1:npti,jl) ) ! out 252 255 ! 253 256 END DO … … 313 316 ! 314 317 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 318 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 315 319 ! 316 320 END SUBROUTINE ice_itd_rem … … 344 348 DO ji = 1, npti 345 349 ! 346 IF( paice(ji) > epsi10 .AND. phice(ji) > 0._wp) THEN350 IF( paice(ji) > epsi10 .AND. phice(ji) > epsi10 ) THEN 347 351 ! 348 352 ! Initialize hL and hR … … 389 393 REAL(wp), DIMENSION(:,:), INTENT(in) :: pdvice ! ice volume transferred across boundary 390 394 ! 391 INTEGER :: ji, j j, jl, jk! dummy loop indices392 INTEGER :: ii, ij, jl2, jl1! local integers395 INTEGER :: ji, jl, jk ! dummy loop indices 396 INTEGER :: jl2, jl1 ! local integers 393 397 REAL(wp) :: ztrans ! ice/snow transferred 394 REAL(wp), DIMENSION(jpij) :: zworka, zworkv ! workspace 395 REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - - 398 REAL(wp), DIMENSION(jpij) :: zworka, zworkv ! workspace 399 REAL(wp), DIMENSION(jpij,jpl) :: zaTsfn ! - - 400 REAL(wp), DIMENSION(jpij,nlay_i,jpl) :: ze_i_2d 401 REAL(wp), DIMENSION(jpij,nlay_s,jpl) :: ze_s_2d 396 402 !!------------------------------------------------------------------ 397 403 … … 405 411 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 406 412 CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 413 DO jl = 1, jpl 414 DO jk = 1, nlay_s 415 CALL tab_2d_1d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) ) 416 END DO 417 DO jk = 1, nlay_i 418 CALL tab_2d_1d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 419 END DO 420 END DO 421 ! to correct roundoff errors on a_i 422 CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti), rn_amax_2d ) 407 423 408 424 !---------------------------------------------------------------------------------------------- … … 435 451 ELSE ; zworka(ji) = 0._wp 436 452 ENDIF 437 !438 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20)439 ! because of truncation error ( i.e. 1. - 1. /= 0 )440 ! I do not think it should be a concern since small areas and volumes are erased (in ice_var_zapsmall.F90)441 453 ! 442 454 a_i_2d(ji,jl1) = a_i_2d(ji,jl1) - pdaice(ji,jl) ! Ice areas … … 476 488 ! 477 489 DO jk = 1, nlay_s !--- Snow heat content 478 !479 490 DO ji = 1, npti 480 ii = MOD( nptidx(ji) - 1, jpi ) + 1481 ij = ( nptidx(ji) - 1 ) / jpi + 1482 491 ! 483 492 jl1 = kdonor(ji,jl) … … 487 496 ELSE ; jl2 = jl 488 497 ENDIF 489 ! 490 ztrans = e_s(ii,ij,jk,jl1) * zworkv(ji) 491 e_s(ii,ij,jk,jl1) = e_s(ii,ij,jk,jl1) - ztrans 492 e_s(ii,ij,jk,jl2) = e_s(ii,ij,jk,jl2) + ztrans 498 ztrans = ze_s_2d(ji,jk,jl1) * zworkv(ji) 499 ze_s_2d(ji,jk,jl1) = ze_s_2d(ji,jk,jl1) - ztrans 500 ze_s_2d(ji,jk,jl2) = ze_s_2d(ji,jk,jl2) + ztrans 493 501 ENDIF 494 502 END DO … … 497 505 DO jk = 1, nlay_i !--- Ice heat content 498 506 DO ji = 1, npti 499 ii = MOD( nptidx(ji) - 1, jpi ) + 1500 ij = ( nptidx(ji) - 1 ) / jpi + 1501 507 ! 502 508 jl1 = kdonor(ji,jl) … … 506 512 ELSE ; jl2 = jl 507 513 ENDIF 508 ! 509 ztrans = e_i(ii,ij,jk,jl1) * zworkv(ji) 510 e_i(ii,ij,jk,jl1) = e_i(ii,ij,jk,jl1) - ztrans 511 e_i(ii,ij,jk,jl2) = e_i(ii,ij,jk,jl2) + ztrans 514 ztrans = ze_i_2d(ji,jk,jl1) * zworkv(ji) 515 ze_i_2d(ji,jk,jl1) = ze_i_2d(ji,jk,jl1) - ztrans 516 ze_i_2d(ji,jk,jl2) = ze_i_2d(ji,jk,jl2) + ztrans 512 517 ENDIF 513 518 END DO … … 515 520 ! 516 521 END DO ! boundaries, 1 to jpl-1 522 523 !------------------- 524 ! 3) roundoff errors 525 !------------------- 526 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 527 ! because of truncation error ( i.e. 1. - 1. /= 0 ) 528 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, ze_s_2d, ze_i_2d ) 529 530 ! at_i must be <= rn_amax 531 zworka(1:npti) = SUM( a_i_2d(1:npti,:), dim=2 ) 532 DO jl = 1, jpl 533 WHERE( zworka(1:npti) > rn_amax_1d(1:npti) ) & 534 & a_i_2d(1:npti,jl) = a_i_2d(1:npti,jl) * rn_amax_1d(1:npti) / zworka(1:npti) 535 END DO 517 536 518 537 !------------------------------------------------------------------------------- 519 ! 3) Update ice thickness and temperature538 ! 4) Update ice thickness and temperature 520 539 !------------------------------------------------------------------------------- 521 540 WHERE( a_i_2d(1:npti,:) >= epsi20 ) … … 536 555 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 537 556 CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 557 DO jl = 1, jpl 558 DO jk = 1, nlay_s 559 CALL tab_1d_2d( npti, nptidx(1:npti), ze_s_2d(1:npti,jk,jl), e_s(:,:,jk,jl) ) 560 END DO 561 DO jk = 1, nlay_i 562 CALL tab_1d_2d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 563 END DO 564 END DO 538 565 ! 539 566 END SUBROUTINE itd_shiftice … … 558 585 ! 559 586 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 587 ! 588 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 589 IF( ln_icediachk ) CALL ice_cons2D (0, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 560 590 ! 561 591 jdonor(:,:) = 0 … … 635 665 END DO 636 666 ! 667 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 668 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 669 ! 637 670 END SUBROUTINE ice_itd_reb 638 671 … … 655 688 REWIND( numnam_ice_ref ) ! Namelist namitd in reference namelist : Parameters for ice 656 689 READ ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 657 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' , lwp)690 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namitd in reference namelist' ) 658 691 REWIND( numnam_ice_cfg ) ! Namelist namitd in configuration namelist : Parameters for ice 659 692 READ ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 660 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' , lwp)693 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namitd in configuration namelist' ) 661 694 IF(lwm) WRITE( numoni, namitd ) 662 695 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icerst.F90
r10425 r11822 14 14 !! ice_rst_read : read restart file 15 15 !!---------------------------------------------------------------------- 16 USE ice ! sea-ice variables16 USE ice ! sea-ice: variables 17 17 USE dom_oce ! ocean domain 18 USE phycst , ONLY : rt0 18 19 USE sbc_oce , ONLY : nn_fsbc, ln_cpl 19 USE icectl 20 USE iceistate ! sea-ice: initial state 21 USE icectl ! sea-ice: control 20 22 ! 21 23 USE in_out_manager ! I/O manager … … 53 55 IF( kt == nit000 ) lrst_ice = .FALSE. ! default definition 54 56 57 IF( ln_rst_list .OR. nn_stock /= -1 ) THEN 55 58 ! in order to get better performances with NetCDF format, we open and define the ice restart file 56 59 ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice 57 60 ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 58 IF( kt == nitrst - 2*nn_fsbc + 1 .OR. n stock == nn_fsbc &61 IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nn_stock == nn_fsbc & 59 62 & .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 60 63 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN … … 81 84 ENDIF 82 85 ENDIF 86 ENDIF 83 87 ! 84 88 IF( ln_icectl ) CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print … … 118 122 119 123 ! Prognostic variables 120 CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i ) 121 CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s ) 122 CALL iom_rstput( iter, nitrst, numriw, 'sv_i', sv_i ) 123 CALL iom_rstput( iter, nitrst, numriw, 'oa_i', oa_i ) 124 CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i ) 125 CALL iom_rstput( iter, nitrst, numriw, 't_su', t_su ) 126 ! Melt ponds 127 CALL iom_rstput( iter, nitrst, numriw, 'a_ip', a_ip ) 128 CALL iom_rstput( iter, nitrst, numriw, 'v_ip', v_ip ) 124 CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i ) 125 CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s ) 126 CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i ) 127 CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i ) 128 CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su ) 129 CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) 130 CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) 131 CALL iom_rstput( iter, nitrst, numriw, 'oa_i' , oa_i ) 132 CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip ) 133 CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip ) 129 134 ! Snow enthalpy 130 135 DO jk = 1, nlay_s … … 141 146 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 142 147 END DO 143 ! ice velocity144 CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) ! u_ice145 CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) ! v_ice146 148 ! fields needed for Met Office (Jules) coupling 147 149 IF( ln_cpl ) THEN … … 161 163 162 164 163 SUBROUTINE ice_rst_read 165 SUBROUTINE ice_rst_read( Kbb, Kmm, Kaa ) 164 166 !!---------------------------------------------------------------------- 165 167 !! *** ice_rst_read *** … … 167 169 !! ** purpose : read restart file 168 170 !!---------------------------------------------------------------------- 171 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 169 172 INTEGER :: jk 170 173 LOGICAL :: llok 171 INTEGER :: id 1! local integer174 INTEGER :: id0, id1, id2, id3, id4 ! local integer 172 175 CHARACTER(len=25) :: znam 173 176 CHARACTER(len=2) :: zchar, zchar1 … … 184 187 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl ) 185 188 186 CALL iom_get( numrir, 'nn_fsbc', zfice ) 187 CALL iom_get( numrir, 'kt_ice' , ziter ) 188 IF(lwp) WRITE(numout,*) ' read ice restart file at time step : ', ziter 189 IF(lwp) WRITE(numout,*) ' in any case we force it to nit000 - 1 : ', nit000 - 1 190 191 ! Control of date 192 IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 ) & 193 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart', & 194 & ' verify the file or rerun with the value 0 for the', & 195 & ' control of time parameter nrstdt' ) 196 IF( NINT(zfice) /= nn_fsbc .AND. ABS( nrstdt ) == 1 ) & 197 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart', & 198 & ' verify the file or rerun with the value 0 for the', & 199 & ' control of time parameter nrstdt' ) 200 201 ! Prognostic variables 202 CALL iom_get( numrir, jpdom_autoglo, 'v_i' , v_i ) 203 CALL iom_get( numrir, jpdom_autoglo, 'v_s' , v_s ) 204 CALL iom_get( numrir, jpdom_autoglo, 'sv_i', sv_i ) 205 CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 206 CALL iom_get( numrir, jpdom_autoglo, 'a_i' , a_i ) 207 CALL iom_get( numrir, jpdom_autoglo, 't_su', t_su ) 208 ! Melt ponds 209 id1 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 210 IF( id1 > 0 ) THEN ! fields exist (melt ponds) 211 CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 212 CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 213 ELSE ! start from rest 214 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it to zero' 215 a_ip(:,:,:) = 0._wp 216 v_ip(:,:,:) = 0._wp 217 ENDIF 218 ! Snow enthalpy 219 DO jk = 1, nlay_s 220 WRITE(zchar1,'(I2.2)') jk 221 znam = 'e_s'//'_l'//zchar1 222 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 223 e_s(:,:,jk,:) = z3d(:,:,:) 224 END DO 225 ! Ice enthalpy 226 DO jk = 1, nlay_i 227 WRITE(zchar1,'(I2.2)') jk 228 znam = 'e_i'//'_l'//zchar1 229 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 230 e_i(:,:,jk,:) = z3d(:,:,:) 231 END DO 232 ! ice velocity 233 CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 234 CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 235 236 CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 237 238 ! fields needed for Met Office (Jules) coupling 239 IF( ln_cpl ) THEN 240 CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 241 CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice ) 189 ! test if v_i exists 190 id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. ) 191 192 ! ! ------------------------------ ! 193 IF( id0 > 0 ) THEN ! == case of a normal restart == ! 194 ! ! ------------------------------ ! 195 196 ! Time info 197 CALL iom_get( numrir, 'nn_fsbc', zfice ) 198 CALL iom_get( numrir, 'kt_ice' , ziter ) 199 IF(lwp) WRITE(numout,*) ' read ice restart file at time step : ', ziter 200 IF(lwp) WRITE(numout,*) ' in any case we force it to nit000 - 1 : ', nit000 - 1 201 202 ! Control of date 203 IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 ) & 204 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart', & 205 & ' verify the file or rerun with the value 0 for the', & 206 & ' control of time parameter nrstdt' ) 207 IF( NINT(zfice) /= nn_fsbc .AND. ABS( nrstdt ) == 1 ) & 208 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart', & 209 & ' verify the file or rerun with the value 0 for the', & 210 & ' control of time parameter nrstdt' ) 211 212 ! --- mandatory fields --- ! 213 CALL iom_get( numrir, jpdom_autoglo, 'v_i' , v_i ) 214 CALL iom_get( numrir, jpdom_autoglo, 'v_s' , v_s ) 215 CALL iom_get( numrir, jpdom_autoglo, 'sv_i' , sv_i ) 216 CALL iom_get( numrir, jpdom_autoglo, 'a_i' , a_i ) 217 CALL iom_get( numrir, jpdom_autoglo, 't_su' , t_su ) 218 CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 219 CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 220 ! Snow enthalpy 221 DO jk = 1, nlay_s 222 WRITE(zchar1,'(I2.2)') jk 223 znam = 'e_s'//'_l'//zchar1 224 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 225 e_s(:,:,jk,:) = z3d(:,:,:) 226 END DO 227 ! Ice enthalpy 228 DO jk = 1, nlay_i 229 WRITE(zchar1,'(I2.2)') jk 230 znam = 'e_i'//'_l'//zchar1 231 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 232 e_i(:,:,jk,:) = z3d(:,:,:) 233 END DO 234 ! -- optional fields -- ! 235 ! ice age 236 id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 237 IF( id1 > 0 ) THEN ! fields exist 238 CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 239 ELSE ! start from rest 240 IF(lwp) WRITE(numout,*) ' ==>> previous run without ice age output then set it to zero' 241 oa_i(:,:,:) = 0._wp 242 ENDIF 243 ! melt ponds 244 id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 245 IF( id2 > 0 ) THEN ! fields exist 246 CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 247 CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 248 ELSE ! start from rest 249 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it to zero' 250 a_ip(:,:,:) = 0._wp 251 v_ip(:,:,:) = 0._wp 252 ENDIF 253 ! fields needed for Met Office (Jules) coupling 254 IF( ln_cpl ) THEN 255 id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 256 id4 = iom_varid( numrir, 't1_ice' , ldstop = .FALSE. ) 257 IF( id3 > 0 .AND. id4 > 0 ) THEN ! fields exist 258 CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 259 CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice ) 260 ELSE ! start from rest 261 IF(lwp) WRITE(numout,*) ' ==>> previous run without conductivity output then set it to zero' 262 cnd_ice(:,:,:) = 0._wp 263 t1_ice (:,:,:) = rt0 264 ENDIF 265 ENDIF 266 267 CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 268 269 ! ! ---------------------------------- ! 270 ELSE ! == case of a simplified restart == ! 271 ! ! ---------------------------------- ! 272 CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 273 ! 274 CALL ice_istate_init 275 CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 276 ! 277 IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 278 & CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 279 ! 242 280 ENDIF 243 281 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icesbc.F90
r10535 r11822 114 114 INTEGER, INTENT(in) :: ksbc ! flux formulation (user defined, bulk or Pure Coupled) 115 115 ! 116 INTEGER :: ji, jj, jl ! dummy loop index 117 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 118 REAL(wp), DIMENSION(jpi,jpj) :: zalb ! 2D workspace 116 INTEGER :: ji, jj, jl ! dummy loop index 117 REAL(wp) :: zmiss_val ! missing value retrieved from xios 118 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 119 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zalb, zmsk00 ! 2D workspace 119 120 !!-------------------------------------------------------------------- 120 121 ! … … 126 127 WRITE(numout,*)'~~~~~~~~~~~~~~~' 127 128 ENDIF 129 130 ! get missing value from xml 131 CALL iom_miss_val( "icetemp", zmiss_val ) 128 132 129 133 ! --- cloud-sky and overcast-sky ice albedos --- ! … … 152 156 153 157 !--- output ice albedo and surface albedo ---! 154 IF( iom_use('icealb') ) THEN 155 WHERE( at_i_b <= epsi06 ) ; zalb(:,:) = rn_alb_oce 156 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 158 IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN 159 160 ALLOCATE( zalb(jpi,jpj), zmsk00(jpi,jpj) ) 161 162 WHERE( at_i_b < 1.e-03 ) 163 zmsk00(:,:) = 0._wp 164 zalb (:,:) = rn_alb_oce 165 ELSEWHERE 166 zmsk00(:,:) = 1._wp 167 zalb (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 157 168 END WHERE 158 CALL iom_put( "icealb" , zalb(:,:) )159 ENDIF160 IF( iom_use('albedo') ) THEN169 ! ice albedo 170 CALL iom_put( 'icealb' , zalb * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) 171 ! ice+ocean albedo 161 172 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) 162 CALL iom_put( "albedo" , zalb(:,:) ) 173 CALL iom_put( 'albedo' , zalb ) 174 175 DEALLOCATE( zalb, zmsk00 ) 176 163 177 ENDIF 164 178 ! … … 272 286 REWIND( numnam_ice_ref ) ! Namelist namsbc in reference namelist : Ice dynamics 273 287 READ ( numnam_ice_ref, namsbc, IOSTAT = ios, ERR = 901) 274 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist' , lwp)288 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist' ) 275 289 REWIND( numnam_ice_cfg ) ! Namelist namsbc in configuration namelist : Ice dynamics 276 290 READ ( numnam_ice_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 277 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' , lwp)291 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' ) 278 292 IF(lwm) WRITE( numoni, namsbc ) 279 293 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icestp.F90
r11480 r11822 190 190 IF( ln_icethd ) CALL ice_thd( kt ) ! -- Ice thermodynamics 191 191 ! 192 IF( ln_icethd )CALL ice_cor( kt , 2 ) ! -- Corrections192 CALL ice_cor( kt , 2 ) ! -- Corrections 193 193 ! 194 194 CALL ice_var_glo2eqv ! necessary calls (at least for coupling) … … 257 257 IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst 258 258 CALL ice_istate_init 259 CALL ice_istate( Kbb, Kmm, Kaa )259 CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 260 260 ELSE ! start from a restart file 261 CALL ice_rst_read 261 CALL ice_rst_read( Kbb, Kmm, Kaa ) 262 262 ENDIF 263 263 CALL ice_var_glo2eqv … … 306 306 REWIND( numnam_ice_ref ) ! Namelist nampar in reference namelist : Parameters for ice 307 307 READ ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901) 308 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist' , lwp)308 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampar in reference namelist' ) 309 309 REWIND( numnam_ice_cfg ) ! Namelist nampar in configuration namelist : Parameters for ice 310 310 READ ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 ) 311 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampar in configuration namelist' , lwp)311 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampar in configuration namelist' ) 312 312 IF(lwm) WRITE( numoni, nampar ) 313 313 ! … … 326 326 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 327 327 ENDIF 328 ! !--- change max ice concentration for roundoff errors 329 rn_amax_n = MIN( rn_amax_n, 1._wp - epsi10 ) 330 rn_amax_s = MIN( rn_amax_s, 1._wp - epsi10 ) 328 331 ! !--- check consistency 329 332 IF ( jpl > 1 .AND. ln_virtual_itd ) THEN … … 425 428 wfx_err_sub(:,:) = 0._wp 426 429 ! 427 afx_tot(:,:) = 0._wp ;428 !429 430 diag_heat(:,:) = 0._wp ; diag_sice(:,:) = 0._wp 430 431 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp … … 434 435 t_si (:,:,:) = rt0 ! temp at the ice-snow interface 435 436 436 tau_icebfr(:,:) = 0._wp ! landfast ice param only (clem: important to keep the init here) 437 cnd_ice (:,:,:) = 0._wp ! initialisation: effective conductivity at the top of ice/snow (ln_cndflx=T) 438 qtr_ice_bot(:,:,:) = 0._wp ! initialization: part of solar radiation transmitted through the ice needed at least for outputs 437 tau_icebfr (:,:) = 0._wp ! landfast ice param only (clem: important to keep the init here) 438 cnd_ice (:,:,:) = 0._wp ! initialisation: effective conductivity at the top of ice/snow (ln_cndflx=T) 439 qcn_ice (:,:,:) = 0._wp ! initialisation: conductive flux (ln_cndflx=T & ln_cndemule=T) 440 qtr_ice_bot(:,:,:) = 0._wp ! initialization: part of solar radiation transmitted through the ice needed at least for outputs 441 qsb_ice_bot(:,:) = 0._wp ! (needed if ln_icethd=F) 439 442 ! 440 443 ! for control checks (ln_icediachk) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd.F90
r10534 r11822 95 95 IF( ln_timing ) CALL timing_start('icethd') ! timing 96 96 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 97 IF( ln_icediachk ) CALL ice_cons2D (0, 'icethd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 97 98 98 99 IF( kt == nit000 .AND. lwp ) THEN … … 102 103 ENDIF 103 104 104 CALL ice_var_glo2eqv105 106 105 !---------------------------------------------! 107 106 ! computation of friction velocity at T points … … 162 161 qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 163 162 164 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 165 IF( zqld > 0._wp ) THEN 163 ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting 164 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 165 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 166 166 fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 167 167 qlead(ji,jj) = 0._wp … … 178 178 ! In case we bypass open-water ice formation 179 179 IF( .NOT. ln_icedO ) qlead(:,:) = 0._wp 180 ! In case we bypass growing/melting from top and bottom : we suppose ice is impermeable => ocean is isolated from atmosphere180 ! In case we bypass growing/melting from top and bottom 181 181 IF( .NOT. ln_icedH ) THEN 182 qt_atm_oi (:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)183 182 qsb_ice_bot(:,:) = 0._wp 184 183 fhld (:,:) = 0._wp … … 221 220 dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp 222 221 dh_snowice(1:npti) = 0._wp ; dh_s_mlt(1:npti) = 0._wp 223 ! 224 IF( ln_icedH ) THEN ! --- growing/melting --- ! 225 CALL ice_thd_zdf ! Ice/Snow Temperature profile 226 CALL ice_thd_dh ! Ice/Snow thickness 227 CALL ice_thd_pnd ! Melt ponds formation 228 CALL ice_thd_ent( e_i_1d(1:npti,:) ) ! Ice enthalpy remapping 222 ! 223 CALL ice_thd_zdf ! --- Ice-Snow temperature --- ! 224 ! 225 IF( ln_icedH ) THEN ! --- Growing/Melting --- ! 226 CALL ice_thd_dh ! Ice-Snow thickness 227 CALL ice_thd_pnd ! Melt ponds formation 228 CALL ice_thd_ent( e_i_1d(1:npti,:) ) ! Ice enthalpy remapping 229 229 ENDIF 230 !231 230 CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- ! 232 231 ! 233 CALL ice_thd_temp ! --- temperature update --- !232 CALL ice_thd_temp ! --- Temperature update --- ! 234 233 ! 235 234 IF( ln_icedH .AND. ln_virtual_itd ) & 236 & CALL ice_thd_mono ! --- extra lateral melting if virtual_itd --- !237 ! 238 IF( ln_icedA ) CALL ice_thd_da ! --- lateral melting --- !235 & CALL ice_thd_mono ! --- Extra lateral melting if virtual_itd --- ! 236 ! 237 IF( ln_icedA ) CALL ice_thd_da ! --- Lateral melting --- ! 239 238 ! 240 239 CALL ice_thd_1d2d( jl, 2 ) ! --- Change units of e_i, e_s from J/m3 to J/m2 --- ! 241 240 ! ! --- & Move to 2D arrays --- ! 242 !243 241 ENDIF 244 242 ! 245 243 END DO 246 ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting) 247 oa_i(:,:,:) = o_i(:,:,:) * a_i(:,:,:) 248 244 ! 249 245 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 250 ! 251 CALL ice_var_zapsmall ! --- remove very small ice concentration (<1e-10) --- ! 252 ! ! & make sure at_i=SUM(a_i) & ato_i=1 where at_i=0 246 IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 253 247 ! 254 IF( jpl > 1 ) CALL ice_itd_rem( kt )! --- Transport ice between thickness categories --- !255 ! 256 IF( ln_icedO ) CALL ice_thd_do ! --- frazil ice growingin leads --- !248 IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- ! 249 ! 250 IF( ln_icedO ) CALL ice_thd_do ! --- Frazil ice growth in leads --- ! 257 251 ! 258 252 ! controls … … 418 412 CALL tab_2d_1d( npti, nptidx(1:npti), sst_1d(1:npti), sst_m ) 419 413 CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d(1:npti), sss_m ) 420 414 ! 415 ! to update ice age 416 CALL tab_2d_1d( npti, nptidx(1:npti), o_i_1d (1:npti), o_i (:,:,kl) ) 417 CALL tab_2d_1d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 418 ! 421 419 ! --- Change units of e_i, e_s from J/m2 to J/m3 --- ! 422 420 DO jk = 1, nlay_i … … 443 441 sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 444 442 v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 443 oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 445 444 446 445 CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i ) … … 516 515 CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 517 516 CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 517 CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 518 518 ! 519 519 END SELECT … … 541 541 REWIND( numnam_ice_ref ) ! Namelist namthd in reference namelist : Ice thermodynamics 542 542 READ ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) 543 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist' , lwp)543 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist' ) 544 544 REWIND( numnam_ice_cfg ) ! Namelist namthd in configuration namelist : Ice thermodynamics 545 545 READ ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 ) 546 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist' , lwp)546 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist' ) 547 547 IF(lwm) WRITE( numoni, namthd ) 548 548 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd_da.F90
r10069 r11822 179 179 REWIND( numnam_ice_ref ) ! Namelist namthd_da in reference namelist : Ice thermodynamics 180 180 READ ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901) 181 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist' , lwp)181 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_da in reference namelist' ) 182 182 REWIND( numnam_ice_cfg ) ! Namelist namthd_da in configuration namelist : Ice thermodynamics 183 183 READ ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 ) 184 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist' , lwp)184 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_da in configuration namelist' ) 185 185 IF(lwm) WRITE( numoni, namthd_da ) 186 186 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd_dh.F90
r10534 r11822 614 614 DO jk = 1, nlay_s 615 615 DO ji = 1,npti 616 ! mask enthalpy 617 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp, - h_s_1d(ji) ) ) 616 ! where there is no ice or no snow 617 rswitch = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) ) ) * ( 1._wp - MAX( 0._wp, SIGN(1._wp, - h_i_1d(ji) ) ) ) 618 ! mass & energy loss to the ocean 619 hfx_res_1d(ji) = hfx_res_1d(ji) + ( 1._wp - rswitch ) * & 620 & ( e_s_1d(ji,jk) * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_rdtice ) ! heat flux to the ocean [W.m-2], < 0 621 wfx_res_1d(ji) = wfx_res_1d(ji) + ( 1._wp - rswitch ) * & 622 & ( rhos * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_rdtice ) ! mass flux 623 ! update energy (mass is updated in the next loop) 618 624 e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk) 619 625 ! recalculate t_s_1d from e_s_1d … … 622 628 END DO 623 629 624 ! --- ensure that a_i = 0 where h_i = 0 --- 625 WHERE( h_i_1d(1:npti) == 0._wp ) a_i_1d(1:npti) = 0._wp 630 ! --- ensure that a_i = 0 & h_s = 0 where h_i = 0 --- 631 WHERE( h_i_1d(1:npti) == 0._wp ) 632 a_i_1d(1:npti) = 0._wp 633 h_s_1d(1:npti) = 0._wp 634 END WHERE 626 635 ! 627 636 END SUBROUTINE ice_thd_dh -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd_do.F90
r10425 r11822 113 113 114 114 IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft ) 115 116 CALL ice_var_agg(1) 117 CALL ice_var_glo2eqv 118 115 IF( ln_icediachk ) CALL ice_cons2D ( 0, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft ) 116 117 at_i(:,:) = SUM( a_i, dim=3 ) 119 118 !------------------------------------------------------------------------------! 120 119 ! 1) Collection thickness of ice formed in leads and polynyas … … 130 129 131 130 ! Default new ice thickness 132 WHERE( qlead(:,:) < 0._wp ) ; ht_i_new(:,:) = rn_hinew133 ELSEWHERE ; ht_i_new(:,:) = 0._wp131 WHERE( qlead(:,:) < 0._wp .AND. tau_icebfr(:,:) == 0._wp ) ; ht_i_new(:,:) = rn_hinew ! if cooling and no landfast 132 ELSEWHERE ; ht_i_new(:,:) = 0._wp 134 133 END WHERE 135 134 … … 184 183 END DO 185 184 ! 185 ! bound ht_i_new (though I don't see why it should be necessary) 186 ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) ) 187 ! 186 188 ENDIF 187 189 ! … … 319 321 320 322 ! --- lateral ice growth --- ! 321 ! If lateral ice growth gives an ice concentration gt 1, then323 ! If lateral ice growth gives an ice concentration > amax, then 322 324 ! we keep the excessive volume in memory and attribute it later to bottom accretion 323 325 DO ji = 1, npti 324 IF ( za_newice(ji) > ( rn_amax_1d(ji) - at_i_1d(ji) ) ) THEN325 zda_res(ji) = za_newice(ji) - (rn_amax_1d(ji) - at_i_1d(ji) )326 IF ( za_newice(ji) > MAX( 0._wp, rn_amax_1d(ji) - at_i_1d(ji) ) ) THEN ! max is for roundoff error 327 zda_res(ji) = za_newice(ji) - MAX( 0._wp, rn_amax_1d(ji) - at_i_1d(ji) ) 326 328 zdv_res(ji) = zda_res (ji) * zh_newice(ji) 327 za_newice(ji) = za_newice(ji) - zda_res (ji)328 zv_newice(ji) = zv_newice(ji) - zdv_res (ji)329 za_newice(ji) = MAX( 0._wp, za_newice(ji) - zda_res (ji) ) 330 zv_newice(ji) = MAX( 0._wp, zv_newice(ji) - zdv_res (ji) ) 329 331 ELSE 330 332 zda_res(ji) = 0._wp … … 419 421 ! 420 422 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 423 IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 421 424 ! 422 425 END SUBROUTINE ice_thd_do … … 442 445 REWIND( numnam_ice_ref ) ! Namelist namthd_do in reference namelist : Ice thermodynamics 443 446 READ ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901) 444 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist' , lwp)447 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_do in reference namelist' ) 445 448 REWIND( numnam_ice_cfg ) ! Namelist namthd_do in configuration namelist : Ice thermodynamics 446 449 READ ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 ) 447 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist' , lwp)450 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_do in configuration namelist' ) 448 451 IF(lwm) WRITE( numoni, namthd_do ) 449 452 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd_pnd.F90
r10532 r11822 205 205 INTEGER :: ios, ioptio ! Local integer 206 206 !! 207 NAMELIST/namthd_pnd/ ln_pnd _H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb207 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 208 208 !!------------------------------------------------------------------- 209 209 ! 210 210 REWIND( numnam_ice_ref ) ! Namelist namthd_pnd in reference namelist : Melt Ponds 211 211 READ ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901) 212 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in reference namelist' , lwp)212 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_pnd in reference namelist' ) 213 213 REWIND( numnam_ice_cfg ) ! Namelist namthd_pnd in configuration namelist : Melt Ponds 214 214 READ ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 ) 215 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' , lwp)215 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' ) 216 216 IF(lwm) WRITE ( numoni, namthd_pnd ) 217 217 ! … … 221 221 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 222 222 WRITE(numout,*) ' Namelist namicethd_pnd:' 223 WRITE(numout,*) ' Evolutive melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 224 WRITE(numout,*) ' Prescribed melt pond fraction and depth ln_pnd_CST = ', ln_pnd_CST 225 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd 226 WRITE(numout,*) ' Prescribed pond depth rn_hpnd = ', rn_hpnd 227 WRITE(numout,*) ' Melt ponds affect albedo or not ln_pnd_alb = ', ln_pnd_alb 223 WRITE(numout,*) ' Melt ponds activated or not ln_pnd = ', ln_pnd 224 WRITE(numout,*) ' Evolutive melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 225 WRITE(numout,*) ' Prescribed melt pond fraction and depth ln_pnd_CST = ', ln_pnd_CST 226 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd 227 WRITE(numout,*) ' Prescribed pond depth rn_hpnd = ', rn_hpnd 228 WRITE(numout,*) ' Melt ponds affect albedo or not ln_pnd_alb = ', ln_pnd_alb 228 229 ENDIF 229 230 ! 230 231 ! !== set the choice of ice pond scheme ==! 231 232 ioptio = 0 232 nice_pnd = np_pndNO 233 IF( ln_pnd_CST ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndCST ; ENDIF 234 IF( ln_pnd_H12 ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndH12 ; ENDIF 235 IF( ioptio > 1 ) CALL ctl_stop( 'ice_thd_pnd_init: choose one and only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 233 IF( .NOT.ln_pnd ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndNO ; ENDIF 234 IF( ln_pnd_CST ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndCST ; ENDIF 235 IF( ln_pnd_H12 ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndH12 ; ENDIF 236 IF( ioptio /= 1 ) & 237 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 236 238 ! 237 239 SELECT CASE( nice_pnd ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd_sal.F90
r10069 r11822 134 134 REWIND( numnam_ice_ref ) ! Namelist namthd_sal in reference namelist : Ice salinity 135 135 READ ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901) 136 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist' , lwp)136 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_sal in reference namelist' ) 137 137 REWIND( numnam_ice_cfg ) ! Namelist namthd_sal in configuration namelist : Ice salinity 138 138 READ ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 ) 139 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_sal in configuration namelist' , lwp)139 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_sal in configuration namelist' ) 140 140 IF(lwm) WRITE ( numoni, namthd_sal ) 141 141 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd_zdf.F90
r10534 r11822 90 90 REWIND( numnam_ice_ref ) ! Namelist namthd_zdf in reference namelist : Ice thermodynamics 91 91 READ ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901) 92 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist' , lwp)92 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd_zdf in reference namelist' ) 93 93 REWIND( numnam_ice_cfg ) ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics 94 94 READ ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 ) 95 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist' , lwp)95 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist' ) 96 96 IF(lwm) WRITE( numoni, namthd_zdf ) 97 97 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icethd_zdf_bl99.F90
r10534 r11822 206 206 ! 207 207 l_T_converged(:) = .FALSE. 208 ! !============================!209 208 ! Convergence calculated until all sub-domain grid points have converged 210 209 ! Calculations keep going for all grid points until sub-domain convergence (vectorisation optimisation) 211 210 ! but values are not taken into account (results independant of MPI partitioning) 212 211 ! 212 ! !============================! 213 213 DO WHILE ( ( .NOT. ALL (l_T_converged(1:npti)) ) .AND. iconv < iconv_max ) ! Iterative procedure begins ! 214 ! !============================!214 ! !============================! 215 215 iconv = iconv + 1 216 216 ! … … 742 742 zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 743 743 ! t_i 744 DO jk = 0, nlay_i744 DO jk = 1, nlay_i 745 745 ztmelts = -rTmlt * sz_i_1d(ji,jk) + rt0 746 746 t_i_1d(ji,jk) = MAX( MIN( t_i_1d(ji,jk), ztmelts ), rt0 - 100._wp ) … … 856 856 t_i_1d (1:npti,:) = ztiold (1:npti,:) 857 857 qcn_ice_1d(1:npti) = qcn_ice_top_1d(1:npti) 858 859 !!clem 860 ! remettre t_su_1d, qns_ice_1d et dqns_ice_1d comme avant puisqu'on devrait faire comme si on avant conduction = input 861 !clem 858 862 ENDIF 859 863 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/iceupdate.F90
r10998 r11822 197 197 ! --- salt fluxes [kg/m2/s] --- ! 198 198 ! ! sfxice = sfxbog + sfxbom + sfxsum + sfxsni + sfxopw + sfxres + sfxdyn + sfxbri + sfxsub + sfxlam 199 IF( iom_use('sfxice' ) ) CALL iom_put( "sfxice", sfx * 1.e-03 ) ! salt flux from total ice growth/melt200 IF( iom_use('sfxbog' ) ) CALL iom_put( "sfxbog", sfx_bog * 1.e-03 ) ! salt flux from bottom growth201 IF( iom_use('sfxbom' ) ) CALL iom_put( "sfxbom", sfx_bom * 1.e-03 ) ! salt flux from bottom melting202 IF( iom_use('sfxsum' ) ) CALL iom_put( "sfxsum", sfx_sum * 1.e-03 ) ! salt flux from surface melting203 IF( iom_use('sfxlam' ) ) CALL iom_put( "sfxlam", sfx_lam * 1.e-03 ) ! salt flux from lateral melting204 IF( iom_use('sfxsni' ) ) CALL iom_put( "sfxsni", sfx_sni * 1.e-03 ) ! salt flux from snow ice formation205 IF( iom_use('sfxopw' ) ) CALL iom_put( "sfxopw", sfx_opw * 1.e-03 ) ! salt flux from open water formation206 IF( iom_use('sfxdyn' ) ) CALL iom_put( "sfxdyn", sfx_dyn * 1.e-03 ) ! salt flux from ridging rafting207 IF( iom_use('sfxbri' ) ) CALL iom_put( "sfxbri", sfx_bri * 1.e-03 ) ! salt flux from brines208 IF( iom_use('sfxres' ) ) CALL iom_put( "sfxres", sfx_res * 1.e-03 ) ! salt flux from undiagnosed processes209 IF( iom_use('sfxsub' ) ) CALL iom_put( "sfxsub", sfx_sub * 1.e-03 ) ! salt flux from sublimation199 IF( iom_use('sfxice' ) ) CALL iom_put( 'sfxice', sfx * 1.e-03 ) ! salt flux from total ice growth/melt 200 IF( iom_use('sfxbog' ) ) CALL iom_put( 'sfxbog', sfx_bog * 1.e-03 ) ! salt flux from bottom growth 201 IF( iom_use('sfxbom' ) ) CALL iom_put( 'sfxbom', sfx_bom * 1.e-03 ) ! salt flux from bottom melting 202 IF( iom_use('sfxsum' ) ) CALL iom_put( 'sfxsum', sfx_sum * 1.e-03 ) ! salt flux from surface melting 203 IF( iom_use('sfxlam' ) ) CALL iom_put( 'sfxlam', sfx_lam * 1.e-03 ) ! salt flux from lateral melting 204 IF( iom_use('sfxsni' ) ) CALL iom_put( 'sfxsni', sfx_sni * 1.e-03 ) ! salt flux from snow ice formation 205 IF( iom_use('sfxopw' ) ) CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 ) ! salt flux from open water formation 206 IF( iom_use('sfxdyn' ) ) CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 ) ! salt flux from ridging rafting 207 IF( iom_use('sfxbri' ) ) CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 ) ! salt flux from brines 208 IF( iom_use('sfxres' ) ) CALL iom_put( 'sfxres', sfx_res * 1.e-03 ) ! salt flux from undiagnosed processes 209 IF( iom_use('sfxsub' ) ) CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 ) ! salt flux from sublimation 210 210 211 211 ! --- mass fluxes [kg/m2/s] --- ! 212 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce", emp_oce ) ! emp over ocean (taking into account the snow blown away from the ice)213 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice", emp_ice ) ! emp over ice (taking into account the snow blown away from the ice)212 CALL iom_put( 'emp_oce', emp_oce ) ! emp over ocean (taking into account the snow blown away from the ice) 213 CALL iom_put( 'emp_ice', emp_ice ) ! emp over ice (taking into account the snow blown away from the ice) 214 214 215 215 ! ! vfxice = vfxbog + vfxbom + vfxsum + vfxsni + vfxopw + vfxdyn + vfxres + vfxlam + vfxpnd 216 IF( iom_use('vfxice' ) ) CALL iom_put( "vfxice" , wfx_ice) ! mass flux from total ice growth/melt217 IF( iom_use('vfxbog' ) ) CALL iom_put( "vfxbog" , wfx_bog) ! mass flux from bottom growth218 IF( iom_use('vfxbom' ) ) CALL iom_put( "vfxbom" , wfx_bom) ! mass flux from bottom melt219 IF( iom_use('vfxsum' ) ) CALL iom_put( "vfxsum" , wfx_sum) ! mass flux from surface melt220 IF( iom_use('vfxlam' ) ) CALL iom_put( "vfxlam" , wfx_lam) ! mass flux from lateral melt221 IF( iom_use('vfxsni' ) ) CALL iom_put( "vfxsni" , wfx_sni) ! mass flux from snow-ice formation222 IF( iom_use('vfxopw' ) ) CALL iom_put( "vfxopw" , wfx_opw) ! mass flux from growth in open water223 IF( iom_use('vfxdyn' ) ) CALL iom_put( "vfxdyn" , wfx_dyn) ! mass flux from dynamics (ridging)224 IF( iom_use('vfxres' ) ) CALL iom_put( "vfxres" , wfx_res) ! mass flux from undiagnosed processes225 IF( iom_use('vfxpnd' ) ) CALL iom_put( "vfxpnd" , wfx_pnd) ! mass flux from melt ponds226 IF( iom_use('vfxsub' ) ) CALL iom_put( "vfxsub", wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.)227 IF( iom_use('vfxsub_err') ) CALL iom_put( "vfxsub_err", wfx_err_sub ) ! "excess" of sublimation sent to ocean228 229 IF ( iom_use( "vfxthin") ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations216 CALL iom_put( 'vfxice' , wfx_ice ) ! mass flux from total ice growth/melt 217 CALL iom_put( 'vfxbog' , wfx_bog ) ! mass flux from bottom growth 218 CALL iom_put( 'vfxbom' , wfx_bom ) ! mass flux from bottom melt 219 CALL iom_put( 'vfxsum' , wfx_sum ) ! mass flux from surface melt 220 CALL iom_put( 'vfxlam' , wfx_lam ) ! mass flux from lateral melt 221 CALL iom_put( 'vfxsni' , wfx_sni ) ! mass flux from snow-ice formation 222 CALL iom_put( 'vfxopw' , wfx_opw ) ! mass flux from growth in open water 223 CALL iom_put( 'vfxdyn' , wfx_dyn ) ! mass flux from dynamics (ridging) 224 CALL iom_put( 'vfxres' , wfx_res ) ! mass flux from undiagnosed processes 225 CALL iom_put( 'vfxpnd' , wfx_pnd ) ! mass flux from melt ponds 226 CALL iom_put( 'vfxsub' , wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.) 227 CALL iom_put( 'vfxsub_err', wfx_err_sub ) ! "excess" of sublimation sent to ocean 228 229 IF ( iom_use( 'vfxthin' ) ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations 230 230 WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog 231 231 ELSEWHERE ; z2d = 0._wp 232 232 END WHERE 233 CALL iom_put( "vfxthin", wfx_opw + z2d )234 ENDIF 235 236 ! 237 IF( iom_use('vfxsnw' ) ) CALL iom_put( "vfxsnw", wfx_snw ) ! mass flux from total snow growth/melt238 IF( iom_use('vfxsnw_sum' ) ) CALL iom_put( "vfxsnw_sum", wfx_snw_sum ) ! mass flux from snow melt at the surface239 IF( iom_use('vfxsnw_sni' ) ) CALL iom_put( "vfxsnw_sni", wfx_snw_sni ) ! mass flux from snow melt during snow-ice formation240 IF( iom_use('vfxsnw_dyn' ) ) CALL iom_put( "vfxsnw_dyn", wfx_snw_dyn ) ! mass flux from dynamics (ridging)241 IF( iom_use('vfxsnw_sub' ) ) CALL iom_put( "vfxsnw_sub", wfx_snw_sub ) ! mass flux from snow sublimation (ice-atm.)242 IF( iom_use('vfxsnw_pre' ) ) CALL iom_put( "vfxsnw_pre", wfx_spr ) ! snow precip233 CALL iom_put( 'vfxthin', wfx_opw + z2d ) 234 ENDIF 235 236 ! ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum 237 CALL iom_put( 'vfxsnw' , wfx_snw ) ! mass flux from total snow growth/melt 238 CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum ) ! mass flux from snow melt at the surface 239 CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni ) ! mass flux from snow melt during snow-ice formation 240 CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn ) ! mass flux from dynamics (ridging) 241 CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub ) ! mass flux from snow sublimation (ice-atm.) 242 CALL iom_put( 'vfxsnw_pre' , wfx_spr ) ! snow precip 243 243 244 244 ! --- heat fluxes [W/m2] --- ! 245 245 ! ! qt_atm_oi - qt_oce_ai = hfxdhc - ( dihctrp + dshctrp ) 246 IF( iom_use('qsr_oce' ) ) CALL iom_put( "qsr_oce", qsr_oce * ( 1._wp - at_i_b ) ) ! solar flux at ocean surface247 IF( iom_use('qns_oce' ) ) CALL iom_put( "qns_oce", qns_oce * ( 1._wp - at_i_b ) + qemp_oce ) ! non-solar flux at ocean surface248 IF( iom_use('qsr_ice' ) ) CALL iom_put( "qsr_ice", SUM( qsr_ice * a_i_b, dim=3 ) ) ! solar flux at ice surface249 IF( iom_use('qns_ice' ) ) CALL iom_put( "qns_ice", SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice ) ! non-solar flux at ice surface250 IF( iom_use('qtr_ice_bot') ) CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice251 IF( iom_use('qtr_ice_top') ) CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface252 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce", ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )253 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice", SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice )254 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( "qt_oce_ai", qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm)255 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( "qt_atm_oi", qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce)256 IF( iom_use('qemp_oce' ) ) CALL iom_put( "qemp_oce", qemp_oce ) ! Downward Heat Flux from E-P over ocean257 IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice", qemp_ice ) ! Downward Heat Flux from E-P over ice246 IF( iom_use('qsr_oce' ) ) CALL iom_put( 'qsr_oce' , qsr_oce * ( 1._wp - at_i_b ) ) ! solar flux at ocean surface 247 IF( iom_use('qns_oce' ) ) CALL iom_put( 'qns_oce' , qns_oce * ( 1._wp - at_i_b ) + qemp_oce ) ! non-solar flux at ocean surface 248 IF( iom_use('qsr_ice' ) ) CALL iom_put( 'qsr_ice' , SUM( qsr_ice * a_i_b, dim=3 ) ) ! solar flux at ice surface 249 IF( iom_use('qns_ice' ) ) CALL iom_put( 'qns_ice' , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice ) ! non-solar flux at ice surface 250 IF( iom_use('qtr_ice_bot') ) CALL iom_put( 'qtr_ice_bot', SUM( qtr_ice_bot * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice 251 IF( iom_use('qtr_ice_top') ) CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface 252 IF( iom_use('qt_oce' ) ) CALL iom_put( 'qt_oce' , ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 253 IF( iom_use('qt_ice' ) ) CALL iom_put( 'qt_ice' , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice ) 254 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm) 255 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 256 IF( iom_use('qemp_oce' ) ) CALL iom_put( 'qemp_oce' , qemp_oce ) ! Downward Heat Flux from E-P over ocean 257 IF( iom_use('qemp_ice' ) ) CALL iom_put( 'qemp_ice' , qemp_ice ) ! Downward Heat Flux from E-P over ice 258 258 259 259 ! heat fluxes from ice transformations 260 ! 261 IF( iom_use('hfxbog' ) ) CALL iom_put ("hfxbog" , hfx_bog) ! heat flux used for ice bottom growth262 IF( iom_use('hfxbom' ) ) CALL iom_put ("hfxbom" , hfx_bom) ! heat flux used for ice bottom melt263 IF( iom_use('hfxsum' ) ) CALL iom_put ("hfxsum" , hfx_sum) ! heat flux used for ice surface melt264 IF( iom_use('hfxopw' ) ) CALL iom_put ("hfxopw" , hfx_opw) ! heat flux used for ice formation in open water265 IF( iom_use('hfxdif' ) ) CALL iom_put ("hfxdif" , hfx_dif) ! heat flux used for ice temperature change266 IF( iom_use('hfxsnw' ) ) CALL iom_put ("hfxsnw" , hfx_snw) ! heat flux used for snow melt267 IF( iom_use('hfxerr' ) ) CALL iom_put ("hfxerr" , hfx_err_dif) ! heat flux error after heat diffusion (included in qt_oce_ai)260 ! ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 261 CALL iom_put ('hfxbog' , hfx_bog ) ! heat flux used for ice bottom growth 262 CALL iom_put ('hfxbom' , hfx_bom ) ! heat flux used for ice bottom melt 263 CALL iom_put ('hfxsum' , hfx_sum ) ! heat flux used for ice surface melt 264 CALL iom_put ('hfxopw' , hfx_opw ) ! heat flux used for ice formation in open water 265 CALL iom_put ('hfxdif' , hfx_dif ) ! heat flux used for ice temperature change 266 CALL iom_put ('hfxsnw' , hfx_snw ) ! heat flux used for snow melt 267 CALL iom_put ('hfxerr' , hfx_err_dif ) ! heat flux error after heat diffusion (included in qt_oce_ai) 268 268 269 269 ! heat fluxes associated with mass exchange (freeze/melt/precip...) 270 IF( iom_use('hfxthd' ) ) CALL iom_put ("hfxthd" , hfx_thd) !271 IF( iom_use('hfxdyn' ) ) CALL iom_put ("hfxdyn" , hfx_dyn) !272 IF( iom_use('hfxres' ) ) CALL iom_put ("hfxres" , hfx_res) !273 IF( iom_use('hfxsub' ) ) CALL iom_put ("hfxsub" , hfx_sub) !274 IF( iom_use('hfxspr' ) ) CALL iom_put ("hfxspr" , hfx_spr) ! Heat flux from snow precip heat content270 CALL iom_put ('hfxthd' , hfx_thd ) ! 271 CALL iom_put ('hfxdyn' , hfx_dyn ) ! 272 CALL iom_put ('hfxres' , hfx_res ) ! 273 CALL iom_put ('hfxsub' , hfx_sub ) ! 274 CALL iom_put ('hfxspr' , hfx_spr ) ! Heat flux from snow precip heat content 275 275 276 276 ! other heat fluxes 277 IF( iom_use('hfxsensib' ) ) CALL iom_put( "hfxsensib" , -qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux 278 IF( iom_use('hfxcndbot' ) ) CALL iom_put( "hfxcndbot" , SUM( qcn_ice_bot * a_i_b, dim=3 ) ) ! Bottom conduction flux 279 IF( iom_use('hfxcndtop' ) ) CALL iom_put( "hfxcndtop" , SUM( qcn_ice_top * a_i_b, dim=3 ) ) ! Surface conduction flux 280 281 ! diags 282 IF( iom_use('hfxdhc' ) ) CALL iom_put ("hfxdhc" , diag_heat ) ! Heat content variation in snow and ice 283 ! 277 IF( iom_use('hfxsensib' ) ) CALL iom_put( 'hfxsensib' , -qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux 278 IF( iom_use('hfxcndbot' ) ) CALL iom_put( 'hfxcndbot' , SUM( qcn_ice_bot * a_i_b, dim=3 ) ) ! Bottom conduction flux 279 IF( iom_use('hfxcndtop' ) ) CALL iom_put( 'hfxcndtop' , SUM( qcn_ice_top * a_i_b, dim=3 ) ) ! Surface conduction flux 280 284 281 ! controls 285 282 !--------- … … 412 409 !! ** Method : use of IOM library 413 410 !!---------------------------------------------------------------------- 414 CHARACTER(len=*) , INTENT(in) :: cdrw ! "READ"/"WRITE"flag411 CHARACTER(len=*) , INTENT(in) :: cdrw ! 'READ'/'WRITE' flag 415 412 INTEGER, OPTIONAL, INTENT(in) :: kt ! ice time-step 416 413 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icevar.F90
r10589 r11822 32 32 !! - vt_s(jpi,jpj) 33 33 !! - at_i(jpi,jpj) 34 !! - st_i(jpi,jpj) 34 35 !! - et_s(jpi,jpj) total snow heat content 35 36 !! - et_i(jpi,jpj) total ice thermal content … … 44 45 !! ice_var_salprof1d : salinity profile in the ice 1D 45 46 !! ice_var_zapsmall : remove very small area and volume 46 !! ice_var_zapneg : remove negative ice fields (to debug the advection scheme UM3-5) 47 !! ice_var_itd : convert 1-cat to jpl-cat 48 !! ice_var_itd2 : convert N-cat to jpl-cat 47 !! ice_var_zapneg : remove negative ice fields 48 !! ice_var_roundoff : remove negative values arising from roundoff erros 49 49 !! ice_var_bv : brine volume 50 50 !! ice_var_enthalpy : compute ice and snow enthalpies from temperature 51 51 !! ice_var_sshdyn : compute equivalent ssh in lead 52 !! ice_var_itd : convert N-cat to M-cat 52 53 !!---------------------------------------------------------------------- 53 54 USE dom_oce ! ocean space and time domain … … 71 72 PUBLIC ice_var_zapsmall 72 73 PUBLIC ice_var_zapneg 73 PUBLIC ice_var_itd 74 PUBLIC ice_var_itd2 74 PUBLIC ice_var_roundoff 75 75 PUBLIC ice_var_bv 76 76 PUBLIC ice_var_enthalpy 77 77 PUBLIC ice_var_sshdyn 78 PUBLIC ice_var_itd 79 80 INTERFACE ice_var_itd 81 MODULE PROCEDURE ice_var_itd_1c1c, ice_var_itd_Nc1c, ice_var_itd_1cMc, ice_var_itd_NcMc 82 END INTERFACE 78 83 79 84 !!---------------------------------------------------------------------- … … 99 104 ! 100 105 ! ! integrated values 101 vt_i(:,:) = SUM( v_i(:,:,:) , dim=3 ) 102 vt_s(:,:) = SUM( v_s(:,:,:) , dim=3 ) 103 at_i(:,:) = SUM( a_i(:,:,:) , dim=3 ) 104 et_s(:,:) = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 105 et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 106 vt_i(:,:) = SUM( v_i (:,:,:) , dim=3 ) 107 vt_s(:,:) = SUM( v_s (:,:,:) , dim=3 ) 108 st_i(:,:) = SUM( sv_i(:,:,:) , dim=3 ) 109 at_i(:,:) = SUM( a_i (:,:,:) , dim=3 ) 110 et_s(:,:) = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 111 et_i(:,:) = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 106 112 ! 107 113 at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds … … 133 139 tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 134 140 om_i (:,:) = SUM( oa_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 135 sm_i (:,:) = SUM( sv_i(:,:,:) , dim=3 )* z1_vt_i(:,:)141 sm_i (:,:) = st_i(:,:) * z1_vt_i(:,:) 136 142 ! 137 143 tm_i(:,:) = 0._wp … … 153 159 tm_s (:,:) = rt0 154 160 END WHERE 155 161 ! 162 ! ! mean melt pond depth 163 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 164 ELSEWHERE ; hm_ip(:,:) = 0._wp 165 END WHERE 166 ! 156 167 DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 168 ! 157 169 ENDIF 158 170 ! … … 229 241 IF ( v_i(ji,jj,jl) > epsi20 ) THEN !--- icy area 230 242 ! 231 ze_i = e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i 243 ze_i = e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i ! Energy of melting e(S,T) [J.m-3] 232 244 ztmelts = - sz_i(ji,jj,jk,jl) * rTmlt ! Ice layer melt temperature [C] 233 245 ! Conversion q(S,T) -> T (second order equation) … … 236 248 t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0 ! [K] with bounds: -100 < t_i < ztmelts 237 249 ! 238 ELSE !--- no ice250 ELSE !--- no ice 239 251 t_i(ji,jj,jk,jl) = rt0 240 252 ENDIF … … 258 270 ! 259 271 ! integrated values 260 vt_i (:,:) = SUM( v_i , dim=3 )261 vt_s (:,:) = SUM( v_s , dim=3 )262 at_i (:,:) = SUM( a_i , dim=3 )272 vt_i (:,:) = SUM( v_i , dim=3 ) 273 vt_s (:,:) = SUM( v_s , dim=3 ) 274 at_i (:,:) = SUM( a_i , dim=3 ) 263 275 ! 264 276 END SUBROUTINE ice_var_glo2eqv … … 528 540 529 541 ! to be sure that at_i is the sum of a_i(jl) 530 at_i (:,:) = SUM( a_i(:,:,:), dim=3 ) 531 vt_i (:,:) = SUM( v_i(:,:,:), dim=3 ) 542 at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) 543 vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) 544 !!clem add? 545 ! vt_s (:,:) = SUM( v_s (:,:,:), dim=3 ) 546 ! st_i (:,:) = SUM( sv_i(:,:,:), dim=3 ) 547 ! et_s(:,:) = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 548 ! et_i(:,:) = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 549 !!clem 532 550 533 551 ! open water = 1 if at_i=0 … … 537 555 538 556 539 SUBROUTINE ice_var_zapneg( p ato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i )557 SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 540 558 !!------------------------------------------------------------------- 541 559 !! *** ROUTINE ice_var_zapneg *** … … 543 561 !! ** Purpose : Remove negative sea ice fields and correct fluxes 544 562 !!------------------------------------------------------------------- 545 INTEGER :: ji, jj, jl, jk ! dummy loop indices 546 ! 563 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 547 564 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pato_i ! open water area 548 565 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i ! ice volume … … 555 572 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content 556 573 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content 557 !!------------------------------------------------------------------- 558 ! 574 ! 575 INTEGER :: ji, jj, jl, jk ! dummy loop indices 576 REAL(wp) :: z1_dt 577 !!------------------------------------------------------------------- 578 ! 579 z1_dt = 1._wp / pdt 559 580 ! 560 581 DO jl = 1, jpl !== loop over the categories ==! 561 582 ! 583 ! make sure a_i=0 where v_i<=0 584 WHERE( pv_i(:,:,:) <= 0._wp ) pa_i(:,:,:) = 0._wp 585 562 586 !---------------------------------------- 563 587 ! zap ice energy and send it to the ocean … … 566 590 DO jj = 1 , jpj 567 591 DO ji = 1 , jpi 568 IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN569 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * r1_rdtice! W.m-2 >0592 IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 593 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 570 594 pe_i(ji,jj,jk,jl) = 0._wp 571 595 ENDIF … … 577 601 DO jj = 1 , jpj 578 602 DO ji = 1 , jpi 579 IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN580 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * r1_rdtice! W.m-2 <0603 IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 604 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 581 605 pe_s(ji,jj,jk,jl) = 0._wp 582 606 ENDIF … … 590 614 DO jj = 1 , jpj 591 615 DO ji = 1 , jpi 592 IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN593 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * r1_rdtice616 IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 617 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 594 618 pv_i (ji,jj,jl) = 0._wp 595 619 ENDIF 596 IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN597 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * r1_rdtice620 IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 621 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 598 622 pv_s (ji,jj,jl) = 0._wp 599 623 ENDIF 600 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN601 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * r1_rdtice624 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 625 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 602 626 psv_i (ji,jj,jl) = 0._wp 603 627 ENDIF … … 616 640 END SUBROUTINE ice_var_zapneg 617 641 642 643 SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pe_s, pe_i ) 644 !!------------------------------------------------------------------- 645 !! *** ROUTINE ice_var_roundoff *** 646 !! 647 !! ** Purpose : Remove negative sea ice values arising from roundoff errors 648 !!------------------------------------------------------------------- 649 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pa_i ! ice concentration 650 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_i ! ice volume 651 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_s ! snw volume 652 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: psv_i ! salt content 653 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: poa_i ! age content 654 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 655 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_ip ! melt pond volume 656 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_s ! snw heat content 657 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_i ! ice heat content 658 !!------------------------------------------------------------------- 659 ! 660 WHERE( pa_i (1:npti,:) < 0._wp .AND. pa_i (1:npti,:) > -epsi10 ) pa_i (1:npti,:) = 0._wp ! a_i must be >= 0 661 WHERE( pv_i (1:npti,:) < 0._wp .AND. pv_i (1:npti,:) > -epsi10 ) pv_i (1:npti,:) = 0._wp ! v_i must be >= 0 662 WHERE( pv_s (1:npti,:) < 0._wp .AND. pv_s (1:npti,:) > -epsi10 ) pv_s (1:npti,:) = 0._wp ! v_s must be >= 0 663 WHERE( psv_i(1:npti,:) < 0._wp .AND. psv_i(1:npti,:) > -epsi10 ) psv_i(1:npti,:) = 0._wp ! sv_i must be >= 0 664 WHERE( poa_i(1:npti,:) < 0._wp .AND. poa_i(1:npti,:) > -epsi10 ) poa_i(1:npti,:) = 0._wp ! oa_i must be >= 0 665 WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 666 WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 667 IF( ln_pnd_H12 ) THEN 668 WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 669 WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 670 ENDIF 671 ! 672 END SUBROUTINE ice_var_roundoff 618 673 619 SUBROUTINE ice_var_itd( zhti, zhts, zati, zh_i, zh_s, za_i )620 !!-------------------------------------------------------------------621 !! *** ROUTINE ice_var_itd ***622 !!623 !! ** Purpose : converting 1-cat ice to multiple ice categories624 !!625 !! ice thickness distribution follows a gaussian law626 !! around the concentration of the most likely ice thickness627 !! (similar as iceistate.F90)628 !!629 !! ** Method: Iterative procedure630 !!631 !! 1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian632 !!633 !! 2) Check whether the distribution conserves area and volume, positivity and634 !! category boundaries635 !!636 !! 3) If not (input ice is too thin), the last category is empty and637 !! the number of categories is reduced (jpl-1)638 !!639 !! 4) Iterate until ok (SUM(itest(:) = 4)640 !!641 !! ** Arguments : zhti: 1-cat ice thickness642 !! zhts: 1-cat snow depth643 !! zati: 1-cat ice concentration644 !!645 !! ** Output : jpl-cat646 !!647 !! (Example of application: BDY forcings when input are cell averaged)648 !!-------------------------------------------------------------------649 INTEGER :: ji, jk, jl ! dummy loop indices650 INTEGER :: idim, i_fill, jl0651 REAL(wp) :: zarg, zV, zconv, zdh, zdv652 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables653 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zh_i, zh_s, za_i ! output ice/snow variables654 INTEGER , DIMENSION(4) :: itest655 !!-------------------------------------------------------------------656 !657 ! ----------------------------------------658 ! distribution over the jpl ice categories659 ! ----------------------------------------660 ! a gaussian distribution for ice concentration is used661 ! then we check whether the distribution fullfills662 ! volume and area conservation, positivity and ice categories bounds663 idim = SIZE( zhti , 1 )664 zh_i(1:idim,1:jpl) = 0._wp665 zh_s(1:idim,1:jpl) = 0._wp666 za_i(1:idim,1:jpl) = 0._wp667 !668 DO ji = 1, idim669 !670 IF( zhti(ji) > 0._wp ) THEN671 !672 ! find which category (jl0) the input ice thickness falls into673 jl0 = jpl674 DO jl = 1, jpl675 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN676 jl0 = jl677 CYCLE678 ENDIF679 END DO680 !681 itest(:) = 0682 i_fill = jpl + 1 !------------------------------------683 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories684 ! !------------------------------------685 i_fill = i_fill - 1686 !687 zh_i(ji,1:jpl) = 0._wp688 za_i(ji,1:jpl) = 0._wp689 itest(:) = 0690 !691 IF ( i_fill == 1 ) THEN !-- case very thin ice: fill only category 1692 zh_i(ji,1) = zhti(ji)693 za_i (ji,1) = zati (ji)694 ELSE !-- case ice is thicker: fill categories >1695 ! thickness696 DO jl = 1, i_fill - 1697 zh_i(ji,jl) = hi_mean(jl)698 END DO699 !700 ! concentration701 za_i(ji,jl0) = zati(ji) / SQRT(REAL(jpl))702 DO jl = 1, i_fill - 1703 IF ( jl /= jl0 ) THEN704 zarg = ( zh_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )705 za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2)706 ENDIF707 END DO708 !709 ! last category710 za_i(ji,i_fill) = zati(ji) - SUM( za_i(ji,1:i_fill-1) )711 zV = SUM( za_i(ji,1:i_fill-1) * zh_i(ji,1:i_fill-1) )712 zh_i(ji,i_fill) = ( zhti(ji) * zati(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 )713 !714 ! correction if concentration of upper cat is greater than lower cat715 ! (it should be a gaussian around jl0 but sometimes it is not)716 IF ( jl0 /= jpl ) THEN717 DO jl = jpl, jl0+1, -1718 IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN719 zdv = zh_i(ji,jl) * za_i(ji,jl)720 zh_i(ji,jl ) = 0._wp721 za_i (ji,jl ) = 0._wp722 za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 )723 END IF724 END DO725 ENDIF726 !727 ENDIF728 !729 ! Compatibility tests730 zconv = ABS( zati(ji) - SUM( za_i(ji,1:jpl) ) )731 IF ( zconv < epsi06 ) itest(1) = 1 ! Test 1: area conservation732 !733 zconv = ABS( zhti(ji)*zati(ji) - SUM( za_i(ji,1:jpl)*zh_i(ji,1:jpl) ) )734 IF ( zconv < epsi06 ) itest(2) = 1 ! Test 2: volume conservation735 !736 IF ( zh_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 ! Test 3: thickness of the last category is in-bounds ?737 !738 itest(4) = 1739 DO jl = 1, i_fill740 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 ! Test 4: positivity of ice concentrations741 END DO742 ! !----------------------------743 END DO ! end iteration on categories744 ! !----------------------------745 ENDIF746 END DO747 748 ! Add Snow in each category where za_i is not 0749 DO jl = 1, jpl750 DO ji = 1, idim751 IF( za_i(ji,jl) > 0._wp ) THEN752 zh_s(ji,jl) = zh_i(ji,jl) * ( zhts(ji) / zhti(ji) )753 ! In case snow load is in excess that would lead to transformation from snow to ice754 ! Then, transfer the snow excess into the ice (different from icethd_dh)755 zdh = MAX( 0._wp, ( rhos * zh_s(ji,jl) + ( rhoi - rau0 ) * zh_i(ji,jl) ) * r1_rau0 )756 ! recompute h_i, h_s avoiding out of bounds values757 zh_i(ji,jl) = MIN( hi_max(jl), zh_i(ji,jl) + zdh )758 zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoi * r1_rhos )759 ENDIF760 END DO761 END DO762 !763 END SUBROUTINE ice_var_itd764 765 766 SUBROUTINE ice_var_itd2( zhti, zhts, zati, zh_i, zh_s, za_i )767 !!-------------------------------------------------------------------768 !! *** ROUTINE ice_var_itd2 ***769 !!770 !! ** Purpose : converting N-cat ice to jpl ice categories771 !!772 !! ice thickness distribution follows a gaussian law773 !! around the concentration of the most likely ice thickness774 !! (similar as iceistate.F90)775 !!776 !! ** Method: Iterative procedure777 !!778 !! 1) Fill ice cat that correspond to input thicknesses779 !! Find the lowest(jlmin) and highest(jlmax) cat that are filled780 !!781 !! 2) Expand the filling to the cat jlmin-1 and jlmax+1782 !! by removing 25% ice area from jlmin and jlmax (resp.)783 !!784 !! 3) Expand the filling to the empty cat between jlmin and jlmax785 !! by a) removing 25% ice area from the lower cat (ascendant loop jlmin=>jlmax)786 !! b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin)787 !!788 !! ** Arguments : zhti: N-cat ice thickness789 !! zhts: N-cat snow depth790 !! zati: N-cat ice concentration791 !!792 !! ** Output : jpl-cat793 !!794 !! (Example of application: BDY forcings when inputs have N-cat /= jpl)795 !!-------------------------------------------------------------------796 INTEGER :: ji, jl, jl1, jl2 ! dummy loop indices797 INTEGER :: idim, icat798 REAL(wp), PARAMETER :: ztrans = 0.25_wp799 REAL(wp), DIMENSION(:,:), INTENT(in) :: zhti, zhts, zati ! input ice/snow variables800 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zh_i, zh_s, za_i ! output ice/snow variables801 INTEGER , DIMENSION(:,:), ALLOCATABLE :: jlfil, jlfil2802 INTEGER , DIMENSION(:) , ALLOCATABLE :: jlmax, jlmin803 !!-------------------------------------------------------------------804 !805 idim = SIZE( zhti, 1 )806 icat = SIZE( zhti, 2 )807 !808 ALLOCATE( jlfil(idim,jpl), jlfil2(idim,jpl) ) ! allocate arrays809 ALLOCATE( jlmin(idim), jlmax(idim) )810 811 ! --- initialize output fields to 0 --- !812 zh_i(1:idim,1:jpl) = 0._wp813 zh_s(1:idim,1:jpl) = 0._wp814 za_i(1:idim,1:jpl) = 0._wp815 !816 ! --- fill the categories --- !817 ! find where cat-input = cat-output and fill cat-output fields818 jlmax(:) = 0819 jlmin(:) = 999820 jlfil(:,:) = 0821 DO jl1 = 1, jpl822 DO jl2 = 1, icat823 DO ji = 1, idim824 IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN825 ! fill the right category826 zh_i(ji,jl1) = zhti(ji,jl2)827 zh_s(ji,jl1) = zhts(ji,jl2)828 za_i(ji,jl1) = zati(ji,jl2)829 ! record categories that are filled830 jlmax(ji) = MAX( jlmax(ji), jl1 )831 jlmin(ji) = MIN( jlmin(ji), jl1 )832 jlfil(ji,jl1) = jl1833 ENDIF834 END DO835 END DO836 END DO837 !838 ! --- fill the gaps between categories --- !839 ! transfer from categories filled at the previous step to the empty ones in between840 DO ji = 1, idim841 jl1 = jlmin(ji)842 jl2 = jlmax(ji)843 IF( jl1 > 1 ) THEN844 ! fill the lower cat (jl1-1)845 za_i(ji,jl1-1) = ztrans * za_i(ji,jl1)846 zh_i(ji,jl1-1) = hi_mean(jl1-1)847 ! remove from cat jl1848 za_i(ji,jl1 ) = ( 1._wp - ztrans ) * za_i(ji,jl1)849 ENDIF850 IF( jl2 < jpl ) THEN851 ! fill the upper cat (jl2+1)852 za_i(ji,jl2+1) = ztrans * za_i(ji,jl2)853 zh_i(ji,jl2+1) = hi_mean(jl2+1)854 ! remove from cat jl2855 za_i(ji,jl2 ) = ( 1._wp - ztrans ) * za_i(ji,jl2)856 ENDIF857 END DO858 !859 jlfil2(:,:) = jlfil(:,:)860 ! fill categories from low to high861 DO jl = 2, jpl-1862 DO ji = 1, idim863 IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN864 ! fill high865 za_i(ji,jl) = ztrans * za_i(ji,jl-1)866 zh_i(ji,jl) = hi_mean(jl)867 jlfil(ji,jl) = jl868 ! remove low869 za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1)870 ENDIF871 END DO872 END DO873 !874 ! fill categories from high to low875 DO jl = jpl-1, 2, -1876 DO ji = 1, idim877 IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN878 ! fill low879 za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1)880 zh_i(ji,jl) = hi_mean(jl)881 jlfil2(ji,jl) = jl882 ! remove high883 za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1)884 ENDIF885 END DO886 END DO887 !888 DEALLOCATE( jlfil, jlfil2 ) ! deallocate arrays889 DEALLOCATE( jlmin, jlmax )890 !891 END SUBROUTINE ice_var_itd2892 893 674 894 675 SUBROUTINE ice_var_bv … … 952 733 END SUBROUTINE ice_var_enthalpy 953 734 735 954 736 FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b) 955 737 !!--------------------------------------------------------------------- … … 998 780 END FUNCTION ice_var_sshdyn 999 781 782 783 !!------------------------------------------------------------------- 784 !! *** INTERFACE ice_var_itd *** 785 !! 786 !! ** Purpose : converting N-cat ice to jpl ice categories 787 !!------------------------------------------------------------------- 788 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, & 789 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 790 !!------------------------------------------------------------------- 791 !! ** Purpose : converting 1-cat ice to 1 ice category 792 !!------------------------------------------------------------------- 793 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 794 REAL(wp), DIMENSION(:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 795 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 796 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 797 !!------------------------------------------------------------------- 798 ! == thickness and concentration == ! 799 ph_i(:) = phti(:) 800 ph_s(:) = phts(:) 801 pa_i(:) = pati(:) 802 ! 803 ! == temperature and salinity and ponds == ! 804 pt_i (:) = ptmi (:) 805 pt_s (:) = ptms (:) 806 pt_su(:) = ptmsu(:) 807 ps_i (:) = psmi (:) 808 pa_ip(:) = patip(:) 809 ph_ip(:) = phtip(:) 810 811 END SUBROUTINE ice_var_itd_1c1c 812 813 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, & 814 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 815 !!------------------------------------------------------------------- 816 !! ** Purpose : converting N-cat ice to 1 ice category 817 !!------------------------------------------------------------------- 818 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 819 REAL(wp), DIMENSION(:) , INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 820 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 821 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 822 ! 823 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs 824 ! 825 INTEGER :: idim 826 !!------------------------------------------------------------------- 827 ! 828 idim = SIZE( phti, 1 ) 829 ! 830 ! == thickness and concentration == ! 831 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim) ) 832 ! 833 pa_i(:) = SUM( pati(:,:), dim=2 ) 834 835 WHERE( ( pa_i(:) ) /= 0._wp ) ; z1_ai(:) = 1._wp / pa_i(:) 836 ELSEWHERE ; z1_ai(:) = 0._wp 837 END WHERE 838 839 ph_i(:) = SUM( phti(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 840 ph_s(:) = SUM( phts(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 841 ! 842 ! == temperature and salinity == ! 843 WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp ) ; z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 844 ELSEWHERE ; z1_vi(:) = 0._wp 845 END WHERE 846 WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp ) ; z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 847 ELSEWHERE ; z1_vs(:) = 0._wp 848 END WHERE 849 pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 850 pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 851 pt_su(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 852 ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 853 854 ! == ponds == ! 855 pa_ip(:) = SUM( patip(:,:), dim=2 ) 856 WHERE( pa_ip(:) /= 0._wp ) ; ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 857 ELSEWHERE ; ph_ip(:) = 0._wp 858 END WHERE 859 ! 860 DEALLOCATE( z1_ai, z1_vi, z1_vs ) 861 ! 862 END SUBROUTINE ice_var_itd_Nc1c 863 864 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, & 865 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 866 !!------------------------------------------------------------------- 867 !! 868 !! ** Purpose : converting 1-cat ice to jpl ice categories 869 !! 870 !! 871 !! ** Method: ice thickness distribution follows a gamma function from Abraham et al. (2015) 872 !! it has the property of conserving total concentration and volume 873 !! 874 !! 875 !! ** Arguments : phti: 1-cat ice thickness 876 !! phts: 1-cat snow depth 877 !! pati: 1-cat ice concentration 878 !! 879 !! ** Output : jpl-cat 880 !! 881 !! Abraham, C., Steiner, N., Monahan, A. and Michel, C., 2015. 882 !! Effects of subgrid‐scale snow thickness variability on radiative transfer in sea ice. 883 !! Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614 884 !!------------------------------------------------------------------- 885 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 886 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 887 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 888 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 889 ! 890 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra, z1_hti 891 INTEGER :: ji, jk, jl 892 INTEGER :: idim 893 REAL(wp) :: zv, zdh 894 !!------------------------------------------------------------------- 895 ! 896 idim = SIZE( phti , 1 ) 897 ! 898 ph_i(1:idim,1:jpl) = 0._wp 899 ph_s(1:idim,1:jpl) = 0._wp 900 pa_i(1:idim,1:jpl) = 0._wp 901 ! 902 ALLOCATE( z1_hti(idim) ) 903 WHERE( phti(:) /= 0._wp ) ; z1_hti(:) = 1._wp / phti(:) 904 ELSEWHERE ; z1_hti(:) = 0._wp 905 END WHERE 906 ! 907 ! == thickness and concentration == ! 908 ! for categories 1:jpl-1, integrate the gamma function from hi_max(jl-1) to hi_max(jl) 909 DO jl = 1, jpl-1 910 DO ji = 1, idim 911 ! 912 IF( phti(ji) > 0._wp ) THEN 913 ! concentration : integrate ((4A/H^2)xexp(-2x/H))dx from x=hi_max(jl-1) to hi_max(jl) 914 pa_i(ji,jl) = pati(ji) * z1_hti(ji) * ( ( phti(ji) + 2.*hi_max(jl-1) ) * EXP( -2.*hi_max(jl-1)*z1_hti(ji) ) & 915 & - ( phti(ji) + 2.*hi_max(jl ) ) * EXP( -2.*hi_max(jl )*z1_hti(ji) ) ) 916 ! 917 ! volume : integrate ((4A/H^2)x^2exp(-2x/H))dx from x=hi_max(jl-1) to hi_max(jl) 918 zv = pati(ji) * z1_hti(ji) * ( ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jl-1) + 2.*hi_max(jl-1)*hi_max(jl-1) ) & 919 & * EXP( -2.*hi_max(jl-1)*z1_hti(ji) ) & 920 & - ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jl) + 2.*hi_max(jl)*hi_max(jl) ) & 921 & * EXP(-2.*hi_max(jl)*z1_hti(ji)) ) 922 ! thickness 923 IF( pa_i(ji,jl) > epsi06 ) THEN 924 ph_i(ji,jl) = zv / pa_i(ji,jl) 925 ELSE 926 ph_i(ji,jl) = 0. 927 pa_i(ji,jl) = 0. 928 ENDIF 929 ENDIF 930 ! 931 ENDDO 932 ENDDO 933 ! 934 ! for the last category (jpl), integrate the gamma function from hi_max(jpl-1) to infinity 935 DO ji = 1, idim 936 ! 937 IF( phti(ji) > 0._wp ) THEN 938 ! concentration : integrate ((4A/H^2)xexp(-2x/H))dx from x=hi_max(jpl-1) to infinity 939 pa_i(ji,jpl) = pati(ji) * z1_hti(ji) * ( phti(ji) + 2.*hi_max(jpl-1) ) * EXP( -2.*hi_max(jpl-1)*z1_hti(ji) ) 940 941 ! volume : integrate ((4A/H^2)x^2exp(-2x/H))dx from x=hi_max(jpl-1) to infinity 942 zv = pati(ji) * z1_hti(ji) * ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jpl-1) + 2.*hi_max(jpl-1)*hi_max(jpl-1) ) & 943 & * EXP( -2.*hi_max(jpl-1)*z1_hti(ji) ) 944 ! thickness 945 IF( pa_i(ji,jpl) > epsi06 ) THEN 946 ph_i(ji,jpl) = zv / pa_i(ji,jpl) 947 else 948 ph_i(ji,jpl) = 0. 949 pa_i(ji,jpl) = 0. 950 ENDIF 951 ENDIF 952 ! 953 ENDDO 954 ! 955 ! Add Snow in each category where pa_i is not 0 956 DO jl = 1, jpl 957 DO ji = 1, idim 958 IF( pa_i(ji,jl) > 0._wp ) THEN 959 ph_s(ji,jl) = ph_i(ji,jl) * phts(ji) * z1_hti(ji) 960 ! In case snow load is in excess that would lead to transformation from snow to ice 961 ! Then, transfer the snow excess into the ice (different from icethd_dh) 962 zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rau0 ) * ph_i(ji,jl) ) * r1_rau0 ) 963 ! recompute h_i, h_s avoiding out of bounds values 964 ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) 965 ph_s(ji,jl) = MAX( 0._wp, ph_s(ji,jl) - zdh * rhoi * r1_rhos ) 966 ENDIF 967 END DO 968 END DO 969 ! 970 DEALLOCATE( z1_hti ) 971 ! 972 ! == temperature and salinity == ! 973 DO jl = 1, jpl 974 pt_i (:,jl) = ptmi (:) 975 pt_s (:,jl) = ptms (:) 976 pt_su(:,jl) = ptmsu(:) 977 ps_i (:,jl) = psmi (:) 978 ps_i (:,jl) = psmi (:) 979 END DO 980 ! 981 ! == ponds == ! 982 ALLOCATE( zfra(idim) ) 983 ! keep the same pond fraction atip/ati for each category 984 WHERE( pati(:) /= 0._wp ) ; zfra(:) = patip(:) / pati(:) 985 ELSEWHERE ; zfra(:) = 0._wp 986 END WHERE 987 DO jl = 1, jpl 988 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 989 END DO 990 ! keep the same v_ip/v_i ratio for each category 991 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 992 ELSEWHERE ; zfra(:) = 0._wp 993 END WHERE 994 DO jl = 1, jpl 995 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 996 ELSEWHERE ; ph_ip(:,jl) = 0._wp 997 END WHERE 998 END DO 999 DEALLOCATE( zfra ) 1000 ! 1001 END SUBROUTINE ice_var_itd_1cMc 1002 1003 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1004 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 1005 !!------------------------------------------------------------------- 1006 !! 1007 !! ** Purpose : converting N-cat ice to jpl ice categories 1008 !! 1009 !! ice thickness distribution follows a gaussian law 1010 !! around the concentration of the most likely ice thickness 1011 !! (similar as iceistate.F90) 1012 !! 1013 !! ** Method: Iterative procedure 1014 !! 1015 !! 1) Fill ice cat that correspond to input thicknesses 1016 !! Find the lowest(jlmin) and highest(jlmax) cat that are filled 1017 !! 1018 !! 2) Expand the filling to the cat jlmin-1 and jlmax+1 1019 !! by removing 25% ice area from jlmin and jlmax (resp.) 1020 !! 1021 !! 3) Expand the filling to the empty cat between jlmin and jlmax 1022 !! by a) removing 25% ice area from the lower cat (ascendant loop jlmin=>jlmax) 1023 !! b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 1024 !! 1025 !! ** Arguments : phti: N-cat ice thickness 1026 !! phts: N-cat snow depth 1027 !! pati: N-cat ice concentration 1028 !! 1029 !! ** Output : jpl-cat 1030 !! 1031 !! (Example of application: BDY forcings when inputs have N-cat /= jpl) 1032 !!------------------------------------------------------------------- 1033 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1034 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1035 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds 1036 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds 1037 ! 1038 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 1039 INTEGER , ALLOCATABLE, DIMENSION(:) :: jlmax, jlmin 1040 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs, ztmp, zfra 1041 ! 1042 REAL(wp), PARAMETER :: ztrans = 0.25_wp 1043 INTEGER :: ji, jl, jl1, jl2 1044 INTEGER :: idim, icat 1045 !!------------------------------------------------------------------- 1046 ! 1047 idim = SIZE( phti, 1 ) 1048 icat = SIZE( phti, 2 ) 1049 ! 1050 ! == thickness and concentration == ! 1051 ! ! ---------------------- ! 1052 IF( icat == jpl ) THEN ! input cat = output cat ! 1053 ! ! ---------------------- ! 1054 ph_i(:,:) = phti(:,:) 1055 ph_s(:,:) = phts(:,:) 1056 pa_i(:,:) = pati(:,:) 1057 ! 1058 ! == temperature and salinity and ponds == ! 1059 pt_i (:,:) = ptmi (:,:) 1060 pt_s (:,:) = ptms (:,:) 1061 pt_su(:,:) = ptmsu(:,:) 1062 ps_i (:,:) = psmi (:,:) 1063 pa_ip(:,:) = patip(:,:) 1064 ph_ip(:,:) = phtip(:,:) 1065 ! ! ---------------------- ! 1066 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! 1067 ! ! ---------------------- ! 1068 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1069 & ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1070 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 1071 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:) ) 1072 ! ! ---------------------- ! 1073 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! 1074 ! ! ---------------------- ! 1075 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1076 & ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1077 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 1078 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1) ) 1079 ! ! ----------------------- ! 1080 ELSE ! input cat /= output cat ! 1081 ! ! ----------------------- ! 1082 1083 ALLOCATE( jlfil(idim,jpl), jlfil2(idim,jpl) ) ! allocate arrays 1084 ALLOCATE( jlmin(idim), jlmax(idim) ) 1085 1086 ! --- initialize output fields to 0 --- ! 1087 ph_i(1:idim,1:jpl) = 0._wp 1088 ph_s(1:idim,1:jpl) = 0._wp 1089 pa_i(1:idim,1:jpl) = 0._wp 1090 ! 1091 ! --- fill the categories --- ! 1092 ! find where cat-input = cat-output and fill cat-output fields 1093 jlmax(:) = 0 1094 jlmin(:) = 999 1095 jlfil(:,:) = 0 1096 DO jl1 = 1, jpl 1097 DO jl2 = 1, icat 1098 DO ji = 1, idim 1099 IF( hi_max(jl1-1) <= phti(ji,jl2) .AND. hi_max(jl1) > phti(ji,jl2) ) THEN 1100 ! fill the right category 1101 ph_i(ji,jl1) = phti(ji,jl2) 1102 ph_s(ji,jl1) = phts(ji,jl2) 1103 pa_i(ji,jl1) = pati(ji,jl2) 1104 ! record categories that are filled 1105 jlmax(ji) = MAX( jlmax(ji), jl1 ) 1106 jlmin(ji) = MIN( jlmin(ji), jl1 ) 1107 jlfil(ji,jl1) = jl1 1108 ENDIF 1109 END DO 1110 END DO 1111 END DO 1112 ! 1113 ! --- fill the gaps between categories --- ! 1114 ! transfer from categories filled at the previous step to the empty ones in between 1115 DO ji = 1, idim 1116 jl1 = jlmin(ji) 1117 jl2 = jlmax(ji) 1118 IF( jl1 > 1 ) THEN 1119 ! fill the lower cat (jl1-1) 1120 pa_i(ji,jl1-1) = ztrans * pa_i(ji,jl1) 1121 ph_i(ji,jl1-1) = hi_mean(jl1-1) 1122 ! remove from cat jl1 1123 pa_i(ji,jl1 ) = ( 1._wp - ztrans ) * pa_i(ji,jl1) 1124 ENDIF 1125 IF( jl2 < jpl ) THEN 1126 ! fill the upper cat (jl2+1) 1127 pa_i(ji,jl2+1) = ztrans * pa_i(ji,jl2) 1128 ph_i(ji,jl2+1) = hi_mean(jl2+1) 1129 ! remove from cat jl2 1130 pa_i(ji,jl2 ) = ( 1._wp - ztrans ) * pa_i(ji,jl2) 1131 ENDIF 1132 END DO 1133 ! 1134 jlfil2(:,:) = jlfil(:,:) 1135 ! fill categories from low to high 1136 DO jl = 2, jpl-1 1137 DO ji = 1, idim 1138 IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 1139 ! fill high 1140 pa_i(ji,jl) = ztrans * pa_i(ji,jl-1) 1141 ph_i(ji,jl) = hi_mean(jl) 1142 jlfil(ji,jl) = jl 1143 ! remove low 1144 pa_i(ji,jl-1) = ( 1._wp - ztrans ) * pa_i(ji,jl-1) 1145 ENDIF 1146 END DO 1147 END DO 1148 ! 1149 ! fill categories from high to low 1150 DO jl = jpl-1, 2, -1 1151 DO ji = 1, idim 1152 IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 1153 ! fill low 1154 pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 1155 ph_i(ji,jl) = hi_mean(jl) 1156 jlfil2(ji,jl) = jl 1157 ! remove high 1158 pa_i(ji,jl+1) = ( 1._wp - ztrans ) * pa_i(ji,jl+1) 1159 ENDIF 1160 END DO 1161 END DO 1162 ! 1163 DEALLOCATE( jlfil, jlfil2 ) ! deallocate arrays 1164 DEALLOCATE( jlmin, jlmax ) 1165 ! 1166 ! == temperature and salinity == ! 1167 ! 1168 ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 1169 ! 1170 WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp ) ; z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 1171 ELSEWHERE ; z1_ai(:) = 0._wp 1172 END WHERE 1173 WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp ) ; z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 1174 ELSEWHERE ; z1_vi(:) = 0._wp 1175 END WHERE 1176 WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp ) ; z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 1177 ELSEWHERE ; z1_vs(:) = 0._wp 1178 END WHERE 1179 ! 1180 ! fill all the categories with the same value 1181 ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1182 DO jl = 1, jpl 1183 pt_i (:,jl) = ztmp(:) 1184 END DO 1185 ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 1186 DO jl = 1, jpl 1187 pt_s (:,jl) = ztmp(:) 1188 END DO 1189 ztmp(:) = SUM( ptmsu(:,:) * pati(:,:) , dim=2 ) * z1_ai(:) 1190 DO jl = 1, jpl 1191 pt_su(:,jl) = ztmp(:) 1192 END DO 1193 ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 1194 DO jl = 1, jpl 1195 ps_i (:,jl) = ztmp(:) 1196 END DO 1197 ! 1198 DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 1199 ! 1200 ! == ponds == ! 1201 ALLOCATE( zfra(idim) ) 1202 ! keep the same pond fraction atip/ati for each category 1203 WHERE( SUM( pati(:,:), dim=2 ) /= 0._wp ) ; zfra(:) = SUM( patip(:,:), dim=2 ) / SUM( pati(:,:), dim=2 ) 1204 ELSEWHERE ; zfra(:) = 0._wp 1205 END WHERE 1206 DO jl = 1, jpl 1207 pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 1208 END DO 1209 ! keep the same v_ip/v_i ratio for each category 1210 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1211 zfra(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1212 ELSEWHERE 1213 zfra(:) = 0._wp 1214 END WHERE 1215 DO jl = 1, jpl 1216 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1217 ELSEWHERE ; ph_ip(:,jl) = 0._wp 1218 END WHERE 1219 END DO 1220 DEALLOCATE( zfra ) 1221 ! 1222 ENDIF 1223 ! 1224 END SUBROUTINE ice_var_itd_NcMc 1000 1225 1001 1226 #else -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/ICE/icewri.F90
r10425 r11822 50 50 INTEGER :: ji, jj, jk, jl ! dummy loop indices 51 51 REAL(wp) :: z2da, z2db, zrho1, zrho2 52 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zfast ! 2D workspace 52 REAL(wp) :: zmiss_val ! missing value retrieved from xios 53 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zfast ! 2D workspace 53 54 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask 54 55 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zmsk00l, zmsksnl ! cat masks … … 58 59 REAL(wp) :: zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 59 60 !!------------------------------------------------------------------- 60 61 ! 61 62 IF( ln_timing ) CALL timing_start('icewri') 63 64 ! get missing value from xml 65 CALL iom_miss_val( 'icetemp', zmiss_val ) 62 66 63 67 ! brine volume … … 85 89 ! Standard outputs 86 90 !----------------- 87 zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau091 zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau0 88 92 ! masks 89 IF( iom_use('icemask' ) ) CALL iom_put( "icemask" , zmsk00 ) ! ice mask 0% 90 IF( iom_use('icemask05') ) CALL iom_put( "icemask05", zmsk05 ) ! ice mask 5% 91 IF( iom_use('icemask15') ) CALL iom_put( "icemask15", zmsk15 ) ! ice mask 15% 93 CALL iom_put( 'icemask' , zmsk00 ) ! ice mask 0% 94 CALL iom_put( 'icemask05', zmsk05 ) ! ice mask 5% 95 CALL iom_put( 'icemask15', zmsk15 ) ! ice mask 15% 96 CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0) 92 97 ! 93 98 ! general fields 94 IF( iom_use('icemass' ) ) CALL iom_put( "icemass", rhoi * vt_i * zmsk00 ) ! Ice mass per cell area 95 IF( iom_use('snwmass' ) ) CALL iom_put( "snwmass", rhos * vt_s * zmsksn ) ! Snow mass per cell area 96 IF( iom_use('icepres' ) ) CALL iom_put( "icepres", zmsk00 ) ! Ice presence (1 or 0) 97 IF( iom_use('iceconc' ) ) CALL iom_put( "iceconc", at_i * zmsk00 ) ! ice concentration 98 IF( iom_use('icevolu' ) ) CALL iom_put( "icevolu", vt_i * zmsk00 ) ! ice volume = mean ice thickness over the cell 99 IF( iom_use('icethic' ) ) CALL iom_put( "icethic", hm_i * zmsk00 ) ! ice thickness 100 IF( iom_use('snwthic' ) ) CALL iom_put( "snwthic", hm_s * zmsk00 ) ! snw thickness 101 IF( iom_use('icebrv' ) ) CALL iom_put( "icebrv" , bvm_i * zmsk00 * 100. ) ! brine volume 102 IF( iom_use('iceage' ) ) CALL iom_put( "iceage" , om_i * zmsk00 / rday ) ! ice age 103 IF( iom_use('icehnew' ) ) CALL iom_put( "icehnew", ht_i_new ) ! new ice thickness formed in the leads 104 IF( iom_use('snwvolu' ) ) CALL iom_put( "snwvolu", vt_s * zmsksn ) ! snow volume 105 IF( iom_use('icefrb') ) THEN 99 IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 ) ! Ice mass per cell area 100 IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s * rhos * zmsksn ) ! Snow mass per cell area 101 IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i * zmsk00 ) ! ice concentration 102 IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i * zmsk00 ) ! ice volume = mean ice thickness over the cell 103 IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i * zmsk00 ) ! ice thickness 104 IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s * zmsk00 ) ! snw thickness 105 IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i* 100. * zmsk00 ) ! brine volume 106 IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age 107 IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new ) ! new ice thickness formed in the leads 108 IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s * zmsksn ) ! snow volume 109 IF( iom_use('icefrb' ) ) THEN ! Ice freeboard 106 110 z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) ) 107 111 WHERE( z2d < 0._wp ) z2d = 0._wp 108 CALL iom_put( "icefrb" , z2d * zmsk00 ) ! Ice freeboard112 CALL iom_put( 'icefrb' , z2d * zmsk00 ) 109 113 ENDIF 110 !111 114 ! melt ponds 112 IF( iom_use('iceapnd' ) ) CALL iom_put( "iceapnd", at_ip * zmsk00 )! melt pond total fraction113 IF( iom_use('ice vpnd' ) ) CALL iom_put( "icevpnd", vt_ip * zmsk00 ) ! melt pond total volume per unit area114 !115 IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip * zmsk00 ) ! melt pond total fraction 116 IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip * zmsk00 ) ! melt pond depth 117 IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip * zmsk00 ) ! melt pond total volume per unit area 115 118 ! salt 116 IF( iom_use('icesalt' ) ) CALL iom_put( "icesalt", sm_i * zmsk00 ) ! mean ice salinity 117 IF( iom_use('icesalm' ) ) CALL iom_put( "icesalm", SUM( sv_i, DIM = 3 ) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area 118 119 IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity 120 IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area 119 121 ! heat 120 IF( iom_use('icetemp' ) ) CALL iom_put( "icetemp", ( tm_i - rt0 ) * zmsk00 ) ! ice mean temperature 121 IF( iom_use('snwtemp' ) ) CALL iom_put( "snwtemp", ( tm_s - rt0 ) * zmsksn ) ! snw mean temperature 122 IF( iom_use('icettop' ) ) CALL iom_put( "icettop", ( tm_su - rt0 ) * zmsk00 ) ! temperature at the ice surface 123 IF( iom_use('icetbot' ) ) CALL iom_put( "icetbot", ( t_bo - rt0 ) * zmsk00 ) ! temperature at the ice bottom 124 IF( iom_use('icetsni' ) ) CALL iom_put( "icetsni", ( tm_si - rt0 ) * zmsk00 ) ! temperature at the snow-ice interface 125 IF( iom_use('icehc' ) ) CALL iom_put( "icehc" , -et_i * zmsk00 ) ! ice heat content 126 IF( iom_use('snwhc' ) ) CALL iom_put( "snwhc" , -et_s * zmsksn ) ! snow heat content 127 122 IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature 123 IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature 124 IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface 125 IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom 126 IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface 127 IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i * zmsk00 ) ! ice heat content 128 IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s * zmsksn ) ! snow heat content 128 129 ! momentum 129 IF( iom_use('uice' ) ) CALL iom_put( "uice" , u_ice ) ! ice velocity u component 130 IF( iom_use('vice' ) ) CALL iom_put( "vice" , v_ice ) ! ice velocity v component 131 IF( iom_use('utau_ai' ) ) CALL iom_put( "utau_ai", utau_ice * zmsk00 ) ! Wind stress term in force balance (x) 132 IF( iom_use('vtau_ai' ) ) CALL iom_put( "vtau_ai", vtau_ice * zmsk00 ) ! Wind stress term in force balance (y) 133 134 IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN 135 ! module of ice velocity 130 IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice ) ! ice velocity u 131 IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice ) ! ice velocity v 132 ! 133 IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity 136 134 DO jj = 2 , jpjm1 137 135 DO ji = 2 , jpim1 138 z2da = ( u_ice(ji,jj) + u_ice(ji-1,jj))139 z2db = ( v_ice(ji,jj) + v_ice(ji,jj-1))136 z2da = u_ice(ji,jj) + u_ice(ji-1,jj) 137 z2db = v_ice(ji,jj) + v_ice(ji,jj-1) 140 138 z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 141 139 END DO 142 140 END DO 143 141 CALL lbc_lnk( 'icewri', z2d, 'T', 1. ) 144 IF( iom_use('icevel') ) CALL iom_put( "icevel" , z2d ) 145 146 ! record presence of fast ice 147 WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk00(:,:) == 1._wp ) ; zfast(:,:) = 1._wp 142 CALL iom_put( 'icevel', z2d ) 143 144 WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice 148 145 ELSEWHERE ; zfast(:,:) = 0._wp 149 146 END WHERE 150 IF( iom_use('fasticepres') ) CALL iom_put( "fasticepres", zfast )147 CALL iom_put( 'fasticepres', zfast ) 151 148 ENDIF 152 149 153 150 ! --- category-dependent fields --- ! 154 IF( iom_use('icemask_cat' ) ) CALL iom_put( "icemask_cat" , zmsk00l ) ! ice mask 0% 155 IF( iom_use('iceconc_cat' ) ) CALL iom_put( "iceconc_cat" , a_i * zmsk00l ) ! area for categories 156 IF( iom_use('icethic_cat' ) ) CALL iom_put( "icethic_cat" , h_i * zmsk00l ) ! thickness for categories 157 IF( iom_use('snwthic_cat' ) ) CALL iom_put( "snwthic_cat" , h_s * zmsksnl ) ! snow depth for categories 158 IF( iom_use('icesalt_cat' ) ) CALL iom_put( "icesalt_cat" , s_i * zmsk00l ) ! salinity for categories 159 IF( iom_use('iceage_cat' ) ) CALL iom_put( "iceage_cat" , o_i * zmsk00l / rday ) ! ice age 160 IF( iom_use('icetemp_cat' ) ) CALL iom_put( "icetemp_cat" , ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zmsk00l ) ! ice temperature 161 IF( iom_use('snwtemp_cat' ) ) CALL iom_put( "snwtemp_cat" , ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zmsksnl ) ! snow temperature 162 IF( iom_use('icettop_cat' ) ) CALL iom_put( "icettop_cat" , ( t_su - rt0 ) * zmsk00l ) ! surface temperature 163 IF( iom_use('icebrv_cat' ) ) CALL iom_put( "icebrv_cat" , bv_i * 100. * zmsk00l ) ! brine volume 164 IF( iom_use('iceapnd_cat' ) ) CALL iom_put( "iceapnd_cat" , a_ip * zmsk00l ) ! melt pond frac for categories 165 IF( iom_use('icehpnd_cat' ) ) CALL iom_put( "icehpnd_cat" , h_ip * zmsk00l ) ! melt pond frac for categories 166 IF( iom_use('iceafpnd_cat') ) CALL iom_put( "iceafpnd_cat", a_ip_frac * zmsk00l ) ! melt pond frac for categories 151 IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0% 152 IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i * zmsk00l ) ! area for categories 153 IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories 154 IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories 155 IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories 156 IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i / rday * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice age 157 IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i, dim=3 ) * r1_nlay_i - rt0 ) & 158 & * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature 159 IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s, dim=3 ) * r1_nlay_s - rt0 ) & 160 & * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature 161 IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su - rt0 ) * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! surface temperature 162 IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i * 100. * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 163 IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip * zmsk00l ) ! melt pond frac for categories 164 IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories 165 IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac * zmsk00l ) ! melt pond frac for categories 166 IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 167 167 168 168 !------------------ … … 170 170 !------------------ 171 171 ! trends 172 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 thermodynamics173 IF( iom_use('dmidyn') ) CALL iom_put( "dmidyn", - wfx_dyn + rhoi * diag_trp_vi )! Sea-ice mass change from dynamics(kg/m2/s)174 IF( iom_use('dmiopw') ) CALL iom_put( "dmiopw", - wfx_opw )! Sea-ice mass change through growth in open water175 IF( iom_use('dmibog') ) CALL iom_put( "dmibog", - wfx_bog )! Sea-ice mass change through basal growth176 IF( iom_use('dmisni') ) CALL iom_put( "dmisni", - wfx_sni )! Sea-ice mass change through snow-to-ice conversion177 IF( iom_use('dmisum') ) CALL iom_put( "dmisum", - wfx_sum )! Sea-ice mass change through surface melting178 IF( iom_use('dmibom') ) CALL iom_put( "dmibom", - wfx_bom )! Sea-ice mass change through bottom melting179 IF( iom_use('dmtsub') ) CALL iom_put( "dmtsub", - wfx_sub )! Sea-ice mass change through evaporation and sublimation180 IF( iom_use('dmssub') ) CALL iom_put( "dmssub", - wfx_snw_sub )! Snow mass change through sublimation181 IF( iom_use('dmisub') ) CALL iom_put( "dmisub", - wfx_ice_sub )! Sea-ice mass change through sublimation182 IF( iom_use('dmsspr') ) CALL iom_put( "dmsspr", - wfx_spr )! Snow mass change through snow fall183 IF( iom_use('dmsssi') ) CALL iom_put( "dmsssi", wfx_sni*rhos*r1_rhoi )! Snow mass change through snow-to-ice conversion184 IF( iom_use('dmsmel') ) CALL iom_put( "dmsmel", - wfx_snw_sum )! Snow mass change through melt185 IF( iom_use('dmsdyn') ) CALL iom_put( "dmsdyn", - wfx_snw_dyn + rhos * diag_trp_vs )! Snow mass change through dynamics(kg/m2/s)186 172 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 173 IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s) 174 IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water 175 IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth 176 IF( iom_use('dmisni') ) CALL iom_put( 'dmisni', - wfx_sni ) ! Sea-ice mass change through snow-to-ice conversion 177 IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting 178 IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting 179 IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation 180 IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation 181 IF( iom_use('dmisub') ) CALL iom_put( 'dmisub', - wfx_ice_sub ) ! Sea-ice mass change through sublimation 182 IF( iom_use('dmsspr') ) CALL iom_put( 'dmsspr', - wfx_spr ) ! Snow mass change through snow fall 183 IF( iom_use('dmsssi') ) CALL iom_put( 'dmsssi', wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion 184 IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt 185 IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s) 186 187 187 ! Global ice diagnostics 188 IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') ) THEN ! NH diagnostics 189 ! 190 WHERE( ff_t > 0._wp ) ; zmsk00(:,:) = 1.0e-12 191 ELSEWHERE ; zmsk00(:,:) = 0. 192 END WHERE 193 zdiag_area_nh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 194 zdiag_volu_nh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 195 ! 196 WHERE( ff_t > 0._wp .AND. at_i > 0.15 ) ; zmsk00(:,:) = 1.0e-12 197 ELSEWHERE ; zmsk00(:,:) = 0. 198 END WHERE 199 zdiag_extt_nh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) ) 200 ! 201 IF( iom_use('NH_icearea') ) CALL iom_put( "NH_icearea" , zdiag_area_nh ) 202 IF( iom_use('NH_icevolu') ) CALL iom_put( "NH_icevolu" , zdiag_volu_nh ) 203 IF( iom_use('NH_iceextt') ) CALL iom_put( "NH_iceextt" , zdiag_extt_nh ) 188 IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & 189 & iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN 190 ! 191 WHERE( ff_t(:,:) > 0._wp ) ; z2d(:,:) = 1._wp 192 ELSEWHERE ; z2d(:,:) = 0. 193 END WHERE 194 ! 195 IF( iom_use('NH_icearea') ) zdiag_area_nh = glob_sum( 'icewri', at_i * z2d * e1e2t * 1.e-12 ) 196 IF( iom_use('NH_icevolu') ) zdiag_volu_nh = glob_sum( 'icewri', vt_i * z2d * e1e2t * 1.e-12 ) 197 IF( iom_use('NH_iceextt') ) zdiag_extt_nh = glob_sum( 'icewri', z2d * e1e2t * 1.e-12 * zmsk15 ) 198 ! 199 IF( iom_use('SH_icearea') ) zdiag_area_sh = glob_sum( 'icewri', at_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 200 IF( iom_use('SH_icevolu') ) zdiag_volu_sh = glob_sum( 'icewri', vt_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 201 IF( iom_use('SH_iceextt') ) zdiag_extt_sh = glob_sum( 'icewri', ( 1._wp - z2d ) * e1e2t * 1.e-12 * zmsk15 ) 202 ! 203 CALL iom_put( 'NH_icearea' , zdiag_area_nh ) 204 CALL iom_put( 'NH_icevolu' , zdiag_volu_nh ) 205 CALL iom_put( 'NH_iceextt' , zdiag_extt_nh ) 206 CALL iom_put( 'SH_icearea' , zdiag_area_sh ) 207 CALL iom_put( 'SH_icevolu' , zdiag_volu_sh ) 208 CALL iom_put( 'SH_iceextt' , zdiag_extt_sh ) 204 209 ! 205 210 ENDIF 206 !207 IF( iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN ! SH diagnostics208 !209 WHERE( ff_t < 0._wp ); zmsk00(:,:) = 1.0e-12;210 ELSEWHERE ; zmsk00(:,:) = 0.211 END WHERE212 zdiag_area_sh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )213 zdiag_volu_sh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )214 !215 WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zmsk00(:,:) = 1.0e-12216 ELSEWHERE ; zmsk00(:,:) = 0.217 END WHERE218 zdiag_extt_sh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) )219 !220 IF( iom_use('SH_icearea') ) CALL iom_put( "SH_icearea", zdiag_area_sh )221 IF( iom_use('SH_icevolu') ) CALL iom_put( "SH_icevolu", zdiag_volu_sh )222 IF( iom_use('SH_iceextt') ) CALL iom_put( "SH_iceextt", zdiag_extt_sh )223 !224 ENDIF225 211 ! 226 212 !!CR ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 227 213 !!CR ! IF( kindic < 0 ) CALL ice_wri_state( 'output.abort' ) 228 214 !!CR ! not yet implemented 229 !!gm idem for the ocean... Ask Seb how to get r ead of ioipsl....215 !!gm idem for the ocean... Ask Seb how to get rid of ioipsl.... 230 216 ! 231 217 IF( ln_timing ) CALL timing_stop('icewri')
Note: See TracChangeset
for help on using the changeset viewer.
