Changeset 7646 for trunk/NEMOGCM/NEMO/LIM_SRC_3
- Timestamp:
- 2017-02-06T10:25:03+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 3 deleted
- 23 edited
- 3 copied
-
dom_ice.F90 (deleted)
-
ice.F90 (modified) (14 diffs)
-
limadv.F90 (deleted)
-
limadv_prather.F90 (copied) (copied from branches/2016/dev_merge_2016/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90)
-
limadv_umx.F90 (copied) (copied from branches/2016/dev_merge_2016/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90)
-
limcons.F90 (modified) (8 diffs)
-
limctl.F90 (modified) (6 diffs)
-
limdiahsb.F90 (modified) (8 diffs)
-
limdyn.F90 (modified) (8 diffs)
-
limhdf.F90 (modified) (15 diffs)
-
limistate.F90 (modified) (16 diffs)
-
limitd_me.F90 (modified) (17 diffs)
-
limitd_th.F90 (modified) (1 diff)
-
limmsh.F90 (deleted)
-
limrhg.F90 (modified) (12 diffs)
-
limrst.F90 (modified) (12 diffs)
-
limsbc.F90 (modified) (14 diffs)
-
limthd.F90 (modified) (17 diffs)
-
limthd_da.F90 (copied) (copied from branches/2016/dev_merge_2016/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90)
-
limthd_dh.F90 (modified) (7 diffs)
-
limthd_dif.F90 (modified) (1 diff)
-
limthd_lac.F90 (modified) (12 diffs)
-
limthd_sal.F90 (modified) (4 diffs)
-
limtrp.F90 (modified) (10 diffs)
-
limupdate1.F90 (modified) (4 diffs)
-
limupdate2.F90 (modified) (4 diffs)
-
limvar.F90 (modified) (8 diffs)
-
limwri.F90 (modified) (8 diffs)
-
thd_ice.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r6490 r7646 146 146 !! smt_i | - | Mean sea ice salinity | ppt | 147 147 !! tm_i | - | Mean sea ice temperature | K | 148 !! ot_i ! - ! Sea ice areal age content | day |149 148 !! et_i ! - ! Total ice enthalpy | J/m2 | 150 149 !! et_s ! - ! Total snow enthalpy | J/m2 | 151 !! bv_i ! - ! Mean relative brine volume| ??? |150 !! bv_i ! - ! relative brine volume | ??? | 152 151 !!===================================================================== 153 152 … … 157 156 !! * Share Module variables 158 157 !!-------------------------------------------------------------------------- 158 ! !!** ice-generic parameters namelist (namicerun) ** 159 INTEGER , PUBLIC :: jpl !: number of ice categories 160 INTEGER , PUBLIC :: nlay_i !: number of ice layers 161 INTEGER , PUBLIC :: nlay_s !: number of snow layers 162 REAL(wp) , PUBLIC :: rn_amax_n !: maximum ice concentration Northern hemisphere 163 REAL(wp) , PUBLIC :: rn_amax_s !: maximum ice concentration Southern hemisphere 164 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input) 165 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output) 166 CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory 167 CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory 168 LOGICAL , PUBLIC :: ln_limthd !: flag for ice thermo (T) or not (F) 169 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 170 INTEGER , PUBLIC :: nn_limdyn !: flag for ice dynamics 171 REAL(wp) , PUBLIC :: rn_uice !: prescribed u-vel (case nn_limdyn=0) 172 REAL(wp) , PUBLIC :: rn_vice !: prescribed v-vel (case nn_limdyn=0) 173 174 ! !!** ice-diagnostics namelist (namicediag) ** 175 LOGICAL , PUBLIC :: ln_limdiachk !: flag for ice diag (T) or not (F) 176 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 177 LOGICAL , PUBLIC :: ln_limctl !: flag for sea-ice points output (T) or not (F) 178 INTEGER , PUBLIC :: iiceprt !: debug i-point 179 INTEGER , PUBLIC :: jiceprt !: debug j-point 180 181 ! !!** ice-init namelist (namiceini) ** 182 ! -- limistate -- ! 183 LOGICAL , PUBLIC :: ln_limini ! initialization or not 184 LOGICAL , PUBLIC :: ln_limini_file ! Ice initialization state from 2D netcdf file 185 REAL(wp), PUBLIC :: rn_thres_sst ! threshold water temperature for initial sea ice 186 REAL(wp), PUBLIC :: rn_hts_ini_n ! initial snow thickness in the north 187 REAL(wp), PUBLIC :: rn_hts_ini_s ! initial snow thickness in the south 188 REAL(wp), PUBLIC :: rn_hti_ini_n ! initial ice thickness in the north 189 REAL(wp), PUBLIC :: rn_hti_ini_s ! initial ice thickness in the south 190 REAL(wp), PUBLIC :: rn_ati_ini_n ! initial leads area in the north 191 REAL(wp), PUBLIC :: rn_ati_ini_s ! initial leads area in the south 192 REAL(wp), PUBLIC :: rn_smi_ini_n ! initial salinity 193 REAL(wp), PUBLIC :: rn_smi_ini_s ! initial salinity 194 REAL(wp), PUBLIC :: rn_tmi_ini_n ! initial temperature 195 REAL(wp), PUBLIC :: rn_tmi_ini_s ! initial temperature 196 197 ! !!** ice-thickness distribution namelist (namiceitd) ** 198 INTEGER , PUBLIC :: nn_catbnd !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 199 REAL(wp), PUBLIC :: rn_himean !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 200 201 ! !!** ice-dynamics namelist (namicedyn) ** 202 ! -- limtrp & limadv -- ! 203 INTEGER , PUBLIC :: nn_limadv !: choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 204 INTEGER , PUBLIC :: nn_limadv_ord !: choose the order of the advection scheme (if Ultimate-Macho) 205 ! -- limitd_me -- ! 206 INTEGER , PUBLIC :: nn_icestr !: ice strength parameterization (0=Hibler79 1=Rothrock75) 207 REAL(wp), PUBLIC :: rn_pe_rdg !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 208 REAL(wp), PUBLIC :: rn_pstar !: determines ice strength, Hibler JPO79 209 REAL(wp), PUBLIC :: rn_crhg !: determines changes in ice strength 210 LOGICAL , PUBLIC :: ln_icestr_bvf !: use brine volume to diminish ice strength 211 ! -- limdyn & limrhg -- ! 212 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress 213 REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9 214 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve 215 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling 216 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 217 LOGICAL , PUBLIC :: ln_landfast !: landfast ice parameterization (T or F) 218 REAL(wp), PUBLIC :: rn_gamma !: fraction of ocean depth that ice must reach to initiate landfast ice 219 REAL(wp), PUBLIC :: rn_icebfr !: maximum bottom stress per unit area of contact (landfast ice) 220 REAL(wp), PUBLIC :: rn_lfrelax !: relaxation time scale (s-1) to reach static friction (landfast ice) 221 222 ! !!** ice-diffusion namelist (namicehdf) ** 223 INTEGER , PUBLIC :: nn_ahi0 !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 224 REAL(wp), PUBLIC :: rn_ahi0_ref !: sea-ice hor. eddy diffusivity coeff. (m2/s) 225 226 ! !!** ice-thermodynamics namelist (namicethd) ** 227 ! -- limthd_dif -- ! 228 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 229 REAL(wp), PUBLIC :: nn_conv_dif !: maximal number of iterations for heat diffusion 230 REAL(wp), PUBLIC :: rn_terr_dif !: maximal tolerated error (C) for heat diffusion 231 INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 232 LOGICAL , PUBLIC :: ln_it_qnsice !: iterate surface flux with changing surface temperature or not (F) 233 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0) 234 ! -- limthd_dh -- ! 235 LOGICAL , PUBLIC :: ln_limdH !: activate ice thickness change from growing/melting (T) or not (F) 236 REAL(wp), PUBLIC :: rn_betas !: coef. for partitioning of snowfall between leads and sea ice 237 ! -- limthd_da -- ! 238 LOGICAL , PUBLIC :: ln_limdA !: activate lateral melting param. (T) or not (F) 239 REAL(wp), PUBLIC :: rn_beta !: coef. beta for lateral melting param. 240 REAL(wp), PUBLIC :: rn_dmin !: minimum floe diameter for lateral melting param. 241 ! -- limthd_lac -- ! 242 LOGICAL , PUBLIC :: ln_limdO !: activate ice growth in open-water (T) or not (F) 243 REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m) 244 LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F) 245 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 246 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice 247 REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice 248 ! -- limitd_th -- ! 249 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness 250 251 ! !!** ice-salinity namelist (namicesal) ** 252 LOGICAL , PUBLIC :: ln_limdS !: activate gravity drainage and flushing (T) or not (F) 253 INTEGER , PUBLIC :: nn_icesal !: salinity configuration used in the model 254 ! ! 1 - constant salinity in both space and time 255 ! ! 2 - prognostic salinity (s(z,t)) 256 ! ! 3 - salinity profile, constant in time 257 REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity 258 REAL(wp), PUBLIC :: rn_sal_gd !: restoring salinity for gravity drainage [PSU] 259 REAL(wp), PUBLIC :: rn_time_gd !: restoring time constant for gravity drainage (= 20 days) [s] 260 REAL(wp), PUBLIC :: rn_sal_fl !: restoring salinity for flushing [PSU] 261 REAL(wp), PUBLIC :: rn_time_fl !: restoring time constant for gravity drainage (= 10 days) [s] 262 REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU] 263 REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU] 264 265 ! !!** ice-mechanical redistribution namelist (namiceitdme) 266 REAL(wp), PUBLIC :: rn_cs !: fraction of shearing energy contributing to ridging 267 INTEGER , PUBLIC :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 268 REAL(wp), PUBLIC :: rn_gstar !: fractional area of young ice contributing to ridging 269 REAL(wp), PUBLIC :: rn_astar !: equivalent of G* for an exponential participation function 270 LOGICAL , PUBLIC :: ln_ridging !: ridging of ice or not 271 REAL(wp), PUBLIC :: rn_hstar !: thickness that determines the maximal thickness of ridged ice 272 REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value) 273 REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging 274 LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not 275 REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging 276 REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting 277 REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging 278 279 ! !!** some other parameters 159 280 INTEGER , PUBLIC :: nstart !: iteration number of the begining of the run 160 281 INTEGER , PUBLIC :: nlast !: iteration number of the end of the run … … 163 284 REAL(wp), PUBLIC :: rdt_ice !: ice time step 164 285 REAL(wp), PUBLIC :: r1_rdtice !: = 1. / rdt_ice 165 166 ! !!** ice-thickness distribution namelist (namiceitd) **167 INTEGER , PUBLIC :: nn_catbnd !: categories distribution following: tanh function (1), or h^(-alpha) function (2)168 REAL(wp), PUBLIC :: rn_himean !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only)169 170 ! !!** ice-dynamics namelist (namicedyn) **171 LOGICAL , PUBLIC :: ln_icestr_bvf !: use brine volume to diminish ice strength172 INTEGER , PUBLIC :: nn_icestr !: ice strength parameterization (0=Hibler79 1=Rothrock75)173 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling174 INTEGER , PUBLIC :: nn_ahi0 !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation)175 REAL(wp), PUBLIC :: rn_pe_rdg !: ridging work divided by pot. energy change in ridging, nn_icestr = 1176 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress177 REAL(wp), PUBLIC :: rn_pstar !: determines ice strength (N/M), Hibler JPO79178 REAL(wp), PUBLIC :: rn_crhg !: determines changes in ice strength179 REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9180 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve181 REAL(wp), PUBLIC :: rn_ahi0_ref !: sea-ice hor. eddy diffusivity coeff. (m2/s)182 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)183 184 ! !!** ice-salinity namelist (namicesal) **185 REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU]186 REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU]187 REAL(wp), PUBLIC :: rn_sal_gd !: restoring salinity for gravity drainage [PSU]188 REAL(wp), PUBLIC :: rn_sal_fl !: restoring salinity for flushing [PSU]189 REAL(wp), PUBLIC :: rn_time_gd !: restoring time constant for gravity drainage (= 20 days) [s]190 REAL(wp), PUBLIC :: rn_time_fl !: restoring time constant for gravity drainage (= 10 days) [s]191 REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity192 193 ! !!** ice-salinity namelist (namicesal) **194 INTEGER , PUBLIC :: nn_icesal !: salinity configuration used in the model195 ! ! 1 - constant salinity in both space and time196 ! ! 2 - prognostic salinity (s(z,t))197 ! ! 3 - salinity profile, constant in time198 INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)199 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0)200 LOGICAL , PUBLIC :: ln_it_qnsice !: iterate surface flux with changing surface temperature or not (F)201 202 ! !!** ice-mechanical redistribution namelist (namiceitdme)203 REAL(wp), PUBLIC :: rn_cs !: fraction of shearing energy contributing to ridging204 REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging205 REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging206 REAL(wp), PUBLIC :: rn_gstar !: fractional area of young ice contributing to ridging207 REAL(wp), PUBLIC :: rn_astar !: equivalent of G* for an exponential participation function208 REAL(wp), PUBLIC :: rn_hstar !: thickness that determines the maximal thickness of ridged ice209 REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging210 REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting211 REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value)212 REAL(wp), PUBLIC :: rn_betas !: coef. for partitioning of snowfall between leads and sea ice213 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]214 REAL(wp), PUBLIC :: nn_conv_dif !: maximal number of iterations for heat diffusion215 REAL(wp), PUBLIC :: rn_terr_dif !: maximal tolerated error (C) for heat diffusion216 217 ! !!** ice-mechanical redistribution namelist (namiceitdme)218 LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not219 INTEGER , PUBLIC :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)220 221 REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( rn_ecc * rn_ecc )222 REAL(wp), PUBLIC :: rhoco !: = rau0 * cio223 286 REAL(wp), PUBLIC :: r1_nlay_i !: 1 / nlay_i 224 287 REAL(wp), PUBLIC :: r1_nlay_s !: 1 / nlay_s 225 ! 226 ! !!** switch for presence of ice or not 227 REAL(wp), PUBLIC :: rswitch 228 ! 229 ! !!** define some parameters 288 REAL(wp), PUBLIC :: rswitch !: switch for the presence of ice (1) or not (0) 230 289 REAL(wp), PUBLIC, PARAMETER :: epsi06 = 1.e-06_wp !: small number 231 290 REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_wp !: small number 232 291 REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number 233 292 234 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s]236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ust2s, hicol !: friction velocity, ice collection thickness accreted in leads237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strp1, strp2 !: strength at previous time steps238 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength 293 ! !!** define arrays 294 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics 295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicol !: ice collection thickness accreted in leads 297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength !: ice strength 239 298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress1_i, stress2_i, stress12_i !: 1st, 2nd & diagonal stress tensor element 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i !: ice rheology elta factor (Flato & Hibler 95) [s-1] 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i !: Divergence of the velocity field [s-1] 301 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 243 302 ! 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Average Sea-Ice Surface Temperature [Kelvin]245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icethi !: total ice thickness (for all categories) (diag only)246 303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 247 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction … … 252 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 253 310 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow/ice sublimation [kg.m-2.s-1] 257 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange [kg.m-2.s-1] 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg.m-2.s-1] 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg.m-2.s-1] 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg.m-2.s-1] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg.m-2.s-1] 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg.m-2.s-1] 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg.m-2.s-1] 311 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow/ice sublimation [kg.m-2.s-1] 314 315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange [kg.m-2.s-1] 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg.m-2.s-1] 317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg.m-2.s-1] 318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg.m-2.s-1] 319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg.m-2.s-1] 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg.m-2.s-1] 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_lam !: lateral melt component of wfx_ice [kg.m-2.s-1] 323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg.m-2.s-1] 266 324 267 325 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1] … … 271 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] 272 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s] 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice growth/melt [PSU/m2/s] 273 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice growth/melt [PSU/m2/s] 274 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to ice growth/melt [PSU/m2/s] … … 302 361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness [W.m-2] 303 362 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ,:) :: ftr_ice !: transmitted solar radiation under ice305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D , pahv3D306 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: rn_amax_2d !: maximum ice concentration 2d array363 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array 364 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 365 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points 307 366 308 367 !!-------------------------------------------------------------------------- … … 310 369 !!-------------------------------------------------------------------------- 311 370 !! Variables defined for each ice category 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i !: Ice thickness (m)313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration)314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m)315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area(m)316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_s !: Snow thickness (m)317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K)318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sm_i !: Sea-Ice Bulk salinity (ppt)319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: smv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m)320 ! ! this is an extensive variable that has to be transported321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (days)322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o v_i !: Sea-Ice Age times volume per area (days.m)323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (days)371 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i !: Ice thickness (m) 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 373 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 374 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area(m) 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_s !: Snow thickness (m) 376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K) 377 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sm_i !: Sea-Ice Bulk salinity (ppt) 378 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: smv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m) 379 ! ! this is an extensive variable that has to be transported 380 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (days) 381 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (days) 382 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume 324 383 325 384 !! Variables summed over all categories, or associated to all the ice in a single grid cell 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tio_u, tio_v !: components of the ice-ocean stress (N/m2) 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ot_i !: mean age over all categories 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 334 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bv_i !: brine volume averaged over all categories 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 336 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 338 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 385 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 387 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 388 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 389 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content 390 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 391 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories 392 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 393 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories 394 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htm_i !: mean ice thickness over all categories 395 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htm_s !: mean snow thickness over all categories 396 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories 397 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction with bathy (landfast param activated) 398 399 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 400 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 339 401 340 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i 341 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i 342 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i 402 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 403 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [J/m2] 404 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i !: ice salinities [PSU] 343 405 344 406 !!-------------------------------------------------------------------------- … … 362 424 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures 363 425 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity 426 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total) 364 427 365 428 !!-------------------------------------------------------------------------- … … 368 431 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 369 432 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 370 371 !!--------------------------------------------------------------------------372 !! * Ice Run373 !!--------------------------------------------------------------------------374 ! !!: ** Namelist namicerun read in sbc_lim_init **375 INTEGER , PUBLIC :: jpl !: number of ice categories376 INTEGER , PUBLIC :: nlay_i !: number of ice layers377 INTEGER , PUBLIC :: nlay_s !: number of snow layers378 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input)379 CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory380 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output)381 CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory382 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F)383 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F)384 REAL(wp) , PUBLIC :: rn_amax_n !: maximum ice concentration Northern hemisphere385 REAL(wp) , PUBLIC :: rn_amax_s !: maximum ice concentration Southern hemisphere386 INTEGER , PUBLIC :: iiceprt !: debug i-point387 INTEGER , PUBLIC :: jiceprt !: debug j-point388 433 ! 389 434 !!-------------------------------------------------------------------------- 390 435 !! * Ice diagnostics 391 436 !!-------------------------------------------------------------------------- 392 ! Increment of global variables393 437 ! thd refers to changes induced by thermodynamics 394 438 ! trp '' '' '' advection (transport of ice) 395 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 396 LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F) 439 ! 397 440 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 398 441 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume … … 419 462 INTEGER :: ice_alloc 420 463 ! 421 INTEGER :: ierr(1 7), ii464 INTEGER :: ierr(15), ii 422 465 !!----------------------------------------------------------------- 423 466 … … 427 470 ! stay within Fortran's max-line length limit. 428 471 ii = 1 429 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 430 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , & 431 & ust2s (jpi,jpj) , hicol (jpi,jpj) , & 432 & strp1 (jpi,jpj) , strp2 (jpi,jpj) , strength (jpi,jpj) , & 433 & stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , & 434 & delta_i (jpi,jpj) , divu_i (jpi,jpj) , shear_i (jpi,jpj) , STAT=ierr(ii) ) 435 436 ii = ii + 1 437 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , & 438 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 439 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , & 472 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 473 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , hicol (jpi,jpj) , & 474 & strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , & 475 & delta_i (jpi,jpj) , divu_i (jpi,jpj) , shear_i (jpi,jpj) , STAT=ierr(ii) ) 476 477 ii = ii + 1 478 ALLOCATE( t_bo (jpi,jpj) , frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 479 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) , & 440 480 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 441 481 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 442 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , & 443 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), pahu3D(jpi,jpj,jpl+1), pahv3D(jpi,jpj,jpl+1), & 444 & rn_amax_2d (jpi,jpj) , qlead (jpi,jpj) , & 445 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj), & 446 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 482 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj), & 483 & fhtur (jpi,jpj) , qlead (jpi,jpj) , & 484 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , & 485 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 447 486 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , & 448 & hfx_ err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) ,&449 & hfx_ in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,&450 & hfx_ sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,&451 & hfx_ thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj), STAT=ierr(ii) )487 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld (jpi,jpj) , & 488 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , & 489 & hfx_opw(jpi,jpj) , hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , & 490 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) , STAT=ierr(ii) ) 452 491 453 492 ! * Ice global state variables 454 493 ii = ii + 1 455 ALLOCATE( ht_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & 456 & v_s (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 457 & sm_i (jpi,jpj,jpl) , smv_i(jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 458 & ov_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 459 ii = ii + 1 460 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(jpi,jpj) , & 494 ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) , & 495 & ht_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & 496 & v_s (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 497 & sm_i (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 498 & oa_i (jpi,jpj,jpl) , bv_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 499 ii = ii + 1 500 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , & 461 501 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) , & 462 & et_i (jpi,jpj) , et_s (jpi,jpj) , ot_i (jpi,jpj) , tm_i (jpi,jpj) , & 463 & bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) ) 502 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) , & 503 & smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) , & 504 & om_i (jpi,jpj) , tau_icebfr(jpi,jpj) , STAT=ierr(ii) ) 464 505 ii = ii + 1 465 506 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) … … 488 529 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 489 530 & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , & 490 & oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 531 & oa_i_b (jpi,jpj,jpl) , STAT=ierr(ii) ) 532 ii = ii + 1 533 ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) ) 491 534 492 535 ! * Ice thickness distribution variables … … 496 539 ! * Ice diagnostics 497 540 ii = ii + 1 498 ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj), &499 & diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj), diag_heat (jpi,jpj), &500 & diag_smvi (jpi,jpj) , diag_vice (jpi,jpj), diag_vsnw (jpi,jpj), STAT=ierr(ii) )541 ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj), & 542 & diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat (jpi,jpj), & 543 & diag_smvi (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), STAT=ierr(ii) ) 501 544 502 545 ice_alloc = MAXVAL( ierr(:) ) 503 IF( ice_alloc /= 0 ) CALL ctl_warn('ice_alloc _2: failed to allocate arrays.')546 IF( ice_alloc /= 0 ) CALL ctl_warn('ice_alloc: failed to allocate arrays.') 504 547 ! 505 548 END FUNCTION ice_alloc … … 513 556 !!====================================================================== 514 557 END MODULE ice 515 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r6416 r7646 18 18 USE phycst ! physical constants 19 19 USE ice ! LIM-3 variables 20 USE dom_ice ! LIM-3 domain21 20 USE dom_oce ! ocean domain 22 21 USE in_out_manager ! I/O manager … … 165 164 !! + test if ice concentration and volume are > 0 166 165 !! 167 !! ** Method : This is an online diagnostics which can be activated with ln_limdia hsb=true166 !! ** Method : This is an online diagnostics which can be activated with ln_limdiachk=true 168 167 !! It prints in ocean.output if there is a violation of conservation at each time-step 169 168 !! The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to … … 185 184 ! salt flux 186 185 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 187 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) 186 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 188 187 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 189 188 190 189 ! water flux 191 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &192 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) 190 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 191 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:) & 193 192 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 194 193 … … 210 209 ! salt flux 211 210 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 212 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) 211 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 213 212 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 214 213 215 214 ! water flux 216 zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &217 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) &215 zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 216 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:) & 218 217 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 219 218 … … 260 259 & cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 261 260 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 261 IF ( zamax > 1._wp ) WRITE(numout,*) 'violation a_i>1 (',cd_routine,') = ',zamax 262 262 ENDIF 263 263 IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin … … 274 274 !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 275 275 !! 276 !! ** Method : This is an online diagnostics which can be activated with ln_limdia hsb=true276 !! ** Method : This is an online diagnostics which can be activated with ln_limdiachk=true 277 277 !! It prints in ocean.output if there is a violation of conservation at each time-step 278 278 !! The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to … … 286 286 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 287 287 288 #if ! defined key_bdy289 288 ! heat flux 290 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - SUM( qevap_ice * a_i_b, dim=3 ) ) & 291 & * e1e2t * tmask(:,:,1) * zconv ) 289 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es & 290 ! & - SUM( qevap_ice * a_i_b, dim=3 ) & !!clem: I think this line must be commented (but need check) 291 & ) * e1e2t * tmask(:,:,1) * zconv ) 292 292 ! salt flux 293 293 zsfx = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday … … 304 304 IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx [psu*Mt/day] (',cd_routine,') = ',(zsfx) 305 305 IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx [GW] (',cd_routine,') = ',(zhfx) 306 #endif307 306 308 307 END SUBROUTINE lim_cons_final -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
r5836 r7646 5 5 !!====================================================================== 6 6 !! History : 3.5 ! 2015-01 (M. Vancoppenolle) Original code 7 !! 3.7 ! 2016-10 (C. Rousset) Add routine lim_prt3D 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 12 13 !! lim_ctl : control prints in case of crash 13 14 !! lim_prt : ice control print at a given grid point 15 !! lim_prt3D : control prints of ice arrays 14 16 !!---------------------------------------------------------------------- 15 17 USE oce ! ocean dynamics and tracers … … 17 19 USE ice ! LIM-3: ice variables 18 20 USE thd_ice ! LIM-3: thermodynamical variables 19 USE dom_ice ! LIM-3: ice domain20 21 USE sbc_oce ! Surface boundary condition: ocean fields 21 22 USE sbc_ice ! Surface boundary condition: ice fields … … 35 36 PUBLIC lim_ctl 36 37 PUBLIC lim_prt 38 PUBLIC lim_prt3D 37 39 38 40 !! * Substitutions … … 445 447 END SUBROUTINE lim_prt 446 448 449 SUBROUTINE lim_prt3D( cd_routine ) 450 !!--------------------------------------------------------------------------------------------------------- 451 !! *** ROUTINE lim_prt3D *** 452 !! 453 !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated 454 !! 455 !!--------------------------------------------------------------------------------------------------------- 456 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 457 INTEGER :: jk, jl ! dummy loop indices 458 459 CALL prt_ctl_info(' ========== ') 460 CALL prt_ctl_info( cd_routine ) 461 CALL prt_ctl_info(' ========== ') 462 CALL prt_ctl_info(' - Cell values : ') 463 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 464 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' cell area :') 465 CALL prt_ctl(tab2d_1=at_i , clinfo1=' at_i :') 466 CALL prt_ctl(tab2d_1=ato_i , clinfo1=' ato_i :') 467 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' vt_i :') 468 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' vt_s :') 469 CALL prt_ctl(tab2d_1=divu_i , clinfo1=' divu_i :') 470 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' delta_i :') 471 CALL prt_ctl(tab2d_1=stress1_i , clinfo1=' stress1_i :') 472 CALL prt_ctl(tab2d_1=stress2_i , clinfo1=' stress2_i :') 473 CALL prt_ctl(tab2d_1=stress12_i , clinfo1=' stress12_i :') 474 CALL prt_ctl(tab2d_1=strength , clinfo1=' strength :') 475 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' delta_i :') 476 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 477 478 DO jl = 1, jpl 479 CALL prt_ctl_info(' ') 480 CALL prt_ctl_info(' - Category : ', ivar1=jl) 481 CALL prt_ctl_info(' ~~~~~~~~~~') 482 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' ht_i : ') 483 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' ht_s : ') 484 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' t_su : ') 485 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' t_snow : ') 486 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' sm_i : ') 487 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' o_i : ') 488 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' a_i : ') 489 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' v_i : ') 490 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' v_s : ') 491 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' e_i1 : ') 492 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' e_snow : ') 493 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' smv_i : ') 494 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' oa_i : ') 495 496 DO jk = 1, nlay_i 497 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 498 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i : ') 499 END DO 500 END DO 501 502 CALL prt_ctl_info(' ') 503 CALL prt_ctl_info(' - Heat / FW fluxes : ') 504 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 505 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 506 CALL prt_ctl(tab2d_1=qsr , clinfo1= ' qsr : ', tab2d_2=qns , clinfo2= ' qns : ') 507 CALL prt_ctl(tab2d_1=emp , clinfo1= ' emp : ', tab2d_2=sfx , clinfo2= ' sfx : ') 508 509 CALL prt_ctl_info(' ') 510 CALL prt_ctl_info(' - Stresses : ') 511 CALL prt_ctl_info(' ~~~~~~~~~~ ') 512 CALL prt_ctl(tab2d_1=utau , clinfo1= ' utau : ', tab2d_2=vtau , clinfo2= ' vtau : ') 513 CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ') 514 CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ') 515 516 END SUBROUTINE lim_prt3D 517 447 518 #else 448 519 !!-------------------------------------------------------------------------- … … 454 525 SUBROUTINE lim_prt ! Empty routine 455 526 END SUBROUTINE lim_prt 527 SUBROUTINE lim_prt3D ! Empty routine 528 END SUBROUTINE lim_prt3D 456 529 #endif 457 530 !!====================================================================== -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r6418 r7646 14 14 !!---------------------------------------------------------------------- 15 15 USE ice ! LIM-3: sea-ice variable 16 USE dom_ice ! LIM-3: sea-ice domain17 16 USE dom_oce ! ocean domain 18 17 USE sbc_oce ! surface boundary condition: ocean fields … … 31 30 32 31 PUBLIC lim_diahsb ! routine called by ice_step.F90 33 34 real(wp) :: frc_sal, frc_vol ! global forcing trends 35 real(wp) :: bg_grme ! global ice growth+melt trends 36 32 PUBLIC lim_diahsb_init ! routine called in sbcice_lim.F90 33 34 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 35 REAL(wp) :: frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot ! global forcing trends 36 37 37 !! * Substitutions 38 38 # include "vectopt_loop_substitute.h90" … … 46 46 CONTAINS 47 47 48 SUBROUTINE lim_diahsb 48 SUBROUTINE lim_diahsb( kt ) 49 49 !!--------------------------------------------------------------------------- 50 50 !! *** ROUTINE lim_diahsb *** … … 53 53 !! 54 54 !!--------------------------------------------------------------------------- 55 INTEGER, INTENT(in) :: kt ! number of iteration 55 56 !! 56 real(wp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 57 real(wp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, & 58 & zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub 59 real(wp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 60 real(wp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub 61 real(wp) :: zbg_hfx_dhc, zbg_hfx_spr 62 real(wp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in 63 real(wp) :: zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 64 real(wp) :: z_frc_vol, z_frc_sal, z_bg_grme 65 real(wp) :: z1_area ! - - 66 REAL(wp) :: ztmp 57 real(wp) :: zbg_ivol, zbg_svol, zbg_area, zbg_isal, zbg_item ,zbg_stem 58 REAL(wp) :: z_frc_voltop, z_frc_volbot, z_frc_sal, z_frc_temtop, z_frc_tembot 59 REAL(wp) :: zdiff_vol, zdiff_sal, zdiff_tem 67 60 !!--------------------------------------------------------------------------- 68 61 IF( nn_timing == 1 ) CALL timing_start('lim_diahsb') 69 62 70 IF( numit == nstart ) CALL lim_diahsb_init 71 72 ! 1/area 73 z1_area = 1._wp / MAX( glob_sum( e1e2t(:,:) * tmask(:,:,1) ), epsi06 ) 74 75 rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1e2t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 76 ! ----------------------- ! 77 ! 1 - Content variations ! 78 ! ----------------------- ! 79 zbg_ivo = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume ice 80 zbg_svo = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume snow 81 zbg_are = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! area 82 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) ) ! mean salt content 83 zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! mean temp content 84 85 !zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 86 !zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 87 88 ! Volume 89 ztmp = rswitch * z1_area * r1_rau0 * rday 90 zbg_vfx = ztmp * glob_sum( emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 91 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 92 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 93 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 94 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 95 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 96 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 97 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 98 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 99 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 100 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 101 102 ! Salt 103 zbg_sfx = ztmp * glob_sum( sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 104 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 105 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 106 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 107 108 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 109 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 110 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 111 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 112 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 113 zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 114 115 ! Heat budget 116 zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * 1.e-20 ) ! ice heat content [1.e20 J] 117 zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 118 zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 119 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 120 121 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 122 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 123 zbg_hfx_res = glob_sum( hfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 124 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 125 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 126 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 127 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 128 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 129 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 130 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 131 zbg_hfx_out = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 132 zbg_hfx_in = glob_sum( hfx_in(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 133 134 ! --------------------------------------------- ! 135 ! 2 - Trends due to forcing and ice growth/melt ! 136 ! --------------------------------------------- ! 137 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 138 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! salt fluxes 139 z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 140 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 141 & wfx_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 142 ! 143 frc_vol = frc_vol + z_frc_vol * rdt_ice 144 frc_sal = frc_sal + z_frc_sal * rdt_ice 145 bg_grme = bg_grme + z_bg_grme * rdt_ice 63 ! ----------------------- ! 64 ! 1 - Contents ! 65 ! ----------------------- ! 66 zbg_ivol = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! ice volume (km3) 67 zbg_svol = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! snow volume (km3) 68 zbg_area = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-6 ) ! area (km2) 69 zbg_isal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt content (pss*km3) 70 zbg_item = glob_sum( et_i * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat content (1.e20 J) 71 zbg_stem = glob_sum( et_s * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat content (1.e20 J) 146 72 147 ! difference 148 !frc_vol = zbg_ivo - frc_vol 149 !frc_sal = zbg_sal - frc_sal 150 151 ! ----------------------- ! 152 ! 3 - Diagnostics writing ! 153 ! ----------------------- ! 154 rswitch = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 155 ! 156 IF( iom_use('ibgvoltot') ) & 157 CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9 ) ! ice volume (km3 equivalent liquid) 158 IF( iom_use('sbgvoltot') ) & 159 CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9 ) ! snw volume (km3 equivalent liquid) 160 IF( iom_use('ibgarea') ) & 161 CALL iom_put( 'ibgarea' , zbg_are * 1.e-6 ) ! ice area (km2) 162 IF( iom_use('ibgsaline') ) & 163 CALL iom_put( 'ibgsaline' , rswitch * zbg_sal / MAX( zbg_ivo, epsi06 ) ) ! ice saline (psu) 164 IF( iom_use('ibgtemper') ) & 165 CALL iom_put( 'ibgtemper' , rswitch * zbg_tem / MAX( zbg_ivo, epsi06 ) ) ! ice temper (C) 166 CALL iom_put( 'ibgheatco' , zbg_ihc ) ! ice heat content (1.e20 J) 167 CALL iom_put( 'sbgheatco' , zbg_shc ) ! snw heat content (1.e20 J) 168 IF( iom_use('ibgsaltco') ) & 169 CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) 170 171 CALL iom_put( 'ibgvfx' , zbg_vfx ) ! volume flux emp (m/day liquid) 172 CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 173 CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw ) ! volume flux open water growth - 174 CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni ) ! volume flux snow ice growth - 175 CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn ) ! volume flux dynamic growth - 176 CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom ) ! volume flux bottom melt - 177 CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum ) ! volume flux surface melt - 178 CALL iom_put( 'ibgvfxres' , zbg_vfx_res ) ! volume flux resultant - 179 CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr ) ! volume flux from snow precip - 180 CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw ) ! volume flux from snow melt - 181 CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub ) ! volume flux from sublimation - 182 183 CALL iom_put( 'ibgsfx' , zbg_sfx ) ! salt flux -(psu*m/day equivalent liquid) 184 CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri ) ! salt flux brines - 185 CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn ) ! salt flux dynamic - 186 CALL iom_put( 'ibgsfxres' , zbg_sfx_res ) ! salt flux result - 187 CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog ) ! salt flux bottom growth 188 CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw ) ! salt flux open water growth - 189 CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni ) ! salt flux snow ice growth - 190 CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom ) ! salt flux bottom melt - 191 CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum ) ! salt flux surface melt - 192 CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub ) ! salt flux sublimation - 193 194 CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc ) ! Heat content variation in snow and ice [W] 195 CALL iom_put( 'ibghfxspr' , zbg_hfx_spr ) ! Heat content of snow precip [W] 196 197 CALL iom_put( 'ibghfxres' , zbg_hfx_res ) ! 198 CALL iom_put( 'ibghfxsub' , zbg_hfx_sub ) ! 199 CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn ) ! 200 CALL iom_put( 'ibghfxthd' , zbg_hfx_thd ) ! 201 CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw ) ! 202 CALL iom_put( 'ibghfxsum' , zbg_hfx_sum ) ! 203 CALL iom_put( 'ibghfxbom' , zbg_hfx_bom ) ! 204 CALL iom_put( 'ibghfxbog' , zbg_hfx_bog ) ! 205 CALL iom_put( 'ibghfxdif' , zbg_hfx_dif ) ! 206 CALL iom_put( 'ibghfxopw' , zbg_hfx_opw ) ! 207 CALL iom_put( 'ibghfxout' , zbg_hfx_out ) ! 208 CALL iom_put( 'ibghfxin' , zbg_hfx_in ) ! 209 210 CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) 211 CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) 212 IF( iom_use('ibgvolgrm') ) & 213 CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 214 73 ! ---------------------------! 74 ! 2 - Trends due to forcing ! 75 ! ---------------------------! 76 z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! freshwater flux ice/snow-ocean 77 z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! freshwater flux ice/snow-atm 78 z_frc_sal = r1_rau0 * glob_sum( - sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt fluxes ice/snow-ocean 79 z_frc_tembot = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat on top of ocean (and below ice) 80 z_frc_temtop = glob_sum( hfx_in (:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat on top of ice-coean 81 ! 82 frc_voltop = frc_voltop + z_frc_voltop * rdt_ice ! km3 83 frc_volbot = frc_volbot + z_frc_volbot * rdt_ice ! km3 84 frc_sal = frc_sal + z_frc_sal * rdt_ice ! km3*pss 85 frc_temtop = frc_temtop + z_frc_temtop * rdt_ice ! 1.e20 J 86 frc_tembot = frc_tembot + z_frc_tembot * rdt_ice ! 1.e20 J 87 88 ! ----------------------- ! 89 ! 3 - Content variations ! 90 ! ----------------------- ! 91 zdiff_vol = r1_rau0 * glob_sum( ( rhoic * vt_i(:,:) + rhosn * vt_s(:,:) - vol_loc_ini(:,:) & ! freshwater trend (km3) 92 & ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) 93 zdiff_sal = r1_rau0 * glob_sum( ( rhoic * SUM( smv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) & ! salt content trend (km3*pss) 94 & ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) 95 zdiff_tem = glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) & ! heat content trend (1.e20 J) 96 ! & + SUM( qevap_ice * a_i_b, dim=3 ) & !! clem: I think this line should be commented (but needs a check) 97 & ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 ) 98 99 ! ----------------------- ! 100 ! 4 - Drifts ! 101 ! ----------------------- ! 102 zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 103 zdiff_sal = zdiff_sal - frc_sal 104 zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 105 106 ! ----------------------- ! 107 ! 5 - Diagnostics writing ! 108 ! ----------------------- ! 109 ! 110 IF( iom_use('ibgvolume') ) CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) 111 IF( iom_use('ibgsaltco') ) CALL iom_put( 'ibgsaltco' , zdiff_sal ) ! ice salt content drift (psu*km3 equivalent ocean water) 112 IF( iom_use('ibgheatco') ) CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 113 IF( iom_use('ibgheatfx') ) CALL iom_put( 'ibgheatfx' , zdiff_tem / & ! ice/snow heat flux drift (W/m2) 114 & glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 115 116 IF( iom_use('ibgfrcvoltop') ) CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) 117 IF( iom_use('ibgfrcvolbot') ) CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water) 118 IF( iom_use('ibgfrcsal') ) CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal - forcing (psu*km3 equivalent ocean water) 119 IF( iom_use('ibgfrctemtop') ) CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J) 120 IF( iom_use('ibgfrctembot') ) CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 121 IF( iom_use('ibgfrchfxtop') ) CALL iom_put( 'ibgfrchfxtop' , frc_temtop / & ! heat on top of ice/snw/ocean (W/m2) 122 & glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 123 IF( iom_use('ibgfrchfxbot') ) CALL iom_put( 'ibgfrchfxbot' , frc_tembot / & ! heat on top of ocean(below ice) (W/m2) 124 & glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 125 126 IF( iom_use('ibgvol_tot' ) ) CALL iom_put( 'ibgvol_tot' , zbg_ivol ) ! ice volume (km3) 127 IF( iom_use('sbgvol_tot' ) ) CALL iom_put( 'sbgvol_tot' , zbg_svol ) ! snow volume (km3) 128 IF( iom_use('ibgarea_tot') ) CALL iom_put( 'ibgarea_tot' , zbg_area ) ! ice area (km2) 129 IF( iom_use('ibgsalt_tot') ) CALL iom_put( 'ibgsalt_tot' , zbg_isal ) ! ice salinity content (pss*km3) 130 IF( iom_use('ibgheat_tot') ) CALL iom_put( 'ibgheat_tot' , zbg_item ) ! ice heat content (1.e20 J) 131 IF( iom_use('sbgheat_tot') ) CALL iom_put( 'sbgheat_tot' , zbg_stem ) ! snow heat content (1.e20 J) 215 132 ! 216 133 IF( lrst_ice ) CALL lim_diahsb_rst( numit, 'WRITE' ) 217 134 ! 218 135 IF( nn_timing == 1 ) CALL timing_stop('lim_diahsb') 219 !136 ! 220 137 END SUBROUTINE lim_diahsb 221 138 … … 233 150 !! - Compute coefficients for conversion 234 151 !!--------------------------------------------------------------------------- 235 INTEGER :: jk ! dummy loop indice236 152 INTEGER :: ierror ! local integer 237 153 !! … … 247 163 WRITE(numout,*) '~~~~~~~~~~~~' 248 164 ENDIF 249 ! 165 ! 166 ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ierror ) 167 IF( ierror > 0 ) THEN 168 CALL ctl_stop( 'lim_diahsb: unable to allocate vol_loc_ini' ) 169 RETURN 170 ENDIF 171 250 172 CALL lim_diahsb_rst( nstart, 'READ' ) !* read or initialize all required files 251 173 ! … … 263 185 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 264 186 ! 265 INTEGER :: id1, id2, id3 ! local integers266 187 !!---------------------------------------------------------------------- 267 188 ! 268 189 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 269 190 IF( ln_rstart ) THEN !* Read the restart file 270 !id1 = iom_varid( numrir, 'frc_vol' , ldstop = .TRUE. )271 191 ! 272 192 IF(lwp) WRITE(numout,*) '~~~~~~~' 273 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp 274 IF(lwp) WRITE(numout,*) '~~~~~~~' 275 CALL iom_get( numrir, 'frc_vol', frc_vol ) 276 CALL iom_get( numrir, 'frc_sal', frc_sal ) 277 CALL iom_get( numrir, 'bg_grme', bg_grme ) 193 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst read at it= ', kt,' date= ', ndastp 194 IF(lwp) WRITE(numout,*) '~~~~~~~' 195 CALL iom_get( numrir, 'frc_voltop' , frc_voltop ) 196 CALL iom_get( numrir, 'frc_volbot' , frc_volbot ) 197 CALL iom_get( numrir, 'frc_temtop' , frc_temtop ) 198 CALL iom_get( numrir, 'frc_tembot' , frc_tembot ) 199 CALL iom_get( numrir, 'frc_sal' , frc_sal ) 200 CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini ) 201 CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini ) 202 CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini ) 278 203 ELSE 279 204 IF(lwp) WRITE(numout,*) '~~~~~~~' 280 205 IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 281 206 IF(lwp) WRITE(numout,*) '~~~~~~~' 282 frc_vol = 0._wp 283 frc_sal = 0._wp 284 bg_grme = 0._wp 207 ! set trends to 0 208 frc_voltop = 0._wp 209 frc_volbot = 0._wp 210 frc_temtop = 0._wp 211 frc_tembot = 0._wp 212 frc_sal = 0._wp 213 ! record initial ice volume, salt and temp 214 vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:) ! ice/snow volume (kg/m2) 215 tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J) 216 sal_loc_ini(:,:) = rhoic * SUM( smv_i(:,:,:), dim=3 ) ! ice salt content (pss*kg/m2) 217 285 218 ENDIF 286 219 … … 288 221 ! ! ------------------- 289 222 IF(lwp) WRITE(numout,*) '~~~~~~~' 290 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp223 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst write at it= ', kt,' date= ', ndastp 291 224 IF(lwp) WRITE(numout,*) '~~~~~~~' 292 CALL iom_rstput( kt, nitrst, numriw, 'frc_vol' , frc_vol ) 293 CALL iom_rstput( kt, nitrst, numriw, 'frc_sal' , frc_sal ) 294 CALL iom_rstput( kt, nitrst, numriw, 'bg_grme' , bg_grme ) 225 CALL iom_rstput( kt, nitrst, numriw, 'frc_voltop' , frc_voltop ) 226 CALL iom_rstput( kt, nitrst, numriw, 'frc_volbot' , frc_volbot ) 227 CALL iom_rstput( kt, nitrst, numriw, 'frc_temtop' , frc_temtop ) 228 CALL iom_rstput( kt, nitrst, numriw, 'frc_tembot' , frc_tembot ) 229 CALL iom_rstput( kt, nitrst, numriw, 'frc_sal' , frc_sal ) 230 CALL iom_rstput( kt, nitrst, numriw, 'vol_loc_ini', vol_loc_ini ) 231 CALL iom_rstput( kt, nitrst, numriw, 'tem_loc_ini', tem_loc_ini ) 232 CALL iom_rstput( kt, nitrst, numriw, 'sal_loc_ini', sal_loc_ini ) 295 233 ! 296 234 ENDIF -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r5836 r7646 17 17 USE phycst ! physical constants 18 18 USE dom_oce ! ocean space and time domain 19 USE sbc_oce ! Surface boundary condition: ocean fields20 19 USE sbc_ice ! Surface boundary condition: ice fields 21 20 USE ice ! LIM-3 variables 22 USE dom_ice ! LIM-3 domain23 21 USE limrhg ! LIM-3 rheology 24 22 USE lbclnk ! lateral boundary conditions - MPP exchanges … … 26 24 USE wrk_nemo ! work arrays 27 25 USE in_out_manager ! I/O manager 28 USE prtctl ! Print control29 26 USE lib_fortran ! glob_sum 30 USE timing ! Timing 31 USE limcons ! conservation tests 27 USE timing ! Timing 28 USE limcons ! conservation tests 29 USE limctl ! control prints 32 30 USE limvar 33 31 … … 35 33 PRIVATE 36 34 37 PUBLIC lim_dyn ! routine called by ice_step 35 PUBLIC lim_dyn ! routine called by sbcice_lim.F90 36 PUBLIC lim_dyn_init ! routine called by sbcice_lim.F90 38 37 39 38 !! * Substitutions … … 50 49 !! *** ROUTINE lim_dyn *** 51 50 !! 52 !! ** Purpose : compute ice velocity and ocean-ice stress51 !! ** Purpose : compute ice velocity 53 52 !! 54 53 !! ** Method : … … 56 55 !! ** Action : - Initialisation 57 56 !! - Call of the dynamic routine for each hemisphere 58 !! - computation of the stress at the ocean surface59 !! - treatment of the case if no ice dynamic60 57 !!------------------------------------------------------------------------------------ 61 58 INTEGER, INTENT(in) :: kt ! number of iteration 62 59 !! 63 INTEGER :: ji, jj, jl, ja ! dummy loop indices 64 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 65 REAL(wp) :: zcoef ! local scalar 66 REAL(wp), POINTER, DIMENSION(:) :: zswitch ! i-averaged indicator of sea-ice 67 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 68 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io ! ice-ocean velocity 69 ! 60 INTEGER :: jl, jk ! dummy loop indices 70 61 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 71 62 !!--------------------------------------------------------------------- … … 73 64 IF( nn_timing == 1 ) CALL timing_start('limdyn') 74 65 75 CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 76 CALL wrk_alloc( jpj, zswitch, zmsk ) 77 78 CALL lim_var_agg(1) ! aggregate ice categories 79 80 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) 81 82 IF( ln_limdyn ) THEN 83 ! 84 ! conservation test 85 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 86 87 u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 88 v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 89 90 ! Rheology (ice dynamics) 91 ! ======== 92 93 ! Define the j-limits where ice rheology is computed 94 ! --------------------------------------------------- 95 96 IF( lk_mpp .OR. lk_mpp_rep ) THEN ! mpp: compute over the whole domain 97 i_j1 = 1 98 i_jpj = jpj 99 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 100 CALL lim_rhg( i_j1, i_jpj ) 101 ELSE ! optimization of the computational area 102 ! 103 DO jj = 1, jpj 104 zswitch(jj) = SUM( 1.0 - at_i(:,jj) ) ! = REAL(jpj) if ocean everywhere on a j-line 105 zmsk (jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line 106 END DO 107 108 IF( l_jeq ) THEN ! local domain include both hemisphere 109 ! ! Rheology is computed in each hemisphere 110 ! ! only over the ice cover latitude strip 111 ! Northern hemisphere 112 i_j1 = njeq 113 i_jpj = jpj 114 DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 115 i_j1 = i_j1 + 1 116 END DO 117 i_j1 = MAX( 1, i_j1-2 ) 118 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : NH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 119 CALL lim_rhg( i_j1, i_jpj ) 120 ! 121 ! Southern hemisphere 122 i_j1 = 1 123 i_jpj = njeq 124 DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 125 i_jpj = i_jpj - 1 126 END DO 127 i_jpj = MIN( jpj, i_jpj+1 ) 128 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : SH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 129 ! 130 CALL lim_rhg( i_j1, i_jpj ) 131 ! 132 ELSE ! local domain extends over one hemisphere only 133 ! ! Rheology is computed only over the ice cover 134 ! ! latitude strip 135 i_j1 = 1 136 DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 137 i_j1 = i_j1 + 1 138 END DO 139 i_j1 = MAX( 1, i_j1-2 ) 140 141 i_jpj = jpj 142 DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 ) 143 i_jpj = i_jpj - 1 144 END DO 145 i_jpj = MIN( jpj, i_jpj+1) 146 ! 147 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : one hemisphere: i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 148 ! 149 CALL lim_rhg( i_j1, i_jpj ) 150 ! 151 ENDIF 152 ! 153 ENDIF 154 155 ! computation of friction velocity 156 ! -------------------------------- 157 ! ice-ocean velocity at U & V-points (u_ice v_ice at U- & V-points ; ssu_m, ssv_m at U- & V-points) 158 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 159 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 160 ! frictional velocity at T-point 161 zcoef = 0.5_wp * rn_cio 162 DO jj = 2, jpjm1 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 ust2s(ji,jj) = zcoef * ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 165 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1) 166 END DO 167 END DO 168 ! 169 ! conservation test 170 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 171 ! 172 ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean 173 ! 174 zcoef = SQRT( 0.5_wp ) * r1_rau0 175 DO jj = 2, jpjm1 176 DO ji = fs_2, fs_jpim1 ! vector opt. 177 ust2s(ji,jj) = zcoef * SQRT( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 178 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1) 179 END DO 180 END DO 181 ! 182 ENDIF 183 CALL lbc_lnk( ust2s, 'T', 1. ) ! T-point 184 185 IF(ln_ctl) THEN ! Control print 186 CALL prt_ctl_info(' ') 187 CALL prt_ctl_info(' - Cell values : ') 188 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 189 CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 190 CALL prt_ctl(tab2d_1=divu_i , clinfo1=' lim_dyn : divu_i :') 191 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' lim_dyn : delta_i :') 192 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_dyn : strength :') 193 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_dyn : cell area :') 194 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_dyn : at_i :') 195 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_dyn : vt_i :') 196 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_dyn : vt_s :') 197 CALL prt_ctl(tab2d_1=stress1_i , clinfo1=' lim_dyn : stress1_i :') 198 CALL prt_ctl(tab2d_1=stress2_i , clinfo1=' lim_dyn : stress2_i :') 199 CALL prt_ctl(tab2d_1=stress12_i, clinfo1=' lim_dyn : stress12_i:') 66 CALL lim_var_agg(1) ! aggregate ice categories 67 ! 68 ! conservation test 69 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 71 ! ice velocities before rheology 72 u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 73 v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 74 75 ! Landfast ice parameterization: define max bottom friction 76 tau_icebfr(:,:) = 0._wp 77 IF( ln_landfast ) THEN 200 78 DO jl = 1, jpl 201 CALL prt_ctl_info(' ') 202 CALL prt_ctl_info(' - Category : ', ivar1=jl) 203 CALL prt_ctl_info(' ~~~~~~~~~~') 204 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_dyn : a_i : ') 205 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_dyn : ht_i : ') 206 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_dyn : ht_s : ') 207 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_dyn : v_i : ') 208 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_dyn : v_s : ') 209 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_dyn : e_s : ') 210 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_dyn : t_su : ') 211 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_dyn : t_snow : ') 212 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_dyn : sm_i : ') 213 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_dyn : smv_i : ') 214 DO ja = 1, nlay_i 215 CALL prt_ctl_info(' ') 216 CALL prt_ctl_info(' - Layer : ', ivar1=ja) 217 CALL prt_ctl_info(' ~~~~~~~') 218 CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_dyn : t_i : ') 219 CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_dyn : e_i : ') 220 END DO 79 WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma ) tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 221 80 END DO 222 81 ENDIF 82 83 ! Rheology (ice dynamics) 84 ! ======== 85 CALL lim_rhg 223 86 ! 224 CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 225 CALL wrk_dealloc( jpj, zswitch, zmsk ) 87 ! conservation test 88 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 89 90 ! Control prints 91 IF( ln_ctl ) CALL lim_prt3D( 'limdyn' ) 226 92 ! 227 93 IF( nn_timing == 1 ) CALL timing_stop('limdyn') … … 243 109 !!------------------------------------------------------------------- 244 110 INTEGER :: ios ! Local integer output status for namelist read 245 NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, & 246 & nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref 247 INTEGER :: ji, jj 248 REAL(wp) :: za00, zd_max 111 NAMELIST/namicedyn/ nn_limadv, nn_limadv_ord, & 112 & nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, & 113 & nn_nevp, rn_relast, ln_landfast, rn_gamma, rn_icebfr, rn_lfrelax 249 114 !!------------------------------------------------------------------- 250 115 … … 262 127 WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics ' 263 128 WRITE(numout,*) '~~~~~~~~~~~~' 264 WRITE(numout,*)' ice strength parameterization (0=Hibler 1=Rothrock) nn_icestr = ', nn_icestr 265 WRITE(numout,*)' Including brine volume in ice strength comp. ln_icestr_bvf = ', ln_icestr_bvf 266 WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging rn_pe_rdg = ', rn_pe_rdg 267 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio 268 WRITE(numout,*) ' first bulk-rheology parameter rn_pstar = ', rn_pstar 269 WRITE(numout,*) ' second bulk-rhelogy parameter rn_crhg = ', rn_crhg 270 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 271 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 272 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 273 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 274 WRITE(numout,*) ' horizontal diffusivity calculation nn_ahi0 = ', nn_ahi0 275 WRITE(numout,*) ' horizontal diffusivity coeff. (orca2 grid) rn_ahi0_ref = ', rn_ahi0_ref 129 ! limtrp 130 WRITE(numout,*)' choose the advection scheme (-1=Prather, 0=Ulimate-Macho) nn_limadv = ', nn_limadv 131 WRITE(numout,*)' choose the order of the scheme (if ultimate) nn_limadv_ord = ', nn_limadv_ord 132 ! limrhg 133 WRITE(numout,*)' ice strength parameterization (0=Hibler 1=Rothrock) nn_icestr = ', nn_icestr 134 WRITE(numout,*)' Including brine volume in ice strength comp. ln_icestr_bvf = ', ln_icestr_bvf 135 WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging rn_pe_rdg = ', rn_pe_rdg 136 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio 137 WRITE(numout,*) ' first bulk-rheology parameter rn_pstar = ', rn_pstar 138 WRITE(numout,*) ' second bulk-rhelogy parameter rn_crhg = ', rn_crhg 139 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 140 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 141 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 142 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 143 WRITE(numout,*) ' Landfast: param (T or F) ln_landfast = ', ln_landfast 144 WRITE(numout,*) ' Landfast: fraction of ocean depth that ice must reach rn_gamma = ', rn_gamma 145 WRITE(numout,*) ' Landfast: maximum bottom stress per unit area of contact rn_icebfr = ', rn_icebfr 146 WRITE(numout,*) ' Landfast: relax time scale (s-1) to reach static friction rn_lfrelax = ', rn_lfrelax 276 147 ENDIF 277 148 ! 278 usecc2 = 1._wp / ( rn_ecc * rn_ecc )279 rhoco = rau0 * rn_cio280 !281 ! Diffusion coefficients282 SELECT CASE( nn_ahi0 )283 284 CASE( 0 )285 ahiu(:,:) = rn_ahi0_ref286 ahiv(:,:) = rn_ahi0_ref287 288 IF(lwp) WRITE(numout,*) ''289 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim constant = rn_ahi0_ref'290 291 CASE( 1 )292 293 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )294 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain295 296 ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2297 ! (60° = min latitude for ice cover)298 ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp299 300 IF(lwp) WRITE(numout,*) ''301 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')'302 IF(lwp) WRITE(numout,*) ' value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp303 304 CASE( 2 )305 306 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )307 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain308 309 za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2310 ! (60° = min latitude for ice cover)311 DO jj = 1, jpj312 DO ji = 1, jpi313 ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1)314 ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1)315 END DO316 END DO317 !318 IF(lwp) WRITE(numout,*) ''319 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to e1'320 IF(lwp) WRITE(numout,*) ' maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max321 322 END SELECT323 324 149 END SUBROUTINE lim_dyn_init 325 150 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r6490 r7646 7 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 8 !! 1.0 ! 2002-08 (C. Ethe) F90, free form 9 !! 3. 0! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf (multiple)9 !! 3.6 ! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf (multiple) 10 10 !!---------------------------------------------------------------------- 11 11 #if defined key_lim3 … … 28 28 PRIVATE 29 29 30 PUBLIC lim_hdf ! called by lim_trp30 PUBLIC lim_hdf ! called by lim_trp 31 31 PUBLIC lim_hdf_init ! called by sbc_lim_init 32 32 33 33 LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call) 34 INTEGER :: nn_convfrq !: convergence check frequency of the Crant-Nicholson scheme35 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! metric coefficient 36 35 … … 44 43 CONTAINS 45 44 46 SUBROUTINE lim_hdf( ptab , ihdf_vars , jpl , nlay_i)45 SUBROUTINE lim_hdf( ptab, ihdf_vars ) 47 46 !!------------------------------------------------------------------- 48 47 !! *** ROUTINE lim_hdf *** … … 55 54 !! ** Action : update ptab with the diffusive contribution 56 55 !!------------------------------------------------------------------- 57 INTEGER :: jpl, nlay_i, isize, ihdf_vars 58 REAL(wp), DIMENSION(:,:,:), INTENT( inout ),TARGET :: ptab ! Field on which the diffusion is applied 59 ! 60 INTEGER :: ji, jj, jk, jl , jm ! dummy loop indices 61 INTEGER :: iter, ierr ! local integers 62 REAL(wp) :: zrlxint ! local scalars 63 REAL(wp), POINTER , DIMENSION ( : ) :: zconv ! local scalars 64 REAL(wp), POINTER , DIMENSION(:,:,:) :: zrlx,zdiv0, ztab0 65 REAL(wp), POINTER , DIMENSION(:,:) :: zflu, zflv, zdiv 66 CHARACTER(lc) :: charout ! local character 67 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure 68 REAL(wp), PARAMETER :: zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 69 INTEGER , PARAMETER :: its = 100 ! Maximum number of iteration 56 INTEGER, INTENT( in ) :: ihdf_vars ! number of fields to diffuse 57 REAL(wp), DIMENSION(:,:,:), INTENT( inout ), TARGET :: ptab ! Field on which the diffusion is applied 58 ! 59 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 60 INTEGER :: iter, ierr, isize ! local integers 61 REAL(wp) :: zrlxint 62 CHARACTER(lc) :: charout ! local character 63 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure 64 REAL(wp), PARAMETER :: zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit 65 INTEGER , PARAMETER :: num_iter_max = 100 ! Maximum number of iteration 66 INTEGER , PARAMETER :: num_convfrq = 5 ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization) 67 REAL(wp), POINTER, DIMENSION(:) :: zconv 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrlx, zdiv0, ztab0 69 REAL(wp), POINTER, DIMENSION(:,:) :: zflu, zflv, zdiv 70 70 !!------------------------------------------------------------------- 71 71 TYPE(arrayptr) , ALLOCATABLE, DIMENSION(:) :: pt2d_array, zrlx_array 72 CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) :: type_array ! define the nature of ptab array grid-points 73 ! ! = T , U , V , F , W and I points 74 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: psgn_array ! =-1 the sign change across the north fold boundary 75 76 !!--------------------------------------------------------------------- 77 72 CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) :: type_array ! define the nature of ptab array grid-points 73 ! ! = T , U , V , F , W and I points 74 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: psgn_array ! =-1 the sign change across the north fold boundary 75 !!------------------------------------------------------------------- 76 78 77 ! !== Initialisation ==! 79 78 ! +1 open water diffusion 80 isize = jpl *(ihdf_vars+nlay_i)+179 isize = jpl * ( ihdf_vars + nlay_i ) + 1 81 80 ALLOCATE( zconv (isize) ) 82 81 ALLOCATE( pt2d_array(isize) , zrlx_array(isize) ) 83 82 ALLOCATE( type_array(isize) ) 84 83 ALLOCATE( psgn_array(isize) ) 84 85 CALL wrk_alloc( jpi,jpj, zflu, zflv, zdiv ) 86 CALL wrk_alloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 ) 85 87 86 CALL wrk_alloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 87 CALL wrk_alloc( jpi, jpj, zflu, zflv, zdiv ) 88 89 DO jk= 1 , isize 90 pt2d_array(jk)%pt2d=>ptab(:,:,jk) 91 zrlx_array(jk)%pt2d=>zrlx(:,:,jk) 92 type_array(jk)='T' 93 psgn_array(jk)=1. 88 DO jk= 1, isize 89 pt2d_array(jk)%pt2d => ptab(:,:,jk) 90 zrlx_array(jk)%pt2d => zrlx(:,:,jk) 91 type_array(jk) = 'T' 92 psgn_array(jk) = 1. 94 93 END DO 95 94 … … 99 98 IF( lk_mpp ) CALL mpp_sum( ierr ) 100 99 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' ) 101 DO jj = 2, jpjm1 100 DO jj = 2, jpjm1 102 101 DO ji = fs_2 , fs_jpim1 ! vector opt. 103 102 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj) … … 106 105 linit = .FALSE. 107 106 ENDIF 108 ! ! Time integration parameters 109 ! 110 zflu (jpi,: ) = 0._wp 111 zflv (jpi,: ) = 0._wp 112 107 ! 108 ! Arrays initialization 109 zflu(jpi,:) = 0._wp 110 zflv(jpi,:) = 0._wp 113 111 DO jk=1 , isize 114 ztab0(:, : , jk ) = ptab(:,:,jk) ! Arrays initialization112 ztab0(:, : , jk ) = ptab(:,:,jk) 115 113 zdiv0(:, 1 , jk ) = 0._wp 116 114 zdiv0(:,jpj, jk ) = 0._wp … … 119 117 END DO 120 118 121 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! 122 iter = 0 123 ! 124 DO WHILE( MAXVAL(zconv(:)) > ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop 119 ! !== horizontal diffusion using a Crant-Nicholson scheme ==! 120 zconv(:) = 1._wp 121 iter = 0 122 ! 123 DO WHILE( MAXVAL( zconv(:) ) > ( 2._wp * 1.e-04 ) .AND. iter <= num_iter_max ) ! Sub-time step loop 125 124 ! 126 125 iter = iter + 1 ! incrementation of the sub-time step number 127 126 ! 128 127 DO jk = 1 , isize 129 jl = ( jk-1) /( ihdf_vars+nlay_i)+1130 IF ( zconv(jk) > ( 2._wp * 1.e-04 )) THEN128 jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1 129 IF ( zconv(jk) > ( 2._wp * 1.e-04 ) ) THEN 131 130 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 132 131 DO ji = 1 , fs_jpim1 ! vector opt. … … 159 158 CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 160 159 ! 161 IF ( MOD( iter-1 , nn_convfrq ) == 0 ) THEN !Convergence test every nn_convfrq iterations (perf. optimization ) 162 DO jk=1,isize 160 161 IF ( MOD( iter-1 , num_convfrq ) == 0 ) THEN ! Convergence test every num_convfrq iterations (perf. optimization ) 162 DO jk = 1, isize 163 163 zconv(jk) = 0._wp ! convergence test 164 164 DO jj = 2, jpjm1 … … 175 175 END DO 176 176 ! 177 END DO ! end of sub-time step loop 178 179 ! ----------------------- 180 !!! final step (clem) !!! 177 END DO ! end of sub-time step loop 178 179 ! --- final step --- ! 181 180 DO jk = 1, isize 182 jl = ( jk-1) /( ihdf_vars+nlay_i)+1181 jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1 183 182 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 184 183 DO ji = 1 , fs_jpim1 ! vector opt. … … 198 197 CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 199 198 200 !!! final step (clem) !!! 201 ! ----------------------- 202 199 ! 203 200 IF(ln_ctl) THEN 204 201 DO jk = 1 , isize … … 209 206 ENDIF 210 207 ! 211 CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0)212 CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv)213 208 CALL wrk_dealloc( jpi,jpj, zflu, zflv, zdiv ) 209 CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 ) 210 ! 214 211 DEALLOCATE( zconv ) 215 212 DEALLOCATE( pt2d_array , zrlx_array ) … … 219 216 END SUBROUTINE lim_hdf 220 217 221 222 218 223 219 SUBROUTINE lim_hdf_init … … 232 228 !!------------------------------------------------------------------- 233 229 INTEGER :: ios ! Local integer output status for namelist read 234 NAMELIST/namicehdf/ nn_convfrq 235 !!------------------------------------------------------------------- 236 ! 237 IF(lwp) THEN 238 WRITE(numout,*) 239 WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion' 240 WRITE(numout,*) '~~~~~~~' 241 ENDIF 230 NAMELIST/namicehdf/ nn_ahi0, rn_ahi0_ref 231 INTEGER :: ji, jj 232 REAL(wp) :: za00, zd_max 233 !!------------------------------------------------------------------- 242 234 ! 243 235 REWIND( numnam_ice_ref ) ! Namelist namicehdf in reference namelist : Ice horizontal diffusion … … 252 244 IF(lwp) THEN ! control print 253 245 WRITE(numout,*) 254 WRITE(numout,*)' Namelist of ice parameters for ice horizontal diffusion computation ' 255 WRITE(numout,*)' convergence check frequency of the Crant-Nicholson scheme nn_convfrq = ', nn_convfrq 246 WRITE(numout,*) 'lim_hdf_init : Ice horizontal diffusion' 247 WRITE(numout,*) '~~~~~~~~~~~' 248 WRITE(numout,*) ' horizontal diffusivity calculation nn_ahi0 = ', nn_ahi0 249 WRITE(numout,*) ' horizontal diffusivity coeff. (orca2 grid) rn_ahi0_ref = ', rn_ahi0_ref 256 250 ENDIF 251 ! 252 ! Diffusion coefficients 253 SELECT CASE( nn_ahi0 ) 254 255 CASE( 0 ) 256 ahiu(:,:) = rn_ahi0_ref 257 ahiv(:,:) = rn_ahi0_ref 258 259 IF(lwp) WRITE(numout,*) '' 260 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim constant = rn_ahi0_ref' 261 262 CASE( 1 ) 263 264 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 265 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 266 267 ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 268 ! (60deg = min latitude for ice cover) 269 ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 270 271 IF(lwp) WRITE(numout,*) '' 272 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 273 IF(lwp) WRITE(numout,*) ' value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp 274 275 CASE( 2 ) 276 277 zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 278 IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain 279 280 za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 281 ! (60deg = min latitude for ice cover) 282 DO jj = 1, jpj 283 DO ji = 1, jpi 284 ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 285 ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 286 END DO 287 END DO 288 ! 289 IF(lwp) WRITE(numout,*) '' 290 IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to e1' 291 IF(lwp) WRITE(numout,*) ' maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 292 293 END SELECT 257 294 ! 258 295 END SUBROUTINE lim_hdf_init … … 265 302 !!====================================================================== 266 303 END MODULE limhdf 267 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r6695 r7646 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2004-01 (C. Ethe, G. Madec) Original code 7 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation7 !! 3.0 ! 2011-02 (G. Madec) dynamical allocation 8 8 !! - ! 2014 (C. Rousset) add N/S initializations 9 9 !!---------------------------------------------------------------------- … … 23 23 USE ice ! sea-ice variables 24 24 USE par_oce ! ocean parameters 25 USE dom_ice ! sea-ice domain26 25 USE limvar ! lim_var_salprof 26 ! 27 27 USE in_out_manager ! I/O manager 28 28 USE lib_mpp ! MPP library … … 36 36 37 37 PUBLIC lim_istate ! routine called by lim_init.F90 38 39 ! !!** init namelist (namiceini) **40 REAL(wp) :: rn_thres_sst ! threshold water temperature for initial sea ice41 REAL(wp) :: rn_hts_ini_n ! initial snow thickness in the north42 REAL(wp) :: rn_hts_ini_s ! initial snow thickness in the south43 REAL(wp) :: rn_hti_ini_n ! initial ice thickness in the north44 REAL(wp) :: rn_hti_ini_s ! initial ice thickness in the south45 REAL(wp) :: rn_ati_ini_n ! initial leads area in the north46 REAL(wp) :: rn_ati_ini_s ! initial leads area in the south47 REAL(wp) :: rn_smi_ini_n ! initial salinity48 REAL(wp) :: rn_smi_ini_s ! initial salinity49 REAL(wp) :: rn_tmi_ini_n ! initial temperature50 REAL(wp) :: rn_tmi_ini_s ! initial temperature51 38 52 39 INTEGER , PARAMETER :: jpfldi = 6 ! maximum number of files to read … … 57 44 INTEGER , PARAMETER :: jp_tmi = 5 ! index of ice temp at T-point 58 45 INTEGER , PARAMETER :: jp_smi = 6 ! index of ice sali at T-point 59 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 60 61 LOGICAL :: ln_iceini ! initialization or not 62 LOGICAL :: ln_iceini_file ! Ice initialization state from 2D netcdf file 46 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 63 47 !!---------------------------------------------------------------------- 64 48 !! LIM 3.0, UCL-LOCEAN-IPSL (2008) … … 74 58 !! ** Purpose : defined the sea-ice initial state 75 59 !! 76 !! ** Method : 77 !! This routine will put some ice where ocean 60 !! ** Method : This routine will put some ice where ocean 78 61 !! is at the freezing point, then fill in ice 79 62 !! state variables using prescribed initial 80 63 !! values in the namelist 81 64 !! 82 !! ** Steps : 83 !! 1) Read namelist 65 !! ** Steps : 1) Read namelist 84 66 !! 2) Basal temperature; ice and hemisphere masks 85 67 !! 3) Fill in the ice thickness distribution using gaussian … … 96 78 !! 4.0 ! 09-11 (M. Vancoppenolle) Enhanced version for ice cats 97 79 !!-------------------------------------------------------------------- 98 99 !! * Local variables 100 INTEGER :: ji, jj, jk, jl ! dummy loop indices 101 REAL(wp) :: ztmelts, zdh 102 INTEGER :: i_hemis, i_fill, jl0 103 REAL(wp) :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 80 INTEGER :: ji, jj, jk, jl ! dummy loop indices 81 REAL(wp) :: ztmelts, zdh 82 INTEGER :: i_hemis, i_fill, jl0 83 REAL(wp) :: zarg, zV, zconv, zdv 104 84 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 105 85 REAL(wp), POINTER, DIMENSION(:,:) :: zht_i_ini, zat_i_ini, zvt_i_ini !data from namelist or nc file 106 86 REAL(wp), POINTER, DIMENSION(:,:) :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini, zv_i_ini !data by cattegories to fill 108 !-------------------------------------------------------------------- 109 110 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini, zv_i_ini ) 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini !data by cattegories to fill 88 INTEGER , POINTER, DIMENSION(:) :: itest 89 !-------------------------------------------------------------------- 90 91 CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 111 92 CALL wrk_alloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 112 93 CALL wrk_alloc( jpi, jpj, zswitch ) 94 Call wrk_alloc( 4, itest ) 113 95 114 96 IF(lwp) WRITE(numout,*) 115 IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization '116 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~'97 IF(lwp) WRITE(numout,*) 'lim_istate : sea-ice initialization ' 98 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ ' 117 99 118 100 !-------------------------------------------------------------------- 119 101 ! 1) Read namelist 120 102 !-------------------------------------------------------------------- 121 122 CALL lim_istate_init ! reading the initials parameters of the ice123 124 ! surface temperature125 DO jl = 1, jpl ! loop over categories103 ! 104 CALL lim_istate_init 105 106 ! init surface temperature 107 DO jl = 1, jpl 126 108 t_su (:,:,jl) = rt0 * tmask(:,:,1) 127 109 tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 128 110 END DO 129 111 130 ! basal temperature (considered at freezing point)112 ! init basal temperature (considered at freezing point) 131 113 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 132 114 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 133 115 134 116 135 IF( ln_iceini ) THEN 136 137 !-------------------------------------------------------------------- 138 ! 2) Basal temperature, ice mask and hemispheric index 139 !-------------------------------------------------------------------- 140 141 DO jj = 1, jpj ! ice if sst <= t-freez + ttest 142 DO ji = 1, jpi 143 IF( ( sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 144 zswitch(ji,jj) = 0._wp * tmask(ji,jj,1) ! no ice 145 ELSE 146 zswitch(ji,jj) = 1._wp * tmask(ji,jj,1) ! ice 147 ENDIF 148 END DO 149 END DO 150 151 !-------------------------------------------------------------------- 152 ! 3) Initialization of sea ice state variables 153 !-------------------------------------------------------------------- 154 IF( ln_iceini_file )THEN 155 117 !-------------------------------------------------------------------- 118 ! 2) Initialization of sea ice state variables 119 !-------------------------------------------------------------------- 120 IF( ln_limini ) THEN 121 ! 122 IF( ln_limini_file )THEN 123 ! 156 124 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 157 125 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) … … 160 128 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 161 129 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 162 163 ELSE ! ln_iceini_file = F 130 ! 131 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 132 ELSEWHERE ; zswitch(:,:) = 0._wp 133 END WHERE 134 ! 135 ELSE ! ln_limini_file = F 136 137 !-------------------------------------------------------------------- 138 ! 3) Basal temperature, ice mask 139 !-------------------------------------------------------------------- 140 ! no ice if sst <= t-freez + ttest 141 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 142 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 143 END WHERE 164 144 165 145 !----------------------------- … … 169 149 DO jj = 1, jpj 170 150 DO ji = 1, jpi 171 IF( f cor(ji,jj) >= 0._wp ) THEN172 zht_i_ini(ji,jj) = rn_hti_ini_n 173 zht_s_ini(ji,jj) = rn_hts_ini_n 174 zat_i_ini(ji,jj) = rn_ati_ini_n 175 zts_u_ini(ji,jj) = rn_tmi_ini_n 176 zsm_i_ini(ji,jj) = rn_smi_ini_n 177 ztm_i_ini(ji,jj) = rn_tmi_ini_n 151 IF( ff_t(ji,jj) >= 0._wp ) THEN 152 zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj) 153 zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj) 154 zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj) 155 zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 156 zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj) 157 ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj) 178 158 ELSE 179 zht_i_ini(ji,jj) = rn_hti_ini_s 180 zht_s_ini(ji,jj) = rn_hts_ini_s 181 zat_i_ini(ji,jj) = rn_ati_ini_s 182 zts_u_ini(ji,jj) = rn_tmi_ini_s 183 zsm_i_ini(ji,jj) = rn_smi_ini_s 184 ztm_i_ini(ji,jj) = rn_tmi_ini_s 159 zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj) 160 zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj) 161 zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj) 162 zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 163 zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj) 164 ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj) 185 165 ENDIF 186 166 END DO 187 167 END DO 188 189 ENDIF ! ln_ iceini_file190 168 ! 169 ENDIF ! ln_limini_file 170 191 171 zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) ! ice volume 192 193 172 !--------------------------------------------------------------------- 194 173 ! 3.2) Distribute ice concentration and thickness into the categories … … 199 178 zh_i_ini(:,:,:) = 0._wp 200 179 za_i_ini(:,:,:) = 0._wp 201 zv_i_ini(:,:,:) = 0._wp 202 180 ! 203 181 DO jj = 1, jpj 204 182 DO ji = 1, jpi 205 183 ! 206 184 IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 207 185 208 ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0 209 ! ztests = 0 210 211 DO i_fill = jpl, 1, -1 212 213 ! IF( ztests .NE. 4 ) THEN 214 IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN 215 !---------------------------- 216 ! fill the i_fill categories 217 !---------------------------- 218 ! *** 1 category to fill 219 IF ( i_fill .EQ. 1 ) THEN 220 zh_i_ini(ji,jj, 1) = zht_i_ini(ji,jj) 221 za_i_ini(ji,jj, 1) = zat_i_ini(ji,jj) 222 zh_i_ini(ji,jj,2:jpl) = 0._wp 223 za_i_ini(ji,jj,2:jpl) = 0._wp 224 ELSE 225 226 ! *** >1 categores to fill 227 !--- Ice thicknesses in the i_fill - 1 first categories 228 DO jl = 1, i_fill - 1 229 zh_i_ini(ji,jj,jl) = hi_mean(jl) 230 END DO 231 232 !--- jl0: most likely index where cc will be maximum 233 DO jl = 1, jpl 234 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. & 235 & ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 236 jl0 = jl 237 ENDIF 238 END DO 239 jl0 = MIN(jl0, i_fill) 240 241 !--- Concentrations 242 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 243 DO jl = 1, i_fill - 1 244 IF( jl .NE. jl0 )THEN 245 zsigma = 0.5 * zht_i_ini(ji,jj) 246 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / zsigma 247 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 248 ENDIF 249 END DO 250 251 zA = 0. ! sum of the areas in the jpl categories 252 DO jl = 1, i_fill - 1 253 zA = zA + za_i_ini(ji,jj,jl) 254 END DO 255 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - zA ! ice conc in the last category 256 IF ( i_fill .LT. jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 257 258 !--- Ice thickness in the last category 259 zV = 0. ! sum of the volumes of the N-1 categories 260 DO jl = 1, i_fill - 1 261 zV = zV + za_i_ini(ji,jj,jl)*zh_i_ini(ji,jj,jl) 262 END DO 263 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill) 264 IF ( i_fill .LT. jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 265 266 !--- volumes 267 zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:) 268 IF ( i_fill .LT. jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 269 270 ENDIF ! i_fill 271 272 !--------------------- 273 ! Compatibility tests 274 !--------------------- 275 ! Test 1: area conservation 276 zA_cons = SUM(za_i_ini(ji,jj,:)) ; zconv = ABS(zat_i_ini(ji,jj) - zA_cons ) 277 IF ( zconv .LT. 1.0e-6 ) THEN 278 ztest_1 = 1 279 ELSE 280 ztest_1 = 0 281 ENDIF 282 283 ! Test 2: volume conservation 284 zV_cons = SUM(zv_i_ini(ji,jj,:)) 285 zconv = ABS(zvt_i_ini(ji,jj) - zV_cons) 286 287 IF( zconv .LT. 1.0e-6 ) THEN 288 ztest_2 = 1 289 ELSE 290 ztest_2 = 0 291 ENDIF 292 293 ! Test 3: thickness of the last category is in-bounds ? 294 IF ( zh_i_ini(ji,jj,i_fill) > hi_max(i_fill-1) ) THEN 295 ztest_3 = 1 296 ELSE 297 ztest_3 = 0 298 ENDIF 299 300 ! Test 4: positivity of ice concentrations 301 ztest_4 = 1 302 DO jl = 1, jpl 303 IF ( za_i_ini(ji,jj,jl) .LT. 0._wp ) THEN 304 ztest_4 = 0 186 !--- jl0: most likely index where cc will be maximum 187 jl0 = jpl 188 DO jl = 1, jpl 189 IF ( ( zht_i_ini(ji,jj) > hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 190 jl0 = jl 191 CYCLE 192 ENDIF 193 END DO 194 ! 195 ! initialisation of tests 196 itest(:) = 0 197 198 i_fill = jpl + 1 !==================================== 199 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 200 ! iteration !==================================== 201 i_fill = i_fill - 1 202 203 ! initialisation of ice variables for each try 204 zh_i_ini(ji,jj,:) = 0._wp 205 za_i_ini(ji,jj,:) = 0._wp 206 itest(:) = 0 207 ! 208 ! *** case very thin ice: fill only category 1 209 IF ( i_fill == 1 ) THEN 210 zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 211 za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 212 213 ! *** case ice is thicker: fill categories >1 214 ELSE 215 216 ! Fill ice thicknesses in the (i_fill-1) cat by hmean 217 DO jl = 1, i_fill-1 218 zh_i_ini(ji,jj,jl) = hi_mean(jl) 219 END DO 220 ! 221 !--- Concentrations 222 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 223 DO jl = 1, i_fill - 1 224 IF( jl /= jl0 )THEN 225 zarg = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 226 za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 305 227 ENDIF 306 228 END DO 307 308 ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4 309 310 ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 311 312 END DO ! i_fill 313 314 IF(lwp) THEN 315 WRITE(numout,*) ' ztests : ', ztests 316 IF( ztests .NE. 4 )THEN 317 WRITE(numout,*) 318 WRITE(numout,*) ' !!!! ALERT !!! ' 319 WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 320 WRITE(numout,*) 321 WRITE(numout,*) ' *** ztests is not equal to 4 ' 322 WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 323 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 324 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 325 ENDIF ! ztests .NE. 4 229 ! 230 ! Concentration in the last (i_fill) category 231 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 232 233 ! Ice thickness in the last (i_fill) category 234 zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 235 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 236 237 ! clem: correction if concentration of upper cat is greater than lower cat 238 ! (it should be a gaussian around jl0 but sometimes it is not) 239 IF ( jl0 /= jpl ) THEN 240 DO jl = jpl, jl0+1, -1 241 IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 242 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 243 zh_i_ini(ji,jj,jl ) = 0._wp 244 za_i_ini(ji,jj,jl ) = 0._wp 245 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1) & 246 & + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 247 END IF 248 ENDDO 249 ENDIF 250 ! 251 ENDIF ! case ice is thick or thin 252 253 !--------------------- 254 ! Compatibility tests 255 !--------------------- 256 ! Test 1: area conservation 257 zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) ) 258 IF ( zconv < epsi06 ) itest(1) = 1 259 260 ! Test 2: volume conservation 261 zconv = ABS( zat_i_ini(ji,jj) * zht_i_ini(ji,jj) & 262 & - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 263 IF ( zconv < epsi06 ) itest(2) = 1 264 265 ! Test 3: thickness of the last category is in-bounds ? 266 IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 267 268 ! Test 4: positivity of ice concentrations 269 itest(4) = 1 270 DO jl = 1, i_fill 271 IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0 272 END DO 273 ! !============================ 274 END DO ! end iteration on categories 275 ! !============================ 276 ! 277 IF( lwp .AND. SUM(itest) /= 4 ) THEN 278 WRITE(numout,*) 279 WRITE(numout,*) ' !!!! ALERT itest is not equal to 4 !!! ' 280 WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 281 WRITE(numout,*) 282 WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 283 WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 284 WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 326 285 ENDIF 327 328 ENDIF ! zat_i_ini(ji,jj) > 0._wp .AND. zh m_i_ini(ji,jj) > 0._wp329 330 END DO331 END DO286 287 ENDIF ! zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp 288 ! 289 END DO 290 END DO 332 291 333 292 !--------------------------------------------------------------------- … … 373 332 smv_i = sm_i * v_i 374 333 ENDIF 375 334 376 335 ! Snow temperature and heat content 377 336 DO jk = 1, nlay_s … … 413 372 tn_ice (:,:,:) = t_su (:,:,:) 414 373 415 ELSE ! if ln_ iceini=false374 ELSE ! if ln_limini=false 416 375 a_i (:,:,:) = 0._wp 417 376 v_i (:,:,:) = 0._wp … … 436 395 END DO 437 396 438 ENDIF ! ln_ iceini397 ENDIF ! ln_limini 439 398 440 399 at_i (:,:) = 0.0_wp … … 486 445 sxyage (:,:,:) = 0._wp 487 446 488 489 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini, zv_i_ini ) 447 !!!clem 448 !! ! Output the initial state and forcings 449 !! CALL dia_wri_state( 'output.init', nit000 ) 450 !!! 451 452 CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini, za_i_ini ) 490 453 CALL wrk_dealloc( jpi, jpj, zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 491 454 CALL wrk_dealloc( jpi, jpj, zswitch ) 455 Call wrk_dealloc( 4, itest ) 492 456 493 457 END SUBROUTINE lim_istate … … 518 482 TYPE(FLD_N), DIMENSION(jpfldi) :: slf_i ! array of namelist informations on the fields to read 519 483 ! 520 NAMELIST/namiceini/ ln_ iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, &484 NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, & 521 485 & rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 522 486 & rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s, & … … 544 508 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 545 509 WRITE(numout,*) '~~~~~~~~~~~~~~~' 546 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_ iceini = ', ln_iceini547 WRITE(numout,*) ' ice initialization from a netcdf file ln_ iceini_file = ', ln_iceini_file510 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_limini = ', ln_limini 511 WRITE(numout,*) ' ice initialization from a netcdf file ln_limini_file = ', ln_limini_file 548 512 WRITE(numout,*) ' threshold water temp. for initial sea-ice rn_thres_sst = ', rn_thres_sst 549 513 WRITE(numout,*) ' initial snow thickness in the north rn_hts_ini_n = ', rn_hts_ini_n … … 559 523 ENDIF 560 524 561 IF( ln_ iceini_file ) THEN ! Ice initialization using input file525 IF( ln_limini_file ) THEN ! Ice initialization using input file 562 526 ! 563 527 ! set si structure -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r6470 r7646 18 18 USE thd_ice ! LIM thermodynamics 19 19 USE ice ! LIM variables 20 USE dom_ice ! LIM domain21 20 USE limvar ! LIM 22 21 USE lbclnk ! lateral boundary condition - MPP exchanges 23 22 USE lib_mpp ! MPP library 24 23 USE wrk_nemo ! work arrays 25 USE prtctl ! Print control26 24 27 25 USE in_out_manager ! I/O manager 28 26 USE iom ! I/O manager 29 27 USE lib_fortran ! glob_sum 30 USE limdiahsb31 28 USE timing ! Timing 32 29 USE limcons ! conservation tests 30 USE limctl ! control prints 33 31 34 32 IMPLICIT NONE … … 70 68 !! *** ROUTINE lim_itd_me_alloc *** 71 69 !!---------------------------------------------------------------------! 72 ALLOCATE( &70 ALLOCATE( & 73 71 !* Variables shared among ridging subroutines 74 & asum (jpi,jpj) , athorn(jpi,jpj,0:jpl) , & 75 & aksum(jpi,jpj) , & 76 & hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , & 77 & hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 72 & asum (jpi,jpj) , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj) , & 73 & hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , & 74 & hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 78 75 ! 79 76 IF( lim_itd_me_alloc /= 0 ) CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' ) … … 127 124 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 128 125 129 IF(ln_ctl) THEN130 CALL prt_ctl(tab2d_1=ato_i , clinfo1=' lim_itd_me: ato_i : ', tab2d_2=at_i , clinfo2=' at_i : ')131 CALL prt_ctl(tab2d_1=divu_i, clinfo1=' lim_itd_me: divu_i : ', tab2d_2=delta_i, clinfo2=' delta_i : ')132 ENDIF133 134 IF( ln_limdyn ) THEN ! Start ridging and rafting !135 136 126 ! conservation test 137 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)127 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 138 128 139 129 !-----------------------------------------------------------------------------! … … 211 201 DO ji = 1, jpi 212 202 za = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 213 IF ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN! would lead to negative ato_i214 zfac = - ato_i(ji,jj) / za203 IF ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN ! would lead to negative ato_i 204 zfac = - ato_i(ji,jj) / za 215 205 opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice 216 206 ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN ! would lead to ato_i > asum 217 zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za207 zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za 218 208 opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice 219 209 ENDIF … … 259 249 closing_net(ji,jj) = 0._wp 260 250 opning (ji,jj) = 0._wp 251 ato_i (ji,jj) = MAX( 0._wp, 1._wp - SUM( a_i(ji,jj,:) ) ) 261 252 ELSE 262 253 iterate_ridging = 1 … … 292 283 ! control prints 293 284 !-----------------------------------------------------------------------------! 294 IF(ln_ctl) THEN295 CALL lim_var_glo2eqv296 297 CALL prt_ctl_info(' ')298 CALL prt_ctl_info(' - Cell values : ')299 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')300 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_itd_me : cell area :')301 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me : at_i :')302 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me : vt_i :')303 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_me : vt_s :')304 DO jl = 1, jpl305 CALL prt_ctl_info(' ')306 CALL prt_ctl_info(' - Category : ', ivar1=jl)307 CALL prt_ctl_info(' ~~~~~~~~~~')308 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_me : a_i : ')309 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_me : ht_i : ')310 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_me : ht_s : ')311 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_me : v_i : ')312 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_me : v_s : ')313 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_me : e_s : ')314 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_me : t_su : ')315 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_me : t_snow : ')316 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_me : sm_i : ')317 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_me : smv_i : ')318 DO jk = 1, nlay_i319 CALL prt_ctl_info(' ')320 CALL prt_ctl_info(' - Layer : ', ivar1=jk)321 CALL prt_ctl_info(' ~~~~~~~')322 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_me : t_i : ')323 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_me : e_i : ')324 END DO325 END DO326 ENDIF327 328 285 ! conservation test 329 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 330 331 ENDIF ! ln_limdyn=.true. 332 ! 286 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 287 288 ! control prints 289 IF( ln_ctl ) CALL lim_prt3D( 'limitd_me' ) 290 333 291 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 334 292 ! … … 368 326 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 369 327 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 370 328 END DO 371 329 END DO 372 330 END DO … … 438 396 ENDIF 439 397 440 IF( ln_rafting ) THEN ! Ridging and rafting ice participation functions 398 ! --- Ridging and rafting participation concentrations --- ! 399 IF( ln_rafting .AND. ln_ridging ) THEN 441 400 ! 442 401 DO jl = 1, jpl … … 445 404 zdummy = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) 446 405 aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl) 447 araft (ji,jj,jl) = ( 1._wp - zdummy ) * 0.5_wp * athorn(ji,jj,jl)406 araft (ji,jj,jl) = athorn(ji,jj,jl) - aridge(ji,jj,jl) 448 407 END DO 449 408 END DO 450 409 END DO 451 452 ELSE 410 ! 411 ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN 453 412 ! 454 413 DO jl = 1, jpl 455 414 aridge(:,:,jl) = athorn(:,:,jl) 415 END DO 416 ! 417 ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN 418 ! 419 DO jl = 1, jpl 420 araft(:,:,jl) = athorn(:,:,jl) 456 421 END DO 457 422 ! … … 657 622 & - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice ! and get sm_i from the ocean 658 623 ENDIF 659 624 660 625 !------------------------------------------ 661 626 ! 3.7 Put the snow somewhere in the ocean … … 795 760 INTEGER :: numts_rm ! number of time steps for the P smoothing 796 761 REAL(wp) :: zp, z1_3 ! local scalars 797 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 762 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 763 REAL(wp), POINTER, DIMENSION(:,:) :: zstrp1, zstrp2 ! strength at previous time steps 798 764 !!---------------------------------------------------------------------- 799 765 800 CALL wrk_alloc( jpi, jpj, zworka)766 CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 801 767 802 768 !------------------------------------------------------------------------------! … … 844 810 END DO 845 811 846 strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) 812 strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1) 847 813 ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 848 814 ksmooth = 1 849 815 850 851 852 816 !------------------------------------------------------------------------------! 817 ! 4) Hibler (1979)' method 818 !------------------------------------------------------------------------------! 853 819 ELSE ! kstrngth ne 1: Hibler (1979) form 854 820 ! 855 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) 821 strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) ) * tmask(:,:,1) 856 822 ! 857 823 ksmooth = 1 … … 866 832 DO jj = 1, jpj 867 833 DO ji = 1, jpi 868 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv _i(ji,jj),0.0)))834 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0))) 869 835 END DO 870 836 END DO … … 880 846 IF ( ksmooth == 1 ) THEN 881 847 882 CALL lbc_lnk( strength, 'T', 1. )883 884 848 DO jj = 2, jpjm1 885 849 DO ji = 2, jpim1 886 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN850 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 887 851 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 888 852 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & … … 907 871 ! Temporal smoothing 908 872 !-------------------- 909 IF ( numit == nit000 + nn_fsbc - 1 ) THEN910 strp1(:,:) = 0.0911 strp2(:,:) = 0.0912 ENDIF913 914 873 IF ( ksmooth == 2 ) THEN 915 874 916 CALL lbc_lnk( strength, 'T', 1. ) 917 918 DO jj = 1, jpj - 1 919 DO ji = 1, jpi - 1 920 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 875 IF ( numit == nit000 + nn_fsbc - 1 ) THEN 876 zstrp1(:,:) = 0._wp 877 zstrp2(:,:) = 0._wp 878 ENDIF 879 880 DO jj = 2, jpjm1 881 DO ji = 2, jpim1 882 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 921 883 numts_rm = 1 ! number of time steps for the running mean 922 IF ( strp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1923 IF ( strp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1924 zp = ( strength(ji,jj) + strp1(ji,jj) +strp2(ji,jj) ) / numts_rm925 strp2(ji,jj) =strp1(ji,jj)926 strp1(ji,jj) = strength(ji,jj)884 IF ( zstrp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 885 IF ( zstrp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 886 zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / numts_rm 887 zstrp2(ji,jj) = zstrp1(ji,jj) 888 zstrp1(ji,jj) = strength(ji,jj) 927 889 strength(ji,jj) = zp 928 929 890 ENDIF 930 891 END DO 931 892 END DO 932 893 894 CALL lbc_lnk( strength, 'T', 1. ) ! Boundary conditions 895 933 896 ENDIF ! ksmooth 934 897 935 CALL lbc_lnk( strength, 'T', 1. ) ! Boundary conditions 936 937 CALL wrk_dealloc( jpi, jpj, zworka ) 898 CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 ) 938 899 ! 939 900 END SUBROUTINE lim_itd_me_icestrength … … 953 914 !!------------------------------------------------------------------- 954 915 INTEGER :: ios ! Local integer output status for namelist read 955 NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft, & 956 & rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, & 957 & nn_partfun 916 NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar, & 917 & ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, ln_rafting, rn_hraft, rn_craft, rn_fsnowrft 958 918 !!------------------------------------------------------------------- 959 919 ! … … 969 929 IF (lwp) THEN ! control print 970 930 WRITE(numout,*) 971 WRITE(numout,*)' 972 WRITE(numout,*)' 931 WRITE(numout,*)'lim_itd_me_init : ice parameters for mechanical ice redistribution ' 932 WRITE(numout,*)'~~~~~~~~~~~~~~~' 973 933 WRITE(numout,*)' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs 974 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg 975 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 934 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun 976 935 WRITE(numout,*)' Fraction of total ice coverage contributing to ridging rn_gstar = ', rn_gstar 977 936 WRITE(numout,*)' Equivalent to G* for an exponential part function rn_astar = ', rn_astar 937 WRITE(numout,*)' Ridging of ice sheets or not ln_ridging = ', ln_ridging 978 938 WRITE(numout,*)' Quantity playing a role in max ridged ice thickness rn_hstar = ', rn_hstar 939 WRITE(numout,*)' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg 940 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg 979 941 WRITE(numout,*)' Rafting of ice sheets or not ln_rafting = ', ln_rafting 980 942 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft 981 943 WRITE(numout,*)' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft 982 WRITE(numout,*)' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg 983 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun 944 WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft 984 945 ENDIF 985 946 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r5407 r7646 18 18 !! lim_itd_shiftice : 19 19 !!---------------------------------------------------------------------- 20 USE dom_ice ! LIM-3 domain21 20 USE par_oce ! ocean parameters 22 21 USE dom_oce ! ocean domain -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r6416 r7646 9 9 !! 3.3 ! 2009-05 (G.Garric) addition of the lim2_evp cas 10 10 !! 3.4 ! 2011-01 (A. Porter) dynamical allocation 11 !! 3.5 ! 2012-08 (R. Benshila) AGRIF 11 !! 3.5 ! 2012-08 (R. Benshila) AGRIF 12 !! 3.6 ! 2016-06 (C. Rousset) Rewriting + landfast ice + possibility to use mEVP (Bouillon 2013) 12 13 !!---------------------------------------------------------------------- 13 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp )14 #if defined key_lim3 14 15 !!---------------------------------------------------------------------- 15 !! 'key_lim3' OR LIM-3 sea-ice model 16 !! 'key_lim2' AND NOT 'key_lim2_vp' EVP LIM-2 sea-ice model 16 !! 'key_lim3' LIM-3 sea-ice model 17 17 !!---------------------------------------------------------------------- 18 18 !! lim_rhg : computes ice velocities … … 24 24 USE sbc_oce ! Surface boundary condition: ocean fields 25 25 USE sbc_ice ! Surface boundary condition: ice fields 26 #if defined key_lim3 27 USE ice ! LIM-3: ice variables 28 USE dom_ice ! LIM-3: ice domain 29 USE limitd_me ! LIM-3: 30 #else 31 USE ice_2 ! LIM-2: ice variables 32 USE dom_ice_2 ! LIM-2: ice domain 33 #endif 26 USE ice ! ice variables 27 USE limitd_me ! ice strength 34 28 USE lbclnk ! Lateral Boundary Condition / MPP link 35 29 USE lib_mpp ! MPP library … … 38 32 USE prtctl ! Print control 39 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 #if defined key_agrif && defined key_lim241 USE agrif_lim 2_interp34 #if defined key_agrif 35 USE agrif_lim3_interp 42 36 #endif 43 #if defined key_bdy 44 USE bdyice_lim 45 #endif 37 USE bdy_oce , ONLY: ln_bdy 38 USE bdyice_lim 46 39 47 40 IMPLICIT NONE 48 41 PRIVATE 49 42 50 PUBLIC lim_rhg ! routine called by lim_dyn (or lim_dyn_2)43 PUBLIC lim_rhg ! routine called by lim_dyn 51 44 52 45 !! * Substitutions … … 59 52 CONTAINS 60 53 61 SUBROUTINE lim_rhg ( k_j1, k_jpj )54 SUBROUTINE lim_rhg 62 55 !!------------------------------------------------------------------- 63 56 !! *** SUBROUTINE lim_rhg *** … … 106 99 !! e.g. in the Canadian Archipelago 107 100 !! 101 !! ** Notes : There is the possibility to use mEVP from Bouillon 2013 102 !! (by uncommenting some lines in part 3 and changing alpha and beta parameters) 103 !! but this solution appears very unstable (see Kimmritz et al 2016) 104 !! 108 105 !! References : Hunke and Dukowicz, JPO97 109 106 !! Bouillon et al., Ocean Modelling 2009 107 !! Bouillon et al., Ocean Modelling 2013 110 108 !!------------------------------------------------------------------- 111 INTEGER, INTENT(in) :: k_j1 ! southern j-index for ice computation 112 INTEGER, INTENT(in) :: k_jpj ! northern j-index for ice computation 113 !! 114 INTEGER :: ji, jj ! dummy loop indices 115 INTEGER :: jter ! local integers 109 INTEGER :: ji, jj ! dummy loop indices 110 INTEGER :: jter ! local integers 116 111 CHARACTER (len=50) :: charout 117 REAL(wp) :: zt11, zt12, zt21, zt22, ztagnx, ztagny, delta ! 118 REAL(wp) :: za, zstms ! local scalars 119 REAL(wp) :: zc1, zc2, zc3 ! ice mass 120 121 REAL(wp) :: dtevp , z1_dtevp ! time step for subcycling 122 REAL(wp) :: dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity 123 REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars 124 REAL(wp) :: zu_ice2, zv_ice1 ! 125 REAL(wp) :: zddc, zdtc ! delta on corners and on centre 126 REAL(wp) :: zdst ! shear at the center of the grid point 127 REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface 128 REAL(wp) :: sigma1, sigma2 ! internal ice stress 129 130 REAL(wp) :: zresm ! Maximal error on ice velocity 131 REAL(wp) :: zintb, zintn ! dummy argument 132 133 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength 134 REAL(wp), POINTER, DIMENSION(:,:) :: zpreshc ! Ice strength on grid cell corners (zpreshc) 135 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld1, zfrld2 ! lead fraction on U/V points 136 REAL(wp), POINTER, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points 137 REAL(wp), POINTER, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points 138 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays 139 REAL(wp), POINTER, DIMENSION(:,:) :: v_oce1 ! ocean u/v component on U points 140 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2 ! ocean u/v component on V points 141 REAL(wp), POINTER, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point 142 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses 143 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! mask ocean grid points 112 113 REAL(wp) :: zrhoco ! rau0 * rn_cio 114 REAL(wp) :: zdtevp, z1_dtevp ! time step for subcycling 115 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity 116 REAL(wp) :: zbeta, zalph1, z1_alph1, zalph2, z1_alph2 ! alpha and beta from Bouillon 2009 and 2013 117 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV ! ice/snow mass 118 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 119 REAL(wp) :: zTauO, zTauB, zTauE, zCor, zvel ! temporary scalars 120 121 REAL(wp) :: zsig1, zsig2 ! internal ice stress 122 REAL(wp) :: zresm ! Maximal error on ice velocity 123 REAL(wp) :: zintb, zintn ! dummy argument 144 124 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdt ! tension at centre of grid cells 146 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! Shear on northeast corner of grid cells 147 REAL(wp), POINTER, DIMENSION(:,:) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs2 148 REAL(wp), POINTER, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs12 149 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity 150 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 151 ! ocean surface (ssh_m) if ice is not embedded 152 ! ice top surface if ice is embedded 153 154 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 155 REAL(wp), PARAMETER :: zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 125 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors 126 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points 127 ! 128 REAL(wp), POINTER, DIMENSION(:,:) :: zaU , zaV ! ice fraction on U/V points 129 REAL(wp), POINTER, DIMENSION(:,:) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points 130 REAL(wp), POINTER, DIMENSION(:,:) :: zmf ! coriolis parameter at T points 131 REAL(wp), POINTER, DIMENSION(:,:) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points 132 REAL(wp), POINTER, DIMENSION(:,:) :: zspgU , zspgV ! surface pressure gradient at U/V points 133 REAL(wp), POINTER, DIMENSION(:,:) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 134 REAL(wp), POINTER, DIMENSION(:,:) :: zfU , zfV ! internal stresses 135 136 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear 137 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components 138 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence 139 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 140 ! ocean surface (ssh_m) if ice is not embedded 141 ! ice top surface if ice is embedded 142 REAL(wp), POINTER, DIMENSION(:,:) :: zswitchU, zswitchV ! dummy arrays 143 REAL(wp), POINTER, DIMENSION(:,:) :: zmaskU, zmaskV ! mask for ice presence 144 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask, zwf ! mask at F points for the ice 145 146 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 147 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity equals ocean velocity 148 REAL(wp), PARAMETER :: zshlat = 2._wp ! boundary condition for sea-ice velocity (2=no slip ; 0=free slip) 156 149 !!------------------------------------------------------------------- 157 150 158 CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 159 CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 160 CALL wrk_alloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 161 CALL wrk_alloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 162 163 #if defined key_lim2 && ! defined key_lim2_vp 164 # if defined key_agrif 165 USE ice_2, vt_s => hsnm 166 USE ice_2, vt_i => hicm 167 # else 168 vt_s => hsnm 169 vt_i => hicm 170 # endif 171 at_i(:,:) = 1. - frld(:,:) 172 #endif 173 #if defined key_agrif && defined key_lim2 174 CALL agrif_rhg_lim2_load ! First interpolation of coarse values 151 CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt ) 152 CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 153 CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 154 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 155 CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 156 157 #if defined key_agrif 158 CALL agrif_interp_lim3( 'U', 0, nn_nevp ) ! First interpolation of coarse values 159 CALL agrif_interp_lim3( 'V', 0, nn_nevp ) 175 160 #endif 176 161 ! 177 162 !------------------------------------------------------------------------------! 178 ! 1) Ice strength (zpresh) ! 179 !------------------------------------------------------------------------------! 163 ! 0) mask at F points for the ice 164 !------------------------------------------------------------------------------! 165 ! ocean/land mask 166 DO jj = 1, jpjm1 167 DO ji = 1, jpim1 ! NO vector opt. 168 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 169 END DO 170 END DO 171 CALL lbc_lnk( zfmask, 'F', 1._wp ) 172 173 ! Lateral boundary conditions on velocity (modify zfmask) 174 zwf(:,:) = zfmask(:,:) 175 DO jj = 2, jpjm1 176 DO ji = fs_2, fs_jpim1 ! vector opt. 177 IF( zfmask(ji,jj) == 0._wp ) THEN 178 zfmask(ji,jj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 179 ENDIF 180 END DO 181 END DO 182 DO jj = 2, jpjm1 183 IF( zfmask(1,jj) == 0._wp ) THEN 184 zfmask(1 ,jj) = zshlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 185 ENDIF 186 IF( zfmask(jpi,jj) == 0._wp ) THEN 187 zfmask(jpi,jj) = zshlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 188 ENDIF 189 END DO 190 DO ji = 2, jpim1 191 IF( zfmask(ji,1) == 0._wp ) THEN 192 zfmask(ji,1 ) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 193 ENDIF 194 IF( zfmask(ji,jpj) == 0._wp ) THEN 195 zfmask(ji,jpj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 196 ENDIF 197 END DO 198 CALL lbc_lnk( zfmask, 'F', 1._wp ) 199 200 !------------------------------------------------------------------------------! 201 ! 1) define some variables and initialize arrays 202 !------------------------------------------------------------------------------! 203 zrhoco = rau0 * rn_cio 204 205 ! ecc2: square of yield ellipse eccenticrity 206 ecc2 = rn_ecc * rn_ecc 207 z1_ecc2 = 1._wp / ecc2 208 209 ! Time step for subcycling 210 zdtevp = rdt_ice / REAL( nn_nevp ) 211 z1_dtevp = 1._wp / zdtevp 212 213 ! alpha parameters (Bouillon 2009) 214 zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp 215 zalph2 = zalph1 * z1_ecc2 216 217 ! alpha and beta parameters (Bouillon 2013) 218 !!zalph1 = 40. 219 !!zalph2 = 40. 220 !!zbeta = 3000. 221 !!zbeta = REAL( nn_nevp ) ! close to classical EVP of Hunke (2001) 222 223 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 224 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 225 226 ! Initialise stress tensor 227 zs1 (:,:) = stress1_i (:,:) 228 zs2 (:,:) = stress2_i (:,:) 229 zs12(:,:) = stress12_i(:,:) 230 231 ! Ice strength 232 CALL lim_itd_me_icestrength( nn_icestr ) 233 234 ! scale factors 235 DO jj = 2, jpjm1 236 DO ji = fs_2, fs_jpim1 237 z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj ) + e1t(ji,jj ) ) 238 z1_e2t0(ji,jj) = 1._wp / ( e2t(ji ,jj+1) + e2t(ji,jj ) ) 239 END DO 240 END DO 241 180 242 ! 181 ! Put every vector to 0182 delta_i(:,:) = 0._wp ;183 zpresh (:,:) = 0._wp ;184 zpreshc(:,:) = 0._wp185 u_ice2 (:,:) = 0._wp ; v_ice1(:,:) = 0._wp186 divu_i (:,:) = 0._wp ; zdt (:,:) = 0._wp ; zds(:,:) = 0._wp187 shear_i(:,:) = 0._wp188 189 #if defined key_lim3190 CALL lim_itd_me_icestrength( nn_icestr ) ! LIM-3: Ice strength on T-points191 #endif192 193 DO jj = k_j1 , k_jpj ! Ice mass and temp variables194 DO ji = 1 , jpi195 #if defined key_lim3196 zpresh(ji,jj) = tmask(ji,jj,1) * strength(ji,jj)197 #endif198 #if defined key_lim2199 zpresh(ji,jj) = tmask(ji,jj,1) * pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )200 #endif201 ! zmask = 1 where there is ice or on land202 zmask(ji,jj) = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1)203 END DO204 END DO205 206 ! Ice strength on grid cell corners (zpreshc)207 ! needed for calculation of shear stress208 DO jj = k_j1+1, k_jpj-1209 DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1)210 zstms = tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) + &211 & tmask(ji+1,jj,1) * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1) * wght(ji+1,jj+1,1,1)212 zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) + &213 & zpresh(ji+1,jj) * wght(ji+1,jj+1,2,1) + zpresh(ji,jj) * wght(ji+1,jj+1,1,1) &214 & ) / MAX( zstms, zepsi )215 END DO216 END DO217 CALL lbc_lnk( zpreshc(:,:), 'F', 1. )218 !219 243 !------------------------------------------------------------------------------! 220 244 ! 2) Wind / ocean stress, mass terms, coriolis terms 221 245 !------------------------------------------------------------------------------! 222 !223 ! Wind stress, coriolis and mass terms on the sides of the squares224 ! zfrld1: lead fraction on U-points225 ! zfrld2: lead fraction on V-points226 ! zmass1: ice/snow mass on U-points227 ! zmass2: ice/snow mass on V-points228 ! zcorl1: Coriolis parameter on U-points229 ! zcorl2: Coriolis parameter on V-points230 ! (ztagnx,ztagny): wind stress on U/V points231 ! v_oce1: ocean v component on u points232 ! u_oce2: ocean u component on v points233 246 234 247 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! … … 242 255 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 243 256 ! 244 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:)) * r1_rau0257 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 245 258 ! 246 259 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! … … 248 261 ENDIF 249 262 250 DO jj = k_j1+1, k_jpj-1263 DO jj = 2, jpjm1 251 264 DO ji = fs_2, fs_jpim1 252 265 253 zc1 = tmask(ji ,jj ,1) * ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) ) 254 zc2 = tmask(ji+1,jj ,1) * ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) ) 255 zc3 = tmask(ji ,jj+1,1) * ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) ) 256 257 zt11 = tmask(ji ,jj,1) * e1t(ji ,jj) 258 zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj) 259 zt21 = tmask(ji,jj ,1) * e2t(ji,jj ) 260 zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1) 261 262 ! Leads area. 263 zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi ) 264 zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi ) 265 266 ! Mass, coriolis coeff. and currents 267 zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi ) 268 zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi ) 269 zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) ) & 270 & / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 271 zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) ) & 272 & / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi ) 273 ! 274 ! Ocean has no slip boundary condition 275 v_oce1(ji,jj) = 0.5 * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji,jj) & 276 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 277 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 278 279 u_oce2(ji,jj) = 0.5 * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj) & 280 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 281 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 282 283 ! Wind stress at U,V-point 284 ztagnx = ( 1. - zfrld1(ji,jj) ) * utau_ice(ji,jj) 285 ztagny = ( 1. - zfrld2(ji,jj) ) * vtau_ice(ji,jj) 286 287 ! Computation of the velocity field taking into account the ice internal interaction. 288 ! Terms that are independent of the velocity field. 289 290 ! SB On utilise maintenant le gradient de la pente de l'ocean 291 ! include it later 292 293 zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 294 zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 295 296 za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 297 za2ct(ji,jj) = ztagny - zmass2(ji,jj) * grav * zdsshy 266 ! ice fraction at U-V points 267 zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 268 zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 269 270 ! Ice/snow mass at U-V points 271 zm1 = ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) ) 272 zm2 = ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) ) 273 zm3 = ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) ) 274 zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 275 zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 276 277 ! Ocean currents at U-V points 278 v_oceU(ji,jj) = 0.5_wp * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji+1,jj) & 279 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 280 281 u_oceV(ji,jj) = 0.5_wp * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj+1) & 282 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 283 284 ! Coriolis at T points (m*f) 285 zmf(ji,jj) = zm1 * ff_t(ji,jj) 286 287 ! m/dt 288 zmU_t(ji,jj) = zmassU * z1_dtevp 289 zmV_t(ji,jj) = zmassV * z1_dtevp 290 291 ! Drag ice-atm. 292 zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 293 zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 294 295 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 296 zspgU(ji,jj) = - zmassU * grav * ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 297 zspgV(ji,jj) = - zmassV * grav * ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 298 299 ! masks 300 zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 301 zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 302 303 ! switches 304 zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin 305 zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin 298 306 299 307 END DO 300 308 END DO 301 309 CALL lbc_lnk( zmf, 'T', 1. ) 302 310 ! 303 311 !------------------------------------------------------------------------------! … … 305 313 !------------------------------------------------------------------------------! 306 314 ! 307 ! Time step for subcycling308 dtevp = rdt_ice / nn_nevp309 #if defined key_lim3310 dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice )311 #else312 dtotel = dtevp / ( 2._wp * telast )313 #endif314 z1_dtotel = 1._wp / ( 1._wp + dtotel )315 z1_dtevp = 1._wp / dtevp316 !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)317 ecc2 = rn_ecc * rn_ecc318 ecci = 1. / ecc2319 320 !-Initialise stress tensor321 zs1 (:,:) = stress1_i (:,:)322 zs2 (:,:) = stress2_i (:,:)323 zs12(:,:) = stress12_i(:,:)324 325 315 ! !----------------------! 326 316 DO jter = 1 , nn_nevp ! loop over jter ! 327 317 ! !----------------------! 328 DO jj = k_j1, k_jpj-1 329 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 330 zv_ice(:,jj) = v_ice(:,jj) 331 END DO 332 333 DO jj = k_j1+1, k_jpj-1 334 DO ji = fs_2, fs_jpim1 !RB bug no vect opt due to zmask 335 336 ! 337 !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 338 !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells 339 !- zds(:,:): shear on northeast corner of grid cells 340 ! 341 !- IMPORTANT REMINDER: Dear Gurvan, note that, the way these terms are coded, 342 ! there are many repeated calculations. 343 ! Speed could be improved by regrouping terms. For 344 ! the moment, however, the stress is on clarity of coding to avoid 345 ! bugs (Martin, for Miguel). 346 ! 347 !- ALSO: arrays zdt, zds and delta could 348 ! be removed in the future to minimise memory demand. 349 ! 350 !- MORE NOTES: Note that we are calculating deformation rates and stresses on the corners of 351 ! grid cells, exactly as in the B grid case. For simplicity, the indexation on 352 ! the corners is the same as in the B grid. 353 ! 354 ! 355 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 356 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 357 & ) * r1_e1e2t(ji,jj) 358 359 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 360 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 361 & ) * r1_e1e2t(ji,jj) 362 363 ! 318 IF(ln_ctl) THEN ! Convergence test 319 DO jj = 1, jpjm1 320 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 321 zv_ice(:,jj) = v_ice(:,jj) 322 END DO 323 ENDIF 324 325 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 326 DO jj = 1, jpjm1 ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 327 DO ji = 1, jpim1 328 329 ! shear at F points 364 330 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 365 331 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 366 & ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) & 367 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 368 369 370 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) & 371 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 372 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 373 374 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 375 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 376 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 377 END DO 378 END DO 379 380 CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. ) ! lateral boundary cond. 332 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 333 334 END DO 335 END DO 336 CALL lbc_lnk( zds, 'F', 1. ) 337 338 DO jj = 2, jpjm1 339 DO ji = 2, jpim1 ! no vector loop 340 341 ! shear**2 at T points (doc eq. A16) 342 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 343 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 344 & ) * 0.25_wp * r1_e1e2t(ji,jj) 345 346 ! divergence at T points 347 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 348 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 349 & ) * r1_e1e2t(ji,jj) 350 zdiv2 = zdiv * zdiv 351 352 ! tension at T points 353 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 354 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 355 & ) * r1_e1e2t(ji,jj) 356 zdt2 = zdt * zdt 357 358 ! delta at T points 359 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 360 361 ! P/delta at T points 362 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 363 364 ! stress at T points 365 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv - zdelta ) ) * z1_alph1 366 zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 ) ) * z1_alph2 367 368 END DO 369 END DO 370 CALL lbc_lnk( zp_delt, 'T', 1. ) 371 372 DO jj = 1, jpjm1 373 DO ji = 1, jpim1 374 375 ! P/delta at F points 376 zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 377 378 ! stress at F points 379 zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 ) * 0.5_wp ) * z1_alph2 380 381 END DO 382 END DO 383 CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 384 385 386 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 387 DO jj = 2, jpjm1 388 DO ji = fs_2, fs_jpim1 389 390 ! U points 391 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 392 & + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) & 393 & ) * r1_e2u(ji,jj) & 394 & + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) & 395 & ) * 2._wp * r1_e1u(ji,jj) & 396 & ) * r1_e1e2u(ji,jj) 397 398 ! V points 399 zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 400 & - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj) & 401 & ) * r1_e1v(ji,jj) & 402 & + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) & 403 & ) * 2._wp * r1_e2v(ji,jj) & 404 & ) * r1_e1e2v(ji,jj) 405 406 ! u_ice at V point 407 u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 408 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 409 410 ! v_ice at U point 411 v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) & 412 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 413 414 END DO 415 END DO 416 ! 417 ! --- Computation of ice velocity --- ! 418 ! Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta are chosen wisely and large nn_nevp 419 ! Bouillon et al. 2009 (eq 34-35) => stable 420 IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 421 422 DO jj = 2, jpjm1 423 DO ji = fs_2, fs_jpim1 424 425 ! tau_io/(v_oce - v_ice) 426 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 427 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 428 429 ! tau_bottom/v_ice 430 zvel = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) ) 431 zTauB = - tau_icebfr(ji,jj) / zvel 432 433 ! Coriolis at V-points (energy conserving formulation) 434 zCor = - 0.25_wp * r1_e2v(ji,jj) * & 435 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 436 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 437 438 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 439 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 440 441 ! landfast switch => 0 = static friction ; 1 = sliding friction 442 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 443 444 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 445 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 446 & + zTauE + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 447 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 448 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 449 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 450 & ) * zmaskV(ji,jj) 451 ! Bouillon 2013 452 !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) ) & 453 !! & + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj) & 454 !! & ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj) 455 456 END DO 457 END DO 458 CALL lbc_lnk( v_ice, 'V', -1. ) 459 460 #if defined key_agrif 461 !! CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 462 CALL agrif_interp_lim3( 'V' ) 463 #endif 464 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 465 466 DO jj = 2, jpjm1 467 DO ji = fs_2, fs_jpim1 468 469 ! tau_io/(u_oce - u_ice) 470 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 471 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 472 473 ! tau_bottom/u_ice 474 zvel = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 475 zTauB = - tau_icebfr(ji,jj) / zvel 476 477 ! Coriolis at U-points (energy conserving formulation) 478 zCor = 0.25_wp * r1_e1u(ji,jj) * & 479 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 480 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 481 482 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 483 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 484 485 ! landfast switch => 0 = static friction ; 1 = sliding friction 486 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 487 488 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 489 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 490 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 491 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 492 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 493 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 494 & ) * zmaskU(ji,jj) 495 ! Bouillon 2013 496 !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) ) & 497 !! & + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj) & 498 !! & ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj) 499 END DO 500 END DO 501 CALL lbc_lnk( u_ice, 'U', -1. ) 502 503 #if defined key_agrif 504 !! CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 505 CALL agrif_interp_lim3( 'U' ) 506 #endif 507 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 508 509 ELSE ! odd iterations 510 511 DO jj = 2, jpjm1 512 DO ji = fs_2, fs_jpim1 513 514 ! tau_io/(u_oce - u_ice) 515 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 516 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 517 518 ! tau_bottom/u_ice 519 zvel = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) ) 520 zTauB = - tau_icebfr(ji,jj) / zvel 521 522 ! Coriolis at U-points (energy conserving formulation) 523 zCor = 0.25_wp * r1_e1u(ji,jj) * & 524 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 525 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 526 527 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 528 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 529 530 ! landfast switch => 0 = static friction ; 1 = sliding friction 531 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 532 533 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 534 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 535 & + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 536 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 537 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 538 & ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 539 & ) * zmaskU(ji,jj) 540 ! Bouillon 2013 541 !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) ) & 542 !! & + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj) & 543 !! & ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj) 544 END DO 545 END DO 546 CALL lbc_lnk( u_ice, 'U', -1. ) 547 548 #if defined key_agrif 549 !! CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 550 CALL agrif_interp_lim3( 'U' ) 551 #endif 552 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 553 554 DO jj = 2, jpjm1 555 DO ji = fs_2, fs_jpim1 381 556 382 DO jj = k_j1+1, k_jpj-1 383 DO ji = fs_2, fs_jpim1 384 385 !- Calculate Delta at centre of grid cells 386 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 387 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) & 388 & ) * r1_e1e2t(ji,jj) 389 390 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 391 delta_i(ji,jj) = delta + rn_creepl 392 393 !- Calculate Delta on corners 394 zddc = ( ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 395 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 396 & ) * r1_e1e2f(ji,jj) 397 398 zdtc = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 399 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 400 & ) * r1_e1e2f(ji,jj) 401 402 zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 403 404 !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide). 405 zs1(ji,jj) = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj) * zpresh(ji,jj) & 406 & ) * z1_dtotel 407 zs2(ji,jj) = ( zs2 (ji,jj) + dtotel * ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) & 408 & ) * z1_dtotel 409 !-Calculate stress tensor component zs12 at corners 410 zs12(ji,jj) = ( zs12(ji,jj) + dtotel * ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) & 411 & ) * z1_dtotel 412 413 END DO 414 END DO 415 416 CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 417 418 ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 419 DO jj = k_j1+1, k_jpj-1 420 DO ji = fs_2, fs_jpim1 421 !- contribution of zs1, zs2 and zs12 to zf1 422 zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 423 & + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj) & 424 & + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 425 & ) * r1_e1e2u(ji,jj) 426 ! contribution of zs1, zs2 and zs12 to zf2 427 zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 428 & - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj) & 429 & + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj) & 430 & ) * r1_e1e2v(ji,jj) 431 END DO 432 END DO 433 ! 434 ! Computation of ice velocity 435 ! 436 ! Both the Coriolis term and the ice-ocean drag are solved semi-implicitly. 437 ! 438 IF (MOD(jter,2).eq.0) THEN 439 440 DO jj = k_j1+1, k_jpj-1 441 DO ji = fs_2, fs_jpim1 442 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 443 z0 = zmass1(ji,jj) * z1_dtevp 444 445 ! SB modif because ocean has no slip boundary condition 446 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji ,jj) & 447 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 448 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 449 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + & 450 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 451 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 452 zcca = z0 + za 453 zccb = zcorl1(ji,jj) 454 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 557 ! tau_io/(v_oce - v_ice) 558 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 559 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 560 561 ! tau_bottom/v_ice 562 zvel = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) ) 563 ztauB = - tau_icebfr(ji,jj) / zvel 564 565 ! Coriolis at V-points (energy conserving formulation) 566 zCor = - 0.25_wp * r1_e2v(ji,jj) * & 567 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 568 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 569 570 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 571 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 572 573 ! landfast switch => 0 = static friction (tau_icebfr > zTauE); 1 = sliding friction 574 rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 575 576 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 577 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 578 & + zTauE + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 579 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 580 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 581 & ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 582 & ) * zmaskV(ji,jj) 583 ! Bouillon 2013 584 !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) ) & 585 !! & + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj) & 586 !! & ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj) 455 587 END DO 456 588 END DO 457 458 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 459 #if defined key_agrif && defined key_lim2 460 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 589 CALL lbc_lnk( v_ice, 'V', -1. ) 590 591 #if defined key_agrif 592 !! CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 593 CALL agrif_interp_lim3( 'V' ) 461 594 #endif 462 #if defined key_bdy 463 CALL bdy_ice_lim_dyn( 'U' ) 464 #endif 465 466 DO jj = k_j1+1, k_jpj-1 467 DO ji = fs_2, fs_jpim1 468 469 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 470 z0 = zmass2(ji,jj) * z1_dtevp 471 ! SB modif because ocean has no slip boundary condition 472 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) & 473 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 474 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 475 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + & 476 & ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 477 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 478 zcca = z0 + za 479 zccb = zcorl2(ji,jj) 480 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 481 END DO 482 END DO 483 484 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 485 #if defined key_agrif && defined key_lim2 486 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 487 #endif 488 #if defined key_bdy 489 CALL bdy_ice_lim_dyn( 'V' ) 490 #endif 491 492 ELSE 493 DO jj = k_j1+1, k_jpj-1 494 DO ji = fs_2, fs_jpim1 495 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 496 z0 = zmass2(ji,jj) * z1_dtevp 497 ! SB modif because ocean has no slip boundary condition 498 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) & 499 & +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 500 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 501 502 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + & 503 & ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) ) 504 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 505 zcca = z0 + za 506 zccb = zcorl2(ji,jj) 507 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 508 END DO 509 END DO 510 511 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 512 #if defined key_agrif && defined key_lim2 513 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 514 #endif 515 #if defined key_bdy 516 CALL bdy_ice_lim_dyn( 'V' ) 517 #endif 518 519 DO jj = k_j1+1, k_jpj-1 520 DO ji = fs_2, fs_jpim1 521 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 522 z0 = zmass1(ji,jj) * z1_dtevp 523 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji,jj) & 524 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 525 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 526 527 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + & 528 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 529 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 530 zcca = z0 + za 531 zccb = zcorl1(ji,jj) 532 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 533 END DO 534 END DO 535 536 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 537 #if defined key_agrif && defined key_lim2 538 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 539 #endif 540 #if defined key_bdy 541 CALL bdy_ice_lim_dyn( 'U' ) 542 #endif 595 IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 543 596 544 597 ENDIF 545 598 546 IF(ln_ctl) THEN 547 !--- Convergence test. 548 DO jj = k_j1+1 , k_jpj-1 599 IF(ln_ctl) THEN ! Convergence test 600 DO jj = 2 , jpjm1 549 601 zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 550 602 END DO 551 zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) )603 zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 552 604 IF( lk_mpp ) CALL mpp_max( zresm ) ! max over the global domain 553 605 ENDIF 554 606 ! 555 607 ! ! ==================== ! 556 608 END DO ! end loop over jter ! … … 558 610 ! 559 611 !------------------------------------------------------------------------------! 560 ! 4) Prevent ice velocities when the ice is thin 561 !------------------------------------------------------------------------------! 562 ! If the ice volume is below zvmin then ice velocity should equal the 563 ! ocean velocity. This prevents high velocity when ice is thin 564 DO jj = k_j1+1, k_jpj-1 565 DO ji = fs_2, fs_jpim1 566 IF ( vt_i(ji,jj) <= zvmin ) THEN 567 u_ice(ji,jj) = u_oce(ji,jj) 568 v_ice(ji,jj) = v_oce(ji,jj) 569 ENDIF 612 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 613 !------------------------------------------------------------------------------! 614 DO jj = 1, jpjm1 615 DO ji = 1, jpim1 616 617 ! shear at F points 618 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 619 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 620 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 621 622 END DO 623 END DO 624 CALL lbc_lnk( zds, 'F', 1. ) 625 626 DO jj = 2, jpjm1 627 DO ji = 2, jpim1 ! no vector loop 628 629 ! tension**2 at T points 630 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 631 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 632 & ) * r1_e1e2t(ji,jj) 633 zdt2 = zdt * zdt 634 635 ! shear**2 at T points (doc eq. A16) 636 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e1e2f(ji-1,jj ) & 637 & + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) & 638 & ) * 0.25_wp * r1_e1e2t(ji,jj) 639 640 ! shear at T points 641 shear_i(ji,jj) = SQRT( zdt2 + zds2 ) 642 643 ! divergence at T points 644 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 645 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 646 & ) * r1_e1e2t(ji,jj) 647 648 ! delta at T points 649 zdelta = SQRT( divu_i(ji,jj) * divu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) 650 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 651 delta_i(ji,jj) = zdelta + rn_creepl * rswitch 652 570 653 END DO 571 654 END DO 572 573 CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 574 575 #if defined key_agrif && defined key_lim2 576 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 577 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 578 #endif 579 #if defined key_bdy 580 CALL bdy_ice_lim_dyn( 'U' ) 581 CALL bdy_ice_lim_dyn( 'V' ) 582 #endif 583 584 DO jj = k_j1+1, k_jpj-1 585 DO ji = fs_2, fs_jpim1 586 IF ( vt_i(ji,jj) <= zvmin ) THEN 587 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji, jj-1) ) * e1t(ji+1,jj) & 588 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 589 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 590 591 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 592 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 593 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 594 ENDIF 595 END DO 596 END DO 597 598 CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. ) 599 600 ! Recompute delta, shear and div, inputs for mechanical redistribution 601 DO jj = k_j1+1, k_jpj-1 602 DO ji = fs_2, jpim1 !RB bug no vect opt due to zmask 603 !- divu_i(:,:), zdt(:,:): divergence and tension at centre 604 !- zds(:,:): shear on northeast corner of grid cells 605 IF ( vt_i(ji,jj) <= zvmin ) THEN 606 607 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj ) * u_ice(ji-1,jj ) & 608 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji ,jj-1) * v_ice(ji ,jj-1) & 609 & ) * r1_e1e2t(ji,jj) 610 611 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 612 & -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 613 & ) * r1_e1e2t(ji,jj) 614 ! 615 ! SB modif because ocean has no slip boundary condition 616 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 617 & +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 618 & ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) & 619 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 620 621 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e1e2t(ji,jj) 623 624 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 625 delta_i(ji,jj) = delta + rn_creepl 626 627 ENDIF 628 END DO 629 END DO 630 ! 631 !------------------------------------------------------------------------------! 632 ! 5) Store stress tensor and its invariants 633 !------------------------------------------------------------------------------! 634 ! * Invariants of the stress tensor are required for limitd_me 635 ! (accelerates convergence and improves stability) 636 DO jj = k_j1+1, k_jpj-1 637 DO ji = fs_2, fs_jpim1 638 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj ) * v_ice1(ji-1,jj) & 639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj) 640 shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 641 END DO 642 END DO 643 644 ! Lateral boundary condition 645 CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1., shear_i(:,:), 'T', 1. ) 646 647 ! * Store the stress tensor for the next time step 655 CALL lbc_lnk_multi( shear_i, 'T', 1., divu_i, 'T', 1., delta_i, 'T', 1. ) 656 657 ! --- Store the stress tensor for the next time step --- ! 648 658 stress1_i (:,:) = zs1 (:,:) 649 659 stress2_i (:,:) = zs2 (:,:) 650 660 stress12_i(:,:) = zs12(:,:) 651 652 661 ! 653 !------------------------------------------------------------------------------! 654 ! 6) Control prints of residual and charge ellipse 662 663 !------------------------------------------------------------------------------! 664 ! 5) Control prints of residual and charge ellipse 655 665 !------------------------------------------------------------------------------! 656 666 ! … … 672 682 WRITE(charout,FMT="('lim_rhg :', I4, I6, I1, I1, A10)") 1000, numit, 0, 0, ' ch. ell. ' 673 683 CALL prt_ctl_info(charout) 674 DO jj = k_j1+1, k_jpj-1684 DO jj = 2, jpjm1 675 685 DO ji = 2, jpim1 676 IF ( zpresh(ji,jj) > 1.0) THEN677 sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )678 sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )686 IF (strength(ji,jj) > 1.0) THEN 687 zsig1 = ( zs1(ji,jj) + SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) ) 688 zsig2 = ( zs1(ji,jj) - SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) ) 679 689 WRITE(charout,FMT="('lim_rhg :', I4, I4, D23.16, D23.16, D23.16, D23.16, A10)") 680 690 CALL prt_ctl_info(charout) … … 686 696 ENDIF 687 697 ENDIF 688 ! 689 CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 690 CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 691 CALL wrk_dealloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 692 CALL wrk_dealloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 698 ! 699 700 CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt ) 701 CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 702 CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 703 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 704 CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 693 705 694 706 END SUBROUTINE lim_rhg … … 699 711 !!---------------------------------------------------------------------- 700 712 CONTAINS 701 SUBROUTINE lim_rhg ( k1 , k2 )! Dummy routine702 WRITE(*,*) 'lim_rhg: You should not have seen this print! error?' , k1, k2713 SUBROUTINE lim_rhg ! Dummy routine 714 WRITE(*,*) 'lim_rhg: You should not have seen this print! error?' 703 715 END SUBROUTINE lim_rhg 704 716 #endif -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r6140 r7646 53 53 INTEGER, INTENT(in) :: kt ! number of iteration 54 54 ! 55 CHARACTER( LEN=20) :: clkt ! ocean time-step define as a character56 CHARACTER( LEN=50) :: clname ! ice output restart file name55 CHARACTER(len=20) :: clkt ! ocean time-step define as a character 56 CHARACTER(len=50) :: clname ! ice output restart file name 57 57 CHARACTER(len=256) :: clpath ! full path to ice output restart file 58 58 !!---------------------------------------------------------------------- … … 91 91 ENDIF 92 92 ! 93 IF( ln_ icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print93 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print 94 94 END SUBROUTINE lim_rst_opn 95 95 … … 105 105 INTEGER :: ji, jj, jk ,jl ! dummy loop indices 106 106 INTEGER :: iter 107 CHARACTER(len= 15) :: znam108 CHARACTER(len= 1) :: zchar, zchar1107 CHARACTER(len=25) :: znam 108 CHARACTER(len=2) :: zchar, zchar1 109 109 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 110 110 !!---------------------------------------------------------------------- … … 128 128 ! Prognostic variables 129 129 DO jl = 1, jpl 130 WRITE(zchar,'(I 1)') jl130 WRITE(zchar,'(I2.2)') jl 131 131 znam = 'v_i'//'_htc'//zchar 132 132 z2d(:,:) = v_i(:,:,jl) … … 150 150 151 151 DO jl = 1, jpl 152 WRITE(zchar,'(I 1)') jl152 WRITE(zchar,'(I2.2)') jl 153 153 znam = 'tempt_sl1'//'_htc'//zchar 154 154 z2d(:,:) = e_s(:,:,1,jl) … … 157 157 158 158 DO jl = 1, jpl 159 WRITE(zchar,'(I 1)') jl159 WRITE(zchar,'(I2.2)') jl 160 160 DO jk = 1, nlay_i 161 WRITE(zchar1,'(I 1)') jk161 WRITE(zchar1,'(I2.2)') jk 162 162 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 163 163 z2d(:,:) = e_i(:,:,jk,jl) … … 174 174 CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) 175 175 176 DO jl = 1, jpl 177 WRITE(zchar,'(I1)') jl 178 znam = 'sxice'//'_htc'//zchar 179 z2d(:,:) = sxice(:,:,jl) 180 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 181 znam = 'syice'//'_htc'//zchar 182 z2d(:,:) = syice(:,:,jl) 183 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 184 znam = 'sxxice'//'_htc'//zchar 185 z2d(:,:) = sxxice(:,:,jl) 186 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 187 znam = 'syyice'//'_htc'//zchar 188 z2d(:,:) = syyice(:,:,jl) 189 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 190 znam = 'sxyice'//'_htc'//zchar 191 z2d(:,:) = sxyice(:,:,jl) 192 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 193 znam = 'sxsn'//'_htc'//zchar 194 z2d(:,:) = sxsn(:,:,jl) 195 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 196 znam = 'sysn'//'_htc'//zchar 197 z2d(:,:) = sysn(:,:,jl) 198 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 199 znam = 'sxxsn'//'_htc'//zchar 200 z2d(:,:) = sxxsn(:,:,jl) 201 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 202 znam = 'syysn'//'_htc'//zchar 203 z2d(:,:) = syysn(:,:,jl) 204 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 205 znam = 'sxysn'//'_htc'//zchar 206 z2d(:,:) = sxysn(:,:,jl) 207 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 208 znam = 'sxa'//'_htc'//zchar 209 z2d(:,:) = sxa(:,:,jl) 210 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 211 znam = 'sya'//'_htc'//zchar 212 z2d(:,:) = sya(:,:,jl) 213 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 214 znam = 'sxxa'//'_htc'//zchar 215 z2d(:,:) = sxxa(:,:,jl) 216 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 217 znam = 'syya'//'_htc'//zchar 218 z2d(:,:) = syya(:,:,jl) 219 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 220 znam = 'sxya'//'_htc'//zchar 221 z2d(:,:) = sxya(:,:,jl) 222 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 223 znam = 'sxc0'//'_htc'//zchar 224 z2d(:,:) = sxc0(:,:,jl) 225 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 226 znam = 'syc0'//'_htc'//zchar 227 z2d(:,:) = syc0(:,:,jl) 228 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 229 znam = 'sxxc0'//'_htc'//zchar 230 z2d(:,:) = sxxc0(:,:,jl) 231 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 232 znam = 'syyc0'//'_htc'//zchar 233 z2d(:,:) = syyc0(:,:,jl) 234 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 235 znam = 'sxyc0'//'_htc'//zchar 236 z2d(:,:) = sxyc0(:,:,jl) 237 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 238 znam = 'sxsal'//'_htc'//zchar 239 z2d(:,:) = sxsal(:,:,jl) 240 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 241 znam = 'sysal'//'_htc'//zchar 242 z2d(:,:) = sysal(:,:,jl) 243 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 244 znam = 'sxxsal'//'_htc'//zchar 245 z2d(:,:) = sxxsal(:,:,jl) 246 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 247 znam = 'syysal'//'_htc'//zchar 248 z2d(:,:) = syysal(:,:,jl) 249 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 250 znam = 'sxysal'//'_htc'//zchar 251 z2d(:,:) = sxysal(:,:,jl) 252 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 253 znam = 'sxage'//'_htc'//zchar 254 z2d(:,:) = sxage(:,:,jl) 255 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 256 znam = 'syage'//'_htc'//zchar 257 z2d(:,:) = syage(:,:,jl) 258 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 259 znam = 'sxxage'//'_htc'//zchar 260 z2d(:,:) = sxxage(:,:,jl) 261 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 262 znam = 'syyage'//'_htc'//zchar 263 z2d(:,:) = syyage(:,:,jl) 264 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 265 znam = 'sxyage'//'_htc'//zchar 266 z2d(:,:) = sxyage(:,:,jl) 267 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 268 END DO 269 270 CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' , sxopw ) 271 CALL iom_rstput( iter, nitrst, numriw, 'syopw ' , syopw ) 272 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' , sxxopw ) 273 CALL iom_rstput( iter, nitrst, numriw, 'syyopw' , syyopw ) 274 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' , sxyopw ) 275 276 DO jl = 1, jpl 277 WRITE(zchar,'(I1)') jl 278 DO jk = 1, nlay_i 279 WRITE(zchar1,'(I1)') jk 280 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 281 z2d(:,:) = sxe(:,:,jk,jl) 282 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 283 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 284 z2d(:,:) = sye(:,:,jk,jl) 285 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 286 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 287 z2d(:,:) = sxxe(:,:,jk,jl) 288 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 289 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 290 z2d(:,:) = syye(:,:,jk,jl) 291 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 292 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 293 z2d(:,:) = sxye(:,:,jk,jl) 294 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 295 END DO 296 END DO 297 176 ! In case Prather scheme is used for advection, write second order moments 177 ! ------------------------------------------------------------------------ 178 IF( nn_limadv == -1 ) THEN 179 180 DO jl = 1, jpl 181 WRITE(zchar,'(I2.2)') jl 182 znam = 'sxice'//'_htc'//zchar 183 z2d(:,:) = sxice(:,:,jl) 184 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 185 znam = 'syice'//'_htc'//zchar 186 z2d(:,:) = syice(:,:,jl) 187 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 188 znam = 'sxxice'//'_htc'//zchar 189 z2d(:,:) = sxxice(:,:,jl) 190 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 191 znam = 'syyice'//'_htc'//zchar 192 z2d(:,:) = syyice(:,:,jl) 193 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 194 znam = 'sxyice'//'_htc'//zchar 195 z2d(:,:) = sxyice(:,:,jl) 196 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 197 znam = 'sxsn'//'_htc'//zchar 198 z2d(:,:) = sxsn(:,:,jl) 199 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 200 znam = 'sysn'//'_htc'//zchar 201 z2d(:,:) = sysn(:,:,jl) 202 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 203 znam = 'sxxsn'//'_htc'//zchar 204 z2d(:,:) = sxxsn(:,:,jl) 205 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 206 znam = 'syysn'//'_htc'//zchar 207 z2d(:,:) = syysn(:,:,jl) 208 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 209 znam = 'sxysn'//'_htc'//zchar 210 z2d(:,:) = sxysn(:,:,jl) 211 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 212 znam = 'sxa'//'_htc'//zchar 213 z2d(:,:) = sxa(:,:,jl) 214 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 215 znam = 'sya'//'_htc'//zchar 216 z2d(:,:) = sya(:,:,jl) 217 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 218 znam = 'sxxa'//'_htc'//zchar 219 z2d(:,:) = sxxa(:,:,jl) 220 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 221 znam = 'syya'//'_htc'//zchar 222 z2d(:,:) = syya(:,:,jl) 223 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 224 znam = 'sxya'//'_htc'//zchar 225 z2d(:,:) = sxya(:,:,jl) 226 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 227 znam = 'sxc0'//'_htc'//zchar 228 z2d(:,:) = sxc0(:,:,jl) 229 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 230 znam = 'syc0'//'_htc'//zchar 231 z2d(:,:) = syc0(:,:,jl) 232 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 233 znam = 'sxxc0'//'_htc'//zchar 234 z2d(:,:) = sxxc0(:,:,jl) 235 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 236 znam = 'syyc0'//'_htc'//zchar 237 z2d(:,:) = syyc0(:,:,jl) 238 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 239 znam = 'sxyc0'//'_htc'//zchar 240 z2d(:,:) = sxyc0(:,:,jl) 241 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 242 znam = 'sxsal'//'_htc'//zchar 243 z2d(:,:) = sxsal(:,:,jl) 244 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 245 znam = 'sysal'//'_htc'//zchar 246 z2d(:,:) = sysal(:,:,jl) 247 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 248 znam = 'sxxsal'//'_htc'//zchar 249 z2d(:,:) = sxxsal(:,:,jl) 250 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 251 znam = 'syysal'//'_htc'//zchar 252 z2d(:,:) = syysal(:,:,jl) 253 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 254 znam = 'sxysal'//'_htc'//zchar 255 z2d(:,:) = sxysal(:,:,jl) 256 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 257 znam = 'sxage'//'_htc'//zchar 258 z2d(:,:) = sxage(:,:,jl) 259 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 260 znam = 'syage'//'_htc'//zchar 261 z2d(:,:) = syage(:,:,jl) 262 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 263 znam = 'sxxage'//'_htc'//zchar 264 z2d(:,:) = sxxage(:,:,jl) 265 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 266 znam = 'syyage'//'_htc'//zchar 267 z2d(:,:) = syyage(:,:,jl) 268 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 269 znam = 'sxyage'//'_htc'//zchar 270 z2d(:,:) = sxyage(:,:,jl) 271 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 272 END DO 273 274 CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' , sxopw ) 275 CALL iom_rstput( iter, nitrst, numriw, 'syopw ' , syopw ) 276 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' , sxxopw ) 277 CALL iom_rstput( iter, nitrst, numriw, 'syyopw' , syyopw ) 278 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' , sxyopw ) 279 280 DO jl = 1, jpl 281 WRITE(zchar,'(I2.2)') jl 282 DO jk = 1, nlay_i 283 WRITE(zchar1,'(I2.2)') jk 284 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 285 z2d(:,:) = sxe(:,:,jk,jl) 286 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 287 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 288 z2d(:,:) = sye(:,:,jk,jl) 289 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 290 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 291 z2d(:,:) = sxxe(:,:,jk,jl) 292 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 293 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 294 z2d(:,:) = syye(:,:,jk,jl) 295 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 296 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 297 z2d(:,:) = sxye(:,:,jk,jl) 298 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 299 END DO 300 END DO 301 302 ENDIF 303 304 ! close restart file 305 ! ------------------ 298 306 IF( iter == nitrst ) THEN 299 CALL iom_close( numriw ) ! close the restart file307 CALL iom_close( numriw ) 300 308 lrst_ice = .FALSE. 301 309 ENDIF … … 315 323 REAL(wp) :: zfice, ziter 316 324 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 317 CHARACTER(len= 15) :: znam318 CHARACTER(len= 1) :: zchar, zchar1325 CHARACTER(len=25) :: znam 326 CHARACTER(len=2) :: zchar, zchar1 319 327 INTEGER :: jlibalt = jprstlib 320 328 LOGICAL :: llok … … 347 355 & ' control of time parameter nrstdt' ) 348 356 357 ! Prognostic variables 349 358 DO jl = 1, jpl 350 WRITE(zchar,'(I 1)') jl359 WRITE(zchar,'(I2.2)') jl 351 360 znam = 'v_i'//'_htc'//zchar 352 361 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) … … 370 379 371 380 DO jl = 1, jpl 372 WRITE(zchar,'(I 1)') jl381 WRITE(zchar,'(I2.2)') jl 373 382 znam = 'tempt_sl1'//'_htc'//zchar 374 383 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) … … 377 386 378 387 DO jl = 1, jpl 379 WRITE(zchar,'(I 1)') jl388 WRITE(zchar,'(I2.2)') jl 380 389 DO jk = 1, nlay_i 381 WRITE(zchar1,'(I 1)') jk390 WRITE(zchar1,'(I2.2)') jk 382 391 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 383 392 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) … … 394 403 CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 395 404 396 DO jl = 1, jpl 397 WRITE(zchar,'(I1)') jl 398 znam = 'sxice'//'_htc'//zchar 399 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 400 sxice(:,:,jl) = z2d(:,:) 401 znam = 'syice'//'_htc'//zchar 402 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 403 syice(:,:,jl) = z2d(:,:) 404 znam = 'sxxice'//'_htc'//zchar 405 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 406 sxxice(:,:,jl) = z2d(:,:) 407 znam = 'syyice'//'_htc'//zchar 408 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 409 syyice(:,:,jl) = z2d(:,:) 410 znam = 'sxyice'//'_htc'//zchar 411 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 412 sxyice(:,:,jl) = z2d(:,:) 413 znam = 'sxsn'//'_htc'//zchar 414 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 415 sxsn(:,:,jl) = z2d(:,:) 416 znam = 'sysn'//'_htc'//zchar 417 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 418 sysn(:,:,jl) = z2d(:,:) 419 znam = 'sxxsn'//'_htc'//zchar 420 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 421 sxxsn(:,:,jl) = z2d(:,:) 422 znam = 'syysn'//'_htc'//zchar 423 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 424 syysn(:,:,jl) = z2d(:,:) 425 znam = 'sxysn'//'_htc'//zchar 426 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 427 sxysn(:,:,jl) = z2d(:,:) 428 znam = 'sxa'//'_htc'//zchar 429 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 430 sxa(:,:,jl) = z2d(:,:) 431 znam = 'sya'//'_htc'//zchar 432 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 433 sya(:,:,jl) = z2d(:,:) 434 znam = 'sxxa'//'_htc'//zchar 435 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 436 sxxa(:,:,jl) = z2d(:,:) 437 znam = 'syya'//'_htc'//zchar 438 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 439 syya(:,:,jl) = z2d(:,:) 440 znam = 'sxya'//'_htc'//zchar 441 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 442 sxya(:,:,jl) = z2d(:,:) 443 znam = 'sxc0'//'_htc'//zchar 444 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 445 sxc0(:,:,jl) = z2d(:,:) 446 znam = 'syc0'//'_htc'//zchar 447 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 448 syc0(:,:,jl) = z2d(:,:) 449 znam = 'sxxc0'//'_htc'//zchar 450 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 451 sxxc0(:,:,jl) = z2d(:,:) 452 znam = 'syyc0'//'_htc'//zchar 453 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 454 syyc0(:,:,jl) = z2d(:,:) 455 znam = 'sxyc0'//'_htc'//zchar 456 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 457 sxyc0(:,:,jl) = z2d(:,:) 458 znam = 'sxsal'//'_htc'//zchar 459 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 460 sxsal(:,:,jl) = z2d(:,:) 461 znam = 'sysal'//'_htc'//zchar 462 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 463 sysal(:,:,jl) = z2d(:,:) 464 znam = 'sxxsal'//'_htc'//zchar 465 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 466 sxxsal(:,:,jl) = z2d(:,:) 467 znam = 'syysal'//'_htc'//zchar 468 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 469 syysal(:,:,jl) = z2d(:,:) 470 znam = 'sxysal'//'_htc'//zchar 471 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 472 sxysal(:,:,jl) = z2d(:,:) 473 znam = 'sxage'//'_htc'//zchar 474 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 475 sxage(:,:,jl) = z2d(:,:) 476 znam = 'syage'//'_htc'//zchar 477 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 478 syage(:,:,jl) = z2d(:,:) 479 znam = 'sxxage'//'_htc'//zchar 480 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 481 sxxage(:,:,jl) = z2d(:,:) 482 znam = 'syyage'//'_htc'//zchar 483 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 484 syyage(:,:,jl) = z2d(:,:) 485 znam = 'sxyage'//'_htc'//zchar 486 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 487 sxyage(:,:,jl)= z2d(:,:) 488 END DO 489 490 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' , sxopw ) 491 CALL iom_get( numrir, jpdom_autoglo, 'syopw ' , syopw ) 492 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' , sxxopw ) 493 CALL iom_get( numrir, jpdom_autoglo, 'syyopw' , syyopw ) 494 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' , sxyopw ) 495 496 DO jl = 1, jpl 497 WRITE(zchar,'(I1)') jl 498 DO jk = 1, nlay_i 499 WRITE(zchar1,'(I1)') jk 500 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 501 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 502 sxe(:,:,jk,jl) = z2d(:,:) 503 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 504 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 505 sye(:,:,jk,jl) = z2d(:,:) 506 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 507 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 508 sxxe(:,:,jk,jl) = z2d(:,:) 509 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 510 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 511 syye(:,:,jk,jl) = z2d(:,:) 512 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 513 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 514 sxye(:,:,jk,jl) = z2d(:,:) 515 END DO 516 END DO 517 ! 405 ! In case Prather scheme is used for advection, read second order moments 406 ! ------------------------------------------------------------------------ 407 IF( nn_limadv == -1 ) THEN 408 409 DO jl = 1, jpl 410 WRITE(zchar,'(I2.2)') jl 411 znam = 'sxice'//'_htc'//zchar 412 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 413 sxice(:,:,jl) = z2d(:,:) 414 znam = 'syice'//'_htc'//zchar 415 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 416 syice(:,:,jl) = z2d(:,:) 417 znam = 'sxxice'//'_htc'//zchar 418 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 419 sxxice(:,:,jl) = z2d(:,:) 420 znam = 'syyice'//'_htc'//zchar 421 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 422 syyice(:,:,jl) = z2d(:,:) 423 znam = 'sxyice'//'_htc'//zchar 424 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 425 sxyice(:,:,jl) = z2d(:,:) 426 znam = 'sxsn'//'_htc'//zchar 427 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 428 sxsn(:,:,jl) = z2d(:,:) 429 znam = 'sysn'//'_htc'//zchar 430 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 431 sysn(:,:,jl) = z2d(:,:) 432 znam = 'sxxsn'//'_htc'//zchar 433 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 434 sxxsn(:,:,jl) = z2d(:,:) 435 znam = 'syysn'//'_htc'//zchar 436 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 437 syysn(:,:,jl) = z2d(:,:) 438 znam = 'sxysn'//'_htc'//zchar 439 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 440 sxysn(:,:,jl) = z2d(:,:) 441 znam = 'sxa'//'_htc'//zchar 442 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 443 sxa(:,:,jl) = z2d(:,:) 444 znam = 'sya'//'_htc'//zchar 445 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 446 sya(:,:,jl) = z2d(:,:) 447 znam = 'sxxa'//'_htc'//zchar 448 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 449 sxxa(:,:,jl) = z2d(:,:) 450 znam = 'syya'//'_htc'//zchar 451 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 452 syya(:,:,jl) = z2d(:,:) 453 znam = 'sxya'//'_htc'//zchar 454 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 455 sxya(:,:,jl) = z2d(:,:) 456 znam = 'sxc0'//'_htc'//zchar 457 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 458 sxc0(:,:,jl) = z2d(:,:) 459 znam = 'syc0'//'_htc'//zchar 460 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 461 syc0(:,:,jl) = z2d(:,:) 462 znam = 'sxxc0'//'_htc'//zchar 463 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 464 sxxc0(:,:,jl) = z2d(:,:) 465 znam = 'syyc0'//'_htc'//zchar 466 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 467 syyc0(:,:,jl) = z2d(:,:) 468 znam = 'sxyc0'//'_htc'//zchar 469 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 470 sxyc0(:,:,jl) = z2d(:,:) 471 znam = 'sxsal'//'_htc'//zchar 472 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 473 sxsal(:,:,jl) = z2d(:,:) 474 znam = 'sysal'//'_htc'//zchar 475 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 476 sysal(:,:,jl) = z2d(:,:) 477 znam = 'sxxsal'//'_htc'//zchar 478 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 479 sxxsal(:,:,jl) = z2d(:,:) 480 znam = 'syysal'//'_htc'//zchar 481 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 482 syysal(:,:,jl) = z2d(:,:) 483 znam = 'sxysal'//'_htc'//zchar 484 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 485 sxysal(:,:,jl) = z2d(:,:) 486 znam = 'sxage'//'_htc'//zchar 487 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 488 sxage(:,:,jl) = z2d(:,:) 489 znam = 'syage'//'_htc'//zchar 490 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 491 syage(:,:,jl) = z2d(:,:) 492 znam = 'sxxage'//'_htc'//zchar 493 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 494 sxxage(:,:,jl) = z2d(:,:) 495 znam = 'syyage'//'_htc'//zchar 496 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 497 syyage(:,:,jl) = z2d(:,:) 498 znam = 'sxyage'//'_htc'//zchar 499 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 500 sxyage(:,:,jl)= z2d(:,:) 501 END DO 502 503 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' , sxopw ) 504 CALL iom_get( numrir, jpdom_autoglo, 'syopw ' , syopw ) 505 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' , sxxopw ) 506 CALL iom_get( numrir, jpdom_autoglo, 'syyopw' , syyopw ) 507 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' , sxyopw ) 508 509 DO jl = 1, jpl 510 WRITE(zchar,'(I2.2)') jl 511 DO jk = 1, nlay_i 512 WRITE(zchar1,'(I2.2)') jk 513 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 514 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 515 sxe(:,:,jk,jl) = z2d(:,:) 516 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 517 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 518 sye(:,:,jk,jl) = z2d(:,:) 519 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 520 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 521 sxxe(:,:,jk,jl) = z2d(:,:) 522 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 523 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 524 syye(:,:,jk,jl) = z2d(:,:) 525 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 526 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 527 sxye(:,:,jk,jl) = z2d(:,:) 528 END DO 529 END DO 530 ! 531 END IF 532 518 533 ! clem: I do not understand why the following IF is needed 519 534 ! I suspect something inconsistent in the main code with option nn_icesal=1 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r6416 r7646 34 34 USE traqsr ! add penetration of solar flux in the calculation of heat budget 35 35 USE domvvl ! Variable volume 36 USE limctl ! 37 USE limcons ! 36 USE limctl ! 37 USE limcons ! 38 USE bdy_oce , ONLY: ln_bdy 38 39 ! 39 40 USE in_out_manager ! I/O manager … … 42 43 USE lib_mpp ! MPP library 43 44 USE wrk_nemo ! work arrays 44 USE prtctl ! Print control45 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 46 46 … … 48 48 PRIVATE 49 49 50 PUBLIC lim_sbc_init ! called by sbc ice_lim50 PUBLIC lim_sbc_init ! called by sbc_lim_init 51 51 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 52 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim … … 94 94 !! - fr_i : ice fraction 95 95 !! - tn_ice : sea-ice surface temperature 96 !! - alb_ice : sea-ice albedo ( only useful incoupled mode)96 !! - alb_ice : sea-ice albedo (recomputed only for coupled mode) 97 97 !! 98 98 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 109 109 REAL(wp), POINTER, DIMENSION(:,:) :: zalb ! 2D workspace 110 110 !!--------------------------------------------------------------------- 111 ! 112 ! make calls for heat fluxes before it is modified 113 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 114 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 115 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 116 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 117 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 118 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 119 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 120 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 121 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 122 IF( iom_use('qemp_oce') ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 123 IF( iom_use('qemp_ice') ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 124 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce" , emp_oce(:,:) ) ! emp over ocean (taking into account the snow blown away from the ice) 125 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice" , emp_ice(:,:) ) ! emp over ice (taking into account the snow blown away from the ice) 126 111 112 ! --- case we bypass ice thermodynamics --- ! 113 IF( .NOT. ln_limthd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere 114 hfx_in (:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 115 hfx_out (:,:) = pfrld(:,:) * qns_oce(:,:) + qemp_oce(:,:) 116 ftr_ice (:,:,:) = 0._wp 117 emp_ice (:,:) = 0._wp 118 qemp_ice (:,:) = 0._wp 119 qevap_ice(:,:,:) = 0._wp 120 ENDIF 121 127 122 ! albedo output 128 123 CALL wrk_alloc( jpi,jpj, zalb ) 129 124 130 125 zalb(:,:) = 0._wp 131 WHERE ( SUM( a_i_b, dim=3 )<= epsi06 ) ; zalb(:,:) = 0.066_wp132 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 )126 WHERE ( at_i_b <= epsi06 ) ; zalb(:,:) = 0.066_wp 127 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 133 128 END WHERE 134 129 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output 135 130 136 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ))131 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b ) 137 132 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 138 133 … … 180 175 ! mass flux from ice/ocean 181 176 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 182 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 177 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 183 178 184 179 ! mass flux at the ocean/ice interface 185 180 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) ) ! F/M mass flux save at least for biogeochemical model 186 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 181 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 187 182 END DO 188 183 END DO … … 192 187 !------------------------------------------! 193 188 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 194 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 189 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 195 190 196 191 !-------------------------------------------------------------! … … 221 216 222 217 ! conservation test 223 IF( ln_limdia hsb )CALL lim_cons_final( 'limsbc' )218 IF( ln_limdiachk .AND. .NOT. ln_bdy) CALL lim_cons_final( 'limsbc' ) 224 219 225 220 ! control prints 226 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 227 ! 228 IF(ln_ctl) THEN 229 CALL prt_ctl( tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ' ) 230 CALL prt_ctl( tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ' ) 231 CALL prt_ctl( tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ' ) 232 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 233 ENDIF 234 ! 221 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 222 IF( ln_ctl ) CALL lim_prt3D( 'limsbc' ) 223 235 224 END SUBROUTINE lim_sbc_flx 236 225 … … 266 255 INTEGER :: ji, jj ! dummy loop indices 267 256 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar 268 REAL(wp) :: zat_v, zvtau_ice, zv_t 257 REAL(wp) :: zat_v, zvtau_ice, zv_t, zrhoco ! - - 269 258 !!--------------------------------------------------------------------- 259 zrhoco = rau0 * rn_cio 270 260 ! 271 261 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) … … 278 268 zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) 279 269 ! ! update the ocean stress modulus 280 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt281 tmod_io(ji,jj) = rhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point270 taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 271 tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point 282 272 END DO 283 273 END DO 284 CALL lbc_lnk ( taum, 'T', 1. ) ; CALL lbc_lnk(tmod_io, 'T', 1. )274 CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 285 275 ! 286 276 utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step … … 303 293 END DO 304 294 END DO 305 CALL lbc_lnk( utau, 'U', -1. ) ; CALL lbc_lnk( vtau, 'V', -1. ) ! lateral boundary condition 306 ! 307 IF(ln_ctl) CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau : ', mask1=umask, & 308 & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask ) 295 CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. ) ! lateral boundary condition 296 ! 309 297 ! 310 298 END SUBROUTINE lim_sbc_tau … … 333 321 soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case 334 322 sice_0(:,:) = sice 335 ! 336 IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea 337 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 338 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 339 soce_0(:,:) = 4._wp 340 sice_0(:,:) = 2._wp 341 END WHERE 342 ENDIF 323 ! ! decrease ocean & ice reference salinities in the Baltic Sea area 324 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 325 & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 326 soce_0(:,:) = 4._wp 327 sice_0(:,:) = 2._wp 328 END WHERE 343 329 ! 344 330 IF( .NOT. ln_rstart ) THEN … … 348 334 snwice_mass_b(:,:) = snwice_mass(:,:) 349 335 ELSE 350 snwice_mass (:,:) = 0. 0_wp! no mass exchanges351 snwice_mass_b(:,:) = 0. 0_wp! no mass exchanges336 snwice_mass (:,:) = 0._wp ! no mass exchanges 337 snwice_mass_b(:,:) = 0._wp ! no mass exchanges 352 338 ENDIF 353 339 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2) deplete the initial ssh below sea-ice area … … 355 341 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 356 342 357 !!gm I really don't like this st aff here... Find a way to put that elsewhere or differently343 !!gm I really don't like this stuff here... Find a way to put that elsewhere or differently 358 344 !!gm 359 345 IF( .NOT.ln_linssh ) THEN -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r6416 r7646 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE ice ! LIM:sea-ice variables24 USE ice ! sea-ice variables 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE dom_ice ! LIM: sea-ice domain28 USE thd_ice ! LIM: thermodynamic sea-ice variables29 USE limthd_d if ! LIM: thermodynamics, vertical diffusion30 USE limthd_d h ! LIM: thermodynamics, ice and snow thickness variation31 USE limthd_sal ! LIM: thermodynamics,ice salinity32 USE limthd_ent ! LIM: thermodynamics,ice enthalpy redistribution33 USE limthd_lac ! LIM:lateral accretion34 USE limitd_th ! LIM:remapping thickness distribution35 USE limtab ! LIM:1D <==> 2D transformation36 USE limvar ! LIM: sea-ice variables37 USE limcons ! LIM:conservation tests38 USE limctl ! LIM:control print27 USE thd_ice ! thermodynamic sea-ice variables 28 USE limthd_dif ! vertical diffusion 29 USE limthd_dh ! ice-snow growth and melt 30 USE limthd_da ! lateral melting 31 USE limthd_sal ! ice salinity 32 USE limthd_ent ! ice enthalpy redistribution 33 USE limthd_lac ! lateral accretion 34 USE limitd_th ! remapping thickness distribution 35 USE limtab ! 1D <==> 2D transformation 36 USE limvar ! 37 USE limcons ! conservation tests 38 USE limctl ! control print 39 39 ! 40 40 USE in_out_manager ! I/O manager 41 USE prtctl ! Print control42 41 USE lbclnk ! lateral boundary condition - MPP links 43 42 USE lib_mpp ! MPP library … … 88 87 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 89 88 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 89 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 90 ! 90 91 !!------------------------------------------------------------------- 91 92 92 93 IF( nn_timing == 1 ) CALL timing_start('limthd') 93 94 95 CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) 96 97 IF( kt == nit000 .AND. lwp ) THEN 98 WRITE(numout,*)'' 99 WRITE(numout,*)' lim_thd ' 100 WRITE(numout,*)' ~~~~~~~~' 101 ENDIF 102 94 103 ! conservation test 95 IF( ln_limdia hsb ) CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)104 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 96 105 97 106 CALL lim_var_glo2eqv 98 !------------------------------------------------------------------------! 99 ! 1) Initialization of some variables ! 100 !------------------------------------------------------------------------! 107 108 !---------------------------------------------! 109 ! computation of friction velocity at T points 110 !---------------------------------------------! 111 IF( ln_limdyn ) THEN 112 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 113 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 114 DO jj = 2, jpjm1 115 DO ji = fs_2, fs_jpim1 116 zfric(ji,jj) = rn_cio * ( 0.5_wp * & 117 & ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 118 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 119 END DO 120 END DO 121 ELSE ! if no ice dynamics => transmit directly the atmospheric stress to the ocean 122 DO jj = 2, jpjm1 123 DO ji = fs_2, fs_jpim1 124 zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp * & 125 & ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 126 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 127 END DO 128 END DO 129 ENDIF 130 CALL lbc_lnk( zfric, 'T', 1. ) 131 ! 132 !----------------------------------! 133 ! Initialization and units change 134 !----------------------------------! 101 135 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 102 136 103 !--------------------104 ! 1.2) Heat content105 !--------------------106 137 ! Change the units of heat content; from J/m2 to J/m3 107 138 DO jl = 1, jpl … … 109 140 DO jj = 1, jpj 110 141 DO ji = 1, jpi 111 !0 if no ice and 1 if yes112 142 rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 ) ) 113 143 !Energy of melting q(S,T) [J.m-3] … … 119 149 DO jj = 1, jpj 120 150 DO ji = 1, jpi 121 !0 if no ice and 1 if yes122 151 rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) ) 123 152 !Energy of melting q(S,T) [J.m-3] … … 128 157 END DO 129 158 130 ! 2) Partial computation of forcing for the thermodynamic sea ice model. ! 131 !-----------------------------------------------------------------------------! 159 !--------------------------------------------------------------------! 160 ! Partial computation of forcing for the thermodynamic sea ice model 161 !--------------------------------------------------------------------! 132 162 DO jj = 1, jpj 133 163 DO ji = 1, jpi … … 148 178 149 179 ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 150 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )180 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 151 181 fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 152 182 fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) … … 166 196 ENDIF 167 197 ! 168 ! ----------------------------------------- 169 ! Net heat flux on top of ice-ocean [W.m-2] 170 ! ----------------------------------------- 198 ! Net heat flux on top of the ice-ocean [W.m-2] 199 ! --------------------------------------------- 171 200 hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 172 173 ! ----------------------------------------------------------------------------- 174 ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 175 ! ----------------------------------------------------------------------------- 176 ! First step here : non solar + precip - qlead - qturb 177 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 178 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 201 END DO 202 END DO 203 204 ! In case we bypass open-water ice formation 205 IF( .NOT. ln_limdO ) qlead(:,:) = 0._wp 206 ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 207 IF( .NOT. ln_limdH ) hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 208 IF( .NOT. ln_limdH ) fhtur (:,:) = 0._wp ; fhld (:,:) = 0._wp 209 210 ! --------------------------------------------------------------------- 211 ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 212 ! --------------------------------------------------------------------- 213 ! First step here : non solar + precip - qlead - qturb 214 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 215 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 216 DO jj = 1, jpj 217 DO ji = 1, jpi 179 218 hfx_out(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) & ! Non solar heat flux received by the ocean 180 219 & - qlead(ji,jj) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation … … 186 225 187 226 !------------------------------------------------------------------------------! 188 ! 3) Select icy points and fulfill arrays for the vectorial grid.227 ! Thermodynamic computation (only on grid points covered by ice) 189 228 !------------------------------------------------------------------------------! 190 229 191 230 DO jl = 1, jpl !loop over ice categories 192 231 193 IF( kt == nit000 .AND. lwp ) THEN 194 WRITE(numout,*) ' lim_thd : transfer to 1D vectors. Category no : ', jl 195 WRITE(numout,*) ' ~~~~~~~~' 196 ENDIF 197 232 ! select ice covered grid points 198 233 nbpb = 0 199 234 DO jj = 1, jpj … … 208 243 ! debug point to follow 209 244 jiindex_1d = 0 210 IF( ln_ icectl ) THEN245 IF( ln_limctl ) THEN 211 246 DO ji = mi0(iiceprt), mi1(iiceprt) 212 247 DO jj = mj0(jiceprt), mj1(jiceprt) … … 217 252 ENDIF 218 253 219 !------------------------------------------------------------------------------! 220 ! 4) Thermodynamic computation 221 !------------------------------------------------------------------------------! 222 223 IF( lk_mpp ) CALL mpp_ini_ice( nbpb , numout ) 254 IF( lk_mpp ) CALL mpp_ini_ice( nbpb , numout ) 224 255 225 256 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. 226 ! 227 CALL lim_thd_1d2d( nbpb, jl, 1 ) ! --- Move to 1D arrays ---! 228 ! 229 CALL lim_thd_dif ( 1, nbpb ) ! --- Ice/Snow Temperature profile --- ! 230 ! 231 CALL lim_thd_dh ( 1, nbpb ) ! --- Ice/Snow thickness ---! 232 ! 233 CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) ) ! --- Ice enthalpy remapping --- ! 234 ! 235 CALL lim_thd_sal ( 1, nbpb ) ! --- Ice salinity --- ! 236 ! 237 CALL lim_thd_temp( 1, nbpb ) ! --- temperature update --- ! 238 ! 239 ! ! --- lateral melting if monocat --- ! 240 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 241 CALL lim_thd_lam( 1, nbpb ) 257 ! 258 s_i_new (:) = 0._wp ; dh_s_tot (:) = 0._wp ! --- some init --- ! 259 dh_i_surf (:) = 0._wp ; dh_i_bott(:) = 0._wp 260 dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp 261 262 CALL lim_thd_1d2d( nbpb, jl, 1 ) ! --- Move to 1D arrays --- ! 263 ! 264 IF( ln_limdH ) CALL lim_thd_dif( 1, nbpb ) ! --- Ice/Snow Temperature profile --- ! 265 ! 266 IF( ln_limdH ) CALL lim_thd_dh( 1, nbpb ) ! --- Ice/Snow thickness --- ! 267 ! 268 IF( ln_limdH ) CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) ! --- Ice enthalpy remapping --- ! 269 ! 270 CALL lim_thd_sal( 1, nbpb ) ! --- Ice salinity --- ! 271 ! 272 CALL lim_thd_temp( 1, nbpb ) ! --- temperature update --- ! 273 ! 274 IF( ln_limdH ) THEN 275 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 276 CALL lim_thd_lam( 1, nbpb ) ! --- extra lateral melting if monocat --- ! 277 END IF 242 278 END IF 243 279 ! 244 CALL lim_thd_1d2d( nbpb, jl, 2 ) ! --- Move to 2D arrays ---245 ! 246 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice )!RB necessary ??280 CALL lim_thd_1d2d( nbpb, jl, 2 ) ! --- Move to 2D arrays --- ! 281 ! 282 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 247 283 ENDIF 248 284 ! 249 285 END DO !jl 250 286 251 !------------------------------------------------------------------------------! 252 ! 5) Global variables, diagnostics 253 !------------------------------------------------------------------------------! 254 255 !------------------------ 256 ! Ice heat content 257 !------------------------ 287 IF( ln_limdA) CALL lim_thd_da ! --- lateral melting --- ! 288 258 289 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 259 290 DO jl = 1, jpl … … 261 292 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 262 293 END DO 263 END DO264 265 !------------------------266 ! Snow heat content267 !------------------------268 ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)269 DO jl = 1, jpl270 294 DO jk = 1, nlay_s 271 295 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s … … 273 297 END DO 274 298 275 !----------------------------------276 299 ! Change thickness to volume 277 !----------------------------------278 300 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:) 279 301 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) … … 292 314 CALL lim_var_zapsmall 293 315 294 !-------------------------------------------- 295 ! Diagnostic thermodynamic growth rates 296 !-------------------------------------------- 297 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' ) ! control print 298 299 IF(ln_ctl) THEN ! Control print 300 CALL prt_ctl_info(' ') 301 CALL prt_ctl_info(' - Cell values : ') 302 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 303 CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd : cell area :') 304 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd : at_i :') 305 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd : vt_i :') 306 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_thd : vt_s :') 307 DO jl = 1, jpl 308 CALL prt_ctl_info(' ') 309 CALL prt_ctl_info(' - Category : ', ivar1=jl) 310 CALL prt_ctl_info(' ~~~~~~~~~~') 311 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_thd : a_i : ') 312 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_thd : ht_i : ') 313 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_thd : ht_s : ') 314 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_thd : v_i : ') 315 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_thd : v_s : ') 316 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_thd : e_s : ') 317 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_thd : t_su : ') 318 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_thd : t_snow : ') 319 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_thd : sm_i : ') 320 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_thd : smv_i : ') 321 DO jk = 1, nlay_i 322 CALL prt_ctl_info(' ') 323 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 324 CALL prt_ctl_info(' ~~~~~~~') 325 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_thd : t_i : ') 326 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_thd : e_i : ') 327 END DO 328 END DO 329 ENDIF 330 ! 331 ! 332 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 333 334 !------------------------------------------------------------------------------| 335 ! 6) Transport of ice between thickness categories. | 336 !------------------------------------------------------------------------------| 316 ! control checks 317 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' ) ! control print 318 ! 319 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 320 321 !------------------------------------------------! 322 ! Transport ice between thickness categories 323 !------------------------------------------------! 337 324 ! Given thermodynamic growth rates, transport ice between thickness categories. 338 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)325 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 339 326 340 327 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 341 328 342 IF( ln_limdia hsb) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)343 344 !------------------------------------------------ ------------------------------|345 ! 7) Add frazil ice growing in leads.346 !------------------------------------------------ ------------------------------|347 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)348 349 CALL lim_thd_lac329 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 330 331 !------------------------------------------------! 332 ! Add frazil ice growing in leads 333 !------------------------------------------------! 334 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 335 336 IF( ln_limdO ) CALL lim_thd_lac 350 337 351 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 338 ! conservation test 339 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 352 340 353 341 ! Control print 354 IF(ln_ctl) THEN 355 CALL lim_var_glo2eqv 356 357 CALL prt_ctl_info(' ') 358 CALL prt_ctl_info(' - Cell values : ') 359 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 360 CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th : cell area :') 361 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :') 362 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :') 363 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :') 364 DO jl = 1, jpl 365 CALL prt_ctl_info(' ') 366 CALL prt_ctl_info(' - Category : ', ivar1=jl) 367 CALL prt_ctl_info(' ~~~~~~~~~~') 368 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ') 369 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ') 370 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ') 371 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ') 372 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ') 373 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ') 374 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ') 375 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ') 376 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 377 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 378 DO jk = 1, nlay_i 379 CALL prt_ctl_info(' ') 380 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 381 CALL prt_ctl_info(' ~~~~~~~') 382 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 383 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 384 END DO 385 END DO 386 ENDIF 387 ! 388 IF( nn_timing == 1 ) CALL timing_stop('limthd') 389 ! 342 IF( ln_ctl ) CALL lim_prt3D( 'limthd' ) 343 ! 344 CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric ) 345 ! 346 IF( nn_timing == 1 ) CALL timing_stop('limthd') 347 390 348 END SUBROUTINE lim_thd 391 349 … … 449 407 zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 450 408 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 451 409 ! adjust thickness 452 410 ht_i_1d(ji) = zvi / a_i_1d(ji) 453 411 ht_s_1d(ji) = zvs / a_i_1d(ji) … … 613 571 !!------------------------------------------------------------------- 614 572 INTEGER :: ios ! Local integer output status for namelist read 615 !!616 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,&617 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,&618 & nn_monocat, ln_it_qnsice573 NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,ln_it_qnsice,nn_monocat, & 574 & ln_limdH, rn_betas, & 575 & ln_limdA, rn_beta, rn_dmin, & 576 & ln_limdO, rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, rn_himin 619 577 !!------------------------------------------------------------------- 620 !621 IF(lwp) THEN622 WRITE(numout,*)623 WRITE(numout,*) 'lim_thd : Ice Thermodynamics'624 WRITE(numout,*) '~~~~~~~'625 ENDIF626 578 ! 627 579 REWIND( numnam_ice_ref ) ! Namelist namicethd in reference namelist : Ice thermodynamics … … 634 586 IF(lwm) WRITE ( numoni, namicethd ) 635 587 ! 636 IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN637 nn_monocat = 0638 IF(lwp) WRITE(numout, *) ' nn_monocat must be 0 in multi-category case '639 ENDIF640 641 !642 588 IF(lwp) THEN ! control print 643 WRITE(numout,*) 644 WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation ' 589 WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics' 590 WRITE(numout,*) '~~~~~~~~~~~~~' 591 WRITE(numout,*)' -- limthd_dif --' 592 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i 593 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif 594 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif 595 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon 596 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice 597 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat 598 WRITE(numout,*)' -- limthd_dh --' 599 WRITE(numout,*)' activate ice thick change from top/bot (T) or not (F) ln_limdH = ', ln_limdH 600 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas 601 WRITE(numout,*)' -- limthd_da --' 602 WRITE(numout,*)' activate lateral melting (T) or not (F) ln_limdA = ', ln_limdA 603 WRITE(numout,*)' Coef. beta for lateral melting param. rn_beta = ', rn_beta 604 WRITE(numout,*)' Minimum floe diameter for lateral melting param. rn_dmin = ', rn_dmin 605 WRITE(numout,*)' -- limthd_lac --' 606 WRITE(numout,*)' activate ice growth in open-water (T) or not (F) ln_limdO = ', ln_limdO 645 607 WRITE(numout,*)' ice thick. for lateral accretion rn_hnewice = ', rn_hnewice 646 608 WRITE(numout,*)' Frazil ice thickness as a function of wind or not ln_frazil = ', ln_frazil … … 648 610 WRITE(numout,*)' Thresold relative drift speed for collection of frazil rn_vfrazb = ', rn_vfrazb 649 611 WRITE(numout,*)' Squeezing coefficient for collection of frazil rn_Cfrazb = ', rn_Cfrazb 612 WRITE(numout,*)' -- limitd_th --' 650 613 WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin 651 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice '652 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas653 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i654 WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif655 WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif656 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon657 614 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 658 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat 659 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice 615 ENDIF 616 IF( jpl > 1 .AND. nn_monocat == 1 ) THEN 617 nn_monocat = 0 618 IF(lwp) WRITE(numout,*) 619 IF(lwp) WRITE(numout,*) ' nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen' 660 620 ENDIF 661 621 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r6470 r7646 76 76 REAL(wp) :: zdum 77 77 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 78 REAL(wp) :: zs_snic ! snow-ice salinity79 78 REAL(wp) :: zswi1 ! switch for computation of bottom salinity 80 79 REAL(wp) :: zswi12 ! switch for computation of bottom salinity … … 116 115 117 116 ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 118 SELECT CASE( nn_icesal ) 117 SELECT CASE( nn_icesal ) ! varying salinity or not 119 118 CASE( 1, 3 ) ; zswitch_sal = 0 ! prescribed salinity profile 120 119 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile … … 126 125 CALL wrk_alloc( jpij, nlay_i, icount ) 127 126 128 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp ; dh_i_sub(:) = 0._wp129 dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp130 131 127 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp 132 128 zq_rema (:) = 0._wp ; zsnw (:) = 0._wp ; zevap_rema(:) = 0._wp ; … … 135 131 zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp 136 132 icount (:,:) = 0 137 138 133 139 134 ! Initialize enthalpy at nlay_i+1 … … 618 613 hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 619 614 620 IF( ln_ icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)615 IF( ln_limctl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 621 616 END DO 622 617 … … 634 629 ht_s_1d(ji) = ht_s_1d(ji) - dh_snowice(ji) 635 630 636 ! Salinity of snow ice637 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1638 zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)639 640 ! entrapment during snow ice formation641 ! new salinity difference stored (to be used in limthd_sal.F90)642 IF ( nn_icesal == 2 ) THEN643 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )644 ! salinity dif due to snow-ice formation645 dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch646 ! salinity dif due to bottom growth647 IF ( zf_tt(ji) < 0._wp ) THEN648 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch649 ENDIF650 ENDIF651 652 631 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 653 632 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 654 zfmdt = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp) ! <0633 zfmdt = ( rhosn - rhoic ) * dh_snowice(ji) ! <0 655 634 zsstK = sst_m(ii,ij) + rt0 656 635 zEw = rcp * ( zsstK - rt0 ) … … 662 641 ! Contribution to salt flux 663 642 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 664 643 665 644 ! virtual salt flux to keep salinity constant 666 645 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 667 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean668 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get sm_ifrom the ocean646 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean 647 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get rn_icesal from the ocean 669 648 ENDIF 670 649 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5512 r7646 734 734 END DO ! End of the do while iterative procedure 735 735 736 IF( ln_ icectl .AND. lwp ) THEN736 IF( ln_limctl .AND. lwp ) THEN 737 737 WRITE(numout,*) ' zerritmax : ', zerritmax 738 738 WRITE(numout,*) ' nconv : ', nconv -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r6416 r7646 21 21 USE sbc_ice ! Surface boundary condition: ice fields 22 22 USE thd_ice ! LIM thermodynamics 23 USE dom_ice ! LIM domain24 23 USE ice ! LIM variables 25 24 USE limtab ! LIM 2D <==> 1D … … 71 70 !! update ht_s_1d, ht_i_1d and tbif_1d(:,:) 72 71 !!------------------------------------------------------------------------ 73 INTEGER :: ji,jj,jk,jl ! dummy loop indices74 INTEGER :: nbpac ! local integers75 INTEGER :: ii, ij, iter ! - -76 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zde! local scalars72 INTEGER :: ji,jj,jk,jl ! dummy loop indices 73 INTEGER :: nbpac ! local integers 74 INTEGER :: ii, ij, iter ! - - 75 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zde ! local scalars 77 76 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf ! - - 78 77 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - … … 154 153 155 154 ! Default new ice thickness 156 WHERE( qlead(:,:) < 0._wp ) ; hicol = rn_hnewice157 ELSEWHERE ; hicol = 0._wp155 WHERE( qlead(:,:) < 0._wp ) ; hicol(:,:) = rn_hnewice 156 ELSEWHERE ; hicol(:,:) = 0._wp 158 157 END WHERE 159 158 … … 170 169 zgamafr = 0.03 171 170 172 DO jj = 2, jpj 173 DO ji = 2, jpi 174 IF ( qlead(ji,jj) < 0._wp ) THEN171 DO jj = 2, jpjm1 172 DO ji = 2, jpim1 173 IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast 175 174 !------------- 176 175 ! Wind stress … … 195 194 !------------------- 196 195 ! C-grid ice velocity 197 rswitch = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) ) ) 198 zvgx = rswitch * ( u_ice(ji-1,jj ) * umask(ji-1,jj ,1) + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 199 zvgy = rswitch * ( v_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 196 zvgx = ( u_ice(ji-1,jj ) * umask(ji-1,jj ,1) + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 197 zvgy = ( v_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 200 198 201 199 !----------------------------------- … … 203 201 !----------------------------------- 204 202 ! absolute relative velocity 205 zvrel2 = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) & 206 & + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) 203 rswitch = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 204 zvrel2 = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) & 205 & + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch 207 206 zvrel(ji,jj) = SQRT( zvrel2 ) 208 207 … … 219 218 zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 220 219 221 hicol(ji,jj) = hicol(ji,jj) - zf /zfp220 hicol(ji,jj) = hicol(ji,jj) - zf / MAX( zfp, epsi20 ) 222 221 iter = iter + 1 223 222 END DO … … 228 227 END DO 229 228 ! 230 CALL lbc_lnk( zvrel (:,:), 'T', 1. )231 CALL lbc_lnk( hicol (:,:), 'T', 1. )229 CALL lbc_lnk( zvrel, 'T', 1. ) 230 CALL lbc_lnk( hicol, 'T', 1. ) 232 231 233 232 ENDIF ! End of computation of frazil ice collection thickness … … 240 239 ! Select points for new ice formation 241 240 !------------------------------------- 242 ! This occurs if open water energy budget is negative 241 ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 243 242 nbpac = 0 244 243 npac(:) = 0 … … 246 245 DO jj = 1, jpj 247 246 DO ji = 1, jpi 248 IF ( qlead(ji,jj) < 0._wp ) THEN247 IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 249 248 nbpac = nbpac + 1 250 249 npac( nbpac ) = (jj - 1) * jpi + ji … … 255 254 ! debug point to follow 256 255 jiindex_1d = 0 257 IF( ln_ icectl ) THEN256 IF( ln_limctl ) THEN 258 257 DO ji = mi0(iiceprt), mi1(iiceprt) 259 258 DO jj = mj0(jiceprt), mj1(jiceprt) … … 265 264 ENDIF 266 265 267 IF( ln_ icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac266 IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 268 267 269 268 !------------------------------ -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r6470 r7646 51 51 INTEGER, INTENT(in) :: kideb, kiut ! thickness category index 52 52 ! 53 INTEGER :: ji, jk ! dummy loop indices 54 REAL(wp) :: iflush, igravdr ! local scalars 53 INTEGER :: ii, ij, ji, jk ! dummy loop indices 54 REAL(wp) :: iflush, igravdr ! local scalars 55 REAL(wp) :: zs_sni, zsm_i_gd, zsm_i_fl, zsm_i_si, zsm_i_bg ! local scalars 55 56 !!--------------------------------------------------------------------- 56 57 57 !---------------------------------------------------------58 ! 0) Update ice salinity from snow-ice and bottom growth59 !---------------------------------------------------------60 DO ji = kideb, kiut61 sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji)62 END DO63 64 58 !--------------------------------------------------------------------| 65 59 ! 1) salinity constant in time | … … 73 67 74 68 DO ji = kideb, kiut 75 !76 ! Switches77 !----------78 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 ) ) ! =1 if summer79 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo80 69 81 !--------------------- 82 ! Salinity tendencies 83 !--------------------- 84 ! drainage by gravity drainage 85 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice 86 ! drainage by flushing 87 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice 70 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 71 !--------------------------------------------------------- 72 ! Update ice salinity from snow-ice and bottom growth 73 !--------------------------------------------------------- 74 zs_sni = sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic ! Salinity of snow ice 75 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 76 zsm_i_si = ( zs_sni - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! snow-ice 77 zsm_i_bg = ( s_i_new(ji) - sm_i_1d(ji) ) * MAX( 0._wp, dh_i_bott(ji) ) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! bottom growth 88 78 89 !----------------- 90 ! Update salinity 91 !----------------- 92 ! only drainage terms ( gravity drainage and flushing ) 93 ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 94 sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 79 ! Update salinity (nb: salt flux already included in limthd_dh) 80 sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_bg + zsm_i_si 95 81 96 !---------------------------- 97 ! Salt flux - brine drainage 98 !---------------------------- 99 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 100 82 IF( ln_limdS ) THEN 83 !--------------------------------------------------------- 84 ! Update ice salinity from brine drainage and flushing 85 !--------------------------------------------------------- 86 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 ) ) ! =1 if summer 87 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo 88 zsm_i_gd = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice ! gravity drainage 89 zsm_i_fl = - iflush * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice ! flushing 90 91 ! Update salinity 92 sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_fl + zsm_i_gd 93 94 ! Salt flux 95 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( zsm_i_fl + zsm_i_gd ) * r1_rdtice 96 ENDIF 101 97 END DO 102 98 … … 127 123 !!------------------------------------------------------------------- 128 124 INTEGER :: ios ! Local integer output status for namelist read 129 NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl, &130 & rn_s imax, rn_simin125 NAMELIST/namicesal/ ln_limdS, nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, & 126 & rn_sal_fl, rn_time_fl, rn_simax, rn_simin 131 127 !!------------------------------------------------------------------- 132 128 ! … … 144 140 WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity ' 145 141 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 146 WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal 147 WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 = ', rn_icesal 148 WRITE(numout,*) ' restoring salinity for GD = ', rn_sal_gd 149 WRITE(numout,*) ' restoring time for GD = ', rn_time_gd 150 WRITE(numout,*) ' restoring salinity for flushing = ', rn_sal_fl 151 WRITE(numout,*) ' restoring time for flushing = ', rn_time_fl 152 WRITE(numout,*) ' Maximum tolerated ice salinity = ', rn_simax 153 WRITE(numout,*) ' Minimum tolerated ice salinity = ', rn_simin 142 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_limdS = ', ln_limdS 143 WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal 144 WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 rn_icesal = ', rn_icesal 145 WRITE(numout,*) ' restoring salinity for gravity drainage rn_sal_gd = ', rn_sal_gd 146 WRITE(numout,*) ' restoring time for for gravity drainage rn_time_gd = ', rn_time_gd 147 WRITE(numout,*) ' restoring salinity for flushing rn_sal_fl = ', rn_sal_fl 148 WRITE(numout,*) ' restoring time for flushing rn_time_fl = ', rn_time_fl 149 WRITE(numout,*) ' Maximum tolerated ice salinity rn_simax = ', rn_simax 150 WRITE(numout,*) ' Minimum tolerated ice salinity rn_simin = ', rn_simin 154 151 ENDIF 155 152 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r6490 r7646 17 17 USE dom_oce ! ocean domain 18 18 USE sbc_oce ! ocean surface boundary condition 19 USE dom_ice ! ice domain20 19 USE ice ! ice variables 21 USE limadv ! ice advection22 20 USE limhdf ! ice horizontal diffusion 23 21 USE limvar ! 22 USE limadv_prather ! advection scheme (Prather) 23 USE limadv_umx ! advection scheme (ultimate-macho) 24 24 ! 25 25 USE in_out_manager ! I/O manager … … 57 57 !! ** method : variables included in the process are scalar, 58 58 !! other values are considered as second order. 59 !! For advection, a second order Prather scheme is used. 59 !! For advection, one can choose between 60 !! a) an Ultimate-Macho scheme (whose order is defined by nn_limadv_ord) => nn_limadv=0 61 !! b) and a second order Prather scheme => nn_limadv=-1 60 62 !! 61 63 !! ** action : 62 64 !!--------------------------------------------------------------------- 63 INTEGER, INTENT(in) :: kt 65 INTEGER, INTENT(in) :: kt ! number of iteration 64 66 ! 65 INTEGER :: ji, jj, jk, jm , jl, jt! dummy loop indices67 INTEGER :: ji, jj, jk, jm, jl, jt ! dummy loop indices 66 68 INTEGER :: initad ! number of sub-timestep for the advection 67 69 REAL(wp) :: zcfl , zusnit ! - - 68 CHARACTER(len=80) :: 70 CHARACTER(len=80) :: cltmp 69 71 ! 70 REAL(wp), POINTER, DIMENSION(:,:) :: zsm 72 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 73 REAL(wp) :: zdv, zda 74 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold, zsmvold 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax, zviold, zvsold 76 ! --- diffusion --- ! 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab 78 INTEGER , PARAMETER :: ihdf_vars = 6 ! Number of variables in which we apply horizontal diffusion 79 ! inside limtrp for each ice category , not counting the 80 ! variables corresponding to ice_layers 81 ! --- ultimate macho only --- ! 82 REAL(wp) :: zdt 83 REAL(wp), POINTER, DIMENSION(:,:) :: zudy, zvdx, zcu_box, zcv_box 84 ! --- prather only --- ! 85 REAL(wp), POINTER, DIMENSION(:,:) :: zarea 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw 71 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw73 88 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: z0ei 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax ! old ice thickness 76 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold ! old concentration, enthalpies 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab 78 REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 79 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 80 !!--------------------------------------------------------------------- 81 INTEGER :: ihdf_vars = 6 !!Number of variables in which we apply horizontal diffusion 82 !! inside limtrp for each ice category , not counting the 83 !! variables corresponding to ice_layers 89 !! 84 90 !!--------------------------------------------------------------------- 85 91 IF( nn_timing == 1 ) CALL timing_start('limtrp') 86 92 87 CALL wrk_alloc( jpi,jpj, zsm, zatold, zeiold, zesold ) 88 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 89 CALL wrk_alloc( jpi,jpj,1, z0opw ) 90 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 91 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold ) 92 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1,zhdfptab) 93 94 IF( numit == nstart .AND. lwp ) THEN 95 WRITE(numout,*) 96 IF( ln_limdyn ) THEN ; WRITE(numout,*) 'lim_trp : Ice transport ' 97 ELSE ; WRITE(numout,*) 'lim_trp : No ice advection as ln_limdyn = ', ln_limdyn 98 ENDIF 99 WRITE(numout,*) '~~~~~~~~~~~~' 93 CALL wrk_alloc( jpi,jpj, zatold, zeiold, zesold, zsmvold ) 94 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold ) 95 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 96 97 IF( kt == nit000 .AND. lwp ) THEN 98 WRITE(numout,*)'' 99 WRITE(numout,*)'limtrp' 100 WRITE(numout,*)'~~~~~~' 100 101 ncfl = 0 ! nb of time step with CFL > 1/2 101 102 ENDIF 102 103 zsm(:,:) = e1e2t(:,:) 104 105 ! !-------------------------------------! 106 IF( ln_limdyn ) THEN ! Advection of sea ice properties ! 107 ! !-------------------------------------! 108 109 ! conservation test 110 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 111 112 ! mass and salt flux init 113 zviold(:,:,:) = v_i(:,:,:) 114 zvsold(:,:,:) = v_s(:,:,:) 115 zsmvold(:,:,:) = smv_i(:,:,:) 116 zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 117 zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 118 119 !--- Thickness correction init. ------------------------------- 120 zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 121 DO jl = 1, jpl 122 DO jj = 1, jpj 123 DO ji = 1, jpi 124 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 125 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 126 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 103 104 CALL lim_var_agg( 1 ) ! integrated values + ato_i 105 106 !-------------------------------------! 107 ! Advection of sea ice properties ! 108 !-------------------------------------! 109 110 ! conservation test 111 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 112 113 ! store old values for diag 114 zviold = v_i 115 zvsold = v_s 116 zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 117 zeiold (:,:) = et_i 118 zesold (:,:) = et_s 119 120 !--- Thickness correction init. --- ! 121 zatold(:,:) = at_i 122 DO jl = 1, jpl 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 126 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 127 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 128 END DO 129 END DO 130 END DO 131 ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 132 zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 133 DO jl = 1, jpl 134 DO jj = 2, jpjm1 135 DO ji = 2, jpim1 136 zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 137 END DO 138 END DO 139 CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 140 END DO 141 142 ! --- If ice drift field is too fast, use an appropriate time step for advection --- ! 143 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) ! CFL test for stability 144 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 145 IF( lk_mpp ) CALL mpp_max( zcfl ) 146 147 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 148 ELSE ; initad = 1 ; zusnit = 1.0_wp 149 ENDIF 150 151 !! IF( zcfl > 0.5_wp .AND. lwp ) THEN 152 !! ncfl = ncfl + 1 153 !! IF( ncfl > 0 ) THEN 154 !! WRITE(cltmp,'(i6.1)') ncfl 155 !! CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 156 !! ENDIF 157 !! ENDIF 158 159 SELECT CASE ( nn_limadv ) 160 161 !=============================! 162 CASE ( 0 ) !== Ultimate-MACHO scheme ==! 163 !=============================! 164 165 CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 166 167 IF( kt == nit000 .AND. lwp ) THEN 168 WRITE(numout,*)'' 169 WRITE(numout,*)'lim_adv_umx : Ultimate-MACHO advection scheme' 170 WRITE(numout,*)'~~~~~~~~~~~' 171 ENDIF 172 ! 173 zdt = rdt_ice / REAL(initad) 174 175 ! transport 176 zudy(:,:) = u_ice(:,:) * e2u(:,:) 177 zvdx(:,:) = v_ice(:,:) * e1v(:,:) 178 179 ! define velocity for advection: u*grad(H) 180 DO jj = 2, jpjm1 181 DO ji = fs_2, fs_jpim1 182 IF ( u_ice(ji,jj) * u_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 183 ELSEIF( u_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = u_ice(ji-1,jj) 184 ELSE ; zcu_box(ji,jj) = u_ice(ji ,jj) 185 ENDIF 186 187 IF ( v_ice(ji,jj) * v_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp 188 ELSEIF( v_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = v_ice(ji,jj-1) 189 ELSE ; zcv_box(ji,jj) = v_ice(ji,jj ) 190 ENDIF 191 END DO 192 END DO 193 194 ! advection 195 DO jt = 1, initad 196 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, ato_i(:,:) ) ! Open water area 197 DO jl = 1, jpl 198 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, a_i(:,:,jl) ) ! Ice area 199 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_i(:,:,jl) ) ! Ice volume 200 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, smv_i(:,:,jl) ) ! Salt content 201 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, oa_i (:,:,jl) ) ! Age content 202 DO jk = 1, nlay_i 203 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_i(:,:,jk,jl) ) ! Ice heat content 127 204 END DO 128 END DO 129 END DO 130 !--------------------------------------------------------------------- 131 ! Record max of the surrounding ice thicknesses for correction 132 ! in case advection creates ice too thick. 133 !--------------------------------------------------------------------- 134 zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 135 DO jl = 1, jpl 136 DO jj = 2, jpjm1 137 DO ji = 2, jpim1 138 zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) ) 139 END DO 140 END DO 141 CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 142 END DO 143 144 !=============================! 145 !== Prather scheme ==! 146 !=============================! 147 148 ! If ice drift field is too fast, use an appropriate time step for advection. 149 zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) ! CFL test for stability 150 zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 151 IF(lk_mpp ) CALL mpp_max( zcfl ) 152 153 IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp 154 ELSE ; initad = 1 ; zusnit = 1.0_wp 205 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_s(:,:,jl) ) ! Snow volume 206 CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_s(:,:,1,jl) ) ! Snow heat content 207 END DO 208 END DO 209 ! 210 at_i(:,:) = a_i(:,:,1) ! total ice fraction 211 DO jl = 2, jpl 212 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 213 END DO 214 ! 215 CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 216 217 !=============================! 218 CASE ( -1 ) !== Prather scheme ==! 219 !=============================! 220 221 CALL wrk_alloc( jpi,jpj, zarea ) 222 CALL wrk_alloc( jpi,jpj,1, z0opw ) 223 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 224 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 225 226 IF( kt == nit000 .AND. lwp ) THEN 227 WRITE(numout,*)'' 228 WRITE(numout,*)'lim_adv_xy : Prather advection scheme' 229 WRITE(numout,*)'~~~~~~~~~~~' 155 230 ENDIF 156 157 IF( zcfl > 0.5_wp .AND. lwp ) ncfl = ncfl + 1 158 !! IF( lwp ) THEN 159 !! IF( ncfl > 0 ) THEN 160 !! WRITE(cltmp,'(i6.1)') ncfl 161 !! CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 162 !! ELSE 163 !! ! WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 ' 164 !! ENDIF 165 !! ENDIF 166 231 232 zarea(:,:) = e1e2t(:,:) 233 167 234 !------------------------- 168 235 ! transported fields … … 176 243 z0oi (:,:,jl) = oa_i (:,:, jl) * e1e2t(:,:) ! Age content 177 244 z0es (:,:,jl) = e_s (:,:,1,jl) * e1e2t(:,:) ! Snow heat content 178 DO jk = 1, nlay_i245 DO jk = 1, nlay_i 179 246 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 180 247 END DO … … 184 251 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 185 252 DO jt = 1, initad 186 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area187 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )188 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0opw (:,:,1), sxopw(:,:), &189 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )253 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area 254 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 255 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), & 256 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 190 257 DO jl = 1, jpl 191 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---192 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )193 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), &194 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )195 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---196 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )197 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), &198 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )199 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---200 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )201 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), &202 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )203 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---204 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )205 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), &206 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )207 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---208 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )209 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), &210 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )211 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---212 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )213 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), &214 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )258 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume --- 259 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 260 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & 261 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 262 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 263 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 264 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & 265 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 266 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 267 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 268 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & 269 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 270 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 271 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 272 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & 273 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 274 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 275 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 276 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & 277 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 278 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 279 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 280 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & 281 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 215 282 DO jk = 1, nlay_i !--- ice heat contents --- 216 CALL lim_adv_x( zusnit, u_ice, 1._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &217 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &218 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )219 CALL lim_adv_y( zusnit, v_ice, 0._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &220 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &221 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )283 CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 284 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 285 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 286 CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 287 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 288 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 222 289 END DO 223 290 END DO … … 225 292 ELSE 226 293 DO jt = 1, initad 227 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area228 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )229 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0opw (:,:,1), sxopw(:,:), &230 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )294 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area 295 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 296 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:), & 297 & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 231 298 DO jl = 1, jpl 232 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---233 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )234 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0ice (:,:,jl), sxice(:,:,jl), &235 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )236 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---237 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )238 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0snw (:,:,jl), sxsn (:,:,jl), &239 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )240 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---241 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )242 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0smi (:,:,jl), sxsal(:,:,jl), &243 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )244 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---245 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )246 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0oi (:,:,jl), sxage(:,:,jl), &247 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )248 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---249 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )250 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0ai (:,:,jl), sxa (:,:,jl), &251 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )252 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---253 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )254 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0es (:,:,jl), sxc0 (:,:,jl), &255 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )299 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume --- 300 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 301 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl), & 302 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 303 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 304 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 305 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl), & 306 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 307 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 308 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 309 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl), & 310 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 311 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 312 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 313 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0oi (:,:,jl), sxage(:,:,jl), & 314 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 315 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 316 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 317 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ai (:,:,jl), sxa (:,:,jl), & 318 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 319 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 320 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 321 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0es (:,:,jl), sxc0 (:,:,jl), & 322 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 256 323 DO jk = 1, nlay_i !--- ice heat contents --- 257 CALL lim_adv_y( zusnit, v_ice, 1._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &258 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &259 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )260 CALL lim_adv_x( zusnit, u_ice, 0._wp, z sm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &261 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), &262 & syye(:,:,jk,jl), sxye(:,:,jk,jl) )324 CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 325 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 326 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 327 CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), & 328 & sxxe(:,:,jk,jl), sye (:,:,jk,jl), & 329 & syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 263 330 END DO 264 331 END DO … … 286 353 at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 287 354 END DO 288 289 !------------------------------------------------------------------------------! 290 ! Diffusion of Ice fields 291 !------------------------------------------------------------------------------! 292 !------------------------------------ 293 ! Diffusion of other ice variables 294 !------------------------------------ 355 356 CALL wrk_dealloc( jpi,jpj, zarea ) 357 CALL wrk_dealloc( jpi,jpj,1, z0opw ) 358 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 359 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 360 361 END SELECT 362 363 !------------------------------! 364 ! Diffusion of Ice fields 365 !------------------------------! 366 IF( nn_ahi0 /= -1 .AND. nn_limdyn == 2 ) THEN 367 ! 368 ! --- Prepare diffusion for variables with categories --- ! 369 ! mask eddy diffusivity coefficient at ocean U- and V-points 295 370 jm=1 296 371 DO jl = 1, jpl 297 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points298 ! DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row299 ! DO ji = 1 , fs_jpim1 ! vector opt.300 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) &301 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)302 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) &303 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)304 ! END DO305 ! END DO306 372 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 307 DO ji = 1 , fs_jpim1 ! vector opt.373 DO ji = 1 , fs_jpim1 308 374 pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj, jl ) ) ) ) & 309 375 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj, jl ) ) ) ) * ahiu(ji,jj) … … 313 379 END DO 314 380 315 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 381 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 316 382 zhdfptab(:,:,jm)= v_i (:,:, jl); jm = jm + 1 317 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 383 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 318 384 zhdfptab(:,:,jm)= smv_i(:,:, jl); jm = jm + 1 319 385 zhdfptab(:,:,jm)= oa_i (:,:, jl); jm = jm + 1 320 386 zhdfptab(:,:,jm)= e_s (:,:,1,jl); jm = jm + 1 321 ! Sample of adding more variables to apply lim_hdf using lim_hdf optimization--- 322 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 323 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 324 ! 325 ! and in this example the parameter ihdf_vars musb be changed to 8 (necessary for allocation) 326 !---------------------------------------------------------------------------------------- 387 ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 388 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 389 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 327 390 DO jk = 1, nlay_i 328 391 zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 329 392 END DO 330 393 END DO 331 ! 332 !-------------------------------- 333 ! diffusion of open water area 334 !-------------------------------- 335 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 336 !DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 337 ! DO ji = 1 , fs_jpim1 ! vector opt. 338 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 339 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 340 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 341 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 342 ! END DO 343 !END DO 344 394 395 ! --- Prepare diffusion for open water area --- ! 396 ! mask eddy diffusivity coefficient at ocean U- and V-points 345 397 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 346 DO ji = 1 , fs_jpim1 ! vector opt.398 DO ji = 1 , fs_jpim1 347 399 pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 348 400 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) … … 353 405 ! 354 406 zhdfptab(:,:,jm)= ato_i (:,:); 355 CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i) 356 407 408 ! --- Apply diffusion --- ! 409 CALL lim_hdf( zhdfptab, ihdf_vars ) 410 411 ! --- Recover properties --- ! 357 412 jm=1 358 413 DO jl = 1, jpl 359 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 360 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 361 v_s (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 362 smv_i(:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 363 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 364 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 365 ! Sample of adding more variables to apply lim_hdf--------- 366 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 367 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 368 !----------------------------------------------------------- 414 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 415 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 416 v_s (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 417 smv_i(:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 418 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 419 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 420 ! Sample of adding more variables to apply lim_hdf 421 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 422 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 369 423 DO jk = 1, nlay_i 370 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 371 END DO 372 END DO 373 424 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 425 END DO 426 END DO 374 427 ato_i (:,:) = zhdfptab(:,:,jm) 375 376 !------------------------------------------------------------------------------! 377 ! limit ice properties after transport 378 !------------------------------------------------------------------------------! 379 !!gm & cr : MAX should not be active if adv scheme is positive ! 428 429 ENDIF 430 431 ! --- diags --- 432 DO jj = 1, jpj 433 DO ji = 1, jpi 434 diag_trp_ei (ji,jj) = ( SUM( e_i (ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 435 diag_trp_es (ji,jj) = ( SUM( e_s (ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 436 diag_trp_smv(ji,jj) = ( SUM( smv_i(ji,jj,:) ) - zsmvold(ji,jj) ) * r1_rdtice 437 diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 438 diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 439 END DO 440 END DO 441 442 IF( nn_limdyn == 2) THEN 443 444 ! zap small areas 445 CALL lim_var_zapsmall 446 447 !--- Thickness correction in case too high --- ! 380 448 DO jl = 1, jpl 381 449 DO jj = 1, jpj 382 450 DO ji = 1, jpi 383 v_s (ji,jj,jl) = MAX( 0._wp, v_s (ji,jj,jl) ) 384 v_i (ji,jj,jl) = MAX( 0._wp, v_i (ji,jj,jl) ) 385 smv_i(ji,jj,jl) = MAX( 0._wp, smv_i(ji,jj,jl) ) 386 oa_i (ji,jj,jl) = MAX( 0._wp, oa_i (ji,jj,jl) ) 387 a_i (ji,jj,jl) = MAX( 0._wp, a_i (ji,jj,jl) ) 388 e_s (ji,jj,1,jl) = MAX( 0._wp, e_s (ji,jj,1,jl) ) 389 END DO 390 END DO 391 392 DO jk = 1, nlay_i 393 DO jj = 1, jpj 394 DO ji = 1, jpi 395 e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) ) 396 END DO 397 END DO 398 END DO 399 END DO 400 !!gm & cr 401 402 ! --- diags --- 403 DO jj = 1, jpj 404 DO ji = 1, jpi 405 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 406 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 407 408 diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 409 diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 410 diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 411 END DO 412 END DO 413 414 ! zap small areas 415 CALL lim_var_zapsmall 416 417 !--- Thickness correction in case too high -------------------------------------------------------- 418 DO jl = 1, jpl 419 DO jj = 1, jpj 420 DO ji = 1, jpi 421 451 422 452 IF ( v_i(ji,jj,jl) > 0._wp ) THEN 423 453 424 454 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 425 455 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 426 456 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 427 457 428 zvi = v_i (ji,jj,jl)429 zvs = v_s (ji,jj,jl)430 zsmv = smv_i(ji,jj,jl)431 zes = e_s (ji,jj,1,jl)432 zei = SUM( e_i(ji,jj,1:nlay_i,jl) )433 434 458 zdv = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl) 435 459 436 460 IF ( ( zdv > 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 437 461 & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 438 462 439 463 rswitch = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) 440 464 a_i(ji,jj,jl) = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 ) 441 465 442 466 ! small correction due to *rswitch for a_i 443 467 v_i (ji,jj,jl) = rswitch * v_i (ji,jj,jl) … … 446 470 e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl) 447 471 e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl) 448 449 ! Update mass fluxes 450 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 451 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 452 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 453 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0 454 hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0 455 472 456 473 ENDIF 457 474 458 475 ENDIF 459 476 460 477 END DO 461 478 END DO … … 463 480 ! ------------------------------------------------- 464 481 465 !-------------------------------------- 466 ! Impose a_i < amax in mono-category 467 !-------------------------------------- 468 ! 469 IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2 470 DO jj = 1, jpj 471 DO ji = 1, jpi 472 a_i(ji,jj,1) = MIN( a_i(ji,jj,1), rn_amax_2d(ji,jj) ) 473 END DO 474 END DO 475 ENDIF 476 477 ! --- agglomerate variables ----------------- 478 vt_i (:,:) = 0._wp 479 vt_s (:,:) = 0._wp 480 at_i (:,:) = 0._wp 482 ! Force the upper limit of ht_i to always be < hi_max (99 m). 483 DO jj = 1, jpj 484 DO ji = 1, jpi 485 rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) ) 486 ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) ) 487 a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 488 END DO 489 END DO 490 491 ENDIF 492 493 !------------------------------------------------------------ 494 ! Impose a_i < amax if no ridging/rafting or in mono-category 495 !------------------------------------------------------------ 496 ! 497 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 498 IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 481 499 DO jl = 1, jpl 482 500 DO jj = 1, jpj 483 501 DO ji = 1, jpi 484 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) 485 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) 486 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 502 rswitch = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) ) 503 zda = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp ) & 504 & * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 ) 505 a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda 487 506 END DO 488 507 END DO 489 508 END DO 490 491 ! --- open water = 1 if at_i=0 --------------------------------492 DO jj = 1, jpj493 DO ji = 1, jpi494 rswitch = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )495 ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)496 END DO497 END DO498 499 ! conservation test500 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)501 502 509 ENDIF 503 510 511 ! --- agglomerate variables ----------------- 512 vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 513 vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 514 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 515 516 ! --- open water = 1 if at_i=0 -------------------------------- 517 WHERE( at_i == 0._wp ) ato_i = 1._wp 518 519 ! conservation test 520 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 521 504 522 ! ------------------------------------------------- 505 523 ! control prints 506 524 ! ------------------------------------------------- 507 IF( ln_ icectl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' )525 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 508 526 ! 509 CALL wrk_dealloc( jpi,jpj, zsm, zatold, zeiold, zesold ) 510 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 511 CALL wrk_dealloc( jpi,jpj,1, z0opw ) 512 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 513 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold ) 514 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i)+1,zhdfptab) 527 CALL wrk_dealloc( jpi,jpj, zatold, zeiold, zesold, zsmvold ) 528 CALL wrk_dealloc( jpi,jpj,jpl, zhimax, zviold, zvsold ) 529 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 515 530 ! 516 531 IF( nn_timing == 1 ) CALL timing_stop('limtrp') 517 532 ! 518 533 END SUBROUTINE lim_trp 519 534 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r6403 r7646 15 15 USE sbc_oce ! Surface boundary condition: ocean fields 16 16 USE sbc_ice ! Surface boundary condition: ice fields 17 USE dom_ice18 17 USE dom_oce 19 18 USE phycst ! physical constants … … 22 21 USE limitd_th 23 22 USE limvar 24 USE prtctl ! Print control25 23 USE wrk_nemo ! work arrays 26 24 USE timing ! Timing 27 25 USE limcons ! conservation tests 26 USE limctl ! control prints 28 27 USE lib_mpp ! MPP library 29 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 59 58 IF( nn_timing == 1 ) CALL timing_start('limupdate1') 60 59 61 IF( ln_limdyn ) THEN62 63 60 IF( kt == nit000 .AND. lwp ) THEN 64 WRITE(numout,*) ' lim_update1 ' 65 WRITE(numout,*) ' ~~~~~~~~~~~ ' 61 WRITE(numout,*)'' 62 WRITE(numout,*)' lim_update1 ' 63 WRITE(numout,*)' ~~~~~~~~~~~ ' 66 64 ENDIF 67 65 68 66 ! conservation test 69 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)67 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 68 71 69 !---------------------------------------------------- … … 137 135 138 136 ! conservation test 139 IF( ln_limdia hsb) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)137 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 140 138 141 ! -------------------------------------------------142 139 ! control prints 143 ! ------------------------------------------------- 144 IF(ln_ctl) THEN ! Control print 145 CALL prt_ctl_info(' ') 146 CALL prt_ctl_info(' - Cell values : ') 147 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 148 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_update1 : cell area :') 149 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update1 : at_i :') 150 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update1 : vt_i :') 151 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_update1 : vt_s :') 152 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update1 : strength :') 153 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update1 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 154 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update1 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 140 IF( ln_ctl ) CALL lim_prt3D( 'limupdate1' ) 141 142 IF( nn_timing == 1 ) CALL timing_stop('limupdate1') 155 143 156 DO jl = 1, jpl 157 CALL prt_ctl_info(' ') 158 CALL prt_ctl_info(' - Category : ', ivar1=jl) 159 CALL prt_ctl_info(' ~~~~~~~~~~') 160 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_update1 : ht_i : ') 161 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_update1 : ht_s : ') 162 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_update1 : t_su : ') 163 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_update1 : t_snow : ') 164 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_update1 : sm_i : ') 165 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' lim_update1 : o_i : ') 166 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update1 : a_i : ') 167 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update1 : a_i_b : ') 168 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update1 : v_i : ') 169 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update1 : v_i_b : ') 170 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update1 : v_s : ') 171 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update1 : v_s_b : ') 172 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1 : ') 173 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1_b : ') 174 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2 : ') 175 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2_b : ') 176 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow : ') 177 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow_b : ') 178 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update1 : smv_i : ') 179 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update1 : smv_i_b : ') 180 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update1 : oa_i : ') 181 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update1 : oa_i_b : ') 144 END SUBROUTINE lim_update1 182 145 183 DO jk = 1, nlay_i184 CALL prt_ctl_info(' - Layer : ', ivar1=jk)185 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update1 : t_i : ')186 END DO187 END DO188 189 CALL prt_ctl_info(' ')190 CALL prt_ctl_info(' - Heat / FW fluxes : ')191 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ')192 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update1 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ')193 194 CALL prt_ctl_info(' ')195 CALL prt_ctl_info(' - Stresses : ')196 CALL prt_ctl_info(' ~~~~~~~~~~ ')197 CALL prt_ctl(tab2d_1=utau , clinfo1= ' lim_update1 : utau : ', tab2d_2=vtau , clinfo2= ' vtau : ')198 CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' lim_update1 : utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ')199 CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' lim_update1 : u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ')200 ENDIF201 202 ENDIF ! ln_limdyn203 204 IF( nn_timing == 1 ) CALL timing_stop('limupdate1')205 END SUBROUTINE lim_update1206 146 #else 207 147 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r6403 r7646 15 15 USE sbc_oce ! Surface boundary condition: ocean fields 16 16 USE sbc_ice ! Surface boundary condition: ice fields 17 USE dom_ice18 17 USE dom_oce 19 18 USE phycst ! physical constants … … 22 21 USE limitd_th 23 22 USE limvar 24 USE prtctl ! Print control25 23 USE lbclnk ! lateral boundary condition - MPP exchanges 26 24 USE wrk_nemo ! work arrays … … 62 60 63 61 IF( kt == nit000 .AND. lwp ) THEN 64 WRITE(numout,*) ' lim_update2 ' 65 WRITE(numout,*) ' ~~~~~~~~~~~ ' 62 WRITE(numout,*)'' 63 WRITE(numout,*)' lim_update2 ' 64 WRITE(numout,*)' ~~~~~~~~~~~ ' 66 65 ENDIF 67 66 68 67 ! conservation test 69 IF( ln_limdia hsb) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)68 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 69 71 70 !---------------------------------------------------------------------- … … 176 175 177 176 ! conservation test 178 IF( ln_limdia hsb) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)177 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 179 178 180 ! necessary calls (at least for coupling)181 CALL lim_var_glo2eqv182 CALL lim_var_agg(2)183 184 ! -------------------------------------------------185 179 ! control prints 186 ! ------------------------------------------------- 187 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! control print 188 189 IF(ln_ctl) THEN ! Control print 190 CALL prt_ctl_info(' ') 191 CALL prt_ctl_info(' - Cell values : ') 192 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 193 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_update2 : cell area :') 194 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update2 : at_i :') 195 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update2 : vt_i :') 196 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_update2 : vt_s :') 197 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update2 : strength :') 198 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update2 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 199 CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update2 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :') 200 201 DO jl = 1, jpl 202 CALL prt_ctl_info(' ') 203 CALL prt_ctl_info(' - Category : ', ivar1=jl) 204 CALL prt_ctl_info(' ~~~~~~~~~~') 205 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_update2 : ht_i : ') 206 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_update2 : ht_s : ') 207 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_update2 : t_su : ') 208 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_update2 : t_snow : ') 209 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_update2 : sm_i : ') 210 CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' lim_update2 : o_i : ') 211 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update2 : a_i : ') 212 CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update2 : a_i_b : ') 213 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update2 : v_i : ') 214 CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update2 : v_i_b : ') 215 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update2 : v_s : ') 216 CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update2 : v_s_b : ') 217 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1 : ') 218 CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1_b : ') 219 CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2 : ') 220 CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2_b : ') 221 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow : ') 222 CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow_b : ') 223 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update2 : smv_i : ') 224 CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update2 : smv_i_b : ') 225 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update2 : oa_i : ') 226 CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update2 : oa_i_b : ') 227 228 DO jk = 1, nlay_i 229 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 230 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update2 : t_i : ') 231 END DO 232 END DO 233 234 CALL prt_ctl_info(' ') 235 CALL prt_ctl_info(' - Heat / FW fluxes : ') 236 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 237 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update2 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 238 239 CALL prt_ctl_info(' ') 240 CALL prt_ctl_info(' - Stresses : ') 241 CALL prt_ctl_info(' ~~~~~~~~~~ ') 242 CALL prt_ctl(tab2d_1=utau , clinfo1= ' lim_update2 : utau : ', tab2d_2=vtau , clinfo2= ' vtau : ') 243 CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' lim_update2 : utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ') 244 CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' lim_update2 : u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ') 245 ENDIF 180 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) 181 IF( ln_ctl ) CALL lim_prt3D( 'limupdate2' ) 246 182 247 183 IF( nn_timing == 1 ) CALL timing_stop('limupdate2') 248 184 249 185 END SUBROUTINE lim_update2 186 250 187 #else 251 188 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r6470 r7646 27 27 !! - et_i(jpi,jpj) !total ice thermal content 28 28 !! - smt_i(jpi,jpj) !mean ice salinity 29 !! - ot_i(jpi,jpj) !average ice age29 !! - tm_i (jpi,jpj) !mean ice temperature 30 30 !!====================================================================== 31 31 !! History : - ! 2006-01 (M. Vancoppenolle) Original code … … 41 41 USE ice ! ice variables 42 42 USE thd_ice ! ice variables (thermodynamics) 43 USE dom_ice ! ice domain44 43 USE in_out_manager ! I/O manager 45 44 USE lib_mpp ! MPP library … … 54 53 PUBLIC lim_var_eqv2glo 55 54 PUBLIC lim_var_salprof 56 PUBLIC lim_var_icetm57 55 PUBLIC lim_var_bv 58 56 PUBLIC lim_var_salprof1d … … 86 84 !!------------------------------------------------------------------ 87 85 88 !-------------------- 89 ! Compute variables 90 !-------------------- 91 vt_i (:,:) = 0._wp 92 vt_s (:,:) = 0._wp 93 at_i (:,:) = 0._wp 94 ato_i(:,:) = 1._wp 95 ! 96 DO jl = 1, jpl 86 ! integrated values 87 vt_i (:,:) = SUM( v_i, dim=3 ) 88 vt_s (:,:) = SUM( v_s, dim=3 ) 89 at_i (:,:) = SUM( a_i, dim=3 ) 90 et_s(:,:) = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 91 et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 92 93 ! open water fraction 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) 97 END DO 98 END DO 99 100 IF( kn > 1 ) THEN 101 102 ! mean ice/snow thickness 97 103 DO jj = 1, jpj 98 104 DO ji = 1, jpi 99 ! 100 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 101 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 102 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 103 ! 104 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 105 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch ! ice thickness 106 END DO 107 END DO 108 END DO 109 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) ! open water fraction 113 END DO 114 END DO 115 116 IF( kn > 1 ) THEN 117 et_s (:,:) = 0._wp 118 ot_i (:,:) = 0._wp 105 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 106 htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 107 htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 108 ENDDO 109 ENDDO 110 111 ! mean temperature (K), salinity and age 119 112 smt_i(:,:) = 0._wp 120 et_i (:,:) = 0._wp 121 ! 113 tm_i(:,:) = 0._wp 114 tm_su(:,:) = 0._wp 115 om_i (:,:) = 0._wp 122 116 DO jl = 1, jpl 117 123 118 DO jj = 1, jpj 124 119 DO ji = 1, jpi 125 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 126 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) ) 127 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch ! ice salinity 128 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) ) 129 ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi20 ) * rswitch ! ice age 130 END DO 131 END DO 132 END DO 133 ! 134 DO jl = 1, jpl 120 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 121 tm_su(ji,jj) = tm_su(ji,jj) + rswitch * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) 122 om_i (ji,jj) = om_i (ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) 123 END DO 124 END DO 125 135 126 DO jk = 1, nlay_i 136 et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl) ! ice heat content 137 END DO 138 END DO 127 DO jj = 1, jpj 128 DO ji = 1, jpi 129 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 130 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 131 & / MAX( vt_i(ji,jj) , epsi10 ) 132 smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl) & 133 & / MAX( vt_i(ji,jj) , epsi10 ) 134 END DO 135 END DO 136 END DO 137 END DO 138 tm_i = tm_i + rt0 139 tm_su = tm_su + rt0 139 140 ! 140 141 ENDIF … … 243 244 END DO 244 245 245 !------------------- 246 ! Mean temperature 247 !------------------- 248 vt_i (:,:) = 0._wp 249 DO jl = 1, jpl 250 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 251 END DO 252 253 tm_i(:,:) = 0._wp 254 DO jl = 1, jpl 255 DO jk = 1, nlay_i 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 259 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 260 & / MAX( vt_i(ji,jj) , epsi10 ) 261 END DO 262 END DO 263 END DO 264 END DO 265 tm_i = tm_i + rt0 246 ! integrated values 247 vt_i (:,:) = SUM( v_i, dim=3 ) 248 vt_s (:,:) = SUM( v_s, dim=3 ) 249 at_i (:,:) = SUM( a_i, dim=3 ) 250 266 251 ! 267 252 END SUBROUTINE lim_var_glo2eqv … … 398 383 399 384 400 SUBROUTINE lim_var_icetm 401 !!------------------------------------------------------------------ 402 !! *** ROUTINE lim_var_icetm *** 403 !! 404 !! ** Purpose : computes mean sea ice temperature 385 SUBROUTINE lim_var_bv 386 !!------------------------------------------------------------------ 387 !! *** ROUTINE lim_var_bv *** 388 !! 389 !! ** Purpose : computes mean brine volume (%) in sea ice 390 !! 391 !! ** Method : e = - 0.054 * S (ppt) / T (C) 392 !! 393 !! References : Vancoppenolle et al., JGR, 2007 405 394 !!------------------------------------------------------------------ 406 395 INTEGER :: ji, jj, jk, jl ! dummy loop indices 407 396 !!------------------------------------------------------------------ 408 409 ! Mean sea ice temperature 410 vt_i (:,:) = 0._wp 411 DO jl = 1, jpl 412 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 413 END DO 414 415 tm_i(:,:) = 0._wp 397 ! 398 bvm_i(:,:) = 0._wp 399 bv_i (:,:,:) = 0._wp 416 400 DO jl = 1, jpl 417 401 DO jk = 1, nlay_i 418 402 DO jj = 1, jpj 419 403 DO ji = 1, jpi 420 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 421 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 422 & / MAX( vt_i(ji,jj) , epsi10 ) 423 END DO 424 END DO 425 END DO 426 END DO 427 tm_i = tm_i + rt0 428 429 END SUBROUTINE lim_var_icetm 430 431 432 SUBROUTINE lim_var_bv 433 !!------------------------------------------------------------------ 434 !! *** ROUTINE lim_var_bv *** 435 !! 436 !! ** Purpose : computes mean brine volume (%) in sea ice 437 !! 438 !! ** Method : e = - 0.054 * S (ppt) / T (C) 439 !! 440 !! References : Vancoppenolle et al., JGR, 2007 441 !!------------------------------------------------------------------ 442 INTEGER :: ji, jj, jk, jl ! dummy loop indices 443 REAL(wp) :: zbvi ! local scalars 444 !!------------------------------------------------------------------ 445 ! 446 vt_i (:,:) = 0._wp 447 DO jl = 1, jpl 448 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 449 END DO 450 451 bv_i(:,:) = 0._wp 452 DO jl = 1, jpl 453 DO jk = 1, nlay_i 454 DO jj = 1, jpj 455 DO ji = 1, jpi 456 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) ) 457 zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) & 458 & * v_i(ji,jj,jl) * r1_nlay_i 459 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) ) ) 460 bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi20 ) 461 END DO 404 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) ) 405 bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i & 406 & / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) 407 END DO 408 END DO 409 END DO 410 411 DO jj = 1, jpj 412 DO ji = 1, jpi 413 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 414 bvm_i(ji,jj) = bvm_i(ji,jj) + rswitch * bv_i(ji,jj,jl) * v_i(ji,jj,jl) / MAX( vt_i(ji,jj), epsi10 ) 462 415 END DO 463 416 END DO … … 683 636 INTEGER :: ji, jk, jl ! dummy loop indices 684 637 INTEGER :: ijpij, i_fill, jl0 685 REAL(wp) :: zarg, zV, zconv, zdh 638 REAL(wp) :: zarg, zV, zconv, zdh, zdv 686 639 REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables 687 640 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables … … 704 657 IF( zhti(ji) > 0._wp ) THEN 705 658 706 ! initialisation of tests 707 itest(:) = 0 659 ! find which category (jl0) the input ice thickness falls into 660 jl0 = jpl 661 DO jl = 1, jpl 662 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 663 jl0 = jl 664 CYCLE 665 ENDIF 666 END DO 667 668 ! initialisation of tests 669 itest(:) = 0 708 670 709 i_fill = jpl + 1 !==================================== 710 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 711 ! iteration !==================================== 712 i_fill = i_fill - 1 671 i_fill = jpl + 1 !==================================== 672 DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories 673 ! iteration !==================================== 674 i_fill = i_fill - 1 675 676 ! initialisation of ice variables for each try 677 zht_i(ji,1:jpl) = 0._wp 678 za_i (ji,1:jpl) = 0._wp 679 itest(:) = 0 680 681 ! *** case very thin ice: fill only category 1 682 IF ( i_fill == 1 ) THEN 683 zht_i(ji,1) = zhti(ji) 684 za_i (ji,1) = zai (ji) 685 686 ! *** case ice is thicker: fill categories >1 687 ELSE 688 689 ! Fill ice thicknesses in the (i_fill-1) cat by hmean 690 DO jl = 1, i_fill - 1 691 zht_i(ji,jl) = hi_mean(jl) 692 END DO 693 694 ! Concentrations in the (i_fill-1) categories 695 za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 696 DO jl = 1, i_fill - 1 697 IF ( jl /= jl0 ) THEN 698 zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 699 za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2) 700 ENDIF 701 END DO 702 703 ! Concentration in the last (i_fill) category 704 za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 705 706 ! Ice thickness in the last (i_fill) category 707 zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 708 zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 ) 709 710 ! clem: correction if concentration of upper cat is greater than lower cat 711 ! (it should be a gaussian around jl0 but sometimes it is not) 712 IF ( jl0 /= jpl ) THEN 713 DO jl = jpl, jl0+1, -1 714 IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN 715 zdv = zht_i(ji,jl) * za_i(ji,jl) 716 zht_i(ji,jl ) = 0._wp 717 za_i (ji,jl ) = 0._wp 718 za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 ) 719 END IF 720 ENDDO 721 ENDIF 722 723 ENDIF ! case ice is thick or thin 724 725 !--------------------- 726 ! Compatibility tests 727 !--------------------- 728 ! Test 1: area conservation 729 zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 730 IF ( zconv < epsi06 ) itest(1) = 1 713 731 714 ! initialisation of ice variables for each try 715 zht_i(ji,1:jpl) = 0._wp 716 za_i (ji,1:jpl) = 0._wp 717 718 ! *** case very thin ice: fill only category 1 719 IF ( i_fill == 1 ) THEN 720 zht_i(ji,1) = zhti(ji) 721 za_i (ji,1) = zai (ji) 722 723 ! *** case ice is thicker: fill categories >1 724 ELSE 725 726 ! Fill ice thicknesses except the last one (i_fill) by hmean 727 DO jl = 1, i_fill - 1 728 zht_i(ji,jl) = hi_mean(jl) 729 END DO 732 ! Test 2: volume conservation 733 zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 734 IF ( zconv < epsi06 ) itest(2) = 1 730 735 731 ! find which category (jl0) the input ice thickness falls into 732 jl0 = i_fill 736 ! Test 3: thickness of the last category is in-bounds ? 737 IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 738 739 ! Test 4: positivity of ice concentrations 740 itest(4) = 1 733 741 DO jl = 1, i_fill 734 IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 735 jl0 = jl 736 CYCLE 737 ENDIF 738 END DO 739 740 ! Concentrations in the (i_fill-1) categories 741 za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl)) 742 DO jl = 1, i_fill - 1 743 IF ( jl == jl0 ) CYCLE 744 zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 745 za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2) 746 END DO 747 748 ! Concentration in the last (i_fill) category 749 za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) ) 750 751 ! Ice thickness in the last (i_fill) category 752 zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) ) 753 zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill) 754 755 ENDIF ! case ice is thick or thin 756 757 !--------------------- 758 ! Compatibility tests 759 !--------------------- 760 ! Test 1: area conservation 761 zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) ) 762 IF ( zconv < epsi06 ) itest(1) = 1 763 764 ! Test 2: volume conservation 765 zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) ) 766 IF ( zconv < epsi06 ) itest(2) = 1 767 768 ! Test 3: thickness of the last category is in-bounds ? 769 IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1 770 771 ! Test 4: positivity of ice concentrations 772 itest(4) = 1 773 DO jl = 1, i_fill 774 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 775 END DO 776 !============================ 777 END DO ! end iteration on categories 778 !============================ 742 IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0 743 END DO 744 ! !============================ 745 END DO ! end iteration on categories 746 ! !============================ 779 747 ENDIF ! if zhti > 0 780 748 END DO ! i loop 781 749 782 750 ! ------------------------------------------------ 783 751 ! Adding Snow in each category where za_i is not 0 -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r6418 r7646 17 17 USE sbc_oce ! Surface boundary condition: ocean fields 18 18 USE sbc_ice ! Surface boundary condition: ice fields 19 USE dom_ice20 19 USE ice 21 20 USE limvar … … 56 55 INTEGER :: ji, jj, jk, jl ! dummy loop indices 57 56 REAL(wp) :: z1_365 58 REAL(wp) :: z tmp59 REAL(wp), POINTER, DIMENSION(:,:,:) :: z oi, zei, zt_i, zt_s60 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z 2da, z2db, zswi ! 2D workspace57 REAL(wp) :: z2da, z2db, ztmp 58 REAL(wp), POINTER, DIMENSION(:,:,:) :: zswi2 59 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, zswi ! 2D workspace 61 60 !!------------------------------------------------------------------- 62 61 63 62 IF( nn_timing == 1 ) CALL timing_start('limwri') 64 63 65 CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s)66 CALL wrk_alloc( jpi, jpj , z2d, z2da, z2db, zswi )64 CALL wrk_alloc( jpi,jpj,jpl, zswi2 ) 65 CALL wrk_alloc( jpi,jpj , z2d, zswi ) 67 66 68 67 !----------------------------- … … 71 70 z1_365 = 1._wp / 365._wp 72 71 73 CALL lim_var_icetm ! mean sea ice temperature74 75 CALL lim_var_bv ! brine volume 76 77 DO jj = 1, jpj ! presence indicator of ice72 ! brine volume 73 CALL lim_var_bv 74 75 ! tresholds for outputs 76 DO jj = 1, jpj 78 77 DO ji = 1, jpi 79 78 zswi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 80 79 END DO 81 80 END DO 82 ! 83 ! 84 ! 85 IF ( iom_use( "icethic_cea" ) ) THEN ! mean ice thickness 86 DO jj = 1, jpj 81 DO jl = 1, jpl 82 DO jj = 1, jpj 87 83 DO ji = 1, jpi 88 z 2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj)84 zswi2(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 89 85 END DO 90 86 END DO 91 CALL iom_put( "icethic_cea" , z2d ) 92 ENDIF 93 94 IF ( iom_use( "snowthic_cea" ) ) THEN ! snow thickness = mean snow thickness over the cell 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 z2d(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 98 END DO 99 END DO 100 CALL iom_put( "snowthic_cea" , z2d ) 101 ENDIF 87 END DO 102 88 ! 89 ! fluxes 90 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 91 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 92 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 93 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 94 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 95 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 96 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 97 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 98 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 99 IF( iom_use('qemp_oce') ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 100 IF( iom_use('qemp_ice') ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 101 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce" , emp_oce(:,:) ) ! emp over ocean (taking into account the snow blown away from the ice) 102 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice" , emp_ice(:,:) ) ! emp over ice (taking into account the snow blown away from the ice) 103 104 ! velocity 103 105 IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 104 106 DO jj = 2 , jpjm1 105 107 DO ji = 2 , jpim1 106 z2da(ji,jj) = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 107 z2db(ji,jj) = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 108 z2da = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 109 z2db = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 110 z2d(ji,jj) = SQRT( z2da * z2da + z2db * z2db ) 108 111 END DO 109 112 END DO 110 CALL lbc_lnk( z2da, 'T', -1. ) 111 CALL lbc_lnk( z2db, 'T', -1. ) 112 CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component 113 CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component 114 DO jj = 1, jpj 115 DO ji = 1, jpi 116 z2d(ji,jj) = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) ) 117 END DO 118 END DO 119 CALL iom_put( "icevel" , z2d ) ! ice velocity module 113 CALL lbc_lnk( z2d, 'T', 1. ) 114 CALL iom_put( "uice_ipa" , u_ice ) ! ice velocity u component 115 CALL iom_put( "vice_ipa" , v_ice ) ! ice velocity v component 116 CALL iom_put( "icevel" , z2d ) ! ice velocity module 120 117 ENDIF 118 119 IF ( iom_use( "tau_icebfr" ) ) CALL iom_put( "tau_icebfr" , tau_icebfr ) ! ice friction with ocean bottom (landfast ice) 121 120 ! 122 IF ( iom_use( "miceage" ) ) THEN 123 z2d(:,:) = 0.e0 124 DO jl = 1, jpl 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 128 z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 129 END DO 130 END DO 131 END DO 132 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 133 ENDIF 134 135 IF ( iom_use( "micet" ) ) THEN 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 139 END DO 140 END DO 141 CALL iom_put( "micet" , z2d ) ! mean ice temperature 142 ENDIF 121 IF ( iom_use( "miceage" ) ) CALL iom_put( "miceage" , om_i * zswi * z1_365 ) ! mean ice age 122 IF ( iom_use( "icethic_cea" ) ) CALL iom_put( "icethic_cea" , htm_i * zswi ) ! ice thickness mean 123 IF ( iom_use( "snowthic_cea" ) ) CALL iom_put( "snowthic_cea", htm_s * zswi ) ! snow thickness mean 124 IF ( iom_use( "micet" ) ) CALL iom_put( "micet" , ( tm_i - rt0 ) * zswi ) ! ice mean temperature 125 IF ( iom_use( "icest" ) ) CALL iom_put( "icest" , ( tm_su - rt0 ) * zswi ) ! ice surface temperature 126 IF ( iom_use( "icecolf" ) ) CALL iom_put( "icecolf" , hicol ) ! frazil ice collection thickness 143 127 ! 144 IF ( iom_use( "icest" ) ) THEN145 z2d(:,:) = 0.e0146 DO jl = 1, jpl147 DO jj = 1, jpj148 DO ji = 1, jpi149 z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )150 END DO151 END DO152 END DO153 CALL iom_put( "icest" , z2d ) ! ice surface temperature154 ENDIF155 156 IF ( iom_use( "icecolf" ) ) CALL iom_put( "icecolf", hicol ) ! frazil ice collection thickness157 158 128 CALL iom_put( "isst" , sst_m ) ! sea surface temperature 159 129 CALL iom_put( "isss" , sss_m ) ! sea surface salinity 160 CALL iom_put( "iceconc" , at_i 161 CALL iom_put( "icevolu" , vt_i 162 CALL iom_put( "icehc" , et_i 163 CALL iom_put( "isnowhc" , et_s 164 CALL iom_put( "ibrinv" , bv _i * 100._wp) ! brine volume130 CALL iom_put( "iceconc" , at_i * zswi ) ! ice concentration 131 CALL iom_put( "icevolu" , vt_i * zswi ) ! ice volume = mean ice thickness over the cell 132 CALL iom_put( "icehc" , et_i * zswi ) ! ice total heat content 133 CALL iom_put( "isnowhc" , et_s * zswi ) ! snow total heat content 134 CALL iom_put( "ibrinv" , bvm_i * zswi * 100. ) ! brine volume 165 135 CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point 166 136 CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point 167 137 CALL iom_put( "snowpre" , sprecip * 86400. ) ! snow precipitation 168 CALL iom_put( "micesalt" , smt_i 169 170 CALL iom_put( "icestr" , strength * 0.001 )! ice strength171 CALL iom_put( "idive" , divu_i * 1.0e8 ) 172 CALL iom_put( "ishear" , shear_i * 1.0e8 ) 173 CALL iom_put( "snowvol" , vt_s 138 CALL iom_put( "micesalt" , smt_i * zswi ) ! mean ice salinity 139 140 CALL iom_put( "icestr" , strength * zswi ) ! ice strength 141 CALL iom_put( "idive" , divu_i * 1.0e8 ) ! divergence 142 CALL iom_put( "ishear" , shear_i * 1.0e8 ) ! shear 143 CALL iom_put( "snowvol" , vt_s * zswi ) ! snow volume 174 144 175 145 CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport … … 180 150 181 151 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from bottom growth 182 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from bottom melt 183 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from surface melt 152 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from bottom melting 153 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from surface melting 154 CALL iom_put( "sfxlam" , sfx_lam * rday ) ! salt flux from lateral melting 184 155 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from snow ice formation 185 156 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from open water formation 186 157 CALL iom_put( "sfxdyn" , sfx_dyn * rday ) ! salt flux from ridging rafting 187 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from residual158 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from limupdate (resultant) 188 159 CALL iom_put( "sfxbri" , sfx_bri * rday ) ! salt flux from brines 189 160 CALL iom_put( "sfxsub" , sfx_sub * rday ) ! salt flux from sublimation … … 198 169 CALL iom_put( "vfxsum" , wfx_sum * ztmp ) ! surface melt 199 170 CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt 171 CALL iom_put( "vfxlam" , wfx_lam * ztmp ) ! lateral melt 200 172 CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt 173 174 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 175 WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 176 ELSEWHERE ; z2d = 0._wp 177 END WHERE 178 CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 179 ENDIF 180 181 ztmp = rday / rhosn 182 CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow) 201 183 CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt 202 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow )203 CALL iom_put( "vfxs pr" , wfx_spr * ztmp ) ! precip (snow)184 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow/ice) 185 CALL iom_put( "vfxsub_err" , wfx_err_sub * ztmp ) ! "excess" of sublimation sent to ocean 204 186 205 187 CALL iom_put( "afxtot" , afx_tot * rday ) ! concentration tendency (total) … … 222 204 CALL iom_put ('hfxdif' , hfx_dif(:,:) ) ! 223 205 CALL iom_put ('hfxopw' , hfx_opw(:,:) ) ! 224 CALL iom_put ('hfxtur' , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base206 CALL iom_put ('hfxtur' , fhtur(:,:) * at_i_b(:,:) ) ! turbulent heat flux at ice base 225 207 CALL iom_put ('hfxdhc' , diag_heat(:,:) ) ! Heat content variation in snow and ice 226 208 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip 227 228 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 229 DO jj = 1, jpj 230 DO ji = 1, jpi 231 z2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness 232 END DO 233 END DO 234 WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog 235 ELSEWHERE ; z2da = 0._wp 236 END WHERE 237 CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp ) 238 ENDIF 239 209 210 240 211 !-------------------------------- 241 212 ! Output values for each category 242 213 !-------------------------------- 243 CALL iom_put( "iceconc_cat" , a_i ) ! area for categories 244 CALL iom_put( "icethic_cat" , ht_i ) ! thickness for categories 245 CALL iom_put( "snowthic_cat" , ht_s ) ! snow depth for categories 246 CALL iom_put( "salinity_cat" , sm_i ) ! salinity for categories 247 214 IF ( iom_use( "iceconc_cat" ) ) CALL iom_put( "iceconc_cat" , a_i * zswi2 ) ! area for categories 215 IF ( iom_use( "icethic_cat" ) ) CALL iom_put( "icethic_cat" , ht_i * zswi2 ) ! thickness for categories 216 IF ( iom_use( "snowthic_cat" ) ) CALL iom_put( "snowthic_cat" , ht_s * zswi2 ) ! snow depth for categories 217 IF ( iom_use( "salinity_cat" ) ) CALL iom_put( "salinity_cat" , sm_i * zswi2 ) ! salinity for categories 248 218 ! ice temperature 249 IF ( iom_use( "icetemp_cat" ) ) THEN 250 zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 251 CALL iom_put( "icetemp_cat" , zt_i - rt0 ) 252 ENDIF 253 219 IF ( iom_use( "icetemp_cat" ) ) CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 ) 254 220 ! snow temperature 255 IF ( iom_use( "snwtemp_cat" ) ) THEN 256 zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 257 CALL iom_put( "snwtemp_cat" , zt_s - rt0 ) 258 ENDIF 259 260 ! Compute ice age 261 IF ( iom_use( "iceage_cat" ) ) THEN 262 DO jl = 1, jpl 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 266 rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 267 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 268 END DO 269 END DO 270 END DO 271 CALL iom_put( "iceage_cat" , zoi * z1_365 ) ! ice age for categories 272 ENDIF 273 274 ! Compute brine volume 275 IF ( iom_use( "brinevol_cat" ) ) THEN 276 zei(:,:,:) = 0._wp 277 DO jl = 1, jpl 278 DO jk = 1, nlay_i 279 DO jj = 1, jpj 280 DO ji = 1, jpi 281 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 282 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * & 283 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 284 rswitch * r1_nlay_i 285 END DO 286 END DO 287 END DO 288 END DO 289 CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories 290 ENDIF 221 IF ( iom_use( "snwtemp_cat" ) ) CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 ) 222 ! ice age 223 IF ( iom_use( "iceage_cat" ) ) CALL iom_put( "iceage_cat" , o_i * zswi2 * z1_365 ) 224 ! brine volume 225 IF ( iom_use( "brinevol_cat" ) ) CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 ) 291 226 292 227 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s … … 294 229 ! not yet implemented 295 230 296 CALL wrk_dealloc( jpi, jpj, jpl, z oi, zei, zt_i, zt_s)297 CALL wrk_dealloc( jpi, jpj , z2d, zswi , z2da, z2db)231 CALL wrk_dealloc( jpi, jpj, jpl, zswi2 ) 232 CALL wrk_dealloc( jpi, jpj , z2d, zswi ) 298 233 299 234 IF( nn_timing == 1 ) CALL timing_stop('limwri') … … 312 247 !! 313 248 !! History : 314 !! 4. 1! 2013-06 (C. Rousset)249 !! 4.0 ! 2013-06 (C. Rousset) 315 250 !!---------------------------------------------------------------------- 316 INTEGER, INTENT( in ) :: kt ! ocean time-step index) 317 INTEGER, INTENT( in ) :: kid , kh_i 251 INTEGER, INTENT( in ) :: kt ! ocean time-step index) 252 INTEGER, INTENT( in ) :: kid , kh_i 253 INTEGER :: nz_i, jl 254 REAL(wp), DIMENSION(jpl) :: jcat 318 255 !!---------------------------------------------------------------------- 319 320 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , & 321 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 322 CALL histdef( kid, "iiceconc", "Ice concentration" , "%" , & 323 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 324 CALL histdef( kid, "iicetemp", "Ice temperature" , "C" , & 325 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 326 CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , & 327 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 328 CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , & 329 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 330 CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", & 331 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 332 CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", & 333 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 334 CALL histdef( kid, "iicesflx", "Solar flux over ocean" , "w/m2" , & 335 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 336 CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" , & 256 DO jl = 1, jpl 257 jcat(jl) = REAL(jl) 258 ENDDO 259 260 CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 261 262 CALL histdef( kid, "sithic", "Ice thickness" , "m" , & 263 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 264 CALL histdef( kid, "siconc", "Ice concentration" , "%" , & 265 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 266 CALL histdef( kid, "sitemp", "Ice temperature" , "C" , & 267 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 268 CALL histdef( kid, "sivelu", "i-Ice speed " , "m/s" , & 269 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 270 CALL histdef( kid, "sivelv", "j-Ice speed " , "m/s" , & 271 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 272 CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa" , & 273 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 274 CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa" , & 275 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 276 CALL histdef( kid, "sisflx", "Solar flux over ocean" , "w/m2" , & 277 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 278 CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" , & 337 279 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 338 280 CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", & 339 281 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 340 CALL histdef( kid, "iicesali", "Ice salinity" , "PSU" , & 341 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 342 CALL histdef( kid, "iicevolu", "Ice volume" , "m" , & 343 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 344 CALL histdef( kid, "iicedive", "Ice divergence" , "10-8s-1", & 345 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 346 CALL histdef( kid, "iicebopr", "Ice bottom production" , "m/s" , & 347 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 348 CALL histdef( kid, "iicedypr", "Ice dynamic production" , "m/s" , & 349 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 350 CALL histdef( kid, "iicelapr", "Ice open water prod" , "m/s" , & 282 CALL histdef( kid, "sisali", "Ice salinity" , "PSU" , & 283 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 284 CALL histdef( kid, "sivolu", "Ice volume" , "m" , & 285 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 286 CALL histdef( kid, "sidive", "Ice divergence" , "10-8s-1", & 287 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 288 289 CALL histdef( kid, "vfxbog", "Ice bottom production" , "m/s" , & 290 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 291 CALL histdef( kid, "vfxdyn", "Ice dynamic production" , "m/s" , & 292 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 293 CALL histdef( kid, "vfxopw", "Ice open water prod" , "m/s" , & 351 294 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 352 CALL histdef( kid, "iicesipr", "Snow ice production " , "m/s" , & 353 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 354 CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s" , & 355 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 356 CALL histdef( kid, "iicebome", "Ice bottom melt" , "m/s" , & 357 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 358 CALL histdef( kid, "iicesume", "Ice surface melt" , "m/s" , & 359 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 360 CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics" , "" , & 361 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 362 CALL histdef( kid, "iisfxres", "Salt flux from limupdate", "" , & 363 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 295 CALL histdef( kid, "vfxsni", "Snow ice production " , "m/s" , & 296 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 297 CALL histdef( kid, "vfxres", "Ice prod from limupdate" , "m/s" , & 298 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 299 CALL histdef( kid, "vfxbom", "Ice bottom melt" , "m/s" , & 300 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 301 CALL histdef( kid, "vfxsum", "Ice surface melt" , "m/s" , & 302 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 303 304 CALL histdef( kid, "sithicat", "Ice thickness" , "m" , & 305 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 306 CALL histdef( kid, "siconcat", "Ice concentration" , "%" , & 307 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 308 CALL histdef( kid, "sisalcat", "Ice salinity" , "" , & 309 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 310 CALL histdef( kid, "sitemcat", "Ice temperature" , "C" , & 311 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 312 CALL histdef( kid, "snthicat", "Snw thickness" , "m" , & 313 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 314 CALL histdef( kid, "sntemcat", "Snw temperature" , "C" , & 315 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 364 316 365 317 CALL histend( kid, snc4set ) ! end of the file definition 366 318 367 CALL histwrite( kid, " iicethic", kt, icethi, jpi*jpj, (/1/) )368 CALL histwrite( kid, " iiceconc", kt, at_i , jpi*jpj, (/1/) )369 CALL histwrite( kid, " iicetemp", kt, tm_i - rt0 , jpi*jpj, (/1/) )370 CALL histwrite( kid, " iicevelu", kt, u_ice , jpi*jpj, (/1/) )371 CALL histwrite( kid, " iicevelv", kt, v_ice , jpi*jpj, (/1/) )372 CALL histwrite( kid, " iicestru", kt, utau_ice , jpi*jpj, (/1/) )373 CALL histwrite( kid, " iicestrv", kt, vtau_ice , jpi*jpj, (/1/) )374 CALL histwrite( kid, " iicesflx", kt, qsr , jpi*jpj, (/1/) )375 CALL histwrite( kid, " iicenflx", kt, qns , jpi*jpj, (/1/) )319 CALL histwrite( kid, "sithic", kt, htm_i , jpi*jpj, (/1/) ) 320 CALL histwrite( kid, "siconc", kt, at_i , jpi*jpj, (/1/) ) 321 CALL histwrite( kid, "sitemp", kt, tm_i - rt0 , jpi*jpj, (/1/) ) 322 CALL histwrite( kid, "sivelu", kt, u_ice , jpi*jpj, (/1/) ) 323 CALL histwrite( kid, "sivelv", kt, v_ice , jpi*jpj, (/1/) ) 324 CALL histwrite( kid, "sistru", kt, utau_ice , jpi*jpj, (/1/) ) 325 CALL histwrite( kid, "sistrv", kt, vtau_ice , jpi*jpj, (/1/) ) 326 CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) ) 327 CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) ) 376 328 CALL histwrite( kid, "isnowpre", kt, sprecip , jpi*jpj, (/1/) ) 377 CALL histwrite( kid, "iicesali", kt, smt_i , jpi*jpj, (/1/) ) 378 CALL histwrite( kid, "iicevolu", kt, vt_i , jpi*jpj, (/1/) ) 379 CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 380 381 CALL histwrite( kid, "iicebopr", kt, wfx_bog , jpi*jpj, (/1/) ) 382 CALL histwrite( kid, "iicedypr", kt, wfx_dyn , jpi*jpj, (/1/) ) 383 CALL histwrite( kid, "iicelapr", kt, wfx_opw , jpi*jpj, (/1/) ) 384 CALL histwrite( kid, "iicesipr", kt, wfx_sni , jpi*jpj, (/1/) ) 385 CALL histwrite( kid, "iicerepr", kt, wfx_res , jpi*jpj, (/1/) ) 386 CALL histwrite( kid, "iicebome", kt, wfx_bom , jpi*jpj, (/1/) ) 387 CALL histwrite( kid, "iicesume", kt, wfx_sum , jpi*jpj, (/1/) ) 388 CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn , jpi*jpj, (/1/) ) 389 CALL histwrite( kid, "iisfxres", kt, sfx_res , jpi*jpj, (/1/) ) 329 CALL histwrite( kid, "sisali", kt, smt_i , jpi*jpj, (/1/) ) 330 CALL histwrite( kid, "sivolu", kt, vt_i , jpi*jpj, (/1/) ) 331 CALL histwrite( kid, "sidive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 332 333 CALL histwrite( kid, "vfxbog", kt, wfx_bog , jpi*jpj, (/1/) ) 334 CALL histwrite( kid, "vfxdyn", kt, wfx_dyn , jpi*jpj, (/1/) ) 335 CALL histwrite( kid, "vfxopw", kt, wfx_opw , jpi*jpj, (/1/) ) 336 CALL histwrite( kid, "vfxsni", kt, wfx_sni , jpi*jpj, (/1/) ) 337 CALL histwrite( kid, "vfxres", kt, wfx_res , jpi*jpj, (/1/) ) 338 CALL histwrite( kid, "vfxbom", kt, wfx_bom , jpi*jpj, (/1/) ) 339 CALL histwrite( kid, "vfxsum", kt, wfx_sum , jpi*jpj, (/1/) ) 340 341 CALL histwrite( kid, "sithicat", kt, ht_i , jpi*jpj*jpl, (/1/) ) 342 CALL histwrite( kid, "siconcat", kt, a_i , jpi*jpj*jpl, (/1/) ) 343 CALL histwrite( kid, "sisalcat", kt, sm_i , jpi*jpj*jpl, (/1/) ) 344 CALL histwrite( kid, "sitemcat", kt, tm_i - rt0 , jpi*jpj*jpl, (/1/) ) 345 CALL histwrite( kid, "snthicat", kt, ht_s , jpi*jpj*jpl, (/1/) ) 346 CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) ) 390 347 391 348 ! Close the file -
trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r6416 r7646 5 5 !!===================================================================== 6 6 !! History : 3.0 ! 2002-11 (C. Ethe) F90: Free form and module 7 !!---------------------------------------------------------------------- 8 #if defined key_lim3 9 !!---------------------------------------------------------------------- 10 !! 'key_lim3' LIM3 sea-ice model 7 11 !!---------------------------------------------------------------------- 8 12 USE in_out_manager ! I/O manager … … 14 18 15 19 PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 16 17 !!---------------------------18 !! * Share Module variables19 !!---------------------------20 ! !!! ** ice-thermo namelist (namicethd) **21 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness22 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom23 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice24 REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice25 REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m)26 27 LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F)28 20 29 21 !!----------------------------- … … 97 89 ! ! to reintegrate longwave flux inside the ice thermodynamics 98 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_se_1d !: Ice salinity variations due to basal salt entrapment102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_si_1d !: Ice salinity variations due to lateral accretion103 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hicol_1d !: Ice collection thickness accumulated in leads 104 92 … … 140 128 !!---------------------------------------------------------------------! 141 129 INTEGER :: thd_ice_alloc ! return value 142 INTEGER :: ierr( 3)130 INTEGER :: ierr(4), ii 143 131 !!---------------------------------------------------------------------! 132 ierr(:) = 0 144 133 134 ii = 1 145 135 ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij) , & 146 136 & qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) , & … … 152 142 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 153 143 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 154 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr( 1) )144 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(ii) ) 155 145 ! 146 ii = ii + 1 156 147 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , & 157 148 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , & … … 162 153 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), & 163 154 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij), & 164 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 165 & dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) ) 155 & hicol_1d (jpij) , STAT=ierr(ii) ) 166 156 ! 167 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 168 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 169 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) , & 170 & dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 171 & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 172 & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , & 173 & qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 157 ii = ii + 1 158 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 159 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 160 & dh_s_tot (jpij) , dh_i_surf (jpij) , dh_i_sub (jpij) , & 161 & dh_i_bott (jpij) , dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 162 & STAT=ierr(ii) ) 174 163 ! 175 thd_ice_alloc = MAXVAL( ierr ) 176 164 ii = ii + 1 165 ALLOCATE( t_s_1d (jpij,nlay_s) , t_i_1d (jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 166 & q_i_1d (jpij,nlay_i+1) , q_s_1d (jpij,nlay_s) , & 167 & qh_i_old(jpij,0:nlay_i+1) , h_i_old(jpij,0:nlay_i+1) , STAT=ierr(ii) ) 168 ! 169 thd_ice_alloc = MAXVAL( ierr(:) ) 177 170 IF( thd_ice_alloc /= 0 ) CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' ) 178 171 ! 179 172 END FUNCTION thd_ice_alloc 180 173 174 #else 175 !!---------------------------------------------------------------------- 176 !! Default option : Empty module NO LIM sea-ice model 177 !!---------------------------------------------------------------------- 178 CONTAINS 179 SUBROUTINE thd_ice_alloc ! Empty routine 180 END SUBROUTINE thd_ice_alloc 181 #endif 182 181 183 !!====================================================================== 182 184 END MODULE thd_ice
Note: See TracChangeset
for help on using the changeset viewer.
