- Timestamp:
- 2015-03-04T17:06:03+01:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO
- Files:
-
- 41 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r5056 r5123 35 35 INTEGER , PUBLIC :: nbiter !: number of sub-time steps for relaxation 36 36 INTEGER , PUBLIC :: nbitdr !: maximum number of iterations for relaxation 37 INTEGER , PUBLIC :: n evp!: number of EVP subcycling iterations37 INTEGER , PUBLIC :: nn_nevp !: number of EVP subcycling iterations 38 38 INTEGER , PUBLIC :: telast !: timescale for EVP elastic waves 39 39 REAL(wp), PUBLIC :: epsd !: tolerance parameter for dynamic … … 47 47 REAL(wp), PUBLIC :: c_rhg !: second bulk-rhelogy parameter 48 48 REAL(wp), PUBLIC :: etamn !: minimun value for viscosity 49 REAL(wp), PUBLIC :: creepl!: creep limit50 REAL(wp), PUBLIC :: ecc!: eccentricity of the elliptical yield curve49 REAL(wp), PUBLIC :: rn_creepl !: creep limit 50 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve 51 51 REAL(wp), PUBLIC :: ahi0 !: sea-ice hor. eddy diffusivity coeff. (m2/s) 52 52 REAL(wp), PUBLIC :: alphaevp !: coefficient for the solution of EVP int. stresses 53 REAL(wp), PUBLIC :: hminrhg = 0.001_wp !: clem : ice volume (a*h in m) below which ice velocity is set to ocean velocity 54 55 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( ecc * ecc ) 53 54 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( rn_ecc * rn_ecc ) 56 55 REAL(wp), PUBLIC :: rhoco !: = rau0 * cw 57 56 REAL(wp), PUBLIC :: sangvg, cangvg !: sin and cos of the turning angle for ocean stress -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
r4624 r5123 227 227 NAMELIST/namicedyn/ epsd, alpha, & 228 228 & dm, nbiter, nbitdr, om, resl, cw, angvg, pstar, & 229 & c_rhg, etamn, creepl,ecc, ahi0, &230 & n evp, telast, alphaevp, hminrhg229 & c_rhg, etamn, rn_creepl, rn_ecc, ahi0, & 230 & nn_nevp, telast, alphaevp 231 231 !!------------------------------------------------------------------- 232 232 … … 256 256 WRITE(numout,*) ' second bulk-rhelogy parameter c_rhg = ', c_rhg 257 257 WRITE(numout,*) ' minimun value for viscosity etamn = ', etamn 258 WRITE(numout,*) ' creep limit creepl = ',creepl259 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ',ecc258 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 259 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 260 260 WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0 261 WRITE(numout,*) ' number of iterations for subcycling nevp = ',nevp261 WRITE(numout,*) ' number of iterations for subcycling nn_nevp= ', nn_nevp 262 262 WRITE(numout,*) ' timescale for elastic waves telast = ', telast 263 263 WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp 264 WRITE(numout,*) ' min ice thickness for rheology calculations hminrhg = ', hminrhg265 264 ENDIF 266 265 ! … … 272 271 273 272 ! Initialization 274 usecc2 = 1.0 / ( ecc *ecc )273 usecc2 = 1.0 / ( rn_ecc * rn_ecc ) 275 274 rhoco = rau0 * cw 276 275 angvg = angvg * rad ! convert angvg from degree to radian -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
r3680 r5123 266 266 267 267 ! Creep limit depends on the size of the grid. 268 zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ), creepl)268 zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ), rn_creepl) 269 269 270 270 !- Computation of viscosities. -
trunk/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
r4161 r5123 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2003-08 (M. Vancoppenolle) LIM-3 original code 7 !! 4.0! 2011-02 (G. Madec) dynamical allocation7 !! 3.5 ! 2011-02 (G. Madec) dynamical allocation 8 8 !!---------------------------------------------------------------------- 9 USE par_ice ! LIM-3 parameter10 9 USE in_out_manager ! I/O manager 11 10 USE lib_mpp ! MPP library … … 21 20 INTEGER, PUBLIC :: njeq , njeqm1 !: j-index of the equator if it is inside the domain 22 21 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcor !: coriolis coefficient 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: covrai !: sine of geographic latitude 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: area !: surface of grid cell 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms, tmi !: temperature mask, mask for stress 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmu, tmv !: mask at u and v velocity points 28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmf !: mask at f-point 29 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcor !: coriolis coefficient 30 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages 31 24 … … 44 37 !!------------------------------------------------------------------- 45 38 ! 46 ALLOCATE( fcor(jpi,jpj) , & 47 & covrai(jpi,jpj) , area(jpi,jpj) , & 48 & tms (jpi,jpj) , tmi (jpi,jpj) , & 49 & tmu (jpi,jpj) , tmv (jpi,jpj) , & 50 & tmf (jpi,jpj) , & 51 & wght(jpi,jpj,2,2) , STAT = dom_ice_alloc ) 39 ALLOCATE( fcor(jpi,jpj), wght(jpi,jpj,2,2), STAT = dom_ice_alloc ) 52 40 ! 53 41 IF( dom_ice_alloc /= 0 ) CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r4990 r5123 11 11 !! 'key_lim3' LIM-3 sea-ice model 12 12 !!---------------------------------------------------------------------- 13 USE par_ice ! LIM sea-ice parameters14 13 USE in_out_manager ! I/O manager 15 14 USE lib_mpp ! MPP library … … 18 17 PRIVATE 19 18 20 PUBLIC ice_alloc ! Called in iceini.F9019 PUBLIC ice_alloc ! Called in sbc_lim_init 21 20 22 21 !!====================================================================== … … 110 109 !! smv_i | - | Sea ice salt content | ppt.m | 111 110 !! oa_i ! - ! Sea ice areal age content | day | 112 !! e_i ! - ! Ice enthalpy | 10^9 J|111 !! e_i ! - ! Ice enthalpy | J/m2 | 113 112 !! - ! q_i_1d ! Ice enthalpy per unit vol. | J/m3 | 114 !! e_s ! - ! Snow enthalpy | 10^9 J|113 !! e_s ! - ! Snow enthalpy | J/m2 | 115 114 !! - ! q_s_1d ! Snow enthalpy per unit vol. | J/m3 | 116 115 !! | … … 148 147 !! tm_i | - | Mean sea ice temperature | K | 149 148 !! ot_i ! - ! Sea ice areal age content | day | 150 !! et_i ! - ! Total ice enthalpy | 10^9 J|151 !! et_s ! - ! Total snow enthalpy | 10^9 J|149 !! et_i ! - ! Total ice enthalpy | J/m2 | 150 !! et_s ! - ! Total snow enthalpy | J/m2 | 152 151 !! bv_i ! - ! Mean relative brine volume | ??? | 153 152 !!===================================================================== … … 165 164 REAL(wp), PUBLIC :: r1_rdtice !: = 1. / rdt_ice 166 165 167 ! !!** ice-dynamic namelist (namicedyn) ** 168 INTEGER , PUBLIC :: nevp !: number of iterations for subcycling 169 REAL(wp), PUBLIC :: epsd !: tolerance parameter for dynamic 170 REAL(wp), PUBLIC :: om !: relaxation constant 171 REAL(wp), PUBLIC :: cw !: drag coefficient for oceanic stress 172 REAL(wp), PUBLIC :: pstar !: determines ice strength (N/M), Hibler JPO79 173 REAL(wp), PUBLIC :: c_rhg !: determines changes in ice strength 174 REAL(wp), PUBLIC :: creepl !: creep limit : has to be under 1.0e-9 175 REAL(wp), PUBLIC :: ecc !: eccentricity of the elliptical yield curve 176 REAL(wp), PUBLIC :: ahi0 !: sea-ice hor. eddy diffusivity coeff. (m2/s) 177 REAL(wp), PUBLIC :: telast !: timescale for elastic waves (s) 178 REAL(wp), PUBLIC :: relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 179 REAL(wp), PUBLIC :: alphaevp !: coeficient of the internal stresses 180 REAL(wp), PUBLIC :: hminrhg !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 166 ! !!** ice-thickness distribution namelist (namiceitd) ** 167 INTEGER , PUBLIC :: nn_catbnd !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 168 REAL(wp), PUBLIC :: rn_himean !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 169 170 ! !!** ice-dynamics namelist (namicedyn) ** 171 LOGICAL , PUBLIC :: ln_icestr_bvf !: use brine volume to diminish ice strength 172 INTEGER , PUBLIC :: nn_icestr !: ice strength parameterization (0=Hibler79 1=Rothrock75) 173 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling 174 INTEGER , PUBLIC :: nn_ahi0 !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 175 REAL(wp), PUBLIC :: rn_pe_rdg !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 176 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress 177 REAL(wp), PUBLIC :: rn_pstar !: determines ice strength (N/M), Hibler JPO79 178 REAL(wp), PUBLIC :: rn_crhg !: determines changes in ice strength 179 REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9 180 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve 181 REAL(wp), PUBLIC :: rn_ahi0_ref !: sea-ice hor. eddy diffusivity coeff. (m2/s) 182 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 181 183 182 184 ! !!** ice-salinity namelist (namicesal) ** 183 REAL(wp), PUBLIC :: s_i_max !: maximum ice salinity [PSU] 184 REAL(wp), PUBLIC :: s_i_min !: minimum ice salinity [PSU] 185 REAL(wp), PUBLIC :: s_i_0 !: 1st sal. value for the computation of sal .prof. [PSU] 186 REAL(wp), PUBLIC :: s_i_1 !: 2nd sal. value for the computation of sal .prof. [PSU] 187 REAL(wp), PUBLIC :: sal_G !: restoring salinity for gravity drainage [PSU] 188 REAL(wp), PUBLIC :: sal_F !: restoring salinity for flushing [PSU] 189 REAL(wp), PUBLIC :: time_G !: restoring time constant for gravity drainage (= 20 days) [s] 190 REAL(wp), PUBLIC :: time_F !: restoring time constant for gravity drainage (= 10 days) [s] 191 REAL(wp), PUBLIC :: bulk_sal !: bulk salinity (ppt) in case of constant salinity 185 REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU] 186 REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU] 187 REAL(wp), PUBLIC :: rn_sal_gd !: restoring salinity for gravity drainage [PSU] 188 REAL(wp), PUBLIC :: rn_sal_fl !: restoring salinity for flushing [PSU] 189 REAL(wp), PUBLIC :: rn_time_gd !: restoring time constant for gravity drainage (= 20 days) [s] 190 REAL(wp), PUBLIC :: rn_time_fl !: restoring time constant for gravity drainage (= 10 days) [s] 191 REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity 192 192 193 193 ! !!** ice-salinity namelist (namicesal) ** 194 INTEGER , PUBLIC :: n um_sal!: salinity configuration used in the model194 INTEGER , PUBLIC :: nn_icesal !: salinity configuration used in the model 195 195 ! ! 1 - constant salinity in both space and time 196 196 ! ! 2 - prognostic salinity (s(z,t)) 197 197 ! ! 3 - salinity profile, constant in time 198 INTEGER , PUBLIC :: thcon_i_swi !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 198 INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 199 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0) 199 200 200 201 ! !!** ice-mechanical redistribution namelist (namiceitdme) 201 REAL(wp), PUBLIC :: Cs !: fraction of shearing energy contributing to ridging 202 REAL(wp), PUBLIC :: Cf !: ratio of ridging work to PE loss 203 REAL(wp), PUBLIC :: fsnowrdg !: fractional snow loss to the ocean during ridging 204 REAL(wp), PUBLIC :: fsnowrft !: fractional snow loss to the ocean during ridging 205 REAL(wp), PUBLIC :: Gstar !: fractional area of young ice contributing to ridging 206 REAL(wp), PUBLIC :: astar !: equivalent of G* for an exponential participation function 207 REAL(wp), PUBLIC :: Hstar !: thickness that determines the maximal thickness of ridged ice 208 REAL(wp), PUBLIC :: hparmeter !: threshold thickness (m) for rafting / ridging 209 REAL(wp), PUBLIC :: Craft !: coefficient for smoothness of the hyperbolic tangent in rafting 210 REAL(wp), PUBLIC :: ridge_por !: initial porosity of ridges (0.3 regular value) 211 REAL(wp), PUBLIC :: betas !: coef. for partitioning of snowfall between leads and sea ice 212 REAL(wp), PUBLIC :: kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 213 REAL(wp), PUBLIC :: nconv_i_thd !: maximal number of iterations for heat diffusion 214 REAL(wp), PUBLIC :: maxer_i_thd !: maximal tolerated error (C) for heat diffusion 202 REAL(wp), PUBLIC :: rn_cs !: fraction of shearing energy contributing to ridging 203 REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging 204 REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging 205 REAL(wp), PUBLIC :: rn_gstar !: fractional area of young ice contributing to ridging 206 REAL(wp), PUBLIC :: rn_astar !: equivalent of G* for an exponential participation function 207 REAL(wp), PUBLIC :: rn_hstar !: thickness that determines the maximal thickness of ridged ice 208 REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging 209 REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting 210 REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value) 211 REAL(wp), PUBLIC :: rn_betas !: coef. for partitioning of snowfall between leads and sea ice 212 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 213 REAL(wp), PUBLIC :: nn_conv_dif !: maximal number of iterations for heat diffusion 214 REAL(wp), PUBLIC :: rn_terr_dif !: maximal tolerated error (C) for heat diffusion 215 215 216 216 ! !!** ice-mechanical redistribution namelist (namiceitdme) 217 INTEGER , PUBLIC :: ridge_scheme_swi !: scheme used for ice ridging218 INTEGER , PUBLIC :: raft_swi !: rafting of ice or not219 INTEGER , PUBLIC :: partfun_swi !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 220 INTEGER , PUBLIC :: brinstren_swi !: use brine volume to diminish ice strength221 222 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( ecc * ecc )223 REAL(wp), PUBLIC :: r hoco !: = rau0 * cw224 217 LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not 218 INTEGER , PUBLIC :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 219 220 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( rn_ecc * rn_ecc ) 221 REAL(wp), PUBLIC :: rhoco !: = rau0 * cio 222 REAL(wp), PUBLIC :: r1_nlay_i !: 1 / nlay_i 223 REAL(wp), PUBLIC :: r1_nlay_s !: 1 / nlay_s 224 ! 225 225 ! !!** switch for presence of ice or not 226 226 REAL(wp), PUBLIC :: rswitch 227 227 ! 228 228 ! !!** define some parameters 229 REAL(wp), PUBLIC, PARAMETER :: unit_fac = 1.e+09_wp !: conversion factor for ice / snow enthalpy230 229 REAL(wp), PUBLIC, PARAMETER :: epsi06 = 1.e-06_wp !: small number 231 230 REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_wp !: small number … … 266 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg/m2] 267 266 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1] 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_thd !: ice concentration tendency (thermodynamics) [s-1] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_dyn !: ice concentration tendency (dynamics) [s-1] 270 268 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] 269 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s] … … 296 299 297 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 298 299 ! temporary arrays for dummy version of the code300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, q_s301 301 302 302 !!-------------------------------------------------------------------------- … … 333 333 334 334 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [Giga J]335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [J/m2] 336 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i !: ice salinities [PSU] 337 337 … … 356 356 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures 357 357 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity 358 359 360 !!-------------------------------------------------------------------------- 361 !! * Increment of global variables 362 !!-------------------------------------------------------------------------- 358 359 !!-------------------------------------------------------------------------- 360 !! * Ice thickness distribution variables 361 !!-------------------------------------------------------------------------- 362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 363 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 364 365 !!-------------------------------------------------------------------------- 366 !! * Ice Run 367 !!-------------------------------------------------------------------------- 368 ! !!: ** Namelist namicerun read in sbc_lim_init ** 369 INTEGER , PUBLIC :: jpl !: number of ice categories 370 INTEGER , PUBLIC :: nlay_i !: number of ice layers 371 INTEGER , PUBLIC :: nlay_s !: number of snow layers 372 CHARACTER(len=32), PUBLIC :: cn_icerst_in !: suffix of ice restart name (input) 373 CHARACTER(len=32), PUBLIC :: cn_icerst_out !: suffix of ice restart name (output) 374 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 375 LOGICAL , PUBLIC :: ln_nicep !: flag for sea-ice points output (T) or not (F) 376 REAL(wp) , PUBLIC :: rn_amax !: maximum ice concentration 377 ! 378 !!-------------------------------------------------------------------------- 379 !! * Ice diagnostics 380 !!-------------------------------------------------------------------------- 381 ! Increment of global variables 363 382 ! thd refers to changes induced by thermodynamics 364 383 ! trp '' '' '' advection (transport of ice) 365 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_a_i_thd , d_a_i_trp !: icefractions 366 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_s_thd , d_v_s_trp !: snow volume 367 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_i_thd , d_v_i_trp !: ice volume 368 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_smv_i_thd, d_smv_i_trp !: 369 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_sm_i_fl , d_sm_i_gd !: 370 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_sm_i_se , d_sm_i_si , d_sm_i_la !: 371 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_oa_i_thd , d_oa_i_trp !: 372 373 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_s_thd , d_e_s_trp !: 374 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_i_thd , d_e_i_trp !: 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: d_u_ice_dyn, d_v_ice_dyn !: ice velocity 376 377 !!-------------------------------------------------------------------------- 378 !! * Ice thickness distribution variables 379 !!-------------------------------------------------------------------------- 380 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 381 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 382 383 !!-------------------------------------------------------------------------- 384 !! * Ice Run 385 !!-------------------------------------------------------------------------- 386 ! !!: ** Namelist namicerun read in iceini ** 387 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input) 388 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output) 389 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 390 LOGICAL , PUBLIC :: ln_nicep !: flag for sea-ice points output (T) or not (F) 391 REAL(wp) , PUBLIC :: cai !: atmospheric drag over sea ice 392 REAL(wp) , PUBLIC :: cao !: atmospheric drag over ocean 393 REAL(wp) , PUBLIC :: amax !: maximum ice concentration 384 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 385 LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F) 386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 387 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume 388 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2) 389 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2) 390 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_smv !: transport of salt content 394 391 ! 395 !!-------------------------------------------------------------------------- 396 !! * Ice diagnostics 397 !!-------------------------------------------------------------------------- 398 !! Check if everything down here is necessary 399 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 400 LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F) 401 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates 402 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 403 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume 404 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2) 405 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2) 406 ! 407 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat_dhc !: snw/ice heat content variation [W/m2] 392 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat_dhc !: snw/ice heat content variation [W/m2] 408 393 ! 409 394 INTEGER , PUBLIC :: jiindx, jjindx !: indexes of the debugging point … … 422 407 INTEGER :: ice_alloc 423 408 ! 424 INTEGER :: ierr(1 9), ii409 INTEGER :: ierr(17), ii 425 410 !!----------------------------------------------------------------- 426 411 … … 439 424 440 425 ii = ii + 1 441 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , &442 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , &443 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , &426 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , & 427 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 428 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , & 444 429 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 445 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , qlead (jpi,jpj) , & 446 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl) , & 447 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 448 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 430 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 431 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , & 432 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead (jpi,jpj) , & 433 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 434 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 449 435 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 450 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) , &451 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , &436 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) , & 437 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 452 438 & hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , STAT=ierr(ii) ) 453 439 … … 464 450 & bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) ) 465 451 ii = ii + 1 466 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , & 467 & e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 452 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 468 453 ii = ii + 1 469 454 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) ) … … 489 474 ii = ii + 1 490 475 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 491 & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) , & 492 & oa_i_b (jpi,jpj,jpl) , & 493 & u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 494 495 ! * Increment of global variables 496 ii = ii + 1 497 ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd (jpi,jpj,jpl) , d_v_s_trp (jpi,jpj,jpl) , & 498 & d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) , & 499 & d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se (jpi,jpj,jpl) , d_sm_i_si (jpi,jpj,jpl) , & 500 & d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , & 501 & STAT=ierr(ii) ) 502 ii = ii + 1 503 ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) , & 504 & d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 476 & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) , & 477 & oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 505 478 506 479 ! * Ice thickness distribution variables … … 510 483 ! * Ice diagnostics 511 484 ii = ii + 1 512 ALLOCATE( dv_dt_thd(jpi,jpj,jpl), & 513 & diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj), & 514 & diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj), STAT=ierr(ii) ) 485 ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei (jpi,jpj), & 486 & diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat_dhc(jpi,jpj), STAT=ierr(ii) ) 515 487 516 488 ice_alloc = MAXVAL( ierr(:) ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r4990 r5123 63 63 !! 64 64 INTEGER :: ji, jj ! dummy loop indices 65 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp , zin0! local scalars65 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp ! local scalars 66 66 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 67 67 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - … … 85 85 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 86 86 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) ) 87 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask87 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 88 88 89 89 ps0 (ji,jj) = zslpmax 90 psx (ji,jj) = zs1new * zin091 psxx(ji,jj) = zs2new * zin092 psy (ji,jj) = psy (ji,jj) * zin093 psyy(ji,jj) = psyy(ji,jj) * zin094 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin090 psx (ji,jj) = zs1new * rswitch 91 psxx(ji,jj) = zs2new * rswitch 92 psy (ji,jj) = psy (ji,jj) * rswitch 93 psyy(ji,jj) = psyy(ji,jj) * rswitch 94 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 95 95 END DO 96 96 END DO 97 97 98 98 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 99 psm (:,:) = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )99 psm (:,:) = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 100 100 101 101 ! Calculate fluxes and moments between boxes i<-->i+1 … … 248 248 !! 249 249 INTEGER :: ji, jj ! dummy loop indices 250 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp , zin0! temporary scalars250 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp ! temporary scalars 251 251 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 252 252 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - … … 270 270 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 271 271 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 272 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask272 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 273 273 ! 274 274 ps0 (ji,jj) = zslpmax 275 psx (ji,jj) = psx (ji,jj) * zin0276 psxx(ji,jj) = psxx(ji,jj) * zin0277 psy (ji,jj) = zs1new * zin0278 psyy(ji,jj) = zs2new * zin0279 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0275 psx (ji,jj) = psx (ji,jj) * rswitch 276 psxx(ji,jj) = psxx(ji,jj) * rswitch 277 psy (ji,jj) = zs1new * rswitch 278 psyy(ji,jj) = zs2new * rswitch 279 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 280 280 END DO 281 281 END DO 282 282 283 283 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 284 psm(:,:) = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )284 psm(:,:) = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 285 285 286 286 ! Calculate fluxes and moments between boxes j<-->j+1 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r4873 r5123 6 6 !! History : - ! Original code from William H. Lipscomb, LANL 7 7 !! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation 8 !! 4.0! 2011-02 (G. Madec) add mpp considerations8 !! 3.5 ! 2011-02 (G. Madec) add mpp considerations 9 9 !! - ! 2014-05 (C. Rousset) add lim_cons_hsm 10 10 !!---------------------------------------------------------------------- … … 16 16 !!---------------------------------------------------------------------- 17 17 USE phycst ! physical constants 18 USE par_ice ! LIM-3 parameter19 18 USE ice ! LIM-3 variables 20 19 USE dom_ice ! LIM-3 domain … … 168 167 REAL(wp) :: zvi, zsmv, zei, zfs, zfw, zft 169 168 REAL(wp) :: zvmin, zamin, zamax 169 REAL(wp) :: zconv 170 171 zconv = 1.e-9 170 172 171 173 IF( icount == 0 ) THEN 172 174 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(:,:) ) 175 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 176 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 177 & ) * e12t(:,:) * tmask(:,:,1) ) 178 179 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 180 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 181 & ) * e12t(:,:) * tmask(:,:,1) ) 182 183 zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 184 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 185 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) 186 187 zvi_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * e12t(:,:) * tmask(:,:,1) ) 188 189 zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) 190 191 zei_b = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + & 192 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) & 193 ) * e12t(:,:) * tmask(:,:,1) * zconv ) 185 194 186 195 ELSEIF( icount == 1 ) THEN 187 196 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 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 198 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 199 & ) * e12t(:,:) * tmask(:,:,1) ) - zfs_b 200 201 zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 202 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 203 & ) * e12t(:,:) * tmask(:,:,1) ) - zfw_b 204 205 zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 206 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 207 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b 197 208 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) 209 zvi = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) & 210 & * e12t(:,:) * tmask(:,:,1) ) - zvi_b ) * r1_rdtice - zfw 211 212 zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) - zsmv_b ) * r1_rdtice + ( zfs * r1_rhoic ) 213 214 zei = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + & 215 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) & 216 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 217 218 zvmin = glob_min( v_i ) 219 zamax = glob_max( SUM( a_i, dim=3 ) ) 220 zamin = glob_min( a_i ) 205 221 206 222 IF(lwp) THEN 207 223 IF ( ABS( zvi ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (',cd_routine,') = ',(zvi * rday) 208 224 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 ) THEN225 IF ( ABS( zei ) > 1.e-4 ) WRITE(numout,*) 'violation enthalpy [GW] (',cd_routine,') = ',(zei) 226 IF ( zvmin < -epsi10 ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',(zvmin) 227 IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > rn_amax+epsi10 ) THEN 212 228 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 213 229 ENDIF 214 IF ( zamin < 0.) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin230 IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 215 231 ENDIF 216 232 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r4990 r5123 14 14 !!---------------------------------------------------------------------- 15 15 USE ice ! LIM-3: sea-ice variable 16 USE par_ice ! LIM-3: ice parameters17 16 USE dom_ice ! LIM-3: sea-ice domain 18 17 USE dom_oce ! ocean domain … … 32 31 33 32 PUBLIC lim_diahsb ! routine called by ice_step.F90 34 !!PUBLIC lim_diahsb_init ! routine called by ice_init.F9035 !!PUBLIC lim_diahsb_rst ! routine called by ice_init.F9036 33 37 34 real(wp) :: frc_sal, frc_vol ! global forcing trends … … 74 71 75 72 ! 1/area 76 z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 )77 78 rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) )73 z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 ) 74 75 rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 79 76 ! ----------------------- ! 80 77 ! 1 - Content variations ! 81 78 ! ----------------------- ! 82 zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice83 zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow84 zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area85 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) ! mean salt content86 zbg_tem = glob_sum( ( tm_i(:,:) - rt t ) * vt_i(:,:) * area(:,:) * tms(:,:) ) ! mean temp content87 88 !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content89 !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content79 zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice 80 zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow 81 zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area 82 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) ! mean salt content 83 zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! mean temp content 84 85 !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 86 !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 90 87 91 88 ! Volume 92 89 ztmp = rswitch * z1_area * r1_rau0 * rday 93 zbg_vfx = ztmp * glob_sum( emp(:,:) * area(:,:) * tms(:,:) )94 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) )95 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) )96 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) )97 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) )98 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) )99 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) )100 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) )101 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) )102 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) )103 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) )90 zbg_vfx = ztmp * glob_sum( emp(:,:) * e12t(:,:) * tmask(:,:,1) ) 91 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 92 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 93 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 94 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 95 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 96 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 97 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 98 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) 99 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) 100 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 104 101 105 102 ! Salt 106 zbg_sfx = ztmp * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) )107 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) )108 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) )109 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) )110 111 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) )112 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) )113 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) )114 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) )115 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) )103 zbg_sfx = ztmp * glob_sum( sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) 104 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) ) 105 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 106 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 107 108 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 109 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 110 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 111 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 112 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 116 113 117 114 ! 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]115 zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content [1.e20 J] 116 zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 117 zbg_hfx_dhc = glob_sum( diag_heat_dhc(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 118 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 119 120 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 121 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 122 zbg_hfx_res = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 123 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 124 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 125 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 126 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 127 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 128 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 129 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 130 zbg_hfx_out = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 131 zbg_hfx_in = glob_sum( hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 135 132 136 133 ! --------------------------------------------- ! 137 134 ! 2 - Trends due to forcing and ice growth/melt ! 138 135 ! --------------------------------------------- ! 139 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes140 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes136 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 137 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes 141 138 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 139 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 140 & wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 143 141 ! 144 142 frc_vol = frc_vol + z_frc_vol * rdt_ice -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r4990 r5123 6 6 !! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code 7 7 !! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid 8 !! 4.0! 2011-02 (G. Madec) dynamical allocation8 !! 3.5 ! 2011-02 (G. Madec) dynamical allocation 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_lim3 … … 20 20 USE sbc_ice ! Surface boundary condition: ice fields 21 21 USE ice ! LIM-3 variables 22 USE par_ice ! LIM-3 parameters23 22 USE dom_ice ! LIM-3 domain 24 23 USE limrhg ! LIM-3 rheology … … 31 30 USE timing ! Timing 32 31 USE limcons ! conservation tests 32 USE limvar 33 33 34 34 IMPLICIT NONE … … 76 76 CALL wrk_alloc( jpj, zswitch, zmsk ) 77 77 78 CALL lim_var_agg(1) ! aggregate ice categories 79 78 80 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) 79 81 … … 83 85 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 84 86 85 u_ice_b(:,:) = u_ice(:,:) * tmu(:,:)86 v_ice_b(:,:) = v_ice(:,:) * tmv(:,:)87 u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 88 v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 87 89 88 90 ! Rheology (ice dynamics) … … 101 103 DO jj = 1, jpj 102 104 zswitch(jj) = SUM( 1.0 - at_i(:,jj) ) ! = REAL(jpj) if ocean everywhere on a j-line 103 zmsk (jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line105 zmsk (jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line 104 106 END DO 105 107 … … 157 159 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 158 160 ! frictional velocity at T-point 159 zcoef = 0.5_wp * cw161 zcoef = 0.5_wp * rn_cio 160 162 DO jj = 2, jpjm1 161 163 DO ji = fs_2, fs_jpim1 ! vector opt. 162 164 ust2s(ji,jj) = zcoef * ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 163 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tms(ji,jj)165 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1) 164 166 END DO 165 167 END DO … … 170 172 ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean 171 173 ! 172 zcoef = SQRT( 0.5_wp ) /rau0174 zcoef = SQRT( 0.5_wp ) * r1_rau0 173 175 DO jj = 2, jpjm1 174 176 DO ji = fs_2, fs_jpim1 ! vector opt. 175 177 ust2s(ji,jj) = zcoef * SQRT( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 176 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tms(ji,jj)178 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1) 177 179 END DO 178 180 END DO … … 189 191 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' lim_dyn : delta_i :') 190 192 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_dyn : strength :') 191 CALL prt_ctl(tab2d_1= area, clinfo1=' lim_dyn : cell area :')193 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_dyn : cell area :') 192 194 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_dyn : at_i :') 193 195 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_dyn : vt_i :') … … 241 243 !!------------------------------------------------------------------- 242 244 INTEGER :: ios ! Local integer output status for namelist read 243 NAMELIST/namicedyn/ epsd, om, cw, pstar, & 244 & c_rhg, creepl, ecc, ahi0, & 245 & nevp, relast, alphaevp, hminrhg 245 NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, & 246 & nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref 247 INTEGER :: ji, jj 248 REAL(wp) :: za00, zd_max 246 249 !!------------------------------------------------------------------- 247 250 … … 259 262 WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 260 263 WRITE(numout,*) '~~~~~~~~~~~~' 261 WRITE(numout,*) ' tolerance parameter epsd = ', epsd262 WRITE(numout,*) ' relaxation constant om = ', om263 WRITE(numout,*) ' drag coefficient for oceanic stress cw = ', cw264 WRITE(numout,*) ' first bulk-rheology parameter pstar = ', pstar265 WRITE(numout,*) ' second bulk-rhelogy parameter c_rhg = ', c_rhg266 WRITE(numout,*) ' creep limit creepl = ', creepl267 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc268 WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0269 WRITE(numout,*) ' number of iterations for subcycling nevp = ',nevp270 WRITE(numout,*) ' ratio of elastic timescale over ice time step relast = ',relast271 WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp272 WRITE(numout,*) ' min ice thickness for rheology calculations hminrhg = ', hminrhg264 WRITE(numout,*)' ice strength parameterization (0=Hibler 1=Rothrock) nn_icestr = ', nn_icestr 265 WRITE(numout,*)' Including brine volume in ice strength comp. ln_icestr_bvf = ', ln_icestr_bvf 266 WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging rn_pe_rdg = ', rn_pe_rdg 267 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio 268 WRITE(numout,*) ' first bulk-rheology parameter rn_pstar = ', rn_pstar 269 WRITE(numout,*) ' second bulk-rhelogy parameter rn_crhg = ', rn_crhg 270 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 271 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 272 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 273 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 274 WRITE(numout,*) ' horizontal diffusivity calculation nn_ahi0 = ', nn_ahi0 275 WRITE(numout,*) ' horizontal diffusivity coeff. (orca2 grid) rn_ahi0_ref = ', rn_ahi0_ref 273 276 ENDIF 274 277 ! 275 usecc2 = 1._wp / ( ecc * ecc ) 276 rhoco = rau0 * cw 277 278 ! elastic damping 279 telast = relast * rdt_ice 280 281 ! Diffusion coefficients. 282 ahiu(:,:) = ahi0 * umask(:,:,1) 283 ahiv(:,:) = ahi0 * vmask(:,:,1) 284 ! 278 usecc2 = 1._wp / ( rn_ecc * rn_ecc ) 279 rhoco = rau0 * rn_cio 280 ! 281 ! Diffusion coefficients 282 SELECT CASE( nn_ahi0 ) 283 284 CASE( 0 ) 285 ahiu(:,:) = rn_ahi0_ref 286 ahiv(:,:) = rn_ahi0_ref 287 288 IF(lwp) WRITE(numout,*) '' 289 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim constant = rn_ahi0_ref' 290 291 CASE( 1 ) 292 293 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 294 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 295 296 ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2 297 ! (60° = min latitude for ice cover) 298 ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 299 300 IF(lwp) WRITE(numout,*) '' 301 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 302 IF(lwp) WRITE(numout,*) ' value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp 303 304 CASE( 2 ) 305 306 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 307 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 308 309 za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2 310 ! (60° = min latitude for ice cover) 311 DO jj = 1, jpj 312 DO ji = 1, jpi 313 ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 314 ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 315 END DO 316 END DO 317 ! 318 IF(lwp) WRITE(numout,*) '' 319 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to e1' 320 IF(lwp) WRITE(numout,*) ' maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 321 322 END SELECT 323 285 324 END SUBROUTINE lim_dyn_init 286 325 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r4990 r5123 26 26 PRIVATE 27 27 28 PUBLIC lim_hdf ! called by lim_tr a28 PUBLIC lim_hdf ! called by lim_trp 29 29 30 LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call) 31 REAL(wp) :: epsi04 = 1.e-04 ! constant 30 LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call) 32 31 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! metric coefficient 33 32 … … 54 53 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 55 54 ! 56 INTEGER :: ji, jj ! dummy loop indices 57 INTEGER :: its, iter, ierr ! local integers 58 REAL(wp) :: zalfa, zrlxint, zconv ! local scalars 59 REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 60 CHARACTER(lc) :: charout ! local character 55 INTEGER :: ji, jj ! dummy loop indices 56 INTEGER :: iter, ierr ! local integers 57 REAL(wp) :: zrlxint, zconv ! local scalars 58 REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 59 CHARACTER(lc) :: charout ! local character 60 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure 61 REAL(wp), PARAMETER :: zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 62 INTEGER , PARAMETER :: its = 100 ! Maximum number of iteration 61 63 !!------------------------------------------------------------------- 62 64 … … 71 73 DO jj = 2, jpjm1 72 74 DO ji = fs_2 , fs_jpim1 ! vector opt. 73 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj))75 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj) 74 76 END DO 75 77 END DO … … 77 79 ENDIF 78 80 ! ! Time integration parameters 79 zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit80 its = 100 ! Maximum number of iteration81 81 ! 82 82 ztab0(:, : ) = ptab(:,:) ! Arrays initialization … … 91 91 iter = 0 92 92 ! 93 DO WHILE( zconv > ( 2._wp * epsi04 ) .AND. iter <= its ) ! Sub-time step loop93 DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop 94 94 ! 95 95 iter = iter + 1 ! incrementation of the sub-time step number … … 97 97 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 98 98 DO ji = 1 , fs_jpim1 ! vector opt. 99 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) /e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )100 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) /e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )99 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 100 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 101 101 END DO 102 102 END DO … … 104 104 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 105 105 DO ji = fs_2 , fs_jpim1 ! vector opt. 106 zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) & 107 & + zflv(ji,jj) - zflv(ji ,jj-1) ) / ( e1t (ji,jj) * e2t (ji,jj) ) 106 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 108 107 END DO 109 108 END DO … … 115 114 zrlxint = ( ztab0(ji,jj) & 116 115 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) & 117 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) )&118 & / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )119 zrlx(ji,jj) = ptab(ji,jj) + om* ( zrlxint - ptab(ji,jj) )116 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) & 117 & ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 118 zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) ) 120 119 END DO 121 120 END DO … … 138 137 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 139 138 DO ji = 1 , fs_jpim1 ! vector opt. 140 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) /e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )141 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) /e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )139 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 140 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 142 141 END DO 143 142 END DO … … 145 144 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 146 145 DO ji = fs_2 , fs_jpim1 ! vector opt. 147 zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) & 148 & + zflv(ji,jj) - zflv(ji ,jj-1) ) / ( e1t (ji,jj) * e2t (ji,jj) ) 146 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 149 147 ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 150 148 END DO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4990 r5123 22 22 USE eosbn2 ! equation of state 23 23 USE ice ! sea-ice variables 24 USE par_ice ! ice parameters25 24 USE par_oce ! ocean parameters 26 25 USE dom_ice ! sea-ice domain … … 36 35 37 36 ! !!** init namelist (namiceini) ** 38 REAL(wp) :: thres_sst ! threshold water temperature for initial sea ice39 REAL(wp) :: hts_ini_n ! initial snow thickness in the north40 REAL(wp) :: hts_ini_s ! initial snow thickness in the south41 REAL(wp) :: hti_ini_n ! initial ice thickness in the north42 REAL(wp) :: hti_ini_s ! initial ice thickness in the south43 REAL(wp) :: ati_ini_n ! initial leads area in the north44 REAL(wp) :: ati_ini_s ! initial leads area in the south45 REAL(wp) :: smi_ini_n ! initial salinity46 REAL(wp) :: smi_ini_s ! initial salinity47 REAL(wp) :: tmi_ini_n ! initial temperature48 REAL(wp) :: tmi_ini_s ! initial temperature49 50 LOGICAL :: ln_ limini ! initialization or not37 REAL(wp) :: rn_thres_sst ! threshold water temperature for initial sea ice 38 REAL(wp) :: rn_hts_ini_n ! initial snow thickness in the north 39 REAL(wp) :: rn_hts_ini_s ! initial snow thickness in the south 40 REAL(wp) :: rn_hti_ini_n ! initial ice thickness in the north 41 REAL(wp) :: rn_hti_ini_s ! initial ice thickness in the south 42 REAL(wp) :: rn_ati_ini_n ! initial leads area in the north 43 REAL(wp) :: rn_ati_ini_s ! initial leads area in the south 44 REAL(wp) :: rn_smi_ini_n ! initial salinity 45 REAL(wp) :: rn_smi_ini_s ! initial salinity 46 REAL(wp) :: rn_tmi_ini_n ! initial temperature 47 REAL(wp) :: rn_tmi_ini_s ! initial temperature 48 49 LOGICAL :: ln_iceini ! initialization or not 51 50 !!---------------------------------------------------------------------- 52 51 !! LIM 3.0, UCL-LOCEAN-IPSL (2008) … … 87 86 !! * Local variables 88 87 INTEGER :: ji, jj, jk, jl ! dummy loop indices 89 REAL(wp) :: epsi20,ztmelts, zdh88 REAL(wp) :: ztmelts, zdh 90 89 INTEGER :: i_hemis, i_fill, jl0 91 90 REAL(wp) :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv … … 101 100 CALL wrk_alloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 102 101 103 epsi20 = 1.e-20_wp104 105 102 IF(lwp) WRITE(numout,*) 106 103 IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' … … 115 112 ! surface temperature 116 113 DO jl = 1, jpl ! loop over categories 117 t_su (:,:,jl) = rt t * tms(:,:)118 tn_ice(:,:,jl) = rt t * tms(:,:)114 t_su (:,:,jl) = rt0 * tmask(:,:,1) 115 tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 119 116 END DO 120 117 121 118 ! basal temperature (considered at freezing point) 122 t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tm s(:,:)123 124 IF( ln_ limini ) THEN119 t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tmask(:,:,1) 120 121 IF( ln_iceini ) THEN 125 122 126 123 !-------------------------------------------------------------------- … … 130 127 DO jj = 1, jpj ! ice if sst <= t-freez + ttest 131 128 DO ji = 1, jpi 132 IF( ( tsn(ji,jj,1,jp_tem) - ( t_bo(ji,jj) - rt0 ) ) * tm s(ji,jj) >=thres_sst ) THEN133 zswitch(ji,jj) = 0._wp * tm s(ji,jj) ! no ice129 IF( ( tsn(ji,jj,1,jp_tem) - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 130 zswitch(ji,jj) = 0._wp * tmask(ji,jj,1) ! no ice 134 131 ELSE 135 zswitch(ji,jj) = 1._wp * tm s(ji,jj) ! ice132 zswitch(ji,jj) = 1._wp * tmask(ji,jj,1) ! ice 136 133 ENDIF 137 134 END DO … … 158 155 !----------------------------- 159 156 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 160 zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) =hti_ini_s ! ice thickness161 zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) =hts_ini_s ! snow depth162 zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) =ati_ini_s ! ice concentration163 zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) =smi_ini_s ! bulk ice salinity164 ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) =tmi_ini_s ! temperature (ice and snow)157 zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s ! ice thickness 158 zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s ! snow depth 159 zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s ! ice concentration 160 zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s ! bulk ice salinity 161 ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s ! temperature (ice and snow) 165 162 166 163 zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:) ! ice volume … … 197 194 !--- Ice thicknesses in the i_fill - 1 first categories 198 195 DO jl = 1, i_fill - 1 199 zh_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1))196 zh_i_ini(jl,i_hemis) = hi_mean(jl) 200 197 END DO 201 198 202 199 !--- jl0: most likely index where cc will be maximum 203 200 DO jl = 1, jpl 204 IF ( ( zht_i_ini(i_hemis) .GT.hi_max(jl-1) ) .AND. &205 ( zht_i_ini(i_hemis) .LE.hi_max(jl) ) ) THEN201 IF ( ( zht_i_ini(i_hemis) > hi_max(jl-1) ) .AND. & 202 & ( zht_i_ini(i_hemis) <= hi_max(jl) ) ) THEN 206 203 jl0 = jl 207 204 ENDIF … … 267 264 268 265 ! Test 3: thickness of the last category is in-bounds ? 269 IF ( zh_i_ini(i_fill, i_hemis) .GT.hi_max(i_fill-1) ) THEN266 IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN 270 267 ztest_3 = 1 271 268 ELSE … … 319 316 ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness 320 317 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) ) ! snow depth 321 sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity318 sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin ! salinity 322 319 o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 323 t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt t! surf temp320 t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 324 321 325 322 ! This case below should not be used if (ht_s/ht_i) is ok in namelist … … 329 326 ! recompute ht_i, ht_s avoiding out of bounds values 330 327 ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh ) 331 ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic /rhosn )328 ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 332 329 333 330 ! ice volume, salt content, age content … … 345 342 DO jj = 1, jpj 346 343 DO ji = 1, jpi 347 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt t344 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 348 345 ! Snow energy of melting 349 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 350 ! Change dimensions 351 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 352 ! Multiply by volume, so that heat content in Joules 353 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 346 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 347 348 ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 349 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 354 350 END DO ! ji 355 351 END DO ! jj … … 362 358 DO jj = 1, jpj 363 359 DO ji = 1, jpi 364 t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt t365 s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min366 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rt t!Melting temperature in K360 t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 361 s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin 362 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 367 363 368 364 ! heat content per unit volume 369 365 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) & 370 + lfus * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 371 - rcp * ( ztmelts - rtt ) ) 372 373 ! Correct dimensions to avoid big values 374 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 375 376 ! Mutliply by ice volume, and divide by number of layers to get heat content in J 377 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 366 + lfus * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 367 - rcp * ( ztmelts - rt0 ) ) 368 369 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 370 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 378 371 END DO ! ji 379 372 END DO ! jj … … 384 377 385 378 ELSE 386 ! if ln_ limini=false379 ! if ln_iceini=false 387 380 a_i (:,:,:) = 0._wp 388 381 v_i (:,:,:) = 0._wp … … 400 393 DO jl = 1, jpl 401 394 DO jk = 1, nlay_i 402 t_i(:,:,jk,jl) = rt t * tms(:,:)395 t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 403 396 END DO 404 397 DO jk = 1, nlay_s 405 t_s(:,:,jk,jl) = rt t * tms(:,:)398 t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 406 399 END DO 407 400 END DO 408 401 409 ENDIF ! ln_ limini402 ENDIF ! ln_iceini 410 403 411 404 at_i (:,:) = 0.0_wp … … 481 474 !! 8.5 ! 07-11 (M. Vancoppenolle) rewritten initialization 482 475 !!----------------------------------------------------------------------------- 483 NAMELIST/namiceini/ ln_ limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n,hti_ini_s, &484 & ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n,tmi_ini_s476 NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s, & 477 & rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s 485 478 INTEGER :: ios ! Local integer output status for namelist read 486 479 !!----------------------------------------------------------------------------- … … 502 495 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 503 496 WRITE(numout,*) '~~~~~~~~~~~~~~~' 504 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_ limini = ', ln_limini505 WRITE(numout,*) ' threshold water temp. for initial sea-ice thres_sst = ',thres_sst506 WRITE(numout,*) ' initial snow thickness in the north hts_ini_n = ',hts_ini_n507 WRITE(numout,*) ' initial snow thickness in the south hts_ini_s = ',hts_ini_s508 WRITE(numout,*) ' initial ice thickness in the north hti_ini_n = ',hti_ini_n509 WRITE(numout,*) ' initial ice thickness in the south hti_ini_s = ',hti_ini_s510 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_n = ',ati_ini_n511 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_s = ',ati_ini_s512 WRITE(numout,*) ' initial ice salinity in the north smi_ini_n = ',smi_ini_n513 WRITE(numout,*) ' initial ice salinity in the south smi_ini_s = ',smi_ini_s514 WRITE(numout,*) ' initial ice/snw temp in the north tmi_ini_n = ',tmi_ini_n515 WRITE(numout,*) ' initial ice/snw temp in the south tmi_ini_s = ',tmi_ini_s497 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_iceini = ', ln_iceini 498 WRITE(numout,*) ' threshold water temp. for initial sea-ice rn_thres_sst = ', rn_thres_sst 499 WRITE(numout,*) ' initial snow thickness in the north rn_hts_ini_n = ', rn_hts_ini_n 500 WRITE(numout,*) ' initial snow thickness in the south rn_hts_ini_s = ', rn_hts_ini_s 501 WRITE(numout,*) ' initial ice thickness in the north rn_hti_ini_n = ', rn_hti_ini_n 502 WRITE(numout,*) ' initial ice thickness in the south rn_hti_ini_s = ', rn_hti_ini_s 503 WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_n = ', rn_ati_ini_n 504 WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_s = ', rn_ati_ini_s 505 WRITE(numout,*) ' initial ice salinity in the north rn_smi_ini_n = ', rn_smi_ini_n 506 WRITE(numout,*) ' initial ice salinity in the south rn_smi_ini_s = ', rn_smi_ini_s 507 WRITE(numout,*) ' initial ice/snw temp in the north rn_tmi_ini_n = ', rn_tmi_ini_n 508 WRITE(numout,*) ' initial ice/snw temp in the south rn_tmi_ini_s = ', rn_tmi_ini_s 516 509 ENDIF 517 510 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4990 r5123 18 18 USE thd_ice ! LIM thermodynamics 19 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters21 20 USE dom_ice ! LIM domain 22 21 USE limthd_lac ! LIM … … 27 26 USE wrk_nemo ! work arrays 28 27 USE prtctl ! Print control 29 ! Check budget (Rousset) 28 30 29 USE iom ! I/O manager 31 30 USE lib_fortran ! glob_sum … … 40 39 PUBLIC lim_itd_me_icestrength 41 40 PUBLIC lim_itd_me_init 42 PUBLIC lim_itd_me_zapsmall 43 PUBLIC lim_itd_me_alloc ! called by iceini.F90 41 PUBLIC lim_itd_me_alloc ! called by sbc_lim_init 44 42 45 43 !----------------------------------------------------------------------- … … 125 123 !! and Elizabeth C. Hunke, LANL are gratefully acknowledged 126 124 !!--------------------------------------------------------------------! 127 INTEGER :: ji, jj, jk, jl ! dummy loop index 128 INTEGER :: niter, nitermax = 20 ! local integer 129 LOGICAL :: asum_error ! flag for asum .ne. 1 125 INTEGER :: ji, jj, jk, jl ! dummy loop index 126 INTEGER :: niter ! local integer 130 127 INTEGER :: iterate_ridging ! if true, repeat the ridging 131 REAL(wp) :: w1, tmpfac! local scalar128 REAL(wp) :: za, zfac ! local scalar 132 129 CHARACTER (len = 15) :: fieldid 133 130 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s) … … 140 137 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 141 138 ! 139 INTEGER, PARAMETER :: nitermax = 20 140 ! 142 141 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 143 142 !!----------------------------------------------------------------------------- … … 159 158 ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 160 159 !-----------------------------------------------------------------------------! 161 Cp = 0.5 * grav * (rau0-rhoic) * rhoic /rau0 ! proport const for PE160 Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0 ! proport const for PE 162 161 ! 163 162 CALL lim_itd_me_ridgeprep ! prepare ridging … … 193 192 ! (thick, newly ridged ice). 194 193 195 closing_net(ji,jj) = Cs * 0.5 * ( Delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )194 closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 196 195 197 196 ! 2.2 divu_adv … … 237 236 ! Reduce the closing rate if more than 100% of the open water 238 237 ! would be removed. Reduce the opening rate proportionately. 239 IF ( ato_i(ji,jj) .GT. epsi10 .AND. athorn(ji,jj,0) .GT.0.0 ) THEN240 w1= athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice241 IF ( w1 .GT.ato_i(ji,jj)) THEN242 tmpfac = ato_i(ji,jj) / w1243 closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac244 opning(ji,jj) = opning(ji,jj) * tmpfac245 ENDIF !w1246 ENDIF !at0i and athorn247 248 END DO ! ji249 END DO ! jj238 IF ( ato_i(ji,jj) > epsi10 .AND. athorn(ji,jj,0) > 0.0 ) THEN 239 za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 240 IF ( za > ato_i(ji,jj)) THEN 241 zfac = ato_i(ji,jj) / za 242 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 243 opning(ji,jj) = opning(ji,jj) * zfac 244 ENDIF 245 ENDIF 246 247 END DO 248 END DO 250 249 251 250 ! correction to closing rate / opening if excessive ice removal … … 258 257 DO ji = 1, jpi 259 258 IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 260 w1= athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice261 IF ( w1> a_i(ji,jj,jl) ) THEN262 tmpfac = a_i(ji,jj,jl) / w1263 closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac264 opning (ji,jj) = opning (ji,jj) * tmpfac259 za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 260 IF ( za > a_i(ji,jj,jl) ) THEN 261 zfac = a_i(ji,jj,jl) / za 262 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 263 opning (ji,jj) = opning (ji,jj) * zfac 265 264 ENDIF 266 265 ENDIF 267 END DO !ji268 END DO ! jj269 END DO !jl266 END DO 267 END DO 268 END DO 270 269 271 270 ! 3.3 Redistribute area, volume, and energy. … … 288 287 DO jj = 1, jpj 289 288 DO ji = 1, jpi 290 IF (ABS(asum(ji,jj) - kamax ) .LT.epsi10) THEN289 IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN 291 290 closing_net(ji,jj) = 0._wp 292 291 opning (ji,jj) = 0._wp … … 324 323 ! Convert ridging rate diagnostics to correct units. 325 324 ! Update fresh water and heat fluxes due to snow melt. 326 327 asum_error = .false.328 329 325 DO jj = 1, jpj 330 326 DO ji = 1, jpi 331 332 IF(ABS(asum(ji,jj) - kamax) > epsi10 ) asum_error = .true.333 327 334 328 dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice … … 341 335 !-----------------------------------------------------------------------------! 342 336 wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean 343 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)337 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 344 338 345 339 END DO … … 359 353 WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl) 360 354 END DO 361 ENDIF ! asum 362 363 END DO !ji 364 END DO !jj 355 ENDIF 356 END DO 357 END DO 365 358 366 359 ! Conservation check … … 375 368 !-----------------------------------------------------------------------------! 376 369 CALL lim_var_glo2eqv 377 CALL lim_itd_me_zapsmall 370 CALL lim_var_zapsmall 371 CALL lim_var_agg( 1 ) 378 372 379 373 … … 382 376 CALL prt_ctl_info(' - Cell values : ') 383 377 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 384 CALL prt_ctl(tab2d_1= area, clinfo1=' lim_itd_me : cell area :')378 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me : cell area :') 385 379 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me : at_i :') 386 380 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me : vt_i :') … … 436 430 !!---------------------------------------------------------------------- 437 431 INTEGER, INTENT(in) :: kstrngth ! = 1 for Rothrock formulation, 0 for Hibler (1979) 438 439 INTEGER :: ji,jj, jl ! dummy loop indices 440 INTEGER :: ksmooth ! smoothing the resistance to deformation 441 INTEGER :: numts_rm ! number of time steps for the P smoothing 442 REAL(wp) :: hi, zw1, zp, zdummy, zzc, z1_3 ! local scalars 432 INTEGER :: ji,jj, jl ! dummy loop indices 433 INTEGER :: ksmooth ! smoothing the resistance to deformation 434 INTEGER :: numts_rm ! number of time steps for the P smoothing 435 REAL(wp) :: zhi, zp, z1_3 ! local scalars 443 436 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 444 437 !!---------------------------------------------------------------------- … … 466 459 ! 467 460 IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN 468 hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)461 zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 469 462 !---------------------------- 470 463 ! PE loss from deforming ice 471 464 !---------------------------- 472 strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi *hi465 strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi 473 466 474 467 !-------------------------- 475 468 ! PE gain from rafting ice 476 469 !-------------------------- 477 strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi *hi470 strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi 478 471 479 472 !---------------------------- … … 481 474 !---------------------------- 482 475 strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl) & 483 * z1_3 * ( hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) )484 !!gm Optimization: (a**3-b**3)/(a-b) = a*a+ab+b*b ==> less costly operations even if a**3 is replaced by a*a*a...485 ENDIF ! aicen > epsi10476 * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 + hrmax(ji,jj,jl) * hrmin(ji,jj,jl) ) 477 !!(a**3-b**3)/(a-b) = a*a+ab+b*b 478 ENDIF 486 479 ! 487 END DO ! ji 488 END DO !jj 489 END DO !jl 490 491 zzc = Cf * Cp ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation 492 strength(:,:) = zzc * strength(:,:) / aksum(:,:) 493 480 END DO 481 END DO 482 END DO 483 484 strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) 485 ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 494 486 ksmooth = 1 495 487 … … 499 491 ELSE ! kstrngth ne 1: Hibler (1979) form 500 492 ! 501 strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) ) )493 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) 502 494 ! 503 495 ksmooth = 1 … … 511 503 ! CAN BE REMOVED 512 504 ! 513 IF ( brinstren_swi == 1) THEN505 IF( ln_icestr_bvf ) THEN 514 506 515 507 DO jj = 1, jpj 516 508 DO ji = 1, jpi 517 IF ( bv_i(ji,jj) .GT. 0.0 ) THEN518 zdummy = MIN ( bv_i(ji,jj), 0.10 ) * MIN( bv_i(ji,jj), 0.10 )519 ELSE520 zdummy = 0.0521 ENDIF522 509 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0))) 523 END DO ! j524 END DO ! i510 END DO 511 END DO 525 512 526 513 ENDIF … … 538 525 CALL lbc_lnk( strength, 'T', 1. ) 539 526 540 DO jj = 2, jpj - 1 541 DO ji = 2, jpi - 1 542 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is 543 ! present 527 DO jj = 2, jpjm1 528 DO ji = 2, jpim1 529 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present 544 530 zworka(ji,jj) = 4.0 * strength(ji,jj) & 545 & + strength(ji-1,jj) * tm s(ji-1,jj) &546 & + strength(ji+1,jj) * tm s(ji+1,jj) &547 & + strength(ji,jj-1) * tm s(ji,jj-1) &548 & + strength(ji,jj+1) * tm s(ji,jj+1)549 550 zw 1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1)551 zworka(ji,jj) = zworka(ji,jj) / zw1531 & + strength(ji-1,jj) * tmask(ji-1,jj,1) & 532 & + strength(ji+1,jj) * tmask(ji+1,jj,1) & 533 & + strength(ji,jj-1) * tmask(ji,jj-1,1) & 534 & + strength(ji,jj+1) * tmask(ji,jj+1,1) 535 536 zworka(ji,jj) = zworka(ji,jj) / & 537 & ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 552 538 ELSE 553 539 zworka(ji,jj) = 0._wp … … 556 542 END DO 557 543 558 DO jj = 2, jpj -1559 DO ji = 2, jpi -1544 DO jj = 2, jpjm1 545 DO ji = 2, jpim1 560 546 strength(ji,jj) = zworka(ji,jj) 561 547 END DO … … 563 549 CALL lbc_lnk( strength, 'T', 1. ) 564 550 565 ENDIF ! ksmooth551 ENDIF 566 552 567 553 !-------------------- … … 580 566 DO jj = 1, jpj - 1 581 567 DO ji = 1, jpi - 1 582 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT.epsi10) THEN ! ice is present568 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present 583 569 numts_rm = 1 ! number of time steps for the running mean 584 IF ( strp1(ji,jj) .GT.0.0 ) numts_rm = numts_rm + 1585 IF ( strp2(ji,jj) .GT.0.0 ) numts_rm = numts_rm + 1570 IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 571 IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 586 572 zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 587 573 strp2(ji,jj) = strp1(ji,jj) … … 612 598 !!---------------------------------------------------------------------! 613 599 INTEGER :: ji,jj, jl ! dummy loop indices 614 REAL(wp) :: Gstari, astari, hi, hrmean, zdummy ! local scalar600 REAL(wp) :: Gstari, astari, zhi, hrmean, zdummy ! local scalar 615 601 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 616 602 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n … … 620 606 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 621 607 622 Gstari = 1.0/ Gstar623 astari = 1.0/ astar608 Gstari = 1.0/rn_gstar 609 astari = 1.0/rn_astar 624 610 aksum(:,:) = 0.0 625 611 athorn(:,:,:) = 0.0 … … 632 618 633 619 ! ! Zero out categories with very small areas 634 CALL lim_ itd_me_zapsmall620 CALL lim_var_zapsmall 635 621 636 622 !------------------------------------------------------------------------------! … … 662 648 DO jj = 1, jpj 663 649 DO ji = 1, jpi 664 IF( a_i(ji,jj,jl) .GT.epsi10 ) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl)665 ELSE 650 IF( a_i(ji,jj,jl) > epsi10 ) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 651 ELSE ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 666 652 ENDIF 667 653 END DO … … 687 673 !----------------------------------------------------------------- 688 674 689 IF( partfun_swi== 0 ) THEN !--- Linear formulation (Thorndike et al., 1975)675 IF( nn_partfun == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 690 676 DO jl = 0, jpl 691 677 DO jj = 1, jpj 692 678 DO ji = 1, jpi 693 IF( Gsum(ji,jj,jl) < Gstar) THEN679 IF( Gsum(ji,jj,jl) < rn_gstar) THEN 694 680 athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * & 695 681 (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari) 696 ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN697 athorn(ji,jj,jl) = Gstari * ( Gstar-Gsum(ji,jj,jl-1)) * &698 (2.0 - (Gsum(ji,jj,jl-1)+ Gstar)*Gstari)682 ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN 683 athorn(ji,jj,jl) = Gstari * (rn_gstar-Gsum(ji,jj,jl-1)) * & 684 (2.0 - (Gsum(ji,jj,jl-1)+rn_gstar)*Gstari) 699 685 ELSE 700 686 athorn(ji,jj,jl) = 0.0 701 687 ENDIF 702 END DO ! ji703 END DO ! jj704 END DO ! jl688 END DO 689 END DO 690 END DO 705 691 706 692 ELSE !--- Exponential, more stable formulation (Lipscomb et al, 2007) … … 715 701 END DO 716 702 ! 717 ENDIF ! partfun_swi718 719 IF( raft_swi == 1) THEN ! Ridging and rafting ice participation functions703 ENDIF ! nn_partfun 704 705 IF( ln_rafting ) THEN ! Ridging and rafting ice participation functions 720 706 ! 721 707 DO jl = 1, jpl 722 708 DO jj = 1, jpj 723 709 DO ji = 1, jpi 724 IF ( athorn(ji,jj,jl) .GT.0._wp ) THEN710 IF ( athorn(ji,jj,jl) > 0._wp ) THEN 725 711 !!gm TANH( -X ) = - TANH( X ) so can be computed only 1 time.... 726 aridge(ji,jj,jl) = ( TANH ( Craft * ( ht_i(ji,jj,jl) - hparmeter) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)727 araft (ji,jj,jl) = ( TANH ( - Craft * ( ht_i(ji,jj,jl) - hparmeter) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)712 aridge(ji,jj,jl) = ( TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 713 araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 728 714 IF ( araft(ji,jj,jl) < epsi06 ) araft(ji,jj,jl) = 0._wp 729 715 aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 ) 730 ENDIF ! athorn731 END DO ! ji732 END DO ! jj733 END DO ! jl734 735 ELSE ! raft_swi = 0716 ENDIF 717 END DO 718 END DO 719 END DO 720 721 ELSE 736 722 ! 737 723 DO jl = 1, jpl … … 741 727 ENDIF 742 728 743 IF ( raft_swi == 1) THEN744 745 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT.epsi10 ) THEN729 IF( ln_rafting ) THEN 730 731 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 ) THEN 746 732 DO jl = 1, jpl 747 733 DO jj = 1, jpj 748 734 DO ji = 1, jpi 749 IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT.epsi10 ) THEN735 IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN 750 736 WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 751 737 WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl … … 793 779 DO ji = 1, jpi 794 780 795 IF (a_i(ji,jj,jl) .GT. epsi10 .AND. athorn(ji,jj,jl) .GT.0.0 ) THEN796 hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)797 hrmean = MAX(SQRT( Hstar*hi),hi*krdgmin)798 hrmin(ji,jj,jl) = MIN(2.0* hi, 0.5*(hrmean +hi))781 IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN 782 zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 783 hrmean = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin) 784 hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi)) 799 785 hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl) 800 hraft(ji,jj,jl) = kraft* hi801 krdg(ji,jj,jl) = hrmean / hi786 hraft(ji,jj,jl) = kraft*zhi 787 krdg(ji,jj,jl) = hrmean / zhi 802 788 ELSE 803 789 hraft(ji,jj,jl) = 0.0 … … 847 833 INTEGER :: ij ! horizontal index, combines i and j loops 848 834 INTEGER :: icells ! number of cells with aicen > puny 849 REAL(wp) :: hL, hR, farea, z dummy, zdummy0, ztmelts ! left and right limits of integration835 REAL(wp) :: hL, hR, farea, ztmelts ! left and right limits of integration 850 836 REAL(wp) :: zsstK ! SST in Kelvin 851 837 … … 989 975 large_afrft = .false. 990 976 991 !CDIR NODEP992 977 DO ij = 1, icells 993 978 ji = indxi(ij) … … 1031 1016 !-------------------------------------------------------------------------- 1032 1017 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 1033 vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + r idge_por)1034 vsw (ji,jj) = vrdg1(ji,jj) * r idge_por1018 vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg ) 1019 vsw (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 1035 1020 1036 1021 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) … … 1062 1047 srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge 1063 1048 1064 !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity1049 !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity 1065 1050 1066 1051 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice … … 1091 1076 ! ij looping 1-icells 1092 1077 1093 msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0- fsnowrdg) & ! rafting included1094 & + rhosn*vsrft(ji,jj)*(1.0- fsnowrft)1095 1096 ! in 1e-9 Joules(same as e_s)1097 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0- fsnowrdg) & !rafting included1098 & - esrft(ji,jj)*(1.0- fsnowrft)1078 msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg) & ! rafting included 1079 & + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft) 1080 1081 ! in J/m2 (same as e_s) 1082 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg) & !rafting included 1083 & - esrft(ji,jj)*(1.0-rn_fsnowrft) 1099 1084 1100 1085 !----------------------------------------------------------------- … … 1116 1101 !-------------------------------------------------------------------- 1117 1102 DO jk = 1, nlay_i 1118 !CDIR NODEP1119 1103 DO ij = 1, icells 1120 1104 ji = indxi(ij) … … 1129 1113 ! clem: if sst>0, then ersw <0 (is that possible?) 1130 1114 zsstK = sst_m(ji,jj) + rt0 1131 ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i )1115 ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) * r1_nlay_i 1132 1116 1133 1117 ! heat flux to the ocean 1134 1118 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice ! > 0 [W.m-2] ocean->ice flux 1135 1119 1136 ! Correct dimensions to avoid big values 1137 ersw(ji,jj,jk) = ersw(ji,jj,jk) / unit_fac 1138 1139 ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 1140 ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 1141 !! MV HC 2014 1142 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) 1143 1120 ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 1144 1121 erdg2(ji,jj,jk) = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 1145 1122 … … 1150 1127 IF( con_i ) THEN 1151 1128 DO jk = 1, nlay_i 1152 !CDIR NODEP1153 1129 DO ij = 1, icells 1154 1130 ji = indxi(ij) … … 1160 1136 1161 1137 IF( large_afrac ) THEN ! there is a bug 1162 !CDIR NODEP1163 1138 DO ij = 1, icells 1164 1139 ji = indxi(ij) … … 1172 1147 ENDIF 1173 1148 IF( large_afrft ) THEN ! there is a bug 1174 !CDIR NODEP1175 1149 DO ij = 1, icells 1176 1150 ji = indxi(ij) … … 1190 1164 DO jl2 = 1, jpl 1191 1165 ! over categories to which ridged ice is transferred 1192 !CDIR NODEP1193 1166 DO ij = 1, icells 1194 1167 ji = indxi(ij) … … 1214 1187 a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + ardg2 (ji,jj) * farea 1215 1188 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj) 1216 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg1217 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg1189 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 1190 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 1218 1191 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 1219 1192 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirdg2(ji,jj) * farea … … 1223 1196 ! Transfer ice energy to category jl2 by ridging 1224 1197 DO jk = 1, nlay_i 1225 !CDIR NODEP1226 1198 DO ij = 1, icells 1227 1199 ji = indxi(ij) … … 1235 1207 DO jl2 = 1, jpl 1236 1208 1237 !CDIR NODEP1238 1209 DO ij = 1, icells 1239 1210 ji = indxi(ij) … … 1246 1217 a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + arft2 (ji,jj) 1247 1218 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + virft (ji,jj) 1248 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrft (ji,jj) * fsnowrft1249 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * fsnowrft1219 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrft (ji,jj) * rn_fsnowrft 1220 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 1250 1221 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + smrft (ji,jj) 1251 1222 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj) 1252 ENDIF ! hraft1223 ENDIF 1253 1224 ! 1254 END DO ! ij1225 END DO 1255 1226 1256 1227 ! Transfer rafted ice energy to category jl2 1257 1228 DO jk = 1, nlay_i 1258 !CDIR NODEP1259 1229 DO ij = 1, icells 1260 1230 ji = indxi(ij) … … 1264 1234 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 1265 1235 ENDIF 1266 END DO ! ij1267 END DO !jk1268 1269 END DO ! jl21236 END DO 1237 END DO 1238 1239 END DO 1270 1240 1271 1241 END DO ! jl1 (deforming categories) … … 1339 1309 !!------------------------------------------------------------------- 1340 1310 INTEGER :: ios ! Local integer output status for namelist read 1341 NAMELIST/namiceitdme/ r idge_scheme_swi, Cs, Cf, fsnowrdg,fsnowrft, &1342 & Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, &1343 & partfun_swi, brinstren_swi1311 NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft, & 1312 & rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, & 1313 & nn_partfun 1344 1314 !!------------------------------------------------------------------- 1345 1315 ! … … 1357 1327 WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' 1358 1328 WRITE(numout,*)' ~~~~~~~~~~~~~~~' 1359 WRITE(numout,*)' Switch choosing the ice redistribution scheme ridge_scheme_swi', ridge_scheme_swi 1360 WRITE(numout,*)' Fraction of shear energy contributing to ridging Cs ', Cs 1361 WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging Cf ', Cf 1362 WRITE(numout,*)' Fraction of snow volume conserved during ridging fsnowrdg ', fsnowrdg 1363 WRITE(numout,*)' Fraction of snow volume conserved during ridging fsnowrft ', fsnowrft 1364 WRITE(numout,*)' Fraction of total ice coverage contributing to ridging Gstar ', Gstar 1365 WRITE(numout,*)' Equivalent to G* for an exponential part function astar ', astar 1366 WRITE(numout,*)' Quantity playing a role in max ridged ice thickness Hstar ', Hstar 1367 WRITE(numout,*)' Rafting of ice sheets or not raft_swi ', raft_swi 1368 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) hparmeter ', hparmeter 1369 WRITE(numout,*)' Rafting hyperbolic tangent coefficient Craft ', Craft 1370 WRITE(numout,*)' Initial porosity of ridges ridge_por ', ridge_por 1371 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential partfun_swi ', partfun_swi 1372 WRITE(numout,*)' Switch for including brine volume in ice strength comp. brinstren_swi ', brinstren_swi 1329 WRITE(numout,*)' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs 1330 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg 1331 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 1332 WRITE(numout,*)' Fraction of total ice coverage contributing to ridging rn_gstar = ', rn_gstar 1333 WRITE(numout,*)' Equivalent to G* for an exponential part function rn_astar = ', rn_astar 1334 WRITE(numout,*)' Quantity playing a role in max ridged ice thickness rn_hstar = ', rn_hstar 1335 WRITE(numout,*)' Rafting of ice sheets or not ln_rafting = ', ln_rafting 1336 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft 1337 WRITE(numout,*)' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft 1338 WRITE(numout,*)' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg 1339 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun 1373 1340 ENDIF 1374 1341 ! 1375 1342 END SUBROUTINE lim_itd_me_init 1376 1377 1378 SUBROUTINE lim_itd_me_zapsmall1379 !!-------------------------------------------------------------------1380 !! *** ROUTINE lim_itd_me_zapsmall ***1381 !!1382 !! ** Purpose : Remove too small sea ice areas and correct salt fluxes1383 !!1384 !! history :1385 !! author: William H. Lipscomb, LANL1386 !! Nov 2003: Modified by Julie Schramm to conserve volume and energy1387 !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with1388 !! additions to local freshwater, salt, and heat fluxes1389 !! 9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code1390 !!-------------------------------------------------------------------1391 INTEGER :: ji, jj, jl, jk ! dummy loop indices1392 INTEGER :: icells ! number of cells with ice to zap1393 1394 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace1395 REAL(wp) :: zmask_glo, zsal, zvi, zvs, zei, zes1396 !!gm REAL(wp) :: xtmp ! temporary variable1397 !!-------------------------------------------------------------------1398 1399 CALL wrk_alloc( jpi, jpj, zmask )1400 1401 ! to be sure that at_i is the sum of a_i(jl)1402 at_i(:,:) = SUM( a_i(:,:,:), dim=3 )1403 1404 DO jl = 1, jpl1405 !-----------------------------------------------------------------1406 ! Count categories to be zapped.1407 !-----------------------------------------------------------------1408 icells = 01409 zmask(:,:) = 0._wp1410 DO jj = 1, jpj1411 DO ji = 1, jpi1412 IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN1413 zmask(ji,jj) = 1._wp1414 ENDIF1415 END DO1416 END DO1417 !zmask_glo = glob_sum(zmask)1418 !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean '1419 1420 !-----------------------------------------------------------------1421 ! Zap ice energy and use ocean heat to melt ice1422 !-----------------------------------------------------------------1423 1424 DO jk = 1, nlay_i1425 DO jj = 1 , jpj1426 DO ji = 1 , jpi1427 zei = e_i(ji,jj,jk,jl)1428 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) )1429 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj)1430 ! update exchanges with ocean1431 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 <01432 END DO1433 END DO1434 END DO1435 1436 DO jj = 1 , jpj1437 DO ji = 1 , jpi1438 1439 zsal = smv_i(ji,jj,jl)1440 zvi = v_i(ji,jj,jl)1441 zvs = v_s(ji,jj,jl)1442 zes = e_s(ji,jj,1,jl)1443 !-----------------------------------------------------------------1444 ! Zap snow energy and use ocean heat to melt snow1445 !-----------------------------------------------------------------1446 ! xtmp = esnon(i,j,n) / dt ! < 01447 ! fhnet(i,j) = fhnet(i,j) + xtmp1448 ! fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp1449 ! xtmp is greater than 01450 ! fluxes are positive to the ocean1451 ! here the flux has to be negative for the ocean1452 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )1453 1454 !-----------------------------------------------------------------1455 ! zap ice and snow volume, add water and salt to ocean1456 !-----------------------------------------------------------------1457 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj)1458 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1459 v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1460 v_s (ji,jj,jl) = v_s (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1461 t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)1462 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1463 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) )1464 e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )1465 ! additional condition1466 IF( v_s(ji,jj,jl) <= epsi10 ) THEN1467 v_s(ji,jj,jl) = 0._wp1468 e_s(ji,jj,1,jl) = 0._wp1469 ENDIF1470 ! update exchanges with ocean1471 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice1472 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice1473 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice1474 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 <01475 END DO1476 END DO1477 END DO ! jl1478 1479 ! to be sure that at_i is the sum of a_i(jl)1480 at_i(:,:) = SUM( a_i(:,:,:), dim=3 )1481 !1482 CALL wrk_dealloc( jpi, jpj, zmask )1483 !1484 END SUBROUTINE lim_itd_me_zapsmall1485 1343 1486 1344 #else … … 1497 1355 SUBROUTINE lim_itd_me_init 1498 1356 END SUBROUTINE lim_itd_me_init 1499 SUBROUTINE lim_itd_me_zapsmall1500 END SUBROUTINE lim_itd_me_zapsmall1501 1357 #endif 1502 1358 !!====================================================================== -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4990 r5123 13 13 !! 'key_lim3' : LIM3 sea-ice model 14 14 !!---------------------------------------------------------------------- 15 !! lim_itd_th : thermodynamics of ice thickness distribution16 15 !! lim_itd_th_rem : 17 16 !! lim_itd_th_reb : … … 25 24 USE thd_ice ! LIM-3 thermodynamic variables 26 25 USE ice ! LIM-3 variables 27 USE par_ice ! LIM-3 parameters28 USE limthd_lac ! LIM-3 lateral accretion29 26 USE limvar ! LIM-3 variables 30 27 USE limcons ! LIM-3 conservation … … 34 31 USE wrk_nemo ! work arrays 35 32 USE lib_fortran ! to use key_nosignedzero 36 USE timing ! Timing 37 USE limcons ! conservation tests 33 USE limcons ! conservation tests 38 34 39 35 IMPLICIT NONE 40 36 PRIVATE 41 37 42 PUBLIC lim_itd_th ! called by ice_stp43 38 PUBLIC lim_itd_th_rem 44 39 PUBLIC lim_itd_th_reb … … 52 47 !!---------------------------------------------------------------------- 53 48 CONTAINS 54 55 SUBROUTINE lim_itd_th( kt )56 !!------------------------------------------------------------------57 !! *** ROUTINE lim_itd_th ***58 !!59 !! ** Purpose : computes the thermodynamics of ice thickness distribution60 !!61 !! ** Method :62 !!------------------------------------------------------------------63 INTEGER, INTENT(in) :: kt ! time step index64 !65 INTEGER :: ji, jj, jk, jl ! dummy loop index66 !67 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b68 !!------------------------------------------------------------------69 IF( nn_timing == 1 ) CALL timing_start('limitd_th')70 71 ! conservation test72 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)73 74 IF( kt == nit000 .AND. lwp ) THEN75 WRITE(numout,*)76 WRITE(numout,*) 'lim_itd_th : Thermodynamics of the ice thickness distribution'77 WRITE(numout,*) '~~~~~~~~~~~'78 ENDIF79 80 !------------------------------------------------------------------------------|81 ! 1) Transport of ice between thickness categories. |82 !------------------------------------------------------------------------------|83 ! Given thermodynamic growth rates, transport ice between84 ! thickness categories.85 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt )86 !87 CALL lim_var_glo2eqv ! only for info88 CALL lim_var_agg(1)89 90 !------------------------------------------------------------------------------|91 ! 3) Add frazil ice growing in leads.92 !------------------------------------------------------------------------------|93 CALL lim_thd_lac94 CALL lim_var_glo2eqv ! only for info95 96 IF(ln_ctl) THEN ! Control print97 CALL prt_ctl_info(' ')98 CALL prt_ctl_info(' - Cell values : ')99 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')100 CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th : cell area :')101 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :')102 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :')103 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :')104 DO jl = 1, jpl105 CALL prt_ctl_info(' ')106 CALL prt_ctl_info(' - Category : ', ivar1=jl)107 CALL prt_ctl_info(' ~~~~~~~~~~')108 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ')109 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ')110 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ')111 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ')112 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ')113 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ')114 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ')115 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ')116 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ')117 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ')118 DO jk = 1, nlay_i119 CALL prt_ctl_info(' ')120 CALL prt_ctl_info(' - Layer : ', ivar1=jk)121 CALL prt_ctl_info(' ~~~~~~~')122 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ')123 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ')124 END DO125 END DO126 ENDIF127 !128 ! conservation test129 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)130 !131 IF( nn_timing == 1 ) CALL timing_stop('limitd_th')132 END SUBROUTINE lim_itd_th133 !134 49 135 50 SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) … … 153 68 REAL(wp) :: zx1, zwk1, zdh0, zetamin, zdamax ! local scalars 154 69 REAL(wp) :: zx2, zwk2, zda0, zetamax ! - - 155 REAL(wp) :: zx3 , zareamin ! - -70 REAL(wp) :: zx3 156 71 CHARACTER (len = 15) :: fieldid 157 72 … … 188 103 CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 189 104 190 zareamin = epsi10 !minimum area in thickness categories tolerated by the conceptors of the model191 192 105 !!---------------------------------------------------------------------------------------------- 193 106 !! 0) Conservation checkand changes in each ice category … … 216 129 DO jj = 1, jpj 217 130 DO ji = 1, jpi 218 rswitch 131 rswitch = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 219 132 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch 220 rswitch 133 rswitch = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 221 134 zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 222 135 IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) … … 239 152 DO jj = 1, jpj 240 153 DO ji = 1, jpi 241 IF ( at_i(ji,jj) .gt. zareamin) THEN154 IF ( at_i(ji,jj) > epsi10 ) THEN 242 155 nbrem = nbrem + 1 243 156 nind_i(nbrem) = ji … … 247 160 zremap_flag(ji,jj) = 0 248 161 ENDIF 249 END DO !ji250 END DO !jj162 END DO 163 END DO 251 164 252 165 !----------------------------------------------------------------------------------------------- … … 254 167 !----------------------------------------------------------------------------------------------- 255 168 !- 4.1 Compute category boundaries 256 ! Tricky trick see limitd_me.F90257 ! will be soon removed, CT258 ! hi_max(kubnd) = 99.259 169 zhbnew(:,:,:) = 0._wp 260 170 … … 291 201 END DO 292 202 293 END DO !jl203 END DO 294 204 295 205 !----------------------------------------------------------------------------------------------- … … 334 244 !----------------------------------------------------------------------------------------------- 335 245 !- 7.1 g(h) for category 1 at start of time step 336 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), & 337 & g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 246 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 338 247 & hR(:,:,klbnd), zremap_flag ) 339 248 … … 344 253 345 254 !ji 346 IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN255 IF( a_i(ii,ij,klbnd) > epsi10 ) THEN 347 256 zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 348 257 ! ji, a_i > epsi10 349 IF (zdh0 .lt. 0.0) THEN !remove area from category 1258 IF( zdh0 < 0.0 ) THEN !remove area from category 1 350 259 ! ji, a_i > epsi10; zdh0 < 0 351 zdh0 = MIN( -zdh0,hi_max(klbnd))260 zdh0 = MIN( -zdh0, hi_max(klbnd) ) 352 261 353 262 !Integrate g(1) from 0 to dh0 to estimate area melted 354 zetamax = MIN( zdh0,hR(ii,ij,klbnd)) - hL(ii,ij,klbnd)355 IF (zetamax.gt.0.0) THEN263 zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd) 264 IF( zetamax > 0.0 ) THEN 356 265 zx1 = zetamax 357 zx2 = 0.5 * zetamax *zetamax266 zx2 = 0.5 * zetamax * zetamax 358 267 zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 359 268 ! Constrain new thickness <= ht_i 360 zdamax = a_i(ii,ij,klbnd) * & 361 (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0 269 zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! zdamax > 0 362 270 !ice area lost due to melting of thin ice 363 zda0 = MIN( zda0, zdamax)271 zda0 = MIN( zda0, zdamax ) 364 272 365 273 ! Remove area, conserving volume 366 ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) & 367 * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 274 ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 368 275 a_i(ii,ij,klbnd) = a_i(ii,ij,klbnd) - zda0 369 v_i(ii,ij,klbnd) = a_i(ii,ij,klbnd) *ht_i(ii,ij,klbnd) ! clem-useless ?370 ENDIF ! zetamax > 0276 v_i(ii,ij,klbnd) = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ? 277 ENDIF 371 278 ! ji, a_i > epsi10 372 279 373 280 ELSE ! if ice accretion 374 281 ! ji, a_i > epsi10; zdh0 > 0 375 zhbnew(ii,ij,klbnd-1) = MIN( zdh0,hi_max(klbnd))282 zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) ) 376 283 ! zhbnew was 0, and is shifted to the right to account for thin ice 377 284 ! growth in openwater (F0 = f1) … … 385 292 !- 7.3 g(h) for each thickness category 386 293 DO jl = klbnd, kubnd 387 CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl),&388 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag)294 CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 295 & g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag ) 389 296 END DO 390 297 … … 406 313 ij = nind_j(ji) 407 314 408 IF (zhbnew(ii,ij,jl) .gt.hi_max(jl)) THEN ! transfer from jl to jl+1315 IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1 409 316 410 317 ! left and right integration limits in eta space 411 zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl)) - hL(ii,ij,jl)412 zvetamax(ji) = MIN (zhbnew(ii,ij,jl), hR(ii,ij,jl)) - hL(ii,ij,jl)318 zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl) 319 zvetamax(ji) = MIN (zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 413 320 zdonor(ii,ij,jl) = jl 414 321 … … 417 324 ! left and right integration limits in eta space 418 325 zvetamin(ji) = 0.0 419 zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1)) - hL(ii,ij,jl+1)326 zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1) 420 327 zdonor(ii,ij,jl) = jl + 1 421 328 422 329 ENDIF ! zhbnew(jl) > hi_max(jl) 423 330 424 zetamax = MAX( zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin331 zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin 425 332 zetamin = zvetamin(ji) 426 333 427 334 zx1 = zetamax - zetamin 428 zwk1 = zetamin *zetamin429 zwk2 = zetamax *zetamax430 zx2 = 0.5 * ( zwk2 - zwk1)335 zwk1 = zetamin * zetamin 336 zwk2 = zetamax * zetamax 337 zx2 = 0.5 * ( zwk2 - zwk1 ) 431 338 zwk1 = zwk1 * zetamin 432 339 zwk2 = zwk2 * zetamax 433 zx3 = 1.0 /3.0 * (zwk2 - zwk1)340 zx3 = 1.0 / 3.0 * ( zwk2 - zwk1 ) 434 341 nd = zdonor(ii,ij,jl) 435 342 zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 436 343 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 437 344 438 END DO ! ji345 END DO 439 346 END DO ! jl klbnd -> kubnd - 1 440 347 … … 451 358 ii = nind_i(ji) 452 359 ij = nind_j(ji) 453 IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim) THEN454 a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim455 ht_i(ii,ij,1) = hiclim360 IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN 361 a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 362 ht_i(ii,ij,1) = rn_himin 456 363 ENDIF 457 END DO !ji364 END DO 458 365 459 366 !!---------------------------------------------------------------------------------------------- … … 491 398 492 399 493 SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, & 494 & g0, g1, hL, hR, zremap_flag ) 400 SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag ) 495 401 !!------------------------------------------------------------------ 496 402 !! *** ROUTINE lim_itd_fitline *** … … 532 438 ! Change hL or hR if hice falls outside central third of range 533 439 534 zh13 = 1.0 /3.0 * (2.0*hL(ji,jj) + hR(ji,jj))535 zh23 = 1.0 /3.0 * (hL(ji,jj) + 2.0*hR(ji,jj))440 zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) ) 441 zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) ) 536 442 537 443 IF ( hice(ji,jj) < zh13 ) THEN ; hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj) … … 544 450 zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr 545 451 zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr 546 g0(ji,jj) = zwk1 * ( 2._wp /3._wp - zwk2 )547 g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5)452 g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 ) 453 g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 ) 548 454 ! 549 455 ELSE ! remap_flag = .false. or a_i < epsi10 … … 606 512 607 513 DO jl = klbnd, kubnd 608 zaTsfn(:,:,jl) = a_i(:,:,jl) *t_su(:,:,jl)514 zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 609 515 END DO 610 516 … … 629 535 DO ji = 1, jpi 630 536 631 IF (zdonor(ji,jj,jl) .GT.0) THEN537 IF (zdonor(ji,jj,jl) > 0) THEN 632 538 jl1 = zdonor(ji,jj,jl) 633 539 634 IF (zdaice(ji,jj,jl) .LT. 0.0) THEN 635 IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN 636 IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) ) & 637 .OR. & 638 ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) & 639 ) THEN 540 IF (zdaice(ji,jj,jl) < 0.0) THEN 541 IF (zdaice(ji,jj,jl) > -epsi10) THEN 542 IF ( ( jl1 == jl .AND. ht_i(ji,jj,jl1) > hi_max(jl) ) .OR. & 543 ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 640 544 zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 641 545 zdvice(ji,jj,jl) = v_i(ji,jj,jl1) … … 649 553 ENDIF 650 554 651 IF (zdvice(ji,jj,jl) .LT. 0.0) THEN 652 IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN 653 IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) ) & 654 .OR. & 655 ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) & 656 ) THEN 555 IF (zdvice(ji,jj,jl) < 0.0) THEN 556 IF (zdvice(ji,jj,jl) > -epsi10 ) THEN 557 IF ( ( jl1 == jl .AND. ht_i(ji,jj,jl1) > hi_max(jl) ) .OR. & 558 ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 657 559 zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 658 560 zdvice(ji,jj,jl) = v_i(ji,jj,jl1) … … 667 569 668 570 ! If daice is close to aicen, set daice = aicen. 669 IF (zdaice(ji,jj,jl) .GT.a_i(ji,jj,jl1) - epsi10 ) THEN670 IF (zdaice(ji,jj,jl) .LT.a_i(ji,jj,jl1)+epsi10) THEN571 IF (zdaice(ji,jj,jl) > a_i(ji,jj,jl1) - epsi10 ) THEN 572 IF (zdaice(ji,jj,jl) < a_i(ji,jj,jl1)+epsi10) THEN 671 573 zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 672 574 zdvice(ji,jj,jl) = v_i(ji,jj,jl1) … … 676 578 ENDIF 677 579 678 IF (zdvice(ji,jj,jl) .GT.v_i(ji,jj,jl1)-epsi10) THEN679 IF (zdvice(ji,jj,jl) .LT.v_i(ji,jj,jl1)+epsi10) THEN580 IF (zdvice(ji,jj,jl) > v_i(ji,jj,jl1)-epsi10) THEN 581 IF (zdvice(ji,jj,jl) < v_i(ji,jj,jl1)+epsi10) THEN 680 582 zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 681 583 zdvice(ji,jj,jl) = v_i(ji,jj,jl1) … … 686 588 687 589 ENDIF ! donor > 0 688 END DO ! i689 END DO ! j690 691 END DO !jl590 END DO 591 END DO 592 593 END DO 692 594 693 595 !------------------------------------------------------------------------------- … … 699 601 DO jj = 1, jpj 700 602 DO ji = 1, jpi 701 IF (zdaice(ji,jj,jl) .GT.0.0 ) THEN ! daice(n) can be < puny603 IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny 702 604 nbrem = nbrem + 1 703 605 nind_i(nbrem) = ji 704 606 nind_j(nbrem) = jj 705 ENDIF ! tmask607 ENDIF 706 608 END DO 707 609 END DO … … 712 614 713 615 jl1 = zdonor(ii,ij,jl) 714 rswitch 715 zworka(ii,ij) = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * rswitch616 rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) ) 617 zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch 716 618 IF( jl1 == jl) THEN ; jl2 = jl1+1 717 ELSE 619 ELSE ; jl2 = jl 718 620 ENDIF 719 621 … … 772 674 zaTsfn(ii,ij,jl2) = zaTsfn(ii,ij,jl2) + zdaTsf 773 675 774 END DO ! ji676 END DO 775 677 776 678 !------------------ … … 779 681 780 682 DO jk = 1, nlay_i 781 !CDIR NODEP782 683 DO ji = 1, nbrem 783 684 ii = nind_i(ji) … … 785 686 786 687 jl1 = zdonor(ii,ij,jl) 787 IF (jl1 .EQ.jl) THEN688 IF (jl1 == jl) THEN 788 689 jl2 = jl+1 789 690 ELSE ! n1 = n+1 … … 794 695 e_i(ii,ij,jk,jl1) = e_i(ii,ij,jk,jl1) - zdeice 795 696 e_i(ii,ij,jk,jl2) = e_i(ii,ij,jk,jl2) + zdeice 796 END DO ! ji797 END DO ! jk697 END DO 698 END DO 798 699 799 700 END DO ! boundaries, 1 to ncat-1 … … 809 710 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / a_i(ji,jj,jl) 810 711 t_su(ji,jj,jl) = zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 811 rswitch = 1.0 - MAX( 0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes712 rswitch = 1.0 - MAX( 0.0, SIGN( 1.0, -v_s(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 812 713 ELSE 813 714 ht_i(ji,jj,jl) = 0._wp 814 t_su(ji,jj,jl) = rt t715 t_su(ji,jj,jl) = rt0 815 716 ENDIF 816 END DO ! ji817 END DO ! jj818 END DO ! jl717 END DO 718 END DO 719 END DO 819 720 ! 820 721 CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) … … 926 827 zdvice(ji,jj,jl) = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi10 ) 927 828 ENDIF 928 END DO ! ji929 END DO ! jj829 END DO 830 END DO 930 831 IF(lk_mpp) CALL mpp_max( zshiftflag ) 931 832 … … 951 852 zshiftflag = 0 952 853 953 !clem-change954 854 DO jj = 1, jpj 955 855 DO ji = 1, jpi … … 961 861 zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 962 862 ENDIF 963 END DO ! ji964 END DO ! jj863 END DO 864 END DO 965 865 966 866 IF(lk_mpp) CALL mpp_max( zshiftflag ) … … 973 873 zdvice(:,:,jl) = 0._wp 974 874 ENDIF 975 !clem-change976 875 977 876 ! ! clem-change begin: why not doing that? … … 982 881 ! a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 983 882 ! ENDIF 984 ! END DO ! ji985 ! END DO ! jj883 ! END DO 884 ! END DO 986 885 ! clem-change end 987 886 988 END DO ! jl887 END DO 989 888 990 889 !------------------------------------------------------------------------------ … … 1013 912 !!---------------------------------------------------------------------- 1014 913 CONTAINS 1015 SUBROUTINE lim_itd_th ! Empty routines1016 END SUBROUTINE lim_itd_th1017 SUBROUTINE lim_itd_th_ini1018 END SUBROUTINE lim_itd_th_ini1019 914 SUBROUTINE lim_itd_th_rem 1020 915 END SUBROUTINE lim_itd_th_rem -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
r4161 r5123 23 23 PRIVATE 24 24 25 PUBLIC lim_msh ! routine called by ice_ini.F9025 PUBLIC lim_msh ! routine called by sbcice_lim.F90 26 26 27 27 !!---------------------------------------------------------------------- … … 41 41 !! - Definition of some constants linked with the grid 42 42 !! - Definition of the metric coef. for the sea/ice 43 !! - Initialization of the ice masks (tmsk, umsk)44 43 !! 45 44 !! Reference : Deleersnijder et al. Ocean Modelling 100, 7-10 … … 103 102 !!gm end 104 103 105 ! !== ice masks ==!106 tms(:,:) = tmask(:,:,1) ! ice T-point : use surface tmask107 tmu(:,:) = umask(:,:,1) ! ice U-point : use surface umask (C-grid EVP)108 tmv(:,:) = vmask(:,:,1) ! ice V-point : use surface vmask (C-grid EVP)109 DO jj = 1, jpjm1 ! ice F-point : recompute fmask (due to nn_shlat)110 DO ji = 1 , jpim1 ! NO vector opt.111 tmf(ji,jj) = tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * tms(ji+1,jj+1)112 END DO113 END DO114 CALL lbc_lnk( tmf(:,:), 'F', 1. ) ! lateral boundary conditions115 116 ! !== unmasked and masked area of T-grid cell117 area(:,:) = e1t(:,:) * e2t(:,:)118 104 ! 119 105 END SUBROUTINE lim_msh -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r4990 r5123 102 102 !! and charge ellipse. 103 103 !! The user should make sure that the parameters 104 !! n evp, telast andcreepl maintain stress state104 !! nn_nevp, elastic time scale and rn_creepl maintain stress state 105 105 !! on the charge ellipse for plastic flow 106 106 !! e.g. in the Canadian Archipelago … … 108 108 !! References : Hunke and Dukowicz, JPO97 109 109 !! Bouillon et al., Ocean Modelling 2009 110 !! Vancoppenolle et al., Ocean Modelling 2008111 110 !!------------------------------------------------------------------- 112 111 INTEGER, INTENT(in) :: k_j1 ! southern j-index for ice computation … … 117 116 CHARACTER (len=50) :: charout 118 117 REAL(wp) :: zt11, zt12, zt21, zt22, ztagnx, ztagny, delta ! 119 REAL(wp) :: za, zstms , zmask! local scalars120 REAL(wp) :: zc1, zc2, zc3 121 122 REAL(wp) :: dtevp ! time step for subcycling123 REAL(wp) :: dtotel, ecc2, ecci ! square of yield ellipse eccenticity124 REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars125 REAL(wp) :: zu_ice2, zv_ice1 !126 REAL(wp) :: zddc, zdtc ! delta on corners and on centre127 REAL(wp) :: zdst ! shear at the center of the grid point128 REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface129 REAL(wp) :: sigma1, sigma2 ! internal ice stress118 REAL(wp) :: za, zstms ! local scalars 119 REAL(wp) :: zc1, zc2, zc3 ! ice mass 120 121 REAL(wp) :: dtevp , z1_dtevp ! time step for subcycling 122 REAL(wp) :: dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity 123 REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars 124 REAL(wp) :: zu_ice2, zv_ice1 ! 125 REAL(wp) :: zddc, zdtc ! delta on corners and on centre 126 REAL(wp) :: zdst ! shear at the center of the grid point 127 REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface 128 REAL(wp) :: sigma1, sigma2 ! internal ice stress 130 129 131 130 REAL(wp) :: zresm ! Maximal error on ice velocity 132 REAL(wp) :: zdummy ! dummy argument133 131 REAL(wp) :: zintb, zintn ! dummy argument 134 132 … … 139 137 REAL(wp), POINTER, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points 140 138 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays 141 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce1, v_oce1! ocean u/v component on U points142 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2 , v_oce2! ocean u/v component on V points139 REAL(wp), POINTER, DIMENSION(:,:) :: v_oce1 ! ocean u/v component on U points 140 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2 ! ocean u/v component on V points 143 141 REAL(wp), POINTER, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point 144 142 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses 143 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! mask ocean grid points 145 144 146 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdt ! tension at centre of grid cells … … 152 151 ! ocean surface (ssh_m) if ice is not embedded 153 152 ! ice top surface if ice is embedded 153 154 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 155 REAL(wp), PARAMETER :: zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 154 156 !!------------------------------------------------------------------- 155 157 156 158 CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 157 CALL wrk_alloc( jpi,jpj, u_oce 1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1)159 CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 158 160 CALL wrk_alloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 159 161 CALL wrk_alloc( jpi,jpj, zdt , zds , zs1 , zs2 , zs12 , zresr , zpice ) … … 161 163 #if defined key_lim2 && ! defined key_lim2_vp 162 164 # if defined key_agrif 163 USE ice_2, vt_s => hsnm164 USE ice_2, vt_i => hicm165 USE ice_2, vt_s => hsnm 166 USE ice_2, vt_i => hicm 165 167 # else 166 vt_s => hsnm167 vt_i => hicm168 vt_s => hsnm 169 vt_i => hicm 168 170 # endif 169 at_i(:,:) = 1. - frld(:,:)171 at_i(:,:) = 1. - frld(:,:) 170 172 #endif 171 173 #if defined key_agrif && defined key_lim2 172 CALL agrif_rhg_lim2_load ! First interpolation of coarse values174 CALL agrif_rhg_lim2_load ! First interpolation of coarse values 173 175 #endif 174 176 ! … … 186 188 187 189 #if defined key_lim3 188 CALL lim_itd_me_icestrength( ridge_scheme_swi ) ! LIM-3: Ice strength on T-points 189 #endif 190 191 !CDIR NOVERRCHK 190 CALL lim_itd_me_icestrength( nn_icestr ) ! LIM-3: Ice strength on T-points 191 #endif 192 192 193 DO jj = k_j1 , k_jpj ! Ice mass and temp variables 193 !CDIR NOVERRCHK194 194 DO ji = 1 , jpi 195 195 #if defined key_lim3 196 zpresh(ji,jj) = tm s(ji,jj) * strength(ji,jj)196 zpresh(ji,jj) = tmask(ji,jj,1) * strength(ji,jj) 197 197 #endif 198 198 #if defined key_lim2 199 zpresh(ji,jj) = tm s(ji,jj) * pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )200 #endif 201 ! tmi= 1 where there is ice or on land202 tmi(ji,jj) = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj)199 zpresh(ji,jj) = tmask(ji,jj,1) * pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) ) 200 #endif 201 ! zmask = 1 where there is ice or on land 202 zmask(ji,jj) = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1) 203 203 END DO 204 204 END DO … … 206 206 ! Ice strength on grid cell corners (zpreshc) 207 207 ! needed for calculation of shear stress 208 !CDIR NOVERRCHK209 208 DO jj = k_j1+1, k_jpj-1 210 !CDIR NOVERRCHK211 209 DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1) 212 zstms = tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 213 & tms(ji,jj+1) * wght(ji+1,jj+1,1,2) + & 214 & tms(ji+1,jj) * wght(ji+1,jj+1,2,1) + & 215 & tms(ji,jj) * wght(ji+1,jj+1,1,1) 216 zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 217 & zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) + & 218 & zpresh(ji+1,jj) * wght(ji+1,jj+1,2,1) + & 219 & zpresh(ji,jj) * wght(ji+1,jj+1,1,1) & 220 & ) / MAX( zstms, epsd ) 210 zstms = tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) + & 211 & tmask(ji+1,jj,1) * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1) * wght(ji+1,jj+1,1,1) 212 zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) + & 213 & zpresh(ji+1,jj) * wght(ji+1,jj+1,2,1) + zpresh(ji,jj) * wght(ji+1,jj+1,1,1) & 214 & ) / MAX( zstms, zepsi ) 221 215 END DO 222 216 END DO 223 224 217 CALL lbc_lnk( zpreshc(:,:), 'F', 1. ) 225 218 ! … … 236 229 ! zcorl2: Coriolis parameter on V-points 237 230 ! (ztagnx,ztagny): wind stress on U/V points 238 ! u_oce1: ocean u component on u points239 231 ! v_oce1: ocean v component on u points 240 232 ! u_oce2: ocean u component on v points 241 ! v_oce2: ocean v component on v points242 233 243 234 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! 244 245 246 235 ! 236 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 237 ! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 247 238 zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 248 249 250 239 ! 240 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 241 ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 251 242 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 252 243 ! 253 244 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 254 245 ! 255 246 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! 256 247 zpice(:,:) = ssh_m(:,:) … … 260 251 DO ji = fs_2, fs_jpim1 261 252 262 zc1 = tm s(ji ,jj) * ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) )263 zc2 = tm s(ji+1,jj) * ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) )264 zc3 = tm s(ji ,jj+1) * ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) )265 266 zt11 = tm s(ji ,jj) * e1t(ji ,jj)267 zt12 = tm s(ji+1,jj) * e1t(ji+1,jj)268 zt21 = tm s(ji,jj) * e2t(ji,jj )269 zt22 = tm s(ji,jj+1) * e2t(ji,jj+1)253 zc1 = tmask(ji ,jj ,1) * ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) ) 254 zc2 = tmask(ji+1,jj ,1) * ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) ) 255 zc3 = tmask(ji ,jj+1,1) * ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) ) 256 257 zt11 = tmask(ji ,jj,1) * e1t(ji ,jj) 258 zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj) 259 zt21 = tmask(ji,jj ,1) * e2t(ji,jj ) 260 zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1) 270 261 271 262 ! Leads area. 272 zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd)273 zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd)263 zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi ) 264 zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi ) 274 265 275 266 ! Mass, coriolis coeff. and currents 276 zmass1(ji,jj) = ( zt12 *zc1 + zt11*zc2 ) / (zt11+zt12+epsd)277 zmass2(ji,jj) = ( zt22 *zc1 + zt21*zc3 ) / (zt21+zt22+epsd)278 zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) *fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) ) &279 & / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd)280 zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) *fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) ) &281 & / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd)267 zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi ) 268 zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi ) 269 zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) ) & 270 & / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 271 zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) ) & 272 & / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi ) 282 273 ! 283 u_oce1(ji,jj) = u_oce(ji,jj)284 v_oce2(ji,jj) = v_oce(ji,jj)285 286 274 ! Ocean has no slip boundary condition 287 v_oce1(ji,jj) = 0.5 *( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)&288 & +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj))&289 & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)290 291 u_oce2(ji,jj) = 0.5 *((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)&292 & +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1))&293 & / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)275 v_oce1(ji,jj) = 0.5 * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji,jj) & 276 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 277 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 278 279 u_oce2(ji,jj) = 0.5 * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj) & 280 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 281 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 294 282 295 283 ! Wind stress at U,V-point … … 303 291 ! include it later 304 292 305 zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) /e1u(ji,jj)306 zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) /e2v(ji,jj)293 zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 294 zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 307 295 308 296 za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx … … 318 306 ! 319 307 ! Time step for subcycling 320 dtevp = rdt_ice / nevp 308 dtevp = rdt_ice / nn_nevp 309 #if defined key_lim3 310 dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice ) 311 #else 321 312 dtotel = dtevp / ( 2._wp * telast ) 322 313 #endif 314 z1_dtotel = 1._wp / ( 1._wp + dtotel ) 315 z1_dtevp = 1._wp / dtevp 323 316 !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter) 324 ecc2 = ecc *ecc317 ecc2 = rn_ecc * rn_ecc 325 318 ecci = 1. / ecc2 326 319 … … 331 324 332 325 ! !----------------------! 333 DO jter = 1 , n evp! loop over jter !326 DO jter = 1 , nn_nevp ! loop over jter ! 334 327 ! !----------------------! 335 328 DO jj = k_j1, k_jpj-1 … … 339 332 340 333 DO jj = k_j1+1, k_jpj-1 341 DO ji = fs_2, jpim1 !RB bug no vect opt due to tmi334 DO ji = fs_2, fs_jpim1 !RB bug no vect opt due to zmask 342 335 343 336 ! … … 360 353 ! 361 354 ! 362 divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj) & 363 & -e2u(ji-1,jj)*u_ice(ji-1,jj) & 364 & +e1v(ji,jj)*v_ice(ji,jj) & 365 & -e1v(ji,jj-1)*v_ice(ji,jj-1) & 366 & ) & 367 & / area(ji,jj) 368 369 zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj) & 370 & -u_ice(ji-1,jj)/e2u(ji-1,jj) & 371 & )*e2t(ji,jj)*e2t(ji,jj) & 372 & -( v_ice(ji,jj)/e1v(ji,jj) & 373 & -v_ice(ji,jj-1)/e1v(ji,jj-1) & 374 & )*e1t(ji,jj)*e1t(ji,jj) & 375 & ) & 376 & / area(ji,jj) 355 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 356 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 357 & ) * r1_e12t(ji,jj) 358 359 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 360 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 361 & ) * r1_e12t(ji,jj) 377 362 378 363 ! 379 zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1) & 380 & -u_ice(ji,jj)/e1u(ji,jj) & 381 & )*e1f(ji,jj)*e1f(ji,jj) & 382 & +( v_ice(ji+1,jj)/e2v(ji+1,jj) & 383 & -v_ice(ji,jj)/e2v(ji,jj) & 384 & )*e2f(ji,jj)*e2f(ji,jj) & 385 & ) & 386 & / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 387 & * tmi(ji,jj) * tmi(ji,jj+1) & 388 & * tmi(ji+1,jj) * tmi(ji+1,jj+1) 389 390 391 v_ice1(ji,jj) = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj) & 392 & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 393 & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 394 395 u_ice2(ji,jj) = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1) & 396 & +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 397 & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 398 399 END DO 400 END DO 401 CALL lbc_lnk( v_ice1, 'U', -1. ) ; CALL lbc_lnk( u_ice2, 'V', -1. ) ! lateral boundary cond. 402 403 !CDIR NOVERRCHK 364 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 365 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 366 & ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) & 367 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 368 369 370 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) & 371 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 372 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 373 374 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 375 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 376 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 377 END DO 378 END DO 379 CALL lbc_lnk( v_ice1 , 'U', -1. ) ; CALL lbc_lnk( u_ice2 , 'V', -1. ) ! lateral boundary cond. 380 404 381 DO jj = k_j1+1, k_jpj-1 405 !CDIR NOVERRCHK406 382 DO ji = fs_2, fs_jpim1 407 383 408 384 !- Calculate Delta at centre of grid cells 409 zdst = ( e2u(ji , jj) * v_ice1(ji ,jj) & 410 & - e2u(ji-1, jj) * v_ice1(ji-1,jj) & 411 & + e1v(ji, jj ) * u_ice2(ji,jj ) & 412 & - e1v(ji, jj-1) * u_ice2(ji,jj-1) & 413 & ) & 414 & / area(ji,jj) 415 416 delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 ) 417 delta_i(ji,jj) = delta + creepl 418 !-Calculate stress tensor components zs1 and zs2 419 !-at centre of grid cells (see section 3.5 of CICE user's guide). 420 zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) ) & 421 & * zpresh(ji,jj) ) ) / ( 1._wp + dtotel ) 422 zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) ) & 423 & / ( 1._wp + dtotel ) 424 425 END DO 426 END DO 427 428 CALL lbc_lnk( zs1(:,:), 'T', 1. ) 429 CALL lbc_lnk( zs2(:,:), 'T', 1. ) 430 431 !CDIR NOVERRCHK 432 DO jj = k_j1+1, k_jpj-1 433 !CDIR NOVERRCHK 434 DO ji = fs_2, fs_jpim1 385 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 386 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) & 387 & ) * r1_e12t(ji,jj) 388 389 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 390 delta_i(ji,jj) = delta + rn_creepl 391 435 392 !- Calculate Delta on corners 436 zddc = ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1) & 437 & -v_ice1(ji,jj)/e1u(ji,jj) & 438 & )*e1f(ji,jj)*e1f(ji,jj) & 439 & +( u_ice2(ji+1,jj)/e2v(ji+1,jj) & 440 & -u_ice2(ji,jj)/e2v(ji,jj) & 441 & )*e2f(ji,jj)*e2f(ji,jj) & 442 & ) & 443 & / ( e1f(ji,jj) * e2f(ji,jj) ) 444 445 zdtc = (-( v_ice1(ji,jj+1)/e1u(ji,jj+1) & 446 & -v_ice1(ji,jj)/e1u(ji,jj) & 447 & )*e1f(ji,jj)*e1f(ji,jj) & 448 & +( u_ice2(ji+1,jj)/e2v(ji+1,jj) & 449 & -u_ice2(ji,jj)/e2v(ji,jj) & 450 & )*e2f(ji,jj)*e2f(ji,jj) & 451 & ) & 452 & / ( e1f(ji,jj) * e2f(ji,jj) ) 453 454 zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 455 456 !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide). 457 zs12(ji,jj) = ( zs12(ji,jj) + dtotel * & 458 & ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) ) & 459 & / ( 1.0 + dtotel ) 460 461 END DO ! ji 462 END DO ! jj 463 464 CALL lbc_lnk( zs12(:,:), 'F', 1. ) 393 zddc = ( ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 394 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 395 & ) * r1_e12f(ji,jj) 396 397 zdtc = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 398 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 399 & ) * r1_e12f(ji,jj) 400 401 zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 402 403 !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide). 404 zs1(ji,jj) = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj) * zpresh(ji,jj) & 405 & ) * z1_dtotel 406 zs2(ji,jj) = ( zs2 (ji,jj) + dtotel * ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) & 407 & ) * z1_dtotel 408 !-Calculate stress tensor component zs12 at corners 409 zs12(ji,jj) = ( zs12(ji,jj) + dtotel * ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) & 410 & ) * z1_dtotel 411 412 END DO 413 END DO 414 CALL lbc_lnk( zs1 , 'T', 1. ) ; CALL lbc_lnk( zs2, 'T', 1. ) 415 CALL lbc_lnk( zs12, 'F', 1. ) 465 416 466 417 ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) … … 468 419 DO ji = fs_2, fs_jpim1 469 420 !- contribution of zs1, zs2 and zs12 to zf1 470 zf1(ji,jj) = 0.5 *( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj)&471 & +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj)&472 & +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj)&473 & ) / ( e1u(ji,jj)*e2u(ji,jj))421 zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 422 & + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj) & 423 & + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 424 & ) * r1_e12u(ji,jj) 474 425 ! contribution of zs1, zs2 and zs12 to zf2 475 zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) & 476 & -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) & 477 & + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 - & 478 zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) & 479 & ) / ( e1v(ji,jj)*e2v(ji,jj) ) 426 zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 427 & - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj) & 428 & + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj) & 429 & ) * r1_e12v(ji,jj) 480 430 END DO 481 431 END DO … … 487 437 IF (MOD(jter,2).eq.0) THEN 488 438 489 !CDIR NOVERRCHK490 439 DO jj = k_j1+1, k_jpj-1 491 !CDIR NOVERRCHK492 440 DO ji = fs_2, fs_jpim1 493 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)494 z0 = zmass1(ji,jj) /dtevp441 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 442 z0 = zmass1(ji,jj) * z1_dtevp 495 443 496 444 ! SB modif because ocean has no slip boundary condition 497 zv_ice1 = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj) & 498 & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj)) & 499 & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 500 za = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 501 (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj)) 502 zr = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 503 za*(u_oce1(ji,jj)) 504 zcca = z0+za 445 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji ,jj) & 446 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 447 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 448 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + & 449 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 450 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 451 zcca = z0 + za 505 452 zccb = zcorl1(ji,jj) 506 u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 507 453 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 508 454 END DO 509 455 END DO … … 511 457 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 512 458 #if defined key_agrif && defined key_lim2 513 CALL agrif_rhg_lim2( jter, n evp, 'U' )459 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 514 460 #endif 515 461 #if defined key_bdy … … 517 463 #endif 518 464 519 !CDIR NOVERRCHK520 465 DO jj = k_j1+1, k_jpj-1 521 !CDIR NOVERRCHK522 466 DO ji = fs_2, fs_jpim1 523 467 524 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)525 z0 = zmass2(ji,jj) /dtevp468 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 469 z0 = zmass2(ji,jj) * z1_dtevp 526 470 ! SB modif because ocean has no slip boundary condition 527 zu_ice2 = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj) & 528 & + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1)) & 529 & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 530 za = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 531 (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 532 zr = z0*v_ice(ji,jj) + zf2(ji,jj) + & 533 za2ct(ji,jj) + za*(v_oce2(ji,jj)) 534 zcca = z0+za 471 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) & 472 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 473 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 474 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + & 475 & ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 476 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 477 zcca = z0 + za 535 478 zccb = zcorl2(ji,jj) 536 v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 537 479 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 538 480 END DO 539 481 END DO … … 541 483 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 542 484 #if defined key_agrif && defined key_lim2 543 CALL agrif_rhg_lim2( jter, n evp, 'V' )485 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 544 486 #endif 545 487 #if defined key_bdy … … 548 490 549 491 ELSE 550 !CDIR NOVERRCHK551 492 DO jj = k_j1+1, k_jpj-1 552 !CDIR NOVERRCHK553 493 DO ji = fs_2, fs_jpim1 554 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)555 z0 = zmass2(ji,jj) /dtevp494 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 495 z0 = zmass2(ji,jj) * z1_dtevp 556 496 ! SB modif because ocean has no slip boundary condition 557 zu_ice2 = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj) & 558 & +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1)) & 559 & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 560 561 za = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 562 (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 563 zr = z0*v_ice(ji,jj) + zf2(ji,jj) + & 564 za2ct(ji,jj) + za*(v_oce2(ji,jj)) 565 zcca = z0+za 497 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) & 498 & +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 499 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 500 501 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + & 502 & ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) ) 503 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 504 zcca = z0 + za 566 505 zccb = zcorl2(ji,jj) 567 v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 568 506 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 569 507 END DO 570 508 END DO … … 572 510 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 573 511 #if defined key_agrif && defined key_lim2 574 CALL agrif_rhg_lim2( jter, n evp, 'V' )512 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 575 513 #endif 576 514 #if defined key_bdy … … 578 516 #endif 579 517 580 !CDIR NOVERRCHK581 518 DO jj = k_j1+1, k_jpj-1 582 !CDIR NOVERRCHK583 519 DO ji = fs_2, fs_jpim1 584 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 585 z0 = zmass1(ji,jj)/dtevp 586 zv_ice1 = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj) & 587 & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj)) & 588 & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 589 590 za = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 591 (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj)) 592 zr = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 593 za*(u_oce1(ji,jj)) 594 zcca = z0+za 520 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 521 z0 = zmass1(ji,jj) * z1_dtevp 522 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji,jj) & 523 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 524 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 525 526 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + & 527 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 528 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 529 zcca = z0 + za 595 530 zccb = zcorl1(ji,jj) 596 u_ice(ji,jj) = ( zr+zccb*zv_ice1)/(zcca+epsd)*zmask597 END DO ! ji598 END DO ! jj531 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 532 END DO 533 END DO 599 534 600 535 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 601 536 #if defined key_agrif && defined key_lim2 602 CALL agrif_rhg_lim2( jter, n evp, 'U' )537 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 603 538 #endif 604 539 #if defined key_bdy … … 611 546 !--- Convergence test. 612 547 DO jj = k_j1+1 , k_jpj-1 613 zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) , & 614 ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 615 END DO 616 zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) ) 548 zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 549 END DO 550 zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) ) 617 551 IF( lk_mpp ) CALL mpp_max( zresm ) ! max over the global domain 618 552 ENDIF … … 625 559 ! 4) Prevent ice velocities when the ice is thin 626 560 !------------------------------------------------------------------------------! 627 ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 628 ! ocean velocity, 629 ! This prevents high velocity when ice is thin 630 !CDIR NOVERRCHK 561 ! If the ice volume is below zvmin then ice velocity should equal the 562 ! ocean velocity. This prevents high velocity when ice is thin 631 563 DO jj = k_j1+1, k_jpj-1 632 !CDIR NOVERRCHK633 564 DO ji = fs_2, fs_jpim1 634 zdummy = vt_i(ji,jj) 635 IF ( zdummy .LE. hminrhg ) THEN 565 IF ( vt_i(ji,jj) <= zvmin ) THEN 636 566 u_ice(ji,jj) = u_oce(ji,jj) 637 567 v_ice(ji,jj) = v_oce(ji,jj) 638 ENDIF ! zdummy568 ENDIF 639 569 END DO 640 570 END DO … … 643 573 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 644 574 #if defined key_agrif && defined key_lim2 645 CALL agrif_rhg_lim2( n evp ,nevp, 'U' )646 CALL agrif_rhg_lim2( n evp ,nevp, 'V' )575 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 576 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 647 577 #endif 648 578 #if defined key_bdy … … 653 583 DO jj = k_j1+1, k_jpj-1 654 584 DO ji = fs_2, fs_jpim1 655 zdummy = vt_i(ji,jj) 656 IF ( zdummy .LE. hminrhg ) THEN 657 v_ice1(ji,jj) = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj) & 658 & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 659 & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 660 661 u_ice2(ji,jj) = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1) & 662 & +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 663 & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 664 ENDIF ! zdummy 585 IF ( vt_i(ji,jj) <= zvmin ) THEN 586 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji, jj-1) ) * e1t(ji+1,jj) & 587 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 588 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 589 590 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 591 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 592 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 593 ENDIF 665 594 END DO 666 595 END DO … … 670 599 671 600 ! Recompute delta, shear and div, inputs for mechanical redistribution 672 !CDIR NOVERRCHK673 601 DO jj = k_j1+1, k_jpj-1 674 !CDIR NOVERRCHK 675 DO ji = fs_2, jpim1 !RB bug no vect opt due to tmi 602 DO ji = fs_2, jpim1 !RB bug no vect opt due to zmask 676 603 !- divu_i(:,:), zdt(:,:): divergence and tension at centre 677 604 !- zds(:,:): shear on northeast corner of grid cells 678 zdummy = vt_i(ji,jj) 679 IF ( zdummy .LE. hminrhg ) THEN 680 681 divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj) & 682 & -e2u(ji-1,jj)*u_ice(ji-1,jj) & 683 & +e1v(ji,jj)*v_ice(ji,jj) & 684 & -e1v(ji,jj-1)*v_ice(ji,jj-1) & 685 & ) & 686 & / area(ji,jj) 687 688 zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj) & 689 & -u_ice(ji-1,jj)/e2u(ji-1,jj) & 690 & )*e2t(ji,jj)*e2t(ji,jj) & 691 & -( v_ice(ji,jj)/e1v(ji,jj) & 692 & -v_ice(ji,jj-1)/e1v(ji,jj-1) & 693 & )*e1t(ji,jj)*e1t(ji,jj) & 694 & ) & 695 & / area(ji,jj) 605 IF ( vt_i(ji,jj) <= zvmin ) THEN 606 607 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj ) * u_ice(ji-1,jj ) & 608 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji ,jj-1) * v_ice(ji ,jj-1) & 609 & ) * r1_e12t(ji,jj) 610 611 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 612 & -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 613 & ) * r1_e12t(ji,jj) 696 614 ! 697 615 ! SB modif because ocean has no slip boundary condition 698 zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1) & 699 & - u_ice(ji,jj) / e1u(ji,jj) ) & 700 & * e1f(ji,jj) * e1f(ji,jj) & 701 & + ( v_ice(ji+1,jj) / e2v(ji+1,jj) & 702 & - v_ice(ji,jj) / e2v(ji,jj) ) & 703 & * e2f(ji,jj) * e2f(ji,jj) ) & 704 & / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 705 & * tmi(ji,jj) * tmi(ji,jj+1) & 706 & * tmi(ji+1,jj) * tmi(ji+1,jj+1) 707 708 zdst = ( e2u( ji , jj ) * v_ice1(ji ,jj ) & 709 & - e2u( ji-1, jj ) * v_ice1(ji-1,jj ) & 710 & + e1v( ji , jj ) * u_ice2(ji ,jj ) & 711 & - e1v( ji , jj-1 ) * u_ice2(ji ,jj-1) ) / area(ji,jj) 712 713 delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 ) 714 delta_i(ji,jj) = delta + creepl 616 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 617 & +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 618 & ) * r1_e12f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) & 619 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 620 621 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e12t(ji,jj) 623 624 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 625 delta_i(ji,jj) = delta + rn_creepl 715 626 716 ENDIF ! zdummy 717 718 END DO !jj 719 END DO !ji 627 ENDIF 628 END DO 629 END DO 720 630 ! 721 631 !------------------------------------------------------------------------------! 722 632 ! 5) Store stress tensor and its invariants 723 633 !------------------------------------------------------------------------------! 724 !725 634 ! * Invariants of the stress tensor are required for limitd_me 726 635 ! (accelerates convergence and improves stability) 727 636 DO jj = k_j1+1, k_jpj-1 728 637 DO ji = fs_2, fs_jpim1 729 ! begin TECLIM change 730 zdst= ( e2u( ji , jj ) * v_ice1(ji,jj) & 731 & - e2u( ji-1, jj ) * v_ice1(ji-1,jj) & 732 & + e1v( ji , jj ) * u_ice2(ji,jj) & 733 & - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj) 638 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj ) * v_ice1(ji-1,jj) & 639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e12t(ji,jj) 734 640 shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 735 ! end TECLIM change736 641 END DO 737 642 END DO … … 772 677 DO jj = k_j1+1, k_jpj-1 773 678 DO ji = 2, jpim1 774 IF (zpresh(ji,jj) .GT.1.0) THEN679 IF (zpresh(ji,jj) > 1.0) THEN 775 680 sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 776 681 sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) … … 786 691 ! 787 692 CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 788 CALL wrk_dealloc( jpi,jpj, u_oce 1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1)693 CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 789 694 CALL wrk_dealloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 790 695 CALL wrk_dealloc( jpi,jpj, zdt , zds , zs1 , zs2 , zs12 , zresr , zpice ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r4990 r5123 18 18 USE ice ! sea-ice variables 19 19 USE oce , ONLY : snwice_mass, snwice_mass_b 20 USE par_ice ! sea-ice parameters21 20 USE dom_oce ! ocean domain 22 21 USE sbc_oce ! Surface boundary condition: ocean fields … … 27 26 USE wrk_nemo ! work arrays 28 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 USE limctl 29 29 30 30 IMPLICIT NONE … … 33 33 PUBLIC lim_rst_opn ! routine called by icestep.F90 34 34 PUBLIC lim_rst_write ! routine called by icestep.F90 35 PUBLIC lim_rst_read ! routine called by iceini.F9035 PUBLIC lim_rst_read ! routine called by sbc_lim_init 36 36 37 37 LOGICAL, PUBLIC :: lrst_ice !: logical to control the ice restart write … … 86 86 ENDIF 87 87 ! 88 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print 88 89 END SUBROUTINE lim_rst_opn 89 90 … … 165 166 CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i ) 166 167 CALL iom_rstput( iter, nitrst, numriw, 'stress12_i' , stress12_i ) 167 CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass' , snwice_mass ) !clem modif168 CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) !clem modif168 CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass' , snwice_mass ) 169 CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) 169 170 170 171 DO jl = 1, jpl … … 395 396 CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i ) 396 397 CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i ) 397 CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass' , snwice_mass ) !clem modif398 CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) !clem modif398 CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass' , snwice_mass ) 399 CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 399 400 400 401 DO jl = 1, jpl … … 521 522 ! 522 523 ! clem: I do not understand why the following IF is needed 523 ! I suspect something inconsistent in the main code with option n um_sal=1524 IF( n um_sal == 1 ) THEN524 ! I suspect something inconsistent in the main code with option nn_icesal=1 525 IF( nn_icesal == 1 ) THEN 525 526 DO jl = 1, jpl 526 sm_i(:,:,jl) = bulk_sal527 sm_i(:,:,jl) = rn_icesal 527 528 DO jk = 1, nlay_i 528 s_i(:,:,jk,jl) = bulk_sal529 s_i(:,:,jk,jl) = rn_icesal 529 530 END DO 530 531 END DO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5020 r5123 25 25 USE par_oce ! ocean parameters 26 26 USE phycst ! physical constants 27 USE par_ice ! ice parameters28 27 USE dom_oce ! ocean domain 29 USE dom_ice, ONLY : tms, area30 28 USE ice ! LIM sea-ice variables 31 29 USE sbc_ice ! Surface boundary condition: sea-ice fields … … 40 38 USE prtctl ! Print control 41 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 42 USE traqsr ! clem: add penetration of solar flux intothe calculation of heat budget40 USE traqsr ! add penetration of solar flux in the calculation of heat budget 43 41 USE iom 44 42 USE domvvl ! Variable volume 43 USE limctl 45 44 46 45 IMPLICIT NONE 47 46 PRIVATE 48 47 49 PUBLIC lim_sbc_init ! called by ice_init48 PUBLIC lim_sbc_init ! called by sbc_lim_init 50 49 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 51 50 PUBLIC lim_sbc_tau ! called by sbc_ice_lim … … 99 98 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 100 99 !! These refs are now obsolete since everything has been revised 101 !! The ref should be Rousset et al., 2015 ?100 !! The ref should be Rousset et al., 2015 102 101 !!--------------------------------------------------------------------- 103 102 INTEGER, INTENT(in) :: kt ! number of iteration 104 !105 103 INTEGER :: ji, jj, jl, jk ! dummy loop indices 106 ! 107 REAL(wp) :: zemp ! local scalars 104 REAL(wp) :: zemp ! local scalars 108 105 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 109 106 REAL(wp) :: zfcm1 ! New solar flux received by the ocean … … 172 169 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction 173 170 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean 174 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)** betas ) ! except solid precip intercepted by sea-ice171 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**rn_betas ) ! except solid precip intercepted by sea-ice 175 172 ENDIF 176 173 … … 199 196 snwice_mass_b(:,:) = snwice_mass(:,:) 200 197 ! new mass per unit area 201 snwice_mass (:,:) = tm s(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )198 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 202 199 ! time evolution of snow+ice mass 203 200 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice … … 225 222 ENDIF 226 223 224 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' ) ! control print 227 225 228 226 IF(ln_ctl) THEN … … 270 268 ! 271 269 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 272 !CDIR NOVERRCHK273 270 DO jj = 2, jpjm1 !* update the modulus of stress at ocean surface (T-point) 274 !CDIR NOVERRCHK275 271 DO ji = fs_2, fs_jpim1 276 272 ! ! 2*(U_ice-U_oce) at T-point … … 322 318 !! ** input : Namelist namicedia 323 319 !!------------------------------------------------------------------- 324 REAL(wp) :: zsum, zarea325 !326 320 INTEGER :: ji, jj, jk ! dummy loop indices 327 321 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar … … 343 337 END WHERE 344 338 ENDIF 345 ! clem modif339 346 340 IF( .NOT. ln_rstart ) THEN 347 341 fraqsr_1lev(:,:) = 1._wp 348 342 ENDIF 349 343 ! 350 ! clem: snwice_mass in the restart file now351 344 IF( .NOT. ln_rstart ) THEN 352 345 ! ! embedded sea ice 353 346 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 354 snwice_mass (:,:) = tm s(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )347 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 355 348 snwice_mass_b(:,:) = snwice_mass(:,:) 356 349 ELSE -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4990 r5123 24 24 USE oce , ONLY : fraqsr_1lev 25 25 USE ice ! LIM: sea-ice variables 26 USE par_ice ! LIM: sea-ice parameters27 26 USE sbc_oce ! Surface boundary condition: ocean fields 28 27 USE sbc_ice ! Surface boundary condition: ice fields … … 34 33 USE limthd_sal ! LIM: thermodynamics, ice salinity 35 34 USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution 35 USE limthd_lac ! LIM-3 lateral accretion 36 USE limitd_th ! remapping thickness distribution 36 37 USE limtab ! LIM: 1D <==> 2D transformation 37 38 USE limvar ! LIM: sea-ice variables … … 44 45 USE timing ! Timing 45 46 USE limcons ! conservation tests 47 USE limctl 46 48 47 49 IMPLICIT NONE … … 49 51 50 52 PUBLIC lim_thd ! called by limstp module 51 PUBLIC lim_thd_init ! called by iceini module53 PUBLIC lim_thd_init ! called by sbc_lim_init 52 54 53 55 !! * Substitutions … … 80 82 !! ** References : 81 83 !!--------------------------------------------------------------------- 82 INTEGER, INTENT(in) :: 84 INTEGER, INTENT(in) :: kt ! number of iteration 83 85 !! 84 86 INTEGER :: ji, jj, jk, jl ! dummy loop indices 85 INTEGER :: nbpb ! nb of icy pts for thermo. cal.87 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 86 88 INTEGER :: ii, ij ! temporary dummy loop index 87 REAL(wp) :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04)88 REAL(wp) :: zch = 0.0057_wp ! heat transfer coefficient89 REAL(wp) :: zareamin90 89 REAL(wp) :: zfric_u, zqld, zqfr 91 !92 90 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 91 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 92 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 93 93 ! 94 94 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns … … 106 106 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 107 107 108 109 108 !-------------------- 110 109 ! 1.2) Heat content 111 110 !-------------------- 112 ! Change the units of heat content; from global units to J.m3111 ! Change the units of heat content; from J/m2 to J/m3 113 112 DO jl = 1, jpl 114 113 DO jk = 1, nlay_i … … 116 115 DO ji = 1, jpi 117 116 !0 if no ice and 1 if yes 118 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi 10 ) )117 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi20 ) ) 119 118 !Energy of melting q(S,T) [J.m-3] 120 e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 121 !convert units ! very important that this line is here 122 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 119 e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i ) 123 120 END DO 124 121 END DO … … 128 125 DO ji = 1, jpi 129 126 !0 if no ice and 1 if yes 130 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi 10 ) )127 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi20 ) ) 131 128 !Energy of melting q(S,T) [J.m-3] 132 e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 133 !convert units ! very important that this line is here 134 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 129 e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s ) 135 130 END DO 136 131 END DO … … 161 156 ENDIF 162 157 163 !CDIR NOVERRCHK164 158 DO jj = 1, jpj 165 !CDIR NOVERRCHK166 159 DO ji = 1, jpi 167 rswitch = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice160 rswitch = tmask(ji,jj,1) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 168 161 ! 169 162 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget … … 178 171 ! precip is included in qns but not in qns_ice 179 172 IF ( lk_cpl ) THEN 180 zqld = tm s(ji,jj) * rdt_ice * &173 zqld = tmask(ji,jj,1) * rdt_ice * & 181 174 & ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) & ! pfrld already included in coupled mode 182 & + ( pfrld(ji,jj)** betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip183 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt t) - lfus ) &184 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt t) )175 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 176 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 177 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 185 178 ELSE 186 zqld = tm s(ji,jj) * rdt_ice * &179 zqld = tmask(ji,jj,1) * rdt_ice * & 187 180 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) & 188 & + ( pfrld(ji,jj)** betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip189 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt t) - lfus ) &190 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt t) )181 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 182 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 183 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 191 184 ENDIF 192 185 193 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 194 zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 186 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 187 zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 188 189 ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 190 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 191 fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 192 fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 193 ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 194 ! the freezing point, so that we do not have SST < T_freeze 195 ! This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 195 196 196 197 !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 197 qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )198 qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 198 199 199 200 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 200 IF( at_i(ji,jj) > epsi10 .AND.zqld > 0._wp ) THEN201 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.F90201 IF( zqld > 0._wp ) THEN 202 fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 202 203 qlead(ji,jj) = 0._wp 203 204 ELSE … … 205 206 ENDIF 206 207 ! 207 !-- Energy from the turbulent oceanic heat flux --- !208 !clem zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )209 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )210 fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2211 ! upper bound for fhtur: we do not want SST to drop below Tfreeze.212 ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)213 ! This is not a clean budget, so that should be corrected at some point214 fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )215 216 208 ! ----------------------------------------- 217 209 ! Net heat flux on top of ice-ocean [W.m-2] … … 223 215 & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) & 224 216 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 225 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt t) - lfus ) &226 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt t)217 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 218 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) 227 219 228 220 ! ----------------------------------------------------------------------------- … … 236 228 & + pfrld(ji,jj) * qns(ji,jj) & 237 229 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 238 & + ( pfrld(ji,jj)** betas - pfrld(ji,jj) ) * sprecip(ji,jj) &239 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt t) - lfus ) &240 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt t) &230 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) & 231 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 232 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) & 241 233 ! heat flux taken from the ocean where there is open water ice formation 242 234 & - qlead(ji,jj) * r1_rdtice & … … 259 251 ENDIF 260 252 261 zareamin = epsi10262 253 nbpb = 0 263 254 DO jj = 1, jpj 264 255 DO ji = 1, jpi 265 IF ( a_i(ji,jj,jl) .gt. zareamin) THEN256 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 266 257 nbpb = nbpb + 1 267 258 npb(nbpb) = (jj - 1) * jpi + ji … … 289 280 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. 290 281 291 !------------------------- 292 ! 4.1 Move to 1D arrays 293 !------------------------- 294 295 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 296 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 297 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 298 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 299 300 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 301 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 302 DO jk = 1, nlay_s 303 CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 304 CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 305 END DO 306 DO jk = 1, nlay_i 307 CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 308 CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 309 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 310 END DO 311 312 CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 313 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 314 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) 315 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 316 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 317 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 318 IF( .NOT. lk_cpl ) THEN 319 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 320 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 321 ENDIF 322 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 323 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 324 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 325 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) 326 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 327 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 328 329 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 330 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 331 332 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 333 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) 334 CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) ) 335 CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) ) 336 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 337 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 338 339 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 340 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) 341 CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) ) 342 CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) ) 343 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 344 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 345 346 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 347 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) 348 CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) ) 349 CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) ) 350 CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) ) 351 CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) ) 352 CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) ) 353 CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) ) 354 CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) ) 355 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 356 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 357 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 358 359 !-------------------------------- 360 ! 4.3) Thermodynamic processes 361 !-------------------------------- 282 !-------------------------! 283 ! --- Move to 1D arrays --- 284 !-------------------------! 285 CALL lim_thd_1d2d( nbpb, jl, 1 ) 286 287 !--------------------------------------! 288 ! --- Ice/Snow Temperature profile --- ! 289 !--------------------------------------! 290 CALL lim_thd_dif( 1, nbpb ) 362 291 363 292 !---------------------------------! 364 ! Ice/Snow Temperature profile ! 365 !---------------------------------! 366 CALL lim_thd_dif( 1, nbpb ) 367 368 !---------------------------------! 369 ! Ice/Snow thicnkess ! 293 ! --- Ice/Snow thickness --- ! 370 294 !---------------------------------! 371 295 CALL lim_thd_dh( 1, nbpb ) … … 375 299 376 300 !---------------------------------! 377 ! --- Ice salinity --- !301 ! --- Ice salinity --- ! 378 302 !---------------------------------! 379 303 CALL lim_thd_sal( 1, nbpb ) 380 304 381 305 !---------------------------------! 382 ! --- temperature update --- !306 ! --- temperature update --- ! 383 307 !---------------------------------! 384 308 CALL lim_thd_temp( 1, nbpb ) 385 309 386 !-------------------------------- 387 ! 4.4) Move 1D to 2D vectors 388 !-------------------------------- 389 390 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 391 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) 392 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj ) 393 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj ) 394 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj ) 395 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj ) 396 DO jk = 1, nlay_s 397 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj) 398 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj) 399 END DO 400 DO jk = 1, nlay_i 401 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj) 402 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj) 403 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj) 404 END DO 405 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 406 407 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 408 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 409 410 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 411 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) 412 CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj ) 413 CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj ) 414 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 415 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 416 417 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 418 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) 419 CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj ) 420 CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj ) 421 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 422 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 423 424 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 425 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) 426 CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj ) 427 CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj ) 428 CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj ) 429 CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj ) 430 CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj ) 431 CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj ) 432 CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj ) 433 CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj ) 434 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 435 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb) , jpi, jpj ) 436 ! 437 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 438 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 310 !------------------------------------! 311 ! --- lateral melting if monocat --- ! 312 !------------------------------------! 313 IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 ) ) THEN 314 CALL lim_thd_lam( 1, nbpb ) 315 END IF 316 317 !-------------------------! 318 ! --- Move to 2D arrays --- 319 !-------------------------! 320 CALL lim_thd_1d2d( nbpb, jl, 2 ) 321 439 322 ! 440 323 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? … … 448 331 449 332 !------------------------ 450 ! 5.1)Ice heat content333 ! Ice heat content 451 334 !------------------------ 452 ! Enthalpies are global variables we have to readjust the units (heat content in J oules)335 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 453 336 DO jl = 1, jpl 454 337 DO jk = 1, nlay_i 455 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a rea(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) )338 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 456 339 END DO 457 340 END DO 458 341 459 342 !------------------------ 460 ! 5.2)Snow heat content343 ! Snow heat content 461 344 !------------------------ 462 ! Enthalpies are global variables we have to readjust the units (heat content in J oules)345 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 463 346 DO jl = 1, jpl 464 347 DO jk = 1, nlay_s 465 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a rea(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) )348 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 466 349 END DO 467 350 END DO 351 352 !------------------------ 353 ! Ice natural aging 354 !------------------------ 355 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice /rday 468 356 469 357 !---------------------------------- 470 ! 5.3)Change thickness to volume358 ! Change thickness to volume 471 359 !---------------------------------- 472 360 CALL lim_var_eqv2glo 473 361 474 362 !-------------------------------------------- 475 ! 5.4)Diagnostic thermodynamic growth rates363 ! Diagnostic thermodynamic growth rates 476 364 !-------------------------------------------- 365 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print 366 477 367 IF(ln_ctl) THEN ! Control print 478 368 CALL prt_ctl_info(' ') 479 369 CALL prt_ctl_info(' - Cell values : ') 480 370 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 481 CALL prt_ctl(tab2d_1= area, clinfo1=' lim_thd : cell area :')371 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd : cell area :') 482 372 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd : at_i :') 483 373 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd : vt_i :') … … 510 400 CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 511 401 512 ! 402 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 403 !------------------------------------------------------------------------------| 404 ! 6) Transport of ice between thickness categories. | 405 !------------------------------------------------------------------------------| 406 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 407 408 ! Given thermodynamic growth rates, transport ice between thickness categories. 409 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 410 ! 411 CALL lim_var_glo2eqv ! only for info 412 CALL lim_var_agg(1) 413 414 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 415 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 416 !------------------------------------------------------------------------------| 417 ! 7) Add frazil ice growing in leads. 418 !------------------------------------------------------------------------------| 419 CALL lim_thd_lac 420 CALL lim_var_glo2eqv ! only for info 421 513 422 ! conservation test 514 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 423 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 424 425 IF(ln_ctl) THEN ! Control print 426 CALL prt_ctl_info(' ') 427 CALL prt_ctl_info(' - Cell values : ') 428 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 429 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th : cell area :') 430 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :') 431 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :') 432 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :') 433 DO jl = 1, jpl 434 CALL prt_ctl_info(' ') 435 CALL prt_ctl_info(' - Category : ', ivar1=jl) 436 CALL prt_ctl_info(' ~~~~~~~~~~') 437 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ') 438 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ') 439 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ') 440 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ') 441 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ') 442 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ') 443 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ') 444 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ') 445 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 446 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 447 DO jk = 1, nlay_i 448 CALL prt_ctl_info(' ') 449 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 450 CALL prt_ctl_info(' ~~~~~~~') 451 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 452 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 453 END DO 454 END DO 455 ENDIF 515 456 ! 516 457 IF( nn_timing == 1 ) CALL timing_stop('limthd') … … 534 475 DO jk = 1, nlay_i 535 476 DO ji = kideb, kiut 536 ztmelts = -tmut * s_i_1d(ji,jk) + rt t477 ztmelts = -tmut * s_i_1d(ji,jk) + rt0 537 478 ! Conversion q(S,T) -> T (second order equation) 538 479 zaaa = cpic 539 zbbb = ( rcp - cpic ) * ( ztmelts - rt t ) + q_i_1d(ji,jk) /rhoic - lfus540 zccc = lfus * ( ztmelts - rt t)480 zbbb = ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus 481 zccc = lfus * ( ztmelts - rt0 ) 541 482 zdiscrim = SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 542 t_i_1d(ji,jk) = rt t- ( zbbb + zdiscrim ) / ( 2._wp * zaaa )483 t_i_1d(ji,jk) = rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 543 484 544 485 ! mask temperature 545 486 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 546 t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt t487 t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 547 488 END DO 548 489 END DO 549 490 550 491 END SUBROUTINE lim_thd_temp 492 493 SUBROUTINE lim_thd_lam( kideb, kiut ) 494 !!----------------------------------------------------------------------- 495 !! *** ROUTINE lim_thd_lam *** 496 !! 497 !! ** Purpose : Lateral melting in case monocategory 498 !! ( dA = A/2h dh ) 499 !!----------------------------------------------------------------------- 500 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 501 INTEGER :: ji ! dummy loop indices 502 REAL(wp) :: zhi_bef ! ice thickness before thermo 503 REAL(wp) :: zdh_mel, zda_mel ! net melting 504 REAL(wp) :: zv ! ice volume 505 506 DO ji = kideb, kiut 507 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 508 IF( zdh_mel < 0._wp ) THEN 509 zv = a_i_1d(ji) * ht_i_1d(ji) 510 ! lateral melting = concentration change 511 zhi_bef = ht_i_1d(ji) - zdh_mel 512 zda_mel = a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi10 ) ) 513 a_i_1d(ji) = MAX( 0._wp, a_i_1d(ji) + zda_mel ) 514 ! adjust thickness 515 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - a_i_1d(ji) + epsi20 ) ) 516 ht_i_1d(ji) = rswitch * zv / MAX( a_i_1d(ji), epsi20 ) 517 ! retrieve total concentration 518 at_i_1d(ji) = a_i_1d(ji) 519 END IF 520 END DO 521 522 END SUBROUTINE lim_thd_lam 523 524 SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) 525 !!----------------------------------------------------------------------- 526 !! *** ROUTINE lim_thd_1d2d *** 527 !! 528 !! ** Purpose : move arrays from 1d to 2d and the reverse 529 !!----------------------------------------------------------------------- 530 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D 531 ! 2= from 1D to 2D 532 INTEGER, INTENT(in) :: nbpb ! size of 1D arrays 533 INTEGER, INTENT(in) :: jl ! ice cat 534 INTEGER :: jk ! dummy loop indices 535 536 SELECT CASE( kn ) 537 538 CASE( 1 ) 539 540 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 541 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 542 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 543 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 544 545 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 546 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 547 DO jk = 1, nlay_s 548 CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 549 CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 550 END DO 551 DO jk = 1, nlay_i 552 CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 553 CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 554 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 555 END DO 556 557 CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 558 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 559 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) 560 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 561 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 562 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 563 IF( .NOT. lk_cpl ) THEN 564 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 565 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 566 ENDIF 567 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 568 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 569 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 570 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) 571 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 572 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 573 574 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 575 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 576 577 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 578 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) 579 CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) ) 580 CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) ) 581 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 582 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 583 584 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 585 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) 586 CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) ) 587 CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) ) 588 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 589 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 590 591 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 592 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) 593 CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) ) 594 CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) ) 595 CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) ) 596 CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) ) 597 CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) ) 598 CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) ) 599 CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) ) 600 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 601 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 602 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 603 604 CASE( 2 ) 605 606 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 607 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) 608 CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj ) 609 CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj ) 610 CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj ) 611 CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj ) 612 DO jk = 1, nlay_s 613 CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj) 614 CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj) 615 END DO 616 DO jk = 1, nlay_i 617 CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj) 618 CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj) 619 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj) 620 END DO 621 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 622 623 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 624 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 625 626 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 627 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) 628 CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj ) 629 CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj ) 630 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 631 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 632 633 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 634 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) 635 CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj ) 636 CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj ) 637 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 638 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 639 640 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 641 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) 642 CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj ) 643 CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj ) 644 CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj ) 645 CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj ) 646 CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj ) 647 CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj ) 648 CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj ) 649 CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj ) 650 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 651 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 652 ! 653 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 654 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 655 656 END SELECT 657 658 END SUBROUTINE lim_thd_1d2d 659 551 660 552 661 SUBROUTINE lim_thd_init … … 563 672 !!------------------------------------------------------------------- 564 673 INTEGER :: ios ! Local integer output status for namelist read 565 NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,&566 & hiclim, hnzst, parsub, betas, &567 & kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi674 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 675 & rn_himin, parsub, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 676 & nn_monocat 568 677 !!------------------------------------------------------------------- 569 678 ! … … 582 691 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 583 692 IF(lwm) WRITE ( numoni, namicethd ) 693 ! 694 IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN 695 nn_monocat = 0 696 IF(lwp) WRITE(numout, *) ' nn_monocat must be 0 in multi-category case ' 697 ENDIF 584 698 585 699 IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) … … 588 702 WRITE(numout,*) 589 703 WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation ' 590 WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt 591 WRITE(numout,*)' ice thick. for lateral accretion hiccrit = ', hiccrit 592 WRITE(numout,*)' Frazil ice thickness as a function of wind or not fraz_swi = ', fraz_swi 593 WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom maxfrazb = ', maxfrazb 594 WRITE(numout,*)' Thresold relative drift speed for collection of frazil vfrazb = ', vfrazb 595 WRITE(numout,*)' Squeezing coefficient for collection of frazil Cfrazb = ', Cfrazb 596 WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim 704 WRITE(numout,*)' ice thick. for lateral accretion rn_hnewice = ', rn_hnewice 705 WRITE(numout,*)' Frazil ice thickness as a function of wind or not ln_frazil = ', ln_frazil 706 WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom rn_maxfrazb = ', rn_maxfrazb 707 WRITE(numout,*)' Thresold relative drift speed for collection of frazil rn_vfrazb = ', rn_vfrazb 708 WRITE(numout,*)' Squeezing coefficient for collection of frazil rn_Cfrazb = ', rn_Cfrazb 709 WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin 597 710 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' 598 WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst599 711 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub 600 WRITE(numout,*)' coefficient for ice-lead partition of snowfall betas = ',betas601 WRITE(numout,*)' extinction radiation parameter in sea ice (1.0) kappa_i = ',kappa_i602 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation n conv_i_thd = ', nconv_i_thd603 WRITE(numout,*)' maximal err. on T for heat diffusion computation maxer_i_thd = ', maxer_i_thd604 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice thcon_i_swi = ', thcon_i_swi712 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas 713 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i 714 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif 715 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif 716 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon 605 717 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 718 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat 606 719 ENDIF 607 720 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4990 r5123 20 20 USE sbc_oce ! Surface boundary condition: ocean fields 21 21 USE ice ! LIM variables 22 USE par_ice ! LIM parameters23 22 USE thd_ice ! LIM thermodynamics 24 23 USE in_out_manager ! I/O manager … … 70 69 71 70 REAL(wp) :: ztmelts ! local scalar 72 REAL(wp) :: z dh, zfdum !71 REAL(wp) :: zfdum 73 72 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 74 73 REAL(wp) :: zcoeff ! dummy argument for snowfall partitioning over ice and leads … … 91 90 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2) 92 91 REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2) 93 REAL(wp), POINTER, DIMENSION(:) :: zq_1cat ! corrected heat in case 1-cat and hmelt>15cm (J.m-2)94 92 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 95 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2)93 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 96 94 INTEGER , POINTER, DIMENSION(:) :: icount ! number of layers vanished by melting 97 95 … … 107 105 REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3) 108 106 109 ! mass and salt flux (clem) 110 REAL(wp) :: zdvres, zswitch_sal 107 REAL(wp) :: zswitch_sal 111 108 112 109 ! Heat conservation … … 115 112 !!------------------------------------------------------------------ 116 113 117 ! Discriminate between varying salinity (n um_sal=2) and prescribed cases (other values)118 SELECT CASE( n um_sal ) ! varying salinity or not114 ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 115 SELECT CASE( nn_icesal ) ! varying salinity or not 119 116 CASE( 1, 3, 4 ) ; zswitch_sal = 0 ! prescribed salinity profile 120 117 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile 121 118 END SELECT 122 119 123 CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_ 1cat, zq_rema )120 CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 124 121 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 125 122 CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i ) … … 130 127 131 128 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt (:) = 0._wp 132 zq_ 1cat(:) = 0._wp ; zq_rema(:) = 0._wp129 zq_rema(:) = 0._wp 133 130 134 131 zh_s (:) = 0._wp … … 148 145 DO jk = 1, nlay_i 149 146 DO ji = kideb, kiut 150 h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i )147 h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i 151 148 qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk) 152 149 ENDDO … … 159 156 DO ji = kideb, kiut 160 157 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 161 ztmelts = rswitch * rt t + ( 1._wp - rswitch ) * rtt158 ztmelts = rswitch * rt0 + ( 1._wp - rswitch ) * rt0 162 159 163 160 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) … … 174 171 !------------------------------------------------------------------------------! 175 172 DO ji = kideb, kiut 176 IF( t_s_1d(ji,1) > rt t) THEN !!! Internal melting173 IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting 177 174 ! Contribution to heat flux to the ocean [W.m-2], < 0 178 175 hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice … … 182 179 ht_s_1d(ji) = 0._wp 183 180 q_s_1d (ji,1) = 0._wp 184 t_s_1d (ji,1) = rt t181 t_s_1d (ji,1) = rt0 185 182 END IF 186 183 END DO … … 191 188 ! 192 189 DO ji = kideb, kiut 193 zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )190 zh_s(ji) = ht_s_1d(ji) * r1_nlay_s 194 191 END DO 195 192 ! … … 202 199 DO jk = 1, nlay_i 203 200 DO ji = kideb, kiut 204 zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i )201 zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i 205 202 zqh_i(ji) = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk) 206 203 END DO … … 230 227 !----------- 231 228 ! thickness change 232 zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )** betas ) / at_i_1d(ji)233 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice /rhosn229 zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**rn_betas ) / at_i_1d(ji) 230 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice * r1_rhosn 234 231 ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 235 zqprec (ji) = rhosn * ( cpic * ( rt t- MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )232 zqprec (ji) = rhosn * ( cpic * ( rt0 - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus ) 236 233 IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 237 234 ! heat flux from snow precip (>0, W.m-2) … … 258 255 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) ) 259 256 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) ) 260 zh_s (ji) = ht_s_1d(ji) / REAL( nlay_s )257 zh_s (ji) = ht_s_1d(ji) * r1_nlay_s 261 258 262 259 ENDIF … … 279 276 280 277 ! updates available heat + thickness 281 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )278 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 282 279 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) ) 283 280 … … 314 311 DO ji = kideb, kiut 315 312 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 316 zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )313 zh_s(ji) = ht_s_1d(ji) * r1_nlay_s 317 314 END DO ! ji 318 315 … … 327 324 q_s_1d(ji,jk) = ( 1._wp - rswitch ) / MAX( ht_s_1d(ji), epsi20 ) * & 328 325 & ( ( MAX( 0._wp, dh_s_tot(ji) ) ) * zqprec(ji) + & 329 & ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rt t- t_s_1d(ji,jk) ) + lfus ) )326 & ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 330 327 zq_s(ji) = zq_s(ji) + q_s_1d(ji,jk) 331 328 END DO … … 338 335 DO jk = 1, nlay_i 339 336 DO ji = kideb, kiut 340 zEi = - q_i_1d(ji,jk) / rhoic! Specific enthalpy of layer k [J/kg, <0]341 342 ztmelts = - tmut * s_i_1d(ji,jk) + rt t! Melting point of layer k [K]337 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of layer k [J/kg, <0] 338 339 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 ! Melting point of layer k [K] 343 340 344 341 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0] … … 348 345 zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 349 346 350 zdeltah(ji,jk) = - zfmdt / rhoic! Melt of layer jk [m, <0]347 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Melt of layer jk [m, <0] 351 348 352 349 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] … … 408 405 ! -> need for an iterative procedure, which converges quickly 409 406 410 IF ( n um_sal == 2 ) THEN407 IF ( nn_icesal == 2 ) THEN 411 408 num_iter_max = 5 412 409 ELSE … … 414 411 ENDIF 415 412 416 ! clem debug.Just to be sure that enthalpy at nlay_i+1 is null413 ! Just to be sure that enthalpy at nlay_i+1 is null 417 414 DO ji = kideb, kiut 418 415 q_i_1d(ji,nlay_i+1) = 0._wp … … 440 437 + ( 1. - zswitch_sal ) * sm_i_1d(ji) 441 438 ! New ice growth 442 ztmelts = - tmut * s_i_new(ji) + rt t! New ice melting point (K)439 ztmelts = - tmut * s_i_new(ji) + rt0 ! New ice melting point (K) 443 440 444 441 zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 445 442 446 443 zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0) 447 & - lfus * ( 1.0 - ( ztmelts - rt t ) / ( zt_i_new - rtt) ) &448 & + rcp * ( ztmelts-rt t)444 & - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) ) & 445 & + rcp * ( ztmelts-rt0 ) 449 446 450 447 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) … … 467 464 zfmdt = - rhoic * dh_i_bott(ji) ! Mass flux x time step (kg/m2, < 0) 468 465 469 ztmelts = - tmut * s_i_new(ji) + rt t! New ice melting point (K)466 ztmelts = - tmut * s_i_new(ji) + rt0 ! New ice melting point (K) 470 467 471 468 zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 472 469 473 470 zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0) 474 & - lfus * ( 1.0 - ( ztmelts - rt t ) / ( zt_i_new - rtt) ) &475 & + rcp * ( ztmelts-rt t)471 & - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) ) & 472 & + rcp * ( ztmelts-rt0 ) 476 473 477 474 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) … … 503 500 DO jk = nlay_i, 1, -1 504 501 DO ji = kideb, kiut 505 IF( zf_tt(ji) >= 0._wp .AND. jk > icount(ji) ) THEN ! do not calculate where layer has already disappeared fromsurface melting506 507 ztmelts = - tmut * s_i_1d(ji,jk) + rt t! Melting point of layer jk (K)502 IF( zf_tt(ji) >= 0._wp .AND. jk > icount(ji) ) THEN ! do not calculate where layer has already disappeared by surface melting 503 504 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 ! Melting point of layer jk (K) 508 505 509 506 IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 510 507 511 zEi = - q_i_1d(ji,jk) / rhoic! Specific enthalpy of melting ice (J/kg, <0)512 513 !!zEw = rcp * ( t_i_1d(ji,jk) - rt t) ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0)508 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 509 510 !!zEw = rcp * ( t_i_1d(ji,jk) - rt0 ) ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0) 514 511 515 512 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) … … 538 535 ELSE !!! Basal melting 539 536 540 zEi = - q_i_1d(ji,jk) /rhoic ! Specific enthalpy of melting ice (J/kg, <0)541 542 zEw = rcp * ( ztmelts - rt t )! Specific enthalpy of meltwater (J/kg, <0)543 544 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0)545 546 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0)547 548 zdeltah(ji,jk) = - zfmdt / rhoic! Gross thickness change537 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 538 539 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of meltwater (J/kg, <0) 540 541 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 542 543 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0) 544 545 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Gross thickness change 549 546 550 547 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change … … 576 573 577 574 ENDIF 578 END DO ! ji 579 END DO ! jk 580 581 !------------------------------------------------------------------------------! 582 ! Excessive ablation in a 1-category model 583 ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 584 !------------------------------------------------------------------------------! 585 ! ??? keep ??? 586 ! clem bug: I think this should be included above, so we would not have to 587 ! track heat/salt/mass fluxes backwards 588 ! IF( jpl == 1 ) THEN 589 ! DO ji = kideb, kiut 590 ! IF( zf_tt(ji) >= 0._wp ) THEN 591 ! zdh = MAX( hmelt , dh_i_bott(ji) ) 592 ! zdvres = zdh - dh_i_bott(ji) ! >=0 593 ! dh_i_bott(ji) = zdh 594 ! 595 ! ! excessive energy is sent to lateral ablation 596 ! rswitch = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) ) 597 ! zq_1cat(ji) = rswitch * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0 598 ! 599 ! ! correct salt and mass fluxes 600 ! 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 601 ! wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice 602 ! ENDIF 603 ! END DO 604 ! ENDIF 575 END DO 576 END DO 605 577 606 578 !------------------------------------------- … … 635 607 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 636 608 ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 637 hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_ 1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice609 hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 638 610 639 611 IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) … … 655 627 ! Salinity of snow ice 656 628 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 657 zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) /rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)629 zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji) 658 630 659 631 ! entrapment during snow ice formation 660 632 ! new salinity difference stored (to be used in limthd_ent.F90) 661 IF ( n um_sal == 2 ) THEN633 IF ( nn_icesal == 2 ) THEN 662 634 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) ) 663 635 ! salinity dif due to snow-ice formation … … 703 675 DO ji = kideb, kiut 704 676 rswitch = 1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 705 t_su_1d(ji) = rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt t677 t_su_1d(ji) = rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0 706 678 END DO ! ji 707 679 … … 712 684 q_s_1d(ji,jk) = ( 1.0 - rswitch ) * q_s_1d(ji,jk) 713 685 ! recalculate t_s_1d from q_s_1d 714 t_s_1d(ji,jk) = rt t+ ( 1._wp - rswitch ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )686 t_s_1d(ji,jk) = rt0 + ( 1._wp - rswitch ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 715 687 END DO 716 688 END DO 717 718 CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_ 1cat, zq_rema )689 690 CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 719 691 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 720 692 CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4990 r5123 19 19 USE phycst ! physical constants (ocean directory) 20 20 USE ice ! LIM-3 variables 21 USE par_ice ! LIM-3 parameters22 21 USE thd_ice ! LIM-3: thermodynamics 23 22 USE in_out_manager ! I/O manager … … 100 99 INTEGER :: nconv ! number of iterations in iterative procedure 101 100 INTEGER :: minnumeqmin, maxnumeqmax 101 102 102 INTEGER, POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation 103 103 INTEGER, POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation 104 INTEGER, POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow104 105 105 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system 106 106 REAL(wp) :: zg1 = 2._wp ! … … 112 112 REAL(wp) :: ztmelt_i ! ice melting temperature 113 113 REAL(wp) :: zerritmax ! current maximal error on temperature 114 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! ice melting point 115 REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure ) 116 REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration 117 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 118 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 119 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 120 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 121 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function 122 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature 123 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 124 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 125 REAL(wp), POINTER, DIMENSION(:) :: zihic, zhsu 126 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity 127 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice 128 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice 129 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice 130 REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice 131 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice 132 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence 133 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat 134 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice 135 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow 136 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow 137 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow 138 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow 139 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence 140 REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow 141 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow 142 REAL(wp), POINTER, DIMENSION(:,:) :: zswiterm ! Independent term 143 REAL(wp), POINTER, DIMENSION(:,:) :: zswitbis ! temporary independent term 144 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis 145 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 114 REAL(wp) :: zhsu 115 116 REAL(wp), POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow 117 REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure ) 118 REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration 119 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 120 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 121 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 122 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 123 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function 124 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature 125 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 126 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 127 REAL(wp), POINTER, DIMENSION(:) :: zihic 128 129 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity 130 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice 131 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice 132 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice 133 REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice 134 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice 135 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence 136 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat 137 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice 138 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow 139 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow 140 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow 141 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow 142 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence 143 REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow 144 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow 145 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! 'Ind'ependent term 146 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! Temporary 'ind'ependent term 147 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis ! Temporary 'dia'gonal term 148 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! Tridiagonal system terms 149 146 150 ! diag errors on heat 147 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 151 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 152 153 ! Mono-category 154 REAL(wp) :: zepsilon ! determines thres. above which computation of G(h) is done 155 REAL(wp) :: zratio_s ! dummy factor 156 REAL(wp) :: zratio_i ! dummy factor 157 REAL(wp) :: zh_thres ! thickness thres. for G(h) computation 158 REAL(wp) :: zhe ! dummy factor 159 REAL(wp) :: zkimean ! mean sea ice thermal conductivity 160 REAL(wp) :: zfac ! dummy factor 161 REAL(wp) :: zihe ! dummy factor 162 REAL(wp) :: zheshth ! dummy factor 163 164 REAL(wp), POINTER, DIMENSION(:) :: zghe ! G(he), th. conduct enhancement factor, mono-cat 165 148 166 !!------------------------------------------------------------------ 149 167 ! 150 CALL wrk_alloc( jpij, numeqmin, numeqmax , isnow)151 CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )152 CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, z hsu)168 CALL wrk_alloc( jpij, numeqmin, numeqmax ) 169 CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 170 CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zghe ) 153 171 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) 154 172 CALL wrk_alloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0) 155 CALL wrk_alloc( jpij, nlay_i+3, z switerm, zswitbis, zdiagbis )173 CALL wrk_alloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 156 174 CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid ) 157 175 … … 161 179 zdq(:) = 0._wp ; zq_ini(:) = 0._wp 162 180 DO ji = kideb, kiut 163 zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i )+ &164 & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ))181 zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i + & 182 & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 165 183 END DO 166 184 … … 168 186 ! 1) Initialization ! 169 187 !------------------------------------------------------------------------------! 170 ! clem clean: replace just ztfs by rtt171 188 DO ji = kideb , kiut 172 ! is there snow or not 173 isnow(ji)= NINT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) ) ) 174 ! surface temperature of fusion 175 ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 189 isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) ) ! is there snow or not 176 190 ! layer thickness 177 zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i )178 zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )191 zh_i(ji) = ht_i_1d(ji) * r1_nlay_i 192 zh_s(ji) = ht_s_1d(ji) * r1_nlay_s 179 193 END DO 180 194 … … 188 202 DO jk = 1, nlay_s ! vert. coord of the up. lim. of the layer-th snow layer 189 203 DO ji = kideb , kiut 190 z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s )204 z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s 191 205 END DO 192 206 END DO … … 194 208 DO jk = 1, nlay_i ! vert. coord of the up. lim. of the layer-th ice layer 195 209 DO ji = kideb , kiut 196 z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i )210 z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i 197 211 END DO 198 212 END DO 199 213 ! 200 214 !------------------------------------------------------------------------------| 201 ! 2) Radiation s|215 ! 2) Radiation | 202 216 !------------------------------------------------------------------------------| 203 217 ! … … 212 226 ! zftrice = io.qsr_ice is below the surface 213 227 ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 214 228 ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover 229 zhsu = 0.1_wp ! threshold for the computation of i0 215 230 DO ji = kideb , kiut 216 231 ! switches 217 isnow(ji) = NINT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ))232 isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 218 233 ! hs > 0, isnow = 1 219 zhsu (ji) = hnzst ! threshold for the computation of i0 220 zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) ) 221 222 i0(ji) = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 223 !fr1_i0_1d = i0 for a thin ice surface 224 !fr1_i0_2d = i0 for a thick ice surface 225 ! a function of the cloud cover 226 ! 227 !i0(ji) = (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0) 228 !formula used in Cice 234 zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu ) ) 235 236 i0(ji) = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 229 237 END DO 230 238 … … 257 265 258 266 DO ji = kideb, kiut ! ice initialization 259 zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1- isnow(ji) )267 zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) ) 260 268 END DO 261 269 … … 263 271 DO ji = kideb, kiut 264 272 ! ! radiation transmitted below the layer-th ice layer 265 zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )273 zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 266 274 ! ! radiation absorbed by the layer-th ice layer 267 275 zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) … … 281 289 ztsub (ji) = t_su_1d(ji) ! temperature at the beg of iter pr. 282 290 ztsubit(ji) = t_su_1d(ji) ! temperature at the previous iter 283 t_su_1d (ji) = MIN( t_su_1d(ji), ztfs(ji) - ztsu_err )! necessary284 zerrit (ji) = 1000._wp! initial value of error291 t_su_1d(ji) = MIN( t_su_1d(ji), rt0 - ztsu_err ) ! necessary 292 zerrit (ji) = 1000._wp ! initial value of error 285 293 END DO 286 294 … … 300 308 zerritmax = 1000._wp ! maximal value of error on all points 301 309 302 DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd)310 DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif ) 303 311 ! 304 312 nconv = nconv + 1 … … 308 316 !------------------------------------------------------------------------------| 309 317 ! 310 IF( thcon_i_swi== 0 ) THEN ! Untersteiner (1964) formula311 DO ji = kideb , kiut 312 ztcond_i(ji,0) = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt)313 ztcond_i(ji,0) = MAX(ztcond_i(ji,0),zkimin)318 IF( nn_ice_thcon == 0 ) THEN ! Untersteiner (1964) formula 319 DO ji = kideb , kiut 320 ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) 321 ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 314 322 END DO 315 323 DO jk = 1, nlay_i-1 316 324 DO ji = kideb , kiut 317 ztcond_i(ji,jk) = rcdic + zbeta *( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) / &318 MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) +t_i_1d(ji,jk+1) - 2.0_wp * rtt)319 ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk),zkimin)325 ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) / & 326 MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0) 327 ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 320 328 END DO 321 329 END DO 322 330 ENDIF 323 331 324 IF( thcon_i_swi== 1 ) THEN ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T325 DO ji = kideb , kiut 326 ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) -rtt) &327 & - 0.011_wp * ( t_i_1d(ji,1) - rt t)332 IF( nn_ice_thcon == 1 ) THEN ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 333 DO ji = kideb , kiut 334 ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) & 335 & - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 328 336 ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 329 337 END DO 330 338 DO jk = 1, nlay_i-1 331 339 DO ji = kideb , kiut 332 ztcond_i(ji,jk) = rcdic + &333 & 0.09 0_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )&334 & / MIN( -2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt) &335 & - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt)340 ztcond_i(ji,jk) = rcdic + & 341 & 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) & 342 & / MIN( -2._wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0 ) & 343 & - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0 * rt0 ) 336 344 ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 337 345 END DO 338 346 END DO 339 347 DO ji = kideb , kiut 340 ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10,t_bo_1d(ji)-rtt) &341 & - 0.011_wp * ( t_bo_1d(ji) - rt t)348 ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 ) & 349 & - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 342 350 ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 343 351 END DO 344 352 ENDIF 345 ! 346 !------------------------------------------------------------------------------| 347 ! 5) kappa factors | 348 !------------------------------------------------------------------------------| 349 ! 353 354 ! 355 !------------------------------------------------------------------------------| 356 ! 5) G(he) - enhancement of thermal conductivity in mono-category case | 357 !------------------------------------------------------------------------------| 358 ! 359 ! Computation of effective thermal conductivity G(h) 360 ! Used in mono-category case only to simulate an ITD implicitly 361 ! Fichefet and Morales Maqueda, JGR 1997 362 363 zghe(:) = 1._wp 364 365 SELECT CASE ( nn_monocat ) 366 367 CASE (1,3) ! LIM3 368 369 zepsilon = 0.1_wp 370 zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp 371 372 DO ji = kideb, kiut 373 374 ! Mean sea ice thermal conductivity 375 zkimean = SUM( ztcond_i(ji,0:nlay_i) ) / REAL( nlay_i+1, wp ) 376 377 ! Effective thickness he (zhe) 378 zfac = 1._wp / ( rcdsn + zkimean ) 379 zratio_s = rcdsn * zfac 380 zratio_i = zkimean * zfac 381 zhe = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji) 382 383 ! G(he) 384 rswitch = MAX( 0._wp , SIGN( 1._wp , zhe - zh_thres ) ) ! =0 if zhe < zh_thres, if > 385 zghe(ji) = ( 1._wp - rswitch ) + rswitch * 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) ) 386 387 ! Impose G(he) < 2. 388 zghe(ji) = MIN( zghe(ji), 2._wp ) 389 390 END DO 391 392 END SELECT 393 394 ! 395 !------------------------------------------------------------------------------| 396 ! 6) kappa factors | 397 !------------------------------------------------------------------------------| 398 ! 399 !--- Snow 350 400 DO ji = kideb, kiut 351 352 !-- Snow kappa factors 353 zkappa_s(ji,0) = rcdsn / MAX(epsi10,zh_s(ji)) 354 zkappa_s(ji,nlay_s) = rcdsn / MAX(epsi10,zh_s(ji)) 401 zfac = 1. / MAX( epsi10 , zh_s(ji) ) 402 zkappa_s(ji,0) = zghe(ji) * rcdsn * zfac 403 zkappa_s(ji,nlay_s) = zghe(ji) * rcdsn * zfac 355 404 END DO 356 405 357 406 DO jk = 1, nlay_s-1 358 407 DO ji = kideb , kiut 359 zkappa_s(ji,jk) = 2.0 * rcdsn / &360 MAX(epsi10,2.0*zh_s(ji))361 362 END DO 363 408 zkappa_s(ji,jk) = zghe(ji) * 2.0 * rcdsn / MAX( epsi10, 2.0 * zh_s(ji) ) 409 END DO 410 END DO 411 412 !--- Ice 364 413 DO jk = 1, nlay_i-1 365 414 DO ji = kideb , kiut 366 !-- Ice kappa factors 367 zkappa_i(ji,jk) = 2.0*ztcond_i(ji,jk)/ & 368 MAX(epsi10,2.0*zh_i(ji)) 369 END DO 370 END DO 371 372 DO ji = kideb , kiut 373 zkappa_i(ji,0) = ztcond_i(ji,0)/MAX(epsi10,zh_i(ji)) 374 zkappa_i(ji,nlay_i) = ztcond_i(ji,nlay_i) / MAX(epsi10,zh_i(ji)) 375 !-- Interface 376 zkappa_s(ji,nlay_s) = 2.0*rcdsn*ztcond_i(ji,0)/MAX(epsi10, & 377 (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 378 zkappa_i(ji,0) = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) & 379 + zkappa_i(ji,0)*REAL( 1 - isnow(ji) ) 380 END DO 381 ! 382 !------------------------------------------------------------------------------| 383 ! 6) Sea ice specific heat, eta factors | 415 zkappa_i(ji,jk) = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) ) 416 END DO 417 END DO 418 419 !--- Snow-ice interface 420 DO ji = kideb , kiut 421 zfac = 1./ MAX( epsi10 , zh_i(ji) ) 422 zkappa_i(ji,0) = zghe(ji) * ztcond_i(ji,0) * zfac 423 zkappa_i(ji,nlay_i) = zghe(ji) * ztcond_i(ji,nlay_i) * zfac 424 zkappa_s(ji,nlay_s) = zghe(ji) * zghe(ji) * 2.0 * rcdsn * ztcond_i(ji,0) / & 425 & MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rcdsn * zh_i(ji) ) ) 426 zkappa_i(ji,0) = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) ) 427 END DO 428 429 ! 430 !------------------------------------------------------------------------------| 431 ! 7) Sea ice specific heat, eta factors | 384 432 !------------------------------------------------------------------------------| 385 433 ! … … 387 435 DO ji = kideb , kiut 388 436 ztitemp(ji,jk) = t_i_1d(ji,jk) 389 zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ & 390 MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10) 391 zeta_i(ji,jk) = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), & 392 epsi10) 437 zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 ) 438 zeta_i(ji,jk) = rdt_ice / MAX( rhoic * zspeche_i(ji,jk) * zh_i(ji), epsi10 ) 393 439 END DO 394 440 END DO … … 397 443 DO ji = kideb , kiut 398 444 ztstemp(ji,jk) = t_s_1d(ji,jk) 399 zeta_s(ji,jk) = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 400 END DO 401 END DO 402 ! 403 !------------------------------------------------------------------------------| 404 ! 7) surface flux computation | 445 zeta_s(ji,jk) = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 ) 446 END DO 447 END DO 448 449 ! 450 !------------------------------------------------------------------------------| 451 ! 8) surface flux computation | 405 452 !------------------------------------------------------------------------------| 406 453 ! … … 415 462 DO ji = kideb , kiut 416 463 ! update incoming flux 417 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 418 + qns_ice_1d(ji) ! non solar total flux 419 ! (LWup, LWdw, SH, LH) 420 END DO 421 422 ! 423 !------------------------------------------------------------------------------| 424 ! 8) tridiagonal system terms | 464 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 465 & + qns_ice_1d(ji) ! non solar total flux (LWup, LWdw, SH, LH) 466 END DO 467 468 ! 469 !------------------------------------------------------------------------------| 470 ! 9) tridiagonal system terms | 425 471 !------------------------------------------------------------------------------| 426 472 ! … … 437 483 ztrid(ji,numeq,2) = 0. 438 484 ztrid(ji,numeq,3) = 0. 439 z switerm(ji,numeq)= 0.440 z switbis(ji,numeq)= 0.485 zindterm(ji,numeq)= 0. 486 zindtbis(ji,numeq)= 0. 441 487 zdiagbis(ji,numeq)= 0. 442 488 ENDDO … … 445 491 DO numeq = nlay_s + 2, nlay_s + nlay_i 446 492 DO ji = kideb , kiut 447 jk = numeq - nlay_s - 1 448 ztrid(ji,numeq,1) = - zeta_i(ji,jk)*zkappa_i(ji,jk-1) 449 ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + & 450 zkappa_i(ji,jk)) 451 ztrid(ji,numeq,3) = - zeta_i(ji,jk)*zkappa_i(ji,jk) 452 zswiterm(ji,numeq) = ztib(ji,jk) + zeta_i(ji,jk)* & 453 zradab_i(ji,jk) 493 jk = numeq - nlay_s - 1 494 ztrid(ji,numeq,1) = - zeta_i(ji,jk) * zkappa_i(ji,jk-1) 495 ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) ) 496 ztrid(ji,numeq,3) = - zeta_i(ji,jk) * zkappa_i(ji,jk) 497 zindterm(ji,numeq) = ztib(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk) 454 498 END DO 455 499 ENDDO … … 459 503 !!ice bottom term 460 504 ztrid(ji,numeq,1) = - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1) 461 ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,nlay_i)*( zkappa_i(ji,nlay_i)*zg1 & 462 + zkappa_i(ji,nlay_i-1) ) 505 ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) ) 463 506 ztrid(ji,numeq,3) = 0.0 464 zswiterm(ji,numeq) = ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* & 465 ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 466 * t_bo_1d(ji) ) 507 zindterm(ji,numeq) = ztib(ji,nlay_i) + zeta_i(ji,nlay_i) * & 508 & ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 467 509 ENDDO 468 510 469 511 470 512 DO ji = kideb , kiut 471 IF ( ht_s_1d(ji) .gt.0.0 ) THEN513 IF ( ht_s_1d(ji) > 0.0 ) THEN 472 514 ! 473 515 !------------------------------------------------------------------------------| … … 477 519 !!snow interior terms (bottom equation has the same form as the others) 478 520 DO numeq = 3, nlay_s + 1 479 jk = numeq - 1 480 ztrid(ji,numeq,1) = - zeta_s(ji,jk)*zkappa_s(ji,jk-1) 481 ztrid(ji,numeq,2) = 1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + & 482 zkappa_s(ji,jk) ) 521 jk = numeq - 1 522 ztrid(ji,numeq,1) = - zeta_s(ji,jk) * zkappa_s(ji,jk-1) 523 ztrid(ji,numeq,2) = 1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) ) 483 524 ztrid(ji,numeq,3) = - zeta_s(ji,jk)*zkappa_s(ji,jk) 484 zswiterm(ji,numeq) = ztsb(ji,jk) + zeta_s(ji,jk)* & 485 zradab_s(ji,jk) 525 zindterm(ji,numeq) = ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk) 486 526 END DO 487 527 … … 489 529 IF ( nlay_i.eq.1 ) THEN 490 530 ztrid(ji,nlay_s+2,3) = 0.0 491 zswiterm(ji,nlay_s+2) = zswiterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 492 t_bo_1d(ji) 531 zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji) 493 532 ENDIF 494 533 495 IF ( t_su_1d(ji) .LT. rtt) THEN534 IF ( t_su_1d(ji) < rt0 ) THEN 496 535 497 536 !------------------------------------------------------------------------------| … … 503 542 504 543 !!surface equation 505 ztrid(ji,1,1) = 0.0506 ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0)507 ztrid(ji,1,3) = zg1s*zkappa_s(ji,0)508 z switerm(ji,1) = dzf(ji)*t_su_1d(ji)- zf(ji)544 ztrid(ji,1,1) = 0.0 545 ztrid(ji,1,2) = dzf(ji) - zg1s * zkappa_s(ji,0) 546 ztrid(ji,1,3) = zg1s * zkappa_s(ji,0) 547 zindterm(ji,1) = dzf(ji) * t_su_1d(ji) - zf(ji) 509 548 510 549 !!first layer of snow equation 511 ztrid(ji,2,1) = - zkappa_s(ji,0) *zg1s*zeta_s(ji,1)512 ztrid(ji,2,2) = 1.0 + zeta_s(ji,1) *(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s)550 ztrid(ji,2,1) = - zkappa_s(ji,0) * zg1s * zeta_s(ji,1) 551 ztrid(ji,2,2) = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s ) 513 552 ztrid(ji,2,3) = - zeta_s(ji,1)* zkappa_s(ji,1) 514 z switerm(ji,2) = ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1)553 zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) * zradab_s(ji,1) 515 554 516 555 ELSE … … 526 565 !!first layer of snow equation 527 566 ztrid(ji,2,1) = 0.0 528 ztrid(ji,2,2) = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + & 529 zkappa_s(ji,0) * zg1s ) 567 ztrid(ji,2,2) = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s ) 530 568 ztrid(ji,2,3) = - zeta_s(ji,1)*zkappa_s(ji,1) 531 zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) * & 532 ( zradab_s(ji,1) + & 533 zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 569 zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) * & 570 & ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 534 571 ENDIF 535 572 ELSE … … 539 576 !------------------------------------------------------------------------------| 540 577 ! 541 IF ( t_su_1d(ji) .LT. rtt) THEN578 IF ( t_su_1d(ji) < rt0 ) THEN 542 579 ! 543 580 !------------------------------------------------------------------------------| … … 553 590 ztrid(ji,numeqmin(ji),2) = dzf(ji) - zkappa_i(ji,0)*zg1 554 591 ztrid(ji,numeqmin(ji),3) = zkappa_i(ji,0)*zg1 555 z switerm(ji,numeqmin(ji)) = dzf(ji)*t_su_1d(ji) - zf(ji)592 zindterm(ji,numeqmin(ji)) = dzf(ji)*t_su_1d(ji) - zf(ji) 556 593 557 594 !!first layer of ice equation 558 595 ztrid(ji,numeqmin(ji)+1,1) = - zkappa_i(ji,0) * zg1 * zeta_i(ji,1) 559 ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) & 560 + zkappa_i(ji,0) * zg1 ) 561 ztrid(ji,numeqmin(ji)+1,3) = - zeta_i(ji,1)*zkappa_i(ji,1) 562 zswiterm(ji,numeqmin(ji)+1)= ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1) 596 ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 597 ztrid(ji,numeqmin(ji)+1,3) = - zeta_i(ji,1) * zkappa_i(ji,1) 598 zindterm(ji,numeqmin(ji)+1)= ztib(ji,1) + zeta_i(ji,1) * zradab_i(ji,1) 563 599 564 600 !!case of only one layer in the ice (surface & ice equations are altered) 565 601 566 IF ( nlay_i.eq.1) THEN602 IF ( nlay_i == 1 ) THEN 567 603 ztrid(ji,numeqmin(ji),1) = 0.0 568 ztrid(ji,numeqmin(ji),2) = dzf(ji) - zkappa_i(ji,0)*2.0 569 ztrid(ji,numeqmin(ji),3) = zkappa_i(ji,0)*2.0 570 ztrid(ji,numeqmin(ji)+1,1) = -zkappa_i(ji,0)*2.0*zeta_i(ji,1) 571 ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 572 zkappa_i(ji,1)) 604 ztrid(ji,numeqmin(ji),2) = dzf(ji) - zkappa_i(ji,0) * 2.0 605 ztrid(ji,numeqmin(ji),3) = zkappa_i(ji,0) * 2.0 606 ztrid(ji,numeqmin(ji)+1,1) = -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1) 607 ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) ) 573 608 ztrid(ji,numeqmin(ji)+1,3) = 0.0 574 609 575 z switerm(ji,numeqmin(ji)+1) = ztib(ji,1) + zeta_i(ji,1)*&576 ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) )610 zindterm(ji,numeqmin(ji)+1) = ztib(ji,1) + zeta_i(ji,1) * & 611 & ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) ) 577 612 ENDIF 578 613 … … 590 625 !!first layer of ice equation 591 626 ztrid(ji,numeqmin(ji),1) = 0.0 592 ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* & 593 zg1) 627 ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 594 628 ztrid(ji,numeqmin(ji),3) = - zeta_i(ji,1) * zkappa_i(ji,1) 595 z switerm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) +&596 zkappa_i(ji,0) * zg1 * t_su_1d(ji) )629 zindterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1) * & 630 & ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 597 631 598 632 !!case of only one layer in the ice (surface & ice equations are altered) 599 IF ( nlay_i.eq.1) THEN633 IF ( nlay_i == 1 ) THEN 600 634 ztrid(ji,numeqmin(ji),1) = 0.0 601 ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 602 zkappa_i(ji,1)) 635 ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) ) 603 636 ztrid(ji,numeqmin(ji),3) = 0.0 604 zswiterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1)* & 605 (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) & 606 + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 637 zindterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) ) & 638 & + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0 607 639 ENDIF 608 640 … … 614 646 ! 615 647 !------------------------------------------------------------------------------| 616 ! 9) tridiagonal system solving|648 ! 10) tridiagonal system solving | 617 649 !------------------------------------------------------------------------------| 618 650 ! … … 626 658 627 659 DO ji = kideb , kiut 628 z switbis(ji,numeqmin(ji)) = zswiterm(ji,numeqmin(ji))660 zindtbis(ji,numeqmin(ji)) = zindterm(ji,numeqmin(ji)) 629 661 zdiagbis(ji,numeqmin(ji)) = ztrid(ji,numeqmin(ji),2) 630 662 minnumeqmin = MIN(numeqmin(ji),minnumeqmin) … … 635 667 DO ji = kideb , kiut 636 668 numeq = min(max(numeqmin(ji)+1,jk),numeqmax(ji)) 637 zdiagbis(ji,numeq) = ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 638 ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) 639 zswitbis(ji,numeq) = zswiterm(ji,numeq) - ztrid(ji,numeq,1)* & 640 zswitbis(ji,numeq-1)/zdiagbis(ji,numeq-1) 669 zdiagbis(ji,numeq) = ztrid(ji,numeq,2) - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3) / zdiagbis(ji,numeq-1) 670 zindtbis(ji,numeq) = zindterm(ji,numeq) - ztrid(ji,numeq,1) * zindtbis(ji,numeq-1) / zdiagbis(ji,numeq-1) 641 671 END DO 642 672 END DO … … 644 674 DO ji = kideb , kiut 645 675 ! ice temperatures 646 t_i_1d(ji,nlay_i) = z switbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))676 t_i_1d(ji,nlay_i) = zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji)) 647 677 END DO 648 678 … … 650 680 DO ji = kideb , kiut 651 681 jk = numeq - nlay_s - 1 652 t_i_1d(ji,jk) = (zswitbis(ji,numeq) - ztrid(ji,numeq,3)* & 653 t_i_1d(ji,jk+1))/zdiagbis(ji,numeq) 682 t_i_1d(ji,jk) = ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq) 654 683 END DO 655 684 END DO … … 657 686 DO ji = kideb , kiut 658 687 ! snow temperatures 659 IF (ht_s_1d(ji).GT.0._wp) & 660 t_s_1d(ji,nlay_s) = (zswitbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 661 * t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) & 662 * MAX(0.0,SIGN(1.0,ht_s_1d(ji))) 688 IF (ht_s_1d(ji) > 0._wp) & 689 t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) & 690 & / zdiagbis(ji,nlay_s+1) * MAX( 0.0, SIGN( 1.0, ht_s_1d(ji) ) ) 663 691 664 692 ! surface temperature 665 isnow(ji) = NINT( 1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) ) ))693 isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) ) 666 694 ztsubit(ji) = t_su_1d(ji) 667 IF( t_su_1d(ji) < ztfs(ji)) &668 t_su_1d(ji) = ( z switbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1)&669 & + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))695 IF( t_su_1d(ji) < rt0 ) & 696 t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3) * & 697 & ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji)) 670 698 END DO 671 699 ! 672 700 !-------------------------------------------------------------------------- 673 ! 1 0) Has the scheme converged ?, end of the iterative procedure |701 ! 11) Has the scheme converged ?, end of the iterative procedure | 674 702 !-------------------------------------------------------------------------- 675 703 ! 676 704 ! check that nowhere it has started to melt 677 ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd678 DO ji = kideb , kiut 679 t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , ztfs(ji)) , 190._wp )680 zerrit(ji) = ABS( t_su_1d(ji) - ztsubit(ji) )705 ! zerrit(ji) is a measure of error, it has to be under terr_dif 706 DO ji = kideb , kiut 707 t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , rt0 ) , 190._wp ) 708 zerrit(ji) = ABS( t_su_1d(ji) - ztsubit(ji) ) 681 709 END DO 682 710 683 711 DO jk = 1, nlay_s 684 712 DO ji = kideb , kiut 685 t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt t), 190._wp )686 zerrit(ji) = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk)))713 t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), 190._wp ) 714 zerrit(ji) = MAX( zerrit(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) ) 687 715 END DO 688 716 END DO … … 690 718 DO jk = 1, nlay_i 691 719 DO ji = kideb , kiut 692 ztmelt_i = -tmut * s_i_1d(ji,jk) + rtt693 t_i_1d(ji,jk) = MAX( MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp)694 zerrit(ji) = MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk)))720 ztmelt_i = -tmut * s_i_1d(ji,jk) + rt0 721 t_i_1d(ji,jk) = MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp ) 722 zerrit(ji) = MAX( zerrit(ji), ABS( t_i_1d(ji,jk) - ztitemp(ji,jk) ) ) 695 723 END DO 696 724 END DO … … 713 741 ! 714 742 !-------------------------------------------------------------------------! 715 ! 1 1) Fluxes at the interfaces !743 ! 12) Fluxes at the interfaces ! 716 744 !-------------------------------------------------------------------------! 717 745 DO ji = kideb, kiut … … 719 747 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) ) ) 720 748 ! ! surface ice conduction flux 721 isnow(ji) = NINT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ))722 fc_su(ji) = - REAL( isnow(ji) )* zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji)) &723 & - REAL( 1- isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_1d(ji,1) - t_su_1d(ji))749 isnow(ji) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) 750 fc_su(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji)) & 751 & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_1d(ji,1) - t_su_1d(ji)) 724 752 ! ! bottom ice conduction flux 725 753 fc_bo_i(ji) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) ) 726 754 END DO 755 756 ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 757 CALL lim_thd_enmelt( kideb, kiut ) 758 759 760 ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 761 DO ji = kideb, kiut 762 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i + & 763 & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 764 IF( t_su_1d(ji) < rt0 ) THEN ! case T_su < 0degC 765 zhfx_err(ji) = qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 766 ELSE ! case T_su = 0degC 767 zhfx_err(ji) = fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 768 ENDIF 769 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 770 END DO 771 772 ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 773 IF( .NOT. lk_cpl ) THEN ! --- forced case: qns_ice and fc_su are diagnosed 774 ! 775 DO ji = kideb, kiut 776 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 777 fc_su (ji) = fc_su(ji) - zhfx_err(ji) 778 END DO 779 ! 780 ELSE ! --- coupled case: ocean turbulent heat flux is diagnosed 781 ! 782 DO ji = kideb, kiut 783 fhtur_1d (ji) = fhtur_1d(ji) - zhfx_err(ji) 784 END DO 785 ! 786 ENDIF 727 787 728 788 !----------------------------------------- … … 730 790 !----------------------------------------- 731 791 DO ji = kideb, kiut 732 IF( t_su_1d(ji) < rt t) THEN ! case T_su < 0degC792 IF( t_su_1d(ji) < rt0 ) THEN ! case T_su < 0degC 733 793 hfx_dif_1d(ji) = hfx_dif_1d(ji) + & 734 794 & ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 735 ELSE ! case T_su = 0degC795 ELSE ! case T_su = 0degC 736 796 hfx_dif_1d(ji) = hfx_dif_1d(ji) + & 737 797 & ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) … … 739 799 END DO 740 800 741 ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 742 CALL lim_thd_enmelt( kideb, kiut ) 743 744 ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 745 DO ji = kideb, kiut 746 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) + & 747 & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 748 zhfx_err(ji) = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 749 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 750 END DO 751 752 ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 753 IF( .NOT. lk_cpl ) THEN ! --- forced case: qns_ice and fc_su are diagnosed 754 ! 755 DO ji = kideb, kiut 756 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 757 fc_su (ji) = fc_su(ji) - zhfx_err(ji) 758 END DO 759 ! 760 ELSE ! --- coupled case: ocean turbulent heat flux is diagnosed 761 ! 762 DO ji = kideb, kiut 763 fhtur_1d (ji) = fhtur_1d(ji) - zhfx_err(ji) 764 END DO 765 ! 766 ENDIF 767 768 ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 801 ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m-2) 769 802 DO ji = kideb, kiut 770 803 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 … … 773 806 774 807 ! 775 CALL wrk_dealloc( jpij, numeqmin, numeqmax , isnow)776 CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )777 CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, z hsu)808 CALL wrk_dealloc( jpij, numeqmin, numeqmax ) 809 CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 810 CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zghe ) 778 811 CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, & 779 812 & ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 780 813 CALL wrk_dealloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 781 CALL wrk_dealloc( jpij, nlay_i+3, z switerm, zswitbis, zdiagbis )814 CALL wrk_dealloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 782 815 CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 783 816 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) … … 801 834 DO jk = 1, nlay_i ! Sea ice energy of melting 802 835 DO ji = kideb, kiut 803 ztmelts = - tmut * s_i_1d(ji,jk) + rt t804 rswitch = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rt t) - epsi10 ) )805 q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) ) &806 & + lfus * ( 1.0 - rswitch * ( ztmelts-rt t ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) ) &807 & - rcp * ( ztmelts-rtt) )836 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 837 rswitch = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rt0) - epsi20 ) ) 838 q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) ) & 839 & + lfus * ( 1.0 - rswitch * ( ztmelts-rt0 ) / MIN( t_i_1d(ji,jk) - rt0, -epsi20 ) ) & 840 & - rcp * ( ztmelts-rt0 ) ) 808 841 END DO 809 842 END DO 810 843 DO jk = 1, nlay_s ! Snow energy of melting 811 844 DO ji = kideb, kiut 812 q_s_1d(ji,jk) = rhosn * ( cpic * ( rt t- t_s_1d(ji,jk) ) + lfus )845 q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) 813 846 END DO 814 847 END DO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r4990 r5123 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 26 USE ice ! LIM variables 27 USE par_ice ! LIM parameters28 27 USE thd_ice ! LIM thermodynamics 29 28 USE limvar ! LIM variables … … 87 86 88 87 !-------------------------------------------------------------------------- 89 ! 1) Cumulative integral of old enthalpy * thic nkess and layers interfaces88 ! 1) Cumulative integral of old enthalpy * thickness and layers interfaces 90 89 !-------------------------------------------------------------------------- 91 90 zqh_cum0(:,0:nlay_i+2) = 0._wp … … 103 102 ! new layer thickesses 104 103 DO ji = kideb, kiut 105 zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i )104 zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i 106 105 ENDDO 107 106 … … 133 132 DO jk1 = 1, nlay_i 134 133 DO ji = kideb, kiut 135 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi 10 ) )136 qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi 10 )134 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi20 ) ) 135 qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 137 136 ENDDO 138 137 ENDDO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4990 r5123 22 22 USE thd_ice ! LIM thermodynamics 23 23 USE dom_ice ! LIM domain 24 USE par_ice ! LIM parameters25 24 USE ice ! LIM variables 26 25 USE limtab ! LIM 2D <==> 1D … … 112 111 113 112 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity 113 114 REAL(wp) :: zcai = 1.4e-3_wp 114 115 !!-----------------------------------------------------------------------! 115 116 … … 129 130 DO ji = 1, jpi 130 131 !Energy of melting q(S,T) [J.m-3] 131 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 132 e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) & 133 & / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i, wp ) 134 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 132 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi20 ) ) !0 if no ice 133 e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp ) 135 134 END DO 136 135 END DO … … 155 154 156 155 ! Default new ice thickness 157 hicol(:,:) = hiccrit158 159 IF( fraz_swi == 1) THEN156 hicol(:,:) = rn_hnewice 157 158 IF( ln_frazil ) THEN 160 159 161 160 !-------------------- … … 166 165 zhicrit = 0.04 ! frazil ice thickness 167 166 ztwogp = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 168 zsqcd = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag)167 zsqcd = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag) 169 168 zgamafr = 0.03 170 169 … … 176 175 !------------- 177 176 ! C-grid wind stress components 178 ztaux = ( utau_ice(ji-1,jj ) * tmu(ji-1,jj) &179 & + utau_ice(ji ,jj ) * tmu(ji ,jj) ) * 0.5_wp180 ztauy = ( vtau_ice(ji ,jj-1) * tmv(ji ,jj-1) &181 & + vtau_ice(ji ,jj ) * tmv(ji ,jj) ) * 0.5_wp177 ztaux = ( utau_ice(ji-1,jj ) * umask(ji-1,jj ,1) & 178 & + utau_ice(ji ,jj ) * umask(ji ,jj ,1) ) * 0.5_wp 179 ztauy = ( vtau_ice(ji ,jj-1) * vmask(ji ,jj-1,1) & 180 & + vtau_ice(ji ,jj ) * vmask(ji ,jj ,1) ) * 0.5_wp 182 181 ! Square root of wind stress 183 182 ztenagm = SQRT( SQRT( ztaux**2 + ztauy**2 ) ) … … 195 194 ! C-grid ice velocity 196 195 rswitch = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) ) ) 197 zvgx = rswitch * ( u_ice(ji-1,jj ) * tmu(ji-1,jj ) + u_ice(ji,jj) * tmu(ji,jj) ) * 0.5_wp198 zvgy = rswitch * ( v_ice(ji ,jj-1) * tmv(ji ,jj-1) + v_ice(ji,jj) * tmv(ji,jj) ) * 0.5_wp196 zvgx = rswitch * ( u_ice(ji-1,jj ) * umask(ji-1,jj ,1) + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 197 zvgy = rswitch * ( v_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 199 198 200 199 !----------------------------------- … … 222 221 iterate_frazil = .true. 223 222 224 DO WHILE ( iter .LT.100 .AND. iterate_frazil )223 DO WHILE ( iter < 100 .AND. iterate_frazil ) 225 224 zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) & 226 225 - hicol(ji,jj) * zhicrit * ztwogp * zvrel2 … … 320 319 !---------------------- 321 320 DO ji = 1, nbpac 322 zh_newice(ji) = hiccrit323 END DO 324 IF( fraz_swi == 1) zh_newice(1:nbpac) = hicol_1d(1:nbpac)321 zh_newice(ji) = rn_hnewice 322 END DO 323 IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 325 324 326 325 !---------------------- 327 326 ! Salinity of new ice 328 327 !---------------------- 329 SELECT CASE ( n um_sal )328 SELECT CASE ( nn_icesal ) 330 329 CASE ( 1 ) ! Sice = constant 331 zs_newice(1:nbpac) = bulk_sal330 zs_newice(1:nbpac) = rn_icesal 332 331 CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)] 333 332 DO ji = 1, nbpac 334 333 ii = MOD( npac(ji) - 1 , jpi ) + 1 335 334 ij = ( npac(ji) - 1 ) / jpi + 1 336 zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(ii,ij) )335 zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij) ) 337 336 END DO 338 337 CASE ( 3 ) ! Sice = F(z) [multiyear ice] … … 345 344 ! We assume that new ice is formed at the seawater freezing point 346 345 DO ji = 1, nbpac 347 ztmelts = - tmut * zs_newice(ji) + rt t! Melting point (K)346 ztmelts = - tmut * zs_newice(ji) + rt0 ! Melting point (K) 348 347 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) & 349 & + lfus * ( 1.0 - ( ztmelts - rt t ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) ) &350 & - rcp * ( ztmelts - rt t) )351 END DO ! ji348 & + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) ) & 349 & - rcp * ( ztmelts - rt0 ) ) 350 END DO 352 351 353 352 !---------------- … … 363 362 DO ji = 1, nbpac 364 363 365 zEi = - ze_newice(ji) / rhoic! specific enthalpy of forming ice [J/kg]366 367 zEw = rcp * ( t_bo_1d(ji) - rt0 ) 364 zEi = - ze_newice(ji) * r1_rhoic ! specific enthalpy of forming ice [J/kg] 365 366 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_1d [J/kg] 368 367 ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 369 368 … … 372 371 zfmdt = - qlead_1d(ji) / zdE ! Fm.dt [kg/m2] (<0) 373 372 ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point 374 zv_newice(ji) = - zfmdt /rhoic373 zv_newice(ji) = - zfmdt * r1_rhoic 375 374 376 375 zQm = zfmdt * zEw ! heat to the ocean >0 associated with mass flux … … 387 386 ! A fraction zfrazb of frazil ice is accreted at the ice bottom 388 387 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 389 zfrazb = rswitch * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 *maxfrazb388 zfrazb = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 390 389 zv_frazb(ji) = zfrazb * zv_newice(ji) 391 390 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) … … 409 408 ! we keep the excessive volume in memory and attribute it later to bottom accretion 410 409 DO ji = 1, nbpac 411 IF ( za_newice(ji) > ( amax - zat_i_1d(ji) ) ) THEN412 zda_res(ji) = za_newice(ji) - ( amax - zat_i_1d(ji) )410 IF ( za_newice(ji) > ( rn_amax - zat_i_1d(ji) ) ) THEN 411 zda_res(ji) = za_newice(ji) - ( rn_amax - zat_i_1d(ji) ) 413 412 zdv_res(ji) = zda_res (ji) * zh_newice(ji) 414 413 za_newice(ji) = za_newice(ji) - zda_res (ji) … … 459 458 DO jk = 1, nlay_i 460 459 DO ji = 1, nbpac 461 h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i )460 h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i 462 461 qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 463 462 END DO … … 525 524 DO jj = 1, jpj 526 525 DO ji = 1, jpi 527 ! heat content in J oules528 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 )526 ! heat content in J/m2 527 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 529 528 END DO 530 529 END DO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r4872 r5123 18 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters21 20 USE thd_ice ! LIM thermodynamics 22 21 USE limvar ! LIM variables … … 30 29 31 30 PUBLIC lim_thd_sal ! called by limthd module 32 PUBLIC lim_thd_sal_init ! called by iceini module31 PUBLIC lim_thd_sal_init ! called by sbc_lim_init 33 32 34 33 !!---------------------------------------------------------------------- … … 46 45 !! 47 46 !! ** Method : 3 possibilities 48 !! -> n um_sal = 1 -> Sice = cst [ice salinity constant in both time & space]49 !! -> n um_sal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]50 !! -> n um_sal = 3 -> Sice = S(z) [multiyear ice]47 !! -> nn_icesal = 1 -> Sice = cst [ice salinity constant in both time & space] 48 !! -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005] 49 !! -> nn_icesal = 3 -> Sice = S(z) [multiyear ice] 51 50 !!--------------------------------------------------------------------- 52 51 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index … … 66 65 ! 1) Constant salinity, constant in time | 67 66 !------------------------------------------------------------------------------| 68 !!gm comment: if n um_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 !!69 !!gm ===>>> simplification of almost all test on n um_sal value70 IF( n um_sal == 1 ) THEN71 s_i_1d (kideb:kiut,1:nlay_i) = bulk_sal72 sm_i_1d(kideb:kiut) = bulk_sal73 s_i_new(kideb:kiut) = bulk_sal67 !!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !! 68 !!gm ===>>> simplification of almost all test on nn_icesal value 69 IF( nn_icesal == 1 ) THEN 70 s_i_1d (kideb:kiut,1:nlay_i) = rn_icesal 71 sm_i_1d(kideb:kiut) = rn_icesal 72 s_i_new(kideb:kiut) = rn_icesal 74 73 ENDIF 75 74 … … 77 76 ! Module 2 : Constant salinity varying in time | 78 77 !------------------------------------------------------------------------------| 79 IF( n um_sal == 2 ) THEN78 IF( nn_icesal == 2 ) THEN 80 79 81 80 DO ji = kideb, kiut … … 83 82 ! Switches 84 83 !---------- 85 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt t) ) ! =1 if summer84 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 ) ) ! =1 if summer 86 85 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo 87 86 … … 90 89 !--------------------- 91 90 ! drainage by gravity drainage 92 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G* rdt_ice91 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice 93 92 ! drainage by flushing 94 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F* rdt_ice93 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice 95 94 96 95 !----------------- … … 116 115 ! Module 3 : Profile of salinity, constant in time | 117 116 !------------------------------------------------------------------------------| 118 IF( n um_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut )117 IF( nn_icesal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 119 118 120 119 ! … … 134 133 !!------------------------------------------------------------------- 135 134 INTEGER :: ios ! Local integer output status for namelist read 136 NAMELIST/namicesal/ n um_sal, bulk_sal, sal_G, time_G, sal_F, time_F, &137 & s_i_max, s_i_min, s_i_0, s_i_1135 NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl, & 136 & rn_simax, rn_simin 138 137 !!------------------------------------------------------------------- 139 138 ! … … 151 150 WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity ' 152 151 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 153 WRITE(numout,*) ' switch for salinity num_sal : ', num_sal 154 WRITE(numout,*) ' bulk salinity value if num_sal = 1 : ', bulk_sal 155 WRITE(numout,*) ' restoring salinity for GD : ', sal_G 156 WRITE(numout,*) ' restoring time for GD : ', time_G 157 WRITE(numout,*) ' restoring salinity for flushing : ', sal_F 158 WRITE(numout,*) ' restoring time for flushing : ', time_F 159 WRITE(numout,*) ' Maximum tolerated ice salinity : ', s_i_max 160 WRITE(numout,*) ' Minimum tolerated ice salinity : ', s_i_min 161 WRITE(numout,*) ' 1st salinity for salinity profile : ', s_i_0 162 WRITE(numout,*) ' 2nd salinity for salinity profile : ', s_i_1 152 WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal 153 WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 = ', rn_icesal 154 WRITE(numout,*) ' restoring salinity for GD = ', rn_sal_gd 155 WRITE(numout,*) ' restoring time for GD = ', rn_time_gd 156 WRITE(numout,*) ' restoring salinity for flushing = ', rn_sal_fl 157 WRITE(numout,*) ' restoring time for flushing = ', rn_time_fl 158 WRITE(numout,*) ' Maximum tolerated ice salinity = ', rn_simax 159 WRITE(numout,*) ' Minimum tolerated ice salinity = ', rn_simin 163 160 ENDIF 164 161 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r4990 r5123 17 17 USE dom_oce ! ocean domain 18 18 USE sbc_oce ! ocean surface boundary condition 19 USE par_ice ! ice parameter20 19 USE dom_ice ! ice domain 21 20 USE ice ! ice variables 22 21 USE limadv ! ice advection 23 22 USE limhdf ! ice horizontal diffusion 23 USE limvar ! 24 ! 24 25 USE in_out_manager ! I/O manager 25 26 USE lbclnk ! lateral boundary conditions -- MPP exchanges … … 28 29 USE prtctl ! Print control 29 30 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 USE limvar ! clem for ice thickness correction 31 USE timing ! Timing 31 USE timing ! Timing 32 32 USE limcons ! conservation tests 33 USE limctl ! control prints 33 34 34 35 IMPLICIT NONE 35 36 PRIVATE 36 37 37 PUBLIC lim_trp ! called by ice_step 38 PUBLIC lim_trp ! called by sbcice_lim 39 40 INTEGER :: ncfl ! number of ice time step with CFL>1/2 38 41 39 42 !! * Substitution … … 58 61 !! ** action : 59 62 !!--------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! number of iteration63 INTEGER, INTENT(in) :: kt ! number of iteration 61 64 ! 62 INTEGER :: ji, jj, jk, jl, j n! dummy loop indices65 INTEGER :: ji, jj, jk, jl, jt ! dummy loop indices 63 66 INTEGER :: initad ! number of sub-timestep for the advection 64 67 REAL(wp) :: zcfl , zusnit ! - - 68 CHARACTER(len=80) :: cltmp 65 69 ! 66 REAL(wp), POINTER, DIMENSION(:,:) :: zui_u, zvi_v, zsm, zs0at, zs0ow 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 70 REAL(wp), POINTER, DIMENSION(:,:) :: zsm, zs0at 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi, zzs0e 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ow 68 73 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e 69 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold ! old ice volume... 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaiold, zhimax ! old ice concentration and thickness 71 REAL(wp), POINTER, DIMENSION(:,:) :: zeiold, zesold ! old enthalpies 72 REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 73 ! 74 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax ! old ice thickness 76 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold ! old concentration, enthalpies 77 REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 78 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 75 79 !!--------------------------------------------------------------------- 76 80 IF( nn_timing == 1 ) CALL timing_start('limtrp') 77 81 78 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )79 CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi)80 CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e)81 82 CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold ) ! clem82 CALL wrk_alloc( jpi,jpj, zsm, zs0at, zatold, zeiold, zesold ) 83 CALL wrk_alloc( jpi,jpj,jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi, zzs0e ) 84 CALL wrk_alloc( jpi,jpj,1, zs0ow ) 85 CALL wrk_alloc( jpi,jpj,nlay_i+1,jpl, zs0e ) 86 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold ) 83 87 84 88 IF( numit == nstart .AND. lwp ) THEN … … 88 92 ENDIF 89 93 WRITE(numout,*) '~~~~~~~~~~~~' 94 ncfl = 0 ! nb of time step with CFL > 1/2 90 95 ENDIF 96 97 zsm(:,:) = e12t(:,:) 91 98 92 zsm(:,:) = area(:,:)93 94 99 ! !-------------------------------------! 95 100 IF( ln_limdyn ) THEN ! Advection of sea ice properties ! … … 97 102 98 103 ! conservation test 99 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)100 101 ! mass and salt flux init (clem)104 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 105 106 ! mass and salt flux init 102 107 zviold(:,:,:) = v_i(:,:,:) 103 zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 104 zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 105 106 !--- Thickness correction init. (clem) ------------------------------- 108 zvsold(:,:,:) = v_s(:,:,:) 109 zsmvold(:,:,:) = smv_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 ) 112 113 !--- Thickness correction init. ------------------------------- 107 114 CALL lim_var_glo2eqv 108 za iold(:,:,:) = a_i(:,:,:)115 zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 109 116 !--------------------------------------------------------------------- 110 117 ! Record max of the surrounding ice thicknesses for correction in limupdate … … 116 123 DO ji = 2, jpim1 117 124 zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) ) 118 !zhimax(ji,jj,jl) = ( ht_i(ji ,jj ,jl) * tmask(ji, jj ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) &119 ! & + ht_i(ji-1,jj ,jl) * tmask(ji-1,jj ,1) + ht_i(ji ,jj-1,jl) * tmask(ji ,jj-1,1) &120 ! & + ht_i(ji+1,jj ,jl) * tmask(ji+1,jj ,1) + ht_i(ji ,jj+1,jl) * tmask(ji ,jj+1,1) &121 ! & + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) )122 125 END DO 123 126 END DO … … 125 128 END DO 126 129 130 !=============================! 131 !== Prather scheme ==! 132 !=============================! 133 134 ! If ice drift field is too fast, use an appropriate time step for advection. 135 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) ! CFL test for stability 136 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 137 IF(lk_mpp ) CALL mpp_max( zcfl ) 138 139 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 140 ELSE ; initad = 1 ; zusnit = 1.0_wp 141 ENDIF 142 143 IF( zcfl > 0.5_wp .AND. lwp ) ncfl = ncfl + 1 144 IF( numit == nlast .AND. lwp ) THEN 145 IF( ncfl > 0 ) THEN 146 WRITE(cltmp,'(i6.1)') ncfl 147 CALL ctl_stop('STOP',TRIM(cltmp) ) 148 CALL ctl_warn( 'lim_trp: ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 149 ELSE 150 WRITE(numout,*) 'lim_trp : CFL criteria for ice advection is always smaller than 1/2 ' 151 ENDIF 152 ENDIF 153 127 154 !------------------------- 128 155 ! transported fields 129 156 !------------------------- 130 ! Snow vol, ice vol, salt and age contents, area 131 zs0ow(:,:) = ato_i(:,:) * area(:,:) ! Open water area 132 DO jl = 1, jpl 133 zs0sn (:,:,jl) = v_s (:,:,jl) * area(:,:) ! Snow volume 134 zs0ice(:,:,jl) = v_i (:,:,jl) * area(:,:) ! Ice volume 135 zs0a (:,:,jl) = a_i (:,:,jl) * area(:,:) ! Ice area 136 zs0sm (:,:,jl) = smv_i(:,:,jl) * area(:,:) ! Salt content 137 zs0oi (:,:,jl) = oa_i (:,:,jl) * area(:,:) ! Age content 138 zs0c0 (:,:,jl) = e_s (:,:,1,jl) ! Snow heat content 139 zs0e (:,:,:,jl) = e_i (:,:,:,jl) ! Ice heat content 140 END DO 141 142 !-------------------------- 143 ! Advection of Ice fields (Prather scheme) 144 !-------------------------- 145 ! If ice drift field is too fast, use an appropriate time step for advection. 146 ! CFL test for stability 147 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) ) 148 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) ) 149 IF(lk_mpp ) CALL mpp_max( zcfl ) 150 !!gm more readability: 151 ! IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 152 ! ELSE ; initad = 1 ; zusnit = 1.0_wp 153 ! ENDIF 154 !!gm end 155 initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 156 zusnit = 1.0 / REAL( initad ) 157 IF( zcfl > 0.5 .AND. lwp ) & 158 WRITE(numout,*) 'lim_trp : CFL violation at day ', nday, ', cfl = ', zcfl, & 159 & ': the ice time stepping is split in two' 157 zs0ow(:,:,1) = ato_i(:,:) * e12t(:,:) ! Open water area 158 DO jl = 1, jpl 159 zs0sn (:,:,jl) = v_s (:,:,jl) * e12t(:,:) ! Snow volume 160 zs0ice(:,:,jl) = v_i (:,:,jl) * e12t(:,:) ! Ice volume 161 zs0a (:,:,jl) = a_i (:,:,jl) * e12t(:,:) ! Ice area 162 zs0sm (:,:,jl) = smv_i(:,:,jl) * e12t(:,:) ! Salt content 163 zs0oi (:,:,jl) = oa_i (:,:,jl) * e12t(:,:) ! Age content 164 zs0c0 (:,:,jl) = e_s (:,:,1,jl) * e12t(:,:) ! Snow heat content 165 DO jk = 1, nlay_i 166 zs0e (:,:,jk,jl) = e_i (:,:,jk,jl) * e12t(:,:) ! Ice heat content 167 END DO 168 END DO 169 160 170 161 171 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 162 DO j n = 1,initad163 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area164 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )165 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,: ), sxopw(:,:), &166 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )172 DO jt = 1, initad 173 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0ow (:,:,1), sxopw(:,:), & !--- ice open water area 174 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 175 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:,1), sxopw(:,:), & 176 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 167 177 DO jl = 1, jpl 168 CALL lim_adv_x( zusnit, u_ice, 1._wp 178 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 169 179 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 170 180 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 171 181 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 172 CALL lim_adv_x( zusnit, u_ice, 1._wp 182 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 173 183 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 174 184 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 175 185 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 176 CALL lim_adv_x( zusnit, u_ice, 1._wp 186 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 177 187 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 178 188 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 179 189 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 180 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), &!--- ice age ---190 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 181 191 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 182 192 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 183 193 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 184 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), &!--- ice concentrations ---194 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 185 195 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 186 196 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 187 197 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 188 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &!--- snow heat contents ---198 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 189 199 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 190 200 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 191 201 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 192 DO jk = 1, nlay_i !--- ice heat contents ---193 CALL lim_adv_x( zusnit, u_ice, 1._wp 202 DO jk = 1, nlay_i !--- ice heat contents --- 203 CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), & 194 204 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 195 205 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) … … 201 211 END DO 202 212 ELSE 203 DO j n= 1, initad204 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area205 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )206 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,: ), sxopw(:,:), &207 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )213 DO jt = 1, initad 214 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0ow (:,:,1), sxopw(:,:), & !--- ice open water area 215 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 216 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:,1), sxopw(:,:), & 217 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 208 218 DO jl = 1, jpl 209 CALL lim_adv_y( zusnit, v_ice, 1._wp 219 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 210 220 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 211 221 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 212 222 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 213 CALL lim_adv_y( zusnit, v_ice, 1._wp 223 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 214 224 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 215 225 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 216 226 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 217 CALL lim_adv_y( zusnit, v_ice, 1._wp 227 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 218 228 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 219 229 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 220 230 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 221 231 222 CALL lim_adv_y( zusnit, v_ice, 1._wp 232 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 223 233 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 224 234 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 225 235 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 226 CALL lim_adv_y( zusnit, v_ice, 1._wp 236 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 227 237 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 228 238 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 229 239 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 230 CALL lim_adv_y( zusnit, v_ice, 1._wp 240 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 231 241 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 232 242 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 233 243 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 234 244 DO jk = 1, nlay_i !--- ice heat contents --- 235 CALL lim_adv_y( zusnit, v_ice, 1._wp 245 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), & 236 246 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 237 247 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) … … 247 257 ! Recover the properties from their contents 248 258 !------------------------------------------- 249 zs0ow(:,:) = zs0ow(:,:) / area(:,:) 250 DO jl = 1, jpl 251 zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:) 252 zs0sn (:,:,jl) = zs0sn (:,:,jl) / area(:,:) 253 zs0sm (:,:,jl) = zs0sm (:,:,jl) / area(:,:) 254 zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 255 zs0a (:,:,jl) = zs0a (:,:,jl) / area(:,:) 256 ! 259 ato_i(:,:) = zs0ow(:,:,1) * r1_e12t(:,:) 260 DO jl = 1, jpl 261 v_i (:,:,jl) = zs0ice(:,:,jl) * r1_e12t(:,:) 262 v_s (:,:,jl) = zs0sn (:,:,jl) * r1_e12t(:,:) 263 smv_i(:,:,jl) = zs0sm (:,:,jl) * r1_e12t(:,:) 264 oa_i (:,:,jl) = zs0oi (:,:,jl) * r1_e12t(:,:) 265 a_i (:,:,jl) = zs0a (:,:,jl) * r1_e12t(:,:) 266 e_s (:,:,1,jl) = zs0c0 (:,:,jl) * r1_e12t(:,:) 267 DO jk = 1, nlay_i 268 e_i (:,:,jk,jl) = zs0e (:,:,jk,jl) * r1_e12t(:,:) 269 END DO 270 END DO 271 272 at_i(:,:) = a_i(:,:,1) ! total ice fraction 273 DO jl = 2, jpl 274 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 257 275 END DO 258 276 259 277 !------------------------------------------------------------------------------! 260 ! 4)Diffusion of Ice fields278 ! Diffusion of Ice fields 261 279 !------------------------------------------------------------------------------! 262 280 281 ! 263 282 !-------------------------------- 264 283 ! diffusion of open water area 265 284 !-------------------------------- 266 zs0at(:,:) = zs0a(:,:,1) ! total ice fraction267 DO jl = 2, jpl268 zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl)269 END DO270 !271 285 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 272 286 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 273 287 DO ji = 1 , fs_jpim1 ! vector opt. 274 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - zs0at(ji ,jj) ) ) ) &275 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)276 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - zs0at(ji,jj ) ) ) ) &277 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)288 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 289 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 290 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 291 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 278 292 END DO 279 293 END DO 280 294 ! 281 CALL lim_hdf( zs0ow(:,:) ) ! Diffusion295 CALL lim_hdf( ato_i (:,:) ) ! Diffusion 282 296 283 297 !------------------------------------ … … 288 302 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 289 303 DO ji = 1 , fs_jpim1 ! vector opt. 290 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - zs0a(ji ,jj,jl) ) ) ) &291 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)292 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - zs0a(ji,jj ,jl) ) ) ) &293 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)294 END DO 295 END DO 296 297 CALL lim_hdf( zs0ice (:,:,jl) )298 CALL lim_hdf( zs0sn (:,:,jl) )299 CALL lim_hdf( zs0sm (:,:,jl) )300 CALL lim_hdf( zs0oi (:,:,jl) )301 CALL lim_hdf( zs0a (:,:,jl) )302 CALL lim_hdf( zs0c0 (:,:,jl) )304 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) & 305 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 306 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) & 307 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 308 END DO 309 END DO 310 311 CALL lim_hdf( v_i (:,:, jl) ) 312 CALL lim_hdf( v_s (:,:, jl) ) 313 CALL lim_hdf( smv_i(:,:, jl) ) 314 CALL lim_hdf( oa_i (:,:, jl) ) 315 CALL lim_hdf( a_i (:,:, jl) ) 316 CALL lim_hdf( e_s (:,:,1,jl) ) 303 317 DO jk = 1, nlay_i 304 CALL lim_hdf( zs0e(:,:,jk,jl) )318 CALL lim_hdf( e_i(:,:,jk,jl) ) 305 319 END DO 306 320 END DO 307 321 308 322 !------------------------------------------------------------------------------! 309 ! 5) Update andlimit ice properties after transport323 ! limit ice properties after transport 310 324 !------------------------------------------------------------------------------! 311 312 !-------------------------------------------------- 313 ! 5.1) Recover mean values over the grid squares. 314 !-------------------------------------------------- 315 zs0at(:,:) = 0._wp 325 !!gm & cr : MAX should not be active if adv scheme is positive ! 316 326 DO jl = 1, jpl 317 327 DO jj = 1, jpj 318 328 DO ji = 1, jpi 319 zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 320 zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 321 zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 322 zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 323 zs0a (ji,jj,jl) = MAX( 0._wp, zs0a (ji,jj,jl) ) 324 zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 325 zs0at (ji,jj) = zs0at(ji,jj) + zs0a(ji,jj,jl) 326 END DO 327 END DO 328 END DO 329 330 !--------------------------------------------------------- 331 ! 5.2) Update and mask variables 332 !--------------------------------------------------------- 333 DO jl = 1, jpl 334 DO jj = 1, jpj 335 DO ji = 1, jpi 336 rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 337 338 zvi = zs0ice(ji,jj,jl) 339 zvs = zs0sn (ji,jj,jl) 340 zes = zs0c0 (ji,jj,jl) 341 zsmv = zs0sm (ji,jj,jl) 342 ! 343 ! Remove very small areas 344 v_s(ji,jj,jl) = rswitch * zs0sn (ji,jj,jl) 345 v_i(ji,jj,jl) = rswitch * zs0ice(ji,jj,jl) 346 a_i(ji,jj,jl) = rswitch * zs0a (ji,jj,jl) 347 e_s(ji,jj,1,jl) = rswitch * zs0c0 (ji,jj,jl) 348 ! Ice salinity and age 349 IF( num_sal == 2 ) THEN 350 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 351 ENDIF 352 oa_i(ji,jj,jl) = MAX( rswitch * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 353 354 ! Update fluxes 355 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 356 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 357 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 358 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 359 END DO 360 END DO 361 END DO 362 363 DO jl = 1, jpl 329 v_s (ji,jj,jl) = MAX( 0._wp, v_s (ji,jj,jl) ) 330 v_i (ji,jj,jl) = MAX( 0._wp, v_i (ji,jj,jl) ) 331 smv_i(ji,jj,jl) = MAX( 0._wp, smv_i(ji,jj,jl) ) 332 oa_i (ji,jj,jl) = MAX( 0._wp, oa_i (ji,jj,jl) ) 333 a_i (ji,jj,jl) = MAX( 0._wp, a_i (ji,jj,jl) ) 334 e_s (ji,jj,1,jl) = MAX( 0._wp, e_s (ji,jj,1,jl) ) 335 END DO 336 END DO 337 364 338 DO jk = 1, nlay_i 365 339 DO jj = 1, jpj 366 340 DO ji = 1, jpi 367 rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10) )368 zei = zs0e(ji,jj,jk,jl)369 e_i(ji,jj,jk,jl) = rswitch * MAX( 0._wp, zs0e(ji,jj,jk,jl) )370 ! Update fluxes371 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 <0372 END DO !ji 373 END DO ! jj 374 END DO ! jk375 END DO ! jl376 377 !--- Thickness correction in case too high (clem)--------------------------------------------------------341 e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) ) 342 END DO 343 END DO 344 END DO 345 END DO 346 !!gm & cr 347 348 ! zap small areas 349 CALL lim_var_zapsmall 350 351 !--- Thickness correction in case too high -------------------------------------------------------- 378 352 CALL lim_var_glo2eqv 379 353 DO jl = 1, jpl … … 388 362 zei = SUM( e_i(ji,jj,1:nlay_i,jl) ) 389 363 zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl) 390 !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)391 364 392 365 rswitch = 1._wp 393 IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl)) < 0.80 ) .OR. &366 IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 394 367 & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN 395 368 ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) … … 413 386 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 414 387 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 415 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 <0416 hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * unit_fac / area(ji,jj) *r1_rdtice ! W.m-2 <0388 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0 389 hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0 417 390 ENDIF 391 418 392 END DO 419 393 END DO 420 394 END DO 421 395 ! ------------------------------------------------- 396 397 !-------------------------------------- 398 ! Impose a_i < amax in mono-category 399 !-------------------------------------- 400 ! 401 IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 a_i(ji,jj,1) = MIN( a_i(ji,jj,1), rn_amax ) 405 END DO 406 END DO 407 ENDIF 422 408 423 409 ! --- diags --- 424 410 DO jj = 1, jpj 425 411 DO ji = 1, jpi 426 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 427 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 428 429 diag_trp_vi(ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 430 diag_trp_vs(ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 412 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 413 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 414 415 diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 416 diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 417 diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 431 418 END DO 432 419 END DO … … 454 441 ! open water = 1 if at_i=0 455 442 rswitch = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 456 ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * zs0ow(ji,jj)443 ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj) 457 444 END DO 458 445 END DO … … 463 450 ENDIF 464 451 465 IF(ln_ctl) THEN ! Control print 466 CALL prt_ctl_info(' ') 467 CALL prt_ctl_info(' - Cell values : ') 468 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 469 CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp : cell area :') 470 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp : at_i :') 471 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp : vt_i :') 472 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp : vt_s :') 473 DO jl = 1, jpl 474 CALL prt_ctl_info(' ') 475 CALL prt_ctl_info(' - Category : ', ivar1=jl) 476 CALL prt_ctl_info(' ~~~~~~~~~~') 477 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_trp : a_i : ') 478 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_trp : ht_i : ') 479 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_trp : ht_s : ') 480 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_trp : v_i : ') 481 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_trp : v_s : ') 482 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_trp : e_s : ') 483 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_trp : t_su : ') 484 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_trp : t_snow : ') 485 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_trp : sm_i : ') 486 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_trp : smv_i : ') 487 DO jk = 1, nlay_i 488 CALL prt_ctl_info(' ') 489 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 490 CALL prt_ctl_info(' ~~~~~~~') 491 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp : t_i : ') 492 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp : e_i : ') 493 END DO 494 END DO 495 ENDIF 452 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 453 454 ! ------------------------------------------------- 455 ! control prints 456 ! ------------------------------------------------- 457 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' ) 496 458 ! 497 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )498 CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi)499 CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e)500 501 CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax ) ! clem459 CALL wrk_dealloc( jpi,jpj, zsm, zs0at, zatold, zeiold, zesold ) 460 CALL wrk_dealloc( jpi,jpj,jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi, zzs0e ) 461 CALL wrk_dealloc( jpi,jpj,1, zs0ow ) 462 CALL wrk_dealloc( jpi,jpj,nlay_i+1,jpl, zs0e ) 463 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold ) 502 464 ! 503 465 IF( nn_timing == 1 ) CALL timing_stop('limtrp') 466 504 467 END SUBROUTINE lim_trp 505 468 … … 512 475 END SUBROUTINE lim_trp 513 476 #endif 514 515 477 !!====================================================================== 516 478 END MODULE limtrp -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r4990 r5123 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3. 6! 2014-06 (C. Rousset) Complete rewriting/cleaning7 !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_lim3 … … 13 13 !! lim_update1 : computes update of sea-ice global variables from trend terms 14 14 !!---------------------------------------------------------------------- 15 USE limrhg ! ice rheology16 17 USE dom_oce18 USE oce ! dynamics and tracers variables19 USE in_out_manager20 15 USE sbc_oce ! Surface boundary condition: ocean fields 21 16 USE sbc_ice ! Surface boundary condition: ice fields 22 17 USE dom_ice 18 USE dom_oce 23 19 USE phycst ! physical constants 24 20 USE ice 25 USE limdyn26 USE limtrp27 USE limthd28 USE limsbc29 USE limdiahsb30 USE limwri31 USE limrst32 21 USE thd_ice ! LIM thermodynamic sea-ice variables 33 USE par_ice34 22 USE limitd_th 35 USE limitd_me36 23 USE limvar 37 USE prtctl ! Print control 38 USE lbclnk ! lateral boundary condition - MPP exchanges 39 USE wrk_nemo ! work arrays 40 USE lib_fortran ! glob_sum 41 USE in_out_manager ! I/O manager 42 USE iom ! I/O manager 43 USE lib_mpp ! MPP library 24 USE prtctl ! Print control 25 USE wrk_nemo ! work arrays 44 26 USE timing ! Timing 45 USE limcons ! conservation tests 27 USE limcons ! conservation tests 28 USE lib_mpp ! MPP library 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 USE in_out_manager ! I/O manager 46 31 47 32 IMPLICIT NONE 48 33 PRIVATE 49 34 50 PUBLIC lim_update1 ! routine called by ice_step35 PUBLIC lim_update1 51 36 52 37 !! * Substitutions … … 59 44 CONTAINS 60 45 61 SUBROUTINE lim_update1 46 SUBROUTINE lim_update1( kt ) 62 47 !!------------------------------------------------------------------- 63 48 !! *** ROUTINE lim_update1 *** … … 67 52 !! 68 53 !!--------------------------------------------------------------------- 54 INTEGER, INTENT(in) :: kt ! number of iteration 69 55 INTEGER :: ji, jj, jk, jl ! dummy loop indices 70 INTEGER :: i_ice_switch71 56 REAL(wp) :: zsal 72 ! 73 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 57 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 74 58 !!------------------------------------------------------------------- 75 59 IF( nn_timing == 1 ) CALL timing_start('limupdate1') … … 77 61 IF( ln_limdyn ) THEN 78 62 63 IF( kt == nit000 .AND. lwp ) THEN 64 WRITE(numout,*) ' lim_update1 ' 65 WRITE(numout,*) ' ~~~~~~~~~~~ ' 66 ENDIF 67 79 68 ! conservation test 80 69 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) … … 83 72 ! zap small values 84 73 !----------------- 85 CALL lim_ itd_me_zapsmall74 CALL lim_var_zapsmall 86 75 87 76 CALL lim_var_glo2eqv … … 103 92 DO jj = 1, jpj 104 93 DO ji = 1, jpi 105 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN106 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )94 IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 95 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 107 96 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 108 97 ENDIF … … 124 113 ! zap small values 125 114 !----------------- 126 CALL lim_ itd_me_zapsmall115 CALL lim_var_zapsmall 127 116 128 117 !--------------------- 129 118 ! Ice salinity bounds 130 119 !--------------------- 131 IF ( n um_sal == 2 ) THEN120 IF ( nn_icesal == 2 ) THEN 132 121 DO jl = 1, jpl 133 122 DO jj = 1, jpj … … 136 125 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 137 126 ! salinity stays in bounds 138 i_ice_switch= 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )139 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) )127 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 128 smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) ) 140 129 ! associated salt flux 141 130 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice … … 145 134 ENDIF 146 135 147 ! -------------------------------------------------148 ! Diagnostics149 ! -------------------------------------------------150 d_u_ice_dyn(:,:) = u_ice(:,:) - u_ice_b(:,:)151 d_v_ice_dyn(:,:) = v_ice(:,:) - v_ice_b(:,:)152 d_a_i_trp (:,:,:) = a_i (:,:,:) - a_i_b (:,:,:)153 d_v_s_trp (:,:,:) = v_s (:,:,:) - v_s_b (:,:,:)154 d_v_i_trp (:,:,:) = v_i (:,:,:) - v_i_b (:,:,:)155 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - e_s_b (:,:,:,:)156 d_e_i_trp (:,:,1:nlay_i,:) = e_i (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)157 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:)158 d_smv_i_trp(:,:,:) = 0._wp159 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)160 161 136 ! conservation test 162 137 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 163 138 139 ! ------------------------------------------------- 140 ! Diagnostics 141 ! ------------------------------------------------- 142 DO jl = 1, jpl 143 afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 144 END DO 145 146 ! heat content variation (W.m-2) 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 diag_heat_dhc(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + & 150 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) & 151 & ) * r1_rdtice 152 END DO 153 END DO 154 155 ! ------------------------------------------------- 156 ! control prints 157 ! ------------------------------------------------- 164 158 IF(ln_ctl) THEN ! Control print 165 159 CALL prt_ctl_info(' ') 166 160 CALL prt_ctl_info(' - Cell values : ') 167 161 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 168 CALL prt_ctl(tab2d_1= area, clinfo1=' lim_update1 : cell area :')162 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_update1 : cell area :') 169 163 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update1 : at_i :') 170 164 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update1 : vt_i :') … … 172 166 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update1 : strength :') 173 167 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update1 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 174 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 :')175 168 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update1 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 176 169 … … 187 180 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update1 : a_i : ') 188 181 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update1 : a_i_b : ') 189 CALL prt_ctl(tab2d_1=d_a_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_a_i_trp : ')190 182 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update1 : v_i : ') 191 183 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update1 : v_i_b : ') 192 CALL prt_ctl(tab2d_1=d_v_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_i_trp : ')193 184 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update1 : v_s : ') 194 185 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update1 : v_s_b : ') 195 CALL prt_ctl(tab2d_1=d_v_s_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_s_trp : ') 196 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1 : ') 197 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1_b : ') 198 CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : de_i1_trp : ') 199 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2 : ') 200 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2_b : ') 201 CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : de_i2_trp : ') 186 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1 : ') 187 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1_b : ') 188 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2 : ') 189 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2_b : ') 202 190 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow : ') 203 191 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow_b : ') 204 CALL prt_ctl(tab2d_1=d_e_s_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : d_e_s_trp : ')205 192 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update1 : smv_i : ') 206 193 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update1 : smv_i_b : ') 207 CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl) , clinfo1= ' lim_update1 : d_smv_i_trp : ')208 194 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update1 : oa_i : ') 209 195 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update1 : oa_i_b : ') 210 CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_oa_i_trp : ')211 196 212 197 DO jk = 1, nlay_i -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r4990 r5123 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3. 6! 2014-06 (C. Rousset) Complete rewriting/cleaning7 !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_lim3 … … 13 13 !! lim_update2 : computes update of sea-ice global variables from trend terms 14 14 !!---------------------------------------------------------------------- 15 USE limrhg ! ice rheology16 17 USE dom_oce18 USE oce ! dynamics and tracers variables19 USE in_out_manager20 15 USE sbc_oce ! Surface boundary condition: ocean fields 21 16 USE sbc_ice ! Surface boundary condition: ice fields 22 17 USE dom_ice 18 USE dom_oce 23 19 USE phycst ! physical constants 24 20 USE ice 25 USE limdyn26 USE limtrp27 USE limthd28 USE limsbc29 USE limdiahsb30 USE limwri31 USE limrst32 21 USE thd_ice ! LIM thermodynamic sea-ice variables 33 USE par_ice34 22 USE limitd_th 35 USE limitd_me36 23 USE limvar 37 USE prtctl ! Print control 38 USE lbclnk ! lateral boundary condition - MPP exchanges 39 USE wrk_nemo ! work arrays 40 USE lib_fortran ! glob_sum 24 USE prtctl ! Print control 25 USE lbclnk ! lateral boundary condition - MPP exchanges 26 USE wrk_nemo ! work arrays 41 27 USE timing ! Timing 42 USE limcons ! conservation tests 28 USE limcons ! conservation tests 29 USE limctl 30 USE lib_mpp ! MPP library 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 USE in_out_manager 43 33 44 34 IMPLICIT NONE … … 56 46 CONTAINS 57 47 58 SUBROUTINE lim_update2 48 SUBROUTINE lim_update2( kt ) 59 49 !!------------------------------------------------------------------- 60 50 !! *** ROUTINE lim_update2 *** … … 64 54 !! 65 55 !!--------------------------------------------------------------------- 66 INTEGER :: ji, jj, jk, jl ! dummy loop indices67 INTEGER :: i_ice_switch56 INTEGER, INTENT(in) :: kt ! number of iteration 57 INTEGER :: ji, jj, jk, jl ! dummy loop indices 68 58 REAL(wp) :: zh, zsal 69 ! 70 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 59 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 71 60 !!------------------------------------------------------------------- 72 61 IF( nn_timing == 1 ) CALL timing_start('limupdate2') 73 62 63 IF( kt == nit000 .AND. lwp ) THEN 64 WRITE(numout,*) ' lim_update2 ' 65 WRITE(numout,*) ' ~~~~~~~~~~~ ' 66 ENDIF 67 74 68 ! conservation test 75 69 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) … … 78 72 ! zap small values 79 73 !----------------- 80 CALL lim_ itd_me_zapsmall81 74 CALL lim_var_agg( 1 ) 75 CALL lim_var_zapsmall 82 76 CALL lim_var_glo2eqv 83 77 … … 88 82 89 83 !---------------------------------------------------------------------- 90 ! Constrain the thickness of the smallest category above hi clim84 ! Constrain the thickness of the smallest category above himin 91 85 !---------------------------------------------------------------------- 92 86 DO jj = 1, jpj 93 87 DO ji = 1, jpi 94 IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim) THEN95 zh = hiclim/ ht_i(ji,jj,1)88 IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN 89 zh = rn_himin / ht_i(ji,jj,1) 96 90 ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh 97 91 ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh … … 112 106 DO jj = 1, jpj 113 107 DO ji = 1, jpi 114 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN115 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )108 IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 109 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 116 110 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 117 111 ENDIF … … 133 127 ! zap small values 134 128 !----------------- 135 CALL lim_ itd_me_zapsmall129 CALL lim_var_zapsmall 136 130 137 131 !--------------------- 138 ! 2.11)Ice salinity132 ! Ice salinity 139 133 !--------------------- 140 IF ( n um_sal == 2 ) THEN134 IF ( nn_icesal == 2 ) THEN 141 135 DO jl = 1, jpl 142 136 DO jj = 1, jpj … … 145 139 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 146 140 ! salinity stays in bounds 147 i_ice_switch= 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )148 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)141 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 142 smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) ) !+ rn_simin * ( 1._wp - rswitch ) * v_i(ji,jj,jl) 149 143 ! associated salt flux 150 144 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice … … 155 149 156 150 !------------------------------------------------------------------------------ 157 ! 2)Corrections to avoid wrong values |151 ! Corrections to avoid wrong values | 158 152 !------------------------------------------------------------------------------ 159 153 ! Ice drift … … 173 167 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 174 168 !mask velocities 175 u_ice(:,:) = u_ice(:,:) * tmu(:,:)176 v_ice(:,:) = v_ice(:,:) * tmv(:,:)169 u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 170 v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 177 171 172 ! for outputs 173 CALL lim_var_glo2eqv ! equivalent variables (outputs) 174 CALL lim_var_agg(2) ! aggregate ice thickness categories 175 176 ! conservation test 177 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 178 178 179 ! ------------------------------------------------- 179 180 ! Diagnostics 180 181 ! ------------------------------------------------- 181 d_a_i_thd(:,:,:) = a_i(:,:,:) - a_i_b(:,:,:) 182 d_v_s_thd(:,:,:) = v_s(:,:,:) - v_s_b(:,:,:) 183 d_v_i_thd(:,:,:) = v_i(:,:,:) - v_i_b(:,:,:) 184 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:) 185 d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 186 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:) 187 d_smv_i_thd(:,:,:) = 0._wp 188 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 189 ! diag only (clem) 190 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 182 DO jl = 1, jpl 183 afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 184 END DO 185 afx_tot = afx_thd + afx_dyn 191 186 192 187 ! heat content variation (W.m-2) 193 188 DO jj = 1, jpj 194 189 DO ji = 1, jpi 195 diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) + & 196 & SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) & 197 & ) * unit_fac * r1_rdtice / area(ji,jj) 198 END DO 199 END DO 200 201 ! conservation test 202 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 190 diag_heat_dhc(ji,jj) = diag_heat_dhc(ji,jj) - & 191 & ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + & 192 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) & 193 & ) * r1_rdtice 194 END DO 195 END DO 196 197 ! ------------------------------------------------- 198 ! control prints 199 ! ------------------------------------------------- 200 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 2, ' - Final state - ' ) ! control print 203 201 204 202 IF(ln_ctl) THEN ! Control print … … 206 204 CALL prt_ctl_info(' - Cell values : ') 207 205 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 208 CALL prt_ctl(tab2d_1= area, clinfo1=' lim_update2 : cell area :')206 CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_update2 : cell area :') 209 207 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update2 : at_i :') 210 208 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update2 : vt_i :') … … 226 224 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update2 : a_i : ') 227 225 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update2 : a_i_b : ') 228 CALL prt_ctl(tab2d_1=d_a_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_a_i_thd : ')229 226 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update2 : v_i : ') 230 227 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update2 : v_i_b : ') 231 CALL prt_ctl(tab2d_1=d_v_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_i_thd : ')232 228 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update2 : v_s : ') 233 229 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update2 : v_s_b : ') 234 CALL prt_ctl(tab2d_1=d_v_s_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_s_thd : ') 235 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1 : ') 236 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1_b : ') 237 CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : de_i1_thd : ') 238 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2 : ') 239 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2_b : ') 240 CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : de_i2_thd : ') 230 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1 : ') 231 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1_b : ') 232 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2 : ') 233 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2_b : ') 241 234 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow : ') 242 235 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow_b : ') 243 CALL prt_ctl(tab2d_1=d_e_s_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : d_e_s_thd : ')244 236 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update2 : smv_i : ') 245 237 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update2 : smv_i_b : ') 246 CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl) , clinfo1= ' lim_update2 : d_smv_i_thd : ')247 238 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update2 : oa_i : ') 248 239 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update2 : oa_i_b : ') 249 CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_oa_i_thd : ')250 240 251 241 DO jk = 1, nlay_i -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r4990 r5123 30 30 !!====================================================================== 31 31 !! History : - ! 2006-01 (M. Vancoppenolle) Original code 32 !! 4.0! 2011-02 (G. Madec) dynamical allocation32 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 33 33 !!---------------------------------------------------------------------- 34 34 #if defined key_lim3 … … 36 36 !! 'key_lim3' LIM3 sea-ice model 37 37 !!---------------------------------------------------------------------- 38 !! lim_var_agg :39 !! lim_var_glo2eqv :40 !! lim_var_eqv2glo :41 !! lim_var_salprof :42 !! lim_var_salprof1d :43 !! lim_var_bv :44 !!----------------------------------------------------------------------45 38 USE par_oce ! ocean parameters 46 39 USE phycst ! physical constants (ocean directory) 47 40 USE sbc_oce ! Surface boundary condition: ocean fields 48 41 USE ice ! ice variables 49 USE par_ice ! ice parameters50 42 USE thd_ice ! ice variables (thermodynamics) 51 43 USE dom_ice ! ice domain … … 58 50 PRIVATE 59 51 60 PUBLIC lim_var_agg ! 61 PUBLIC lim_var_glo2eqv ! 62 PUBLIC lim_var_eqv2glo ! 63 PUBLIC lim_var_salprof ! 64 PUBLIC lim_var_icetm ! 65 PUBLIC lim_var_bv ! 66 PUBLIC lim_var_salprof1d ! 52 PUBLIC lim_var_agg 53 PUBLIC lim_var_glo2eqv 54 PUBLIC lim_var_eqv2glo 55 PUBLIC lim_var_salprof 56 PUBLIC lim_var_icetm 57 PUBLIC lim_var_bv 58 PUBLIC lim_var_salprof1d 59 PUBLIC lim_var_zapsmall 60 PUBLIC lim_var_itd 67 61 68 62 !!---------------------------------------------------------------------- 69 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)63 !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011) 70 64 !! $Id$ 71 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 129 123 DO jj = 1, jpj 130 124 DO ji = 1, jpi 131 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content125 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 132 126 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 133 127 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch ! ice salinity … … 175 169 END DO 176 170 177 IF( n um_sal == 2 )THEN171 IF( nn_icesal == 2 )THEN 178 172 DO jl = 1, jpl 179 173 DO jj = 1, jpj … … 191 185 ! Ice temperatures 192 186 !------------------- 193 !CDIR NOVERRCHK 194 DO jl = 1, jpl 195 !CDIR NOVERRCHK 187 DO jl = 1, jpl 196 188 DO jk = 1, nlay_i 197 !CDIR NOVERRCHK 198 DO jj = 1, jpj 199 !CDIR NOVERRCHK 189 DO jj = 1, jpj 200 190 DO ji = 1, jpi 201 191 ! ! Energy of melting q(S,T) [J.m-3] 202 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) ! rswitch = 0 if no ice and 1 if yes 203 zq_i = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 204 zq_i = zq_i * unit_fac !convert units 205 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature 192 rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi20 ) ) ! rswitch = 0 if no ice and 1 if yes 193 zq_i = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp) 194 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0 ! Ice layer melt temperature 206 195 ! 207 196 zaaa = cpic ! Conversion q(S,T) -> T (second order equation) 208 zbbb = ( rcp - cpic ) * ( ztmelts - rt t ) + zq_i /rhoic - lfus209 zccc = lfus * (ztmelts-rt t)197 zbbb = ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus 198 zccc = lfus * (ztmelts-rt0) 210 199 zdiscrim = SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 211 t_i(ji,jj,jk,jl) = rt t+ rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )212 t_i(ji,jj,jk,jl) = MIN( rt t, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt200 t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 201 t_i(ji,jj,jk,jl) = MIN( rt0, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) ) ! 100-rt0 < t_i < rt0 213 202 END DO 214 203 END DO … … 226 215 DO ji = 1, jpi 227 216 !Energy of melting q(S,T) [J.m-3] 228 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) ) ! rswitch = 0 if no ice and 1 if yes 229 zq_s = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 230 zq_s = zq_s * unit_fac ! convert units 217 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi20 ) ) ! rswitch = 0 if no ice and 1 if yes 218 zq_s = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp) 231 219 ! 232 t_s(ji,jj,jk,jl) = rt t+ rswitch * ( - zfac1 * zq_s + zfac2 )233 t_s(ji,jj,jk,jl) = MIN( rt t, MAX( 173.15, t_s(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt220 t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 ) 221 t_s(ji,jj,jk,jl) = MIN( rt0, MAX( 173.15, t_s(ji,jj,jk,jl) ) ) ! 100-rt0 < t_i < rt0 234 222 END DO 235 223 END DO … … 281 269 !! ** Purpose : computes salinity profile in function of bulk salinity 282 270 !! 283 !! ** Method : If bulk salinity greater than s_i_1,271 !! ** Method : If bulk salinity greater than zsi1, 284 272 !! the profile is assumed to be constant (S_inf) 285 !! If bulk salinity lower than s_i_0,273 !! If bulk salinity lower than zsi0, 286 274 !! the profile is linear with 0 at the surface (S_zero) 287 !! If it is between s_i_0 and s_i_1, it is a275 !! If it is between zsi0 and zsi1, it is a 288 276 !! alpha-weighted linear combination of s_inf and s_zero 289 277 !! 290 !! ** References : Vancoppenolle et al., 2007 (in preparation)278 !! ** References : Vancoppenolle et al., 2007 291 279 !!------------------------------------------------------------------ 292 280 INTEGER :: ji, jj, jk, jl ! dummy loop index 293 REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac, zsal ! local scalar 294 REAL(wp) :: zswi0, zswi01, zswibal, zargtemp , zs_zero ! - - 295 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha ! 3D pointer 281 REAL(wp) :: zfac0, zfac1, zsal 282 REAL(wp) :: zswi0, zswi01, zargtemp , zs_zero 283 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha 284 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 285 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 296 286 !!------------------------------------------------------------------ 297 287 … … 301 291 ! Vertically constant, constant in time 302 292 !--------------------------------------- 303 IF( n um_sal == 1 ) s_i(:,:,:,:) = bulk_sal293 IF( nn_icesal == 1 ) s_i(:,:,:,:) = rn_icesal 304 294 305 295 !----------------------------------- 306 296 ! Salinity profile, varying in time 307 297 !----------------------------------- 308 IF( n um_sal == 2 ) THEN298 IF( nn_icesal == 2 ) THEN 309 299 ! 310 300 DO jk = 1, nlay_i … … 320 310 END DO 321 311 ! 322 dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) ! Weighting factor between zs_zero and zs_inf323 dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )312 zfac0 = 1._wp / ( zsi0 - zsi1 ) ! Weighting factor between zs_zero and zs_inf 313 zfac1 = zsi1 / ( zsi1 - zsi0 ) 324 314 ! 325 315 zalpha(:,:,:) = 0._wp … … 327 317 DO jj = 1, jpj 328 318 DO ji = 1, jpi 329 ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise330 zswi0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i(ji,jj,jl) ) )331 ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws332 zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i(ji,jj,jl) ) )333 ! If 2.sm_i GE sss_m then zswibal= 1319 ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise 320 zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i(ji,jj,jl) ) ) 321 ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 322 zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i(ji,jj,jl) ) ) 323 ! If 2.sm_i GE sss_m then rswitch = 1 334 324 ! this is to force a constant salinity profile in the Baltic Sea 335 zswibal= MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )336 zalpha(ji,jj,jl) = zswi0 + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )337 zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal)338 END DO 339 END DO 340 END DO 341 342 dummy_fac = 1._wp / REAL( nlay_i )! Computation of the profile325 rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 326 zalpha(ji,jj,jl) = zswi0 + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 ) 327 zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch ) 328 END DO 329 END DO 330 END DO 331 332 ! Computation of the profile 343 333 DO jl = 1, jpl 344 334 DO jk = 1, nlay_i … … 346 336 DO ji = 1, jpi 347 337 ! ! linear profile with 0 at the surface 348 zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac338 zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i 349 339 ! ! weighting the profile 350 340 s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) … … 354 344 END DO ! jl 355 345 ! 356 ENDIF ! n um_sal346 ENDIF ! nn_icesal 357 347 358 348 !------------------------------------------------------- … … 360 350 !------------------------------------------------------- 361 351 362 IF( n um_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)352 IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 363 353 ! 364 354 sm_i(:,:,:) = 2.30_wp 365 355 ! 366 356 DO jl = 1, jpl 367 !CDIR NOVERRCHK368 357 DO jk = 1, nlay_i 369 zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)358 zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 370 359 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 371 360 s_i(:,:,jk,jl) = zsal … … 373 362 END DO 374 363 ! 375 ENDIF ! n um_sal364 ENDIF ! nn_icesal 376 365 ! 377 366 CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha ) … … 397 386 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) ) 398 387 tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) & 399 & / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ))388 & * r1_nlay_i / MAX( vt_i(ji,jj) , epsi10 ) 400 389 END DO 401 390 END DO … … 425 414 DO jj = 1, jpj 426 415 DO ji = 1, jpi 427 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt t) + epsi10 ) ) )428 zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt t, - epsi10 ) &429 & * v_i(ji,jj,jl) / REAL(nlay_i,wp)416 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) ) 417 zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) & 418 & * v_i(ji,jj,jl) * r1_nlay_i 430 419 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) ) 431 420 bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi10 ) … … 448 437 ! 449 438 INTEGER :: ji, jk ! dummy loop indices 450 INTEGER :: ii, ij ! local integers451 REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal ! local scalars452 REAL(wp) :: zalpha, zswi0, zswi01, zs wibal, zs_zero ! - -439 INTEGER :: ii, ij ! local integers 440 REAL(wp) :: zfac0, zfac1, zargtemp, zsal ! local scalars 441 REAL(wp) :: zalpha, zswi0, zswi01, zs_zero ! - - 453 442 ! 454 443 REAL(wp), POINTER, DIMENSION(:) :: z_slope_s 444 REAL(wp), PARAMETER :: zsi0 = 3.5_wp 445 REAL(wp), PARAMETER :: zsi1 = 4.5_wp 455 446 !!--------------------------------------------------------------------- 456 447 … … 460 451 ! Vertically constant, constant in time 461 452 !--------------------------------------- 462 IF( n um_sal == 1 ) s_i_1d(:,:) = bulk_sal453 IF( nn_icesal == 1 ) s_i_1d(:,:) = rn_icesal 463 454 464 455 !------------------------------------------------------ … … 466 457 !------------------------------------------------------ 467 458 468 IF( n um_sal == 2 ) THEN459 IF( nn_icesal == 2 ) THEN 469 460 ! 470 461 DO ji = kideb, kiut ! Slope of the linear profile zs_zero … … 474 465 ! Weighting factor between zs_zero and zs_inf 475 466 !--------------------------------------------- 476 dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) 477 dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 478 dummy_fac2 = 1._wp / REAL(nlay_i,wp) 479 480 !CDIR NOVERRCHK 467 zfac0 = 1._wp / ( zsi0 - zsi1 ) 468 zfac1 = zsi1 / ( zsi1 - zsi0 ) 481 469 DO jk = 1, nlay_i 482 !CDIR NOVERRCHK483 470 DO ji = kideb, kiut 484 471 ii = MOD( npb(ji) - 1 , jpi ) + 1 485 472 ij = ( npb(ji) - 1 ) / jpi + 1 486 ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise487 zswi0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i_1d(ji) ) )488 ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws489 zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) )490 ! if 2.sm_i GE sss_m then zswibal= 1473 ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise 474 zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i_1d(ji) ) ) 475 ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 476 zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) ) 477 ! if 2.sm_i GE sss_m then rswitch = 1 491 478 ! this is to force a constant salinity profile in the Baltic Sea 492 zswibal= MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )479 rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 493 480 ! 494 zalpha = ( zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 ) ) * ( 1.0 - zswibal)481 zalpha = ( zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 ) ) * ( 1._wp - rswitch ) 495 482 ! 496 zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2483 zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i 497 484 ! weighting the profile 498 485 s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 499 END DO ! ji500 END DO ! jk501 502 ENDIF ! num_sal486 END DO 487 END DO 488 489 ENDIF 503 490 504 491 !------------------------------------------------------- … … 506 493 !------------------------------------------------------- 507 494 508 IF( n um_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)495 IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 509 496 ! 510 497 sm_i_1d(:) = 2.30_wp 511 498 ! 512 !CDIR NOVERRCHK513 499 DO jk = 1, nlay_i 514 zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)515 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ))500 zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 501 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) ) 516 502 DO ji = kideb, kiut 517 503 s_i_1d(ji,jk) = zsal … … 524 510 ! 525 511 END SUBROUTINE lim_var_salprof1d 512 513 SUBROUTINE lim_var_zapsmall 514 !!------------------------------------------------------------------- 515 !! *** ROUTINE lim_var_zapsmall *** 516 !! 517 !! ** Purpose : Remove too small sea ice areas and correct fluxes 518 !! 519 !! history : LIM3.5 - 01-2014 (C. Rousset) original code 520 !!------------------------------------------------------------------- 521 INTEGER :: ji, jj, jl, jk ! dummy loop indices 522 REAL(wp) :: zsal, zvi, zvs, zei, zes 523 !!------------------------------------------------------------------- 524 at_i (:,:) = 0._wp 525 DO jl = 1, jpl 526 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 527 END DO 528 529 DO jl = 1, jpl 530 531 !----------------------------------------------------------------- 532 ! Zap ice energy and use ocean heat to melt ice 533 !----------------------------------------------------------------- 534 DO jk = 1, nlay_i 535 DO jj = 1 , jpj 536 DO ji = 1 , jpi 537 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 538 rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch 539 zei = e_i(ji,jj,jk,jl) 540 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch 541 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch ) 542 ! update exchanges with ocean 543 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0 544 END DO 545 END DO 546 END DO 547 548 DO jj = 1 , jpj 549 DO ji = 1 , jpi 550 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 551 rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch 552 553 zsal = smv_i(ji,jj, jl) 554 zvi = v_i (ji,jj, jl) 555 zvs = v_s (ji,jj, jl) 556 zes = e_s (ji,jj,1,jl) 557 !----------------------------------------------------------------- 558 ! Zap snow energy 559 !----------------------------------------------------------------- 560 t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch ) 561 e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch 562 563 !----------------------------------------------------------------- 564 ! zap ice and snow volume, add water and salt to ocean 565 !----------------------------------------------------------------- 566 ato_i(ji,jj) = a_i (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj) 567 a_i (ji,jj,jl) = a_i (ji,jj,jl) * rswitch 568 v_i (ji,jj,jl) = v_i (ji,jj,jl) * rswitch 569 v_s (ji,jj,jl) = v_s (ji,jj,jl) * rswitch 570 t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch ) 571 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch 572 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch 573 574 ! ice salinity must stay in bounds 575 IF( nn_icesal == 2 ) THEN 576 smv_i(ji,jj,jl) = MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) ) 577 ENDIF 578 ! update exchanges with ocean 579 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 580 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 581 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 582 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0 583 END DO 584 END DO 585 END DO 586 587 ! to be sure that at_i is the sum of a_i(jl) 588 at_i (:,:) = 0._wp 589 DO jl = 1, jpl 590 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 591 END DO 592 593 ! open water = 1 if at_i=0 594 DO jj = 1, jpj 595 DO ji = 1, jpi 596 rswitch = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 597 ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj) 598 END DO 599 END DO 600 601 ! 602 END SUBROUTINE lim_var_zapsmall 603 604 SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i ) 605 !!------------------------------------------------------------------ 606 !! *** ROUTINE lim_var_itd *** 607 !! 608 !! ** Purpose : converting 1-cat ice to multiple ice categories 609 !! 610 !! ice thickness distribution follows a gaussian law 611 !! around the concentration of the most likely ice thickness 612 !! (similar as limistate.F90) 613 !! 614 !! ** Method: Iterative procedure 615 !! 616 !! 1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian 617 !! 618 !! 2) Check whether the distribution conserves area and volume, positivity and 619 !! category boundaries 620 !! 621 !! 3) If not (input ice is too thin), the last category is empty and 622 !! the number of categories is reduced (jpl-1) 623 !! 624 !! 4) Iterate until ok (SUM(itest(:) = 4) 625 !! 626 !! ** Arguments : zhti: 1-cat ice thickness 627 !! zhts: 1-cat snow depth 628 !! zai : 1-cat ice concentration 629 !! 630 !! ** Output : jpl-cat 631 !! 632 !! (Example of application: BDY forcings when input are cell averaged) 633 !! 634 !!------------------------------------------------------------------- 635 !! History : LIM3.5 - 2012 (M. Vancoppenolle) Original code 636 !! 2014 (C. Rousset) Rewriting 637 !!------------------------------------------------------------------- 638 !! Local variables 639 INTEGER :: ji, jk, jl ! dummy loop indices 640 INTEGER :: ijpij, i_fill, jl0 641 REAL(wp) :: zarg, zV, zconv, zdh 642 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables 643 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables 644 INTEGER , POINTER, DIMENSION(:) :: itest 645 646 CALL wrk_alloc( 4, itest ) 647 !-------------------------------------------------------------------- 648 ! initialisation of variables 649 !-------------------------------------------------------------------- 650 ijpij = SIZE(zhti,1) 651 zht_i(1:ijpij,1:jpl) = 0._wp 652 zht_s(1:ijpij,1:jpl) = 0._wp 653 za_i (1:ijpij,1:jpl) = 0._wp 654 655 ! ---------------------------------------- 656 ! distribution over the jpl ice categories 657 ! ---------------------------------------- 658 DO ji = 1, ijpij 659 660 IF( zhti(ji) > 0._wp ) THEN 661 662 ! initialisation of tests 663 itest(:) = 0 664 665 i_fill = jpl + 1 !==================================== 666 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 667 ! iteration !==================================== 668 i_fill = i_fill - 1 669 670 ! initialisation of ice variables for each try 671 zht_i(ji,1:jpl) = 0._wp 672 za_i (ji,1:jpl) = 0._wp 673 674 ! *** case very thin ice: fill only category 1 675 IF ( i_fill == 1 ) THEN 676 zht_i(ji,1) = zhti(ji) 677 za_i (ji,1) = zai (ji) 678 679 ! *** case ice is thicker: fill categories >1 680 ELSE 681 682 ! Fill ice thicknesses except the last one (i_fill) by hmean 683 DO jl = 1, i_fill - 1 684 zht_i(ji,jl) = hi_mean(jl) 685 END DO 686 687 ! find which category (jl0) the input ice thickness falls into 688 jl0 = i_fill 689 DO jl = 1, i_fill 690 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 691 jl0 = jl 692 CYCLE 693 ENDIF 694 END DO 695 696 ! Concentrations in the (i_fill-1) categories 697 za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 698 DO jl = 1, i_fill - 1 699 IF ( jl == jl0 ) CYCLE 700 zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 701 za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2) 702 END DO 703 704 ! Concentration in the last (i_fill) category 705 za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 706 707 ! Ice thickness in the last (i_fill) category 708 zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 709 zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill) 710 711 ENDIF ! case ice is thick or thin 712 713 !--------------------- 714 ! Compatibility tests 715 !--------------------- 716 ! Test 1: area conservation 717 zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 718 IF ( zconv < epsi06 ) itest(1) = 1 719 720 ! Test 2: volume conservation 721 zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 722 IF ( zconv < epsi06 ) itest(2) = 1 723 724 ! Test 3: thickness of the last category is in-bounds ? 725 IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 726 727 ! Test 4: positivity of ice concentrations 728 itest(4) = 1 729 DO jl = 1, i_fill 730 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 731 END DO 732 !============================ 733 END DO ! end iteration on categories 734 !============================ 735 ENDIF ! if zhti > 0 736 END DO ! i loop 737 738 ! ------------------------------------------------ 739 ! Adding Snow in each category where za_i is not 0 740 ! ------------------------------------------------ 741 DO jl = 1, jpl 742 DO ji = 1, ijpij 743 IF( za_i(ji,jl) > 0._wp ) THEN 744 zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) ) 745 ! In case snow load is in excess that would lead to transformation from snow to ice 746 ! Then, transfer the snow excess into the ice (different from limthd_dh) 747 zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 ) 748 ! recompute ht_i, ht_s avoiding out of bounds values 749 zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh ) 750 zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn ) 751 ENDIF 752 ENDDO 753 ENDDO 754 755 CALL wrk_dealloc( 4, itest ) 756 ! 757 END SUBROUTINE lim_var_itd 758 526 759 527 760 #else … … 542 775 SUBROUTINE lim_var_salprof1d ! Emtpy routines 543 776 END SUBROUTINE lim_var_salprof1d 777 SUBROUTINE lim_var_zapsmall 778 END SUBROUTINE lim_var_zapsmall 779 SUBROUTINE lim_var_itd 780 END SUBROUTINE lim_var_itd 544 781 #endif 545 782 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r4990 r5123 24 24 USE lib_mpp ! MPP library 25 25 USE wrk_nemo ! work arrays 26 USE par_ice27 26 USE iom 28 27 USE timing ! Timing … … 107 106 DO jj = 2 , jpjm1 108 107 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_wp110 z2db(ji,jj) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp108 z2da(ji,jj) = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 109 z2db(ji,jj) = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 111 110 END DO 112 111 END DO … … 139 138 DO jj = 1, jpj 140 139 DO ji = 1, jpi 141 z2d(ji,jj) = ( tm_i(ji,jj) - rt t) * zswi(ji,jj)140 z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 142 141 END DO 143 142 END DO … … 150 149 DO jj = 1, jpj 151 150 DO ji = 1, jpi 152 z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt t) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )151 z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 153 152 END DO 154 153 END DO … … 186 185 CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport 187 186 CALL iom_put( "snwtrp" , diag_trp_vs * rday ) ! snw volume transport 187 CALL iom_put( "saltrp" , diag_trp_smv * rday * rhoic ) ! salt content transport 188 188 CALL iom_put( "deitrp" , diag_trp_ei ) ! advected ice enthalpy (W/m2) 189 189 CALL iom_put( "destrp" , diag_trp_es ) ! advected snw enthalpy (W/m2) … … 200 200 201 201 ztmp = rday / rhoic 202 CALL iom_put( "vfxres" , wfx_res * ztmp ) ! daily prod./melting due to limupdate 203 CALL iom_put( "vfxopw" , wfx_opw * ztmp ) ! daily lateral thermodynamic ice production 204 CALL iom_put( "vfxsni" , wfx_sni * ztmp ) ! daily snowice ice production 205 CALL iom_put( "vfxbog" , wfx_bog * ztmp ) ! daily bottom thermodynamic ice production 206 CALL iom_put( "vfxdyn" , wfx_dyn * ztmp ) ! daily dynamic ice production (rid/raft) 207 CALL iom_put( "vfxsum" , wfx_sum * ztmp ) ! surface melt 208 CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt 209 CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt 210 CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt 211 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow) 212 CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow) 213 214 CALL iom_put ('hfxthd', hfx_thd(:,:) ) ! 215 CALL iom_put ('hfxdyn', hfx_dyn(:,:) ) ! 216 CALL iom_put ('hfxres', hfx_res(:,:) ) ! 217 CALL iom_put ('hfxout', hfx_out(:,:) ) ! 218 CALL iom_put ('hfxin' , hfx_in(:,:) ) ! 219 CALL iom_put ('hfxsnw', hfx_snw(:,:) ) ! 220 CALL iom_put ('hfxsub', hfx_sub(:,:) ) ! 221 CALL iom_put ('hfxerr', hfx_err(:,:) ) ! 222 CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) ) ! 223 224 CALL iom_put ('hfxsum', hfx_sum(:,:) ) ! 225 CALL iom_put ('hfxbom', hfx_bom(:,:) ) ! 226 CALL iom_put ('hfxbog', hfx_bog(:,:) ) ! 227 CALL iom_put ('hfxdif', hfx_dif(:,:) ) ! 228 CALL iom_put ('hfxopw', hfx_opw(:,:) ) ! 229 CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base 230 CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) ) ! Heat content variation in snow and ice 231 CALL iom_put ('hfxspr', hfx_spr(:,:) ) ! Heat content of snow precip 202 CALL iom_put( "vfxres" , wfx_res * ztmp ) ! daily prod./melting due to limupdate 203 CALL iom_put( "vfxopw" , wfx_opw * ztmp ) ! daily lateral thermodynamic ice production 204 CALL iom_put( "vfxsni" , wfx_sni * ztmp ) ! daily snowice ice production 205 CALL iom_put( "vfxbog" , wfx_bog * ztmp ) ! daily bottom thermodynamic ice production 206 CALL iom_put( "vfxdyn" , wfx_dyn * ztmp ) ! daily dynamic ice production (rid/raft) 207 CALL iom_put( "vfxsum" , wfx_sum * ztmp ) ! surface melt 208 CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt 209 CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt 210 CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt 211 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow) 212 CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow) 213 214 CALL iom_put( "afxtot" , afx_tot * rday ) ! concentration tendency (total) 215 CALL iom_put( "afxdyn" , afx_dyn * rday ) ! concentration tendency (dynamics) 216 CALL iom_put( "afxthd" , afx_thd * rday ) ! concentration tendency (thermo) 217 218 CALL iom_put ('hfxthd' , hfx_thd(:,:) ) ! 219 CALL iom_put ('hfxdyn' , hfx_dyn(:,:) ) ! 220 CALL iom_put ('hfxres' , hfx_res(:,:) ) ! 221 CALL iom_put ('hfxout' , hfx_out(:,:) ) ! 222 CALL iom_put ('hfxin' , hfx_in(:,:) ) ! 223 CALL iom_put ('hfxsnw' , hfx_snw(:,:) ) ! 224 CALL iom_put ('hfxsub' , hfx_sub(:,:) ) ! 225 CALL iom_put ('hfxerr' , hfx_err(:,:) ) ! 226 CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:) ) ! 227 228 CALL iom_put ('hfxsum' , hfx_sum(:,:) ) ! 229 CALL iom_put ('hfxbom' , hfx_bom(:,:) ) ! 230 CALL iom_put ('hfxbog' , hfx_bog(:,:) ) ! 231 CALL iom_put ('hfxdif' , hfx_dif(:,:) ) ! 232 CALL iom_put ('hfxopw' , hfx_opw(:,:) ) ! 233 CALL iom_put ('hfxtur' , fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base 234 CALL iom_put ('hfxdhc' , diag_heat_dhc(:,:) ) ! Heat content variation in snow and ice 235 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip 232 236 233 237 !-------------------------------- … … 261 265 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 262 266 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 263 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt t), - epsi06 ) ) * &264 rswitch /nlay_i267 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 268 rswitch * r1_nlay_i 265 269 END DO 266 270 END DO … … 348 352 CALL histwrite( kid, "iicethic", kt, icethi , jpi*jpj, (/1/) ) 349 353 CALL histwrite( kid, "iiceconc", kt, at_i , jpi*jpj, (/1/) ) 350 CALL histwrite( kid, "iicetemp", kt, tm_i - rt t, jpi*jpj, (/1/) )354 CALL histwrite( kid, "iicetemp", kt, tm_i - rt0 , jpi*jpj, (/1/) ) 351 355 CALL histwrite( kid, "iicevelu", kt, u_ice , jpi*jpj, (/1/) ) 352 356 CALL histwrite( kid, "iicevelv", kt, v_ice , jpi*jpj, (/1/) ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
r4688 r5123 92 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 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )94 ztmu = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) ) 95 95 zcmo(ji,jj,1) = ht_s (ji,jj,1) 96 96 zcmo(ji,jj,2) = ht_i (ji,jj,1) … … 99 99 zcmo(ji,jj,5) = sist (ji,jj) 100 100 zcmo(ji,jj,6) = fhtur (ji,jj) 101 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj) &102 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &101 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * umask(ji,jj,1) + u_ice(ji+1,jj ) * umask(ji+1,jj,1) & 102 + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 103 103 / ztmu 104 104 105 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj) &106 + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &105 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * umask(ji,jj,1) + v_ice(ji+1,jj ) * umask(ji+1,jj,1) & 106 + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 107 107 / ztmu 108 108 zcmo(ji,jj,9) = sst_m(ji,jj) … … 135 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 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )137 ztmu = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) ) 138 138 rcmoy(ji,jj,1) = ht_s (ji,jj,1) 139 139 rcmoy(ji,jj,2) = ht_i (ji,jj,1) … … 142 142 rcmoy(ji,jj,5) = sist (ji,jj) 143 143 rcmoy(ji,jj,6) = fhtur (ji,jj) 144 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj) &145 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &144 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * umask(ji,jj,1) + u_ice(ji+1,jj ) * umask(ji+1,jj,1) & 145 + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 146 146 / ztmu 147 147 148 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj) &149 + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &148 rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * umask(ji,jj,1) + v_ice(ji+1,jj ) * umask(ji+1,jj,1) & 149 + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) & 150 150 / ztmu 151 151 rcmoy(ji,jj,9) = sst_m(ji,jj) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r4990 r5123 6 6 !! History : 3.0 ! 2002-11 (C. Ethe) F90: Free form and module 7 7 !!---------------------------------------------------------------------- 8 USE par_ice ! LIM-3 parameters9 8 USE in_out_manager ! I/O manager 10 9 USE lib_mpp ! MPP library 10 USE ice, ONLY : nlay_i, nlay_s 11 11 12 12 IMPLICIT NONE … … 19 19 !!--------------------------- 20 20 ! !!! ** ice-thermo namelist (namicethd) ** 21 REAL(wp), PUBLIC :: hmelt !: maximum melting at the bottom; active only for one category 22 REAL(wp), PUBLIC :: hiclim !: minimum ice thickness 23 REAL(wp), PUBLIC :: hnzst !: thick. of the surf. layer in temp. comp. 21 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness 24 22 REAL(wp), PUBLIC :: parsub !: switch for snow sublimation or not 25 REAL(wp), PUBLIC :: maxfrazb!: maximum portion of frazil ice collecting at the ice bottom26 REAL(wp), PUBLIC :: vfrazb!: threshold drift speed for collection of bottom frazil ice27 REAL(wp), PUBLIC :: Cfrazb!: squeezing coefficient for collection of bottom frazil ice28 REAL(wp), PUBLIC :: hiccrit !: ice th. for lateral accretion in the NH (SH)(m)23 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 24 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice 25 REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice 26 REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m) 29 27 30 INTEGER , PUBLIC :: fraz_swi !: use of frazil ice collection in function of wind (1) or not (0)28 LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F) 31 29 32 30 !!----------------------------- … … 37 35 !: are the variables corresponding to 2d vectors 38 36 39 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npb !: number of points where computations has to be done 40 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: correspondance between points (lateral accretion) 37 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npb !: address vector for 1d vertical thermo computations 38 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nplm !: address vector for mono-category lateral melting 39 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: address vector for new ice formation 41 40 42 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlead_1d … … 140 139 !!---------------------------------------------------------------------! 141 140 142 ALLOCATE( npb (jpij) , np ac (jpij),&141 ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij), & 143 142 ! ! 144 143 & qlead_1d (jpij) , ftr_ice_1d (jpij) , & … … 167 166 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 168 167 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , & 169 & dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 168 & dh_snowice(jpij) , & 169 & sm_i_1d (jpij) , s_i_new (jpij) , & 170 170 & t_s_1d(jpij,nlay_s), & 171 171 & t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1) , & -
trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r4689 r5123 33 33 USE ice_2 34 34 #elif defined key_lim3 35 USE par_ice36 35 USE ice 37 USE lim cat_1D! redistribute ice input into categories36 USE limvar ! redistribute ice input into categories 38 37 #endif 39 38 USE sbcapr … … 380 379 #if defined key_lim3 381 380 IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type) 382 CALL lim_ cat_1D( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &381 CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 383 382 & dta_bdy(ib_bdy)%ht_i, dta_bdy(ib_bdy)%ht_s, dta_bdy(ib_bdy)%a_i ) 384 383 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r4990 r5123 26 26 USE dom_ice_2 ! sea-ice domain 27 27 #elif defined key_lim3 28 USE par_ice29 28 USE ice ! LIM_3 ice variables 30 29 USE dom_ice ! sea-ice domain … … 60 59 !!---------------------------------------------------------------------- 61 60 INTEGER, INTENT( in ) :: kt ! Main time step counter 62 !!63 61 INTEGER :: ib_bdy ! Loop index 62 64 63 DO ib_bdy=1, nb_bdy 65 64 … … 72 71 CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 73 72 END SELECT 74 ENDDO 73 74 END DO 75 75 76 76 END SUBROUTINE bdy_ice_lim … … 194 194 t_su(ji,jj,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy) 195 195 DO jk = 1, nlay_s 196 t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt t196 t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 197 197 END DO 198 198 DO jk = 1, nlay_i 199 t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt t199 t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 200 200 s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min 201 201 END DO … … 206 206 sm_i(ji,jj,jl) = rswitch * sm_i(ii,ij,jl) + ( 1.0 - rswitch ) * s_i_min 207 207 o_i(ji,jj,jl) = rswitch * o_i(ii,ij,jl) + ( 1.0 - rswitch ) 208 t_su(ji,jj,jl) = rswitch * t_su(ii,ij,jl) + ( 1.0 - rswitch ) * rt t208 t_su(ji,jj,jl) = rswitch * t_su(ii,ij,jl) + ( 1.0 - rswitch ) * rt0 209 209 DO jk = 1, nlay_s 210 t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt t210 t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 211 211 END DO 212 212 DO jk = 1, nlay_i 213 t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt t213 t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 214 214 s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * s_i_min 215 215 END DO … … 228 228 DO jk = 1, nlay_s 229 229 ! Snow energy of melting 230 e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 231 ! Change dimensions 232 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 233 ! Multiply by volume, so that heat content in 10^9 Joules 234 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 230 e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 231 ! Multiply by volume, so that heat content in J/m2 232 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 235 233 END DO 236 234 DO jk = 1, nlay_i 237 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rt t!Melting temperature in K235 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 238 236 ! heat content per unit volume 239 237 e_i(ji,jj,jk,jl) = rswitch * rhoic * & 240 238 ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) & 241 + lfus * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 242 - rcp * ( ztmelts - rtt ) ) 243 ! Correct dimensions to avoid big values 244 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 245 ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 246 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / nlay_i 239 + lfus * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 240 - rcp * ( ztmelts - rt0 ) ) 241 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 242 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 247 243 END DO 248 244 249 250 END DO !jb 245 END DO 251 246 252 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) ! lateral boundary conditions247 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 253 248 CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy ) 254 249 CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r5120 r5123 162 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 163 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !: 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factorsat t-point (m)165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factorsat u-point (m)166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factorsat v-point (m)167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factorsat f-point (m)164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t, r1_e1t, r1_e2t !: horizontal scale factors and inverse at t-point (m) 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, e2u, r1_e1u, r1_e2u !: horizontal scale factors and inverse at u-point (m) 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, e2v, r1_e1v, r1_e2v !: horizontal scale factors and inverse at v-point (m) 167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f, r1_e1f, r1_e2f !: horizontal scale factors and inverse at f-point (m) 168 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t !: surface at t-point (m2) 169 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) … … 346 346 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(2) ) 347 347 ! 348 ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , & 349 & glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , & 350 & glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) , & 351 & glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff (jpi,jpj) , STAT=ierr(3) ) 348 ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) , & 349 & glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) , & 350 & glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) , & 351 & glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) , & 352 & e1e2t(jpi,jpj) , ff (jpi,jpj) , STAT=ierr(3) ) 352 353 ! 353 354 ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) , & -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5118 r5123 471 471 re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 472 472 re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 473 r1_e1t (:,:) = 1._wp / e1t(:,:) 474 r1_e1u (:,:) = 1._wp / e1u(:,:) 475 r1_e1v (:,:) = 1._wp / e1v(:,:) 476 r1_e1f (:,:) = 1._wp / e1f(:,:) 477 r1_e2t (:,:) = 1._wp / e2t(:,:) 478 r1_e2u (:,:) = 1._wp / e2u(:,:) 479 r1_e2v (:,:) = 1._wp / e2v(:,:) 480 r1_e2f (:,:) = 1._wp / e2f(:,:) 473 481 474 482 ! Control printing : Grid informations (if not restart) -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r4990 r5123 41 41 REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin] 42 42 #if defined key_lim3 43 REAL(wp), PUBLIC :: rt0_snow = 273.1 6_wp !: melting point of snow [Kelvin]44 REAL(wp), PUBLIC :: rt0_ice = 273.1 6_wp !: melting point of ice [Kelvin]43 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin] 44 REAL(wp), PUBLIC :: rt0_ice = 273.15_wp !: melting point of ice [Kelvin] 45 45 #else 46 46 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin] … … 82 82 REAL(wp), PUBLIC :: xlic = 300.33e+6_wp !: volumetric latent heat fusion of ice [J/m3] 83 83 REAL(wp), PUBLIC :: xsn = 2.8e+6_wp !: volumetric latent heat of sublimation of snow [J/m3] 84 #endif 85 #if defined key_lim3 86 REAL(wp), PUBLIC :: r1_rhoic !: 1 / rhoic 87 REAL(wp), PUBLIC :: r1_rhosn !: 1 / rhosn 84 88 #endif 85 89 !!---------------------------------------------------------------------- … … 166 170 lfus = xlsn / rhosn ! latent heat of fusion of fresh ice 167 171 #endif 168 172 #if defined key_lim3 173 r1_rhoic = 1._wp / rhoic 174 r1_rhosn = 1._wp / rhosn 175 #endif 169 176 IF(lwp) THEN 170 177 WRITE(numout,*) -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5118 r5123 33 33 USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes 34 34 #if defined key_lim3 35 USE par_ice35 USE ice , ONLY : jpl 36 36 #elif defined key_lim2 37 37 USE par_ice_2 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5009 r5123 16 16 USE sbc_oce ! surface boundary condition: ocean 17 17 # if defined key_lim3 18 USE par_ice! LIM-3 parameters18 USE ice ! LIM-3 parameters 19 19 # endif 20 20 # if defined key_lim2 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5009 r5123 24 24 USE phycst ! physical constants 25 25 #if defined key_lim3 26 USE par_ice ! ice parameters27 26 USE ice ! ice variables 28 27 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r4990 r5123 19 19 !!---------------------------------------------------------------------- 20 20 !! sbc_ice_lim : sea-ice model time-stepping and update ocean sbc over ice-covered area 21 !! lim_ctl : alerts in case of ice model crash22 !! lim_prt_state : ice control print at a given grid point23 21 !!---------------------------------------------------------------------- 24 22 USE oce ! ocean dynamics and tracers 25 23 USE dom_oce ! ocean space and time domain 26 USE par_ice ! sea-ice parameters27 24 USE ice ! LIM-3: ice variables 28 USE iceini ! LIM-3: ice initialisation25 USE thd_ice ! LIM-3: thermodynamical variables 29 26 USE dom_ice ! LIM-3: ice domain 30 27 … … 41 38 USE limtrp ! Ice transport 42 39 USE limthd ! Ice thermodynamics 43 USE limitd_th ! Thermodynamics on ice thickness distribution44 40 USE limitd_me ! Mechanics on ice thickness distribution 45 41 USE limsbc ! sea surface boundary condition … … 47 43 USE limwri ! Ice outputs 48 44 USE limrst ! Ice restarts 49 USE limupdate1 50 USE limupdate2 45 USE limupdate1 ! update of global variables 46 USE limupdate2 ! update of global variables 51 47 USE limvar ! Ice variables switch 48 49 USE limmsh ! LIM mesh 50 USE limistate ! LIM initial state 51 USE limthd_sal ! LIM ice thermodynamics: salinity 52 52 53 53 USE c1d ! 1D vertical configuration … … 60 60 USE prtctl ! Print control 61 61 USE lib_fortran ! 62 USE limctl 62 63 63 64 #if defined key_bdy … … 69 70 70 71 PUBLIC sbc_ice_lim ! routine called by sbcmod.F90 71 PUBLIC lim_prt_state72 PUBLIC sbc_lim_init ! routine called by sbcmod.F90 72 73 73 74 !! * Substitutions … … 106 107 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 107 108 !! 108 INTEGER :: jl ! dummy loop index 109 REAL(wp) :: zcoef ! local scalar 109 INTEGER :: jl ! dummy loop index 110 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 111 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled) … … 114 114 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 115 115 116 IF( kt == nit000 ) THEN 117 IF(lwp) WRITE(numout,*) 118 IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 119 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 120 ! 121 CALL ice_init 122 ! 123 IF( ln_nicep ) THEN ! control print at a given point 124 jiindx = 15 ; jjindx = 44 125 IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 126 ENDIF 127 ENDIF 128 129 ! !----------------------! 130 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only ! 131 ! !----------------------! 132 ! ! Bulk Formulae ! 133 ! !----------------! 134 ! 135 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point 136 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) ! (C-grid dynamics : U- & V-points as the ocean) 137 ! 138 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) ! masked sea surface freezing temperature [Kelvin] 139 ! ! (set to rt0 over land) 140 ! ! Ice albedo 141 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 142 116 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only 117 !-----------------------! 118 ! --- Bulk Formulae --- ! 119 !-----------------------! 120 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point 121 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) ! (C-grid dynamics : U- & V-points as the ocean) 122 123 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 124 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 125 ! 126 ! Ice albedo 127 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 143 128 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 144 129 130 ! CORE and COUPLED bulk formulations 145 131 SELECT CASE( kblk ) 146 CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations132 CASE( jp_core , jp_cpl ) 147 133 148 134 ! albedo depends on cloud fraction because of non-linear spectral effects … … 153 139 END SELECT 154 140 155 ! ! Mask sea ice surface temperature141 ! Mask sea ice surface temperature (set to rt0 over land) 156 142 DO jl = 1, jpl 157 t_su(:,:,jl) = t_su(:,:,jl) + rt0 * ( 1.- tmask(:,:,1) )143 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 158 144 END DO 159 145 … … 191 177 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 192 178 193 ! MV -> seb194 ! CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su )195 196 ! IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , &197 ! & dqns_ice, qla_ice, dqla_ice, nn_limflx )198 ! ! Latent heat flux is forced to 0 in coupled :199 ! ! it is included in qns (non-solar heat flux)200 ! qla_ice (:,:,:) = 0._wp201 ! dqla_ice (:,:,:) = 0._wp202 ! END MV -> seb203 !204 179 END SELECT 205 180 206 ! !----------------------! 207 ! ! LIM-3 time-stepping ! 208 ! !----------------------! 209 ! 181 !------------------------------! 182 ! --- LIM-3 main time-step --- ! 183 !------------------------------! 210 184 numit = numit + nn_fsbc ! Ice model time step 211 ! 212 ! ! Store previous ice values 213 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 214 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 215 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 216 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 217 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 218 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 219 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 220 u_ice_b(:,:) = u_ice(:,:) 221 v_ice_b(:,:) = v_ice(:,:) 222 223 ! salt, heat and mass fluxes 224 sfx (:,:) = 0._wp ; 225 sfx_bri(:,:) = 0._wp ; 226 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 227 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 228 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 229 sfx_res(:,:) = 0._wp 230 231 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 232 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 233 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 234 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 235 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 236 wfx_spr(:,:) = 0._wp ; 237 238 hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp 239 hfx_thd(:,:) = 0._wp ; 240 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 241 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 242 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 243 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 244 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 245 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 246 247 CALL lim_rst_opn( kt ) ! Open Ice restart file 248 ! 249 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print 185 ! 186 CALL sbc_lim_update ! Store previous ice values 187 188 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 189 190 CALL lim_rst_opn( kt ) ! Open Ice restart file 191 ! 250 192 ! ---------------------------------------------- 251 193 ! ice dynamics and transport (except in 1D case) 252 194 ! ---------------------------------------------- 253 195 IF( .NOT. lk_c1d ) THEN 254 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 255 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 256 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 257 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' ) ! control print 258 CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 259 CALL lim_var_agg( 1 ) 196 197 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 198 199 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 200 201 IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 202 260 203 #if defined key_bdy 261 ! bdy ice thermo 262 CALL lim_var_glo2eqv ! equivalent variables 263 CALL bdy_ice_lim( kt ) 264 CALL lim_itd_me_zapsmall 265 CALL lim_var_agg(1) 266 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' ) ! control print 204 CALL lim_var_glo2eqv 205 CALL bdy_ice_lim( kt ) ! bdy ice thermo 206 CALL lim_var_zapsmall 207 CALL lim_var_agg(1) 208 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' ) 267 209 #endif 268 CALL lim_update1 210 CALL lim_update1( kt ) 211 269 212 ENDIF 270 ! !- Change old values for new values 271 u_ice_b(:,:) = u_ice(:,:) 272 v_ice_b(:,:) = v_ice(:,:) 273 a_i_b (:,:,:) = a_i (:,:,:) 274 v_s_b (:,:,:) = v_s (:,:,:) 275 v_i_b (:,:,:) = v_i (:,:,:) 276 e_s_b (:,:,:,:) = e_s (:,:,:,:) 277 e_i_b (:,:,:,:) = e_i (:,:,:,:) 278 oa_i_b (:,:,:) = oa_i (:,:,:) 279 smv_i_b(:,:,:) = smv_i(:,:,:) 213 214 CALL sbc_lim_update ! Store previous ice values 280 215 281 216 ! ---------------------------------------------- 282 ! ice thermodynamic 217 ! ice thermodynamics 283 218 ! ---------------------------------------------- 284 CALL lim_var_glo2eqv ! equivalent variables 285 CALL lim_var_agg(1) ! aggregate ice categories 286 ! previous lead fraction and ice volume for flux calculations 287 pfrld(:,:) = 1._wp - at_i(:,:) 288 phicif(:,:) = vt_i(:,:) 289 290 ! MV -> seb 291 SELECT CASE( kblk ) 292 CASE ( jp_cpl ) 293 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 294 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 295 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 296 ! Latent heat flux is forced to 0 in coupled : 297 ! it is included in qns (non-solar heat flux) 298 qla_ice (:,:,:) = 0._wp 299 dqla_ice (:,:,:) = 0._wp 300 END SELECT 301 ! END MV -> seb 302 ! 303 CALL lim_var_bv ! bulk brine volume (diag) 304 CALL lim_thd( kt ) ! Ice thermodynamics 305 zcoef = rdt_ice /rday ! Ice natural aging 306 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 307 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print 308 CALL lim_itd_th( kt ) ! Remap ice categories, lateral accretion ! 309 CALL lim_var_agg( 1 ) ! requested by limupdate 310 CALL lim_update2 ! Global variables update 311 312 CALL lim_var_glo2eqv ! equivalent variables (outputs) 313 CALL lim_var_agg(2) ! aggregate ice thickness categories 314 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 2, ' - Final state - ' ) ! control print 315 ! 316 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 317 ! 318 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' ) ! control print 319 ! 320 ! ! Diagnostics and outputs 321 IF (ln_limdiaout) CALL lim_diahsb 322 323 CALL lim_wri( 1 ) ! Ice outputs 324 219 CALL lim_var_glo2eqv 220 CALL lim_var_agg(1) 221 222 ! previous lead fraction and ice volume for flux calculations 223 pfrld(:,:) = 1._wp - at_i(:,:) 224 phicif(:,:) = vt_i(:,:) 225 226 SELECT CASE( kblk ) 227 CASE ( jp_cpl ) 228 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 229 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 230 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 231 ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 232 qla_ice (:,:,:) = 0._wp 233 dqla_ice (:,:,:) = 0._wp 234 END SELECT 235 ! 236 CALL lim_thd( kt ) ! Ice thermodynamics 237 238 CALL lim_update2( kt ) ! Corrections 239 ! 240 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 241 ! 242 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 243 244 CALL lim_wri( 1 ) ! Ice outputs 245 325 246 IF( kt == nit000 .AND. ln_rstart ) & 326 & CALL iom_close( numrir ) ! clem:close input ice restart file327 ! 328 IF( lrst_ice ) CALL lim_rst_write( kt ) 329 CALL lim_var_glo2eqv! ???330 ! 331 IF( ln_nicep ) CALL lim_ctl( kt ) 247 & CALL iom_close( numrir ) ! close input ice restart file 248 ! 249 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 250 CALL lim_var_glo2eqv ! ??? 251 ! 252 IF( ln_nicep ) CALL lim_ctl( kt ) ! alerts in case of model crash 332 253 ! 333 254 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 334 255 ! 335 ENDIF ! End sea-ice time step only 336 337 ! !--------------------------! 338 ! ! at all ocean time step ! 339 ! !--------------------------! 340 ! 341 ! ! Update surface ocean stresses (only in ice-dynamic case) 342 ! ! otherwise the atm.-ocean stresses are used everywhere 256 ENDIF ! End sea-ice time step only 257 258 !--------------------------------! 259 ! --- at all ocean time step --- ! 260 !--------------------------------! 261 ! Update surface ocean stresses (only in ice-dynamic case) 262 ! otherwise the atm.-ocean stresses are used everywhere 343 263 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 344 264 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 345 346 265 ! 347 266 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') … … 349 268 END SUBROUTINE sbc_ice_lim 350 269 270 271 SUBROUTINE sbc_lim_init 272 !!---------------------------------------------------------------------- 273 !! *** ROUTINE sbc_lim_init *** 274 !! 275 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 276 !!---------------------------------------------------------------------- 277 INTEGER :: ierr 278 !!---------------------------------------------------------------------- 279 IF(lwp) WRITE(numout,*) 280 IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 281 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 282 ! 283 ! Open the reference and configuration namelist files and namelist output file 284 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 285 CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 286 IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 287 288 CALL ice_run ! set some ice run parameters 289 ! 290 ! ! Allocate the ice arrays 291 ierr = ice_alloc () ! ice variables 292 ierr = ierr + dom_ice_alloc () ! domain 293 ierr = ierr + sbc_ice_alloc () ! surface forcing 294 ierr = ierr + thd_ice_alloc () ! thermodynamics 295 ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics 296 ! 297 IF( lk_mpp ) CALL mpp_sum( ierr ) 298 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays') 299 ! 300 ! ! adequation jpk versus ice/snow layers/categories 301 IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) & 302 & CALL ctl_stop( 'STOP', & 303 & 'sbc_lim_init: the 3rd dimension of workspace arrays is too small.', & 304 & 'use more ocean levels or less ice/snow layers/categories.' ) 305 ! 306 CALL lim_itd_init ! ice thickness distribution initialization 307 ! 308 CALL lim_thd_init ! set ice thermodynics parameters 309 ! 310 CALL lim_thd_sal_init ! set ice salinity parameters 311 ! 312 CALL lim_msh ! ice mesh initialization 313 ! 314 CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation 315 ! ! Initial sea-ice state 316 IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst 317 numit = 0 318 numit = nit000 - 1 319 CALL lim_istate 320 ELSE ! start from a restart file 321 CALL lim_rst_read 322 numit = nit000 - 1 323 ENDIF 324 CALL lim_var_agg(1) 325 CALL lim_var_glo2eqv 326 ! 327 CALL lim_sbc_init ! ice surface boundary condition 328 ! 329 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction 330 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 331 ! 332 nstart = numit + nn_fsbc 333 nitrun = nitend - nit000 + 1 334 nlast = numit + nitrun 335 ! 336 IF( nstock == 0 ) nstock = nlast + 1 337 ! 338 END SUBROUTINE sbc_lim_init 339 340 341 SUBROUTINE ice_run 342 !!------------------------------------------------------------------- 343 !! *** ROUTINE ice_run *** 344 !! 345 !! ** Purpose : Definition some run parameter for ice model 346 !! 347 !! ** Method : Read the namicerun namelist and check the parameter 348 !! values called at the first timestep (nit000) 349 !! 350 !! ** input : Namelist namicerun 351 !!------------------------------------------------------------------- 352 INTEGER :: ios ! Local integer output status for namelist read 353 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_out, & 354 & ln_limdyn, rn_amax, ln_nicep, ln_limdiahsb, ln_limdiaout 355 !!------------------------------------------------------------------- 356 ! 357 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 358 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 359 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 360 361 REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice 362 READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 363 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 364 IF(lwm) WRITE ( numoni, namicerun ) 365 ! 366 ! 367 IF(lwp) THEN ! control print 368 WRITE(numout,*) 369 WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 370 WRITE(numout,*) ' ~~~~~~' 371 WRITE(numout,*) ' number of ice categories = ', jpl 372 WRITE(numout,*) ' number of ice layers = ', nlay_i 373 WRITE(numout,*) ' number of snow layers = ', nlay_s 374 WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn 375 WRITE(numout,*) ' maximum ice concentration = ', rn_amax 376 WRITE(numout,*) ' Several ice points in the ice or not in ocean.output = ', ln_nicep 377 WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb 378 WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout 379 ENDIF 380 ! 381 !IF( lk_mpp .AND. ln_nicep ) THEN 382 ! ln_nicep = .FALSE. 383 ! CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' ) 384 !ENDIF 385 IF( ln_nicep ) THEN ! control print at a given point 386 jiindx = 15 ; jjindx = 44 387 IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 388 ENDIF 389 ! 390 ! sea-ice timestep and inverse 391 rdt_ice = nn_fsbc * rdttra(1) 392 r1_rdtice = 1._wp / rdt_ice 393 394 ! inverse of nlay_i and nlay_s 395 r1_nlay_i = 1._wp / REAL( nlay_i, wp ) 396 r1_nlay_s = 1._wp / REAL( nlay_s, wp ) 397 ! 398 END SUBROUTINE ice_run 399 400 401 SUBROUTINE lim_itd_init 402 !!------------------------------------------------------------------ 403 !! *** ROUTINE lim_itd_init *** 404 !! 405 !! ** Purpose : Initializes the ice thickness distribution 406 !! ** Method : ... 407 !! ** input : Namelist namiceitd 408 !!------------------------------------------------------------------- 409 INTEGER :: ios ! Local integer output status for namelist read 410 NAMELIST/namiceitd/ nn_catbnd, rn_himean 411 ! 412 INTEGER :: jl ! dummy loop index 413 REAL(wp) :: zc1, zc2, zc3, zx1 ! local scalars 414 REAL(wp) :: zhmax, znum, zden, zalpha ! 415 !!------------------------------------------------------------------ 416 ! 417 REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice 418 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 419 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 420 421 REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice 422 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 423 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 424 IF(lwm) WRITE ( numoni, namiceitd ) 425 ! 426 ! 427 IF(lwp) THEN ! control print 428 WRITE(numout,*) 429 WRITE(numout,*) 'ice_itd : ice cat distribution' 430 WRITE(numout,*) ' ~~~~~~' 431 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 432 WRITE(numout,*) ' mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 433 ENDIF 434 435 !---------------------------------- 436 !- Thickness categories boundaries 437 !---------------------------------- 438 IF(lwp) WRITE(numout,*) 439 IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 440 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 441 442 hi_max(:) = 0._wp 443 444 SELECT CASE ( nn_catbnd ) 445 !---------------------- 446 CASE (1) ! tanh function (CICE) 447 !---------------------- 448 zc1 = 3._wp / REAL( jpl, wp ) 449 zc2 = 10._wp * zc1 450 zc3 = 3._wp 451 452 DO jl = 1, jpl 453 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 454 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 455 END DO 456 457 !---------------------- 458 CASE (2) ! h^(-alpha) function 459 !---------------------- 460 zalpha = 0.05 ! exponent of the transform function 461 462 zhmax = 3.*rn_himean 463 464 DO jl = 1, jpl 465 znum = jpl * ( zhmax+1 )**zalpha 466 zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl 467 hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 468 END DO 469 470 END SELECT 471 472 DO jl = 1, jpl 473 hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 474 END DO 475 476 ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) 477 hi_max(jpl) = 99._wp 478 479 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 480 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 481 ! 482 END SUBROUTINE lim_itd_init 483 351 484 352 485 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, & 353 486 & pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 354 487 !!--------------------------------------------------------------------- 355 !! *** ROUTINE sbc_ice_lim***488 !! *** ROUTINE ice_lim_flx *** 356 489 !! 357 490 !! ** Purpose : update the ice surface boundary condition by averaging and / or … … 428 561 ! 429 562 END SUBROUTINE ice_lim_flx 430 431 432 SUBROUTINE lim_ctl( kt ) 433 !!----------------------------------------------------------------------- 434 !! *** ROUTINE lim_ctl *** 435 !! 436 !! ** Purpose : Alerts in case of model crash 437 !!------------------------------------------------------------------- 438 INTEGER, INTENT(in) :: kt ! ocean time step 439 INTEGER :: ji, jj, jk, jl ! dummy loop indices 440 INTEGER :: inb_altests ! number of alert tests (max 20) 441 INTEGER :: ialert_id ! number of the current alert 442 REAL(wp) :: ztmelts ! ice layer melting point 443 CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert 444 INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive 445 !!------------------------------------------------------------------- 446 447 inb_altests = 10 448 inb_alp(:) = 0 449 450 ! Alert if incompatible volume and concentration 451 ialert_id = 2 ! reference number of this alert 452 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 453 454 DO jl = 1, jpl 455 DO jj = 1, jpj 456 DO ji = 1, jpi 457 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 458 !WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 459 !WRITE(numout,*) ' at_i ', at_i(ji,jj) 460 !WRITE(numout,*) ' Point - category', ji, jj, jl 461 !WRITE(numout,*) ' a_i *** a_i_b ', a_i (ji,jj,jl), a_i_b (ji,jj,jl) 462 !WRITE(numout,*) ' v_i *** v_i_b ', v_i (ji,jj,jl), v_i_b (ji,jj,jl) 463 !WRITE(numout,*) ' d_a_i_thd/trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 464 !WRITE(numout,*) ' d_v_i_thd/trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 465 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 466 ENDIF 467 END DO 468 END DO 469 END DO 470 471 ! Alerte if very thick ice 472 ialert_id = 3 ! reference number of this alert 473 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 474 jl = jpl 475 DO jj = 1, jpj 476 DO ji = 1, jpi 477 IF( ht_i(ji,jj,jl) > 50._wp ) THEN 478 !CALL lim_prt_state( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 479 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 480 ENDIF 481 END DO 482 END DO 483 484 ! Alert if very fast ice 485 ialert_id = 4 ! reference number of this alert 486 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 487 DO jj = 1, jpj 488 DO ji = 1, jpi 489 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5 .AND. & 490 & at_i(ji,jj) > 0._wp ) THEN 491 !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 492 !WRITE(numout,*) ' ice strength : ', strength(ji,jj) 493 !WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj) 494 !WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj) 495 !WRITE(numout,*) ' sea-ice stress utau_ice : ', utau_ice(ji,jj) 496 !WRITE(numout,*) ' sea-ice stress vtau_ice : ', vtau_ice(ji,jj) 497 !WRITE(numout,*) ' oceanic speed u : ', u_oce(ji,jj) 498 !WRITE(numout,*) ' oceanic speed v : ', v_oce(ji,jj) 499 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 500 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 501 !WRITE(numout,*) 502 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 503 ENDIF 504 END DO 505 END DO 506 507 ! Alert if there is ice on continents 508 ialert_id = 6 ! reference number of this alert 509 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 510 DO jj = 1, jpj 511 DO ji = 1, jpi 512 IF( tms(ji,jj) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 513 !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 514 !WRITE(numout,*) ' masks s, u, v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 515 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 516 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 517 !WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj) 518 !WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj) 519 !WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1) 520 !WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj) 521 !WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj) 522 ! 523 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 524 ENDIF 525 END DO 526 END DO 527 528 ! 529 ! ! Alert if very fresh ice 530 ialert_id = 7 ! reference number of this alert 531 cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert 532 DO jl = 1, jpl 533 DO jj = 1, jpj 534 DO ji = 1, jpi 535 IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 536 ! CALL lim_prt_state(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 537 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj) 538 ! WRITE(numout,*) ' sss : ', sss_m(ji,jj) 539 ! WRITE(numout,*) 540 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 541 ENDIF 542 END DO 543 END DO 544 END DO 545 ! 546 547 ! ! Alert if too old ice 548 ialert_id = 9 ! reference number of this alert 549 cl_alname(ialert_id) = ' Very old ice ' ! name of the alert 550 DO jl = 1, jpl 551 DO jj = 1, jpj 552 DO ji = 1, jpi 553 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 554 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 555 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 556 !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 557 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 558 ENDIF 559 END DO 560 END DO 561 END DO 562 563 ! Alert on salt flux 564 ialert_id = 5 ! reference number of this alert 565 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 566 DO jj = 1, jpj 567 DO ji = 1, jpi 568 IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 569 !CALL lim_prt_state( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 570 !DO jl = 1, jpl 571 !WRITE(numout,*) ' Category no: ', jl 572 !WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' a_i_b : ', a_i_b (ji,jj,jl) 573 !WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl) 574 !WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' v_i_b : ', v_i_b (ji,jj,jl) 575 !WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl) 576 !WRITE(numout,*) ' ' 577 !END DO 578 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 579 ENDIF 580 END DO 581 END DO 582 583 ! Alert if qns very big 584 ialert_id = 8 ! reference number of this alert 585 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 586 DO jj = 1, jpj 587 DO ji = 1, jpi 588 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 589 ! 590 !WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 591 !WRITE(numout,*) ' ji, jj : ', ji, jj 592 !WRITE(numout,*) ' qns : ', qns(ji,jj) 593 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 594 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 595 ! 596 !CALL lim_prt_state( kt, ji, jj, 2, ' ') 597 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 598 ! 599 ENDIF 600 END DO 601 END DO 602 !+++++ 603 604 ! Alert if very warm ice 605 ialert_id = 10 ! reference number of this alert 606 cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 607 inb_alp(ialert_id) = 0 608 DO jl = 1, jpl 609 DO jk = 1, nlay_i 610 DO jj = 1, jpj 611 DO ji = 1, jpi 612 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt 613 IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 614 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 615 !WRITE(numout,*) ' ALERTE 10 : Very warm ice' 616 !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 617 !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 618 !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 619 !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl) 620 !WRITE(numout,*) ' ztmelts : ', ztmelts 621 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 622 ENDIF 623 END DO 624 END DO 625 END DO 626 END DO 627 628 ! sum of the alerts on all processors 629 IF( lk_mpp ) THEN 630 DO ialert_id = 1, inb_altests 631 CALL mpp_sum(inb_alp(ialert_id)) 632 END DO 633 ENDIF 634 635 ! print alerts 636 IF( lwp ) THEN 637 ialert_id = 1 ! reference number of this alert 638 cl_alname(ialert_id) = ' NO alerte 1 ' ! name of the alert 639 WRITE(numout,*) ' time step ',kt 640 WRITE(numout,*) ' All alerts at the end of ice model ' 641 DO ialert_id = 1, inb_altests 642 WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 643 END DO 644 ENDIF 645 ! 646 END SUBROUTINE lim_ctl 647 648 649 SUBROUTINE lim_prt_state( kt, ki, kj, kn, cd1 ) 650 !!----------------------------------------------------------------------- 651 !! *** ROUTINE lim_prt_state *** 652 !! 653 !! ** Purpose : Writes global ice state on the (i,j) point 654 !! in ocean.ouput 655 !! 3 possibilities exist 656 !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1) 657 !! n = 2 -> exhaustive state 658 !! n = 3 -> ice/ocean salt fluxes 659 !! 660 !! ** input : point coordinates (i,j) 661 !! n : number of the option 662 !!------------------------------------------------------------------- 663 INTEGER , INTENT(in) :: kt ! ocean time step 664 INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices 665 CHARACTER(len=*), INTENT(in) :: cd1 ! 666 !! 667 INTEGER :: jl, ji, jj 668 !!------------------------------------------------------------------- 669 670 DO ji = mi0(ki), mi1(ki) 671 DO jj = mj0(kj), mj1(kj) 672 673 WRITE(numout,*) ' time step ',kt,' ',cd1 ! print title 674 675 !---------------- 676 ! Simple state 677 !---------------- 678 679 IF ( kn == 1 .OR. kn == -1 ) THEN 680 WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 681 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 682 WRITE(numout,*) ' Simple state ' 683 WRITE(numout,*) ' masks s,u,v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 684 WRITE(numout,*) ' lat - long : ', gphit(ji,jj), glamt(ji,jj) 685 WRITE(numout,*) ' Time step : ', numit 686 WRITE(numout,*) ' - Ice drift ' 687 WRITE(numout,*) ' ~~~~~~~~~~~ ' 688 WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj) 689 WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj) 690 WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1) 691 WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj) 692 WRITE(numout,*) ' strength : ', strength(ji,jj) 693 WRITE(numout,*) 694 WRITE(numout,*) ' - Cell values ' 695 WRITE(numout,*) ' ~~~~~~~~~~~ ' 696 WRITE(numout,*) ' cell area : ', area(ji,jj) 697 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 698 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 699 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 700 DO jl = 1, jpl 701 WRITE(numout,*) ' - Category (', jl,')' 702 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) 703 WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl) 704 WRITE(numout,*) ' ht_s : ', ht_s(ji,jj,jl) 705 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) 706 WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) 707 WRITE(numout,*) ' e_s : ', e_s(ji,jj,1,jl)/1.0e9 708 WRITE(numout,*) ' e_i : ', e_i(ji,jj,1:nlay_i,jl)/1.0e9 709 WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) 710 WRITE(numout,*) ' t_snow : ', t_s(ji,jj,1,jl) 711 WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl) 712 WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl) 713 WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl) 714 WRITE(numout,*) 715 END DO 716 ENDIF 717 IF( kn == -1 ) THEN 718 WRITE(numout,*) ' Mechanical Check ************** ' 719 WRITE(numout,*) ' Check what means ice divergence ' 720 WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj) 721 WRITE(numout,*) ' Total lead fraction ', ato_i(ji,jj) 722 WRITE(numout,*) ' Sum of both ', ato_i(ji,jj) + at_i(ji,jj) 723 WRITE(numout,*) ' Sum of both minus 1 ', ato_i(ji,jj) + at_i(ji,jj) - 1.00 724 ENDIF 725 726 727 !-------------------- 728 ! Exhaustive state 729 !-------------------- 730 731 IF ( kn .EQ. 2 ) THEN 732 WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 733 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 734 WRITE(numout,*) ' Exhaustive state ' 735 WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 736 WRITE(numout,*) ' Time step ', numit 737 WRITE(numout,*) 738 WRITE(numout,*) ' - Cell values ' 739 WRITE(numout,*) ' ~~~~~~~~~~~ ' 740 WRITE(numout,*) ' cell area : ', area(ji,jj) 741 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 742 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 743 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 744 WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj) 745 WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj) 746 WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1) 747 WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj) 748 WRITE(numout,*) ' strength : ', strength(ji,jj) 749 WRITE(numout,*) ' d_u_ice_dyn : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn : ', d_v_ice_dyn(ji,jj) 750 WRITE(numout,*) ' u_ice_b : ', u_ice_b(ji,jj) , ' v_ice_b : ', v_ice_b(ji,jj) 751 WRITE(numout,*) 752 753 DO jl = 1, jpl 754 WRITE(numout,*) ' - Category (',jl,')' 755 WRITE(numout,*) ' ~~~~~~~~ ' 756 WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl) , ' ht_s : ', ht_s(ji,jj,jl) 757 WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl) 758 WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) , ' t_s : ', t_s(ji,jj,1,jl) 759 WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl) , ' o_i : ', o_i(ji,jj,jl) 760 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl) 761 WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl) 762 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl) 763 WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl) 764 WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl) 765 WRITE(numout,*) ' d_v_s_trp : ', d_v_s_trp(ji,jj,jl) , ' d_v_s_thd : ', d_v_s_thd(ji,jj,jl) 766 WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl)/1.0e9 , ' ei1 : ', e_i_b(ji,jj,1,jl)/1.0e9 767 WRITE(numout,*) ' de_i1_trp : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd : ', d_e_i_thd(ji,jj,1,jl)/1.0e9 768 WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl)/1.0e9 , ' ei2_b : ', e_i_b(ji,jj,2,jl)/1.0e9 769 WRITE(numout,*) ' de_i2_trp : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd : ', d_e_i_thd(ji,jj,2,jl)/1.0e9 770 WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl) 771 WRITE(numout,*) ' d_e_s_trp : ', d_e_s_trp(ji,jj,1,jl) , ' d_e_s_thd : ', d_e_s_thd(ji,jj,1,jl) 772 WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl) , ' smv_i_b : ', smv_i_b(ji,jj,jl) 773 WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl) , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl) 774 WRITE(numout,*) ' oa_i : ', oa_i(ji,jj,jl) , ' oa_i_b : ', oa_i_b(ji,jj,jl) 775 WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl) , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl) 776 END DO !jl 777 778 WRITE(numout,*) 779 WRITE(numout,*) ' - Heat / FW fluxes ' 780 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 781 WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 782 WRITE(numout,*) ' qsr_ini : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) ) 783 WRITE(numout,*) ' qns_ini : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) 784 WRITE(numout,*) 785 WRITE(numout,*) 786 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 787 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 788 WRITE(numout,*) 789 WRITE(numout,*) ' - Stresses ' 790 WRITE(numout,*) ' ~~~~~~~~ ' 791 WRITE(numout,*) ' utau_ice : ', utau_ice(ji,jj) 792 WRITE(numout,*) ' vtau_ice : ', vtau_ice(ji,jj) 793 WRITE(numout,*) ' utau : ', utau (ji,jj) 794 WRITE(numout,*) ' vtau : ', vtau (ji,jj) 795 WRITE(numout,*) ' oc. vel. u : ', u_oce (ji,jj) 796 WRITE(numout,*) ' oc. vel. v : ', v_oce (ji,jj) 797 ENDIF 798 799 !--------------------- 800 ! Salt / heat fluxes 801 !--------------------- 802 803 IF ( kn .EQ. 3 ) THEN 804 WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 805 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 806 WRITE(numout,*) ' - Salt / Heat Fluxes ' 807 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 808 WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 809 WRITE(numout,*) ' Time step ', numit 810 WRITE(numout,*) 811 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 812 WRITE(numout,*) ' qsr : ', qsr(ji,jj) 813 WRITE(numout,*) ' qns : ', qns(ji,jj) 814 WRITE(numout,*) 815 WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 816 WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj) 817 WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj) 818 WRITE(numout,*) ' dhc : ', diag_heat_dhc(ji,jj) 819 WRITE(numout,*) 820 WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj) 821 WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj) 822 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 823 WRITE(numout,*) ' fhtur : ', fhtur(ji,jj) 824 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_rdtice 825 WRITE(numout,*) 826 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 827 WRITE(numout,*) ' emp : ', emp (ji,jj) 828 WRITE(numout,*) ' sfx : ', sfx (ji,jj) 829 WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj) 830 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj) 831 WRITE(numout,*) ' sfx_dyn : ', sfx_dyn(ji,jj) 832 WRITE(numout,*) 833 WRITE(numout,*) ' - Momentum fluxes ' 834 WRITE(numout,*) ' utau : ', utau(ji,jj) 835 WRITE(numout,*) ' vtau : ', vtau(ji,jj) 836 ENDIF 837 WRITE(numout,*) ' ' 838 ! 839 END DO 840 END DO 841 ! 842 END SUBROUTINE lim_prt_state 843 844 563 564 SUBROUTINE sbc_lim_update 565 !!---------------------------------------------------------------------- 566 !! *** ROUTINE sbc_lim_update *** 567 !! 568 !! ** purpose : store ice variables at "before" time step 569 !!---------------------------------------------------------------------- 570 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 571 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 572 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 573 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 574 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 575 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content 576 oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content 577 u_ice_b(:,:) = u_ice(:,:) 578 v_ice_b(:,:) = v_ice(:,:) 579 580 END SUBROUTINE sbc_lim_update 581 582 SUBROUTINE sbc_lim_diag0 583 !!---------------------------------------------------------------------- 584 !! *** ROUTINE sbc_lim_diag0 *** 585 !! 586 !! ** purpose : set ice-ocean and ice-atm. fluxes to zeros at the beggining 587 !! of the time step 588 !!---------------------------------------------------------------------- 589 sfx (:,:) = 0._wp ; 590 sfx_bri(:,:) = 0._wp ; 591 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 592 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 593 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 594 sfx_res(:,:) = 0._wp 595 596 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 597 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 598 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 599 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 600 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 601 wfx_spr(:,:) = 0._wp ; 602 603 hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp 604 hfx_thd(:,:) = 0._wp ; 605 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 606 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 607 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 608 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 609 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 610 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 611 612 afx_tot(:,:) = 0._wp ; 613 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 614 615 diag_heat_dhc(:,:) = 0._wp ; 616 617 END SUBROUTINE sbc_lim_diag0 618 845 619 FUNCTION fice_cell_ave ( ptab ) 846 620 !!-------------------------------------------------------------------------- … … 854 628 855 629 DO jl = 1, jpl 856 fice_cell_ave (:,:) = fice_cell_ave (:,:) & 857 & + a_i (:,:,jl) * ptab (:,:,jl) 630 fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 858 631 END DO 859 632 … … 882 655 WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk 883 656 END SUBROUTINE sbc_ice_lim 657 SUBROUTINE sbc_lim_init ! Dummy routine 658 END SUBROUTINE sbc_lim_init 884 659 #endif 885 660 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5120 r5123 273 273 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 274 274 ! 275 IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialisation 276 275 277 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 276 278 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5120 r5123 384 384 IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics 385 385 386 CALL sbc_init ! Forcings : surface module (clem: moved here for bdy purpose) 387 386 388 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 387 389 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays … … 390 392 391 393 CALL dyn_nept_init ! simplified form of Neptune effect 392 393 394 ! 394 395 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 395 396 ! 396 397 ! Ocean physics 397 CALL sbc_init ! Forcings : surface module398 398 ! ! Vertical physics 399 399 CALL zdf_init ! namelist read
Note: See TracChangeset
for help on using the changeset viewer.