- Timestamp:
- 2014-11-28T14:59:01+01:00 (10 years ago)
- Location:
- branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 26 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r4333 r4921 105 105 !! ** Global variables | 106 106 !!-------------|-------------|---------------------------------|-------| 107 !! a_i | a_i_ b| Ice concentration | |107 !! a_i | a_i_1d | Ice concentration | | 108 108 !! v_i | - | Ice volume per unit area | m | 109 109 !! v_s | - | Snow volume per unit area | m | … … 111 111 !! oa_i ! - ! Sea ice areal age content | day | 112 112 !! e_i ! - ! Ice enthalpy | 10^9 J| 113 !! - ! q_i_ b! Ice enthalpy per unit vol. | J/m3 |113 !! - ! q_i_1d ! Ice enthalpy per unit vol. | J/m3 | 114 114 !! e_s ! - ! Snow enthalpy | 10^9 J| 115 !! - ! q_s_ b! Snow enthalpy per unit vol. | J/m3 |115 !! - ! q_s_1d ! Snow enthalpy per unit vol. | J/m3 | 116 116 !! | 117 117 !!-------------|-------------|---------------------------------|-------| … … 120 120 !!-------------|-------------|---------------------------------|-------| 121 121 !! | 122 !! ht_i | ht_i_ b| Ice thickness | m |123 !! ht_s ! ht_s_ b| Snow depth | m |124 !! sm_i ! sm_i_ b| Sea ice bulk salinity ! ppt |125 !! s_i ! s_i_ b| Sea ice salinity profile ! ppt |122 !! ht_i | ht_i_1d | Ice thickness | m | 123 !! ht_s ! ht_s_1d | Snow depth | m | 124 !! sm_i ! sm_i_1d | Sea ice bulk salinity ! ppt | 125 !! s_i ! s_i_1d | Sea ice salinity profile ! ppt | 126 126 !! o_i ! - | Sea ice Age ! days | 127 !! t_i ! t_i_ b| Sea ice temperature ! K |128 !! t_s ! t_s_ b| Snow temperature ! K |129 !! t_su ! t_su_ b| Sea ice surface temperature ! K |127 !! t_i ! t_i_1d | Sea ice temperature ! K | 128 !! t_s ! t_s_1d | Snow temperature ! K | 129 !! t_su ! t_su_1d | Sea ice surface temperature ! K | 130 130 !! | 131 131 !! notes: the ice model only sees a bulk (i.e., vertically averaged) | … … 142 142 !! *** Category-summed state variables (diagnostic) *** | 143 143 !! ******************************************************************* | 144 !! at_i | at_i_ b| Total ice concentration | |144 !! at_i | at_i_1d | Total ice concentration | | 145 145 !! vt_i | - | Total ice vol. per unit area | m | 146 146 !! vt_s | - | Total snow vol. per unit ar. | m | … … 166 166 167 167 ! !!** ice-dynamic namelist (namicedyn) ** 168 INTEGER , PUBLIC :: nbiter !: number of sub-time steps for relaxation169 INTEGER , PUBLIC :: nbitdr !: maximum number of iterations for relaxation170 168 INTEGER , PUBLIC :: nevp !: number of iterations for subcycling 171 INTEGER , PUBLIC :: nlay_i = 5 !: number of layers in the ice172 173 ! !!** ice-dynamic namelist (namicedyn) **174 169 REAL(wp), PUBLIC :: epsd !: tolerance parameter for dynamic 175 REAL(wp), PUBLIC :: alpha !: coefficient for semi-implicit coriolis176 REAL(wp), PUBLIC :: dm !: diffusion constant for dynamics177 170 REAL(wp), PUBLIC :: om !: relaxation constant 178 REAL(wp), PUBLIC :: resl !: maximum value for the residual of relaxation179 171 REAL(wp), PUBLIC :: cw !: drag coefficient for oceanic stress 180 172 REAL(wp), PUBLIC :: angvg !: turning angle for oceanic stress 181 173 REAL(wp), PUBLIC :: pstar !: determines ice strength (N/M), Hibler JPO79 182 174 REAL(wp), PUBLIC :: c_rhg !: determines changes in ice strength 183 REAL(wp), PUBLIC :: etamn !: minimun value for viscosity : has to be 0184 175 REAL(wp), PUBLIC :: creepl !: creep limit : has to be under 1.0e-9 185 176 REAL(wp), PUBLIC :: ecc !: eccentricity of the elliptical yield curve 186 177 REAL(wp), PUBLIC :: ahi0 !: sea-ice hor. eddy diffusivity coeff. (m2/s) 187 REAL(wp), PUBLIC :: telast !: timescale for elastic waves (s) !SB 188 REAL(wp), PUBLIC :: alphaevp !: coeficient of the internal stresses !SB 178 REAL(wp), PUBLIC :: telast !: timescale for elastic waves (s) 179 REAL(wp), PUBLIC :: relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 180 REAL(wp), PUBLIC :: alphaevp !: coeficient of the internal stresses 189 181 REAL(wp), PUBLIC :: unit_fac = 1.e+09_wp !: conversion factor for ice / snow enthalpy 190 REAL(wp), PUBLIC :: hminrhg = 0.001_wp !: clem: ice volume (a*h, in m) below which ice velocity is set to ocean velocity182 REAL(wp), PUBLIC :: hminrhg !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 191 183 192 184 ! !!** ice-salinity namelist (namicesal) ** … … 202 194 203 195 ! !!** ice-salinity namelist (namicesal) ** 204 INTEGER , PUBLIC :: num_sal !: salinity configuration used in the model196 INTEGER , PUBLIC :: num_sal !: salinity configuration used in the model 205 197 ! ! 1 - constant salinity in both space and time 206 198 ! ! 2 - prognostic salinity (s(z,t)) 207 199 ! ! 3 - salinity profile, constant in time 208 INTEGER , PUBLIC :: sal_prof = 1 !: salinity profile or not 209 INTEGER , PUBLIC :: thcon_i_swi !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) 200 INTEGER , PUBLIC :: thcon_i_swi !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 210 201 211 202 ! !!** ice-mechanical redistribution namelist (namiceitdme) … … 220 211 REAL(wp), PUBLIC :: Craft !: coefficient for smoothness of the hyperbolic tangent in rafting 221 212 REAL(wp), PUBLIC :: ridge_por !: initial porosity of ridges (0.3 regular value) 222 REAL(wp), PUBLIC :: sal_max_ridge !: maximum ridged ice salinity (ppt)223 213 REAL(wp), PUBLIC :: betas !: coef. for partitioning of snowfall between leads and sea ice 224 214 REAL(wp), PUBLIC :: kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] … … 228 218 ! !!** ice-mechanical redistribution namelist (namiceitdme) 229 219 INTEGER , PUBLIC :: ridge_scheme_swi !: scheme used for ice ridging 230 INTEGER , PUBLIC :: raft swi!: rafting of ice or not220 INTEGER , PUBLIC :: raft_swi !: rafting of ice or not 231 221 INTEGER , PUBLIC :: partfun_swi !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 232 INTEGER , PUBLIC :: transfun_swi !: transfer function: =0 Hibler 1980, =1 Lipscomb et al. 2007233 222 INTEGER , PUBLIC :: brinstren_swi !: use brine volume to diminish ice strength 234 223 … … 249 238 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 250 239 ! 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: firic !: IR flux over the ice (diag only)252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcsic !: Sensible heat flux over the ice (diag only)253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fleic !: Latent heat flux over the ice (diag only)254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlatic !: latent flux255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvosif !: Variation of volume at surface (diag only)256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvobif !: Variation of ice volume at the bottom ice (diag only)257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdvolif !: Total variation of ice volume (diag only)258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvonif !: Lateral Variation of ice volume (diag only)259 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Average Sea-Ice Surface Temperature [Kelvin] 260 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icethi !: total ice thickness (for all categories) (diag only) 261 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicifp !: Ice production/melting==>!obsolete... can be removed263 243 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction 264 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfrld !: Leads fraction at previous time 265 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: phicif !: Old ice thickness 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbif !: Heat flux at the ice base 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_snw !: Variation of snow mass over 1 time step [Kg/m2] 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_snw !: Heat content associated with rdm_snw [J/m2] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_ice !: Variation of ice mass over 1 time step [Kg/m2] 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_ice !: Heat content associated with rdm_ice [J/m2] 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qldif !: heat balance of the lead (or of the open ocean) 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qcmif !: Energy needed to bring the ocean to freezing 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdtcn !: net downward heat flux from the ice to the ocean 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qdtcn !: energy from the ice to the ocean 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric !: transmitted solar radiation under ice 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fscmbq !: associated with lead chipotage with solar flux 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ffltbif !: related to max heat contained in brine pockets (?) 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsbbq !: Also linked with the solar flux below the ice (?) 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qfvbq !: store energy in case of total lateral ablation (?) 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dmgwi !: Variation of the mass of snow ice 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_thd !: salt flux due to ice growth/melt [PSU/m2/s] 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlead !: heat balance of the lead (or of the open ocean) 247 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhtur !: net downward heat flux from the ice to the ocean 248 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 249 250 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange over 1 time step [kg/m2] 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice over 1 time step [kg/m2] 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow sublimation over 1 time step [kg/m2] 253 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange over 1 time step [kg/m2] 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg/m2] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg/m2] 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg/m2] 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg/m2] 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg/m2] 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg/m2] 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg/m2] 262 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s] 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice growth/melt [PSU/m2/s] 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to ice growth/melt [PSU/m2/s] 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to ice growth/melt [PSU/m2/s] 282 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [PSU/m2/s] 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_ mec!: salt flux due to porous ridged ice formation [PSU/m2/s]269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [PSU/m2/s] 284 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: residual salt flux due to correction of ice thickness [PSU/m2/s] 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhbri !: heat flux due to brine rejection 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_mec !: heat flux associated with porous ridged ice formation [???] 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_res !: residual heat flux due to correction of ice thickness 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmec !: mass flux due to snow loss during compression [Kg/m2/s] 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhmec !: heat flux due to snow loss during compression 271 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sum !: total heat flux causing surface ice melt 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_opw !: total heat flux causing open water ice formation 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dif !: total heat flux causing Temp change in the ice 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in !: heat flux available for thermo transformations 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_out !: heat flux remaining at the end of thermo transformations 282 283 ! heat flux associated with ice-atmosphere mass exchange 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sub !: heat flux for sublimation 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_spr !: heat flux of the snow precipitation 286 287 ! heat flux associated with ice-ocean mass exchange 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (limthd_dh) 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from mecanical processes (limitd_me) 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness 291 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 290 293 291 294 ! temporary arrays for dummy version of the code 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D,q_s295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, q_s 293 296 294 297 !!-------------------------------------------------------------------------- … … 321 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 322 325 323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: at_i_typ !: total area contained in each ice type [m^2]324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vt_i_typ !: total volume contained in each ice type [m^3]325 326 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 327 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 328 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_i_cat !: ! go to trash330 328 331 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] … … 348 346 !! * Old values of global variables 349 347 !!-------------------------------------------------------------------------- 350 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: old_v_s, old_v_i!: snow and ice volumes351 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: old_a_i, old_smv_i, old_oa_i !: ???352 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: old_e_s!: snow heat content353 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: old_e_i!: ice temperatures354 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: old_u_ice, old_v_ice !: ice velocity (gv6 and gv7)348 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s_b, v_i_b !: snow and ice volumes 349 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, smv_i_b, oa_i_b !: 350 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content 351 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures 352 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity 355 353 356 354 … … 375 373 !! * Ice thickness distribution variables 376 374 !!-------------------------------------------------------------------------- 377 ! REMOVE378 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ice_types !: Vector connecting types and categories379 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ice_cat_bounds !: Matrix containing the integer upper and380 ! ! lower boundaries of ice thickness categories381 ! REMOVE382 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ice_ncat_types !: nb of thickness categories in each ice type383 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 384 376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 385 ! REMOVE386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hi_max_typ !: Boundary of ice thickness categories in thickness space387 377 388 378 !!-------------------------------------------------------------------------- … … 404 394 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 405 395 LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F) 406 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: v_newice !: volume of ice formed in the leads 407 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates 408 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: izero, fstroc, fhbricat 409 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sni_gr ! snow ice growth 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_lat_gr ! lateral ice growth 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_gr ! bottom ice growth 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_dyn_gr ! dynamical ice growth 413 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_me ! vertical bottom melt 414 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sur_me ! vertical surface melt 415 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_res_pr ! production (growth+melt) due to limupdate 416 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi ! transport of ice volume 396 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates 397 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: izero 398 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 399 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume 400 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2) 401 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2) 402 ! 403 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat_dhc !: snw/ice heat content variation [W/m2] 404 ! 417 405 INTEGER , PUBLIC :: jiindx, jjindx !: indexes of the debugging point 418 406 … … 447 435 448 436 ii = ii + 1 449 ALLOCATE( firic (jpi,jpj) , fcsic (jpi,jpj) , fleic (jpi,jpj) , qlatic (jpi,jpj) ,&450 & rdvosif (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif (jpi,jpj) ,&451 & sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , hicifp (jpi,jpj) ,&452 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , fbif(jpi,jpj) , &453 & rdm_snw (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice(jpi,jpj) , rdq_ice(jpi,jpj) , &454 & qldif (jpi,jpj) , qcmif (jpi,jpj) ,&455 & fdtcn (jpi,jpj) , qdtcn (jpi,jpj) , fstric (jpi,jpj) , fscmbq (jpi,jpj) ,&456 & ffltbif (jpi,jpj) , fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) ,&457 & sfx_res (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) ,&458 & fhbri (jpi,jpj) , fmmec (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec (jpi,jpj) ,&459 & fheat_res(jpi,jpj) , STAT=ierr(ii) )460 461 ii = ii + 1 462 ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) , &463 & fsup2D (jpi,jpj) , focea2D (jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) )437 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , & 438 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 439 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , & 440 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 441 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , qlead (jpi,jpj) , & 442 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl) , & 443 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 444 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 445 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 446 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) , & 447 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 448 & hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , STAT=ierr(ii) ) 449 450 ii = ii + 1 451 ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) ) 464 452 465 453 ! * Ice global state variables … … 475 463 & bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) ) 476 464 ii = ii + 1 477 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,&478 & e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) ,STAT=ierr(ii) )479 ii = ii + 1 480 ALLOCATE( t_i(jpi,jpj, jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) )465 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , & 466 & e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 467 ii = ii + 1 468 ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) ) 481 469 482 470 ! * Moments for advection … … 494 482 & STAT=ierr(ii) ) 495 483 ii = ii + 1 496 ALLOCATE( sxe (jpi,jpj, jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) , &497 & syye(jpi,jpj, jkmax,jpl) , sxye(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) )484 ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) , & 485 & syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) ) 498 486 499 487 ! * Old values of global variables 500 488 ii = ii + 1 501 ALLOCATE( old_v_s (jpi,jpj,jpl) , old_v_i (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) , &502 & old_a_i (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax,jpl) , &503 & o ld_oa_i(jpi,jpj,jpl) , &504 & old_u_ice(jpi,jpj) , old_v_ice(jpi,jpj) , STAT=ierr(ii) )489 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 490 & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) , & 491 & oa_i_b (jpi,jpj,jpl) , & 492 & u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 505 493 506 494 ! * Increment of global variables … … 512 500 & STAT=ierr(ii) ) 513 501 ii = ii + 1 514 ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj, jkmax,jpl) , d_u_ice_dyn(jpi,jpj) , &515 & d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj, jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )502 ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i+1,jpl) , d_u_ice_dyn(jpi,jpj) , & 503 & d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i+1,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 516 504 517 505 ! * Ice thickness distribution variables 518 506 ii = ii + 1 519 ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types (jpm) , & 520 & hi_max (0:jpl) , hi_mean(jpl) , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) ) 507 ALLOCATE( hi_max(0:jpl), hi_mean(jpl), STAT=ierr(ii) ) 521 508 522 509 ! * Ice diagnostics 523 510 ii = ii + 1 524 ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) , & 525 & izero (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) , & 526 & fstroc (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) , & 527 & fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(jpi,jpj) , STAT=ierr(ii) ) 511 ALLOCATE( dv_dt_thd(jpi,jpj,jpl), izero (jpi,jpj,jpl), & 512 & diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj), & 513 & diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj), STAT=ierr(ii) ) 528 514 529 515 ice_alloc = MAXVAL( ierr(:) ) -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r4624 r4921 66 66 ! 67 67 ! ! adequation jpk versus ice/snow layers/categories 68 IF( jpl > jpk .OR. jpm > jpk .OR.&69 jkmax > jpk .OR. nlay_s > jpk ) CALL ctl_stop( 'STOP',&68 IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) & 69 & CALL ctl_stop( 'STOP', & 70 70 & 'ice_init: the 3rd dimension of workspace arrays is too small.', & 71 71 & 'use more ocean levels or less ice/snow layers/categories.' ) … … 89 89 CALL lim_itd_ini ! ice thickness distribution initialization 90 90 ! 91 CALL lim_itd_me_init ! ice thickness distribution initialization 91 92 ! ! Initial sea-ice state 92 93 IF( .NOT. ln_rstart ) THEN ! start from rest … … 173 174 !! limistate (only) and is changed to 99 m in ice_init 174 175 !!------------------------------------------------------------------ 175 INTEGER :: jl , jm! dummy loop index176 INTEGER :: jl ! dummy loop index 176 177 REAL(wp) :: zc1, zc2, zc3, zx1 ! local scalars 177 178 !!------------------------------------------------------------------ … … 184 185 ! 1) Ice thickness distribution parameters initialization 185 186 !------------------------------------------------------------------------------! 186 187 !- Types boundaries (integer)188 !----------------------------189 ice_cat_bounds(1,1) = 1190 ice_cat_bounds(1,2) = jpl191 192 !- Number of ice thickness categories in each ice type193 DO jm = 1, jpm194 ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1195 END DO196 197 !- Make the correspondence between thickness categories and ice types198 !---------------------------------------------------------------------199 DO jm = 1, jpm !over types200 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories201 ice_types(jl) = jm202 END DO203 END DO204 205 187 IF(lwp) THEN 206 WRITE(numout,*) ' Number of ice types jpm = ', jpm207 188 WRITE(numout,*) ' Number of ice categories jpl = ', jpl 208 DO jm = 1, jpm209 WRITE(numout,*) ' Ice type ', jm210 WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm)211 WRITE(numout,*) ' Thickness category boundaries ', ice_cat_bounds(jm,1:2)212 END DO213 WRITE(numout,*) 'Ice type vector', ice_types(1:jpl)214 WRITE(numout,*)215 189 ENDIF 216 190 … … 218 192 !---------------------------------- 219 193 hi_max(:) = 0._wp 220 hi_max_typ(:,:) = 0._wp 221 222 !- Type 1 - undeformed ice 223 zc1 = 3._wp / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp ) 194 195 zc1 = 3._wp / REAL( jpl, wp ) 224 196 zc2 = 10._wp * zc1 225 197 zc3 = 3._wp 226 198 227 DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)228 zx1 = REAL( jl-1 , wp ) / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1, wp )199 DO jl = 1, jpl 200 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 229 201 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 230 202 END DO 231 203 232 !- Fill in the hi_max_typ vector, useful in other circumstances 233 ! Tricky trick: hi_max_typ is actually not used in the code and will be removed in a 234 ! next flyspray at this time, the tricky trick will also be removed (Martin, march 08) 235 DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 236 hi_max_typ(jl,1) = hi_max(jl) 237 END DO 238 239 IF(lwp) WRITE(numout,*) ' Thickness category boundaries independently of ice type ' 204 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 240 205 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 241 206 242 IF(lwp) WRITE(numout,*) ' Thickness category boundaries inside ice types '243 IF(lwp) THEN244 DO jm = 1, jpm245 WRITE(numout,*) ' Type number ', jm246 WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm)247 END DO248 ENDIF249 207 ! 250 208 DO jl = 1, jpl -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r4161 r4921 32 32 33 33 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 34 REAL(wp) :: rzero = 0._wp ! - -35 REAL(wp) :: rone = 1._wp ! - -36 34 37 35 !! * Substitutions … … 84 82 DO jj = 1, jpj 85 83 DO ji = 1, jpi 86 zslpmax = MAX( rzero, ps0(ji,jj) )84 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 87 85 zs1max = 1.5 * zslpmax 88 86 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 89 87 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 90 88 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) ) 91 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask89 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 92 90 93 91 ps0 (ji,jj) = zslpmax … … 106 104 DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0 107 105 DO ji = 1, jpi 108 zbet(ji,jj) = MAX( rzero, SIGN( rone, put(ji,jj) ) )109 zalf = MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)106 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 107 zalf = MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 110 108 zalfq = zalf * zalf 111 109 zalf1 = 1.0 - zalf … … 133 131 DO jj = 1, jpjm1 ! Flux from i+1 to i when u LT 0. 134 132 DO ji = 1, fs_jpim1 135 zalf = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)133 zalf = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 136 134 zalg (ji,jj) = zalf 137 135 zalfq = zalf * zalf … … 269 267 DO jj = 1, jpj 270 268 DO ji = 1, jpi 271 zslpmax = MAX( rzero, ps0(ji,jj) )269 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 272 270 zs1max = 1.5 * zslpmax 273 271 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 274 272 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 275 273 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 276 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask274 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 277 275 ! 278 276 ps0 (ji,jj) = zslpmax … … 291 289 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 292 290 DO ji = 1, jpi 293 zbet(ji,jj) = MAX( rzero, SIGN( rone, pvt(ji,jj) ) )294 zalf = MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)291 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 292 zalf = MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 295 293 zalfq = zalf * zalf 296 294 zalf1 = 1.0 - zalf … … 318 316 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 319 317 DO ji = 1, jpi 320 zalf = ( MAX( rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)318 zalf = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 321 319 zalg (ji,jj) = zalf 322 320 zalfq = zalf * zalf -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r4161 r4921 7 7 !! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation 8 8 !! 4.0 ! 2011-02 (G. Madec) add mpp considerations 9 !! - ! 2014-05 (C. Rousset) add lim_cons_hsm 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim3 … … 14 15 !! lim_cons : checks whether energy, mass and salt are conserved 15 16 !!---------------------------------------------------------------------- 17 USE phycst ! physical constants 16 18 USE par_ice ! LIM-3 parameter 17 19 USE ice ! LIM-3 variables … … 28 30 PUBLIC lim_column_sum_energy 29 31 PUBLIC lim_cons_check 32 PUBLIC lim_cons_hsm 30 33 31 34 !!---------------------------------------------------------------------- … … 70 73 !! ** Method : Arithmetics 71 74 !!--------------------------------------------------------------------- 72 INTEGER , INTENT(in ) :: ksum !: number of categories73 INTEGER , INTENT(in ) :: klay !: number of vertical layers74 REAL(wp), DIMENSION(jpi,jpj, jkmax,jpl), INTENT(in ) :: pin !: input field75 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field75 INTEGER , INTENT(in ) :: ksum !: number of categories 76 INTEGER , INTENT(in ) :: klay !: number of vertical layers 77 REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in ) :: pin !: input field 78 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field 76 79 ! 77 80 INTEGER :: jk, jl ! dummy loop indices … … 151 154 END SUBROUTINE lim_cons_check 152 155 156 157 SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 158 !!------------------------------------------------------------------- 159 !! *** ROUTINE lim_cons_hsm *** 160 !! 161 !! ** Purpose : Test the conservation of heat, salt and mass for each routine 162 !! 163 !! ** Method : 164 !!--------------------------------------------------------------------- 165 INTEGER , INTENT(in) :: icount ! determine wether this is the beggining of the routine (0) or the end (1) 166 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 167 REAL(wp) , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 168 REAL(wp) :: zvi, zsmv, zei, zfs, zfw, zft 169 REAL(wp) :: zvmin, zamin, zamax 170 171 IF( icount == 0 ) THEN 172 173 zvi_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 174 zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 175 zei_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 176 zfw_b = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 177 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 178 & ) * area(:,:) * tms(:,:) ) 179 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 180 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 181 & ) * area(:,:) * tms(:,:) ) 182 zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 183 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 184 & ) * area(:,:) / unit_fac * tms(:,:) ) 185 186 ELSEIF( icount == 1 ) THEN 187 188 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 189 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 190 & ) * area(:,:) * tms(:,:) ) - zfs_b 191 zfw = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 192 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 193 & ) * area(:,:) * tms(:,:) ) - zfw_b 194 zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 195 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 196 & ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b 197 198 zvi = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw 199 zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic ) 200 zei = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft 201 202 zvmin = glob_min(v_i) 203 zamax = glob_max(SUM(a_i,dim=3)) 204 zamin = glob_min(a_i) 205 206 IF(lwp) THEN 207 IF ( ABS( zvi ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (',cd_routine,') = ',(zvi * rday) 208 IF ( ABS( zsmv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 209 IF ( ABS( zei ) > 1. ) WRITE(numout,*) 'violation enthalpy [1e9 J] (',cd_routine,') = ',(zei) 210 IF ( zvmin < 0. ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',(zvmin) 211 IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 212 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 213 ENDIF 214 IF ( zamin < 0. ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 215 ENDIF 216 217 ENDIF 218 219 END SUBROUTINE lim_cons_hsm 220 153 221 #else 154 222 !!---------------------------------------------------------------------- -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r4909 r4921 18 18 USE dom_oce ! ocean domain 19 19 USE sbc_oce ! surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: sea-ice fields 20 21 USE daymod ! model calendar 21 22 USE phycst ! physical constant … … 37 38 REAL(dp) :: bg_grme ! global ice growth+melt trends 38 39 REAL(wp) :: epsi06 = 1.e-6_wp ! small number 39 REAL(wp) :: epsi03 = 1.e-3_wp ! small number40 41 40 42 41 !! * Substitutions … … 60 59 !! 61 60 REAL(dp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 62 REAL(dp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec 63 REAL(dp) :: zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res 61 REAL(dp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, & 62 & zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn 63 REAL(dp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 64 REAL(dp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub 65 REAL(dp) :: zbg_hfx_dhc, zbg_hfx_spr 66 REAL(dp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in 67 REAL(dp) :: zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 64 68 REAL(dp) :: z_frc_vol, z_frc_sal, z_bg_grme 65 69 REAL(dp) :: z1_area ! - - … … 86 90 !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 87 91 88 zbg_ihc = glob_sum( et_i(:,:) * 1.e-11 ) ! ice heat content [10^9*1.e-11 J] 89 zbg_shc = glob_sum( et_s(:,:) * 1.e-11 ) ! snow heat content [10^9*1.e-11 J] 90 91 zbg_emp = zinda * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 92 zbg_emp_bog = zinda * glob_sum( diag_bot_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 93 zbg_emp_lag = zinda * glob_sum( diag_lat_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 94 zbg_emp_sig = zinda * glob_sum( diag_sni_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 95 zbg_emp_dyg = zinda * glob_sum( diag_dyn_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 96 zbg_emp_bom = zinda * glob_sum( diag_bot_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 97 zbg_emp_sum = zinda * glob_sum( diag_sur_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 98 zbg_emp_res = zinda * glob_sum( diag_res_pr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 99 92 ! Volume 93 zbg_vfx = zinda * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 94 zbg_vfx_bog = zinda * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 95 zbg_vfx_opw = zinda * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 96 zbg_vfx_sni = zinda * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 97 zbg_vfx_dyn = zinda * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 98 zbg_vfx_bom = zinda * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 99 zbg_vfx_sum = zinda * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 100 zbg_vfx_res = zinda * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 101 zbg_vfx_spr = zinda * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 102 zbg_vfx_snw = zinda * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 103 zbg_vfx_sub = zinda * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 104 105 ! Salt 100 106 zbg_sfx = zinda * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 101 107 zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 102 zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday103 108 zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 104 zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 105 109 zbg_sfx_dyn = zinda * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 110 111 zbg_sfx_bog = zinda * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 112 zbg_sfx_opw = zinda * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 113 zbg_sfx_sni = zinda * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 114 zbg_sfx_bom = zinda * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 115 zbg_sfx_sum = zinda * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 116 117 ! Heat budget 118 zbg_ihc = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content [1.e-20 J] 119 zbg_shc = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 120 zbg_hfx_dhc = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W] 121 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 122 123 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 124 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 125 zbg_hfx_res = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 126 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 127 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 128 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W] 129 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W] 130 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W] 131 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W] 132 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 133 zbg_hfx_out = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 134 zbg_hfx_in = glob_sum( hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 135 106 136 ! --------------------------------------------- ! 107 137 ! 2 - Trends due to forcing and ice growth/melt ! … … 109 139 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 110 140 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 111 z_bg_grme = glob_sum( ( diag_bot_gr(:,:) + diag_lat_gr(:,:) + diag_sni_gr(:,:) + diag_dyn_gr(:,:) + &112 & diag_bot_me(:,:) + diag_sur_me(:,:) + diag_res_pr(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes141 z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 142 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 113 143 ! 114 144 frc_vol = frc_vol + z_frc_vol * rdt_ice … … 134 164 CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) 135 165 136 CALL iom_put( 'ibgemp' , zbg_emp ) ! volume flux emp (m/day liquid) 137 CALL iom_put( 'ibgempbog' , zbg_emp_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 138 CALL iom_put( 'ibgemplag' , zbg_emp_lag ) ! volume flux open water growth - 139 CALL iom_put( 'ibgempsig' , zbg_emp_sig ) ! volume flux snow ice growth - 140 CALL iom_put( 'ibgempdyg' , zbg_emp_dyg ) ! volume flux dynamic growth - 141 CALL iom_put( 'ibgempbom' , zbg_emp_bom ) ! volume flux bottom melt - 142 CALL iom_put( 'ibgempsum' , zbg_emp_sum ) ! volume flux surface melt - 143 CALL iom_put( 'ibgempres' , zbg_emp_res ) ! volume flux resultant - 166 CALL iom_put( 'ibgvfx' , zbg_vfx ) ! volume flux emp (m/day liquid) 167 CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 168 CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw ) ! volume flux open water growth - 169 CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni ) ! volume flux snow ice growth - 170 CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn ) ! volume flux dynamic growth - 171 CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom ) ! volume flux bottom melt - 172 CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum ) ! volume flux surface melt - 173 CALL iom_put( 'ibgvfxres' , zbg_vfx_res ) ! volume flux resultant - 174 CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr ) ! volume flux from snow precip - 175 CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw ) ! volume flux from snow melt - 176 CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub ) ! volume flux from sublimation - 144 177 145 178 CALL iom_put( 'ibgsfx' , zbg_sfx ) ! salt flux -(psu*m/day equivalent liquid) 146 179 CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri ) ! salt flux brines - 147 CALL iom_put( 'ibgsfxthd' , zbg_sfx_thd ) ! salt flux thermo - 148 CALL iom_put( 'ibgsfxmec' , zbg_sfx_mec ) ! salt flux dynamic - 180 CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn ) ! salt flux dynamic - 149 181 CALL iom_put( 'ibgsfxres' , zbg_sfx_res ) ! salt flux result - 182 CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog ) ! salt flux bottom growth 183 CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw ) ! salt flux open water growth - 184 CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni ) ! salt flux snow ice growth - 185 CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom ) ! salt flux bottom melt - 186 CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum ) ! salt flux surface melt - 187 188 CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc ) ! Heat content variation in snow and ice [W] 189 CALL iom_put( 'ibghfxspr' , zbg_hfx_spr ) ! Heat content of snow precip [W] 190 191 CALL iom_put( 'ibghfxres' , zbg_hfx_res ) ! 192 CALL iom_put( 'ibghfxsub' , zbg_hfx_sub ) ! 193 CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn ) ! 194 CALL iom_put( 'ibghfxthd' , zbg_hfx_thd ) ! 195 CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw ) ! 196 CALL iom_put( 'ibghfxsum' , zbg_hfx_sum ) ! 197 CALL iom_put( 'ibghfxbom' , zbg_hfx_bom ) ! 198 CALL iom_put( 'ibghfxbog' , zbg_hfx_bog ) ! 199 CALL iom_put( 'ibghfxdif' , zbg_hfx_dif ) ! 200 CALL iom_put( 'ibghfxopw' , zbg_hfx_opw ) ! 201 CALL iom_put( 'ibghfxout' , zbg_hfx_out ) ! 202 CALL iom_put( 'ibghfxin' , zbg_hfx_in ) ! 150 203 151 204 CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) 152 205 CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) 153 CALL iom_put( 'ibggrme' , bg_grme * rhoic * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 206 CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 207 154 208 ! 155 209 IF( lrst_ice ) CALL lim_diahsb_rst( numit, 'WRITE' ) -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r4624 r4921 30 30 USE lib_fortran ! glob_sum 31 31 USE timing ! Timing 32 USE limcons ! conservation tests 32 33 33 34 IMPLICIT NONE … … 66 67 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 67 68 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io ! ice-ocean velocity 68 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)69 REAL(wp) :: z chk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)69 ! 70 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 70 71 !!--------------------------------------------------------------------- 71 72 … … 75 76 CALL wrk_alloc( jpj, zind, zmsk ) 76 77 77 ! -------------------------------78 !- check conservation (C Rousset)79 IF (ln_limdiahsb) THEN80 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )81 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )82 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) )83 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) )84 ENDIF85 !- check conservation (C Rousset)86 ! -------------------------------87 88 78 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) 89 79 90 80 IF( ln_limdyn ) THEN 91 81 ! 92 old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 93 old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) 82 ! conservation test 83 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 84 85 u_ice_b(:,:) = u_ice(:,:) * tmu(:,:) 86 v_ice_b(:,:) = v_ice(:,:) * tmv(:,:) 94 87 95 88 ! Rheology (ice dynamics) … … 171 164 END DO 172 165 END DO 166 ! 167 ! conservation test 168 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 173 169 ! 174 170 ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean … … 224 220 ENDIF 225 221 ! 226 ! -------------------------------227 !- check conservation (C Rousset)228 IF (ln_limdiahsb) THEN229 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b230 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b231 232 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice233 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic )234 235 zchk_vmin = glob_min(v_i)236 zchk_amax = glob_max(SUM(a_i,dim=3))237 zchk_amin = glob_min(a_i)238 239 IF(lwp) THEN240 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limdyn) = ',(zchk_v_i * rday)241 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limdyn) = ',(zchk_smv * rday)242 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limdyn) = ',(zchk_vmin * 1.e-3)243 !IF ( zchk_amax > amax+1.e-10 ) WRITE(numout,*) 'violation a_i>amax (limdyn) = ',zchk_amax244 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limdyn) = ',zchk_amin245 ENDIF246 ENDIF247 !- check conservation (C Rousset)248 ! -------------------------------249 250 222 CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 251 223 CALL wrk_dealloc( jpj, zind, zmsk ) … … 269 241 !!------------------------------------------------------------------- 270 242 INTEGER :: ios ! Local integer output status for namelist read 271 NAMELIST/namicedyn/ epsd, alpha, & 272 & dm, nbiter, nbitdr, om, resl, cw, angvg, pstar, & 273 & c_rhg, etamn, creepl, ecc, ahi0, & 274 & nevp, telast, alphaevp, hminrhg 243 NAMELIST/namicedyn/ epsd, om, cw, angvg, pstar, & 244 & c_rhg, creepl, ecc, ahi0, & 245 & nevp, relast, alphaevp, hminrhg 275 246 !!------------------------------------------------------------------- 276 247 … … 289 260 WRITE(numout,*) '~~~~~~~~~~~~' 290 261 WRITE(numout,*) ' tolerance parameter epsd = ', epsd 291 WRITE(numout,*) ' coefficient for semi-implicit coriolis alpha = ', alpha292 WRITE(numout,*) ' diffusion constant for dynamics dm = ', dm293 WRITE(numout,*) ' number of sub-time steps for relaxation nbiter = ', nbiter294 WRITE(numout,*) ' maximum number of iterations for relaxation nbitdr = ', nbitdr295 262 WRITE(numout,*) ' relaxation constant om = ', om 296 WRITE(numout,*) ' maximum value for the residual of relaxation resl = ', resl297 263 WRITE(numout,*) ' drag coefficient for oceanic stress cw = ', cw 298 264 WRITE(numout,*) ' turning angle for oceanic stress angvg = ', angvg 299 265 WRITE(numout,*) ' first bulk-rheology parameter pstar = ', pstar 300 266 WRITE(numout,*) ' second bulk-rhelogy parameter c_rhg = ', c_rhg 301 WRITE(numout,*) ' minimun value for viscosity etamn = ', etamn302 267 WRITE(numout,*) ' creep limit creepl = ', creepl 303 268 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc 304 269 WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0 305 270 WRITE(numout,*) ' number of iterations for subcycling nevp = ', nevp 306 WRITE(numout,*) ' timescale for elastic waves telast = ', telast271 WRITE(numout,*) ' ratio of elastic timescale over ice time step relast = ', relast 307 272 WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp 308 273 WRITE(numout,*) ' min ice thickness for rheology calculations hminrhg = ', hminrhg … … 322 287 pstarh = pstar * 0.5_wp 323 288 289 ! elastic damping 290 telast = relast * rdt_ice 291 324 292 ! Diffusion coefficients. 325 293 ahiu(:,:) = ahi0 * umask(:,:,1) -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4909 r4921 26 26 USE dom_ice ! sea-ice domain 27 27 USE in_out_manager ! I/O manager 28 USE lbclnk ! lateral boundary condition - MPP exchanges29 28 USE lib_mpp ! MPP library 30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 30 USE wrk_nemo ! work arrays 31 USE cpl_oasis3, ONLY : lk_cpl 32 32 33 33 IMPLICIT NONE … … 38 38 !! * Module variables 39 39 ! !!** init namelist (namiceini) ** 40 REAL(wp) :: ttest ! threshold water temperature for initial sea ice 41 REAL(wp) :: hninn ! initial snow thickness in the north 42 REAL(wp) :: hnins ! initial snow thickness in the south 43 REAL(wp) :: hginn ! initial ice thickness in the north 44 REAL(wp) :: hgins ! initial ice thickness in the south 45 REAL(wp) :: aginn ! initial leads area in the north 46 REAL(wp) :: agins ! initial leads area in the south 47 REAL(wp) :: sinn ! initial salinity 48 REAL(wp) :: sins 49 40 REAL(wp) :: thres_sst ! threshold water temperature for initial sea ice 41 REAL(wp) :: hts_ini_n ! initial snow thickness in the north 42 REAL(wp) :: hts_ini_s ! initial snow thickness in the south 43 REAL(wp) :: hti_ini_n ! initial ice thickness in the north 44 REAL(wp) :: hti_ini_s ! initial ice thickness in the south 45 REAL(wp) :: ati_ini_n ! initial leads area in the north 46 REAL(wp) :: ati_ini_s ! initial leads area in the south 47 REAL(wp) :: smi_ini_n ! initial salinity 48 REAL(wp) :: smi_ini_s ! initial salinity 49 REAL(wp) :: tmi_ini_n ! initial temperature 50 REAL(wp) :: tmi_ini_s ! initial temperature 51 52 LOGICAL :: ln_limini ! initialization or not 50 53 !!---------------------------------------------------------------------- 51 54 !! LIM 3.0, UCL-LOCEAN-IPSL (2008) … … 90 93 INTEGER :: i_hemis, i_fill, jl0 91 94 REAL(wp) :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 92 REAL(wp), POINTER, DIMENSION(:) :: zh m_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini93 REAL(wp), POINTER, DIMENSION(:,:) :: zh t_i_ini, za_i_ini, zv_i_ini94 REAL(wp), POINTER, DIMENSION(:,:) :: z idto! ice indicator95 REAL(wp), POINTER, DIMENSION(:) :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 96 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i_ini, za_i_ini, zv_i_ini 97 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 95 98 INTEGER, POINTER, DIMENSION(:,:) :: zhemis ! hemispheric index 96 99 !-------------------------------------------------------------------- 97 100 98 CALL wrk_alloc( jpi, jpj, z idto)101 CALL wrk_alloc( jpi, jpj, zswitch ) 99 102 CALL wrk_alloc( jpi, jpj, zhemis ) 100 CALL wrk_alloc( jpl, 2, zht_i_ini, za_i_ini, zv_i_ini ) 101 CALL wrk_alloc( 2, zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 102 103 epsi20 = 1.0e-20 103 CALL wrk_alloc( jpl, 2, zh_i_ini, za_i_ini, zv_i_ini ) 104 CALL wrk_alloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 105 106 epsi20 = 1.e-20_wp 107 104 108 IF(lwp) WRITE(numout,*) 105 109 IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' … … 112 116 CALL lim_istate_init ! reading the initials parameters of the ice 113 117 114 !!gm in lim2 the initialisation if only done if required in the namelist : 115 !!gm IF( .NOT. ln_limini ) THEN 116 !!gm this should be added in lim3 namelist... 118 # if defined key_coupled 119 albege(:,:) = 0.8 * tms(:,:) 120 # endif 121 122 ! surface temperature 123 DO jl = 1, jpl ! loop over categories 124 t_su (:,:,jl) = rtt * tms(:,:) 125 tn_ice(:,:,jl) = rtt * tms(:,:) 126 END DO 127 ! Basal temperature is set to the freezing point of seawater in Kelvin 128 t_bo(:,:) = ( tfreez( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:) 129 130 IF( ln_limini ) THEN 117 131 118 132 !-------------------------------------------------------------------- 119 133 ! 2) Basal temperature, ice mask and hemispheric index 120 134 !-------------------------------------------------------------------- 121 122 ! Basal temperature is set to the freezing point of seawater in Celsius 123 t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius] 124 125 DO jj = 1, jpj ! ice if sst <= t-freez + ttest 135 ! ice if sst <= t-freez + thres_sst 136 DO jj = 1, jpj 126 137 DO ji = 1, jpi 127 IF( tsn(ji,jj,1,jp_tem) - t_bo(ji,jj) >= ttest ) THEN ; zidto(ji,jj) = 0._wp ! no ice 128 ELSE ; zidto(ji,jj) = 1._wp ! ice 138 IF( ( tsn(ji,jj,1,jp_tem) - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN 139 zswitch(ji,jj) = 0._wp * tms(ji,jj) ! no ice 140 ELSE 141 zswitch(ji,jj) = 1._wp * tms(ji,jj) ! ice 129 142 ENDIF 130 143 END DO 131 144 END DO 132 145 133 t_bo(:,:) = t_bo(:,:) + rt0 ! conversion to Kelvin134 146 135 147 ! Hemispheric index … … 153 165 ! 3.1) Hemisphere-dependent arrays 154 166 !----------------------------- 155 ! assign initial thickness, concentration, snow depth and salinity to 156 ! an hemisphere-dependent array 157 zhm_i_ini(1) = hginn ; zhm_i_ini(2) = hgins ! ice thickness 158 zat_i_ini(1) = aginn ; zat_i_ini(2) = agins ! ice concentration 159 zvt_i_ini(:) = zhm_i_ini(:) * zat_i_ini(:) ! ice volume 160 zhm_s_ini(1) = hninn ; zhm_s_ini(2) = hnins ! snow depth 161 zsm_i_ini(1) = sinn ; zsm_i_ini(2) = sins ! bulk ice salinity 167 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 168 zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s ! ice thickness 169 zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s ! snow depth 170 zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s ! ice concentration 171 zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s ! bulk ice salinity 172 ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s ! temperature (ice and snow) 173 174 zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:) ! ice volume 162 175 163 176 !--------------------------------------------------------------------- … … 183 196 ! *** 1 category to fill 184 197 IF ( i_fill .EQ. 1 ) THEN 185 zh t_i_ini(1,i_hemis) = zhm_i_ini(i_hemis)186 za_i_ini(1,i_hemis) 187 zh t_i_ini(2:jpl,i_hemis) = 0._wp188 za_i_ini(2:jpl,i_hemis) 198 zh_i_ini(1,i_hemis) = zht_i_ini(i_hemis) 199 za_i_ini(1,i_hemis) = zat_i_ini(i_hemis) 200 zh_i_ini(2:jpl,i_hemis) = 0._wp 201 za_i_ini(2:jpl,i_hemis) = 0._wp 189 202 ELSE 190 203 191 ! *** >1 categores to fill192 !--- Ice thicknesses in the i_fill - 1 first categories204 ! *** >1 categores to fill 205 !--- Ice thicknesses in the i_fill - 1 first categories 193 206 DO jl = 1, i_fill - 1 194 zh t_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1) )207 zh_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 195 208 END DO 196 197 !--- jl0: most likely index where cc will be maximum209 210 !--- jl0: most likely index where cc will be maximum 198 211 DO jl = 1, jpl 199 IF ( ( zh m_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. &200 ( zhm_i_ini(i_hemis) .LE. hi_max(jl) ) ) THEN212 IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 213 ( zht_i_ini(i_hemis) .LE. hi_max(jl) ) ) THEN 201 214 jl0 = jl 202 215 ENDIF 203 216 END DO 204 217 jl0 = MIN(jl0, i_fill) 205 206 !--- Concentrations218 219 !--- Concentrations 207 220 za_i_ini(jl0,i_hemis) = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 208 221 DO jl = 1, i_fill - 1 209 222 IF ( jl .NE. jl0 ) THEN 210 zsigma = 0.5 * zh m_i_ini(i_hemis)211 zarg = ( zh t_i_ini(jl,i_hemis) - zhm_i_ini(i_hemis) ) / zsigma223 zsigma = 0.5 * zht_i_ini(i_hemis) 224 zarg = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 212 225 za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 213 226 ENDIF 214 END DO 215 227 END DO 228 216 229 zA = 0. ! sum of the areas in the jpl categories 217 230 DO jl = 1, i_fill - 1 … … 221 234 IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 222 235 223 !--- Ice thickness in the last category236 !--- Ice thickness in the last category 224 237 zV = 0. ! sum of the volumes of the N-1 categories 225 238 DO jl = 1, i_fill - 1 226 zV = zV + za_i_ini(jl,i_hemis)*zh t_i_ini(jl,i_hemis)239 zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 227 240 END DO 228 zh t_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)229 IF ( i_fill .LT. jpl ) zh t_i_ini(i_fill+1:jpl, i_hemis) = 0._wp230 231 !--- volumes232 zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh t_i_ini(:,i_hemis)241 zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis) 242 IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 243 244 !--- volumes 245 zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 233 246 IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 234 247 … … 262 275 263 276 ! Test 3: thickness of the last category is in-bounds ? 264 IF ( zh t_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN277 IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 265 278 ztest_3 = 1 266 279 ELSE 267 280 ! this write is useful 268 IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh t_i_ini(i_fill,i_hemis) = ', &269 zh t_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1)281 IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 282 zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 270 283 ztest_3 = 0 271 284 ENDIF … … 291 304 IF ( ztests .NE. 4 ) THEN 292 305 WRITE(numout,*) 293 WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 294 WRITE(numout,*) ' !!!! RED ALERT !!! ' 295 WRITE(numout,*) ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 306 WRITE(numout,*) ' !!!! ALERT !!! ' 296 307 WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 297 WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '298 308 WRITE(numout,*) 299 309 WRITE(numout,*) ' *** ztests is not equal to 4 ' 300 310 WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 301 311 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis) 302 WRITE(numout,*) ' zh m_i_ini : ', zhm_i_ini(i_hemis)312 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis) 303 313 ENDIF ! ztests .NE. 4 304 314 ENDIF … … 314 324 DO jj = 1, jpj 315 325 DO ji = 1, jpi 316 a_i(ji,jj,jl) = z idto(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration317 ht_i(ji,jj,jl) = z idto(ji,jj) * zht_i_ini(jl,zhemis(ji,jj)) ! ice thickness318 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zh m_s_ini( zhemis(ji,jj) ) / zhm_i_ini( zhemis(ji,jj) ) ) ! snow depth319 sm_i(ji,jj,jl) = z idto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min ! salinity320 o_i(ji,jj,jl) = z idto(ji,jj) * 1._wp + ( 1._wp - zidto(ji,jj) ) ! age321 t_su(ji,jj,jl) = z idto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * 270.0! surf temp326 a_i(ji,jj,jl) = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration 327 ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness 328 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) ) ! snow depth 329 sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 330 o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 331 t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 322 332 323 333 ! This case below should not be used if (ht_s/ht_i) is ok in namelist … … 343 353 DO jj = 1, jpj 344 354 DO ji = 1, jpi 345 t_s(ji,jj,jk,jl) = z idto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt355 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 346 356 ! Snow energy of melting 347 e_s(ji,jj,jk,jl) = z idto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )357 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 348 358 ! Change dimensions 349 359 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 350 ! Multiply by volume, so that heat content in 10^9Joules360 ! Multiply by volume, so that heat content in Joules 351 361 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 352 362 END DO ! ji … … 360 370 DO jj = 1, jpj 361 371 DO ji = 1, jpi 362 t_i(ji,jj,jk,jl) = z idto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt363 s_i(ji,jj,jk,jl) = z idto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min372 t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 373 s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 364 374 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 365 375 366 376 ! heat content per unit volume 367 e_i(ji,jj,jk,jl) = z idto(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) &377 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) & 368 378 + lfus * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 369 379 - rcp * ( ztmelts - rtt ) ) … … 372 382 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 373 383 374 ! Mutliply by ice volume, and divide by number of layers 375 ! to get heat content in 10^9 J 384 ! Mutliply by ice volume, and divide by number of layers to get heat content in J 376 385 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 377 386 END DO ! ji … … 380 389 END DO ! jk 381 390 391 tn_ice (:,:,:) = t_su (:,:,:) 392 393 ELSE 394 ! if ln_limini=false 395 a_i (:,:,:) = 0._wp 396 v_i (:,:,:) = 0._wp 397 v_s (:,:,:) = 0._wp 398 smv_i(:,:,:) = 0._wp 399 oa_i (:,:,:) = 0._wp 400 ht_i (:,:,:) = 0._wp 401 ht_s (:,:,:) = 0._wp 402 sm_i (:,:,:) = 0._wp 403 o_i (:,:,:) = 0._wp 404 405 e_i(:,:,:,:) = 0._wp 406 e_s(:,:,:,:) = 0._wp 407 408 DO jl = 1, jpl 409 DO jk = 1, nlay_i 410 t_i(:,:,jk,jl) = rtt * tms(:,:) 411 END DO 412 DO jk = 1, nlay_s 413 t_s(:,:,jk,jl) = rtt * tms(:,:) 414 END DO 415 END DO 416 417 ENDIF ! ln_limini 418 419 at_i (:,:) = 0.0_wp 420 DO jl = 1, jpl 421 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 422 END DO 423 ! 382 424 !-------------------------------------------------------------------- 383 425 ! 4) Global ice variables for output diagnostics | 384 426 !-------------------------------------------------------------------- 385 fsbbq (:,:) = 0._wp386 427 u_ice (:,:) = 0._wp 387 428 v_ice (:,:) = 0._wp … … 390 431 stress12_i(:,:) = 0._wp 391 432 392 # if defined key_coupled393 albege(:,:) = 0.8 * tms(:,:)394 # endif395 396 433 !-------------------------------------------------------------------- 397 434 ! 5) Moments for advection … … 428 465 sxyage (:,:,:) = 0._wp 429 466 430 !-------------------------------------------------------------------- 431 ! 6) Lateral boundary conditions | 432 !-------------------------------------------------------------------- 433 434 DO jl = 1, jpl 435 436 CALL lbc_lnk( a_i(:,:,jl) , 'T', 1. ) 437 CALL lbc_lnk( v_i(:,:,jl) , 'T', 1. ) 438 CALL lbc_lnk( v_s(:,:,jl) , 'T', 1. ) 439 CALL lbc_lnk( smv_i(:,:,jl), 'T', 1. ) 440 CALL lbc_lnk( oa_i(:,:,jl) , 'T', 1. ) 441 442 CALL lbc_lnk( ht_i(:,:,jl) , 'T', 1. ) 443 CALL lbc_lnk( ht_s(:,:,jl) , 'T', 1. ) 444 CALL lbc_lnk( sm_i(:,:,jl) , 'T', 1. ) 445 CALL lbc_lnk( o_i(:,:,jl) , 'T', 1. ) 446 CALL lbc_lnk( t_su(:,:,jl) , 'T', 1. ) 447 DO jk = 1, nlay_s 448 CALL lbc_lnk(t_s(:,:,jk,jl), 'T', 1. ) 449 CALL lbc_lnk(e_s(:,:,jk,jl), 'T', 1. ) 450 END DO 451 DO jk = 1, nlay_i 452 CALL lbc_lnk(t_i(:,:,jk,jl), 'T', 1. ) 453 CALL lbc_lnk(e_i(:,:,jk,jl), 'T', 1. ) 454 END DO 455 ! 456 a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 457 END DO 458 459 at_i (:,:) = 0.0_wp 460 DO jl = 1, jpl 461 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 462 END DO 463 464 CALL lbc_lnk( at_i , 'T', 1. ) 465 at_i(:,:) = tms(:,:) * at_i(:,:) ! put 0 over land 466 ! 467 CALL lbc_lnk( fsbbq , 'T', 1. ) 468 ! 469 !-------------------------------------------------------------------- 470 ! 6) ???? | 471 !-------------------------------------------------------------------- 472 tn_ice (:,:,:) = t_su (:,:,:) 473 474 CALL wrk_dealloc( jpi, jpj, zidto ) 467 468 CALL wrk_dealloc( jpi, jpj, zswitch ) 475 469 CALL wrk_dealloc( jpi, jpj, zhemis ) 476 CALL wrk_dealloc( jpl, 2, zh t_i_ini, za_i_ini, zv_i_ini )477 CALL wrk_dealloc( 2, zh m_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini )470 CALL wrk_dealloc( jpl, 2, zh_i_ini, za_i_ini, zv_i_ini ) 471 CALL wrk_dealloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 478 472 479 473 END SUBROUTINE lim_istate … … 495 489 !! 8.5 ! 07-11 (M. Vancoppenolle) rewritten initialization 496 490 !!----------------------------------------------------------------------------- 497 NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins498 !491 NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s, & 492 & ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 499 493 INTEGER :: ios ! Local integer output status for namelist read 500 494 !!----------------------------------------------------------------------------- … … 516 510 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 517 511 WRITE(numout,*) '~~~~~~~~~~~~~~~' 518 WRITE(numout,*) ' threshold water temp. for initial sea-ice ttest = ', ttest 519 WRITE(numout,*) ' initial snow thickness in the north hninn = ', hninn 520 WRITE(numout,*) ' initial snow thickness in the south hnins = ', hnins 521 WRITE(numout,*) ' initial ice thickness in the north hginn = ', hginn 522 WRITE(numout,*) ' initial ice thickness in the south hgins = ', hgins 523 WRITE(numout,*) ' initial ice concentr. in the north aginn = ', aginn 524 WRITE(numout,*) ' initial ice concentr. in the north agins = ', agins 525 WRITE(numout,*) ' initial ice salinity in the north sinn = ', sinn 526 WRITE(numout,*) ' initial ice salinity in the south sins = ', sins 512 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_limini = ', ln_limini 513 WRITE(numout,*) ' threshold water temp. for initial sea-ice thres_sst = ', thres_sst 514 WRITE(numout,*) ' initial snow thickness in the north hts_ini_n = ', hts_ini_n 515 WRITE(numout,*) ' initial snow thickness in the south hts_ini_s = ', hts_ini_s 516 WRITE(numout,*) ' initial ice thickness in the north hti_ini_n = ', hti_ini_n 517 WRITE(numout,*) ' initial ice thickness in the south hti_ini_s = ', hti_ini_s 518 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_n = ', ati_ini_n 519 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_s = ', ati_ini_s 520 WRITE(numout,*) ' initial ice salinity in the north smi_ini_n = ', smi_ini_n 521 WRITE(numout,*) ' initial ice salinity in the south smi_ini_s = ', smi_ini_s 522 WRITE(numout,*) ' initial ice/snw temp in the north tmi_ini_n = ', tmi_ini_n 523 WRITE(numout,*) ' initial ice/snw temp in the south tmi_ini_s = ', tmi_ini_s 527 524 ENDIF 528 525 -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4624 r4921 5 5 !!====================================================================== 6 6 !! History : LIM ! 2006-02 (M. Vancoppenolle) Original code 7 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_ mec7 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn 8 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 9 !!---------------------------------------------------------------------- … … 22 22 USE limthd_lac ! LIM 23 23 USE limvar ! LIM 24 USE limcons ! LIM25 24 USE in_out_manager ! I/O manager 26 25 USE lbclnk ! lateral boundary condition - MPP exchanges … … 30 29 ! Check budget (Rousset) 31 30 USE iom ! I/O manager 32 USE lib_fortran ! glob_sum31 USE lib_fortran ! glob_sum 33 32 USE limdiahsb 34 USE timing ! Timing 33 USE timing ! Timing 34 USE limcons ! conservation tests 35 35 36 36 IMPLICIT NONE … … 143 143 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2) 144 144 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 145 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 146 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 147 ! mass and salt flux (clem) 148 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 145 ! 146 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 149 147 !!----------------------------------------------------------------------------- 150 148 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 151 149 152 150 CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 153 154 CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold ) ! clem155 156 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only)157 151 158 152 IF(ln_ctl) THEN … … 162 156 163 157 IF( ln_limdyn ) THEN ! Start ridging and rafting ! 164 ! ------------------------------- 165 !- check conservation (C Rousset) 166 IF (ln_limdiahsb) THEN 167 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 168 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 169 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 170 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 171 ENDIF 172 !- check conservation (C Rousset) 173 ! ------------------------------- 174 175 ! mass and salt flux init (clem) 176 zviold(:,:,:) = v_i(:,:,:) 177 zvsold(:,:,:) = v_s(:,:,:) 178 zsmvold(:,:,:) = smv_i(:,:,:) 158 159 ! conservation test 160 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 179 161 180 162 !-----------------------------------------------------------------------------! … … 362 344 ! 5) Heat, salt and freshwater fluxes 363 345 !-----------------------------------------------------------------------------! 364 fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean365 fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice ! heat sink for ocean346 wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean 347 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 366 348 367 349 END DO … … 399 381 CALL lim_itd_me_zapsmall 400 382 401 !--------------------------------402 ! Update mass/salt fluxes (clem)403 !--------------------------------404 DO jl = 1, jpl405 DO jj = 1, jpj406 DO ji = 1, jpi407 diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice408 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic409 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn410 sfx_mec(ji,jj) = sfx_mec(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic * r1_rdtice411 END DO412 END DO413 END DO414 383 415 384 IF(ln_ctl) THEN ! Control print … … 445 414 ENDIF 446 415 447 ! ------------------------------- 448 !- check conservation (C Rousset) 449 IF (ln_limdiahsb) THEN 450 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 451 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 452 453 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 454 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 455 456 zchk_vmin = glob_min(v_i) 457 zchk_amax = glob_max(SUM(a_i,dim=3)) 458 zchk_amin = glob_min(a_i) 459 460 IF(lwp) THEN 461 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limitd_me) = ',(zchk_v_i * rday) 462 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * rday) 463 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limitd_me) = ',(zchk_vmin * 1.e-3) 464 IF ( zchk_amax > kamax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limitd_me) = ',zchk_amax 465 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limitd_me) = ',zchk_amin 466 ENDIF 467 ENDIF 468 !- check conservation (C Rousset) 469 ! ------------------------------- 416 ! conservation test 417 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 470 418 471 419 ENDIF ! ln_limdyn=.true. 472 420 ! 473 421 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 474 !475 CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold ) ! clem476 422 ! 477 423 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 670 616 !!---------------------------------------------------------------------! 671 617 INTEGER :: ji,jj, jl ! dummy loop indices 672 INTEGER :: krdg_index !673 618 REAL(wp) :: Gstari, astari, hi, hrmean, zdummy ! local scalar 674 619 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here … … 746 691 !----------------------------------------------------------------- 747 692 748 krdg_index = 1 749 750 IF( krdg_index == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 751 DO jl = 0, ice_cat_bounds(1,2) ! only undeformed ice participates 693 IF( partfun_swi == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 694 DO jl = 0, jpl 752 695 DO jj = 1, jpj 753 696 DO ji = 1, jpi … … 772 715 Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 773 716 END DO !jl 774 DO jl = 0, ice_cat_bounds(1,2)717 DO jl = 0, jpl 775 718 athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 776 719 END DO 777 720 ! 778 ENDIF ! krdg_index779 780 IF( raft swi == 1 ) THEN ! Ridging and rafting ice participation functions721 ENDIF ! partfun_swi 722 723 IF( raft_swi == 1 ) THEN ! Ridging and rafting ice participation functions 781 724 ! 782 725 DO jl = 1, jpl … … 794 737 END DO ! jl 795 738 796 ELSE ! raft swi = 0739 ELSE ! raft_swi = 0 797 740 ! 798 741 DO jl = 1, jpl … … 802 745 ENDIF 803 746 804 IF ( raft swi == 1 ) THEN747 IF ( raft_swi == 1 ) THEN 805 748 806 749 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN … … 908 851 INTEGER :: ij ! horizontal index, combines i and j loops 909 852 INTEGER :: icells ! number of cells with aicen > puny 910 REAL(wp) :: zindb , zsrdg2! local scalar853 REAL(wp) :: zindb ! local scalar 911 854 REAL(wp) :: hL, hR, farea, zdummy, zdummy0, ztmelts ! left and right limits of integration 855 REAL(wp) :: zsstK ! SST in Kelvin 912 856 913 857 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices … … 917 861 918 862 REAL(wp), POINTER, DIMENSION(:,:,:) :: aicen_init, vicen_init ! ice area & volume before ridging 919 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsn on_init, esnon_init ! snow volume & energy before ridging863 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsnwn_init, esnwn_init ! snow volume & energy before ridging 920 864 REAL(wp), POINTER, DIMENSION(:,:,:) :: smv_i_init, oa_i_init ! ice salinity & age before ridging 921 865 … … 952 896 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 953 897 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 954 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsn on_init, esnon_init, smv_i_init, oa_i_init )955 CALL wrk_alloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw )956 CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init )898 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 899 CALL wrk_alloc( jpi, jpj, nlay_i+1, eirft, erdg1, erdg2, ersw ) 900 CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 957 901 958 902 ! Conservation check … … 1008 952 aicen_init(:,:,jl) = a_i(:,:,jl) 1009 953 vicen_init(:,:,jl) = v_i(:,:,jl) 1010 vsn on_init(:,:,jl) = v_s(:,:,jl)954 vsnwn_init(:,:,jl) = v_s(:,:,jl) 1011 955 ! 1012 956 smv_i_init(:,:,jl) = smv_i(:,:,jl) … … 1014 958 END DO !jl 1015 959 1016 esn on_init(:,:,:) = e_s(:,:,1,:)960 esnwn_init(:,:,:) = e_s(:,:,1,:) 1017 961 1018 962 DO jl = 1, jpl … … 1091 1035 ! / rafting category n1. 1092 1036 !-------------------------------------------------------------------------- 1093 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1037 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 1094 1038 vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 1095 1039 vsw (ji,jj) = vrdg1(ji,jj) * ridge_por 1096 1040 1097 vsrdg(ji,jj) = vsn on_init(ji,jj,jl1) * afrac(ji,jj)1098 esrdg(ji,jj) = esn on_init(ji,jj,jl1) * afrac(ji,jj)1099 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1100 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1041 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 1042 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 1043 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1044 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 1101 1045 1102 1046 ! rafting volumes, heat contents ... 1103 1047 virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 1104 vsrft(ji,jj) = vsn on_init(ji,jj,jl1) * afrft(ji,jj)1105 esrft(ji,jj) = esn on_init(ji,jj,jl1) * afrft(ji,jj)1048 vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 1049 esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 1106 1050 smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 1107 1051 … … 1120 1064 ! Salinity 1121 1065 !------------- 1122 smsw(ji,jj) = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0 ! salt content of seawater frozen in voids 1123 1124 zsrdg2 = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge 1125 1126 srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity 1066 smsw(ji,jj) = vsw(ji,jj) * sss_m(ji,jj) ! salt content of seawater frozen in voids !! MV HC2014 1067 srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge 1068 1069 !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity 1127 1070 1128 ! ! excess of salt is flushed into the ocean 1129 !sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 1130 1131 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic ! gurvan: increase in ice volume du to seawater frozen in voids 1071 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 1072 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! gurvan: increase in ice volume du to seawater frozen in voids 1132 1073 1133 1074 !------------------------------------ … … 1158 1099 & + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 1159 1100 1160 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included 1161 & + esrft(ji,jj)*(1.0-fsnowrft) 1101 ! in 1e-9 Joules (same as e_s) 1102 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included 1103 & - esrft(ji,jj)*(1.0-fsnowrft) 1162 1104 1163 1105 !----------------------------------------------------------------- … … 1184 1126 jj = indxj(ij) 1185 1127 ! heat content of ridged ice 1186 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1128 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) 1187 1129 eirft(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 1188 1130 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 1189 ! sea water heat content 1190 ztmelts = - tmut * sss_m(ji,jj) + rtt 1191 ! heat content per unit volume 1192 zdummy0 = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 1193 1194 ! corrected sea water salinity 1195 zindb = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - epsi20 ) ) 1196 zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), epsi20 ) 1197 1198 ztmelts = - tmut * zdummy + rtt 1199 ersw(ji,jj,jk) = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 1200 1201 ! heat flux 1202 fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 1131 1132 1133 ! enthalpy of the trapped seawater (J/m2, >0) 1134 ! clem: if sst>0, then ersw <0 (is that possible?) 1135 zsstK = sst_m(ji,jj) + rt0 1136 ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 1137 1138 ! heat flux to the ocean 1139 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice ! > 0 [W.m-2] ocean->ice flux 1203 1140 1204 1141 ! Correct dimensions to avoid big values 1205 ersw(ji,jj,jk) = ersw(ji,jj,jk) * 1.e-09 1206 1207 ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 1208 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 1142 ersw(ji,jj,jk) = ersw(ji,jj,jk) / unit_fac 1143 1144 ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 1145 ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 1146 !! MV HC 2014 1147 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) 1209 1148 1210 1149 erdg2(ji,jj,jk) = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 1150 1211 1151 END DO ! ij 1212 1152 END DO !jk … … 1253 1193 !------------------------------------------------------------------------------- 1254 1194 ! jl1 looping 1-jpl 1255 DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2)1195 DO jl2 = 1, jpl 1256 1196 ! over categories to which ridged ice is transferred 1257 1197 !CDIR NODEP … … 1298 1238 END DO ! jl2 (new ridges) 1299 1239 1300 DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2)1240 DO jl2 = 1, jpl 1301 1241 1302 1242 !CDIR NODEP … … 1361 1301 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 1362 1302 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 1363 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsn on_init, esnon_init, smv_i_init, oa_i_init )1364 CALL wrk_dealloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw )1365 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init )1303 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 1304 CALL wrk_dealloc( jpi, jpj, nlay_i+1, eirft, erdg1, erdg2, ersw ) 1305 CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 1366 1306 ! 1367 1307 END SUBROUTINE lim_itd_me_ridgeshift … … 1404 1344 !!------------------------------------------------------------------- 1405 1345 INTEGER :: ios ! Local integer output status for namelist read 1406 NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,& 1407 Gstar, astar, & 1408 Hstar, raftswi, hparmeter, Craft, ridge_por, & 1409 sal_max_ridge, partfun_swi, transfun_swi, & 1410 brinstren_swi 1346 NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft, & 1347 & Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, & 1348 & partfun_swi, brinstren_swi 1411 1349 !!------------------------------------------------------------------- 1412 1350 ! … … 1432 1370 WRITE(numout,*)' Equivalent to G* for an exponential part function astar ', astar 1433 1371 WRITE(numout,*)' Quantity playing a role in max ridged ice thickness Hstar ', Hstar 1434 WRITE(numout,*)' Rafting of ice sheets or not raft swi ', raftswi1372 WRITE(numout,*)' Rafting of ice sheets or not raft_swi ', raft_swi 1435 1373 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) hparmeter ', hparmeter 1436 1374 WRITE(numout,*)' Rafting hyperbolic tangent coefficient Craft ', Craft 1437 1375 WRITE(numout,*)' Initial porosity of ridges ridge_por ', ridge_por 1438 WRITE(numout,*)' Maximum salinity of ridging ice sal_max_ridge ', sal_max_ridge1439 1376 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential partfun_swi ', partfun_swi 1440 WRITE(numout,*)' Switch for tran. function (0) linear (1) exponential transfun_swi ', transfun_swi1441 1377 WRITE(numout,*)' Switch for including brine volume in ice strength comp. brinstren_swi ', brinstren_swi 1442 1378 ENDIF … … 1462 1398 1463 1399 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace 1464 REAL(wp) :: zmask_glo 1400 REAL(wp) :: zmask_glo, zsal, zvi, zvs, zei, zes 1465 1401 !!gm REAL(wp) :: xtmp ! temporary variable 1466 1402 !!------------------------------------------------------------------- … … 1468 1404 CALL wrk_alloc( jpi, jpj, zmask ) 1469 1405 1406 ! to be sure that at_i is the sum of a_i(jl) 1407 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 1408 1470 1409 DO jl = 1, jpl 1471 1472 1410 !----------------------------------------------------------------- 1473 1411 ! Count categories to be zapped. 1474 ! Abort model in case of negative area.1475 1412 !----------------------------------------------------------------- 1476 1413 icells = 0 … … 1478 1415 DO jj = 1, jpj 1479 1416 DO ji = 1, jpi 1480 IF( ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) < 0._wp ) .OR. & 1481 & ( a_i(ji,jj,jl) > 0._wp .AND. a_i(ji,jj,jl) <= epsi10 ) .OR. & 1482 & ( v_i(ji,jj,jl) == 0._wp .AND. a_i(ji,jj,jl) > 0._wp ) .OR. & 1483 & ( v_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) <= epsi10 ) ) zmask(ji,jj) = 1._wp 1417 IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN 1418 zmask(ji,jj) = 1._wp 1419 ENDIF 1484 1420 END DO 1485 1421 END DO … … 1494 1430 DO jj = 1 , jpj 1495 1431 DO ji = 1 , jpi 1496 !!gm xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 1497 !!gm xtmp = xtmp * unit_fac 1498 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1432 zei = e_i(ji,jj,jk,jl) 1499 1433 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 1434 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj) 1435 ! update exchanges with ocean 1436 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 1500 1437 END DO 1501 1438 END DO … … 1504 1441 DO jj = 1 , jpj 1505 1442 DO ji = 1 , jpi 1506 1443 1444 zsal = smv_i(ji,jj,jl) 1445 zvi = v_i(ji,jj,jl) 1446 zvs = v_s(ji,jj,jl) 1447 zes = e_s(ji,jj,1,jl) 1507 1448 !----------------------------------------------------------------- 1508 1449 ! Zap snow energy and use ocean heat to melt snow … … 1514 1455 ! fluxes are positive to the ocean 1515 1456 ! here the flux has to be negative for the ocean 1516 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice1517 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp1518 1519 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB ???????1520 1521 1457 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 1522 1458 … … 1524 1460 ! zap ice and snow volume, add water and salt to ocean 1525 1461 !----------------------------------------------------------------- 1526 1527 ! xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 1528 ! sfx_res(ji,jj) = sfx_res(ji,jj) + ( sss_m(ji,jj) ) & 1529 ! * rhosn * v_s(ji,jj,jl) * r1_rdtice 1530 ! sfx_res(ji,jj) = sfx_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) & 1531 ! * rhoic * v_i(ji,jj,jl) * r1_rdtice 1532 ! sfx (i,j) = sfx (i,j) + xtmp 1533 1534 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) 1462 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) 1535 1463 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1536 1464 v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) … … 1539 1467 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1540 1468 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1541 ! 1469 e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 1470 ! additional condition 1471 IF( v_s(ji,jj,jl) <= epsi10 ) THEN 1472 v_s(ji,jj,jl) = 0._wp 1473 e_s(ji,jj,1,jl) = 0._wp 1474 ENDIF 1475 ! update exchanges with ocean 1476 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 1477 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 1478 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 1479 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 1542 1480 END DO 1543 1481 END DO 1544 ! 1545 END DO ! jl 1482 END DO ! jl 1483 1484 ! to be sure that at_i is the sum of a_i(jl) 1485 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 1546 1486 ! 1547 1487 CALL wrk_dealloc( jpi, jpj, zmask ) -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4333 r4921 6 6 !! History : - ! (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 7 7 !! 3.0 ! 2005-12 (M. Vancoppenolle) adaptation to LIM-3 8 !! - ! 2006-06 (M. Vancoppenolle) adaptation to include salt, age and types8 !! - ! 2006-06 (M. Vancoppenolle) adaptation to include salt, age 9 9 !! - ! 2007-04 (M. Vancoppenolle) Mass conservation checked 10 10 !!---------------------------------------------------------------------- … … 35 35 USE lib_fortran ! to use key_nosignedzero 36 36 USE timing ! Timing 37 USE limcons ! conservation tests 37 38 38 39 IMPLICIT NONE … … 65 66 INTEGER, INTENT(in) :: kt ! time step index 66 67 ! 67 INTEGER :: j l, ja, jm, jbnd1, jbnd2 ! ice typesdummy loop index68 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)69 REAL(wp) :: z chk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)68 INTEGER :: ji, jj, jk, jl ! dummy loop index 69 ! 70 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 70 71 !!------------------------------------------------------------------ 71 72 IF( nn_timing == 1 ) CALL timing_start('limitd_th') 72 73 73 ! ------------------------------- 74 !- check conservation (C Rousset) 75 IF (ln_limdiahsb) THEN 76 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 77 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 78 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 79 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 80 ENDIF 81 !- check conservation (C Rousset) 82 ! ------------------------------- 74 ! conservation test 75 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 83 76 84 77 IF( kt == nit000 .AND. lwp ) THEN … … 93 86 ! Given thermodynamic growth rates, transport ice between 94 87 ! thickness categories. 95 DO jm = 1, jpm 96 jbnd1 = ice_cat_bounds(jm,1) 97 jbnd2 = ice_cat_bounds(jm,2) 98 IF( ice_ncat_types(jm) > 1 ) CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 99 END DO 88 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 100 89 ! 101 90 CALL lim_var_glo2eqv ! only for info … … 105 94 ! 3) Add frazil ice growing in leads. 106 95 !------------------------------------------------------------------------------| 107 108 96 CALL lim_thd_lac 109 97 CALL lim_var_glo2eqv ! only for info 110 111 IF(ln_ctl) THEN ! Control print98 99 IF(ln_ctl) THEN ! Control print 112 100 CALL prt_ctl_info(' ') 113 101 CALL prt_ctl_info(' - Cell values : ') … … 131 119 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 132 120 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 133 DO j a= 1, nlay_i121 DO jk = 1, nlay_i 134 122 CALL prt_ctl_info(' ') 135 CALL prt_ctl_info(' - Layer : ', ivar1=j a)123 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 136 124 CALL prt_ctl_info(' ~~~~~~~') 137 CALL prt_ctl(tab2d_1=t_i(:,:,j a,jl) , clinfo1= ' lim_itd_th : t_i : ')138 CALL prt_ctl(tab2d_1=e_i(:,:,j a,jl) , clinfo1= ' lim_itd_th : e_i : ')125 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 126 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 139 127 END DO 140 128 END DO 141 129 ENDIF 142 130 ! 143 ! ------------------------------- 144 !- check conservation (C Rousset) 145 IF( ln_limdiahsb ) THEN 146 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 147 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 148 149 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 150 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 151 152 zchk_vmin = glob_min(v_i) 153 zchk_amax = glob_max(SUM(a_i,dim=3)) 154 zchk_amin = glob_min(a_i) 155 156 IF(lwp) THEN 157 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limitd_th) = ',(zchk_v_i * rday) 158 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 159 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limitd_th) = ',(zchk_vmin * 1.e-3) 160 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limitd_th) = ',zchk_amax 161 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limitd_th) = ',zchk_amin 162 ENDIF 163 ENDIF 164 !- check conservation (C Rousset) 165 ! ------------------------------- 131 ! conservation test 132 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 166 133 ! 167 134 IF( nn_timing == 1 ) CALL timing_stop('limitd_th') … … 169 136 ! 170 137 171 SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp,kt )138 SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 172 139 !!------------------------------------------------------------------ 173 140 !! *** ROUTINE lim_itd_th_rem *** … … 182 149 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 183 150 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 184 INTEGER , INTENT (in) :: ntyp ! Number of the type used185 151 INTEGER , INTENT (in) :: kt ! Ocean time step 186 152 ! … … 200 166 REAL(wp), POINTER, DIMENSION(:,:,:) :: hL ! left boundary for the ITD for each thickness 201 167 REAL(wp), POINTER, DIMENSION(:,:,:) :: hR ! left boundary for the ITD for each thickness 202 REAL(wp), POINTER, DIMENSION(:,:,:) :: zht_i_ o! old ice thickness168 REAL(wp), POINTER, DIMENSION(:,:,:) :: zht_i_b ! old ice thickness 203 169 REAL(wp), POINTER, DIMENSION(:,:,:) :: dummy_es 204 170 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdaice, zdvice ! local increment of ice area and volume … … 218 184 CALL wrk_alloc( jpi,jpj, zremap_flag ) ! integer 219 185 CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) ! integer 220 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_ o, dummy_es )186 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 221 187 CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice ) 222 188 CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) … … 247 213 WRITE(numout,*) ' klbnd : ', klbnd 248 214 WRITE(numout,*) ' kubnd : ', kubnd 249 WRITE(numout,*) ' ntyp : ', ntyp250 215 ENDIF 251 216 … … 256 221 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 257 222 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb 258 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes259 zht_i_ o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb260 IF( a_i(ji,jj,jl) > epsi 06 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)223 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 224 zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * zindb 225 IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) 261 226 END DO 262 227 END DO … … 302 267 ij = nind_j(ji) 303 268 ! 304 IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &305 ( zht_i_o(ii,ij,jl+1) .GT. epsi10 )) THEN269 zhbnew(ii,ij,jl) = hi_max(jl) 270 IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 306 271 !interpolate between adjacent category growth rates 307 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / & 308 ( zht_i_o (ii,ij,jl+1) - zht_i_o (ii,ij,jl) ) 309 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 310 zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 311 ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 272 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 273 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 274 ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN 312 275 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 313 ELSEIF ( zht_i_o(ii,ij,jl+1).gt.epsi10) THEN276 ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN 314 277 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 315 ELSE316 zhbnew(ii,ij,jl) = hi_max(jl)317 278 ENDIF 318 279 END DO … … 320 281 !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 321 282 DO ji = 1, nbrem 322 ! jl, ji323 283 ii = nind_i(ji) 324 284 ij = nind_j(ji) 325 ! jl, ji 326 IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. & 327 ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 328 ) THEN 285 IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 329 286 zremap_flag(ii,ij) = 0 330 ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 331 ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 332 ) THEN 287 ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 333 288 zremap_flag(ii,ij) = 0 334 289 ENDIF 335 290 336 291 !- 4.3 Check that each zhbnew does not exceed maximal values hi_max 337 ! jl, ji 338 IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 339 zremap_flag(ii,ij) = 0 340 ENDIF 341 ! jl, ji 342 IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 343 zremap_flag(ii,ij) = 0 344 ENDIF 345 ! jl, ji 346 END DO !ji 347 ! ji 292 IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 293 IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 294 END DO 295 348 296 END DO !jl 349 297 … … 354 302 DO jj = 1, jpj 355 303 DO ji = 1, jpi 356 IF 304 IF( zremap_flag(ji,jj) == 1 ) THEN 357 305 nbrem = nbrem + 1 358 306 nind_i(nbrem) = ji 359 307 nind_j(nbrem) = jj 360 308 ENDIF 361 END DO !ji362 END DO !jj309 END DO 310 END DO 363 311 364 312 !----------------------------------------------------------------------------------------------- … … 367 315 DO jj = 1, jpj 368 316 DO ji = 1, jpi 369 zhb0(ji,jj) = hi_max _typ(0,ntyp) ! 0eme370 zhb1(ji,jj) = hi_max _typ(1,ntyp) ! 1er317 zhb0(ji,jj) = hi_max(0) ! 0eme 318 zhb1(ji,jj) = hi_max(1) ! 1er 371 319 372 320 zhbnew(ji,jj,klbnd-1) = 0._wp … … 380 328 ENDIF 381 329 382 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) 330 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 383 331 384 332 END DO !jj … … 389 337 !----------------------------------------------------------------------------------------------- 390 338 !- 7.1 g(h) for category 1 at start of time step 391 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_ o(:,:,klbnd), &339 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), & 392 340 & g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 393 341 & hR(:,:,klbnd), zremap_flag ) … … 414 362 ! Constrain new thickness <= ht_i 415 363 zdamax = a_i(ii,ij,klbnd) * & 416 (1.0 - ht_i(ii,ij,klbnd)/zht_i_ o(ii,ij,klbnd)) ! zdamax > 0364 (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0 417 365 !ice area lost due to melting of thin ice 418 366 zda0 = MIN(zda0, zdamax) … … 428 376 ELSE ! if ice accretion 429 377 ! ji, a_i > epsi10; zdh0 > 0 430 IF ( ntyp .EQ. 1 )zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))378 zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 431 379 ! zhbnew was 0, and is shifted to the right to account for thin ice 432 380 ! growth in openwater (F0 = f1) 433 IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0434 ! in other types there is435 ! no open water growth (F0 = 0)436 381 ENDIF ! zdh0 437 382 … … 444 389 DO jl = klbnd, kubnd 445 390 CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 446 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), & 447 zremap_flag) 391 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 448 392 END DO 449 393 … … 493 437 nd = zdonor(ii,ij,jl) 494 438 zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 495 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 496 zdaice(ii,ij,jl)*hL(ii,ij,nd) 439 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 497 440 498 441 END DO ! ji … … 511 454 ii = nind_i(ji) 512 455 ij = nind_j(ji) 513 IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim )) THEN456 IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 514 457 a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim 515 458 ht_i(ii,ij,1) = hiclim 516 v_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless517 459 ENDIF 518 460 END DO !ji … … 542 484 CALL wrk_dealloc( jpi,jpj, zremap_flag ) ! integer 543 485 CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) ! integer 544 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_ o, dummy_es )486 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 545 487 CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice ) 546 488 CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) … … 799 741 !-------------- 800 742 801 zdvsnow 743 zdvsnow = v_s(ii,ij,jl1) * zworka(ii,ij) 802 744 v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 803 745 v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow … … 807 749 !-------------------- 808 750 809 zdesnow 751 zdesnow = e_s(ii,ij,1,jl1) * zworka(ii,ij) 810 752 e_s(ii,ij,1,jl1) = e_s(ii,ij,1,jl1) - zdesnow 811 753 e_s(ii,ij,1,jl2) = e_s(ii,ij,1,jl2) + zdesnow … … 815 757 !-------------- 816 758 817 zdo_aice 759 zdo_aice = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 818 760 oa_i(ii,ij,jl1) = oa_i(ii,ij,jl1) - zdo_aice 819 761 oa_i(ii,ij,jl2) = oa_i(ii,ij,jl2) + zdo_aice … … 823 765 !-------------- 824 766 825 zdsm_vice 767 zdsm_vice = smv_i(ii,ij,jl1) * zworka(ii,ij) 826 768 smv_i(ii,ij,jl1) = smv_i(ii,ij,jl1) - zdsm_vice 827 769 smv_i(ii,ij,jl2) = smv_i(ii,ij,jl2) + zdsm_vice … … 831 773 !--------------------- 832 774 833 zdaTsf 775 zdaTsf = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 834 776 zaTsfn(ii,ij,jl1) = zaTsfn(ii,ij,jl1) - zdaTsf 835 777 zaTsfn(ii,ij,jl2) = zaTsfn(ii,ij,jl2) + zdaTsf … … 888 830 889 831 890 SUBROUTINE lim_itd_th_reb( klbnd, kubnd , ntyp)832 SUBROUTINE lim_itd_th_reb( klbnd, kubnd ) 891 833 !!------------------------------------------------------------------ 892 834 !! *** ROUTINE lim_itd_th_reb *** … … 898 840 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 899 841 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 900 INTEGER , INTENT (in) :: ntyp ! number of the ice type involved in the rebinning process901 842 ! 902 843 INTEGER :: ji,jj, jl ! dummy loop indices … … 910 851 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 911 852 !!------------------------------------------------------------------ 853 !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 912 854 913 855 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger … … 937 879 938 880 !------------------------------------------------------------------------------ 939 ! 2) Make sure thickness of cat klbnd is at least hi_max _typ(klbnd)881 ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd) 940 882 !------------------------------------------------------------------------------ 941 883 DO jj = 1, jpj 942 884 DO ji = 1, jpi 943 885 IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 944 IF( ht_i(ji,jj,klbnd) <= hi_max _typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN945 a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max _typ(0,ntyp)946 ht_i(ji,jj,klbnd) = hi_max _typ(0,ntyp)886 IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN 887 a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max(0) 888 ht_i(ji,jj,klbnd) = hi_max(0) 947 889 ENDIF 948 890 ENDIF … … 1015 957 1016 958 !clem-change 959 DO jj = 1, jpj 960 DO ji = 1, jpi 961 IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 962 ! 963 zshiftflag = 1 964 zdonor(ji,jj,jl) = jl + 1 965 zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 966 zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 967 ENDIF 968 END DO ! ji 969 END DO ! jj 970 971 IF(lk_mpp) CALL mpp_max( zshiftflag ) 972 973 IF( zshiftflag == 1 ) THEN ! Shift ice between categories 974 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 975 ! Reset shift parameters 976 zdonor(:,:,jl) = 0 977 zdaice(:,:,jl) = 0._wp 978 zdvice(:,:,jl) = 0._wp 979 ENDIF 980 !clem-change 981 982 ! ! clem-change begin: why not doing that? 1017 983 ! DO jj = 1, jpj 1018 984 ! DO ji = 1, jpi 1019 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. & 1020 ! ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1021 ! ! 1022 ! zshiftflag = 1 1023 ! zdonor(ji,jj,jl) = jl + 1 1024 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 1025 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 985 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 986 ! ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 987 ! a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 1026 988 ! ENDIF 1027 989 ! END DO ! ji 1028 990 ! END DO ! jj 1029 !1030 ! IF(lk_mpp) CALL mpp_max( zshiftflag )1031 !1032 ! IF( zshiftflag == 1 ) THEN ! Shift ice between categories1033 ! CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )1034 ! ! Reset shift parameters1035 ! zdonor(:,:,jl) = 01036 ! zdaice(:,:,jl) = 0._wp1037 ! zdvice(:,:,jl) = 0._wp1038 ! ENDIF1039 !clem-change1040 1041 ! clem-change begin: why not doing that?1042 DO jj = 1, jpj1043 DO ji = 1, jpi1044 IF( a_i(ji,jj,jl+1) > epsi10 .AND. &1045 ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN1046 ht_i(ji,jj,jl+1) = hi_max(jl) + epsi101047 a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)1048 ENDIF1049 END DO ! ji1050 END DO ! jj1051 991 ! clem-change end 1052 992 -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r4346 r4921 51 51 52 52 REAL(wp) :: epsi10 = 1.e-10_wp ! 53 REAL(wp) :: rzero = 0._wp ! constant values54 REAL(wp) :: rone = 1._wp ! constant values55 53 56 54 !! * Substitutions … … 514 512 !CDIR NOVERRCHK 515 513 DO ji = fs_2, fs_jpim1 516 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)514 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 517 515 zsang = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 518 516 z0 = zmass1(ji,jj)/dtevp … … 547 545 DO ji = fs_2, fs_jpim1 548 546 549 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)547 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 550 548 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 551 549 z0 = zmass2(ji,jj)/dtevp … … 579 577 !CDIR NOVERRCHK 580 578 DO ji = fs_2, fs_jpim1 581 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)579 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 582 580 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 583 581 z0 = zmass2(ji,jj)/dtevp … … 611 609 !CDIR NOVERRCHK 612 610 DO ji = fs_2, fs_jpim1 613 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)611 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 614 612 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 615 613 z0 = zmass1(ji,jj)/dtevp … … 661 659 ! 4) Prevent ice velocities when the ice is thin 662 660 !------------------------------------------------------------------------------! 663 !clem : add hminrhg in the namelist664 !665 661 ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 666 662 ! ocean velocity, -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r4205 r4921 142 142 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 143 143 END DO 144 144 145 145 DO jl = 1, jpl 146 146 WRITE(zchar,'(I1)') jl … … 162 162 CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice ) 163 163 CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice ) 164 CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq )165 164 CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i ) 166 165 CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i ) … … 393 392 CALL iom_get( numrir, jpdom_autoglo, 'u_ice' , u_ice ) 394 393 CALL iom_get( numrir, jpdom_autoglo, 'v_ice' , v_ice ) 395 CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq )396 394 CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i ) 397 395 CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i ) … … 522 520 END DO 523 521 ! 522 ! clem: I do not understand why the following IF is needed 523 ! I suspect something inconsistent in the main code with option num_sal=1 524 IF( num_sal == 1 ) THEN 525 DO jl = 1, jpl 526 sm_i(:,:,jl) = bulk_sal 527 DO jk = 1, nlay_i 528 s_i(:,:,jk,jl) = bulk_sal 529 END DO 530 END DO 531 ENDIF 532 ! 524 533 !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 525 534 ! -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4614 r4921 27 27 USE par_ice ! ice parameters 28 28 USE dom_oce ! ocean domain 29 USE domvvl ! ocean vertical scale factors 30 USE dom_ice, ONLY : tms 29 USE dom_ice, ONLY : tms, area 31 30 USE ice ! LIM sea-ice variables 32 31 USE sbc_ice ! Surface boundary condition: sea-ice fields … … 43 42 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 43 USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget 44 USE iom 45 USE domvvl ! Variable volume 45 46 46 47 IMPLICIT NONE … … 51 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 52 53 53 REAL(wp) :: rzero = 0._wp54 REAL(wp) :: rone = 1._wp54 REAL(wp) :: epsi10 = 1.e-10 ! 55 REAL(wp) :: epsi20 = 1.e-20 ! 55 56 56 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] … … 104 105 INTEGER, INTENT(in) :: kt ! number of iteration 105 106 ! 106 INTEGER :: ji, jj, jl ! dummy loop indices 107 INTEGER :: ierr, ifvt, i1mfr, idfr ! local integer 108 INTEGER :: iflt, ial , iadv , ifral, ifrdv ! - - 109 REAL(wp) :: zinda, zemp, zemp_snow, zfmm ! local scalars 110 REAL(wp) :: zemp_snw ! - - 111 REAL(wp) :: zfcm1 , zfcm2 ! - - 107 INTEGER :: ji, jj, jl, jk ! dummy loop indices 108 REAL(wp) :: zinda, zemp ! local scalars 109 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 110 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 112 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 113 REAL(wp) :: zzfcm1, zfscmbq ! clem: for light penetration114 112 !!--------------------------------------------------------------------- 115 113 116 114 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 117 115 118 !------------------------------------------! 119 ! heat flux at the ocean surface ! 120 !------------------------------------------! 116 ! make calls for heat fluxes before it is modified 117 CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 118 CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 119 CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 120 CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 121 CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 122 CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 123 CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 124 121 125 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 122 ! changed to old_frld and old ht_i123 124 126 DO jj = 1, jpj 125 127 DO ji = 1, jpi 126 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 127 ifvt = zinda * MAX( rzero , SIGN( rone, - phicif(ji,jj) ) ) !subscripts are bad here 128 i1mfr = 1.0 - MAX( rzero , SIGN( rone , - at_i(ji,jj) ) ) 129 idfr = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 130 iflt = zinda * (1 - i1mfr) * (1 - ifvt ) 131 ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr 132 iadv = ( 1 - i1mfr ) * zinda 133 ifral = ( 1 - i1mfr * ( 1 - ial ) ) 134 ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 135 136 ! switch --- 1.0 ---------------- 0.0 -------------------- 137 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 ! zinda | if pfrld = 1 | if pfrld < 1 | 139 ! -> ifvt| if pfrld old_ht_i 140 ! i1mfr | if frld = 1 | if frld < 1 | 141 ! idfr | if frld <= pfrld | if frld > pfrld | 142 ! iflt | 143 ! ial | 144 ! iadv | 145 ! ifral 146 ! ifrdv 147 148 ! computation the solar flux at ocean surface 149 IF (lk_cpl) THEN ! be carfeful: not been tested yet 128 129 !------------------------------------------! 130 ! heat flux at the ocean surface ! 131 !------------------------------------------! 132 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 133 134 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 135 !--------------------------------------------------- 136 IF( lk_cpl ) THEN ! be carfeful: not been tested yet 150 137 ! original line 151 !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 152 ! new line to include solar penetration (not tested) 153 zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 138 zfcm1 = qsr_tot(ji,jj) 139 !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 154 140 DO jl = 1, jpl 155 zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl)141 zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 156 142 END DO 157 143 ELSE 158 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 159 & ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 144 !!!zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 145 !!! & ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 146 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 147 DO jl = 1, jpl 148 zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 149 END DO 160 150 ENDIF 161 ! fstric Solar flux transmitted trough the ice 162 ! qsr Net short wave heat flux on free ocean 163 ! new line 164 fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 165 166 ! solar flux and fscmbq with light penetration (clem) 167 zzfcm1 = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 168 zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 169 170 ! computation the non solar heat flux at ocean surface 171 zfcm2 = - zzfcm1 & ! 172 & + iflt * zfscmbq & ! total ablation: heat given to the ocean 173 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 174 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 175 & + fhmec(ji,jj) & ! snow melt when ridging 176 & + fheat_mec(ji,jj) & ! ridge formation 177 & + fheat_res(ji,jj) ! residual heat flux 178 ! qcmif Energy needed to bring the ocean surface layer until its freezing (ok) 179 ! qldif heat balance of the lead (or of the open ocean) 180 ! qfvbq latent heat uptake/release after accretion/ablation 181 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 182 183 IF( num_sal == 2 ) zfcm2 = zfcm2 + fhbri(ji,jj) ! add contribution due to brine drainage 184 185 ! bottom radiative component is sent to the computation of the oceanic heat flux 186 fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj) 187 188 ! used to compute the oceanic heat flux at the next time step 189 qsr(ji,jj) = zfcm1 ! solar heat flux 190 qns(ji,jj) = zfcm2 - fdtcn(ji,jj) ! non solar heat flux 191 ! ! fdtcn : turbulent oceanic heat flux 192 END DO 193 END DO 194 195 !------------------------------------------! 196 ! mass flux at the ocean surface ! 197 !------------------------------------------! 198 199 !!gm optimisation: this loop have to be merged with the previous one 200 DO jj = 1, jpj 201 DO ji = 1, jpi 151 152 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 153 !--------------------------------------------------- 154 zf_mass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 155 hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 156 157 ! New qsr and qns used to compute the oceanic heat flux at the next time step 158 !--------------------------------------------------- 159 qsr(ji,jj) = zfcm1 160 qns(ji,jj) = hfx_out(ji,jj) - zfcm1 161 162 !------------------------------------------! 163 ! mass flux at the ocean surface ! 164 !------------------------------------------! 202 165 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 203 166 ! ------------------------------------------------------------------------------------- … … 208 171 ! Even if i see Ice melting as a FW and SALT flux 209 172 ! 210 211 173 ! computing freshwater exchanges at the ice/ocean interface 212 IF (lk_cpl) THEN174 IF( lk_cpl ) THEN 213 175 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 214 & - rdm_snw(ji,jj) / rdt_ice176 & + wfx_snw(ji,jj) 215 177 ELSE 216 zemp = emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 217 & - tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 218 & + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 219 & - fmmec(ji,jj) ! snow falling when ridging 178 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction 179 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean 180 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas ) ! except solid precip intercepted by sea-ice 220 181 ENDIF 221 182 222 ! mass flux at the ocean/ice interface (sea ice fraction)223 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean224 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus melting225 226 fmmflx(ji,jj) = zfmm ! F/M mass flux save at least for biogeochemical model227 228 emp(ji,jj) = zemp + zemp_snw + zfmm! mass flux + F/M mass flux (always ice/ocean mass exchange)183 ! mass flux from ice/ocean 184 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 185 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 186 187 ! mass flux at the ocean/ice interface 188 fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice ! F/M mass flux save at least for biogeochemical model 189 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 229 190 230 ! correcting brine salt fluxes (zinda = 1 if pfrld=1 , =0 otherwise)231 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )232 sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj)233 191 END DO 234 192 END DO … … 237 195 ! salt flux at the ocean surface ! 238 196 !------------------------------------------! 239 240 IF( num_sal == 2 ) THEN ! variable ice salinity: brine drainage included in the salt flux 241 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 242 ELSE ! constant ice salinity: 243 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 244 ENDIF 245 !-----------------------------------------------! 246 ! mass of snow and ice per unit area ! 247 !-----------------------------------------------! 248 IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required) 249 snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step 250 ! ! new mass per unit area 197 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 198 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 199 200 !-------------------------------------------------------------! 201 ! mass of snow and ice per unit area for embedded sea-ice ! 202 !-------------------------------------------------------------! 203 IF( nn_ice_embd /= 0 ) THEN 204 ! save mass from the previous ice time step 205 snwice_mass_b(:,:) = snwice_mass(:,:) 206 ! new mass per unit area 251 207 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 252 ! !time evolution of snow+ice mass208 ! time evolution of snow+ice mass 253 209 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 254 210 ENDIF … … 265 221 IF( lk_cpl ) THEN ! coupled case 266 222 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 267 !268 223 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 269 224 ENDIF 225 270 226 271 227 IF(ln_ctl) THEN -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4624 r4921 8 8 !! 3.0 ! 2005-11 (M. Vancoppenolle) LIM-3 : Multi-layer thermodynamics + salinity variations 9 9 !! - ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw 11 11 !! 3.3 ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 12 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation … … 43 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 44 USE timing ! Timing 45 USE cpl_oasis3, ONLY : lk_cpl 46 USE limcons ! conservation tests 45 47 46 48 IMPLICIT NONE … … 51 53 52 54 REAL(wp) :: epsi10 = 1.e-10_wp ! 53 REAL(wp) :: zzero = 0._wp !54 REAL(wp) :: zone = 1._wp !55 55 56 56 !! * Substitutions … … 84 84 INTEGER, INTENT(in) :: kt ! number of iteration 85 85 !! 86 INTEGER :: 87 INTEGER :: 88 REAL(wp) :: zfric_umin = 5e-03_wp ! lower bound for the friction velocity89 REAL(wp) :: zfric_umax = 2e-02_wp ! upper bound for the friction velocity90 REAL(wp) :: zinda, zindb, zthsnice, zfric_u ! local scalar91 REAL(wp) :: zfntlat, zpareff, zareamin, zcoef ! - -92 REAL(wp) , POINTER, DIMENSION(:,:) :: zqlbsbq ! link with lead energy budget qldif93 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)94 REAL(wp) :: z chk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)86 INTEGER :: ji, jj, jk, jl ! dummy loop indices 87 INTEGER :: nbpb ! nb of icy pts for thermo. cal. 88 INTEGER :: ii, ij ! temporary dummy loop index 89 REAL(wp) :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 90 REAL(wp) :: zch = 0.0057_wp ! heat transfer coefficient 91 REAL(wp) :: zinda, zindb, zareamin 92 REAL(wp) :: zfric_u, zqld, zqfr 93 ! 94 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 95 95 !!------------------------------------------------------------------- 96 96 IF( nn_timing == 1 ) CALL timing_start('limthd') 97 97 98 CALL wrk_alloc( jpi, jpj, zqlbsbq ) 99 100 ! ------------------------------- 101 !- check conservation (C Rousset) 102 IF (ln_limdiahsb) THEN 103 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 104 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 105 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 106 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 107 ENDIF 108 !- check conservation (C Rousset) 109 ! ------------------------------- 98 ! conservation test 99 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 110 100 111 101 !------------------------------------------------------------------------------! … … 121 111 DO jj = 1, jpj 122 112 DO ji = 1, jpi 123 !Energy of melting q(S,T) [J.m-3]124 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )125 113 !0 if no ice and 1 if yes 126 114 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) 127 !convert units ! very important that this line is here 128 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 115 !Energy of melting q(S,T) [J.m-3] 116 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 117 !convert units ! very important that this line is here 118 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 129 119 END DO 130 120 END DO … … 133 123 DO jj = 1, jpj 134 124 DO ji = 1, jpi 135 !Energy of melting q(S,T) [J.m-3]136 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )137 125 !0 if no ice and 1 if yes 138 126 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 ) ) 127 !Energy of melting q(S,T) [J.m-3] 128 e_s(ji,jj,jk,jl) = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 139 129 !convert units ! very important that this line is here 140 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb130 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 141 131 END DO 142 132 END DO 143 133 END DO 144 134 END DO 145 146 !-----------------------------------147 ! 1.4) Compute global heat content148 !-----------------------------------149 qt_i_in (:,:) = 0.e0150 qt_s_in (:,:) = 0.e0151 qt_i_fin (:,:) = 0.e0152 qt_s_fin (:,:) = 0.e0153 sum_fluxq(:,:) = 0.e0154 fatm (:,:) = 0.e0155 135 156 136 ! 2) Partial computation of forcing for the thermodynamic sea ice model. ! … … 161 141 !CDIR NOVERRCHK 162 142 DO ji = 1, jpi 163 zinda = tms(ji,jj) * ( 1. 0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) )143 zinda = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 164 144 ! 165 145 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget … … 168 148 ! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean 169 149 ! ! temperature and turbulent mixing (McPhee, 1992) 170 ! friction velocity171 zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )172 173 ! here the drag will depend on ice thickness and type (0.006)174 fdtcn(ji,jj) = zinda * rau0 * rcp * 0.006 * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) )175 ! also category dependent176 ! !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead177 qdtcn(ji,jj) = zinda * fdtcn(ji,jj) * ( 1.0 - at_i(ji,jj) ) * rdt_ice178 !179 ! !-- Lead heat budget, qldif (part 1, next one is in limthd_dh)180 ! ! caution: exponent betas used as more snow can fallinto leads181 qldif(ji,jj) = tms(ji,jj) * rdt_ice * ( &182 & pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif183 & + qns(ji,jj) & ! non solar heat184 & + fdtcn(ji,jj) & ! turbulent ice-ocean heat185 & + fsbbq(ji,jj) * ( 1.0 - zinda ) ) & ! residual heat from previous step186 & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus ) ! latent heat of sprecip melting187 150 ! 188 ! Positive heat budget is used for bottom ablation 189 zfntlat = 1.0 - MAX( zzero , SIGN( zone , - qldif(ji,jj) ) ) 190 != 1 if positive heat budget 191 zpareff = 1.0 - zinda * zfntlat 192 != 0 if ice and positive heat budget and 1 if one of those two is false 193 zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / ( rdt_ice * MAX( at_i(ji,jj), epsi10 ) ) 151 ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 152 zqld = tms(ji,jj) * rdt_ice * & 153 & ( pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif 154 & + qns(ji,jj) ) & ! non solar heat 155 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 156 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) & 157 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 158 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) & 159 & * rcp * ( tatm_ice(ji,jj) - rtt ) ) 160 161 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 162 zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 163 164 !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 165 qlead(ji,jj) = MIN( 0._wp , zqld - zqfr ) 166 167 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 168 IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 169 fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 170 qlead(ji,jj) = 0._wp 171 ENDIF 194 172 ! 195 ! Heat budget of the lead, energy transferred from ice to ocean 196 qldif (ji,jj) = zpareff * qldif(ji,jj) 197 qdtcn (ji,jj) = zpareff * qdtcn(ji,jj) 198 ! 199 ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 200 qcmif (ji,jj) = rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 201 ! 202 ! oceanic heat flux (limthd_dh) 203 fbif (ji,jj) = zinda * ( fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) + fdtcn(ji,jj) ) 204 ! 173 !-- Energy from the turbulent oceanic heat flux --- ! 174 !clem zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 175 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 176 fhtur(ji,jj) = MAX( 0._wp, zinda * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 177 ! upper bound for fhtur: we do not want SST to drop below Tfreeze. 178 ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr) 179 ! This is not a clean budget, so that should be corrected at some point 180 fhtur(ji,jj) = zinda * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 181 182 ! ----------------------------------------- 183 ! Net heat flux on top of ice-ocean [W.m-2] 184 ! ----------------------------------------- 185 ! First step here : heat flux at the ocean surface + precip 186 ! Second step below : heat flux at the ice surface (after limthd_dif) 187 hfx_in(ji,jj) = hfx_in(ji,jj) & 188 ! heat flux above the ocean 189 & + pfrld(ji,jj) * ( qns(ji,jj) + qsr(ji,jj) ) & 190 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 191 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 192 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 193 194 ! ----------------------------------------------------------------------------- 195 ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 196 ! ----------------------------------------------------------------------------- 197 ! First step here : non solar + precip - qlead - qturb 198 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 199 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 200 hfx_out(ji,jj) = hfx_out(ji,jj) & 201 ! Non solar heat flux received by the ocean 202 & + pfrld(ji,jj) * qns(ji,jj) & 203 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 204 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) & 205 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 206 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) & 207 ! heat flux taken from the ocean where there is open water ice formation 208 & - qlead(ji,jj) * r1_rdtice & 209 ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 210 & - at_i(ji,jj) * fhtur(ji,jj) & 211 & - at_i(ji,jj) * fhld(ji,jj) 212 205 213 END DO 206 214 END DO … … 234 242 DO jj = mj0(jjindx), mj1(jjindx) 235 243 jiindex_1d = (jj - 1) * jpi + ji 244 WRITE(numout,*) ' lim_thd : Category no : ', jl 236 245 END DO 237 246 END DO … … 250 259 !------------------------- 251 260 252 CALL tab_2d_1d( nbpb, at_i_ b(1:nbpb), at_i , jpi, jpj, npb(1:nbpb) )253 CALL tab_2d_1d( nbpb, a_i_ b(1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )254 CALL tab_2d_1d( nbpb, ht_i_ b(1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )255 CALL tab_2d_1d( nbpb, ht_s_ b(1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) )256 257 CALL tab_2d_1d( nbpb, t_su_ b(1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) )258 CALL tab_2d_1d( nbpb, sm_i_ b(1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )261 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 262 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 263 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 264 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 265 266 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 267 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 259 268 DO jk = 1, nlay_s 260 CALL tab_2d_1d( nbpb, t_s_ b(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )261 CALL tab_2d_1d( nbpb, q_s_ b(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )269 CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 270 CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 262 271 END DO 263 272 DO jk = 1, nlay_i 264 CALL tab_2d_1d( nbpb, t_i_ b(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )265 CALL tab_2d_1d( nbpb, q_i_ b(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )266 CALL tab_2d_1d( nbpb, s_i_ b(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )273 CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 274 CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 275 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 267 276 END DO 268 277 … … 271 280 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) 272 281 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 273 CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 274 #if ! defined key_coupled 275 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 276 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 277 #endif 282 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 283 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 284 IF( .NOT. lk_cpl ) THEN 285 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 286 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 287 ENDIF 278 288 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 279 CALL tab_2d_1d( nbpb, t_bo_ b(1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) )289 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 280 290 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 281 CALL tab_2d_1d( nbpb, fbif_1d (1:nbpb), fbif , jpi, jpj, npb(1:nbpb) ) 282 CALL tab_2d_1d( nbpb, qldif_1d (1:nbpb), qldif , jpi, jpj, npb(1:nbpb) ) 283 CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice , jpi, jpj, npb(1:nbpb) ) 284 CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw , jpi, jpj, npb(1:nbpb) ) 285 CALL tab_2d_1d( nbpb, dmgwi_1d (1:nbpb), dmgwi , jpi, jpj, npb(1:nbpb) ) 286 CALL tab_2d_1d( nbpb, qlbbq_1d (1:nbpb), zqlbsbq , jpi, jpj, npb(1:nbpb) ) 287 288 CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd , jpi, jpj, npb(1:nbpb) ) 291 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) 292 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 293 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 294 295 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 296 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 297 298 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 299 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) 300 CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) ) 301 CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) ) 302 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 303 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 304 305 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 306 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) 307 CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) ) 308 CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) ) 289 309 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 290 CALL tab_2d_1d( nbpb, fhbri_1d (1:nbpb), fhbri , jpi, jpj, npb(1:nbpb) ) 291 CALL tab_2d_1d( nbpb, fstbif_1d (1:nbpb), fstric , jpi, jpj, npb(1:nbpb) ) 292 CALL tab_2d_1d( nbpb, qfvbq_1d (1:nbpb), qfvbq , jpi, jpj, npb(1:nbpb) ) 293 294 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) ) ! clem modif 295 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) ) ! clem modif 310 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 311 312 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) ) 313 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) ) 314 315 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 316 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) 317 CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) ) 318 CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) ) 319 CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) ) 320 CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) ) 321 CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) ) 322 CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) ) 323 CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) ) 324 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 325 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 326 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 327 296 328 !-------------------------------- 297 329 ! 4.3) Thermodynamic processes 298 330 !-------------------------------- 299 331 300 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_enmelt( 1, nbpb ) ! computes sea ice energy of melting 301 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec( qt_i_in, qt_s_in, q_i_layer_in, 1, nbpb, jl ) 302 303 ! !---------------------------------! 304 CALL lim_thd_dif( 1, nbpb, jl ) ! Ice/Snow Temperature profile ! 305 ! !---------------------------------! 306 307 CALL lim_thd_enmelt( 1, nbpb ) ! computes sea ice energy of melting compulsory for limthd_dh 308 309 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl ) 310 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_con_dif( 1 , nbpb , jl ) 311 312 ! !---------------------------------! 313 CALL lim_thd_dh( 1, nbpb, jl ) ! Ice/Snow thickness ! 314 ! !---------------------------------! 315 316 ! !---------------------------------! 317 CALL lim_thd_ent( 1, nbpb, jl ) ! Ice/Snow enthalpy remapping ! 318 ! !---------------------------------! 319 320 ! !---------------------------------! 321 CALL lim_thd_sal( 1, nbpb ) ! Ice salinity computation ! 322 ! !---------------------------------! 323 324 ! CALL lim_thd_enmelt(1,nbpb) ! computes sea ice energy of melting 325 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl ) 326 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_con_dh ( 1 , nbpb , jl ) 332 !---------------------------------! 333 ! Ice/Snow Temperature profile ! 334 !---------------------------------! 335 CALL lim_thd_dif( 1, nbpb ) 336 337 !---------------------------------! 338 ! Ice/Snow thicnkess ! 339 !---------------------------------! 340 CALL lim_thd_dh( 1, nbpb ) 341 342 ! --- Ice enthalpy remapping --- ! 343 CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) 344 345 !---------------------------------! 346 ! --- Ice salinity --- ! 347 !---------------------------------! 348 CALL lim_thd_sal( 1, nbpb ) 349 350 !---------------------------------! 351 ! --- temperature update --- ! 352 !---------------------------------! 353 CALL lim_thd_temp( 1, nbpb ) 327 354 328 355 !-------------------------------- … … 330 357 !-------------------------------- 331 358 332 CALL tab_1d_2d( nbpb, at_i , npb, at_i_ b(1:nbpb) , jpi, jpj )333 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_ b(1:nbpb) , jpi, jpj )334 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_ b(1:nbpb) , jpi, jpj )335 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_ b(1:nbpb) , jpi, jpj )336 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_ b(1:nbpb) , jpi, jpj )337 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_ b(1:nbpb) , jpi, jpj )359 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 360 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) 361 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj ) 362 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj ) 363 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj ) 364 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj ) 338 365 DO jk = 1, nlay_s 339 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_ b(1:nbpb,jk), jpi, jpj)340 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_ b(1:nbpb,jk), jpi, jpj)366 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj) 367 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj) 341 368 END DO 342 369 DO jk = 1, nlay_i 343 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b (1:nbpb,jk), jpi, jpj) 344 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b (1:nbpb,jk), jpi, jpj) 345 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b (1:nbpb,jk), jpi, jpj) 346 END DO 347 CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb) , jpi, jpj ) 348 CALL tab_1d_2d( nbpb, qldif , npb, qldif_1d (1:nbpb) , jpi, jpj ) 349 CALL tab_1d_2d( nbpb, qfvbq , npb, qfvbq_1d (1:nbpb) , jpi, jpj ) 350 CALL tab_1d_2d( nbpb, rdm_ice , npb, rdm_ice_1d(1:nbpb) , jpi, jpj ) 351 CALL tab_1d_2d( nbpb, rdm_snw , npb, rdm_snw_1d(1:nbpb) , jpi, jpj ) 352 CALL tab_1d_2d( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) 353 CALL tab_1d_2d( nbpb, rdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 354 CALL tab_1d_2d( nbpb, rdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 355 CALL tab_1d_2d( nbpb, fdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 356 CALL tab_1d_2d( nbpb, rdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 357 CALL tab_1d_2d( nbpb, sfx_thd , npb, sfx_thd_1d(1:nbpb) , jpi, jpj ) 370 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj) 371 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj) 372 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj) 373 END DO 374 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 375 376 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 377 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 378 379 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 380 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) 381 CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj ) 382 CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj ) 383 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 384 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 385 386 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 387 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) 388 CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj ) 389 CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj ) 390 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 358 391 ! 359 392 IF( num_sal == 2 ) THEN 360 393 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 361 CALL tab_1d_2d( nbpb, fhbri , npb, fhbri_1d (1:nbpb) , jpi, jpj )362 394 ENDIF 395 396 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 397 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) 398 CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj ) 399 CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj ) 400 CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj ) 401 CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj ) 402 CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj ) 403 CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj ) 404 CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj ) 405 CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj ) 406 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 407 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb) , jpi, jpj ) 363 408 ! 364 409 !+++++ temporary stuff for a dummy version 365 CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb) , jpi, jpj ) 366 CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb) , jpi, jpj ) 367 CALL tab_1d_2d( nbpb, fsup2D , npb, fsup (1:nbpb) , jpi, jpj ) 368 CALL tab_1d_2d( nbpb, focea2D , npb, focea (1:nbpb) , jpi, jpj ) 369 CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new (1:nbpb) , jpi, jpj ) 370 CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0 (1:nbpb) , jpi, jpj ) 371 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 410 CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb) , jpi, jpj ) 411 CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb) , jpi, jpj ) 412 CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new (1:nbpb) , jpi, jpj ) 413 CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0 (1:nbpb) , jpi, jpj ) 372 414 !+++++ 415 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 416 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 373 417 ! 374 418 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? … … 384 428 ! 5.1) Ice heat content 385 429 !------------------------ 386 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 387 zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 430 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 388 431 DO jl = 1, jpl 389 432 DO jk = 1, nlay_i 390 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef433 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 391 434 END DO 392 435 END DO … … 395 438 ! 5.2) Snow heat content 396 439 !------------------------ 397 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 398 zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 440 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 399 441 DO jl = 1, jpl 400 442 DO jk = 1, nlay_s 401 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef443 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 402 444 END DO 403 445 END DO … … 411 453 ! 5.4) Diagnostic thermodynamic growth rates 412 454 !-------------------------------------------- 413 !clem@useless d_v_i_thd(:,:,:) = v_i (:,:,:) - old_v_i(:,:,:) ! ice volumes414 !clem@mv-to-itd dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday415 416 IF( con_i .AND. jiindex_1d > 0 ) fbif(:,:) = fbif(:,:) + zqlbsbq(:,:)417 418 455 IF(ln_ctl) THEN ! Control print 419 456 CALL prt_ctl_info(' ') … … 448 485 ENDIF 449 486 ! 450 ! ------------------------------- 451 !- check conservation (C Rousset) 452 IF (ln_limdiahsb) THEN 453 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 454 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 455 456 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 457 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 458 459 zchk_vmin = glob_min(v_i) 460 zchk_amax = glob_max(SUM(a_i,dim=3)) 461 zchk_amin = glob_min(a_i) 462 463 IF(lwp) THEN 464 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limthd) = ',(zchk_v_i * rday) 465 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * rday) 466 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limthd) = ',(zchk_vmin * 1.e-3) 467 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limthd) = ',zchk_amax 468 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limthd) = ',zchk_amin 469 ENDIF 470 ENDIF 471 !- check conservation (C Rousset) 472 ! ------------------------------- 473 ! 474 CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 487 ! conservation test 488 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 475 489 ! 476 490 IF( nn_timing == 1 ) CALL timing_stop('limthd') 477 END SUBROUTINE lim_thd 478 479 480 SUBROUTINE lim_thd_glohec( eti, ets, etilayer, kideb, kiut, jl ) 491 END SUBROUTINE lim_thd 492 493 SUBROUTINE lim_thd_temp( kideb, kiut ) 481 494 !!----------------------------------------------------------------------- 482 !! *** ROUTINE lim_thd_ glohec***495 !! *** ROUTINE lim_thd_temp *** 483 496 !! 484 !! ** Purpose : Compute total heat content for each category 485 !! Works with 1d vectors only 486 !!----------------------------------------------------------------------- 487 INTEGER , INTENT(in ) :: kideb, kiut ! bounds for the spatial loop 488 INTEGER , INTENT(in ) :: jl ! category number 489 REAL(wp), INTENT( out), DIMENSION (jpij,jpl ) :: eti, ets ! vertically-summed heat content for ice & snow 490 REAL(wp), INTENT( out), DIMENSION (jpij,jkmax) :: etilayer ! heat content for ice layers 491 !! 492 INTEGER :: ji,jk ! loop indices 493 !!----------------------------------------------------------------------- 494 eti(:,:) = 0._wp 495 ets(:,:) = 0._wp 496 ! 497 DO jk = 1, nlay_i ! total q over all layers, ice [J.m-2] 498 DO ji = kideb, kiut 499 etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 500 eti (ji,jl) = eti(ji,jl) + etilayer(ji,jk) 501 END DO 502 END DO 503 DO ji = kideb, kiut ! total q over all layers, snow [J.m-2] 504 ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 505 END DO 506 ! 507 WRITE(numout,*) ' lim_thd_glohec ' 508 WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 509 WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 510 WRITE(numout,*) ' qt_in : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 511 ! 512 END SUBROUTINE lim_thd_glohec 513 514 515 SUBROUTINE lim_thd_con_dif( kideb, kiut, jl ) 516 !!----------------------------------------------------------------------- 517 !! *** ROUTINE lim_thd_con_dif *** 518 !! 519 !! ** Purpose : Test energy conservation after heat diffusion 520 !!------------------------------------------------------------------- 521 INTEGER , INTENT(in ) :: kideb, kiut ! bounds for the spatial loop 522 INTEGER , INTENT(in ) :: jl ! category number 523 524 INTEGER :: ji, jk ! loop indices 525 INTEGER :: ii, ij 526 INTEGER :: numce ! number of points for which conservation is violated 527 REAL(wp) :: meance ! mean conservation error 528 REAL(wp) :: max_cons_err, max_surf_err 529 !!--------------------------------------------------------------------- 530 531 max_cons_err = 1.0_wp ! maximum tolerated conservation error 532 max_surf_err = 0.001_wp ! maximum tolerated surface error 533 534 !-------------------------- 535 ! Increment of energy 536 !-------------------------- 537 ! global 538 DO ji = kideb, kiut 539 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 540 END DO 541 ! layer by layer 542 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) 543 544 !---------------------------------------- 545 ! Atmospheric heat flux, ice heat budget 546 !---------------------------------------- 547 DO ji = kideb, kiut 548 ii = MOD( npb(ji) - 1 , jpi ) + 1 549 ij = ( npb(ji) - 1 ) / jpi + 1 550 fatm (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) 551 sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(ii,ij,jl) 552 END DO 553 554 !-------------------- 555 ! Conservation error 556 !-------------------- 557 DO ji = kideb, kiut 558 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 559 END DO 560 561 numce = 0 562 meance = 0._wp 563 DO ji = kideb, kiut 564 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 565 numce = numce + 1 566 meance = meance + cons_error(ji,jl) 567 ENDIF 568 END DO 569 IF( numce > 0 ) meance = meance / numce 570 571 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 572 WRITE(numout,*) ' After lim_thd_dif, category : ', jl 573 WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 574 WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit 575 576 !------------------------------------------------------- 577 ! Surface error due to imbalance between Fatm and Fcsu 578 !------------------------------------------------------- 579 numce = 0 580 meance = 0._wp 581 582 DO ji = kideb, kiut 583 surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) ) 584 IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN 585 numce = numce + 1 586 meance = meance + surf_error(ji,jl) 587 ENDIF 588 ENDDO 589 IF( numce > 0 ) meance = meance / numce 590 591 WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err 592 WRITE(numout,*) ' After lim_thd_dif, category : ', jl 593 WRITE(numout,*) ' Mean surface error on big error points ', meance, numit 594 WRITE(numout,*) ' Number of points where there is a surf err gt than surf_err : ', numce, numit 595 596 WRITE(numout,*) ' fc_su : ', fc_su(jiindex_1d) 597 WRITE(numout,*) ' fatm : ', fatm(jiindex_1d,jl) 598 WRITE(numout,*) ' t_su : ', t_su_b(jiindex_1d) 599 600 !--------------------------------------- 601 ! Write ice state in case of big errors 602 !--------------------------------------- 603 DO ji = kideb, kiut 604 IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 605 ( cons_error(ji,jl) .GT. max_cons_err ) ) THEN 606 ii = MOD( npb(ji) - 1, jpi ) + 1 607 ij = ( npb(ji) - 1 ) / jpi + 1 608 ! 609 WRITE(numout,*) ' alerte 1 ' 610 WRITE(numout,*) ' Untolerated conservation / surface error after ' 611 WRITE(numout,*) ' heat diffusion in the ice ' 612 WRITE(numout,*) ' Category : ', jl 613 WRITE(numout,*) ' ii , ij : ', ii, ij 614 WRITE(numout,*) ' lat, lon : ', gphit(ii,ij), glamt(ii,ij) 615 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 616 WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 617 WRITE(numout,*) ' dq_i : ', - dq_i(ji,jl) * r1_rdtice 618 WRITE(numout,*) ' Fdt : ', sum_fluxq(ji,jl) 619 WRITE(numout,*) 620 ! WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) 621 ! WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) 622 ! WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) 623 ! WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) 624 ! WRITE(numout,*) ' qt : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl) 625 WRITE(numout,*) ' ht_i : ', ht_i_b(ji) 626 WRITE(numout,*) ' ht_s : ', ht_s_b(ji) 627 WRITE(numout,*) ' t_su : ', t_su_b(ji) 628 WRITE(numout,*) ' t_s : ', t_s_b(ji,1) 629 WRITE(numout,*) ' t_i : ', t_i_b(ji,1:nlay_i) 630 WRITE(numout,*) ' t_bo : ', t_bo_b(ji) 631 WRITE(numout,*) ' q_i : ', q_i_b(ji,1:nlay_i) 632 WRITE(numout,*) ' s_i : ', s_i_b(ji,1:nlay_i) 633 WRITE(numout,*) ' tmelts : ', rtt - tmut*s_i_b(ji,1:nlay_i) 634 WRITE(numout,*) 635 WRITE(numout,*) ' Fluxes ' 636 WRITE(numout,*) ' ~~~~~~ ' 637 WRITE(numout,*) ' fatm : ', fatm(ji,jl) 638 WRITE(numout,*) ' fc_su : ', fc_su (ji) 639 WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 640 WRITE(numout,*) ' fc_bo : ', - fc_bo_i (ji) 641 WRITE(numout,*) ' foc : ', fbif_1d(ji) 642 WRITE(numout,*) ' fstroc : ', fstroc (ii,ij,jl) 643 WRITE(numout,*) ' i0 : ', i0(ji) 644 WRITE(numout,*) ' qsr_ice : ', (1.0-i0(ji))*qsr_ice_1d(ji) 645 WRITE(numout,*) ' qns_ice : ', qnsr_ice_1d(ji) 646 WRITE(numout,*) ' Conduction fluxes : ' 647 WRITE(numout,*) ' fc_s : ', fc_s(ji,0:nlay_s) 648 WRITE(numout,*) ' fc_i : ', fc_i(ji,0:nlay_i) 649 WRITE(numout,*) 650 WRITE(numout,*) ' Layer by layer ... ' 651 WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 652 WRITE(numout,*) ' dfc_snow : ', fc_s(ji,1) - fc_s(ji,0) 653 DO jk = 1, nlay_i 654 WRITE(numout,*) ' layer : ', jk 655 WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice 656 WRITE(numout,*) ' radab : ', radab(ji,jk) 657 WRITE(numout,*) ' dfc_i : ', fc_i(ji,jk) - fc_i(ji,jk-1) 658 WRITE(numout,*) ' tot f : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk) 659 END DO 660 661 ENDIF 662 ! 663 END DO 664 ! 665 END SUBROUTINE lim_thd_con_dif 666 667 668 SUBROUTINE lim_thd_con_dh( kideb, kiut, jl ) 669 !!----------------------------------------------------------------------- 670 !! *** ROUTINE lim_thd_con_dh *** 671 !! 672 !! ** Purpose : Test energy conservation after enthalpy redistr. 673 !!----------------------------------------------------------------------- 674 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 675 INTEGER, INTENT(in) :: jl ! category number 676 ! 677 INTEGER :: ji ! loop indices 678 INTEGER :: ii, ij, numce ! local integers 679 REAL(wp) :: meance, max_cons_err !local scalar 680 !!--------------------------------------------------------------------- 681 682 max_cons_err = 1._wp 683 684 !-------------------------- 685 ! Increment of energy 686 !-------------------------- 687 DO ji = kideb, kiut 688 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) ! global 689 END DO 690 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) ! layer by layer 691 692 !---------------------------------------- 693 ! Atmospheric heat flux, ice heat budget 694 !---------------------------------------- 695 DO ji = kideb, kiut 696 ii = MOD( npb(ji) - 1 , jpi ) + 1 697 ij = ( npb(ji) - 1 ) / jpi + 1 698 699 fatm (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji) ! total heat flux 700 sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(ii,ij,jl) 701 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 702 END DO 703 704 !-------------------- 705 ! Conservation error 706 !-------------------- 707 DO ji = kideb, kiut 708 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 709 END DO 710 711 numce = 0 712 meance = 0._wp 713 DO ji = kideb, kiut 714 IF( cons_error(ji,jl) .GT. max_cons_err ) THEN 715 numce = numce + 1 716 meance = meance + cons_error(ji,jl) 717 ENDIF 718 ENDDO 719 IF(numce > 0 ) meance = meance / numce 720 721 WRITE(numout,*) ' Error report - Category : ', jl 722 WRITE(numout,*) ' ~~~~~~~~~~~~ ' 723 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 724 WRITE(numout,*) ' After lim_thd_ent, category : ', jl 725 WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 726 WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 727 728 !--------------------------------------- 729 ! Write ice state in case of big errors 730 !--------------------------------------- 731 DO ji = kideb, kiut 732 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 733 ii = MOD( npb(ji) - 1, jpi ) + 1 734 ij = ( npb(ji) - 1 ) / jpi + 1 735 ! 736 WRITE(numout,*) ' alerte 1 - category : ', jl 737 WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 738 WRITE(numout,*) ' ii , ij : ', ii, ij 739 WRITE(numout,*) ' lat, lon : ', gphit(ii,ij), glamt(ii,ij) 740 WRITE(numout,*) ' * ' 741 WRITE(numout,*) ' Ftotal : ', sum_fluxq(ji,jl) 742 WRITE(numout,*) ' dq_t : ', - dq_i(ji,jl) * r1_rdtice 743 WRITE(numout,*) ' dq_i : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 744 WRITE(numout,*) ' dq_s : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 745 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 746 WRITE(numout,*) ' * ' 747 WRITE(numout,*) ' Fluxes --- : ' 748 WRITE(numout,*) ' fatm : ', fatm(ji,jl) 749 WRITE(numout,*) ' foce : ', fbif_1d(ji) 750 WRITE(numout,*) ' fres : ', ftotal_fin(ji) 751 WRITE(numout,*) ' fhbri : ', fhbricat(ii,ij,jl) 752 WRITE(numout,*) ' * ' 753 WRITE(numout,*) ' Heat contents --- : ' 754 WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) * r1_rdtice 755 WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) * r1_rdtice 756 WRITE(numout,*) ' qt_in : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 757 WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) * r1_rdtice 758 WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) * r1_rdtice 759 WRITE(numout,*) ' qt_fin : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 760 WRITE(numout,*) ' * ' 761 WRITE(numout,*) ' Ice variables --- : ' 762 WRITE(numout,*) ' ht_i : ', ht_i_b(ji) 763 WRITE(numout,*) ' ht_s : ', ht_s_b(ji) 764 WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 765 WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 766 WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 767 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 768 ENDIF 769 ! 770 END DO 771 ! 772 END SUBROUTINE lim_thd_con_dh 773 774 775 SUBROUTINE lim_thd_enmelt( kideb, kiut ) 776 !!----------------------------------------------------------------------- 777 !! *** ROUTINE lim_thd_enmelt *** 778 !! 779 !! ** Purpose : Computes sea ice energy of melting q_i (J.m-3) 497 !! ** Purpose : Computes sea ice temperature (Kelvin) from enthalpy 780 498 !! 781 499 !! ** Method : Formula (Bitz and Lipscomb, 1999) … … 784 502 !! 785 503 INTEGER :: ji, jk ! dummy loop indices 786 REAL(wp) :: ztmelts ! local scalar504 REAL(wp) :: ztmelts, zswitch, zaaa, zbbb, zccc, zdiscrim ! local scalar 787 505 !!------------------------------------------------------------------- 788 ! 789 DO jk = 1, nlay_i ! Sea ice energy of melting506 ! Recover ice temperature 507 DO jk = 1, nlay_i 790 508 DO ji = kideb, kiut 791 ztmelts = - tmut * s_i_b(ji,jk) + rtt 792 q_i_b(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) ) & 793 & + lfus * ( 1.0 - (ztmelts-rtt) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) ) & 794 & - rcp * ( ztmelts-rtt ) ) 795 END DO 796 END DO 797 DO jk = 1, nlay_s ! Snow energy of melting 798 DO ji = kideb, kiut 799 q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 800 END DO 801 END DO 802 ! 803 END SUBROUTINE lim_thd_enmelt 804 509 ztmelts = -tmut * s_i_1d(ji,jk) + rtt 510 ! Conversion q(S,T) -> T (second order equation) 511 zaaa = cpic 512 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus 513 zccc = lfus * ( ztmelts - rtt ) 514 zdiscrim = SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 515 t_i_1d(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 516 517 ! mask temperature 518 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 519 t_i_1d(ji,jk) = zswitch * t_i_1d(ji,jk) + ( 1._wp - zswitch ) * rtt 520 END DO 521 END DO 522 523 END SUBROUTINE lim_thd_temp 805 524 806 525 SUBROUTINE lim_thd_init … … 818 537 INTEGER :: ios ! Local integer output status for namelist read 819 538 NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb, & 820 & hicmin, hiclim, & 821 & sbeta , parlat, hakspl, hibspl, exld, & 822 & hakdif, hnzst , thth , parsub, alphs, betas, & 539 & hiclim, hnzst, parsub, betas, & 823 540 & kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 824 541 !!------------------------------------------------------------------- … … 843 560 WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation ' 844 561 WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt 845 WRITE(numout,*)' ice thick. for lateral accretion in NH (SH) hiccrit(1/2)= ', hiccrit562 WRITE(numout,*)' ice thick. for lateral accretion hiccrit = ', hiccrit 846 563 WRITE(numout,*)' Frazil ice thickness as a function of wind or not fraz_swi = ', fraz_swi 847 564 WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom maxfrazb = ', maxfrazb 848 565 WRITE(numout,*)' Thresold relative drift speed for collection of frazil vfrazb = ', vfrazb 849 566 WRITE(numout,*)' Squeezing coefficient for collection of frazil Cfrazb = ', Cfrazb 850 WRITE(numout,*)' ice thick. corr. to max. energy stored in brine pocket hicmin = ', hicmin851 567 WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim 852 568 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' 853 WRITE(numout,*)' Cranck-Nicholson (=0.5), implicit (=1), explicit (=0) sbeta = ', sbeta854 WRITE(numout,*)' percentage of energy used for lateral ablation parlat = ', parlat855 WRITE(numout,*)' slope of distr. for Hakkinen-Mellor lateral melting hakspl = ', hakspl856 WRITE(numout,*)' slope of distribution for Hibler lateral melting hibspl = ', hibspl857 WRITE(numout,*)' exponent for leads-closure rate exld = ', exld858 WRITE(numout,*)' coefficient for diffusions of ice and snow hakdif = ', hakdif859 WRITE(numout,*)' threshold thick. for comp. of eq. thermal conductivity zhth = ', thth860 569 WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst 861 570 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub 862 WRITE(numout,*)' coefficient for snow density when snow ice formation alphs = ', alphs863 571 WRITE(numout,*)' coefficient for ice-lead partition of snowfall betas = ', betas 864 572 WRITE(numout,*)' extinction radiation parameter in sea ice (1.0) kappa_i = ', kappa_i … … 866 574 WRITE(numout,*)' maximal err. on T for heat diffusion computation maxer_i_thd = ', maxer_i_thd 867 575 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice thcon_i_swi = ', thcon_i_swi 576 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 868 577 ENDIF 869 !870 rcdsn = hakdif * rcdsn871 rcdic = hakdif * rcdic872 578 ! 873 579 END SUBROUTINE lim_thd_init -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4333 r4921 6 6 !! History : LIM ! 2003-05 (M. Vancoppenolle) Original code in 1D 7 7 !! ! 2005-06 (M. Vancoppenolle) 3D version 8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw & rdm_ice8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice 9 9 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 10 10 !! 3.5 ! 2012-10 (G. Madec & co) salt flux + bug fixes … … 26 26 USE wrk_nemo ! work arrays 27 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 28 USE cpl_oasis3, ONLY : lk_cpl 29 29 30 IMPLICIT NONE 30 31 PRIVATE … … 34 35 REAL(wp) :: epsi20 = 1.e-20 ! constant values 35 36 REAL(wp) :: epsi10 = 1.e-10 ! 36 REAL(wp) :: epsi13 = 1.e-13 !37 REAL(wp) :: zzero = 0._wp !38 REAL(wp) :: zone = 1._wp !39 37 40 38 !!---------------------------------------------------------------------- … … 45 43 CONTAINS 46 44 47 SUBROUTINE lim_thd_dh( kideb, kiut , jl)45 SUBROUTINE lim_thd_dh( kideb, kiut ) 48 46 !!------------------------------------------------------------------ 49 47 !! *** ROUTINE lim_thd_dh *** … … 70 68 !!------------------------------------------------------------------ 71 69 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 72 INTEGER , INTENT(in) :: jl ! Thickness cateogry number73 70 !! 74 71 INTEGER :: ji , jk ! dummy loop indices 75 72 INTEGER :: ii, ij ! 2D corresponding indices to ji 76 INTEGER :: isnow ! switch for presence (1) or absence (0) of snow77 INTEGER :: isnowic ! snow ice formation not78 INTEGER :: i_ice_switch ! ice thickness above a certain treshold or not79 73 INTEGER :: iter 80 74 81 REAL(wp) :: zzfmass_i, zihgnew ! local scalar 82 REAL(wp) :: zzfmass_s, zhsnew, ztmelts ! local scalar 83 REAL(wp) :: zhn, zdhcf, zdhbf, zhni, zhnfi, zihg ! 84 REAL(wp) :: zdhnm, zhnnew, zhisn, zihic, zzc ! 75 REAL(wp) :: ztmelts ! local scalar 76 REAL(wp) :: zdh, zfdum ! 85 77 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 86 78 REAL(wp) :: zcoeff ! dummy argument for snowfall partitioning over ice and leads 87 REAL(wp) :: zs m_snowice! snow-ice salinity79 REAL(wp) :: zs_snic ! snow-ice salinity 88 80 REAL(wp) :: zswi1 ! switch for computation of bottom salinity 89 81 REAL(wp) :: zswi12 ! switch for computation of bottom salinity 90 82 REAL(wp) :: zswi2 ! switch for computation of bottom salinity 91 83 REAL(wp) :: zgrr ! bottom growth rate 92 REAL(wp) :: ztform ! bottom formation temperature 93 ! 94 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 84 REAL(wp) :: zt_i_new ! bottom formation temperature 85 86 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean 87 REAL(wp) :: zEi ! specific enthalpy of sea ice (J/kg) 88 REAL(wp) :: zEw ! specific enthalpy of exchanged water (J/kg) 89 REAL(wp) :: zdE ! specific enthalpy difference (J/kg) 90 REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean 91 REAL(wp) :: zsstK ! SST in Kelvin 92 95 93 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 96 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! melting point 97 REAL(wp), POINTER, DIMENSION(:) :: zhsold ! old snow thickness 98 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow 99 REAL(wp), POINTER, DIMENSION(:) :: zqfont_su ! incoming, remaining surface energy 100 REAL(wp), POINTER, DIMENSION(:) :: zqfont_bo ! incoming, bottom energy 101 REAL(wp), POINTER, DIMENSION(:) :: z_f_surf ! surface heat for ablation 102 REAL(wp), POINTER, DIMENSION(:) :: zhgnew ! new ice thickness 103 REAL(wp), POINTER, DIMENSION(:) :: zfmass_i ! 94 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3) 95 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2) 96 REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2) 97 REAL(wp), POINTER, DIMENSION(:) :: zq_1cat ! corrected heat in case 1-cat and hmelt>15cm (J.m-2) 98 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 99 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 100 INTEGER , POINTER, DIMENSION(:) :: icount ! number of layers vanished by melting 104 101 105 102 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt … … 108 105 109 106 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah 110 111 ! Pathological cases 112 REAL(wp), POINTER, DIMENSION(:) :: zfdt_init ! total incoming heat for ice melt 113 REAL(wp), POINTER, DIMENSION(:) :: zfdt_final ! total remaing heat for ice melt 114 REAL(wp), POINTER, DIMENSION(:) :: zqt_i ! total ice heat content 115 REAL(wp), POINTER, DIMENSION(:) :: zqt_s ! total snow heat content 116 REAL(wp), POINTER, DIMENSION(:) :: zqt_dummy ! dummy heat content 117 118 REAL(wp), POINTER, DIMENSION(:,:) :: zqt_i_lay ! total ice heat content 107 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness 108 109 REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2) 110 REAL(wp), POINTER, DIMENSION(:) :: zqh_s ! total snow heat content (J.m-2) 111 REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3) 119 112 120 113 ! mass and salt flux (clem) 121 REAL(wp) :: zdvres, zdvsur, zdvbot 122 REAL(wp), POINTER, DIMENSION(:) :: zviold, zvsold ! old ice volume... 114 REAL(wp) :: zdvres, zswitch_sal, zswitch 123 115 124 116 ! Heat conservation 125 INTEGER :: num_iter_max, numce_dh 126 REAL(wp) :: meance_dh 127 REAL(wp) :: zinda 128 REAL(wp), POINTER, DIMENSION(:) :: zinnermelt 129 REAL(wp), POINTER, DIMENSION(:) :: zfbase, zdq_i 117 INTEGER :: num_iter_max 118 REAL(wp) :: zinda, zindq, zindh 119 REAL(wp), POINTER, DIMENSION(:) :: zintermelt ! debug 120 130 121 !!------------------------------------------------------------------ 131 122 132 CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 133 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 134 CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 135 CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 136 137 CALL wrk_alloc( jpij, zviold, zvsold ) ! clem 123 ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values) 124 SELECT CASE( num_sal ) ! varying salinity or not 125 CASE( 1, 3, 4 ) ; zswitch_sal = 0 ! prescribed salinity profile 126 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile 127 END SELECT 128 129 CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 130 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 131 CALL wrk_alloc( jpij, zintermelt ) 132 CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i ) 133 CALL wrk_alloc( jpij, icount ) 138 134 139 ftotal_fin(:) = 0._wp 140 zfdt_init (:) = 0._wp 141 zfdt_final(:) = 0._wp 142 143 dh_i_surf (:) = 0._wp 144 dh_i_bott (:) = 0._wp 145 dh_snowice(:) = 0._wp 146 147 DO ji = kideb, kiut 148 old_ht_i_b(ji) = ht_i_b(ji) 149 old_ht_s_b(ji) = ht_s_b(ji) 150 zviold(ji) = a_i_b(ji) * ht_i_b(ji) ! clem 151 zvsold(ji) = a_i_b(ji) * ht_s_b(ji) ! clem 152 END DO 135 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp 136 dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp 137 138 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt (:) = 0._wp 139 zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp 140 141 zh_s (:) = 0._wp 142 zdh_s_pre(:) = 0._wp 143 zdh_s_mel(:) = 0._wp 144 zdh_s_sub(:) = 0._wp 145 zqh_s (:) = 0._wp 146 zqh_i (:) = 0._wp 147 148 zh_i (:,:) = 0._wp 149 zdeltah (:,:) = 0._wp 150 zintermelt(:) = 0._wp 151 icount (:) = 0 152 153 ! initialize layer thicknesses and enthalpies 154 h_i_old (:,0:nlay_i+1) = 0._wp 155 qh_i_old(:,0:nlay_i+1) = 0._wp 156 DO jk = 1, nlay_i 157 DO ji = kideb, kiut 158 h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i ) 159 qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk) 160 ENDDO 161 ENDDO 153 162 ! 154 163 !------------------------------------------------------------------------------! 155 ! 1) Calculate available heat for surface a blation!164 ! 1) Calculate available heat for surface and bottom ablation ! 156 165 !------------------------------------------------------------------------------! 157 166 ! 158 167 DO ji = kideb, kiut 159 isnow = INT( 1.0 - MAX( 0.0 , SIGN( 1.0 , - ht_s_b(ji) ) ) ) 160 ztfs (ji) = isnow * rtt + ( 1.0 - isnow ) * rtt 161 z_f_surf (ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 162 z_f_surf (ji) = MAX( zzero , z_f_surf(ji) ) * MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 163 zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice 164 END DO ! ji 165 166 zqfont_su (:) = 0._wp 167 zqfont_bo (:) = 0._wp 168 dsm_i_se_1d(:) = 0._wp 169 dsm_i_si_1d(:) = 0._wp 168 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 169 ztmelts = zinda * rtt + ( 1._wp - zinda ) * rtt 170 171 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 172 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 173 174 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) ) 175 zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 176 END DO 177 170 178 ! 171 179 !------------------------------------------------------------------------------! 172 ! 2) Computing layer thicknesses and snow and sea-ice enthalpies. ! 180 ! If snow temperature is above freezing point, then snow melts 181 ! (should not happen but sometimes it does) 173 182 !------------------------------------------------------------------------------! 174 ! 175 DO ji = kideb, kiut ! Layer thickness 176 zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 177 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 178 END DO 179 ! 180 zqt_s(:) = 0._wp ! Total enthalpy of the snow 183 DO ji = kideb, kiut 184 IF( t_s_1d(ji,1) > rtt ) THEN !!! Internal melting 185 ! Contribution to heat flux to the ocean [W.m-2], < 0 186 hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 187 ! Contribution to mass flux 188 wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 189 ! updates 190 ht_s_1d(ji) = 0._wp 191 q_s_1d (ji,1) = 0._wp 192 t_s_1d (ji,1) = rtt 193 END IF 194 END DO 195 196 !------------------------------------------------------------! 197 ! 2) Computing layer thicknesses and enthalpies. ! 198 !------------------------------------------------------------! 199 ! 200 DO ji = kideb, kiut 201 zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 202 END DO 203 ! 181 204 DO jk = 1, nlay_s 182 205 DO ji = kideb, kiut 183 zq t_s(ji) = zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s)206 zqh_s(ji) = zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji) 184 207 END DO 185 208 END DO 186 209 ! 187 zqt_i(:) = 0._wp ! Total enthalpy of the ice188 210 DO jk = 1, nlay_i 189 211 DO ji = kideb, kiut 190 zzc = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 191 zqt_i(ji) = zqt_i(ji) + zzc 192 zqt_i_lay(ji,jk) = zzc 212 zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i ) 213 zqh_i(ji) = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk) 193 214 END DO 194 215 END DO … … 212 233 ! Martin Vancoppenolle, December 2006 213 234 214 ! Snow fall 215 DO ji = kideb, kiut 216 zcoeff = ( 1.0 - ( 1.0 - at_i_b(ji) )**betas ) / at_i_b(ji) 235 DO ji = kideb, kiut 236 !----------- 237 ! Snow fall 238 !----------- 239 ! thickness change 240 zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**betas ) / at_i_1d(ji) 217 241 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn 218 END DO 219 zdh_s_mel(:) = 0._wp 220 221 ! Melt of fallen snow 222 DO ji = kideb, kiut 223 ! tatm_ice is now in K 224 zqprec (ji) = rhosn * ( cpic * ( rtt - tatm_ice_1d(ji) ) + lfus ) 225 zqfont_su(ji) = z_f_surf(ji) * rdt_ice 226 zdeltah (ji,1) = MIN( 0.e0 , - zqfont_su(ji) / MAX( zqprec(ji) , epsi13 ) ) 227 zqfont_su(ji) = MAX( 0.e0 , - zdh_s_pre(ji) - zdeltah(ji,1) ) * zqprec(ji) 228 zdeltah (ji,1) = MAX( - zdh_s_pre(ji) , zdeltah(ji,1) ) 229 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1) 230 ! heat conservation 231 qt_s_in(ji,jl) = qt_s_in(ji,jl) + zqprec(ji) * zdh_s_pre(ji) 232 zqt_s (ji) = zqt_s (ji) + zqprec(ji) * zdh_s_pre(ji) 233 zqt_s (ji) = MAX( zqt_s(ji) - zqfont_su(ji) , 0.e0 ) 234 END DO 235 236 237 ! Snow melt due to surface heat imbalance 242 ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 243 zqprec (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus ) 244 IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 245 ! heat flux from snow precip (>0, W.m-2) 246 hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 247 ! mass flux, <0 248 wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice 249 ! update thickness 250 ht_s_1d (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) ) 251 252 !--------------------- 253 ! Melt of falling snow 254 !--------------------- 255 ! thickness change 256 IF( zdh_s_pre(ji) > 0._wp ) THEN 257 zindq = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) ) 258 zdh_s_mel (ji) = - zindq * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 259 zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting 260 ! heat used to melt snow (W.m-2, >0) 261 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 262 ! snow melting only = water into the ocean (then without snow precip), >0 263 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice 264 265 ! updates available heat + thickness 266 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) ) 267 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) ) 268 zh_s (ji) = ht_s_1d(ji) / REAL( nlay_s ) 269 270 ENDIF 271 END DO 272 273 ! If heat still available, then melt more snow 274 zdeltah(:,:) = 0._wp ! important 238 275 DO jk = 1, nlay_s 239 276 DO ji = kideb, kiut 240 zdeltah (ji,jk) = - zqfont_su(ji) / q_s_b(ji,jk) 241 zqfont_su(ji) = MAX( 0.0 , - zh_s(ji) - zdeltah(ji,jk) ) * q_s_b(ji,jk) 242 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) 243 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) ! resulting melt of snow 277 ! thickness change 278 zindh = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) 279 zindq = 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_1d(ji,jk) + epsi20 ) ) 280 zdeltah (ji,jk) = - zindh * zindq * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 ) 281 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting 282 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) 283 ! heat used to melt snow(W.m-2, >0) 284 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * q_s_1d(ji,jk) * r1_rdtice 285 ! snow melting only = water into the ocean (then without snow precip) 286 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 287 288 ! updates available heat + thickness 289 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 290 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) ) 291 244 292 END DO 245 293 END DO 246 294 247 ! Apply snow melt to snow depth 248 DO ji = kideb, kiut 249 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) 250 ! Old and new snow depths 251 zhsold(ji) = ht_s_b(ji) 252 zhsnew = ht_s_b(ji) + dh_s_tot(ji) 253 ! If snow is still present zhn = 1, else zhn = 0 254 zhn = 1.0 - MAX( zzero , SIGN( zone , - zhsnew ) ) 255 ht_s_b(ji) = MAX( zzero , zhsnew ) 256 ! we recompute dh_s_tot (clem) 257 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 258 ! Volume and mass variations of snow 259 dvsbq_1d (ji) = a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 260 dvsbq_1d (ji) = MIN( zzero, dvsbq_1d(ji) ) 261 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 295 !---------------------- 296 ! 3.2 Snow sublimation 297 !---------------------- 298 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 299 ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean) 300 ! clem comment: ice should also sublimate 301 IF( lk_cpl ) THEN 302 ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 303 zdh_s_sub(:) = 0._wp 304 ELSE 305 ! forced mode: snow thickness change due to sublimation 306 DO ji = kideb, kiut 307 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 308 ! Heat flux by sublimation [W.m-2], < 0 309 ! sublimate first snow that had fallen, then pre-existing snow 310 zcoeff = ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) * zqprec(ji) + & 311 & ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) ) & 312 & * a_i_1d(ji) * r1_rdtice 313 hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff 314 ! Mass flux by sublimation 315 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 316 ! new snow thickness 317 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 318 END DO 319 ENDIF 320 321 ! --- Update snow diags --- ! 322 DO ji = kideb, kiut 323 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 324 zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 262 325 END DO ! ji 263 326 327 !------------------------------------------- 328 ! 3.3 Update temperature, energy 329 !------------------------------------------- 330 ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 331 zq_s(:) = 0._wp 332 DO jk = 1, nlay_s 333 DO ji = kideb,kiut 334 zindh = MAX( 0._wp , SIGN( 1._wp, - ht_s_1d(ji) + epsi20 ) ) 335 q_s_1d(ji,jk) = ( 1._wp - zindh ) / MAX( ht_s_1d(ji), epsi20 ) * & 336 & ( ( MAX( 0._wp, dh_s_tot(ji) ) ) * zqprec(ji) + & 337 & ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) ) 338 zq_s(ji) = zq_s(ji) + q_s_1d(ji,jk) 339 END DO 340 END DO 341 264 342 !-------------------------- 265 ! 3. 2Surface ice ablation343 ! 3.4 Surface ice ablation 266 344 !-------------------------- 267 DO ji = kideb, kiut 268 z_f_surf (ji) = zqfont_su(ji) * r1_rdtice ! heat conservation test 269 zdq_i (ji) = 0._wp 270 END DO ! ji 271 345 zdeltah(:,:) = 0._wp ! important 272 346 DO jk = 1, nlay_i 273 347 DO ji = kideb, kiut 274 ! ! melt of layer jk 275 zdeltah (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk) 276 ! ! recompute heat available 277 zqfont_su(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 278 ! ! melt of layer jk cannot be higher than its thickness 279 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 280 ! ! update surface melt 281 dh_i_surf(ji ) = dh_i_surf(ji) + zdeltah(ji,jk) 282 ! ! for energy conservation 283 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 284 ! 285 ! clem 286 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) & 287 & * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 348 zEi = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of layer k [J/kg, <0] 349 350 ztmelts = - tmut * s_i_1d(ji,jk) + rtt ! Melting point of layer k [K] 351 352 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0] 353 354 zdE = zEi - zEw ! Specific enthalpy difference < 0 355 356 zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 357 358 zdeltah(ji,jk) = - zfmdt / rhoic ! Melt of layer jk [m, <0] 359 360 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0] 361 362 zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 363 364 dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt 365 366 zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 367 368 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 369 370 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 371 sfx_sum_1d(ji) = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 372 373 ! Contribution to heat flux [W.m-2], < 0 374 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 375 376 ! Total heat flux used in this process [W.m-2], > 0 377 hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 378 379 ! Contribution to mass flux 380 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 381 382 ! record which layers have disappeared (for bottom melting) 383 ! => icount=0 : no layer has vanished 384 ! => icount=5 : 5 layers have vanished 385 zindh = NINT( MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) ) 386 icount(ji) = icount(ji) + zindh 387 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 388 389 ! update heat content (J.m-2) and layer thickness 390 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 391 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 288 392 END DO 289 393 END DO 290 291 ! !------------------- 292 IF( con_i .AND. jiindex_1d > 0 ) THEN ! Conservation test 293 ! !------------------- 294 numce_dh = 0 295 meance_dh = 0._wp 296 DO ji = kideb, kiut 297 IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 298 numce_dh = numce_dh + 1 299 meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji) 300 ENDIF 301 IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN! 302 WRITE(numout,*) ' ALERTE heat loss for surface melt ' 303 WRITE(numout,*) ' ii, ij, jl :', ii, ij, jl 304 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 305 WRITE(numout,*) ' z_f_surf : ', z_f_surf(ji) 306 WRITE(numout,*) ' zdq_i : ', zdq_i(ji) 307 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 308 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 309 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 310 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 311 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 312 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij) 313 ENDIF 314 END DO 315 ! 316 IF( numce_dh > 0 ) meance_dh = meance_dh / numce_dh 317 WRITE(numout,*) ' Error report - Category : ', jl 318 WRITE(numout,*) ' ~~~~~~~~~~~~ ' 319 WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh 320 WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh 321 ! 322 ENDIF 323 324 !---------------------- 325 ! 3.3 Snow sublimation 326 !---------------------- 327 328 DO ji = kideb, kiut 329 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 330 #if defined key_coupled 331 zdh_s_sub(ji) = 0._wp ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 332 #else 333 ! ! forced mode: snow thickness change due to sublimation 334 zdh_s_sub(ji) = - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice 335 #endif 336 dh_s_tot (ji) = dh_s_tot(ji) + zdh_s_sub(ji) 337 zdhcf = ht_s_b(ji) + zdh_s_sub(ji) 338 ht_s_b (ji) = MAX( zzero , zdhcf ) 339 ! we recompute dh_s_tot 340 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 341 qt_s_in (ji,jl) = qt_s_in(ji,jl) + zdh_s_sub(ji)*q_s_b(ji,1) 342 END DO 343 344 zqt_dummy(:) = 0.e0 345 DO jk = 1, nlay_s 346 DO ji = kideb,kiut 347 q_s_b (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 348 zqt_dummy(ji) = zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) ! heat conservation 349 END DO 350 END DO 351 352 DO jk = 1, nlay_s 353 DO ji = kideb, kiut 354 ! In case of disparition of the snow, we have to update the snow temperatures 355 zhisn = MAX( zzero , SIGN( zone, - ht_s_b(ji) ) ) 356 t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 357 q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) 358 END DO 394 ! update ice thickness 395 DO ji = kideb, kiut 396 ht_i_1d(ji) = MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) ) 359 397 END DO 360 398 … … 364 402 !------------------------------------------------------------------------------! 365 403 ! 366 ! Ice basal growth / melt is given by the ratio of heat budget over basal 367 ! ice heat content. Basal heat budget is given by the difference between 368 ! the inner conductive flux (fc_bo_i), from the open water heat flux 369 ! (qlbbqb) and the turbulent ocean flux (fbif). 370 ! fc_bo_i is positive downwards. fbif and qlbbq are positive to the ice 371 372 !----------------------------------------------------- 373 ! 4.1 Basal growth - (a) salinity not varying in time 374 !----------------------------------------------------- 375 IF( num_sal /= 2 ) THEN ! ice salinity constant in time 404 !------------------ 405 ! 4.1 Basal growth 406 !------------------ 407 ! Basal growth is driven by heat imbalance at the ice-ocean interface, 408 ! between the inner conductive flux (fc_bo_i), from the open water heat flux 409 ! (fhld) and the turbulent ocean flux (fhtur). 410 ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice 411 412 ! If salinity varies in time, an iterative procedure is required, because 413 ! the involved quantities are inter-dependent. 414 ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi), 415 ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott) 416 ! -> need for an iterative procedure, which converges quickly 417 418 IF ( num_sal == 2 ) THEN 419 num_iter_max = 5 420 ELSE 421 num_iter_max = 1 422 ENDIF 423 424 !clem debug. Just to be sure that enthalpy at nlay_i+1 is null 425 DO ji = kideb, kiut 426 q_i_1d(ji,nlay_i+1) = 0._wp 427 END DO 428 429 ! Iterative procedure 430 DO iter = 1, num_iter_max 376 431 DO ji = kideb, kiut 377 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0._wp ) THEN 378 s_i_new(ji) = sm_i_b(ji) 379 ! Melting point in K 380 ztmelts = - tmut * s_i_new(ji) + rtt 381 ! New ice heat content (Bitz and Lipscomb, 1999) 382 ztform = t_i_b(ji,nlay_i) ! t_bo_b crashes in the 383 ! Baltic 384 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - ztform ) & 385 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( ztform - rtt ) ) & 386 & - rcp * ( ztmelts - rtt ) ) 387 ! Basal growth rate = - F*dt / q 388 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 389 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 390 ENDIF 391 END DO 392 ENDIF 393 394 !------------------------------------------------- 395 ! 4.1 Basal growth - (b) salinity varying in time 396 !------------------------------------------------- 397 IF( num_sal == 2 ) THEN 398 ! the growth rate (dh_i_bott) is function of the new ice heat content (q_i_b(nlay_i+1)). 399 ! q_i_b depends on the new ice salinity (snewice). 400 ! snewice depends on dh_i_bott ; it converges quickly, so, no problem 401 ! See Vancoppenolle et al., OM08 for more info on this 402 403 ! Initial value (tested 1D, can be anything between 1 and 20) 404 num_iter_max = 4 405 s_i_new(:) = 4.0 406 407 ! Iterative procedure 408 DO iter = 1, num_iter_max 409 DO ji = kideb, kiut 410 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0 ) THEN 411 ii = MOD( npb(ji) - 1, jpi ) + 1 412 ij = ( npb(ji) - 1 ) / jpi + 1 413 ! Melting point in K 414 ztmelts = - tmut * s_i_new(ji) + rtt 415 ! New ice heat content (Bitz and Lipscomb, 1999) 416 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 417 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 418 & - rcp * ( ztmelts-rtt ) ) 419 ! Bottom growth rate = - F*dt / q 420 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 421 ! New ice salinity ( Cox and Weeks, JGR, 1988 ) 422 ! zswi2 (1) if dh_i_bott/rdt .GT. 3.6e-7 423 ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8 424 ! zswi1 (1) if dh_i_bott/rdt .LT. 2.0e-8 425 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi13 ) ) 426 zswi2 = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) ) 427 zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 428 zswi1 = 1. - zswi2 * zswi12 429 zfracs = zswi1 * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) & 430 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) 431 zfracs = MIN( 0.5 , zfracs ) 432 s_i_new(ji) = zfracs * sss_m(ii,ij) 433 ENDIF ! fc_bo_i 434 END DO ! ji 435 END DO ! iter 436 437 ! Final values 438 DO ji = kideb, kiut 439 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .LT. 0.0 ) THEN 440 ! New ice salinity must not exceed 20 psu 441 s_i_new(ji) = MIN( s_i_new(ji), s_i_max ) 442 ! Metling point in K 443 ztmelts = - tmut * s_i_new(ji) + rtt 444 ! New ice heat content (Bitz and Lipscomb, 1999) 445 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 446 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 447 & - rcp * ( ztmelts - rtt ) ) 448 ! Basal growth rate = - F*dt / q 449 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 450 ! Salinity update 451 ! entrapment during bottom growth 452 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 453 ENDIF ! heat budget 454 END DO 455 ENDIF 432 IF( zf_tt(ji) < 0._wp ) THEN 433 434 ! New bottom ice salinity (Cox & Weeks, JGR88 ) 435 !--- zswi1 if dh/dt < 2.0e-8 436 !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 437 !--- zswi2 if dh/dt > 3.6e-7 438 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) ) 439 zswi2 = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 440 zswi12 = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 441 zswi1 = 1. - zswi2 * zswi12 442 zfracs = MIN ( zswi1 * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) & 443 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) , 0.5 ) 444 445 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 446 447 s_i_new(ji) = zswitch_sal * zfracs * sss_m(ii,ij) & ! New ice salinity 448 + ( 1. - zswitch_sal ) * sm_i_1d(ji) 449 ! New ice growth 450 ztmelts = - tmut * s_i_new(ji) + rtt ! New ice melting point (K) 451 452 zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 453 454 zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0) 455 & - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) ) & 456 & + rcp * ( ztmelts-rtt ) 457 458 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) 459 460 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 461 462 dh_i_bott(ji) = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) ) 463 464 q_i_1d(ji,nlay_i+1) = -zEi * rhoic ! New ice energy of melting (J/m3, >0) 465 466 ENDIF ! fc_bo_i 467 END DO ! ji 468 END DO ! iter 469 470 ! Contribution to Energy and Salt Fluxes 471 DO ji = kideb, kiut 472 IF( zf_tt(ji) < 0._wp ) THEN 473 ! New ice growth 474 475 zfmdt = - rhoic * dh_i_bott(ji) ! Mass flux x time step (kg/m2, < 0) 476 477 ztmelts = - tmut * s_i_new(ji) + rtt ! New ice melting point (K) 478 479 zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 480 481 zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0) 482 & - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) ) & 483 & + rcp * ( ztmelts-rtt ) 484 485 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) 486 487 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 488 489 ! Contribution to heat flux to the ocean [W.m-2], >0 490 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 491 492 ! Total heat flux used in this process [W.m-2], <0 493 hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 494 495 ! Contribution to salt flux, <0 496 sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice 497 498 ! Contribution to mass flux, <0 499 wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * r1_rdtice 500 501 ! update heat content (J.m-2) and layer thickness 502 qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_1d(ji,nlay_i+1) 503 h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji) 504 ENDIF 505 END DO 456 506 457 507 !---------------- 458 508 ! 4.2 Basal melt 459 509 !---------------- 460 meance_dh = 0._wp 461 numce_dh = 0 462 zinnermelt(:) = 0._wp 463 464 DO ji = kideb, kiut 465 ! heat convergence at the surface > 0 466 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0._wp ) THEN 467 s_i_new(ji) = s_i_b(ji,nlay_i) 468 zqfont_bo(ji) = rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 469 zfbase(ji) = zqfont_bo(ji) * r1_rdtice ! heat conservation test 470 zdq_i(ji) = 0._wp 471 dh_i_bott(ji) = 0._wp 472 ENDIF 473 END DO 474 510 zdeltah(:,:) = 0._wp ! important 475 511 DO jk = nlay_i, 1, -1 476 512 DO ji = kideb, kiut 477 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN 478 ztmelts = - tmut * s_i_b(ji,jk) + rtt 479 IF( t_i_b(ji,jk) >= ztmelts ) THEN !!gm : a comment is needed 480 zdeltah (ji,jk) = - zh_i(ji) 481 dh_i_bott (ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 482 zinnermelt(ji ) = 1._wp 483 ELSE ! normal ablation 484 zdeltah (ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 485 zqfont_bo(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 486 zdeltah (ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 487 dh_i_bott(ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 488 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 513 IF( zf_tt(ji) >= 0._wp .AND. jk > icount(ji) ) THEN ! do not calculate where layer has already disappeared from surface melting 514 515 ztmelts = - tmut * s_i_1d(ji,jk) + rtt ! Melting point of layer jk (K) 516 517 IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 518 zintermelt(ji) = 1._wp 519 520 zEi = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 521 522 !!zEw = rcp * ( t_i_1d(ji,jk) - rtt ) ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0) 523 524 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 525 ! set up at 0 since no energy is needed to melt water...(it is already melted) 526 527 zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 528 ! this should normally not happen, but sometimes, heat diffusion leads to this 529 530 dh_i_bott (ji) = dh_i_bott(ji) + zdeltah(ji,jk) 531 532 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 533 534 ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 535 hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice 536 537 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 538 sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 539 540 ! Contribution to mass flux 541 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 542 543 ! update heat content (J.m-2) and layer thickness 544 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 545 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 546 547 ELSE !!! Basal melting 548 549 zEi = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 550 551 zEw = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0) 552 553 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 554 555 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0) 556 557 zdeltah(ji,jk) = - zfmdt / rhoic ! Gross thickness change 558 559 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 560 561 zq_bo(ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 562 563 dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) ! Update basal melt 564 565 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 566 567 zQm = zfmdt * zEw ! Heat exchanged with ocean 568 569 ! Contribution to heat flux to the ocean [W.m-2], <0 570 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 571 572 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 573 sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 574 575 ! Total heat flux used in this process [W.m-2], >0 576 hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 577 578 ! Contribution to mass flux 579 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 580 581 ! update heat content (J.m-2) and layer thickness 582 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 583 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 489 584 ENDIF 490 ! clem: contribution to salt flux 491 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) & 492 & * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 585 493 586 ENDIF 494 587 END DO ! ji 495 588 END DO ! jk 496 589 497 ! !-------------------498 IF( con_i .AND. jiindex_1d > 0 ) THEN ! Conservation test499 ! !-------------------500 DO ji = kideb, kiut501 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0.e0 ) THEN502 IF( ( zfbase(ji) + zdq_i(ji) ) >= 1.e-3 ) THEN503 numce_dh = numce_dh + 1504 meance_dh = meance_dh + zfbase(ji) + zdq_i(ji)505 ENDIF506 IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN507 WRITE(numout,*) ' ALERTE heat loss for basal melt : ii, ij, jl :', ii, ij, jl508 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji)509 WRITE(numout,*) ' zfbase : ', zfbase(ji)510 WRITE(numout,*) ' zdq_i : ', zdq_i(ji)511 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji)512 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji)513 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji)514 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji)515 WRITE(numout,*) ' s_i_new : ', s_i_new(ji)516 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij)517 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji)518 WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) )519 ENDIF520 ENDIF521 END DO522 IF( numce_dh > 0 ) meance_dh = meance_dh / numce_dh523 WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh524 WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh525 WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d)526 !527 ENDIF528 529 !530 590 !------------------------------------------------------------------------------! 531 ! 5) Pathological cases ! 591 ! Excessive ablation in a 1-category model 592 ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 532 593 !------------------------------------------------------------------------------! 533 ! 534 !---------------------------------------------- 535 ! 5.1 Excessive ablation in a 1-category model 536 !---------------------------------------------- 537 538 DO ji = kideb, kiut 539 ! ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 540 IF( jpl == 1 ) THEN ; zdhbf = MAX( hmelt , dh_i_bott(ji) ) 541 ELSE ; zdhbf = dh_i_bott(ji) 542 ENDIF 543 zdvres = zdhbf - dh_i_bott(ji) 544 dh_i_bott(ji) = zdhbf 545 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice 546 ! ! excessive energy is sent to lateral ablation 547 zinda = MAX( 0._wp, SIGN( 1._wp , 1.0 - at_i_b(ji) - epsi10 ) ) 548 fsup(ji) = zinda * rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi10 ) * zdvres * r1_rdtice 549 END DO 550 551 !----------------------------------- 552 ! 5.2 More than available ice melts 553 !----------------------------------- 554 ! then heat applied minus heat content at previous time step should equal heat remaining 555 ! 556 DO ji = kideb, kiut 557 ! Adapt the remaining energy if too much ice melts 558 !-------------------------------------------------- 559 zdvres = MAX( 0._wp, - ht_i_b(ji) - dh_i_surf(ji) - dh_i_bott(ji) ) 560 zdvsur = MIN( 0._wp, dh_i_surf(ji) + zdvres ) - dh_i_surf(ji) ! fill the surface first 561 zdvbot = MAX( 0._wp, zdvres - zdvsur ) ! then the bottom 562 dh_i_surf (ji) = dh_i_surf(ji) + zdvsur ! clem 563 dh_i_bott (ji) = dh_i_bott(ji) + zdvbot ! clem 564 565 ! new ice thickness (clem) 566 zhgnew(ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 567 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 568 zhgnew(ji) = zihgnew * zhgnew(ji) ! ice thickness is put to 0 569 570 ! !since ice volume is only used for outputs, we keep it global for all categories 571 dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 572 573 ! remaining heat 574 zfdt_final(ji) = ( 1.0 - zihgnew ) * ( zqfont_su(ji) + zqfont_bo(ji) ) 575 576 ! If snow remains, energy is used to melt snow 577 zhni = ht_s_b(ji) ! snow depth at previous time step 578 zihg = MAX( zzero , SIGN ( zone , - ht_s_b(ji) ) ) ! =0 if snow 579 580 ! energy of melting of remaining snow 581 zinda = MAX( 0._wp, SIGN( 1._wp , zhni - epsi10 ) ) 582 zqt_s(ji) = ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi10 ) * zinda 583 zdhnm = - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 ) 584 zhnfi = zhni + zdhnm 585 zfdt_final(ji) = MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 586 ht_s_b(ji) = MAX( zzero , zhnfi ) 587 zqt_s(ji) = zqt_s(ji) * ht_s_b(ji) 588 ! we recompute dh_s_tot (clem) 589 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 590 591 ! Mass variations of ice and snow 592 !--------------------------------- 593 ! ! mass variation of the jl category 594 zzfmass_s = - a_i_b(ji) * ( zhni - ht_s_b(ji) ) * rhosn ! snow 595 zzfmass_i = a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic ! ice 596 ! 597 zfmass_i(ji) = zzfmass_i ! ice variation saved to compute salt flux (see below) 598 ! 599 ! ! mass variation cumulated over category 600 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s ! snow 601 !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i ! ice 602 603 ! Remaining heat to the ocean 604 !--------------------------------- 605 focea(ji) = - zfdt_final(ji) * r1_rdtice ! focea is in W.m-2 * dt 606 607 ! residual salt flux (clem) 608 !-------------------------- 609 ! surface 610 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvsur * rhoic * r1_rdtice 611 ! bottom 612 IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN ! melting 613 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 614 ELSE ! growth 615 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 616 ENDIF 617 ! 618 ! diagnostic 619 ii = MOD( npb(ji) - 1, jpi ) + 1 620 ij = ( npb(ji) - 1 ) / jpi + 1 621 diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 622 diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 623 diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 624 END DO 625 626 ftotal_fin (:) = zfdt_final(:) * r1_rdtice 627 628 !--------------------------- 629 ! heat fluxes 630 !--------------------------- 631 DO ji = kideb, kiut 632 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) ! =1 if ice 633 ! 634 ! Heat flux 635 ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 636 ! excessive total ablation energy (focea) sent to the ocean 637 qfvbq_1d(ji) = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice 638 639 zihic = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) ) ! equals 0 if ht_i = 0, 1 if ht_i gt 0 640 fscbq_1d(ji) = a_i_b(ji) * fstbif_1d(ji) 641 qldif_1d(ji) = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea (ji) * a_i_b(ji) * rdt_ice & 642 & + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice 643 END DO ! ji 644 645 !------------------------------------------- 646 ! Correct temperature, energy and thickness 647 !------------------------------------------- 648 DO ji = kideb, kiut 649 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 650 t_su_b(ji) = zihgnew * t_su_b(ji) + ( 1.0 - zihgnew ) * rtt 651 END DO ! ji 652 653 DO jk = 1, nlay_i 654 DO ji = kideb, kiut 655 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 656 t_i_b(ji,jk) = zihgnew * t_i_b(ji,jk) + ( 1.0 - zihgnew ) * rtt 657 q_i_b(ji,jk) = zihgnew * q_i_b(ji,jk) 658 END DO 659 END DO ! ji 660 661 DO ji = kideb, kiut 662 ht_i_b(ji) = zhgnew(ji) 663 END DO ! ji 594 ! ??? keep ??? 595 ! clem bug: I think this should be included above, so we would not have to 596 ! track heat/salt/mass fluxes backwards 597 ! IF( jpl == 1 ) THEN 598 ! DO ji = kideb, kiut 599 ! IF( zf_tt(ji) >= 0._wp ) THEN 600 ! zdh = MAX( hmelt , dh_i_bott(ji) ) 601 ! zdvres = zdh - dh_i_bott(ji) ! >=0 602 ! dh_i_bott(ji) = zdh 603 ! 604 ! ! excessive energy is sent to lateral ablation 605 ! zinda = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) ) 606 ! zq_1cat(ji) = zinda * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0 607 ! 608 ! ! correct salt and mass fluxes 609 ! sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation 610 ! wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice 611 ! ENDIF 612 ! END DO 613 ! ENDIF 614 615 !------------------------------------------- 616 ! Update temperature, energy 617 !------------------------------------------- 618 DO ji = kideb, kiut 619 ht_i_1d(ji) = MAX( 0._wp , ht_i_1d(ji) + dh_i_bott(ji) ) 620 END DO 621 622 !------------------------------------------- 623 ! 5. What to do with remaining energy 624 !------------------------------------------- 625 ! If heat still available for melting and snow remains, then melt more snow 626 !------------------------------------------- 627 zdeltah(:,:) = 0._wp ! important 628 DO ji = kideb, kiut 629 zq_rema(ji) = zq_su(ji) + zq_bo(ji) 630 ! zindh = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) ! =1 if snow 631 ! zindq = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) ) 632 ! zdeltah (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 ) 633 ! zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting 634 ! zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1) 635 ! dh_s_tot (ji) = dh_s_tot(ji) + zdeltah(ji,1) 636 ! ht_s_1d (ji) = ht_s_1d(ji) + zdeltah(ji,1) 637 ! 638 ! zq_rema(ji) = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji) ! update available heat (J.m-2) 639 ! ! heat used to melt snow 640 ! hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0) 641 ! ! Contribution to mass flux 642 ! wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 643 ! 644 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 645 ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 646 hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 647 648 IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 649 END DO 650 664 651 ! 665 652 !------------------------------------------------------------------------------| … … 670 657 DO ji = kideb, kiut 671 658 ! 672 dh_snowice(ji) = MAX( zzero , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic ) ) 673 zhgnew(ji) = MAX( zhgnew(ji) , zhgnew(ji) + dh_snowice(ji) ) 674 zhnnew = MIN( ht_s_b(ji) , ht_s_b(ji) - dh_snowice(ji) ) 675 676 ! Changes in ice volume and ice mass. 677 dvnbq_1d (ji) = a_i_b(ji) * ( zhgnew(ji)-ht_i_b(ji) ) 678 dmgwi_1d (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 679 680 !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic 681 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew - ht_s_b(ji) ) * rhosn 682 683 ! Equivalent salt flux (1) Snow-ice formation component 684 ! ----------------------------------------------------- 685 ii = MOD( npb(ji) - 1, jpi ) + 1 686 ij = ( npb(ji) - 1 ) / jpi + 1 687 688 IF( num_sal == 2 ) THEN ; zsm_snowice = sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic 689 ELSE ; zsm_snowice = sm_i_b(ji) 690 ENDIF 659 dh_snowice(ji) = MAX( 0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic ) ) 660 661 ht_i_1d(ji) = ht_i_1d(ji) + dh_snowice(ji) 662 ht_s_1d(ji) = ht_s_1d(ji) - dh_snowice(ji) 663 664 ! Salinity of snow ice 665 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 666 zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji) 667 691 668 ! entrapment during snow ice formation 692 ! clem:new salinity difference stored (to be used in limthd_ent.F90)669 ! new salinity difference stored (to be used in limthd_ent.F90) 693 670 IF ( num_sal == 2 ) THEN 694 i_ice_switch = MAX( 0._wp , SIGN( 1._wp , zhgnew(ji) - epsi10 ) )671 zswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) ) 695 672 ! salinity dif due to snow-ice formation 696 dsm_i_si_1d(ji) = ( zs m_snowice - sm_i_b(ji) ) * dh_snowice(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch673 dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi10 ) * zswitch 697 674 ! salinity dif due to bottom growth 698 IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0._wp ) THEN699 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_ b(ji) ) * dh_i_bott(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch675 IF ( zf_tt(ji) < 0._wp ) THEN 676 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi10 ) * zswitch 700 677 ENDIF 701 678 ENDIF 702 679 703 ! Actualize new snow and ice thickness. 704 ht_s_b(ji) = zhnnew 705 ht_i_b(ji) = zhgnew(ji) 706 707 ! Total ablation ! new lines added to debug 708 IF( ht_i_b(ji) <= 0._wp ) a_i_b(ji) = 0._wp 709 710 ! diagnostic ( snow ice growth ) 711 ii = MOD( npb(ji) - 1, jpi ) + 1 712 ij = ( npb(ji) - 1 ) / jpi + 1 713 diag_sni_gr(ii,ij) = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice 714 ! 715 ! salt flux 716 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 717 !-------------------------------- 718 ! Update mass fluxes (clem) 719 !-------------------------------- 720 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ( a_i_b(ji) * ht_i_b(ji) - zviold(ji) ) * rhoic 721 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ( a_i_b(ji) * ht_s_b(ji) - zvsold(ji) ) * rhosn 680 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 681 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 682 zfmdt = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp ) ! <0 683 zsstK = sst_m(ii,ij) + rt0 684 zEw = rcp * ( zsstK - rt0 ) 685 zQm = zfmdt * zEw 686 687 ! Contribution to heat flux 688 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 689 690 ! Contribution to salt flux 691 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 692 693 ! Contribution to mass flux 694 ! All snow is thrown in the ocean, and seawater is taken to replace the volume 695 wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice 696 wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice 697 698 ! update heat content (J.m-2) and layer thickness 699 qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_1d(ji,1) + zfmdt * zEw 700 h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 701 702 ! Total ablation (to debug) 703 IF( ht_i_1d(ji) <= 0._wp ) a_i_1d(ji) = 0._wp 722 704 723 705 END DO !ji 724 ! 725 CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 726 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 727 CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 728 CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 729 ! 730 CALL wrk_dealloc( jpij, zviold, zvsold ) ! clem 706 707 ! 708 !------------------------------------------- 709 ! Update temperature, energy 710 !------------------------------------------- 711 !clem bug: we should take snow into account here 712 DO ji = kideb, kiut 713 zindh = 1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 714 t_su_1d(ji) = zindh * t_su_1d(ji) + ( 1.0 - zindh ) * rtt 715 END DO ! ji 716 717 DO jk = 1, nlay_s 718 DO ji = kideb,kiut 719 ! mask enthalpy 720 zinda = MAX( 0._wp , SIGN( 1._wp, - ht_s_1d(ji) ) ) 721 q_s_1d(ji,jk) = ( 1.0 - zinda ) * q_s_1d(ji,jk) 722 ! recalculate t_s_1d from q_s_1d 723 t_s_1d(ji,jk) = rtt + ( 1._wp - zinda ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 724 END DO 725 END DO 726 727 CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 728 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 729 CALL wrk_dealloc( jpij, zintermelt ) 730 CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i ) 731 CALL wrk_dealloc( jpij, icount ) 732 ! 731 733 ! 732 734 END SUBROUTINE lim_thd_dh -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4333 r4921 25 25 USE wrk_nemo ! work arrays 26 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 USE cpl_oasis3, ONLY : lk_cpl 27 28 28 29 IMPLICIT NONE … … 31 32 PUBLIC lim_thd_dif ! called by lim_thd 32 33 33 REAL(wp) :: epsi10 =1.e-10_wp !34 REAL(wp) :: epsi10 = 1.e-10_wp ! 34 35 !!---------------------------------------------------------------------- 35 36 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 39 40 CONTAINS 40 41 41 SUBROUTINE lim_thd_dif( kideb , kiut , jl)42 SUBROUTINE lim_thd_dif( kideb , kiut ) 42 43 !!------------------------------------------------------------------ 43 44 !! *** ROUTINE lim_thd_dif *** … … 74 75 !! 75 76 !! ** Inputs / Ouputs : (global commons) 76 !! surface temperature : t_su_ b77 !! ice/snow temperatures : t_i_ b, t_s_b78 !! ice salinities : s_i_ b77 !! surface temperature : t_su_1d 78 !! ice/snow temperatures : t_i_1d, t_s_1d 79 !! ice salinities : s_i_1d 79 80 !! number of layers in the ice/snow: nlay_i, nlay_s 80 81 !! profile of the ice/snow layers : z_i, z_s 81 !! total ice/snow thickness : ht_i_ b, ht_s_b82 !! total ice/snow thickness : ht_i_1d, ht_s_1d 82 83 !! 83 84 !! ** External : … … 91 92 !! (04-2007) Energy conservation tested by M. Vancoppenolle 92 93 !!------------------------------------------------------------------ 93 INTEGER , INTENT (in) :: kideb ! Start point on which the the computation is applied 94 INTEGER , INTENT (in) :: kiut ! End point on which the the computation is applied 95 INTEGER , INTENT (in) :: jl ! Category number 94 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 96 95 97 96 !! * Local variables … … 99 98 INTEGER :: ii, ij ! temporary dummy loop index 100 99 INTEGER :: numeq ! current reference number of equation 101 INTEGER :: layer! vertical dummy loop index100 INTEGER :: jk ! vertical dummy loop index 102 101 INTEGER :: nconv ! number of iterations in iterative procedure 103 102 INTEGER :: minnumeqmin, maxnumeqmax 104 INTEGER, DIMENSION(kiut) :: numeqmin ! reference number of top equation105 INTEGER, DIMENSION(kiut) :: numeqmax ! reference number of bottom equation106 INTEGER, DIMENSION(kiut) :: isnow ! switch for presence (1) or absence (0) of snow103 INTEGER, POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation 104 INTEGER, POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation 105 INTEGER, POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow 107 106 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system 108 107 REAL(wp) :: zg1 = 2._wp ! … … 111 110 REAL(wp) :: zraext_s = 1.e+8_wp ! extinction coefficient of radiation in the snow 112 111 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 112 REAL(wp) :: ztsu_err = 1.e-5_wp ! range around which t_su is considered as 0°C 113 113 REAL(wp) :: ztmelt_i ! ice melting temperature 114 114 REAL(wp) :: zerritmax ! current maximal error on temperature 115 REAL(wp), DIMENSION(kiut) :: ztfs ! ice melting point 116 REAL(wp), DIMENSION(kiut) :: ztsuold ! old surface temperature (before the iterative procedure ) 117 REAL(wp), DIMENSION(kiut) :: ztsuoldit ! surface temperature at previous iteration 118 REAL(wp), DIMENSION(kiut) :: zh_i ! ice layer thickness 119 REAL(wp), DIMENSION(kiut) :: zh_s ! snow layer thickness 120 REAL(wp), DIMENSION(kiut) :: zfsw ! solar radiation absorbed at the surface 121 REAL(wp), DIMENSION(kiut) :: zf ! surface flux function 122 REAL(wp), DIMENSION(kiut) :: dzf ! derivative of the surface flux function 123 REAL(wp), DIMENSION(kiut) :: zerrit ! current error on temperature 124 REAL(wp), DIMENSION(kiut) :: zdifcase ! case of the equation resolution (1->4) 125 REAL(wp), DIMENSION(kiut) :: zftrice ! solar radiation transmitted through the ice 126 REAL(wp), DIMENSION(kiut) :: zihic, zhsu 127 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztcond_i ! Ice thermal conductivity 128 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradtr_i ! Radiation transmitted through the ice 129 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradab_i ! Radiation absorbed in the ice 130 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zkappa_i ! Kappa factor in the ice 131 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztiold ! Old temperature in the ice 132 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zeta_i ! Eta factor in the ice 133 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztitemp ! Temporary temperature in the ice to check the convergence 134 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zspeche_i ! Ice specific heat 135 REAL(wp), DIMENSION(kiut,0:nlay_i) :: z_i ! Vertical cotes of the layers in the ice 136 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradtr_s ! Radiation transmited through the snow 137 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradab_s ! Radiation absorbed in the snow 138 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zkappa_s ! Kappa factor in the snow 139 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zeta_s ! Eta factor in the snow 140 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztstemp ! Temporary temperature in the snow to check the convergence 141 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztsold ! Temporary temperature in the snow 142 REAL(wp), DIMENSION(kiut,0:nlay_s) :: z_s ! Vertical cotes of the layers in the snow 143 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindterm ! Independent term 144 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindtbis ! temporary independent term 145 REAL(wp), DIMENSION(kiut,jkmax+2) :: zdiagbis 146 REAL(wp), DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 115 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! ice melting point 116 REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure ) 117 REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration 118 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 119 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 120 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 121 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 122 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function 123 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature 124 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 125 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 126 REAL(wp), POINTER, DIMENSION(:) :: zihic, zhsu 127 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity 128 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice 129 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice 130 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice 131 REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice 132 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice 133 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence 134 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat 135 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice 136 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow 137 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow 138 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow 139 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow 140 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence 141 REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow 142 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow 143 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! Independent term 144 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! temporary independent term 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis 146 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 147 ! diag errors on heat 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 149 REAL(wp) :: zhfx_err 147 150 !!------------------------------------------------------------------ 148 151 ! 152 CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow ) 153 CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 154 CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 155 CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0) 156 CALL wrk_alloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0) 157 CALL wrk_alloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 158 CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid ) 159 160 CALL wrk_alloc( jpij, zdq, zq_ini ) 161 162 ! --- diag error on heat diffusion - PART 1 --- ! 163 zdq(:) = 0._wp ; zq_ini(:) = 0._wp 164 DO ji = kideb, kiut 165 zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) + & 166 & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 167 END DO 168 149 169 !------------------------------------------------------------------------------! 150 170 ! 1) Initialization ! 151 171 !------------------------------------------------------------------------------! 152 ! 172 ! clem clean: replace just ztfs by rtt 153 173 DO ji = kideb , kiut 154 174 ! is there snow or not 155 isnow(ji)= NINT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_ b(ji) ) ) )175 isnow(ji)= NINT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) ) ) 156 176 ! surface temperature of fusion 157 !!gm ??? ztfs(ji) = rtt !!!????158 177 ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 159 178 ! layer thickness 160 zh_i(ji) = ht_i_ b(ji) / REAL( nlay_i )161 zh_s(ji) = ht_s_ b(ji) / REAL( nlay_s )179 zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i ) 180 zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 162 181 END DO 163 182 … … 169 188 z_i(:,0) = 0._wp ! vert. coord. of the up. lim. of the 1st ice layer 170 189 171 DO layer= 1, nlay_s ! vert. coord of the up. lim. of the layer-th snow layer172 DO ji = kideb , kiut 173 z_s(ji, layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s )174 END DO 175 END DO 176 177 DO layer= 1, nlay_i ! vert. coord of the up. lim. of the layer-th ice layer178 DO ji = kideb , kiut 179 z_i(ji, layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i )190 DO jk = 1, nlay_s ! vert. coord of the up. lim. of the layer-th snow layer 191 DO ji = kideb , kiut 192 z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s ) 193 END DO 194 END DO 195 196 DO jk = 1, nlay_i ! vert. coord of the up. lim. of the layer-th ice layer 197 DO ji = kideb , kiut 198 z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i ) 180 199 END DO 181 200 END DO … … 194 213 ! zfsw = (1-i0).qsr_ice is absorbed at the surface 195 214 ! zftrice = io.qsr_ice is below the surface 196 ! f stbif= io.qsr_ice.exp(-k(h_i)) transmitted below the ice215 ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 197 216 198 217 DO ji = kideb , kiut 199 218 ! switches 200 isnow(ji) = NINT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_ b(ji) ) ) )219 isnow(ji) = NINT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) ) 201 220 ! hs > 0, isnow = 1 202 221 zhsu (ji) = hnzst ! threshold for the computation of i0 203 zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_ b(ji) / zhsu(ji) ) )222 zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) ) 204 223 205 224 i0(ji) = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) … … 208 227 ! a function of the cloud cover 209 228 ! 210 !i0(ji) = (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_ b(ji)+10.0)229 !i0(ji) = (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0) 211 230 !formula used in Cice 212 231 END DO … … 230 249 END DO 231 250 232 DO layer= 1, nlay_s ! Radiation through snow251 DO jk = 1, nlay_s ! Radiation through snow 233 252 DO ji = kideb, kiut 234 253 ! ! radiation transmitted below the layer-th snow layer 235 zradtr_s(ji, layer) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,layer) ) ) )254 zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) ) 236 255 ! ! radiation absorbed by the layer-th snow layer 237 zradab_s(ji, layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer)256 zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk) 238 257 END DO 239 258 END DO … … 243 262 END DO 244 263 245 DO layer= 1, nlay_i ! Radiation through ice264 DO jk = 1, nlay_i ! Radiation through ice 246 265 DO ji = kideb, kiut 247 266 ! ! radiation transmitted below the layer-th ice layer 248 zradtr_i(ji, layer) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,layer) ) ) )267 zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 249 268 ! ! radiation absorbed by the layer-th ice layer 250 zradab_i(ji, layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer)269 zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 251 270 END DO 252 271 END DO 253 272 254 273 DO ji = kideb, kiut ! Radiation transmitted below the ice 255 fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 256 END DO 257 258 ! +++++ 259 ! just to check energy conservation 260 DO ji = kideb, kiut 261 ii = MOD( npb(ji) - 1 , jpi ) + 1 262 ij = ( npb(ji) - 1 ) / jpi + 1 263 fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 264 END DO 265 ! +++++ 266 267 DO layer = 1, nlay_i 268 DO ji = kideb, kiut 269 radab(ji,layer) = zradab_i(ji,layer) 270 END DO 274 !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_1d(ji) / at_i_1d(ji) ! clem modif 275 ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 271 276 END DO 272 277 … … 277 282 ! 278 283 DO ji = kideb, kiut ! Old surface temperature 279 ztsu old (ji) = t_su_b(ji) ! temperature at the beg of iter pr.280 ztsu oldit(ji) = t_su_b(ji) ! temperature at the previous iter281 t_su_ b (ji) = MIN( t_su_b(ji), ztfs(ji)-0.00001 )! necessary284 ztsub (ji) = t_su_1d(ji) ! temperature at the beg of iter pr. 285 ztsubit(ji) = t_su_1d(ji) ! temperature at the previous iter 286 t_su_1d (ji) = MIN( t_su_1d(ji), ztfs(ji) - ztsu_err ) ! necessary 282 287 zerrit (ji) = 1000._wp ! initial value of error 283 288 END DO 284 289 285 DO layer= 1, nlay_s ! Old snow temperature286 DO ji = kideb , kiut 287 zts old(ji,layer) = t_s_b(ji,layer)288 END DO 289 END DO 290 291 DO layer= 1, nlay_i ! Old ice temperature292 DO ji = kideb , kiut 293 zti old(ji,layer) = t_i_b(ji,layer)290 DO jk = 1, nlay_s ! Old snow temperature 291 DO ji = kideb , kiut 292 ztsb(ji,jk) = t_s_1d(ji,jk) 293 END DO 294 END DO 295 296 DO jk = 1, nlay_i ! Old ice temperature 297 DO ji = kideb , kiut 298 ztib(ji,jk) = t_i_1d(ji,jk) 294 299 END DO 295 300 END DO … … 308 313 IF( thcon_i_swi == 0 ) THEN ! Untersteiner (1964) formula 309 314 DO ji = kideb , kiut 310 ztcond_i(ji,0) = rcdic + zbeta*s_i_ b(ji,1) / MIN(-epsi10,t_i_b(ji,1)-rtt)315 ztcond_i(ji,0) = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt) 311 316 ztcond_i(ji,0) = MAX(ztcond_i(ji,0),zkimin) 312 317 END DO 313 DO layer= 1, nlay_i-1318 DO jk = 1, nlay_i-1 314 319 DO ji = kideb , kiut 315 ztcond_i(ji, layer) = rcdic + zbeta*( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) / &316 MIN(-2.0_wp * epsi10, t_i_ b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)317 ztcond_i(ji, layer) = MAX(ztcond_i(ji,layer),zkimin)320 ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) / & 321 MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt) 322 ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin) 318 323 END DO 319 324 END DO … … 322 327 IF( thcon_i_swi == 1 ) THEN ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 323 328 DO ji = kideb , kiut 324 ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_ b(ji,1) / MIN( -epsi10, t_i_b(ji,1)-rtt ) &325 & - 0.011_wp * ( t_i_ b(ji,1) - rtt )329 ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt ) & 330 & - 0.011_wp * ( t_i_1d(ji,1) - rtt ) 326 331 ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 327 332 END DO 328 DO layer= 1, nlay_i-1333 DO jk = 1, nlay_i-1 329 334 DO ji = kideb , kiut 330 ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) & 331 & / MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt) & 332 & - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt ) 333 ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin ) 335 ztcond_i(ji,jk) = rcdic + & 336 & 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) & 337 & / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt) & 338 & - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt ) 339 ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 334 340 END DO 335 341 END DO 336 342 DO ji = kideb , kiut 337 ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_ b(ji,nlay_i) / MIN(-epsi10,t_bo_b(ji)-rtt) &338 & - 0.011_wp * ( t_bo_ b(ji) - rtt )343 ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt) & 344 & - 0.011_wp * ( t_bo_1d(ji) - rtt ) 339 345 ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 340 346 END DO … … 352 358 END DO 353 359 354 DO layer= 1, nlay_s-1355 DO ji = kideb , kiut 356 zkappa_s(ji, layer) = 2.0 * rcdsn / &360 DO jk = 1, nlay_s-1 361 DO ji = kideb , kiut 362 zkappa_s(ji,jk) = 2.0 * rcdsn / & 357 363 MAX(epsi10,2.0*zh_s(ji)) 358 364 END DO 359 365 END DO 360 366 361 DO layer= 1, nlay_i-1367 DO jk = 1, nlay_i-1 362 368 DO ji = kideb , kiut 363 369 !-- Ice kappa factors 364 zkappa_i(ji, layer) = 2.0*ztcond_i(ji,layer)/ &370 zkappa_i(ji,jk) = 2.0*ztcond_i(ji,jk)/ & 365 371 MAX(epsi10,2.0*zh_i(ji)) 366 372 END DO … … 381 387 !------------------------------------------------------------------------------| 382 388 ! 383 DO layer= 1, nlay_i384 DO ji = kideb , kiut 385 ztitemp(ji, layer) = t_i_b(ji,layer)386 zspeche_i(ji, layer) = cpic + zgamma*s_i_b(ji,layer)/ &387 MAX((t_i_ b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),epsi10)388 zeta_i(ji, layer) = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), &389 DO jk = 1, nlay_i 390 DO ji = kideb , kiut 391 ztitemp(ji,jk) = t_i_1d(ji,jk) 392 zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ & 393 MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10) 394 zeta_i(ji,jk) = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), & 389 395 epsi10) 390 396 END DO 391 397 END DO 392 398 393 DO layer= 1, nlay_s394 DO ji = kideb , kiut 395 ztstemp(ji, layer) = t_s_b(ji,layer)396 zeta_s(ji, layer) = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10)399 DO jk = 1, nlay_s 400 DO ji = kideb , kiut 401 ztstemp(ji,jk) = t_s_1d(ji,jk) 402 zeta_s(ji,jk) = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 397 403 END DO 398 404 END DO … … 403 409 ! 404 410 DO ji = kideb , kiut 405 406 411 ! update of the non solar flux according to the update in T_su 407 qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * & 408 ( t_su_b(ji) - ztsuoldit(ji) ) 412 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) ) 409 413 410 414 ! update incoming flux 411 415 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 412 + qns r_ice_1d(ji)! non solar total flux416 + qns_ice_1d(ji) ! non solar total flux 413 417 ! (LWup, LWdw, SH, LH) 414 415 418 END DO 416 419 … … 427 430 !!ice interior terms (top equation has the same form as the others) 428 431 429 DO numeq=1, jkmax+2432 DO numeq=1,nlay_i+3 430 433 DO ji = kideb , kiut 431 434 ztrid(ji,numeq,1) = 0. … … 440 443 DO numeq = nlay_s + 2, nlay_s + nlay_i 441 444 DO ji = kideb , kiut 442 layer= numeq - nlay_s - 1443 ztrid(ji,numeq,1) = - zeta_i(ji, layer)*zkappa_i(ji,layer-1)444 ztrid(ji,numeq,2) = 1.0 + zeta_i(ji, layer)*(zkappa_i(ji,layer-1) + &445 zkappa_i(ji, layer))446 ztrid(ji,numeq,3) = - zeta_i(ji, layer)*zkappa_i(ji,layer)447 zindterm(ji,numeq) = zti old(ji,layer) + zeta_i(ji,layer)* &448 zradab_i(ji, layer)445 jk = numeq - nlay_s - 1 446 ztrid(ji,numeq,1) = - zeta_i(ji,jk)*zkappa_i(ji,jk-1) 447 ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + & 448 zkappa_i(ji,jk)) 449 ztrid(ji,numeq,3) = - zeta_i(ji,jk)*zkappa_i(ji,jk) 450 zindterm(ji,numeq) = ztib(ji,jk) + zeta_i(ji,jk)* & 451 zradab_i(ji,jk) 449 452 END DO 450 453 ENDDO … … 457 460 + zkappa_i(ji,nlay_i-1) ) 458 461 ztrid(ji,numeq,3) = 0.0 459 zindterm(ji,numeq) = zti old(ji,nlay_i) + zeta_i(ji,nlay_i)* &462 zindterm(ji,numeq) = ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* & 460 463 ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 461 * t_bo_ b(ji) )464 * t_bo_1d(ji) ) 462 465 ENDDO 463 466 464 467 465 468 DO ji = kideb , kiut 466 IF ( ht_s_ b(ji).gt.0.0 ) THEN469 IF ( ht_s_1d(ji).gt.0.0 ) THEN 467 470 ! 468 471 !------------------------------------------------------------------------------| … … 472 475 !!snow interior terms (bottom equation has the same form as the others) 473 476 DO numeq = 3, nlay_s + 1 474 layer= numeq - 1475 ztrid(ji,numeq,1) = - zeta_s(ji, layer)*zkappa_s(ji,layer-1)476 ztrid(ji,numeq,2) = 1.0 + zeta_s(ji, layer)*( zkappa_s(ji,layer-1) + &477 zkappa_s(ji, layer) )478 ztrid(ji,numeq,3) = - zeta_s(ji, layer)*zkappa_s(ji,layer)479 zindterm(ji,numeq) = zts old(ji,layer) + zeta_s(ji,layer)* &480 zradab_s(ji, layer)477 jk = numeq - 1 478 ztrid(ji,numeq,1) = - zeta_s(ji,jk)*zkappa_s(ji,jk-1) 479 ztrid(ji,numeq,2) = 1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + & 480 zkappa_s(ji,jk) ) 481 ztrid(ji,numeq,3) = - zeta_s(ji,jk)*zkappa_s(ji,jk) 482 zindterm(ji,numeq) = ztsb(ji,jk) + zeta_s(ji,jk)* & 483 zradab_s(ji,jk) 481 484 END DO 482 485 … … 485 488 ztrid(ji,nlay_s+2,3) = 0.0 486 489 zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 487 t_bo_ b(ji)490 t_bo_1d(ji) 488 491 ENDIF 489 492 490 IF ( t_su_ b(ji) .LT. rtt ) THEN493 IF ( t_su_1d(ji) .LT. rtt ) THEN 491 494 492 495 !------------------------------------------------------------------------------| … … 501 504 ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0) 502 505 ztrid(ji,1,3) = zg1s*zkappa_s(ji,0) 503 zindterm(ji,1) = dzf(ji)*t_su_ b(ji) - zf(ji)506 zindterm(ji,1) = dzf(ji)*t_su_1d(ji) - zf(ji) 504 507 505 508 !!first layer of snow equation … … 507 510 ztrid(ji,2,2) = 1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s) 508 511 ztrid(ji,2,3) = - zeta_s(ji,1)* zkappa_s(ji,1) 509 zindterm(ji,2) = zts old(ji,1) + zeta_s(ji,1)*zradab_s(ji,1)512 zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 510 513 511 514 ELSE … … 524 527 zkappa_s(ji,0) * zg1s ) 525 528 ztrid(ji,2,3) = - zeta_s(ji,1)*zkappa_s(ji,1) 526 zindterm(ji,2) = zts old(ji,1) + zeta_s(ji,1) * &529 zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) * & 527 530 ( zradab_s(ji,1) + & 528 zkappa_s(ji,0) * zg1s * t_su_ b(ji) )531 zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 529 532 ENDIF 530 533 ELSE … … 534 537 !------------------------------------------------------------------------------| 535 538 ! 536 IF (t_su_ b(ji) .LT. rtt) THEN539 IF (t_su_1d(ji) .LT. rtt) THEN 537 540 ! 538 541 !------------------------------------------------------------------------------| … … 548 551 ztrid(ji,numeqmin(ji),2) = dzf(ji) - zkappa_i(ji,0)*zg1 549 552 ztrid(ji,numeqmin(ji),3) = zkappa_i(ji,0)*zg1 550 zindterm(ji,numeqmin(ji)) = dzf(ji)*t_su_ b(ji) - zf(ji)553 zindterm(ji,numeqmin(ji)) = dzf(ji)*t_su_1d(ji) - zf(ji) 551 554 552 555 !!first layer of ice equation … … 555 558 + zkappa_i(ji,0) * zg1 ) 556 559 ztrid(ji,numeqmin(ji)+1,3) = - zeta_i(ji,1)*zkappa_i(ji,1) 557 zindterm(ji,numeqmin(ji)+1)= zti old(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)560 zindterm(ji,numeqmin(ji)+1)= ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1) 558 561 559 562 !!case of only one layer in the ice (surface & ice equations are altered) … … 568 571 ztrid(ji,numeqmin(ji)+1,3) = 0.0 569 572 570 zindterm(ji,numeqmin(ji)+1) = zti old(ji,1) + zeta_i(ji,1)* &571 ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_ b(ji) )573 zindterm(ji,numeqmin(ji)+1) = ztib(ji,1) + zeta_i(ji,1)* & 574 ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) ) 572 575 ENDIF 573 576 … … 588 591 zg1) 589 592 ztrid(ji,numeqmin(ji),3) = - zeta_i(ji,1) * zkappa_i(ji,1) 590 zindterm(ji,numeqmin(ji)) = zti old(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + &591 zkappa_i(ji,0) * zg1 * t_su_ b(ji) )593 zindterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 594 zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 592 595 593 596 !!case of only one layer in the ice (surface & ice equations are altered) … … 597 600 zkappa_i(ji,1)) 598 601 ztrid(ji,numeqmin(ji),3) = 0.0 599 zindterm(ji,numeqmin(ji)) = zti old(ji,1) + zeta_i(ji,1)* &600 (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_ b(ji)) &601 + t_su_ b(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0602 zindterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1)* & 603 (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) & 604 + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 602 605 ENDIF 603 606 … … 618 621 619 622 maxnumeqmax = 0 620 minnumeqmin = jkmax+4623 minnumeqmin = nlay_i+5 621 624 622 625 DO ji = kideb , kiut … … 627 630 END DO 628 631 629 DO layer= minnumeqmin+1, maxnumeqmax630 DO ji = kideb , kiut 631 numeq = min(max(numeqmin(ji)+1, layer),numeqmax(ji))632 DO jk = minnumeqmin+1, maxnumeqmax 633 DO ji = kideb , kiut 634 numeq = min(max(numeqmin(ji)+1,jk),numeqmax(ji)) 632 635 zdiagbis(ji,numeq) = ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 633 636 ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) … … 639 642 DO ji = kideb , kiut 640 643 ! ice temperatures 641 t_i_ b(ji,nlay_i) = zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))644 t_i_1d(ji,nlay_i) = zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 642 645 END DO 643 646 644 647 DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 645 648 DO ji = kideb , kiut 646 layer= numeq - nlay_s - 1647 t_i_ b(ji,layer) = (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* &648 t_i_ b(ji,layer+1))/zdiagbis(ji,numeq)649 jk = numeq - nlay_s - 1 650 t_i_1d(ji,jk) = (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* & 651 t_i_1d(ji,jk+1))/zdiagbis(ji,numeq) 649 652 END DO 650 653 END DO … … 652 655 DO ji = kideb , kiut 653 656 ! snow temperatures 654 IF (ht_s_ b(ji).GT.0._wp) &655 t_s_ b(ji,nlay_s) = (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) &656 * t_i_ b(ji,1))/zdiagbis(ji,nlay_s+1) &657 * MAX(0.0,SIGN(1.0,ht_s_ b(ji)))657 IF (ht_s_1d(ji).GT.0._wp) & 658 t_s_1d(ji,nlay_s) = (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 659 * t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) & 660 * MAX(0.0,SIGN(1.0,ht_s_1d(ji))) 658 661 659 662 ! surface temperature 660 isnow(ji) = NINT( 1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_ b(ji) ) ) )661 ztsu oldit(ji) = t_su_b(ji)662 IF( t_su_ b(ji) < ztfs(ji) ) &663 t_su_ b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1) &664 & + REAL( 1 - isnow(ji) )*t_i_ b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))663 isnow(ji) = NINT( 1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) ) ) ) 664 ztsubit(ji) = t_su_1d(ji) 665 IF( t_su_1d(ji) < ztfs(ji) ) & 666 t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1) & 667 & + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji)) 665 668 END DO 666 669 ! … … 672 675 ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 673 676 DO ji = kideb , kiut 674 t_su_b(ji) = MAX( MIN( t_su_b(ji) , ztfs(ji) ) , 190._wp ) 675 zerrit(ji) = ABS( t_su_b(ji) - ztsuoldit(ji) ) 676 END DO 677 678 DO layer = 1, nlay_s 679 DO ji = kideb , kiut 680 ii = MOD( npb(ji) - 1, jpi ) + 1 681 ij = ( npb(ji) - 1 ) / jpi + 1 682 t_s_b(ji,layer) = MAX( MIN( t_s_b(ji,layer), rtt ), 190._wp ) 683 zerrit(ji) = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) 684 END DO 685 END DO 686 687 DO layer = 1, nlay_i 688 DO ji = kideb , kiut 689 ztmelt_i = -tmut * s_i_b(ji,layer) + rtt 690 t_i_b(ji,layer) = MAX(MIN(t_i_b(ji,layer),ztmelt_i), 190._wp) 691 zerrit(ji) = MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer))) 677 t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp ) 678 zerrit(ji) = ABS( t_su_1d(ji) - ztsubit(ji) ) 679 END DO 680 681 DO jk = 1, nlay_s 682 DO ji = kideb , kiut 683 t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rtt ), 190._wp ) 684 zerrit(ji) = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk))) 685 END DO 686 END DO 687 688 DO jk = 1, nlay_i 689 DO ji = kideb , kiut 690 ztmelt_i = -tmut * s_i_1d(ji,jk) + rtt 691 t_i_1d(ji,jk) = MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp) 692 zerrit(ji) = MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk))) 692 693 END DO 693 694 END DO … … 713 714 !-------------------------------------------------------------------------! 714 715 DO ji = kideb, kiut 715 #if ! defined key_coupled716 716 ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux) 717 qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 718 #endif 717 IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) ) 719 718 ! ! surface ice conduction flux 720 isnow(ji) = NINT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_ b(ji) ) ) )721 fc_su(ji) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_ b(ji,1) - t_su_b(ji)) &722 & - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_ b(ji,1) - t_su_b(ji))719 isnow(ji) = NINT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) ) 720 fc_su(ji) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji)) & 721 & - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_1d(ji,1) - t_su_1d(ji)) 723 722 ! ! bottom ice conduction flux 724 fc_bo_i(ji) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 725 END DO 726 727 !-------------------------! 728 ! Heat conservation ! 729 !-------------------------! 730 IF( con_i .AND. jiindex_1d > 0 ) THEN 723 fc_bo_i(ji) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) ) 724 END DO 725 726 !----------------------------------------- 727 ! Heat flux used to warm/cool ice in W.m-2 728 !----------------------------------------- 729 DO ji = kideb, kiut 730 IF( t_su_1d(ji) < rtt ) THEN ! case T_su < 0degC 731 hfx_dif_1d(ji) = hfx_dif_1d(ji) + & 732 & ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 733 ELSE ! case T_su = 0degC 734 hfx_dif_1d(ji) = hfx_dif_1d(ji) + & 735 & ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 736 ENDIF 737 END DO 738 739 ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 740 CALL lim_thd_enmelt( kideb, kiut ) 741 742 ! --- diag error on heat diffusion - PART 2 --- ! 743 DO ji = kideb, kiut 744 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) + & 745 & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 746 zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 747 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_1d(ji) 748 ! --- correction of qns_ice and surface conduction flux --- ! 749 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 750 fc_su (ji) = fc_su (ji) - zhfx_err 751 ! --- Heat flux at the ice surface in W.m-2 --- ! 752 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 753 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 754 END DO 755 756 ! 757 CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow ) 758 CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 759 CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 760 CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, & 761 & ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 762 CALL wrk_dealloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 763 CALL wrk_dealloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 764 CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 765 CALL wrk_dealloc( jpij, zdq, zq_ini ) 766 767 END SUBROUTINE lim_thd_dif 768 769 SUBROUTINE lim_thd_enmelt( kideb, kiut ) 770 !!----------------------------------------------------------------------- 771 !! *** ROUTINE lim_thd_enmelt *** 772 !! 773 !! ** Purpose : Computes sea ice energy of melting q_i (J.m-3) from temperature 774 !! 775 !! ** Method : Formula (Bitz and Lipscomb, 1999) 776 !!------------------------------------------------------------------- 777 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 778 ! 779 INTEGER :: ji, jk ! dummy loop indices 780 REAL(wp) :: ztmelts, zindb ! local scalar 781 !!------------------------------------------------------------------- 782 ! 783 DO jk = 1, nlay_i ! Sea ice energy of melting 731 784 DO ji = kideb, kiut 732 ! Upper snow value 733 fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) ) 734 ! Bott. snow value 735 fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) ) 736 END DO 737 DO ji = kideb, kiut ! Upper ice layer 738 fc_i(ji,0) = - REAL( isnow(ji) ) * & ! interface flux if there is snow 739 ( zkappa_i(ji,0) * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 740 - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * & 741 zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 742 END DO 743 DO layer = 1, nlay_i - 1 ! Internal ice layers 744 DO ji = kideb, kiut 745 fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 746 ii = MOD( npb(ji) - 1, jpi ) + 1 747 ij = ( npb(ji) - 1 ) / jpi + 1 748 END DO 749 END DO 750 DO ji = kideb, kiut ! Bottom ice layers 751 fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 752 END DO 753 ENDIF 785 ztmelts = - tmut * s_i_1d(ji,jk) + rtt 786 zindb = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) ) 787 q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) ) & 788 & + lfus * ( 1.0 - zindb * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) ) & 789 & - rcp * ( ztmelts-rtt ) ) 790 END DO 791 END DO 792 DO jk = 1, nlay_s ! Snow energy of melting 793 DO ji = kideb, kiut 794 q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) 795 END DO 796 END DO 754 797 ! 755 END SUBROUTINE lim_thd_ dif798 END SUBROUTINE lim_thd_enmelt 756 799 757 800 #else -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r4333 r4921 10 10 !! ! 2006-11 (X. Fettweis) Vectorized 11 11 !! 3.0 ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 12 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 13 !! - ! 2014-05 (C. Rousset) complete rewriting 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_lim3 … … 22 23 USE domain ! 23 24 USE phycst ! physical constants 25 USE sbc_oce ! Surface boundary condition: ocean fields 24 26 USE ice ! LIM variables 25 27 USE par_ice ! LIM parameters … … 34 36 PRIVATE 35 37 36 PUBLIC lim_thd_ent ! called by lim _thd38 PUBLIC lim_thd_ent ! called by limthd and limthd_lac 37 39 38 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 39 REAL(wp) :: epsi10 = 1.e-10_wp ! 40 REAL(wp) :: zzero = 0._wp ! 41 REAL(wp) :: zone = 1._wp ! 40 REAL(wp) :: epsi20 = 1.e-20 ! constant values 41 REAL(wp) :: epsi10 = 1.e-10 ! constant values 42 42 43 43 !!---------------------------------------------------------------------- … … 48 48 CONTAINS 49 49 50 SUBROUTINE lim_thd_ent( kideb, kiut, jl)50 SUBROUTINE lim_thd_ent( kideb, kiut, qnew ) 51 51 !!------------------------------------------------------------------- 52 52 !! *** ROUTINE lim_thd_ent *** 53 53 !! 54 54 !! ** Purpose : 55 !! This routine computes new vertical grids 56 !! in the ice and in the snow, and consistently redistributes 57 !! temperatures in the snow / ice. 55 !! This routine computes new vertical grids in the ice, 56 !! and consistently redistributes temperatures. 58 57 !! Redistribution is made so as to ensure to energy conservation 59 58 !! … … 61 60 !! ** Method : linear conservative remapping 62 61 !! 63 !! ** Steps : 1) Grid 64 !! 2) Switches 65 !! 3) Snow redistribution 66 !! 4) Ice enthalpy redistribution 67 !! 5) Ice salinity, recover temperature 62 !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 63 !! 2) linear remapping on the new layers 64 !! 65 !! ------------ cum0(0) ------------- cum1(0) 66 !! NEW ------------- 67 !! ------------ cum0(1) ==> ------------- 68 !! ... ------------- 69 !! ------------ ------------- 70 !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i) 71 !! 68 72 !! 69 73 !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 70 74 !!------------------------------------------------------------------- 71 75 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 72 INTEGER , INTENT(in) :: jl ! Thickness cateogry number73 76 74 INTEGER :: ji,jk ! dummy loop indices 75 INTEGER :: ii, ij , & ! dummy indices 76 ntop0 , & ! old layer top index 77 nbot1 , & ! new layer bottom index 78 ntop1 , & ! new layer top index 79 limsum , & ! temporary loop index 80 nlayi0,nlays0 , & ! old number of layers 81 maxnbot0 , & ! old layer bottom index 82 layer0, layer1 ! old/new layer indexes 77 REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew ! new enthlapies (J.m-3, remapped) 83 78 84 85 REAL(wp) :: & 86 ztmelts , & ! ice melting point 87 zqsnic , & ! enthalpy of snow ice layer 88 zhsnow , & ! temporary snow thickness variable 89 zswitch , & ! dummy switch argument 90 zfac1 , & ! dummy factor 91 zfac2 , & ! dummy factor 92 ztform , & !: bottom formation temperature 93 zaaa , & !: dummy factor 94 zbbb , & !: dummy factor 95 zccc , & !: dummy factor 96 zdiscrim !: dummy factor 97 98 INTEGER, POINTER, DIMENSION(:) :: snswi ! snow switch 99 INTEGER, POINTER, DIMENSION(:) :: nbot0 ! old layer bottom index 100 INTEGER, POINTER, DIMENSION(:) :: icsuind ! ice surface index 101 INTEGER, POINTER, DIMENSION(:) :: icsuswi ! ice surface switch 102 INTEGER, POINTER, DIMENSION(:) :: icboind ! ice bottom index 103 INTEGER, POINTER, DIMENSION(:) :: icboswi ! ice bottom switch 104 INTEGER, POINTER, DIMENSION(:) :: snicind ! snow ice index 105 INTEGER, POINTER, DIMENSION(:) :: snicswi ! snow ice switch 106 INTEGER, POINTER, DIMENSION(:) :: snind ! snow index 79 INTEGER :: ji ! dummy loop indices 80 INTEGER :: jk0, jk1 ! old/new layer indices 81 REAL(wp) :: zswitch 107 82 ! 108 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! thickness of an ice layer 109 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! thickness of a snow layer 110 REAL(wp), POINTER, DIMENSION(:) :: zqsnow ! enthalpy of the snow put in snow ice 111 REAL(wp), POINTER, DIMENSION(:) :: zdeltah ! temporary variable 112 REAL(wp), POINTER, DIMENSION(:) :: zqti_in, zqts_in 113 REAL(wp), POINTER, DIMENSION(:) :: zqti_fin, zqts_fin 114 115 REAL(wp), POINTER, DIMENSION(:,:) :: zm0 ! old layer-system vertical cotes 116 REAL(wp), POINTER, DIMENSION(:,:) :: qm0 ! old layer-system heat content 117 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! new snow system vertical cotes 118 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! new ice system vertical cotes 119 REAL(wp), POINTER, DIMENSION(:,:) :: zthick0 ! old ice thickness 120 REAL(wp), POINTER, DIMENSION(:,:) :: zhl0 ! old and new layer thicknesses 121 REAL(wp), POINTER, DIMENSION(:,:) :: zrl01 122 123 REAL(wp) :: zinda 83 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces 84 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces 85 REAL(wp), POINTER, DIMENSION(:) :: zhnew ! new layers thicknesses 124 86 !!------------------------------------------------------------------- 125 87 126 CALL wrk_alloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 127 CALL wrk_alloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 128 CALL wrk_alloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 129 CALL wrk_alloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 88 CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 89 CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 90 CALL wrk_alloc( jpij, zhnew ) 130 91 131 zthick0(:,:) = 0._wp 132 zm0 (:,:) = 0._wp 133 qm0 (:,:) = 0._wp 134 zrl01 (:,:) = 0._wp 135 zhl0 (:,:) = 0._wp 136 z_i (:,:) = 0._wp 137 z_s (:,:) = 0._wp 138 139 ! 140 !------------------------------------------------------------------------------| 141 ! 1) Grid | 142 !------------------------------------------------------------------------------| 143 nlays0 = nlay_s 144 nlayi0 = nlay_i 145 146 DO ji = kideb, kiut 147 zh_i(ji) = old_ht_i_b(ji) / REAL( nlay_i ) 148 zh_s(ji) = old_ht_s_b(ji) / REAL( nlay_s ) 149 END DO 150 151 ! 152 !------------------------------------------------------------------------------| 153 ! 2) Switches | 154 !------------------------------------------------------------------------------| 155 ! 2.1 snind(ji), snswi(ji) 156 ! snow surface behaviour : computation of snind(ji)-snswi(ji) 157 ! snind(ji) : index which equals 158 ! 0 if snow is accumulating 159 ! 1 if 1st layer is melting 160 ! 2 if 2nd layer is melting ... 161 DO ji = kideb, kiut 162 snind (ji) = 0 163 zdeltah(ji) = 0._wp 164 ENDDO !ji 165 166 DO jk = 1, nlays0 92 !-------------------------------------------------------------------------- 93 ! 1) Cumulative integral of old enthalpy * thicnkess and layers interfaces 94 !-------------------------------------------------------------------------- 95 zqh_cum0(:,0:nlay_i+2) = 0._wp 96 zh_cum0 (:,0:nlay_i+2) = 0._wp 97 DO jk0 = 1, nlay_i+2 167 98 DO ji = kideb, kiut 168 snind(ji) = jk * NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)))) & 169 + snind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji))))) 170 zdeltah(ji)= zdeltah(ji) + zh_s(ji) 171 END DO ! ji 172 END DO ! jk 173 174 ! snswi(ji) : switch which value equals 1 if snow melts 175 ! 0 if not 176 DO ji = kideb, kiut 177 snswi(ji) = MAX(0,NINT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 178 END DO ! ji 179 180 ! 2.2 icsuind(ji), icsuswi(ji) 181 ! ice surface behaviour : computation of icsuind(ji)-icsuswi(ji) 182 ! icsuind(ji) : index which equals 183 ! 0 if nothing happens at the surface 184 ! 1 if first layer is melting 185 ! 2 if 2nd layer is reached by melt ... 186 DO ji = kideb, kiut 187 icsuind(ji) = 0 188 zdeltah(ji) = 0._wp 189 END DO !ji 190 DO jk = 1, nlayi0 191 DO ji = kideb, kiut 192 icsuind(ji) = jk * NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)))) & 193 + icsuind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji))))) 194 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 195 END DO ! ji 196 ENDDO !jk 197 198 ! icsuswi(ji) : switch which equals 199 ! 1 if ice melts at the surface 200 ! 0 if not 201 DO ji = kideb, kiut 202 icsuswi(ji) = MAX(0,NINT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 99 zqh_cum0(ji,jk0) = zqh_cum0(ji,jk0-1) + qh_i_old(ji,jk0-1) 100 zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1) 101 ENDDO 203 102 ENDDO 204 103 205 ! 2.3 icboind(ji), icboswi(ji) 206 ! ice bottom behaviour : computation of icboind(ji)-icboswi(ji) 207 ! icboind(ji) : index which equals 208 ! 0 if accretion is on the way 209 ! 1 if last layer has started to melt 210 ! 2 if penultiem layer is melting ... and so on 211 ! N+1 if all layers melt and that snow transforms into ice 212 DO ji = kideb, kiut 213 icboind(ji) = 0 214 zdeltah(ji) = 0._wp 215 END DO 216 DO jk = nlayi0, 1, -1 217 DO ji = kideb, kiut 218 icboind(ji) = (nlayi0+1-jk) * NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))) & 219 & + icboind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji))))) 220 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 221 END DO 222 END DO 223 104 !------------------------------------ 105 ! 2) Interpolation on the new layers 106 !------------------------------------ 107 ! new layer thickesses 224 108 DO ji = kideb, kiut 225 ! case of total ablation with remaining snow 226 IF ( ( ht_i_b(ji) .GT. epsi20 ) .AND. & 227 ( ht_i_b(ji) - dh_snowice(ji) .LT. epsi20 ) ) icboind(ji) = nlay_i + 1 228 END DO 229 230 ! icboswi(ji) : switch which equals 231 ! 1 if ice accretion is on the way 232 ! 0 if ablation is on the way 233 DO ji = kideb, kiut 234 icboswi(ji) = MAX(0,NINT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 235 END DO 236 237 ! 2.4 snicind(ji), snicswi(ji) 238 ! snow ice formation : calcul de snicind(ji)-snicswi(ji) 239 ! snicind(ji) : index which equals 240 ! 0 if no snow-ice forms 241 ! 1 if last layer of snow has started to melt 242 ! 2 if penultiem layer ... 243 DO ji = kideb, kiut 244 snicind(ji) = 0 245 zdeltah(ji) = 0._wp 246 END DO 247 DO jk = nlays0, 1, -1 248 DO ji = kideb, kiut 249 snicind(ji) = (nlays0+1-jk) & 250 * NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)))) + snicind(ji) & 251 * (1 - NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji))))) 252 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 253 END DO 254 END DO 255 256 ! snicswi(ji) : switch which equals 257 ! 1 if snow-ice forms 258 ! 0 if not 259 DO ji = kideb, kiut 260 snicswi(ji) = MAX(0,NINT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 109 zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i ) 261 110 ENDDO 262 111 263 ! 264 !------------------------------------------------------------------------------| 265 ! 3) Snow redistribution | 266 !------------------------------------------------------------------------------| 267 ! 268 !------------- 269 ! Old profile 270 !------------- 271 272 ! by 'old', it is meant that layers coming from accretion are included, 273 ! and that interfacial layers which were partly melted are reduced 274 275 ! indexes of the vectors 276 !------------------------ 277 ntop0 = 1 278 maxnbot0 = 0 279 280 DO ji = kideb, kiut 281 nbot0(ji) = nlays0 + 1 - snind(ji) + ( 1 - snicind(ji) ) * snicswi(ji) 282 ! cotes of the top of the layers 283 zm0(ji,0) = 0._wp 284 maxnbot0 = MAX ( maxnbot0 , nbot0(ji) ) 285 END DO 286 IF( lk_mpp ) CALL mpp_max( maxnbot0, kcom=ncomm_ice ) 287 288 DO jk = 1, maxnbot0 112 ! new layers interfaces 113 zh_cum1(:,0:nlay_i) = 0._wp 114 DO jk1 = 1, nlay_i 289 115 DO ji = kideb, kiut 290 !change 291 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 292 limsum = MIN( limsum , nlay_s ) 293 zm0(ji,jk) = dh_s_tot(ji) + zh_s(ji) * REAL( limsum ) 294 END DO 295 END DO 296 297 DO ji = kideb, kiut 298 zm0(ji,nbot0(ji)) = dh_s_tot(ji) - REAL( snicswi(ji) ) * dh_snowice(ji) + zh_s(ji) * REAL( nlays0 ) 299 zm0(ji,1) = dh_s_tot(ji) * REAL( 1 - snswi(ji) ) + REAL( snswi(ji) ) * zm0(ji,1) 300 END DO 301 302 DO jk = ntop0, maxnbot0 303 DO ji = kideb, kiut 304 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) ! layer thickness 305 END DO 306 END DO 307 308 zqts_in(:) = 0._wp 309 310 DO ji = kideb, kiut ! layer heat content 311 qm0 (ji,1) = rhosn * ( cpic * ( rtt - REAL( 1 - snswi(ji) ) * tatm_ice_1d(ji) & 312 & - REAL( snswi(ji) ) * t_s_b (ji,1) ) & 313 & + lfus ) * zthick0(ji,1) 314 zqts_in(ji) = zqts_in(ji) + qm0(ji,1) 315 END DO 316 317 DO jk = 2, maxnbot0 318 DO ji = kideb, kiut 319 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 320 limsum = MIN( limsum , nlay_s ) 321 qm0(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk) 322 zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, - ht_s_b(ji) ) ) 323 zqts_in(ji) = zqts_in(ji) + REAL( 1 - snswi(ji) ) * qm0(ji,jk) * zswitch 324 END DO ! jk 325 END DO ! ji 326 327 !------------------------------------------------ 328 ! Energy given by the snow in snow-ice formation 329 !------------------------------------------------ 330 ! zqsnow, enthalpy of the flooded snow 331 DO ji = kideb, kiut 332 zqsnow (ji) = rhosn * lfus 333 zdeltah(ji) = 0._wp 334 END DO 335 336 DO jk = nlays0, 1, -1 337 DO ji = kideb, kiut 338 zhsnow = MAX( 0._wp , dh_snowice(ji)-zdeltah(ji) ) 339 zqsnow (ji) = zqsnow (ji) + rhosn*cpic*(rtt-t_s_b(ji,jk)) 340 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 341 END DO 342 END DO 343 344 DO ji = kideb, kiut 345 zqsnow(ji) = zqsnow(ji) * dh_snowice(ji) 346 END DO 347 348 !------------------ 349 ! new snow profile 350 !------------------ 351 352 !-------------- 353 ! Vector index 354 !-------------- 355 ntop1 = 1 356 nbot1 = nlay_s 357 358 !------------------- 359 ! Layer coordinates 360 !------------------- 361 DO ji = kideb, kiut 362 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 363 z_s(ji,0) = 0._wp 116 zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 117 ENDDO 364 118 ENDDO 365 119 366 DO jk = 1, nlay_s 120 zqh_cum1(:,0:nlay_i) = 0._wp 121 ! new cumulative q*h => linear interpolation 122 DO jk0 = 1, nlay_i+1 123 DO jk1 = 1, nlay_i-1 124 DO ji = kideb, kiut 125 IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 126 zqh_cum1(ji,jk1) = ( zqh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1 ) ) + & 127 & zqh_cum0(ji,jk0 ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) ) & 128 & / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 129 ENDIF 130 ENDDO 131 ENDDO 132 ENDDO 133 ! to ensure that total heat content is strictly conserved, set: 134 zqh_cum1(:,nlay_i) = zqh_cum0(:,nlay_i+2) 135 136 ! new enthalpies 137 DO jk1 = 1, nlay_i 367 138 DO ji = kideb, kiut 368 z_s(ji,jk) = zh_s(ji) * REAL( jk ) 369 END DO 370 END DO 371 372 !----------------- 373 ! Layer thickness 374 !----------------- 375 DO layer0 = ntop0, maxnbot0 376 DO ji = kideb, kiut 377 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 378 END DO 379 END DO 380 381 DO layer1 = ntop1, nbot1 382 DO ji = kideb, kiut 383 q_s_b(ji,layer1) = 0._wp 384 END DO 385 END DO 386 387 !---------------- 388 ! Weight factors 389 !---------------- 390 DO layer0 = ntop0, maxnbot0 391 DO layer1 = ntop1, nbot1 392 DO ji = kideb, kiut 393 zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 394 zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1)) & 395 & - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10)) 396 q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0) & 397 & * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 398 END DO 399 END DO 400 END DO 401 402 ! Heat conservation 403 zqts_fin(:) = 0._wp 404 DO jk = 1, nlay_s 405 DO ji = kideb, kiut 406 zqts_fin(ji) = zqts_fin(ji) + q_s_b(ji,jk) 407 END DO 408 END DO 409 410 IF ( con_i .AND. jiindex_1d > 0 ) THEN 411 DO ji = kideb, kiut 412 IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 413 ii = MOD( npb(ji) - 1, jpi ) + 1 414 ij = ( npb(ji) - 1 ) / jpi + 1 415 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 416 WRITE(numout,*) ' ji, jj : ', ii, ij 417 WRITE(numout,*) ' ht_s_b : ', ht_s_b(ji) 418 WRITE(numout,*) ' zqts_in : ', zqts_in (ji) * r1_rdtice 419 WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) * r1_rdtice 420 WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 421 WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 422 WRITE(numout,*) ' snswi : ', snswi(ji) 423 ENDIF 424 END DO 425 ENDIF 426 427 !--------------------- 428 ! Recover heat content 429 !--------------------- 430 DO jk = 1, nlay_s 431 DO ji = kideb, kiut 432 zinda = MAX( 0._wp, SIGN( 1._wp , zh_s(ji) - epsi10 ) ) 433 q_s_b(ji,jk) = zinda * q_s_b(ji,jk) / MAX( zh_s(ji) , epsi10 ) 434 END DO !ji 435 END DO !jk 436 437 !--------------------- 438 ! Recover temperature 439 !--------------------- 440 zfac1 = 1. / ( rhosn * cpic ) 441 zfac2 = lfus / cpic 442 DO jk = 1, nlay_s 443 DO ji = kideb, kiut 444 zswitch = MAX ( 0.0 , SIGN ( 1.0, - ht_s_b(ji) ) ) 445 t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 446 END DO 447 END DO 448 ! 449 !------------------------------------------------------------------------------| 450 ! 4) Ice redistribution | 451 !------------------------------------------------------------------------------| 452 ! 453 !------------- 454 ! OLD PROFILE 455 !------------- 456 457 !---------------- 458 ! Vector indexes 459 !---------------- 460 ntop0 = 1 461 maxnbot0 = 0 462 463 DO ji = kideb, kiut 464 ! reference number of the bottommost layer 465 nbot0(ji) = MAX( 1 , MIN( nlayi0 + ( 1 - icboind(ji) ) + & 466 & ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , nlay_i + 2 ) ) 467 ! maximum reference number of the bottommost layer over all domain 468 maxnbot0 = MAX( maxnbot0 , nbot0(ji) ) 469 END DO 470 471 !------------------------- 472 ! Cotes of old ice layers 473 !------------------------- 474 zm0(:,0) = 0._wp 475 476 DO jk = 1, maxnbot0 477 DO ji = kideb, kiut 478 ! jk goes from 1 to nbot0 479 ! the ice layer number goes from 1 to nlay_i 480 ! limsum is the real ice layer number corresponding to present jk 481 limsum = ( (icsuswi(ji)*(icsuind(ji)+jk-1) + & 482 (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 483 zm0(ji,jk)= REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) & 484 + REAL(limsum) * zh_i(ji) 485 END DO 486 END DO 487 488 DO ji = kideb, kiut 489 zm0(ji,nbot0(ji)) = REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) + dh_i_bott(ji) & 490 + zh_i(ji) * REAL(nlayi0) 491 zm0(ji,1) = REAL(snicswi(ji))*dh_snowice(ji) + REAL(1-snicswi(ji))*zm0(ji,1) 492 END DO 493 494 !----------------------------- 495 ! Thickness of old ice layers 496 !----------------------------- 497 DO jk = ntop0, maxnbot0 498 DO ji = kideb, kiut 499 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) 500 END DO 501 END DO 502 503 !--------------------------- 504 ! Inner layers heat content 505 !--------------------------- 506 qm0(:,:) = 0.0 507 zqti_in(:) = 0.0 508 509 DO jk = ntop0, maxnbot0 510 DO ji = kideb, kiut 511 limsum = MAX(1,MIN(snicswi(ji)*(jk-1) + icsuswi(ji)*(jk-1+icsuind(ji)) + & 512 (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i)) 513 ztmelts = -tmut * s_i_b(ji,limsum) + rtt 514 qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ & 515 MIN((t_i_b(ji,limsum)-rtt),-epsi20) ) - rcp*(ztmelts-rtt) ) & 516 * zthick0(ji,jk) 517 END DO 518 END DO 519 520 !---------------------------- 521 ! Bottom layers heat content 522 !---------------------------- 523 DO ji = kideb, kiut 524 ztmelts = REAL( 1 - icboswi(ji) ) * (-tmut * s_i_b (ji,nlayi0) ) & ! case of melting ice 525 & + REAL( icboswi(ji) ) * (-tmut * s_i_new(ji) ) & ! case of forming ice 526 & + rtt ! in Kelvin 527 528 ! bottom formation temperature 529 ztform = t_i_b(ji,nlay_i) 530 IF( num_sal == 2 ) ztform = t_bo_b(ji) 531 qm0(ji,nbot0(ji)) = REAL( 1 - icboswi(ji) )*qm0(ji,nbot0(ji)) & ! case of melting ice 532 & + REAL( icboswi(ji) ) * rhoic * ( cpic*(ztmelts-ztform) & ! case of forming ice 533 + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) ) & 534 - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji) ) 535 END DO 536 537 !----------------------------- 538 ! Snow ice layer heat content 539 !----------------------------- 540 DO ji = kideb, kiut 541 ! energy of the flooding seawater 542 zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 543 (rhoic - rhosn) / rhoic * REAL(snicswi(ji)) ! generally positive 544 ! Heat conservation diagnostic 545 qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic 546 547 qldif_1d(ji) = qldif_1d(ji) + zqsnic * a_i_b(ji) 548 549 ! enthalpy of the newly formed snow-ice layer 550 ! = enthalpy of snow + enthalpy of frozen water 551 zqsnic = zqsnow(ji) + zqsnic 552 qm0(ji,1) = REAL(snicswi(ji)) * zqsnic + REAL( 1 - snicswi(ji) ) * qm0(ji,1) 553 554 END DO ! ji 555 556 DO jk = ntop0, maxnbot0 557 DO ji = kideb, kiut 558 ! Heat conservation 559 zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi10) ) & 560 & * MAX( 0.0 , SIGN( 1. , REAL(nbot0(ji) - jk) ) ) 561 END DO 562 END DO 563 564 !------------- 565 ! NEW PROFILE 566 !------------- 567 568 !--------------- 569 ! Vectors index 570 !--------------- 571 ntop1 = 1 572 nbot1 = nlay_i 573 574 !------------------ 575 ! Layers thickness 576 !------------------ 577 DO ji = kideb, kiut 578 zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 139 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 140 qnew(ji,jk1) = zswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 ) 141 ENDDO 579 142 ENDDO 580 143 581 !------------- 582 ! Layer cotes 583 !------------- 584 z_i(:,0) = 0._wp 585 DO jk = 1, nlay_i 586 DO ji = kideb, kiut 587 z_i(ji,jk) = zh_i(ji) * jk 588 END DO 144 ! --- diag error on heat remapping --- ! 145 ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac), 146 ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 147 DO ji = kideb, kiut 148 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice * & 149 & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) ) 589 150 END DO 590 591 !--thicknesses of the layers 592 DO layer0 = ntop0, maxnbot0 593 DO ji = kideb, kiut 594 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) ! thicknesses of the layers 595 END DO 596 END DO 597 598 !------------------------ 599 ! Weights for relayering 600 !------------------------ 601 q_i_b(:,:) = 0._wp 602 DO layer0 = ntop0, maxnbot0 603 DO layer1 = ntop1, nbot1 604 DO ji = kideb, kiut 605 zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 606 zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) & 607 - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10)) 608 q_i_b(ji,layer1) = q_i_b(ji,layer1) & 609 + zrl01(layer1,layer0)*qm0(ji,layer0) & 610 * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi10)) & 611 * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 612 END DO 613 END DO 614 END DO 615 616 !------------------------- 617 ! Heat conservation check 618 !------------------------- 619 zqti_fin(:) = 0._wp 620 DO jk = 1, nlay_i 621 DO ji = kideb, kiut 622 zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) 623 END DO 624 END DO 151 625 152 ! 626 IF ( con_i .AND. jiindex_1d > 0 ) THEN 627 DO ji = kideb, kiut 628 IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 629 ii = MOD( npb(ji) - 1, jpi ) + 1 630 ij = ( npb(ji) - 1 ) / jpi + 1 631 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 632 WRITE(numout,*) ' ji, jj : ', ii, ij 633 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 634 WRITE(numout,*) ' zqti_in : ', zqti_in (ji) * r1_rdtice 635 WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 636 WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 637 WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 638 WRITE(numout,*) ' dh_snowice:', dh_snowice(ji) 639 WRITE(numout,*) ' icsuswi : ', icsuswi(ji) 640 WRITE(numout,*) ' icboswi : ', icboswi(ji) 641 WRITE(numout,*) ' snicswi : ', snicswi(ji) 642 ENDIF 643 END DO 644 ENDIF 645 646 !---------------------- 647 ! Recover heat content 648 !---------------------- 649 DO jk = 1, nlay_i 650 DO ji = kideb, kiut 651 zinda = MAX( 0._wp, SIGN( 1._wp , zh_i(ji) - epsi10 ) ) 652 q_i_b(ji,jk) = zinda * q_i_b(ji,jk) / MAX( zh_i(ji) , epsi10 ) 653 END DO !ji 654 END DO !jk 655 656 ! Heat conservation 657 zqti_fin(:) = 0.0 658 DO jk = 1, nlay_i 659 DO ji = kideb, kiut 660 zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) * zh_i(ji) 661 END DO 662 END DO 663 664 ! 665 !------------------------------------------------------------------------------| 666 ! 5) Update salinity and recover temperature | 667 !------------------------------------------------------------------------------| 668 ! 669 ! Update salinity (basal entrapment, snow ice formation) 670 DO ji = kideb, kiut 671 sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 672 END DO !ji 673 674 ! Recover temperature 675 DO jk = 1, nlay_i 676 DO ji = kideb, kiut 677 ztmelts = -tmut*s_i_b(ji,jk) + rtt 678 !Conversion q(S,T) -> T (second order equation) 679 zaaa = cpic 680 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 681 zccc = lfus * ( ztmelts - rtt ) 682 zdiscrim = SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 683 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 684 END DO !ji 685 686 END DO !jk 687 ! 688 CALL wrk_dealloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 689 CALL wrk_dealloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 690 CALL wrk_dealloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 691 CALL wrk_dealloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 153 CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 154 CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 155 CALL wrk_dealloc( jpij, zhnew ) 692 156 ! 693 157 END SUBROUTINE lim_thd_ent -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4333 r4921 29 29 USE lib_mpp ! MPP library 30 30 USE wrk_nemo ! work arrays 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 USE limthd_ent 32 34 33 35 IMPLICIT NONE … … 37 39 38 40 REAL(wp) :: epsi10 = 1.e-10_wp ! 39 REAL(wp) :: zzero = 0._wp ! 40 REAL(wp) :: zone = 1._wp ! 41 REAL(wp) :: epsi20 = 1.e-20_wp ! 41 42 42 43 !!---------------------------------------------------------------------- … … 71 72 !! - Computation of variation of ice volume and mass 72 73 !! - Computation of frldb after lateral accretion and 73 !! update ht_s_ b, ht_i_band tbif_1d(:,:)74 !! update ht_s_1d, ht_i_1d and tbif_1d(:,:) 74 75 !!------------------------------------------------------------------------ 75 INTEGER :: ji,jj,jk,jl ,jm! dummy loop indices76 INTEGER :: layer, nbpac! local integers77 INTEGER :: ii, ij, iter ! - -78 REAL(wp) :: ztmelts, zdv, z qold, zfrazb, zweight, zalphai, zindb, zinda, zde ! local scalars76 INTEGER :: ji,jj,jk,jl ! dummy loop indices 77 INTEGER :: nbpac ! local integers 78 INTEGER :: ii, ij, iter ! - - 79 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde ! local scalars 79 80 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new ! - - 80 81 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - 81 82 LOGICAL :: iterate_frazil ! iterate frazil ice collection thickness 82 83 CHARACTER (len = 15) :: fieldid 83 ! 84 INTEGER , POINTER, DIMENSION(:) :: zcatac ! indexes of categories where new ice grows 84 85 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 86 REAL(wp) :: zEi ! sea ice specific enthalpy (J/kg) 87 REAL(wp) :: zEw ! seawater specific enthalpy (J/kg) 88 REAL(wp) :: zfmdt ! mass flux x time step (kg/m2, >0 towards ocean) 89 90 REAL(wp) :: zv_newfra 91 92 INTEGER , POINTER, DIMENSION(:) :: jcat ! indexes of categories where new ice grows 85 93 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not 86 94 … … 93 101 REAL(wp), POINTER, DIMENSION(:) :: zdv_res ! residual volume in case of excessive heat budget 94 102 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget 95 REAL(wp), POINTER, DIMENSION(:) :: zat_i_ac ! total ice fraction 96 REAL(wp), POINTER, DIMENSION(:) :: zat_i_lev ! total ice fraction for level ice only (type 1) 97 REAL(wp), POINTER, DIMENSION(:) :: zdh_frazb ! accretion of frazil ice at the ice bottom 98 REAL(wp), POINTER, DIMENSION(:) :: zvrel_ac ! relative ice / frazil velocity (1D vector) 99 100 REAL(wp), POINTER, DIMENSION(:,:) :: zhice_old ! previous ice thickness 101 REAL(wp), POINTER, DIMENSION(:,:) :: zdummy ! dummy thickness of new ice 102 REAL(wp), POINTER, DIMENSION(:,:) :: zdhicbot ! thickness of new ice which is accreted vertically 103 REAL(wp), POINTER, DIMENSION(:,:) :: zv_old ! old volume of ice in category jl 104 REAL(wp), POINTER, DIMENSION(:,:) :: za_old ! old area of ice in category jl 105 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_ac ! 1-D version of a_i 106 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_ac ! 1-D version of v_i 107 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_ac ! 1-D version of oa_i 108 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_ac ! 1-D version of smv_i 109 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_ac !: 1-D version of e_i 111 112 REAL(wp), POINTER, DIMENSION(:) :: zqbgow ! heat budget of the open water (negative) 113 REAL(wp), POINTER, DIMENSION(:) :: zdhex ! excessively thick accreted sea ice (hlead-hice) 114 115 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqm0 ! old layer-system heat content 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zthick0 ! old ice thickness 117 118 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 119 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 120 REAL(wp), POINTER, DIMENSION(:,:) :: et_i_init, et_i_final ! ice energy summed over categories 121 REAL(wp), POINTER, DIMENSION(:,:) :: et_s_init ! snow energy summed over categories 103 REAL(wp), POINTER, DIMENSION(:) :: zat_i_1d ! total ice fraction 104 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom 105 REAL(wp), POINTER, DIMENSION(:) :: zvrel_1d ! relative ice / frazil velocity (1D vector) 106 107 REAL(wp), POINTER, DIMENSION(:,:) :: zv_b ! old volume of ice in category jl 108 REAL(wp), POINTER, DIMENSION(:,:) :: za_b ! old area of ice in category jl 109 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i 110 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i 111 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_1d ! 1-D version of oa_i 112 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d !: 1-D version of e_i 115 122 116 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity 123 117 !!-----------------------------------------------------------------------! 124 118 125 CALL wrk_alloc( jpij, zcatac) ! integer119 CALL wrk_alloc( jpij, jcat ) ! integer 126 120 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 127 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 128 CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 129 CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 130 CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 131 CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 132 133 et_i_init(:,:) = 0._wp 134 et_s_init(:,:) = 0._wp 135 vt_i_init(:,:) = 0._wp 136 vt_s_init(:,:) = 0._wp 137 138 !------------------------------------------------------------------------------! 139 ! 1) Conservation check and changes in each ice category 140 !------------------------------------------------------------------------------! 141 IF( con_i ) THEN 142 CALL lim_column_sum ( jpl, v_i , vt_i_init) 143 CALL lim_column_sum ( jpl, v_s , vt_s_init) 144 CALL lim_column_sum_energy ( jpl, nlay_i , e_i , et_i_init) 145 CALL lim_column_sum ( jpl, e_s(:,:,1,:) , et_s_init) 146 ENDIF 121 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 122 CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 123 CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d ) 124 CALL wrk_alloc( jpi,jpj, zvrel ) 147 125 148 126 !------------------------------------------------------------------------------| … … 154 132 DO ji = 1, jpi 155 133 !Energy of melting q(S,T) [J.m-3] 156 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) , epsi10 ) * REAL( nlay_i )157 134 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 158 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 135 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i, wp ) 136 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 159 137 END DO 160 138 END DO … … 179 157 180 158 ! Default new ice thickness 181 hicol(:,:) = hiccrit (1)182 183 IF( fraz_swi == 1 ._wp) THEN159 hicol(:,:) = hiccrit 160 161 IF( fraz_swi == 1 ) THEN 184 162 185 163 !-------------------- … … 193 171 zgamafr = 0.03 194 172 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 198 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 173 DO jj = 2, jpj 174 DO ji = 2, jpi 175 IF ( qlead(ji,jj) < 0._wp ) THEN 199 176 !------------- 200 177 ! Wind stress … … 206 183 & + vtau_ice(ji ,jj ) * tmv(ji ,jj ) ) * 0.5_wp 207 184 ! Square root of wind stress 208 ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy) )185 ztenagm = SQRT( SQRT( ztaux**2 + ztauy**2 ) ) 209 186 210 187 !--------------------- 211 188 ! Frazil ice velocity 212 189 !--------------------- 213 zvfrx = zgamafr * zsqcd * ztaux / MAX(ztenagm,epsi10) 214 zvfry = zgamafr * zsqcd * ztauy / MAX(ztenagm,epsi10) 190 zindb = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 191 zvfrx = zindb * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 192 zvfry = zindb * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 215 193 216 194 !------------------- … … 264 242 END DO ! loop on ji ends 265 243 END DO ! loop on jj ends 244 ! 245 CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 246 CALL lbc_lnk( hicol(:,:), 'T', 1. ) 266 247 267 248 ENDIF ! End of computation of frazil ice collection thickness … … 276 257 ! This occurs if open water energy budget is negative 277 258 nbpac = 0 259 npac(:) = 0 260 ! 278 261 DO jj = 1, jpj 279 262 DO ji = 1, jpi 280 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) >0._wp ) THEN263 IF ( qlead(ji,jj) < 0._wp ) THEN 281 264 nbpac = nbpac + 1 282 265 npac( nbpac ) = (jj - 1) * jpi + ji … … 290 273 DO ji = mi0(jiindx), mi1(jiindx) 291 274 DO jj = mj0(jjindx), mj1(jjindx) 292 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) >0._wp ) THEN275 IF ( qlead(ji,jj) < 0._wp ) THEN 293 276 jiindex_1d = (jj - 1) * jpi + ji 294 277 ENDIF … … 307 290 IF ( nbpac > 0 ) THEN 308 291 309 CALL tab_2d_1d( nbpac, zat_i_ ac(1:nbpac) , at_i , jpi, jpj, npac(1:nbpac) )292 CALL tab_2d_1d( nbpac, zat_i_1d (1:nbpac) , at_i , jpi, jpj, npac(1:nbpac) ) 310 293 DO jl = 1, jpl 311 CALL tab_2d_1d( nbpac, za_i_ ac(1:nbpac,jl), a_i (:,:,jl), jpi, jpj, npac(1:nbpac) )312 CALL tab_2d_1d( nbpac, zv_i_ ac(1:nbpac,jl), v_i (:,:,jl), jpi, jpj, npac(1:nbpac) )313 CALL tab_2d_1d( nbpac, zoa_i_ ac(1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) )314 CALL tab_2d_1d( nbpac, zsmv_i_ ac(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) )294 CALL tab_2d_1d( nbpac, za_i_1d (1:nbpac,jl), a_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 295 CALL tab_2d_1d( nbpac, zv_i_1d (1:nbpac,jl), v_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 296 CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 297 CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 315 298 DO jk = 1, nlay_i 316 CALL tab_2d_1d( nbpac, ze_i_ ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) )299 CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 317 300 END DO ! jk 318 301 END DO ! jl 319 302 320 CALL tab_2d_1d( nbpac, qldif_1d (1:nbpac) , qldif , jpi, jpj, npac(1:nbpac) ) 321 CALL tab_2d_1d( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) ) 322 CALL tab_2d_1d( nbpac, t_bo_b (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 323 CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac) , sfx_thd, jpi, jpj, npac(1:nbpac) ) 324 CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac) , rdm_ice, jpi, jpj, npac(1:nbpac) ) 325 CALL tab_2d_1d( nbpac, hicol_b (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 326 CALL tab_2d_1d( nbpac, zvrel_ac (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 303 CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) ) 304 CALL tab_2d_1d( nbpac, t_bo_1d (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 305 CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac) , sfx_opw, jpi, jpj, npac(1:nbpac) ) 306 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 307 CALL tab_2d_1d( nbpac, hicol_1d (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 308 CALL tab_2d_1d( nbpac, zvrel_1d (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 309 310 CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac) , hfx_thd, jpi, jpj, npac(1:nbpac) ) 311 CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac) , hfx_opw, jpi, jpj, npac(1:nbpac) ) 327 312 328 313 !------------------------------------------------------------------------------! … … 330 315 !------------------------------------------------------------------------------! 331 316 317 !----------------------------------------- 318 ! Keep old ice areas and volume in memory 319 !----------------------------------------- 320 zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:) 321 za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 332 322 !---------------------- 333 323 ! Thickness of new ice 334 324 !---------------------- 335 325 DO ji = 1, nbpac 336 zh_newice(ji) = hiccrit (1)337 END DO 338 IF( fraz_swi == 1 .0 ) zh_newice(:) = hicol_b(:)326 zh_newice(ji) = hiccrit 327 END DO 328 IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 339 329 340 330 !---------------------- 341 331 ! Salinity of new ice 342 332 !---------------------- 343 344 333 SELECT CASE ( num_sal ) 345 334 CASE ( 1 ) ! Sice = constant 346 zs_newice( :) = bulk_sal335 zs_newice(1:nbpac) = bulk_sal 347 336 CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)] 348 337 DO ji = 1, nbpac … … 352 341 END DO 353 342 CASE ( 3 ) ! Sice = F(z) [multiyear ice] 354 zs_newice( :) = 2.3343 zs_newice(1:nbpac) = 2.3 355 344 END SELECT 356 357 345 358 346 !------------------------- … … 362 350 DO ji = 1, nbpac 363 351 ztmelts = - tmut * zs_newice(ji) + rtt ! Melting point (K) 364 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_ b(ji) ) &365 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt) ) &352 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) & 353 & + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) ) & 366 354 & - rcp * ( ztmelts - rtt ) ) 367 ze_newice(ji) = MAX( ze_newice(ji) , 0._wp ) &368 & + MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) ) * rhoic * lfus369 355 END DO ! ji 356 370 357 !---------------- 371 358 ! Age of new ice … … 375 362 END DO ! ji 376 363 377 !--------------------------378 ! Open water energy budget379 !--------------------------380 DO ji = 1, nbpac381 zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji) !<0382 END DO ! ji383 384 364 !------------------- 385 365 ! Volume of new ice 386 366 !------------------- 387 367 DO ji = 1, nbpac 388 zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 368 369 zEi = - ze_newice(ji) / rhoic ! specific enthalpy of forming ice [J/kg] 370 371 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_1d [J/kg] 372 ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 373 374 zdE = zEi - zEw ! specific enthalpy difference [J/kg] 375 376 zfmdt = - qlead_1d(ji) / zdE ! Fm.dt [kg/m2] (<0) 377 ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point 378 zv_newice(ji) = - zfmdt / rhoic 379 380 zQm = zfmdt * zEw ! heat to the ocean >0 associated with mass flux 381 382 ! Contribution to heat flux to the ocean [W.m-2], >0 383 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 384 ! Total heat flux used in this process [W.m-2] 385 hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice 386 ! mass flux 387 wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice 388 ! salt flux 389 sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 389 390 390 391 ! A fraction zfrazb of frazil ice is accreted at the ice bottom 391 zfrazb = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 392 zdh_frazb(ji) = zfrazb * zv_newice(ji) 392 zinda = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 393 zfrazb = zinda * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 394 zv_frazb(ji) = zfrazb * zv_newice(ji) 393 395 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 394 396 END DO 395 396 !------------------------------------397 ! Diags for energy conservation test398 !------------------------------------399 DO ji = 1, nbpac400 ii = MOD( npac(ji) - 1 , jpi ) + 1401 ij = ( npac(ji) - 1 ) / jpi + 1402 !403 zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji)404 !405 vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji) ! volume406 et_i_init(ii,ij) = et_i_init(ii,ij) + zde ! Energy407 408 END DO409 410 ! keep new ice volume in memory411 CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj )412 397 413 398 !----------------- … … 415 400 !----------------- 416 401 DO ji = 1, nbpac 417 ii = MOD( npac(ji) - 1 , jpi ) + 1418 ij = ( npac(ji) - 1 ) / jpi + 1419 402 za_newice(ji) = zv_newice(ji) / zh_newice(ji) 420 diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem 421 END DO !ji 403 END DO 422 404 423 405 !------------------------------------------------------------------------------! … … 425 407 !------------------------------------------------------------------------------! 426 408 427 !----------------------------------------- 428 ! Keep old ice areas and volume in memory 429 !----------------------------------------- 430 zv_old(:,:) = zv_i_ac(:,:) 431 za_old(:,:) = za_i_ac(:,:) 432 433 !------------------------------------------- 434 ! Compute excessive new ice area and volume 435 !------------------------------------------- 409 !------------------------ 410 ! 6.1) lateral ice growth 411 !------------------------ 436 412 ! If lateral ice growth gives an ice concentration gt 1, then 437 413 ! we keep the excessive volume in memory and attribute it later to bottom accretion 438 414 DO ji = 1, nbpac 439 IF ( za_newice(ji) > ( amax - zat_i_ ac(ji) ) ) THEN440 zda_res(ji) = za_newice(ji) - ( amax - zat_i_ ac(ji) )415 IF ( za_newice(ji) > ( amax - zat_i_1d(ji) ) ) THEN 416 zda_res(ji) = za_newice(ji) - ( amax - zat_i_1d(ji) ) 441 417 zdv_res(ji) = zda_res (ji) * zh_newice(ji) 442 418 za_newice(ji) = za_newice(ji) - zda_res (ji) … … 446 422 zdv_res(ji) = 0._wp 447 423 ENDIF 448 END DO ! ji 449 450 !------------------------------------------------ 451 ! Laterally redistribute new ice volume and area 452 !------------------------------------------------ 453 zat_i_ac(:) = 0._wp 424 END DO 425 426 ! find which category to fill 427 zat_i_1d(:) = 0._wp 454 428 DO jl = 1, jpl 455 429 DO ji = 1, nbpac 456 IF( hi_max (jl-1) < zh_newice(ji) .AND. & 457 & zh_newice(ji) <= hi_max (jl) ) THEN 458 za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 459 zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 460 zat_i_ac(ji) = zat_i_ac(ji) + za_i_ac (ji,jl) 461 zcatac (ji) = jl 430 IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN 431 za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji) 432 zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji) 433 jcat (ji) = jl 462 434 ENDIF 463 END DO 464 END DO 465 466 !---------------------------------- 467 ! Heat content - lateral accretion 468 !---------------------------------- 469 DO ji = 1, nbpac 470 jl = zcatac(ji) ! categroy in which new ice is put 471 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) ) ! zindb=1 if ice =0 otherwise 472 zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb ! old ice thickness 473 zdhex (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) ) ! difference in thickness 474 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) ) ! ice totally new in jl category 435 zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d (ji,jl) 436 END DO 437 END DO 438 439 ! Heat content 440 DO ji = 1, nbpac 441 jl = jcat(ji) ! categroy in which new ice is put 442 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) ) ! 0 if old ice 475 443 END DO 476 444 477 445 DO jk = 1, nlay_i 478 446 DO ji = 1, nbpac 479 jl = zcatac(ji) 480 zqold = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 481 zalphai = MIN( zhice_old(ji,jl) * REAL( jk ) / REAL( nlay_i ), zh_newice(ji) ) & 482 & - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 483 ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji) & 484 + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl) * zqold * zhice_old(ji,jl) / REAL( nlay_i ) & 485 + za_newice(ji) * ze_newice(ji) * zalphai & 486 + za_newice(ji) * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 487 END DO 488 END DO 489 490 !----------------------------------------------- 491 ! Add excessive volume of new ice at the bottom 492 !----------------------------------------------- 493 ! If the ice concentration exceeds 1, the remaining volume of new ice 494 ! is equally redistributed among all ice categories in which there is 495 ! ice 496 497 ! Fraction of level ice 498 jm = 1 499 zat_i_lev(:) = 0._wp 500 501 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 502 DO ji = 1, nbpac 503 zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl) 504 END DO 505 END DO 506 507 IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 508 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 509 DO ji = 1, nbpac 510 zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 511 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi10 ) ) ! clem 512 zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zinda * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi10 ) 513 END DO 514 END DO 515 IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 516 517 !--------------------------------- 518 ! Heat content - bottom accretion 519 !--------------------------------- 520 jm = 1 521 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 522 DO ji = 1, nbpac 523 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) ) ! zindb=1 if ice =0 otherwise 524 zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 525 zdhicbot (ji,jl) = zdv_res(ji) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb & 526 & + zindb * zdh_frazb(ji) ! frazil ice may coalesce 527 zdummy(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb ! thickness of residual ice 528 END DO 529 END DO 530 531 ! old layers thicknesses and enthalpies 532 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 447 jl = jcat(ji) 448 zinda = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 449 ze_i_1d(ji,jk,jl) = zswinew(ji) * ze_newice(ji) + & 450 & ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) ) & 451 & * zinda / MAX( zv_i_1d(ji,jl), epsi20 ) 452 END DO 453 END DO 454 455 !------------------------------------------------ 456 ! 6.2) bottom ice growth + ice enthalpy remapping 457 !------------------------------------------------ 458 DO jl = 1, jpl 459 460 ! for remapping 461 h_i_old (1:nbpac,0:nlay_i+1) = 0._wp 462 qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 533 463 DO jk = 1, nlay_i 534 464 DO ji = 1, nbpac 535 zthick0(ji,jk,jl) = zhice_old(ji,jl) / REAL( nlay_i )536 zqm0 (ji,jk,jl) = ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl)465 h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i ) 466 qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 537 467 END DO 538 468 END DO 539 END DO 540 !!gm ??? why the previous do loop if ocerwriten by the following one ? 541 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 469 470 ! new volumes including lateral/bottom accretion + residual 542 471 DO ji = 1, nbpac 543 zthick0(ji,nlay_i+1,jl) = zdhicbot(ji,jl) 544 zqm0 (ji,nlay_i+1,jl) = ze_newice(ji) * zdhicbot(ji,jl) 545 END DO ! ji 546 END DO ! jl 547 548 ! Redistributing energy on the new grid 549 ze_i_ac(:,:,:) = 0._wp 550 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 551 DO jk = 1, nlay_i 552 DO layer = 1, nlay_i + 1 553 DO ji = 1, nbpac 554 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) ) 555 ! Redistributing energy on the new grid 556 zweight = MAX ( MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) ) & 557 & - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp ) & 558 & /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 559 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl) 560 END DO ! ji 561 END DO ! layer 562 END DO ! jk 563 END DO ! jl 564 565 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 566 DO jk = 1, nlay_i 567 DO ji = 1, nbpac 568 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) 569 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) & 570 & / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 571 END DO 572 END DO 573 END DO 472 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 473 zv_newfra = zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 ) 474 za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl) 475 zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 476 ! for remapping 477 h_i_old (ji,nlay_i+1) = zv_newfra 478 qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 479 ENDDO 480 481 ! --- Ice enthalpy remapping --- ! 482 CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 483 ENDDO 574 484 575 485 !------------ … … 578 488 DO jl = 1, jpl 579 489 DO ji = 1, nbpac 580 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes581 zoa_i_ ac(ji,jl) = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb490 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) ) ! 0 if no ice and 1 if yes 491 zoa_i_1d(ji,jl) = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * zindb 582 492 END DO 583 493 END DO … … 586 496 ! Update salinity 587 497 !----------------- 588 !clem IF( num_sal == 2 ) THEN589 DO jl = 1, jpl590 DO ji = 1, nbpac591 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes592 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl)593 zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif594 END DO595 END DO596 !clem ENDIF597 598 !--------------------------------599 ! Update mass/salt fluxes (clem)600 !--------------------------------601 498 DO jl = 1, jpl 602 499 DO ji = 1, nbpac 603 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes 604 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl) 605 rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb 606 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb 607 END DO 500 zdv = zv_i_1d(ji,jl) - zv_b(ji,jl) 501 zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 502 END DO 608 503 END DO 609 504 610 505 !------------------------------------------------------------------------------! 611 ! 8) Change 2D vectors to 1D vectors506 ! 7) Change 2D vectors to 1D vectors 612 507 !------------------------------------------------------------------------------! 613 508 DO jl = 1, jpl 614 CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_ac (1:nbpac,jl), jpi, jpj ) 615 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 616 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 617 !clem IF ( num_sal == 2 ) & 618 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 509 CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 510 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 511 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj ) 512 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 619 513 DO jk = 1, nlay_i 620 CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 621 END DO 622 END DO 623 CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 624 CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 514 CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj ) 515 END DO 516 END DO 517 CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 518 CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 519 520 CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 521 CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj ) 625 522 ! 626 523 ENDIF ! nbpac > 0 627 524 628 525 !------------------------------------------------------------------------------! 629 ! 9) Change units for e_i526 ! 8) Change units for e_i 630 527 !------------------------------------------------------------------------------! 631 528 DO jl = 1, jpl 632 DO jk = 1, nlay_i ! heat content in 10^9 Joules 633 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i ) / unit_fac 529 DO jk = 1, nlay_i 530 DO jj = 1, jpj 531 DO ji = 1, jpi 532 ! heat content in Joules 533 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac ) 534 END DO 535 END DO 634 536 END DO 635 537 END DO 636 538 637 !------------------------------------------------------------------------------|638 ! 10) Conservation check and changes in each ice category639 !------------------------------------------------------------------------------|640 IF( con_i ) THEN641 CALL lim_column_sum (jpl, v_i, vt_i_final)642 fieldid = 'v_i, limthd_lac'643 CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)644 !645 CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final)646 fieldid = 'e_i, limthd_lac'647 CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid)648 !649 CALL lim_column_sum (jpl, v_s, vt_s_final)650 fieldid = 'v_s, limthd_lac'651 CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)652 !653 ! CALL lim_column_sum (jpl, e_s(:,:,1,:) , et_s_init)654 ! fieldid = 'e_s, limthd_lac'655 ! CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)656 IF( ln_nicep ) THEN657 DO ji = mi0(jiindx), mi1(jiindx)658 DO jj = mj0(jjindx), mj1(jjindx)659 WRITE(numout,*) ' vt_i_init : ', vt_i_init (ji,jj)660 WRITE(numout,*) ' vt_i_final: ', vt_i_final(ji,jj)661 WRITE(numout,*) ' et_i_init : ', et_i_init (ji,jj)662 WRITE(numout,*) ' et_i_final: ', et_i_final(ji,jj)663 END DO664 END DO665 ENDIF666 !667 ENDIF668 539 ! 669 CALL wrk_dealloc( jpij, zcatac) ! integer540 CALL wrk_dealloc( jpij, jcat ) ! integer 670 541 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 671 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 672 CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 673 CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 674 CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 675 CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 542 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 543 CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 544 CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d ) 545 CALL wrk_dealloc( jpi,jpj, zvrel ) 676 546 ! 677 547 END SUBROUTINE lim_thd_lac -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r4624 r4921 53 53 ! 54 54 INTEGER :: ji, jk ! dummy loop indices 55 REAL(wp) :: zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars 56 REAL(wp) :: zaaa, zbbb, zccc, zdiscrim ! local scalars 57 REAL(wp), POINTER, DIMENSION(:) :: ze_init, zhiold, zsiold 55 REAL(wp) :: iflush, igravdr ! local scalars 58 56 !!--------------------------------------------------------------------- 59 57 60 CALL wrk_alloc( jpij, ze_init, zhiold, zsiold ) 61 58 !--------------------------------------------------------- 59 ! 0) Update ice salinity from snow-ice and bottom growth 60 !--------------------------------------------------------- 61 DO ji = kideb, kiut 62 sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 63 END DO 64 62 65 !------------------------------------------------------------------------------| 63 66 ! 1) Constant salinity, constant in time | 64 67 !------------------------------------------------------------------------------| 65 !!gm comment: if num_sal = 1 s_i_new, s_i_ b and sm_i_bcan be set to bulk_sal one for all in the initialisation phase !!68 !!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !! 66 69 !!gm ===>>> simplification of almost all test on num_sal value 67 70 IF( num_sal == 1 ) THEN 68 s_i_ b(kideb:kiut,1:nlay_i) = bulk_sal69 sm_i_ b(kideb:kiut) = bulk_sal71 s_i_1d (kideb:kiut,1:nlay_i) = bulk_sal 72 sm_i_1d(kideb:kiut) = bulk_sal 70 73 s_i_new(kideb:kiut) = bulk_sal 71 74 ENDIF … … 74 77 ! Module 2 : Constant salinity varying in time | 75 78 !------------------------------------------------------------------------------| 76 77 79 IF( num_sal == 2 ) THEN 78 79 !---------------------------------80 ! Thickness at previous time step81 !---------------------------------82 DO ji = kideb, kiut83 zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji)84 zsiold(ji) = sm_i_b(ji)85 END DO86 87 !---------------------88 ! Global heat content89 !---------------------90 ze_init(:) = 0._wp91 DO jk = 1, nlay_i92 DO ji = kideb, kiut93 ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i )94 END DO95 END DO96 80 97 81 DO ji = kideb, kiut … … 99 83 ! Switches 100 84 !---------- 101 iflush = MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt ) ) ! =1 if summer 102 igravdr = MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) ! =1 if t_su < t_bo 103 iaccrbo = MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) ) ) ! =1 if bottom accretion 104 i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 105 isnowic = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch ! =1 if snow ice formation 85 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt ) ) ! =1 if summer 86 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo 106 87 107 88 !--------------------- 108 89 ! Salinity tendencies 109 90 !--------------------- 110 ! !drainage by gravity drainage111 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_ b(ji) - sal_G , 0._wp ) / time_G * rdt_ice112 ! !drainage by flushing113 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_ b(ji) - sal_F , 0._wp ) / time_F * rdt_ice91 ! drainage by gravity drainage 92 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice 93 ! drainage by flushing 94 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice 114 95 115 96 !----------------- … … 118 99 ! only drainage terms ( gravity drainage and flushing ) 119 100 ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 120 sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 121 122 ! if no ice, salinity = 0.1 123 i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 124 sm_i_b(ji) = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 125 126 !---------------------------- 127 ! Heat flux - brine drainage 128 !---------------------------- 129 fhbri_1d(ji) = 0._wp 101 sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 130 102 131 103 !---------------------------- 132 104 ! Salt flux - brine drainage 133 105 !---------------------------- 134 sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) * ( sm_i_b(ji) - zsiold(ji) ) * r1_rdtice106 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 135 107 136 108 END DO … … 138 110 ! Salinity profile 139 111 CALL lim_var_salprof1d( kideb, kiut ) 140 141 142 ! Only necessary for conservation check since salinity is modified143 !--------------------144 ! Temperature update145 !--------------------146 DO jk = 1, nlay_i147 DO ji = kideb, kiut148 ztmelts = -tmut*s_i_b(ji,jk) + rtt149 !Conversion q(S,T) -> T (second order equation)150 zaaa = cpic151 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus152 zccc = lfus * ( ztmelts - rtt )153 zdiscrim = SQRT( MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp ) )154 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa )155 END DO156 END DO157 112 ! 158 113 ENDIF … … 161 116 ! Module 3 : Profile of salinity, constant in time | 162 117 !------------------------------------------------------------------------------| 163 164 118 IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 165 119 166 !167 CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold )168 120 ! 169 121 END SUBROUTINE lim_thd_sal -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r4333 r4921 30 30 USE limvar ! clem for ice thickness correction 31 31 USE timing ! Timing 32 USE limcons ! conservation tests 32 33 33 34 IMPLICIT NONE … … 37 38 38 39 REAL(wp) :: epsi10 = 1.e-10_wp 39 REAL(wp) :: rzero = 0._wp 40 REAL(wp) :: rone = 1._wp 40 REAL(wp) :: epsi20 = 1.e-20_wp 41 41 42 42 !! * Substitution … … 63 63 INTEGER, INTENT(in) :: kt ! number of iteration 64 64 ! 65 INTEGER :: ji, jj, jk, jl, layer! dummy loop indices65 INTEGER :: ji, jj, jk, jl, jn ! dummy loop indices 66 66 INTEGER :: initad ! number of sub-timestep for the advection 67 67 INTEGER :: ierr ! error status 68 68 REAL(wp) :: zindb , zindsn , zindic, zindh, zinda ! local scalar 69 REAL(wp) :: zusvosn, zusvoic, zbigval ! - -70 69 REAL(wp) :: zcfl , zusnit ! - - 71 REAL(wp) :: z e , zsal , zage ! - -70 REAL(wp) :: zsal , zage ! - - 72 71 ! 73 72 REAL(wp), POINTER, DIMENSION(:,:) :: zui_u, zvi_v, zsm, zs0at, zs0ow 74 73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 75 74 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e 76 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)77 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset)78 75 ! mass and salt flux (clem) 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold ! old ice volume... 80 ! correct ice thickness (clem) 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold ! old ice volume... 81 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaiold, zhimax ! old ice concentration and thickness 82 REAL(wp) :: zdv, zda, zvi, zvs, zsmv 78 REAL(wp), POINTER, DIMENSION(:,:) :: zeiold, zesold ! old enthalpies 79 REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 80 ! 81 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 83 82 !!--------------------------------------------------------------------- 84 83 IF( nn_timing == 1 ) CALL timing_start('limtrp') 85 84 86 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )85 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 87 86 CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 88 CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 89 90 CALL wrk_alloc( jpi,jpj,jpl,zviold ) ! clem 91 CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax ) ! clem 92 93 ! ------------------------------- 94 !- check conservation (C Rousset) 95 IF( ln_limdiahsb ) THEN 96 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 97 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 98 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 99 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 100 ENDIF 101 !- check conservation (C Rousset) 102 ! ------------------------------- 87 CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 88 89 CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold ) ! clem 103 90 104 91 IF( numit == nstart .AND. lwp ) THEN … … 115 102 IF( ln_limdyn ) THEN ! Advection of sea ice properties ! 116 103 ! !-------------------------------------! 104 105 ! conservation test 106 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 107 117 108 ! mass and salt flux init (clem) 118 109 zviold(:,:,:) = v_i(:,:,:) 110 zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 111 zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 119 112 120 113 !--- Thickness correction init. (clem) ------------------------------- … … 167 160 ! ENDIF 168 161 !!gm end 169 initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) )162 initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 170 163 zusnit = 1.0 / REAL( initad ) 171 164 IF( zcfl > 0.5 .AND. lwp ) & … … 174 167 175 168 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 176 DO j k= 1,initad177 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area169 DO jn = 1,initad 170 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 178 171 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 179 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), &172 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), & 180 173 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 181 174 DO jl = 1, jpl 182 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---175 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 183 176 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 184 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &177 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 185 178 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 186 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---179 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 187 180 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 188 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &181 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 189 182 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 190 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---183 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 191 184 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 192 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &185 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 193 186 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 194 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---187 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 195 188 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 196 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &189 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 197 190 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 198 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---191 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 199 192 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 200 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), &193 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 201 194 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 202 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---195 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 203 196 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 204 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &197 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 205 198 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 206 DO layer= 1, nlay_i !--- ice heat contents ---207 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &208 & sxxe(:,:, layer,jl), sye (:,:,layer,jl), &209 & syye(:,:, layer,jl), sxye(:,:,layer,jl) )210 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &211 & sxxe(:,:, layer,jl), sye (:,:,layer,jl), &212 & syye(:,:, layer,jl), sxye(:,:,layer,jl) )199 DO jk = 1, nlay_i !--- ice heat contents --- 200 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), & 201 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 202 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 203 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), & 204 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 205 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 213 206 END DO 214 207 END DO 215 208 END DO 216 209 ELSE 217 DO j k= 1, initad218 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area210 DO jn = 1, initad 211 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 219 212 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 220 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), &213 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), & 221 214 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 222 215 DO jl = 1, jpl 223 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---216 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 224 217 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 225 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &218 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 226 219 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 227 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---220 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 228 221 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 229 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &222 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 230 223 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 231 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---224 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 232 225 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 233 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &226 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 234 227 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 235 228 236 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---229 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 237 230 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 238 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &231 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 239 232 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 240 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---233 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 241 234 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 242 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), &235 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 243 236 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 244 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---237 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 245 238 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 246 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &239 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 247 240 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 248 DO layer= 1, nlay_i !--- ice heat contents ---249 CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &250 & sxxe(:,:, layer,jl), sye (:,:,layer,jl), &251 & syye(:,:, layer,jl), sxye(:,:,layer,jl) )252 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &253 & sxxe(:,:, layer,jl), sye (:,:,layer,jl), &254 & syye(:,:, layer,jl), sxye(:,:,layer,jl) )241 DO jk = 1, nlay_i !--- ice heat contents --- 242 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), & 243 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 244 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 245 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), & 246 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 247 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 255 248 END DO 256 249 END DO … … 268 261 zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 269 262 zs0a (:,:,jl) = zs0a (:,:,jl) / area(:,:) 270 zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:) 271 DO jk = 1, nlay_i 272 zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:) 273 END DO 263 ! 274 264 END DO 275 265 … … 289 279 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 290 280 DO ji = 1 , fs_jpim1 ! vector opt. 291 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji ,jj) ) ) ) &292 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)293 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj ) ) ) ) &294 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)281 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji ,jj) ) ) ) & 282 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 283 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj ) ) ) ) & 284 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 295 285 END DO 296 286 END DO … … 305 295 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 306 296 DO ji = 1 , fs_jpim1 ! vector opt. 307 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji ,jj,jl) ) ) ) &308 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)309 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj ,jl) ) ) ) &310 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)297 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji ,jj,jl) ) ) ) & 298 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 299 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj ,jl) ) ) ) & 300 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 311 301 END DO 312 302 END DO … … 334 324 DO jj = 1, jpj 335 325 DO ji = 1, jpi 336 zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) )337 zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) )338 zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) )339 zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) )340 zs0a (ji,jj,jl) = MAX( rzero, zs0a (ji,jj,jl) )341 zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) )326 zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 327 zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 328 zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 329 zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 330 zs0a (ji,jj,jl) = MAX( 0._wp, zs0a (ji,jj,jl) ) 331 zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 342 332 zs0at (ji,jj) = zs0at(ji,jj) + zs0a(ji,jj,jl) 343 333 END DO … … 346 336 347 337 !--------------------------------------------------------- 348 ! 5.2) Snow thickness, Ice thickness, Ice concentrations338 ! 5.2) Update and mask variables 349 339 !--------------------------------------------------------- 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 zindb = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 353 zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 354 ato_i(ji,jj) = zs0ow(ji,jj) 355 END DO 356 END DO 357 358 DO jl = 1, jpl ! Remove very small areas 340 DO jl = 1, jpl 359 341 DO jj = 1, jpj 360 342 DO ji = 1, jpi 361 zvi = zs0ice(ji,jj,jl) 362 zvs = zs0sn(ji,jj,jl) 343 zindb= MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 344 345 zvi = zs0ice(ji,jj,jl) 346 zvs = zs0sn (ji,jj,jl) 347 zes = zs0c0 (ji,jj,jl) 348 zsmv = zs0sm (ji,jj,jl) 363 349 ! 364 zindb = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 365 ! 366 v_s(ji,jj,jl) = zindb * zs0sn (ji,jj,jl) 367 v_i(ji,jj,jl) = zindb * zs0ice(ji,jj,jl) 368 ! 369 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 370 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 371 zindb = MAX( zindsn, zindic ) 372 ! 373 zs0a(ji,jj,jl) = zindb * zs0a(ji,jj,jl) !ice concentration 374 a_i (ji,jj,jl) = zs0a(ji,jj,jl) 375 v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 376 v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 377 ! 378 ! Update mass fluxes (clem) 379 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 380 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 350 ! Remove very small areas 351 v_s(ji,jj,jl) = zindb * zs0sn (ji,jj,jl) 352 v_i(ji,jj,jl) = zindb * zs0ice(ji,jj,jl) 353 a_i(ji,jj,jl) = zindb * zs0a (ji,jj,jl) 354 e_s(ji,jj,1,jl) = zindb * zs0c0 (ji,jj,jl) 355 ! Ice salinity and age 356 IF( num_sal == 2 ) THEN 357 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 358 ENDIF 359 oa_i(ji,jj,jl) = MAX( zindb * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 360 361 ! Update fluxes 362 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 363 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 364 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 365 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 381 366 END DO 382 367 END DO 383 368 END DO 369 370 DO jl = 1, jpl 371 DO jk = 1, nlay_i 372 DO jj = 1, jpj 373 DO ji = 1, jpi 374 zindb = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 375 zei = zs0e(ji,jj,jk,jl) 376 e_i(ji,jj,jk,jl) = zindb * MAX( 0._wp, zs0e(ji,jj,jk,jl) ) 377 ! Update fluxes 378 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 379 END DO !ji 380 END DO ! jj 381 END DO ! jk 382 END DO ! jl 384 383 385 384 !--- Thickness correction in case too high (clem) -------------------------------------------------------- … … 390 389 391 390 IF ( v_i(ji,jj,jl) > 0._wp ) THEN 392 zvi = v_i(ji,jj,jl) 393 zvs = v_s(ji,jj,jl) 394 zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl) 391 zvi = v_i (ji,jj,jl) 392 zvs = v_s (ji,jj,jl) 393 zsmv = smv_i(ji,jj,jl) 394 zes = e_s (ji,jj,1,jl) 395 zei = SUM( e_i(ji,jj,:,jl) ) 396 zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl) 395 397 !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl) 396 398 … … 399 401 & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN 400 402 ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 401 zindh = MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) )402 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi 10 )403 zindh = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 404 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 403 405 ELSE 404 406 ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 405 zindh = MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) )406 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi 10 )407 zindh = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 408 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 407 409 ENDIF 408 410 409 411 ! small correction due to *zindh for a_i 410 v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 411 v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 412 v_i (ji,jj,jl) = zindh * v_i (ji,jj,jl) 413 v_s (ji,jj,jl) = zindh * v_s (ji,jj,jl) 414 smv_i(ji,jj,jl) = zindh * smv_i(ji,jj,jl) 415 e_s(ji,jj,1,jl) = zindh * e_s(ji,jj,1,jl) 416 e_i(ji,jj,:,jl) = zindh * e_i(ji,jj,:,jl) 412 417 413 418 ! Update mass fluxes 414 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 415 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 419 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 420 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 421 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 422 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 423 hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,:,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 416 424 417 425 ENDIF 418 426 419 427 diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 420 421 END DO 422 END DO 423 END DO 424 425 ! --- 428 diag_trp_vs(ji,jj) = diag_trp_vs(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * r1_rdtice 429 430 END DO 431 END DO 432 END DO 433 ! ------------------------------------------------- 434 435 ! --- diags --- 426 436 DO jj = 1, jpj 427 437 DO ji = 1, jpi 428 zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless??429 END DO430 END DO431 432 !---------------------- 433 ! 5.3) Ice properties434 !----------------------435 436 zbigval = 1.e+13437 438 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 439 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 440 END DO 441 END DO 442 443 ! --- agglomerate variables (clem) ----------------- 444 vt_i (:,:) = 0._wp 445 vt_s (:,:) = 0._wp 446 at_i (:,:) = 0._wp 447 ! 438 448 DO jl = 1, jpl 439 449 DO jj = 1, jpj 440 450 DO ji = 1, jpi 441 zsmv = zs0sm(ji,jj,jl) 442 443 ! Switches and dummy variables 444 zusvosn = 1.0/MAX( v_s(ji,jj,jl) , epsi10 ) 445 zusvoic = 1.0/MAX( v_i(ji,jj,jl) , epsi10 ) 446 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 447 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 448 zindb = MAX( zindsn, zindic ) 449 450 ! Ice salinity and age 451 !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 452 IF( num_sal == 2 ) THEN 453 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 454 ENDIF 455 456 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) ), 0._wp ) * a_i(ji,jj,jl) 457 oa_i (ji,jj,jl) = zindic * zage 458 459 ! Snow heat content 460 ze = MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 461 e_s(ji,jj,1,jl) = zindsn * ze 462 463 ! Update salt fluxes (clem) 464 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 465 END DO !ji 466 END DO !jj 467 END DO ! jl 468 469 DO jl = 1, jpl 470 DO jk = 1, nlay_i 471 DO jj = 1, jpj 472 DO ji = 1, jpi 473 ! Ice heat content 474 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 475 ze = MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 476 e_i(ji,jj,jk,jl) = zindic * ze 477 END DO !ji 478 END DO ! jj 479 END DO ! jk 480 END DO ! jl 481 482 483 ! --- agglomerate variables (clem) ----------------- 484 vt_i (:,:) = 0._wp 485 vt_s (:,:) = 0._wp 486 at_i (:,:) = 0._wp 487 ! 488 DO jl = 1, jpl 451 ! 452 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 453 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 454 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 455 END DO 456 END DO 457 END DO 458 ! ------------------------------------------------- 459 460 ! open water 489 461 DO jj = 1, jpj 490 462 DO ji = 1, jpi 491 ! 492 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 493 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 494 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 495 ! 496 zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi10 ) ) 497 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda ! ice thickness 498 END DO 499 END DO 500 END DO 501 ! ------------------------------------------------- 502 503 463 ! open water = 1 if at_i=0 464 zindb = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 465 ato_i(ji,jj) = zindb + (1._wp - zindb ) * zs0ow(ji,jj) 466 END DO 467 END DO 468 469 ! conservation test 470 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 504 471 505 472 ENDIF … … 536 503 END DO 537 504 ENDIF 538 ! -------------------------------539 !- check conservation (C Rousset)540 IF( ln_limdiahsb ) THEN541 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b542 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b543 544 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice545 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic )546 547 zchk_vmin = glob_min(v_i)548 zchk_amax = glob_max(SUM(a_i,dim=3))549 zchk_amin = glob_min(a_i)550 zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2))551 552 IF(lwp) THEN553 IF ( ABS( zchk_v_i ) > 1.e-5 ) THEN554 WRITE(numout,*) 'violation volume [m3/day] (limtrp) = ',(zchk_v_i * rday)555 WRITE(numout,*) 'u_ice max [m/s] (limtrp) = ',zchk_umax556 WRITE(numout,*) 'number of time steps (limtrp) =',kt557 ENDIF558 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday)559 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limtrp) = ',(zchk_vmin * 1.e-3)560 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limtrp) = ',zchk_amin561 ENDIF562 ENDIF563 !- check conservation (C Rousset)564 ! -------------------------------565 505 ! 566 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )506 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 567 507 CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 568 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e )569 570 CALL wrk_dealloc( jpi, jpj,jpl,zaiold, zhimax ) ! clem508 CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 509 510 CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax ) ! clem 571 511 ! 572 512 IF( nn_timing == 1 ) CALL timing_stop('limtrp') -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r4333 r4921 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3.6 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 32 33 USE par_ice 33 34 USE limitd_th 35 USE limitd_me 34 36 USE limvar 35 37 USE prtctl ! Print control … … 37 39 USE wrk_nemo ! work arrays 38 40 USE lib_fortran ! glob_sum 39 ! Check budget (Rousset)40 41 USE in_out_manager ! I/O manager 41 42 USE iom ! I/O manager 42 43 USE lib_mpp ! MPP library 43 44 USE timing ! Timing 45 USE limcons ! conservation tests 44 46 45 47 IMPLICIT NONE … … 49 51 50 52 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 51 REAL(wp) :: rzero = 0._wp ! - -52 REAL(wp) :: rone = 1._wp ! - -53 53 54 54 !! * Substitutions … … 66 66 !! 67 67 !! ** Purpose : Computes update of sea-ice global variables at 68 !! the end of the time step. 69 !! Address pathological cases 70 !! This place is very important 68 !! the end of the dynamics. 71 69 !! 72 !! ** Method :73 !! Ice speed from ice dynamics74 !! Ice thickness, Snow thickness, Temperatures, Lead fraction75 !! from advection and ice thermodynamics76 !!77 !! ** Action : -78 70 !!--------------------------------------------------------------------- 79 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 80 INTEGER :: jbnd1, jbnd2 81 INTEGER :: i_ice_switch 82 INTEGER :: ind_im, layer ! indices for internal melt 83 REAL(wp) :: zweight, zesum, z_da_i, zhimax 84 REAL(wp) :: zinda, zindb, zindsn, zindic 85 REAL(wp) :: zindg, zh, zdvres, zviold2 86 REAL(wp) :: zbigvalue, zvsold2, z_da_ex 87 REAL(wp) :: z_prescr_hi, zat_i_old, ztmelts, ze_s 88 89 REAL(wp), POINTER, DIMENSION(:) :: zthick0, zqm0 ! thickness of the layers and heat contents for 90 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 91 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 92 ! mass and salt flux (clem) 93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 71 INTEGER :: ji, jj, jk, jl ! dummy loop indices 72 INTEGER :: i_ice_switch 73 REAL(wp) :: zsal 74 ! 75 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 94 76 !!------------------------------------------------------------------- 95 77 IF( nn_timing == 1 ) CALL timing_start('limupdate1') 96 78 97 CALL wrk_alloc( jkmax, zthick0, zqm0 ) 98 99 CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem 100 101 !------------------------------------------------------------------------------ 102 ! 1. Update of Global variables | 103 !------------------------------------------------------------------------------ 104 105 !----------------- 106 ! Trend terms 107 !----------------- 108 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:) 109 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:) 110 d_a_i_trp (:,:,:) = a_i (:,:,:) - old_a_i (:,:,:) 111 d_v_s_trp (:,:,:) = v_s (:,:,:) - old_v_s (:,:,:) 112 d_v_i_trp (:,:,:) = v_i (:,:,:) - old_v_i (:,:,:) 113 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - old_e_s (:,:,:,:) 114 d_e_i_trp (:,:,:,:) = e_i (:,:,:,:) - old_e_i (:,:,:,:) 115 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 116 d_smv_i_trp(:,:,:) = 0._wp 117 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 118 119 ! mass and salt flux init (clem) 120 zviold(:,:,:) = v_i(:,:,:) 121 zvsold(:,:,:) = v_s(:,:,:) 122 zsmvold(:,:,:) = smv_i(:,:,:) 123 124 ! ------------------------------- 125 !- check conservation (C Rousset) 126 IF (ln_limdiahsb) THEN 127 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 128 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 129 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 130 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 131 ENDIF 132 !- check conservation (C Rousset) 133 ! ------------------------------- 79 IF( ln_limdyn ) THEN 80 81 ! conservation test 82 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 83 84 !----------------- 85 ! zap small values 86 !----------------- 87 CALL lim_itd_me_zapsmall 134 88 135 89 CALL lim_var_glo2eqv 136 137 !--------------------------------------138 ! 2. Review of all pathological cases139 !--------------------------------------140 141 ! clem: useless now142 !-------------------------------------------143 ! 2.1) Advection of ice in an ice-free cell144 !-------------------------------------------145 ! should be removed since it is treated after dynamics now146 ! zhimax = 5._wp147 ! ! first category148 ! DO jj = 1, jpj149 ! DO ji = 1, jpi150 ! !--- the thickness of such an ice is often out of bounds151 ! !--- thus we recompute a new area while conserving ice volume152 ! zat_i_old = SUM( old_a_i(ji,jj,:) )153 ! zindb = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_trp(ji,jj,1) ) - epsi10 ) )154 ! IF( ( ABS( d_v_i_trp(ji,jj,1) ) / MAX( ABS( d_a_i_trp(ji,jj,1) ), epsi10 ) * zindb .GT. zhimax ) &155 ! & .AND.( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) &156 ! & .AND.( zat_i_old .LT. 1.e-6 ) ) THEN ! new line157 ! ht_i(ji,jj,1) = hi_max(1) * 0.5_wp158 ! a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1)159 ! ENDIF160 ! END DO161 ! END DO162 !163 ! zhimax = 20._wp164 ! ! other categories165 ! DO jl = 2, jpl166 ! jm = ice_types(jl)167 ! DO jj = 1, jpj168 ! DO ji = 1, jpi169 ! zindb = MAX( rzero, SIGN( rone, ABS( d_a_i_trp(ji,jj,jl) ) - epsi10 ) )170 ! ! this correction is very tricky... sometimes, advection gets wrong i don't know why171 ! ! it makes problems when the advected volume and concentration do not seem to be172 ! ! related with each other173 ! ! the new thickness is sometimes very big!174 ! ! and sometimes d_a_i_trp and d_v_i_trp have different sign175 ! ! which of course is plausible176 ! ! but fuck! it fucks everything up :)177 ! IF ( ( ABS( d_v_i_trp(ji,jj,jl) ) / MAX( ABS( d_a_i_trp(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) &178 ! & .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN179 ! ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp180 ! a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl)181 ! ENDIF182 ! END DO ! ji183 ! END DO !jj184 ! END DO !jl185 90 91 !---------------------------------------------------- 92 ! Rebin categories with thickness out of bounds 93 !---------------------------------------------------- 94 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 95 186 96 at_i(:,:) = 0._wp 187 97 DO jl = 1, jpl … … 190 100 191 101 !---------------------------------------------------- 192 ! 2.2) Rebin categories with thickness out of bounds 193 !---------------------------------------------------- 194 DO jm = 1, jpm 195 jbnd1 = ice_cat_bounds(jm,1) 196 jbnd2 = ice_cat_bounds(jm,2) 197 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 102 ! ice concentration should not exceed amax 103 !----------------------------------------------------- 104 DO jl = 1, jpl 105 DO jj = 1, jpj 106 DO ji = 1, jpi 107 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 108 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 109 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 110 ENDIF 111 END DO 112 END DO 198 113 END DO 199 114 … … 202 117 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 203 118 END DO 204 205 zbigvalue = 1.0e+20 206 207 DO jl = 1, jpl 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 211 !switches 212 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 213 !switch = 1 if a_i > 1e-06 and 0 if not 214 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 215 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 216 ! bug fix 25 avril 2007 217 zindb = zindb*zindic 218 219 !--- 2.3 Correction to ice age 220 !------------------------------ 221 ! IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 222 ! o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 223 ! ENDIF 224 IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 225 oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 226 ENDIF 227 oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 228 229 !--- 2.4 Correction to snow thickness 230 !------------------------------------- 231 ! ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 232 ! v_s(ji,jj,jl) = MAX( zindb * v_s(ji,jj,jl), 0.0) 233 ! snow thickness cannot be smaller than 1e-6 234 zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 235 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 236 237 !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 238 239 !--- 2.5 Correction to ice thickness 240 !------------------------------------- 241 zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 242 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 243 244 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 245 !sfx_res(ji,jj) = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 246 247 !--- 2.6 Snow is transformed into ice if the original ice cover disappears 248 !---------------------------------------------------------------------------- 249 zindg = tms(ji,jj) * MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 250 zdvres = zindg * rhosn * v_s(ji,jj,jl) / rau0 251 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 252 253 zdvres = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 254 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 255 256 !--- 2.7 Correction to ice concentrations 257 !-------------------------------------------- 258 ! if greater than 0, ice concentration cannot be smaller than 1e-10 259 a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 260 261 !------------------------- 262 ! 2.8) Snow heat content 263 !------------------------- 264 e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0._wp, e_s(ji,jj,1,jl) ), zbigvalue ) ) 265 266 END DO ! ji 267 END DO ! jj 268 END DO ! jl 269 270 !------------------------ 271 ! 2.9) Ice heat content 272 !------------------------ 273 274 DO jl = 1, jpl 275 DO jk = 1, nlay_i 119 120 ! -------------------------------------- 121 ! Final thickness distribution rebinning 122 ! -------------------------------------- 123 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 124 125 !----------------- 126 ! zap small values 127 !----------------- 128 CALL lim_itd_me_zapsmall 129 130 !--------------------- 131 ! Ice salinity bounds 132 !--------------------- 133 IF ( num_sal == 2 ) THEN 134 DO jl = 1, jpl 276 135 DO jj = 1, jpj 277 136 DO ji = 1, jpi 278 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 279 e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 280 END DO ! ji 281 END DO ! jj 282 END DO !jk 283 END DO !jl 284 285 at_i(:,:) = 0._wp 286 DO jl = 1, jpl 287 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 288 END DO 289 290 !--- 2.13 ice concentration should not exceed amax 291 ! (it should not be the case) 292 !----------------------------------------------------- 293 DO jj = 1, jpj 294 DO ji = 1, jpi 295 z_da_ex = MAX( at_i(ji,jj) - amax , 0.0 ) 296 zindb = MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) ) 297 DO jl = 1, jpl 298 z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 299 a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 300 ! 301 zinda = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 302 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 303 !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 137 zsal = smv_i(ji,jj,jl) 138 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 139 ! salinity stays in bounds 140 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 141 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 142 ! associated salt flux 143 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 144 END DO 304 145 END DO 305 146 END DO 306 END DO307 at_i(:,:) = a_i(:,:,1)308 DO jl = 2, jpl309 at_i(:,:) = a_i(:,:,jl) + at_i(:,:)310 END DO311 312 313 ! Final thickness distribution rebinning314 ! --------------------------------------315 DO jm = 1, jpm316 jbnd1 = ice_cat_bounds(jm,1)317 jbnd2 = ice_cat_bounds(jm,2)318 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm)319 IF (ice_ncat_types(jm) .EQ. 1 ) THEN320 ENDIF321 END DO322 323 324 !---------------------325 ! 2.11) Ice salinity326 !---------------------327 ! clem correct bug on smv_i328 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)329 330 IF ( num_sal == 2 ) THEN ! general case331 DO jl = 1, jpl332 !DO jk = 1, nlay_i333 DO jj = 1, jpj334 DO ji = 1, jpi335 ! salinity stays in bounds336 !clem smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) )337 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )338 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) )339 smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)340 END DO ! ji341 END DO ! jj342 !END DO !jk343 END DO !jl344 147 ENDIF 345 148 346 at_i(:,:) = a_i(:,:,1) 347 DO jl = 2, jpl 348 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 349 END DO 350 351 352 !-------------------------------- 353 ! Update mass/salt fluxes (clem) 354 !-------------------------------- 355 DO jl = 1, jpl 356 DO jj = 1, jpj 357 DO ji = 1, jpi 358 diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice 359 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic 360 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn 361 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice 362 END DO 363 END DO 364 END DO 365 366 ! ------------------------------- 367 !- check conservation (C Rousset) 368 IF (ln_limdiahsb) THEN 369 370 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 371 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 372 373 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 374 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 375 376 zchk_vmin = glob_min(v_i) 377 zchk_amax = glob_max(SUM(a_i,dim=3)) 378 zchk_amin = glob_min(a_i) 379 380 IF(lwp) THEN 381 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limupdate1) = ',(zchk_v_i * rday) 382 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate1) = ',(zchk_smv * rday) 383 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limupdate1) = ',(zchk_vmin * 1.e-3) 384 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limupdate1) = ',zchk_amax 385 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limupdate1) = ',zchk_amin 386 ENDIF 387 ENDIF 388 !- check conservation (C Rousset) 389 ! ------------------------------- 149 ! ------------------------------------------------- 150 ! Diagnostics 151 ! ------------------------------------------------- 152 d_u_ice_dyn(:,:) = u_ice(:,:) - u_ice_b(:,:) 153 d_v_ice_dyn(:,:) = v_ice(:,:) - v_ice_b(:,:) 154 d_a_i_trp (:,:,:) = a_i (:,:,:) - a_i_b (:,:,:) 155 d_v_s_trp (:,:,:) = v_s (:,:,:) - v_s_b (:,:,:) 156 d_v_i_trp (:,:,:) = v_i (:,:,:) - v_i_b (:,:,:) 157 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - e_s_b (:,:,:,:) 158 d_e_i_trp (:,:,1:nlay_i,:) = e_i (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 159 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:) 160 d_smv_i_trp(:,:,:) = 0._wp 161 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 162 163 ! conservation test 164 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 390 165 391 166 IF(ln_ctl) THEN ! Control print … … 400 175 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update1 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 401 176 CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1 : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :') 402 CALL prt_ctl(tab2d_1= old_u_ice , clinfo1=' lim_update1 : old_u_ice :', tab2d_2=old_v_ice , clinfo2=' old_v_ice:')177 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update1 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 403 178 404 179 DO jl = 1, jpl … … 413 188 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' lim_update1 : o_i : ') 414 189 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update1 : a_i : ') 415 CALL prt_ctl(tab2d_1= old_a_i (:,:,jl) , clinfo1= ' lim_update1 : old_a_i: ')190 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update1 : a_i_b : ') 416 191 CALL prt_ctl(tab2d_1=d_a_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_a_i_trp : ') 417 192 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update1 : v_i : ') 418 CALL prt_ctl(tab2d_1= old_v_i (:,:,jl) , clinfo1= ' lim_update1 : old_v_i: ')193 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update1 : v_i_b : ') 419 194 CALL prt_ctl(tab2d_1=d_v_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_i_trp : ') 420 195 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update1 : v_s : ') 421 CALL prt_ctl(tab2d_1= old_v_s (:,:,jl) , clinfo1= ' lim_update1 : old_v_s: ')196 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update1 : v_s_b : ') 422 197 CALL prt_ctl(tab2d_1=d_v_s_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_s_trp : ') 423 198 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1 : ') 424 CALL prt_ctl(tab2d_1= old_e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : old_e_i1: ')199 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1_b : ') 425 200 CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : de_i1_trp : ') 426 201 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2 : ') 427 CALL prt_ctl(tab2d_1= old_e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : old_e_i2: ')202 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2_b : ') 428 203 CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : de_i2_trp : ') 429 204 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow : ') 430 CALL prt_ctl(tab2d_1= old_e_s (:,:,1,jl) , clinfo1= ' lim_update1 : old_e_snow: ')205 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow_b : ') 431 206 CALL prt_ctl(tab2d_1=d_e_s_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : d_e_s_trp : ') 432 207 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update1 : smv_i : ') 433 CALL prt_ctl(tab2d_1= old_smv_i (:,:,jl) , clinfo1= ' lim_update1 : old_smv_i: ')208 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update1 : smv_i_b : ') 434 209 CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl) , clinfo1= ' lim_update1 : d_smv_i_trp : ') 435 210 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update1 : oa_i : ') 436 CALL prt_ctl(tab2d_1=o ld_oa_i (:,:,jl) , clinfo1= ' lim_update1 : old_oa_i: ')211 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update1 : oa_i_b : ') 437 212 CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_oa_i_trp : ') 438 213 … … 446 221 CALL prt_ctl_info(' - Heat / FW fluxes : ') 447 222 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 448 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update1 : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ')449 223 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update1 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 450 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update1 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ')451 224 452 225 CALL prt_ctl_info(' ') … … 458 231 ENDIF 459 232 460 461 CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 462 463 CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem 233 ENDIF ! ln_limdyn 464 234 465 235 IF( nn_timing == 1 ) CALL timing_stop('limupdate1') -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r4333 r4921 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3.6 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 39 40 USE lib_fortran ! glob_sum 40 41 USE timing ! Timing 42 USE limcons ! conservation tests 41 43 42 44 IMPLICIT NONE … … 45 47 PUBLIC lim_update2 ! routine called by ice_step 46 48 47 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 48 REAL(wp) :: rzero = 0._wp ! - - 49 REAL(wp) :: rone = 1._wp ! - - 50 49 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 50 REAL(wp) :: epsi20 = 1.e-20_wp 51 51 52 !! * Substitutions 52 53 # include "vectopt_loop_substitute.h90" … … 64 65 !! ** Purpose : Computes update of sea-ice global variables at 65 66 !! the end of the time step. 66 !! Address pathological cases67 !! This place is very important68 !!69 !! ** Method :70 !! Ice speed from ice dynamics71 !! Ice thickness, Snow thickness, Temperatures, Lead fraction72 !! from advection and ice thermodynamics73 67 !! 74 !! ** Action : -75 68 !!--------------------------------------------------------------------- 76 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 77 INTEGER :: jbnd1, jbnd2 78 INTEGER :: i_ice_switch 79 INTEGER :: ind_im, layer ! indices for internal melt 80 REAL(wp) :: zweight, zesum, zhimax, z_da_i 81 REAL(wp) :: zinda, zindb, zindsn, zindic 82 REAL(wp) :: zindg, zh, zdvres, zviold2 83 REAL(wp) :: zbigvalue, zvsold2, z_da_ex 84 REAL(wp) :: z_prescr_hi, zat_i_old, ztmelts, ze_s 85 86 INTEGER , POINTER, DIMENSION(:,:,:) :: internal_melt 87 REAL(wp), POINTER, DIMENSION(:) :: zthick0, zqm0 ! thickness of the layers and heat contents for 88 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 89 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 90 ! mass and salt flux (clem) 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 69 INTEGER :: ji, jj, jk, jl ! dummy loop indices 70 INTEGER :: i_ice_switch 71 REAL(wp) :: zh, zsal 72 ! 73 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 92 74 !!------------------------------------------------------------------- 93 75 IF( nn_timing == 1 ) CALL timing_start('limupdate2') 94 76 95 CALL wrk_alloc( jpi,jpj,jpl, internal_melt ) ! integer 96 CALL wrk_alloc( jkmax, zthick0, zqm0 ) 97 98 CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem 99 100 !---------------------------------------------------------------------------------------- 101 ! 1. Computation of trend terms 102 !---------------------------------------------------------------------------------------- 103 !- Trend terms 104 d_a_i_thd(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:) 105 d_v_s_thd(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:) 106 d_v_i_thd(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:) 107 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 108 d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 109 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 110 d_smv_i_thd(:,:,:) = 0._wp 111 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 112 ! diag only (clem) 113 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 114 115 ! mass and salt flux init (clem) 116 zviold(:,:,:) = v_i(:,:,:) 117 zvsold(:,:,:) = v_s(:,:,:) 118 zsmvold(:,:,:) = smv_i(:,:,:) 119 120 ! ------------------------------- 121 !- check conservation (C Rousset) 122 IF (ln_limdiahsb) THEN 123 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 124 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 125 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 126 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 127 ENDIF 128 !- check conservation (C Rousset) 129 ! ------------------------------- 77 ! conservation test 78 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 79 80 !----------------- 81 ! zap small values 82 !----------------- 83 CALL lim_itd_me_zapsmall 130 84 131 85 CALL lim_var_glo2eqv 132 86 133 !-------------------------------------- 134 ! 2. Review of all pathological cases 135 !-------------------------------------- 136 137 ! clem: useless now 138 !------------------------------------------- 139 ! 2.1) Advection of ice in an ice-free cell 140 !------------------------------------------- 141 ! should be removed since it is treated after dynamics now 142 ! zhimax = 5._wp 143 ! ! first category 144 ! DO jj = 1, jpj 145 ! DO ji = 1, jpi 146 ! !--- the thickness of such an ice is often out of bounds 147 ! !--- thus we recompute a new area while conserving ice volume 148 ! zat_i_old = SUM( old_a_i(ji,jj,:) ) 149 ! zindb = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_thd(ji,jj,1) ) - epsi10 ) ) 150 ! IF ( ( ABS( d_v_i_thd(ji,jj,1) ) / MAX( ABS( d_a_i_thd(ji,jj,1) ),epsi10 ) * zindb .GT. zhimax ) & 151 ! & .AND. ( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 152 ! & .AND. ( zat_i_old .LT. 1.e-6 ) ) THEN ! new line 153 ! ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 154 ! a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 155 ! ENDIF 156 ! END DO 157 ! END DO 158 159 ! zhimax = 20._wp 160 ! ! other categories 161 ! DO jl = 2, jpl 162 ! jm = ice_types(jl) 163 ! DO jj = 1, jpj 164 ! DO ji = 1, jpi 165 ! zindb = MAX( rzero, SIGN( rone, ABS( d_a_i_thd(ji,jj,jl)) - epsi10 ) ) 166 ! ! this correction is very tricky... sometimes, advection gets wrong i don't know why 167 ! ! it makes problems when the advected volume and concentration do not seem to be 168 ! ! related with each other 169 ! ! the new thickness is sometimes very big! 170 ! ! and sometimes d_a_i_trp and d_v_i_trp have different sign 171 ! ! which of course is plausible 172 ! ! but fuck! it fucks everything up :) 173 ! IF ( ( ABS( d_v_i_thd(ji,jj,jl) ) / MAX( ABS( d_a_i_thd(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 174 ! & .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 175 ! ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 176 ! a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 177 ! ENDIF 178 ! END DO ! ji 179 ! END DO !jj 180 ! END DO !jl 181 87 !---------------------------------------------------- 88 ! Rebin categories with thickness out of bounds 89 !---------------------------------------------------- 90 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 91 92 !---------------------------------------------------------------------- 93 ! Constrain the thickness of the smallest category above hiclim 94 !---------------------------------------------------------------------- 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN 98 zh = hiclim / ht_i(ji,jj,1) 99 ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh 100 ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh 101 a_i (ji,jj,1) = a_i(ji,jj,1) / zh 102 ENDIF 103 END DO 104 END DO 105 106 !----------------------------------------------------- 107 ! ice concentration should not exceed amax 108 !----------------------------------------------------- 182 109 at_i(:,:) = 0._wp 183 110 DO jl = 1, jpl … … 185 112 END DO 186 113 187 !---------------------------------------------------- 188 ! 2.2) Rebin categories with thickness out of bounds 189 !---------------------------------------------------- 190 DO jm = 1, jpm 191 jbnd1 = ice_cat_bounds(jm,1) 192 jbnd2 = ice_cat_bounds(jm,2) 193 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 194 END DO 195 196 !--------------------------------- 197 ! 2.3) Melt of an internal layer 198 !--------------------------------- 199 internal_melt(:,:,:) = 0 200 201 DO jl = 1, jpl 202 DO jk = 1, nlay_i 203 DO jj = 1, jpj 204 DO ji = 1, jpi 205 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 206 IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 207 & .AND. ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 208 internal_melt(ji,jj,jl) = 1 209 ENDIF 210 END DO ! ji 211 END DO ! jj 212 END DO !jk 213 END DO !jl 214 215 DO jl = 1, jpl 216 DO jj = 1, jpj 114 DO jl = 1, jpl 115 DO jj = 1, jpj 217 116 DO ji = 1, jpi 218 IF( internal_melt(ji,jj,jl) == 1 ) THEN 219 ! initial ice thickness 220 !----------------------- 117 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 118 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 221 119 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 222 223 ! reduce ice thickness 224 !----------------------- 225 ind_im = 0 226 zesum = 0.0 227 DO jk = 1, nlay_i 228 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 229 IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) ind_im = ind_im + 1 230 zesum = zesum + e_i(ji,jj,jk,jl) 231 END DO 232 ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) 233 v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 234 235 !CLEM 236 zdvres = REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) * a_i(ji,jj,jl) 237 !rdm_ice(ji,jj) = rdm_ice(ji,jj) - zdvres * rhoic 238 !sfx_res(ji,jj) = sfx_res(ji,jj) + sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 239 240 ! redistribute heat 241 !----------------------- 242 ! old thicknesses and enthalpies 243 ind_im = 0 244 DO jk = 1, nlay_i 245 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 246 IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND. & 247 ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 248 ind_im = ind_im + 1 249 zthick0(ind_im) = ht_i(ji,jj,jl) * REAL(ind_im / nlay_i) 250 zqm0 (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 251 ENDIF 252 END DO 253 254 ! Redistributing energy on the new grid 255 IF ( ind_im .GT. 0 ) THEN 256 257 DO jk = 1, nlay_i 258 e_i(ji,jj,jk,jl) = 0.0 259 DO layer = 1, ind_im 260 zweight = MAX ( & 261 MIN( ht_i(ji,jj,jl) * REAL(layer/ind_im) , ht_i(ji,jj,jl) * REAL(jk / nlay_i) ) - & 262 MAX( ht_i(ji,jj,jl) * REAL((layer-1)/ind_im) , ht_i(ji,jj,jl) * REAL((jk-1) / nlay_i) ) , 0.0 ) & 263 / ( ht_i(ji,jj,jl) / REAL(ind_im) ) 264 265 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 266 END DO !layer 267 END DO ! jk 268 269 zesum = 0.0 270 DO jk = 1, nlay_i 271 zesum = zesum + e_i(ji,jj,jk,jl) 272 END DO 273 274 ELSE ! ind_im .EQ. 0, total melt 275 e_i(ji,jj,jk,jl) = 0.0 276 ENDIF 277 278 ENDIF ! internal_melt 279 280 END DO ! ji 281 END DO !jj 282 END DO !jl 283 284 internal_melt(:,:,:) = 0 285 286 287 ! Melt of snow 288 !-------------- 289 DO jl = 1, jpl 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 ! snow energy of melting 293 zinda = MAX( 0._wp, SIGN( 1._wp, v_s(ji,jj,jl) - epsi10 ) ) 294 ze_s = zinda * e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) / MAX( v_s(ji,jj,jl), epsi10 ) ! snow energy of melting 295 296 ! If snow energy of melting smaller then Lf 297 ! Then all snow melts and meltwater, heat go to the ocean 298 IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 299 120 ENDIF 300 121 END DO 301 122 END DO 302 123 END DO 303 304 DO jl = 1, jpl305 DO jj = 1, jpj306 DO ji = 1, jpi307 IF ( internal_melt(ji,jj,jl) == 1 ) THEN308 zdvres = v_s(ji,jj,jl)309 ! release heat310 fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * zdvres / rdt_ice311 ! release mass312 !rdm_snw(ji,jj) = rdm_snw(ji,jj) - zdvres * rhosn313 !314 v_s(ji,jj,jl) = 0.0315 e_s(ji,jj,1,jl) = 0.0316 ENDIF317 END DO318 END DO319 END DO320 321 zbigvalue = 1.0e+20322 DO jl = 1, jpl323 DO jj = 1, jpj324 DO ji = 1, jpi325 326 !switches327 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )328 !switch = 1 if a_i > 1e-06 and 0 if not329 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not330 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not331 ! bug fix 25 avril 2007332 zindb = zindb*zindic333 334 !--- 2.3 Correction to ice age335 !------------------------------336 ! IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN337 ! o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday338 ! ENDIF339 IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN340 oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl)341 ENDIF342 oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl)343 344 !--- 2.4 Correction to snow thickness345 !-------------------------------------346 zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl)347 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres348 349 !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn350 351 !--- 2.5 Correction to ice thickness352 !-------------------------------------353 zdvres = (zindb - 1._wp) * v_i(ji,jj,jl)354 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres355 356 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic357 !sfx_res(ji,jj) = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice )358 359 !--- 2.6 Snow is transformed into ice if the original ice cover disappears360 !----------------------------------------------------------------------------361 zindg = tms(ji,jj) * MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) )362 zdvres = zindg * rhosn * v_s(ji,jj,jl) / rau0363 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres364 365 zdvres = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn )366 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres367 368 !--- 2.7 Correction to ice concentrations369 !--------------------------------------------370 a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl)371 372 !-------------------------373 ! 2.8) Snow heat content374 !-------------------------375 e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) )376 377 END DO ! ji378 END DO ! jj379 END DO ! jl380 381 !------------------------382 ! 2.9) Ice heat content383 !------------------------384 385 DO jl = 1, jpl386 DO jk = 1, nlay_i387 DO jj = 1, jpj388 DO ji = 1, jpi389 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )390 e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) )391 END DO ! ji392 END DO ! jj393 END DO !jk394 END DO !jl395 396 397 DO jm = 1, jpm398 DO jj = 1, jpj399 DO ji = 1, jpi400 jl = ice_cat_bounds(jm,1)401 !--- 2.12 Constrain the thickness of the smallest category above 5 cm402 !----------------------------------------------------------------------403 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )404 ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi10)405 zh = MAX( rone , zindb * hiclim / MAX( ht_i(ji,jj,jl) , epsi10 ) )406 ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh407 ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh408 a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh409 !CLEM410 v_i (ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl)411 v_s (ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl)412 END DO !ji413 END DO !jj414 END DO !jm415 124 416 125 at_i(:,:) = 0.0 … … 418 127 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 419 128 END DO 420 421 !--- 2.13 ice concentration should not exceed amax 422 ! (it should not be the case) 423 !----------------------------------------------------- 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 z_da_ex = MAX( at_i(ji,jj) - amax , 0.0 ) 427 zindb = MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) ) 428 DO jl = 1, jpl 429 z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 430 a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 431 ! 432 zinda = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 433 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 434 !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 435 END DO 436 END DO 437 END DO 438 at_i(:,:) = 0.0 439 DO jl = 1, jpl 440 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 441 END DO 442 129 130 ! -------------------------------------- 443 131 ! Final thickness distribution rebinning 444 132 ! -------------------------------------- 445 DO jm = 1, jpm 446 jbnd1 = ice_cat_bounds(jm,1) 447 jbnd2 = ice_cat_bounds(jm,2) 448 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 449 IF (ice_ncat_types(jm) .EQ. 1 ) THEN 450 ENDIF 451 END DO 133 IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 134 135 !----------------- 136 ! zap small values 137 !----------------- 138 CALL lim_itd_me_zapsmall 452 139 453 140 !--------------------- 454 141 ! 2.11) Ice salinity 455 142 !--------------------- 456 ! clem correct bug on smv_i 457 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 458 459 IF ( num_sal == 2 ) THEN ! general case 143 IF ( num_sal == 2 ) THEN 460 144 DO jl = 1, jpl 461 !DO jk = 1, nlay_i462 DO j j = 1, jpj463 DO ji = 1, jpi464 ! salinity stays in bounds465 !clem smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) )466 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )467 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ))468 smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)469 END DO ! ji470 END DO ! j j471 !END DO !jk145 DO jj = 1, jpj 146 DO ji = 1, jpi 147 zsal = smv_i(ji,jj,jl) 148 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 149 ! salinity stays in bounds 150 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 151 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 152 ! associated salt flux 153 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 154 END DO ! ji 155 END DO ! jj 472 156 END DO !jl 473 157 ENDIF 474 475 ! -------------------476 at_i(:,:) = a_i(:,:,1)477 DO jl = 2, jpl478 at_i(:,:) = a_i(:,:,jl) + at_i(:,:)479 END DO480 158 481 159 !------------------------------------------------------------------------------ … … 486 164 DO jj = 2, jpjm1 487 165 DO ji = 2, jpim1 488 IF ( at_i(ji,jj) .EQ. 0.0) THEN ! what to do if there is no ice489 IF ( at_i(ji+1,jj) .EQ. 0.0 ) u_ice(ji,jj) = 0.0! right side490 IF ( at_i(ji-1,jj) .EQ. 0.0 ) u_ice(ji-1,jj) = 0.0! left side491 IF ( at_i(ji,jj+1) .EQ. 0.0 ) v_ice(ji,jj) = 0.0! upper side492 IF ( at_i(ji,jj-1) .EQ. 0.0 ) v_ice(ji,jj-1) = 0.0! bottom side166 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 167 IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj) = 0._wp ! right side 168 IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 169 IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj) = 0._wp ! upper side 170 IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 493 171 ENDIF 494 172 END DO … … 501 179 v_ice(:,:) = v_ice(:,:) * tmv(:,:) 502 180 503 !-------------------------------- 504 ! Update mass/salt fluxes (clem) 505 !-------------------------------- 506 DO jl = 1, jpl 507 DO jj = 1, jpj 508 DO ji = 1, jpi 509 diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice 510 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic 511 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn 512 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice 513 END DO 514 END DO 515 END DO 516 517 ! ------------------------------- 518 !- check conservation (C Rousset) 519 IF (ln_limdiahsb) THEN 520 521 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 522 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 523 524 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 525 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 526 527 zchk_vmin = glob_min(v_i) 528 zchk_amax = glob_max(SUM(a_i,dim=3)) 529 zchk_amin = glob_min(a_i) 530 531 IF(lwp) THEN 532 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limupdate2) = ',(zchk_v_i * rday) 533 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate2) = ',(zchk_smv * rday) 534 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limupdate2) = ',(zchk_vmin * 1.e-3) 535 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limupdate2) = ',zchk_amax 536 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limupdate2) = ',zchk_amin 537 ENDIF 538 ENDIF 539 !- check conservation (C Rousset) 540 ! ------------------------------- 181 ! ------------------------------------------------- 182 ! Diagnostics 183 ! ------------------------------------------------- 184 d_a_i_thd(:,:,:) = a_i(:,:,:) - a_i_b(:,:,:) 185 d_v_s_thd(:,:,:) = v_s(:,:,:) - v_s_b(:,:,:) 186 d_v_i_thd(:,:,:) = v_i(:,:,:) - v_i_b(:,:,:) 187 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:) 188 d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 189 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:) 190 d_smv_i_thd(:,:,:) = 0._wp 191 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 192 ! diag only (clem) 193 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 194 195 ! heat content variation (W.m-2) 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) + & 199 & SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) & 200 & ) * unit_fac * r1_rdtice / area(ji,jj) 201 END DO 202 END DO 203 204 ! conservation test 205 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 541 206 542 207 IF(ln_ctl) THEN ! Control print … … 550 215 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update2 : strength :') 551 216 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update2 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 552 CALL prt_ctl(tab2d_1= old_u_ice , clinfo1=' lim_update2 : old_u_ice :', tab2d_2=old_v_ice , clinfo2=' old_v_ice:')217 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update2 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 553 218 554 219 DO jl = 1, jpl … … 563 228 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' lim_update2 : o_i : ') 564 229 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update2 : a_i : ') 565 CALL prt_ctl(tab2d_1= old_a_i (:,:,jl) , clinfo1= ' lim_update2 : old_a_i: ')230 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update2 : a_i_b : ') 566 231 CALL prt_ctl(tab2d_1=d_a_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_a_i_thd : ') 567 232 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update2 : v_i : ') 568 CALL prt_ctl(tab2d_1= old_v_i (:,:,jl) , clinfo1= ' lim_update2 : old_v_i: ')233 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update2 : v_i_b : ') 569 234 CALL prt_ctl(tab2d_1=d_v_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_i_thd : ') 570 235 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update2 : v_s : ') 571 CALL prt_ctl(tab2d_1= old_v_s (:,:,jl) , clinfo1= ' lim_update2 : old_v_s: ')236 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update2 : v_s_b : ') 572 237 CALL prt_ctl(tab2d_1=d_v_s_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_s_thd : ') 573 238 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1 : ') 574 CALL prt_ctl(tab2d_1= old_e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : old_e_i1: ')239 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1_b : ') 575 240 CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : de_i1_thd : ') 576 241 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2 : ') 577 CALL prt_ctl(tab2d_1= old_e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : old_e_i2: ')242 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2_b : ') 578 243 CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : de_i2_thd : ') 579 244 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow : ') 580 CALL prt_ctl(tab2d_1= old_e_s (:,:,1,jl) , clinfo1= ' lim_update2 : old_e_snow: ')245 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow_b : ') 581 246 CALL prt_ctl(tab2d_1=d_e_s_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : d_e_s_thd : ') 582 247 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update2 : smv_i : ') 583 CALL prt_ctl(tab2d_1= old_smv_i (:,:,jl) , clinfo1= ' lim_update2 : old_smv_i: ')248 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update2 : smv_i_b : ') 584 249 CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl) , clinfo1= ' lim_update2 : d_smv_i_thd : ') 585 250 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update2 : oa_i : ') 586 CALL prt_ctl(tab2d_1=o ld_oa_i (:,:,jl) , clinfo1= ' lim_update2 : old_oa_i: ')251 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update2 : oa_i_b : ') 587 252 CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_oa_i_thd : ') 588 253 … … 596 261 CALL prt_ctl_info(' - Heat / FW fluxes : ') 597 262 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 598 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update2 : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ')599 263 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update2 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 600 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update2 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ')601 264 602 265 CALL prt_ctl_info(' ') … … 608 271 ENDIF 609 272 610 CALL wrk_dealloc( jpi,jpj,jpl, internal_melt ) ! integer611 CALL wrk_dealloc( jkmax, zthick0, zqm0 )612 613 CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem614 615 273 IF( nn_timing == 1 ) CALL timing_stop('limupdate2') 274 616 275 END SUBROUTINE lim_update2 617 276 #else -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r4333 r4921 67 67 68 68 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 69 REAL(wp) :: zzero = 0.e0 ! - -70 REAL(wp) :: zone = 1.e0 ! - -71 69 72 70 !!---------------------------------------------------------------------- … … 113 111 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 114 112 ! 115 zinda = MAX( zzero , SIGN( zone, at_i(ji,jj) - epsi10 ) )113 zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 116 114 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda ! ice thickness 117 115 END DO … … 134 132 DO jj = 1, jpj 135 133 DO ji = 1, jpi 136 zinda = MAX( zzero , SIGN( zone, vt_i(ji,jj) - epsi10 ) )137 zindb = MAX( zzero , SIGN( zone, at_i(ji,jj) - epsi10 ) )134 zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 135 zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 138 136 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 139 137 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda ! ice salinity … … 205 203 DO ji = 1, jpi 206 204 ! ! Energy of melting q(S,T) [J.m-3] 207 zq_i = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)208 205 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes 209 zq_i = zq_i * unit_fac * zindb !convert units 206 zq_i = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 207 zq_i = zq_i * unit_fac !convert units 210 208 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature 211 209 ! … … 231 229 DO ji = 1, jpi 232 230 !Energy of melting q(S,T) [J.m-3] 233 zq_s = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)234 231 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes 235 zq_s = zq_s * unit_fac * zindb ! convert units 232 zq_s = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 233 zq_s = zq_s * unit_fac ! convert units 236 234 ! 237 235 t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) … … 320 318 DO jj = 1, jpj 321 319 DO ji = 1, jpi 322 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01, ht_i(ji,jj,jl) )320 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 323 321 END DO 324 322 END DO … … 466 464 ! Vertically constant, constant in time 467 465 !--------------------------------------- 468 IF( num_sal == 1 ) s_i_ b(:,:) = bulk_sal466 IF( num_sal == 1 ) s_i_1d(:,:) = bulk_sal 469 467 470 468 !------------------------------------------------------ … … 475 473 ! 476 474 DO ji = kideb, kiut ! Slope of the linear profile zs_zero 477 z_slope_s(ji) = 2._wp * sm_i_ b(ji) / MAX( 0.01 , ht_i_b(ji) )475 z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) ) 478 476 END DO 479 477 … … 491 489 ij = ( npb(ji) - 1 ) / jpi + 1 492 490 ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 493 zind0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i_ b(ji) ) )491 zind0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i_1d(ji) ) ) 494 492 ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 495 zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_ b(ji) ) )493 zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) ) 496 494 ! if 2.sm_i GE sss_m then zindbal = 1 497 495 ! this is to force a constant salinity profile in the Baltic Sea 498 zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_ b(ji) - sss_m(ii,ij) ) )496 zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 499 497 ! 500 zalpha = ( zind0 + zind01 * ( sm_i_ b(ji) * dummy_fac0 + dummy_fac1 ) ) * ( 1.0 - zindbal )498 zalpha = ( zind0 + zind01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 ) ) * ( 1.0 - zindbal ) 501 499 ! 502 zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_ b(ji) * dummy_fac2500 zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2 503 501 ! weighting the profile 504 s_i_ b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji)502 s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 505 503 END DO ! ji 506 504 END DO ! jk … … 514 512 IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 515 513 ! 516 sm_i_ b(:) = 2.30_wp514 sm_i_1d(:) = 2.30_wp 517 515 ! 518 516 !CDIR NOVERRCHK … … 521 519 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 522 520 DO ji = kideb, kiut 523 s_i_ b(ji,jk) = zsal521 s_i_1d(ji,jk) = zsal 524 522 END DO 525 523 END DO -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r4624 r4921 9 9 !!---------------------------------------------------------------------- 10 10 !! lim_wri : write of the diagnostics variables in ouput file 11 !! lim_wri_init : initialization and namelist read12 11 !! lim_wri_state : write for initial state or/and abandon 13 12 !!---------------------------------------------------------------------- … … 36 35 PUBLIC lim_wri_state ! called by dia_wri_state 37 36 38 INTEGER, PARAMETER :: jpnoumax = 43 !: maximum number of variable for ice output39 40 INTEGER :: noumef ! number of fields41 INTEGER :: noumefa ! number of additional fields42 INTEGER :: add_diag_swi ! additional diagnostics43 INTEGER :: nz ! dimension for the itd field44 45 REAL(wp) , DIMENSION(jpnoumax) :: cmulti ! multiplicative constant46 REAL(wp) , DIMENSION(jpnoumax) :: cadd ! additive constant47 REAL(wp) , DIMENSION(jpnoumax) :: cmultia ! multiplicative constant48 REAL(wp) , DIMENSION(jpnoumax) :: cadda ! additive constant49 CHARACTER(len = 35), DIMENSION(jpnoumax) :: titn, titna ! title of the field50 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: nam , nama ! name of the field51 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: uni , unia ! unit of the field52 INTEGER , DIMENSION(jpnoumax) :: nc , nca ! switch for saving field ( = 1 ) or not ( = 0 )53 54 37 REAL(wp) :: epsi06 = 1.e-6_wp 55 REAL(wp) :: zzero = 0._wp56 REAL(wp) :: zone = 1._wp57 38 !!---------------------------------------------------------------------- 58 39 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 78 59 INTEGER, INTENT(in) :: kindic ! if kindic < 0 there has been an error somewhere 79 60 ! 80 INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices 81 INTEGER :: ierr 82 REAL(wp),DIMENSION(1) :: zdept 83 REAL(wp) :: zsto, zjulian, zout, zindh, zinda, zindb, zindc 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcmo, zcmoa 85 REAL(wp), POINTER, DIMENSION(:,: ) :: zfield 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmaskitd, zoi, zei 87 88 CHARACTER(len = 60) :: clhstnam, clop, clhstnama 89 90 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 91 INTEGER , SAVE :: nicea, nhorida, ndimitd 92 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndex51 93 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndexitd 61 INTEGER :: ji, jj, jk, jl ! dummy loop indices 62 REAL(wp) :: zinda, zindb, z1_365 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zoi, zei 64 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z2da, z2db, zind ! 2D workspace 94 65 !!------------------------------------------------------------------- 95 66 96 67 IF( nn_timing == 1 ) CALL timing_start('limwri') 97 68 98 CALL wrk_alloc( jpi, jpj, zfield ) 99 CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 100 CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 101 102 ipl = jpl 103 104 IF( numit == nstart ) THEN 105 106 ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr ) 107 IF( lk_mpp ) CALL mpp_sum ( ierr ) 108 IF( ierr /= 0 ) THEN 109 CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' ) ; RETURN 110 ENDIF 111 112 CALL lim_wri_init 113 114 IF(lwp) WRITE(numout,*) ' lim_wri, first time step ' 115 IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi 116 117 !-------------------- 118 ! 1) Initialization 119 !-------------------- 120 121 !------------- 122 ! Normal file 123 !------------- 124 niter = ( nit000 - 1 ) / nn_fsbc 125 CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 126 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 127 !clem 128 ! zsto = rdt_ice 129 ! IF( ln_mskland ) THEN ; clop = "ave(only(x))" ! put 1.e+20 on land (very expensive!!) 130 ! ELSE ; clop = "ave(x)" ! no use of the mask value (require less cpu time) 131 ! ENDIF 132 ! zout = nwrite * rdt_ice / nn_fsbc 133 ! zdept(1) = 0. 134 ! 135 ! CALL dia_nam ( clhstnam, nwrite, 'icemod_old' ) 136 ! CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice, & 137 ! & nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 138 ! CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 139 ! CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 140 ! 141 ! DO jf = 1 , noumef 142 ! IF(lwp) WRITE(numout,*) 'jf', jf 143 ! IF ( nc(jf) == 1 ) THEN 144 ! CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 145 ! , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 146 ! IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout' 147 ! IF(lwp) WRITE(numout,*) nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout 148 ! ENDIF 149 ! END DO 150 ! 151 ! CALL histend(nice, snc4set) 152 !clem 153 ! 154 !----------------- 155 ! ITD file output 156 !----------------- 157 zsto = rdt_ice 158 clop = "ave(x)" 159 zout = nwrite * rdt_ice / nn_fsbc 160 zdept(1) = 0. 161 162 CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 163 CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit, & 164 1, jpi, 1, jpj, & ! zoom 165 niter, zjulian, rdt_ice, & ! time 166 nhorida, & ! ? linked with horizontal ... 167 nicea , domain_id=nidom, snc4chunks=snc4set) ! file 168 CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 69 CALL wrk_alloc( jpi, jpj, jpl, zoi, zei ) 70 CALL wrk_alloc( jpi, jpj , z2d, z2da, z2db, zind ) 71 72 !----------------------------- 73 ! Mean category values 74 !----------------------------- 75 76 CALL lim_var_icetm ! mean sea ice temperature 77 78 CALL lim_var_bv ! brine volume 79 80 DO jj = 1, jpj ! presence indicator of ice 81 DO ji = 1, jpi 82 zind(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 83 END DO 84 END DO 85 ! 86 ! 87 ! 88 IF ( iom_use( "icethic_cea" ) ) THEN ! mean ice thickness 89 DO jj = 1, jpj 90 DO ji = 1, jpi 91 z2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 92 END DO 93 END DO 94 CALL iom_put( "icethic_cea" , z2d ) 95 ENDIF 96 97 IF ( iom_use( "snowthic_cea" ) ) THEN ! snow thickness = mean snow thickness over the cell 98 DO jj = 1, jpj 99 DO ji = 1, jpi 100 z2d(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 101 END DO 102 END DO 103 CALL iom_put( "snowthic_cea" , z2d ) 104 ENDIF 105 ! 106 IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 107 DO jj = 2 , jpjm1 108 DO ji = 2 , jpim1 109 z2da(ji,jj) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 110 z2db(ji,jj) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 111 END DO 112 END DO 113 CALL lbc_lnk( z2da, 'T', -1. ) 114 CALL lbc_lnk( z2db, 'T', -1. ) 115 CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component 116 CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 z2d(ji,jj) = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) ) 120 END DO 121 END DO 122 CALL iom_put( "icevel" , z2d ) ! ice velocity module 123 ENDIF 124 ! 125 IF ( iom_use( "miceage" ) ) THEN 126 z2d(:,:) = 0.e0 169 127 DO jl = 1, jpl 170 zmaskitd(:,:,jl) = tmask(:,:,1) 171 END DO 172 CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 173 CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd ) 174 CALL histdef( nicea, "iice_itd", "Ice area in categories" , "-" , & 175 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 176 CALL histdef( nicea, "iice_hid", "Ice thickness in categories" , "m" , & 177 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 178 CALL histdef( nicea, "iice_hsd", "Snow depth in in categories" , "m" , & 179 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 180 CALL histdef( nicea, "iice_std", "Ice salinity distribution" , "ppt" , & 181 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 182 CALL histdef( nicea, "iice_otd", "Ice age distribution" , "days", & 183 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 184 CALL histdef( nicea, "iice_etd", "Brine volume distr. " , "%" , & 185 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 186 CALL histend(nicea, snc4set) 187 ENDIF 188 189 ! !-----------------------------------------------------------------------! 190 ! !--2. Computation of instantaneous values ! 191 ! !-----------------------------------------------------------------------! 192 193 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 194 !IF( ln_nicep ) THEN 195 ! WRITE(numout,*) 196 ! WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit 197 ! WRITE(numout,*) '~~~~~~~ ' 198 ! WRITE(numout,*) ' kindic = ', kindic 199 !ENDIF 200 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 201 202 !-- calculs des valeurs instantanees 203 zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 204 zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 205 206 ! Ice surface temperature and some fluxes 207 DO jl = 1, jpl 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * oa_i(ji,jj,jl) 131 END DO 132 END DO 133 END DO 134 z1_365 = 1._wp / 365._wp 135 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 136 ENDIF 137 138 IF ( iom_use( "micet" ) ) THEN 208 139 DO jj = 1, jpj 209 140 DO ji = 1, jpi 210 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 211 zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 212 zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 213 zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 214 zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 215 END DO 216 END DO 217 END DO 218 219 ! Mean sea ice temperature 220 CALL lim_var_icetm 221 222 ! Brine volume 223 CALL lim_var_bv 224 225 DO jj = 2 , jpjm1 226 DO ji = 2 , jpim1 227 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 228 zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 229 230 zcmo(ji,jj,1) = at_i(ji,jj) 231 zcmo(ji,jj,2) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 232 zcmo(ji,jj,3) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 233 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * rday ! Bottom thermodynamic ice production 234 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * rday ! Dynamic ice production (rid/raft) 235 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday ! Lateral thermodynamic ice production 236 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday ! Snow ice production ice production 237 zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda 238 239 zcmo(ji,jj,6) = fbif(ji,jj)*at_i(ji,jj) 240 zcmo(ji,jj,7) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 241 zcmo(ji,jj,8) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 242 zcmo(ji,jj,9) = sst_m(ji,jj) 243 zcmo(ji,jj,10) = sss_m(ji,jj) 244 245 zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 246 zcmo(ji,jj,12) = qsr(ji,jj) 247 zcmo(ji,jj,13) = qns(ji,jj) 248 zcmo(ji,jj,14) = fhbri(ji,jj) 249 zcmo(ji,jj,15) = utau_ice(ji,jj) 250 zcmo(ji,jj,16) = vtau_ice(ji,jj) 251 zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 252 zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 253 zcmo(ji,jj,19) = sprecip(ji,jj) 254 zcmo(ji,jj,20) = smt_i(ji,jj) 255 zcmo(ji,jj,25) = et_i(ji,jj) 256 zcmo(ji,jj,26) = et_s(ji,jj) 257 zcmo(ji,jj,28) = sfx_bri(ji,jj) 258 zcmo(ji,jj,29) = sfx_thd(ji,jj) 259 260 zcmo(ji,jj,30) = bv_i(ji,jj) 261 zcmo(ji,jj,31) = hicol(ji,jj) * zindb 262 zcmo(ji,jj,32) = strength(ji,jj) 263 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 264 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday ! Surface melt 265 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday ! Bottom melt 266 zcmo(ji,jj,36) = divu_i(ji,jj) 267 zcmo(ji,jj,37) = shear_i(ji,jj) 268 zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday ! Bottom melt 269 zcmo(ji,jj,39) = vt_i(ji,jj) ! ice volume 270 zcmo(ji,jj,40) = vt_s(ji,jj) ! snow volume 271 272 zcmo(ji,jj,41) = sfx_mec(ji,jj) 273 zcmo(ji,jj,42) = sfx_res(ji,jj) 274 275 zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday ! transport of ice volume 276 277 END DO 278 END DO 279 280 ! 281 ! ecriture d'un fichier netcdf 282 ! 283 niter = niter + 1 284 !clem 285 ! DO jf = 1 , noumef 286 ! ! 287 ! zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 288 ! ! 289 ! IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN ; CALL lbc_lnk( zfield, 'T', -1. ) 290 ! ELSE ; CALL lbc_lnk( zfield, 'T', 1. ) 291 ! ENDIF 292 ! ! 293 ! IF( ln_nicep ) THEN 294 ! WRITE(numout,*) 295 ! WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 296 ! WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 297 ! ENDIF 298 ! IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 299 ! ! 300 ! END DO 301 ! 302 ! IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 303 ! IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 304 ! CALL histclo( nice ) 305 ! ENDIF 306 !clem 307 ! 308 CALL iom_put ('iceconc', zcmo(:,:,1) ) ! field1: ice concentration 309 CALL iom_put ('icethic_cea', zcmo(:,:,2) ) ! field2: ice thickness (i.e. icethi(:,:)) 310 CALL iom_put ('snowthic_cea', zcmo(:,:,3)) ! field3: snow thickness 311 CALL iom_put ('icebopr', zcmo(:,:,4) ) ! field4: daily bottom thermo ice production 312 CALL iom_put ('icedypr', zcmo(:,:,5) ) ! field5: daily dynamic ice production 313 CALL iom_put ('ioceflxb', zcmo(:,:,6) ) ! field6: Oceanic flux at the ice base 314 CALL iom_put ('uice_ipa', zcmo(:,:,7) ) ! field7: ice velocity u component 315 CALL iom_put ('vice_ipa', zcmo(:,:,8) ) ! field8: ice velocity v component 316 CALL iom_put ('isst', zcmo(:,:,9) ) ! field 9: sea surface temperature 317 CALL iom_put ('isss', zcmo(:,:,10) ) ! field 10: sea surface salinity 318 CALL iom_put ('qt_oce', zcmo(:,:,11) ) ! field 11: total flux at ocean surface 319 CALL iom_put ('qsr_oce', zcmo(:,:,12) ) ! field 12: solar flux at ocean surface 320 CALL iom_put ('qns_oce', zcmo(:,:,13) ) ! field 13: non-solar flux at ocean surface 321 !CALL iom_put ('hfbri', fhbri ) ! field 14: heat flux due to brine release 322 CALL iom_put( 'utau_ice', zcmo(:,:,15) ) ! Wind stress over ice along i-axis at I-point 323 CALL iom_put( 'vtau_ice', zcmo(:,:,16) ) ! Wind stress over ice along j-axis at I-point 324 CALL iom_put ('qsr_io', zcmo(:,:,17) ) ! field 17: solar flux at ice/ocean surface 325 CALL iom_put ('qns_io', zcmo(:,:,18) ) ! field 18: non-solar flux at ice/ocean surface 326 !CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip 327 CALL iom_put ('micesalt', zcmo(:,:,20) ) ! field 20 :mean ice salinity 328 CALL iom_put ('miceage', zcmo(:,:,21) / 365) ! field 21: mean ice age 329 CALL iom_put ('icelapr',zcmo(:,:,22) ) ! field 22: daily lateral thermo ice prod. 330 CALL iom_put ('icesipr',zcmo(:,:,23) ) ! field 23: daily snowice ice prod. 331 CALL iom_put ('micet', zcmo(:,:,24) ) ! field 24: mean ice temperature 332 CALL iom_put ('icehc', zcmo(:,:,25) ) ! field 25: ice total heat content 333 CALL iom_put ('isnowhc', zcmo(:,:,26) ) ! field 26: snow total heat content 334 CALL iom_put ('icest', zcmo(:,:,27) ) ! field 27: ice surface temperature 335 CALL iom_put ('sfxbri', zcmo(:,:,28) * rday ) ! field 28: brine salt flux 336 CALL iom_put ('sfxthd', zcmo(:,:,29) * rday ) ! field 29: equivalent FW salt flux 337 CALL iom_put ('ibrinv', zcmo(:,:,30) *100 ) ! field 30: brine volume 338 CALL iom_put ('icecolf', zcmo(:,:,31) ) ! field 31: frazil ice collection thickness 339 CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 ) ! field 32: ice strength 340 CALL iom_put ('icevel', zcmo(:,:,33) ) ! field 33: ice velocity 341 CALL iom_put ('isume', zcmo(:,:,34) ) ! field 34: surface melt 342 CALL iom_put ('ibome', zcmo(:,:,35) ) ! field 35: bottom melt 343 CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8) ! field 36: divergence 344 CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 ) ! field 37: shear 345 CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate 346 CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume 347 CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume 348 CALL iom_put ('sfxmec', zcmo(:,:,41) * rday ) ! field 41: salt flux from ridging rafting 349 CALL iom_put ('sfxres', zcmo(:,:,42) * rday ) ! field 42: salt flux from limupdate (resultant) 350 CALL iom_put ('icetrp', zcmo(:,:,43) ) ! field 43: ice volume transport 351 352 !----------------------------- 353 ! Thickness distribution file 354 !----------------------------- 355 IF( add_diag_swi == 1 ) THEN 356 357 DO jl = 1, jpl 358 CALL lbc_lnk( a_i(:,:,jl) , 'T' , 1. ) 359 CALL lbc_lnk( sm_i(:,:,jl) , 'T' , 1. ) 360 CALL lbc_lnk( oa_i(:,:,jl) , 'T' , 1. ) 361 CALL lbc_lnk( ht_i(:,:,jl) , 'T' , 1. ) 362 CALL lbc_lnk( ht_s(:,:,jl) , 'T' , 1. ) 363 END DO 364 365 ! Compute ice age 141 z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zind(ji,jj) 142 END DO 143 END DO 144 CALL iom_put( "micet" , z2d ) ! mean ice temperature 145 ENDIF 146 ! 147 IF ( iom_use( "icest" ) ) THEN 148 z2d(:,:) = 0.e0 149 DO jl = 1, jpl 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 153 END DO 154 END DO 155 END DO 156 CALL iom_put( "icest" , z2d ) ! ice surface temperature 157 ENDIF 158 159 IF ( iom_use( "icecolf" ) ) THEN 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 163 z2d(ji,jj) = hicol(ji,jj) * zindb 164 END DO 165 END DO 166 CALL iom_put( "icecolf" , z2d ) ! frazil ice collection thickness 167 ENDIF 168 169 CALL iom_put( "isst" , sst_m ) ! sea surface temperature 170 CALL iom_put( "isss" , sss_m ) ! sea surface salinity 171 CALL iom_put( "iceconc" , at_i ) ! ice concentration 172 CALL iom_put( "icevolu" , vt_i ) ! ice volume = mean ice thickness over the cell 173 CALL iom_put( "icehc" , et_i ) ! ice total heat content 174 CALL iom_put( "isnowhc" , et_s ) ! snow total heat content 175 CALL iom_put( "ibrinv" , bv_i * 100._wp ) ! brine volume 176 CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point 177 CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point 178 CALL iom_put( "snowpre" , sprecip ) ! snow precipitation 179 CALL iom_put( "micesalt" , smt_i ) ! mean ice salinity 180 181 CALL iom_put( "icestr" , strength * 0.001 ) ! ice strength 182 CALL iom_put( "idive" , divu_i * 1.0e8 ) ! divergence 183 CALL iom_put( "ishear" , shear_i * 1.0e8 ) ! shear 184 CALL iom_put( "snowvol" , vt_s ) ! snow volume 185 186 CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport 187 CALL iom_put( "snwtrp" , diag_trp_vs * rday ) ! snw volume transport 188 CALL iom_put( "deitrp" , diag_trp_ei ) ! advected ice enthalpy (W/m2) 189 CALL iom_put( "destrp" , diag_trp_es ) ! advected snw enthalpy (W/m2) 190 191 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from brines 192 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from brines 193 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from brines 194 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from brines 195 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from brines 196 CALL iom_put( "sfxdyn" , sfx_dyn * rday ) ! salt flux from ridging rafting 197 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from limupdate (resultant) 198 CALL iom_put( "sfxbri" , sfx_bri * rday ) ! salt flux from brines 199 CALL iom_put( "sfx" , sfx * rday ) ! total salt flux 200 201 CALL iom_put( "vfxres" , wfx_res * rday / rhoic ) ! daily prod./melting due to limupdate 202 CALL iom_put( "vfxopw" , wfx_opw * rday / rhoic ) ! daily lateral thermodynamic ice production 203 CALL iom_put( "vfxsni" , wfx_sni * rday / rhoic ) ! daily snowice ice production 204 CALL iom_put( "vfxbog" , wfx_bog * rday / rhoic ) ! daily bottom thermodynamic ice production 205 CALL iom_put( "vfxdyn" , wfx_dyn * rday / rhoic ) ! daily dynamic ice production (rid/raft) 206 CALL iom_put( "vfxsum" , wfx_sum * rday / rhoic ) ! surface melt 207 CALL iom_put( "vfxbom" , wfx_bom * rday / rhoic ) ! bottom melt 208 CALL iom_put( "vfxice" , wfx_ice * rday / rhoic ) ! total ice growth/melt 209 CALL iom_put( "vfxsnw" , wfx_snw * rday / rhoic ) ! total snw growth/melt 210 CALL iom_put( "vfxsub" , wfx_sub * rday / rhoic ) ! sublimation (snow) 211 CALL iom_put( "vfxspr" , wfx_spr * rday / rhoic ) ! precip (snow) 212 213 CALL iom_put ('hfxthd', hfx_thd(:,:) ) ! 214 CALL iom_put ('hfxdyn', hfx_dyn(:,:) ) ! 215 CALL iom_put ('hfxres', hfx_res(:,:) ) ! 216 CALL iom_put ('hfxout', hfx_out(:,:) ) ! 217 CALL iom_put ('hfxin' , hfx_in(:,:) ) ! 218 CALL iom_put ('hfxsnw', hfx_snw(:,:) ) ! 219 CALL iom_put ('hfxsub', hfx_sub(:,:) ) ! 220 CALL iom_put ('hfxerr', hfx_err(:,:) ) ! 221 CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) ) ! 222 223 CALL iom_put ('hfxsum', hfx_sum(:,:) ) ! 224 CALL iom_put ('hfxbom', hfx_bom(:,:) ) ! 225 CALL iom_put ('hfxbog', hfx_bog(:,:) ) ! 226 CALL iom_put ('hfxdif', hfx_dif(:,:) ) ! 227 CALL iom_put ('hfxopw', hfx_opw(:,:) ) ! 228 CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base 229 CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) ) ! Heat content variation in snow and ice 230 CALL iom_put ('hfxspr', hfx_spr(:,:) ) ! Heat content of snow precip 231 232 !-------------------------------- 233 ! Output values for each category 234 !-------------------------------- 235 CALL iom_put( "iceconc_cat" , a_i ) ! area for categories 236 CALL iom_put( "icethic_cat" , ht_i ) ! thickness for categories 237 CALL iom_put( "snowthic_cat" , ht_s ) ! snow depth for categories 238 CALL iom_put( "salinity_cat" , sm_i ) ! salinity for categories 239 240 ! Compute ice age 241 IF ( iom_use( "iceage_cat" ) ) THEN 366 242 DO jl = 1, jpl 367 243 DO jj = 1, jpj 368 244 DO ji = 1, jpi 369 zinda = MAX( zzero , SIGN( zone, a_i(ji,jj,jl) - epsi06 ) )245 zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 370 246 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 371 247 END DO 372 248 END DO 373 249 END DO 374 375 ! Compute brine volume 250 CALL iom_put( "iceage_cat" , zoi ) ! ice age for categories 251 ENDIF 252 253 ! Compute brine volume 254 IF ( iom_use( "brinevol_cat" ) ) THEN 376 255 zei(:,:,:) = 0._wp 377 256 DO jl = 1, jpl … … 379 258 DO jj = 1, jpj 380 259 DO ji = 1, jpi 381 zinda = MAX( zzero , SIGN( zone, a_i(ji,jj,jl) - epsi06 ) )260 zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 382 261 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 383 262 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & … … 387 266 END DO 388 267 END DO 389 390 DO jl = 1, jpl 391 CALL lbc_lnk( zei(:,:,jl) , 'T' , 1. ) 392 END DO 393 394 CALL histwrite( nicea, "iice_itd", niter, a_i , ndimitd , ndexitd ) ! area 395 CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd ) ! thickness 396 CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd ) ! snow depth 397 CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd ) ! salinity 398 CALL histwrite( nicea, "iice_otd", niter, zoi , ndimitd , ndexitd ) ! age 399 CALL histwrite( nicea, "iice_etd", niter, zei , ndimitd , ndexitd ) ! brine volume 400 401 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 402 ! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' ) 403 ! not yet implemented 404 405 IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 406 IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 407 CALL histclo( nicea ) 408 ENDIF 409 ! 410 ENDIF 411 412 CALL wrk_dealloc( jpi, jpj, zfield ) 413 CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 414 CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 268 CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories 269 ENDIF 270 271 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 272 ! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' ) 273 ! not yet implemented 274 275 CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei ) 276 CALL wrk_dealloc( jpi, jpj , z2d, zind, z2da, z2db ) 415 277 416 278 IF( nn_timing == 1 ) CALL timing_stop('limwri') … … 419 281 #endif 420 282 421 SUBROUTINE lim_wri_init422 !!-------------------------------------------------------------------423 !! *** ROUTINE lim_wri_init ***424 !!425 !! ** Purpose : ???426 !!427 !! ** Method : Read the namicewri namelist and check the parameter428 !! values called at the first timestep (nit000)429 !!430 !! ** input : Namelist namicewri431 !!-------------------------------------------------------------------432 INTEGER :: nf ! ???433 INTEGER :: ios ! Local integer output status for namelist read434 435 TYPE FIELD436 CHARACTER(len = 35) :: ztitle437 CHARACTER(len = 8 ) :: zname438 CHARACTER(len = 8 ) :: zunit439 INTEGER :: znc440 REAL :: zcmulti441 REAL :: zcadd442 END TYPE FIELD443 444 TYPE(FIELD) :: &445 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &446 field_7 , field_8 , field_9 , field_10, field_11, field_12, &447 field_13, field_14, field_15, field_16, field_17, field_18, &448 field_19, field_20, field_21, field_22, field_23, field_24, &449 field_25, field_26, field_27, field_28, field_29, field_30, &450 field_31, field_32, field_33, field_34, field_35, field_36, &451 field_37, field_38, field_39, field_40, field_41, field_42, field_43452 453 TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield454 !455 NAMELIST/namiceout/ noumef, &456 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &457 field_7 , field_8 , field_9 , field_10, field_11, field_12, &458 field_13, field_14, field_15, field_16, field_17, field_18, &459 field_19, field_20, field_21, field_22, field_23, field_24, &460 field_25, field_26, field_27, field_28, field_29, field_30, &461 field_31, field_32, field_33, field_34, field_35, field_36, &462 field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi463 !!-------------------------------------------------------------------464 REWIND( numnam_ice_ref ) ! Namelist namiceout in reference namelist : Ice outputs465 READ ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)466 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )467 468 REWIND( numnam_ice_cfg ) ! Namelist namiceout in configuration namelist : Ice outputs469 READ ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )470 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )471 IF(lwm) WRITE ( numoni, namiceout )472 473 zfield(1) = field_1474 zfield(2) = field_2475 zfield(3) = field_3476 zfield(4) = field_4477 zfield(5) = field_5478 zfield(6) = field_6479 zfield(7) = field_7480 zfield(8) = field_8481 zfield(9) = field_9482 zfield(10) = field_10483 zfield(11) = field_11484 zfield(12) = field_12485 zfield(13) = field_13486 zfield(14) = field_14487 zfield(15) = field_15488 zfield(16) = field_16489 zfield(17) = field_17490 zfield(18) = field_18491 zfield(19) = field_19492 zfield(20) = field_20493 zfield(21) = field_21494 zfield(22) = field_22495 zfield(23) = field_23496 zfield(24) = field_24497 zfield(25) = field_25498 zfield(26) = field_26499 zfield(27) = field_27500 zfield(28) = field_28501 zfield(29) = field_29502 zfield(30) = field_30503 zfield(31) = field_31504 zfield(32) = field_32505 zfield(33) = field_33506 zfield(34) = field_34507 zfield(35) = field_35508 zfield(36) = field_36509 zfield(37) = field_37510 zfield(38) = field_38511 zfield(39) = field_39512 zfield(40) = field_40513 zfield(41) = field_41514 zfield(42) = field_42515 zfield(43) = field_43516 517 DO nf = 1, noumef518 titn (nf) = zfield(nf)%ztitle519 nam (nf) = zfield(nf)%zname520 uni (nf) = zfield(nf)%zunit521 nc (nf) = zfield(nf)%znc522 cmulti(nf) = zfield(nf)%zcmulti523 cadd (nf) = zfield(nf)%zcadd524 END DO525 526 IF(lwp) THEN ! control print527 WRITE(numout,*)528 WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'529 WRITE(numout,*) '~~~~~~~~~~~~'530 WRITE(numout,*) ' number of fields to be stored noumef = ', noumef531 WRITE(numout,*) ' title name unit Saving (1/0) ', &532 & ' multiplicative constant additive constant '533 DO nf = 1 , noumef534 WRITE(numout,*) ' ', titn(nf), ' ' , nam (nf), ' ' , uni (nf), &535 & ' ' , nc (nf),' ', cmulti(nf), ' ', cadd(nf)536 END DO537 WRITE(numout,*) ' add_diag_swi ', add_diag_swi538 ENDIF539 !540 END SUBROUTINE lim_wri_init541 283 542 284 SUBROUTINE lim_wri_state( kt, kid, kh_i ) … … 555 297 INTEGER, INTENT( in ) :: kid , kh_i 556 298 !!---------------------------------------------------------------------- 557 !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz ) 558 559 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 560 CALL histdef( kid, "iiceconc", "Ice concentration" , "%" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 561 CALL histdef( kid, "iicetemp", "Ice temperature" , "C" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 562 CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 563 CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 564 CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 565 CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 566 CALL histdef( kid, "iicesflx", "Solar flux over ocean" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 567 CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 568 CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 569 CALL histdef( kid, "iicesali", "Ice salinity" , "PSU" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 570 CALL histdef( kid, "iicevolu", "Ice volume" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 571 CALL histdef( kid, "iicedive", "Ice divergence" , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 572 CALL histdef( kid, "iicebopr", "Ice bottom production" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 573 CALL histdef( kid, "iicedypr", "Ice dynamic production" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 574 CALL histdef( kid, "iicelapr", "Ice open water prod" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 575 CALL histdef( kid, "iicesipr", "Snow ice production " , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 576 CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 577 CALL histdef( kid, "iicebome", "Ice bottom melt" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 578 CALL histdef( kid, "iicesume", "Ice surface melt" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 579 CALL histdef( kid, "iisfxthd", "Salt flux from thermo" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 580 CALL histdef( kid, "iisfxmec", "Salt flux from dynmics" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 581 CALL histdef( kid, "iisfxres", "Salt flux from limupdate", "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 582 583 584 !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt ) 585 !CALL histdef( kid, "iice_hid", "Ice thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt ) 586 !CALL histdef( kid, "iice_hsd", "Snow thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt ) 587 !CALL histdef( kid, "iice_std", "Ice salinity by cat" , "PSU" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt ) 299 300 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , & 301 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 302 CALL histdef( kid, "iiceconc", "Ice concentration" , "%" , & 303 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 304 CALL histdef( kid, "iicetemp", "Ice temperature" , "C" , & 305 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 306 CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , & 307 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 308 CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , & 309 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 310 CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", & 311 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 312 CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", & 313 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 314 CALL histdef( kid, "iicesflx", "Solar flux over ocean" , "w/m2" , & 315 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 316 CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" , & 317 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 318 CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", & 319 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 320 CALL histdef( kid, "iicesali", "Ice salinity" , "PSU" , & 321 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 322 CALL histdef( kid, "iicevolu", "Ice volume" , "m" , & 323 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 324 CALL histdef( kid, "iicedive", "Ice divergence" , "10-8s-1", & 325 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 326 CALL histdef( kid, "iicebopr", "Ice bottom production" , "m/s" , & 327 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 328 CALL histdef( kid, "iicedypr", "Ice dynamic production" , "m/s" , & 329 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 330 CALL histdef( kid, "iicelapr", "Ice open water prod" , "m/s" , & 331 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 332 CALL histdef( kid, "iicesipr", "Snow ice production " , "m/s" , & 333 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 334 CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s" , & 335 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 336 CALL histdef( kid, "iicebome", "Ice bottom melt" , "m/s" , & 337 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 338 CALL histdef( kid, "iicesume", "Ice surface melt" , "m/s" , & 339 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 340 CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics" , "" , & 341 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 342 CALL histdef( kid, "iisfxres", "Salt flux from limupdate", "" , & 343 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 588 344 589 345 CALL histend( kid, snc4set ) ! end of the file definition … … 603 359 CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 604 360 605 CALL histwrite( kid, "iicebopr", kt, diag_bot_gr , jpi*jpj, (/1/) ) 606 CALL histwrite( kid, "iicedypr", kt, diag_dyn_gr , jpi*jpj, (/1/) ) 607 CALL histwrite( kid, "iicelapr", kt, diag_lat_gr , jpi*jpj, (/1/) ) 608 CALL histwrite( kid, "iicesipr", kt, diag_sni_gr , jpi*jpj, (/1/) ) 609 CALL histwrite( kid, "iicerepr", kt, diag_res_pr , jpi*jpj, (/1/) ) 610 CALL histwrite( kid, "iicebome", kt, diag_bot_me , jpi*jpj, (/1/) ) 611 CALL histwrite( kid, "iicesume", kt, diag_sur_me , jpi*jpj, (/1/) ) 612 CALL histwrite( kid, "iisfxthd", kt, sfx_thd , jpi*jpj, (/1/) ) 613 CALL histwrite( kid, "iisfxmec", kt, sfx_mec , jpi*jpj, (/1/) ) 361 CALL histwrite( kid, "iicebopr", kt, wfx_bog , jpi*jpj, (/1/) ) 362 CALL histwrite( kid, "iicedypr", kt, wfx_dyn , jpi*jpj, (/1/) ) 363 CALL histwrite( kid, "iicelapr", kt, wfx_opw , jpi*jpj, (/1/) ) 364 CALL histwrite( kid, "iicesipr", kt, wfx_sni , jpi*jpj, (/1/) ) 365 CALL histwrite( kid, "iicerepr", kt, wfx_res , jpi*jpj, (/1/) ) 366 CALL histwrite( kid, "iicebome", kt, wfx_bom , jpi*jpj, (/1/) ) 367 CALL histwrite( kid, "iicesume", kt, wfx_sum , jpi*jpj, (/1/) ) 368 CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn , jpi*jpj, (/1/) ) 614 369 CALL histwrite( kid, "iisfxres", kt, sfx_res , jpi*jpj, (/1/) ) 615 370 616 !CALL histwrite( kid, "iice_itd", kt, a_i , jpi*jpj*jpl, (/1/) ) ! area 617 !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/) ) ! thickness 618 !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/) ) ! snow depth 619 !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/) ) ! salinity 371 ! Close the file 372 ! ----------------- 373 !CALL histclo( kid ) 620 374 621 375 END SUBROUTINE lim_wri_state -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
r3764 r4921 89 89 DO jj = 2 , jpjm1 90 90 DO ji = 2 , jpim1 ! NO vector opt. 91 zindh = MAX( zzero , SIGN( zone, ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )92 zinda = MAX( zzero , SIGN( zone, ( 1.0 - frld(ji,jj) ) - 0.10 ) )91 zindh = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 92 zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 93 93 zindb = zindh * zinda 94 ztmu = MAX( 0.5 * zone, ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )94 ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 95 95 zcmo(ji,jj,1) = ht_s (ji,jj,1) 96 96 zcmo(ji,jj,2) = ht_i (ji,jj,1) 97 zcmo(ji,jj,3) = hicifp(ji,jj)97 zcmo(ji,jj,3) = 0. 98 98 zcmo(ji,jj,4) = frld (ji,jj) 99 99 zcmo(ji,jj,5) = sist (ji,jj) 100 zcmo(ji,jj,6) = f bif(ji,jj)100 zcmo(ji,jj,6) = fhtur (ji,jj) 101 101 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 102 102 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & … … 132 132 DO jj = 2 , jpjm1 133 133 DO ji = 2 , jpim1 ! NO vector opt. 134 zindh = MAX( zzero , SIGN( zone, ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )135 zinda = MAX( zzero , SIGN( zone, ( 1.0 - frld(ji,jj) ) - 0.10 ) )134 zindh = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 135 zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 136 136 zindb = zindh * zinda 137 ztmu = MAX( 0.5 * zone, ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )137 ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 138 138 rcmoy(ji,jj,1) = ht_s (ji,jj,1) 139 139 rcmoy(ji,jj,2) = ht_i (ji,jj,1) 140 rcmoy(ji,jj,3) = hicifp(ji,jj)140 rcmoy(ji,jj,3) = 0. 141 141 rcmoy(ji,jj,4) = frld (ji,jj) 142 142 rcmoy(ji,jj,5) = sist (ji,jj) 143 rcmoy(ji,jj,6) = f bif(ji,jj)143 rcmoy(ji,jj,6) = fhtur (ji,jj) 144 144 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 145 145 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
r2528 r4921 12 12 13 13 ! !!! ice thermodynamics 14 INTEGER, PUBLIC, PARAMETER :: jkmax = 6 !: maximumnumber of ice layers14 INTEGER, PUBLIC, PARAMETER :: nlay_i = 5 !: number of ice layers 15 15 INTEGER, PUBLIC, PARAMETER :: nlay_s = 1 !: number of snow layers 16 16 17 17 ! !!! ice mechanical redistribution 18 18 INTEGER, PUBLIC, PARAMETER :: jpl = 5 !: number of ice categories 19 INTEGER, PUBLIC, PARAMETER :: jpm = 1 !: number of ice types20 19 21 20 !!---------------------------------------------------------------------- -
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r4205 r4921 20 20 ! !!! ** ice-thermo namelist (namicethd) ** 21 21 REAL(wp), PUBLIC :: hmelt !: maximum melting at the bottom; active only for one category 22 REAL(wp), PUBLIC :: hicmin !: (REMOVE)23 22 REAL(wp), PUBLIC :: hiclim !: minimum ice thickness 24 REAL(wp), PUBLIC :: sbeta !: numerical scheme for diffusion in ice (REMOVE)25 REAL(wp), PUBLIC :: parlat !: (REMOVE)26 REAL(wp), PUBLIC :: hakspl !: (REMOVE)27 REAL(wp), PUBLIC :: hibspl !: (REMOVE)28 REAL(wp), PUBLIC :: exld !: (REMOVE)29 REAL(wp), PUBLIC :: hakdif !: (REMOVE)30 REAL(wp), PUBLIC :: thth !: (REMOVE)31 23 REAL(wp), PUBLIC :: hnzst !: thick. of the surf. layer in temp. comp. 32 24 REAL(wp), PUBLIC :: parsub !: switch for snow sublimation or not 33 REAL(wp), PUBLIC :: alphs !: coef. for snow density when snow-ice formation34 REAL(wp), PUBLIC :: fraz_swi !: use of frazil ice collection in function of wind (1.0) or not (0.0)35 25 REAL(wp), PUBLIC :: maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 36 26 REAL(wp), PUBLIC :: vfrazb !: threshold drift speed for collection of bottom frazil ice 37 27 REAL(wp), PUBLIC :: Cfrazb !: squeezing coefficient for collection of bottom frazil ice 28 REAL(wp), PUBLIC :: hiccrit !: ice th. for lateral accretion in the NH (SH) (m) 38 29 39 REAL(wp), PUBLIC, DIMENSION(2) :: hiccrit !: ice th. for lateral accretion in the NH (SH) (m)30 INTEGER , PUBLIC :: fraz_swi !: use of frazil ice collection in function of wind (1) or not (0) 40 31 41 32 !!----------------------------- … … 43 34 !!----------------------------- 44 35 !: In ice thermodynamics, to spare memory, the vectors are folded 45 !: from 1D to 2D vectors. The following variables, with ending _1d (or _b)36 !: from 1D to 2D vectors. The following variables, with ending _1d 46 37 !: are the variables corresponding to 2d vectors 47 38 … … 49 40 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: correspondance between points (lateral accretion) 50 41 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qldif_1d !: <==> the 2D qldif 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qcmif_1d !: <==> the 2D qcmif 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fstbif_1d !: <==> the 2D fstric 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fltbif_1d !: <==> the 2D ffltbif 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fscbq_1d !: <==> the 2D fscmcbq 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d !: <==> the 2D qsr_ice 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr1_i0_1d !: <==> the 2D fr1_i0 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr2_i0_1d !: <==> the 2D fr2_i0 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qnsr_ice_1d !: <==> the 2D qns_ice 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qfvbq_1d !: <==> the 2D qfvbq 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_bo_b !: <==> the 2D t_bo 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlead_1d 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftr_ice_1d 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr1_i0_1d 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr2_i0_1d 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qns_ice_1d 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_bo_1d 49 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sum_1d 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_bom_1d 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_bog_1d 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_dif_1d 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_opw_1d 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_snw_1d 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_1d 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d 58 59 ! heat flux associated with ice-atmosphere mass exchange 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sub_1d 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_spr_1d 62 63 ! heat flux associated with ice-ocean mass exchange 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_thd_1d 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_res_1d 66 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_1d 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sub_1d 69 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bog_1d 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bom_1d 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sum_1d 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sni_1d 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_opw_1d 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_res_1d 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_spr_1d 77 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bog_1d 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bom_1d 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sum_1d 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sni_1d 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_opw_1d 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_res_1d 62 85 63 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d !: <==> the 2D sprecip 64 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: frld_1d !: <==> the 2D frld 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_b !: <==> the 2D frld 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fbif_1d !: <==> the 2D fbif 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_ice_1d !: <==> the 2D rdm_ice 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_snw_1d !: <==> the 2D rdm_snw 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlbbq_1d !: <==> the 2D qlbsbq 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dmgwi_1d !: <==> the 2D dmgwi 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvsbq_1d !: <==> the 2D rdvosif 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvbbq_1d !: <==> the 2D rdvobif 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvlbq_1d !: <==> the 2D rdvolif 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvnbq_1d !: <==> the 2D rdvolif 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_1d !: <==> the 2D at_i 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhtur_1d !: <==> the 2D fhtur 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d !: <==> the 2D fhld 75 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice 76 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qla_ice_1d !: <==> the 2D qla_ice … … 78 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tatm_ice_1d !: <==> the 2D tatm_ice 79 95 ! ! to reintegrate longwave flux inside the ice thermodynamics 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fsup !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: focea !: Remaining energy in case of total ablation82 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_i_b !: Ice thickness at the beginnning of the time step [m]84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_s_b !: Snow thickness at the beginning of the time step [m]85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d !: <==> the 2D sfx_bri86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhbri_1d !: Heat flux due to brine drainage87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_thd_1d !: <==> the 2D sfx_thd88 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing 89 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage 90 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_se_1d !: Ice salinity variations due to basal salt entrapment 91 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_si_1d !: Ice salinity variations due to lateral accretion 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hicol_ b !: Ice collection thickness accumulated in fleads101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hicol_1d !: Ice collection thickness accumulated in leads 93 102 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_su_b !: <==> the 2D t_su 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_i_b !: <==> the 2D a_i 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_i_b !: <==> the 2D ht_s 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_s_b !: <==> the 2D ht_i 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_su !: Surface Conduction flux 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_bo_i !: Bottom Conduction flux 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_tot !: Snow accretion/ablation [m] 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_surf !: Ice surface accretion/ablation [m] 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bott !: Ice bottom accretion/ablation [m] 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_snowice !: Snow ice formation [m of ice] 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sm_i_b !: Ice bulk salinity [ppt] 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_snowice !: Salinity of new snow ice on top of the ice 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: o_i_b !: Ice age [days] 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_su_1d !: <==> the 2D t_su 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_i_1d !: <==> the 2D a_i 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_i_1d !: <==> the 2D ht_s 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_s_1d !: <==> the 2D ht_i 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_su !: Surface Conduction flux 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_bo_i !: Bottom Conduction flux 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_tot !: Snow accretion/ablation [m] 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_surf !: Ice surface accretion/ablation [m] 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bott !: Ice bottom accretion/ablation [m] 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_snowice !: Snow ice formation [m of ice] 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sm_i_1d !: Ice bulk salinity [ppt] 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom 108 115 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: iatte_1d !: clemattenuation coef of the input solar flux (unitless)110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: oatte_1d !: clemattenuation coef of the input solar flux (unitless)116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: iatte_1d !: attenuation coef of the input solar flux (unitless) 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: oatte_1d !: attenuation coef of the input solar flux (unitless) 111 118 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_ b!: corresponding to the 2D var t_s113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_ b!: corresponding to the 2D var t_i114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: s_i_ b!: profiled ice salinity115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_ b!: Ice enthalpy per unit volume116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_s_ b!: Snow enthalpy per unit volume119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_1d !: corresponding to the 2D var t_s 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_1d !: corresponding to the 2D var t_i 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: s_i_1d !: profiled ice salinity 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_1d !: Ice enthalpy per unit volume 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_s_1d !: Snow enthalpy per unit volume 117 124 118 ! Clean the following ... 119 ! These variables are coded for conservation checks 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_in !: ice energy summed over categories (initial) 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_fin !: ice energy summed over categories (final) 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_s_in, qt_s_fin !: snow energy summed over categories 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i, sum_fluxq !: increment of energy, sum of fluxes 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fatm, foce !: atmospheric, oceanic, heat flux 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cons_error, surf_error !: conservation, surface error 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qh_i_old !: ice heat content (q*h, J.m-2) 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_i_old !: ice thickness layer (m) 126 127 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_in !: goes to trash128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_fin !: goes to trash129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i_layer, radab !: goes to trash130 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_in !: initial total heat flux132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_fin !: final total heat flux133 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_s135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_i136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_s_lay137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_i_lay138 139 128 INTEGER , PUBLIC :: jiindex_1d ! 1D index of debugging point 140 129 … … 151 140 !!---------------------------------------------------------------------! 152 141 INTEGER :: thd_ice_alloc ! return value 153 INTEGER :: ierr( 4)142 INTEGER :: ierr(3) 154 143 !!---------------------------------------------------------------------! 155 144 156 145 ALLOCATE( npb (jpij) , npac (jpij), & 157 146 ! ! 158 & qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d (jpij) , & 159 & fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) , & 160 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) , & 161 & qfvbq_1d (jpij) , t_bo_b (jpij) , iatte_1d (jpij) , & 162 & oatte_1d (jpij) , STAT=ierr(1) ) 147 & qlead_1d (jpij) , ftr_ice_1d (jpij) , & 148 & qsr_ice_1d (jpij) , & 149 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) , & 150 & t_bo_1d (jpij) , iatte_1d (jpij) , oatte_1d (jpij) , & 151 & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij), & 152 & hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 153 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 154 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 155 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij), STAT=ierr(1) ) 163 156 ! 164 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_ b(jpij) , &165 & f bif_1d (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) , &166 & qlbbq_1d (jpij) , dmgwi_1d (jpij) , dvsbq_1d (jpij) ,&167 & dvbbq_1d (jpij) , dvlbq_1d (jpij) , dvnbq_1d (jpij) ,&157 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , & 158 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , & 159 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , & 160 & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d (jpij) , & 168 161 & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) , & 169 & tatm_ice_1d(jpij) , fsup (jpij) , focea (jpij) , & 170 & i0 (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) , & 171 & sfx_bri_1d (jpij) , fhbri_1d (jpij) , sfx_thd_1d (jpij) , & 162 & tatm_ice_1d(jpij) , & 163 & i0 (jpij) , & 164 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) , & 165 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 172 166 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 173 & dsm_i_si_1d(jpij) , hicol_ b(jpij) , STAT=ierr(2) )167 & dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) ) 174 168 ! 175 ALLOCATE( t_su_ b (jpij) , a_i_b (jpij) , ht_i_b(jpij) , &176 & ht_s_ b(jpij) , fc_su (jpij) , fc_bo_i (jpij) , &169 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 170 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 177 171 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , & 178 & dh_snowice(jpij) , sm_i_b (jpij) , s_i_new (jpij) , & 179 & s_snowice (jpij) , o_i_b (jpij) , & 180 ! ! 181 & t_s_b(jpij,nlay_s), & 182 ! ! 183 & t_i_b(jpij,jkmax), s_i_b(jpij,jkmax) , & 184 & q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , STAT=ierr(3)) 172 & dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 173 & t_s_1d(jpij,nlay_s), & 174 & t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1) , & 175 & q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1) , & 176 & qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 185 177 ! 186 ALLOCATE( qt_i_in (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in (jpij,jpl) , &187 & qt_s_fin (jpij,jpl) , dq_i (jpij,jpl) , sum_fluxq (jpij,jpl) , &188 & fatm (jpij,jpl) , foce (jpij,jpl) , cons_error(jpij,jpl) , &189 & surf_error(jpij,jpl) , &190 ! !191 & q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax) , &192 & dq_i_layer (jpij,jkmax) , radab (jpij,jkmax) , &193 ! !194 & ftotal_in(jpij), ftotal_fin(jpij) , &195 ! !196 & fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s) , &197 & fc_i(jpij,0:jkmax) , de_i_lay(jpij,jkmax) , STAT=ierr(4) )198 199 178 thd_ice_alloc = MAXVAL( ierr ) 200 179
Note: See TracChangeset
for help on using the changeset viewer.