Changeset 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_3
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- Location:
- trunk/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 28 edited
-
dom_ice.F90 (modified) (2 diffs)
-
ice.F90 (modified) (6 diffs)
-
iceini.F90 (modified) (5 diffs)
-
limadv.F90 (modified) (9 diffs)
-
limcons.F90 (modified) (3 diffs)
-
limdia.F90 (modified) (4 diffs)
-
limdyn.F90 (modified) (13 diffs)
-
limhdf.F90 (modified) (6 diffs)
-
limistate.F90 (modified) (5 diffs)
-
limitd_me.F90 (modified) (64 diffs)
-
limitd_th.F90 (modified) (40 diffs)
-
limmsh.F90 (modified) (4 diffs)
-
limrhg.F90 (modified) (4 diffs)
-
limrst.F90 (modified) (9 diffs)
-
limsbc.F90 (modified) (12 diffs)
-
limtab.F90 (modified) (3 diffs)
-
limthd.F90 (modified) (22 diffs)
-
limthd_dh.F90 (modified) (18 diffs)
-
limthd_dif.F90 (modified) (21 diffs)
-
limthd_ent.F90 (modified) (39 diffs)
-
limthd_lac.F90 (modified) (17 diffs)
-
limthd_sal.F90 (modified) (13 diffs)
-
limtrp.F90 (modified) (15 diffs)
-
limupdate.F90 (modified) (32 diffs)
-
limvar.F90 (modified) (14 diffs)
-
limwri.F90 (modified) (17 diffs)
-
limwri_dimg.h90 (modified) (2 diffs)
-
thd_ice.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
r2528 r2715 4 4 !! LIM-3 Sea Ice : Domain variables 5 5 !!====================================================================== 6 !! History : 3.0 ! 2003-08 (M. Vancoppenolle) LIM-3 6 !! History : 3.0 ! 2003-08 (M. Vancoppenolle) LIM-3 original code 7 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 7 8 !!---------------------------------------------------------------------- 8 USE par_ice 9 USE par_ice ! LIM-3 parameter 10 USE in_out_manager ! I/O manager 11 USE lib_mpp ! MPP library 9 12 10 13 IMPLICIT NONE 11 14 PRIVATE 15 16 PUBLIC dom_ice_alloc ! Routine called by nemogcm.F90 12 17 13 18 LOGICAL, PUBLIC :: l_jeq = .TRUE. !: Equator inside the domain flag … … 15 20 INTEGER, PUBLIC :: njeq , njeqm1 !: j-index of the equator if it is inside the domain 16 21 17 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fs2cor !: coriolis factor 18 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fcor !: coriolis coefficient 19 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: covrai !: sine of geographic latitude 20 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: area !: surface of grid cell 21 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tms, tmi !: temperature mask, mask for stress 22 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmu, tmv !: mask at u and v velocity points 23 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmf !: mask at f-point 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcor !: coriolis coefficient 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: covrai !: sine of geographic latitude 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: area !: surface of grid cell 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms, tmi !: temperature mask, mask for stress 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmu, tmv !: mask at u and v velocity points 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmf !: mask at f-point 24 28 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) :: wght!: weight of the 4 neighbours to compute averages29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages 26 30 27 31 !!---------------------------------------------------------------------- 28 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)32 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 29 33 !! $Id$ 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 !!---------------------------------------------------------------------- 36 CONTAINS 37 38 FUNCTION dom_ice_alloc 39 !!------------------------------------------------------------------- 40 !! *** Routine dom_ice_alloc *** 41 !!------------------------------------------------------------------- 42 INTEGER :: dom_ice_alloc 43 !!------------------------------------------------------------------- 44 ! 45 ALLOCATE( fcor(jpi,jpj) , & 46 & covrai(jpi,jpj) , area(jpi,jpj) , & 47 & tms (jpi,jpj) , tmi (jpi,jpj) , & 48 & tmu (jpi,jpj) , tmv (jpi,jpj) , & 49 & tmf (jpi,jpj) , & 50 & wght(jpi,jpj,2,2) , STAT = dom_ice_alloc ) 51 ! 52 IF( dom_ice_alloc /= 0 ) CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' ) 53 ! 54 END FUNCTION dom_ice_alloc 55 31 56 !!====================================================================== 32 57 END MODULE dom_ice -
trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r2528 r2715 4 4 !! LIM-3 Sea Ice physics: diagnostics variables of ice defined in memory 5 5 !!===================================================================== 6 !! History : 3.0 ! 2008-03 (M. Vancoppenolle) : original code LIM-3 6 !! History : 3.0 ! 2008-03 (M. Vancoppenolle) original code LIM-3 7 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 11 12 !!---------------------------------------------------------------------- 12 13 USE par_ice ! LIM sea-ice parameters 14 USE in_out_manager ! I/O manager 15 USE lib_mpp ! MPP library 13 16 14 17 IMPLICIT NONE 15 18 PRIVATE 19 20 PUBLIC ice_alloc ! Called in iceini.F90 16 21 17 22 !!====================================================================== 18 23 !! LIM3 by the use of sweat, agile fingers and sometimes brain juice, 19 24 !! was developed in Louvain-la-Neuve by : 20 !!21 25 !! * Martin Vancoppenolle (UCL-ASTR, Belgium) 22 26 !! * Sylvain Bouillon (UCL-ASTR, Belgium) 23 !! * Miguel Angel Morales Maqueda ( POL, UK)27 !! * Miguel Angel Morales Maqueda (NOC-L, UK) 24 28 !! 25 29 !! Based on extremely valuable earlier work by 26 !!27 30 !! * Thierry Fichefet 28 31 !! * Hugues Goosse 29 32 !! 30 33 !! The following persons also contributed to the code in various ways 31 !! 32 !! * Gurvan Madec, Claude Talandier, Christian Ethe 33 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 34 !! * Gurvan Madec, Claude Talandier, Christian Ethe (LOCEAN, France) 34 35 !! * Xavier Fettweis (UCL-ASTR), Ralph Timmermann (AWI, Germany) 35 36 !! * Bill Lipscomb (LANL), Cecilia Bitz (UWa) 36 37 !! and Elisabeth Hunke (LANL), USA. 37 38 !! 38 !! (c) UCL-ASTR, 2005-2008 39 !! 40 !! For more info, the interested user is kindly invited to consult the 41 !! following references 39 !! For more info, the interested user is kindly invited to consult the following references 42 40 !! For model description and validation : 43 41 !! * Vancoppenolle et al., Ocean Modelling, 2008a. 44 42 !! * Vancoppenolle et al., Ocean Modelling, 2008b. 43 !! For a specific description of EVP : 44 !! * Bouillon et al., Ocean Modelling 2009. 45 45 !! 46 !! For a specific description of EVP : 47 !! * Bouillon et al., in prep for 2008. 48 !! 49 !! Or the reference manual, that should be available by 2010 46 !! Or the reference manual, that should be available by 2011 50 47 !!====================================================================== 51 48 !! | … … 168 165 REAL(wp), PUBLIC :: rdt_ice !: ice time step 169 166 170 INTEGER , PUBLIC :: & !!: ** ice-dynamic namelist (namicedyn) ** 171 nbiter = 1 , & !: number of sub-time steps for relaxation 172 nbitdr = 250 , & !: maximum number of iterations for relaxation 173 nevp = 400 , & !: number of iterations for subcycling 174 nlay_i = 5 !: number of layers in the ice 175 176 REAL(wp), PUBLIC :: & !!: ** ice-dynamic namelist (namicedyn) ** 177 epsd = 1.0e-20, & !: tolerance parameter for dynamic 178 alpha = 0.5 , & !: coefficient for semi-implicit coriolis 179 dm = 0.6e+03, & !: diffusion constant for dynamics 180 om = 0.5 , & !: relaxation constant 181 resl = 5.0e-05, & !: maximum value for the residual of relaxation 182 cw = 5.0e-03, & !: drag coefficient for oceanic stress 183 angvg = 0.0 , & !: turning angle for oceanic stress 184 pstar = 1.0e+04, & !: determines ice strength (N/M), Hibler JPO79 185 c_rhg = 20.0 , & !: determines changes in ice strength 186 etamn = 0.0e+07, & !: minimun value for viscosity : has to be 0 187 creepl = 2.0e-08, & !: creep limit : has to be under 1.0e-9 188 ecc = 2.0 , & !: eccentricity of the elliptical yield curve 189 ahi0 = 350.e0 , & !: sea-ice hor. eddy diffusivity coeff. (m2/s) 190 telast = 2880.0 , & !: timescale for elastic waves (s) !SB 191 alphaevp = 1.0 , & !: coeficient of the internal stresses !SB 192 unit_fac = 1.0e9 !: conversion factor for ice / snow enthalpy 193 194 REAL(wp), PUBLIC :: & !!: ** ice-salinity namelist (namicesal) ** 195 s_i_max = 20.0 , & !: maximum ice salinity (ppt) 196 s_i_min = 0.1 , & !: minimum ice salinity (ppt) 197 s_i_0 = 3.5 , & !: 1st sal. value for the computation of sal .prof. 198 !: (ppt) 199 s_i_1 = 4.5 , & !: 2nd sal. value for the computation of sal .prof. 200 !: (ppt) 201 sal_G = 5.00 , & !: restoring salinity for gravity drainage 202 !: (ppt) 203 sal_F = 2.50 , & !: restoring salinity for flushing 204 !: (ppt) 205 time_G = 1.728e+06,&!: restoring time constant for gravity drainage 206 !: (= 20 days, in s) 207 time_F = 8.640e+05,&!: restoring time constant for gravity drainage 208 !: (= 10 days, in s) 209 bulk_sal = 4.0 !: bulk salinity (ppt) in case of constant salinity 210 211 INTEGER , PUBLIC :: & !!: ** ice-salinity namelist (namicesal) ** 212 num_sal = 1 , & !: salinity configuration used in the model 213 !: 1 - s constant in space and time 214 !: 2 - prognostic salinity (s(z,t)) 215 !: 3 - salinity profile, constant in time 216 !: 4 - salinity variations affect only ice 217 ! thermodynamics 218 sal_prof = 1 , & !: salinity profile or not 219 thcon_i_swi = 1 !: thermal conductivity of Untersteiner (1964) (1) or 220 !: Pringle et al (2007) (2) 221 222 REAL(wp), PUBLIC :: & !!: ** ice-mechanical redistribution namelist (namiceitdme) 223 Cs = 0.25 , & !!: fraction of shearing energy contributing to ridging 224 Cf = 17.0 , & !!: ratio of ridging work to PE loss 225 fsnowrdg = 0.5 , & !!: fractional snow loss to the ocean during ridging 226 fsnowrft = 0.5 , & !!: fractional snow loss to the ocean during ridging 227 Gstar = 0.15 , & !!: fractional area of young ice contributing to ridging 228 astar = 0.05 , & !!: equivalent of G* for an exponential participation function 229 Hstar = 100.0 , & !!: thickness that determines the maximal thickness of ridged 230 !!: ice 231 hparmeter = 0.75, & !!: threshold thickness (m) for rafting / ridging 232 Craft = 5.0 , & !!: coefficient for smoothness of the hyperbolic tangent in rafting 233 ridge_por = 0.0 , & !!: initial porosity of ridges (0.3 regular value) 234 sal_max_ridge = 15.0, & !!: maximum ridged ice salinity (ppt) 235 betas = 1.0 , & !:: coef. for partitioning of snowfall between leads and sea ice 236 kappa_i = 1.0 , & !!: coefficient for the extinction of radiation 237 !!: Grenfell et al. (2006) (m-1) 238 nconv_i_thd = 50 , & !!: maximal number of iterations for heat diffusion 239 maxer_i_thd = 1.0e-4 !!: maximal tolerated error (C) for heat diffusion 240 241 INTEGER , PUBLIC :: & !!: ** ice-mechanical redistribution namelist (namiceitdme) 242 ridge_scheme_swi = 0, & !!: scheme used for ice ridging 243 raftswi = 1, & !!: rafting of ice or not 244 partfun_swi = 1, & !!: participation function Thorndike et al. JGR75 (0) 245 !!: or Lipscomb et al. JGR07 (1) 246 transfun_swi = 0, & !!: transfer function of Hibler, MWR80 (0) 247 !!: or Lipscomb et al., 2007 (1) 248 brinstren_swi = 0 !!: use brine volume to diminish ice strength 249 250 REAL(wp), PUBLIC :: & !: 251 usecc2 , & !: = 1.0 / ( ecc * ecc ) 252 rhoco , & !: = rau0 * cw 253 sangvg, cangvg , & !: sin and cos of the turning angle for ocean stress 254 pstarh !: pstar / 2.0 255 256 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 257 u_oce, v_oce , & !: surface ocean velocity used in ice dynamics 258 ahiu , ahiv , & !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 259 pahu , pahv , & !: ice hor. eddy diffusivity coef. at ocean U- and V-points 260 ust2s, hicol , & !: friction velocity, ice collection thickness accreted in leads 261 strength , & !: ice strength 262 strp1, strp2 , & !: strength at previous time steps 263 stress1_i , & !: first stress tensor element 264 stress2_i , & !: second stress tensor element 265 stress12_i , & !: diagonal stress tensor element 266 delta_i , & !: Delta factor for the ice rheology (see Flato and Hibler 95) [s-1] -> limrhg.F90 267 divu_i , & !: Divergence of the velocity field [s-1] -> limrhg.F90 268 shear_i !: Shear of the velocity field [s-1] -> limrhg.F90 269 270 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 271 firic , & !: IR flux over the ice (only used for outputs) 272 fcsic , & !: Sensible heat flux over the ice (only used for outputs) 273 fleic , & !: Latent heat flux over the ice (only used for outputs) 274 qlatic , & !: latent flux 275 rdvosif, & !: Variation of volume at surface (only used for outputs) 276 rdvobif, & !: Variation of ice volume at the bottom ice (only used for outputs) 277 fdvolif, & !: Total variation of ice volume (only used for outputs) 278 rdvonif, & !: Lateral Variation of ice volume (only used for outputs) 279 sist , & !: Average Sea-Ice Surface Temperature (Kelvin) 280 icethi , & !: total ice thickness (for all categories) (only used for outputs) 281 t_bo , & !: Sea-Ice bottom temperature (Kelvin) 282 hicifp , & !: Ice production/melting 283 !obsolete... can be removed 284 frld , & !: Leads fraction = 1-a/totalarea REFERS TO LEAD FRACTION everywhere 285 !: except in the OUTPUTS!!!! 286 pfrld , & !: Leads fraction at previous time 287 phicif , & !: Old ice thickness 288 fbif , & !: Heat flux at the ice base 289 rdmsnif, & !: Variation of snow mass 290 rdmicif, & !: Variation of ice mass 291 qldif , & !: heat balance of the lead (or of the open ocean) 292 qcmif , & !: Energy needed to bring the ocean surface layer until its freezing 293 fdtcn , & !: net downward heat flux from the ice to the ocean 294 qdtcn , & !: energy from the ice to the ocean 295 fstric , & !: transmitted solar radiation under ice 296 fscmbq , & !: associated with lead chipotage with solar flux 297 ffltbif, & !: Array linked with the max heat contained in brine pockets (?) 298 fsbbq , & !: Also linked with the solar flux below the ice (?) 299 qfvbq , & !: Array used to store energy in case of toral lateral ablation (?) 300 dmgwi , & !: Variation of the mass of snow ice 301 fsalt_res, & !: Residual salt flux due to correction of ice thickness 302 fsbri , & !: Salt flux due to brine rejection 303 fsalt_rpo, & !: Salt flux associated with porous ridged ice formation 304 fheat_rpo, & !: Heat flux associated with porous ridged ice formation 305 fhbri , & !: heat flux due to brine rejection 306 fmmec , & !: Mass flux due to snow loss during compression 307 fseqv , & !: Equivalent salt flux due to ice growth/melt 308 fheat_res, & !: Residual heat flux due to correction of ice thickness 309 fhmec !: Heat flux due to snow loss during compression 167 ! !!** ice-dynamic namelist (namicedyn) ** 168 INTEGER , PUBLIC :: nbiter = 1 !: number of sub-time steps for relaxation 169 INTEGER , PUBLIC :: nbitdr = 250 !: maximum number of iterations for relaxation 170 INTEGER , PUBLIC :: nevp = 400 !: number of iterations for subcycling 171 INTEGER , PUBLIC :: nlay_i = 5 !: number of layers in the ice 172 173 ! !!** ice-dynamic namelist (namicedyn) ** 174 REAL(wp), PUBLIC :: epsd = 1.0e-20_wp !: tolerance parameter for dynamic 175 REAL(wp), PUBLIC :: alpha = 0.5_wp !: coefficient for semi-implicit coriolis 176 REAL(wp), PUBLIC :: dm = 0.6e+03_wp !: diffusion constant for dynamics 177 REAL(wp), PUBLIC :: om = 0.5_wp !: relaxation constant 178 REAL(wp), PUBLIC :: resl = 5.0e-05_wp !: maximum value for the residual of relaxation 179 REAL(wp), PUBLIC :: cw = 5.0e-03_wp !: drag coefficient for oceanic stress 180 REAL(wp), PUBLIC :: angvg = 0._wp !: turning angle for oceanic stress 181 REAL(wp), PUBLIC :: pstar = 1.0e+04_wp !: determines ice strength (N/M), Hibler JPO79 182 REAL(wp), PUBLIC :: c_rhg = 20._wp !: determines changes in ice strength 183 REAL(wp), PUBLIC :: etamn = 0.0e+07_wp !: minimun value for viscosity : has to be 0 184 REAL(wp), PUBLIC :: creepl = 2.0e-08_wp !: creep limit : has to be under 1.0e-9 185 REAL(wp), PUBLIC :: ecc = 2._wp !: eccentricity of the elliptical yield curve 186 REAL(wp), PUBLIC :: ahi0 = 350._wp !: sea-ice hor. eddy diffusivity coeff. (m2/s) 187 REAL(wp), PUBLIC :: telast = 2880._wp !: timescale for elastic waves (s) !SB 188 REAL(wp), PUBLIC :: alphaevp = 1._wp !: coeficient of the internal stresses !SB 189 REAL(wp), PUBLIC :: unit_fac = 1.e+09_wp !: conversion factor for ice / snow enthalpy 190 191 ! !!** ice-salinity namelist (namicesal) ** 192 REAL(wp), PUBLIC :: s_i_max = 20.0_wp !: maximum ice salinity [PSU] 193 REAL(wp), PUBLIC :: s_i_min = 0.1_wp !: minimum ice salinity [PSU] 194 REAL(wp), PUBLIC :: s_i_0 = 3.5_wp !: 1st sal. value for the computation of sal .prof. [PSU] 195 REAL(wp), PUBLIC :: s_i_1 = 4.5_wp !: 2nd sal. value for the computation of sal .prof. [PSU] 196 REAL(wp), PUBLIC :: sal_G = 5.0_wp !: restoring salinity for gravity drainage [PSU] 197 REAL(wp), PUBLIC :: sal_F = 2.5_wp !: restoring salinity for flushing [PSU] 198 REAL(wp), PUBLIC :: time_G = 1.728e+06_wp !: restoring time constant for gravity drainage (= 20 days) [s] 199 REAL(wp), PUBLIC :: time_F = 8.640e+05_wp !: restoring time constant for gravity drainage (= 10 days) [s] 200 REAL(wp), PUBLIC :: bulk_sal = 4.0_wp !: bulk salinity (ppt) in case of constant salinity 201 202 ! !!** ice-salinity namelist (namicesal) ** 203 INTEGER , PUBLIC :: num_sal = 1 !: salinity configuration used in the model 204 ! ! 1 - s constant in space and time 205 ! ! 2 - prognostic salinity (s(z,t)) 206 ! ! 3 - salinity profile, constant in time 207 ! ! 4 - salinity variations affect only ice thermodynamics 208 INTEGER , PUBLIC :: sal_prof = 1 !: salinity profile or not 209 INTEGER , PUBLIC :: thcon_i_swi = 1 !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) 210 211 ! !!** ice-mechanical redistribution namelist (namiceitdme) 212 REAL(wp), PUBLIC :: Cs = 0.25_wp !: fraction of shearing energy contributing to ridging 213 REAL(wp), PUBLIC :: Cf = 17.0_wp !: ratio of ridging work to PE loss 214 REAL(wp), PUBLIC :: fsnowrdg = 0.5_wp !: fractional snow loss to the ocean during ridging 215 REAL(wp), PUBLIC :: fsnowrft = 0.5_wp !: fractional snow loss to the ocean during ridging 216 REAL(wp), PUBLIC :: Gstar = 0.15_wp !: fractional area of young ice contributing to ridging 217 REAL(wp), PUBLIC :: astar = 0.05_wp !: equivalent of G* for an exponential participation function 218 REAL(wp), PUBLIC :: Hstar = 100.0_wp !: thickness that determines the maximal thickness of ridged ice 219 REAL(wp), PUBLIC :: hparmeter = 0.75_wp !: threshold thickness (m) for rafting / ridging 220 REAL(wp), PUBLIC :: Craft = 5.0_wp !: coefficient for smoothness of the hyperbolic tangent in rafting 221 REAL(wp), PUBLIC :: ridge_por = 0.0_wp !: initial porosity of ridges (0.3 regular value) 222 REAL(wp), PUBLIC :: sal_max_ridge = 15.0_wp !: maximum ridged ice salinity (ppt) 223 REAL(wp), PUBLIC :: betas = 1.0_wp !: coef. for partitioning of snowfall between leads and sea ice 224 REAL(wp), PUBLIC :: kappa_i = 1.0_wp !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 225 REAL(wp), PUBLIC :: nconv_i_thd = 50_wp !: maximal number of iterations for heat diffusion 226 REAL(wp), PUBLIC :: maxer_i_thd = 1.0e-4_wp !: maximal tolerated error (C) for heat diffusion 227 228 ! !!** ice-mechanical redistribution namelist (namiceitdme) 229 INTEGER , PUBLIC :: ridge_scheme_swi = 0 !: scheme used for ice ridging 230 INTEGER , PUBLIC :: raftswi = 1 !: rafting of ice or not 231 INTEGER , PUBLIC :: partfun_swi = 1 !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 232 INTEGER , PUBLIC :: transfun_swi = 0 !: transfer function: =0 Hibler 1980, =1 Lipscomb et al. 2007 233 INTEGER , PUBLIC :: brinstren_swi = 0 !: use brine volume to diminish ice strength 234 235 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( ecc * ecc ) 236 REAL(wp), PUBLIC :: rhoco !: = rau0 * cw 237 REAL(wp), PUBLIC :: sangvg, cangvg !: sin and cos of the turning angle for ocean stress 238 REAL(wp), PUBLIC :: pstarh !: pstar / 2.0 239 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pahu , pahv !: ice hor. eddy diffusivity coef. at U- and V-points 243 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ust2s, hicol !: friction velocity, ice collection thickness accreted in leads 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strp1, strp2 !: strength at previous time steps 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength !: ice strength 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress1_i, stress2_i, stress12_i !: 1st, 2nd & diagonal stress tensor element 247 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i !: ice rheology elta factor (Flato & Hibler 95) [s-1] 248 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i !: Divergence of the velocity field [s-1] 249 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 250 ! 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: firic !: IR flux over the ice (diag only) 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcsic !: Sensible heat flux over the ice (diag only) 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fleic !: Latent heat flux over the ice (diag only) 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlatic !: latent flux 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvosif !: Variation of volume at surface (diag only) 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvobif !: Variation of ice volume at the bottom ice (diag only) 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdvolif !: Total variation of ice volume (diag only) 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvonif !: Lateral Variation of ice volume (diag only) 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Average Sea-Ice Surface Temperature [Kelvin] 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icethi !: total ice thickness (for all categories) (diag only) 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicifp !: Ice production/melting==>!obsolete... can be removed 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfrld !: Leads fraction at previous time 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: phicif !: Old ice thickness 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbif !: Heat flux at the ice base 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmsnif !: Variation of snow mass 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdmicif !: Variation of ice mass 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qldif !: heat balance of the lead (or of the open ocean) 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qcmif !: Energy needed to bring the ocean to freezing 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdtcn !: net downward heat flux from the ice to the ocean 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qdtcn !: energy from the ice to the ocean 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric !: transmitted solar radiation under ice 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fscmbq !: associated with lead chipotage with solar flux 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ffltbif !: related to max heat contained in brine pockets (?) 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsbbq !: Also linked with the solar flux below the ice (?) 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qfvbq !: store energy in case of total lateral ablation (?) 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dmgwi !: Variation of the mass of snow ice 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsalt_res !: Residual salt flux due to correction of ice thickness 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsbri !: Salt flux due to brine rejection 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsalt_rpo !: Salt flux associated with porous ridged ice formation 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_rpo !: Heat flux associated with porous ridged ice formation 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhbri !: heat flux due to brine rejection 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmec !: Mass flux due to snow loss during compression 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fseqv !: Equivalent salt flux due to ice growth/melt 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhmec !: Heat flux due to snow loss during compression 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_res !: Residual heat flux due to correction of ice thickness 310 288 311 289 ! temporary arrays for dummy version of the code 312 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 313 dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D, q_s 314 315 INTEGER, PUBLIC, DIMENSION(jpi, jpj, jpl) :: & !:: 316 patho_case ! number of the pathological case (if any, of course) 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D, q_s 291 292 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: patho_case ! number of the pathological case (if any, of course) 317 293 318 294 !!-------------------------------------------------------------------------- … … 320 296 !!-------------------------------------------------------------------------- 321 297 !! Variables defined for each ice category 322 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) :: & !: 323 ht_i , & !: Ice thickness (m) 324 a_i , & !: Ice fractional areas (concentration) 325 v_i , & !: Ice volume per unit area (m) 326 v_s , & !: Snow volume per unit area(m) 327 ht_s , & !: Snow thickness (m) 328 t_su , & !: Sea-Ice Surface Temperature (K) 329 sm_i , & !: Sea-Ice Bulk salinity (ppt) 330 smv_i , & !: Sea-Ice Bulk salinity times volume per area (ppt.m) 331 !: this is an extensive variable that has to be transported 332 o_i , & !: Sea-Ice Age (days) 333 ov_i , & !: Sea-Ice Age times volume per area (days.m) 334 oa_i !: Sea-Ice Age times ice area (days) 335 336 !! Variables summed over all categories, or associated to 337 !! all the ice in a single grid cell 338 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 339 u_ice, v_ice, & !: two components of the ice velocity (m/s) 340 tio_u, tio_v, & !: two components of the ice-ocean stress (N/m2) 341 vt_i , & !: ice total volume per unit area (m) 342 vt_s , & !: snow total volume per unit area (m) 343 at_i , & !: ice total fractional area (ice concentration) 344 ato_i , & !: total open water fractional area (1-at_i) 345 et_i , & !: total ice heat content 346 et_s , & !: total snow heat content 347 ot_i , & !: mean age over all categories 348 tm_i , & !: mean ice temperature over all categories 349 bv_i , & !: brine volume averaged over all categories 350 smt_i !: mean sea ice salinity averaged over all categories 351 352 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpm) :: & !: 353 at_i_typ , & !: total area contained in each ice type 354 vt_i_typ !: total volume contained in each ice type 355 356 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,nlay_s,jpl) :: & !: 357 t_s, & !: Snow temperatures (K) 358 e_s 359 360 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) :: & !: ! go to trash 361 e_i_cat 362 363 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jkmax,jpl) :: & !: 364 t_i, & !: Ice temperatures [ Kelvins ] 365 e_i, & !: Ice thermal contents [ Joules*10^9 ] 366 s_i !: Ice salinities 298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i !: Ice thickness (m) 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 301 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area(m) 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_s !: Snow thickness (m) 303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K) 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sm_i !: Sea-Ice Bulk salinity (ppt) 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: smv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m) 306 ! ! this is an extensive variable that has to be transported 307 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (days) 308 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ov_i !: Sea-Ice Age times volume per area (days.m) 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (days) 310 311 !! Variables summed over all categories, or associated to all the ice in a single grid cell 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tio_u, tio_v !: components of the ice-ocean stress (N/m2) 314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content 318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ot_i !: mean age over all categories 319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bv_i !: brine volume averaged over all categories 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 322 323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: at_i_typ !: total area contained in each ice type [m^2] 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vt_i_typ !: total volume contained in each ice type [m^3] 325 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 328 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_i_cat !: ! go to trash 330 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [Giga J] 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i !: ice salinities [PSU] 367 334 368 335 !!-------------------------------------------------------------------------- 369 336 !! * Moments for advection 370 337 !!-------------------------------------------------------------------------- 371 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 372 sxopw, syopw, sxxopw, syyopw, sxyopw !: open water in sea ice 373 374 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) :: & !: 375 sxice, syice, sxxice, syyice, sxyice, & !: ice thickness moments for advection 376 sxsn, sysn, sxxsn, syysn, sxysn, & !: snow thickness 377 sxa, sya, sxxa, syya, sxya, & !: lead fraction 378 sxc0, syc0, sxxc0, syyc0, sxyc0, & !: snow thermal content 379 sxsal, sysal, sxxsal, syysal, sxysal, & !: ice salinity 380 sxage, syage, sxxage, syyage, sxyage !: ice age 381 382 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jkmax,jpl) :: & !: 383 sxe , sye , sxxe , syye , sxye !: ice layers heat content 338 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxopw, syopw, sxxopw, syyopw, sxyopw !: open water in sea ice 339 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxice, syice, sxxice, syyice, sxyice !: ice thickness 340 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsn , sysn , sxxsn , syysn , sxysn !: snow thickness 341 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxa , sya , sxxa , syya , sxya !: lead fraction 342 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxc0 , syc0 , sxxc0 , syyc0 , sxyc0 !: snow thermal content 343 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsal, sysal, sxxsal, syysal, sxysal !: ice salinity 344 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage !: ice age 345 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye !: ice layers heat content 384 346 385 347 !!-------------------------------------------------------------------------- 386 348 !! * Old values of global variables 387 349 !!-------------------------------------------------------------------------- 388 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) :: & !: 389 old_v_s, old_v_i, & !: snow and ice volumes 390 old_a_i, old_smv_i, old_oa_i 391 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,nlay_s,jpl) :: & !: 392 old_e_s !: snow heat content 393 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jkmax,jpl) :: & !: 394 old_e_i !: ice temperatures 395 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: ice velocity (gv6 and gv7) 396 old_u_ice, old_v_ice 350 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: old_v_s, old_v_i !: snow and ice volumes 351 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: old_a_i, old_smv_i, old_oa_i !: ??? 352 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: old_e_s !: snow heat content 353 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: old_e_i !: ice temperatures 354 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: old_u_ice, old_v_ice !: ice velocity (gv6 and gv7) 355 397 356 398 357 !!-------------------------------------------------------------------------- … … 401 360 ! thd refers to changes induced by thermodynamics 402 361 ! trp '' '' '' advection (transport of ice) 403 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) :: & !: 404 d_a_i_thd , d_a_i_trp , & !: icefractions 405 d_v_s_thd , d_v_s_trp, & !: snow volume 406 d_v_i_thd , d_v_i_trp, & !: ice volume 407 d_smv_i_thd, d_smv_i_trp, & 408 d_sm_i_fl , d_sm_i_gd , & 409 d_sm_i_se , d_sm_i_si , d_sm_i_la , & 410 d_oa_i_thd , d_oa_i_trp, s_i_newice 411 412 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,nlay_s,jpl) :: & !: 413 d_e_s_thd, d_e_s_trp 414 415 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jkmax,jpl) :: & !: 416 d_e_i_thd, d_e_i_trp 417 418 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: ice velocity 419 d_u_ice_dyn, d_v_ice_dyn 420 362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_a_i_thd , d_a_i_trp !: icefractions 363 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_s_thd , d_v_s_trp !: snow volume 364 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_i_thd , d_v_i_trp !: ice volume 365 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_smv_i_thd, d_smv_i_trp !: 366 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_sm_i_fl , d_sm_i_gd !: 367 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_sm_i_se , d_sm_i_si , d_sm_i_la !: 368 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_oa_i_thd , d_oa_i_trp , s_i_newice !: 369 370 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_s_thd , d_e_s_trp !: 371 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_i_thd , d_e_i_trp !: 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: d_u_ice_dyn, d_v_ice_dyn !: ice velocity 373 421 374 !!-------------------------------------------------------------------------- 422 375 !! * Ice thickness distribution variables 423 376 !!-------------------------------------------------------------------------- 424 377 ! REMOVE 425 INTEGER, PUBLIC, DIMENSION(jpl) :: & !: 426 ice_types !: Vector making the connection between types and categories 427 428 INTEGER, PUBLIC, DIMENSION(jpm,2) :: & !: 429 ice_cat_bounds !: Matrix containing the integer upper and 430 !: lower boundaries of ice thickness categories 431 378 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ice_types !: Vector connecting types and categories 379 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ice_cat_bounds !: Matrix containing the integer upper and 380 ! ! lower boundaries of ice thickness categories 432 381 ! REMOVE 433 INTEGER, PUBLIC, DIMENSION(jpm) :: & !: 434 ice_ncat_types !: Vector containing the number of thickness categories in each ice type 435 436 REAL(wp), PUBLIC, DIMENSION(0:jpl) :: & !: 437 hi_max !: Boundary of ice thickness categories in thickness space 438 439 REAL(wp), PUBLIC, DIMENSION(jpl) :: & !: 440 hi_mean !: Mean ice thickness in catgories 441 382 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ice_ncat_types !: nb of thickness categories in each ice type 383 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 384 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 442 385 ! REMOVE 443 REAL(wp), PUBLIC, DIMENSION(0:jpl,jpm) :: & !: 444 hi_max_typ !: Boundary of ice thickness categories 445 !:in thickness space (same but specific for each ice type) 386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hi_max_typ !: Boundary of ice thickness categories in thickness space 446 387 447 388 !!-------------------------------------------------------------------------- 448 389 !! * Ice Run 449 390 !!-------------------------------------------------------------------------- 450 ! ! Namelist namicerun read in iceini391 ! !!: ** Namelist namicerun read in iceini ** 451 392 CHARACTER(len=32) , PUBLIC :: cn_icerst_in = "restart_ice_in" !: suffix of ice restart name (input) 452 393 CHARACTER(len=32) , PUBLIC :: cn_icerst_out = "restart_ice" !: suffix of ice restart name (output) … … 463 404 !!-------------------------------------------------------------------------- 464 405 !! Check if everything down here is necessary 465 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: volume of ice formed in the leads 466 v_newice 467 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) :: & !: thermodynamic growth rates 468 dv_dt_thd, & 469 izero, fstroc, fhbricat 470 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & 471 diag_sni_gr, & ! snow ice growth 472 diag_lat_gr, & ! lateral ice growth 473 diag_bot_gr, & ! bottom ice growth 474 diag_dyn_gr, & ! dynamical ice growth 475 diag_bot_me, & ! vertical bottom melt 476 diag_sur_me ! vertical surface melt 406 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: v_newice !: volume of ice formed in the leads 407 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates 408 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: izero, fstroc, fhbricat 409 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sni_gr ! snow ice growth 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_lat_gr ! lateral ice growth 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_gr ! bottom ice growth 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_dyn_gr ! dynamical ice growth 413 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_me ! vertical bottom melt 414 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sur_me ! vertical surface melt 477 415 INTEGER , PUBLIC :: jiindx, jjindx !: indexes of the debugging point 416 417 !!---------------------------------------------------------------------- 418 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 419 !! $Id$ 420 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 421 !!---------------------------------------------------------------------- 422 CONTAINS 423 424 FUNCTION ice_alloc() 425 !!----------------------------------------------------------------- 426 !! *** Routine ice_alloc_2 *** 427 !!----------------------------------------------------------------- 428 INTEGER :: ice_alloc 429 ! 430 INTEGER :: ierr(20), ii 431 !!----------------------------------------------------------------- 432 433 ierr(:) = 0 434 435 ! What could be one huge allocate statement is broken-up to try to 436 ! stay within Fortran's max-line length limit. 437 ii = 1 438 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 439 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , & 440 & pahu (jpi,jpj) , pahv (jpi,jpj) , & 441 & ust2s (jpi,jpj) , hicol (jpi,jpj) , & 442 & strp1 (jpi,jpj) , strp2 (jpi,jpj) , strength (jpi,jpj) , & 443 & stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , & 444 & delta_i (jpi,jpj) , divu_i (jpi,jpj) , shear_i (jpi,jpj) , STAT=ierr(ii) ) 445 446 ii = ii + 1 447 ALLOCATE( firic (jpi,jpj) , fcsic (jpi,jpj) , fleic (jpi,jpj) , qlatic (jpi,jpj) , & 448 & rdvosif (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif (jpi,jpj) , rdvonif (jpi,jpj) , & 449 & sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , hicifp (jpi,jpj) , & 450 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , fbif (jpi,jpj) , & 451 & rdmsnif (jpi,jpj) , rdmicif(jpi,jpj) , qldif (jpi,jpj) , qcmif (jpi,jpj) , & 452 & fdtcn (jpi,jpj) , qdtcn (jpi,jpj) , fstric (jpi,jpj) , fscmbq (jpi,jpj) , & 453 & ffltbif (jpi,jpj) , fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) , & 454 & fsalt_res(jpi,jpj) , fsbri (jpi,jpj) , fsalt_rpo(jpi,jpj) , fheat_rpo(jpi,jpj) , & 455 & fhbri (jpi,jpj) , fmmec (jpi,jpj) , fseqv (jpi,jpj) , fhmec (jpi,jpj) , & 456 & fheat_res(jpi,jpj) , STAT=ierr(ii) ) 457 458 ii = ii + 1 459 ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) , & 460 & fsup2D (jpi,jpj) , focea2D (jpi,jpj) , q_s (jpi,jpj) , STAT=ierr(ii) ) 461 462 ii = ii + 1 463 ALLOCATE( patho_case(jpi, jpj, jpl) , STAT=ierr(ii) ) 464 465 ! * Ice global state variables 466 ii = ii + 1 467 ALLOCATE( ht_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & 468 & v_s (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 469 & sm_i (jpi,jpj,jpl) , smv_i(jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 470 & ov_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 471 ii = ii + 1 472 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(jpi,jpj) , & 473 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) , & 474 & et_i (jpi,jpj) , et_s (jpi,jpj) , ot_i (jpi,jpj) , tm_i (jpi,jpj) , & 475 & bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) ) 476 ii = ii + 1 477 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) , & 478 & e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) , STAT=ierr(ii) ) 479 ii = ii + 1 480 ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) ) 481 482 ! * Moments for advection 483 ii = ii + 1 484 ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , STAT=ierr(ii) ) 485 ii = ii + 1 486 ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 487 & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , & 488 & STAT=ierr(ii) ) 489 ii = ii + 1 490 ALLOCATE( sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , & 491 & sxc0 (jpi,jpj,jpl) , syc0 (jpi,jpj,jpl) , sxxc0 (jpi,jpj,jpl) , syyc0 (jpi,jpj,jpl) , sxyc0 (jpi,jpj,jpl) , & 492 & sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) , & 493 & sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) , & 494 & STAT=ierr(ii) ) 495 ii = ii + 1 496 ALLOCATE( sxe (jpi,jpj,jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) , & 497 & syye(jpi,jpj,jkmax,jpl) , sxye(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) ) 498 499 ! * Old values of global variables 500 ii = ii + 1 501 ALLOCATE( old_v_s (jpi,jpj,jpl) , old_v_i (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) , & 502 & old_a_i (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax ,jpl) , & 503 & old_oa_i (jpi,jpj,jpl) , & 504 & old_u_ice(jpi,jpj) , old_v_ice(jpi,jpj) , STAT=ierr(ii) ) 505 506 ! * Increment of global variables 507 ii = ii + 1 508 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) , & 509 & 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) , & 510 & 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) , & 511 & d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , s_i_newice (jpi,jpj,jpl) , & 512 & STAT=ierr(ii) ) 513 ii = ii + 1 514 ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,jkmax,jpl) , d_u_ice_dyn(jpi,jpj) , & 515 & d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 516 517 ! * Ice thickness distribution variables 518 ii = ii + 1 519 ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types (jpm) , & 520 & hi_max (0:jpl) , hi_mean(jpl) , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) ) 521 522 ! * Ice diagnostics 523 ii = ii + 1 524 ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) , & 525 & izero (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) , & 526 & fstroc (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) , & 527 & fhbricat (jpi,jpj,jpl) , v_newice (jpi,jpj) , STAT=ierr(ii) ) 528 529 ice_alloc = MAXVAL( ierr(:) ) 530 IF( ice_alloc /= 0 ) CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 531 ! 532 END FUNCTION ice_alloc 478 533 479 534 #else -
trunk/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r2528 r2715 6 6 !! History : 3.0 ! 2008-03 (M. Vancoppenolle) LIM-3 original code 7 7 !! 3.3 ! 2010-12 (G. Madec) add call to lim_thd_init and lim_thd_sal_init 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim3 … … 13 14 !! ice_init : sea-ice model initialization 14 15 !!---------------------------------------------------------------------- 15 USE phycst ! physical constants 16 USE dom_oce ! ocean domain 17 USE sbc_oce ! Surface boundary condition: ocean fields 18 USE sbc_ice ! Surface boundary condition: ice fields 19 USE ice ! LIM: sea-ice variables 20 USE limmsh ! LIM: mesh 21 USE limistate ! LIM: initial state 22 USE limrst ! LIM: restart 23 USE limthd ! LIM: ice thermodynamics 24 USE limthd_sal ! LIM: ice thermodynamics: salinity 25 USE par_ice ! LIM: sea-ice parameters 26 USE limvar ! LIM: variables 27 USE in_out_manager ! I/O manager 28 USE lib_mpp ! MPP library 16 USE phycst ! physical constants 17 USE dom_oce ! ocean domain 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbc_ice ! Surface boundary condition: ice fields 20 USE ice ! LIM variables 21 USE par_ice ! LIM parameters 22 USE dom_ice ! LIM domain 23 USE thd_ice ! LIM thermodynamical variables 24 USE limitd_me ! LIM ice thickness distribution 25 USE limrhg ! LIM dynamics 26 USE limmsh ! LIM mesh 27 USE limistate ! LIM initial state 28 USE limrst ! LIM restart 29 USE limthd ! LIM ice thermodynamics 30 USE limthd_sal ! LIM ice thermodynamics: salinity 31 USE limvar ! LIM variables 32 USE limsbc ! LIM surface boundary condition 33 USE in_out_manager ! I/O manager 34 USE lib_mpp ! MPP library 29 35 30 36 IMPLICIT NONE 31 37 PRIVATE 32 38 33 PUBLIC ice_init ! called by opa.F9034 35 !!---------------------------------------------------------------------- 36 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)39 PUBLIC ice_init ! called by sbcice_lim.F90 40 41 !!---------------------------------------------------------------------- 42 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 37 43 !! $Id$ 38 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 44 50 !! *** ROUTINE ice_init *** 45 51 !! 46 !! ** purpose : 52 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 47 53 !!---------------------------------------------------------------------- 48 ! 54 INTEGER :: ierr 55 !!---------------------------------------------------------------------- 56 57 ! ! Allocate the ice arrays 58 ierr = ice_alloc () ! ice variables 59 ierr = ierr + dom_ice_alloc () ! domain 60 ierr = ierr + sbc_ice_alloc () ! surface forcing 61 ierr = ierr + thd_ice_alloc () ! thermodynamics 62 ierr = ierr + lim_itd_me_alloc() ! ice thickness distribution - mechanics 63 ierr = ierr + lim_rhg_alloc () ! dynamics 64 ! 65 IF( lk_mpp ) CALL mpp_sum( ierr ) 66 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays') 67 ! 68 ! ! adequation jpk versus ice/snow layers/categories 69 IF( jpl > jpk .OR. jpm > jpk .OR. & 70 jkmax > jpk .OR. nlay_s > jpk ) CALL ctl_stop( 'STOP', & 71 & 'ice_init: the 3rd dimension of workspace arrays is too small.', & 72 & 'use more ocean levels or less ice/snow layers/categories.' ) 73 49 74 ! ! Open the namelist file 50 75 CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 51 76 ! 52 CALL ice_run ! namelist readsome ice run parameters53 ! 54 CALL lim_thd_init ! namelist readice thermodynics parameters55 ! 56 CALL lim_thd_sal_init ! namelist readice salinity parameters77 CALL ice_run ! set some ice run parameters 78 ! 79 CALL lim_thd_init ! set ice thermodynics parameters 80 ! 81 CALL lim_thd_sal_init ! set ice salinity parameters 57 82 ! 58 83 rdt_ice = nn_fsbc * rdttra(1) ! sea-ice timestep … … 60 85 CALL lim_msh ! ice mesh initialization 61 86 ! 62 CALL lim_itd_ini ! initialize the ice thickness distribution 87 CALL lim_itd_ini ! ice thickness distribution initialization 88 ! 89 CALL lim_sbc_init ! ice surface boundary condition 90 63 91 64 92 ! ! Initial sea-ice state … … 94 122 !! 95 123 !! ** Method : Read the namicerun namelist and check the parameter 96 !! values called at the first timestep (nit000)124 !! values called at the first timestep (nit000) 97 125 !! 98 126 !! ** input : Namelist namicerun -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r2528 r2715 6 6 !! History : LIM ! 2008-03 (M. Vancoppenolle) LIM-3 from LIM-2 code 7 7 !! 3.2 ! 2009-06 (F. Dupont) correct a error in the North fold b. c. 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 9 !!-------------------------------------------------------------------- 9 10 #if defined key_lim3 … … 14 15 !! lim_adv_y : advection of sea ice on y axis 15 16 !!---------------------------------------------------------------------- 16 USE dom_oce 17 USE dom_ice 18 USE ice 19 USE lbclnk 20 USE in_out_manager ! I/O manager 21 USE prtctl ! Print control 17 USE dom_oce ! ocean domain 18 USE dom_ice ! LIM-3 domain 19 USE ice ! LIM-3 variables 20 USE lbclnk ! lateral boundary condition - MPP exchanges 21 USE in_out_manager ! I/O manager 22 USE prtctl ! Print control 23 USE lib_mpp ! MPP library 22 24 23 25 IMPLICIT NONE … … 27 29 PUBLIC lim_adv_y ! called by lim_trp 28 30 29 REAL(wp) :: epsi20 = 1.e-20 ! constant values30 REAL(wp) :: rzero = 0. e0! - -31 REAL(wp) :: rone = 1. e0! - -31 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 32 REAL(wp) :: rzero = 0._wp ! - - 33 REAL(wp) :: rone = 1._wp ! - - 32 34 33 35 !! * Substitutions 34 36 # include "vectopt_loop_substitute.h90" 35 37 !!---------------------------------------------------------------------- 36 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)38 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 37 39 !! $Id$ 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 40 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 41 42 CONTAINS 42 43 … … 55 56 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 56 57 !!-------------------------------------------------------------------- 58 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 59 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace 60 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - - 61 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - - 62 ! 57 63 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 58 64 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 64 70 !! 65 71 INTEGER :: ji, jj ! dummy loop indices 66 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp, zin0 ! temporary scalars 67 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 68 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 69 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace 70 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - - 71 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 72 REAL(wp) :: zs1max, zrdt, zslpmax, ztemp, zin0 ! local scalars 73 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 74 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 72 75 !--------------------------------------------------------------------- 76 77 IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 78 CALL ctl_stop('lim_adv_x: requested workspace arrays unavailable') ; RETURN 79 ENDIF 73 80 74 81 ! Limitation of moments. … … 216 223 CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :') 217 224 ENDIF 225 ! 226 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) & 227 CALL ctl_stop('lim_adv_x : failed to release workspace arrays') 218 228 ! 219 229 END SUBROUTINE lim_adv_x … … 234 244 !! Reference: Prather, 1986, JGR, 91, D6. 6671-6681. 235 245 !!--------------------------------------------------------------------- 246 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 247 USE wrk_nemo, ONLY: zf0 => wrk_2d_11 , zfx => wrk_2d_12 , zfy => wrk_2d_13 , zbet => wrk_2d_14 ! 2D workspace 248 USE wrk_nemo, ONLY: zfm => wrk_2d_15 , zfxx => wrk_2d_16 , zfyy => wrk_2d_17 , zfxy => wrk_2d_18 ! - - 249 USE wrk_nemo, ONLY: zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21 ! - - 250 ! 236 251 REAL(wp) , INTENT(in ) :: pdf ! reduction factor for the time step 237 252 REAL(wp) , INTENT(in ) :: pcrh ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) … … 246 261 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - 247 262 REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - - 248 REAL(wp), DIMENSION(jpi,jpj) :: zf0, zfx , zfy , zbet ! 2D workspace249 REAL(wp), DIMENSION(jpi,jpj) :: zfm, zfxx, zfyy, zfxy ! - -250 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - -251 263 !--------------------------------------------------------------------- 264 265 IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 266 CALL ctl_stop('lim_adv_y : requested workspace arrays unavailable') ; RETURN 267 ENDIF 252 268 253 269 ! Limitation of moments. … … 397 413 ENDIF 398 414 ! 415 IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) & 416 CALL ctl_stop('lim_adv_y: failed to release workspace arrays') 417 ! 399 418 END SUBROUTINE lim_adv_y 400 401 419 402 420 #else -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r2528 r2715 1 1 MODULE limcons 2 !!====================================================================== 3 !! *** MODULE limcons *** 4 !! LIM-3 Sea Ice : conservation check 5 !!====================================================================== 6 !! History : - ! Original code from William H. Lipscomb, LANL 7 !! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation 8 !! 4.0 ! 2011-02 (G. Madec) add mpp considerations 9 !!---------------------------------------------------------------------- 2 10 #if defined key_lim3 3 11 !!---------------------------------------------------------------------- 4 12 !! 'key_lim3' : LIM3 sea-ice model 5 13 !!---------------------------------------------------------------------- 6 !! 7 !!====================================================================== 8 !! *** MODULE limcons *** 9 !! 10 !! This module checks whether 11 !! Ice Total Energy 12 !! Ice Total Mass 13 !! Salt Mass 14 !! Are conserved ! 15 !! 16 !!====================================================================== 17 !! lim_cons : checks whether energy/mass are conserved 14 !! lim_cons : checks whether energy, mass and salt are conserved 18 15 !!---------------------------------------------------------------------- 19 !! 20 !! * Modules used 21 22 USE par_ice 23 USE dom_oce 24 USE dom_ice 25 USE ice 26 USE in_out_manager ! I/O manager 16 USE par_ice ! LIM-3 parameter 17 USE ice ! LIM-3 variables 18 USE dom_ice ! LIM-3 domain 19 USE dom_oce ! ocean domain 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! MPP library 27 22 28 23 IMPLICIT NONE 29 24 PRIVATE 30 25 31 !! * Accessibility 32 PUBLIC lim_column_sum 33 PUBLIC lim_column_sum_energy 34 PUBLIC lim_cons_check 35 36 !! * Module variables 37 !!---------------------------------------------------------------------- 38 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 39 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 26 PUBLIC lim_column_sum 27 PUBLIC lim_column_sum_energy 28 PUBLIC lim_cons_check 42 29 43 30 !!---------------------------------------------------------------------- 44 31 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 32 !! $Id$ 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !!---------------------------------------------------------------------- 45 35 CONTAINS 46 36 47 !=============================================================================== 48 49 SUBROUTINE lim_column_sum(nsum,xin,xout) 50 ! !!------------------------------------------------------------------- 51 ! !! *** ROUTINE lim_column_sum *** 52 ! !! 53 ! !! ** Purpose : Compute the sum of xin over nsum categories 54 ! !! 55 ! !! ** Method : Arithmetics 56 ! !! 57 ! !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj) 58 ! !! 59 ! !! History : 60 ! !! author: William H. Lipscomb, LANL 61 ! !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation 62 ! !!--------------------------------------------------------------------- 63 ! !! * Local variables 64 INTEGER, INTENT(in) :: & 65 nsum ! number of categories/layers 66 67 REAL (wp), DIMENSION(jpi, jpj, jpl), INTENT(IN) :: & 68 xin ! input field 69 70 REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) :: & 71 xout ! output field 72 INTEGER :: & 73 ji, jj, jl ! horizontal indices 74 75 ! !!--------------------------------------------------------------------- 76 ! WRITE(numout,*) ' lim_column_sum ' 77 ! WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 78 79 xout(:,:) = 0.00 80 81 DO jl = 1, nsum 82 DO jj = 1, jpj 83 DO ji = 1, jpi 84 xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jl) 85 END DO ! ji 86 END DO ! jj 87 END DO ! jl 88 37 SUBROUTINE lim_column_sum( ksum, pin, pout ) 38 !!------------------------------------------------------------------- 39 !! *** ROUTINE lim_column_sum *** 40 !! 41 !! ** Purpose : Compute the sum of xin over nsum categories 42 !! 43 !! ** Method : Arithmetics 44 !! 45 !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj) 46 !!--------------------------------------------------------------------- 47 INTEGER , INTENT(in ) :: ksum ! number of categories/layers 48 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pin ! input field 49 REAL(wp), DIMENSION(:,:) , INTENT( out) :: pout ! output field 50 ! 51 INTEGER :: jl ! dummy loop indices 52 !!--------------------------------------------------------------------- 53 ! 54 pout(:,:) = pin(:,:,1) 55 DO jl = 2, ksum 56 pout(:,:) = pout(:,:) + pin(:,:,jl) 57 END DO 58 ! 89 59 END SUBROUTINE lim_column_sum 90 60 91 !===============================================================================92 61 93 SUBROUTINE lim_column_sum_energy(nsum,nlay,xin,xout) 94 62 SUBROUTINE lim_column_sum_energy( ksum, klay, pin, pout) 95 63 !!------------------------------------------------------------------- 96 64 !! *** ROUTINE lim_column_sum_energy *** … … 100 68 !! 101 69 !! ** Method : Arithmetics 102 !!103 !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj)104 !!105 !! History :106 !! author: William H. Lipscomb, LANL107 !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation108 70 !!--------------------------------------------------------------------- 109 !! * Local variables 110 INTEGER, INTENT(in) :: & 111 nsum, & !: number of categories 112 nlay !: number of vertical layers 113 114 REAL (wp), DIMENSION(jpi, jpj, jkmax, jpl), INTENT(IN) :: & 115 xin !: input field 116 117 REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) :: & 118 xout !: output field 119 120 INTEGER :: & 121 ji, jj, & !: horizontal indices 122 jk, jl !: layer and category indices 71 INTEGER , INTENT(in ) :: ksum !: number of categories 72 INTEGER , INTENT(in ) :: klay !: number of vertical layers 73 REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl), INTENT(in ) :: pin !: input field 74 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field 75 ! 76 INTEGER :: jk, jl ! dummy loop indices 123 77 !!--------------------------------------------------------------------- 124 125 ! WRITE(numout,*) ' lim_column_sum_energy ' 126 ! WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~ ' 127 128 xout(:,:) = 0.00 129 130 DO jl = 1, nsum 131 DO jk = 1, nlay 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jk,jl) 135 END DO ! ji 136 END DO ! jj 137 END DO ! jk 138 END DO ! jl 139 78 ! 79 DO jl = 1, ksum 80 pout(:,:) = pin(:,:,1,jl) 81 DO jk = 2, klay 82 pout(:,:) = pout(:,:) + pin(:,:,jk,jl) 83 END DO 84 END DO 85 ! 140 86 END SUBROUTINE lim_column_sum_energy 141 87 142 !===============================================================================143 88 144 SUBROUTINE lim_cons_check( x1, x2, max_err, fieldid)89 SUBROUTINE lim_cons_check( px1, px2, pmax_err, cd_fieldid ) 145 90 !!------------------------------------------------------------------- 146 91 !! *** ROUTINE lim_cons_check *** … … 152 97 !! 153 98 !! ** Method : 154 !!155 !! ** Action : -156 !! History :157 !! author: William H. Lipscomb, LANL158 !! 2.1 ! 04-06 (M. Vancoppenolle) Energy Conservation159 99 !!--------------------------------------------------------------------- 160 !! * Local variables 100 REAL(wp), DIMENSION(:,:), INTENT(in ) :: px1 !: initial field 101 REAL(wp), DIMENSION(:,:), INTENT(in ) :: px2 !: final field 102 REAL(wp) , INTENT(in ) :: pmax_err !: max allowed error 103 CHARACTER(len=15) , INTENT(in ) :: cd_fieldid !: field identifyer 104 ! 105 INTEGER :: ji, jj ! dummy loop indices 106 INTEGER :: inb_error ! number of g.c where there is a cons. error 107 LOGICAL :: llconserv_err ! = .true. if conservation check failed 108 REAL(wp) :: zmean_error ! mean error on error points 109 !!--------------------------------------------------------------------- 110 ! 111 IF(lwp) WRITE(numout,*) ' lim_cons_check ' 112 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 161 113 162 REAL (wp), DIMENSION(jpi, jpj), INTENT(IN) :: & 163 x1 (jpi,jpj) , & !: initial field 164 x2 (jpi,jpj) !: final field 114 llconserv_err = .FALSE. 115 inb_error = 0 116 zmean_error = 0._wp 117 IF( MAXVAL( px2(:,:) - px1(:,:) ) > pmax_err ) llconserv_err = .TRUE. 165 118 166 REAL (wp) , INTENT ( IN ) :: & 167 max_err !: max allowed error 168 169 REAL (wp) :: & 170 mean_error !: mean error on error points 171 172 INTEGER :: & 173 num_error !: number of g.c where there is a cons. error 174 175 CHARACTER(len=15) , INTENT(IN) :: & 176 fieldid !: field identifyer 177 178 INTEGER :: & 179 ji, jj !: horizontal indices 180 181 LOGICAL :: & 182 conserv_err !: = .true. if conservation check failed 183 184 !!--------------------------------------------------------------------- 185 WRITE(numout,*) ' lim_cons_check ' 186 WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 187 188 conserv_err = .FALSE. 189 DO jj = 1, jpj 190 DO ji = 1, jpi 191 IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT. max_err) THEN 192 conserv_err = .TRUE. 193 ENDIF 194 END DO 195 END DO 196 197 IF ( conserv_err ) THEN 198 199 num_error = 0 200 mean_error = 0.0 119 IF( llconserv_err ) THEN 201 120 DO jj = 1, jpj 202 121 DO ji = 1, jpi 203 IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT.max_err ) THEN204 num_error = num_error + 1205 mean_error = mean_error + ABS(x2(ji,jj) - x1(ji,jj))206 207 WRITE (numout,*) ' ALERTE 99 '208 WRITE (numout,*) ' Conservation error: ', fieldid209 WRITE (numout,*) ' Point : ', ji, jj210 WRITE (numout,*) ' lat, lon : ', gphit(ji,jj), &211 glamt(ji,jj)212 WRITE (numout,*) ' Initial value : ',x1(ji,jj)213 WRITE (numout,*) ' Final value : ',x2(ji,jj)214 WRITE (numout,*) ' Difference : ', x2(ji,jj) -x1(ji,jj)215 122 IF( ABS( px2(ji,jj) - px1(ji,jj) ) > pmax_err ) THEN 123 inb_error = inb_error + 1 124 zmean_error = zmean_error + ABS( px2(ji,jj) - px1(ji,jj) ) 125 ! 126 IF(lwp) THEN 127 WRITE (numout,*) ' ALERTE 99 ' 128 WRITE (numout,*) ' Conservation error: ', cd_fieldid 129 WRITE (numout,*) ' Point : ', ji, jj 130 WRITE (numout,*) ' lat, lon : ', gphit(ji,jj), glamt(ji,jj) 131 WRITE (numout,*) ' Initial value : ', px1(ji,jj) 132 WRITE (numout,*) ' Final value : ', px2(ji,jj) 133 WRITE (numout,*) ' Difference : ', px2(ji,jj) - px1(ji,jj) 134 ENDIF 216 135 ENDIF 217 136 END DO 218 137 END DO 219 220 IF ( num_error .GT. 0 ) mean_error = mean_error / num_error 221 WRITE(numout,*) ' Conservation check for : ', fieldid 222 WRITE(numout,*) ' Number of error points : ', num_error 223 WRITE(numout,*) ' Mean error on these pts: ', mean_error 224 225 ENDIF ! conserv_err 226 138 ! 139 ENDIF 140 IF(lk_mpp) CALL mpp_sum( inb_error ) 141 IF(lk_mpp) CALL mpp_sum( zmean_error ) 142 ! 143 IF( inb_error > 0 .AND. lwp ) THEN 144 zmean_error = zmean_error / REAL( inb_error, wp ) 145 WRITE(numout,*) ' Conservation check for : ', cd_fieldid 146 WRITE(numout,*) ' Number of error points : ', inb_error 147 WRITE(numout,*) ' Mean error on these pts: ', zmean_error 148 ENDIF 149 ! 227 150 END SUBROUTINE lim_cons_check 228 151 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90
r2528 r2715 52 52 53 53 REAL(wp), DIMENSION(jpinfmx) :: vinfom ! temporary working space 54 REAL(wp), DIMENSION(jpi,jpj) :: aire ! masked grid cell area54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: aire ! masked grid cell area 55 55 56 56 !! * Substitutions … … 67 67 !! *** ROUTINE lim_dia *** 68 68 !! 69 !! ** Purpose : Computation and outputs on file ice.evolu70 !! the temporal evolution of some key variables69 !! ** Purpose : Computation and outputs on file ice.evolu 70 !! the temporal evolution of some key variables 71 71 !!------------------------------------------------------------------- 72 72 INTEGER :: jv, ji, jj, jl ! dummy loop indices … … 410 410 !!------------------------------------------------------------------- 411 411 INTEGER :: jv ! dummy loop indice 412 INTEGER :: ntot , ndeb , irecl ! local integers412 INTEGER :: ierr, ntot , ndeb , irecl ! local integers 413 413 REAL(wp) :: zxx0, zxx1 ! local scalars 414 414 CHARACTER(len=jpchinf) :: titinf … … 431 431 ENDIF 432 432 433 aire(:,:) = area(:,:) * tms(:,:) * tmask_i(:,:) ! masked grid cell area (interior domain only) 433 ALLOCATE( aire(jpi,jpj) , STAT=ierr ) ! masked grid cell area (interior domain only) 434 IF( lk_mpp ) CALL mpp_sum( ierr ) 435 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_dia_init_2 : unable to allocate arrays' ) 436 aire(:,:) = area(:,:) * tms(:,:) * tmask_i(:,:) 434 437 435 438 ! Titles of ice key variables : 436 439 titvar(1) = 'NoIt' ! iteration number 437 440 titvar(2) = 'T yr' ! time step in years 438 nbvt = 2! number of time variables441 nbvt = 2 ! number of time variables 439 442 440 443 titvar(3) = 'AI_N' ! sea ice area in the northern Hemisp.(10^12 km2) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r2528 r2715 4 4 !! Sea-Ice dynamics : 5 5 !!====================================================================== 6 !! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code 7 !! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid 6 !! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code 7 !! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim3 … … 14 15 !! lim_dyn_init : initialization and namelist read 15 16 !!---------------------------------------------------------------------- 16 USE phycst 17 USE in_out_manager ! I/O manager18 USE dom_ice19 USE dom_oce ! ocean space and time domain20 USE ice 21 USE par_ice 22 USE sbc_oce ! Surface boundary condition: ocean fields23 USE sbc_ice ! Surface boundary condition: ice fields24 USE l imrhg ! ice rheology25 USE l bclnk26 USE lib_mpp27 USE prtctl ! Print control17 USE phycst ! physical constants 18 USE dom_oce ! ocean space and time domain 19 USE sbc_oce ! Surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: ice fields 21 USE ice ! LIM-3 variables 22 USE par_ice ! LIM-3 parameters 23 USE dom_ice ! LIM-3 domain 24 USE limrhg ! LIM-3 rheology 25 USE lbclnk ! lateral boundary conditions - MPP exchanges 26 USE lib_mpp ! MPP library 27 USE in_out_manager ! I/O manager 28 USE prtctl ! Print control 28 29 29 30 IMPLICIT NONE … … 35 36 # include "vectopt_loop_substitute.h90" 36 37 !!---------------------------------------------------------------------- 37 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)38 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 38 39 !! $Id$ 39 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 54 55 !! - treatment of the case if no ice dynamic 55 56 !!------------------------------------------------------------------------------------ 57 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 58 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2 59 USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2 ! ice-ocean velocity 60 ! 56 61 INTEGER, INTENT(in) :: kt ! number of iteration 57 62 !! … … 59 64 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 60 65 REAL(wp) :: zcoef ! local scalar 61 REAL(wp), DIMENSION(jpj) :: zind ! i-averaged indicator of sea-ice 62 REAL(wp), DIMENSION(jpj) :: zmsk ! i-averaged of tmask 63 REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io ! ice-ocean velocity 66 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 67 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 64 68 !!--------------------------------------------------------------------- 65 69 66 IF( kt == nit000 .AND. lwp ) THEN 67 WRITE(numout,*) ' lim_dyn : Ice dynamics ' 68 WRITE(numout,*) ' ~~~~~~~ ' 69 ENDIF 70 71 IF( numit == nstart ) CALL lim_dyn_init ! Initialization (first time-step only) 72 73 IF ( ln_limdyn ) THEN 74 70 IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1,2) ) THEN 71 CALL ctl_stop('lim_dyn : requested workspace arrays unavailable') ; RETURN 72 ENDIF 73 zind => wrk_1d_1(1:jpj) ! Set-up pointers to sub-arrays of workspaces 74 zmsk => wrk_1d_2(1:jpj) 75 76 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) 77 78 IF( ln_limdyn ) THEN 79 ! 75 80 old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 76 81 old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) … … 88 93 CALL lim_rhg( i_j1, i_jpj ) 89 94 ELSE ! optimization of the computational area 90 95 ! 91 96 DO jj = 1, jpj 92 zind(jj) = SUM( 1.0 - at_i (:,jj ) ) ! = FLOAT(jpj) if ocean everywhere on a j-line93 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0if land everywhere on a j-line97 zind(jj) = SUM( 1.0 - at_i(:,jj) ) ! = REAL(jpj) if ocean everywhere on a j-line 98 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line 94 99 END DO 95 100 … … 106 111 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : NH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 107 112 CALL lim_rhg( i_j1, i_jpj ) 108 113 ! 109 114 ! Southern hemisphere 110 115 i_j1 = 1 … … 115 120 i_jpj = MIN( jpj, i_jpj+1 ) 116 121 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : SH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 117 118 CALL lim_rhg( i_j1, i_jpj )119 120 ELSE ! local domain extends over one hemisphere only121 ! ! Rheology is computed only over the ice cover122 ! ! latitude strip123 i_j1 = 1122 ! 123 CALL lim_rhg( i_j1, i_jpj ) 124 ! 125 ELSE ! local domain extends over one hemisphere only 126 ! ! Rheology is computed only over the ice cover 127 ! ! latitude strip 128 i_j1 = 1 124 129 DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 125 130 i_j1 = i_j1 + 1 … … 132 137 END DO 133 138 i_jpj = MIN( jpj, i_jpj+1) 134 139 ! 135 140 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : one hemisphere: i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 136 141 ! 137 142 CALL lim_rhg( i_j1, i_jpj ) 138 143 ! 139 144 ENDIF 140 145 ! 141 146 ENDIF 142 147 … … 147 152 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 148 153 ! frictional velocity at T-point 149 zcoef = 0.5 * cw154 zcoef = 0.5_wp * cw 150 155 DO jj = 2, jpjm1 151 156 DO ji = fs_2, fs_jpim1 ! vector opt. … … 157 162 ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean 158 163 ! 159 zcoef = SQRT( 0.5 ) / rau0164 zcoef = SQRT( 0.5_wp ) / rau0 160 165 DO jj = 2, jpjm1 161 166 DO ji = fs_2, fs_jpim1 ! vector opt. … … 207 212 ENDIF 208 213 ! 214 IF( wrk_not_released(1, 1,2) .OR. & 215 wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_dyn : failed to release workspace arrays' ) 216 ! 209 217 END SUBROUTINE lim_dyn 210 218 … … 271 279 ahiu(:,:) = ahi0 * umask(:,:,1) 272 280 ahiv(:,:) = ahi0 * vmask(:,:,1) 273 281 ! 274 282 END SUBROUTINE lim_dyn_init 275 283 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r2528 r2715 4 4 !! LIM ice model : horizontal diffusion of sea-ice quantities 5 5 !!====================================================================== 6 !! History : LIM ! 2000-01 (LIM) Original code 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 !! 1.0 ! 2002-08 (C. Ethe) F90, free form 9 !!---------------------------------------------------------------------- 6 10 #if defined key_lim3 7 11 !!---------------------------------------------------------------------- … … 10 14 !! lim_hdf : diffusion trend on sea-ice variable 11 15 !!---------------------------------------------------------------------- 12 !! * Modules used 13 USE dom_oce 14 USE in_out_manager 15 USE ice 16 USE lbclnk 17 USE lib_mpp 18 USE prtctl ! Print control 16 USE dom_oce ! ocean domain 17 USE ice ! LIM-3: ice variables 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 USE lib_mpp ! MPP library 20 USE prtctl ! Print control 21 USE in_out_manager ! I/O manager 19 22 20 23 IMPLICIT NONE 21 24 PRIVATE 22 25 23 !! * Routine accessibility 24 PUBLIC lim_hdf ! called by lim_tra 26 PUBLIC lim_hdf ! called by lim_tra 25 27 26 !! * Module variables 27 LOGICAL :: linit = .TRUE. ! ??? 28 LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call) 28 29 REAL(wp) :: epsi04 = 1e-04 ! constant 29 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! ???30 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! metric coefficient 30 31 31 32 !! * Substitution 32 33 # include "vectopt_loop_substitute.h90" 33 34 !!---------------------------------------------------------------------- 34 !! NEMO/LIM3 3.3, UCL - NEMO Consortium (2010)35 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 35 36 !! $Id$ 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 38 !!---------------------------------------------------------------------- 38 39 39 CONTAINS 40 40 … … 43 43 !! *** ROUTINE lim_hdf *** 44 44 !! 45 !! ** purpose : Compute and add the diffusive trend on sea-ice 46 !! variables 45 !! ** purpose : Compute and add the diffusive trend on sea-ice variables 47 46 !! 48 47 !! ** method : Second order diffusive operator evaluated using a 49 !! Cranck-Nicholson time Scheme.48 !! Cranck-Nicholson time Scheme. 50 49 !! 51 50 !! ** Action : update ptab with the diffusive contribution 52 !!53 !! History :54 !! ! 00-01 (LIM) Original code55 !! ! 01-05 (G. Madec, R. Hordoir) opa norm56 !! ! 02-08 (C. Ethe) F90, free form57 51 !!------------------------------------------------------------------- 58 ! * Arguments 59 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: & 60 ptab ! Field on which the diffusion is applied 61 REAL(wp), DIMENSION(jpi,jpj) :: & 62 ptab0 ! ??? 63 64 ! * Local variables 65 INTEGER :: ji, jj ! dummy loop indices 66 INTEGER :: & 67 its, iter ! temporary integers 68 CHARACTER (len=55) :: charout 69 REAL(wp) :: & 70 zalfa, zrlxint, zconv, zeps ! temporary scalars 71 REAL(wp), DIMENSION(jpi,jpj) :: & 72 zrlx, zflu, zflv, & ! temporary workspaces 73 zdiv0, zdiv ! " " 52 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 53 USE wrk_nemo, ONLY: zflu => wrk_2d_11, zdiv => wrk_2d_13, zrlx => wrk_2d_15 54 USE wrk_nemo, ONLY: zflv => wrk_2d_12, zdiv0 => wrk_2d_14, ztab0 => wrk_2d_16 55 ! 56 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 57 ! 58 INTEGER :: ji, jj ! dummy loop indices 59 INTEGER :: its, iter, ierr ! local integers 60 REAL(wp) :: zalfa, zrlxint, zconv, zeps ! local scalars 61 CHARACTER(lc) :: charout ! local character 74 62 !!------------------------------------------------------------------- 75 76 ! Initialisation 77 ! --------------- 78 ! Time integration parameters 79 zalfa = 0.5 ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 80 its = 100 ! Maximum number of iteration 81 zeps = 2. * epsi04 82 83 ! Arrays initialization 84 ptab0 (:, : ) = ptab(:,:) 85 !bug zflu (:,jpj) = 0.e0 86 !bug zflv (:,jpj) = 0.e0 87 zdiv0(:, 1 ) = 0.e0 88 zdiv0(:,jpj) = 0.e0 89 IF( .NOT.lk_vopt_loop ) THEN 90 zflu (jpi,:) = 0.e0 91 zflv (jpi,:) = 0.e0 92 zdiv0(1, :) = 0.e0 93 zdiv0(jpi,:) = 0.e0 63 64 IF( wrk_in_use(2, 11,12,13,14,15,16) ) THEN 65 CALL ctl_stop( 'lim_hdf: requested workspace arrays unavailable' ) ; RETURN 94 66 ENDIF 95 67 96 ! Metric coefficient (compute at the first call and saved in 97 IF( linit ) THEN 68 ! !== Initialisation ==! 69 ! 70 IF( linit ) THEN ! Metric coefficient (compute at the first call and saved in efact) 71 ALLOCATE( efact(jpi,jpj) , STAT=ierr ) 72 IF( lk_mpp ) CALL mpp_sum( ierr ) 73 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' ) 98 74 DO jj = 2, jpjm1 99 75 DO ji = fs_2 , fs_jpim1 ! vector opt. 100 zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj ) + e1v(ji,jj) + e1v(ji,jj-1) ) & 101 & / ( e1t(ji,jj) * e2t(ji,jj) ) 76 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) ) 102 77 END DO 103 78 END DO 104 79 linit = .FALSE. 105 80 ENDIF 81 ! ! Time integration parameters 82 zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 83 its = 100 ! Maximum number of iteration 84 zeps = 2._wp * epsi04 85 ! 86 ztab0(:, : ) = ptab(:,:) ! Arrays initialization 87 zdiv0(:, 1 ) = 0._wp 88 zdiv0(:,jpj) = 0._wp 89 IF( .NOT.lk_vopt_loop ) THEN 90 zflu (jpi,:) = 0._wp 91 zflv (jpi,:) = 0._wp 92 zdiv0(1, :) = 0._wp 93 zdiv0(jpi,:) = 0._wp 94 ENDIF 106 95 107 108 ! Sub-time step loop 109 zconv = 1.e0 96 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! 110 97 iter = 0 111 112 ! !=================== 113 DO WHILE ( ( zconv > zeps ) .AND. (iter <= its) ) ! Sub-time step loop 114 ! !=================== 115 ! incrementation of the sub-time step number 116 iter = iter + 1 117 118 ! diffusive fluxes in U- and V- direction 119 DO jj = 1, jpjm1 98 ! 99 DO WHILE( zconv > zeps .AND. iter <= its ) ! Sub-time step loop 100 ! 101 iter = iter + 1 ! incrementation of the sub-time step number 102 ! 103 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 120 104 DO ji = 1 , fs_jpim1 ! vector opt. 121 105 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) … … 123 107 END DO 124 108 END DO 125 126 ! diffusive trend : divergence of the fluxes 127 DO jj= 2, jpjm1 109 ! 110 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 128 111 DO ji = fs_2 , fs_jpim1 ! vector opt. 129 112 zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) & … … 131 114 END DO 132 115 END DO 133 134 ! save the first evaluation of the diffusive trend in zdiv0 135 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) 136 137 ! XXXX iterative evaluation????? 138 DO jj = 2, jpjm1 116 ! 117 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0 118 ! 119 DO jj = 2, jpjm1 ! iterative evaluation 139 120 DO ji = fs_2 , fs_jpim1 ! vector opt. 140 zrlxint = ( ptab0(ji,jj) &141 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + zfact(ji,jj) * ptab(ji,jj) ) &121 zrlxint = ( ztab0(ji,jj) & 122 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) & 142 123 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) ) & 143 & / ( 1.0 + zalfa * rdt_ice * zfact(ji,jj) )124 & / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 144 125 zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) ) 145 126 END DO 146 127 END DO 147 148 ! lateral boundary condition on zrlx 149 CALL lbc_lnk( zrlx, 'T', 1. ) 150 151 ! convergence test 152 zconv = 0.e0 128 CALL lbc_lnk( zrlx, 'T', 1. ) ! lateral boundary condition 129 ! 130 zconv = 0._wp ! convergence test 153 131 DO jj = 2, jpjm1 154 132 DO ji = fs_2, fs_jpim1 … … 156 134 END DO 157 135 END DO 158 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain 159 160 DO jj = 1, jpj 161 DO ji = 1 , jpi 162 ptab(ji,jj) = zrlx(ji,jj) 163 END DO 164 END DO 165 166 ! !========================== 136 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain 137 ! 138 ptab(:,:) = zrlx(:,:) 139 ! 167 140 END DO ! end of sub-time step loop 168 ! !==========================169 141 170 142 IF(ln_ctl) THEN 171 zrlx(:,:) = ptab(:,:) - ptab0(:,:)143 zrlx(:,:) = ptab(:,:) - ztab0(:,:) 172 144 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 173 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout)145 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 174 146 ENDIF 175 176 147 ! 148 IF( wrk_not_released(2, 11,12,13,14,15,16) ) CALL ctl_stop('lim_hdf: failed to release workspace arrays') 149 ! 177 150 END SUBROUTINE lim_hdf 178 151 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r2528 r2715 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2004-01 (C. Ethe, G. Madec) Original code 7 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 23 24 USE in_out_manager ! I/O manager 24 25 USE lbclnk ! lateral boundary condition - MPP exchanges 26 USE lib_mpp ! MPP library 25 27 26 28 IMPLICIT NONE … … 45 47 46 48 !!---------------------------------------------------------------------- 47 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)49 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 48 50 !! $Id$ 49 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 60 62 !! or from arbitrary sea-ice conditions 61 63 !!------------------------------------------------------------------- 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 65 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4 66 USE wrk_nemo, ONLY: zidto => wrk_2d_1 ! ice indicator 67 ! 62 68 INTEGER :: ji, jj, jk, jl ! dummy loop indices 63 69 REAL(wp) :: zeps6, zeps, ztmelts, epsi06 ! local scalars 64 REAL(wp) :: zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 65 REAL(wp), DIMENSION(jpm) :: zgfactorn, zhin 66 REAL(wp), DIMENSION(jpm) :: zgfactors, zhis 67 REAL(wp), DIMENSION(jpi,jpj) :: zidto ! ice indicator 68 !-------------------------------------------------------------------- 70 REAL(wp) :: zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 71 REAL(wp), POINTER, DIMENSION(:) :: zgfactorn, zhin 72 REAL(wp), POINTER, DIMENSION(:) :: zgfactors, zhis 73 !-------------------------------------------------------------------- 74 75 IF( wrk_in_use(1, 1,2) ) THEN 76 CALL ctl_stop( 'lim_istate: requested workspace arrays unavailable' ) ; RETURN 77 ENDIF 78 zgfactorn => wrk_1d_1(1:jpm) ; zhin => wrk_1d_3(1:jpm) ! Set-up pointers to sub-arrays of workspaces 79 zgfactors => wrk_1d_2(1:jpm) ; zhis => wrk_1d_4(1:jpm) 69 80 70 81 !-------------------------------------------------------------------- … … 506 517 CALL lbc_lnk( fsbbq , 'T', 1. ) 507 518 ! 519 IF( wrk_not_released(1, 1,2) ) CALL ctl_stop('lim_istate : failed to release workspace arrays') 520 ! 508 521 END SUBROUTINE lim_istate 509 522 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r2528 r2715 2 2 !!====================================================================== 3 3 !! *** MODULE limitd_me *** 4 !! Mechanical impact on ice thickness distribution 5 !! computation of changes in g(h) 4 !! LIM-3 : Mechanical impact on ice thickness distribution 6 5 !!====================================================================== 7 6 !! History : LIM ! 2006-02 (M. Vancoppenolle) Original code 8 7 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & fsalt_rpo 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_lim3 … … 12 12 !! 'key_lim3' : LIM3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 USE dom_ice15 14 USE par_oce ! ocean parameters 16 USE dom_oce 17 USE lbclnk 15 USE dom_oce ! ocean domain 18 16 USE phycst ! physical constants (ocean directory) 19 USE sbc_oce ! Surface boundary condition: ocean fields 20 USE thd_ice 21 USE in_out_manager 22 USE ice 23 USE par_ice 24 USE limthd_lac 25 USE limvar 26 USE limcons 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE thd_ice ! LIM thermodynamics 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters 21 USE dom_ice ! LIM domain 22 USE limthd_lac ! LIM 23 USE limvar ! LIM 24 USE limcons ! LIM 25 USE in_out_manager ! I/O manager 26 USE lbclnk ! lateral boundary condition - MPP exchanges 27 USE lib_mpp ! MPP library 27 28 USE prtctl ! Print control 28 USE lib_mpp29 USE wrk_nemo ! workspace manager 29 30 30 31 IMPLICIT NONE 31 32 PRIVATE 32 33 33 !! * Routine accessibility 34 PUBLIC lim_itd_me ! called by ice_stp 35 PUBLIC lim_itd_me_icestrength 36 PUBLIC lim_itd_me_ridgeprep 37 PUBLIC lim_itd_me_ridgeshift 38 PUBLIC lim_itd_me_asumr 39 PUBLIC lim_itd_me_init 40 PUBLIC lim_itd_me_zapsmall 41 42 !! * Module variables 43 REAL(wp) :: & ! constant values 44 epsi20 = 1e-20 , & 45 epsi13 = 1e-13 , & 46 epsi11 = 1e-11 , & 47 zzero = 0.e0 , & 48 zone = 1.e0 34 PUBLIC lim_itd_me ! called by ice_stp 35 PUBLIC lim_itd_me_icestrength 36 PUBLIC lim_itd_me_init 37 PUBLIC lim_itd_me_zapsmall 38 PUBLIC lim_itd_me_alloc ! called by nemogcm.F90 39 40 REAL(wp) :: epsi11 = 1.e-11_wp ! constant values 41 REAL(wp) :: epsi10 = 1.e-10_wp ! constant values 42 REAL(wp) :: epsi06 = 1.e-06_wp ! constant values 49 43 50 44 !----------------------------------------------------------------------- 51 45 ! Variables shared among ridging subroutines 52 46 !----------------------------------------------------------------------- 53 REAL(wp), DIMENSION (jpi,jpj) :: & 54 asum , & ! sum of total ice and open water area 55 aksum ! ratio of area removed to area ridged 56 57 REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: & 58 athorn ! participation function; fraction of ridging/ 59 ! closing associated w/ category n 60 61 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 62 hrmin , & ! minimum ridge thickness 63 hrmax , & ! maximum ridge thickness 64 hraft , & ! thickness of rafted ice 65 krdg , & ! mean ridge thickness/thickness of ridging ice 66 aridge , & ! participating ice ridging 67 araft ! participating ice rafting 68 69 REAL(wp), PARAMETER :: & 70 krdgmin = 1.1, & ! min ridge thickness multiplier 71 kraft = 2.0 ! rafting multipliyer 72 73 REAL(wp) :: & 74 Cp 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: asum ! sum of total ice and open water area 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: aksum ! ratio of area removed to area ridged 49 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: athorn ! participation function; fraction of ridging/ 51 ! ! closing associated w/ category n 52 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmin ! minimum ridge thickness 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hrmax ! maximum ridge thickness 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hraft ! thickness of rafted ice 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: krdg ! mean ridge thickness/thickness of ridging ice 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aridge ! participating ice ridging 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: araft ! participating ice rafting 59 60 REAL(wp), PARAMETER :: krdgmin = 1.1_wp ! min ridge thickness multiplier 61 REAL(wp), PARAMETER :: kraft = 2.0_wp ! rafting multipliyer 62 63 REAL(wp) :: Cp ! 75 64 ! 76 65 !----------------------------------------------------------------------- 77 66 ! Ridging diagnostic arrays for history files 78 67 !----------------------------------------------------------------------- 79 ! 80 REAL (wp), DIMENSION(jpi,jpj) :: & 81 dardg1dt , & ! rate of fractional area loss by ridging ice (1/s) 82 dardg2dt , & ! rate of fractional area gain by new ridges (1/s) 83 dvirdgdt , & ! rate of ice volume ridged (m/s) 84 opening ! rate of opening due to divergence/shear (1/s) 85 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dardg1dt ! rate of fractional area loss by ridging ice (1/s) 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dardg2dt ! rate of fractional area gain by new ridges (1/s) 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dvirdgdt ! rate of ice volume ridged (m/s) 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: opening ! rate of opening due to divergence/shear (1/s) 86 72 87 73 !!---------------------------------------------------------------------- 88 74 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 89 75 !! $Id$ 90 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)76 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 91 77 !!---------------------------------------------------------------------- 92 93 94 78 CONTAINS 95 79 96 !!-----------------------------------------------------------------------------! 97 !!-----------------------------------------------------------------------------! 98 99 SUBROUTINE lim_itd_me ! (subroutine 1/6) 80 INTEGER FUNCTION lim_itd_me_alloc() 81 !!---------------------------------------------------------------------! 82 !! *** ROUTINE lim_itd_me_alloc *** 83 !!---------------------------------------------------------------------! 84 ALLOCATE( & 85 !* Variables shared among ridging subroutines 86 & asum (jpi,jpj) , athorn(jpi,jpj,0:jpl) , & 87 & aksum(jpi,jpj) , & 88 ! 89 & hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , & 90 & hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , & 91 ! 92 !* Ridging diagnostic arrays for history files 93 & dardg1dt(jpi,jpj) , dardg2dt(jpi,jpj) , & 94 & dvirdgdt(jpi,jpj) , opening(jpi,jpj) , STAT=lim_itd_me_alloc ) 95 ! 96 IF( lim_itd_me_alloc /= 0 ) CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' ) 97 ! 98 END FUNCTION lim_itd_me_alloc 99 100 101 SUBROUTINE lim_itd_me 100 102 !!---------------------------------------------------------------------! 101 103 !! *** ROUTINE lim_itd_me *** 102 !! ** Purpose : 103 !! This routine computes the mechanical redistribution 104 !! of ice thickness 105 !! 106 !! ** Method : a very simple method :-) 107 !! 108 !! ** Arguments : 109 !! kideb , kiut : Starting and ending points on which the 110 !! the computation is applied 111 !! 112 !! ** Inputs / Ouputs : (global commons) 113 !! 114 !! ** External : 115 !! 116 !! ** Steps : 117 !! 1) Thickness categories boundaries, ice / o.w. concentrations 118 !! Ridge preparation 119 !! 2) Dynamical inputs (closing rate, divu_adv, opning) 120 !! 3) Ridging iteration 121 !! 4) Ridging diagnostics 122 !! 5) Heat, salt and freshwater fluxes 123 !! 6) Compute increments of tate variables and come back to old values 124 !! 125 !! ** References : There are a lot of references and can be difficult / 126 !! boring to read 127 !! 128 !! Flato, G. M., and W. D. Hibler III, 1995: Ridging and strength 129 !! in modeling the thickness distribution of Arctic sea ice, 130 !! J. Geophys. Res., 100, 18,611-18,626. 131 !! 132 !! Hibler, W. D. III, 1980: Modeling a variable thickness sea ice 133 !! cover, Mon. Wea. Rev., 108, 1943-1973, 1980. 134 !! 135 !! Rothrock, D. A., 1975: The energetics of the plastic deformation of 136 !! pack ice by ridging, J. Geophys. Res., 80, 4514-4519. 137 !! 138 !! Thorndike, A. S., D. A. Rothrock, G. A. Maykut, and R. Colony, 139 !! 1975: The thickness distribution of sea ice, J. Geophys. Res., 140 !! 80, 4501-4513. 141 !! 142 !! Bitz et al., JGR 2001 143 !! 144 !! Amundrud and Melling, JGR 2005 145 !! 146 !! Babko et al., JGR 2002 104 !! 105 !! ** Purpose : computes the mechanical redistribution of ice thickness 106 !! 107 !! ** Method : Steps : 108 !! 1) Thickness categories boundaries, ice / o.w. concentrations 109 !! Ridge preparation 110 !! 2) Dynamical inputs (closing rate, divu_adv, opning) 111 !! 3) Ridging iteration 112 !! 4) Ridging diagnostics 113 !! 5) Heat, salt and freshwater fluxes 114 !! 6) Compute increments of tate variables and come back to old values 115 !! 116 !! References : Flato, G. M., and W. D. Hibler III, 1995, JGR, 100, 18,611-18,626. 117 !! Hibler, W. D. III, 1980, MWR, 108, 1943-1973, 1980. 118 !! Rothrock, D. A., 1975: JGR, 80, 4514-4519. 119 !! Thorndike et al., 1975, JGR, 80, 4501-4513. 120 !! Bitz et al., JGR, 2001 121 !! Amundrud and Melling, JGR 2005 122 !! Babko et al., JGR 2002 147 123 !! 148 124 !! This routine is based on CICE code and authors William H. Lipscomb, 149 125 !! and Elizabeth C. Hunke, LANL are gratefully acknowledged 150 126 !!--------------------------------------------------------------------! 151 !! * Arguments 152 153 !! * Local variables 154 INTEGER :: ji, & ! spatial dummy loop index 155 jj, & ! spatial dummy loop index 156 jk, & ! vertical layering dummy loop index 157 jl, & ! ice category dummy loop index 158 niter, & ! iteration counter 159 nitermax = 20 ! max number of ridging iterations 160 161 REAL(wp) :: & ! constant values 162 zeps = 1.0e-10, & 163 epsi10 = 1.0e-10, & 164 epsi06 = 1.0e-6 165 166 REAL(wp), DIMENSION(jpi,jpj) :: & 167 closing_net, & ! net rate at which area is removed (1/s) 168 ! (ridging ice area - area of new ridges) / dt 169 divu_adv , & ! divu as implied by transport scheme (1/s) 170 opning , & ! rate of opening due to divergence/shear 171 closing_gross, & ! rate at which area removed, not counting 172 ! area of new ridges 173 msnow_mlt , & ! mass of snow added to ocean (kg m-2) 174 esnow_mlt ! energy needed to melt snow in ocean (J m-2) 175 176 REAL(wp) :: & 177 w1, & ! temporary variable 178 tmpfac, & ! factor by which opening/closing rates are cut 179 dti ! 1 / dt 180 181 LOGICAL :: & 182 asum_error ! flag for asum .ne. 1 183 184 INTEGER :: iterate_ridging ! if true, repeat the ridging 185 186 REAL(wp) :: & 187 big = 1.0e8 188 189 REAL (wp), DIMENSION(jpi,jpj) :: & ! 190 vt_i_init, vt_i_final ! ice volume summed over categories 191 192 CHARACTER (len = 15) :: fieldid 193 194 !!-- End of declarations 195 !-----------------------------------------------------------------------------! 196 197 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only) 127 USE wrk_nemo, ONLY: closing_net => wrk_2d_1 ! net rate at which area is removed (1/s) 128 ! ! (ridging ice area - area of new ridges) / dt 129 USE wrk_nemo, ONLY: divu_adv => wrk_2d_2 ! divu as implied by transport scheme (1/s) 130 USE wrk_nemo, ONLY: opning => wrk_2d_3 ! rate of opening due to divergence/shear 131 USE wrk_nemo, ONLY: closing_gross => wrk_2d_4 ! rate at which area removed, not counting area of new ridges 132 USE wrk_nemo, ONLY: msnow_mlt => wrk_2d_5 ! mass of snow added to ocean (kg m-2) 133 USE wrk_nemo, ONLY: esnow_mlt => wrk_2d_6 ! energy needed to melt snow in ocean (J m-2) 134 USE wrk_nemo, ONLY: vt_i_init => wrk_2d_7 ! ice volume summed over 135 USE wrk_nemo, ONLY: vt_i_final => wrk_2d_8 ! categories 136 ! 137 INTEGER :: ji, jj, jk, jl ! dummy loop index 138 INTEGER :: niter, nitermax = 20 ! local integer 139 LOGICAL :: asum_error ! flag for asum .ne. 1 140 INTEGER :: iterate_ridging ! if true, repeat the ridging 141 REAL(wp) :: w1, tmpfac, dti ! local scalar 142 CHARACTER (len = 15) :: fieldid 143 !!----------------------------------------------------------------------------- 144 145 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 146 CALL ctl_stop('lim_itd_me: requested workspace arrays unavailable') ; RETURN 147 ENDIF 148 149 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only) 198 150 199 151 IF(ln_ctl) THEN … … 210 162 hi_max(jpl) = 999.99 211 163 212 Cp = 0.5 * grav * (rau0-rhoic)*rhoic/rau0! proport const for PE164 Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0 ! proport const for PE 213 165 CALL lim_itd_me_ridgeprep ! prepare ridging 214 166 215 ! conservation check 216 IF ( con_i) CALL lim_column_sum (jpl, v_i, vt_i_init) 217 218 ! Initialize arrays. 219 DO jj = 1, jpj 167 IF( con_i) CALL lim_column_sum( jpl, v_i, vt_i_init ) ! conservation check 168 169 DO jj = 1, jpj ! Initialize arrays. 220 170 DO ji = 1, jpi 221 222 msnow_mlt(ji,jj) = 0.0 223 esnow_mlt(ji,jj) = 0.0 224 dardg1dt(ji,jj) = 0.0 225 dardg2dt(ji,jj) = 0.0 226 dvirdgdt(ji,jj) = 0.0 227 opening (ji,jj) = 0.0 171 msnow_mlt(ji,jj) = 0._wp 172 esnow_mlt(ji,jj) = 0._wp 173 dardg1dt (ji,jj) = 0._wp 174 dardg2dt (ji,jj) = 0._wp 175 dvirdgdt (ji,jj) = 0._wp 176 opening (ji,jj) = 0._wp 228 177 229 178 !-----------------------------------------------------------------------------! … … 246 195 ! (thick, newly ridged ice). 247 196 248 closing_net(ji,jj) = & 249 Cs*0.5*(Delta_i(ji,jj)-ABS(divu_i(ji,jj))) - MIN(divu_i(ji,jj),0.0) 197 closing_net(ji,jj) = Cs * 0.5 * ( Delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 250 198 251 199 ! 2.2 divu_adv … … 258 206 ! to give asum = 1.0 after ridging. 259 207 260 divu_adv(ji,jj) = (1.0-asum(ji,jj)) / rdt_ice ! asum found in ridgeprep 261 262 IF (divu_adv(ji,jj) .LT. 0.0) & 263 closing_net(ji,jj) = max(closing_net(ji,jj), -divu_adv(ji,jj)) 208 divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) / rdt_ice ! asum found in ridgeprep 209 210 IF( divu_adv(ji,jj) < 0._wp ) closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) ) 264 211 265 212 ! 2.3 opning … … 268 215 ! asum = 1.0 after ridging. 269 216 opning(ji,jj) = closing_net(ji,jj) + divu_adv(ji,jj) 270 271 217 END DO 272 218 END DO … … 275 221 ! 3) Ridging iteration 276 222 !-----------------------------------------------------------------------------! 277 niter = 1 ! iteration counter223 niter = 1 ! iteration counter 278 224 iterate_ridging = 1 279 280 225 281 226 DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax ) … … 315 260 DO jj = 1, jpj 316 261 DO ji = 1, jpi 317 IF ( a_i(ji,jj,jl) .GT. epsi11 .AND. athorn(ji,jj,jl) .GT. 0.0 )THEN262 IF ( a_i(ji,jj,jl) > epsi11 .AND. athorn(ji,jj,jl) > 0._wp )THEN 318 263 w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 319 IF ( w1 .GT.a_i(ji,jj,jl) ) THEN264 IF ( w1 > a_i(ji,jj,jl) ) THEN 320 265 tmpfac = a_i(ji,jj,jl) / w1 321 266 closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 322 opning (ji,jj) = opning(ji,jj) * tmpfac267 opning (ji,jj) = opning (ji,jj) * tmpfac 323 268 ENDIF 324 269 ENDIF … … 330 275 !-----------------------------------------------------------------------------! 331 276 332 CALL lim_itd_me_ridgeshift (opning, closing_gross, & 333 msnow_mlt, esnow_mlt) 277 CALL lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt ) 334 278 335 279 ! 3.4 Compute total area of ice plus open water after ridging. … … 348 292 DO ji = 1, jpi 349 293 IF (ABS(asum(ji,jj) - 1.0) .LT. epsi11) THEN 350 closing_net(ji,jj) = 0. 0351 opning (ji,jj) = 0.0294 closing_net(ji,jj) = 0._wp 295 opning (ji,jj) = 0._wp 352 296 ELSE 353 297 iterate_ridging = 1 354 divu_adv (ji,jj) = (1.0- asum(ji,jj)) / rdt_ice355 closing_net(ji,jj) = MAX( 0.0, -divu_adv(ji,jj))356 opning (ji,jj) = MAX(0.0, divu_adv(ji,jj))298 divu_adv (ji,jj) = (1._wp - asum(ji,jj)) / rdt_ice 299 closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) ) 300 opning (ji,jj) = MAX( 0._wp, divu_adv(ji,jj) ) 357 301 ENDIF 358 302 END DO 359 303 END DO 360 304 361 IF( lk_mpp ) CALL mpp_max(iterate_ridging)305 IF( lk_mpp ) CALL mpp_max( iterate_ridging ) 362 306 363 307 ! Repeat if necessary. … … 368 312 niter = niter + 1 369 313 370 IF (iterate_ridging == 1) THEN371 IF (niter .GT. nitermax) THEN314 IF( iterate_ridging == 1 ) THEN 315 IF( niter .GT. nitermax ) THEN 372 316 WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 373 317 WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging … … 384 328 ! Update fresh water and heat fluxes due to snow melt. 385 329 386 dti = 1. 0/rdt_ice330 dti = 1._wp / rdt_ice 387 331 388 332 asum_error = .false. … … 401 345 ! 5) Heat, salt and freshwater fluxes 402 346 !-----------------------------------------------------------------------------! 403 ! fresh water source for ocean 404 fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj)*dti 405 406 ! heat sink for ocean 407 fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj)*dti 347 fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * dti ! fresh water source for ocean 348 fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * dti ! heat sink for ocean 408 349 409 350 END DO … … 446 387 !----------------- 447 388 448 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:) 449 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:) 450 d_a_i_trp(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:) 451 d_v_s_trp(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:) 452 d_v_i_trp(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:) 453 d_e_s_trp(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 454 d_e_i_trp(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 455 d_oa_i_trp(:,:,:) = oa_i(:,:,:) - old_oa_i(:,:,:) 456 d_smv_i_trp(:,:,:) = 0.0 457 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 458 d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 389 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:) 390 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:) 391 d_a_i_trp (:,:,:) = a_i (:,:,:) - old_a_i (:,:,:) 392 d_v_s_trp (:,:,:) = v_s (:,:,:) - old_v_s (:,:,:) 393 d_v_i_trp (:,:,:) = v_i (:,:,:) - old_v_i (:,:,:) 394 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - old_e_s (:,:,:,:) 395 d_e_i_trp (:,:,:,:) = e_i (:,:,:,:) - old_e_i (:,:,:,:) 396 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 397 d_smv_i_trp(:,:,:) = 0._wp 398 IF( num_sal == 2 .OR. num_sal == 4 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 459 399 460 400 IF(ln_ctl) THEN ! Control print … … 503 443 e_i(:,:,:,:) = old_e_i(:,:,:,:) 504 444 oa_i(:,:,:) = old_oa_i(:,:,:) 505 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 506 smv_i(:,:,:) = old_smv_i(:,:,:) 445 IF( num_sal == 2 .OR. num_sal == 4 ) smv_i(:,:,:) = old_smv_i(:,:,:) 507 446 508 447 !----------------------------------------------------! … … 518 457 DO jj = 1, jpj 519 458 DO ji = 1, jpi 520 IF ( ( old_v_i(ji,jj,jl) .LT.epsi06 ) .AND. &521 ( d_v_i_trp(ji,jj,jl) .GT.epsi06 ) ) THEN459 IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 460 ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 522 461 old_e_i(ji,jj,jk,jl) = d_e_i_trp(ji,jj,jk,jl) 523 d_e_i_trp(ji,jj,jk,jl) = 0. 0462 d_e_i_trp(ji,jj,jk,jl) = 0._wp 524 463 ENDIF 525 464 END DO … … 531 470 DO jj = 1, jpj 532 471 DO ji = 1, jpi 533 IF ( ( old_v_i(ji,jj,jl) .LT.epsi06 ) .AND. &534 ( d_v_i_trp(ji,jj,jl) .GT.epsi06 ) ) THEN472 IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 473 ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 535 474 old_v_i(ji,jj,jl) = d_v_i_trp(ji,jj,jl) 536 d_v_i_trp(ji,jj,jl) = 0. 0475 d_v_i_trp(ji,jj,jl) = 0._wp 537 476 old_a_i(ji,jj,jl) = d_a_i_trp(ji,jj,jl) 538 d_a_i_trp(ji,jj,jl) = 0. 0477 d_a_i_trp(ji,jj,jl) = 0._wp 539 478 old_v_s(ji,jj,jl) = d_v_s_trp(ji,jj,jl) 540 d_v_s_trp(ji,jj,jl) = 0. 0479 d_v_s_trp(ji,jj,jl) = 0._wp 541 480 old_e_s(ji,jj,1,jl) = d_e_s_trp(ji,jj,1,jl) 542 d_e_s_trp(ji,jj,1,jl) = 0. 0481 d_e_s_trp(ji,jj,1,jl) = 0._wp 543 482 old_oa_i(ji,jj,jl) = d_oa_i_trp(ji,jj,jl) 544 d_oa_i_trp(ji,jj,jl) = 0.0 545 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 546 old_smv_i(ji,jj,jl) = d_smv_i_trp(ji,jj,jl) 547 d_smv_i_trp(ji,jj,jl) = 0.0 483 d_oa_i_trp(ji,jj,jl) = 0._wp 484 IF( num_sal == 2 .OR. num_sal == 4 ) old_smv_i(ji,jj,jl) = d_smv_i_trp(ji,jj,jl) 485 d_smv_i_trp(ji,jj,jl) = 0._wp 548 486 ENDIF 549 487 END DO … … 551 489 END DO 552 490 491 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('lim_itd_me: failed to release workspace arrays') 492 ! 553 493 END SUBROUTINE lim_itd_me 554 494 555 !=============================================================================== 556 557 SUBROUTINE lim_itd_me_icestrength (kstrngth) ! (subroutine 2/6) 558 495 496 SUBROUTINE lim_itd_me_icestrength( kstrngth ) 559 497 !!---------------------------------------------------------------------- 560 498 !! *** ROUTINE lim_itd_me_icestrength *** 561 !! ** Purpose : 562 !! This routine computes ice strength used in dynamics routines 563 !! of ice thickness 564 !! 565 !! ** Method : 566 !! Compute the strength of the ice pack, defined as the energy (J m-2) 567 !! dissipated per unit area removed from the ice pack under compression, 568 !! and assumed proportional to the change in potential energy caused 569 !! by ridging. Note that only Hibler's formulation is stable and that 570 !! ice strength has to be smoothed 499 !! 500 !! ** Purpose : computes ice strength used in dynamics routines of ice thickness 501 !! 502 !! ** Method : Compute the strength of the ice pack, defined as the energy (J m-2) 503 !! dissipated per unit area removed from the ice pack under compression, 504 !! and assumed proportional to the change in potential energy caused 505 !! by ridging. Note that only Hibler's formulation is stable and that 506 !! ice strength has to be smoothed 571 507 !! 572 508 !! ** Inputs / Ouputs : kstrngth (what kind of ice strength we are using) 573 !!574 !! ** External :575 !!576 !! ** References :577 !!578 509 !!---------------------------------------------------------------------- 579 !! * Arguments 580 581 INTEGER, INTENT(in) :: & 582 kstrngth ! = 1 for Rothrock formulation, 0 for Hibler (1979) 583 584 INTEGER :: & 585 ji,jj, & !: horizontal indices 586 jl, & !: thickness category index 587 ksmooth, & !: smoothing the resistance to deformation 588 numts_rm !: number of time steps for the P smoothing 589 590 REAL(wp) :: & 591 hi, & !: ice thickness (m) 592 zw1, & !: temporary variable 593 zp, & !: temporary ice strength 594 zdummy 595 596 REAL(wp), DIMENSION(jpi,jpj) :: & 597 zworka !: temporary array used here 510 USE wrk_nemo, ONLY: zworka => wrk_2d_1 ! 2D workspace 511 ! 512 INTEGER, INTENT(in) :: kstrngth ! = 1 for Rothrock formulation, 0 for Hibler (1979) 513 514 INTEGER :: ji,jj, jl ! dummy loop indices 515 INTEGER :: ksmooth ! smoothing the resistance to deformation 516 INTEGER :: numts_rm ! number of time steps for the P smoothing 517 518 REAL(wp) :: hi, zw1, zp, zdummy, zzc, z1_3 ! local scalars 519 !!---------------------------------------------------------------------- 520 521 IF( wrk_in_use(2, 1) ) THEN 522 CALL ctl_stop('lim_itd_me_icestrength : requested workspace array unavailable') ; RETURN 523 ENDIF 598 524 599 525 !------------------------------------------------------------------------------! 600 526 ! 1) Initialize 601 527 !------------------------------------------------------------------------------! 602 strength(:,:) = 0. 0528 strength(:,:) = 0._wp 603 529 604 530 !------------------------------------------------------------------------------! … … 610 536 ! 3) Rothrock(1975)'s method 611 537 !------------------------------------------------------------------------------! 612 IF (kstrngth == 1) then613 538 IF( kstrngth == 1 ) THEN 539 z1_3 = 1._wp / 3._wp 614 540 DO jl = 1, jpl 615 541 DO jj= 1, jpj 616 542 DO ji = 1, jpi 617 618 IF( ( a_i(ji,jj,jl) .GT. epsi11 )&619 .AND. ( athorn(ji,jj,jl) .GT. 0.0 )) THEN543 ! 544 IF( a_i(ji,jj,jl) > epsi11 .AND. & 545 athorn(ji,jj,jl) > 0._wp ) THEN 620 546 hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 621 547 !---------------------------- 622 548 ! PE loss from deforming ice 623 549 !---------------------------- 624 strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * & 625 hi * hi 550 strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi * hi 626 551 627 552 !-------------------------- 628 553 ! PE gain from rafting ice 629 554 !-------------------------- 630 strength(ji,jj) = strength(ji,jj) + 2.0 * araft(ji,jj,jl) & 631 * hi * hi 555 strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi * hi 632 556 633 557 !---------------------------- 634 558 ! PE gain from ridging ice 635 559 !---------------------------- 636 strength(ji,jj) = strength(ji,jj) & 637 + aridge(ji,jj,jl)/krdg(ji,jj,jl) & 638 * 1.0/3.0 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) & 639 / (hrmax(ji,jj,jl)-hrmin(ji,jj,jl)) 560 strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl) & 561 * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) ) 562 !!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... 640 563 ENDIF ! aicen > epsi11 641 564 ! 642 565 END DO ! ji 643 566 END DO !jj 644 567 END DO !jl 645 568 646 DO jj = 1, jpj 647 DO ji = 1, jpi 648 strength(ji,jj) = Cf * Cp * strength(ji,jj) / aksum(ji,jj) 649 ! Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) 650 ! Cf accounts for frictional dissipation 651 652 END DO ! j 653 END DO ! i 569 zzc = Cf * Cp ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation 570 strength(:,:) = zzc * strength(:,:) / aksum(:,:) 654 571 655 572 ksmooth = 1 … … 659 576 !------------------------------------------------------------------------------! 660 577 ELSE ! kstrngth ne 1: Hibler (1979) form 661 662 DO jj = 1, jpj 663 DO ji = 1, jpi 664 strength(ji,jj) = Pstar*vt_i(ji,jj)*exp(-C_rhg*(1.0-at_i(ji,jj))) 665 END DO ! j 666 END DO ! i 667 578 ! 579 strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) ) ) 580 ! 668 581 ksmooth = 1 669 582 ! 670 583 ENDIF ! kstrngth 671 584 … … 676 589 ! CAN BE REMOVED 677 590 ! 678 IF ( brinstren_swi .EQ.1 ) THEN591 IF ( brinstren_swi == 1 ) THEN 679 592 680 593 DO jj = 1, jpj … … 699 612 ! Spatial smoothing 700 613 !------------------- 701 IF ( ksmooth .EQ.1 ) THEN614 IF ( ksmooth == 1 ) THEN 702 615 703 616 CALL lbc_lnk( strength, 'T', 1. ) … … 713 626 + strength(ji,jj+1) * tms(ji,jj+1) 714 627 715 zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) & 716 + tms(ji,jj-1) + tms(ji,jj+1) 628 zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1) 717 629 zworka(ji,jj) = zworka(ji,jj) / zw1 718 630 ELSE … … 734 646 ! Temporal smoothing 735 647 !-------------------- 736 IF ( numit .EQ.nit000 + nn_fsbc - 1 ) THEN648 IF ( numit == nit000 + nn_fsbc - 1 ) THEN 737 649 strp1(:,:) = 0.0 738 650 strp2(:,:) = 0.0 739 651 ENDIF 740 652 741 IF ( ksmooth .EQ.2 ) THEN653 IF ( ksmooth == 2 ) THEN 742 654 743 655 … … 746 658 DO jj = 1, jpj - 1 747 659 DO ji = 1, jpi - 1 748 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi11) THEN ! ice is 749 ! present 660 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi11) THEN ! ice is present 750 661 numts_rm = 1 ! number of time steps for the running mean 751 662 IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 752 663 IF ( strp2(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 753 zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / & 754 numts_rm 664 zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 755 665 strp2(ji,jj) = strp1(ji,jj) 756 666 strp1(ji,jj) = strength(ji,jj) … … 763 673 ENDIF ! ksmooth 764 674 765 ! Boundary conditions 766 CALL lbc_lnk( strength, 'T', 1. ) 767 675 CALL lbc_lnk( strength, 'T', 1. ) ! Boundary conditions 676 677 IF( wrk_not_released(2, 1) ) CALL ctl_stop('lim_itd_me_icestrength: failed to release workspace array') 678 ! 768 679 END SUBROUTINE lim_itd_me_icestrength 769 680 770 !=============================================================================== 771 772 SUBROUTINE lim_itd_me_ridgeprep !(subroutine 3/6) 773 681 682 SUBROUTINE lim_itd_me_ridgeprep 774 683 !!---------------------------------------------------------------------! 775 684 !! *** ROUTINE lim_itd_me_ridgeprep *** 776 !! ** Purpose : 777 !! preparation for ridging and strength calculations 778 !! 779 !! ** Method : 780 !! Compute the thickness distribution of the ice and open water 781 !! participating in ridging and of the resulting ridges. 782 !! 783 !! ** Arguments : 784 !! 785 !! ** External : 786 !! 685 !! 686 !! ** Purpose : preparation for ridging and strength calculations 687 !! 688 !! ** Method : Compute the thickness distribution of the ice and open water 689 !! participating in ridging and of the resulting ridges. 787 690 !!---------------------------------------------------------------------! 788 !! * Arguments 789 790 INTEGER :: & 791 ji,jj, & ! horizontal indices 792 jl, & ! thickness category index 793 krdg_index ! which participation function using 794 795 REAL(wp) :: & 796 Gstari, & ! = 1.0/Gstar 797 astari ! = 1.0/astar 798 799 REAL(wp), DIMENSION(jpi,jpj,-1:jpl) :: & 800 Gsum ! Gsum(n) = sum of areas in categories 0 to n 801 802 REAL(wp) :: & 803 hi, & ! ice thickness for each cat (m) 804 hrmean ! mean ridge thickness (m) 805 806 REAL(wp), DIMENSION(jpi,jpj) :: & 807 zworka ! temporary array used here 808 809 REAL(wp) :: & 810 zdummy, & 811 epsi06 = 1.0e-6 812 691 INTEGER :: ji,jj, jl ! dummy loop indices 692 INTEGER :: krdg_index ! 693 694 REAL(wp) :: Gstari, astari, hi, hrmean, zdummy ! local scalar 695 696 REAL(wp), DIMENSION(jpi,jpj,-1:jpl) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 697 698 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 813 699 !------------------------------------------------------------------------------! 814 700 … … 841 727 ! initial value (in h = 0) equals open water area 842 728 843 Gsum(:,:,-1) = 0. 0729 Gsum(:,:,-1) = 0._wp 844 730 845 731 DO jj = 1, jpj 846 732 DO ji = 1, jpi 847 IF (ato_i(ji,jj) .GT. epsi11) THEN 848 Gsum(ji,jj,0) = ato_i(ji,jj) 849 ELSE 850 Gsum(ji,jj,0) = 0.0 733 IF( ato_i(ji,jj) > epsi11 ) THEN ; Gsum(ji,jj,0) = ato_i(ji,jj) 734 ELSE ; Gsum(ji,jj,0) = 0._wp 851 735 ENDIF 852 736 END DO … … 857 741 DO jj = 1, jpj 858 742 DO ji = 1, jpi 859 IF ( a_i(ji,jj,jl) .GT. epsi11 ) THEN 860 Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 861 ELSE 862 Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 743 IF( a_i(ji,jj,jl) .GT. epsi11 ) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 744 ELSE ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 863 745 ENDIF 864 746 END DO … … 867 749 868 750 ! Normalize the cumulative distribution to 1 869 DO jj = 1, jpj 870 DO ji = 1, jpi 871 zworka(ji,jj) = 1.0 / Gsum(ji,jj,jpl) 872 END DO 873 END DO 874 751 zworka(:,:) = 1._wp / Gsum(:,:,jpl) 875 752 DO jl = 0, jpl 876 DO jj = 1, jpj 877 DO ji = 1, jpi 878 Gsum(ji,jj,jl) = Gsum(ji,jj,jl) * zworka(ji,jj) 879 END DO 880 END DO 753 Gsum(:,:,jl) = Gsum(:,:,jl) * zworka(:,:) 881 754 END DO 882 755 … … 895 768 krdg_index = 1 896 769 897 IF ( krdg_index .EQ. 0 ) THEN 898 899 !--- Linear formulation (Thorndike et al., 1975) 900 DO jl = 0, ice_cat_bounds(1,2) ! only undeformed ice participates 770 IF( krdg_index == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 771 DO jl = 0, ice_cat_bounds(1,2) ! only undeformed ice participates 901 772 DO jj = 1, jpj 902 773 DO ji = 1, jpi 903 IF (Gsum(ji,jj,jl) < Gstar) THEN774 IF( Gsum(ji,jj,jl) < Gstar) THEN 904 775 athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * & 905 776 (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari) … … 914 785 END DO ! jl 915 786 916 ELSE ! krdg_index = 1 917 918 !--- Exponential, more stable formulation (Lipscomb et al, 2007) 919 ! precompute exponential terms using Gsum as a work array 920 zdummy = 1.0 / (1.0-EXP(-astari)) 787 ELSE !--- Exponential, more stable formulation (Lipscomb et al, 2007) 788 ! 789 zdummy = 1._wp / ( 1._wp - EXP(-astari) ) ! precompute exponential terms using Gsum as a work array 921 790 922 791 DO jl = -1, jpl 923 DO jj = 1, jpj 924 DO ji = 1, jpi 925 Gsum(ji,jj,jl) = EXP(-Gsum(ji,jj,jl)*astari)*zdummy 926 END DO !ji 927 END DO !jj 792 Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 928 793 END DO !jl 929 930 ! compute athorn931 794 DO jl = 0, ice_cat_bounds(1,2) 932 DO jj = 1, jpj 933 DO ji = 1, jpi 934 athorn(ji,jj,jl) = Gsum(ji,jj,jl-1) - Gsum(ji,jj,jl) 935 END DO !ji 936 END DO ! jj 937 END DO !jl 938 795 athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 796 END DO 797 ! 939 798 ENDIF ! krdg_index 940 799 941 ! Ridging and rafting ice participation functions 942 IF ( raftswi .EQ. 1 ) THEN 943 800 IF( raftswi == 1 ) THEN ! Ridging and rafting ice participation functions 801 ! 944 802 DO jl = 1, jpl 945 803 DO jj = 1, jpj 946 804 DO ji = 1, jpi 947 IF ( athorn(ji,jj,jl) .GT. 0.0 ) THEN 948 aridge(ji,jj,jl) = ( TANH ( Craft * ( ht_i(ji,jj,jl) - & 949 hparmeter ) ) + 1.0 ) / 2.0 * & 950 athorn(ji,jj,jl) 951 araft (ji,jj,jl) = ( TANH ( - Craft * ( ht_i(ji,jj,jl) - & 952 hparmeter ) ) + 1.0 ) / 2.0 * & 953 athorn(ji,jj,jl) 954 IF ( araft(ji,jj,jl) .LT. epsi06 ) araft(ji,jj,jl) = 0.0 955 aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0) 805 IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN 806 !!gm TANH( -X ) = - TANH( X ) so can be computed only 1 time.... 807 aridge(ji,jj,jl) = ( TANH ( Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 808 araft (ji,jj,jl) = ( TANH ( -Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 809 IF ( araft(ji,jj,jl) < epsi06 ) araft(ji,jj,jl) = 0._wp 810 aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 ) 956 811 ENDIF ! athorn 957 812 END DO ! ji … … 960 815 961 816 ELSE ! raftswi = 0 962 817 ! 963 818 DO jl = 1, jpl 964 DO jj = 1, jpj 965 DO ji = 1, jpi 966 aridge(ji,jj,jl) = 1.0*athorn(ji,jj,jl) 967 END DO 968 END DO 969 END DO 970 819 aridge(:,:,jl) = athorn(:,:,jl) 820 END DO 821 ! 971 822 ENDIF 972 823 973 IF ( raftswi .EQ.1 ) THEN824 IF ( raftswi == 1 ) THEN 974 825 975 826 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi11 ) THEN … … 1043 894 1044 895 ! Normalization factor : aksum, ensures mass conservation 1045 DO jj = 1, jpj1046 DO ji = 1, jpi1047 aksum(ji,jj) = athorn(ji,jj,0)1048 END DO896 aksum(:,:) = athorn(ji,jj,0) 897 DO jl = 1, jpl 898 aksum(:,:) = aksum(:,:) + aridge(:,:,jl) * ( 1._wp - 1._wp / krdg(:,:,jl) ) & 899 & + araft (:,:,jl) * ( 1._wp - 1._wp / kraft ) 1049 900 END DO 1050 1051 DO jl = 1, jpl 1052 DO jj = 1, jpj 1053 DO ji = 1, jpi 1054 aksum(ji,jj) = aksum(ji,jj) & 1055 + aridge(ji,jj,jl) * (1.0 - 1.0/krdg(ji,jj,jl)) & 1056 + araft (ji,jj,jl) * (1.0 - 1.0/kraft) 1057 END DO 1058 END DO 1059 END DO 1060 901 ! 1061 902 END SUBROUTINE lim_itd_me_ridgeprep 1062 903 1063 !=============================================================================== 1064 1065 SUBROUTINE lim_itd_me_ridgeshift(opning, closing_gross, & 1066 msnow_mlt, esnow_mlt) ! (subroutine 4/6) 1067 1068 !!----------------------------------------------------------------------------- 904 905 SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt ) 906 !!---------------------------------------------------------------------- 1069 907 !! *** ROUTINE lim_itd_me_icestrength *** 1070 !! ** Purpose : 1071 !! This routine shift ridging ice among thickness categories 1072 !! of ice thickness 1073 !! 1074 !! ** Method : 1075 !! Remove area, volume, and energy from each ridging category 1076 !! and add to thicker ice categories. 1077 !! 1078 !! ** Arguments : 1079 !! 1080 !! ** Inputs / Ouputs : 1081 !! 1082 !! ** External : 1083 !! 1084 1085 REAL (wp), DIMENSION(jpi,jpj), INTENT(IN) :: & 1086 opning, & ! rate of opening due to divergence/shear 1087 closing_gross ! rate at which area removed, not counting 1088 ! area of new ridges 1089 1090 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: & 1091 msnow_mlt, & ! mass of snow added to ocean (kg m-2) 1092 esnow_mlt ! energy needed to melt snow in ocean (J m-2) 1093 1094 INTEGER :: & 1095 ji, jj, & ! horizontal indices 1096 jl, jl1, jl2, & ! thickness category indices 1097 jk, & ! ice layer index 1098 ij, & ! horizontal index, combines i and j loops 1099 icells ! number of cells with aicen > puny 1100 1101 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 1102 indxi, indxj ! compressed indices 1103 1104 REAL(wp), DIMENSION(jpi,jpj) :: & 1105 vice_init, vice_final, & ! ice volume summed over categories 1106 eice_init, eice_final ! ice energy summed over layers 1107 1108 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 1109 aicen_init, & ! ice area before ridging 1110 vicen_init, & ! ice volume before ridging 1111 vsnon_init, & ! snow volume before ridging 1112 esnon_init, & ! snow energy before ridging 1113 smv_i_init, & ! ice salinity before ridging 1114 oa_i_init ! ice age before ridging 1115 1116 REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl) :: & 1117 eicen_init ! ice energy before ridging 1118 1119 REAL(wp), DIMENSION(jpi,jpj) :: & 1120 afrac , & ! fraction of category area ridged 1121 ardg1 , & ! area of ice ridged 1122 ardg2 , & ! area of new ridges 1123 vsrdg , & ! snow volume of ridging ice 1124 esrdg , & ! snow energy of ridging ice 1125 oirdg1 , & ! areal age content of ridged ice 1126 oirdg2 , & ! areal age content of ridging ice 1127 dhr , & ! hrmax - hrmin 1128 dhr2 , & ! hrmax^2 - hrmin^2 1129 fvol ! fraction of new ridge volume going to n2 1130 1131 REAL(wp), DIMENSION(jpi,jpj) :: & 1132 vrdg1 , & ! volume of ice ridged 1133 vrdg2 , & ! volume of new ridges 1134 vsw , & ! volume of seawater trapped into ridges 1135 srdg1 , & ! sal*volume of ice ridged 1136 srdg2 , & ! sal*volume of new ridges 1137 smsw ! sal*volume of water trapped into ridges 1138 1139 REAL(wp), DIMENSION(jpi,jpj) :: & 1140 afrft , & ! fraction of category area rafted 1141 arft1 , & ! area of ice rafted 1142 arft2 , & ! area of new rafted zone 1143 virft , & ! ice volume of rafting ice 1144 vsrft , & ! snow volume of rafting ice 1145 esrft , & ! snow energy of rafting ice 1146 smrft , & ! salinity of rafting ice 1147 oirft1 , & ! areal age content of rafted ice 1148 oirft2 ! areal age content of rafting ice 1149 1150 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: & 1151 eirft , & ! ice energy of rafting ice 1152 erdg1 , & ! enth*volume of ice ridged 1153 erdg2 , & ! enth*volume of new ridges 1154 ersw ! enth of water trapped into ridges 1155 1156 REAL(wp) :: & 1157 hL, hR , & ! left and right limits of integration 1158 farea , & ! fraction of new ridge area going to n2 1159 zdummy , & ! dummy argument 1160 zdummy0 , & ! dummy argument 1161 ztmelts ! ice melting point 1162 1163 REAL(wp) :: zsrdg2 1164 1165 CHARACTER (len=80) :: & 1166 fieldid ! field identifier 1167 1168 LOGICAL, PARAMETER :: & 1169 l_conservation_check = .true. ! if true, check conservation 1170 ! (useful for debugging) 1171 LOGICAL :: & 1172 neg_ato_i , & ! flag for ato_i(i,j) < -puny 1173 large_afrac , & ! flag for afrac > 1 1174 large_afrft ! flag for afrac > 1 1175 1176 REAL(wp) :: & 1177 zeps , & 1178 epsi10 , & 1179 zindb ! switch for the presence of ridge poros or not 1180 1181 !---------------------------------------------------------------------------- 908 !! 909 !! ** Purpose : shift ridging ice among thickness categories of ice thickness 910 !! 911 !! ** Method : Remove area, volume, and energy from each ridging category 912 !! and add to thicker ice categories. 913 !!---------------------------------------------------------------------- 914 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: opning ! rate of opening due to divergence/shear 915 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: closing_gross ! rate at which area removed, excluding area of new ridges 916 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: msnow_mlt ! mass of snow added to ocean (kg m-2) 917 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2) 918 ! 919 CHARACTER (len=80) :: fieldid ! field identifier 920 LOGICAL, PARAMETER :: l_conservation_check = .true. ! if true, check conservation (useful for debugging) 921 ! 922 LOGICAL :: neg_ato_i ! flag for ato_i(i,j) < -puny 923 LOGICAL :: large_afrac ! flag for afrac > 1 924 LOGICAL :: large_afrft ! flag for afrac > 1 925 INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices 926 INTEGER :: ij ! horizontal index, combines i and j loops 927 INTEGER :: icells ! number of cells with aicen > puny 928 REAL(wp) :: zeps, zindb, zsrdg2 ! local scalar 929 REAL(wp) :: hL, hR, farea, zdummy, zdummy0, ztmelts ! left and right limits of integration 930 931 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: indxi, indxj ! compressed indices 932 933 REAL(wp), DIMENSION(jpi,jpj) :: vice_init, vice_final ! ice volume summed over categories 934 REAL(wp), DIMENSION(jpi,jpj) :: eice_init, eice_final ! ice energy summed over layers 935 936 REAL(wp), DIMENSION(jpi,jpj,jpl) :: aicen_init, vicen_init ! ice area & volume before ridging 937 REAL(wp), DIMENSION(jpi,jpj,jpl) :: vsnon_init, esnon_init ! snow volume & energy before ridging 938 REAL(wp), DIMENSION(jpi,jpj,jpl) :: smv_i_init, oa_i_init ! ice salinity & age before ridging 939 940 REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl) :: eicen_init ! ice energy before ridging 941 942 REAL(wp), DIMENSION(jpi,jpj) :: afrac , fvol ! fraction of category area ridged & new ridge volume going to n2 943 REAL(wp), DIMENSION(jpi,jpj) :: ardg1 , ardg2 ! area of ice ridged & new ridges 944 REAL(wp), DIMENSION(jpi,jpj) :: vsrdg , esrdg ! snow volume & energy of ridging ice 945 REAL(wp), DIMENSION(jpi,jpj) :: oirdg1, oirdg2 ! areal age content of ridged & rifging ice 946 REAL(wp), DIMENSION(jpi,jpj) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 947 948 REAL(wp), DIMENSION(jpi,jpj) :: vrdg1 ! volume of ice ridged 949 REAL(wp), DIMENSION(jpi,jpj) :: vrdg2 ! volume of new ridges 950 REAL(wp), DIMENSION(jpi,jpj) :: vsw ! volume of seawater trapped into ridges 951 REAL(wp), DIMENSION(jpi,jpj) :: srdg1 ! sal*volume of ice ridged 952 REAL(wp), DIMENSION(jpi,jpj) :: srdg2 ! sal*volume of new ridges 953 REAL(wp), DIMENSION(jpi,jpj) :: smsw ! sal*volume of water trapped into ridges 954 955 REAL(wp), DIMENSION(jpi,jpj) :: afrft ! fraction of category area rafted 956 REAL(wp), DIMENSION(jpi,jpj) :: arft1 , arft2 ! area of ice rafted and new rafted zone 957 REAL(wp), DIMENSION(jpi,jpj) :: virft , vsrft ! ice & snow volume of rafting ice 958 REAL(wp), DIMENSION(jpi,jpj) :: esrft , smrft ! snow energy & salinity of rafting ice 959 REAL(wp), DIMENSION(jpi,jpj) :: oirft1, oirft2 ! areal age content of rafted ice & rafting ice 960 961 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: eirft ! ice energy of rafting ice 962 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: erdg1 ! enth*volume of ice ridged 963 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: erdg2 ! enth*volume of new ridges 964 REAL(wp), DIMENSION(jpi,jpj,jkmax) :: ersw ! enth of water trapped into ridges 965 !!---------------------------------------------------------------------- 1182 966 1183 967 ! Conservation check 1184 eice_init(:,:) = 0. 01185 1186 IF 968 eice_init(:,:) = 0._wp 969 970 IF( con_i ) THEN 1187 971 CALL lim_column_sum (jpl, v_i, vice_init ) 1188 972 WRITE(numout,*) ' vice_init : ', vice_init(jiindx,jjindx) … … 1191 975 ENDIF 1192 976 1193 zeps = 1.0d-20 1194 epsi10 = 1.0d-10 977 zeps = 1.e-20_wp 1195 978 1196 979 !------------------------------------------------------------------------------- … … 1202 985 DO jj = 1, jpj 1203 986 DO ji = 1, jpi 1204 ato_i(ji,jj) = ato_i(ji,jj) & 1205 - athorn(ji,jj,0)*closing_gross(ji,jj)*rdt_ice & 1206 + opning(ji,jj)*rdt_ice 1207 IF (ato_i(ji,jj) .LT. -epsi11) THEN 1208 neg_ato_i = .true. 1209 ELSEIF (ato_i(ji,jj) .LT. 0.0) THEN ! roundoff error 1210 ato_i(ji,jj) = 0.0 987 ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice & 988 & + opning(ji,jj) * rdt_ice 989 IF( ato_i(ji,jj) < -epsi11 ) THEN 990 neg_ato_i = .TRUE. 991 ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error 992 ato_i(ji,jj) = 0._wp 1211 993 ENDIF 1212 994 END DO !jj … … 1214 996 1215 997 ! if negative open water area alert it 1216 IF (neg_ato_i) THEN ! there is a bug998 IF( neg_ato_i ) THEN ! there is a bug 1217 999 DO jj = 1, jpj 1218 1000 DO ji = 1, jpi 1219 IF (ato_i(ji,jj) .LT. -epsi11) THEN1001 IF( ato_i(ji,jj) < -epsi11 ) THEN 1220 1002 WRITE(numout,*) '' 1221 1003 WRITE(numout,*) 'Ridging error: ato_i < 0' 1222 1004 WRITE(numout,*) 'ato_i : ', ato_i(ji,jj) 1223 1005 ENDIF ! ato_i < -epsi11 1224 END DO ! ji1225 END DO ! jj1226 ENDIF ! neg_ato_i1006 END DO 1007 END DO 1008 ENDIF 1227 1009 1228 1010 !----------------------------------------------------------------- … … 1231 1013 1232 1014 DO jl = 1, jpl 1233 DO jj = 1, jpj 1234 DO ji = 1, jpi 1235 aicen_init(ji,jj,jl) = a_i(ji,jj,jl) 1236 vicen_init(ji,jj,jl) = v_i(ji,jj,jl) 1237 vsnon_init(ji,jj,jl) = v_s(ji,jj,jl) 1238 1239 smv_i_init(ji,jj,jl) = smv_i(ji,jj,jl) 1240 oa_i_init (ji,jj,jl) = oa_i(ji,jj,jl) 1241 END DO !ji 1242 END DO ! jj 1015 aicen_init(:,:,jl) = a_i(:,:,jl) 1016 vicen_init(:,:,jl) = v_i(:,:,jl) 1017 vsnon_init(:,:,jl) = v_s(:,:,jl) 1018 ! 1019 smv_i_init(:,:,jl) = smv_i(:,:,jl) 1020 oa_i_init (:,:,jl) = oa_i (:,:,jl) 1243 1021 END DO !jl 1244 1022 … … 1247 1025 DO jl = 1, jpl 1248 1026 DO jk = 1, nlay_i 1249 DO jj = 1, jpj 1250 DO ji = 1, jpi 1251 eicen_init(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) 1252 END DO !ji 1253 END DO !jj 1254 END DO !jk 1255 END DO !jl 1027 eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl) 1028 END DO 1029 END DO 1256 1030 1257 1031 ! … … 1324 1098 ! / rafting category n1. 1325 1099 !-------------------------------------------------------------------------- 1326 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / & 1327 ( 1.0 + ridge_por ) 1100 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 1328 1101 vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 1329 1102 vsw (ji,jj) = vrdg1(ji,jj) * ridge_por … … 1331 1104 vsrdg(ji,jj) = vsnon_init(ji,jj,jl1) * afrac(ji,jj) 1332 1105 esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj) 1333 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / & 1334 ( 1. + ridge_por ) 1106 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 1335 1107 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1336 1108 … … 1371 1143 ! ij looping 1-icells 1372 1144 1373 dardg1dt (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj)1374 dardg2dt (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj)1145 dardg1dt (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 1146 dardg2dt (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj) 1375 1147 diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) / rdt_ice 1376 opening (ji,jj)= opening (ji,jj) + opning(ji,jj)*rdt_ice1377 1378 IF (con_i)vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj)1148 opening (ji,jj) = opening (ji,jj) + opning(ji,jj)*rdt_ice 1149 1150 IF( con_i ) vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj) 1379 1151 1380 1152 !------------------------------------------ … … 1390 1162 ! ij looping 1-icells 1391 1163 1392 msnow_mlt(ji,jj) = msnow_mlt(ji,jj) & 1393 + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg) & 1394 !rafting included 1395 + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 1396 1397 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) & 1398 + esrdg(ji,jj)*(1.0-fsnowrdg) & 1399 !rafting included 1400 + esrft(ji,jj)*(1.0-fsnowrft) 1164 msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg) & ! rafting included 1165 & + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 1166 1167 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included 1168 & + esrft(ji,jj)*(1.0-fsnowrft) 1401 1169 1402 1170 !----------------------------------------------------------------- … … 1409 1177 1410 1178 dhr(ji,jj) = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) 1411 dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) & 1412 - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) 1179 dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) 1413 1180 1414 1181 … … 1425 1192 jj = indxj(ij) 1426 1193 ! heat content of ridged ice 1427 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / & 1428 ( 1.0 + ridge_por ) 1194 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 1429 1195 eirft(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 1430 e_i(ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) & 1431 - erdg1(ji,jj,jk) & 1432 - eirft(ji,jj,jk) 1196 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 1433 1197 ! sea water heat content 1434 1198 ztmelts = - tmut * sss_m(ji,jj) + rtt … … 1437 1201 1438 1202 ! corrected sea water salinity 1439 zindb = MAX( 0.0, SIGN( 1.0, vsw(ji,jj) - zeps ) ) 1440 zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / & 1441 MAX( ridge_por * vsw(ji,jj), zeps ) 1203 zindb = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - zeps ) ) 1204 zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), zeps ) 1442 1205 1443 1206 ztmelts = - tmut * zdummy + rtt … … 1445 1208 1446 1209 ! heat flux 1447 fheat_rpo(ji,jj) = fheat_rpo(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) / & 1448 rdt_ice 1210 fheat_rpo(ji,jj) = fheat_rpo(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) / rdt_ice 1449 1211 1450 1212 ! Correct dimensions to avoid big values 1451 ersw(ji,jj,jk) = ersw(ji,jj,jk) / 1.0d+091213 ersw(ji,jj,jk) = ersw(ji,jj,jk) * 1.e-09 1452 1214 1453 1215 ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 1454 ersw(ji,jj,jk) = ersw(ji,jj,jk) * & 1455 area(ji,jj) * vsw(ji,jj) / & 1456 nlay_i 1216 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / nlay_i 1457 1217 1458 1218 erdg2(ji,jj,jk) = erdg1(ji,jj,jk) + ersw(ji,jj,jk) … … 1461 1221 1462 1222 1463 IF 1223 IF( con_i ) THEN 1464 1224 DO jk = 1, nlay_i 1465 1225 !CDIR NODEP … … 1467 1227 ji = indxi(ij) 1468 1228 jj = indxj(ij) 1469 eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - & 1470 erdg1(ji,jj,jk) 1229 eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk) 1471 1230 END DO ! ij 1472 1231 END DO !jk 1473 1232 ENDIF 1474 1233 1475 IF (large_afrac) THEN! there is a bug1234 IF( large_afrac ) THEN ! there is a bug 1476 1235 !CDIR NODEP 1477 1236 DO ij = 1, icells 1478 1237 ji = indxi(ij) 1479 1238 jj = indxj(ij) 1480 IF 1239 IF( afrac(ji,jj) > 1.0 + epsi11 ) THEN 1481 1240 WRITE(numout,*) '' 1482 1241 WRITE(numout,*) ' ardg > a_i' 1483 WRITE(numout,*) ' ardg, aicen_init : ', & 1484 ardg1(ji,jj), aicen_init(ji,jj,jl1) 1485 ENDIF ! afrac > 1 + puny 1486 ENDDO ! if 1487 ENDIF ! large_afrac 1488 IF (large_afrft) THEN ! there is a bug 1242 WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 1243 ENDIF 1244 END DO 1245 ENDIF 1246 IF( large_afrft ) THEN ! there is a bug 1489 1247 !CDIR NODEP 1490 1248 DO ij = 1, icells 1491 1249 ji = indxi(ij) 1492 1250 jj = indxj(ij) 1493 IF 1251 IF( afrft(ji,jj) > 1.0 + epsi11 ) THEN 1494 1252 WRITE(numout,*) '' 1495 1253 WRITE(numout,*) ' arft > a_i' 1496 WRITE(numout,*) ' arft, aicen_init : ', & 1497 arft1(ji,jj), aicen_init(ji,jj,jl1) 1498 ENDIF ! afrft > 1 + puny 1499 ENDDO ! if 1500 ENDIF ! large_afrft 1254 WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 1255 ENDIF 1256 END DO 1257 ENDIF 1501 1258 1502 1259 !------------------------------------------------------------------------------- … … 1528 1285 fvol(ji,jj) = (hR*hR - hL*hL) / dhr2(ji,jj) 1529 1286 1530 a_i(ji,jj,jl2) = a_i(ji,jj,jl2) + farea * ardg2(ji,jj) 1531 v_i(ji,jj,jl2) = v_i(ji,jj,jl2) + fvol(ji,jj) * vrdg2(ji,jj) 1532 v_s(ji,jj,jl2) = v_s(ji,jj,jl2) & 1533 + fvol(ji,jj) * vsrdg(ji,jj) * fsnowrdg 1534 e_s(ji,jj,1,jl2) = e_s(ji,jj,1,jl2) & 1535 + fvol(ji,jj) * esrdg(ji,jj) * fsnowrdg 1536 smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2) + fvol(ji,jj) * srdg2(ji,jj) 1537 oa_i(ji,jj,jl2) = oa_i(ji,jj,jl2) + farea * oirdg2(ji,jj) 1287 a_i (ji,jj,jl2) = a_i (ji,jj,jl2) + ardg2 (ji,jj) * farea 1288 v_i (ji,jj,jl2) = v_i (ji,jj,jl2) + vrdg2 (ji,jj) * fvol(ji,jj) 1289 v_s (ji,jj,jl2) = v_s (ji,jj,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 1290 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 1291 smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 1292 oa_i (ji,jj,jl2) = oa_i (ji,jj,jl2) + oirdg2(ji,jj) * farea 1538 1293 1539 1294 END DO ! ij … … 1545 1300 ji = indxi(ij) 1546 1301 jj = indxj(ij) 1547 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) & 1548 + fvol(ji,jj)*erdg2(ji,jj,jk) 1549 END DO ! ij 1550 END DO !jk 1551 1552 1302 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj)*erdg2(ji,jj,jk) 1303 END DO 1304 END DO 1305 ! 1553 1306 END DO ! jl2 (new ridges) 1554 1307 1555 DO jl2 1308 DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 1556 1309 1557 1310 !CDIR NODEP … … 1566 1319 a_i(ji,jj,jl2) = a_i(ji,jj,jl2) + arft2(ji,jj) 1567 1320 v_i(ji,jj,jl2) = v_i(ji,jj,jl2) + virft(ji,jj) 1568 v_s(ji,jj,jl2) = v_s(ji,jj,jl2) & 1569 + vsrft(ji,jj)*fsnowrft 1570 e_s(ji,jj,1,jl2) = e_s(ji,jj,1,jl2) & 1571 + esrft(ji,jj)*fsnowrft 1572 smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2) & 1573 + smrft(ji,jj) 1574 oa_i(ji,jj,jl2) = oa_i(ji,jj,jl2) & 1575 + oirft2(ji,jj) 1321 v_s(ji,jj,jl2) = v_s(ji,jj,jl2) + vsrft(ji,jj)*fsnowrft 1322 e_s(ji,jj,1,jl2) = e_s(ji,jj,1,jl2) + esrft(ji,jj)*fsnowrft 1323 smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2) + smrft(ji,jj) 1324 oa_i(ji,jj,jl2) = oa_i(ji,jj,jl2) + oirft2(ji,jj) 1576 1325 ENDIF ! hraft 1577 1326 … … 1586 1335 IF (hraft(ji,jj,jl1) .LE. hi_max(jl2) .AND. & 1587 1336 hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN 1588 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) & 1589 + eirft(ji,jj,jk) 1337 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 1590 1338 ENDIF 1591 1339 END DO ! ij … … 1610 1358 WRITE(numout,*) ' eice_final : ', eice_final(jiindx,jjindx) 1611 1359 ENDIF 1612 1360 ! 1613 1361 END SUBROUTINE lim_itd_me_ridgeshift 1614 1362 1615 !============================================================================== 1616 1617 SUBROUTINE lim_itd_me_asumr !(subroutine 5/6) 1618 1363 1364 SUBROUTINE lim_itd_me_asumr 1619 1365 !!----------------------------------------------------------------------------- 1620 1366 !! *** ROUTINE lim_itd_me_asumr *** 1621 !! ** Purpose : 1622 !! This routine finds total fractional area 1623 !! 1624 !! ** Method : 1625 !! Find the total area of ice plus open water in each grid cell. 1626 !! 1627 !! This is similar to the aggregate_area subroutine except that the 1628 !! total area can be greater than 1, so the open water area is 1629 !! included in the sum instead of being computed as a residual. 1630 !! 1631 !! ** Arguments : 1632 1633 INTEGER :: ji, jj, jl 1634 1635 !----------------------------------------------------------------- 1636 ! open water 1637 !----------------------------------------------------------------- 1638 1639 DO jj = 1, jpj 1640 DO ji = 1, jpi 1641 asum(ji,jj) = ato_i(ji,jj) 1642 END DO 1367 !! 1368 !! ** Purpose : finds total fractional area 1369 !! 1370 !! ** Method : Find the total area of ice plus open water in each grid cell. 1371 !! This is similar to the aggregate_area subroutine except that the 1372 !! total area can be greater than 1, so the open water area is 1373 !! included in the sum instead of being computed as a residual. 1374 !!----------------------------------------------------------------------------- 1375 INTEGER :: jl ! dummy loop index 1376 !!----------------------------------------------------------------------------- 1377 ! 1378 asum(:,:) = ato_i(:,:) ! open water 1379 DO jl = 1, jpl ! ice categories 1380 asum(:,:) = asum(:,:) + a_i(:,:,jl) 1643 1381 END DO 1644 1645 !----------------------------------------------------------------- 1646 ! ice categories 1647 !----------------------------------------------------------------- 1648 1649 DO jl = 1, jpl 1650 DO jj= 1, jpj 1651 DO ji = 1, jpi 1652 asum(ji,jj) = asum(ji,jj) + a_i(ji,jj,jl) 1653 END DO !ji 1654 END DO !jj 1655 END DO ! jl 1656 1382 ! 1657 1383 END SUBROUTINE lim_itd_me_asumr 1658 1384 1659 !============================================================================== 1660 1661 SUBROUTINE lim_itd_me_init ! (subroutine 6/6) 1385 1386 SUBROUTINE lim_itd_me_init 1662 1387 !!------------------------------------------------------------------- 1663 1388 !! *** ROUTINE lim_itd_me_init *** … … 1671 1396 !! 1672 1397 !! ** input : Namelist namiceitdme 1673 !!1674 !! history :1675 !! 9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code1676 1398 !!------------------------------------------------------------------- 1677 1399 NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,& … … 1681 1403 brinstren_swi 1682 1404 !!------------------------------------------------------------------- 1683 1684 ! Define the initial parameters 1685 ! ------------------------- 1686 REWIND( numnam_ice ) 1405 ! 1406 REWIND( numnam_ice ) ! read namiceitdme namelist 1687 1407 READ ( numnam_ice , namiceitdme) 1688 IF (lwp) THEN 1408 ! 1409 IF (lwp) THEN ! control print 1689 1410 WRITE(numout,*) 1690 1411 WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution ' … … 1707 1428 WRITE(numout,*)' Switch for including brine volume in ice strength comp. brinstren_swi ', brinstren_swi 1708 1429 ENDIF 1709 1430 ! 1710 1431 END SUBROUTINE lim_itd_me_init 1711 1432 1712 !==============================================================================1713 1433 1714 1434 SUBROUTINE lim_itd_me_zapsmall … … 1717 1437 !! 1718 1438 !! ** Purpose : Remove too small sea ice areas and correct salt fluxes 1719 !!1720 1439 !! 1721 1440 !! history : … … 1726 1445 !! 9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code 1727 1446 !!------------------------------------------------------------------- 1728 1729 INTEGER :: & 1730 ji,jj, & ! horizontal indices 1731 jl, & ! ice category index 1732 jk, & ! ice layer index 1733 ! ij, & ! combined i/j horizontal index 1734 icells ! number of cells with ice to zap 1735 1736 ! INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 1737 ! indxi, & ! compressed indices for i/j directions 1738 ! indxj 1739 1740 INTEGER, DIMENSION(jpi,jpj) :: zmask 1741 1742 1743 REAL(wp) :: & 1744 xtmp ! temporary variable 1447 INTEGER :: ji, jj, jl, jk ! dummy loop indices 1448 INTEGER :: icells ! number of cells with ice to zap 1449 1450 REAL(wp), DIMENSION(jpi,jpj) :: zmask ! 2D workspace 1451 1452 !!gm REAL(wp) :: xtmp ! temporary variable 1453 !!------------------------------------------------------------------- 1745 1454 1746 1455 DO jl = 1, jpl … … 1763 1472 1764 1473 icells = 0 1765 zmask = 0.e01474 zmask = 0._wp 1766 1475 DO jj = 1, jpj 1767 1476 DO ji = 1, jpi 1768 IF ( ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0.0) & 1769 .OR. & 1770 ( a_i(ji,jj,jl) .GT. 0.0 .AND. a_i(ji,jj,jl) .LE. 1.0e-11 ) & 1771 .OR. & 1772 !new line 1773 ( v_i(ji,jj,jl) .EQ. 0.0 .AND. a_i(ji,jj,jl) .GT. 0.0 ) & 1774 .OR. & 1775 ( v_i(ji,jj,jl) .GT. 0.0 .AND. v_i(ji,jj,jl) .LT. 1.e-12 ) ) THEN 1776 zmask(ji,jj) = 1 1777 ENDIF 1778 END DO 1779 END DO 1780 IF( ln_nicep ) WRITE(numout,*) SUM(zmask), ' cells of ice zapped in the ocean ' 1477 IF( ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0._wp ) .OR. & 1478 & ( a_i(ji,jj,jl) .GT. 0._wp .AND. a_i(ji,jj,jl) .LE. 1.0e-11 ) .OR. & 1479 & ( v_i(ji,jj,jl) == 0._wp .AND. a_i(ji,jj,jl) .GT. 0._wp ) .OR. & 1480 & ( v_i(ji,jj,jl) .GT. 0._wp .AND. v_i(ji,jj,jl) .LT. 1.e-12 ) ) zmask(ji,jj) = 1._wp 1481 END DO 1482 END DO 1483 IF( ln_nicep ) WRITE(numout,*) SUM(zmask), ' cells of ice zapped in the ocean ' 1781 1484 1782 1485 !----------------------------------------------------------------- … … 1787 1490 DO jj = 1 , jpj 1788 1491 DO ji = 1 , jpi 1789 1790 xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice 1791 xtmp = xtmp * unit_fac 1792 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1492 !!gm xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice 1493 !!gm xtmp = xtmp * unit_fac 1494 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1793 1495 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1 - zmask(ji,jj) ) 1794 END DO ! ji1795 END DO ! jj1796 END DO ! jk1496 END DO 1497 END DO 1498 END DO 1797 1499 1798 1500 DO jj = 1 , jpj … … 1802 1504 ! Zap snow energy and use ocean heat to melt snow 1803 1505 !----------------------------------------------------------------- 1804 1805 1506 ! xtmp = esnon(i,j,n) / dt ! < 0 1806 1507 ! fhnet(i,j) = fhnet(i,j) + xtmp … … 1809 1510 ! fluxes are positive to the ocean 1810 1511 ! here the flux has to be negative for the ocean 1811 xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice1512 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice 1812 1513 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1813 1514 1814 xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB ???????1515 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB ??????? 1815 1516 1816 1517 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) ) … … 1833 1534 ! fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 1834 1535 1835 ato_i(ji,jj) = a_i(ji,jj,jl) * zmask(ji,jj)+ ato_i(ji,jj)1836 a_i (ji,jj,jl) = a_i(ji,jj,jl) * ( 1 - zmask(ji,jj) )1837 v_i (ji,jj,jl) = v_i(ji,jj,jl) * ( 1 - zmask(ji,jj) )1838 v_s (ji,jj,jl) = v_s(ji,jj,jl) * ( 1 - zmask(ji,jj) )1839 t_su (ji,jj,jl) = t_su(ji,jj,jl) * (1 -zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)1840 oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * ( 1 - zmask(ji,jj) )1536 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) 1537 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1538 v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1539 v_s (ji,jj,jl) = v_s (ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1540 t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1 - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj) 1541 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1841 1542 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 1842 1843 END DO ! ji1844 END DO ! jj1845 1543 ! 1544 END DO 1545 END DO 1546 ! 1846 1547 END DO ! jl 1847 1548 ! 1848 1549 END SUBROUTINE lim_itd_me_zapsmall 1849 1550 1850 1551 #else 1851 !!====================================================================== 1852 !! *** MODULE limitd_me *** 1853 !! no sea ice model 1854 !!====================================================================== 1855 1552 !!---------------------------------------------------------------------- 1553 !! Default option Empty module NO LIM-3 sea-ice model 1554 !!---------------------------------------------------------------------- 1856 1555 CONTAINS 1857 1858 1556 SUBROUTINE lim_itd_me ! Empty routines 1859 1557 END SUBROUTINE lim_itd_me 1860 1558 SUBROUTINE lim_itd_me_icestrength 1861 1559 END SUBROUTINE lim_itd_me_icestrength 1862 SUBROUTINE lim_itd_me_ridgeprep1863 END SUBROUTINE lim_itd_me_ridgeprep1864 SUBROUTINE lim_itd_me_ridgeshift1865 END SUBROUTINE lim_itd_me_ridgeshift1866 SUBROUTINE lim_itd_me_asumr1867 END SUBROUTINE lim_itd_me_asumr1868 1560 SUBROUTINE lim_itd_me_sort 1869 1561 END SUBROUTINE lim_itd_me_sort … … 1873 1565 END SUBROUTINE lim_itd_me_zapsmall 1874 1566 #endif 1567 !!====================================================================== 1875 1568 END MODULE limitd_me -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r2528 r2715 5 5 !! computation of changes in g(h) 6 6 !!====================================================================== 7 !! History : - ! (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 8 !! 3.0 ! 2005-12 (M. Vancoppenolle) adaptation to LIM-3 9 !! - ! 2006-06 (M. Vancoppenolle) adaptation to include salt, age and types 10 !! - ! 2007-04 (M. Vancoppenolle) Mass conservation checked 11 !!---------------------------------------------------------------------- 7 12 #if defined key_lim3 8 13 !!---------------------------------------------------------------------- 9 14 !! 'key_lim3' : LIM3 sea-ice model 10 15 !!---------------------------------------------------------------------- 16 !! lim_itd_th : thermodynamics of ice thickness distribution 17 !! lim_itd_th_rem : 18 !! lim_itd_th_reb : 19 !! lim_itd_fitline : 20 !! lim_itd_shiftice : 11 21 !!---------------------------------------------------------------------- 12 USE dom_ice 22 USE dom_ice ! LIM-3 domain 13 23 USE par_oce ! ocean parameters 14 USE dom_oce 24 USE dom_oce ! ocean domain 15 25 USE phycst ! physical constants (ocean directory) 16 USE thd_ice 17 USE ice 18 USE par_ice 19 USE limthd_lac 20 USE limvar 21 USE limcons 26 USE thd_ice ! LIM-3 thermodynamic variables 27 USE ice ! LIM-3 variables 28 USE par_ice ! LIM-3 parameters 29 USE limthd_lac ! LIM-3 lateral accretion 30 USE limvar ! LIM-3 variables 31 USE limcons ! LIM-3 conservation 22 32 USE prtctl ! Print control 23 USE in_out_manager 24 USE lib_mpp 33 USE in_out_manager ! I/O manager 34 USE lib_mpp ! MPP library 25 35 26 36 IMPLICIT NONE 27 37 PRIVATE 28 38 29 PUBLIC lim_itd_th ! called by ice_stp 30 PUBLIC lim_itd_th_rem 31 PUBLIC lim_itd_th_reb 32 PUBLIC lim_itd_fitline 33 PUBLIC lim_itd_shiftice 34 35 REAL(wp) :: & ! constant values 36 epsi20 = 1e-20 , & 37 epsi13 = 1e-13 , & 38 zzero = 0.e0 , & 39 zone = 1.e0 39 PUBLIC lim_itd_th ! called by ice_stp 40 PUBLIC lim_itd_th_rem 41 PUBLIC lim_itd_th_reb 42 PUBLIC lim_itd_fitline 43 PUBLIC lim_itd_shiftice 44 45 REAL(wp) :: epsi20 = 1e-20_wp ! constant values 46 REAL(wp) :: epsi13 = 1e-13_wp ! 47 REAL(wp) :: epsi10 = 1e-10_wp ! 40 48 41 49 !!---------------------------------------------------------------------- 42 !! NEMO/LIM3 3.3, UCL - NEMO Consortium (2010)50 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 43 51 !! $Id$ 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 53 !!---------------------------------------------------------------------- 46 47 48 54 CONTAINS 49 55 … … 51 57 !!------------------------------------------------------------------ 52 58 !! *** ROUTINE lim_itd_th *** 53 !! ** Purpose :54 !! This routine computes the thermodynamics of ice thickness55 !! distribution59 !! 60 !! ** Purpose : computes the thermodynamics of ice thickness distribution 61 !! 56 62 !! ** Method : 57 !! 58 !! ** Arguments : 59 !! kideb , kiut : Starting and ending points on which the 60 !! the computation is applied 61 !! 62 !! ** Inputs / Ouputs : (global commons) 63 !! 64 !! ** External : 65 !! 66 !! ** References : 67 !! 68 !! ** History : 69 !! (12-2005) Martin Vancoppenolle 70 !! 71 !!------------------------------------------------------------------ 72 !! * Arguments 73 INTEGER, INTENT(in) :: kt 74 !! * Local variables 75 INTEGER :: jl, ja, & ! ice category, layers 76 jm, & ! ice types dummy loop index 77 jbnd1, & 78 jbnd2 79 80 REAL(wp) :: & ! constant values 81 zeps = 1.0e-10, & 82 epsi10 = 1.0e-10 63 !!------------------------------------------------------------------ 64 INTEGER, INTENT(in) :: kt ! time step index 65 ! 66 INTEGER :: jl, ja, jm, jbnd1, jbnd2 ! ice types dummy loop index 67 68 !!------------------------------------------------------------------ 83 69 84 70 IF( kt == nit000 .AND. lwp ) THEN … … 96 82 jbnd1 = ice_cat_bounds(jm,1) 97 83 jbnd2 = ice_cat_bounds(jm,2) 98 IF (ice_ncat_types(jm) .GT. 1 )CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt )84 IF( ice_ncat_types(jm) > 1 ) CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 99 85 END DO 100 101 CALL lim_var_glo2eqv ! only for info86 ! 87 CALL lim_var_glo2eqv ! only for info 102 88 CALL lim_var_agg(1) 103 89 … … 107 93 108 94 CALL lim_thd_lac 109 CALL lim_var_glo2eqv ! only for info95 CALL lim_var_glo2eqv ! only for info 110 96 111 97 !---------------------------------------------------------------------------------------- … … 120 106 d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 121 107 122 d_smv_i_thd(:,:,:) = 0.0 123 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 124 d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 108 d_smv_i_thd(:,:,:) = 0._wp 109 IF( num_sal == 2 .OR. num_sal == 4 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 125 110 126 111 IF(ln_ctl) THEN ! Control print … … 157 142 158 143 !- Recover Old values 159 a_i(:,:,:) = old_a_i (:,:,:) 160 v_s(:,:,:) = old_v_s (:,:,:) 161 v_i(:,:,:) = old_v_i (:,:,:) 162 e_s(:,:,:,:) = old_e_s (:,:,:,:) 163 e_i(:,:,:,:) = old_e_i (:,:,:,:) 164 165 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 166 smv_i(:,:,:) = old_smv_i (:,:,:) 167 144 a_i(:,:,:) = old_a_i (:,:,:) 145 v_s(:,:,:) = old_v_s (:,:,:) 146 v_i(:,:,:) = old_v_i (:,:,:) 147 e_s(:,:,:,:) = old_e_s (:,:,:,:) 148 e_i(:,:,:,:) = old_e_i (:,:,:,:) 149 ! 150 IF( num_sal == 2 .OR. num_sal == 4 ) smv_i(:,:,:) = old_smv_i (:,:,:) 151 ! 168 152 END SUBROUTINE lim_itd_th 169 153 ! … … 172 156 !!------------------------------------------------------------------ 173 157 !! *** ROUTINE lim_itd_th_rem *** 174 !! ** Purpose :175 !! This routinecomputes the redistribution of ice thickness176 !! after thermodynamic growth of ice thickness158 !! 159 !! ** Purpose : computes the redistribution of ice thickness 160 !! after thermodynamic growth of ice thickness 177 161 !! 178 162 !! ** Method : Linear remapping 179 163 !! 180 !! ** Arguments : 181 !! klbnd, kubnd : Starting and ending category index on which the 182 !! the computation is applied 183 !! 184 !! ** Inputs / Ouputs : (global commons) 185 !! 186 !! ** External : 187 !! 188 !! ** References : W.H. Lipscomb, JGR 2001 189 !! 190 !! ** History : 191 !! largely inspired from CICE (c) W. H. Lipscomb and E.C. Hunke 192 !! 193 !! (01-2006) Martin Vancoppenolle, UCL-ASTR, translation from 194 !! CICE 195 !! (06-2006) Adaptation to include salt, age and types 196 !! (04-2007) Mass conservation checked 197 !!------------------------------------------------------------------ 198 !! * Arguments 199 200 INTEGER , INTENT (IN) :: & 201 klbnd , & ! Start thickness category index point 202 kubnd , & ! End point on which the the computation is applied 203 ntyp , & ! Number of the type used 204 kt ! Ocean time step 205 206 !! * Local variables 207 INTEGER :: ji, & ! spatial dummy loop index 208 jj, & ! spatial dummy loop index 209 jl, & ! ice category dummy loop index 210 zji, zjj, & ! dummy indices used when changing coordinates 211 nd ! used for thickness categories 212 213 INTEGER , DIMENSION(jpi,jpj,jpl-1) :: & 214 zdonor ! donor category index 215 216 REAL(wp) :: & ! constant values 217 zeps = 1.0e-10 218 219 REAL(wp) :: & ! constant values for ice enthalpy 220 zindb , & 221 zareamin , & ! minimum tolerated area in a thickness category 222 zwk1, zwk2, & ! all the following are dummy arguments 223 zx1, zx2, zx3, & ! 224 zetamin , & ! minimum value of eta 225 zetamax , & ! maximum value of eta 226 zdh0 , & ! 227 zda0 , & ! 228 zdamax , & ! 229 zhimin 164 !! References : W.H. Lipscomb, JGR 2001 165 !!------------------------------------------------------------------ 166 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 167 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 168 INTEGER , INTENT (in) :: ntyp ! Number of the type used 169 INTEGER , INTENT (in) :: kt ! Ocean time step 170 ! 171 INTEGER :: ji, jj, jl ! dummy loop index 172 INTEGER :: zji, zjj, nd ! local integer 173 REAL(wp) :: zx1, zwk1, zdh0, zetamin, zdamax ! local scalars 174 REAL(wp) :: zx2, zwk2, zda0, zetamax, zhimin ! - - 175 REAL(wp) :: zx3, zareamin, zindb ! - - 176 CHARACTER (len = 15) :: fieldid 177 178 INTEGER , DIMENSION(jpi,jpj,jpl-1) :: zdonor ! donor category index 230 179 231 180 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & … … 238 187 dummy_es 239 188 240 REAL(wp), DIMENSION(jpi,jpj,jpl-1) :: & 241 zdaice , & ! local increment of ice area 242 zdvice ! local increment of ice volume 243 244 REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: & 245 zhbnew ! new boundaries of ice categories 246 247 REAL(wp), DIMENSION(jpi,jpj) :: & 248 zhb0, zhb1 ! category boundaries for thinnes categories 249 250 REAL, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 251 zvetamin, zvetamax ! maximum values for etas 252 253 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 254 nind_i , & ! compressed indices for i/j directions 255 nind_j 256 257 INTEGER :: & 258 nbrem ! number of cells with ice to transfer 259 260 LOGICAL, DIMENSION(jpi,jpj) :: & !: 261 zremap_flag ! compute remapping or not ???? 262 263 REAL(wp) :: & ! constant values for ice enthalpy 264 zslope ! used to compute local thermodynamic "speeds" 265 266 REAL (wp), DIMENSION(jpi,jpj) :: & ! 267 vt_i_init, vt_i_final, & ! ice volume summed over categories 268 vt_s_init, vt_s_final, & ! snow volume summed over categories 269 et_i_init, et_i_final, & ! ice energy summed over categories 270 et_s_init, et_s_final ! snow energy summed over categories 271 272 CHARACTER (len = 15) :: fieldid 273 274 !!-- End of declarations 275 !!---------------------------------------------------------------------------------------------- 276 zhimin = 0.1 !minimum ice thickness tolerated by the model 277 zareamin = zeps !minimum area in thickness categories tolerated by the conceptors of the model 189 REAL(wp), DIMENSION(jpi,jpj,jpl-1) :: zdaice, zdvice ! local increment of ice area and volume 190 191 REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: zhbnew ! new boundaries of ice categories 192 193 194 REAL, DIMENSION(1:(jpi+1)*(jpj+1)) :: zvetamin, zvetamax ! maximum values for etas 195 196 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions 197 198 INTEGER :: nbrem ! number of cells with ice to transfer 199 200 LOGICAL, DIMENSION(jpi,jpj) :: zremap_flag ! compute remapping or not ???? 201 202 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 203 204 REAL(wp), DIMENSION(jpi,jpj) :: zhb0, zhb1 ! category boundaries for thinnes categories 205 REAL(wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 206 REAL(wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 207 REAL(wp), DIMENSION(jpi,jpj) :: et_i_init, et_i_final ! ice energy summed over categories 208 REAL(wp), DIMENSION(jpi,jpj) :: et_s_init, et_s_final ! snow energy summed over categories 209 !!------------------------------------------------------------------ 210 211 zhimin = 0.1 !minimum ice thickness tolerated by the model 212 zareamin = epsi10 !minimum area in thickness categories tolerated by the conceptors of the model 278 213 279 214 !!---------------------------------------------------------------------------------------------- 280 215 !! 0) Conservation checkand changes in each ice category 281 216 !!---------------------------------------------------------------------------------------------- 282 IF 217 IF( con_i ) THEN 283 218 CALL lim_column_sum (jpl, v_i, vt_i_init) 284 219 CALL lim_column_sum (jpl, v_s, vt_s_init) … … 291 226 !! 1) Compute thickness and changes in each ice category 292 227 !!---------------------------------------------------------------------------------------------- 293 IF (kt == nit000 .AND. lwp) THEN228 IF( kt == nit000 .AND. lwp) THEN 294 229 WRITE(numout,*) 295 230 WRITE(numout,*) 'lim_itd_th_rem : Remapping the ice thickness distribution' … … 300 235 ENDIF 301 236 302 zdhice(:,:,:) = 0. 0237 zdhice(:,:,:) = 0._wp 303 238 DO jl = klbnd, kubnd 304 239 DO jj = 1, jpj 305 240 DO ji = 1, jpi 306 241 zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 307 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl), zeps) * zindb242 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl),epsi10) * zindb 308 243 zindb = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl))) !0 if no ice and 1 if yes 309 zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX(old_a_i(ji,jj,jl),zeps) * zindb 310 IF (a_i(ji,jj,jl).gt.1e-6) THEN 311 zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 312 ENDIF 244 zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX(old_a_i(ji,jj,jl),epsi10) * zindb 245 IF( a_i(ji,jj,jl) > 1e-6 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 313 246 END DO 314 247 END DO … … 318 251 ! 2) Compute fractional ice area in each grid cell 319 252 !----------------------------------------------------------------------------------------------- 320 at_i(:,:) = 0. 0253 at_i(:,:) = 0._wp 321 254 DO jl = klbnd, kubnd 322 DO jj = 1, jpj 323 DO ji = 1, jpi 324 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 325 END DO 326 END DO 255 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 327 256 END DO 328 257 … … 351 280 ! will be soon removed, CT 352 281 ! hi_max(kubnd) = 999.99 353 zhbnew(:,:,:) = 0. 0282 zhbnew(:,:,:) = 0._wp 354 283 355 284 DO jl = klbnd, kubnd - 1 356 ! jl357 285 DO ji = 1, nbrem 358 ! jl, ji359 286 zji = nind_i(ji) 360 287 zjj = nind_j(ji) 361 288 ! 362 IF ( ( zht_i_o(zji,zjj,jl) .GT. zeps) .AND. &363 ( zht_i_o(zji,zjj,jl+1).GT. zeps) ) THEN289 IF ( ( zht_i_o(zji,zjj,jl) .GT.epsi10 ) .AND. & 290 ( zht_i_o(zji,zjj,jl+1).GT.epsi10 ) ) THEN 364 291 !interpolate between adjacent category growth rates 365 292 zslope = ( zdhice(zji,zjj,jl+1) - zdhice(zji,zjj,jl) ) / & … … 367 294 zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl) + & 368 295 zslope * ( hi_max(jl) - zht_i_o(zji,zjj,jl) ) 369 ELSEIF (zht_i_o(zji,zjj,jl).gt. zeps) THEN296 ELSEIF (zht_i_o(zji,zjj,jl).gt.epsi10) THEN 370 297 zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl) 371 ELSEIF (zht_i_o(zji,zjj,jl+1).gt. zeps) THEN298 ELSEIF (zht_i_o(zji,zjj,jl+1).gt.epsi10) THEN 372 299 zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl+1) 373 300 ELSE 374 301 zhbnew(zji,zjj,jl) = hi_max(jl) 375 302 ENDIF 376 ! jl, ji 377 END DO !ji 378 ! jl 303 END DO 379 304 380 305 !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness … … 384 309 zjj = nind_j(ji) 385 310 ! jl, ji 386 IF ( ( a_i(zji,zjj,jl) .GT. zeps) .AND. &311 IF ( ( a_i(zji,zjj,jl) .GT.epsi10) .AND. & 387 312 ( ht_i(zji,zjj,jl).GE. zhbnew(zji,zjj,jl) ) & 388 313 ) THEN 389 314 zremap_flag(zji,zjj) = .false. 390 ELSEIF ( ( a_i(zji,zjj,jl+1) .GT. zeps) .AND. &315 ELSEIF ( ( a_i(zji,zjj,jl+1) .GT. epsi10 ) .AND. & 391 316 ( ht_i(zji,zjj,jl+1).LE. zhbnew(zji,zjj,jl) ) & 392 317 ) THEN … … 430 355 zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er 431 356 432 zhbnew(ji,jj,klbnd-1) = 0. 0433 434 IF ( a_i(ji,jj,kubnd) .GT. zeps) THEN435 zhbnew(ji,jj,kubnd) = 3. 0*ht_i(ji,jj,kubnd) - 2.0*zhbnew(ji,jj,kubnd-1)357 zhbnew(ji,jj,klbnd-1) = 0._wp 358 359 IF( a_i(ji,jj,kubnd) > epsi10 ) THEN 360 zhbnew(ji,jj,kubnd) = 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) 436 361 ELSE 437 362 zhbnew(ji,jj,kubnd) = hi_max(kubnd) 438 363 ENDIF 439 364 440 IF ( zhbnew(ji,jj,kubnd) .LT. hi_max(kubnd-1) ) & 441 zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 365 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 442 366 443 367 END DO !jj … … 448 372 !----------------------------------------------------------------------------------------------- 449 373 !- 7.1 g(h) for category 1 at start of time step 450 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd),&451 g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),&452 hR(:,:,klbnd), zremap_flag)374 CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd), & 375 & g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 376 & hR(:,:,klbnd), zremap_flag ) 453 377 454 378 !- 7.2 Area lost due to melting of thin ice (first category, klbnd) … … 458 382 459 383 !ji 460 IF (a_i(zji,zjj,klbnd) .gt. zeps) THEN384 IF (a_i(zji,zjj,klbnd) .gt. epsi10) THEN 461 385 zdh0 = zdhice(zji,zjj,klbnd) !decrease of ice thickness in the lower category 462 ! ji, a_i > zeps386 ! ji, a_i > epsi10 463 387 IF (zdh0 .lt. 0.0) THEN !remove area from category 1 464 ! ji, a_i > zeps; zdh0 < 0388 ! ji, a_i > epsi10; zdh0 < 0 465 389 zdh0 = MIN(-zdh0,hi_max(klbnd)) 466 390 … … 483 407 v_i(zji,zjj,klbnd) = a_i(zji,zjj,klbnd)*ht_i(zji,zjj,klbnd) 484 408 ENDIF ! zetamax > 0 485 ! ji, a_i > zeps409 ! ji, a_i > epsi10 486 410 487 411 ELSE ! if ice accretion 488 ! ji, a_i > zeps; zdh0 > 0412 ! ji, a_i > epsi10; zdh0 > 0 489 413 IF ( ntyp .EQ. 1 ) zhbnew(zji,zjj,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 490 414 ! zhbnew was 0, and is shifted to the right to account for thin ice … … 495 419 ENDIF ! zdh0 496 420 497 ! a_i > zeps498 ENDIF ! a_i > zeps421 ! a_i > epsi10 422 ENDIF ! a_i > epsi10 499 423 500 424 END DO ! ji … … 571 495 zjj = nind_j(ji) 572 496 IF ( ( zhimin .GT. 0.0 ) .AND. & 573 ( ( a_i(zji,zjj,1) .GT. zeps) .AND. ( ht_i(zji,zjj,1) .LT. zhimin ) ) &497 ( ( a_i(zji,zjj,1) .GT. epsi10 ) .AND. ( ht_i(zji,zjj,1) .LT. zhimin ) ) & 574 498 ) THEN 575 499 a_i(zji,zjj,1) = a_i(zji,zjj,1) * ht_i(zji,zjj,1) / zhimin … … 602 526 603 527 END SUBROUTINE lim_itd_th_rem 604 ! 605 606 SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag )607 528 529 530 SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, & 531 & g0, g1, hL, hR, zremap_flag ) 608 532 !!------------------------------------------------------------------ 609 533 !! *** ROUTINE lim_itd_fitline *** 610 !! ** Purpose :611 !! fit g(h) with a line using area, volume constraints612 534 !! 613 !! ** Method : 614 !! Fit g(h) with a line, satisfying area and volume constraints. 615 !! To reduce roundoff errors caused by large values of g0 and g1, 616 !! we actually compute g(eta), where eta = h - hL, and hL is the 617 !! left boundary. 535 !! ** Purpose : fit g(h) with a line using area, volume constraints 618 536 !! 619 !! ** Arguments : 620 !! 621 !! ** Inputs / Ouputs : (global commons) 622 !! 623 !! ** External : 624 !! 625 !! ** References : 626 !! 627 !! ** History : 628 !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 629 !! (01-2006) Martin Vancoppenolle 630 !! 631 !!------------------------------------------------------------------ 632 !! * Arguments 633 634 INTEGER, INTENT(in) :: num_cat ! category index 635 636 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & !: 637 HbL, HbR ! left and right category boundaries 638 639 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & !: 640 hice ! ice thickness 641 642 REAL(wp), DIMENSION(jpi,jpj), INTENT(OUT) :: & !: 643 g0, g1 , & ! coefficients in linear equation for g(eta) 644 hL , & ! min value of range over which g(h) > 0 645 hR ! max value of range over which g(h) > 0 646 647 LOGICAL, DIMENSION(jpi,jpj), INTENT(IN) :: & !: 648 zremap_flag 649 650 INTEGER :: & 651 ji,jj ! horizontal indices 652 653 REAL(wp) :: & 654 zh13 , & ! HbL + 1/3 * (HbR - HbL) 655 zh23 , & ! HbL + 2/3 * (HbR - HbL) 656 zdhr , & ! 1 / (hR - hL) 657 zwk1, zwk2 , & ! temporary variables 658 zacrith ! critical minimum concentration in an ice category 659 660 REAL(wp) :: & ! constant values 661 zeps = 1.0e-10 662 537 !! ** Method : Fit g(h) with a line, satisfying area and volume constraints. 538 !! To reduce roundoff errors caused by large values of g0 and g1, 539 !! we actually compute g(eta), where eta = h - hL, and hL is the 540 !! left boundary. 541 !!------------------------------------------------------------------ 542 INTEGER , INTENT(in ) :: num_cat ! category index 543 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: HbL, HbR ! left and right category boundaries 544 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: hice ! ice thickness 545 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: g0, g1 ! coefficients in linear equation for g(eta) 546 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: hL ! min value of range over which g(h) > 0 547 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: hR ! max value of range over which g(h) > 0 548 LOGICAL , DIMENSION(jpi,jpj), INTENT(in ) :: zremap_flag ! 549 ! 550 INTEGER :: ji,jj ! horizontal indices 551 REAL(wp) :: zh13 ! HbL + 1/3 * (HbR - HbL) 552 REAL(wp) :: zh23 ! HbL + 2/3 * (HbR - HbL) 553 REAL(wp) :: zdhr ! 1 / (hR - hL) 554 REAL(wp) :: zwk1, zwk2 ! temporary variables 555 REAL(wp) :: zacrith ! critical minimum concentration in an ice category 556 !!------------------------------------------------------------------ 557 ! 663 558 zacrith = 1.0e-6 664 !!-- End of declarations 665 !!---------------------------------------------------------------------------------------------- 666 559 ! 667 560 DO jj = 1, jpj 668 561 DO ji = 1, jpi 669 670 IF ( zremap_flag(ji,jj) .AND. a_i(ji,jj,num_cat) .gt. zacrith&671 .AND. hice(ji,jj) .GT. 0.0) THEN562 ! 563 IF( zremap_flag(ji,jj) .AND. a_i(ji,jj,num_cat) > zacrith & 564 & .AND. hice(ji,jj) > 0._wp ) THEN 672 565 673 566 ! Initialize hL and hR … … 681 574 zh23 = 1.0/3.0 * (hL(ji,jj) + 2.0*hR(ji,jj)) 682 575 683 IF (hice(ji,jj) < zh13) THEN 684 hR(ji,jj) = 3.0*hice(ji,jj) - 2.0*hL(ji,jj) 685 ELSEIF (hice(ji,jj) > zh23) THEN 686 hL(ji,jj) = 3.0*hice(ji,jj) - 2.0*hR(ji,jj) 576 IF ( hice(ji,jj) < zh13 ) THEN ; hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj) 577 ELSEIF( hice(ji,jj) > zh23 ) THEN ; hL(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hR(ji,jj) 687 578 ENDIF 688 579 689 580 ! Compute coefficients of g(eta) = g0 + g1*eta 690 581 691 zdhr = 1.0 / (hR(ji,jj) - hL(ji,jj)) 692 zwk1 = 6.0 * a_i(ji,jj,num_cat) * zdhr 693 zwk2 = (hice(ji,jj) - hL(ji,jj)) * zdhr 694 g0(ji,jj) = zwk1 * (2.0/3.0 - zwk2) 695 g1(ji,jj) = 2.0*zdhr * zwk1 * (zwk2 - 0.5) 696 697 ELSE ! remap_flag = .false. or a_i < zeps 698 699 hL(ji,jj) = 0.0 700 hR(ji,jj) = 0.0 701 g0(ji,jj) = 0.0 702 g1(ji,jj) = 0.0 703 704 ENDIF ! a_i > zeps 705 706 END DO !ji 707 END DO ! jj 708 582 zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj)) 583 zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr 584 zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr 585 g0(ji,jj) = zwk1 * ( 2._wp/3._wp - zwk2 ) 586 g1(ji,jj) = 2._wp * zdhr * zwk1 * (zwk2 - 0.5) 587 ! 588 ELSE ! remap_flag = .false. or a_i < epsi10 589 hL(ji,jj) = 0._wp 590 hR(ji,jj) = 0._wp 591 g0(ji,jj) = 0._wp 592 g1(ji,jj) = 0._wp 593 ENDIF ! a_i > epsi10 594 ! 595 END DO 596 END DO 597 ! 709 598 END SUBROUTINE lim_itd_fitline 710 ! 711 712 SUBROUTINE lim_itd_shiftice (klbnd, kubnd, zdonor, zdaice, zdvice)599 600 601 SUBROUTINE lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 713 602 !!------------------------------------------------------------------ 714 603 !! *** ROUTINE lim_itd_shiftice *** 715 !! ** Purpose : shift ice across category boundaries, conserving everything 604 !! 605 !! ** Purpose : shift ice across category boundaries, conserving everything 716 606 !! ( area, volume, energy, age*vol, and mass of salt ) 717 607 !! 718 608 !! ** Method : 719 !! 720 !! ** Arguments : 721 !! 722 !! ** Inputs / Ouputs : (global commons) 723 !! 724 !! ** External : 725 !! 726 !! ** References : 727 !! 728 !! ** History : 729 !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 730 !! (01-2006) Martin Vancoppenolle 731 !! 732 !!------------------------------------------------------------------ 733 !! * Arguments 734 735 INTEGER , INTENT (IN) :: & 736 klbnd , & ! Start thickness category index point 737 kubnd ! End point on which the the computation is applied 738 739 INTEGER , DIMENSION(jpi,jpj,jpl-1), INTENT(IN) :: & 740 zdonor ! donor category index 741 742 REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(INOUT) :: & 743 zdaice , & ! ice area transferred across boundary 744 zdvice ! ice volume transferred across boundary 745 746 INTEGER :: & 747 ji,jj,jl, & ! horizontal indices, thickness category index 748 jl2, & ! receiver category 749 jl1, & ! donor category 750 jk, & ! ice layer index 751 zji, zjj ! indices when changing from 2D-1D is done 752 753 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 754 zaTsfn 755 756 REAL(wp), DIMENSION(jpi,jpj) :: & 757 zworka ! temporary array used here 758 759 REAL(wp) :: & 760 zdvsnow , & ! snow volume transferred 761 zdesnow , & ! snow energy transferred 762 zdeice , & ! ice energy transferred 763 zdsm_vice , & ! ice salinity times volume transferred 764 zdo_aice , & ! ice age times volume transferred 765 zdaTsf , & ! aicen*Tsfcn transferred 766 zindsn , & ! snow or not 767 zindb ! ice or not 768 769 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 770 nind_i , & ! compressed indices for i/j directions 771 nind_j 772 773 INTEGER :: & 774 nbrem ! number of cells with ice to transfer 775 776 LOGICAL :: & 777 zdaice_negative , & ! true if daice < -puny 778 zdvice_negative , & ! true if dvice < -puny 779 zdaice_greater_aicen , & ! true if daice > aicen 780 zdvice_greater_vicen ! true if dvice > vicen 781 782 REAL(wp) :: & ! constant values 783 zeps = 1.0e-10 784 785 !!-- End of declarations 609 !!------------------------------------------------------------------ 610 INTEGER , INTENT(in ) :: klbnd ! Start thickness category index point 611 INTEGER , INTENT(in ) :: kubnd ! End point on which the the computation is applied 612 613 INTEGER , DIMENSION(jpi,jpj,jpl-1), INTENT(in ) :: zdonor ! donor category index 614 615 REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) :: zdaice ! ice area transferred across boundary 616 REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) :: zdvice ! ice volume transferred across boundary 617 618 INTEGER :: ji, jj, jl, jl2, jl1, jk ! dummy loop indices 619 INTEGER :: zji, zjj ! indices when changing from 2D-1D is done 620 621 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zaTsfn 622 623 REAL(wp), DIMENSION(jpi,jpj) :: zworka ! temporary array used here 624 625 REAL(wp) :: zdvsnow, zdesnow ! snow volume and energy transferred 626 REAL(wp) :: zdeice ! ice energy transferred 627 REAL(wp) :: zdsm_vice ! ice salinity times volume transferred 628 REAL(wp) :: zdo_aice ! ice age times volume transferred 629 REAL(wp) :: zdaTsf ! aicen*Tsfcn transferred 630 REAL(wp) :: zindsn ! snow or not 631 REAL(wp) :: zindb ! ice or not 632 633 INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: nind_i, nind_j ! compressed indices for i/j directions 634 635 INTEGER :: nbrem ! number of cells with ice to transfer 636 637 LOGICAL :: zdaice_negative ! true if daice < -puny 638 LOGICAL :: zdvice_negative ! true if dvice < -puny 639 LOGICAL :: zdaice_greater_aicen ! true if daice > aicen 640 LOGICAL :: zdvice_greater_vicen ! true if dvice > vicen 641 !!------------------------------------------------------------------ 786 642 787 643 !---------------------------------------------------------------------------------------------- … … 790 646 791 647 DO jl = klbnd, kubnd 792 DO jj = 1, jpj 793 DO ji = 1, jpi 794 zaTsfn(ji,jj,jl) = a_i(ji,jj,jl)*t_su(ji,jj,jl) 795 END DO ! ji 796 END DO ! jj 797 END DO ! jl 648 zaTsfn(:,:,jl) = a_i(:,:,jl)*t_su(:,:,jl) 649 END DO 798 650 799 651 !---------------------------------------------------------------------------------------------- … … 821 673 822 674 IF (zdaice(ji,jj,jl) .LT. 0.0) THEN 823 IF (zdaice(ji,jj,jl) .GT. - zeps) THEN675 IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN 824 676 IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) ) & 825 677 .OR. & … … 838 690 839 691 IF (zdvice(ji,jj,jl) .LT. 0.0) THEN 840 IF (zdvice(ji,jj,jl) .GT. - zeps) THEN692 IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN 841 693 IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) ) & 842 694 .OR. & … … 855 707 856 708 ! If daice is close to aicen, set daice = aicen. 857 IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - zeps) THEN858 IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+ zeps) THEN709 IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 ) THEN 710 IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+epsi10) THEN 859 711 zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 860 712 zdvice(ji,jj,jl) = v_i(ji,jj,jl1) … … 864 716 ENDIF 865 717 866 IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)- zeps) THEN867 IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+ zeps) THEN718 IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-epsi10) THEN 719 IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+epsi10) THEN 868 720 zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 869 721 zdvice(ji,jj,jl) = v_i(ji,jj,jl1) … … 900 752 901 753 jl1 = zdonor(zji,zjj,jl) 902 zindb = MAX( 0.0 , SIGN( 1.0 , v_i(zji,zjj,jl1) - zeps ) ) 903 zworka(zji,zjj) = zdvice(zji,zjj,jl) / MAX(v_i(zji,zjj,jl1),zeps) * zindb 904 IF (jl1 .eq. jl) THEN 905 jl2 = jl1+1 906 ELSE ! n1 = n+1 907 jl2 = jl 754 zindb = MAX( 0.0 , SIGN( 1.0 , v_i(zji,zjj,jl1) - epsi10 ) ) 755 zworka(zji,zjj) = zdvice(zji,zjj,jl) / MAX(v_i(zji,zjj,jl1),epsi10) * zindb 756 IF( jl1 == jl) THEN ; jl2 = jl1+1 757 ELSE ; jl2 = jl 908 758 ENDIF 909 759 … … 996 846 DO jj = 1, jpj 997 847 DO ji = 1, jpi 998 IF ( a_i(ji,jj,jl) .GT. zeps) THEN999 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / a_i(ji,jj,jl)848 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 849 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / a_i(ji,jj,jl) 1000 850 t_su(ji,jj,jl) = zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 1001 851 zindsn = 1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl))) !0 if no ice and 1 if yes 1002 852 ELSE 1003 ht_i(ji,jj,jl) = 0. 0853 ht_i(ji,jj,jl) = 0._wp 1004 854 t_su(ji,jj,jl) = rtt 1005 855 ENDIF … … 1007 857 END DO ! jj 1008 858 END DO ! jl 1009 859 ! 1010 860 END SUBROUTINE lim_itd_shiftice 1011 !1012 1013 SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp)861 862 863 SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp ) 1014 864 !!------------------------------------------------------------------ 1015 865 !! *** ROUTINE lim_itd_th_reb *** 866 !! 1016 867 !! ** Purpose : rebin - rebins thicknesses into defined categories 1017 868 !! 1018 869 !! ** Method : 1019 !! 1020 !! ** Arguments : 1021 !! 1022 !! ** Inputs / Ouputs : (global commons) 1023 !! 1024 !! ** External : 1025 !! 1026 !! ** References : 1027 !! 1028 !! ** History : (2005) Translation from CICE 1029 !! (2006) Adaptation to include salt, age and types 1030 !! (2007) Mass conservation checked 1031 !! 1032 !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 1033 !! (01-2006) Martin Vancoppenolle (adaptation) 1034 !! 1035 !!------------------------------------------------------------------ 1036 !! * Arguments 1037 INTEGER , INTENT (in) :: & 1038 klbnd , & ! Start thickness category index point 1039 kubnd , & ! End point on which the the computation is applied 1040 ntyp ! number of the ice type involved in the rebinning process 1041 1042 INTEGER :: & 1043 ji,jj, & ! horizontal indices 1044 jl ! category index 1045 1046 INTEGER :: & !: 1047 zshiftflag ! = .true. if ice must be shifted 1048 1049 INTEGER, DIMENSION(jpi,jpj,jpl) :: & 1050 zdonor ! donor category index 1051 1052 REAL(wp), DIMENSION(jpi, jpj, jpl) :: & 1053 zdaice , & ! ice area transferred 1054 zdvice ! ice volume transferred 1055 1056 REAL(wp) :: & ! constant values 1057 zeps = 1.0e-10, & 1058 epsi10 = 1.0e-10 1059 1060 REAL (wp), DIMENSION(jpi,jpj) :: & ! 1061 vt_i_init, vt_i_final, & ! ice volume summed over categories 1062 vt_s_init, vt_s_final ! snow volume summed over categories 1063 870 !!------------------------------------------------------------------ 871 INTEGER , INTENT (in) :: klbnd ! Start thickness category index point 872 INTEGER , INTENT (in) :: kubnd ! End point on which the the computation is applied 873 INTEGER , INTENT (in) :: ntyp ! number of the ice type involved in the rebinning process 874 ! 875 INTEGER :: ji,jj, jl ! dummy loop indices 876 INTEGER :: zshiftflag ! = .true. if ice must be shifted 1064 877 CHARACTER (len = 15) :: fieldid 1065 878 1066 !!-- End of declarations 1067 !------------------------------------------------------------------------------ 1068 1069 ! ! conservation check 1070 IF ( con_i ) THEN 879 INTEGER , DIMENSION(jpi,jpj,jpl) :: zdonor ! donor category index 880 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zdaice, zdvice ! ice area and volume transferred 881 882 REAL (wp), DIMENSION(jpi,jpj) :: vt_i_init, vt_i_final ! ice volume summed over categories 883 REAL (wp), DIMENSION(jpi,jpj) :: vt_s_init, vt_s_final ! snow volume summed over categories 884 !!------------------------------------------------------------------ 885 ! 886 IF( con_i ) THEN ! conservation check 1071 887 CALL lim_column_sum (jpl, v_i, vt_i_init) 1072 888 CALL lim_column_sum (jpl, v_s, vt_s_init) … … 1080 896 DO jj = 1, jpj 1081 897 DO ji = 1, jpi 1082 IF (a_i(ji,jj,jl) .GT. zeps) THEN898 IF( a_i(ji,jj,jl) > epsi10 ) THEN 1083 899 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 1084 900 ELSE 1085 ht_i(ji,jj,jl) = 0. 0901 ht_i(ji,jj,jl) = 0._wp 1086 902 ENDIF 1087 END DO ! i1088 END DO ! j1089 END DO ! n903 END DO 904 END DO 905 END DO 1090 906 1091 907 !------------------------------------------------------------------------------ … … 1094 910 DO jj = 1, jpj 1095 911 DO ji = 1, jpi 1096 1097 IF (a_i(ji,jj,klbnd) > zeps) THEN 1098 IF (ht_i(ji,jj,klbnd) .LE. hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) .GT. 0.0 ) THEN 912 IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 913 IF( ht_i(ji,jj,klbnd) <= hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN 1099 914 a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp) 1100 915 ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp) 1101 916 ENDIF 1102 917 ENDIF 1103 END DO ! i1104 END DO ! j918 END DO 919 END DO 1105 920 1106 921 !------------------------------------------------------------------------------ … … 1111 926 ! Initialize shift arrays 1112 927 !------------------------- 1113 1114 928 DO jl = klbnd, kubnd 1115 DO jj = 1, jpj 1116 DO ji = 1, jpi 1117 zdonor(ji,jj,jl) = 0 1118 zdaice(ji,jj,jl) = 0.0 1119 zdvice(ji,jj,jl) = 0.0 1120 END DO 1121 END DO 929 zdonor(:,:,jl) = 0 930 zdaice(:,:,jl) = 0._wp 931 zdvice(:,:,jl) = 0._wp 1122 932 END DO 1123 933 … … 1135 945 DO jj = 1, jpj 1136 946 DO ji = 1, jpi 1137 IF (a_i(ji,jj,jl) .GT. zeps .AND. ht_i(ji,jj,jl) .GT.hi_max(jl) ) THEN947 IF( a_i(ji,jj,jl) > epsi10 .AND. ht_i(ji,jj,jl) > hi_max(jl) ) THEN 1138 948 zshiftflag = 1 1139 949 zdonor(ji,jj,jl) = jl … … 1143 953 END DO ! ji 1144 954 END DO ! jj 1145 IF( lk_mpp ) CALL mpp_max(zshiftflag) 1146 1147 IF ( zshiftflag == 1 ) THEN 1148 1149 !------------------------------ 1150 ! Shift ice between categories 1151 !------------------------------ 1152 CALL lim_itd_shiftice (klbnd, kubnd, zdonor, zdaice, zdvice) 1153 1154 !------------------------ 955 IF(lk_mpp) CALL mpp_max( zshiftflag ) 956 957 IF( zshiftflag == 1 ) THEN ! Shift ice between categories 958 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 1155 959 ! Reset shift parameters 1156 !------------------------ 1157 DO jj = 1, jpj 1158 DO ji = 1, jpi 1159 zdonor(ji,jj,jl) = 0 1160 zdaice(ji,jj,jl) = 0.0 1161 zdvice(ji,jj,jl) = 0.0 1162 END DO 1163 END DO 1164 1165 ENDIF ! zshiftflag 1166 960 zdonor(:,:,jl) = 0 961 zdaice(:,:,jl) = 0._wp 962 zdvice(:,:,jl) = 0._wp 963 ENDIF 964 ! 1167 965 END DO ! jl 1168 966 … … 1180 978 DO jj = 1, jpj 1181 979 DO ji = 1, jpi 1182 IF (a_i(ji,jj,jl+1) .GT. zeps .AND.&1183 ht_i(ji,jj,jl+1) .LE. hi_max(jl)) THEN1184 980 IF( a_i(ji,jj,jl+1) > epsi10 .AND. & 981 ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 982 ! 1185 983 zshiftflag = 1 1186 984 zdonor(ji,jj,jl) = jl + 1 … … 1191 989 END DO ! jj 1192 990 1193 IF(lk_mpp) CALL mpp_max(zshiftflag) 1194 IF (zshiftflag==1) THEN 1195 1196 !------------------------------ 1197 ! Shift ice between categories 1198 !------------------------------ 1199 CALL lim_itd_shiftice (klbnd, kubnd, zdonor, zdaice, zdvice) 1200 1201 !------------------------ 991 IF(lk_mpp) CALL mpp_max( zshiftflag ) 992 993 IF( zshiftflag == 1 ) THEN ! Shift ice between categories 994 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 1202 995 ! Reset shift parameters 1203 !------------------------ 1204 DO jj = 1, jpj 1205 DO ji = 1, jpi 1206 zdonor(ji,jj,jl) = 0 1207 zdaice(ji,jj,jl) = 0.0 1208 zdvice(ji,jj,jl) = 0.0 1209 END DO 1210 END DO 1211 1212 ENDIF ! zshiftflag 996 zdonor(:,:,jl) = 0 997 zdaice(:,:,jl) = 0._wp 998 zdvice(:,:,jl) = 0._wp 999 ENDIF 1213 1000 1214 1001 END DO ! jl … … 1218 1005 !------------------------------------------------------------------------------ 1219 1006 1220 IF 1007 IF( con_i ) THEN 1221 1008 CALL lim_column_sum (jpl, v_i, vt_i_final) 1222 1009 fieldid = ' v_i : limitd_reb ' … … 1227 1014 CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 1228 1015 ENDIF 1229 1016 ! 1230 1017 END SUBROUTINE lim_itd_th_reb 1231 1018 1232 1019 #else 1233 !!====================================================================== 1234 !! *** MODULE limitd_th *** 1235 !! no sea ice model 1236 !!====================================================================== 1020 !!---------------------------------------------------------------------- 1021 !! Default option Dummy module NO LIM sea-ice model 1022 !!---------------------------------------------------------------------- 1237 1023 CONTAINS 1238 1024 SUBROUTINE lim_itd_th ! Empty routines … … 1249 1035 END SUBROUTINE lim_itd_th_reb 1250 1036 #endif 1037 !!====================================================================== 1251 1038 END MODULE limitd_th -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
r2528 r2715 16 16 USE dom_ice ! sea-ice domain 17 17 USE in_out_manager ! I/O manager 18 USE lbclnk ! 18 USE lbclnk ! lateral boundary condition - MPP exchanges 19 USE lib_mpp ! MPP library 19 20 20 21 IMPLICIT NONE … … 24 25 25 26 !!---------------------------------------------------------------------- 26 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)27 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 27 28 !! $Id$ 28 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 29 30 !!---------------------------------------------------------------------- 30 31 31 CONTAINS 32 32 … … 45 45 !!--------------------------------------------------------------------- 46 46 INTEGER :: ji, jj ! dummy loop indices 47 REAL(wp) :: zusden ! temporaryscalar47 REAL(wp) :: zusden ! local scalar 48 48 !!--------------------------------------------------------------------- 49 49 … … 55 55 56 56 IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 ) & 57 & CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane' 57 & CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane') 58 58 59 59 ! !== coriolis factor & Equator position ==! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r2580 r2715 8 8 !! - ! 2008-11 (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy 9 9 !! 3.3 ! 2009-05 (G.Garric) addition of the lim2_evp cas 10 !! 4.0 ! 2011-01 (A Porter) dynamical allocation 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp ) … … 37 38 PRIVATE 38 39 39 PUBLIC lim_rhg ! routine called by lim_dyn (or lim_dyn_2) 40 PUBLIC lim_rhg ! routine called by lim_dyn (or lim_dyn_2) 41 PUBLIC lim_rhg_alloc ! routine called by nemo_alloc in nemogcm.F90 40 42 41 43 REAL(wp) :: rzero = 0._wp ! constant values 42 44 REAL(wp) :: rone = 1._wp ! constant values 43 45 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zpresh ! temporary array for ice strength 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zpreshc ! Ice strength on grid cell corners (zpreshc) 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfrld1, zfrld2 ! lead fraction on U/V points 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays 52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zc1 ! ice mass 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zusw ! temporary weight for ice strength computation 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce1, v_oce1 ! ocean u/v component on U points 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce2, v_oce2 ! ocean u/v component on V points 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses 58 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdd , zdt ! Divergence and tension at centre of grid cells 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zds ! Shear on northeast corner of grid cells 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: deltat, deltac ! Delta at centre and corners of grid cells 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs2 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs12 64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity 65 44 66 !! * Substitutions 45 67 # include "vectopt_loop_substitute.h90" 46 68 !!---------------------------------------------------------------------- 47 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)69 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 48 70 !! $Id$ 49 71 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 72 !!---------------------------------------------------------------------- 51 73 CONTAINS 74 75 FUNCTION lim_rhg_alloc() 76 !!------------------------------------------------------------------- 77 !! *** FUNCTION lim_rhg_alloc *** 78 !!------------------------------------------------------------------- 79 INTEGER :: lim_rhg_alloc ! return value 80 INTEGER :: ierr(2) ! local integer 81 !!------------------------------------------------------------------- 82 ! 83 ierr(:) = 0 84 ! 85 ALLOCATE( zpresh (jpi,jpj) , zfrld1(jpi,jpj), zmass1(jpi,jpj), zcorl1(jpi,jpj), za1ct(jpi,jpj) , & 86 & zpreshc(jpi,jpj) , zfrld2(jpi,jpj), zmass2(jpi,jpj), zcorl2(jpi,jpj), za2ct(jpi,jpj) , & 87 & zc1 (jpi,jpj) , u_oce1(jpi,jpj), u_oce2(jpi,jpj), u_ice2(jpi,jpj), & 88 & zusw (jpi,jpj) , v_oce1(jpi,jpj), v_oce2(jpi,jpj), v_ice1(jpi,jpj) , STAT=ierr(1) ) 89 ! 90 ALLOCATE( zf1(jpi,jpj) , deltat(jpi,jpj) , zu_ice(jpi,jpj) , & 91 & zf2(jpi,jpj) , deltac(jpi,jpj) , zv_ice(jpi,jpj) , & 92 & zdd(jpi,jpj) , zdt (jpi,jpj) , zds (jpi,jpj) , & 93 & zs1(jpi,jpj) , zs2 (jpi,jpj) , zs12 (jpi,jpj) , zresr(jpi,jpj), STAT=ierr(2) ) 94 ! 95 lim_rhg_alloc = MAXVAL(ierr) 96 ! 97 END FUNCTION lim_rhg_alloc 98 52 99 53 100 SUBROUTINE lim_rhg( k_j1, k_jpj ) … … 111 158 REAL(wp) :: za, zstms, zsang, zmask ! local scalars 112 159 113 REAL(wp),DIMENSION(jpi,jpj) :: & 114 zpresh , & !: temporary array for ice strength 115 zpreshc , & !: Ice strength on grid cell corners (zpreshc) 116 zfrld1, zfrld2, & !: lead fraction on U/V points 117 zmass1, zmass2, & !: ice/snow mass on U/V points 118 zcorl1, zcorl2, & !: coriolis parameter on U/V points 119 za1ct, za2ct , & !: temporary arrays 120 zc1 , & !: ice mass 121 zusw , & !: temporary weight for the computation 122 !: of ice strength 123 u_oce1, v_oce1, & !: ocean u/v component on U points 124 u_oce2, v_oce2, & !: ocean u/v component on V points 125 u_ice2, & !: ice u component on V point 126 v_ice1 !: ice v component on U point 127 128 REAL(wp) :: & 129 dtevp, & ! time step for subcycling 130 dtotel, & ! 131 ecc2, & ! square of yield ellipse eccenticity 132 z0, & ! temporary scalar 133 zr, & ! temporary scalar 134 zcca, zccb, & ! temporary scalars 135 zu_ice2, & ! 136 zv_ice1, & ! 137 zddc, zdtc, & ! temporary array for delta on corners 138 zdst, & ! temporary array for delta on centre 139 zdsshx, zdsshy, & ! term for the gradient of ocean surface 140 sigma1, sigma2 ! internal ice stress 141 142 REAL(wp),DIMENSION(jpi,jpj) :: zf1, zf2 ! arrays for internal stresses 143 144 REAL(wp),DIMENSION(jpi,jpj) :: & 145 zdd, zdt, & ! Divergence and tension at centre of grid cells 146 zds, & ! Shear on northeast corner of grid cells 147 deltat, & ! Delta at centre of grid cells 148 deltac, & ! Delta on corners 149 zs1, zs2, & ! Diagonal stress tensor components zs1 and zs2 150 zs12 ! Non-diagonal stress tensor component zs12 151 152 REAL(wp) :: & 153 zresm , & ! Maximal error on ice velocity 154 zindb , & ! ice (1) or not (0) 155 zdummy ! dummy argument 156 157 REAL(wp),DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! Local error on velocity 160 REAL(wp) :: dtevp ! time step for subcycling 161 REAL(wp) :: dtotel, ecc2 ! square of yield ellipse eccenticity 162 REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars 163 REAL(wp) :: zu_ice2, zv_ice1 ! 164 REAL(wp) :: zddc, zdtc, zdst ! delta on corners and on centre 165 REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface 166 REAL(wp) :: sigma1, sigma2 ! internal ice stress 167 168 REAL(wp) :: zresm ! Maximal error on ice velocity 169 REAL(wp) :: zindb ! ice (1) or not (0) 170 REAL(wp) :: zdummy ! dummy argument 158 171 !!------------------------------------------------------------------- 159 172 #if defined key_lim2 && ! defined key_lim2_vp … … 747 760 ENDIF 748 761 ENDIF 749 762 ! 750 763 END SUBROUTINE lim_rhg 751 764 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r2528 r2715 6 6 !! History: - ! 2005-04 (M. Vancoppenolle) Original code 7 7 !! 3.0 ! 2008-03 (C. Ethe) restart files in using IOM interface 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim3 … … 22 23 USE in_out_manager ! I/O manager 23 24 USE iom ! I/O library 25 USE lib_mpp ! MPP library 24 26 25 27 IMPLICIT NONE … … 34 36 35 37 !!---------------------------------------------------------------------- 36 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)38 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 37 39 !! $Id$ 38 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 90 92 !! ** purpose : output of sea-ice variable in a netcdf file 91 93 !!---------------------------------------------------------------------- 94 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 95 USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! 2D workspace 96 ! 92 97 INTEGER, INTENT(in) :: kt ! number of iteration 93 98 !! … … 96 101 CHARACTER(len=15) :: znam 97 102 CHARACTER(len=1) :: zchar, zchar1 98 REAL(wp), DIMENSION(jpi,jpj) :: z2d 99 !!---------------------------------------------------------------------- 103 !!---------------------------------------------------------------------- 104 105 IF( wrk_in_use(2, 1) ) THEN 106 CALL ctl_stop( 'lim_rst_write : requested workspace arrays unavailable' ) ; RETURN 107 END IF 100 108 101 109 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 … … 287 295 ENDIF 288 296 ! 297 IF( wrk_not_released(2, 1) ) CALL ctl_stop( 'lim_rst_write : failed to release workspace arrays' ) 298 ! 289 299 END SUBROUTINE lim_rst_write 290 300 … … 296 306 !! ** purpose : read of sea-ice variable restart in a netcdf file 297 307 !!---------------------------------------------------------------------- 308 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 309 USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! 2D workspace 310 ! 298 311 INTEGER :: ji, jj, jk, jl, indx 299 312 REAL(wp) :: zfice, ziter 300 313 REAL(wp) :: zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb ! local scalars used for the salinity profile 301 314 REAL(wp), DIMENSION(nlay_i) :: zs_zero 302 REAL(wp), DIMENSION(jpi,jpj) :: z2d303 315 CHARACTER(len=15) :: znam 304 316 CHARACTER(len=1) :: zchar, zchar1 … … 307 319 !!---------------------------------------------------------------------- 308 320 321 IF( wrk_in_use(2, 1) ) THEN 322 CALL ctl_stop( 'lim_rst_read : requested workspace arrays unavailable.' ) ; RETURN 323 ENDIF 324 309 325 IF(lwp) THEN 310 326 WRITE(numout,*) 311 327 WRITE(numout,*) 'lim_rst_read : read ice NetCDF restart file' 312 WRITE(numout,*) '~~~~~~~~~~~~~ ~'328 WRITE(numout,*) '~~~~~~~~~~~~~' 313 329 ENDIF 314 330 … … 554 570 CALL iom_close( numrir ) 555 571 ! 572 IF( wrk_not_released(2, 1) ) THEN 573 CALL ctl_stop( 'lim_rst_read : failed to release workspace arrays.' ) 574 END IF 575 ! 556 576 END SUBROUTINE lim_rst_read 557 577 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r2528 r2715 9 9 !! 3.3 ! 2010-05 (G. Madec) decrease ocean & ice reference salinities in the Baltic sea 10 10 !! ! + simplification of the ice-ocean stress calculation 11 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_lim3 … … 14 15 !! 'key_lim3' LIM 3.0 sea-ice model 15 16 !!---------------------------------------------------------------------- 16 !! lim_sbc_flx : updates mass, heat and salt fluxes at the ocean surface 17 !! lim_sbc_tau : update i- and j-stresses, and its modulus at the ocean surface 17 !! lim_sbc_alloc : allocate the limsbc arrays 18 !! lim_sbc_init : initialisation 19 !! lim_sbc_flx : updates mass, heat and salt fluxes at the ocean surface 20 !! lim_sbc_tau : update i- and j-stresses, and its modulus at the ocean surface 18 21 !!---------------------------------------------------------------------- 19 22 USE par_oce ! ocean parameters … … 27 30 USE lbclnk ! ocean lateral boundary condition 28 31 USE in_out_manager ! I/O manager 32 USE lib_mpp ! MPP library 29 33 USE prtctl ! Print control 34 USE cpl_oasis3, ONLY : lk_cpl 30 35 31 36 IMPLICIT NONE 32 37 PRIVATE 33 38 34 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 35 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 39 PUBLIC lim_sbc_init ! called by ice_init 40 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 41 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 36 42 37 43 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 40 46 REAL(wp) :: rone = 1._wp 41 47 42 REAL(wp), DIMENSION(jpi,jpj) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 43 REAL(wp), DIMENSION(jpi,jpj) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s] 44 45 REAL(wp), DIMENSION(jpi,jpj) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean velocity [m/s] 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0 , sice_0 ! cst SSS and ice salinity (levitating sea-ice) 46 51 47 52 !! * Substitutions 48 53 # include "vectopt_loop_substitute.h90" 49 54 !!---------------------------------------------------------------------- 50 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)55 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 51 56 !! $Id$ 52 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 58 !!---------------------------------------------------------------------- 54 59 CONTAINS 60 61 INTEGER FUNCTION lim_sbc_alloc() 62 !!------------------------------------------------------------------- 63 !! *** ROUTINE lim_sbc_alloc *** 64 !!------------------------------------------------------------------- 65 ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) , & 66 & sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc) 67 ! 68 IF( lk_mpp ) CALL mpp_sum( lim_sbc_alloc ) 69 IF( lim_sbc_alloc /= 0 ) CALL ctl_warn('lim_sbc_alloc: failed to allocate arrays') 70 END FUNCTION lim_sbc_alloc 71 55 72 56 73 SUBROUTINE lim_sbc_flx( kt ) … … 76 93 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 77 94 !!--------------------------------------------------------------------- 95 USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use 96 USE wrk_nemo, ONLY: zfcm1 => wrk_2d_1 , zfcm2 => wrk_2d_2 ! 2D workspace 97 USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5 ! 3D workspace 98 ! 78 99 INTEGER, INTENT(in) :: kt ! number of iteration 79 ! !100 ! 80 101 INTEGER :: ji, jj ! dummy loop indices 102 INTEGER :: ierr ! local integer 81 103 INTEGER :: ifvt, i1mfr, idfr ! some switches 82 104 INTEGER :: iflt, ial, iadv, ifral, ifrdv 83 REAL(wp) :: zinda ! switch for testing the values of ice concentration 84 REAL(wp) :: zfons ! salt exchanges at the ice/ocean interface 85 REAL(wp) :: zpme ! freshwater exchanges at the ice/ocean interface 86 REAL(wp), DIMENSION(jpi,jpj) :: zfcm1 , zfcm2 ! solar/non solar heat fluxes 87 #if defined key_coupled 88 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb ! albedo of ice under overcast sky 89 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalbp ! albedo of ice under clear sky 90 #endif 105 REAL(wp) :: zinda, zfons, zpme ! local scalars 106 ! 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 91 108 !!--------------------------------------------------------------------- 92 109 93 IF( kt == nit000 ) THEN 94 IF(lwp) WRITE(numout,*) 95 IF(lwp) WRITE(numout,*) 'lim_sbc_flx : LIM 3.0 sea-ice - heat salt and mass ocean surface fluxes' 96 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 97 ! 98 r1_rdtice = 1. / rdt_ice 99 ! 100 soce_0(:,:) = soce 101 sice_0(:,:) = sice 102 ! 103 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea 104 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 105 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 106 soce_0(:,:) = 4._wp 107 sice_0(:,:) = 2._wp 108 END WHERE 109 ENDIF 110 ! 111 ENDIF 110 IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 4,5) ) THEN 111 CALL ctl_stop( 'lim_sbc_flx : requested workspace arrays unavailable' ) ; RETURN 112 ENDIF 113 ! Set-up pointers to sub-arrays of 3d workspaces 114 zalb => wrk_3d_4(:,:,1:jpl) 115 zalbp => wrk_3d_5(:,:,1:jpl) 112 116 113 117 !------------------------------------------! … … 168 172 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 169 173 170 IF ( num_sal .EQ.2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + &174 IF ( num_sal == 2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + & 171 175 fhbri(ji,jj) ! new contribution due to brine drainage 172 176 … … 181 185 182 186 !!gm this IF prevents the vertorisation of the whole loop 183 IF ( ( ji .EQ. jiindx ) .AND. ( jj .EQ.jjindx) ) THEN187 IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 184 188 WRITE(numout,*) ' lim_sbc : heat fluxes ' 185 189 WRITE(numout,*) ' qsr : ', qsr(jiindx,jjindx) … … 274 278 ! Storing the transmitted variables ! 275 279 !-----------------------------------------------! 276 277 280 fr_i (:,:) = at_i(:,:) ! Sea-ice fraction 278 281 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 279 282 280 #if defined key_coupled281 283 !------------------------------------------------! 282 284 ! Computation of snow/ice and ocean albedo ! 283 285 !------------------------------------------------! 284 zalb (:,:,:) = 0.e0 285 zalbp (:,:,:) = 0.e0 286 287 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) 288 289 alb_ice(:,:,:) = 0.5 * zalbp(:,:,:) + 0.5 * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 290 #endif 286 IF( lk_cpl ) THEN ! coupled case 287 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 288 ! 289 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 290 ENDIF 291 291 292 292 IF(ln_ctl) THEN … … 296 296 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 297 297 ENDIF 298 ! 299 IF( wrk_not_released(2, 1,2) .OR. & 300 wrk_not_released(3, 4,5) ) & 301 CALL ctl_stop( 'lim_sbc_flx: failed to release workspace arrays' ) 298 302 ! 299 303 END SUBROUTINE lim_sbc_flx … … 331 335 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar 332 336 REAL(wp) :: zat_v, zvtau_ice, zv_t ! - - 333 !!--------------------------------------------------------------------- 334 335 IF( kt == nit000 ) THEN 336 IF(lwp) WRITE(numout,*) 337 IF(lwp) WRITE(numout,*) 'lim_sbc_tau : LIM-3 sea-ice - surface ocean momentum fluxes' 338 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 339 ENDIF 340 337 !!--------------------------------------------------------------------- 338 ! 341 339 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 342 340 !CDIR NOVERRCHK … … 360 358 ! 361 359 ENDIF 362 363 !!== every ocean time-step ==!364 360 ! 361 ! !== every ocean time-step ==! 362 ! 365 363 DO jj = 2, jpjm1 !* update the stress WITHOUT a ice-ocean rotation angle 366 364 DO ji = fs_2, fs_jpim1 ! Vect. Opt. … … 382 380 END SUBROUTINE lim_sbc_tau 383 381 382 383 SUBROUTINE lim_sbc_init 384 !!------------------------------------------------------------------- 385 !! *** ROUTINE lim_sbc_init *** 386 !! 387 !! ** Purpose : Preparation of the file ice_evolu for the output of 388 !! the temporal evolution of key variables 389 !! 390 !! ** input : Namelist namicedia 391 !!------------------------------------------------------------------- 392 ! 393 IF(lwp) WRITE(numout,*) 394 IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' 395 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ ' 396 397 ! ! allocate lim_sbc array 398 IF( lim_sbc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 399 ! 400 r1_rdtice = 1. / rdt_ice 401 ! 402 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 403 sice_0(:,:) = sice 404 ! 405 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea 406 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 407 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 408 soce_0(:,:) = 4._wp 409 sice_0(:,:) = 2._wp 410 END WHERE 411 ENDIF 412 ! 413 END SUBROUTINE lim_sbc_init 414 384 415 #else 385 416 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90
r2528 r2715 2 2 !!====================================================================== 3 3 !! *** MODULE limtab *** 4 !! 4 !! LIM : transform 1D (2D) array to a 2D (1D) table 5 5 !!====================================================================== 6 6 #if defined key_lim3 … … 8 8 !! 'key_lim3' LIM3 sea-ice model 9 9 !!---------------------------------------------------------------------- 10 !! tab_2d_1d : 2-D to1-D11 !! tab_1d_2d : 1-D to2-D10 !! tab_2d_1d : 2-D <==> 1-D 11 !! tab_1d_2d : 1-D <==> 2-D 12 12 !!---------------------------------------------------------------------- 13 !! * Modules used14 13 USE par_kind 15 14 … … 17 16 PRIVATE 18 17 19 !! * Routine accessibility 20 PUBLIC tab_2d_1d ! called by lim_ther 21 PUBLIC tab_1d_2d ! called by lim_ther 18 PUBLIC tab_2d_1d ! called by limthd 19 PUBLIC tab_1d_2d ! called by limthd 22 20 23 21 !!---------------------------------------------------------------------- 24 !! NEMO/LIM3 3.3, UCL - NEMO Consortium (2010)22 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 25 23 !! $Id$ 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 25 !!---------------------------------------------------------------------- 28 26 CONTAINS 29 27 30 SUBROUTINE tab_2d_1d ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 31 32 INTEGER, INTENT(in) :: & 33 ndim1d, ndim2d_x, ndim2d_y 34 35 REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT(in) :: & 36 tab2d 37 38 INTEGER, DIMENSION ( ndim1d), INTENT ( in) :: & 39 tab_ind 40 41 REAL(wp), DIMENSION(ndim1d), INTENT ( out) :: & 42 tab1d 43 44 INTEGER :: & 45 jn , jid, jjd 46 28 SUBROUTINE tab_2d_1d( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 29 !!---------------------------------------------------------------------- 30 !! *** ROUTINE tab_2d_1d *** 31 !!---------------------------------------------------------------------- 32 INTEGER , INTENT(in ) :: ndim1d, ndim2d_x, ndim2d_y ! 1d & 2D sizes 33 REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in ) :: tab2d ! input 2D field 34 INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index 35 REAL(wp), DIMENSION(ndim1d) , INTENT( out) :: tab1d ! output 1D field 36 ! 37 INTEGER :: jn , jid, jjd 38 !!---------------------------------------------------------------------- 47 39 DO jn = 1, ndim1d 48 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 149 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 140 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 41 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 50 42 tab1d( jn) = tab2d( jid, jjd) 51 43 END DO 52 53 44 END SUBROUTINE tab_2d_1d 54 45 55 46 56 SUBROUTINE tab_1d_2d ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 57 58 INTEGER, INTENT ( in) :: & 59 ndim1d, ndim2d_x, ndim2d_y 60 61 INTEGER, DIMENSION (ndim1d) , INTENT (in) :: & 62 tab_ind 63 64 REAL(wp), DIMENSION(ndim1d), INTENT (in) :: & 65 tab1d 66 67 REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT ( out) :: & 68 tab2d 69 70 INTEGER :: & 71 jn, jid, jjd 72 47 SUBROUTINE tab_1d_2d( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE tab_2d_1d *** 50 !!---------------------------------------------------------------------- 51 INTEGER , INTENT(in ) :: ndim1d, ndim2d_x, ndim2d_y ! 1d & 2D sizes 52 REAL(wp), DIMENSION(ndim1d) , INTENT(in ) :: tab1d ! input 1D field 53 INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index 54 REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT( out) :: tab2d ! output 2D field 55 ! 56 INTEGER :: jn , jid, jjd 57 !!---------------------------------------------------------------------- 73 58 DO jn = 1, ndim1d 74 jid = MOD( tab_ind(jn) - 1 , ndim2d_x) + 159 jid = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 75 60 jjd = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 76 61 tab2d(jid, jjd) = tab1d( jn) 77 62 END DO 78 79 63 END SUBROUTINE tab_1d_2d 80 64 65 #else 66 !!---------------------------------------------------------------------- 67 !! Default option Dummy module NO LIM sea-ice model 68 !!---------------------------------------------------------------------- 81 69 #endif 70 !!====================================================================== 82 71 END MODULE limtab -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r2528 r2715 10 10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdmsnif 11 11 !! 3.3 ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_lim3 … … 46 47 REAL(wp) :: epsi20 = 1e-20_wp ! constant values 47 48 REAL(wp) :: epsi16 = 1e-16_wp ! 49 REAL(wp) :: epsi10 = 1e-10_wp ! 48 50 REAL(wp) :: epsi06 = 1e-06_wp ! 49 51 REAL(wp) :: epsi04 = 1e-04_wp ! … … 79 81 !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 80 82 !!--------------------------------------------------------------------- 83 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 84 USE wrk_nemo, ONLY: zqlbsbq => wrk_2d_1 ! 2D workspace 85 ! 81 86 INTEGER, INTENT(in) :: kt ! number of iteration 82 87 !! 83 88 INTEGER :: ji, jj, jk, jl ! dummy loop indices 84 89 INTEGER :: nbpb ! nb of icy pts for thermo. cal. 85 REAL(wp) :: zfric_umin = 5e-03 ! lower bound for the friction velocity 86 REAL(wp) :: zfric_umax = 2e-02 ! upper bound for the friction velocity 87 REAL(wp) :: zinda, zindb, zthsnice, zfric_u ! temporary scalar 88 REAL(wp) :: zfntlat, zpareff ! - - 89 REAL(wp) :: zeps, zareamin, zcoef 90 REAL(wp), DIMENSION(jpi,jpj) :: zqlbsbq ! link with lead energy budget qldif 90 REAL(wp) :: zfric_umin = 5e-03_wp ! lower bound for the friction velocity 91 REAL(wp) :: zfric_umax = 2e-02_wp ! upper bound for the friction velocity 92 REAL(wp) :: zinda, zindb, zthsnice, zfric_u ! local scalar 93 REAL(wp) :: zfntlat, zpareff, zareamin, zcoef ! - - 91 94 !!------------------------------------------------------------------- 92 95 96 IF( wrk_in_use(2, 1) ) THEN 97 CALL ctl_stop( 'lim_thd : requested workspace arrays unavailable' ) ; RETURN 98 ENDIF 99 93 100 !------------------------------------------------------------------------------! 94 101 ! 1) Initialization of diagnostic variables ! 95 102 !------------------------------------------------------------------------------! 96 zeps = 1.e-1097 103 98 104 !-------------------- … … 240 246 !------------------------------------------------------------------------------! 241 247 242 IF( lk_mpp ) CALL mpp_ini_ice( nbpb )248 IF( lk_mpp ) CALL mpp_ini_ice( nbpb , numout ) 243 249 244 250 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. … … 387 393 !------------------------ 388 394 ! Enthalpies are global variables we have to readjust the units 389 zcoef = 1. e0 / ( unit_fac * REAL(nlay_i) )395 zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 390 396 DO jl = 1, jpl 391 397 DO jk = 1, nlay_i … … 399 405 !------------------------ 400 406 ! Enthalpies are global variables we have to readjust the units 401 zcoef = 1. e0 / ( unit_fac * REAL(nlay_s) )407 zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 402 408 DO jl = 1, jpl 403 409 DO jk = 1, nlay_s … … 452 458 ENDIF 453 459 ! 460 IF( wrk_not_released(2, 1) ) CALL ctl_stop( 'lim_thd: failed to release workspace arrays' ) 461 ! 454 462 END SUBROUTINE lim_thd 455 463 … … 468 476 !! 469 477 INTEGER :: ji,jk ! loop indices 470 REAL(wp) :: zeps ! very small value (1.e-10)471 478 !!----------------------------------------------------------------------- 472 eti(:,:) = 0.e0 473 ets(:,:) = 0.e0 474 zeps = 1.e-10 475 479 eti(:,:) = 0._wp 480 ets(:,:) = 0._wp 481 ! 476 482 DO jk = 1, nlay_i ! total q over all layers, ice [J.m-2] 477 483 DO ji = kideb, kiut … … 483 489 ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / nlay_s 484 490 END DO 485 491 ! 486 492 IF(lwp) WRITE(numout,*) ' lim_thd_glohec ' 487 493 IF(lwp) WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) / rdt_ice … … 508 514 !!--------------------------------------------------------------------- 509 515 510 max_cons_err = 1.0 ! maximum tolerated conservation error511 max_surf_err = 0.001 ! maximum tolerated surface error516 max_cons_err = 1.0_wp ! maximum tolerated conservation error 517 max_surf_err = 0.001_wp ! maximum tolerated surface error 512 518 513 519 !-------------------------- … … 539 545 540 546 numce = 0 541 meance = 0. 0547 meance = 0._wp 542 548 DO ji = kideb, kiut 543 549 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN … … 546 552 ENDIF 547 553 END DO 548 IF( numce .GT. 0 )meance = meance / numce554 IF( numce > 0 ) meance = meance / numce 549 555 550 556 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err … … 557 563 !------------------------------------------------------- 558 564 numce = 0 559 meance = 0. 0565 meance = 0._wp 560 566 561 567 DO ji = kideb, kiut … … 566 572 ENDIF 567 573 ENDDO 568 IF( numce .GT. 0 )meance = meance / numce574 IF( numce > 0 ) meance = meance / numce 569 575 570 576 WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err … … 639 645 640 646 ENDIF 641 647 ! 642 648 END DO 643 649 ! … … 651 657 !! ** Purpose : Test energy conservation after enthalpy redistr. 652 658 !!----------------------------------------------------------------------- 653 INTEGER, INTENT(in) :: & 654 kideb, kiut, & !: bounds for the spatial loop 655 jl !: category number 656 657 REAL(wp) :: & !: ! goes to trash 658 meance, & !: mean conservation error 659 max_cons_err !: maximum tolerated conservation error 660 661 INTEGER :: & 662 numce !: number of points for which conservation 663 ! is violated 664 INTEGER :: ji, zji, zjj ! loop indices 659 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 660 INTEGER, INTENT(in) :: jl ! category number 661 ! 662 INTEGER :: ji ! loop indices 663 INTEGER :: zji, zjj, numce ! local integers 664 REAL(wp) :: meance, max_cons_err !local scalar 665 665 !!--------------------------------------------------------------------- 666 666 667 max_cons_err = 1. 0667 max_cons_err = 1._wp 668 668 669 669 !-------------------------- 670 670 ! Increment of energy 671 671 !-------------------------- 672 ! global 673 DO ji = kideb, kiut 674 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) & 675 + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 676 END DO 677 ! layer by layer 678 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) 672 DO ji = kideb, kiut 673 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) ! global 674 END DO 675 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) ! layer by layer 679 676 680 677 !---------------------------------------- 681 678 ! Atmospheric heat flux, ice heat budget 682 679 !---------------------------------------- 683 684 DO ji = kideb, kiut 685 zji = MOD( npb(ji) - 1, jpi ) + 1 686 zjj = ( npb(ji) - 1 ) / jpi + 1 687 688 fatm(ji,jl) = & 689 qnsr_ice_1d(ji) + & ! atm non solar 690 ! (1.0-i0(ji))*qsr_ice_1d(ji) ! atm solar 691 qsr_ice_1d(ji) ! atm solar 692 693 sum_fluxq(ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) & 694 - fstroc(zji,zjj,jl) 695 cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 680 DO ji = kideb, kiut 681 zji = MOD( npb(ji) - 1 , jpi ) + 1 682 zjj = ( npb(ji) - 1 ) / jpi + 1 683 684 fatm (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji) ! total heat flux 685 sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(zji,zjj,jl) 686 cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 696 687 END DO 697 688 … … 699 690 ! Conservation error 700 691 !-------------------- 701 702 692 DO ji = kideb, kiut 703 693 cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) … … 705 695 706 696 numce = 0 707 meance = 0. 0708 DO ji = kideb, kiut 709 IF 697 meance = 0._wp 698 DO ji = kideb, kiut 699 IF( cons_error(ji,jl) .GT. max_cons_err ) THEN 710 700 numce = numce + 1 711 701 meance = meance + cons_error(ji,jl) 712 702 ENDIF 713 703 ENDDO 714 IF (numce .GT.0 ) meance = meance / numce704 IF(numce > 0 ) meance = meance / numce 715 705 716 706 WRITE(numout,*) ' Error report - Category : ', jl … … 718 708 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 719 709 WRITE(numout,*) ' After lim_thd_ent, category : ', jl 720 WRITE(numout,*) ' Mean conservation error on big error points ', meance, & 721 numit 710 WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 722 711 WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 723 712 … … 727 716 DO ji = kideb, kiut 728 717 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 729 zji 730 zjj =( npb(ji) - 1 ) / jpi + 1718 zji = MOD( npb(ji) - 1, jpi ) + 1 719 zjj = ( npb(ji) - 1 ) / jpi + 1 731 720 ! 732 721 WRITE(numout,*) ' alerte 1 - category : ', jl … … 779 768 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 780 769 !! 781 INTEGER :: ji, jk ! dummy loop indices782 REAL(wp) :: ztmelts , zeps ! temporaryscalar770 INTEGER :: ji, jk ! dummy loop indices 771 REAL(wp) :: ztmelts ! local scalar 783 772 !!------------------------------------------------------------------- 784 zeps = 1.e-10785 773 ! 786 774 DO jk = 1, nlay_i ! Sea ice energy of melting … … 788 776 ztmelts = - tmut * s_i_b(ji,jk) + rtt 789 777 q_i_b(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) ) & 790 & + lfus * ( 1.0 - (ztmelts-rtt) / MIN( t_i_b(ji,jk)-rtt, - zeps) ) &778 & + lfus * ( 1.0 - (ztmelts-rtt) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) ) & 791 779 & - rcp * ( ztmelts-rtt ) ) 792 780 END DO 793 781 END DO 794 782 DO jk = 1, nlay_s ! Snow energy of melting 795 DO ji = kideb, kiut783 DO ji = kideb, kiut 796 784 q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 797 785 END DO -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r2528 r2715 7 7 !! ! 2005-06 (M. Vancoppenolle) 3D version 8 8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdmsnif & rdmicif 9 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim3 … … 17 18 USE phycst ! physical constants (OCE directory) 18 19 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE ice 20 USE par_ice 21 USE thd_ice 22 USE in_out_manager 23 USE lib_mpp 20 USE ice ! LIM variables 21 USE par_ice ! LIM parameters 22 USE thd_ice ! LIM thermodynamics 23 USE wrk_nemo ! workspace manager 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 24 26 25 27 IMPLICIT NONE … … 35 37 36 38 !!---------------------------------------------------------------------- 37 !! NEMO/LIM3 3.3, UCL - NEMO Consortium (2010)39 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 38 40 !! $Id$ 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 42 !!---------------------------------------------------------------------- 41 42 43 CONTAINS 43 44 44 SUBROUTINE lim_thd_dh( kideb,kiut,jl)45 SUBROUTINE lim_thd_dh( kideb, kiut, jl ) 45 46 !!------------------------------------------------------------------ 46 47 !! *** ROUTINE lim_thd_dh *** … … 75 76 INTEGER :: i_ice_switch ! ice thickness above a certain treshold or not 76 77 INTEGER :: iter 77 78 REAL(wp) :: zzfmass_i, zzfmass_s ! temporary scalar 79 REAL(wp) :: zhsnew, zihgnew, ztmelts ! temporary scalar 78 INTEGER :: num_iter_max, numce_dh 79 80 REAL(wp) :: meance_dh 81 REAL(wp) :: zzfmass_i, zihgnew ! local scalar 82 REAL(wp) :: zzfmass_s, zhsnew, ztmelts ! local scalar 80 83 REAL(wp) :: zhn, zdhcf, zdhbf, zhni, zhnfi, zihg ! 81 REAL(wp) :: zdhnm, zhnnew, zhisn, zihic 84 REAL(wp) :: zdhnm, zhnnew, zhisn, zihic, zzc ! 82 85 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 83 86 REAL(wp) :: zds ! increment of bottom ice salinity … … 89 92 REAL(wp) :: zgrr ! bottom growth rate 90 93 REAL(wp) :: ztform ! bottom formation temperature 91 92 REAL(wp), DIMENSION(jpij) :: zh_i ! ice layer thickness 93 REAL(wp), DIMENSION(jpij) :: zh_s ! snow layer thickness 94 REAL(wp), DIMENSION(jpij) :: ztfs ! melting point 95 REAL(wp), DIMENSION(jpij) :: zhsold ! old snow thickness 96 REAL(wp), DIMENSION(jpij) :: zqprec ! energy of fallen snow 97 REAL(wp), DIMENSION(jpij) :: zqfont_su ! incoming, remaining surface energy 98 REAL(wp), DIMENSION(jpij) :: zqfont_bo ! incoming, bottom energy 99 REAL(wp), DIMENSION(jpij) :: z_f_surf ! surface heat for ablation 100 REAL(wp), DIMENSION(jpij) :: zhgnew ! new ice thickness 101 REAL(wp), DIMENSION(jpij) :: zfmass_i ! 102 103 REAL(wp), DIMENSION(jpij) :: zdh_s_mel ! snow melt 104 REAL(wp), DIMENSION(jpij) :: zdh_s_pre ! snow precipitation 105 REAL(wp), DIMENSION(jpij) :: zdh_s_sub ! snow sublimation 106 REAL(wp), DIMENSION(jpij) :: zfsalt_melt ! salt flux due to ice melt 107 108 REAL(wp) , DIMENSION(jpij,jkmax) :: zdeltah 109 110 ! Pathological cases 111 REAL(wp), DIMENSION(jpij) :: zfdt_init ! total incoming heat for ice melt 112 REAL(wp), DIMENSION(jpij) :: zfdt_final ! total remaing heat for ice melt 113 REAL(wp), DIMENSION(jpij) :: zqt_i ! total ice heat content 114 REAL(wp), DIMENSION(jpij) :: zqt_s ! total snow heat content 115 REAL(wp), DIMENSION(jpij) :: zqt_dummy ! dummy heat content 116 94 ! 95 REAL(wp), POINTER, DIMENSION(:) :: zh_i, ztfs , zqfont_su, zqprec , zhgnew 96 REAL(wp), POINTER, DIMENSION(:) :: zh_s, zhsold, zqfont_bo, z_f_surf, zfmass_i 97 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel, zdh_s_sub , zfdt_init , zqt_i, zqt_dummy, zdq_i 98 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_pre, zfsalt_melt, zfdt_final, zqt_s, zfbase , zinnermelt 99 ! 100 REAL(wp), DIMENSION(jpij,jkmax) :: zdeltah 117 101 REAL(wp), DIMENSION(jpij,jkmax) :: zqt_i_lay ! total ice heat content 118 119 ! Heat conservation120 INTEGER :: num_iter_max, numce_dh121 REAL(wp) :: meance_dh122 INTEGER , DIMENSION(jpij) :: innermelt123 REAL(wp), DIMENSION(jpij) :: zfbase, zdq_i124 102 !!------------------------------------------------------------------ 125 103 126 zfsalt_melt(:) = 0.0 127 ftotal_fin(:) = 0.0 128 zfdt_init(:) = 0.0 129 zfdt_final(:) = 0.0 104 IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22) ) THEN 105 CALL ctl_stop('lim_thd_dh: requestead workspace arrays unavailable') ; RETURN 106 ENDIF 107 ! Set-up pointers to sub-arrays of workspace arrays 108 zh_i => wrk_1d_1 (1:jpij) ! ice layer thickness 109 zh_s => wrk_1d_2 (1:jpij) ! snow layer thickness 110 ztfs => wrk_1d_3 (1:jpij) ! melting point 111 zhsold => wrk_1d_4 (1:jpij) ! old snow thickness 112 zqprec => wrk_1d_5 (1:jpij) ! energy of fallen snow 113 zqfont_su => wrk_1d_6 (1:jpij) ! incoming, remaining surface energy 114 zqfont_bo => wrk_1d_7 (1:jpij) ! incoming, bottom energy 115 z_f_surf => wrk_1d_8 (1:jpij) ! surface heat for ablation 116 zhgnew => wrk_1d_9 (1:jpij) ! new ice thickness 117 zfmass_i => wrk_1d_10(1:jpij) ! 118 ! 119 zdh_s_mel => wrk_1d_11(1:jpij) ! snow melt 120 zdh_s_pre => wrk_1d_12(1:jpij) ! snow precipitation 121 zdh_s_sub => wrk_1d_13(1:jpij) ! snow sublimation 122 zfsalt_melt => wrk_1d_14(1:jpij) ! salt flux due to ice melt 123 ! 124 ! ! Pathological cases 125 zfdt_init => wrk_1d_15(1:jpij) ! total incoming heat for ice melt 126 zfdt_final => wrk_1d_16(1:jpij) ! total remaing heat for ice melt 127 zqt_i => wrk_1d_17(1:jpij) ! total ice heat content 128 zqt_s => wrk_1d_18(1:jpij) ! total snow heat content 129 zqt_dummy => wrk_1d_19(1:jpij) ! dummy heat content 130 131 zfbase => wrk_1d_20(1:jpij) 132 zdq_i => wrk_1d_21(1:jpij) 133 zinnermelt => wrk_1d_22(1:jpij) 134 135 zfsalt_melt(:) = 0._wp 136 ftotal_fin(:) = 0._wp 137 zfdt_init(:) = 0._wp 138 zfdt_final(:) = 0._wp 130 139 131 140 DO ji = kideb, kiut … … 138 147 !------------------------------------------------------------------------------! 139 148 ! 140 DO ji = kideb, kiut149 DO ji = kideb, kiut 141 150 isnow = INT( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) ) 142 151 ztfs(ji) = isnow * rtt + ( 1.0 - isnow ) * rtt … … 146 155 END DO ! ji 147 156 148 zqfont_su (:) = 0.0149 zqfont_bo (:) = 0.0150 dsm_i_se_1d(:) = 0. 0151 dsm_i_si_1d(:) = 0. 0157 zqfont_su (:) = 0._wp 158 zqfont_bo (:) = 0._wp 159 dsm_i_se_1d(:) = 0._wp 160 dsm_i_si_1d(:) = 0._wp 152 161 ! 153 162 !------------------------------------------------------------------------------! … … 155 164 !------------------------------------------------------------------------------! 156 165 ! 157 ! Layer thickness 158 DO ji = kideb,kiut 166 DO ji = kideb, kiut ! Layer thickness 159 167 zh_i(ji) = ht_i_b(ji) / nlay_i 160 168 zh_s(ji) = ht_s_b(ji) / nlay_s 161 169 END DO 162 163 ! Total enthalpy of the snow 164 zqt_s(:) = 0.0 170 ! 171 zqt_s(:) = 0._wp ! Total enthalpy of the snow 165 172 DO jk = 1, nlay_s 166 DO ji = kideb, kiut173 DO ji = kideb, kiut 167 174 zqt_s(ji) = zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / nlay_s 168 175 END DO 169 176 END DO 170 171 ! Total enthalpy of the ice 172 zqt_i(:) = 0.0 177 ! 178 zqt_i(:) = 0._wp ! Total enthalpy of the ice 173 179 DO jk = 1, nlay_i 174 DO ji = kideb,kiut 175 zqt_i(ji) = zqt_i(ji) + q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 176 zqt_i_lay(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 180 DO ji = kideb, kiut 181 zzc = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 182 zqt_i(ji) = zqt_i(ji) + zzc 183 zqt_i_lay(ji,jk) = zzc 177 184 END DO 178 185 END DO … … 201 208 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn 202 209 END DO 203 zdh_s_mel(:) = 0. 0210 zdh_s_mel(:) = 0._wp 204 211 205 212 ! Melt of fallen snow … … 248 255 !-------------------------- 249 256 DO ji = kideb, kiut 250 dh_i_surf(ji) = 0. e0257 dh_i_surf(ji) = 0._wp 251 258 z_f_surf (ji) = zqfont_su(ji) / rdt_ice ! heat conservation test 252 zdq_i (ji) = 0. e0259 zdq_i (ji) = 0._wp 253 260 END DO ! ji 254 261 … … 267 274 ! 268 275 ! contribution to ice-ocean salt flux 269 zji = MOD( npb(ji) - 1 , jpi ) + 1270 zjj = ( npb(ji) - 1 ) / jpi + 1276 zji = MOD( npb(ji) - 1 , jpi ) + 1 277 zjj = ( npb(ji) - 1 ) / jpi + 1 271 278 zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji) ) * a_i_b(ji) & 272 279 & * MIN( zdeltah(ji,jk) , 0.e0 ) * rhoic / rdt_ice … … 278 285 ! !------------------- 279 286 numce_dh = 0 280 meance_dh = 0. e0287 meance_dh = 0._wp 281 288 DO ji = kideb, kiut 282 289 IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN … … 287 294 WRITE(numout,*) ' ALERTE heat loss for surface melt ' 288 295 WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl 289 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji)290 WRITE(numout,*) ' z_f_surf : ', z_f_surf(ji)291 WRITE(numout,*) ' zdq_i : ', zdq_i(ji)292 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji)293 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji)294 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji)295 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji)296 WRITE(numout,*) ' s_i_new : ', s_i_new(ji)297 WRITE(numout,*) ' sss_m : ', sss_m(zji,zjj)296 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 297 WRITE(numout,*) ' z_f_surf : ', z_f_surf(ji) 298 WRITE(numout,*) ' zdq_i : ', zdq_i(ji) 299 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 300 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 301 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 302 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 303 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 304 WRITE(numout,*) ' sss_m : ', sss_m(zji,zjj) 298 305 ENDIF 299 306 END DO … … 440 447 ! 4.2 Basal melt 441 448 !---------------- 442 meance_dh = 0. 0449 meance_dh = 0._wp 443 450 numce_dh = 0 444 innermelt(:) = 0451 zinnermelt(:) = 0._wp 445 452 446 453 DO ji = kideb, kiut 447 454 ! heat convergence at the surface > 0 448 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0.e0 ) THEN 449 455 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0._wp ) THEN 450 456 s_i_new(ji) = s_i_b(ji,nlay_i) 451 457 zqfont_bo(ji) = rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 452 453 zfbase(ji) = zqfont_bo(ji) / rdt_ice ! heat conservation test 454 zdq_i(ji) = 0.e0 455 456 dh_i_bott(ji) = 0.e0 458 zfbase(ji) = zqfont_bo(ji) / rdt_ice ! heat conservation test 459 zdq_i(ji) = 0._wp 460 dh_i_bott(ji) = 0._wp 457 461 ENDIF 458 462 END DO … … 461 465 DO ji = kideb, kiut 462 466 IF ( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .GE. 0.0 ) THEN 463 ztmelts 464 IF ( t_i_b(ji,jk) .GE.ztmelts ) THEN467 ztmelts = - tmut * s_i_b(ji,jk) + rtt 468 IF( t_i_b(ji,jk) >= ztmelts ) THEN 465 469 zdeltah(ji,jk) = - zh_i(ji) 466 470 dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) 467 innermelt(ji) = 1471 zinnermelt(ji) = 1._wp 468 472 ELSE ! normal ablation 469 473 zdeltah(ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) … … 492 496 ENDIF 493 497 IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN 494 WRITE(numout,*) ' ALERTE heat loss for basal melt ' 495 WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl 496 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 497 WRITE(numout,*) ' zfbase : ', zfbase(ji) 498 WRITE(numout,*) ' zdq_i : ', zdq_i(ji) 499 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 500 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 501 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 502 WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 503 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 504 WRITE(numout,*) ' sss_m : ', sss_m(zji,zjj) 498 WRITE(numout,*) ' ALERTE heat loss for basal melt : zji, zjj, jl :', zji, zjj, jl 499 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 500 WRITE(numout,*) ' zfbase : ', zfbase(ji) 501 WRITE(numout,*) ' zdq_i : ', zdq_i(ji) 502 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 503 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 504 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 505 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 506 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 507 WRITE(numout,*) ' sss_m : ', sss_m(zji,zjj) 505 508 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 506 WRITE(numout,*) ' innermelt : ', innermelt(ji)509 WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) ) 507 510 ENDIF 508 511 ENDIF … … 687 690 688 691 ! Total ablation ! new lines added to debug 689 IF( ht_i_b(ji) <= 0. e0 ) a_i_b(ji) = 0.0692 IF( ht_i_b(ji) <= 0._wp ) a_i_b(ji) = 0._wp 690 693 691 694 ! diagnostic ( snow ice growth ) … … 695 698 ! 696 699 END DO !ji 697 700 ! 701 IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21) ) & 702 CALL ctl_stop('lim_thd_dh : failed to release workspace arrays') 703 ! 698 704 END SUBROUTINE lim_thd_dh 699 705 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r2591 r2715 5 5 !! computation of surface and inner T 6 6 !!====================================================================== 7 !! History : LIM ! 02-2003 (M. Vancoppenolle) original 1D code 8 !! ! 06-2005 (M. Vancoppenolle) 3d version 9 !! ! 11-2006 (X Fettweis) Vectorization by Xavier 10 !! ! 04-2007 (M. Vancoppenolle) Energy conservation 11 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 7 12 !!---------------------------------------------------------------------- 8 13 #if defined key_lim3 … … 12 17 USE par_oce ! ocean parameters 13 18 USE phycst ! physical constants (ocean directory) 14 USE thd_ice15 USE in_out_manager16 USE ice17 USE par_ice18 USE lib_mpp 19 USE ice ! LIM-3 variables 20 USE par_ice ! LIM-3 parameters 21 USE thd_ice ! LIM-3: thermodynamics 22 USE in_out_manager ! I/O manager 23 USE lib_mpp ! MPP library 19 24 20 25 IMPLICIT NONE … … 23 28 PUBLIC lim_thd_dif ! called by lim_thd 24 29 25 REAL(wp) :: & ! constant values 26 epsi20 = 1e-20 , & 27 epsi13 = 1e-13 , & 28 zzero = 0.e0 , & 29 zone = 1.e0 30 REAL(wp) :: epsi20 = 1e-20 ! constant values 31 REAL(wp) :: epsi13 = 1e-13 ! constant values 30 32 31 33 !!---------------------------------------------------------------------- 32 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)34 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 33 35 !! $Id$ 34 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 95 97 !! * Local variables 96 98 INTEGER :: ji, & ! spatial loop index 97 zji, zjj, & ! temporary dummy loop index99 ii, ij, & ! temporary dummy loop index 98 100 numeq, & ! current reference number of equation 99 101 layer, & ! vertical dummy loop index 100 102 nconv, & ! number of iterations in iterative procedure 101 minnumeqmin, & ! 102 maxnumeqmax 103 minnumeqmin, maxnumeqmax 103 104 104 105 INTEGER , DIMENSION(kiut) :: & … … 137 138 zdiagbis 138 139 139 REAL(wp) , DIMENSION(kiut,jkmax+2,3) :: & 140 ztrid ! tridiagonal system terms 140 REAL(wp) , DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 141 141 142 142 REAL(wp), DIMENSION(kiut) :: & 143 143 ztfs , & ! ice melting point 144 ztsuold , & ! old surface temperature (before the iterative 145 ! procedure ) 144 ztsuold , & ! old surface temperature (before the iterative procedure ) 146 145 ztsuoldit, & ! surface temperature at previous iteration 147 146 zh_i , & !ice layer thickness … … 152 151 153 152 REAL(wp) :: & ! constant values 154 zeps = 1.0e-10, & ! 155 zg1s = 2.0, & !: for the tridiagonal system 156 zg1 = 2.0, & 157 zgamma = 18009.0, & !: for specific heat 158 zbeta = 0.117, & !: for thermal conductivity (could be 0.13) 159 zraext_s = 1.0e08, & !: extinction coefficient of radiation in the snow 160 zkimin = 0.10 , & !: minimum ice thermal conductivity 161 zht_smin = 1.0e-4 !: minimum snow depth 162 163 REAL(wp) :: & ! local variables 164 ztmelt_i, & ! ice melting temperature 165 zerritmax ! current maximal error on temperature 166 167 REAL(wp), DIMENSION(kiut) :: & 168 zerrit, & ! current error on temperature 169 zdifcase, & ! case of the equation resolution (1->4) 170 zftrice, & ! solar radiation transmitted through the ice 171 zihic, zhsu 153 zeps = 1.e-10_wp, & ! 154 zg1s = 2._wp, & !: for the tridiagonal system 155 zg1 = 2._wp, & 156 zgamma = 18009._wp, & !: for specific heat 157 zbeta = 0.117_wp, & !: for thermal conductivity (could be 0.13) 158 zraext_s = 1.e+8_wp, & !: extinction coefficient of radiation in the snow 159 zkimin = 0.10_wp , & !: minimum ice thermal conductivity 160 zht_smin = 1.e-4_wp !: minimum snow depth 161 162 REAL(wp) :: ztmelt_i ! ice melting temperature 163 REAL(wp) :: zerritmax ! current maximal error on temperature 164 REAL(wp), DIMENSION(kiut) :: zerrit ! current error on temperature 165 REAL(wp), DIMENSION(kiut) :: zdifcase ! case of the equation resolution (1->4) 166 REAL(wp), DIMENSION(kiut) :: zftrice ! solar radiation transmitted through the ice 167 REAL(wp), DIMENSION(kiut) :: zihic, zhsu 172 168 !!------------------------------------------------------------------ 173 169 ! … … 178 174 DO ji = kideb , kiut 179 175 ! is there snow or not 180 isnow(ji)= INT ( 1.0 - MAX( 0.0 , SIGN (1.0, - ht_s_b(ji) ) ))176 isnow(ji)= INT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) ) ) 181 177 ! surface temperature of fusion 178 !!gm ??? ztfs(ji) = rtt !!!???? 182 179 ztfs(ji) = isnow(ji) * rtt + (1.0-isnow(ji)) * rtt 183 180 ! layer thickness 184 zh_i(ji) 185 zh_s(ji) 181 zh_i(ji) = ht_i_b(ji) / nlay_i 182 zh_s(ji) = ht_s_b(ji) / nlay_s 186 183 END DO 187 184 … … 190 187 !-------------------- 191 188 192 z_s(:,0) = 0.0 ! vert. coord. of the up. lim. of the 1st snow layer 193 z_i(:,0) = 0.0 ! vert. coord. of the up. lim. of the 1st ice layer 194 195 DO layer = 1, nlay_s 196 DO ji = kideb , kiut 197 ! vert. coord of the up. lim. of the layer-th snow layer 198 z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s 199 END DO 200 END DO 201 202 DO layer = 1, nlay_i 203 DO ji = kideb , kiut 204 ! vert. coord of the up. lim. of the layer-th ice layer 205 z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i 189 z_s(:,0) = 0._wp ! vert. coord. of the up. lim. of the 1st snow layer 190 z_i(:,0) = 0._wp ! vert. coord. of the up. lim. of the 1st ice layer 191 192 DO layer = 1, nlay_s ! vert. coord of the up. lim. of the layer-th snow layer 193 DO ji = kideb , kiut 194 z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s 195 END DO 196 END DO 197 198 DO layer = 1, nlay_i ! vert. coord of the up. lim. of the layer-th ice layer 199 DO ji = kideb , kiut 200 z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i 206 201 END DO 207 202 END DO … … 224 219 DO ji = kideb , kiut 225 220 ! switches 226 isnow(ji) = INT ( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ))221 isnow(ji) = INT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) ) 227 222 ! hs > 0, isnow = 1 228 zhsu(ji) = hnzst !threshold for the computation of i0 229 zihic(ji) = MAX( zzero , 1.0 - ( ht_i_b(ji) / zhsu(ji) ) ) 230 231 i0(ji) = ( 1.0 - isnow(ji) ) * & 232 ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 223 zhsu (ji) = hnzst ! threshold for the computation of i0 224 zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) ) 225 226 i0(ji) = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 233 227 !fr1_i0_1d = i0 for a thin ice surface 234 228 !fr1_i0_2d = i0 for a thick ice surface … … 244 238 !------------------------------------------------------- 245 239 DO ji = kideb , kiut 246 247 ! Shortwave radiation absorbed at surface 248 zfsw(ji) = qsr_ice_1d(ji) * ( 1 - i0(ji) ) 249 250 ! Solar radiation transmitted below the surface layer 251 zftrice(ji)= qsr_ice_1d(ji) * i0(ji) 252 253 ! derivative of incoming nonsolar flux 254 dzf(ji) = dqns_ice_1d(ji) 255 240 zfsw (ji) = qsr_ice_1d(ji) * ( 1 - i0(ji) ) ! Shortwave radiation absorbed at surface 241 zftrice(ji) = qsr_ice_1d(ji) * i0(ji) ! Solar radiation transmitted below the surface layer 242 dzf (ji) = dqns_ice_1d(ji) ! derivative of incoming nonsolar flux 256 243 END DO 257 244 … … 260 247 !--------------------------------------------------------- 261 248 262 DO ji = kideb , kiut 263 ! Initialization 264 zradtr_s(ji,0) = zftrice(ji) ! radiation penetrating through snow 265 END DO 266 267 ! Radiation through snow 268 DO layer = 1, nlay_s 269 DO ji = kideb , kiut 270 ! radiation transmitted below the layer-th snow layer 271 zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP ( - zraext_s * ( MAX ( 0.0 , & 272 z_s(ji,layer) ) ) ) 273 ! radiation absorbed by the layer-th snow layer 249 DO ji = kideb, kiut ! snow initialization 250 zradtr_s(ji,0) = zftrice(ji) ! radiation penetrating through snow 251 END DO 252 253 DO layer = 1, nlay_s ! Radiation through snow 254 DO ji = kideb, kiut 255 ! ! radiation transmitted below the layer-th snow layer 256 zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,layer) ) ) ) 257 ! ! radiation absorbed by the layer-th snow layer 274 258 zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer) 275 259 END DO 276 260 END DO 277 261 278 ! Radiation through ice 279 DO ji = kideb , kiut 280 zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + & 281 zftrice(ji) * ( 1 - isnow(ji) ) 282 END DO 283 284 DO layer = 1, nlay_i 285 DO ji = kideb , kiut 286 ! radiation transmitted below the layer-th ice layer 287 zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP ( - kappa_i * ( MAX ( 0.0 , & 288 z_i(ji,layer) ) ) ) 289 ! radiation absorbed by the layer-th ice layer 262 DO ji = kideb, kiut ! ice initialization 263 zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) ) 264 END DO 265 266 DO layer = 1, nlay_i ! Radiation through ice 267 DO ji = kideb, kiut 268 ! ! radiation transmitted below the layer-th ice layer 269 zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,layer) ) ) ) 270 ! ! radiation absorbed by the layer-th ice layer 290 271 zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer) 291 272 END DO 292 273 END DO 293 274 294 ! Radiation transmitted below the ice 295 DO ji = kideb , kiut 296 fstbif_1d(ji) = fstbif_1d(ji) + & 297 zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) 275 DO ji = kideb, kiut ! Radiation transmitted below the ice 276 fstbif_1d(ji) = fstbif_1d(ji) + zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) 298 277 END DO 299 278 300 279 ! +++++ 301 280 ! just to check energy conservation 302 DO ji = kideb , kiut 303 zji = MOD( npb(ji) - 1, jpi ) + 1 304 zjj = ( npb(ji) - 1 ) / jpi + 1 305 fstroc(zji,zjj,jl) = & 306 zradtr_i(ji,nlay_i) 281 DO ji = kideb, kiut 282 ii = MOD( npb(ji) - 1, jpi ) + 1 283 ij = ( npb(ji) - 1 ) / jpi + 1 284 fstroc(ii,ij,jl) = zradtr_i(ji,nlay_i) 307 285 END DO 308 286 ! +++++ 309 287 310 288 DO layer = 1, nlay_i 311 DO ji = kideb 289 DO ji = kideb, kiut 312 290 radab(ji,layer) = zradab_i(ji,layer) 313 291 END DO … … 320 298 !------------------------------------------------------------------------------| 321 299 ! 322 ! Old surface temperature 323 DO ji = kideb, kiut 324 ztsuold(ji) = t_su_b(ji) ! temperature at the beg of iter pr. 325 ztsuoldit(ji) = t_su_b(ji) ! temperature at the previous iter 326 t_su_b(ji) = MIN(t_su_b(ji),ztfs(ji)-0.00001) !necessary 327 zerrit(ji) = 1000.0 ! initial value of error 328 END DO 329 !RB Min global ?? 330 331 ! Old snow temperature 332 DO layer = 1, nlay_s 333 DO ji = kideb , kiut 334 ztsold(ji,layer) = t_s_b(ji,layer) 335 END DO 336 END DO 337 338 ! Old ice temperature 339 DO layer = 1, nlay_i 340 DO ji = kideb , kiut 341 ztiold(ji,layer) = t_i_b(ji,layer) 342 END DO 343 END DO 344 345 nconv = 0 ! number of iterations 346 zerritmax = 1000.0 ! maximal value of error on all points 347 348 DO WHILE ((zerritmax > maxer_i_thd).AND.(nconv < nconv_i_thd)) 349 350 nconv = nconv+1 351 300 DO ji = kideb, kiut ! Old surface temperature 301 ztsuold (ji) = t_su_b(ji) ! temperature at the beg of iter pr. 302 ztsuoldit(ji) = t_su_b(ji) ! temperature at the previous iter 303 t_su_b (ji) = MIN( t_su_b(ji), ztfs(ji)-0.00001 ) ! necessary 304 zerrit (ji) = 1000._wp ! initial value of error 305 END DO 306 307 DO layer = 1, nlay_s ! Old snow temperature 308 DO ji = kideb , kiut 309 ztsold(ji,layer) = t_s_b(ji,layer) 310 END DO 311 END DO 312 313 DO layer = 1, nlay_i ! Old ice temperature 314 DO ji = kideb , kiut 315 ztiold(ji,layer) = t_i_b(ji,layer) 316 END DO 317 END DO 318 319 nconv = 0 ! number of iterations 320 zerritmax = 1000._wp ! maximal value of error on all points 321 322 DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd ) 323 ! 324 nconv = nconv + 1 352 325 ! 353 326 !------------------------------------------------------------------------------| … … 355 328 !------------------------------------------------------------------------------| 356 329 ! 357 IF ( thcon_i_swi .EQ. 0 ) THEN 358 ! Untersteiner (1964) formula 330 IF( thcon_i_swi == 0 ) THEN ! Untersteiner (1964) formula 359 331 DO ji = kideb , kiut 360 332 ztcond_i(ji,0) = rcdic + zbeta*s_i_b(ji,1) / & … … 362 334 ztcond_i(ji,0) = MAX(ztcond_i(ji,0),zkimin) 363 335 END DO 364 ENDIF365 366 IF ( thcon_i_swi .EQ. 1 ) THEN367 ! Pringle et al formula included,368 ! 2.11 + 0.09 S/T - 0.011.T369 DO ji = kideb , kiut370 ztcond_i(ji,0) = rcdic + 0.09*s_i_b(ji,1) / &371 MIN(-zeps,t_i_b(ji,1)-rtt) - &372 0.011* ( t_i_b(ji,1) - rtt )373 ztcond_i(ji,0) = MAX(ztcond_i(ji,0),zkimin)374 END DO375 ENDIF376 377 IF ( thcon_i_swi .EQ. 0 ) THEN ! Untersteiner378 336 DO layer = 1, nlay_i-1 379 337 DO ji = kideb , kiut … … 406 364 ENDIF 407 365 408 IF ( thcon_i_swi .EQ. 1 ) THEN ! Pringle 409 DO ji = kideb , kiut 410 ztcond_i(ji,nlay_i) = rcdic + 0.09*s_i_b(ji,nlay_i) / & 411 MIN(-zeps,t_bo_b(ji)-rtt) - & 412 0.011* ( t_bo_b(ji) - rtt ) 413 ztcond_i(ji,nlay_i) = MAX(ztcond_i(ji,nlay_i),zkimin) 366 IF( thcon_i_swi == 1 ) THEN ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 367 DO ji = kideb , kiut 368 ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_b(ji,1) / MIN( -zeps, t_i_b(ji,1)-rtt ) & 369 & - 0.011_wp * ( t_i_b(ji,1) - rtt ) 370 ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 371 END DO 372 DO layer = 1, nlay_i-1 373 DO ji = kideb , kiut 374 ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) & 375 & / MIN(-2.0*zeps, t_i_b(ji,layer)+t_i_b(ji,layer+1)-2.0*rtt) & 376 & - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt ) 377 ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin ) 378 END DO 379 END DO 380 DO ji = kideb , kiut 381 ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-zeps,t_bo_b(ji)-rtt) & 382 & - 0.011_wp * ( t_bo_b(ji) - rtt ) 383 ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 414 384 END DO 415 385 ENDIF … … 732 702 733 703 ! surface temperature 734 isnow(ji) 735 ztsuoldit(ji) 704 isnow(ji) = INT(1.0-max(0.0,sign(1.0,-ht_s_b(ji)))) 705 ztsuoldit(ji) = t_su_b(ji) 736 706 IF (t_su_b(ji) .LT. ztfs(ji)) & 737 t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* & 738 ( isnow(ji)*t_s_b(ji,1) + & 739 (1.0-isnow(ji))*t_i_b(ji,1) ) ) / & 740 zdiagbis(ji,numeqmin(ji)) 707 t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( isnow(ji)*t_s_b(ji,1) & 708 & + (1.0-isnow(ji))*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji)) 741 709 END DO 742 710 ! … … 748 716 ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 749 717 DO ji = kideb , kiut 750 t_su_b(ji) = MAX(MIN(t_su_b(ji),ztfs(ji)),190.0)751 zerrit(ji) = ABS(t_su_b(ji)-ztsuoldit(ji))718 t_su_b(ji) = MAX( MIN( t_su_b(ji) , ztfs(ji) ) , 190._wp ) 719 zerrit(ji) = ABS( t_su_b(ji) - ztsuoldit(ji) ) 752 720 END DO 753 721 754 722 DO layer = 1, nlay_s 755 723 DO ji = kideb , kiut 756 zji = MOD( npb(ji) - 1, jpi ) + 1 757 zjj = ( npb(ji) - 1 ) / jpi + 1 758 t_s_b(ji,layer) = MAX(MIN(t_s_b(ji,layer),rtt),190.0) 759 zerrit(ji) = MAX(zerrit(ji),ABS(t_s_b(ji,layer) & 760 - ztstemp(ji,layer))) 724 ii = MOD( npb(ji) - 1, jpi ) + 1 725 ij = ( npb(ji) - 1 ) / jpi + 1 726 t_s_b(ji,layer) = MAX( MIN( t_s_b(ji,layer), rtt ), 190._wp ) 727 zerrit(ji) = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) 761 728 END DO 762 729 END DO … … 764 731 DO layer = 1, nlay_i 765 732 DO ji = kideb , kiut 766 ztmelt_i = -tmut*s_i_b(ji,layer) +rtt767 t_i_b(ji,layer) 768 zerrit(ji) 733 ztmelt_i = -tmut * s_i_b(ji,layer) + rtt 734 t_i_b(ji,layer) = MAX(MIN(t_i_b(ji,layer),ztmelt_i),190.0) 735 zerrit(ji) = MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer))) 769 736 END DO 770 737 END DO 771 738 772 739 ! Compute spatial maximum over all errors 773 ! note that this could be optimized substantially by iterating only 774 ! the non-converging points 775 zerritmax = 0.0 776 DO ji = kideb , kiut 777 zerritmax = MAX(zerritmax,zerrit(ji)) 778 END DO 779 IF( lk_mpp ) CALL mpp_max(zerritmax, kcom=ncomm_ice) 740 ! note that this could be optimized substantially by iterating only the non-converging points 741 zerritmax = 0._wp 742 DO ji = kideb, kiut 743 zerritmax = MAX( zerritmax, zerrit(ji) ) 744 END DO 745 IF( lk_mpp ) CALL mpp_max( zerritmax, kcom=ncomm_ice ) 780 746 781 747 END DO ! End of the do while iterative procedure … … 787 753 788 754 ! 789 !-------------------------------------------------------------------------- 790 ! 11) Fluxes at the interfaces | 791 !-------------------------------------------------------------------------- 792 ! 755 !-------------------------------------------------------------------------! 756 ! 11) Fluxes at the interfaces ! 757 !-------------------------------------------------------------------------! 793 758 DO ji = kideb, kiut 794 ! update of latent heat fluxes 795 qla_ice_1d (ji) = qla_ice_1d (ji) + & 796 dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) 797 798 ! surface ice conduction flux 799 isnow(ji) = int(1.0-max(0.0,sign(1.0,-ht_s_b(ji)))) 800 fc_su(ji) = - isnow(ji)*zkappa_s(ji,0)*zg1s*(t_s_b(ji,1) - & 801 t_su_b(ji)) & 802 - (1.0-isnow(ji))*zkappa_i(ji,0)*zg1* & 803 (t_i_b(ji,1) - t_su_b(ji)) 804 805 ! bottom ice conduction flux 806 fc_bo_i(ji) = - zkappa_i(ji,nlay_i)* & 807 ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 808 759 ! ! update of latent heat fluxes 760 qla_ice_1d (ji) = qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) 761 ! ! surface ice conduction flux 762 isnow(ji) = INT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) ) ) 763 fc_su(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji)) & 764 & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_b(ji,1) - t_su_b(ji)) 765 ! ! bottom ice conduction flux 766 fc_bo_i(ji) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 809 767 END DO 810 768 … … 812 770 ! Heat conservation ! 813 771 !-------------------------! 814 IF ( con_i ) THEN 815 772 IF( con_i ) THEN 816 773 DO ji = kideb, kiut 817 774 ! Upper snow value 818 fc_s(ji,0) = - isnow(ji)* & 819 zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - & 820 t_su_b(ji) ) 775 fc_s(ji,0) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) ) 821 776 ! Bott. snow value 822 fc_s(ji,1) = - isnow(ji)* & 823 zkappa_s(ji,1) * ( t_i_b(ji,1) - & 824 t_s_b(ji,1) ) 825 END DO 826 827 ! Upper ice layer 828 DO ji = kideb, kiut 777 fc_s(ji,1) = - isnow(ji)* zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) ) 778 END DO 779 DO ji = kideb, kiut ! Upper ice layer 829 780 fc_i(ji,0) = - isnow(ji) * & ! interface flux if there is snow 830 781 ( zkappa_i(ji,0) * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & … … 832 783 zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 833 784 END DO 834 835 ! Internal ice layers 836 DO layer = 1, nlay_i - 1 785 DO layer = 1, nlay_i - 1 ! Internal ice layers 837 786 DO ji = kideb, kiut 838 fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - & 839 t_i_b(ji,layer) ) 840 zji = MOD( npb(ji) - 1, jpi ) + 1 841 zjj = ( npb(ji) - 1 ) / jpi + 1 842 END DO 843 END DO 844 845 ! Bottom ice layers 846 DO ji = kideb, kiut 847 fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i)* & 848 ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 849 END DO 850 787 fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 788 ii = MOD( npb(ji) - 1, jpi ) + 1 789 ij = ( npb(ji) - 1 ) / jpi + 1 790 END DO 791 END DO 792 DO ji = kideb, kiut ! Bottom ice layers 793 fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 794 END DO 851 795 ENDIF 852 796 ! 853 797 END SUBROUTINE lim_thd_dif 854 798 855 799 #else 856 !!====================================================================== 857 !! *** MODULE limthd_dif *** 858 !! no sea ice model 859 !!====================================================================== 800 !!---------------------------------------------------------------------- 801 !! Dummy Module No LIM-3 sea-ice model 802 !!---------------------------------------------------------------------- 860 803 CONTAINS 861 804 SUBROUTINE lim_thd_dif ! Empty routine -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r2528 r2715 6 6 !! after vertical growth/decay 7 7 !!====================================================================== 8 !! History : LIM ! 2003-05 (M. Vancoppenolle) Original code in 1D 9 !! ! 2005-07 (M. Vancoppenolle) 3D version 10 !! ! 2006-11 (X. Fettweis) Vectorized 11 !! 3.0 ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 13 !!---------------------------------------------------------------------- 8 14 #if defined key_lim3 9 15 !!---------------------------------------------------------------------- … … 13 19 !!---------------------------------------------------------------------- 14 20 USE par_oce ! ocean parameters 15 USE dom_oce 16 USE domain 17 USE in_out_manager 18 USE phycst 19 USE thd_ice 20 USE ice 21 USE limvar 22 USE par_ice 23 USE lib_mpp 21 USE dom_oce ! domain variables 22 USE domain ! 23 USE phycst ! physical constants 24 USE ice ! LIM variables 25 USE par_ice ! LIM parameters 26 USE thd_ice ! LIM thermodynamics 27 USE limvar ! LIM variables 28 USE in_out_manager ! I/O manager 29 USE wrk_nemo ! workspace manager 30 USE lib_mpp ! MPP library 24 31 25 32 IMPLICIT NONE … … 28 35 PUBLIC lim_thd_ent ! called by lim_thd 29 36 30 REAL(wp) :: & ! constant values 31 epsi20 = 1.e-20 , & 32 epsi13 = 1.e-13 , & 33 zzero = 0.e0 , & 34 zone = 1.e0 , & 35 epsi10 = 1.0e-10 37 REAL(wp) :: epsi20 = 1e-20_wp ! constant values 38 REAL(wp) :: epsi13 = 1e-13_wp ! 39 REAL(wp) :: epsi10 = 1e-10_wp ! 40 REAL(wp) :: epsi06 = 1e-06_wp ! 41 REAL(wp) :: zzero = 0._wp ! 42 REAL(wp) :: zone = 1._wp ! 43 36 44 !!---------------------------------------------------------------------- 37 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)45 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 38 46 !! $Id$ 39 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 41 49 CONTAINS 42 50 43 SUBROUTINE lim_thd_ent( kideb,kiut,jl)51 SUBROUTINE lim_thd_ent( kideb, kiut, jl ) 44 52 !!------------------------------------------------------------------- 45 53 !! *** ROUTINE lim_thd_ent *** … … 60 68 !! 5) Ice salinity, recover temperature 61 69 !! 62 !! ** Arguments 63 !! 64 !! ** Inputs / Outputs 65 !! 66 !! ** External 67 !! 68 !! ** References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 69 !! 70 !! ** History : (05-2003) Martin V. UCL-Astr 71 !! (07-2005) Martin for 3d adapatation 72 !! (11-2006) Vectorized by Xavier Fettweis (ASTR) 73 !! (03-2008) Energy conservation and clean code 74 !! * Arguments 75 76 INTEGER , INTENT(IN):: & 77 kideb , & ! start point on which the the computation is applied 78 kiut , & ! end point on which the the computation is applied 79 jl ! thickness category number 80 81 INTEGER :: & 82 ji,jk , & ! dummy loop indices 83 zji, zjj , & ! dummy indices 70 !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 71 !!------------------------------------------------------------------- 72 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 73 INTEGER , INTENT(in) :: jl ! Thickness cateogry number 74 75 INTEGER :: ji,jk ! dummy loop indices 76 INTEGER :: zji, zjj , & ! dummy indices 84 77 ntop0 , & ! old layer top index 85 78 nbot1 , & ! new layer bottom index … … 90 83 layer0, layer1 ! old/new layer indexes 91 84 92 INTEGER, DIMENSION(jpij) :: &93 snswi , & ! snow switch94 nbot0 , & ! old layer bottom index95 icsuind , & ! ice surface index96 icsuswi , & ! ice surface switch97 icboind , & ! ice bottom index98 icboswi , & ! ice bottom switch99 snicind , & ! snow ice index100 snicswi , & ! snow ice switch101 snind ! snow index102 85 103 86 REAL(wp) :: & 104 zeps, zeps6 , & ! numerical constant very small105 87 ztmelts , & ! ice melting point 106 88 zqsnic , & ! enthalpy of snow ice layer … … 115 97 zdiscrim !: dummy factor 116 98 117 REAL(wp), DIMENSION(jpij) :: & 118 zh_i , & ! thickness of an ice layer 119 zh_s , & ! thickness of a snow layer 120 zqsnow , & ! enthalpy of the snow put in snow ice 121 zdeltah ! temporary variable 122 123 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: & 124 zm0 , & ! old layer-system vertical cotes 125 qm0 , & ! old layer-system heat content 126 z_s , & ! new snow system vertical cotes 127 z_i , & ! new ice system vertical cotes 128 zthick0 ! old ice thickness 129 130 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: & 131 zhl0 ! old and new layer thicknesses 132 133 REAL(wp), DIMENSION(0:jkmax+3,0:jkmax+3) :: & 134 zrl01 135 136 ! Energy conservation 137 REAL(wp), DIMENSION(jpij) :: & 138 zqti_in, zqts_in, & 139 zqti_fin, zqts_fin 140 141 !------------------------------------------------------------------------------| 142 143 zeps = 1.0d-20 144 zeps6 = 1.0d-06 145 zthick0(:,:) = 0.0 146 zm0(:,:) = 0.0 147 qm0(:,:) = 0.0 148 zrl01(:,:) = 0.0 149 zhl0(:,:) = 0.0 150 z_i(:,:) = 0.0 151 z_s(:,:) = 0.0 99 INTEGER, DIMENSION(jpij) :: & 100 snswi , & ! snow switch 101 nbot0 , & ! old layer bottom index 102 icsuind , & ! ice surface index 103 icsuswi , & ! ice surface switch 104 icboind , & ! ice bottom index 105 icboswi , & ! ice bottom switch 106 snicind , & ! snow ice index 107 snicswi , & ! snow ice switch 108 snind ! snow index 109 ! 110 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: zm0 ! old layer-system vertical cotes 111 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: qm0 ! old layer-system heat content 112 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: z_s ! new snow system vertical cotes 113 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: z_i ! new ice system vertical cotes 114 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: zthick0 ! old ice thickness 115 REAL(wp), DIMENSION(jpij,0:jkmax+3) :: zhl0 ! old and new layer thicknesses 116 ! 117 REAL(wp), DIMENSION(0:jkmax+3,0:jkmax+3) :: zrl01 118 ! 119 REAL(wp), POINTER, DIMENSION(:) :: zh_i, zqsnow , zqti_in, zqti_fin 120 REAL(wp), POINTER, DIMENSION(:) :: zh_s, zdeltah, zqts_in, zqts_fin 121 !!------------------------------------------------------------------- 122 123 IF( wrk_in_use(1, 1,2,3,4,5,6,7,8) ) THEN 124 CALL ctl_stop('lim_thd_dh : requestead workspace arrays unavailable') ; RETURN 125 END IF 126 127 ! Set-up pointers to sub-arrays of workspace arrays 128 zh_i => wrk_1d_1 (1:jpij) ! thickness of an ice layer 129 zh_s => wrk_1d_2 (1:jpij) ! thickness of a snow layer 130 zqsnow => wrk_1d_3 (1:jpij) ! enthalpy of the snow put in snow ice 131 zdeltah => wrk_1d_4 (1:jpij) ! temporary variable 132 zqti_in => wrk_1d_5 (1:jpij) ! Energy conservation 133 zqts_in => wrk_1d_6 (1:jpij) ! - - 134 zqti_fin => wrk_1d_7 (1:jpij) ! - - 135 zqts_fin => wrk_1d_8 (1:jpij) ! - - 136 137 zthick0(:,:) = 0._wp 138 zm0 (:,:) = 0._wp 139 qm0 (:,:) = 0._wp 140 zrl01 (:,:) = 0._wp 141 zhl0 (:,:) = 0._wp 142 z_i (:,:) = 0._wp 143 z_s (:,:) = 0._wp 152 144 153 145 ! … … 155 147 ! 1) Grid | 156 148 !------------------------------------------------------------------------------| 157 ! 158 nlays0 = nlay_s 159 nlayi0 = nlay_i 160 161 DO ji = kideb, kiut 162 zh_i(ji) = old_ht_i_b(ji) / nlay_i 163 zh_s(ji) = old_ht_s_b(ji) / nlay_s 164 ENDDO 149 nlays0 = nlay_s 150 nlayi0 = nlay_i 151 152 DO ji = kideb, kiut 153 zh_i(ji) = old_ht_i_b(ji) / nlay_i 154 zh_s(ji) = old_ht_s_b(ji) / nlay_s 155 END DO 165 156 166 157 ! … … 168 159 ! 2) Switches | 169 160 !------------------------------------------------------------------------------| 170 !171 161 ! 2.1 snind(ji), snswi(ji) 172 162 ! snow surface behaviour : computation of snind(ji)-snswi(ji) … … 176 166 ! 2 if 2nd layer is melting ... 177 167 DO ji = kideb, kiut 178 snind (ji)= 0179 zdeltah(ji) = 0.0168 snind (ji) = 0 169 zdeltah(ji) = 0._wp 180 170 ENDDO !ji 181 171 182 172 DO jk = 1, nlays0 183 173 DO ji = kideb, kiut 184 snind(ji) = jk * INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)- zeps))) &185 + snind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)- zeps))))174 snind(ji) = jk * INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20))) & 175 + snind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20)))) 186 176 zdeltah(ji)= zdeltah(ji) + zh_s(ji) 187 177 END DO ! ji 188 END DO ! jk178 END DO ! jk 189 179 190 180 ! snswi(ji) : switch which value equals 1 if snow melts 191 181 ! 0 if not 192 182 DO ji = kideb, kiut 193 snswi(ji) = MAX(0,INT(-dh_s_tot(ji)/MAX( zeps,ABS(dh_s_tot(ji)))))194 END DO ! ji183 snswi(ji) = MAX(0,INT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 184 END DO ! ji 195 185 196 186 ! 2.2 icsuind(ji), icsuswi(ji) … … 201 191 ! 2 if 2nd layer is reached by melt ... 202 192 DO ji = kideb, kiut 203 icsuind(ji) 204 zdeltah(ji) = 0.0205 END DO !ji193 icsuind(ji) = 0 194 zdeltah(ji) = 0._wp 195 END DO !ji 206 196 DO jk = 1, nlayi0 207 197 DO ji = kideb, kiut 208 icsuind(ji) = jk * INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)- zeps))) &209 + icsuind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)- zeps))))198 icsuind(ji) = jk * INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20))) & 199 + icsuind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20)))) 210 200 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 211 201 END DO ! ji … … 216 206 ! 0 if not 217 207 DO ji = kideb, kiut 218 icsuswi(ji) = MAX(0,INT(-dh_i_surf(ji)/MAX( zeps, ABS(dh_i_surf(ji)) ) ) )208 icsuswi(ji) = MAX(0,INT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 219 209 ENDDO 220 210 … … 227 217 ! N+1 if all layers melt and that snow transforms into ice 228 218 DO ji = kideb, kiut 229 icboind(ji) 230 zdeltah(ji) = 0.0231 END DO219 icboind(ji) = 0 220 zdeltah(ji) = 0._wp 221 END DO 232 222 DO jk = nlayi0, 1, -1 233 223 DO ji = kideb, kiut 234 icboind(ji) = (nlayi0+1-jk) & 235 * INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-zeps))) & 236 + icboind(ji) & 237 * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-zeps)))) 224 icboind(ji) = (nlayi0+1-jk) * INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20))) & 225 & + icboind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20)))) 238 226 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 239 227 END DO 240 END DO228 END DO 241 229 242 230 DO ji = kideb, kiut 243 231 ! case of total ablation with remaining snow 244 IF ( ( ht_i_b(ji) .GT. zeps) .AND. &245 ( ht_i_b(ji) - dh_snowice(ji) .LT. zeps) ) icboind(ji) = nlay_i + 1232 IF ( ( ht_i_b(ji) .GT. epsi20 ) .AND. & 233 ( ht_i_b(ji) - dh_snowice(ji) .LT. epsi20 ) ) icboind(ji) = nlay_i + 1 246 234 END DO 247 235 … … 250 238 ! 0 if ablation is on the way 251 239 DO ji = kideb, kiut 252 icboswi(ji) = MAX(0,INT(dh_i_bott(ji) / MAX(zeps,ABS(dh_i_bott(ji)))))253 END DO240 icboswi(ji) = MAX(0,INT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 241 END DO 254 242 255 243 ! 2.4 snicind(ji), snicswi(ji) … … 260 248 ! 2 if penultiem layer ... 261 249 DO ji = kideb, kiut 262 snicind(ji) 263 zdeltah(ji) = 0.0264 END DO250 snicind(ji) = 0 251 zdeltah(ji) = 0._wp 252 END DO 265 253 DO jk = nlays0, 1, -1 266 254 DO ji = kideb, kiut 267 255 snicind(ji) = (nlays0+1-jk) & 268 * INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-zeps))) & 269 + snicind(ji) & 270 * (1 - INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-zeps)))) 256 * INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20))) + snicind(ji) & 257 * (1 - INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20)))) 271 258 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 272 259 END DO 273 END DO260 END DO 274 261 275 262 ! snicswi(ji) : switch which equals … … 277 264 ! 0 if not 278 265 DO ji = kideb, kiut 279 snicswi(ji) = MAX(0,INT(dh_snowice(ji)/MAX( zeps,ABS(dh_snowice(ji)))))266 snicswi(ji) = MAX(0,INT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 280 267 ENDDO 281 268 … … 294 281 ! indexes of the vectors 295 282 !------------------------ 296 ntop0 = 1 297 maxnbot0 = 0 298 299 DO ji = kideb, kiut 300 nbot0(ji) = nlays0 + 1 - snind(ji) + ( 1. - snicind(ji) ) * & 301 snicswi(ji) 283 ntop0 = 1 284 maxnbot0 = 0 285 286 DO ji = kideb, kiut 287 nbot0(ji) = nlays0 + 1 - snind(ji) + ( 1. - snicind(ji) ) * snicswi(ji) 302 288 ! cotes of the top of the layers 303 zm0(ji,0) = 0.0304 maxnbot0 305 END DO306 IF( lk_mpp ) CALL mpp_max( maxnbot0, kcom=ncomm_ice )289 zm0(ji,0) = 0._wp 290 maxnbot0 = MAX ( maxnbot0 , nbot0(ji) ) 291 END DO 292 IF( lk_mpp ) CALL mpp_max( maxnbot0, kcom=ncomm_ice ) 307 293 308 294 DO jk = 1, maxnbot0 309 295 DO ji = kideb, kiut 310 296 !change 311 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + & 312 snswi(ji) * ( jk + snind(ji) - 1 ) 297 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 298 limsum = MIN( limsum , nlay_s ) 299 zm0(ji,jk) = dh_s_tot(ji) + zh_s(ji) * limsum 300 END DO 301 END DO 302 303 DO ji = kideb, kiut 304 zm0(ji,nbot0(ji)) = dh_s_tot(ji) - snicswi(ji) * dh_snowice(ji) + zh_s(ji) * nlays0 305 zm0(ji,1) = dh_s_tot(ji) * (1 -snswi(ji) ) + snswi(ji) * zm0(ji,1) 306 END DO 307 308 DO jk = ntop0, maxnbot0 309 DO ji = kideb, kiut 310 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) ! layer thickness 311 END DO 312 END DO 313 314 zqts_in(:) = 0._wp 315 316 DO ji = kideb, kiut ! layer heat content 317 qm0 (ji,1) = rhosn * ( cpic * ( rtt - ( 1. - snswi(ji) ) * tatm_ice_1d(ji) & 318 & - snswi(ji) * t_s_b (ji,1) ) & 319 & + lfus ) * zthick0(ji,1) 320 zqts_in(ji) = zqts_in(ji) + qm0(ji,1) 321 END DO 322 323 DO jk = 2, maxnbot0 324 DO ji = kideb, kiut 325 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 313 326 limsum = MIN( limsum , nlay_s ) 314 zm0(ji,jk) = dh_s_tot(ji) + zh_s(ji) * limsum 315 END DO 316 ENDDO 317 318 DO ji = kideb, kiut 319 zm0(ji,nbot0(ji)) = dh_s_tot(ji) - snicswi(ji) * dh_snowice(ji) + & 320 zh_s(ji) * nlays0 321 zm0(ji,1) = dh_s_tot(ji) * (1 -snswi(ji) ) + & 322 snswi(ji) * zm0(ji,1) 323 ENDDO 324 325 DO jk = ntop0, maxnbot0 326 DO ji = kideb, kiut 327 ! layer thickness 328 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) 329 END DO 330 ENDDO 331 332 zqts_in(:) = 0.0 333 334 DO ji = kideb, kiut 335 ! layer heat content 336 qm0(ji,1) = rhosn * ( cpic * ( rtt - ( 1. - snswi(ji) ) * ( tatm_ice_1d(ji) ) & 337 - snswi(ji) * t_s_b(ji,1) ) & 338 + lfus ) * zthick0(ji,1) 339 zqts_in(ji) = zqts_in(ji) + qm0(ji,1) 340 ENDDO 341 342 DO jk = 2, maxnbot0 343 DO ji = kideb, kiut 344 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + & 345 snswi(ji) * ( jk + snind(ji) - 1 ) 346 limsum = MIN( limsum , nlay_s ) 347 qm0(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) & 348 * zthick0(ji,jk) 349 zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, zeps - ht_s_b(ji) ) ) 327 qm0(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk) 328 zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, epsi20 - ht_s_b(ji) ) ) 350 329 zqts_in(ji) = zqts_in(ji) + ( 1. - snswi(ji) ) * qm0(ji,jk) * zswitch 351 330 END DO ! jk 352 END DO ! ji331 END DO ! ji 353 332 354 333 !------------------------------------------------ … … 357 336 ! zqsnow, enthalpy of the flooded snow 358 337 DO ji = kideb, kiut 359 zqsnow (ji) = rhosn*lfus360 zdeltah(ji) = 0.0361 END DO338 zqsnow (ji) = rhosn * lfus 339 zdeltah(ji) = 0._wp 340 END DO 362 341 363 342 DO jk = nlays0, 1, -1 364 343 DO ji = kideb, kiut 365 zhsnow = MAX(0.0,dh_snowice(ji)-zdeltah(ji)) 366 zqsnow(ji) = zqsnow(ji) + & 367 rhosn*cpic*(rtt-t_s_b(ji,jk)) 344 zhsnow = MAX( 0._wp , dh_snowice(ji)-zdeltah(ji) ) 345 zqsnow (ji) = zqsnow (ji) + rhosn*cpic*(rtt-t_s_b(ji,jk)) 368 346 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 369 347 END DO 370 END DO348 END DO 371 349 372 350 DO ji = kideb, kiut … … 381 359 ! Vector index 382 360 !-------------- 383 ntop1 384 nbot1 361 ntop1 = 1 362 nbot1 = nlay_s 385 363 386 364 !------------------- … … 389 367 DO ji = kideb, kiut 390 368 zh_s(ji) = ht_s_b(ji) / nlay_s 391 z_s(ji,0) = 0. 0369 z_s(ji,0) = 0._wp 392 370 ENDDO 393 371 … … 396 374 z_s(ji,jk) = zh_s(ji) * jk 397 375 END DO 398 END DO376 END DO 399 377 400 378 !----------------- … … 405 383 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 406 384 END DO 407 END DO385 END DO 408 386 409 387 DO layer1 = ntop1, nbot1 410 388 DO ji = kideb, kiut 411 q_s_b(ji,layer1) = 0.0412 END DO 413 END DO389 q_s_b(ji,layer1) = 0._wp 390 END DO 391 END DO 414 392 415 393 !---------------- … … 419 397 DO layer1 = ntop1, nbot1 420 398 DO ji = kideb, kiut 421 zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1)) &422 - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10))423 q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0) &424 * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+zeps))399 zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1)) & 400 & - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10)) 401 q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0) & 402 & * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20)) 425 403 END DO 426 404 END DO 427 END DO405 END DO 428 406 429 407 ! Heat conservation 430 zqts_fin(:) = 0. 0408 zqts_fin(:) = 0._wp 431 409 DO jk = 1, nlay_s 432 410 DO ji = kideb, kiut … … 458 436 DO jk = 1, nlay_s 459 437 DO ji = kideb, kiut 460 q_s_b(ji,jk) = q_s_b(ji,jk) / MAX( zh_s(ji) , zeps)438 q_s_b(ji,jk) = q_s_b(ji,jk) / MAX( zh_s(ji) , epsi20 ) 461 439 END DO !ji 462 END DO !jk440 END DO !jk 463 441 464 442 !--------------------- … … 469 447 DO jk = 1, nlay_s 470 448 DO ji = kideb, kiut 471 zswitch = MAX ( 0.0 , SIGN ( 1.0, zeps - ht_s_b(ji) ) ) 472 t_s_b(ji,jk) = rtt & 473 + ( 1.0 - zswitch ) * & 474 ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 475 END DO 476 ENDDO 449 zswitch = MAX ( 0.0 , SIGN ( 1.0, epsi20 - ht_s_b(ji) ) ) 450 t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 451 END DO 452 END DO 477 453 ! 478 454 !------------------------------------------------------------------------------| … … 487 463 ! Vector indexes 488 464 !---------------- 489 ntop0 490 maxnbot0 465 ntop0 = 1 466 maxnbot0 = 0 491 467 492 468 DO ji = kideb, kiut 493 469 ! reference number of the bottommost layer 494 nbot0(ji) = MAX( 1 , MIN( nlayi0 + ( 1 - icboind(ji) ) + & 495 ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , & 496 nlay_i + 2 ) ) 470 nbot0(ji) = MAX( 1 , MIN( nlayi0 + ( 1 - icboind(ji) ) + & 471 & ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , nlay_i + 2 ) ) 497 472 ! maximum reference number of the bottommost layer over all domain 498 maxnbot0 499 END DO473 maxnbot0 = MAX( maxnbot0 , nbot0(ji) ) 474 END DO 500 475 501 476 !------------------------- 502 477 ! Cotes of old ice layers 503 478 !------------------------- 504 zm0(:,0) = 0.0479 zm0(:,0) = 0.-wp 505 480 506 481 DO jk = 1, maxnbot0 … … 514 489 + limsum * zh_i(ji) 515 490 END DO 516 END DO491 END DO 517 492 518 493 DO ji = kideb, kiut … … 520 495 + zh_i(ji) * nlayi0 521 496 zm0(ji,1) = snicswi(ji)*dh_snowice(ji) + (1-snicswi(ji))*zm0(ji,1) 522 END DO497 END DO 523 498 524 499 !----------------------------- … … 529 504 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) 530 505 END DO 531 END DO506 END DO 532 507 533 508 !--------------------------- … … 543 518 ztmelts = -tmut * s_i_b(ji,limsum) + rtt 544 519 qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ & 545 MIN((t_i_b(ji,limsum)-rtt),- zeps) ) - rcp*(ztmelts-rtt) ) &520 MIN((t_i_b(ji,limsum)-rtt),-epsi20) ) - rcp*(ztmelts-rtt) ) & 546 521 * zthick0(ji,jk) 547 522 END DO 548 END DO523 END DO 549 524 550 525 !---------------------------- … … 552 527 !---------------------------- 553 528 DO ji = kideb, kiut 554 ztmelts = ( 1.0 - icboswi(ji) ) * (-tmut * s_i_b (ji,nlayi0))& ! case of melting ice555 + icboswi(ji) * (-tmut * s_i_new(ji))& ! case of forming ice556 + rtt ! this temperature is in Celsius529 ztmelts = ( 1.0 - icboswi(ji) ) * (-tmut * s_i_b (ji,nlayi0) ) & ! case of melting ice 530 & + icboswi(ji) * (-tmut * s_i_new(ji) ) & ! case of forming ice 531 & + rtt ! in Kelvin 557 532 558 533 ! bottom formation temperature 559 534 ztform = t_i_b(ji,nlay_i) 560 535 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) ztform = t_bo_b(ji) 561 qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji)) & ! case of melting ice 562 + icboswi(ji) * & ! case of forming ice 563 rhoic*( cpic*(ztmelts-ztform) & 564 + lfus *( 1.0-(ztmelts-rtt)/ & 565 MIN ( (ztform-rtt) , - epsi10 ) ) & 566 - rcp*(ztmelts-rtt) ) & 567 *zthick0(ji,nbot0(ji)) 568 ENDDO 536 qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji)) & ! case of melting ice 537 & + icboswi(ji) * rhoic * ( cpic*(ztmelts-ztform) & ! case of forming ice 538 + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) ) & 539 - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji) ) 540 END DO 569 541 570 542 !----------------------------- … … 585 557 qm0(ji,1) = snicswi(ji) * zqsnic + ( 1 - snicswi(ji) ) * qm0(ji,1) 586 558 587 END DO ! ji559 END DO ! ji 588 560 589 561 DO jk = ntop0, maxnbot0 590 562 DO ji = kideb, kiut 591 563 ! Heat conservation 592 zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) & 593 * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-zeps6+zeps) ) & 594 * MAX( 0.0 , SIGN( 1. , nbot0(ji) - jk + zeps ) ) 595 END DO 596 ENDDO 564 zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi06+epsi20) ) & 565 & * MAX( 0.0 , SIGN( 1. , nbot0(ji) - jk + epsi20 ) ) 566 END DO 567 END DO 597 568 598 569 !------------- … … 603 574 ! Vectors index 604 575 !--------------- 605 606 ntop1 = 1 607 nbot1 = nlay_i 576 ntop1 = 1 577 nbot1 = nlay_i 608 578 609 579 !------------------ … … 611 581 !------------------ 612 582 DO ji = kideb, kiut 613 zh_i(ji) 583 zh_i(ji) = ht_i_b(ji) / nlay_i 614 584 ENDDO 615 585 … … 617 587 ! Layer cotes 618 588 !------------- 619 z_i(:,0) = 0. 0589 z_i(:,0) = 0._wp 620 590 DO jk = 1, nlay_i 621 591 DO ji = kideb, kiut 622 592 z_i(ji,jk) = zh_i(ji) * jk 623 593 END DO 624 END DO594 END DO 625 595 626 596 !--thicknesses of the layers 627 597 DO layer0 = ntop0, maxnbot0 628 598 DO ji = kideb, kiut 629 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) !thicknesses of the layers630 END DO 631 END DO599 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) ! thicknesses of the layers 600 END DO 601 END DO 632 602 633 603 !------------------------ 634 604 ! Weights for relayering 635 605 !------------------------ 636 637 q_i_b(:,:) = 0.0 606 q_i_b(:,:) = 0._wp 638 607 DO layer0 = ntop0, maxnbot0 639 608 DO layer1 = ntop1, nbot1 … … 643 612 q_i_b(ji,layer1) = q_i_b(ji,layer1) & 644 613 + zrl01(layer1,layer0)*qm0(ji,layer0) & 645 * MAX(0.0,SIGN(1.0,ht_i_b(ji)- zeps6+zeps)) &646 * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+ zeps))614 * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi06+epsi20)) & 615 * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20)) 647 616 END DO 648 617 END DO 649 END DO618 END DO 650 619 651 620 !------------------------- 652 621 ! Heat conservation check 653 622 !------------------------- 654 zqti_fin(:) = 0. 0623 zqti_fin(:) = 0._wp 655 624 DO jk = 1, nlay_i 656 625 DO ji = kideb, kiut … … 663 632 zji = MOD( npb(ji) - 1, jpi ) + 1 664 633 zjj = ( npb(ji) - 1 ) / jpi + 1 665 WRITE(numout,*) ' violation of heat conservation : ', & 666 ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice 634 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice 667 635 WRITE(numout,*) ' ji, jj : ', zji, zjj 668 636 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) … … 683 651 DO jk = 1, nlay_i 684 652 DO ji = kideb, kiut 685 q_i_b(ji,jk) = q_i_b(ji,jk) / MAX( zh_i(ji) , zeps)653 q_i_b(ji,jk) = q_i_b(ji,jk) / MAX( zh_i(ji) , epsi20 ) 686 654 END DO !ji 687 END DO !jk655 END DO !jk 688 656 689 657 ! Heat conservation … … 702 670 ! Update salinity (basal entrapment, snow ice formation) 703 671 DO ji = kideb, kiut 704 sm_i_b(ji) = sm_i_b(ji) & 705 + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 672 sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 706 673 END DO !ji 707 674 708 675 ! Recover temperature 709 676 DO jk = 1, nlay_i 710 711 DO ji = kideb, kiut 712 677 DO ji = kideb, kiut 713 678 ztmelts = -tmut*s_i_b(ji,jk) + rtt 714 679 !Conversion q(S,T) -> T (second order equation) 715 680 zaaa = cpic 716 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + & 717 q_i_b(ji,jk) / rhoic - lfus 681 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 718 682 zccc = lfus * ( ztmelts - rtt ) 719 683 zdiscrim = SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 720 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / & 721 ( 2.0 *zaaa ) 684 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 722 685 END DO !ji 723 686 724 687 END DO !jk 725 688 ! 689 IF( wrk_not_released(1, 1,2,3,4,5,6,7,8) ) CALL ctl_stop( 'lim_thd_ent : failed to release workspace arrays' ) 690 ! 726 691 END SUBROUTINE lim_thd_ent 727 692 728 693 #else 729 !!====================================================================== 730 !! *** MODULE limthd_ent *** 731 !! no sea ice model 732 !!====================================================================== 694 !!---------------------------------------------------------------------- 695 !! Default option NO LIM3 sea-ice model 696 !!---------------------------------------------------------------------- 733 697 CONTAINS 734 698 SUBROUTINE lim_thd_ent ! Empty routine 735 699 END SUBROUTINE lim_thd_ent 736 700 #endif 701 702 !!====================================================================== 737 703 END MODULE limthd_ent -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r2528 r2715 4 4 !! lateral thermodynamic growth of the ice 5 5 !!====================================================================== 6 !! History : LIM ! 2005-12 (M. Vancoppenolle) Original code 7 !! - ! 2006-01 (M. Vancoppenolle) add ITD 8 !! 3.0 ! 2007-07 (M. Vancoppenolle) Mass and energy conservation tested 9 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 10 !!---------------------------------------------------------------------- 6 11 #if defined key_lim3 7 12 !!---------------------------------------------------------------------- … … 11 16 !!---------------------------------------------------------------------- 12 17 USE par_oce ! ocean parameters 13 USE dom_oce 14 USE in_out_manager 15 USE phycst 16 USE sbc_oce ! Surface boundary condition: ocean fields 17 USE sbc_ice ! Surface boundary condition: ice fields 18 USE thd_ice 19 USE dom_ice 20 USE par_ice 21 USE ice 22 USE limtab 23 USE limcons 18 USE dom_oce ! domain variables 19 USE phycst ! physical constants 20 USE sbc_oce ! Surface boundary condition: ocean fields 21 USE sbc_ice ! Surface boundary condition: ice fields 22 USE thd_ice ! LIM thermodynamics 23 USE dom_ice ! LIM domain 24 USE par_ice ! LIM parameters 25 USE ice ! LIM variables 26 USE limtab ! LIM 2D <==> 1D 27 USE limcons ! LIM conservation 28 USE wrk_nemo ! workspace manager 29 USE in_out_manager ! I/O manager 30 USE lib_mpp ! MPP library 24 31 25 32 IMPLICIT NONE 26 33 PRIVATE 27 34 28 !! * Routine accessibility29 35 PUBLIC lim_thd_lac ! called by lim_thd 30 36 31 !! * Module variables 32 REAL(wp) :: & ! constant values 33 epsi20 = 1.e-20 , & 34 epsi13 = 1.e-13 , & 35 epsi11 = 1.e-13 , & 36 epsi03 = 1.e-03 , & 37 epsi06 = 1.e-06 , & 38 zeps = 1.e-10 , & 39 zzero = 0.e0 , & 40 zone = 1.e0 37 REAL(wp) :: epsi20 = 1e-20_wp ! constant values 38 REAL(wp) :: epsi13 = 1e-13_wp ! 39 REAL(wp) :: epsi11 = 1e-11_wp ! 40 REAL(wp) :: epsi10 = 1e-10_wp ! 41 REAL(wp) :: epsi06 = 1e-06_wp ! 42 REAL(wp) :: epsi03 = 1e-03_wp ! 43 REAL(wp) :: zzero = 0._wp ! 44 REAL(wp) :: zone = 1._wp ! 41 45 42 46 !!---------------------------------------------------------------------- 43 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)47 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 44 48 !! $Id$ 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 50 !!---------------------------------------------------------------------- 47 48 51 CONTAINS 49 52 … … 73 76 !! - Computation of frldb after lateral accretion and 74 77 !! update ht_s_b, ht_i_b and tbif_1d(:,:) 75 !!76 !! ** References : Not available yet77 !!78 !! History :79 !! 3.0 ! 12-05 (M. Vancoppenolle) Thorough rewrite of the routine80 !! Salinity variations in sea ice,81 !! Multi-layer code82 !! 3.1 ! 01-06 (M. Vancoppenolle) ITD83 !! 3.2 ! 04-07 (M. Vancoppenolle) Mass and energy conservation tested84 78 !!------------------------------------------------------------------------ 85 !! * Arguments 86 !! * Local variables 87 INTEGER :: & 88 ji,jj,jk,jl,jm , & !: dummy loop indices 89 layer , & !: layer index 90 nbpac !: nb of pts for lateral accretion 91 92 INTEGER :: & 93 zji , & !: ji of dummy test point 94 zjj , & !: jj of dummy test point 95 iter !: iteration for frazil ice computation 96 97 INTEGER, DIMENSION(jpij) :: & 98 zcatac , & !: indexes of categories where new ice grows 99 zswinew !: switch for new ice or not 100 101 REAL(wp), DIMENSION(jpij) :: & 102 zv_newice , & !: volume of accreted ice 103 za_newice , & !: fractional area of accreted ice 104 zh_newice , & !: thickness of accreted ice 105 ze_newice , & !: heat content of accreted ice 106 zs_newice , & !: salinity of accreted ice 107 zo_newice , & !: age of accreted ice 108 zdv_res , & !: residual volume in case of excessive heat budget 109 zda_res , & !: residual area in case of excessive heat budget 110 zat_i_ac , & !: total ice fraction 111 zat_i_lev , & !: total ice fraction for level ice only (type 1) 112 zdh_frazb , & !: accretion of frazil ice at the ice bottom 113 zvrel_ac !: relative ice / frazil velocity (1D vector) 114 115 REAL(wp), DIMENSION(jpij,jpl) :: & 116 zhice_old , & !: previous ice thickness 117 zdummy , & !: dummy thickness of new ice 118 zdhicbot , & !: thickness of new ice which is accreted vertically 119 zv_old , & !: old volume of ice in category jl 120 za_old , & !: old area of ice in category jl 121 za_i_ac , & !: 1-D version of a_i 122 zv_i_ac , & !: 1-D version of v_i 123 zoa_i_ac , & !: 1-D version of oa_i 124 zsmv_i_ac !: 1-D version of smv_i 125 126 REAL(wp), DIMENSION(jpij,jkmax,jpl) :: & 127 ze_i_ac !: 1-D version of e_i 128 129 REAL(wp), DIMENSION(jpij) :: & 130 zqbgow , & !: heat budget of the open water (negative) 131 zdhex !: excessively thick accreted sea ice (hlead-hice) 132 133 REAL(wp) :: & 134 ztmelts , & !: melting point of an ice layer 135 zdv , & !: increase in ice volume in each category 136 zfrazb !: fraction of frazil ice accreted at the ice bottom 137 138 ! Redistribution of energy after bottom accretion 139 REAL(wp) :: & !: Energy redistribution 140 zqold , & !: old ice enthalpy 141 zweight , & !: weight of redistribution 142 zeps6 , & !: epsilon value 143 zalphai , & !: factor describing how old and new layers overlap each other [m] 144 zindb 145 146 REAL(wp), DIMENSION(jpij,jkmax+1,jpl) :: & 147 zqm0 , & !: old layer-system heat content 148 zthick0 !: old ice thickness 149 150 ! Frazil ice collection thickness 151 LOGICAL :: & !: iterate frazil ice collection thickness 152 iterate_frazil 153 154 REAL(wp), DIMENSION(jpi,jpj) :: & 155 zvrel !: relative ice / frazil velocity 156 157 REAL(wp) :: & 158 zgamafr , & !: mult. coeff. between frazil vel. and wind speed 159 ztenagm , & !: square root of wind stress 160 zvfrx , & !: x-component of frazil velocity 161 zvfry , & !: y-component of frazil velocity 162 zvgx , & !: x-component of ice velocity 163 zvgy , & !: y-component of ice velocity 164 ztaux , & !: x-component of wind stress 165 ztauy , & !: y-component of wind stress 166 ztwogp , & !: dummy factor including reduced gravity 167 zvrel2 , & !: square of the relative ice-frazil velocity 168 zf , & !: F for Newton-Raphson procedure 169 zfp , & !: dF for Newton-Raphson procedure 170 zhicol_new , & !: updated collection thickness 171 zsqcd , & !: 1 / square root of ( airdensity * drag ) 172 zhicrit !: minimum thickness of frazil ice 173 174 ! Variables for energy conservation 175 REAL (wp), DIMENSION(jpi,jpj) :: & ! 176 vt_i_init, vt_i_final, & ! ice volume summed over categories 177 vt_s_init, vt_s_final, & ! snow volume summed over categories 178 et_i_init, et_i_final, & ! ice energy summed over categories 179 et_s_init ! snow energy summed over categories 180 181 REAL(wp) :: & 182 zde ! :increment of energy in category jl 183 79 USE wrk_nemo, ONLY : vt_i_init => wrk_2d_1 , vt_i_final => wrk_2d_4 , et_i_init => wrk_2d_7 80 USE wrk_nemo, ONLY : vt_s_init => wrk_2d_2 , vt_s_final => wrk_2d_5 , et_s_init => wrk_2d_8 81 USE wrk_nemo, ONLY : zvrel => wrk_2d_3 , et_i_final => wrk_2d_6 82 ! 83 INTEGER :: ji,jj,jk,jl,jm ! dummy loop indices 84 INTEGER :: layer, nbpac ! local integers 85 INTEGER :: zji, zjj, iter ! - - 86 REAL(wp) :: ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zde ! local scalars 87 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new ! - - 88 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - 89 LOGICAL :: iterate_frazil ! iterate frazil ice collection thickness 184 90 CHARACTER (len = 15) :: fieldid 185 91 ! 92 INTEGER, DIMENSION(jpij) :: zcatac ! indexes of categories where new ice grows 93 94 REAL(wp), DIMENSION(jpij,jpl) :: zhice_old ! previous ice thickness 95 REAL(wp), DIMENSION(jpij,jpl) :: zdummy ! dummy thickness of new ice 96 REAL(wp), DIMENSION(jpij,jpl) :: zdhicbot ! thickness of new ice which is accreted vertically 97 REAL(wp), DIMENSION(jpij,jpl) :: zv_old ! old volume of ice in category jl 98 REAL(wp), DIMENSION(jpij,jpl) :: za_old ! old area of ice in category jl 99 REAL(wp), DIMENSION(jpij,jpl) :: za_i_ac ! 1-D version of a_i 100 REAL(wp), DIMENSION(jpij,jpl) :: zv_i_ac ! 1-D version of v_i 101 REAL(wp), DIMENSION(jpij,jpl) :: zoa_i_ac ! 1-D version of oa_i 102 REAL(wp), DIMENSION(jpij,jpl) :: zsmv_i_ac ! 1-D version of smv_i 103 104 REAL(wp), DIMENSION(jpij,jkmax ,jpl) :: ze_i_ac !: 1-D version of e_i 105 REAL(wp), DIMENSION(jpij,jkmax+1,jpl) :: zqm0 ! old layer-system heat content 106 REAL(wp), DIMENSION(jpij,jkmax+1,jpl) :: zthick0 ! old ice thickness 107 108 REAL(wp), POINTER, DIMENSION(:) :: zv_newice, zh_newice, zs_newice, zdv_res, zat_i_ac , zdh_frazb, zqbgow 109 REAL(wp), POINTER, DIMENSION(:) :: za_newice, ze_newice, zo_newice, zda_res, zat_i_lev, zvrel_ac , zdhex 110 REAL(wp), POINTER, DIMENSION(:) :: zswinew 186 111 !!-----------------------------------------------------------------------! 187 112 188 et_i_init(:,:) = 0.0 189 et_s_init(:,:) = 0.0 190 vt_i_init(:,:) = 0.0 191 vt_s_init(:,:) = 0.0 192 zeps6 = 1.0e-6 113 IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 114 & wrk_in_use(2, 1,2,3,4,5,6,7,8) ) THEN 115 CALL ctl_stop('lim_thd_dh : requestead workspace arrays unavailable.') ; RETURN 116 END IF 117 ! Set-up pointers to sub-arrays of workspace arrays 118 zv_newice => wrk_1d_1 (1:jpij) ! volume of accreted ice 119 za_newice => wrk_1d_2 (1:jpij) ! fractional area of accreted ice 120 zh_newice => wrk_1d_3 (1:jpij) ! thickness of accreted ice 121 ze_newice => wrk_1d_4 (1:jpij) ! heat content of accreted ice 122 zs_newice => wrk_1d_5 (1:jpij) ! salinity of accreted ice 123 zo_newice => wrk_1d_6 (1:jpij) ! age of accreted ice 124 zdv_res => wrk_1d_7 (1:jpij) ! residual volume in case of excessive heat budget 125 zda_res => wrk_1d_8 (1:jpij) ! residual area in case of excessive heat budget 126 zat_i_ac => wrk_1d_9 (1:jpij) ! total ice fraction 127 zat_i_lev => wrk_1d_10(1:jpij) ! total ice fraction for level ice only (type 1) 128 zdh_frazb => wrk_1d_11(1:jpij) ! accretion of frazil ice at the ice bottom 129 zvrel_ac => wrk_1d_12(1:jpij) ! relative ice / frazil velocity (1D vector) 130 zqbgow => wrk_1d_13(1:jpij) ! heat budget of the open water (negative) 131 zdhex => wrk_1d_14(1:jpij) ! excessively thick accreted sea ice (hlead-hice) 132 133 134 135 et_i_init(:,:) = 0._wp 136 et_s_init(:,:) = 0._wp 137 vt_i_init(:,:) = 0._wp 138 vt_s_init(:,:) = 0._wp 193 139 194 140 !------------------------------------------------------------------------------! … … 211 157 !Energy of melting q(S,T) [J.m-3] 212 158 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / & 213 MAX( area(ji,jj) * v_i(ji,jj,jl) , zeps) * &159 MAX( area(ji,jj) * v_i(ji,jj,jl) , epsi10 ) * & 214 160 nlay_i 215 161 zindb = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) !0 if no ice and 1 if yes … … 273 219 ! Frazil ice velocity 274 220 !--------------------- 275 zvfrx = zgamafr * zsqcd * ztaux / MAX(ztenagm, zeps)276 zvfry = zgamafr * zsqcd * ztauy / MAX(ztenagm, zeps)221 zvfrx = zgamafr * zsqcd * ztaux / MAX(ztenagm,epsi10) 222 zvfry = zgamafr * zsqcd * ztauy / MAX(ztenagm,epsi10) 277 223 278 224 !------------------- … … 546 492 ! Laterally redistribute new ice volume and area 547 493 !------------------------------------------------ 548 zat_i_ac(:) = 0.0 549 494 zat_i_ac(:) = 0._wp 550 495 DO jl = 1, jpl 551 496 DO ji = 1, nbpac 552 ! vectorize 553 IF ( ( hi_max(jl-1) .LT. zh_newice(ji) ) & 554 .AND. ( zh_newice(ji) .LE. hi_max(jl) ) ) THEN 555 za_i_ac(ji,jl) = za_i_ac(ji,jl) + za_newice(ji) 556 zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zv_newice(ji) 557 zat_i_ac(ji) = zat_i_ac(ji) + za_i_ac(ji,jl) 558 zcatac(ji) = jl 497 IF( hi_max (jl-1) < zh_newice(ji) .AND. & 498 & zh_newice(ji) <= hi_max (jl) ) THEN 499 za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 500 zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 501 zat_i_ac(ji) = zat_i_ac(ji) + za_i_ac (ji,jl) 502 zcatac (ji) = jl 559 503 ENDIF 560 504 END DO ! ji … … 565 509 !---------------------------------- 566 510 DO ji = 1, nbpac 567 jl = zcatac(ji) ! categroy in which new ice is put 568 ! zindb = 0 if no ice and 1 if yes 569 zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , -za_old(ji,jl) ) ) 570 ! old ice thickness 571 zhice_old(ji,jl) = zv_old(ji,jl) & 572 / MAX ( za_old(ji,jl) , zeps ) * zindb 573 ! difference in thickness 574 zdhex(ji) = MAX( 0.0, zh_newice(ji) - zhice_old(ji,jl) ) 575 ! is ice totally new in category jl ? 576 zswinew(ji) = MAX( 0.0, SIGN( 1.0 , - za_old(ji,jl) + epsi11 ) ) 511 jl = zcatac(ji) ! categroy in which new ice is put 512 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) ) ) ! zindb=1 if ice =0 otherwise 513 zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb ! old ice thickness 514 zdhex (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) ) ! difference in thickness 515 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi11 ) ) ! ice totally new in jl category 577 516 END DO 578 517 … … 580 519 DO ji = 1, nbpac 581 520 jl = zcatac(ji) 582 zqold = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 583 zalphai = MIN( zhice_old(ji,jl) * jk / nlay_i , & 584 zh_newice(ji) ) & 585 - MIN( zhice_old(ji,jl) * ( jk - 1 ) & 586 / nlay_i , zh_newice(ji) ) 587 ze_i_ac(ji,jk,jl) = & 588 zswinew(ji) * ze_newice(ji) & 589 + ( 1.0 - zswinew(ji) ) * & 590 ( za_old(ji,jl) * zqold * zhice_old(ji,jl) / nlay_i & 591 + za_newice(ji) * ze_newice(ji) * zalphai & 592 + za_newice(ji) * ze_newice(ji) * zdhex(ji) / nlay_i ) / & 593 ( ( zv_i_ac(ji,jl) ) / nlay_i ) 594 595 END DO !ji 596 END DO !jl 521 zqold = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 522 zalphai = MIN( zhice_old(ji,jl) * jk / nlay_i , zh_newice(ji) ) & 523 & - MIN( zhice_old(ji,jl) * ( jk - 1 ) / nlay_i , zh_newice(ji) ) 524 ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji) & 525 + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl) * zqold * zhice_old(ji,jl) / nlay_i & 526 + za_newice(ji) * ze_newice(ji) * zalphai & 527 + za_newice(ji) * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( ( zv_i_ac(ji,jl) ) / nlay_i ) 528 END DO 529 END DO 597 530 598 531 !----------------------------------------------- … … 605 538 ! Fraction of level ice 606 539 jm = 1 607 zat_i_lev(:) = 0. 0540 zat_i_lev(:) = 0._wp 608 541 609 542 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) … … 616 549 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 617 550 DO ji = 1, nbpac 618 zindb = MAX( 0.0, SIGN( 1.0, zdv_res(ji) ) ) 619 zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + & 620 zindb * zdv_res(ji) * za_i_ac(ji,jl) / & 621 MAX( zat_i_lev(ji) , epsi06 ) 622 END DO ! ji 623 END DO ! jl 624 IF( ln_nicep ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 551 zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 552 zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi06 ) 553 END DO 554 END DO 555 IF( ln_nicep ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 625 556 626 557 !--------------------------------- … … 630 561 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 631 562 DO ji = 1, nbpac 632 ! zindb = 0 if no ice and 1 if yes 633 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 & 634 , - za_i_ac(ji,jl ) ) ) 635 zhice_old(ji,jl) = zv_i_ac(ji,jl) / & 636 MAX( za_i_ac(ji,jl) , zeps ) * zindb 637 zdhicbot(ji,jl) = zdv_res(ji) / MAX( za_i_ac(ji,jl) , zeps ) & 638 * zindb & 639 + zindb * zdh_frazb(ji) ! frazil ice 640 ! may coalesce 641 ! thickness of residual ice 642 zdummy(ji,jl) = zv_i_ac(ji,jl)/MAX(za_i_ac(ji,jl),zeps)*zindb 643 END DO !ji 644 END DO !jl 563 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) ) ) ! zindb=1 if ice =0 otherwise 564 zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 565 zdhicbot (ji,jl) = zdv_res(ji) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb & 566 & + zindb * zdh_frazb(ji) ! frazil ice may coalesce 567 zdummy(ji,jl) = zv_i_ac(ji,jl)/MAX(za_i_ac(ji,jl),epsi10)*zindb ! thickness of residual ice 568 END DO 569 END DO 645 570 646 571 ! old layers thicknesses and enthalpies … … 648 573 DO jk = 1, nlay_i 649 574 DO ji = 1, nbpac 650 zthick0(ji,jk,jl) = zhice_old(ji,jl) / nlay_i651 zqm0 (ji,jk,jl) = ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl)652 END DO !ji653 END DO !jk654 END DO !jl655 575 zthick0(ji,jk,jl) = zhice_old(ji,jl) / nlay_i 576 zqm0 (ji,jk,jl) = ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 577 END DO 578 END DO 579 END DO 580 !!gm ??? why the previous do loop if ocerwriten by the following one ? 656 581 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 657 582 DO ji = 1, nbpac 658 583 zthick0(ji,nlay_i+1,jl) = zdhicbot(ji,jl) 659 zqm0 (ji,nlay_i+1,jl) = ze_newice(ji) *zdhicbot(ji,jl)584 zqm0 (ji,nlay_i+1,jl) = ze_newice(ji) * zdhicbot(ji,jl) 660 585 END DO ! ji 661 586 END DO ! jl 662 587 663 588 ! Redistributing energy on the new grid 664 ze_i_ac(:,:,:) = 0. 0589 ze_i_ac(:,:,:) = 0._wp 665 590 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 666 591 DO jk = 1, nlay_i 667 592 DO layer = 1, nlay_i + 1 668 593 DO ji = 1, nbpac 669 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , & 670 - za_i_ac(ji,jl ) ) ) 594 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) ) 671 595 ! Redistributing energy on the new grid 672 zweight = MAX ( & 673 MIN( zhice_old(ji,jl) * layer , zdummy(ji,jl) * jk ) - & 674 MAX( zhice_old(ji,jl) * ( layer - 1 ) , zdummy(ji,jl) * & 675 ( jk - 1 ) ) , 0.0 ) & 676 / ( MAX(nlay_i * zthick0(ji,layer,jl),zeps) ) * zindb 677 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) + & 678 zweight * zqm0(ji,layer,jl) 596 zweight = MAX ( MIN( zhice_old(ji,jl) * layer , zdummy(ji,jl) * jk ) & 597 & - MAX( zhice_old(ji,jl) * ( layer - 1 ) , zdummy(ji,jl) * ( jk - 1 ) ) , 0._wp ) & 598 & /( MAX(nlay_i * zthick0(ji,layer,jl),epsi10) ) * zindb 599 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl) 679 600 END DO ! ji 680 601 END DO ! layer … … 685 606 DO jk = 1, nlay_i 686 607 DO ji = 1, nbpac 687 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 & 688 , - zv_i_ac(ji,jl) ) ) !0 if no ice 689 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) / & 690 MAX( zv_i_ac(ji,jl) , zeps) & 691 * za_i_ac(ji,jl) * nlay_i * zindb 608 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) ) 609 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) & 610 & / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * nlay_i * zindb 692 611 END DO 693 612 END DO … … 699 618 DO jl = 1, jpl 700 619 DO ji = 1, nbpac 701 !--ice age 702 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - & 703 za_i_ac(ji,jl) ) ) ! 0 if no ice and 1 if yes 704 zoa_i_ac(ji,jl) = za_old(ji,jl) * zoa_i_ac(ji,jl) / & 705 MAX( za_i_ac(ji,jl) , zeps ) * zindb 706 END DO ! ji 707 END DO ! jl 620 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) ) ! 0 if no ice and 1 if yes 621 zoa_i_ac(ji,jl) = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 622 END DO 623 END DO 708 624 709 625 !----------------- 710 626 ! Update salinity 711 627 !----------------- 712 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 713 628 IF( num_sal == 2 .OR. num_sal == 4 ) THEN 714 629 DO jl = 1, jpl 715 630 DO ji = 1, nbpac 716 !zindb = 0 if no ice and 1 if yes 717 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - & 718 zv_i_ac(ji,jl) ) ) ! 0 if no ice and 1 if yes 719 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl) 720 zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * & 721 zindb 722 END DO ! ji 723 END DO ! jl 724 725 ENDIF ! num_sal 726 631 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) ) ! 0 if no ice and 1 if yes 632 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl) 633 zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * zindb 634 END DO 635 END DO 636 ENDIF 727 637 728 638 !------------------------------------------------------------------------------! 729 639 ! 8) Change 2D vectors to 1D vectors 730 640 !------------------------------------------------------------------------------! 731 732 641 DO jl = 1, jpl 733 CALL tab_1d_2d( nbpac, a_i(:,:,jl) , npac(1:nbpac) , & 734 za_i_ac(1:nbpac,jl) , jpi, jpj ) 735 CALL tab_1d_2d( nbpac, v_i(:,:,jl) , npac(1:nbpac) , & 736 zv_i_ac(1:nbpac,jl) , jpi, jpj ) 737 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac) , & 738 zoa_i_ac(1:nbpac,jl), jpi, jpj ) 739 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 740 CALL tab_1d_2d( nbpac, smv_i(:,:,jl) , npac(1:nbpac) , & 741 zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 642 CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_ac (1:nbpac,jl), jpi, jpj ) 643 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 644 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 645 IF ( num_sal == 2 .OR. num_sal == 4 ) & 646 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 742 647 DO jk = 1, nlay_i 743 CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl) , npac(1:nbpac), & 744 ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 745 END DO ! jk 746 END DO !jl 747 CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d (1:nbpac) , & 748 jpi, jpj ) 749 648 CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 649 END DO 650 END DO 651 CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d (1:nbpac) , jpi, jpj ) 652 ! 750 653 ENDIF ! nbpac > 0 751 654 … … 753 656 ! 9) Change units for e_i 754 657 !------------------------------------------------------------------------------! 755 756 658 DO jl = 1, jpl 757 DO jk = 1, nlay_i 758 DO jj = 1, jpj 759 DO ji = 1, jpi 760 ! Correct dimensions to avoid big values 761 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 762 763 ! Mutliply by ice volume, and divide by number 764 ! of layers to get heat content in 10^9 Joules 765 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * & 766 area(ji,jj) * v_i(ji,jj,jl) / & 767 nlay_i 768 END DO 769 END DO 659 DO jk = 1, nlay_i ! heat content in 10^9 Joules 660 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i / unit_fac 770 661 END DO 771 662 END DO … … 774 665 ! 10) Conservation check and changes in each ice category 775 666 !------------------------------------------------------------------------------| 776 777 IF ( con_i ) THEN 667 IF( con_i ) THEN 778 668 CALL lim_column_sum (jpl, v_i, vt_i_final) 779 669 fieldid = 'v_i, limthd_lac' 780 670 CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 781 671 ! 782 672 CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final) 783 673 fieldid = 'e_i, limthd_lac' 784 674 CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid) 785 675 ! 786 676 CALL lim_column_sum (jpl, v_s, vt_s_final) 787 677 fieldid = 'v_s, limthd_lac' 788 678 CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 789 679 ! 790 680 ! CALL lim_column_sum (jpl, e_s(:,:,1,:) , et_s_init) 791 681 ! fieldid = 'e_s, limthd_lac' 792 682 ! CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid) 793 794 683 IF( ln_nicep ) THEN 795 684 WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindx,jjindx) … … 798 687 WRITE(numout,*) ' et_i_final: ', et_i_final(jiindx,jjindx) 799 688 ENDIF 800 689 ! 801 690 ENDIF 802 691 ! 692 IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 693 wrk_not_released(2, 1,2,3,4,5,6,7,8) ) & 694 CALL ctl_stop( 'lim_thd_lac : failed to release workspace arrays' ) 695 ! 803 696 END SUBROUTINE lim_thd_lac 804 697 805 698 #else 806 !!====================================================================== 807 !! *** MODULE limthd_lac *** 808 !! no sea ice model 809 !!====================================================================== 699 !!---------------------------------------------------------------------- 700 !! Default option NO LIM3 sea-ice model 701 !!---------------------------------------------------------------------- 810 702 CONTAINS 811 703 SUBROUTINE lim_thd_lac ! Empty routine 812 704 END SUBROUTINE lim_thd_lac 813 705 #endif 706 707 !!====================================================================== 814 708 END MODULE limthd_lac -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r2528 r2715 6 6 !! History : - ! 2003-05 (M. Vancoppenolle) UCL-ASTR first coding for LIM3-1D 7 7 !! 3.0 ! 2005-12 (M. Vancoppenolle) adapted to the 3-D version 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 9 !!--------------------------------------------------------------------- 9 10 #if defined key_lim3 … … 16 17 USE phycst ! physical constants (ocean directory) 17 18 USE sbc_oce ! Surface boundary condition: ocean fields 18 USE ice ! LIM: sea-ice variables 19 USE par_ice ! LIM: sea-ice parameters 20 USE thd_ice ! LIM: sea-ice thermodynamics 21 USE limvar ! LIM: sea-ice variables 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters 21 USE thd_ice ! LIM thermodynamics 22 USE limvar ! LIM variables 23 USE wrk_nemo ! workspace manager 22 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 23 26 24 27 IMPLICIT NONE … … 29 32 30 33 !!---------------------------------------------------------------------- 31 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)34 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 32 35 !! $Id$ 33 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 51 54 INTEGER :: ji, jk ! dummy loop indices 52 55 INTEGER :: zji, zjj ! local integers 53 REAL(wp) :: zsold, zeps,iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars56 REAL(wp) :: zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars 54 57 REAL(wp) :: zaaa, zbbb, zccc, zdiscrim ! local scalars 55 REAL(wp), DIMENSION(jpij) :: ze_init, zhiold, zsiold ! 1D workspace 58 ! 59 REAL(wp), POINTER, DIMENSION(:) :: ze_init, zhiold, zsiold 56 60 !!--------------------------------------------------------------------- 57 61 58 zeps=1.0e-06_wp 62 IF( wrk_in_use(1, 1,2,3) ) THEN 63 CALL ctl_stop('lim_thd_dh : requestead workspace arrays unavailable.') ; RETURN 64 END IF 65 ! Set-up pointers to sub-arrays of workspace arrays 66 ze_init => wrk_1d_1 (1:jpij) 67 zhiold => wrk_1d_2 (1:jpij) 68 zsiold => wrk_1d_3 (1:jpij) 59 69 60 70 !------------------------------------------------------------------------------| 61 71 ! 1) Constant salinity, constant in time | 62 72 !------------------------------------------------------------------------------| 63 73 !!gm comment: if num_sal = 1 s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 64 74 IF( num_sal == 1 ) THEN 75 ! 65 76 DO jk = 1, nlay_i 66 77 DO ji = kideb, kiut … … 79 90 !------------------------------------------------------------------------------| 80 91 81 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 82 83 ! WRITE(numout,*) 84 ! WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 85 ! num_sal 86 ! WRITE(numout,*) '~~~~~~~~~~~' 87 ! WRITE(numout,*) 92 IF( num_sal == 2 .OR. num_sal == 4 ) THEN 88 93 89 94 !--------------------------------- … … 91 96 !--------------------------------- 92 97 DO ji = kideb, kiut 93 zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - & 94 dh_i_surf(ji) 95 END DO ! ji 98 zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 99 END DO 96 100 97 101 !--------------------- 98 102 ! Global heat content 99 103 !--------------------- 100 101 ze_init(:) = 0.0 104 ze_init(:) = 0._wp 102 105 DO jk = 1, nlay_i 103 106 DO ji = kideb, kiut 104 107 ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 105 END DO ! ji 106 END DO ! jk 107 108 DO ji = kideb, kiut 109 110 !---------- 108 END DO 109 END DO 110 111 DO ji = kideb, kiut 112 ! 111 113 ! Switches 112 114 !---------- 113 114 ! iflush : 1 if summer 115 iflush = MAX( 0.0 , SIGN ( 1.0 , t_su_b(ji) - rtt ) ) 116 ! igravdr : 1 if t_su lt t_bo 117 igravdr = MAX( 0.0 , SIGN ( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) 118 ! iaccrbo : 1 if bottom accretion 119 iaccrbo = MAX( 0.0 , SIGN ( 1.0 , dh_i_bott(ji) ) ) 120 ! isnowic : 1 if snow ice formation 121 i_ice_switch = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i_b(ji) + 1.0e-2 ) ) 122 isnowic = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - dh_snowice(ji) ) ) * i_ice_switch 115 iflush = MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt ) ) ! =1 if summer 116 igravdr = MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) ! =1 if t_su < t_bo 117 iaccrbo = MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) ) ) ! =1 if bottom accretion 118 i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 119 isnowic = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch ! =1 if snow ice formation 123 120 124 121 !--------------------- 125 122 ! Salinity tendencies 126 123 !--------------------- 127 128 ! drainage by gravity drainage 124 ! ! drainage by gravity drainage 129 125 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 130 131 ! drainage by flushing 132 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 126 ! ! drainage by flushing 127 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 133 128 134 129 !----------------- 135 130 ! Update salinity 136 131 !----------------- 137 138 132 ! only drainage terms ( gravity drainage and flushing ) 139 ! snow ice / bottom sources are added in lim_thd_ent 140 ! to conserve energy 133 ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 141 134 zsiold(ji) = sm_i_b(ji) 142 135 sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 143 136 144 ! if no ice, salinity eq0.1137 ! if no ice, salinity = 0.1 145 138 i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 146 sm_i_b(ji) = i_ice_switch *sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch )139 sm_i_b(ji) = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 147 140 END DO ! ji 148 141 … … 155 148 156 149 DO ji = kideb, kiut 150 !!gm useless 157 151 ! iflush : 1 if summer 158 152 iflush = MAX( 0._wp , SIGN ( 1._wp , t_su_b(ji) - rtt ) ) … … 161 155 ! iaccrbo : 1 if bottom accretion 162 156 iaccrbo = MAX( 0._wp , SIGN ( 1._wp , dh_i_bott(ji) ) ) 157 !!gm end useless 163 158 ! 164 159 fhbri_1d(ji) = 0._wp … … 186 181 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 187 182 zccc = lfus * ( ztmelts - rtt ) 188 zdiscrim = SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0))183 zdiscrim = SQRT( MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp ) ) 189 184 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 190 END DO !ji191 END DO !jk185 END DO 186 END DO 192 187 ! 193 188 ENDIF ! num_sal .EQ. 2 … … 197 192 !------------------------------------------------------------------------------| 198 193 199 IF( num_sal .EQ. 3 ) THEN 200 201 WRITE(numout,*) 202 WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 203 num_sal 204 WRITE(numout,*) '~~~~~~~~~~~~' 205 206 CALL lim_var_salprof1d(kideb,kiut) 207 208 ENDIF ! num_sal .EQ. 3 194 IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 209 195 210 196 !------------------------------------------------------------------------------| … … 212 198 !------------------------------------------------------------------------------| 213 199 214 ! Cox and Weeks, 1974 215 IF (num_sal.eq.5) THEN 216 217 WRITE(numout,*) 218 WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 219 num_sal 220 WRITE(numout,*) '~~~~~~~~~~~~' 221 222 DO ji = kideb, kiut 223 200 IF( num_sal == 5 ) THEN ! Cox and Weeks, 1974 201 ! 202 DO ji = kideb, kiut 224 203 zsold = sm_i_b(ji) 225 226 IF (ht_i_b(ji).lt.0.4) THEN 227 sm_i_b(ji) = 14.24 - 19.39*ht_i_b(ji) 204 IF( ht_i_b(ji) < 0.4 ) THEN 205 sm_i_b(ji) = 14.24 - 19.39 * ht_i_b(ji) 228 206 ELSE 229 sm_i_b(ji) = 7.88 - 1.59*ht_i_b(ji)230 sm_i_b(ji) = MIN(sm_i_b(ji),zsold)207 sm_i_b(ji) = 7.88 - 1.59 * ht_i_b(ji) 208 sm_i_b(ji) = MIN( sm_i_b(ji) , zsold ) 231 209 ENDIF 232 233 IF ( ht_i_b(ji) .GT. 3.06918239 ) THEN 234 sm_i_b(ji) = 3.0 210 IF( ht_i_b(ji) > 3.06918239 ) THEN 211 sm_i_b(ji) = 3._wp 235 212 ENDIF 236 237 213 DO jk = 1, nlay_i 238 214 s_i_b(ji,jk) = sm_i_b(ji) 239 215 END DO 240 241 END DO ! ji 242 216 END DO 217 ! 243 218 ENDIF ! num_sal 244 219 … … 247 222 !------------------------------------------------------------------------------| 248 223 249 IF ( num_sal .EQ.4 ) THEN250 DO ji = kideb, kiut 251 zji = MOD( npb(ji) - 1, jpi ) + 1252 zjj =( npb(ji) - 1 ) / jpi + 1224 IF ( num_sal == 4 ) THEN 225 DO ji = kideb, kiut 226 zji = MOD( npb(ji) - 1 , jpi ) + 1 227 zjj = ( npb(ji) - 1 ) / jpi + 1 253 228 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal ) & 254 229 & * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice … … 256 231 ELSE 257 232 DO ji = kideb, kiut 258 zji = MOD( npb(ji) - 1, jpi ) + 1259 zjj =( npb(ji) - 1 ) / jpi + 1233 zji = MOD( npb(ji) - 1 , jpi ) + 1 234 zjj = ( npb(ji) - 1 ) / jpi + 1 260 235 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - s_i_new(ji) ) & 261 236 & * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 262 END DO ! ji237 END DO 263 238 ENDIF 239 ! 240 IF( wrk_not_released(1, 1,2,3) ) CALL ctl_stop( 'lim_thd_lac : failed to release workspace arrays' ) 264 241 ! 265 242 END SUBROUTINE lim_thd_sal -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r2528 r2715 4 4 !! LIM transport ice model : sea-ice advection/diffusion 5 5 !!====================================================================== 6 !! History : LIM-2 ! 2000-01 (M.A. Morales Maqueda, H. Goosse, and T. Fichefet) Original code 7 !! 3.0 ! 2005-11 (M. Vancoppenolle) Multi-layer sea ice, salinity variations 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 !!---------------------------------------------------------------------- 6 10 #if defined key_lim3 7 11 !!---------------------------------------------------------------------- … … 9 13 !!---------------------------------------------------------------------- 10 14 !! lim_trp : advection/diffusion process of sea ice 11 !! lim_trp_init : initialization and namelist read 12 !!---------------------------------------------------------------------- 13 USE phycst 14 USE dom_oce 15 !!---------------------------------------------------------------------- 16 USE phycst ! physical constant 17 USE dom_oce ! ocean domain 18 USE sbc_oce ! ocean surface boundary condition 19 USE par_ice ! LIM-3 parameter 20 USE dom_ice ! LIM-3 domain 21 USE ice ! LIM-3 variables 22 USE limadv ! LIM-3 advection 23 USE limhdf ! LIM-3 horizontal diffusion 15 24 USE in_out_manager ! I/O manager 16 USE sbc_oce ! Surface boundary condition: ocean fields 17 USE dom_ice 18 USE ice 19 USE limadv 20 USE limhdf 21 USE lbclnk 22 USE lib_mpp 23 USE par_ice 25 USE lbclnk ! lateral boundary conditions -- MPP exchanges 26 USE lib_mpp ! MPP library 24 27 USE prtctl ! Print control 25 28 … … 27 30 PRIVATE 28 31 29 !! * Routine accessibility 30 PUBLIC lim_trp ! called by ice_step 31 32 !! * Shared module variables 33 REAL(wp), PUBLIC :: & !: 34 bound = 0.e0 !: boundary condit. (0.0 no-slip, 1.0 free-slip) 35 36 !! * Module variables 37 REAL(wp) :: & ! constant values 38 epsi06 = 1.e-06 , & 39 epsi03 = 1.e-03 , & 40 epsi16 = 1.e-16 , & 41 rzero = 0.e0 , & 42 rone = 1.e0 , & 43 zeps10 = 1.e-10 32 PUBLIC lim_trp ! called by ice_step 33 34 REAL(wp), PUBLIC :: bound = 0._wp !: boundary condit. (0.0 no-slip, 1.0 free-slip) 35 36 REAL(wp) :: epsi06 = 1.e-06_wp ! constant values 37 REAL(wp) :: epsi03 = 1.e-03_wp 38 REAL(wp) :: zeps10 = 1.e-10_wp 39 REAL(wp) :: epsi16 = 1.e-16_wp 40 REAL(wp) :: rzero = 0._wp 41 REAL(wp) :: rone = 1._wp 44 42 45 43 !! * Substitution 46 44 # include "vectopt_loop_substitute.h90" 47 45 !!---------------------------------------------------------------------- 48 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)46 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 49 47 !! $Id$ 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 !!---------------------------------------------------------------------- 52 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 !!---------------------------------------------------------------------- 53 50 CONTAINS 54 51 … … 64 61 !! 65 62 !! ** action : 66 !!67 !! History :68 !! 1.0 ! 00-01 (M.A. Morales Maqueda, H. Goosse, and T. Fichefet) Original code69 !! ! 01-05 (G. Madec, R. Hordoir) opa norm70 !! 2.0 ! 04-01 (G. Madec, C. Ethe) F90, mpp71 !! 3.0 ! 05-11 (M. Vancoppenolle) Multi-layer sea ice, salinity variations72 63 !!--------------------------------------------------------------------- 73 INTEGER, INTENT(in) :: kt ! number of iteration 74 !! * Local Variables 75 INTEGER :: ji, jj, jk, jl, layer, & ! dummy loop indices 76 initad ! number of sub-timestep for the advection 77 INTEGER :: ji_maxu, ji_maxv, jj_maxu, jj_maxv 78 79 REAL(wp) :: & 80 zindb , & 81 zindsn , & 82 zindic , & 83 zusvosn, & 84 zusvoic, & 85 zvbord , & 86 zcfl , & 87 zusnit , & 88 zrtt, zsal, zage, & 89 zbigval, ze, & 90 zmaxu, zmaxv 91 92 REAL(wp), DIMENSION(jpi,jpj) :: & ! temporary workspace 93 zui_u , zvi_v , zsm , & 94 zs0at, zs0ow 95 96 REAL(wp), DIMENSION(jpi,jpj,jpl):: & ! temporary workspace 97 zs0ice, zs0sn, zs0a , & 98 zs0c0 , & 99 zs0sm , zs0oi 100 101 ! MHE Multilayer heat content 102 REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl) :: & ! temporary workspace 103 zs0e 104 105 !--------------------------------------------------------------------- 106 107 IF( numit == nstart ) CALL lim_trp_init ! Initialization (first time-step only) 108 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 65 USE wrk_nemo, ONLY: zs0at => wrk_2d_1 , zsm => wrk_2d_2 , zs0ow => wrk_2d_3 ! 2D workspace 66 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2, wrk_3d_3, wrk_3d_4, wrk_3d_5, wrk_3d_6 ! 3D workspace 67 USE wrk_nemo, ONLY: wrk_4d_1 ! 4D workspace 68 ! 69 INTEGER, INTENT(in) :: kt ! number of iteration 70 ! 71 INTEGER :: ji, jj, jk, jl, layer ! dummy loop indices 72 INTEGER :: initad ! number of sub-timestep for the advection 73 REAL(wp) :: zindb , zindsn , zindic ! local scalar 74 REAL(wp) :: zusvosn, zusvoic, zbigval ! - - 75 REAL(wp) :: zcfl , zusnit , zrtt ! - - 76 REAL(wp) :: ze , zsal , zage ! - - 77 ! 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ! 3D pointer 79 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e ! 4D pointer 80 !!--------------------------------------------------------------------- 81 82 IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 83 CALL ctl_stop( 'lim_trp : requested workspace arrays unavailable' ) ; RETURN 84 END IF 85 86 zs0ice => wrk_3d_1(:,:,1:jpl) ; zs0a => wrk_3d_3 ; zs0sm => wrk_3d_3 87 zs0sn => wrk_3d_2(:,:,1:jpl) ; zs0c0 => wrk_3d_3 ; zs0oi => wrk_3d_3 88 zs0e => wrk_4d_1(:,:,1:jkmax,1:jpl) 89 90 91 IF( numit == nstart .AND. lwp ) THEN 92 WRITE(numout,*) 93 IF( ln_limdyn ) THEN ; WRITE(numout,*) 'lim_trp : Ice transport ' 94 ELSE ; WRITE(numout,*) 'lim_trp : No ice advection as ln_limdyn = ', ln_limdyn 95 ENDIF 96 WRITE(numout,*) '~~~~~~~~~~~~' 97 ENDIF 98 109 99 zsm(:,:) = area(:,:) 110 100 111 IF( ln_limdyn ) THEN 112 IF( kt == nit000 .AND. lwp ) THEN 113 WRITE(numout,*) ' lim_trp : Ice Advection' 114 WRITE(numout,*) ' ~~~~~~~' 115 ENDIF 116 117 !-----------------------------------------------------------------------------! 118 ! 1) CFL Test 119 !-----------------------------------------------------------------------------! 120 121 !------------------------------------------ 122 ! ice velocities at ocean U- and V-points 123 !------------------------------------------ 124 125 ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions. 126 zvbord = 1.0 + ( 1.0 - bound ) 127 DO jj = 1, jpjm1 128 DO ji = 1, fs_jpim1 129 zui_u(ji,jj) = u_ice(ji,jj) 130 zvi_v(ji,jj) = v_ice(ji,jj) 131 END DO 132 END DO 133 134 ! Lateral boundary conditions 135 CALL lbc_lnk( zui_u, 'U', -1. ) 136 CALL lbc_lnk( zvi_v, 'V', -1. ) 101 ! !-------------------------------------! 102 IF( ln_limdyn ) THEN ! Advection of sea ice properties ! 103 ! !-------------------------------------! 104 ! 137 105 138 106 !------------------------- 107 ! transported fields 108 !------------------------- 109 ! Snow vol, ice vol, salt and age contents, area 110 zs0ow(:,:) = ato_i(:,:) * area(:,:) ! Open water area 111 DO jl = 1, jpl 112 zs0sn (:,:,jl) = v_s (:,:,jl) * area(:,:) ! Snow volume 113 zs0ice(:,:,jl) = v_i (:,:,jl) * area(:,:) ! Ice volume 114 zs0a (:,:,jl) = a_i (:,:,jl) * area(:,:) ! Ice area 115 zs0sm (:,:,jl) = smv_i(:,:,jl) * area(:,:) ! Salt content 116 zs0oi (:,:,jl) = oa_i (:,:,jl) * area(:,:) ! Age content 117 zs0c0 (:,:,jl) = e_s (:,:,1,jl) ! Snow heat content 118 zs0e (:,:,:,jl) = e_i (:,:,:,jl) ! Ice heat content 119 END DO 120 121 !-------------------------- 122 ! Advection of Ice fields (Prather scheme) 123 !-------------------------- 124 ! If ice drift field is too fast, use an appropriate time step for advection. 139 125 ! CFL test for stability 140 !------------------------- 141 142 zcfl = 0.e0 143 zcfl = MAX( zcfl, MAXVAL( ABS( zui_u(1:jpim1, : ) ) * rdt_ice / e1u(1:jpim1, : ) ) ) 144 zcfl = MAX( zcfl, MAXVAL( ABS( zvi_v( : ,1:jpjm1) ) * rdt_ice / e2v( : ,1:jpjm1) ) ) 145 146 zmaxu = 0.0 147 zmaxv = 0.0 148 DO ji = 1, jpim1 149 DO jj = 1, jpjm1 150 IF ( (ABS(zui_u(ji,jj)) .GT. zmaxu) ) THEN 151 zmaxu = MAX(zui_u(ji,jj), zmaxu ) 152 ji_maxu = ji 153 jj_maxu = jj 154 ENDIF 155 IF ( (ABS(zvi_v(ji,jj)) .GT. zmaxv) ) THEN 156 zmaxv = MAX(zvi_v(ji,jj), zmaxv ) 157 ji_maxv = ji 158 jj_maxv = jj 159 ENDIF 160 END DO 161 END DO 162 163 IF (lk_mpp ) CALL mpp_max(zcfl) 164 165 IF ( zcfl > 0.5 .AND. lwp ) & 166 WRITE(numout,*) 'lim_trp : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl 167 168 !-----------------------------------------------------------------------------! 169 ! 2) Computation of transported fields 170 !-----------------------------------------------------------------------------! 171 172 !------------------------------------------------------ 173 ! 1.1) Snow vol, ice vol, salt and age contents, area 174 !------------------------------------------------------ 175 176 zs0ow (:,:) = ato_i(:,:) * area(:,:) ! Open water area 177 DO jl = 1, jpl !sum over thickness categories 178 ! area -> is the unmasked and masked area of T-grid cell 179 zs0sn (:,:,jl) = v_s(:,:,jl) * area(:,:) ! Snow volume. 180 zs0ice(:,:,jl) = v_i(:,:,jl) * area(:,:) ! Ice volume. 181 zs0a (:,:,jl) = a_i(:,:,jl) * area(:,:) ! Ice area 182 zs0sm (:,:,jl) = smv_i(:,:,jl) * area(:,:) ! Salt content 183 zs0oi (:,:,jl) = oa_i (:,:,jl) * area(:,:) ! Age content 184 185 !---------------------------------- 186 ! 1.2) Ice and snow heat contents 187 !---------------------------------- 188 189 zs0c0 (:,:,jl) = e_s(:,:,1,jl) ! Snow heat cont. 190 DO jk = 1, nlay_i 191 zs0e(:,:,jk,jl) = e_i(:,:,jk,jl) ! Ice heat content 192 END DO 193 END DO 194 195 !-----------------------------------------------------------------------------! 196 ! 3) Advection of Ice fields 197 !-----------------------------------------------------------------------------! 198 199 ! If ice drift field is too fast, use an appropriate time step for advection. 126 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) ) 127 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) ) 128 IF(lk_mpp ) CALL mpp_max( zcfl ) 129 !!gm more readability: 130 ! IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 131 ! ELSE ; initad = 1 ; zusnit = 1.0_wp 132 ! ENDIF 133 !!gm end 200 134 initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 201 135 zusnit = 1.0 / REAL( initad ) 202 203 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN !== odd ice time step: adv_x then adv_y ==! 136 IF( zcfl > 0.5 .AND. lwp ) & 137 WRITE(numout,*) 'lim_trp_2 : CFL violation at day ', nday, ', cfl = ', zcfl, & 138 & ': the ice time stepping is split in two' 139 140 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 204 141 DO jk = 1,initad 205 !--- ice open water area 206 CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0ow(:,:) , sxopw(:,:) , & 207 sxxopw(:,:), syopw(:,:) , & 208 syyopw(:,:), sxyopw(:,:) ) 209 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0ow(:,:) , sxopw (:,:) , & 210 sxxopw(:,:), syopw (:,:) , & 211 syyopw(:,:), sxyopw(:,:) ) 142 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 143 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 144 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), & 145 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 212 146 DO jl = 1, jpl 213 !--- ice volume --- 214 CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , & 215 sxxice(:,:,jl) , syice (:,:,jl) , & 216 syyice(:,:,jl) , sxyice(:,:,jl) ) 217 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , & 218 sxxice(:,:,jl) , syice (:,:,jl) , & 219 syyice(:,:,jl) , sxyice(:,:,jl) ) 220 !--- snow volume --- 221 CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0sn (:,:,jl) , sxsn (:,:,jl) , & 222 sxxsn (:,:,jl) , sysn (:,:,jl) , & 223 syysn (:,:,jl) , sxysn (:,:,jl) ) 224 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0sn (:,:,jl) , sxsn (:,:,jl) , & 225 sxxsn (:,:,jl) , sysn (:,:,jl) , & 226 syysn (:,:,jl) , sxysn (:,:,jl) ) 227 !--- ice salinity --- 228 CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 229 sxxsal(:,:,jl) , sysal (:,:,jl) , & 230 syysal(:,:,jl) , sxysal(:,:,jl) ) 231 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 232 sxxsal(:,:,jl) , sysal (:,:,jl) , & 233 syysal(:,:,jl) , sxysal(:,:,jl) ) 234 !--- ice age --- 235 CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 236 sxxage(:,:,jl) , syage (:,:,jl) , & 237 syyage(:,:,jl) , sxyage(:,:,jl) ) 238 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 239 sxxage(:,:,jl) , syage (:,:,jl) , & 240 syyage(:,:,jl) , sxyage(:,:,jl) ) 241 !--- ice concentrations --- 242 CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0a (:,:,jl) , sxa (:,:,jl) , & 243 sxxa (:,:,jl) , sya (:,:,jl) , & 244 syya (:,:,jl) , sxya (:,:,jl) ) 245 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0a (:,:,jl) , sxa (:,:,jl) , & 246 sxxa (:,:,jl) , sya (:,:,jl) , & 247 syya (:,:,jl) , sxya (:,:,jl) ) 248 !--- ice / snow thermal energetic contents --- 249 CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0c0 (:,:,jl) , sxc0 (:,:,jl) , & 250 sxxc0 (:,:,jl) , syc0 (:,:,jl) , & 251 syyc0 (:,:,jl) , sxyc0 (:,:,jl) ) 252 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0c0 (:,:,jl) , sxc0 (:,:,jl) , & 253 sxxc0 (:,:,jl) , syc0 (:,:,jl) , & 254 syyc0 (:,:,jl) , sxyc0 (:,:,jl) ) 255 DO layer = 1, nlay_i 256 CALL lim_adv_x( zusnit, zui_u, rone , zsm, & 257 zs0e(:,:,layer,jl) , sxe (:,:,layer,jl) , & 258 sxxe(:,:,layer,jl) , sye (:,:,layer,jl) , & 259 syye(:,:,layer,jl) , sxye(:,:,layer,jl) ) 260 CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, & 261 zs0e(:,:,layer,jl) , sxe (:,:,layer,jl) , & 262 sxxe(:,:,layer,jl) , sye (:,:,layer,jl) , & 263 syye(:,:,layer,jl) , sxye(:,:,layer,jl) ) 147 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 148 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 149 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 150 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 151 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 152 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 153 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 154 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 155 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 156 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 157 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 158 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 159 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 160 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 161 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 162 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 163 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 164 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 165 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 166 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 167 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 168 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 169 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 170 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 171 DO layer = 1, nlay_i !--- ice heat contents --- 172 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 173 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 174 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 175 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 176 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 177 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 264 178 END DO 265 179 END DO … … 267 181 ELSE 268 182 DO jk = 1, initad 269 !--- ice volume --- 270 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0ow (:,:) , sxopw (:,:) , & 271 sxxopw(:,:) , syopw (:,:) , & 272 syyopw(:,:) , sxyopw(:,:) ) 273 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0ow (:,:) , sxopw (:,:) , & 274 sxxopw(:,:) , syopw (:,:) , & 275 syyopw(:,:) , sxyopw(:,:) ) 183 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 184 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 185 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:), & 186 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 276 187 DO jl = 1, jpl 277 !--- ice volume --- 278 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , & 279 sxxice(:,:,jl) , syice (:,:,jl) , & 280 syyice(:,:,jl) , sxyice(:,:,jl) ) 281 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , & 282 sxxice(:,:,jl) , syice (:,:,jl) , & 283 syyice(:,:,jl) , sxyice(:,:,jl) ) 284 !--- snow volume --- 285 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0sn (:,:,jl) , sxsn (:,:,jl) , & 286 sxxsn (:,:,jl) , sysn (:,:,jl) , & 287 syysn (:,:,jl) , sxysn (:,:,jl) ) 288 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0sn (:,:,jl) , sxsn (:,:,jl) , & 289 sxxsn (:,:,jl) , sysn (:,:,jl) , & 290 syysn (:,:,jl) , sxysn (:,:,jl) ) 291 !--- ice salinity --- 292 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 293 sxxsal(:,:,jl) , sysal (:,:,jl) , & 294 syysal(:,:,jl) , sxysal(:,:,jl) ) 295 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 296 sxxsal(:,:,jl) , sysal (:,:,jl) , & 297 syysal(:,:,jl) , sxysal(:,:,jl) ) 298 !--- ice age --- 299 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 300 sxxage(:,:,jl) , syage (:,:,jl) , & 301 syyage(:,:,jl) , sxyage(:,:,jl) ) 302 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 303 sxxage(:,:,jl) , syage (:,:,jl) , & 304 syyage(:,:,jl) , sxyage(:,:,jl) ) 305 !--- ice concentration --- 306 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0a (:,:,jl) , sxa (:,:,jl) , & 307 sxxa (:,:,jl) , sya (:,:,jl) , & 308 syya (:,:,jl) , sxya (:,:,jl) ) 309 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0a (:,:,jl) , sxa (:,:,jl) , & 310 sxxa (:,:,jl) , sya (:,:,jl) , & 311 syya (:,:,jl) , sxya (:,:,jl) ) 312 !--- ice / snow thermal energetic contents --- 313 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0c0 (:,:,jl) , sxc0 (:,:,jl) , & 314 sxxc0 (:,:,jl) , syc0 (:,:,jl) , & 315 syyc0 (:,:,jl) , sxyc0 (:,:,jl) ) 316 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0c0 (:,:,jl) , sxc0 (:,:,jl) , & 317 sxxc0 (:,:,jl) , syc0 (:,:,jl) , & 318 syyc0 (:,:,jl) , sxyc0 (:,:,jl) ) 319 DO layer = 1, nlay_i 320 CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0e(:,:,layer,jl) , & 321 sxe (:,:,layer,jl) , sxxe (:,:,layer,jl) , sye (:,:,layer,jl) , & 322 syye (:,:,layer,jl), sxye (:,:,layer,jl) ) 323 CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0e(:,:,layer,jl) , & 324 sxe (:,:,layer,jl) , sxxe (:,:,layer,jl) , sye (:,:,layer,jl) , & 325 syye (:,:,layer,jl), sxye (:,:,layer,jl) ) 188 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 189 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 190 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 191 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 192 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 193 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 194 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 195 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 196 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 197 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 198 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 199 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 200 201 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 202 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 203 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 204 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 205 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 206 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 207 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a (:,:,jl), sxa (:,:,jl), & 208 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 209 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 210 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 211 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 212 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 213 DO layer = 1, nlay_i !--- ice heat contents --- 214 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 215 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 216 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 217 CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 218 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 219 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 326 220 END DO 327 328 221 END DO 329 222 END DO … … 333 226 ! Recover the properties from their contents 334 227 !------------------------------------------- 335 336 zs0ow (:,:) = zs0ow(:,:) / area(:,:) 228 zs0ow(:,:) = zs0ow(:,:) / area(:,:) 337 229 DO jl = 1, jpl 338 230 zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:) … … 351 243 !------------------------------------------------------------------------------! 352 244 245 !-------------------------------- 246 ! diffusion of open water area 247 !-------------------------------- 248 zs0at(:,:) = zs0a(:,:,1) ! total ice fraction 249 DO jl = 2, jpl 250 zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl) 251 END DO 252 ! 253 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 254 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 255 DO ji = 1 , fs_jpim1 ! vector opt. 256 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji ,jj) ) ) ) & 257 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 258 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj ) ) ) ) & 259 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 260 END DO 261 END DO 262 ! 263 CALL lim_hdf( zs0ow (:,:) ) ! Diffusion 264 353 265 !------------------------------------ 354 ! 4.1) diffusion of open water area266 ! Diffusion of other ice variables 355 267 !------------------------------------ 356 357 ! Compute total ice fraction 358 zs0at(:,:) = 0.0 359 DO jl = 1, jpl 360 DO jj = 1, jpj 361 DO ji = 1, jpi 362 zs0at (ji,jj) = zs0at(ji,jj) + zs0a(ji,jj,jl) ! 363 END DO 364 END DO 365 END DO 366 367 ! Masked eddy diffusivity coefficient at ocean U- and V-points 368 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 369 DO ji = 1 , fs_jpim1 ! vector opt. 370 pahu(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0at(ji ,jj) ) ) ) & 371 & * ( 1.0 - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 372 pahv(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0at(ji,jj ) ) ) ) & 373 & * ( 1.0 - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 374 END DO !jj 375 END DO ! ji 376 377 ! Diffusion 378 CALL lim_hdf( zs0ow (:,:) ) 379 380 !---------------------------------------- 381 ! 4.2) Diffusion of other ice variables 382 !---------------------------------------- 383 DO jl = 1, jpl 384 385 ! Masked eddy diffusivity coefficient at ocean U- and V-points 386 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 268 DO jl = 1, jpl 269 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 270 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 387 271 DO ji = 1 , fs_jpim1 ! vector opt. 388 pahu(ji,jj) = ( 1. 0- MAX( rzero, SIGN( rone, -zs0a(ji ,jj,jl) ) ) ) &389 & * ( 1. 0- MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)390 pahv(ji,jj) = ( 1. 0 - MAX( rzero, SIGN( rone, -zs0a(ji,jj,jl) ) ) ) &391 & * ( 1. 0- MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)392 END DO !jj393 END DO ! ji272 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji ,jj,jl) ) ) ) & 273 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 274 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj ,jl) ) ) ) & 275 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 276 END DO 277 END DO 394 278 395 279 CALL lim_hdf( zs0ice (:,:,jl) ) … … 401 285 DO jk = 1, nlay_i 402 286 CALL lim_hdf( zs0e (:,:,jk,jl) ) 403 END DO ! jk404 END DO !jl287 END DO 288 END DO 405 289 406 290 !----------------------------------------- 407 ! 4.3)Remultiply everything by ice area291 ! Remultiply everything by ice area 408 292 !----------------------------------------- 409 zs0ow(:,:) = MAX( rzero, zs0ow(:,:) * area(:,:) )293 zs0ow(:,:) = MAX( rzero, zs0ow(:,:) * area(:,:) ) 410 294 DO jl = 1, jpl 411 295 zs0ice(:,:,jl) = MAX( rzero, zs0ice(:,:,jl) * area(:,:) ) !!bug: est-ce utile … … 432 316 DO jj = 1, jpj 433 317 DO ji = 1, jpi 434 zs0e (ji,jj,jk,jl) = & 435 MAX( rzero, zs0e (ji,jj,jk,jl) / area(ji,jj) ) 318 zs0e(ji,jj,jk,jl) = MAX( rzero, zs0e(ji,jj,jk,jl) / area(ji,jj) ) 436 319 END DO 437 320 END DO … … 441 324 DO jj = 1, jpj 442 325 DO ji = 1, jpi 443 zs0ow 444 END DO 445 END DO 446 447 zs0at(:,:) = 0. 0326 zs0ow(ji,jj) = MAX( rzero, zs0ow (ji,jj) / area(ji,jj) ) 327 END DO 328 END DO 329 330 zs0at(:,:) = 0._wp 448 331 DO jl = 1, jpl 449 332 DO jj = 1, jpj … … 463 346 ! 5.2) Snow thickness, Ice thickness, Ice concentrations 464 347 !--------------------------------------------------------- 465 466 348 DO jj = 1, jpj 467 349 DO ji = 1, jpi 468 zindb = MAX( 0.0 , SIGN( 1.0, zs0at(ji,jj) - zeps10) ) 469 zs0ow(ji,jj) = (1.0 - zindb) + zindb*MAX( zs0ow(ji,jj), 0.00 ) 470 ato_i(ji,jj) = zs0ow(ji,jj) 471 END DO 472 END DO 473 474 ! Remove very small areas 475 DO jl = 1, jpl 350 zindb = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - zeps10) ) 351 zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 352 ato_i(ji,jj) = zs0ow(ji,jj) 353 END DO 354 END DO 355 356 DO jl = 1, jpl ! Remove very small areas 476 357 DO jj = 1, jpj 477 358 DO ji = 1, jpi 478 359 zindb = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - zeps10) ) 479 480 zs0a(ji,jj,jl) 481 v_s(ji,jj,jl) 482 v_i(ji,jj,jl) 483 484 zindsn 485 zindic 486 zindb 487 zs0a 488 a_i 489 v_s 490 v_i 360 ! 361 zs0a(ji,jj,jl) = zindb * MIN( zs0a(ji,jj,jl), 0.99 ) 362 v_s(ji,jj,jl) = zindb * zs0sn (ji,jj,jl) 363 v_i(ji,jj,jl) = zindb * zs0ice(ji,jj,jl) 364 ! 365 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - zeps10 ) ) 366 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) ) 367 zindb = MAX( zindsn, zindic ) 368 zs0a(ji,jj,jl) = zindb * zs0a(ji,jj,jl) !ice concentration 369 a_i (ji,jj,jl) = zs0a(ji,jj,jl) 370 v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 371 v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 491 372 END DO 492 373 END DO … … 495 376 DO jj = 1, jpj 496 377 DO ji = 1, jpi 497 zs0at(ji,jj) 378 zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) 498 379 END DO 499 380 END DO … … 503 384 !---------------------- 504 385 505 zbigval = 1.0d+13386 zbigval = 1.d+13 506 387 507 388 DO jl = 1, jpl … … 518 399 519 400 ! Ice salinity and age 520 zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj) , & 521 zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * & 522 v_i(ji,jj,jl) 401 zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj) , & 402 zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 523 403 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 524 404 smv_i(ji,jj,jl) = zindic*zsal + (1.0-zindic)*0.0 525 405 526 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / & 527 MAX( a_i(ji,jj,jl), epsi16 ) ), 0.0 ) * & 528 a_i(ji,jj,jl) 406 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / & 407 MAX( a_i(ji,jj,jl), epsi16 ) ), 0.0 ) * a_i(ji,jj,jl) 529 408 oa_i (ji,jj,jl) = zindic*zage 530 409 … … 583 462 END DO 584 463 ENDIF 585 464 ! 465 IF( wrk_not_released(2, 1,2,3,4,5) ) CALL ctl_stop('lim_trp_2 : failed to release workspace arrays') 466 ! 586 467 END SUBROUTINE lim_trp 587 588 589 SUBROUTINE lim_trp_init590 !!-------------------------------------------------------------------591 !! *** ROUTINE lim_trp_init ***592 !!593 !! ** Purpose : initialization of ice advection parameters594 !!595 !! ** Method : Read the namicetrp namelist and check the parameter596 !! values called at the first timestep (nit000)597 !!598 !! ** input : Namelist namicetrp599 !!600 !! history :601 !! 2.0 ! 03-08 (C. Ethe) Original code602 !!-------------------------------------------------------------------603 NAMELIST/namicetrp/ bound604 !!-------------------------------------------------------------------605 606 ! Read Namelist namicetrp607 REWIND ( numnam_ice )608 READ ( numnam_ice , namicetrp )609 IF(lwp) THEN610 WRITE(numout,*)611 WRITE(numout,*) 'lim_trp_init : Ice parameters for advection '612 WRITE(numout,*) '~~~~~~~~~~~~'613 WRITE(numout,*) ' boundary conditions (0.0 no-slip, 1.0 free-slip) bound = ', bound614 WRITE(numout,*)615 ENDIF616 617 END SUBROUTINE lim_trp_init618 468 619 469 #else -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90
r2528 r2715 2 2 !!====================================================================== 3 3 !! *** MODULE limupdate *** 4 !! Update of sea-ice global variables 5 !! at the end of the time step 6 !! 7 !! Ice speed from ice dynamics 8 !! Ice thickness, Snow thickness, Temperatures, Lead fraction 9 !! from advection and ice thermodynamics 4 !! LIM-3 : Update of sea-ice global variables at the end of the time step 10 5 !!====================================================================== 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !!---------------------------------------------------------------------- 11 8 #if defined key_lim3 12 9 !!---------------------------------------------------------------------- … … 16 13 !!---------------------------------------------------------------------- 17 14 USE limrhg ! ice rheology 18 USE lbclnk19 15 20 16 USE dom_oce … … 24 20 USE sbc_ice ! Surface boundary condition: ice fields 25 21 USE dom_ice 26 USE phycst ! Define parameters for the routines22 USE phycst ! physical constants 27 23 USE ice 28 USE lbclnk29 24 USE limdyn 30 25 USE limtrp … … 38 33 USE limitd_th 39 34 USE limvar 40 USE prtctl ! Print control41 35 USE prtctl ! Print control 36 USE lbclnk ! lateral boundary condition - MPP exchanges 42 37 43 38 IMPLICIT NONE 44 39 PRIVATE 45 40 46 !! * Accessibility 47 PUBLIC lim_update ! routine called by ice_step 48 41 PUBLIC lim_update ! routine called by ice_step 42 43 REAL(wp) :: epsi06 = 1.e-06_wp ! module constants 44 REAL(wp) :: epsi04 = 1.e-04_wp ! - - 45 REAL(wp) :: epsi03 = 1.e-03_wp ! - - 46 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 47 REAL(wp) :: epsi16 = 1.e-16_wp ! - - 48 REAL(wp) :: epsi20 = 1.e-20_wp ! - - 49 REAL(wp) :: rzero = 0._wp ! - - 50 REAL(wp) :: rone = 1._wp ! - - 51 49 52 !! * Substitutions 50 53 # include "vectopt_loop_substitute.h90" 51 52 54 !!---------------------------------------------------------------------- 53 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)55 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 54 56 !! $Id$ 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 58 !!---------------------------------------------------------------------- 57 58 59 CONTAINS 59 60 … … 67 68 !! This place is very important 68 69 !! 69 !! ** Method : Mathematical 70 !! ** Method : 71 !! Ice speed from ice dynamics 72 !! Ice thickness, Snow thickness, Temperatures, Lead fraction 73 !! from advection and ice thermodynamics 70 74 !! 71 75 !! ** Action : - 72 !!73 !! History : This routine was new for LIM 3.074 !! 3.0 ! 04-06 (M. Vancoppenolle) Tendencies75 76 !!--------------------------------------------------------------------- 76 !! * Local variables 77 INTEGER :: & 78 ji, jj, & ! geographical indices 79 jk, jl, jm ! layer, category and type indices 80 INTEGER :: & 81 jbnd1, jbnd2 82 INTEGER :: & 83 i_ice_switch 84 85 REAL(wp) :: & ! constant values 86 epsi06 = 1.e-06 , & 87 epsi03 = 1.e-03 , & 88 epsi16 = 1.e-16 , & 89 epsi20 = 1.e-20 , & 90 epsi04 = 1.e-04 , & 91 epsi10 = 1.e-10 , & 92 rzero = 0.e0 , & 93 rone = 1.e0 , & 94 zhimax ! maximum thickness tolerated for advection of 95 ! in an ice-free cell 96 REAL(wp) :: & ! dummy switches and arguments 97 zindb, zindsn, zindic, zacrith, & 98 zrtt, zindg, zh, zdvres, zviold, & 99 zbigvalue, zvsold, z_da_ex, zamax, & 100 z_prescr_hi, zat_i_old, & 101 ztmelts, ze_s 102 103 REAL(wp), DIMENSION(jpl) :: z_da_i, z_dv_i 104 105 LOGICAL, DIMENSION(jpi,jpj,jpl) :: & 106 internal_melt 107 108 INTEGER :: & 109 ind_im, layer ! indices for internal melt 110 REAL(wp), DIMENSION(jkmax) :: & 111 zthick0, zqm0 ! thickness of the layers and heat contents for 112 ! internal melt 113 REAL(wp) :: & 114 zweight, zesum 115 116 77 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 78 INTEGER :: jbnd1, jbnd2 79 INTEGER :: i_ice_switch 80 INTEGER :: ind_im, layer ! indices for internal melt 81 REAL(wp) :: zweight, zesum, zhimax, z_da_i, z_dv_i 82 REAL(wp) :: zindb, zindsn, zindic, zacrith 83 REAL(wp) :: zrtt, zindg, zh, zdvres, zviold 84 REAL(wp) :: zbigvalue, zvsold, z_da_ex, zamax 85 REAL(wp) :: z_prescr_hi, zat_i_old, ztmelts, ze_s 86 87 LOGICAL , DIMENSION(jpi,jpj,jpl) :: internal_melt 88 REAL(wp), DIMENSION(jkmax) :: zthick0, zqm0 ! thickness of the layers and heat contents for 117 89 !!------------------------------------------------------------------- 118 90 … … 139 111 ! Ice dynamics 140 112 !--------------------- 141 142 113 u_ice(:,:) = u_ice(:,:) + d_u_ice_dyn(:,:) 143 114 v_ice(:,:) = v_ice(:,:) + d_v_ice_dyn(:,:) … … 146 117 ! Update ice and snow volumes 147 118 !----------------------------- 148 149 DO jl = 1, jpl 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 153 v_i(ji,jj,jl) = v_i(ji,jj,jl) + d_v_i_trp(ji,jj,jl) & 154 + d_v_i_thd(ji,jj,jl) 155 v_s(ji,jj,jl) = v_s(ji,jj,jl) + d_v_s_trp(ji,jj,jl) & 156 + d_v_s_thd(ji,jj,jl) 157 END DO 158 END DO 119 DO jl = 1, jpl 120 v_i(:,:,jl) = v_i(:,:,jl) + d_v_i_trp(:,:,jl) + d_v_i_thd(:,:,jl) 121 v_s(:,:,jl) = v_s(:,:,jl) + d_v_s_trp(:,:,jl) + d_v_s_thd(:,:,jl) 159 122 END DO 160 123 … … 168 131 ! with negative advection, very pathological ) 169 132 ! (5) v_i (old) = 0; d_v_i_trp > 0 (advection of ice in a free-cell) 170 133 ! 171 134 DO jl = 1, jpl 172 135 DO jj = 1, jpj 173 136 DO ji = 1, jpi 174 137 patho_case(ji,jj,jl) = 1 175 IF 138 IF( v_i(ji,jj,jl) .GE. 0.0 ) THEN 176 139 IF ( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN 177 140 patho_case(ji,jj,jl) = 2 … … 179 142 ELSE 180 143 patho_case(ji,jj,jl) = 3 181 IF 144 IF( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN 182 145 patho_case(ji,jj,jl) = 4 183 146 ENDIF 184 147 ENDIF 185 IF 186 ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN148 IF( ( old_v_i(ji,jj,jl) .LE. epsi10 ) .AND. & 149 ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN 187 150 patho_case(ji,jj,jl) = 5 ! advection of ice in an ice-free 188 151 ! cell … … 229 192 v_i(ji,jj,jl) = zindic*v_i(ji,jj,jl) !ice volume cannot be negative 230 193 !correct thermodynamic ablation 231 d_v_i_thd(ji,jj,jl) = zindic * d_v_i_thd(ji,jj,jl) + & 232 (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl)) 194 d_v_i_thd(ji,jj,jl) = zindic * d_v_i_thd(ji,jj,jl) + (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl)) 233 195 ! THIS IS NEW 234 196 d_a_i_thd(ji,jj,jl) = zindic * d_a_i_thd(ji,jj,jl) + & … … 252 214 253 215 !residual salt flux if snow is over-molten 254 fsalt_res(ji,jj) = fsalt_res(ji,jj) + sss_m(ji,jj) * & 255 ( rhosn * zdvres / rdt_ice ) 216 fsalt_res(ji,jj) = fsalt_res(ji,jj) + sss_m(ji,jj) * ( rhosn * zdvres / rdt_ice ) 256 217 !this flux will be positive if snow was over-molten 257 218 ! fheat_res(ji,jj) = fheat_res(ji,jj) + rhosn * lfus * zdvres / rdt_ice … … 288 249 !--------------------------------------------- 289 250 290 a_i (:,:,:) = a_i (:,:,:) + d_a_i_trp(:,:,:) & 291 + d_a_i_thd(:,:,:) 292 CALL lim_var_glo2eqv ! useless, just for debug 251 a_i (:,:,:) = a_i (:,:,:) + d_a_i_trp(:,:,:) + d_a_i_thd(:,:,:) 252 CALL lim_var_glo2eqv ! useless, just for debug 293 253 IF( ln_nicep ) THEN 294 254 DO jk = 1, nlay_i … … 297 257 ENDIF 298 258 e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_trp(:,:,:,:) 299 CALL lim_var_glo2eqv ! useless, just for debug259 CALL lim_var_glo2eqv ! useless, just for debug 300 260 IF( ln_nicep) THEN 301 WRITE(numout,*) ' After transport update '261 WRITE(numout,*) ' After transport update ' 302 262 DO jk = 1, nlay_i 303 263 WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) … … 313 273 ENDIF 314 274 315 at_i(:,:) = 0. 0275 at_i(:,:) = 0._wp 316 276 DO jl = 1, jpl 317 277 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) … … 335 295 ! Snow temperature and ice age 336 296 !------------------------------ 337 338 e_s(:,:,:,:) = e_s(:,:,:,:) + & 339 d_e_s_trp(:,:,:,:) + & 340 d_e_s_thd(:,:,:,:) 341 342 oa_i(:,:,:) = oa_i(:,:,:) + & 343 d_oa_i_trp(:,:,:) + & 344 d_oa_i_thd(:,:,:) 297 e_s (:,:,:,:) = e_s (:,:,:,:) + d_e_s_trp (:,:,:,:) + d_e_s_thd (:,:,:,:) 298 oa_i(:,:,:) = oa_i(:,:,:) + d_oa_i_trp(:,:,:) + d_oa_i_thd(:,:,:) 345 299 346 300 !-------------- … … 348 302 !-------------- 349 303 350 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN! general case351 304 IF( num_sal == 2 .OR. num_sal == 4 ) THEN ! general case 305 ! 352 306 IF( ln_nicep ) THEN 353 307 WRITE(numout,*) ' Before everything ' … … 360 314 ENDIF 361 315 362 smv_i(:,:,:) = smv_i(:,:,:) + & 363 d_smv_i_thd(:,:,:) + & 364 d_smv_i_trp(:,:,:) 365 316 smv_i(:,:,:) = smv_i(:,:,:) + d_smv_i_thd(:,:,:) + d_smv_i_trp(:,:,:) 317 ! 366 318 IF( ln_nicep ) THEN 367 319 WRITE(numout,*) ' After advection ' … … 369 321 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 370 322 ENDIF 371 372 ENDIF ! num_sal .EQ. 2323 ! 324 ENDIF 373 325 374 326 CALL lim_var_glo2eqv … … 377 329 ! 2. Review of all pathological cases 378 330 !-------------------------------------- 379 380 zrtt = 173.15 * rone 381 zacrith = 1.0e-6 331 zrtt = 173.15_wp * rone 332 zacrith = 1.e-6_wp 382 333 383 334 !------------------------------------------- … … 386 337 ! should be removed since it is treated after dynamics now 387 338 388 zhimax = 5. 0339 zhimax = 5._wp 389 340 ! first category 390 341 DO jj = 1, jpj … … 416 367 417 368 !change this 14h44 418 zhimax = 20.0 ! line added up369 zhimax = 20.0 ! line added up 419 370 ! change this also 17 aug 420 zhimax = 30.0 ! line added up371 zhimax = 30.0 ! line added up 421 372 422 373 DO jl = 2, jpl … … 435 386 .AND.(v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl),epsi10)*zindb).GT.zhimax ) THEN 436 387 z_prescr_hi = ( hi_max_typ(jl-ice_cat_bounds(jm,1) ,jm) + & 437 hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) / & 438 2.0 439 a_i(ji,jj,jl) = v_i(ji,jj,jl) / z_prescr_hi 388 hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) / 2.0 389 a_i (ji,jj,jl) = v_i(ji,jj,jl) / z_prescr_hi 440 390 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 441 391 ENDIF … … 458 408 ENDIF 459 409 460 at_i(:,:) = 0. 0410 at_i(:,:) = 0._wp 461 411 DO jl = 1, jpl 462 412 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) … … 481 431 jbnd1 = ice_cat_bounds(jm,1) 482 432 jbnd2 = ice_cat_bounds(jm,2) 483 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm)433 IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 484 434 END DO 485 435 … … 498 448 ENDIF 499 449 500 at_i(:,:) = 0. 0450 at_i(:,:) = 0._wp 501 451 DO jl = 1, jpl 502 452 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) … … 531 481 DO jj = 1, jpj 532 482 DO ji = 1, jpi 533 IF 483 IF( internal_melt(ji,jj,jl) ) THEN 534 484 ! initial ice thickness 535 485 !----------------------- … … 852 802 ! 2.13.2) Total ice concentration cannot exceed zamax 853 803 !---------------------------------------------------- 854 at_i(:,:) = 0.0855 DO jl = 1, jpl804 at_i(:,:) = a_i(:,:,1) 805 DO jl = 2, jpl 856 806 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 857 807 END DO … … 867 817 zindb = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi03 ) ) 868 818 zindb = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) ) ) 869 z_da_i(jl) = a_i(ji,jj,jl)*zindb*z_da_ex/MAX(at_i(ji,jj),epsi06) 870 z_dv_i(jl) = v_i(ji,jj,jl)*z_da_i(jl)/MAX(at_i(ji,jj),epsi06) 871 a_i(ji,jj,jl) = a_i(ji,jj,jl) - z_da_i(jl) 872 v_i(ji,jj,jl) = v_i(ji,jj,jl) + z_dv_i(jl) 873 819 z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi06 ) * zindb 820 z_dv_i = v_i(ji,jj,jl) * z_da_i / MAX( at_i(ji,jj), epsi06 ) 821 a_i(ji,jj,jl) = a_i(ji,jj,jl) - z_da_i 822 v_i(ji,jj,jl) = v_i(ji,jj,jl) + z_dv_i 874 823 END DO 875 824 … … 879 828 IF( ln_nicep ) THEN 880 829 WRITE(numout,*) ' 2.13 ' 881 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 882 WRITE(numout,*) ' at_i ', at_i(jiindx,jjindx) 883 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 884 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 885 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 886 ENDIF 887 888 at_i(:,:) = 0.0 889 DO jl = 1, jpl 830 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl), ' at_i ', at_i(jiindx,jjindx) 831 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl), ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 832 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 833 ENDIF 834 835 at_i(:,:) = a_i(:,:,1) 836 DO jl = 2, jpl 890 837 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 891 838 END DO … … 941 888 ENDIF 942 889 943 at_i(:,:) = 0.0944 DO jl = 1, jpl890 at_i(:,:) = a_i(:,:,1) 891 DO jl = 2, jpl 945 892 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 946 893 END DO … … 951 898 ! Ice drift 952 899 !------------ 953 954 900 DO jj = 2, jpjm1 955 901 DO ji = fs_2, fs_jpim1 … … 976 922 DO jj = 1, jpj 977 923 DO ji = 1, jpi 978 DO jl = 1, jpl979 ! IF ((v_i(ji,jj,jl).NE.0.0).AND.(a_i(ji,jj,jl).EQ.0.0)) THEN980 ! WRITE(numout,*) ' lim_update : incompatible volume and concentration '981 END DO ! jl982 983 924 DO jl = 1, jpl 984 925 IF ( (a_i(ji,jj,jl).GT.1.0).OR.(at_i(ji,jj).GT.1.0) ) THEN -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r2528 r2715 1 1 MODULE limvar 2 !!----------------------------------------------------------------------3 !! 'key_lim3' LIM3 sea-ice model4 !!----------------------------------------------------------------------5 2 !!====================================================================== 6 3 !! *** MODULE limvar *** … … 32 29 !! - ot_i(jpi,jpj) !average ice age 33 30 !!====================================================================== 31 !! History : - ! 2006-01 (M. Vancoppenolle) Original code 32 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 33 !!---------------------------------------------------------------------- 34 34 #if defined key_lim3 35 35 !!---------------------------------------------------------------------- 36 !! * Modules used 37 USE dom_ice 36 !! 'key_lim3' LIM3 sea-ice model 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 !!---------------------------------------------------------------------- 38 45 USE par_oce ! ocean parameters 39 46 USE phycst ! physical constants (ocean directory) 40 47 USE sbc_oce ! Surface boundary condition: ocean fields 41 USE thd_ice 42 USE in_out_manager 43 USE ice 44 USE par_ice 48 USE ice ! LIM variables 49 USE par_ice ! LIM parameters 50 USE dom_ice ! LIM domain 51 USE thd_ice ! LIM thermodynamics 52 USE wrk_nemo ! workspace manager 53 USE in_out_manager ! I/O manager 54 USE lib_mpp ! MPP library 45 55 46 56 IMPLICIT NONE 47 57 PRIVATE 48 58 49 !! * Routine accessibility50 PUBLIC lim_var_agg51 PUBLIC lim_var_glo2eqv52 PUBLIC lim_var_eqv2glo53 PUBLIC lim_var_salprof54 PUBLIC lim_var_bv55 PUBLIC lim_var_salprof1d 56 57 !! * Module variables58 REAL(wp) :: & ! constant values59 epsi20 = 1e-20 , &60 epsi13 = 1e-13 , &61 zzero = 0.e0 , &62 zone = 1.e063 64 !!---------------------------------------------------------------------- 65 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)59 PUBLIC lim_var_agg ! 60 PUBLIC lim_var_glo2eqv ! 61 PUBLIC lim_var_eqv2glo ! 62 PUBLIC lim_var_salprof ! 63 PUBLIC lim_var_bv ! 64 PUBLIC lim_var_salprof1d ! 65 66 REAL(wp) :: eps20 = 1.e-20_wp ! module constants 67 REAL(wp) :: eps16 = 1.e-16_wp ! - - 68 REAL(wp) :: eps13 = 1.e-13_wp ! - - 69 REAL(wp) :: eps10 = 1.e-10_wp ! - - 70 REAL(wp) :: eps06 = 1.e-06_wp ! - - 71 REAL(wp) :: zzero = 0.e0 ! - - 72 REAL(wp) :: zone = 1.e0 ! - - 73 74 !!---------------------------------------------------------------------- 75 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 66 76 !! $Id$ 67 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 68 !!---------------------------------------------------------------------- 69 70 77 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 78 !!---------------------------------------------------------------------- 71 79 CONTAINS 72 80 73 SUBROUTINE lim_var_agg( n)81 SUBROUTINE lim_var_agg( kn ) 74 82 !!------------------------------------------------------------------ 75 83 !! *** ROUTINE lim_var_agg *** 76 !! ** Purpose : 77 !! This routine aggregates ice-thickness-category variables to 78 !! all-ice variables 79 !! i.e. it turns VGLO into VAGG 84 !! 85 !! ** Purpose : aggregates ice-thickness-category variables to all-ice variables 86 !! i.e. it turns VGLO into VAGG 80 87 !! ** Method : 81 88 !! 82 !! ** Arguments :83 !! kideb , kiut : Starting and ending points on which the84 !! the computation is applied85 !!86 !! ** Inputs / Ouputs : (global commons)87 89 !! ** Arguments : n = 1, at_i vt_i only 88 90 !! n = 2 everything 89 91 !! 90 !! ** External :91 !!92 !! ** References :93 !!94 !! ** History :95 !! (01-2006) Martin Vancoppenolle, UCL-ASTR96 !!97 92 !! note : you could add an argument when you need only at_i, vt_i 98 93 !! and when you need everything 99 94 !!------------------------------------------------------------------ 100 !! * Arguments 101 102 !! * Local variables 103 INTEGER :: ji, & ! spatial dummy loop index 104 jj, & ! spatial dummy loop index 105 jk, & ! vertical layering dummy loop index 106 jl ! ice category dummy loop index 107 108 REAL :: zeps, epsi16, zinda, epsi06 109 110 INTEGER, INTENT( in ) :: n ! describes what is needed 111 112 !!-- End of declarations 113 !!---------------------------------------------------------------------------------------------- 114 zeps = 1.0e-13 115 epsi16 = 1.0e-16 116 epsi06 = 1.0e-6 117 118 !------------------ 119 ! Zero everything 120 !------------------ 121 122 vt_i(:,:) = 0.0 123 vt_s(:,:) = 0.0 124 at_i(:,:) = 0.0 125 ato_i(:,:) = 1.0 126 127 IF ( n .GT. 1 ) THEN 128 et_s(:,:) = 0.0 129 ot_i(:,:) = 0.0 130 smt_i(:,:) = 0.0 131 et_i(:,:) = 0.0 132 ENDIF 95 INTEGER, INTENT( in ) :: kn ! =1 at_i & vt only ; = what is needed 96 ! 97 INTEGER :: ji, jj, jk, jl ! dummy loop indices 98 REAL(wp) :: zinda 99 !!------------------------------------------------------------------ 133 100 134 101 !-------------------- 135 102 ! Compute variables 136 103 !-------------------- 137 104 vt_i (:,:) = 0._wp 105 vt_s (:,:) = 0._wp 106 at_i (:,:) = 0._wp 107 ato_i(:,:) = 1._wp 108 ! 138 109 DO jl = 1, jpl 139 110 DO jj = 1, jpj 140 111 DO ji = 1, jpi 141 112 ! 142 113 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 143 114 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 144 115 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 145 116 ! 146 117 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 147 icethi(ji,jj) = vt_i(ji,jj) / MAX(at_i(ji,jj),epsi16)*zinda 148 ! ice thickness 118 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , eps16 ) * zinda ! ice thickness 149 119 END DO 150 120 END DO … … 153 123 DO jj = 1, jpj 154 124 DO ji = 1, jpi 155 ato_i(ji,jj) = MAX(1.0 - at_i(ji,jj), 0.0) ! open water fraction 156 END DO 157 END DO 158 159 IF ( n .GT. 1 ) THEN 160 125 ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) ! open water fraction 126 END DO 127 END DO 128 129 IF( kn > 1 ) THEN 130 et_s (:,:) = 0._wp 131 ot_i (:,:) = 0._wp 132 smt_i(:,:) = 0._wp 133 et_i (:,:) = 0._wp 134 ! 161 135 DO jl = 1, jpl 162 136 DO jj = 1, jpj 163 137 DO ji = 1, jpi 164 et_s(ji,jj) = et_s(ji,jj) + & ! snow heat content 165 e_s(ji,jj,1,jl) 138 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 166 139 zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - 0.10 ) ) 167 smt_i(ji,jj) = smt_i(ji,jj) + & ! ice salinity 168 smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , zeps ) * & 169 zinda 140 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , eps13 ) * zinda ! ice salinity 170 141 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 171 ot_i(ji,jj) = ot_i(ji,jj) + & ! ice age 172 oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , zeps ) * & 173 zinda 174 END DO 175 END DO 176 END DO 177 142 ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , eps13 ) * zinda ! ice age 143 END DO 144 END DO 145 END DO 146 ! 178 147 DO jl = 1, jpl 179 148 DO jk = 1, nlay_i 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 et_i(ji,jj) = et_i(ji,jj) + e_i(ji,jj,jk,jl) ! ice heat 183 ! content 184 END DO 185 END DO 186 END DO 187 END DO 188 189 ENDIF ! n .GT. 1 190 149 et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl) ! ice heat content 150 END DO 151 END DO 152 ! 153 ENDIF 154 ! 191 155 END SUBROUTINE lim_var_agg 192 156 193 !==============================================================================194 157 195 158 SUBROUTINE lim_var_glo2eqv 196 159 !!------------------------------------------------------------------ 197 !! *** ROUTINE lim_var_glo2eqv ***' 198 !! ** Purpose : 199 !! This routine computes equivalent variables as function of 200 !! global variables 201 !! i.e. it turns VGLO into VEQV 202 !! ** Method : 203 !! 204 !! ** Arguments : 205 !! kideb , kiut : Starting and ending points on which the 206 !! the computation is applied 207 !! 208 !! ** Inputs / Ouputs : 209 !! 210 !! ** External : 211 !! 212 !! ** References : 213 !! 214 !! ** History : 215 !! (01-2006) Martin Vancoppenolle, UCL-ASTR 216 !! 217 !!------------------------------------------------------------------ 218 219 !! * Local variables 220 INTEGER :: ji, & ! spatial dummy loop index 221 jj, & ! spatial dummy loop index 222 jk, & ! vertical layering dummy loop index 223 jl ! ice category dummy loop index 224 225 REAL :: zq_i, zaaa, zbbb, zccc, zdiscrim, & 226 ztmelts, zindb, zq_s, zfac1, zfac2 227 228 REAL :: zeps, epsi06 229 230 zeps = 1.0e-10 231 epsi06 = 1.0e-06 232 233 !!-- End of declarations 234 !!------------------------------------------------------------------------------ 160 !! *** ROUTINE lim_var_glo2eqv *** 161 !! 162 !! ** Purpose : computes equivalent variables as function of global variables 163 !! i.e. it turns VGLO into VEQV 164 !!------------------------------------------------------------------ 165 INTEGER :: ji, jj, jk, jl ! dummy loop indices 166 REAL(wp) :: zq_i, zaaa, zbbb, zccc, zdiscrim ! local scalars 167 REAL(wp) :: ztmelts, zindb, zq_s, zfac1, zfac2 ! - - 168 !!------------------------------------------------------------------ 235 169 236 170 !------------------------------------------------------- 237 171 ! Ice thickness, snow thickness, ice salinity, ice age 238 172 !------------------------------------------------------- 239 !CDIR NOVERRCHK240 173 DO jl = 1, jpl 241 !CDIR NOVERRCHK242 174 DO jj = 1, jpj 243 !CDIR NOVERRCHK244 175 DO ji = 1, jpi 245 zindb = 1.0-MAX(0.0,SIGN(1.0,- a_i(ji,jj,jl))) !0 if no ice and 1 if yes 246 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , zeps ) * zindb 247 ht_s(ji,jj,jl) = v_s(ji,jj,jl) / MAX( a_i(ji,jj,jl) , zeps ) * zindb 248 o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , zeps ) * zindb 249 END DO 250 END DO 251 END DO 252 253 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) )THEN 254 255 !CDIR NOVERRCHK 176 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) ) !0 if no ice and 1 if yes 177 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 178 ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 179 o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 180 END DO 181 END DO 182 END DO 183 184 IF( num_sal == 2 .OR. num_sal == 4 )THEN 256 185 DO jl = 1, jpl 257 !CDIR NOVERRCHK 258 DO jj = 1, jpj 259 !CDIR NOVERRCHK 260 DO ji = 1, jpi 261 zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 262 sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX(v_i(ji,jj,jl),zeps) * zindb 263 END DO 264 END DO 265 END DO 266 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) ) !0 if no ice and 1 if yes 189 sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , eps10 ) * zindb 190 END DO 191 END DO 192 END DO 267 193 ENDIF 268 194 269 ! salinity profile 270 CALL lim_var_salprof 195 CALL lim_var_salprof ! salinity profile 271 196 272 197 !------------------- … … 281 206 !CDIR NOVERRCHK 282 207 DO ji = 1, jpi 283 !Energy of melting q(S,T) [J.m-3] 284 zq_i = e_i(ji,jj,jk,jl) / area(ji,jj) / & 285 MAX( v_i(ji,jj,jl) , epsi06 ) * nlay_i 286 ! zindb = 0 if no ice and 1 if yes 287 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) ) 288 !convert units ! very important that this line is here 289 zq_i = zq_i * unit_fac * zindb 290 !Ice layer melt temperature 291 ztmelts = -tmut*s_i(ji,jj,jk,jl) + rtt 292 !Conversion q(S,T) -> T (second order equation) 293 zaaa = cpic 294 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + & 295 zq_i / rhoic - lfus 208 ! ! Energy of melting q(S,T) [J.m-3] 209 zq_i = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , eps06 ) * REAL(nlay_i,wp) 210 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) ) ! zindb = 0 if no ice and 1 if yes 211 zq_i = zq_i * unit_fac * zindb !convert units 212 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature 213 ! 214 zaaa = cpic ! Conversion q(S,T) -> T (second order equation) 215 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus 296 216 zccc = lfus * (ztmelts-rtt) 297 zdiscrim = SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 298 t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / & 299 ( 2.0 *zaaa ) 300 t_i(ji,jj,jk,jl) = MIN( rtt, MAX(173.15, t_i(ji,jj,jk,jl) ) ) 217 zdiscrim = SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 218 t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 219 t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt 301 220 END DO 302 221 END DO … … 307 226 ! Snow temperatures 308 227 !-------------------- 309 zfac1 = 1. / ( rhosn * cpic )228 zfac1 = 1._wp / ( rhosn * cpic ) 310 229 zfac2 = lfus / cpic 311 !CDIR NOVERRCHK312 230 DO jl = 1, jpl 313 !CDIR NOVERRCHK314 231 DO jk = 1, nlay_s 315 !CDIR NOVERRCHK 316 DO jj = 1, jpj 317 !CDIR NOVERRCHK 232 DO jj = 1, jpj 318 233 DO ji = 1, jpi 319 234 !Energy of melting q(S,T) [J.m-3] 320 zq_s = e_s(ji,jj,jk,jl) / area(ji,jj) / & 321 MAX( v_s(ji,jj,jl) , epsi06 ) * nlay_s 322 ! zindb = 0 if no ice and 1 if yes 323 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) ) ) 324 !convert units ! very important that this line is here 325 zq_s = zq_s * unit_fac * zindb 235 zq_s = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , eps06 ) ) * REAL(nlay_s,wp) 236 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) ) ) ! zindb = 0 if no ice and 1 if yes 237 zq_s = zq_s * unit_fac * zindb ! convert units 238 ! 326 239 t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 327 t_s(ji,jj,jk,jl) = MIN( rtt, MAX(173.15, t_s(ji,jj,jk,jl) ) ) 328 240 t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt 329 241 END DO 330 242 END DO … … 335 247 ! Mean temperature 336 248 !------------------- 337 tm_i(:,:) = 0.0 338 !CDIR NOVERRCHK 249 tm_i(:,:) = 0._wp 339 250 DO jl = 1, jpl 340 !CDIR NOVERRCHK341 251 DO jk = 1, nlay_i 342 !CDIR NOVERRCHK 343 DO jj = 1, jpj 344 !CDIR NOVERRCHK 345 DO ji = 1, jpi 346 zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) 347 zindb = zindb*1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 348 tm_i(ji,jj) = tm_i(ji,jj) + t_i(ji,jj,jk,jl)*v_i(ji,jj,jl) / & 349 REAL(nlay_i) / MAX( vt_i(ji,jj) , zeps ) 350 END DO 351 END DO 352 END DO 353 END DO 354 252 DO jj = 1, jpj 253 DO ji = 1, jpi 254 zindb = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , -a_i(ji,jj,jl) ) ) ) & 255 & * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) ) ) ) 256 tm_i(ji,jj) = tm_i(ji,jj) + t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) & 257 & / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , eps10 ) ) 258 END DO 259 END DO 260 END DO 261 END DO 262 ! 355 263 END SUBROUTINE lim_var_glo2eqv 356 264 357 !===============================================================================358 265 359 266 SUBROUTINE lim_var_eqv2glo 360 267 !!------------------------------------------------------------------ 361 !! *** ROUTINE lim_var_eqv2glo ***' 362 !! ** Purpose : 363 !! This routine computes global variables as function of 364 !! equivalent variables 365 !! i.e. it turns VEQV into VGLO 268 !! *** ROUTINE lim_var_eqv2glo *** 269 !! 270 !! ** Purpose : computes global variables as function of equivalent variables 271 !! i.e. it turns VEQV into VGLO 366 272 !! ** Method : 367 273 !! 368 !! ** Arguments : 369 !! 370 !! ** Inputs / Ouputs : (global commons) 371 !! 372 !! ** External : 373 !! 374 !! ** References : 375 !! 376 !! ** History : 377 !! (01-2006) Martin Vancoppenolle, UCL-ASTR 378 !! Take it easy man 379 !! Life is just a simple game, between 380 !! ups / and downs \ :@) 381 !! 382 !!------------------------------------------------------------------ 383 274 !! ** History : (01-2006) Martin Vancoppenolle, UCL-ASTR 275 !!------------------------------------------------------------------ 276 ! 384 277 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:) 385 278 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) 386 279 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 387 280 oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:) 388 281 ! 389 282 END SUBROUTINE lim_var_eqv2glo 390 283 391 !===============================================================================392 284 393 285 SUBROUTINE lim_var_salprof 394 286 !!------------------------------------------------------------------ 395 !! *** ROUTINE lim_var_salprof ***' 396 !! ** Purpose : 397 !! This routine computes salinity profile in function of 398 !! bulk salinity 287 !! *** ROUTINE lim_var_salprof *** 288 !! 289 !! ** Purpose : computes salinity profile in function of bulk salinity 399 290 !! 400 291 !! ** Method : If bulk salinity greater than s_i_1, … … 406 297 !! 407 298 !! ** References : Vancoppenolle et al., 2007 (in preparation) 408 !! 409 !! ** History : 410 !! (08-2006) Martin Vancoppenolle, UCL-ASTR 411 !! Take it easy man 412 !! Life is just a simple game, between ups 413 !! / and downs \ :@) 414 !! 415 !!------------------------------------------------------------------ 416 !! * Arguments 417 418 !! * Local variables 419 INTEGER :: & 420 ji , & !: spatial dummy loop index 421 jj , & !: spatial dummy loop index 422 jk , & !: vertical layering dummy loop index 423 jl !: ice category dummy loop index 424 425 REAL(wp) :: & 426 dummy_fac0 , & !: dummy factor used in computations 427 dummy_fac1 , & !: dummy factor used in computations 428 dummy_fac , & !: dummy factor used in computations 429 zind0 , & !: switch, = 1 if sm_i lt s_i_0 430 zind01 , & !: switch, = 1 if sm_i between s_i_0 and s_i_1 431 zindbal , & !: switch, = 1, if 2*sm_i gt sss_m 432 zargtemp !: dummy factor 433 434 REAL(wp), DIMENSION(nlay_i) :: & 435 zs_zero !: linear salinity profile for salinities under 436 !: s_i_0 437 438 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 439 z_slope_s , & !: slope of the salinity profile 440 zalpha !: weight factor for s between s_i_0 and s_i_1 441 442 !!-- End of declarations 443 !!------------------------------------------------------------------------------ 299 !!------------------------------------------------------------------ 300 INTEGER :: ji, jj, jk, jl ! dummy loop index 301 REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac, zsal ! local scalar 302 REAL(wp) :: zind0, zind01, zindbal, zargtemp , zs_zero ! - - 303 ! 304 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha ! 3D pointer 305 !!------------------------------------------------------------------ 306 307 IF( wrk_in_use( 2, 1,2 ) ) THEN 308 CALL ctl_stop( 'lim_var_salprof: requested workspace arrays unavailable' ) ; RETURN 309 END IF 310 311 z_slope_s => wrk_3d_1(:,:,1:jpl) ! slope of the salinity profile 312 zalpha => wrk_3d_2(:,:,1:jpl) ! weight factor for s between s_i_0 and s_i_1 444 313 445 314 !--------------------------------------- 446 315 ! Vertically constant, constant in time 447 316 !--------------------------------------- 448 449 IF ( num_sal .EQ. 1 ) THEN 450 451 s_i(:,:,:,:) = bulk_sal 452 453 ENDIF 317 IF( num_sal == 1 ) s_i(:,:,:,:) = bulk_sal 454 318 455 319 !----------------------------------- … … 457 321 !----------------------------------- 458 322 459 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) )THEN460 323 IF( num_sal == 2 .OR. num_sal == 4 ) THEN 324 ! 461 325 DO jk = 1, nlay_i 462 326 s_i(:,:,jk,:) = sm_i(:,:,:) 463 END DO ! jk 464 465 ! Slope of the linear profile zs_zero 466 !------------------------------------- 327 END DO 328 ! 329 DO jl = 1, jpl ! Slope of the linear profile 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01 , ht_i(ji,jj,jl) ) 333 END DO 334 END DO 335 END DO 336 ! 337 dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) ! Weighting factor between zs_zero and zs_inf 338 dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 339 340 zalpha(:,:,:) = 0._wp 467 341 DO jl = 1, jpl 468 342 DO jj = 1, jpj 469 DO ji = 1, jpi470 z_slope_s(ji,jj,jl) = 2.0 * sm_i(ji,jj,jl) / MAX( 0.01 &471 , ht_i(ji,jj,jl) )472 END DO ! ji473 END DO ! jj474 END DO ! jl475 476 ! Weighting factor between zs_zero and zs_inf477 !---------------------------------------------478 dummy_fac0 = 1. / ( ( s_i_0 - s_i_1 ) )479 dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )480 481 zalpha(:,:,:) = 0.0482 483 !CDIR NOVERRCHK484 DO jl = 1, jpl485 !CDIR NOVERRCHK486 DO jj = 1, jpj487 !CDIR NOVERRCHK488 343 DO ji = 1, jpi 489 344 ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 490 345 zind0 = MAX( 0.0 , SIGN( 1.0 , s_i_0 - sm_i(ji,jj,jl) ) ) 491 346 ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 492 zind01 = ( 1.0 - zind0 ) * & 493 MAX( 0.0 , SIGN( 1.0 , s_i_1 - sm_i(ji,jj,jl) ) ) 347 zind01 = ( 1.0 - zind0 ) * MAX( 0.0 , SIGN( 1.0 , s_i_1 - sm_i(ji,jj,jl) ) ) 494 348 ! If 2.sm_i GE sss_m then zindbal = 1 495 zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) - & 496 sss_m(ji,jj) ) ) 497 zalpha(ji,jj,jl) = zind0 * 1.0 & 498 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + & 499 dummy_fac1 ) 349 zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 350 zalpha(ji,jj,jl) = zind0 * 1.0 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 500 351 zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1.0 - zindbal ) 501 352 END DO … … 503 354 END DO 504 355 505 ! Computation of the profile 506 !---------------------------- 507 dummy_fac = 1. / nlay_i 508 356 dummy_fac = 1._wp / nlay_i ! Computation of the profile 509 357 DO jl = 1, jpl 510 358 DO jk = 1, nlay_i 511 359 DO jj = 1, jpj 512 360 DO ji = 1, jpi 513 ! linear profile with 0 at the surface 514 zs_zero(jk) = z_slope_s(ji,jj,jl) * ( jk - 1./2. ) * & 515 ht_i(ji,jj,jl) * dummy_fac 516 ! weighting the profile 517 s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero(jk) + & 518 ( 1.0 - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 361 ! ! linear profile with 0 at the surface 362 zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac 363 ! ! weighting the profile 364 s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 519 365 END DO ! ji 520 366 END DO ! jj … … 527 373 ! Vertically varying salinity profile, constant in time 528 374 !------------------------------------------------------- 529 ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 530 531 IF ( num_sal .EQ. 3 ) THEN 532 533 sm_i(:,:,:) = 2.30 534 535 !CDIR NOVERRCHK 375 376 IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 377 ! 378 sm_i(:,:,:) = 2.30_wp 379 ! 536 380 DO jl = 1, jpl 537 381 !CDIR NOVERRCHK 538 382 DO jk = 1, nlay_i 539 !CDIR NOVERRCHK 540 DO jj = 1, jpj 541 !CDIR NOVERRCHK 542 DO ji = 1, jpi 543 zargtemp = ( jk - 0.5 ) / nlay_i 544 s_i(ji,jj,jk,jl) = 1.6 - 1.6 * COS( 3.14169265 * & 545 ( zargtemp**(0.407/ & 546 ( 0.573 + zargtemp ) ) ) ) 547 END DO ! ji 548 END DO ! jj 549 END DO ! jk 550 END DO ! jl 383 zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 384 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 385 s_i(:,:,jk,jl) = zsal 386 END DO 387 END DO 551 388 552 389 ENDIF ! num_sal 553 390 ! 391 IF( wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_var_salprof: failed to release workspace arrays.') 392 ! 554 393 END SUBROUTINE lim_var_salprof 555 394 556 !===============================================================================557 395 558 396 SUBROUTINE lim_var_bv 559 397 !!------------------------------------------------------------------ 560 !! *** ROUTINE lim_var_bv *** '561 !! ** Purpose :562 !! This routinecomputes mean brine volume (%) in sea ice398 !! *** ROUTINE lim_var_bv *** 399 !! 400 !! ** Purpose : computes mean brine volume (%) in sea ice 563 401 !! 564 402 !! ** Method : e = - 0.054 * S (ppt) / T (C) 565 403 !! 566 !! ** Arguments : 567 !! 568 !! ** Inputs / Ouputs : (global commons) 569 !! 570 !! ** External : 571 !! 572 !! ** References : Vancoppenolle et al., JGR, 2007 573 !! 574 !! ** History : 575 !! (08-2006) Martin Vancoppenolle, UCL-ASTR 576 !! 577 !!------------------------------------------------------------------ 578 !! * Arguments 579 580 !! * Local variables 581 INTEGER :: ji, & ! spatial dummy loop index 582 jj, & ! spatial dummy loop index 583 jk, & ! vertical layering dummy loop index 584 jl ! ice category dummy loop index 585 586 REAL :: zbvi, & ! brine volume for a single ice category 587 zeps, & ! very small value 588 zindb ! is there ice or not 589 590 !!-- End of declarations 591 !!------------------------------------------------------------------------------ 592 593 zeps = 1.0e-13 594 bv_i(:,:) = 0.0 595 !CDIR NOVERRCHK 404 !! References : Vancoppenolle et al., JGR, 2007 405 !!------------------------------------------------------------------ 406 INTEGER :: ji, jj, jk, jl ! dummy loop indices 407 REAL(wp) :: zbvi, zindb ! local scalars 408 !!------------------------------------------------------------------ 409 ! 410 bv_i(:,:) = 0._wp 596 411 DO jl = 1, jpl 597 !CDIR NOVERRCHK598 412 DO jk = 1, nlay_i 599 !CDIR NOVERRCHK 600 DO jj = 1, jpj 601 !CDIR NOVERRCHK 602 DO ji = 1, jpi 603 zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 604 zbvi = - zindb * tmut *s_i(ji,jj,jk,jl) / & 605 MIN( t_i(ji,jj,jk,jl) - 273.15 , zeps ) & 606 * v_i(ji,jj,jl) / REAL(nlay_i) 607 bv_i(ji,jj) = bv_i(ji,jj) + zbvi & 608 / MAX( vt_i(ji,jj) , zeps ) 609 END DO 610 END DO 611 END DO 612 END DO 613 413 DO jj = 1, jpj 414 DO ji = 1, jpi 415 zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 416 zbvi = - zindb * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - 273.15 , eps13 ) & 417 & * v_i(ji,jj,jl) / REAL(nlay_i,wp) 418 bv_i(ji,jj) = bv_i(ji,jj) + zbvi / MAX( vt_i(ji,jj) , eps13 ) 419 END DO 420 END DO 421 END DO 422 END DO 423 ! 614 424 END SUBROUTINE lim_var_bv 615 425 616 !=============================================================================== 617 618 SUBROUTINE lim_var_salprof1d(kideb,kiut) 426 427 SUBROUTINE lim_var_salprof1d( kideb, kiut ) 619 428 !!------------------------------------------------------------------- 620 429 !! *** ROUTINE lim_thd_salprof1d *** 621 430 !! 622 431 !! ** Purpose : 1d computation of the sea ice salinity profile 623 !! Works with 1d vectors and is used by thermodynamic 624 !! modules 625 !! 626 !! history : 627 !! 3.0 ! May 2007 M. Vancoppenolle Original code 432 !! Works with 1d vectors and is used by thermodynamic modules 628 433 !!------------------------------------------------------------------- 629 INTEGER, INTENT(in) :: & 630 kideb, kiut ! thickness category index 631 632 INTEGER :: & 633 ji, jk, & ! geographic and layer index 634 zji, zjj 635 636 REAL(wp) :: & 637 dummy_fac0, & ! dummy factors 638 dummy_fac1, & 639 dummy_fac2, & 640 zalpha , & ! weighting factor 641 zind0 , & ! switches as in limvar 642 zind01 , & ! switch 643 zindbal , & ! switch if in freshwater area 644 zargtemp 645 646 REAL(wp), DIMENSION(jpij) :: & 647 z_slope_s 648 649 REAL(wp), DIMENSION(jpij,jkmax) :: & 650 zs_zero 651 !!------------------------------------------------------------------- 434 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index 435 ! 436 INTEGER :: ji, jk ! dummy loop indices 437 INTEGER :: zji, zjj ! local integers 438 REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal ! local scalars 439 REAL(wp) :: zalpha, zind0, zind01, zindbal, zs_zero ! - - 440 ! 441 REAL(wp), POINTER, DIMENSION(:) :: z_slope_s 442 !!--------------------------------------------------------------------- 443 444 IF( wrk_in_use(1, 1) ) THEN 445 CALL ctl_stop('lim_var_salprof1d : requestead workspace arrays unavailable.') ; RETURN 446 END IF 447 ! Set-up pointers to sub-arrays of workspace arrays 448 z_slope_s => wrk_1d_1 (1:jpij) 652 449 653 450 !--------------------------------------- 654 451 ! Vertically constant, constant in time 655 452 !--------------------------------------- 656 657 IF ( num_sal .EQ. 1 ) THEN 658 659 s_i_b(:,:) = bulk_sal 660 661 ENDIF 453 IF( num_sal == 1 ) s_i_b(:,:) = bulk_sal 662 454 663 455 !------------------------------------------------------ … … 665 457 !------------------------------------------------------ 666 458 667 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 668 669 ! Slope of the linear profile zs_zero 670 !------------------------------------- 671 !CDIR NOVERRCHK 672 DO ji = kideb, kiut 673 z_slope_s(ji) = 2.0 * sm_i_b(ji) / MAX( 0.01 & 674 , ht_i_b(ji) ) 675 END DO ! ji 459 IF( num_sal == 2 .OR. num_sal == 4 ) THEN 460 ! 461 DO ji = kideb, kiut ! Slope of the linear profile zs_zero 462 z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01 , ht_i_b(ji) ) 463 END DO 676 464 677 465 ! Weighting factor between zs_zero and zs_inf 678 466 !--------------------------------------------- 679 dummy_fac0 = 1. / ( ( s_i_0 - s_i_1 ))467 dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) 680 468 dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 681 dummy_fac2 = 1. / nlay_i469 dummy_fac2 = 1._wp / REAL(nlay_i,wp) 682 470 683 471 !CDIR NOVERRCHK … … 685 473 !CDIR NOVERRCHK 686 474 DO ji = kideb, kiut 687 zji = MOD( npb(ji) - 1, jpi ) + 1 688 zjj = ( npb(ji) - 1 ) / jpi + 1 689 zalpha = 0.0 475 zji = MOD( npb(ji) - 1 , jpi ) + 1 476 zjj = ( npb(ji) - 1 ) / jpi + 1 690 477 ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 691 zind0 = MAX( 0. 0 , SIGN( 1.0, s_i_0 - sm_i_b(ji) ) )478 zind0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i_b(ji) ) ) 692 479 ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 693 zind01 = ( 1.0 - zind0 ) * & 694 MAX( 0.0 , SIGN( 1.0 , s_i_1 - sm_i_b(ji) ) ) 480 zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) ) 695 481 ! if 2.sm_i GE sss_m then zindbal = 1 696 zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i_b(ji) - & 697 sss_m(zji,zjj) ) ) 698 699 zalpha = zind0 * 1.0 & 700 + zind01 * ( sm_i_b(ji) * dummy_fac0 + & 701 dummy_fac1 ) 702 zalpha = zalpha * ( 1.0 - zindbal ) 703 704 zs_zero(ji,jk) = z_slope_s(ji) * ( jk - 1./2. ) * & 705 ht_i_b(ji) * dummy_fac2 482 zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(zji,zjj) ) ) 483 ! 484 zalpha = ( zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 ) ) * ( 1.0 - zindbal ) 485 ! 486 zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2 706 487 ! weighting the profile 707 s_i_b(ji,jk) = zalpha * zs_zero(ji,jk) + & 708 ( 1.0 - zalpha ) * sm_i_b(ji) 488 s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji) 709 489 END DO ! ji 710 490 END DO ! jk … … 715 495 ! Vertically varying salinity profile, constant in time 716 496 !------------------------------------------------------- 717 ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 718 719 IF ( num_sal .EQ. 3 ) THEN720 721 sm_i_b(:) = 2.30722 723 !CDIR NOVERRCHK 724 DO ji = kideb, kiut725 !CDIR NOVERRCHK 726 DO j k = 1, nlay_i727 zargtemp = ( jk - 0.5 ) / nlay_i728 s_i_b(ji,jk) = 1.6 - 1.6*cos(3.14169265*(zargtemp**(0.407/ &729 (0.573+zargtemp))))730 END DO ! jk731 END DO ! ji732 733 ENDIF ! num_sal734 497 498 IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 499 ! 500 sm_i_b(:) = 2.30_wp 501 ! 502 !CDIR NOVERRCHK 503 DO jk = 1, nlay_i 504 zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 505 zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 506 DO ji = kideb, kiut 507 s_i_b(ji,jk) = zsal 508 END DO 509 END DO 510 ! 511 ENDIF 512 ! 513 IF( wrk_not_released(1, 1) ) CALL ctl_stop( 'lim_var_salprof1d : failed to release workspace arrays' ) 514 ! 735 515 END SUBROUTINE lim_var_salprof1d 736 516 737 !===============================================================================738 739 517 #else 740 !!====================================================================== 741 !! *** MODULE limvar *** 742 !! no sea ice model 743 !!====================================================================== 518 !!---------------------------------------------------------------------- 519 !! Default option Dummy module NO LIM3 sea-ice model 520 !!---------------------------------------------------------------------- 744 521 CONTAINS 745 522 SUBROUTINE lim_var_agg ! Empty routines … … 755 532 SUBROUTINE lim_var_salprof1d ! Emtpy routines 756 533 END SUBROUTINE lim_var_salprof1d 757 758 534 #endif 535 536 !!====================================================================== 759 537 END MODULE limvar -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r2528 r2715 15 15 USE phycst 16 16 USE dom_oce 17 USE in_out_manager18 17 USE sbc_oce ! Surface boundary condition: ocean fields 19 18 USE sbc_ice ! Surface boundary condition: ice fields 20 19 USE dom_ice 21 20 USE ice 21 USE limvar 22 USE in_out_manager 22 23 USE lbclnk 24 USE lib_mpp ! MPP library 23 25 USE par_ice 24 USE limvar25 26 26 27 IMPLICIT NONE 27 28 PRIVATE 28 29 29 !! * Accessibility30 30 PUBLIC lim_wri ! routine called by lim_step.F90 31 31 32 !! * Module variables 33 INTEGER, PARAMETER :: & !: 34 jpnoumax = 40 !: maximum number of variable for ice output 35 INTEGER :: & 36 noumef , & ! number of fields 37 noumefa , & ! number of additional fields 38 add_diag_swi , & ! additional diagnostics 39 nz ! dimension for the itd field 40 41 REAL(wp) , DIMENSION(jpnoumax) :: & 42 cmulti , & ! multiplicative constant 43 cadd , & ! additive constant 44 cmultia , & ! multiplicative constant 45 cadda ! additive constant 46 CHARACTER(len = 35), DIMENSION(jpnoumax) :: & 47 titn, titna ! title of the field 48 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: & 49 nam, nama ! name of the field 50 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: & 51 uni, unia ! unit of the field 52 INTEGER , DIMENSION(jpnoumax) :: & 53 nc, nca ! switch for saving field ( = 1 ) or not ( = 0 ) 54 55 REAL(wp) :: & ! constant values 56 epsi16 = 1e-16 , & 57 zzero = 0.e0 , & 58 zone = 1.e0 32 INTEGER, PARAMETER :: jpnoumax = 40 !: maximum number of variable for ice output 33 34 INTEGER :: noumef ! number of fields 35 INTEGER :: noumefa ! number of additional fields 36 INTEGER :: add_diag_swi ! additional diagnostics 37 INTEGER :: nz ! dimension for the itd field 38 39 REAL(wp) , DIMENSION(jpnoumax) :: cmulti ! multiplicative constant 40 REAL(wp) , DIMENSION(jpnoumax) :: cadd ! additive constant 41 REAL(wp) , DIMENSION(jpnoumax) :: cmultia ! multiplicative constant 42 REAL(wp) , DIMENSION(jpnoumax) :: cadda ! additive constant 43 CHARACTER(len = 35), DIMENSION(jpnoumax) :: titn, titna ! title of the field 44 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: nam , nama ! name of the field 45 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: uni , unia ! unit of the field 46 INTEGER , DIMENSION(jpnoumax) :: nc , nca ! switch for saving field ( = 1 ) or not ( = 0 ) 47 48 REAL(wp) :: epsi16 = 1e-16_wp 49 REAL(wp) :: zzero = 0._wp 50 REAL(wp) :: zone = 1._wp 59 51 60 52 !!---------------------------------------------------------------------- 61 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)53 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 62 54 !! $Id$ 63 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 64 56 !!---------------------------------------------------------------------- 65 57 CONTAINS … … 79 71 !! modif : 03/06/98 80 72 !!------------------------------------------------------------------- 81 INTEGER, INTENT(in) :: & 82 kindic ! if kindic < 0 there has been an error somewhere 83 84 !! * Local variables 73 USE wrk_nemo, ONLY: wrk_not_released, wrk_in_use 74 USE wrk_nemo, ONLY: zfield => wrk_2d_1 ! 2D workspace 75 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3D_2, wrk_3d_3 ! 3D workspace 76 ! 77 INTEGER, INTENT(in) :: kindic ! if kindic < 0 there has been an error somewhere 78 ! 79 INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices 80 INTEGER :: ierr 85 81 REAL(wp),DIMENSION(1) :: zdept 86 87 REAL(wp) :: & 88 zsto, zjulian,zout, & 89 zindh,zinda,zindb 90 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 91 zcmo, & 92 zcmoa ! additional fields 93 94 REAL(wp), DIMENSION(jpi,jpj) :: & 95 zfield 96 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 98 zmaskitd, zoi, zei 99 100 INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices 101 102 CHARACTER(len = 40) :: & 103 clhstnam, clop, & 104 clhstnama 105 106 INTEGER , SAVE :: & 107 nice, nhorid, ndim, niter, ndepid 108 INTEGER , SAVE :: & 109 nicea, nhorida, ndimitd 110 INTEGER , DIMENSION( jpij ) , SAVE :: & 111 ndex51 112 INTEGER , DIMENSION( jpij*jpl ) , SAVE :: & 113 ndexitd 82 REAL(wp) :: zsto, zjulian, zout, zindh, zinda, zindb 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcmo, zcmoa ! additional fields 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmaskitd, zoi, zei 85 86 CHARACTER(len = 40) :: clhstnam, clop, clhstnama 87 88 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 89 INTEGER , SAVE :: nicea, nhorida, ndimitd 90 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndex51 91 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndexitd 114 92 !!------------------------------------------------------------------- 115 93 116 94 ipl = jpl 117 95 118 IF ( numit == nstart ) THEN 96 zcmo => wrk_3d_1(:,:,1:jpnoumax) 97 zcmoa => wrk_3d_2(:,:,1:jpnoumax) 98 zmaskitd => wrk_3d_2(:,:,1:jpl) 99 zoi => wrk_3d_2(:,:,1:jpl) 100 zei => wrk_3d_2(:,:,1:jpl) 101 102 103 IF( numit == nstart ) THEN 104 105 ALLOCATE( ndex51(jpij) , ndexitd(jpij*jpl) , STAT=ierr ) 106 IF( ierr /= 0 ) THEN 107 CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' ) ; RETURN 108 ENDIF 119 109 120 110 CALL lim_wri_init … … 209 199 210 200 !-- calculs des valeurs instantanees 211 zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0.0212 zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0. 0201 zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 202 zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 213 203 214 204 DO jl = 1, jpl … … 233 223 234 224 zcmo(ji,jj,1) = at_i(ji,jj) 235 zcmo(ji,jj,2) = vt_i(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda 236 zcmo(ji,jj,3) = vt_s(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda 237 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * & 238 86400.0 * zinda !Bottom thermodynamic ice production 239 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * & 240 86400.0 * zinda !Dynamic ice production (rid/raft) 241 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * & 242 86400.0 * zinda !Lateral thermodynamic ice production 243 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * & 244 86400.0 * zinda !Snow ice production ice production 225 zcmo(ji,jj,2) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 226 zcmo(ji,jj,3) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 227 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * 86400.0 * zinda ! Bottom thermodynamic ice production 228 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * 86400.0 * zinda ! Dynamic ice production (rid/raft) 229 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0 * zinda ! Lateral thermodynamic ice production 230 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0 * zinda ! Snow ice production ice production 245 231 zcmo(ji,jj,24) = tm_i(ji,jj) - rtt 246 232 247 233 zcmo(ji,jj,6) = fbif (ji,jj) 248 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) & 249 & + u_ice(ji-1,jj) * tmu(ji-1,jj) ) & 250 & / 2.0 251 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) & 252 & + v_ice(ji,jj-1) * tmv(ji,jj-1) ) & 253 & / 2.0 234 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 235 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 254 236 zcmo(ji,jj,9) = sst_m(ji,jj) 255 237 zcmo(ji,jj,10) = sss_m(ji,jj) … … 261 243 zcmo(ji,jj,15) = utau_ice(ji,jj) 262 244 zcmo(ji,jj,16) = vtau_ice(ji,jj) 263 zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1.0-at_i(ji,jj))*qsr(ji,jj)264 zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1.0-at_i(ji,jj))*qns(ji,jj)245 zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 246 zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 265 247 zcmo(ji,jj,19) = sprecip(ji,jj) 266 248 zcmo(ji,jj,20) = smt_i(ji,jj) … … 274 256 zcmo(ji,jj,31) = hicol(ji,jj) 275 257 zcmo(ji,jj,32) = strength(ji,jj) 276 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + & 277 zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 278 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * & 279 86400.0 * zinda ! Surface melt 280 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * & 281 86400.0 * zinda ! Bottom melt 258 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 259 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0 * zinda ! Surface melt 260 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0 * zinda ! Bottom melt 282 261 zcmo(ji,jj,36) = divu_i(ji,jj) 283 262 zcmo(ji,jj,37) = shear_i(ji,jj) … … 290 269 niter = niter + 1 291 270 DO jf = 1 , noumef 292 DO jj = 1 , jpj 293 DO ji = 1 , jpi 294 zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf) 295 END DO 296 END DO 297 298 IF ( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 299 CALL lbc_lnk( zfield, 'T', -1. ) 300 ELSE 301 CALL lbc_lnk( zfield, 'T', 1. ) 271 ! 272 zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 273 ! 274 IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN ; CALL lbc_lnk( zfield, 'T', -1. ) 275 ELSE ; CALL lbc_lnk( zfield, 'T', 1. ) 302 276 ENDIF 303 277 ! 304 278 IF( ln_nicep ) THEN 305 279 WRITE(numout,*) … … 307 281 WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 308 282 ENDIF 309 IF 310 283 IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 284 ! 311 285 END DO 312 286 313 IF 287 IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 314 288 IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 315 289 CALL histclo( nice ) … … 319 293 ! Thickness distribution file 320 294 !----------------------------- 321 IF ( add_diag_swi .EQ.1 ) THEN295 IF( add_diag_swi == 1 ) THEN 322 296 323 297 DO jl = 1, jpl … … 334 308 DO ji = 1, jpi 335 309 zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 336 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * & 337 zinda 310 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * zinda 338 311 END DO 339 312 END DO … … 341 314 342 315 ! Compute brine volume 343 zei(:,:,:) = 0. 0316 zei(:,:,:) = 0._wp 344 317 DO jl = 1, jpl 345 318 DO jk = 1, nlay_i … … 370 343 ! not yet implemented 371 344 372 IF 345 IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 373 346 IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 374 347 CALL histclo( nicea ) 375 348 ENDIF 376 349 ! 377 350 ENDIF 378 351 … … 390 363 !! 391 364 !! ** input : Namelist namicewri 392 !! 393 !! history : 394 !! 8.5 ! 03-08 (C. Ethe) original code 395 !!------------------------------------------------------------------- 396 !! * Local declarations 365 !!------------------------------------------------------------------- 397 366 INTEGER :: nf ! ??? 398 367 … … 416 385 417 386 TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 418 387 ! 419 388 NAMELIST/namiceout/ noumef, & 420 389 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , & … … 427 396 !!------------------------------------------------------------------- 428 397 429 ! Read Namelist namicewri 430 REWIND ( numnam_ice ) 431 READ ( numnam_ice , namiceout ) 398 REWIND( numnam_ice ) ! Read Namelist namicewri 399 READ ( numnam_ice , namiceout ) 432 400 433 401 zfield(1) = field_1 … … 478 446 END DO 479 447 480 IF(lwp) THEN 448 IF(lwp) THEN ! control print 481 449 WRITE(numout,*) 482 450 WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs' … … 486 454 & ' multiplicative constant additive constant ' 487 455 DO nf = 1 , noumef 488 WRITE(numout,*) ' ', titn(nf), ' ' , nam(nf),' ', uni(nf),' ', nc(nf),' ', cmulti(nf), &489 ' ', cadd(nf)456 WRITE(numout,*) ' ', titn(nf), ' ' , nam (nf), ' ' , uni (nf), & 457 & ' ' , nc (nf),' ', cmulti(nf), ' ', cadd(nf) 490 458 END DO 491 459 WRITE(numout,*) ' add_diag_swi ', add_diag_swi 492 460 ENDIF 493 461 ! 494 462 END SUBROUTINE lim_wri_init 495 463 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
r2528 r2715 14 14 !! modif : 03/06/98 15 15 !!------------------------------------------------------------------- 16 !! * Local variables17 16 USE diawri, ONLY : dia_wri_dimg 18 17 REAL(wp),DIMENSION(1) :: zdept 19 18 20 REAL(wp) :: & 21 zsto, zsec, zjulian,zout, & 22 zindh,zinda,zindb, & 23 ztmu 24 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 25 zcmo 26 REAL(wp), DIMENSION(jpi,jpj) :: & 27 zfield 28 INTEGER, SAVE :: nmoyice, & !: counter for averaging 29 & nwf !: number of fields to write on disk 19 REAL(wp) :: zsto, zsec, zjulian,zout, & 20 REAL(wp) :: zindh,zinda,zindb, ztmu 21 REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo 22 REAL(wp), DIMENSION(jpi,jpj) :: zfield 23 INTEGER, SAVE :: nmoyice !: counter for averaging 24 INTEGER, SAVE :: nwf !: number of fields to write on disk 30 25 INTEGER, SAVE,DIMENSION (:), ALLOCATABLE :: nsubindex !: subindex to be saved 31 26 ! according to namelist … … 43 38 44 39 45 INTEGER , SAVE :: & 46 nice, nhorid, ndim, niter, ndepid 47 INTEGER , DIMENSION( jpij ) , SAVE :: & 48 ndex51 40 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 41 INTEGER , DIMENSION( jpij ) , SAVE :: ndex51 49 42 !!------------------------------------------------------------------- 50 43 IF ( numit == nstart ) THEN -
trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r2528 r2715 4 4 !! LIM sea-ice : Ice thermodynamics in 1D 5 5 !!===================================================================== 6 !! History : 7 !! 2.0 ! 02-11 (C. Ethe) F90: Free form and module 6 !! History : 3.0 ! 2002-11 (C. Ethe) F90: Free form and module 8 7 !!---------------------------------------------------------------------- 9 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 10 !! $Id$ 11 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 12 !!---------------------------------------------------------------------- 13 !! * Modules used 14 USE par_ice 8 USE par_ice ! LIM-3 parameters 9 USE in_out_manager ! I/O manager 10 USE lib_mpp ! MPP library 15 11 16 12 IMPLICIT NONE 17 13 PRIVATE 14 15 PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 18 16 19 17 !!--------------------------- 20 18 !! * Share Module variables 21 19 !!--------------------------- 22 REAL(wp) , PUBLIC :: & !!! ** ice-thermo namelist (namicethd) ** 23 hmelt = -0.15 , & !: maximum melting at the bottom; active only for 24 !: one category 25 hicmin = 0.2 , & !: (REMOVE) 26 hiclim = 0.05 , & !: minimum ice thickness 27 amax = 0.999 , & !: maximum lead fraction 28 sbeta = 1.0 , & !: numerical scheme for diffusion in ice (REMOVE) 29 parlat = 0.0 , & !: (REMOVE) 30 hakspl = 0.5 , & !: (REMOVE) 31 hibspl = 0.5 , & !: (REMOVE) 32 exld = 2.0 , & !: (REMOVE) 33 hakdif = 1.0 , & !: (REMOVE) 34 thth = 0.2 , & !: (REMOVE) 35 hnzst = 0.1 , & !: thick. of the surf. layer in temp. comp. 36 parsub = 1.0 , & !: switch for snow sublimation or not 37 alphs = 1.0 , & !: coef. for snow density when snow-ice formation 38 fraz_swi= 1.0 , & !: use of frazil ice collection in function of wind (1.0) or not (0.0) 39 maxfrazb= 0.7 , & !: maximum portion of frazil ice collecting at the ice bottom 40 vfrazb = 0.41667, & !: threshold drift speed for collection of bottom frazil ice 41 Cfrazb = 5.0 !: squeezing coefficient for collection of bottom frazil ice 42 43 REAL(wp), PUBLIC, DIMENSION(2) :: & !: 44 hiccrit = (/0.3,0.3/) !: ice th. for lateral accretion in the NH (SH) (m) 20 ! !!! ** ice-thermo namelist (namicethd) ** 21 REAL(wp), PUBLIC :: hmelt = -0.15 !: maximum melting at the bottom; active only for one category 22 REAL(wp), PUBLIC :: hicmin = 0.2 !: (REMOVE) 23 REAL(wp), PUBLIC :: hiclim = 0.05 !: minimum ice thickness 24 REAL(wp), PUBLIC :: amax = 0.999 !: maximum lead fraction 25 REAL(wp), PUBLIC :: sbeta = 1.0 !: numerical scheme for diffusion in ice (REMOVE) 26 REAL(wp), PUBLIC :: parlat = 0.0 !: (REMOVE) 27 REAL(wp), PUBLIC :: hakspl = 0.5 !: (REMOVE) 28 REAL(wp), PUBLIC :: hibspl = 0.5 !: (REMOVE) 29 REAL(wp), PUBLIC :: exld = 2.0 !: (REMOVE) 30 REAL(wp), PUBLIC :: hakdif = 1.0 !: (REMOVE) 31 REAL(wp), PUBLIC :: thth = 0.2 !: (REMOVE) 32 REAL(wp), PUBLIC :: hnzst = 0.1 !: thick. of the surf. layer in temp. comp. 33 REAL(wp), PUBLIC :: parsub = 1.0 !: switch for snow sublimation or not 34 REAL(wp), PUBLIC :: alphs = 1.0 !: coef. for snow density when snow-ice formation 35 REAL(wp), PUBLIC :: fraz_swi= 1.0 !: use of frazil ice collection in function of wind (1.0) or not (0.0) 36 REAL(wp), PUBLIC :: maxfrazb= 0.7 !: maximum portion of frazil ice collecting at the ice bottom 37 REAL(wp), PUBLIC :: vfrazb = 0.41667 !: threshold drift speed for collection of bottom frazil ice 38 REAL(wp), PUBLIC :: Cfrazb = 5.0 !: squeezing coefficient for collection of bottom frazil ice 39 40 REAL(wp), PUBLIC, DIMENSION(2) :: hiccrit = (/0.3,0.3/) !: ice th. for lateral accretion in the NH (SH) (m) 45 41 46 42 !!----------------------------- … … 51 47 !: are the variables corresponding to 2d vectors 52 48 53 INTEGER , PUBLIC, DIMENSION(jpij) :: & !: 54 npb , & !: number of points where computations has to be done 55 npac !: correspondance between the points (lateral accretion) 56 57 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !: 58 qldif_1d , & !: corresponding to the 2D var qldif 59 qcmif_1d , & !: corresponding to the 2D var qcmif 60 fstbif_1d , & !: " " fstric 61 fltbif_1d , & !: " " ffltbif 62 fscbq_1d , & !: " " fscmcbq 63 qsr_ice_1d , & !: " " qsr_ice 64 fr1_i0_1d , & !: " " fr1_i0 65 fr2_i0_1d , & !: " " fr2_i0 66 qnsr_ice_1d , & !: " " qns_ice 67 qfvbq_1d , & !: " " qfvbq 68 t_bo_b !: " " t_bo 69 70 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !: 71 sprecip_1d , & !: " " sprecip 72 frld_1d , & !: " " frld 73 at_i_b , & !: " " frld 74 fbif_1d , & !: " " fbif 75 rdmicif_1d , & !: " " rdmicif 76 rdmsnif_1d , & !: " " rdmsnif 77 qlbbq_1d , & !: " " qlbsbq 78 dmgwi_1d , & !: " " dmgwi 79 dvsbq_1d , & !: " " rdvosif 80 dvbbq_1d , & !: " " rdvobif 81 dvlbq_1d , & !: " " rdvolif 82 dvnbq_1d , & !: " " rdvolif 83 dqns_ice_1d , & !: " " dqns_ice 84 qla_ice_1d , & !: " " qla_ice 85 dqla_ice_1d , & !: " " dqla_ice 86 ! to reintegrate longwave flux inside the ice thermodynamics 87 !!sm: not used qtur_ice_1d , & !: " " qtur_ice 88 !!sm: not used dqtu_ice_1d , & !: " " dqtu_ice 89 !!sm: not used catm_ice_1d , & !: " " catm_ice 90 tatm_ice_1d , & !: " " tatm_ice 91 !!sm: not used evsq_ice_1d , & !: " " evsq_ice 92 !!sm: not used sbud_ice_1d , & !: " " sbud_ice 93 fsup , & !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 94 focea , & !: Remaining energy in case of total ablation 95 i0 , & !: fraction of radiation transmitted to the ice interior 96 old_ht_i_b , & !: Ice thickness at the beginnning of the time step [m] 97 old_ht_s_b , & !: Snow thickness at the beginning of the time step [m] 98 fsbri_1d , & !: Salt flux due to brine drainage 99 fhbri_1d , & !: Heat flux due to brine drainage 100 fseqv_1d , & !: Equivalent Salt flux due to ice growth/decay 101 dsm_i_fl_1d , & !: Ice salinity variations due to flushing 102 dsm_i_gd_1d , & !: Ice salinity variations due to gravity drainage 103 dsm_i_se_1d , & !: Ice salinity variations due to basal salt entrapment 104 !!sm: not used dsm_i_la_1d , & !: Ice salinity variations due to lateral accretion 105 dsm_i_si_1d , & !: Ice salinity variations due to lateral accretion 106 hicol_b !: Ice collection thickness accumulated in fleads 107 108 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !: 109 t_su_b , & !: " " t_su 110 a_i_b , & !: a_i 111 ht_i_b , & !: " " ht_s 112 ht_s_b , & !: " " ht_i 113 fc_su , & !: Surface Conduction flux 114 fc_bo_i , & !: Bottom Conduction flux 115 dh_s_tot , & !: Snow accretion/ablation [m] 116 dh_i_surf , & !: Ice surface accretion/ablation [m] 117 dh_i_bott , & !: Ice bottom accretion/ablation [m] 118 dh_snowice , & !: Snow ice formation [m of ice] 119 sm_i_b , & !: Ice bulk salinity [ppt] 120 s_i_new , & !: Salinity of new ice at the bottom 121 s_snowice , & !: Salinity of new snow ice on top of the ice 122 o_i_b !: Ice age [days] 123 124 REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) :: & !: 125 t_s_b !: corresponding to the 2D var t_s 126 REAL(wp), PUBLIC, DIMENSION(jpij,jkmax) :: & !: 127 t_i_b, & !: corresponding to the 2D var t_i 128 s_i_b, & !: profiled ice salinity 129 q_i_b, & !: Ice enthalpy per unit volume 130 q_s_b !: Snow enthalpy per unit volume 49 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npb !: number of points where computations has to be done 50 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: correspondance between points (lateral accretion) 51 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qldif_1d !: <==> the 2D qldif 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qcmif_1d !: <==> the 2D qcmif 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fstbif_1d !: <==> the 2D fstric 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fltbif_1d !: <==> the 2D ffltbif 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fscbq_1d !: <==> the 2D fscmcbq 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d !: <==> the 2D qsr_ice 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr1_i0_1d !: <==> the 2D fr1_i0 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr2_i0_1d !: <==> the 2D fr2_i0 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qnsr_ice_1d !: <==> the 2D qns_ice 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qfvbq_1d !: <==> the 2D qfvbq 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_bo_b !: <==> the 2D t_bo 63 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d !: <==> the 2D sprecip 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: frld_1d !: <==> the 2D frld 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_b !: <==> the 2D frld 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fbif_1d !: <==> the 2D fbif 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdmicif_1d !: <==> the 2D rdmicif 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdmsnif_1d !: <==> the 2D rdmsnif 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlbbq_1d !: <==> the 2D qlbsbq 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dmgwi_1d !: <==> the 2D dmgwi 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvsbq_1d !: <==> the 2D rdvosif 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvbbq_1d !: <==> the 2D rdvobif 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvlbq_1d !: <==> the 2D rdvolif 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvnbq_1d !: <==> the 2D rdvolif 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qla_ice_1d !: <==> the 2D qla_ice 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqla_ice_1d !: <==> the 2D dqla_ice 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tatm_ice_1d !: <==> the 2D tatm_ice 80 ! ! to reintegrate longwave flux inside the ice thermodynamics 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fsup !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: focea !: Remaining energy in case of total ablation 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_i_b !: Ice thickness at the beginnning of the time step [m] 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_s_b !: Snow thickness at the beginning of the time step [m] 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fsbri_1d !: Salt flux due to brine drainage 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhbri_1d !: Heat flux due to brine drainage 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fseqv_1d !: Equivalent Salt flux due to ice growth/decay 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_se_1d !: Ice salinity variations due to basal salt entrapment 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_si_1d !: Ice salinity variations due to lateral accretion 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hicol_b !: Ice collection thickness accumulated in fleads 94 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_su_b !: <==> the 2D t_su 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_i_b !: <==> the 2D a_i 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_i_b !: <==> the 2D ht_s 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_s_b !: <==> the 2D ht_i 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_su !: Surface Conduction flux 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_bo_i !: Bottom Conduction flux 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_tot !: Snow accretion/ablation [m] 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_surf !: Ice surface accretion/ablation [m] 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bott !: Ice bottom accretion/ablation [m] 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_snowice !: Snow ice formation [m of ice] 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sm_i_b !: Ice bulk salinity [ppt] 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_snowice !: Salinity of new snow ice on top of the ice 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: o_i_b !: Ice age [days] 109 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_b !: corresponding to the 2D var t_s 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_b !: corresponding to the 2D var t_i 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: s_i_b !: profiled ice salinity 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_b !: Ice enthalpy per unit volume 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_s_b !: Snow enthalpy per unit volume 131 115 132 116 ! Clean the following ... 133 117 ! These variables are coded for conservation checks 134 REAL(wp), PUBLIC, DIMENSION(jpij,jpl) :: & ! 135 qt_i_in , & !: ice energy summed over categories (initial) 136 qt_i_fin , & !: ice energy summed over categories (final) 137 qt_s_in, qt_s_fin , & !: snow energy summed over categories 138 dq_i, sum_fluxq , & !: increment of energy, sum of fluxes 139 fatm, foce, & !: atmospheric, oceanic, heat flux 140 cons_error, surf_error !: conservation, surface error 141 142 REAL(wp), PUBLIC, DIMENSION(jpij,jkmax):: & !: goes to trash 143 q_i_layer_in, & 144 q_i_layer_fin, & 145 dq_i_layer, radab 146 147 REAL(wp), PUBLIC, DIMENSION(jpij) :: & !: 148 ftotal_in , & !: initial total heat flux 149 ftotal_fin !: final total heat flux 150 151 REAL(wp), PUBLIC, DIMENSION(jpij,0:nlay_s) :: & !: 152 fc_s 153 REAL(wp), PUBLIC, DIMENSION(jpij,0:jkmax) :: & !: 154 fc_i 155 REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) :: & !: 156 de_s_lay 157 REAL(wp), PUBLIC, DIMENSION(jpij,jkmax) :: & !: 158 de_i_lay 159 INTEGER , PUBLIC :: & 160 jiindex_1d ! 1D index of debugging point 161 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_in !: ice energy summed over categories (initial) 119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_fin !: ice energy summed over categories (final) 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_s_in, qt_s_fin !: snow energy summed over categories 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i, sum_fluxq !: increment of energy, sum of fluxes 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fatm, foce !: atmospheric, oceanic, heat flux 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cons_error, surf_error !: conservation, surface error 124 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_in !: goes to trash 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_fin !: goes to trash 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i_layer, radab !: goes to trash 128 129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_in !: initial total heat flux 130 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_fin !: final total heat flux 131 132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_s 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_i 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_s_lay 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_i_lay 136 137 INTEGER , PUBLIC :: jiindex_1d ! 1D index of debugging point 138 139 !!---------------------------------------------------------------------- 140 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 141 !! $Id$ 142 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 143 !!---------------------------------------------------------------------- 144 CONTAINS 145 146 FUNCTION thd_ice_alloc() 147 !!---------------------------------------------------------------------! 148 !! *** ROUTINE thd_ice_alloc *** 149 !!---------------------------------------------------------------------! 150 INTEGER :: thd_ice_alloc ! return value 151 INTEGER :: ierr(4) 152 !!---------------------------------------------------------------------! 153 154 ALLOCATE( npb (jpij) , npac (jpij), & 155 ! ! 156 & qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d (jpij) , & 157 & fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) , & 158 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) , & 159 & qfvbq_1d (jpij) , t_bo_b (jpij) , STAT=ierr(1) ) 160 ! 161 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_b (jpij) , & 162 & fbif_1d (jpij) , rdmicif_1d (jpij) , rdmsnif_1d (jpij) , & 163 & qlbbq_1d (jpij) , dmgwi_1d (jpij) , dvsbq_1d (jpij) , & 164 & dvbbq_1d (jpij) , dvlbq_1d (jpij) , dvnbq_1d (jpij) , & 165 & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) , & 166 & tatm_ice_1d(jpij) , fsup (jpij) , focea (jpij) , & 167 & i0 (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) , & 168 & fsbri_1d (jpij) , fhbri_1d (jpij) , fseqv_1d (jpij) , & 169 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 170 & dsm_i_si_1d(jpij) , hicol_b (jpij) , STAT=ierr(2) ) 171 ! 172 ALLOCATE( t_su_b (jpij) , a_i_b (jpij) , ht_i_b (jpij) , & 173 & ht_s_b (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 174 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , & 175 & dh_snowice(jpij) , sm_i_b (jpij) , s_i_new (jpij) , & 176 & s_snowice (jpij) , o_i_b (jpij) , & 177 ! ! 178 & t_s_b(jpij,nlay_s), & 179 ! ! 180 & t_i_b(jpij,jkmax), s_i_b(jpij,jkmax) , & 181 & q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , STAT=ierr(3)) 182 ! 183 ALLOCATE( qt_i_in (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in (jpij,jpl) , & 184 & qt_s_fin (jpij,jpl) , dq_i (jpij,jpl) , sum_fluxq (jpij,jpl) , & 185 & fatm (jpij,jpl) , foce (jpij,jpl) , cons_error(jpij,jpl) , & 186 & surf_error(jpij,jpl) , & 187 ! ! 188 & q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax) , & 189 & dq_i_layer (jpij,jkmax) , radab (jpij,jkmax) , & 190 ! ! 191 & ftotal_in(jpij), ftotal_fin(jpij) , & 192 ! ! 193 & fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s) , & 194 & fc_i(jpij,0:jkmax) , de_i_lay(jpij,jkmax) , STAT=ierr(4) ) 195 196 thd_ice_alloc = MAXVAL( ierr ) 197 198 IF( thd_ice_alloc /= 0 ) CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' ) 199 ! 200 END FUNCTION thd_ice_alloc 201 162 202 !!====================================================================== 163 203 END MODULE thd_ice
Note: See TracChangeset
for help on using the changeset viewer.
