- Timestamp:
- 2020-09-16T15:05:19+02:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 deleted
- 95 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg
r13461 r13472 353 353 &namzdf_tke ! turbulent eddy kinetic dependent vertical diffusion (ln_zdftke =T) 354 354 !----------------------------------------------------------------------- 355 rn_eice = 0 ! below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4356 355 / 357 356 !!====================================================================== -
NEMO/trunk/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
r13461 r13472 354 354 &namzdf_tke ! turbulent eddy kinetic dependent vertical diffusion (ln_zdftke =T) 355 355 !----------------------------------------------------------------------- 356 rn_eice = 0 ! below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4357 356 / 358 357 !!====================================================================== -
NEMO/trunk/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg
r13461 r13472 378 378 ! = 2 add a tke source just at the base of the ML 379 379 ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T) 380 rn_eice = 0 ! below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4381 380 / 382 381 !----------------------------------------------------------------------- -
NEMO/trunk/cfgs/SHARED/field_def_nemo-ice.xml
r12377 r13472 49 49 <field id="icehpnd" long_name="melt pond depth" standard_name="sea_ice_meltpond_depth" unit="m" /> 50 50 <field id="icevpnd" long_name="melt pond volume" standard_name="sea_ice_meltpond_volume" unit="m" /> 51 <field id="icehlid" long_name="melt pond lid depth" standard_name="sea_ice_meltpondlid_depth" unit="m" /> 52 <field id="icevlid" long_name="melt pond lid volume" standard_name="sea_ice_meltpondlid_volume" unit="m" /> 51 53 52 54 <!-- heat --> … … 81 83 <field id="icediv" long_name="Divergence of the sea-ice velocity field" standard_name="divergence_of_sea_ice_velocity" unit="s-1" /> 82 84 <field id="iceshe" long_name="Maximum shear of sea-ice velocity field" standard_name="maximum_shear_of_sea_ice_velocity" unit="s-1" /> 83 85 <field id="beta_evp" long_name="Relaxation parameter of ice rheology (beta)" standard_name="relaxation_parameter_of_ice_rheology" unit="" /> 86 84 87 <!-- surface heat fluxes --> 85 88 <field id="qt_ice" long_name="total heat flux at ice surface" standard_name="surface_downward_heat_flux_in_air" unit="W/m2" /> … … 173 176 <field id="frq_m" unit="-" /> 174 177 178 <!-- rheology convergence tests --> 179 <field id="uice_cvg" long_name="sea ice velocity convergence" standard_name="sea_ice_velocity_convergence" unit="m/s" /> 180 175 181 <!-- ================= --> 176 182 <!-- Add-ons for SIMIP --> … … 211 217 <field id="dmisum" long_name="sea-ice mass change through surface melting" standard_name="tendency_of_sea_ice_amount_due_to_surface_melting" unit="kg/m2/s" /> 212 218 <field id="dmibom" long_name="sea-ice mass change through bottom melting" standard_name="tendency_of_sea_ice_amount_due_to_basal_melting" unit="kg/m2/s" /> 219 <field id="dmilam" long_name="sea-ice mass change through lateral melting" standard_name="tendency_of_sea_ice_amount_due_to_lateral_melting" unit="kg/m2/s" /> 213 220 <field id="dmsspr" long_name="snow mass change through snow fall" standard_name="snowfall_flux" unit="kg/m2/s" /> 214 221 <field id="dmsmel" long_name="snow mass change through melt" standard_name="surface_snow_melt_flux" unit="kg/m2/s" /> … … 289 296 <field id="iceapnd_cat" long_name="Ice melt pond concentration per category" unit="" /> 290 297 <field id="icehpnd_cat" long_name="Ice melt pond thickness per category" unit="m" detect_missing_value="true" /> 298 <field id="icehlid_cat" long_name="Ice melt pond lid thickness per category" unit="m" detect_missing_value="true" /> 291 299 <field id="iceafpnd_cat" long_name="Ice melt pond fraction per category" unit="" /> 300 <field id="iceaepnd_cat" long_name="Ice melt pond effective fraction per category" unit="" /> 292 301 <field id="icemask_cat" long_name="Fraction of time step with sea ice (per category)" unit="" /> 293 302 <field id="iceage_cat" long_name="Ice age per category" unit="days" detect_missing_value="true" /> … … 300 309 <field id="snwthic_cat_cmip" long_name="Snow thickness in thickness categories" standard_name="snow_thickness_over_categories" detect_missing_value="true" unit="m" > snwthic_cat * icemask_cat + $missval * (1.-icemask_cat) </field> 301 310 <field id="iceconc_cat_pct_cmip" long_name="Sea-ice area fractions in thickness categories" standard_name="sea_ice_area_fraction_over_categories" detect_missing_value="true" unit="%" > iceconc_cat*100. * icemask_cat + $missval * (1.-icemask_cat) </field> 311 312 <!-- heat diffusion convergence tests --> 313 <field id="tice_cvgerr" long_name="sea ice temperature convergence error" standard_name="sea_ice_temperature_convergence_err" unit="K" /> 314 <field id="tice_cvgstp" long_name="sea ice temperature convergence iterations" standard_name="sea_ice_temperature_convergence_stp" unit="" /> 302 315 303 316 </field_group> <!-- SBC_3D --> … … 560 573 <field field_ref="dmisum" name="sidmassmelttop" /> 561 574 <field field_ref="dmibom" name="sidmassmeltbot" /> 575 <field field_ref="dmilam" name="sidmassmeltlat" /> 562 576 <field field_ref="dmsspr" name="sndmasssnf" /> 563 577 <field field_ref="dmsmel" name="sndmassmelt" /> -
NEMO/trunk/cfgs/SHARED/field_def_nemo-oce.xml
r13214 r13472 129 129 <!-- AGRIF sponge --> 130 130 <field id="agrif_spt" long_name=" AGRIF t-sponge coefficient" unit=" " /> 131 132 <!-- additions to diawri.F90 --> 133 <field id="socegrad" long_name="module of salinity gradient" unit="psu/m" grid_ref="grid_T_3D"/> 134 <field id="socegrad2" long_name="square of module of salinity gradient" unit="psu2/m2" grid_ref="grid_T_3D"/> 135 <field id="ke" long_name="kinetic energy" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" grid_ref="grid_T_3D" /> 136 <field id="ke_int" long_name="vertical integration of kinetic energy" unit="m3/s2" /> 137 <field id="relvor" long_name="relative vorticity" unit="s-1" grid_ref="grid_T_3D"/> 138 <field id="absvor" long_name="absolute vorticity" unit="s-1" grid_ref="grid_T_3D"/> 139 <field id="potvor" long_name="potential vorticity" unit="s-1" grid_ref="grid_T_3D"/> 140 <field id="salt2c" long_name="Salt content vertically integrated" unit="1e-3*kg/m2" /> 131 141 132 142 <!-- t-eddy viscosity coefficients (ldfdyn) --> … … 177 187 <field id="alpha" long_name="thermal expansion" unit="degC-1" grid_ref="grid_T_3D" /> 178 188 <field id="beta" long_name="haline contraction" unit="1e3" grid_ref="grid_T_3D" /> 179 <field id="bn2" long_name="squared Brunt-Vaisala frequency" unit="s-1" grid_ref="grid_T_3D" />180 189 <field id="rhop" long_name="potential density (sigma0)" standard_name="sea_water_sigma_theta" unit="kg/m3" grid_ref="grid_T_3D" /> 181 190 182 191 <!-- Energy - horizontal divergence --> 183 <field id="eken" long_name="kinetic energy" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" grid_ref="grid_T_3D" />184 192 <field id="hdiv" long_name="horizontal divergence" unit="s-1" grid_ref="grid_T_3D" /> 185 193 … … 655 663 <field id="w_masstr2" long_name="square of vertical mass transport" standard_name="square_of_upward_ocean_mass_transport" unit="kg2/s2" /> 656 664 665 <!-- EOS --> 666 <field id="bn2" long_name="squared Brunt-Vaisala frequency" unit="s-2" /> 667 657 668 </field_group> 658 669 … … 710 721 <field id="masstr_strait" long_name="Sea water transport across line" grid_ref="grid_4strait" > u_masstr_strait + v_masstr_strait </field> 711 722 </field_group> 712 713 723 714 724 <!-- variables available with ln_floats --> -
NEMO/trunk/cfgs/SHARED/namelist_ice_ref
r12377 r13472 43 43 ln_cat_usr = .false. ! ice categories are defined by rn_catbnd below (m) 44 44 rn_catbnd = 0.,0.45,1.1,2.1,3.7,6.0 45 rn_himin = 0.1 ! minimum ice thickness (m) used in remapping 45 rn_himin = 0.1 ! minimum ice thickness (m) allowed 46 rn_himax = 99.0 ! maximum ice thickness (m) allowed 46 47 / 47 48 !------------------------------------------------------------------------------ … … 56 57 rn_ishlat = 2. ! lbc : free slip (0) ; partial slip (0-2) ; no slip (2) ; strong slip (>2) 57 58 ln_landfast_L16 = .false. ! landfast: parameterization from Lemieux 2016 58 rn_ depfra= 0.125 ! fraction of ocean depth that ice must reach to initiate landfast59 rn_lf_depfra = 0.125 ! fraction of ocean depth that ice must reach to initiate landfast 59 60 ! recommended range: [0.1 ; 0.25] 60 rn_ icebfr = 15. ! maximum bottom stress per unit volume [N/m3]61 rn_lf relax= 1.e-5 ! relaxation time scale to reach static friction [s-1]62 rn_ tensile= 0.05 ! isotropic tensile strength [0-0.5??]61 rn_lf_bfr = 15. ! maximum bottom stress per unit volume [N/m3] 62 rn_lf_relax = 1.e-5 ! relaxation time scale to reach static friction [s-1] 63 rn_lf_tensile = 0.05 ! isotropic tensile strength [0-0.5??] 63 64 / 64 65 !------------------------------------------------------------------------------ … … 94 95 rn_creepl = 2.0e-9 ! creep limit [1/s] 95 96 rn_ecc = 2.0 ! eccentricity of the elliptical yield curve 96 nn_nevp = 1 20 ! number of EVP subcycles97 nn_nevp = 100 ! number of EVP subcycles 97 98 rn_relast = 0.333 ! ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 98 ! advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 99 ! advised value: 1/3 (nn_nevp=100) or 1/9 (nn_nevp=300) 100 nn_rhg_chkcvg = 0 ! check convergence of rheology 101 ! = 0 no check 102 ! = 1 check at the main time step (output xml: uice_cvg) 103 ! = 2 check at both main and rheology time steps (additional output: ice_cvg.nc) 104 ! this option 2 asks a lot of communications between cpu 99 105 / 100 106 !------------------------------------------------------------------------------ 101 107 &namdyn_adv ! Ice advection 102 108 !------------------------------------------------------------------------------ 103 ln_adv_Pra = .true. ! Advection scheme (Prather)104 ln_adv_UMx = .false. 109 ln_adv_Pra = .true. ! Advection scheme (Prather) 110 ln_adv_UMx = .false. ! Advection scheme (Ultimate-Macho) 105 111 nn_UMx = 5 ! order of the scheme for UMx (1-5 ; 20=centered 2nd order) 106 112 / … … 109 115 !------------------------------------------------------------------------------ 110 116 rn_cio = 5.0e-03 ! ice-ocean drag coefficient (-) 111 rn_blow_s = 0.66 ! mesure of snow blowing into the leads 117 nn_snwfra = 2 ! calculate the fraction of ice covered by snow (for zdf and albedo) 118 ! = 0 fraction = 1 (if snow) or 0 (if no snow) 119 ! = 1 fraction = 1-exp(-0.2*rhos*hsnw) [MetO formulation] 120 ! = 2 fraction = hsnw / (hsnw+0.02) [CICE formulation] 121 rn_snwblow = 0.66 ! mesure of snow blowing into the leads 112 122 ! = 1 => no snow blowing, < 1 => some snow blowing 113 123 nn_flxdist = -1 ! Redistribute heat flux over ice categories … … 118 128 ln_cndflx = .false. ! Use conduction flux as surface boundary conditions (i.e. for Jules coupling) 119 129 ln_cndemulate = .false. ! emulate conduction flux (if not provided in the inputs) 130 nn_qtrice = 1 ! Solar flux transmitted thru the surface scattering layer: 131 ! = 0 Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow) 132 ! = 1 Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 120 133 / 121 134 !------------------------------------------------------------------------------ … … 126 139 ln_icedO = .true. ! activate ice growth in open-water (T) or not (F) 127 140 ln_icedS = .true. ! activate brine drainage (T) or not (F) 141 ! 142 ln_leadhfx = .true. ! heat in the leads is used to melt sea-ice before warming the ocean 128 143 / 129 144 !------------------------------------------------------------------------------ … … 135 150 rn_cnd_s = 0.31 ! thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 136 151 ! Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 137 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice [1/m] 152 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice [1/m] 153 rn_kappa_s = 10.0 ! nn_qtrice = 0: radiation attenuation coefficient in snow [1/m] 154 rn_kappa_smlt = 7.0 ! nn_qtrice = 1: radiation attenuation coefficient in melting snow [1/m] 155 rn_kappa_sdry = 10.0 ! radiation attenuation coefficient in dry snow [1/m] 156 ln_zdf_chkcvg = .false. ! check convergence of heat diffusion scheme (outputs: tice_cvgerr, tice_cvgstp) 138 157 / 139 158 !------------------------------------------------------------------------------ … … 175 194 &namthd_pnd ! Melt ponds 176 195 !------------------------------------------------------------------------------ 177 ln_pnd = .false. ! activate melt ponds or not 178 ln_pnd_H12 = .false. ! activate evolutive melt ponds (from Holland et al 2012) 179 ln_pnd_CST = .false. ! activate constant melt ponds 180 rn_apnd = 0.2 ! prescribed pond fraction, at Tsu=0 degC 181 rn_hpnd = 0.05 ! prescribed pond depth, at Tsu=0 degC 182 ln_pnd_alb = .false. ! melt ponds affect albedo or not 196 ln_pnd = .true. ! activate melt ponds or not 197 ln_pnd_LEV = .true. ! level ice melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 198 rn_apnd_min = 0.15 ! minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 199 rn_apnd_max = 0.85 ! maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 200 ln_pnd_CST = .false. ! constant melt ponds 201 rn_apnd = 0.2 ! prescribed pond fraction, at Tsu=0 degC 202 rn_hpnd = 0.05 ! prescribed pond depth, at Tsu=0 degC 203 ln_pnd_lids = .true. ! frozen lids on top of the ponds (only for ln_pnd_LEV) 204 ln_pnd_alb = .true. ! effect of melt ponds on ice albedo 183 205 / 184 206 !------------------------------------------------------------------------------ … … 186 208 !------------------------------------------------------------------------------ 187 209 ln_iceini = .true. ! activate ice initialization (T) or not (F) 188 ln_iceini_file = .false. ! netcdf file provided for initialization (T) or not (F) 210 nn_iceini_file = 0 ! 0 = Initialise sea ice based on SSTs 211 ! 1 = Initialise sea ice from single category netcdf file 212 ! 2 = Initialise sea ice from multi category restart file 189 213 rn_thres_sst = 2.0 ! max temp. above Tfreeze with initial ice = (sst - tfreeze) 190 214 rn_hti_ini_n = 3.0 ! initial ice thickness (m), North … … 206 230 rn_hpd_ini_n = 0.05 ! initial pond depth (m), North 207 231 rn_hpd_ini_s = 0.05 ! " " South 208 ! -- for ln_iceini_file = T 232 rn_hld_ini_n = 0.0 ! initial pond lid depth (m), North 233 rn_hld_ini_s = 0.0 ! " " South 234 ! -- for nn_iceini_file = 1 209 235 sn_hti = 'Ice_initialization' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' 210 236 sn_hts = 'Ice_initialization' , -12 ,'hts' , .false. , .true., 'yearly' , '' , '', '' … … 217 243 sn_apd = 'NOT USED' , -12 ,'apd' , .false. , .true., 'yearly' , '' , '', '' 218 244 sn_hpd = 'NOT USED' , -12 ,'hpd' , .false. , .true., 'yearly' , '' , '', '' 245 sn_hld = 'NOT USED' , -12 ,'hld' , .false. , .true., 'yearly' , '' , '', '' 219 246 cn_dir='./' 220 247 / … … 238 265 ln_icediahsb = .false. ! output the heat, mass & salt budgets (T) or not (F) 239 266 ln_icectl = .false. ! ice points output for debug (T or F) 240 iiceprt = 10 !i-index for debug241 jiceprt = 10 !j-index for debug242 / 267 iiceprt = 10 ! i-index for debug 268 jiceprt = 10 ! j-index for debug 269 / -
NEMO/trunk/cfgs/SHARED/namelist_ref
r13461 r13472 296 296 sn_uoatm = 'NOT USED' , 6. , 'UOATM' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , 'Uoceatm', '' 297 297 sn_voatm = 'NOT USED' , 6. , 'VOATM' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , 'Voceatm', '' 298 sn_cc = 'NOT USED' , 24. , 'CC' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 298 299 sn_hpgi = 'NOT USED' , 24. , 'uhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG' , '' 299 300 sn_hpgj = 'NOT USED' , 24. , 'vhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG' , '' … … 335 336 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 336 337 !----------------------------------------------------------------------- 337 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentially sending/receiving data 338 ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models 339 ! ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 340 nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1) 338 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentially sending/receiving data 339 ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models 340 ! ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 341 ln_scale_ice_flux = .false. ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 342 nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1) 341 343 !_____________!__________________________!____________!_____________!______________________!________! 342 344 ! ! description ! multiple ! vector ! vector ! vector ! … … 732 734 bn_aip = 'NOT USED' , 24. , 'siapnd' , .true. , .false., 'daily' , '' , '' , '' 733 735 bn_hip = 'NOT USED' , 24. , 'sihpnd' , .true. , .false., 'daily' , '' , '' , '' 736 bn_hil = 'NOT USED' , 24. , 'sihlid' , .true. , .false., 'daily' , '' , '' , '' 734 737 ! if bn_t_i etc are "not used", then define arbitrary temperatures and salinity and ponds 735 738 rn_ice_tem = 270. ! arbitrary temperature of incoming sea ice … … 738 741 rn_ice_apnd = 0.2 ! -- pond fraction = a_ip/a_i -- 739 742 rn_ice_hpnd = 0.05 ! -- pond depth -- 743 rn_ice_hlid = 0.0 ! -- pond lid depth -- 740 744 / 741 745 !----------------------------------------------------------------------- … … 765 769 ! 766 770 ln_drgimp = .true. ! implicit top/bottom friction flag 771 ln_drgice_imp = .false. ! implicit ice-ocean drag 767 772 / 768 773 !----------------------------------------------------------------------- … … 1135 1140 rn_bshear = 1.e-20 ! background shear (>0) currently a numerical threshold (do not change it) 1136 1141 nn_pdl = 1 ! Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm) 1137 nn_mxl = 2! mixing length: = 0 bounded by the distance to surface and bottom1142 nn_mxl = 3 ! mixing length: = 0 bounded by the distance to surface and bottom 1138 1143 ! ! = 1 bounded by the local vertical scale factor 1139 1144 ! ! = 2 first vertical derivative of mixing length bounded by 1 1140 1145 ! ! = 3 as =2 with distinct dissipative an mixing length scale 1141 1146 ln_mxl0 = .true. ! surface mixing length scale = F(wind stress) (T) or not (F) 1142 nn_mxlice = 0! type of scaling under sea-ice1147 nn_mxlice = 2 ! type of scaling under sea-ice 1143 1148 ! = 0 no scaling under sea-ice 1144 1149 ! = 1 scaling with constant sea-ice thickness 1145 ! = 2 1146 ! = 3 1150 ! = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 1151 ! = 3 scaling with maximum sea-ice thickness 1147 1152 rn_mxlice = 10. ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 1148 1153 rn_mxl0 = 0.04 ! surface buoyancy lenght scale minimum value … … 1157 1162 ! = 0 constant 10 m length scale 1158 1163 ! = 1 0.5m at the equator to 30m poleward of 40 degrees 1159 rn_eice = 4 ! below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4 1164 nn_eice = 1 ! attenutaion of langmuir & surface wave breaking under ice 1165 ! ! = 0 no impact of ice cover on langmuir & surface wave breaking 1166 ! ! = 1 weigthed by 1-TANH(10*fr_i) 1167 ! ! = 2 weighted by 1-fr_i 1168 ! ! = 3 weighted by 1-MIN(1,4*fr_i) 1160 1169 / 1161 1170 !----------------------------------------------------------------------- … … 1170 1179 rn_charn = 70000. ! Charnock constant for wb induced roughness length 1171 1180 rn_hsro = 0.02 ! Minimum surface roughness 1181 rn_hsri = 0.03 ! Ice-ocean roughness 1172 1182 rn_frac_hs = 1.3 ! Fraction of wave height as roughness (if nn_z0_met>1) 1173 1183 nn_z0_met = 2 ! Method for surface roughness computation (0/1/2/3) 1174 ! ! =3 requires ln_wave=T 1184 ! ! = 3 requires ln_wave=T 1185 nn_z0_ice = 1 ! attenutaion of surface wave breaking under ice 1186 ! ! = 0 no impact of ice cover 1187 ! ! = 1 roughness uses rn_hsri and is weigthed by 1-TANH(10*fr_i) 1188 ! ! = 2 roughness uses rn_hsri and is weighted by 1-fr_i 1189 ! ! = 3 roughness uses rn_hsri and is weighted by 1-MIN(1,4*fr_i) 1175 1190 nn_bc_surf = 1 ! surface condition (0/1=Dir/Neum) 1176 1191 nn_bc_bot = 1 ! bottom condition (0/1=Dir/Neum) -
NEMO/trunk/cfgs/SPITZ12/EXPREF/namelist_cfg
r13461 r13472 216 216 ln_loglayer = .true. ! logarithmic drag: Cd = vkarmn/log(z/z0) |U| 217 217 ln_drgimp = .true. ! implicit top/bottom friction flag 218 ln_drgice_imp = .true. ! implicit ice-ocean drag 218 219 / 219 220 !----------------------------------------------------------------------- … … 339 340 nn_havtb = 1 ! horizontal shape for avtb (=1) or not (=0) 340 341 / 342 !----------------------------------------------------------------------- 343 &namzdf_tke ! turbulent eddy kinetic dependent vertical diffusion (ln_zdftke =T) 344 !----------------------------------------------------------------------- 345 ln_mxl0 = .true. ! surface mixing length scale = F(wind stress) (T) or not (F) 346 nn_mxlice = 0 ! type of scaling under sea-ice 347 ! = 0 no scaling under sea-ice 348 ! = 1 scaling with constant sea-ice thickness 349 ! = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 350 ! = 3 scaling with maximum sea-ice thickness 351 nn_eice = 0 ! attenutaion of langmuir & surface wave breaking under ice 352 ! ! = 0 no impact of ice cover on langmuir & surface wave breaking 353 ! ! = 1 weigthed by 1-TANH(10*fr_i) 354 ! ! = 2 weighted by 1-fr_i 355 ! ! = 3 weighted by 1-MIN(1,4*fr_i) 356 / 341 357 !!====================================================================== 342 358 !! *** Diagnostics namelists *** !! -
NEMO/trunk/cfgs/SPITZ12/EXPREF/namelist_ice_cfg
r11731 r13472 55 55 &namsbc ! Ice surface boundary conditions 56 56 !------------------------------------------------------------------------------ 57 nn_snwfra = 0 ! calculate the fraction of ice covered by snow (for zdf and albedo) 58 ! = 0 fraction = 1 (if snow) or 0 (if no snow) 59 ! = 1 fraction = 1-exp(-0.2*rhos*hsnw) [MetO formulation] 60 ! = 2 fraction = hsnw / (hsnw+0.02) [CICE formulation] 61 nn_qtrice = 0 ! Solar flux transmitted thru the surface scattering layer: 62 ! = 0 Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow) 63 ! = 1 Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 57 64 / 58 65 !------------------------------------------------------------------------------ … … 81 88 &namthd_pnd ! Melt ponds 82 89 !------------------------------------------------------------------------------ 83 ln_pnd = .true. ! activate melt ponds or not 84 ln_pnd_H12 = .true. ! activate evolutive melt ponds (from Holland et al 2012) 85 ln_pnd_alb = .true. ! melt ponds affect albedo or not 90 ln_pnd = .false. ! activate melt ponds or not 91 ln_pnd_LEV = .false. ! activate level ice melt ponds 86 92 / 87 93 -
NEMO/trunk/doc/namelists/nambdy_dta
r11703 r13472 29 29 bn_aip = 'NOT USED' , 24. , 'siapnd' , .true. , .false., 'daily' , '' , '' , '' 30 30 bn_hip = 'NOT USED' , 24. , 'sihpnd' , .true. , .false., 'daily' , '' , '' , '' 31 bn_hil = 'NOT USED' , 24. , 'sihlid' , .true. , .false., 'daily' , '' , '' , '' 31 32 ! if bn_t_i etc are "not used", then define arbitrary temperatures and salinity and ponds 32 33 rn_ice_tem = 270. ! arbitrary temperature of incoming sea ice … … 35 36 rn_ice_apnd = 0.2 ! -- pond fraction = a_ip/a_i -- 36 37 rn_ice_hpnd = 0.05 ! -- pond depth -- 38 rn_ice_hlid = 0.0 ! -- pond lid depth -- 37 39 / -
NEMO/trunk/doc/namelists/namdia
r11703 r13472 8 8 ln_icediahsb = .false. ! output the heat, mass & salt budgets (T) or not (F) 9 9 ln_icectl = .false. ! ice points output for debug (T or F) 10 iiceprt = 10 !i-index for debug11 jiceprt = 10 !j-index for debug10 iiceprt = 10 ! i-index for debug 11 jiceprt = 10 ! j-index for debug 12 12 / -
NEMO/trunk/doc/namelists/namdrg
r13461 r13472 8 8 ! 9 9 ln_drgimp = .true. ! implicit top/bottom friction flag 10 ln_drgice_imp = .false. ! implicit ice-ocean drag 10 11 / -
NEMO/trunk/doc/namelists/namdyn
r11703 r13472 10 10 rn_ishlat = 2. ! lbc : free slip (0) ; partial slip (0-2) ; no slip (2) ; strong slip (>2) 11 11 ln_landfast_L16 = .false. ! landfast: parameterization from Lemieux 2016 12 rn_ depfra= 0.125 ! fraction of ocean depth that ice must reach to initiate landfast12 rn_lf_depfra = 0.125 ! fraction of ocean depth that ice must reach to initiate landfast 13 13 ! recommended range: [0.1 ; 0.25] 14 rn_ icebfr = 15. ! maximum bottom stress per unit volume [N/m3]15 rn_lf relax= 1.e-5 ! relaxation time scale to reach static friction [s-1]16 rn_ tensile= 0.05 ! isotropic tensile strength [0-0.5??]14 rn_lf_bfr = 15. ! maximum bottom stress per unit volume [N/m3] 15 rn_lf_relax = 1.e-5 ! relaxation time scale to reach static friction [s-1] 16 rn_lf_tensile = 0.05 ! isotropic tensile strength [0-0.5??] 17 17 / -
NEMO/trunk/doc/namelists/namdyn_rhg
r11025 r13472 9 9 rn_relast = 0.333 ! ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 10 10 ! advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 11 ln_rhg_chkcvg = .false. ! check convergence of rheology (outputs: file ice_cvg.nc & variable uice_cvg) 11 12 / -
NEMO/trunk/doc/namelists/namini
r11703 r13472 3 3 !------------------------------------------------------------------------------ 4 4 ln_iceini = .true. ! activate ice initialization (T) or not (F) 5 ln_iceini_file = .false. ! netcdf file provided for initialization (T) or not (F) 5 nn_iceini_file = 0 ! 0 = Initialise sea ice based on SSTs 6 ! 1 = Initialise sea ice from single category netcdf file 7 ! 2 = Initialise sea ice from multi category restart file 6 8 rn_thres_sst = 2.0 ! max temp. above Tfreeze with initial ice = (sst - tfreeze) 7 9 rn_hti_ini_n = 3.0 ! initial ice thickness (m), North … … 23 25 rn_hpd_ini_n = 0.05 ! initial pond depth (m), North 24 26 rn_hpd_ini_s = 0.05 ! " " South 25 ! -- for ln_iceini_file = T 27 rn_hld_ini_n = 0.0 ! initial pond lid depth (m), North 28 rn_hld_ini_s = 0.0 ! " " South 29 ! -- for nn_iceini_file = 1 26 30 sn_hti = 'Ice_initialization' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' 27 31 sn_hts = 'Ice_initialization' , -12 ,'hts' , .false. , .true., 'yearly' , '' , '', '' … … 34 38 sn_apd = 'NOT USED' , -12 ,'apd' , .false. , .true., 'yearly' , '' , '', '' 35 39 sn_hpd = 'NOT USED' , -12 ,'hpd' , .false. , .true., 'yearly' , '' , '', '' 40 sn_hld = 'NOT USED' , -12 ,'hld' , .false. , .true., 'yearly' , '' , '', '' 36 41 cn_dir='./' 37 42 / -
NEMO/trunk/doc/namelists/namsbc_blk
r12377 r13472 35 35 sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 36 36 sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 37 sn_hpgi = 'NONE' , 24. , 'uhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG' , ''38 sn_hpgj = 'NONE' , 24. , 'vhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG' , ''39 37 sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 40 38 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 41 39 sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 40 sn_uoatm = 'NOT USED' , 6. , 'UOATM' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , 'Uoceatm', '' 41 sn_voatm = 'NOT USED' , 6. , 'VOATM' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , 'Voceatm', '' 42 sn_cc = 'NOT USED' , 24. , 'CC' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 43 sn_hpgi = 'NOT USED' , 24. , 'uhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG' , '' 44 sn_hpgj = 'NOT USED' , 24. , 'vhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG' , '' 42 45 / -
NEMO/trunk/doc/namelists/namsbc_cpl
r10075 r13472 2 2 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 3 3 !----------------------------------------------------------------------- 4 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentially sending/receiving data5 ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models6 ! ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)7 nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1)8 4 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentially sending/receiving data 5 ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models 6 ! ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 7 ln_scale_ice_flux = .false. ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 8 nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1) 9 9 !_____________!__________________________!____________!_____________!______________________!________! 10 10 ! ! description ! multiple ! vector ! vector ! vector ! -
NEMO/trunk/doc/namelists/namthd
r11025 r13472 6 6 ln_icedO = .true. ! activate ice growth in open-water (T) or not (F) 7 7 ln_icedS = .true. ! activate brine drainage (T) or not (F) 8 ! 9 ln_leadhfx = .true. ! heat in the leads is used to melt sea-ice before warming the ocean 8 10 / -
NEMO/trunk/doc/namelists/namthd_pnd
r11536 r13472 2 2 &namthd_pnd ! Melt ponds 3 3 !------------------------------------------------------------------------------ 4 ln_pnd = .false. ! activate melt ponds or not 5 ln_pnd_H12 = .false. ! activate evolutive melt ponds (from Holland et al 2012) 6 ln_pnd_CST = .false. ! activate constant melt ponds 7 rn_apnd = 0.2 ! prescribed pond fraction, at Tsu=0 degC 8 rn_hpnd = 0.05 ! prescribed pond depth, at Tsu=0 degC 9 ln_pnd_alb = .false. ! melt ponds affect albedo or not 4 ln_pnd = .false. ! activate melt ponds or not 5 ln_pnd_LEV = .false. ! level ice melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 6 rn_apnd_min = 0.15 ! minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 7 rn_apnd_max = 0.85 ! maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 8 ln_pnd_CST = .false. ! constant melt ponds 9 rn_apnd = 0.2 ! prescribed pond fraction, at Tsu=0 degC 10 rn_hpnd = 0.05 ! prescribed pond depth, at Tsu=0 degC 11 ln_pnd_lids = .true. ! frozen lids on top of the ponds (only for ln_pnd_LEV) 12 ln_pnd_alb = .true. ! effect of melt ponds on ice albedo 10 13 / -
NEMO/trunk/doc/namelists/namthd_zdf
r11025 r13472 7 7 rn_cnd_s = 0.31 ! thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 8 8 ! Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 9 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice [1/m] 9 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice [1/m] 10 rn_kappa_s = 10.0 ! nn_qtrice = 0: radiation attenuation coefficient in snow [1/m] 11 rn_kappa_smlt = 7.0 ! nn_qtrice = 1: radiation attenuation coefficient in melting snow [1/m] 12 rn_kappa_sdry = 10.0 ! radiation attenuation coefficient in dry snow [1/m] 13 ln_zdf_chkcvg = .false. ! check convergence of heat diffusion scheme (output variable: tice_cvg) 10 14 / -
NEMO/trunk/doc/namelists/namzdf_gls
r9355 r13472 13 13 nn_z0_met = 2 ! Method for surface roughness computation (0/1/2/3) 14 14 ! ! =3 requires ln_wave=T 15 nn_z0_ice = 1 ! attenutaion of surface wave breaking under ice 16 ! ! = 0 no impact of ice cover 17 ! ! = 1 roughness uses rn_hsri and is weigthed by 1-TANH(10*fr_i) 18 ! ! = 2 roughness uses rn_hsri and is weighted by 1-fr_i 19 ! ! = 3 roughness uses rn_hsri and is weighted by 1-MIN(1,4*fr_i) 15 20 nn_bc_surf = 1 ! surface condition (0/1=Dir/Neum) 16 21 nn_bc_bot = 1 ! bottom condition (0/1=Dir/Neum) -
NEMO/trunk/doc/namelists/namzdf_tke
r13461 r13472 25 25 ! = 0 constant 10 m length scale 26 26 ! = 1 0.5m at the equator to 30m poleward of 40 degrees 27 rn_eice = 4 ! below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4 27 nn_eice = 1 ! attenutaion of langmuir & surface wave breaking under ice 28 ! ! = 0 no impact of ice cover on langmuir & surface wave breaking 29 ! ! = 1 weigthed by 1-TANH(10*fr_i) 30 ! ! = 2 weighted by 1-fr_i 31 ! ! = 3 weighted by 1-MIN(1,4*fr_i) 28 32 / -
NEMO/trunk/src/ICE/ice.F90
r12489 r13472 70 70 !! a_ip | - | Ice pond concentration | | 71 71 !! v_ip | - | Ice pond volume per unit area| m | 72 !! v_il | v_il_1d | Ice pond lid volume per area | m | 72 73 !! | 73 74 !!-------------|-------------|---------------------------------|-------| … … 85 86 !! t_su ! t_su_1d | Sea ice surface temperature ! K | 86 87 !! h_ip | h_ip_1d | Ice pond thickness | m | 88 !! h_il | h_il_1d | Ice pond lid thickness | m | 87 89 !! | 88 90 !! notes: the ice model only sees a bulk (i.e., vertically averaged) | … … 112 114 !! hm_ip | - | Mean ice pond depth | m | 113 115 !! vt_ip | - | Total ice pond vol. per unit area| m | 116 !! hm_il | - | Mean ice pond lid depth | m | 117 !! vt_il | - | Total ice pond lid vol. per area | m | 114 118 !!===================================================================== 115 119 … … 137 141 REAL(wp), PUBLIC :: rn_ishlat !: lateral boundary condition for sea-ice 138 142 LOGICAL , PUBLIC :: ln_landfast_L16 !: landfast ice parameterizationfrom lemieux2016 139 REAL(wp), PUBLIC :: rn_ depfra!: fraction of ocean depth that ice must reach to initiate landfast ice140 REAL(wp), PUBLIC :: rn_ icebfr !: maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)141 REAL(wp), PUBLIC :: rn_lf relax!: relaxation time scale (s-1) to reach static friction142 REAL(wp), PUBLIC :: rn_ tensile!: isotropic tensile strength143 REAL(wp), PUBLIC :: rn_lf_depfra !: fraction of ocean depth that ice must reach to initiate landfast ice 144 REAL(wp), PUBLIC :: rn_lf_bfr !: maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home) 145 REAL(wp), PUBLIC :: rn_lf_relax !: relaxation time scale (s-1) to reach static friction 146 REAL(wp), PUBLIC :: rn_lf_tensile !: isotropic tensile strength 143 147 ! 144 148 ! !!** ice-ridging/rafting namelist (namdyn_rdgrft) ** … … 151 155 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling 152 156 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 157 INTEGER , PUBLIC :: nn_rhg_chkcvg !: check ice rheology convergence 153 158 ! 154 159 ! !!** ice-advection namelist (namdyn_adv) ** … … 158 163 ! !!** ice-surface boundary conditions namelist (namsbc) ** 159 164 ! -- icethd_dh -- ! 160 REAL(wp), PUBLIC :: rn_blow_s !: coef. for partitioning of snowfall between leads and sea ice 165 REAL(wp), PUBLIC :: rn_snwblow !: coef. for partitioning of snowfall between leads and sea ice 166 ! -- icethd_zdf and icealb -- ! 167 INTEGER , PUBLIC :: nn_snwfra !: calculate the fraction of ice covered by snow 168 ! ! = 0 fraction = 1 (if snow) or 0 (if no snow) 169 ! ! = 1 fraction = 1-exp(-0.2*rhos*hsnw) [MetO formulation] 170 ! ! = 2 fraction = hsnw / (hsnw+0.02) [CICE formulation] 161 171 ! -- icethd -- ! 162 172 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress … … 166 176 ! ! = 1 Average N(cat) fluxes then redistribute over the N(cat) ice using T-ice and albedo sensitivity 167 177 ! ! = 2 Redistribute a single flux over categories 178 ! -- icethd_zdf -- ! 168 179 LOGICAL , PUBLIC :: ln_cndflx !: use conduction flux as surface boundary condition (instead of qsr and qns) 169 180 LOGICAL , PUBLIC :: ln_cndemulate !: emulate conduction flux (if not provided) … … 172 183 INTEGER, PUBLIC, PARAMETER :: np_cnd_ON = 1 !: forcing from conduction flux (SM0L) (compute qcn and qsr_tr via sbcblk.F90 or sbccpl.F90) 173 184 INTEGER, PUBLIC, PARAMETER :: np_cnd_EMU = 2 !: emulate conduction flux via icethd_zdf.F90 (BL99) (1st round compute qcn and qsr_tr, 2nd round use it) 174 185 INTEGER, PUBLIC :: nn_qtrice !: Solar flux transmitted thru the surface scattering layer: 186 ! ! = 0 Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow) 187 ! ! = 1 Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 188 ! 175 189 ! !!** ice-vertical diffusion namelist (namthd_zdf) ** 176 190 LOGICAL , PUBLIC :: ln_cndi_U64 !: thermal conductivity: Untersteiner (1964) 177 191 LOGICAL , PUBLIC :: ln_cndi_P07 !: thermal conductivity: Pringle et al (2007) 178 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]179 192 REAL(wp), PUBLIC :: rn_cnd_s !: thermal conductivity of the snow [W/m/K] 193 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation in sea ice, Grenfell et al. (2006) [1/m] 194 REAL(wp), PUBLIC :: rn_kappa_s !: coef. for the extinction of radiation in snw (nn_qtrice=0) [1/m] 195 REAL(wp), PUBLIC :: rn_kappa_smlt !: coef. for the extinction of radiation in melt snw (nn_qtrice=1) [1/m] 196 REAL(wp), PUBLIC :: rn_kappa_sdry !: coef. for the extinction of radiation in dry snw (nn_qtrice=1) [1/m] 197 LOGICAL , PUBLIC :: ln_zdf_chkcvg !: check convergence of heat diffusion scheme 180 198 181 199 ! !!** ice-salinity namelist (namthd_sal) ** … … 190 208 ! !!** ice-ponds namelist (namthd_pnd) 191 209 LOGICAL , PUBLIC :: ln_pnd !: Melt ponds (T) or not (F) 192 LOGICAL , PUBLIC :: ln_pnd_H12 !: Melt ponds scheme from Holland et al 2012 210 LOGICAL , PUBLIC :: ln_pnd_LEV !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 211 REAL(wp), PUBLIC :: rn_apnd_min !: Minimum ice fraction that contributes to melt ponds 212 REAL(wp), PUBLIC :: rn_apnd_max !: Maximum ice fraction that contributes to melt ponds 193 213 LOGICAL , PUBLIC :: ln_pnd_CST !: Melt ponds scheme with constant fraction and depth 194 214 REAL(wp), PUBLIC :: rn_apnd !: prescribed pond fraction (0<rn_apnd<1) 195 215 REAL(wp), PUBLIC :: rn_hpnd !: prescribed pond depth (0<rn_hpnd<1) 216 LOGICAL, PUBLIC :: ln_pnd_lids !: Allow ponds to have frozen lids 196 217 LOGICAL , PUBLIC :: ln_pnd_alb !: melt ponds affect albedo 197 218 … … 218 239 219 240 ! !!** define arrays 220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce,v_oce !: surface ocean velocity used in ice dynamics 221 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_i_new !: ice collection thickness accreted in leads 222 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength !: ice strength 223 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress1_i, stress2_i, stress12_i !: 1st, 2nd & diagonal stress tensor element 224 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i !: ice rheology elta factor (Flato & Hibler 95) [s-1] 225 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i !: Divergence of the velocity field [s-1] 226 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 227 ! 228 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 229 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlead !: heat balance of the lead (or of the open ocean) 230 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsb_ice_bot !: net downward heat flux from the ice to the ocean 231 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 232 233 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: mass flux from snow-ocean mass exchange [kg.m-2.s-1] 234 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sni !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sum !: mass flux from surface melt component of wfx_snw [kg.m-2.s-1] 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_pnd !: mass flux from melt pond-ocean mass exchange [kg.m-2.s-1] 237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: mass flux from snow precipitation on ice [kg.m-2.s-1] 238 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: mass flux from sublimation of snow/ice [kg.m-2.s-1] 239 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sub !: mass flux from snow sublimation [kg.m-2.s-1] 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice_sub !: mass flux from ice sublimation [kg.m-2.s-1] 241 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_dyn !: mass flux from dynamical component of wfx_snw [kg.m-2.s-1] 243 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: mass flux from ice-ocean mass exchange [kg.m-2.s-1] 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: mass flux from snow ice growth component of wfx_ice [kg.m-2.s-1] 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: mass flux from lateral ice growth component of wfx_ice [kg.m-2.s-1] 247 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: mass flux from bottom ice growth component of wfx_ice [kg.m-2.s-1] 248 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 249 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: mass flux from bottom melt component of wfx_ice [kg.m-2.s-1] 250 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: mass flux from surface melt component of wfx_ice [kg.m-2.s-1] 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_lam !: mass flux from lateral melt component of wfx_ice [kg.m-2.s-1] 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: mass flux from residual component of wfx_ice [kg.m-2.s-1] 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 254 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice bottom growth [pss.kg.m-2.s-1 => g.m-2.s-1] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice bottom melt [pss.kg.m-2.s-1 => g.m-2.s-1] 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice lateral melt [pss.kg.m-2.s-1 => g.m-2.s-1] 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice surface melt [pss.kg.m-2.s-1 => g.m-2.s-1] 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to snow-ice growth [pss.kg.m-2.s-1 => g.m-2.s-1] 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to growth in open water [pss.kg.m-2.s-1 => g.m-2.s-1] 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [pss.kg.m-2.s-1 => g.m-2.s-1] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [pss.kg.m-2.s-1 => g.m-2.s-1] 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1] 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation [pss.kg.m-2.s-1 => g.m-2.s-1] 265 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth [W.m-2] 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt [W.m-2] 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sum !: total heat flux causing surface ice melt [W.m-2] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_opw !: total heat flux causing open water ice formation [W.m-2] 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dif !: total heat flux causing Temp change in the ice [W.m-2] 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt [W.m-2] 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping => must be 0 [W.m-2] 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_atm_oi !: heat flux at the interface atm-[oce+ice] [W.m-2] 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_oce_ai !: heat flux at the interface oce-[atm+ice] [W.m-2] 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce,v_oce !: surface ocean velocity used in ice dynamics 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_i_new !: ice collection thickness accreted in leads 243 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength !: ice strength 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress1_i, stress2_i, stress12_i !: 1st, 2nd & diagonal stress tensor element 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: delta_i !: ice rheology elta factor (Flato & Hibler 95) [s-1] 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: divu_i !: Divergence of the velocity field [s-1] 247 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 248 ! 249 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 250 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlead !: heat balance of the lead (or of the open ocean) 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsb_ice_bot !: net downward heat flux from the ice to the ocean 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 253 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: mass flux from snow-ocean mass exchange [kg.m-2.s-1] 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sni !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sum !: mass flux from surface melt component of wfx_snw [kg.m-2.s-1] 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_pnd !: mass flux from melt pond-ocean mass exchange [kg.m-2.s-1] 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: mass flux from snow precipitation on ice [kg.m-2.s-1] 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: mass flux from sublimation of snow/ice [kg.m-2.s-1] 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sub !: mass flux from snow sublimation [kg.m-2.s-1] 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice_sub !: mass flux from ice sublimation [kg.m-2.s-1] 262 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_dyn !: mass flux from dynamical component of wfx_snw [kg.m-2.s-1] 264 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: mass flux from ice-ocean mass exchange [kg.m-2.s-1] 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: mass flux from snow ice growth component of wfx_ice [kg.m-2.s-1] 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: mass flux from lateral ice growth component of wfx_ice [kg.m-2.s-1] 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: mass flux from bottom ice growth component of wfx_ice [kg.m-2.s-1] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: mass flux from bottom melt component of wfx_ice [kg.m-2.s-1] 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: mass flux from surface melt component of wfx_ice [kg.m-2.s-1] 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_lam !: mass flux from lateral melt component of wfx_ice [kg.m-2.s-1] 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: mass flux from residual component of wfx_ice [kg.m-2.s-1] 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 275 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice bottom growth [pss.kg.m-2.s-1 => g.m-2.s-1] 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice bottom melt [pss.kg.m-2.s-1 => g.m-2.s-1] 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_lam !: salt flux due to ice lateral melt [pss.kg.m-2.s-1 => g.m-2.s-1] 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice surface melt [pss.kg.m-2.s-1 => g.m-2.s-1] 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to snow-ice growth [pss.kg.m-2.s-1 => g.m-2.s-1] 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to growth in open water [pss.kg.m-2.s-1 => g.m-2.s-1] 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [pss.kg.m-2.s-1 => g.m-2.s-1] 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [pss.kg.m-2.s-1 => g.m-2.s-1] 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1] 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation [pss.kg.m-2.s-1 => g.m-2.s-1] 286 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth [W.m-2] 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt [W.m-2] 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sum !: total heat flux causing surface ice melt [W.m-2] 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_opw !: total heat flux causing open water ice formation [W.m-2] 291 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dif !: total heat flux causing Temp change in the ice [W.m-2] 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt [W.m-2] 293 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 294 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_atm_oi !: heat flux at the interface atm-[oce+ice] [W.m-2] 295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_oce_ai !: heat flux at the interface oce-[atm+ice] [W.m-2] 276 296 277 297 ! heat flux associated with ice-atmosphere mass exchange 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sub!: heat flux for sublimation [W.m-2]279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_spr!: heat flux of the snow precipitation [W.m-2]298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sub !: heat flux for sublimation [W.m-2] 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_spr !: heat flux of the snow precipitation [W.m-2] 280 300 281 301 ! heat flux associated with ice-ocean mass exchange 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd!: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2]283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn!: ice-ocean heat flux from ridging [W.m-2]284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res!: heat flux due to correction on ice thick. (residual) [W.m-2]285 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_bot !: transmitted solar radiation under ice288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t1_ice !: temperature of the first layer(ln_cndflx=T) [K]289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: cnd_ice !: effective conductivity at the top of ice/snow(ln_cndflx=T) [W.m-2.K-1]302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from ridging [W.m-2] 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: heat flux due to correction on ice thick. (residual) [W.m-2] 305 306 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array 307 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_bot !: transmitted solar radiation under ice 308 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t1_ice !: temperature of the first layer (ln_cndflx=T) [K] 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: cnd_ice !: effective conductivity of the 1st layer (ln_cndflx=T) [W.m-2.K-1] 290 310 291 311 !!---------------------------------------------------------------------- … … 293 313 !!---------------------------------------------------------------------- 294 314 !! Variables defined for each ice category 295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i!: Ice thickness (m)296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i!: Ice fractional areas (concentration)297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i!: Ice volume per unit area (m)298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s!: Snow volume per unit area (m)299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_s!: Snow thickness (m)300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su!: Sea-Ice Surface Temperature (K)301 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i!: Sea-Ice Bulk salinity (pss)302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i!: Sea-Ice Bulk salinity * volume per area (pss.m)303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i!: Sea-Ice Age (s)304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i!: Sea-Ice Age times ice area (s)305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i!: brine volume315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i !: Ice thickness (m) 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area (m) 319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_s !: Snow thickness (m) 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K) 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (pss) 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity * volume per area (pss.m) 323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (s) 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (s) 325 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume 306 326 307 327 !! Variables summed over all categories, or associated to all the ice in a single grid cell 308 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 309 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 310 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (pss.m) 311 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 312 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 313 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content (J/m2) 314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories (K) 315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_s !: mean snw temperature over all categories (K) 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories 317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories (pss) 318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories (K) 319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_i !: mean ice thickness over all categories (m) 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_s !: mean snow thickness over all categories (m) 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories (s) 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction on ocean bottom (landfast param activated) 323 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 325 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow enthalpy [J/m2] 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice enthalpy [J/m2] 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSS] 329 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond concentration 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond fraction (a_ip/a_i) 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond depth [m] 334 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond concentration 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_ip !: mean melt pond depth [m] 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per gridcell area [m] 338 339 !!---------------------------------------------------------------------- 340 !! * Old values of global variables 341 !!---------------------------------------------------------------------- 342 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s_b, v_i_b, h_s_b, h_i_b, h_ip_b !: snow and ice volumes/thickness 343 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, sv_i_b, oa_i_b !: 344 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content 345 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures 346 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity 347 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total) 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: st_i !: Total ice salinity content (pss.m) 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content (J/m2) 334 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories (K) 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_s !: mean snw temperature over all categories (K) 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories (pss) 338 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories (K) 339 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_i !: mean ice thickness over all categories (m) 340 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_s !: mean snow thickness over all categories (m) 341 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories (s) 342 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction on ocean bottom (landfast param activated) 343 344 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 345 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow enthalpy [J/m2] 346 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 347 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice enthalpy [J/m2] 348 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSS] 349 350 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond concentration 351 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] 352 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond fraction (a_ip/a_i) 353 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_eff !: melt pond effective fraction (not covered up by lid) (a_ip/a_i) 354 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond depth [m] 355 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_il !: melt pond lid volume [m] 356 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_il !: melt pond lid thickness [m] 357 358 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond concentration 359 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_ip !: mean melt pond depth [m] 360 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per gridcell area [m] 361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_il !: mean melt pond lid depth [m] 362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_il !: total melt pond lid volume per gridcell area [m] 363 364 !!---------------------------------------------------------------------- 365 !! * Global variables at before time step 366 !!---------------------------------------------------------------------- 367 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 368 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, sv_i_b !: 369 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content 370 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures 371 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total) 348 373 349 374 !!---------------------------------------------------------------------- 350 375 !! * Ice thickness distribution variables 351 376 !!---------------------------------------------------------------------- 352 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max!: Boundary of ice thickness categories in thickness space353 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean!: Mean ice thickness in catgories377 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 378 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 354 379 ! 355 380 !!---------------------------------------------------------------------- 356 381 !! * Ice diagnostics 357 382 !!---------------------------------------------------------------------- 358 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume359 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume360 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy [W/m2]361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy [W/m2]362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_sv !: transport of salt content363 ! 364 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat !: snw/ice heat content variation [W/m2]365 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sice !: ice salt content variation []366 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vice !: ice volume variation [m/s]367 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s]368 383 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 384 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume 385 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy [W/m2] 386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy [W/m2] 387 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_sv !: transport of salt content 388 ! 389 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat !: snw/ice heat content variation [W/m2] 390 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sice !: ice salt content variation [] 391 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vice !: ice volume variation [m/s] 392 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s] 393 ! 369 394 !!---------------------------------------------------------------------- 370 395 !! * Ice conservation 371 396 !!---------------------------------------------------------------------- 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_v !: conservation of ice volume373 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_s !: conservation of ice salt374 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_t !: conservation of ice heat375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fv !: conservation of ice volume376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fs !: conservation of ice salt377 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_ft !: conservation of ice heat397 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_v !: conservation of ice volume 398 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_s !: conservation of ice salt 399 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_t !: conservation of ice heat 400 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fv !: conservation of ice volume 401 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fs !: conservation of ice salt 402 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_ft !: conservation of ice heat 378 403 ! 379 404 !!---------------------------------------------------------------------- … … 381 406 !!---------------------------------------------------------------------- 382 407 ! Extra sea ice diagnostics to address the data request 383 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_si !: Temperature at Snow-ice interface (K) 384 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_si !: mean temperature at the snow-ice interface (K) 385 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_bot !: Bottom conduction flux (W/m2) 386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_top !: Surface conduction flux (W/m2) 387 408 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_si !: Temperature at Snow-ice interface (K) 409 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_si !: mean temperature at the snow-ice interface (K) 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_bot !: Bottom conduction flux (W/m2) 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_top !: Surface conduction flux (W/m2) 388 412 ! 389 413 !!---------------------------------------------------------------------- … … 424 448 & hfx_sum (jpi,jpj) , hfx_bom (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , & 425 449 & hfx_opw (jpi,jpj) , hfx_thd (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , & 426 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) ,STAT=ierr(ii) )450 & hfx_err_dif(jpi,jpj) , wfx_err_sub(jpi,jpj) , STAT=ierr(ii) ) 427 451 428 452 ! * Ice global state variables … … 448 472 449 473 ii = ii + 1 450 ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl) , STAT = ierr(ii) ) 451 452 ii = ii + 1 453 ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 474 ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl), & 475 & v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 476 477 ii = ii + 1 478 ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , hm_il(jpi,jpj) , vt_il(jpi,jpj) , STAT = ierr(ii) ) 454 479 455 480 ! * Old values of global variables 456 481 ii = ii + 1 457 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl) , h_i_b(jpi,jpj,jpl), h_ip_b(jpi,jpj,jpl),&458 & a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , 459 & oa_i_b(jpi,jpj,jpl) ,STAT=ierr(ii) )482 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl) , h_i_b(jpi,jpj,jpl), & 483 & a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 484 & STAT=ierr(ii) ) 460 485 461 486 ii = ii + 1 … … 484 509 IF( ice_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' ) 485 510 ! 511 486 512 END FUNCTION ice_alloc 487 513 -
NEMO/trunk/src/ICE/ice1d.F90
r10786 r13472 51 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_snw_1d 52 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_dyn_1d 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d54 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_dif_1d 55 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qt_oce_ai_1d … … 124 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: oa_i_1d !: 125 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: o_i_1d !: 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_ip_1d !: 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_ip_1d !: ice ponds 127 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: v_ip_1d !: 128 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_ip_1d !: 129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_ip_frac_1d !: 128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: v_il_1d !: Ice pond lid 129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_il_1d !: 130 130 131 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_1d !: corresponding to the 2D var t_s … … 146 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sss_1d 147 147 148 ! convergence check 149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tice_cvgerr_1d !: convergence of ice/snow temp (dT) [K] 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tice_cvgstp_1d !: convergence of ice/snow temp (subtimestep) [-] 148 151 ! 149 152 !!---------------------- … … 157 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: a_ip_2d 158 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: v_ip_2d 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: v_il_2d 159 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_su_2d 160 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_i_2d … … 175 179 !!---------------------------------------------------------------------! 176 180 INTEGER :: ice1D_alloc ! return value 177 INTEGER :: ierr( 7), ii181 INTEGER :: ierr(8), ii 178 182 !!---------------------------------------------------------------------! 179 183 ierr(:) = 0 … … 189 193 & hfx_thd_1d(jpij) , hfx_spr_1d (jpij) , & 190 194 & hfx_snw_1d(jpij) , hfx_sub_1d (jpij) , & 191 & hfx_res_1d(jpij) , hfx_err_ rem_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) )195 & hfx_res_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 192 196 ! 193 197 ii = ii + 1 … … 208 212 & dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) , & 209 213 & dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , s_i_1d (jpij) , s_i_new (jpij) , & 210 & a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d (jpij) , v_s_1d (jpij) , 211 & h_i p_1d (jpij) , a_ip_frac_1d(jpij) ,&214 & a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d (jpij) , v_s_1d (jpij) , v_il_1d (jpij) , & 215 & h_il_1d (jpij) , h_ip_1d (jpij) , & 212 216 & sv_i_1d (jpij) , oa_i_1d (jpij) , o_i_1d (jpij) , STAT=ierr(ii) ) 213 217 ! … … 224 228 ! 225 229 ii = ii + 1 230 ALLOCATE( tice_cvgerr_1d(jpij) , tice_cvgstp_1d(jpij) , STAT=ierr(ii) ) 231 ! 232 ii = ii + 1 226 233 ALLOCATE( a_i_2d (jpij,jpl) , a_ib_2d(jpij,jpl) , h_i_2d (jpij,jpl) , h_ib_2d(jpij,jpl) , & 227 234 & v_i_2d (jpij,jpl) , v_s_2d (jpij,jpl) , oa_i_2d(jpij,jpl) , sv_i_2d(jpij,jpl) , & 228 & a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) , 235 & a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) , v_il_2d(jpij,jpl) , & 229 236 & STAT=ierr(ii) ) 230 237 -
NEMO/trunk/src/ICE/icealb.F90
r13295 r13472 14 14 !! ice_alb_init : initialisation of albedo computation 15 15 !!---------------------------------------------------------------------- 16 USE ice, ONLY: jpl ! sea-ice: number of categories17 16 USE phycst ! physical constants 18 17 USE dom_oce ! domain: ocean 18 USE ice, ONLY: jpl ! sea-ice: number of categories 19 USE icevar ! sea-ice: operations 19 20 ! 20 21 USE in_out_manager ! I/O manager … … 47 48 CONTAINS 48 49 49 SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, p alb_cs, palb_os)50 SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice ) 50 51 !!---------------------------------------------------------------------- 51 52 !! *** ROUTINE ice_alb *** … … 99 100 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pafrac_pnd ! melt pond relative fraction (per unit ice area) 100 101 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_pnd ! melt pond depth 101 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb_cs ! albedo of ice under clear sky 102 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb_os ! albedo of ice under overcast sky 103 ! 102 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pcloud_fra ! cloud fraction 103 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb_ice ! albedo of ice 104 ! 105 REAL(wp), DIMENSION(jpi,jpj,jpl) :: za_s_fra ! ice fraction covered by snow 104 106 INTEGER :: ji, jj, jl ! dummy loop indices 105 107 REAL(wp) :: z1_c1, z1_c2,z1_c3, z1_c4 ! local scalar … … 108 110 REAL(wp) :: zalb_ice, zafrac_ice ! bare sea ice albedo & relative ice fraction 109 111 REAL(wp) :: zalb_snw, zafrac_snw ! snow-covered sea ice albedo & relative snow fraction 112 REAL(wp) :: zalb_cs, zalb_os ! albedo of ice under clear/overcast sky 110 113 !!--------------------------------------------------------------------- 111 114 ! … … 118 121 z1_c4 = 1. / 0.03 119 122 ! 123 CALL ice_var_snwfra( ph_snw, za_s_fra ) ! calculate ice fraction covered by snow 124 ! 120 125 DO jl = 1, jpl 121 126 DO_2D( 1, 1, 1, 1 ) 122 ! !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time) 123 IF( ph_snw(ji,jj,jl) == 0._wp ) THEN 124 zafrac_snw = 0._wp 125 IF( ld_pnd_alb ) THEN 126 zafrac_pnd = pafrac_pnd(ji,jj,jl) 127 ELSE 128 zafrac_pnd = 0._wp 129 ENDIF 130 zafrac_ice = 1._wp - zafrac_pnd 127 ! 128 !---------------------------------------------! 129 !--- Specific snow, ice and pond fractions ---! 130 !---------------------------------------------! 131 zafrac_snw = za_s_fra(ji,jj,jl) 132 IF( ld_pnd_alb ) THEN 133 zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1 131 134 ELSE 132 zafrac_snw = 1._wp ! Snow fully "shades" melt ponds and ice133 135 zafrac_pnd = 0._wp 134 zafrac_ice = 0._wp 135 ENDIF 136 ! 136 ENDIF 137 zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors 138 ! 139 !---------------! 140 !--- Albedos ---! 141 !---------------! 137 142 ! !--- Bare ice albedo (for hi > 150cm) 138 143 IF( ld_pnd_alb ) THEN 139 144 zalb_ice = rn_alb_idry 140 145 ELSE 141 IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN ; zalb_ice = rn_alb_imlt142 ELSE ; zalb_ice = rn_alb_idry ; ENDIF146 IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN ; zalb_ice = rn_alb_imlt 147 ELSE ; zalb_ice = rn_alb_idry ; ENDIF 143 148 ENDIF 144 149 ! !--- Bare ice albedo (for hi < 150cm) … … 156 161 ENDIF 157 162 ! !--- Ponded ice albedo 158 IF( ld_pnd_alb ) THEN 159 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 160 ELSE 161 zalb_pnd = rn_alb_dpnd 162 ENDIF 163 zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd ) 164 ! 163 165 ! !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 164 palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 165 ! 166 palb_cs(ji,jj,jl) = palb_os(ji,jj,jl) & 167 & - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl) & 168 & + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 169 ! 166 zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 167 ! 168 zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os & 169 & + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 170 ! 171 ! albedo depends on cloud fraction because of non-linear spectral effects 172 palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 173 170 174 END_2D 171 175 END DO -
NEMO/trunk/src/ICE/icecor.F90
r13295 r13472 81 81 DO jl = 1, jpl 82 82 WHERE( at_i(:,:) > rn_amax_2d(:,:) ) a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 83 END DO 84 83 END DO 84 ! !----------------------------------------------------- 85 ! ! Rebin categories with thickness out of bounds ! 86 ! !----------------------------------------------------- 87 IF ( jpl > 1 ) CALL ice_itd_reb( kt ) 88 ! 85 89 ! !----------------------------------------------------- 86 90 IF ( nn_icesal == 2 ) THEN ! salinity must stay in bounds [Simin,Simax] ! … … 95 99 END DO 96 100 ENDIF 97 ! !-----------------------------------------------------98 ! ! Rebin categories with thickness out of bounds !99 ! !-----------------------------------------------------100 IF ( jpl > 1 ) CALL ice_itd_reb( kt )101 102 101 ! !----------------------------------------------------- 103 102 CALL ice_var_zapsmall ! Zap small values ! -
NEMO/trunk/src/ICE/icectl.F90
r13295 r13472 350 350 !! *** ROUTINE ice_ctl *** 351 351 !! 352 !! ** Purpose : Alerts in case of model crash352 !! ** Purpose : control checks 353 353 !!------------------------------------------------------------------- 354 354 INTEGER, INTENT(in) :: kt ! ocean time step 355 INTEGER :: ji, jj, jk, jl ! dummy loop indices 356 INTEGER :: inb_altests ! number of alert tests (max 20) 357 INTEGER :: ialert_id ! number of the current alert 358 REAL(wp) :: ztmelts ! ice layer melting point 355 INTEGER :: ja, ji, jj, jk, jl ! dummy loop indices 356 INTEGER :: ialert_id ! number of the current alert 357 REAL(wp) :: ztmelts ! ice layer melting point 359 358 CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert 360 359 INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive 361 360 !!------------------------------------------------------------------- 362 363 inb_altests = 10 364 inb_alp(:) = 0 365 366 ! Alert if incompatible volume and concentration 367 ialert_id = 2 ! reference number of this alert 368 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 361 inb_alp(:) = 0 362 ialert_id = 0 363 364 ! Alert if very high salinity 365 ialert_id = ialert_id + 1 ! reference number of this alert 366 cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 369 367 DO jl = 1, jpl 370 368 DO_2D( 1, 1, 1, 1 ) 371 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 372 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 373 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 369 IF( v_i(ji,jj,jl) > epsi10 ) THEN 370 IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 371 WRITE(numout,*) ' ALERTE : Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 372 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 373 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 374 ENDIF 374 375 ENDIF 375 376 END_2D 376 377 END DO 377 378 378 ! Alerte if very thick ice 379 ialert_id = 3 ! reference number of this alert 380 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 381 jl = jpl 382 DO_2D( 1, 1, 1, 1 ) 383 IF( h_i(ji,jj,jl) > 50._wp ) THEN 384 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 385 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 386 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 387 ENDIF 388 END_2D 389 390 ! Alert if very fast ice 391 ialert_id = 4 ! reference number of this alert 392 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 393 DO_2D( 1, 1, 1, 1 ) 394 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 395 & at_i(ji,jj) > 0._wp ) THEN 396 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 397 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 398 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 399 ENDIF 400 END_2D 401 402 ! Alert on salt flux 403 ialert_id = 5 ! reference number of this alert 404 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 405 DO_2D( 1, 1, 1, 1 ) 406 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 407 WRITE(numout,*) ' ALERTE 5 : High salt flux' 408 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 409 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 410 ENDIF 411 END_2D 412 413 ! Alert if there is ice on continents 414 ialert_id = 6 ! reference number of this alert 415 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 416 DO_2D( 1, 1, 1, 1 ) 417 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 418 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 419 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 420 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 421 ENDIF 422 END_2D 423 424 ! 425 ! ! Alert if very fresh ice 426 ialert_id = 7 ! reference number of this alert 427 cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert 379 ! Alert if very low salinity 380 ialert_id = ialert_id + 1 ! reference number of this alert 381 cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 428 382 DO jl = 1, jpl 429 383 DO_2D( 1, 1, 1, 1 ) 430 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 431 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 432 ! CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 433 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 384 IF( v_i(ji,jj,jl) > epsi10 ) THEN 385 IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 386 WRITE(numout,*) ' ALERTE : Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 387 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 388 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 389 ENDIF 434 390 ENDIF 435 391 END_2D 436 392 END DO 437 ! 438 ! Alert if qns very big 439 ialert_id = 8 ! reference number of this alert 440 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 441 DO_2D( 1, 1, 1, 1 ) 442 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 443 ! 444 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 445 !CALL ice_prt( kt, ji, jj, 2, ' ') 446 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 447 ! 448 ENDIF 449 END_2D 450 !+++++ 451 452 ! ! Alert if too old ice 453 ialert_id = 9 ! reference number of this alert 454 cl_alname(ialert_id) = ' Very old ice ' ! name of the alert 455 DO jl = 1, jpl 456 DO_2D( 1, 1, 1, 1 ) 457 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rDt_ice ) .OR. & 458 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 459 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 460 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 461 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 462 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 463 ENDIF 464 END_2D 465 END DO 466 467 ! Alert if very warm ice 468 ialert_id = 10 ! reference number of this alert 469 cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 470 inb_alp(ialert_id) = 0 393 394 ! Alert if very cold ice 395 ialert_id = ialert_id + 1 ! reference number of this alert 396 cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 471 397 DO jl = 1, jpl 472 398 DO_3D( 1, 1, 1, 1, 1, nlay_i ) 473 399 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 474 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 &475 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN476 WRITE(numout,*) ' ALERTE 10 : Very warm ice'400 IF( t_i(ji,jj,jk,jl) < -50.+rt0 .AND. v_i(ji,jj,jl) > epsi10 ) THEN 401 WRITE(numout,*) ' ALERTE : Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 402 WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 477 403 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 478 404 ENDIF 479 405 END_3D 480 406 END DO 407 408 ! Alert if very warm ice 409 ialert_id = ialert_id + 1 ! reference number of this alert 410 cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 411 DO jl = 1, jpl 412 DO_3D( 1, 1, 1, 1, 1, nlay_i ) 413 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 414 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > epsi10 ) THEN 415 WRITE(numout,*) ' ALERTE : Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 416 WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 417 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 418 ENDIF 419 END_3D 420 END DO 421 422 ! Alerte if very thick ice 423 ialert_id = ialert_id + 1 ! reference number of this alert 424 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 425 jl = jpl 426 DO_2D( 1, 1, 1, 1 ) 427 IF( h_i(ji,jj,jl) > 50._wp ) THEN 428 WRITE(numout,*) ' ALERTE : Very thick ice ',h_i(ji,jj,jl) 429 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 430 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 431 ENDIF 432 END_2D 433 434 ! Alerte if very thin ice 435 ialert_id = ialert_id + 1 ! reference number of this alert 436 cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 437 jl = 1 438 DO_2D( 1, 1, 1, 1 ) 439 IF( h_i(ji,jj,jl) < rn_himin ) THEN 440 WRITE(numout,*) ' ALERTE : Very thin ice ',h_i(ji,jj,jl) 441 WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 442 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 443 ENDIF 444 END_2D 445 446 ! Alert if very fast ice 447 ialert_id = ialert_id + 1 ! reference number of this alert 448 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 449 DO_2D( 1, 1, 1, 1 ) 450 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 451 WRITE(numout,*) ' ALERTE : Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 452 WRITE(numout,*) ' at i,j = ',ji,jj 453 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 454 ENDIF 455 END_2D 456 457 ! Alert if there is ice on continents 458 ialert_id = ialert_id + 1 ! reference number of this alert 459 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 460 DO_2D( 1, 1, 1, 1 ) 461 IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 462 WRITE(numout,*) ' ALERTE : Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 463 WRITE(numout,*) ' at i,j = ',ji,jj 464 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 465 ENDIF 466 END_2D 467 468 ! Alert if incompatible ice concentration and volume 469 ialert_id = ialert_id + 1 ! reference number of this alert 470 cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 471 DO_2D( 1, 1, 1, 1 ) 472 IF( ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. & 473 & ( vt_i(ji,jj) > 0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 474 WRITE(numout,*) ' ALERTE : Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 475 WRITE(numout,*) ' at i,j = ',ji,jj 476 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 477 ENDIF 478 END_2D 481 479 482 480 ! sum of the alerts on all processors 483 481 IF( lk_mpp ) THEN 484 DO ialert_id = 1, inb_altests485 CALL mpp_sum('icectl', inb_alp( ialert_id))482 DO ja = 1, ialert_id 483 CALL mpp_sum('icectl', inb_alp(ja)) 486 484 END DO 487 485 ENDIF … … 489 487 ! print alerts 490 488 IF( lwp ) THEN 491 ialert_id = 1 ! reference number of this alert492 cl_alname(ialert_id) = ' NO alerte 1 ' ! name of the alert493 489 WRITE(numout,*) ' time step ',kt 494 490 WRITE(numout,*) ' All alerts at the end of ice model ' 495 DO ialert_id = 1, inb_altests496 WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '491 DO ja = 1, ialert_id 492 WRITE(numout,*) ja, cl_alname(ja)//' : ', inb_alp(ja), ' times ! ' 497 493 END DO 498 494 ENDIF … … 543 539 WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj) 544 540 WRITE(numout,*) ' strength : ', strength(ji,jj) 545 WRITE(numout,*)546 541 WRITE(numout,*) ' - Cell values ' 547 542 WRITE(numout,*) ' ~~~~~~~~~~~ ' … … 552 547 DO jl = 1, jpl 553 548 WRITE(numout,*) ' - Category (', jl,')' 549 WRITE(numout,*) ' ~~~~~~~~~~~ ' 554 550 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) 555 551 WRITE(numout,*) ' h_i : ', h_i(ji,jj,jl) … … 588 584 WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj) 589 585 WRITE(numout,*) ' strength : ', strength(ji,jj) 590 WRITE(numout,*) ' u_ice_b : ', u_ice_b(ji,jj) , ' v_ice_b : ', v_ice_b(ji,jj)591 586 WRITE(numout,*) 592 587 … … 605 600 WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl) 606 601 WRITE(numout,*) ' sv_i : ', sv_i(ji,jj,jl) , ' sv_i_b : ', sv_i_b(ji,jj,jl) 607 WRITE(numout,*) ' oa_i : ', oa_i(ji,jj,jl) , ' oa_i_b : ', oa_i_b(ji,jj,jl)608 602 END DO !jl 609 603 … … 713 707 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' v_i : ') 714 708 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' v_s : ') 715 CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' e_i1 : ')716 709 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' e_snow : ') 717 710 CALL prt_ctl(tab2d_1=sv_i (:,:,jl) , clinfo1= ' sv_i : ') … … 721 714 CALL prt_ctl_info(' - Layer : ', ivar=jk) 722 715 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i : ') 716 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' e_i : ') 723 717 END DO 724 718 END DO -
NEMO/trunk/src/ICE/icedyn.F90
r13295 r13472 100 100 WHERE( a_ip(:,:,:) >= epsi20 ) 101 101 h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 102 h_il(:,:,:) = v_il(:,:,:) / a_ip(:,:,:) 102 103 ELSEWHERE 103 104 h_ip(:,:,:) = 0._wp 105 h_il(:,:,:) = 0._wp 104 106 END WHERE 105 107 ! … … 127 129 ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 128 130 DO_2D( 1, 1, 1, 1 ) 129 zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1.)130 zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1.)131 u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1.0_wp, zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1)132 v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1.0_wp, zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1)131 zcoefu = ( REAL(jpiglo+1)*0.5_wp - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5_wp - 1._wp ) 132 zcoefv = ( REAL(jpjglo+1)*0.5_wp - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5_wp - 1._wp ) 133 u_ice(ji,jj) = rn_uice * 1.5_wp * SIGN( 1.0_wp, zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 134 v_ice(ji,jj) = rn_vice * 1.5_wp * SIGN( 1.0_wp, zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 133 135 END_2D 134 136 ! --- … … 218 220 NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice, & 219 221 & rn_ishlat , & 220 & ln_landfast_L16, rn_ depfra, rn_icebfr, rn_lfrelax, rn_tensile222 & ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile 221 223 !!------------------------------------------------------------------- 222 224 ! … … 239 241 WRITE(numout,*) ' lateral boundary condition for sea ice dynamics rn_ishlat = ', rn_ishlat 240 242 WRITE(numout,*) ' Landfast: param from Lemieux 2016 ln_landfast_L16 = ', ln_landfast_L16 241 WRITE(numout,*) ' fraction of ocean depth that ice must reach rn_ depfra = ', rn_depfra242 WRITE(numout,*) ' maximum bottom stress per unit area of contact rn_ icebfr = ', rn_icebfr243 WRITE(numout,*) ' relax time scale (s-1) to reach static friction rn_lf relax = ', rn_lfrelax244 WRITE(numout,*) ' isotropic tensile strength rn_ tensile = ', rn_tensile243 WRITE(numout,*) ' fraction of ocean depth that ice must reach rn_lf_depfra = ', rn_lf_depfra 244 WRITE(numout,*) ' maximum bottom stress per unit area of contact rn_lf_bfr = ', rn_lf_bfr 245 WRITE(numout,*) ' relax time scale (s-1) to reach static friction rn_lf_relax = ', rn_lf_relax 246 WRITE(numout,*) ' isotropic tensile strength rn_lf_tensile = ', rn_lf_tensile 245 247 WRITE(numout,*) 246 248 ENDIF -
NEMO/trunk/src/ICE/icedyn_adv.F90
r12489 r13472 82 82 ! !-----------------------! 83 83 CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, & 84 & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )84 & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 85 85 ! !-----------------------! 86 86 CASE( np_advPRA ) ! PRATHER scheme ! 87 87 ! !-----------------------! 88 88 CALL ice_dyn_adv_pra( kt, u_ice, v_ice, h_i, h_s, h_ip, & 89 & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )89 & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 90 90 END SELECT 91 91 -
NEMO/trunk/src/ICE/icedyn_adv_pra.F90
r13295 r13472 44 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxap , syap , sxxap , syyap , sxyap ! melt pond fraction 45 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvp , syvp , sxxvp , syyvp , sxyvp ! melt pond volume 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvl , syvl , sxxvl , syyvl , sxyvl ! melt pond lid volume 46 47 47 48 !! * Substitutions … … 55 56 56 57 SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, & 57 & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, p e_s, pe_i )58 & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 58 59 !!---------------------------------------------------------------------- 59 60 !! ** routine ice_dyn_adv_pra ** … … 81 82 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 82 83 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 84 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid thickness 83 85 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content 84 86 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content 85 87 ! 86 INTEGER :: ji, jj, jk, jl, jt! dummy loop indices88 INTEGER :: ji, jj, jk, jl, jt ! dummy loop indices 87 89 INTEGER :: icycle ! number of sub-timestep for the advection 88 90 REAL(wp) :: zdt ! - - … … 90 92 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 91 93 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx 92 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 94 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max, zs_i, zsi_max 95 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i, zei_max 96 REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s, zes_max 93 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zarea 94 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ice, z0snw, z0ai, z0smi, z0oi 95 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ap , z0vp 99 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ap , z0vp, z0vl 96 100 REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: z0es 97 101 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: z0ei … … 100 104 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 101 105 ! 102 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 106 ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 107 ! thickness and salinity 108 WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 109 ELSEWHERE ; zs_i(:,:,:) = 0._wp 110 END WHERE 103 111 DO jl = 1, jpl 104 112 DO_2D( 0, 0, 0, 0 ) … … 115 123 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 116 124 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 125 zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj ,jl), zs_i (ji ,jj+1,jl), & 126 & zs_i (ji-1,jj ,jl), zs_i (ji ,jj-1,jl), & 127 & zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 128 & zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 117 129 END_2D 118 130 END DO 119 CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 131 CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 132 ! 133 ! enthalpies 134 DO jk = 1, nlay_i 135 WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 136 ELSEWHERE ; ze_i(:,:,jk,:) = 0._wp 137 END WHERE 138 END DO 139 DO jk = 1, nlay_s 140 WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 141 ELSEWHERE ; ze_s(:,:,jk,:) = 0._wp 142 END WHERE 143 END DO 144 DO jl = 1, jpl 145 DO_3D( 0, 0, 0, 0, 1, nlay_i ) 146 zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj ,jk,jl), ze_i(ji ,jj+1,jk,jl), & 147 & ze_i(ji-1,jj ,jk,jl), ze_i(ji ,jj-1,jk,jl), & 148 & ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 149 & ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 150 END_3D 151 END DO 152 DO jl = 1, jpl 153 DO_3D( 0, 0, 0, 0, 1, nlay_s ) 154 zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj ,jk,jl), ze_s(ji ,jj+1,jk,jl), & 155 & ze_s(ji-1,jj ,jk,jl), ze_s(ji ,jj-1,jk,jl), & 156 & ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 157 & ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 158 END_3D 159 END DO 160 CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 161 CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1. ) 162 ! 120 163 ! 121 164 ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! … … 156 199 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 157 200 END DO 158 IF ( ln_pnd_H12 ) THEN 159 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 160 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 201 IF ( ln_pnd_LEV ) THEN 202 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 203 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume 204 IF ( ln_pnd_lids ) THEN 205 z0vl(:,:,jl) = pv_il(:,:,jl) * e1e2t(:,:) ! Melt pond lid volume 206 ENDIF 161 207 ENDIF 162 208 END DO … … 189 235 END DO 190 236 ! 191 IF ( ln_pnd_ H12) THEN237 IF ( ln_pnd_LEV ) THEN 192 238 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 193 239 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 194 240 CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 195 241 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 242 IF ( ln_pnd_lids ) THEN 243 CALL adv_x( zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 244 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 245 ENDIF 196 246 ENDIF 197 247 ! !--------------------------------------------! … … 220 270 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 221 271 END DO 222 IF ( ln_pnd_ H12) THEN272 IF ( ln_pnd_LEV ) THEN 223 273 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 224 274 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 225 275 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 226 276 CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 227 ENDIF 277 IF ( ln_pnd_lids ) THEN 278 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 279 CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 280 ENDIF 281 ENDIF 228 282 ! 229 283 ENDIF … … 242 296 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 243 297 END DO 244 IF ( ln_pnd_ H12) THEN298 IF ( ln_pnd_LEV ) THEN 245 299 pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 246 300 pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 301 IF ( ln_pnd_lids ) THEN 302 pv_il(:,:,jl) = z0vl(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 303 ENDIF 247 304 ENDIF 248 305 END DO … … 259 316 ! Remove negative values (conservation is ensured) 260 317 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 261 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, p e_s, pe_i )318 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 262 319 ! 263 320 ! --- Make sure ice thickness is not too big --- ! 264 321 ! (because ice thickness can be too large where ice concentration is very small) 265 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 322 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & 323 & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 266 324 ! 267 325 ! --- Ensure snow load is not too big --- ! … … 591 649 592 650 593 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 651 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 652 & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 594 653 !!------------------------------------------------------------------- 595 654 !! *** ROUTINE Hbig *** … … 605 664 !! ** input : Max thickness of the surrounding 9-points 606 665 !!------------------------------------------------------------------- 607 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 608 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max ! max ice thick from surrounding 9-pts 609 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip 666 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 667 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts 668 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pes_max 669 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pei_max 670 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 610 671 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 611 ! 612 INTEGER :: ji, jj, jl ! dummy loop indices 613 REAL(wp) :: z1_dt, zhip, zhi, zhs, zfra 672 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i 673 ! 674 INTEGER :: ji, jj, jk, jl ! dummy loop indices 675 REAL(wp) :: z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 614 676 !!------------------------------------------------------------------- 615 677 ! … … 617 679 ! 618 680 DO jl = 1, jpl 619 620 681 DO_2D( 1, 1, 1, 1 ) 621 682 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN … … 623 684 ! ! -- check h_ip -- ! 624 685 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 625 IF( ln_pnd_ H12.AND. pv_ip(ji,jj,jl) > 0._wp ) THEN686 IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 626 687 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 627 688 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN … … 650 711 ENDIF 651 712 ! 713 ! ! -- check s_i -- ! 714 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 715 zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 716 IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 717 zfra = psi_max(ji,jj,jl) / zsi 718 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 719 psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 720 ENDIF 721 ! 652 722 ENDIF 653 723 END_2D 654 724 END DO 725 ! 726 ! ! -- check e_i/v_i -- ! 727 DO jl = 1, jpl 728 DO_3D( 1, 1, 1, 1, 1, nlay_i ) 729 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 730 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 731 zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 732 IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 733 zfra = pei_max(ji,jj,jk,jl) / zei 734 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 735 pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 736 ENDIF 737 ENDIF 738 END_3D 739 END DO 740 ! ! -- check e_s/v_s -- ! 741 DO jl = 1, jpl 742 DO_3D( 1, 1, 1, 1, 1, nlay_s ) 743 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 744 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 745 zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 746 IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 747 zfra = pes_max(ji,jj,jk,jl) / zes 748 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 749 pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 750 ENDIF 751 ENDIF 752 END_3D 753 END DO 655 754 ! 656 755 END SUBROUTINE Hbig … … 724 823 & sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) , & 725 824 & sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) , & 726 & sxap(jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) , & 727 & sxvp(jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) , & 825 & sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) , & 826 & sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) , & 827 & sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) , & 728 828 ! 729 829 & sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , & … … 820 920 END DO 821 921 ! 822 IF( ln_pnd_H12 ) THEN ! melt pond fraction 823 CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap ) 824 CALL iom_get( numrir, jpdom_auto, 'syap' , syap ) 825 CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap ) 826 CALL iom_get( numrir, jpdom_auto, 'syyap', syyap ) 827 CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap ) 828 ! ! melt pond volume 829 CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp ) 830 CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp ) 831 CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp ) 832 CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp ) 833 CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp ) 922 IF( ln_pnd_LEV ) THEN ! melt pond fraction 923 IF( iom_varid( numror, 'sxap', ldstop = .FALSE. ) > 0 ) THEN 924 CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap ) 925 CALL iom_get( numrir, jpdom_auto, 'syap' , syap ) 926 CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap ) 927 CALL iom_get( numrir, jpdom_auto, 'syyap', syyap ) 928 CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap ) 929 ! ! melt pond volume 930 CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp ) 931 CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp ) 932 CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp ) 933 CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp ) 934 CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp ) 935 ELSE 936 sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction 937 sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume 938 ENDIF 939 ! 940 IF ( ln_pnd_lids ) THEN ! melt pond lid volume 941 IF( iom_varid( numror, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN 942 CALL iom_get( numrir, jpdom_auto, 'sxvl' , sxvl ) 943 CALL iom_get( numrir, jpdom_auto, 'syvl' , syvl ) 944 CALL iom_get( numrir, jpdom_auto, 'sxxvl', sxxvl ) 945 CALL iom_get( numrir, jpdom_auto, 'syyvl', syyvl ) 946 CALL iom_get( numrir, jpdom_auto, 'sxyvl', sxyvl ) 947 ELSE 948 sxvl = 0._wp; syvl = 0._wp ; sxxvl = 0._wp ; syyvl = 0._wp ; sxyvl = 0._wp ! melt pond lid volume 949 ENDIF 950 ENDIF 834 951 ENDIF 835 952 ! … … 845 962 sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow layers heat content 846 963 sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content 847 IF( ln_pnd_H12 ) THEN 848 sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction 849 sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume 964 IF( ln_pnd_LEV ) THEN 965 sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction 966 sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume 967 IF ( ln_pnd_lids ) THEN 968 sxvl = 0._wp; syvl = 0._wp ; sxxvl = 0._wp ; syyvl = 0._wp ; sxyvl = 0._wp ! melt pond lid volume 969 ENDIF 850 970 ENDIF 851 971 ENDIF … … 910 1030 END DO 911 1031 ! 912 IF( ln_pnd_ H12) THEN ! melt pond fraction1032 IF( ln_pnd_LEV ) THEN ! melt pond fraction 913 1033 CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap ) 914 1034 CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap ) … … 922 1042 CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) 923 1043 CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) 1044 ! 1045 IF ( ln_pnd_lids ) THEN ! melt pond lid volume 1046 CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl ) 1047 CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl ) 1048 CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl ) 1049 CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl ) 1050 CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl ) 1051 ENDIF 924 1052 ENDIF 925 1053 ! -
NEMO/trunk/src/ICE/icedyn_adv_umx.F90
r13295 r13472 60 60 61 61 SUBROUTINE ice_dyn_adv_umx( kn_umx, kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, & 62 & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, p e_s, pe_i )62 & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 63 63 !!---------------------------------------------------------------------- 64 64 !! *** ROUTINE ice_dyn_adv_umx *** … … 85 85 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond concentration 86 86 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 87 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume 87 88 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content 88 89 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content … … 92 93 REAL(wp) :: zamsk ! 1 if advection of concentration, 0 if advection of other tracers 93 94 REAL(wp) :: zdt, zvi_cen 94 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 95 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 96 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups 99 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar 100 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 95 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 96 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 97 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat 99 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups 100 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar 101 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max, zs_i, zsi_max 102 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i, zei_max 103 REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s, zes_max 101 104 ! 102 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs … … 105 108 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' 106 109 ! 107 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 110 ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 111 ! thickness and salinity 112 WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 113 ELSEWHERE ; zs_i(:,:,:) = 0._wp 114 END WHERE 108 115 DO jl = 1, jpl 109 116 DO_2D( 0, 0, 0, 0 ) … … 120 127 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 121 128 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 122 END_2D 123 END DO 124 CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 129 zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj ,jl), zs_i (ji ,jj+1,jl), & 130 & zs_i (ji-1,jj ,jl), zs_i (ji ,jj-1,jl), & 131 & zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 132 & zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 133 END_2D 134 END DO 135 CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 136 ! 137 ! enthalpies 138 DO jk = 1, nlay_i 139 WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 140 ELSEWHERE ; ze_i(:,:,jk,:) = 0._wp 141 END WHERE 142 END DO 143 DO jk = 1, nlay_s 144 WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 145 ELSEWHERE ; ze_s(:,:,jk,:) = 0._wp 146 END WHERE 147 END DO 148 DO jl = 1, jpl 149 DO_3D( 0, 0, 0, 0, 1, nlay_i ) 150 zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj ,jk,jl), ze_i(ji ,jj+1,jk,jl), & 151 & ze_i(ji-1,jj ,jk,jl), ze_i(ji ,jj-1,jk,jl), & 152 & ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 153 & ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 154 END_3D 155 END DO 156 DO jl = 1, jpl 157 DO_3D( 0, 0, 0, 0, 1, nlay_s ) 158 zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj ,jk,jl), ze_s(ji ,jj+1,jk,jl), & 159 & ze_s(ji-1,jj ,jk,jl), ze_s(ji ,jj-1,jk,jl), & 160 & ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 161 & ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 162 END_3D 163 END DO 164 CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 165 CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1. ) 125 166 ! 126 167 ! … … 318 359 ! 319 360 !== melt ponds ==! 320 IF ( ln_pnd_ H12) THEN361 IF ( ln_pnd_LEV ) THEN 321 362 ! concentration 322 363 zamsk = 1._wp … … 328 369 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 329 370 & zhvar, pv_ip, zua_ups, zva_ups ) 371 ! lid 372 IF ( ln_pnd_lids ) THEN 373 zamsk = 0._wp 374 zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) 375 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 376 & zhvar, pv_il, zua_ups, zva_ups ) 377 ENDIF 330 378 ENDIF 331 379 ! … … 342 390 ! Remove negative values (conservation is ensured) 343 391 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 344 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, p e_s, pe_i )392 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 345 393 ! 346 394 ! --- Make sure ice thickness is not too big --- ! 347 395 ! (because ice thickness can be too large where ice concentration is very small) 348 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 396 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & 397 & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 349 398 ! 350 399 ! --- Ensure snow load is not too big --- ! … … 1409 1458 1410 1459 1411 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 1460 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 1461 & pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 1412 1462 !!------------------------------------------------------------------- 1413 1463 !! *** ROUTINE Hbig *** … … 1423 1473 !! ** input : Max thickness of the surrounding 9-points 1424 1474 !!------------------------------------------------------------------- 1425 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 1426 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max ! max ice thick from surrounding 9-pts 1427 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip 1475 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 1476 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max, psi_max ! max ice thick from surrounding 9-pts 1477 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pes_max 1478 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pei_max 1479 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 1428 1480 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 1429 ! 1430 INTEGER :: ji, jj, jl ! dummy loop indices 1431 REAL(wp) :: z1_dt, zhip, zhi, zhs, zfra 1481 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i 1482 ! 1483 INTEGER :: ji, jj, jk, jl ! dummy loop indices 1484 REAL(wp) :: z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 1432 1485 !!------------------------------------------------------------------- 1433 1486 ! … … 1435 1488 ! 1436 1489 DO jl = 1, jpl 1437 1438 1490 DO_2D( 1, 1, 1, 1 ) 1439 1491 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN … … 1441 1493 ! ! -- check h_ip -- ! 1442 1494 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 1443 IF( ln_pnd_ H12.AND. pv_ip(ji,jj,jl) > 0._wp ) THEN1495 IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 1444 1496 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 1445 1497 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN … … 1468 1520 ENDIF 1469 1521 ! 1522 ! ! -- check s_i -- ! 1523 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 1524 zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 1525 IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1526 zfra = psi_max(ji,jj,jl) / zsi 1527 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 1528 psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 1529 ENDIF 1530 ! 1470 1531 ENDIF 1471 1532 END_2D 1472 1533 END DO 1534 ! 1535 ! ! -- check e_i/v_i -- ! 1536 DO jl = 1, jpl 1537 DO_3D( 1, 1, 1, 1, 1, nlay_i ) 1538 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1539 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 1540 zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 1541 IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1542 zfra = pei_max(ji,jj,jk,jl) / zei 1543 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1544 pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 1545 ENDIF 1546 ENDIF 1547 END_3D 1548 END DO 1549 ! ! -- check e_s/v_s -- ! 1550 DO jl = 1, jpl 1551 DO_3D( 1, 1, 1, 1, 1, nlay_s ) 1552 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 1553 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 1554 zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 1555 IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 1556 zfra = pes_max(ji,jj,jk,jl) / zes 1557 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1558 pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 1559 ENDIF 1560 ENDIF 1561 END_3D 1562 END DO 1473 1563 ! 1474 1564 END SUBROUTINE Hbig -
NEMO/trunk/src/ICE/icedyn_rdgrft.F90
r13295 r13472 502 502 REAL(wp) :: airdg1, oirdg1, aprdg1, virdg1, sirdg1 503 503 REAL(wp) :: airft1, oirft1, aprft1 504 REAL(wp), DIMENSION(jpij) :: airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg ! area etc of new ridges505 REAL(wp), DIMENSION(jpij) :: airft2, oirft2, aprft2, virft , sirft , vsrft, vprft ! area etc of rafted ice504 REAL(wp), DIMENSION(jpij) :: airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg ! area etc of new ridges 505 REAL(wp), DIMENSION(jpij) :: airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft ! area etc of rafted ice 506 506 ! 507 507 REAL(wp), DIMENSION(jpij) :: ersw ! enth of water trapped into ridges … … 573 573 oirft2(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft 574 574 575 IF ( ln_pnd_ H12) THEN575 IF ( ln_pnd_LEV ) THEN 576 576 aprdg1 = a_ip_2d(ji,jl1) * afrdg 577 577 aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) … … 580 580 aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 581 581 vprft (ji) = v_ip_2d(ji,jl1) * afrft 582 IF ( ln_pnd_lids ) THEN 583 vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 584 vlrft (ji) = v_il_2d(ji,jl1) * afrft 585 ENDIF 582 586 ENDIF 583 587 … … 606 610 sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1 - sirft(ji) 607 611 oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1 - oirft1 608 IF ( ln_pnd_ H12) THEN612 IF ( ln_pnd_LEV ) THEN 609 613 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1 - aprft1 610 614 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 615 IF ( ln_pnd_lids ) THEN 616 v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 617 ENDIF 611 618 ENDIF 612 619 ENDIF … … 700 707 v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji) + & 701 708 & vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 702 IF ( ln_pnd_ H12) THEN709 IF ( ln_pnd_LEV ) THEN 703 710 v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg (ji) * rn_fpndrdg * fvol (ji) & 704 711 & + vprft (ji) * rn_fpndrft * zswitch(ji) ) 705 712 a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + ( aprdg2(ji) * rn_fpndrdg * farea & 706 713 & + aprft2(ji) * rn_fpndrft * zswitch(ji) ) 714 IF ( ln_pnd_lids ) THEN 715 v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + ( vlrdg(ji) * rn_fpndrdg * fvol (ji) & 716 & + vlrft(ji) * rn_fpndrft * zswitch(ji) ) 717 ENDIF 707 718 ENDIF 708 719 … … 735 746 !---------------- 736 747 ! In case ridging/rafting lead to very small negative values (sometimes it happens) 737 CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d )748 CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 738 749 ! 739 750 END SUBROUTINE rdgrft_shift … … 841 852 CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 842 853 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 854 CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 843 855 DO jl = 1, jpl 844 856 DO jk = 1, nlay_s … … 867 879 CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 868 880 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 881 CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 869 882 DO jl = 1, jpl 870 883 DO jk = 1, nlay_s -
NEMO/trunk/src/ICE/icedyn_rhg.F90
r12377 r13472 108 108 INTEGER :: ios, ioptio ! Local integer output status for namelist read 109 109 !! 110 NAMELIST/namdyn_rhg/ ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast 110 NAMELIST/namdyn_rhg/ ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg 111 111 !!------------------------------------------------------------------- 112 112 ! … … 122 122 WRITE(numout,*) '~~~~~~~~~~~~~~~' 123 123 WRITE(numout,*) ' Namelist : namdyn_rhg:' 124 WRITE(numout,*) ' rheology EVP (icedyn_rhg_evp) ln_rhg_EVP = ', ln_rhg_EVP 125 WRITE(numout,*) ' use adaptive EVP (aEVP) ln_aEVP = ', ln_aEVP 126 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 127 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 128 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 129 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 124 WRITE(numout,*) ' rheology EVP (icedyn_rhg_evp) ln_rhg_EVP = ', ln_rhg_EVP 125 WRITE(numout,*) ' use adaptive EVP (aEVP) ln_aEVP = ', ln_aEVP 126 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 127 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 128 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 129 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 130 WRITE(numout,*) ' check convergence of rheology nn_rhg_chkcvg = ', nn_rhg_chkcvg 131 IF ( nn_rhg_chkcvg == 0 ) THEN ; WRITE(numout,*) ' no check' 132 ELSEIF( nn_rhg_chkcvg == 1 ) THEN ; WRITE(numout,*) ' check cvg at the main time step' 133 ELSEIF( nn_rhg_chkcvg == 2 ) THEN ; WRITE(numout,*) ' check cvg at both main and rheology time steps' 134 ENDIF 130 135 ENDIF 131 136 ! -
NEMO/trunk/src/ICE/icedyn_rhg_evp.F90
r13461 r13472 41 41 USE prtctl ! Print control 42 42 43 USE netcdf ! NetCDF library for convergence test 43 44 IMPLICIT NONE 44 45 PRIVATE … … 50 51 # include "do_loop_substitute.h90" 51 52 # include "domzgr_substitute.h90" 53 54 !! for convergence tests 55 INTEGER :: ncvgid ! netcdf file id 56 INTEGER :: nvarid ! netcdf variable id 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmsk00, zmsk15 52 58 !!---------------------------------------------------------------------- 53 59 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 121 127 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity 122 128 REAL(wp) :: zalph1, z1_alph1, zalph2, z1_alph2 ! alpha coef from Bouillon 2009 or Kimmritz 2017 129 REAl(wp) :: zbetau, zbetav 123 130 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV, zvU, zvV ! ice/snow mass and volume 124 131 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars … … 127 134 REAL(wp) :: zvCr ! critical ice volume above which ice is landfast 128 135 ! 129 REAL(wp) :: zresm ! Maximal error on ice velocity130 136 REAL(wp) :: zintb, zintn ! dummy argument 131 137 REAL(wp) :: zfac_x, zfac_y … … 143 149 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear 144 150 REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components 145 !!$ REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! check convergence146 151 REAL(wp), DIMENSION(jpi,jpj) :: zsshdyn ! array used for the calculation of ice surface slope: 147 152 ! ! ocean surface (ssh_m) if ice is not embedded … … 162 167 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity becomes very small 163 168 REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small 169 !! --- check convergence 170 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice 164 171 !! --- diags 165 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00166 172 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig1, zsig2, zsig3 167 173 !! --- SIMIP diags … … 176 182 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology' 177 183 ! 178 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 184 ! for diagnostics and convergence tests 185 ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 186 DO_2D( 1, 1, 1, 1 ) 187 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 188 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 189 END_2D 190 ! 191 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 179 192 !------------------------------------------------------------------------------! 180 193 ! 0) mask at F points for the ice … … 220 233 z1_ecc2 = 1._wp / ecc2 221 234 222 ! Time step for subcycling223 zdtevp = rDt_ice / REAL( nn_nevp )224 z1_dtevp = 1._wp / zdtevp225 226 235 ! alpha parameters (Bouillon 2009) 227 236 IF( .NOT. ln_aEVP ) THEN 228 zalph1 = ( 2._wp * rn_relast * rDt_ice ) * z1_dtevp 237 zdtevp = rDt_ice / REAL( nn_nevp ) 238 zalph1 = 2._wp * rn_relast * REAL( nn_nevp ) 229 239 zalph2 = zalph1 * z1_ecc2 230 240 231 241 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 232 242 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 243 ELSE 244 zdtevp = rdt_ice 245 ! zalpha parameters set later on adaptatively 233 246 ENDIF 247 z1_dtevp = 1._wp / zdtevp 234 248 235 249 ! Initialise stress tensor … … 242 256 243 257 ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 244 IF( ln_landfast_L16 ) THEN ; zkt = rn_ tensile258 IF( ln_landfast_L16 ) THEN ; zkt = rn_lf_tensile 245 259 ELSE ; zkt = 0._wp 246 260 ENDIF … … 310 324 zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 311 325 ! ice-bottom stress at U points 312 zvCr = zaU(ji,jj) * rn_ depfra * hu(ji,jj,Kmm)313 ztaux_base(ji,jj) = - rn_ icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )326 zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 327 ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 314 328 ! ice-bottom stress at V points 315 zvCr = zaV(ji,jj) * rn_ depfra * hv(ji,jj,Kmm)316 ztauy_base(ji,jj) = - rn_ icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )329 zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 330 ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 317 331 ! ice_bottom stress at T points 318 zvCr = at_i(ji,jj) * rn_ depfra * ht(ji,jj)319 tau_icebfr(ji,jj) = - rn_ icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )332 zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 333 tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 320 334 END_2D 321 335 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) … … 337 351 l_full_nf_update = jter == nn_nevp ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 338 352 ! 339 !!$ IF(sn_cfctl%l_prtctl) THEN ! Convergence test 340 !!$ DO jj = 1, jpjm1 341 !!$ zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 342 !!$ zv_ice(:,jj) = v_ice(:,jj) 343 !!$ END DO 344 !!$ ENDIF 353 ! convergence test 354 IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 355 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 356 zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 357 zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 358 END_2D 359 ENDIF 345 360 346 361 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! … … 380 395 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 381 396 382 ! alpha & betafor aEVP397 ! alpha for aEVP 383 398 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 384 399 ! alpha = beta = sqrt(4*gamma) … … 388 403 zalph2 = zalph1 389 404 z1_alph2 = z1_alph1 405 ! explicit: 406 ! z1_alph1 = 1._wp / zalph1 407 ! z1_alph2 = 1._wp / zalph1 408 ! zalph1 = zalph1 - 1._wp 409 ! zalph2 = zalph1 390 410 ENDIF 391 411 … … 397 417 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 398 418 419 ! Save beta at T-points for further computations 420 IF( ln_aEVP ) THEN 421 DO_2D( 1, 1, 1, 1 ) 422 zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 423 END_2D 424 ENDIF 425 399 426 DO_2D( 1, 0, 1, 0 ) 400 427 401 ! alpha & betafor aEVP428 ! alpha for aEVP 402 429 IF( ln_aEVP ) THEN 403 zalph2 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj)) )430 zalph2 = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 404 431 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 405 zbeta(ji,jj) = zalph2 432 ! explicit: 433 ! z1_alph2 = 1._wp / zalph2 434 ! zalph2 = zalph2 - 1._wp 406 435 ENDIF 407 436 … … 469 498 ! 470 499 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 471 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 472 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 473 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 474 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 475 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 500 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 501 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 502 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 503 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 504 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 505 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 506 & ) / ( zbetav + 1._wp ) & 507 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 476 508 & ) * zmsk00y(ji,jj) 477 509 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 478 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj)* v_ice(ji,jj) & ! previous velocity479 & + zRHS + zTauO * v_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)480 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast481 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0482 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin483 & ) 510 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 511 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 512 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 513 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 514 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 515 & ) * zmsk00y(ji,jj) 484 516 ENDIF 485 517 END_2D … … 518 550 ! 519 551 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 520 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 521 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 522 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 523 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 524 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 552 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 553 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 554 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 555 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 556 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 557 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 558 & ) / ( zbetau + 1._wp ) & 559 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 525 560 & ) * zmsk00x(ji,jj) 526 561 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 527 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj)* u_ice(ji,jj) & ! previous velocity528 & + zRHS + zTauO * u_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)529 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast530 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0531 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin532 & 562 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 563 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 564 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 565 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 566 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 567 & ) * zmsk00x(ji,jj) 533 568 ENDIF 534 569 END_2D … … 569 604 ! 570 605 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 571 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 572 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 573 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 574 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 575 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 606 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 607 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 608 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 609 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 610 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 611 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 612 & ) / ( zbetau + 1._wp ) & 613 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 576 614 & ) * zmsk00x(ji,jj) 577 615 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 578 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj)* u_ice(ji,jj) & ! previous velocity579 & + zRHS + zTauO * u_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)580 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast581 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0582 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin583 & 616 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 617 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 618 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 619 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 620 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 621 & ) * zmsk00x(ji,jj) 584 622 ENDIF 585 623 END_2D … … 618 656 ! 619 657 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 620 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 621 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 622 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 623 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 624 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 658 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 659 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 660 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 661 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 662 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 663 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 664 & ) / ( zbetav + 1._wp ) & 665 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 625 666 & ) * zmsk00y(ji,jj) 626 667 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 627 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj)* v_ice(ji,jj) & ! previous velocity628 & + zRHS + zTauO * v_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)629 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast630 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0631 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin632 & 668 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 669 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 670 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 671 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 672 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 673 & ) * zmsk00y(ji,jj) 633 674 ENDIF 634 675 END_2D … … 643 684 ENDIF 644 685 645 !!$ IF(sn_cfctl%l_prtctl) THEN ! Convergence test 646 !!$ DO jj = 2 , jpjm1 647 !!$ zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 648 !!$ END DO 649 !!$ zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 650 !!$ CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 651 !!$ ENDIF 686 ! convergence test 687 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 652 688 ! 653 689 ! ! ==================== ! 654 690 END DO ! end loop over jter ! 655 691 ! ! ==================== ! 692 IF( ln_aEVP ) CALL iom_put( 'beta_evp' , zbeta ) 656 693 ! 657 694 !------------------------------------------------------------------------------! … … 706 743 ! 5) diagnostics 707 744 !------------------------------------------------------------------------------! 708 DO_2D( 1, 1, 1, 1 )709 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice710 END_2D711 712 745 ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 713 746 IF( iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & … … 764 797 DEALLOCATE( zsig1 , zsig2 , zsig3 ) 765 798 ENDIF 766 799 767 800 ! --- SIMIP --- ! 768 801 IF( iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & … … 818 851 ENDIF 819 852 ! 853 ! --- convergence tests --- ! 854 IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 855 IF( iom_use('uice_cvg') ) THEN 856 IF( ln_aEVP ) THEN ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 857 CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 858 & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 859 ELSE ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 860 CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 861 & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 862 ENDIF 863 ENDIF 864 ENDIF 865 ! 866 DEALLOCATE( zmsk00, zmsk15 ) 867 ! 820 868 END SUBROUTINE ice_dyn_rhg_evp 869 870 871 SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 872 !!---------------------------------------------------------------------- 873 !! *** ROUTINE rhg_cvg *** 874 !! 875 !! ** Purpose : check convergence of oce rheology 876 !! 877 !! ** Method : create a file ice_cvg.nc containing the convergence of ice velocity 878 !! during the sub timestepping of rheology so as: 879 !! uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) ) 880 !! This routine is called every sub-iteration, so it is cpu expensive 881 !! 882 !! ** Note : for the first sub-iteration, uice_cvg is set to 0 (too large otherwise) 883 !!---------------------------------------------------------------------- 884 INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index 885 REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities 886 !! 887 INTEGER :: it, idtime, istatus 888 INTEGER :: ji, jj ! dummy loop indices 889 REAL(wp) :: zresm ! local real 890 CHARACTER(len=20) :: clname 891 REAL(wp), DIMENSION(jpi,jpj) :: zres ! check convergence 892 !!---------------------------------------------------------------------- 893 894 ! create file 895 IF( kt == nit000 .AND. kiter == 1 ) THEN 896 ! 897 IF( lwp ) THEN 898 WRITE(numout,*) 899 WRITE(numout,*) 'rhg_cvg : ice rheology convergence control' 900 WRITE(numout,*) '~~~~~~~' 901 ENDIF 902 ! 903 IF( lwm ) THEN 904 clname = 'ice_cvg.nc' 905 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 906 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 907 istatus = NF90_DEF_DIM( ncvgid, 'time' , NF90_UNLIMITED, idtime ) 908 istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE , (/ idtime /), nvarid ) 909 istatus = NF90_ENDDEF(ncvgid) 910 ENDIF 911 ! 912 ENDIF 913 914 ! time 915 it = ( kt - 1 ) * kitermax + kiter 916 917 ! convergence 918 IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large) 919 zresm = 0._wp 920 ELSE 921 DO_2D( 1, 1, 1, 1 ) 922 zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 923 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 924 END_2D 925 zresm = MAXVAL( zres ) 926 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 927 ENDIF 928 929 IF( lwm ) THEN 930 ! write variables 931 istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 932 ! close file 933 IF( kt == nitend ) istatus = NF90_CLOSE(ncvgid) 934 ENDIF 935 936 END SUBROUTINE rhg_cvg 821 937 822 938 … … 876 992 END SUBROUTINE rhg_evp_rst 877 993 994 878 995 #else 879 996 !!---------------------------------------------------------------------- -
NEMO/trunk/src/ICE/iceistate.F90
r13429 r13472 47 47 ! !! ** namelist (namini) ** 48 48 LOGICAL, PUBLIC :: ln_iceini !: Ice initialization or not 49 LOGICAL, PUBLIC :: ln_iceini_file !: Ice initialization from 2D netcdf file 49 INTEGER, PUBLIC :: nn_iceini_file !: Ice initialization: 50 ! 0 = Initialise sea ice based on SSTs 51 ! 1 = Initialise sea ice from single category netcdf file 52 ! 2 = Initialise sea ice from multi category restart file 50 53 REAL(wp) :: rn_thres_sst 51 54 REAL(wp) :: rn_hti_ini_n, rn_hts_ini_n, rn_ati_ini_n, rn_smi_ini_n, rn_tmi_ini_n, rn_tsu_ini_n, rn_tms_ini_n 52 55 REAL(wp) :: rn_hti_ini_s, rn_hts_ini_s, rn_ati_ini_s, rn_smi_ini_s, rn_tmi_ini_s, rn_tsu_ini_s, rn_tms_ini_s 53 REAL(wp) :: rn_apd_ini_n, rn_hpd_ini_n 54 REAL(wp) :: rn_apd_ini_s, rn_hpd_ini_s 56 REAL(wp) :: rn_apd_ini_n, rn_hpd_ini_n, rn_hld_ini_n 57 REAL(wp) :: rn_apd_ini_s, rn_hpd_ini_s, rn_hld_ini_s 55 58 ! 56 ! ! if ln_iceini_file = T57 INTEGER , PARAMETER :: jpfldi = 9! maximum number of files to read59 ! ! if nn_iceini_file = 1 60 INTEGER , PARAMETER :: jpfldi = 10 ! maximum number of files to read 58 61 INTEGER , PARAMETER :: jp_hti = 1 ! index of ice thickness (m) 59 62 INTEGER , PARAMETER :: jp_hts = 2 ! index of snw thickness (m) … … 65 68 INTEGER , PARAMETER :: jp_apd = 8 ! index of pnd fraction (-) 66 69 INTEGER , PARAMETER :: jp_hpd = 9 ! index of pnd depth (m) 70 INTEGER , PARAMETER :: jp_hld = 10 ! index of pnd lid depth (m) 67 71 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 68 72 … … 89 93 !! ** Steps : 1) Set initial surface and basal temperatures 90 94 !! 2) Recompute or read sea ice state variables 91 !! 3) Fill in the ice thickness distribution using gaussian 92 !! 4) Fill in space-dependent arrays for state variables 93 !! 5) snow-ice mass computation 94 !! 6) store before fields 95 !! 3) Fill in space-dependent arrays for state variables 96 !! 4) snow-ice mass computation 95 97 !! 96 98 !! ** Notes : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even … … 107 109 REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file 108 110 REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 109 REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini 110 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d ! locakarrays111 !! 112 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 111 REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini, zhlid_ini !data from namelist or nc file 112 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !temporary arrays 113 !! 114 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d 113 115 !-------------------------------------------------------------------- 114 116 … … 164 166 a_ip (:,:,:) = 0._wp 165 167 v_ip (:,:,:) = 0._wp 166 a_ip_frac(:,:,:) = 0._wp 168 v_il (:,:,:) = 0._wp 169 a_ip_eff (:,:,:) = 0._wp 167 170 h_ip (:,:,:) = 0._wp 171 h_il (:,:,:) = 0._wp 168 172 ! 169 173 ! ice velocities … … 174 178 ! 2) overwrite some of the fields with namelist parameters or netcdf file 175 179 !------------------------------------------------------------------------ 176 177 178 180 IF( ln_iceini ) THEN 179 ! !---------------! 180 181 ! 181 182 IF( Agrif_Root() ) THEN 182 183 IF( ln_iceini_file )THEN! Read a file !183 ! !---------------! 184 IF( nn_iceini_file == 1 )THEN ! Read a file ! 184 185 ! !---------------! 185 186 WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp … … 195 196 196 197 ! -- optional fields -- ! 197 ! if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature)198 ! if fields do not exist then set them to the values present in the namelist (except for temperatures) 198 199 ! 199 200 ! ice salinity … … 207 208 si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 208 209 si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 209 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2210 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 )211 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2212 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 )213 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s214 si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1)215 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i216 si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1)217 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su218 si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1)219 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i220 si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1)221 210 ENDIF 211 IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 212 & si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 213 IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) & ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 214 & si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 215 IF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_su, set T_su = T_s 216 & si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 217 IF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) & ! if T_i is read and not T_su, set T_su = T_i 218 & si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 219 IF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) & ! if T_su is read and not T_s, set T_s = T_su 220 & si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 221 IF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) & ! if T_i is read and not T_s, set T_s = T_i 222 & si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 222 223 ! 223 224 ! pond concentration … … 229 230 IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 230 231 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 232 ! 233 ! pond lid depth 234 IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) & 235 & si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zswitch + rn_hld_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 231 236 ! 232 237 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) … … 236 241 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 237 242 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 243 zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * tmask(:,:,1) 238 244 ! 239 245 ! change the switch for the following … … 261 267 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 262 268 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 269 zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) 263 270 ELSEWHERE 264 271 zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) … … 271 278 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 272 279 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 280 zhlid_ini(:,:) = rn_hld_ini_s * zswitch(:,:) 273 281 END WHERE 274 282 ! … … 281 289 zapnd_ini(:,:) = 0._wp 282 290 zhpnd_ini(:,:) = 0._wp 291 zhlid_ini(:,:) = 0._wp 283 292 ENDIF 284 293 285 !-------------! 286 ! fill fields ! 287 !-------------! 294 IF ( .NOT.ln_pnd_lids ) THEN 295 zhlid_ini(:,:) = 0._wp 296 ENDIF 297 298 !----------------! 299 ! 3) fill fields ! 300 !----------------! 288 301 ! select ice covered grid points 289 302 npti = 0 ; nptidx(:) = 0 … … 305 318 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) 306 319 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 307 320 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti) , zhlid_ini ) 321 308 322 ! allocate temporary arrays 309 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 310 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 311 323 ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & 324 & zti_2d (npti,jpl), zts_2d (npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), & 325 & zaip_2d(npti,jpl), zhip_2d(npti,jpl), zhil_2d(npti,jpl) ) 326 312 327 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 313 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 314 & zhi_2d , zhs_2d , zai_2d , & 315 & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 316 & zti_2d , zts_2d , ztsu_2d , zsi_2d , zaip_2d , zhip_2d ) 328 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 329 & zhi_2d , zhs_2d , zai_2d , & 330 & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), & 331 & s_i_1d(1:npti) , a_ip_1d(1:npti) , h_ip_1d(1:npti), h_il_1d(1:npti), & 332 & zti_2d , zts_2d , ztsu_2d , & 333 & zsi_2d , zaip_2d , zhip_2d , zhil_2d ) 317 334 318 335 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) … … 330 347 CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) 331 348 CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) 349 CALL tab_2d_3d( npti, nptidx(1:npti), zhil_2d , h_il ) 332 350 333 351 ! deallocate temporary arrays 334 352 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 335 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d )353 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d ) 336 354 337 355 ! calculate extensive and intensive variables … … 363 381 END_3D 364 382 END DO 365 366 ! Melt ponds 367 WHERE( a_i > epsi10 ) 368 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 369 ELSEWHERE 370 a_ip_frac(:,:,:) = 0._wp 371 END WHERE 372 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 373 374 ! specific temperatures for coupled runs 375 tn_ice(:,:,:) = t_su(:,:,:) 376 t1_ice(:,:,:) = t_i (:,:,1,:) 377 ! 378 383 379 384 #if defined key_agrif 380 385 ELSE … … 391 396 Agrif_UseSpecialValue = .FALSE. 392 397 ! lbc ???? 393 ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i398 ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, t_su, e_s, e_i 394 399 CALL ice_var_glo2eqv 395 400 CALL ice_var_zapsmall 396 401 CALL ice_var_agg(2) 397 398 ! Melt ponds399 WHERE( a_i > epsi10 )400 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:)401 ELSEWHERE402 a_ip_frac(:,:,:) = 0._wp403 END WHERE404 WHERE( a_ip > 0._wp ) ! ???????405 h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:)406 ELSEWHERE407 h_ip(:,:,:) = 0._wp408 END WHERE409 410 tn_ice(:,:,:) = t_su(:,:,:)411 t1_ice(:,:,:) = t_i (:,:,1,:)412 402 #endif 413 ENDIF ! Agrif_Root 403 ENDIF ! Agrif_Root 404 ! 405 ! Melt ponds 406 WHERE( a_i > epsi10 ) ; a_ip_eff(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 407 ELSEWHERE ; a_ip_eff(:,:,:) = 0._wp 408 END WHERE 409 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 410 v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 411 412 ! specific temperatures for coupled runs 413 tn_ice(:,:,:) = t_su(:,:,:) 414 t1_ice(:,:,:) = t_i (:,:,1,:) 415 ! 416 ! ice concentration should not exceed amax 417 at_i(:,:) = SUM( a_i, dim=3 ) 418 DO jl = 1, jpl 419 WHERE( at_i(:,:) > rn_amax_2d(:,:) ) a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 420 END DO 421 at_i(:,:) = SUM( a_i, dim=3 ) 422 ! 414 423 ENDIF ! ln_iceini 415 424 ! 416 at_i(:,:) = SUM( a_i, dim=3 )417 !418 425 !---------------------------------------------- 419 ! 3) Snow-ice mass (case ice is fully embedded)426 ! 4) Snow-ice mass (case ice is fully embedded) 420 427 !---------------------------------------------- 421 428 snwice_mass (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3 ) ! snow+ice mass … … 469 476 ! ENDIF 470 477 ENDIF 471 472 !------------------------------------ 473 ! 4) store fields at before time-step 474 !------------------------------------ 475 ! it is only necessary for the 1st interpolation by Agrif 476 a_i_b (:,:,:) = a_i (:,:,:) 477 e_i_b (:,:,:,:) = e_i (:,:,:,:) 478 v_i_b (:,:,:) = v_i (:,:,:) 479 v_s_b (:,:,:) = v_s (:,:,:) 480 e_s_b (:,:,:,:) = e_s (:,:,:,:) 481 sv_i_b (:,:,:) = sv_i (:,:,:) 482 oa_i_b (:,:,:) = oa_i (:,:,:) 483 u_ice_b(:,:) = u_ice(:,:) 484 v_ice_b(:,:) = v_ice(:,:) 485 ! total concentration is needed for Lupkes parameterizations 486 at_i_b (:,:) = at_i (:,:) 487 488 !!clem: output of initial state should be written here but it is impossible because 489 !! the ocean and ice are in the same file 490 !! CALL dia_wri_state( Kmm, 'output.init' ) 478 479 !!clem: output of initial state should be written here but it is impossible because 480 !! the ocean and ice are in the same file 481 !! CALL dia_wri_state( 'output.init' ) 491 482 ! 492 483 END SUBROUTINE ice_istate … … 505 496 !! 506 497 !!----------------------------------------------------------------------------- 507 INTEGER :: ios , ifpr, ierror ! Local integers508 498 INTEGER :: ios ! Local integer output status for namelist read 499 INTEGER :: ifpr, ierror 509 500 ! 510 501 CHARACTER(len=256) :: cn_dir ! Root directory for location of ice files 511 TYPE(FLD_N) :: sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd 502 TYPE(FLD_N) :: sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd, sn_hld 512 503 TYPE(FLD_N), DIMENSION(jpfldi) :: slf_i ! array of namelist informations on the fields to read 513 504 ! 514 NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, &505 NAMELIST/namini/ ln_iceini, nn_iceini_file, rn_thres_sst, & 515 506 & rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 516 507 & rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 517 508 & rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 518 & rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, &519 & sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, cn_dir509 & rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, rn_hld_ini_n, rn_hld_ini_s, & 510 & sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, sn_hld, cn_dir 520 511 !!----------------------------------------------------------------------------- 521 512 ! … … 529 520 slf_i(jp_ati) = sn_ati ; slf_i(jp_smi) = sn_smi 530 521 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_tsu) = sn_tsu ; slf_i(jp_tms) = sn_tms 531 slf_i(jp_apd) = sn_apd ; slf_i(jp_hpd) = sn_hpd 522 slf_i(jp_apd) = sn_apd ; slf_i(jp_hpd) = sn_hpd ; slf_i(jp_hld) = sn_hld 532 523 ! 533 524 IF(lwp) THEN ! control print … … 537 528 WRITE(numout,*) ' Namelist namini:' 538 529 WRITE(numout,*) ' ice initialization (T) or not (F) ln_iceini = ', ln_iceini 539 WRITE(numout,*) ' ice initialization from a netcdf file ln_iceini_file = ', ln_iceini_file530 WRITE(numout,*) ' ice initialization from a netcdf file nn_iceini_file = ', nn_iceini_file 540 531 WRITE(numout,*) ' max ocean temp. above Tfreeze with initial ice rn_thres_sst = ', rn_thres_sst 541 IF( ln_iceini .AND. .NOT.ln_iceini_file) THEN532 IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN 542 533 WRITE(numout,*) ' initial snw thickness in the north-south rn_hts_ini = ', rn_hts_ini_n,rn_hts_ini_s 543 534 WRITE(numout,*) ' initial ice thickness in the north-south rn_hti_ini = ', rn_hti_ini_n,rn_hti_ini_s … … 549 540 WRITE(numout,*) ' initial pnd fraction in the north-south rn_apd_ini = ', rn_apd_ini_n,rn_apd_ini_s 550 541 WRITE(numout,*) ' initial pnd depth in the north-south rn_hpd_ini = ', rn_hpd_ini_n,rn_hpd_ini_s 542 WRITE(numout,*) ' initial pnd lid depth in the north-south rn_hld_ini = ', rn_hld_ini_n,rn_hld_ini_s 551 543 ENDIF 552 544 ENDIF 553 545 ! 554 IF( ln_iceini_file) THEN ! Ice initialization using input file546 IF( nn_iceini_file == 1 ) THEN ! Ice initialization using input file 555 547 ! 556 548 ! set si structure … … 573 565 rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 574 566 rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 575 CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 567 rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 568 CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 & rn_hld_ini = 0 when no ponds' ) 569 ENDIF 570 ! 571 IF( .NOT.ln_pnd_lids ) THEN 572 rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 576 573 ENDIF 577 574 ! -
NEMO/trunk/src/ICE/iceitd.F90
r13295 r13472 47 47 LOGICAL :: ln_cat_usr ! ice categories are defined by rn_catbnd 48 48 REAL(wp), DIMENSION(0:100) :: rn_catbnd ! ice categories bounds 49 REAL(wp) :: rn_himax ! maximum ice thickness allowed 49 50 ! 50 51 !! * Substitutions … … 314 315 IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 315 316 a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 316 IF( ln_pnd_ H12) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin317 IF( ln_pnd_LEV ) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 317 318 h_i_1d(ji) = rn_himin 318 319 ENDIF … … 420 421 CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 421 422 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 423 CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 422 424 CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 423 425 DO jl = 1, jpl … … 484 486 zaTsfn(ji,jl2) = zaTsfn(ji,jl2) + ztrans 485 487 ! 486 IF ( ln_pnd_ H12) THEN488 IF ( ln_pnd_LEV ) THEN 487 489 ztrans = a_ip_2d(ji,jl1) * zworka(ji) ! Pond fraction 488 490 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans … … 492 494 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 493 495 v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 496 ! 497 IF ( ln_pnd_lids ) THEN ! Pond lid volume 498 ztrans = v_il_2d(ji,jl1) * zworka(ji) 499 v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 500 v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 501 ENDIF 494 502 ENDIF 495 503 ! … … 536 544 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 537 545 ! because of truncation error ( i.e. 1. - 1. /= 0 ) 538 CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d )546 CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 539 547 540 548 ! at_i must be <= rn_amax … … 568 576 CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 569 577 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 578 CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 570 579 CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 571 580 DO jl = 1, jpl … … 693 702 REAL(wp) :: zhmax, znum, zden, zalpha ! - - 694 703 ! 695 NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin 704 NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin, rn_himax 696 705 !!------------------------------------------------------------------ 697 706 ! … … 710 719 WRITE(numout,*) ' mean ice thickness in the domain rn_himean = ', rn_himean 711 720 WRITE(numout,*) ' Ice categories are defined by rn_catbnd ln_cat_usr = ', ln_cat_usr 712 WRITE(numout,*) ' minimum ice thickness rn_himin = ', rn_himin 721 WRITE(numout,*) ' minimum ice thickness allowed rn_himin = ', rn_himin 722 WRITE(numout,*) ' maximum ice thickness allowed rn_himax = ', rn_himax 713 723 ENDIF 714 724 ! … … 747 757 END DO 748 758 ! 749 hi_max(jpl) = 99._wp! set to a big value to ensure that all ice is thinner than hi_max(jpl)759 hi_max(jpl) = rn_himax ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 750 760 ! 751 761 IF(lwp) WRITE(numout,*) -
NEMO/trunk/src/ICE/icerst.F90
r13286 r13472 18 18 USE phycst , ONLY : rt0 19 19 USE sbc_oce , ONLY : nn_fsbc, ln_cpl 20 USE sbc_oce , ONLY : nn_components, jp_iam_sas ! SAS ss[st]_m init 21 USE sbc_oce , ONLY : sst_m, sss_m ! SAS ss[st]_m init 22 USE oce , ONLY : ts ! SAS ss[st]_m init 23 USE eosbn2 , ONLY : l_useCT, eos_pt_from_ct ! SAS ss[st]_m init 20 24 USE iceistate ! sea-ice: initial state 21 25 USE icectl ! sea-ice: control … … 132 136 CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip ) 133 137 CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip ) 138 CALL iom_rstput( iter, nitrst, numriw, 'v_il' , v_il ) 134 139 ! Snow enthalpy 135 140 DO jk = 1, nlay_s … … 172 177 INTEGER :: jk 173 178 LOGICAL :: llok 174 INTEGER :: id0, id1, id2, id3, id4 ! local integer179 INTEGER :: id0, id1, id2, id3, id4, id5 ! local integer 175 180 CHARACTER(len=25) :: znam 176 181 CHARACTER(len=2) :: zchar, zchar1 … … 251 256 v_ip(:,:,:) = 0._wp 252 257 ENDIF 258 ! melt pond lids 259 id3 = iom_varid( numrir, 'v_il' , ldstop = .FALSE. ) 260 IF( id3 > 0 ) THEN 261 CALL iom_get( numrir, jpdom_auto, 'v_il', v_il) 262 ELSE 263 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds lids output then set it to zero' 264 v_il(:,:,:) = 0._wp 265 ENDIF 253 266 ! fields needed for Met Office (Jules) coupling 254 267 IF( ln_cpl ) THEN 255 id 3= iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. )256 id 4= iom_varid( numrir, 't1_ice' , ldstop = .FALSE. )257 IF( id 3 > 0 .AND. id4> 0 ) THEN ! fields exist268 id4 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 269 id5 = iom_varid( numrir, 't1_ice' , ldstop = .FALSE. ) 270 IF( id4 > 0 .AND. id5 > 0 ) THEN ! fields exist 258 271 CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice ) 259 272 CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice ) … … 270 283 ELSE ! == case of a simplified restart == ! 271 284 ! ! ---------------------------------- ! 272 CALL ctl_warn('ice_rst_read: you are using a simplifiedice restart')285 CALL ctl_warn('ice_rst_read: you are attempting to use an unsuitable ice restart') 273 286 ! 274 CALL ice_istate_init 287 IF( .NOT. ln_iceini .OR. nn_iceini_file == 2 ) THEN 288 CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and nn_iceini_file=0 or 1') 289 ELSE 290 CALL ctl_warn('ice_rst_read: using ice_istate to set initial conditions instead') 291 ENDIF 292 ! 293 IF( nn_components == jp_iam_sas ) THEN ! SAS case: ss[st]_m were not initialized by sbc_ssm_init 294 ! 295 IF(lwp) WRITE(numout,*) ' SAS: default initialisation of ss[st]_m arrays used in ice_istate' 296 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem, Kmm), ts(:,:,1,jp_sal, Kmm) ) 297 ELSE ; sst_m(:,:) = ts(:,:,1,jp_tem, Kmm) 298 ENDIF 299 sss_m(:,:) = ts(:,:,1,jp_sal, Kmm) 300 ENDIF 301 ! 275 302 CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 276 303 ! 277 IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) &278 & CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T')279 !280 304 ENDIF 281 305 -
NEMO/trunk/src/ICE/icesbc.F90
r13295 r13472 119 119 INTEGER :: ji, jj, jl ! dummy loop index 120 120 REAL(wp) :: zmiss_val ! missing value retrieved from xios 121 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 122 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zalb, zmsk00 ! 2D workspace 121 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zalb, zmsk00 ! 2D workspace 123 122 !!-------------------------------------------------------------------- 124 123 ! … … 134 133 CALL iom_miss_val( "icetemp", zmiss_val ) 135 134 136 ! --- cloud-sky and overcast-sky ice albedos --- ! 137 CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) 138 139 ! albedo depends on cloud fraction because of non-linear spectral effects 140 !!gm cldf_ice is a real, DOCTOR naming rule: start with cd means CHARACTER passed in argument ! 141 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 142 ! 135 ! --- ice albedo --- ! 136 CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) 137 143 138 ! 144 139 SELECT CASE( ksbc ) !== fluxes over sea ice ==! … … 285 280 INTEGER :: ios, ioptio ! Local integer 286 281 !! 287 NAMELIST/namsbc/ rn_cio, rn_blow_s, nn_flxdist, ln_cndflx, ln_cndemulate282 NAMELIST/namsbc/ rn_cio, nn_snwfra, rn_snwblow, nn_flxdist, ln_cndflx, ln_cndemulate, nn_qtrice 288 283 !!------------------------------------------------------------------- 289 284 ! … … 299 294 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 300 295 WRITE(numout,*) ' Namelist namsbc:' 301 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio 302 WRITE(numout,*) ' coefficient for ice-lead partition of snowfall rn_blow_s = ', rn_blow_s 303 WRITE(numout,*) ' Multicategory heat flux formulation nn_flxdist = ', nn_flxdist 304 WRITE(numout,*) ' Use conduction flux as surface condition ln_cndflx = ', ln_cndflx 305 WRITE(numout,*) ' emulate conduction flux ln_cndemulate = ', ln_cndemulate 296 WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio 297 WRITE(numout,*) ' fraction of ice covered by snow (options 0,1,2) nn_snwfra = ', nn_snwfra 298 WRITE(numout,*) ' coefficient for ice-lead partition of snowfall rn_snwblow = ', rn_snwblow 299 WRITE(numout,*) ' Multicategory heat flux formulation nn_flxdist = ', nn_flxdist 300 WRITE(numout,*) ' Use conduction flux as surface condition ln_cndflx = ', ln_cndflx 301 WRITE(numout,*) ' emulate conduction flux ln_cndemulate = ', ln_cndemulate 302 WRITE(numout,*) ' solar flux transmitted thru the surface scattering layer nn_qtrice = ', nn_qtrice 303 WRITE(numout,*) ' = 0 Grenfell and Maykut 1977' 304 WRITE(numout,*) ' = 1 Lebrun 2019' 306 305 ENDIF 307 306 ! -
NEMO/trunk/src/ICE/icestp.F90
r13216 r13472 201 201 IF( lrst_ice ) CALL ice_rst_write( kt ) ! -- Ice restart file 202 202 ! 203 IF( ln_icectl ) CALL ice_ctl( kt ) ! -- alerts in case of model crash203 IF( ln_icectl ) CALL ice_ctl( kt ) ! -- Control checks 204 204 ! 205 205 ENDIF ! End sea-ice time step only … … 224 224 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 225 225 ! 226 INTEGER :: ji, jj,ierr226 INTEGER :: ierr 227 227 !!---------------------------------------------------------------------- 228 228 IF(lwp) WRITE(numout,*) … … 252 252 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays') 253 253 ! 254 CALL ice_itd_init ! ice thickness distribution initialization255 !256 CALL ice_thd_init ! set ice thermodynics parameters (clem: important to call it first for melt ponds)257 !258 ! ! Initial sea-ice state259 IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst260 CALL ice_istate_init261 CALL ice_istate( nit000, Kbb, Kmm, Kaa )262 ELSE ! start from a restart file263 CALL ice_rst_read( Kbb, Kmm, Kaa )264 ENDIF265 CALL ice_var_glo2eqv266 CALL ice_var_agg(1)267 !268 CALL ice_sbc_init ! set ice-ocean and ice-atm. coupling parameters269 !270 CALL ice_dyn_init ! set ice dynamics parameters271 !272 CALL ice_update_init ! ice surface boundary condition273 !274 CALL ice_alb_init ! ice surface albedo275 !276 CALL ice_dia_init ! initialization for diags277 !278 fr_i (:,:) = at_i(:,:) ! initialisation of sea-ice fraction279 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu280 !281 254 ! ! set max concentration in both hemispheres 282 255 WHERE( gphit(:,:) > 0._wp ) ; rn_amax_2d(:,:) = rn_amax_n ! NH 283 256 ELSEWHERE ; rn_amax_2d(:,:) = rn_amax_s ! SH 284 257 END WHERE 285 258 ! 259 CALL ice_itd_init ! ice thickness distribution initialization 260 ! 261 CALL ice_thd_init ! set ice thermodynics parameters (clem: important to call it first for melt ponds) 262 ! 263 ! ! Initial sea-ice state 264 CALL ice_istate_init 265 IF ( ln_rstart .OR. nn_iceini_file == 2 ) THEN 266 CALL ice_rst_read( Kbb, Kmm, Kaa ) ! start from a restart file 267 ELSE 268 CALL ice_istate( nit000, Kbb, Kmm, Kaa ) ! start from rest or read a file 269 ENDIF 270 CALL ice_var_glo2eqv 271 CALL ice_var_agg(1) 272 ! 273 CALL ice_sbc_init ! set ice-ocean and ice-atm. coupling parameters 274 ! 275 CALL ice_dyn_init ! set ice dynamics parameters 276 ! 277 CALL ice_update_init ! ice surface boundary condition 278 ! 279 CALL ice_alb_init ! ice surface albedo 280 ! 281 CALL ice_dia_init ! initialization for diags 282 ! 283 fr_i (:,:) = at_i(:,:) ! initialisation of sea-ice fraction 284 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 285 ! 286 286 IF( ln_rstart ) CALL iom_close( numrir ) ! close input ice restart file 287 287 ! … … 366 366 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 367 367 sv_i_b(:,:,:) = sv_i(:,:,:) ! salt content 368 oa_i_b(:,:,:) = oa_i(:,:,:) ! areal age content369 368 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 370 369 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy … … 375 374 h_i_b(:,:,:) = 0._wp 376 375 h_s_b(:,:,:) = 0._wp 377 END WHERE378 379 WHERE( a_ip(:,:,:) >= epsi20 )380 h_ip_b(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) ! ice pond thickness381 ELSEWHERE382 h_ip_b(:,:,:) = 0._wp383 376 END WHERE 384 377 ! … … 424 417 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 425 418 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 426 hfx_err_rem(:,:) = 0._wp427 419 hfx_err_dif(:,:) = 0._wp 428 420 wfx_err_sub(:,:) = 0._wp … … 445 437 diag_trp_ei(:,:) = 0._wp ; diag_trp_es(:,:) = 0._wp 446 438 diag_trp_sv(:,:) = 0._wp 447 439 448 440 END SUBROUTINE diag_set0 449 441 -
NEMO/trunk/src/ICE/icethd.F90
r13295 r13472 35 35 ! 36 36 USE in_out_manager ! I/O manager 37 USE iom ! I/O manager library 37 38 USE lib_mpp ! MPP library 38 39 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) … … 51 52 LOGICAL :: ln_icedO ! activate ice growth in open-water (T) or not (F) 52 53 LOGICAL :: ln_icedS ! activate gravity drainage and flushing (T) or not (F) 54 LOGICAL :: ln_leadhfx ! heat in the leads is used to melt sea-ice before warming the ocean 55 56 !! for convergence tests 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztice_cvgerr, ztice_cvgstp 53 58 54 59 !! * Substitutions … … 101 106 WRITE(numout,*) 'ice_thd: sea-ice thermodynamics' 102 107 WRITE(numout,*) '~~~~~~~' 108 ENDIF 109 110 ! convergence tests 111 IF( ln_zdf_chkcvg ) THEN 112 ALLOCATE( ztice_cvgerr(jpi,jpj,jpl) , ztice_cvgstp(jpi,jpj,jpl) ) 113 ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 103 114 ENDIF 104 115 … … 159 170 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 160 171 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 161 fhld (ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 172 IF( ln_leadhfx ) THEN ; fhld(ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 173 ELSE ; fhld(ji,jj) = 0._wp 174 ENDIF 162 175 qlead(ji,jj) = 0._wp 163 176 ELSE … … 208 221 ! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 209 222 ! 210 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here)223 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) 211 224 dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp 212 225 dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp … … 242 255 IF( ln_icedO ) CALL ice_thd_do ! --- Frazil ice growth in leads --- ! 243 256 ! 257 ! convergence tests 258 IF( ln_zdf_chkcvg ) THEN 259 CALL iom_put( 'tice_cvgerr', ztice_cvgerr ) ; DEALLOCATE( ztice_cvgerr ) 260 CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp ) 261 ENDIF 262 ! 244 263 ! controls 245 264 IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints … … 347 366 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) ) 348 367 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) ) 349 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )368 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) ) 350 369 ! 351 370 CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d (1:npti), qprec_ice ) … … 399 418 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 400 419 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 401 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem )402 420 CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 403 421 ! … … 434 452 sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 435 453 v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 454 v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 436 455 oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 437 456 … … 453 472 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) ) 454 473 CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) ) 455 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )474 CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) ) 456 475 ! 457 476 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) … … 491 510 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 492 511 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 493 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem )494 512 CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 495 513 ! … … 508 526 CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 509 527 CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 528 CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 510 529 CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 530 ! check convergence of heat diffusion scheme 531 IF( ln_zdf_chkcvg ) THEN 532 CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) ) 533 CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) ) 534 ENDIF 511 535 ! 512 536 END SELECT … … 529 553 INTEGER :: ios ! Local integer output status for namelist read 530 554 !! 531 NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS 555 NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx 532 556 !!------------------------------------------------------------------- 533 557 ! … … 543 567 WRITE(numout,*) '~~~~~~~~~~~~' 544 568 WRITE(numout,*) ' Namelist namthd:' 545 WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH 546 WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA 547 WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO 548 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS 569 WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH 570 WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA 571 WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO 572 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS 573 WRITE(numout,*) ' heat in the leads is used to melt sea-ice before warming the ocean ln_leadhfx = ', ln_leadhfx 549 574 ENDIF 550 575 ! -
NEMO/trunk/src/ICE/icethd_dh.F90
r13226 r13472 13 13 !!---------------------------------------------------------------------- 14 14 !! ice_thd_dh : vertical sea-ice growth and melt 15 !! ice_thd_snwblow : distribute snow fall between ice and ocean 16 !!---------------------------------------------------------------------- 15 !!---------------------------------------------------------------------- 17 16 USE dom_oce ! ocean space and time domain 18 17 USE phycst ! physical constants … … 20 19 USE ice1D ! sea-ice: thermodynamics variables 21 20 USE icethd_sal ! sea-ice: salinity profiles 21 USE icevar ! for CALL ice_var_snwblow 22 22 ! 23 23 USE in_out_manager ! I/O manager … … 29 29 30 30 PUBLIC ice_thd_dh ! called by ice_thd 31 PUBLIC ice_thd_snwblow ! called in sbcblk/sbccpl and here32 33 INTERFACE ice_thd_snwblow34 MODULE PROCEDURE ice_thd_snwblow_1d, ice_thd_snwblow_2d35 END INTERFACE36 31 37 32 !!---------------------------------------------------------------------- … … 186 181 ! Snow precipitation 187 182 !------------------- 188 CALL ice_ thd_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) ) ! snow distribution over ice after wind blowing183 CALL ice_var_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) ) ! snow distribution over ice after wind blowing 189 184 190 185 zdeltah(1:npti,:) = 0._wp … … 636 631 END SUBROUTINE ice_thd_dh 637 632 638 639 !!--------------------------------------------------------------------------640 !! INTERFACE ice_thd_snwblow641 !!642 !! ** Purpose : Compute distribution of precip over the ice643 !!644 !! Snow accumulation in one thermodynamic time step645 !! snowfall is partitionned between leads and ice.646 !! If snow fall was uniform, a fraction (1-at_i) would fall into leads647 !! but because of the winds, more snow falls on leads than on sea ice648 !! and a greater fraction (1-at_i)^beta of the total mass of snow649 !! (beta < 1) falls in leads.650 !! In reality, beta depends on wind speed,651 !! and should decrease with increasing wind speed but here, it is652 !! considered as a constant. an average value is 0.66653 !!--------------------------------------------------------------------------654 !!gm I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE....655 SUBROUTINE ice_thd_snwblow_2d( pin, pout )656 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pin ! previous fraction lead ( 1. - a_i_b )657 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout658 pout = ( 1._wp - ( pin )**rn_blow_s )659 END SUBROUTINE ice_thd_snwblow_2d660 661 SUBROUTINE ice_thd_snwblow_1d( pin, pout )662 REAL(wp), DIMENSION(:), INTENT(in ) :: pin663 REAL(wp), DIMENSION(:), INTENT(inout) :: pout664 pout = ( 1._wp - ( pin )**rn_blow_s )665 END SUBROUTINE ice_thd_snwblow_1d666 667 633 #else 668 634 !!---------------------------------------------------------------------- -
NEMO/trunk/src/ICE/icethd_ent.F90
r13226 r13472 130 130 ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in icethd_do), 131 131 ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 132 IF( compute_hfx_err ) THEN 133 DO ji = 1, npti 134 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * & 135 & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 136 END DO 137 END IF 138 132 !DO ji = 1, npti 133 ! hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * & 134 ! & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 135 !END DO 136 139 137 END SUBROUTINE ice_thd_ent 140 138 -
NEMO/trunk/src/ICE/icethd_pnd.F90
r12489 r13472 35 35 ! ! associated indices: 36 36 INTEGER, PARAMETER :: np_pndNO = 0 ! No pond scheme 37 INTEGER, PARAMETER :: np_pndCST = 1 ! Constant pond scheme38 INTEGER, PARAMETER :: np_pnd H12 = 2 ! Evolutive pond scheme (Holland et al. 2012)37 INTEGER, PARAMETER :: np_pndCST = 1 ! Constant ice pond scheme 38 INTEGER, PARAMETER :: np_pndLEV = 2 ! Level ice pond scheme 39 39 40 40 !!---------------------------------------------------------------------- … … 49 49 !! *** ROUTINE ice_thd_pnd *** 50 50 !! 51 !! ** Purpose : change melt pond fraction 51 !! ** Purpose : change melt pond fraction and thickness 52 52 !! 53 !! ** Method : brut force54 53 !!------------------------------------------------------------------- 55 54 ! … … 58 57 CASE (np_pndCST) ; CALL pnd_CST !== Constant melt ponds ==! 59 58 ! 60 CASE (np_pnd H12) ; CALL pnd_H12 !== Holland et al 2012melt ponds ==!59 CASE (np_pndLEV) ; CALL pnd_LEV !== Level ice melt ponds ==! 61 60 ! 62 61 END SELECT … … 86 85 ! 87 86 IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 88 a_ip_frac_1d(ji) = rn_apnd89 87 h_ip_1d(ji) = rn_hpnd 90 a_ip_1d(ji) = a_ip_frac_1d(ji) * a_i_1d(ji) 88 a_ip_1d(ji) = rn_apnd * a_i_1d(ji) 89 h_il_1d(ji) = 0._wp ! no pond lids whatsoever 91 90 ELSE 92 a_ip_frac_1d(ji) = 0._wp93 91 h_ip_1d(ji) = 0._wp 94 92 a_ip_1d(ji) = 0._wp 93 h_il_1d(ji) = 0._wp 95 94 ENDIF 96 95 ! … … 100 99 101 100 102 SUBROUTINE pnd_H12 103 !!------------------------------------------------------------------- 104 !! *** ROUTINE pnd_H12 *** 105 !! 106 !! ** Purpose : Compute melt pond evolution 107 !! 108 !! ** Method : Empirical method. A fraction of meltwater is accumulated in ponds 109 !! and sent to ocean when surface is freezing 110 !! 111 !! pond growth: Vp = Vp + dVmelt 112 !! with dVmelt = R/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 113 !! pond contraction: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp) 114 !! with Tp = -2degC 115 !! 116 !! ** Tunable parameters : (no real expertise yet, ideas?) 101 SUBROUTINE pnd_LEV 102 !!------------------------------------------------------------------- 103 !! *** ROUTINE pnd_LEV *** 104 !! 105 !! ** Purpose : Compute melt pond evolution 106 !! 107 !! ** Method : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing 108 !! We work with volumes and then redistribute changes into thickness and concentration 109 !! assuming linear relationship between the two. 110 !! 111 !! ** Action : - pond growth: Vp = Vp + dVmelt --- from Holland et al 2012 --- 112 !! dVmelt = (1-r)/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 113 !! dh_i = meltwater from ice surface melt 114 !! dh_s = meltwater from snow melt 115 !! (1-r) = fraction of melt water that is not flushed 116 !! 117 !! - limtations: a_ip must not exceed (1-r)*a_i 118 !! h_ip must not exceed 0.5*h_i 119 !! 120 !! - pond shrinking: 121 !! if lids: Vp = Vp -dH * a_ip 122 !! dH = lid thickness change. Retrieved from this eq.: --- from Flocco et al 2010 --- 123 !! 124 !! rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H 125 !! H = lid thickness 126 !! Lf = latent heat of fusion 127 !! Tp = -2C 128 !! 129 !! And solved implicitely as: 130 !! H(t+dt)**2 -H(t) * H(t+dt) -ki * (Tp-Tsu) * dt / (rhoi*Lf) = 0 131 !! 132 !! if no lids: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp) --- from Holland et al 2012 --- 133 !! 134 !! - Flushing: w = -perm/visc * rho_oce * grav * Hp / Hi --- from Flocco et al 2007 --- 135 !! perm = permability of sea-ice 136 !! visc = water viscosity 137 !! Hp = height of top of the pond above sea-level 138 !! Hi = ice thickness thru which there is flushing 139 !! 140 !! - Corrections: remove melt ponds when lid thickness is 10 times the pond thickness 141 !! 142 !! - pond thickness and area is retrieved from pond volume assuming a linear relationship between h_ip and a_ip: 143 !! a_ip/a_i = a_ip_frac = h_ip / zaspect 144 !! 145 !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min 117 146 !! 118 !! ** Note : Stolen from CICE for quick test of the melt pond 119 !! radiation and freshwater interfaces 120 !! Coupling can be radiative AND freshwater 121 !! Advection, ridging, rafting are called 122 !! 123 !! ** References : Holland, M. M. et al (J Clim 2012) 124 !!------------------------------------------------------------------- 125 REAL(wp), PARAMETER :: zrmin = 0.15_wp ! minimum fraction of available meltwater retained for melt ponding 126 REAL(wp), PARAMETER :: zrmax = 0.70_wp ! maximum - - - - - 127 REAL(wp), PARAMETER :: zpnd_aspect = 0.8_wp ! pond aspect ratio 128 REAL(wp), PARAMETER :: zTp = -2._wp ! reference temperature 129 ! 130 REAL(wp) :: zfr_mlt ! fraction of available meltwater retained for melt ponding 131 REAL(wp) :: zdv_mlt ! available meltwater for melt ponding 132 REAL(wp) :: z1_Tp ! inverse reference temperature 133 REAL(wp) :: z1_rhow ! inverse freshwater density 134 REAL(wp) :: z1_zpnd_aspect ! inverse pond aspect ratio 135 REAL(wp) :: zfac, zdum 136 ! 137 INTEGER :: ji ! loop indices 138 !!------------------------------------------------------------------- 139 z1_rhow = 1._wp / rhow 140 z1_zpnd_aspect = 1._wp / zpnd_aspect 141 z1_Tp = 1._wp / zTp 147 !! ** Note : mostly stolen from CICE 148 !! 149 !! ** References : Flocco and Feltham (JGR, 2007) 150 !! Flocco et al (JGR, 2010) 151 !! Holland et al (J. Clim, 2012) 152 !!------------------------------------------------------------------- 153 REAL(wp), DIMENSION(nlay_i) :: ztmp ! temporary array 154 !! 155 REAL(wp), PARAMETER :: zaspect = 0.8_wp ! pond aspect ratio 156 REAL(wp), PARAMETER :: zTp = -2._wp ! reference temperature 157 REAL(wp), PARAMETER :: zvisc = 1.79e-3_wp ! water viscosity 158 !! 159 REAL(wp) :: zfr_mlt, zdv_mlt ! fraction and volume of available meltwater retained for melt ponding 160 REAL(wp) :: zdv_frz, zdv_flush ! Amount of melt pond that freezes, flushes 161 REAL(wp) :: zhp ! heigh of top of pond lid wrt ssh 162 REAL(wp) :: zv_ip_max ! max pond volume allowed 163 REAL(wp) :: zdT ! zTp-t_su 164 REAL(wp) :: zsbr ! Brine salinity 165 REAL(wp) :: zperm ! permeability of sea ice 166 REAL(wp) :: zfac, zdum ! temporary arrays 167 REAL(wp) :: z1_rhow, z1_aspect, z1_Tp ! inverse 168 !! 169 INTEGER :: ji, jk ! loop indices 170 !!------------------------------------------------------------------- 171 z1_rhow = 1._wp / rhow 172 z1_aspect = 1._wp / zaspect 173 z1_Tp = 1._wp / zTp 142 174 143 175 DO ji = 1, npti 144 ! !--------------------------------!145 IF( h_i_1d(ji) < rn_himin ) THEN ! Case ice thickness < rn_himin!146 ! !--------------------------------!147 !--- Remove ponds on thin ice 176 ! !----------------------------------------------------! 177 IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN ! Case ice thickness < rn_himin or tiny ice fraction ! 178 ! !----------------------------------------------------! 179 !--- Remove ponds on thin ice or tiny ice fractions 148 180 a_ip_1d(ji) = 0._wp 149 a_ip_frac_1d(ji) = 0._wp150 181 h_ip_1d(ji) = 0._wp 151 ! !--------------------------------! 152 ELSE ! Case ice thickness >= rn_himin ! 153 ! !--------------------------------! 154 v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) ! record pond volume at previous time step 155 ! 156 ! available meltwater for melt ponding [m, >0] and fraction 157 zdv_mlt = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 158 zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji) ! from CICE doc 159 !zfr_mlt = zrmin + zrmax * a_i_1d(ji) ! from Holland paper 160 ! 161 !--- Pond gowth ---! 162 ! v_ip should never be negative, otherwise code crashes 163 v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt ) 164 ! 165 ! melt pond mass flux (<0) 182 h_il_1d(ji) = 0._wp 183 ! !--------------------------------! 184 ELSE ! Case ice thickness >= rn_himin ! 185 ! !--------------------------------! 186 v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) ! retrieve volume from thickness 187 v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 188 ! 189 !------------------! 190 ! case ice melting ! 191 !------------------! 192 ! 193 !--- available meltwater for melt ponding ---! 194 zdum = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 195 zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) ! = ( 1 - r ) = fraction of melt water that is not flushed 196 zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors? 197 ! 198 !--- overflow ---! 199 ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 200 ! a_ip_max = zfr_mlt * a_i 201 ! => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 202 zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 203 zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 204 205 ! If pond depth exceeds half the ice thickness then reduce the pond volume 206 ! h_ip_max = 0.5 * h_i 207 ! => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 208 zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 209 zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 210 211 !--- Pond growing ---! 212 v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 213 ! 214 !--- Lid melting ---! 215 IF( ln_pnd_lids ) v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 216 ! 217 !--- mass flux ---! 166 218 IF( zdv_mlt > 0._wp ) THEN 167 zfac = z fr_mlt * zdv_mlt * rhow * r1_Dt_ice219 zfac = zdv_mlt * rhow * r1_Dt_ice ! melt pond mass flux < 0 [kg.m-2.s-1] 168 220 wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 169 221 ! 170 ! adjust ice/snow melting flux to balance melt pond flux (>0) 171 zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) 222 zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) ! adjust ice/snow melting flux > 0 to balance melt pond flux 172 223 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 173 224 wfx_sum_1d(ji) = wfx_sum_1d(ji) * (1._wp + zdum) 174 225 ENDIF 226 227 !-------------------! 228 ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 229 !-------------------! 230 ! 231 zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 175 232 ! 176 233 !--- Pond contraction (due to refreezing) ---! 177 v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp ) 178 ! 179 ! Set new pond area and depth assuming linear relation between h_ip and a_ip_frac 180 ! h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i 181 a_ip_1d(ji) = SQRT( v_ip_1d(ji) * z1_zpnd_aspect * a_i_1d(ji) ) 182 a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji) 183 h_ip_1d(ji) = zpnd_aspect * a_ip_frac_1d(ji) 234 IF( ln_pnd_lids ) THEN 235 ! 236 !--- Lid growing and subsequent pond shrinking ---! 237 zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 238 & SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 239 240 ! Lid growing 241 v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 242 243 ! Pond shrinking 244 v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 245 246 ELSE 247 ! Pond shrinking 248 v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 249 ENDIF 250 ! 251 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 252 ! v_ip = h_ip * a_ip 253 ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 254 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 255 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 256 257 !---------------! 258 ! Pond flushing ! 259 !---------------! 260 ! height of top of the pond above sea-level 261 zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 262 263 ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 264 DO jk = 1, nlay_i 265 zsbr = - 1.2_wp & 266 & - 21.8_wp * ( t_i_1d(ji,jk) - rt0 ) & 267 & - 0.919_wp * ( t_i_1d(ji,jk) - rt0 )**2 & 268 & - 0.0178_wp * ( t_i_1d(ji,jk) - rt0 )**3 269 ztmp(jk) = sz_i_1d(ji,jk) / zsbr 270 END DO 271 zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 272 273 ! Do the drainage using Darcy's law 274 zdv_flush = -zperm * rho0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 275 zdv_flush = MAX( zdv_flush, -v_ip_1d(ji) ) 276 v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 277 278 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 279 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 280 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 281 282 !--- Corrections and lid thickness ---! 283 IF( ln_pnd_lids ) THEN 284 !--- retrieve lid thickness from volume ---! 285 IF( a_ip_1d(ji) > epsi10 ) THEN ; h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 286 ELSE ; h_il_1d(ji) = 0._wp 287 ENDIF 288 !--- remove ponds if lids are much larger than ponds ---! 289 IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 290 a_ip_1d(ji) = 0._wp 291 h_ip_1d(ji) = 0._wp 292 h_il_1d(ji) = 0._wp 293 ENDIF 294 ENDIF 184 295 ! 185 296 ENDIF 297 186 298 END DO 187 299 ! 188 END SUBROUTINE pnd_ H12300 END SUBROUTINE pnd_LEV 189 301 190 302 … … 203 315 INTEGER :: ios, ioptio ! Local integer 204 316 !! 205 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 317 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, & 318 & ln_pnd_CST , rn_apnd, rn_hpnd, & 319 & ln_pnd_lids, ln_pnd_alb 206 320 !!------------------------------------------------------------------- 207 321 ! … … 217 331 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 218 332 WRITE(numout,*) ' Namelist namicethd_pnd:' 219 WRITE(numout,*) ' Melt ponds activated or not ln_pnd = ', ln_pnd 220 WRITE(numout,*) ' Evolutive melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 221 WRITE(numout,*) ' Prescribed melt pond fraction and depth ln_pnd_CST = ', ln_pnd_CST 222 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd 223 WRITE(numout,*) ' Prescribed pond depth rn_hpnd = ', rn_hpnd 224 WRITE(numout,*) ' Melt ponds affect albedo or not ln_pnd_alb = ', ln_pnd_alb 333 WRITE(numout,*) ' Melt ponds activated or not ln_pnd = ', ln_pnd 334 WRITE(numout,*) ' Level ice melt pond scheme ln_pnd_LEV = ', ln_pnd_LEV 335 WRITE(numout,*) ' Minimum ice fraction that contributes to melt ponds rn_apnd_min = ', rn_apnd_min 336 WRITE(numout,*) ' Maximum ice fraction that contributes to melt ponds rn_apnd_max = ', rn_apnd_max 337 WRITE(numout,*) ' Constant ice melt pond scheme ln_pnd_CST = ', ln_pnd_CST 338 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd 339 WRITE(numout,*) ' Prescribed pond depth rn_hpnd = ', rn_hpnd 340 WRITE(numout,*) ' Frozen lids on top of melt ponds ln_pnd_lids = ', ln_pnd_lids 341 WRITE(numout,*) ' Melt ponds affect albedo or not ln_pnd_alb = ', ln_pnd_alb 225 342 ENDIF 226 343 ! … … 229 346 IF( .NOT.ln_pnd ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndNO ; ENDIF 230 347 IF( ln_pnd_CST ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndCST ; ENDIF 231 IF( ln_pnd_ H12 ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndH12; ENDIF348 IF( ln_pnd_LEV ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndLEV ; ENDIF 232 349 IF( ioptio /= 1 ) & 233 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_ H12or ln_pnd_CST)' )350 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV or ln_pnd_CST)' ) 234 351 ! 235 352 SELECT CASE( nice_pnd ) 236 353 CASE( np_pndNO ) 237 IF( ln_pnd_alb ) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF 354 IF( ln_pnd_alb ) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF 355 IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF 356 CASE( np_pndCST ) 357 IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF 238 358 END SELECT 239 359 ! -
NEMO/trunk/src/ICE/icethd_sal.F90
r12489 r13472 55 55 !! -> nn_icesal = 3 -> Sice = S(z) [multiyear ice] 56 56 !!--------------------------------------------------------------------- 57 LOGICAL, INTENT(in) :: ld_sal 57 LOGICAL, INTENT(in) :: ld_sal ! gravity drainage and flushing or not 58 58 ! 59 INTEGER :: ji, jk ! dummy loop indices 60 REAL(wp) :: iflush, igravdr ! local scalars 61 REAL(wp) :: zs_sni, zs_i_gd, zs_i_fl, zs_i_si, zs_i_bg ! local scalars 59 INTEGER :: ji ! dummy loop indices 60 REAL(wp) :: zs_sni, zds ! local scalars 62 61 REAL(wp) :: z1_time_gd, z1_time_fl 63 62 !!--------------------------------------------------------------------- … … 68 67 CASE( 2 ) ! time varying salinity with linear profile ! 69 68 ! !---------------------------------------------! 70 z1_time_gd = 1._wp / rn_time_gd * rDt_ice71 z1_time_fl = 1._wp / rn_time_fl * rDt_ice69 z1_time_gd = rDt_ice / rn_time_gd 70 z1_time_fl = rDt_ice / rn_time_fl 72 71 ! 73 72 DO ji = 1, npti 74 73 ! 75 !---------------------------------------------------------76 ! Update ice salinity from snow-ice and bottom growth77 !---------------------------------------------------------78 74 IF( h_i_1d(ji) > 0._wp ) THEN 79 zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi ! Salinity of snow ice 80 zs_i_si = ( zs_sni - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice 81 zs_i_bg = ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog (ji) / h_i_1d(ji) ! bottom growth 82 ! Update salinity (nb: salt flux already included in icethd_dh) 83 s_i_1d(ji) = s_i_1d(ji) + zs_i_bg + zs_i_si 75 ! 76 ! --- Update ice salinity from snow-ice and bottom growth --- ! 77 zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi ! salinity of snow ice 78 zds = ( zs_sni - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice 79 zds = zds + ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog (ji) / h_i_1d(ji) ! bottom growth 80 ! update salinity (nb: salt flux already included in icethd_dh) 81 s_i_1d(ji) = s_i_1d(ji) + zds 82 ! 83 ! --- Update ice salinity from brine drainage and flushing --- ! 84 IF( ld_sal ) THEN 85 IF( t_su_1d(ji) >= rt0 ) THEN ! flushing (summer time) 86 zds = - MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl 87 ELSEIF( t_su_1d(ji) <= t_bo_1d(ji) ) THEN ! gravity drainage 88 zds = - MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd 89 ELSE 90 zds = 0._wp 91 ENDIF 92 ! update salinity 93 s_i_1d(ji) = s_i_1d(ji) + zds 94 ! salt flux 95 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice 96 ENDIF 97 ! 98 ! --- salinity must stay inbounds --- ! 99 zds = MAX( 0._wp, rn_simin - s_i_1d(ji) ) ! > 0 if s_i < simin 100 zds = zds + MIN( 0._wp, rn_simax - s_i_1d(ji) ) ! < 0 if s_i > simax 101 ! update salinity 102 s_i_1d(ji) = s_i_1d(ji) + zds 103 ! salt flux 104 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice 105 ! 84 106 ENDIF 85 107 ! 86 IF( ld_sal ) THEN87 !---------------------------------------------------------88 ! Update ice salinity from brine drainage and flushing89 !---------------------------------------------------------90 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 ) ) ! =1 if summer91 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo92 93 zs_i_gd = - igravdr * MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd ! gravity drainage94 zs_i_fl = - iflush * MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl ! flushing95 96 ! Update salinity97 s_i_1d(ji) = s_i_1d(ji) + zs_i_fl + zs_i_gd98 99 ! Salt flux100 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_Dt_ice101 ENDIF102 108 END DO 103 109 ! -
NEMO/trunk/src/ICE/icethd_zdf.F90
r12377 r13472 85 85 INTEGER :: ios, ioptio ! Local integer 86 86 !! 87 NAMELIST/namthd_zdf/ ln_zdf_BL99, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, rn_kappa_i 87 NAMELIST/namthd_zdf/ ln_zdf_BL99, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, & 88 & rn_kappa_i, rn_kappa_s, rn_kappa_smlt, rn_kappa_sdry, ln_zdf_chkcvg 88 89 !!------------------------------------------------------------------- 89 90 ! … … 99 100 WRITE(numout,*) '~~~~~~~~~~~~~~~~' 100 101 WRITE(numout,*) ' Namelist namthd_zdf:' 101 WRITE(numout,*) ' Bitz and Lipscomb (1999) formulation ln_zdf_BL99 = ', ln_zdf_BL99 102 WRITE(numout,*) ' thermal conductivity in the ice (Untersteiner 1964) ln_cndi_U64 = ', ln_cndi_U64 103 WRITE(numout,*) ' thermal conductivity in the ice (Pringle et al 2007) ln_cndi_P07 = ', ln_cndi_P07 104 WRITE(numout,*) ' thermal conductivity in the snow rn_cnd_s = ', rn_cnd_s 105 WRITE(numout,*) ' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i 102 WRITE(numout,*) ' Bitz and Lipscomb (1999) formulation ln_zdf_BL99 = ', ln_zdf_BL99 103 WRITE(numout,*) ' thermal conductivity in the ice (Untersteiner 1964) ln_cndi_U64 = ', ln_cndi_U64 104 WRITE(numout,*) ' thermal conductivity in the ice (Pringle et al 2007) ln_cndi_P07 = ', ln_cndi_P07 105 WRITE(numout,*) ' thermal conductivity in the snow rn_cnd_s = ', rn_cnd_s 106 WRITE(numout,*) ' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i 107 WRITE(numout,*) ' extinction radiation parameter in snw (nn_qtrice=0) rn_kappa_s = ', rn_kappa_s 108 WRITE(numout,*) ' extinction radiation parameter in melt snw (nn_qtrice=1) rn_kappa_smlt = ', rn_kappa_smlt 109 WRITE(numout,*) ' extinction radiation parameter in dry snw (nn_qtrice=1) rn_kappa_sdry = ', rn_kappa_sdry 110 WRITE(numout,*) ' check convergence of heat diffusion scheme ln_zdf_chkcvg = ', ln_zdf_chkcvg 106 111 ENDIF 107 112 ! -
NEMO/trunk/src/ICE/icethd_zdf_bl99.F90
r12489 r13472 85 85 86 86 LOGICAL, DIMENSION(jpij) :: l_T_converged ! true when T converges (per grid point) 87 !87 ! 88 88 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system 89 89 REAL(wp) :: zg1 = 2._wp ! 90 90 REAL(wp) :: zgamma = 18009._wp ! for specific heat 91 91 REAL(wp) :: zbeta = 0.117_wp ! for thermal conductivity (could be 0.13) 92 REAL(wp) :: zraext_s = 10._wp ! extinction coefficient of radiation in the snow93 92 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 94 93 REAL(wp) :: ztsu_err = 1.e-5_wp ! range around which t_su is considered at 0C 95 94 REAL(wp) :: zdti_bnd = 1.e-4_wp ! maximal authorized error on temperature 96 REAL(wp) :: zhs_min = 0.01_wp ! minimum snow thickness for conductivity calculation 95 REAL(wp) :: zhs_ssl = 0.03_wp ! surface scattering layer in the snow 96 REAL(wp) :: zhi_ssl = 0.10_wp ! surface scattering layer in the ice 97 REAL(wp) :: zh_min = 1.e-3_wp ! minimum ice/snow thickness for conduction 97 98 REAL(wp) :: ztmelts ! ice melting temperature 98 99 REAL(wp) :: zdti_max ! current maximal error on temperature 99 100 REAL(wp) :: zcpi ! Ice specific heat 100 101 REAL(wp) :: zhfx_err, zdq ! diag errors on heat 101 REAL(wp) :: zfac ! dummy factor 102 ! 103 REAL(wp), DIMENSION(jpij) :: isnow ! switch for presence (1) or absence (0) of snow 102 ! 103 REAL(wp), DIMENSION(jpij) :: zraext_s ! extinction coefficient of radiation in the snow 104 104 REAL(wp), DIMENSION(jpij) :: ztsub ! surface temperature at previous iteration 105 105 REAL(wp), DIMENSION(jpij) :: zh_i, z1_h_i ! ice layer thickness … … 124 124 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zkappa_s ! Kappa factor in the snow 125 125 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zeta_s ! Eta factor in the snow 126 REAL(wp), DIMENSION(jpij) :: zkappa_comb ! Combined snow and ice surface conductivity 126 127 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindterm ! 'Ind'ependent term 127 128 REAL(wp), DIMENSION(jpij,nlay_i+3) :: zindtbis ! Temporary 'ind'ependent term … … 130 131 REAL(wp), DIMENSION(jpij) :: zq_ini ! diag errors on heat 131 132 REAL(wp), DIMENSION(jpij) :: zghe ! G(he), th. conduct enhancement factor, mono-cat 133 REAL(wp), DIMENSION(jpij) :: za_s_fra ! ice fraction covered by snow 134 REAL(wp), DIMENSION(jpij) :: isnow ! snow presence (1) or not (0) 135 REAL(wp), DIMENSION(jpij) :: isnow_comb ! snow presence for met-office 132 136 ! 133 137 ! Mono-category … … 143 147 END DO 144 148 149 ! calculate ice fraction covered by snow for radiation 150 CALL ice_var_snwfra( h_s_1d(1:npti), za_s_fra(1:npti) ) 151 145 152 !------------------ 146 153 ! 1) Initialization 147 154 !------------------ 155 ! 156 ! extinction radiation in the snow 157 IF ( nn_qtrice == 0 ) THEN ! constant 158 zraext_s(1:npti) = rn_kappa_s 159 ELSEIF( nn_qtrice == 1 ) THEN ! depends on melting/freezing conditions 160 WHERE( t_su_1d(1:npti) < rt0 ) ; zraext_s(1:npti) = rn_kappa_sdry ! no surface melting 161 ELSEWHERE ; zraext_s(1:npti) = rn_kappa_smlt ! surface melting 162 END WHERE 163 ENDIF 164 ! 165 ! thicknesses 148 166 DO ji = 1, npti 149 isnow(ji) = 1._wp - MAX( 0._wp , SIGN(1._wp, - h_s_1d(ji) ) ) ! is there snow or not 150 ! layer thickness 151 zh_i(ji) = h_i_1d(ji) * r1_nlay_i 152 zh_s(ji) = h_s_1d(ji) * r1_nlay_s 167 ! ice thickness 168 IF( h_i_1d(ji) > 0._wp ) THEN 169 zh_i (ji) = MAX( zh_min , h_i_1d(ji) ) * r1_nlay_i ! set a minimum thickness for conduction 170 z1_h_i(ji) = 1._wp / zh_i(ji) ! it must be very small 171 ELSE 172 zh_i (ji) = 0._wp 173 z1_h_i(ji) = 0._wp 174 ENDIF 175 ! snow thickness 176 IF( h_s_1d(ji) > 0._wp ) THEN 177 zh_s (ji) = MAX( zh_min , h_s_1d(ji) ) * r1_nlay_s ! set a minimum thickness for conduction 178 z1_h_s(ji) = 1._wp / zh_s(ji) ! it must be very small 179 isnow (ji) = 1._wp 180 ELSE 181 zh_s (ji) = 0._wp 182 z1_h_s(ji) = 0._wp 183 isnow (ji) = 0._wp 184 ENDIF 185 ! for Met-Office 186 IF( h_s_1d(ji) < zh_min ) THEN 187 isnow_comb(ji) = h_s_1d(ji) / zh_min 188 ELSE 189 isnow_comb(ji) = 1._wp 190 ENDIF 153 191 END DO 154 ! 155 WHERE( zh_i(1:npti) >= epsi10 ) ; z1_h_i(1:npti) = 1._wp / zh_i(1:npti) 156 ELSEWHERE ; z1_h_i(1:npti) = 0._wp 157 END WHERE 158 ! 159 WHERE( zh_s(1:npti) > 0._wp ) zh_s(1:npti) = MAX( zhs_min * r1_nlay_s, zh_s(1:npti) ) 160 ! 161 WHERE( zh_s(1:npti) > 0._wp ) ; z1_h_s(1:npti) = 1._wp / zh_s(1:npti) 162 ELSEWHERE ; z1_h_s(1:npti) = 0._wp 163 END WHERE 192 ! clem: we should apply correction on snow thickness to take into account snow fraction 193 ! it must be a distribution, so it is a bit complicated 164 194 ! 165 195 ! Store initial temperatures and non solar heat fluxes 166 196 IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_EMU ) THEN 167 !168 197 ztsub (1:npti) = t_su_1d(1:npti) ! surface temperature at iteration n-1 169 198 ztsuold (1:npti) = t_su_1d(1:npti) ! surface temperature initial value … … 185 214 DO ji = 1, npti 186 215 ! ! radiation transmitted below the layer-th snow layer 187 zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * h_s_1d(ji) * r1_nlay_s * REAL(jk) )216 zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s(ji) * MAX( 0._wp, zh_s(ji) * REAL(jk) - zhs_ssl ) ) 188 217 ! ! radiation absorbed by the layer-th snow layer 189 218 zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk) … … 191 220 END DO 192 221 ! 193 zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - isnow(1:npti) )222 zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * za_s_fra(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - za_s_fra(1:npti) ) 194 223 DO jk = 1, nlay_i 195 224 DO ji = 1, npti 196 225 ! ! radiation transmitted below the layer-th ice layer 197 zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * zh_i(ji) * REAL(jk) ) 226 zradtr_i(ji,jk) = za_s_fra(ji) * zradtr_s(ji,nlay_s) & ! part covered by snow 227 & * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zh_min ) ) & 228 & + ( 1._wp - za_s_fra(ji) ) * qtr_ice_top_1d(ji) & ! part snow free 229 & * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) ) 198 230 ! ! radiation absorbed by the layer-th ice layer 199 231 zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) … … 203 235 qtr_ice_bot_1d(1:npti) = zradtr_i(1:npti,nlay_i) ! record radiation transmitted below the ice 204 236 ! 205 iconv 237 iconv = 0 ! number of iterations 206 238 ! 207 239 l_T_converged(:) = .FALSE. … … 230 262 DO ji = 1, npti 231 263 ztcond_i_cp(ji,jk) = rcnd_i + zbeta * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) / & 232 & MIN( -epsi10, 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 )264 & MIN( -epsi10, 0.5_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) ) - rt0 ) 233 265 END DO 234 266 END DO … … 238 270 DO ji = 1, npti 239 271 ztcond_i_cp(ji,0) = rcnd_i + 0.09_wp * sz_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) & 240 & - 0.011_wp * ( t_i_1d(ji,1) - rt0 )272 & - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 241 273 ztcond_i_cp(ji,nlay_i) = rcnd_i + 0.09_wp * sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 ) & 242 & - 0.011_wp * ( t_bo_1d(ji) - rt0 )274 & - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 243 275 END DO 244 276 DO jk = 1, nlay_i-1 245 277 DO ji = 1, npti 246 ztcond_i_cp(ji,jk) = rcnd_i + 0.09_wp * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) / 247 & MIN( -epsi10, 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 )&248 & - 0.011_wp * ( 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d(ji,jk+1) ) - rt0 )278 ztcond_i_cp(ji,jk) = rcnd_i + 0.09_wp * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) / & 279 & MIN( -epsi10, 0.5_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) ) - rt0 ) & 280 & - 0.011_wp * ( 0.5_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) ) - rt0 ) 249 281 END DO 250 282 END DO … … 290 322 END DO 291 323 DO ji = 1, npti ! Snow-ice interface 292 IF ( .NOT. l_T_converged(ji) ) THEN 293 zfac = 0.5_wp * ( ztcond_i(ji,0) * zh_s(ji) + rn_cnd_s * zh_i(ji) ) 294 IF( zfac > epsi10 ) THEN 295 zkappa_s(ji,nlay_s) = zghe(ji) * rn_cnd_s * ztcond_i(ji,0) / zfac 296 ELSE 297 zkappa_s(ji,nlay_s) = 0._wp 298 ENDIF 299 ENDIF 324 IF ( .NOT. l_T_converged(ji) ) & 325 zkappa_s(ji,nlay_s) = isnow(ji) * zghe(ji) * rn_cnd_s * ztcond_i(ji,0) & 326 & / ( 0.5_wp * ( ztcond_i(ji,0) * zh_s(ji) + rn_cnd_s * zh_i(ji) ) ) 300 327 END DO 301 328 … … 310 337 END DO 311 338 DO ji = 1, npti ! Snow-ice interface 312 IF ( .NOT. l_T_converged(ji) ) & 313 zkappa_i(ji,0) = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) ) 339 IF ( .NOT. l_T_converged(ji) ) THEN 340 ! Calculate combined surface snow and ice conductivity to pass through the coupler (met-office) 341 zkappa_comb(ji) = isnow_comb(ji) * zkappa_s(ji,0) + ( 1._wp - isnow_comb(ji) ) * zkappa_i(ji,0) 342 ! If there is snow then use the same snow-ice interface conductivity for the top layer of ice 343 IF( h_s_1d(ji) > 0._wp ) zkappa_i(ji,0) = zkappa_s(ji,nlay_s) 344 ENDIF 314 345 END DO 315 346 ! … … 320 351 DO ji = 1, npti 321 352 zcpi = rcpi + zgamma * sz_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztiold(ji,jk) - rt0 ), epsi10 ) 322 zeta_i(ji,jk) = rDt_ice * r1_rhoi * z1_h_i(ji) / MAX( epsi10, zcpi )353 zeta_i(ji,jk) = rDt_ice * r1_rhoi * z1_h_i(ji) / zcpi 323 354 END DO 324 355 END DO … … 544 575 ztsub(ji) = t_su_1d(ji) 545 576 IF( t_su_1d(ji) < rt0 ) THEN 546 t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) * &547 & ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) *t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji))577 t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) * & 578 & ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 548 579 ENDIF 549 580 ENDIF 550 581 END DO 582 !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 551 583 ! 552 584 !-------------------------------------------------------------- … … 561 593 562 594 IF ( .NOT. l_T_converged(ji) ) THEN 595 563 596 t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , rt0 ) , rt0 - 100._wp ) 564 597 zdti_max = MAX( zdti_max, ABS( t_su_1d(ji) - ztsub(ji) ) ) 565 598 566 t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 567 zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 599 IF( h_s_1d(ji) > 0._wp ) THEN 600 DO jk = 1, nlay_s 601 t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), rt0 - 100._wp ) 602 zdti_max = MAX ( zdti_max , ABS( t_s_1d(ji,jk) - ztsb(ji,jk) ) ) 603 END DO 604 ENDIF 568 605 569 606 DO jk = 1, nlay_i … … 572 609 zdti_max = MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 573 610 END DO 574 575 IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 611 612 ! convergence test 613 IF( ln_zdf_chkcvg ) THEN 614 tice_cvgerr_1d(ji) = zdti_max 615 tice_cvgstp_1d(ji) = REAL(iconv) 616 ENDIF 617 618 IF( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 576 619 577 620 ENDIF … … 726 769 ENDIF 727 770 END DO 771 !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 728 772 ! 729 773 !-------------------------------------------------------------- … … 738 782 739 783 IF ( .NOT. l_T_converged(ji) ) THEN 740 ! t_s 741 t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 742 zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 743 ! t_i 784 785 IF( h_s_1d(ji) > 0._wp ) THEN 786 DO jk = 1, nlay_s 787 t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), rt0 - 100._wp ) 788 zdti_max = MAX ( zdti_max , ABS( t_s_1d(ji,jk) - ztsb(ji,jk) ) ) 789 END DO 790 ENDIF 791 744 792 DO jk = 1, nlay_i 745 793 ztmelts = -rTmlt * sz_i_1d(ji,jk) + rt0 … … 748 796 END DO 749 797 750 IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 798 ! convergence test 799 IF( ln_zdf_chkcvg ) THEN 800 tice_cvgerr_1d(ji) = zdti_max 801 tice_cvgstp_1d(ji) = REAL(iconv) 802 ENDIF 803 804 IF( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 751 805 752 806 ENDIF … … 755 809 756 810 ENDIF ! k_cnd 757 811 758 812 END DO ! End of the do while iterative procedure 759 760 IF( ln_icectl .AND. lwp ) THEN761 WRITE(numout,*) ' zdti_max : ', zdti_max762 WRITE(numout,*) ' iconv : ', iconv763 ENDIF764 765 813 ! 766 814 !----------------------------- … … 771 819 ! bottom ice conduction flux 772 820 DO ji = 1, npti 773 qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1 821 qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 774 822 END DO 775 823 ! surface ice conduction flux … … 777 825 ! 778 826 DO ji = 1, npti 779 qcn_ice_top_1d(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) )&780 & 827 qcn_ice_top_1d(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 828 & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * ( t_i_1d(ji,1) - t_su_1d(ji) ) 781 829 END DO 782 830 ! … … 792 840 ! 793 841 DO ji = 1, npti 794 t_su_1d(ji) = ( qcn_ice_top_1d(ji) & ! calculate surface temperature 795 & + isnow(ji) * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) & 796 & + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * t_i_1d(ji,1) & 797 & ) / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 842 t_su_1d(ji) = ( qcn_ice_top_1d(ji) + isnow(ji) * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) + & 843 & ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * t_i_1d(ji,1) ) & 844 & / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 798 845 t_su_1d(ji) = MAX( MIN( t_su_1d(ji), rt0 ), rt0 - 100._wp ) ! cap t_su 799 846 END DO … … 853 900 !-------------------------------------------------------------------- 854 901 ! effective conductivity and 1st layer temperature (needed by Met Office) 902 ! this is a conductivity at mid-layer, hence the factor 2 855 903 DO ji = 1, npti 856 IF( h_s_1d(ji) > 0.1_wp ) THEN 857 cnd_ice_1d(ji) = 2._wp * zkappa_s(ji,0) 904 IF( h_i_1d(ji) >= zhi_ssl ) THEN 905 cnd_ice_1d(ji) = 2._wp * zkappa_comb(ji) 906 !!cnd_ice_1d(ji) = 2._wp * zkappa_i(ji,0) 858 907 ELSE 859 IF( h_i_1d(ji) > 0.1_wp ) THEN 860 cnd_ice_1d(ji) = 2._wp * zkappa_i(ji,0) 861 ELSE 862 cnd_ice_1d(ji) = 2._wp * ztcond_i(ji,0) * 10._wp 863 ENDIF 908 cnd_ice_1d(ji) = 2._wp * ztcond_i(ji,0) / zhi_ssl ! cnd_ice is capped by: cond_i/zhi_ssl 864 909 ENDIF 865 910 t1_ice_1d(ji) = isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) … … 877 922 DO ji = 1, npti 878 923 !--- Snow-ice interfacial temperature (diagnostic SIMIP) 879 zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji) 880 IF( h_s_1d(ji) >= zhs_min ) THEN 881 t_si_1d(ji) = ( rn_cnd_s * zh_i(ji) * t_s_1d(ji,1) + & 882 & ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac ) 924 IF( h_s_1d(ji) >= zhs_ssl ) THEN 925 t_si_1d(ji) = ( rn_cnd_s * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji,1) & 926 & + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1) ) & 927 & / ( rn_cnd_s * h_i_1d(ji) * r1_nlay_i & 928 & + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s ) 883 929 ELSE 884 930 t_si_1d(ji) = t_su_1d(ji) -
NEMO/trunk/src/ICE/iceupdate.F90
r13295 r13472 25 25 USE icectl ! sea-ice: control prints 26 26 USE bdy_oce , ONLY : ln_bdy 27 USE zdfdrg , ONLY : ln_drgice_imp 27 28 ! 28 29 USE in_out_manager ! I/O manager … … 93 94 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 94 95 REAL(wp) :: zqsr ! New solar flux received by the ocean 95 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 96 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_cs, zalb_os ! 3D workspace 96 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 97 97 !!--------------------------------------------------------------------- 98 98 IF( ln_timing ) CALL timing_start('ice_update') … … 182 182 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 183 183 !------------------------------------------------------------------ 184 CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 185 ! 186 alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 184 CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) ! ice albedo 185 187 186 ! 188 187 IF( lrst_ice ) THEN !* write snwice_mass fields in the restart file … … 320 319 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar 321 320 REAL(wp) :: zat_v, zvtau_ice, zv_t, zrhoco ! - - 321 REAL(wp) :: zflagi ! - - 322 322 !!--------------------------------------------------------------------- 323 323 IF( ln_timing ) CALL timing_start('ice_update_tau') … … 350 350 ! 351 351 ! !== every ocean time-step ==! 352 IF ( ln_drgice_imp ) THEN 353 ! Save drag with right sign to update top drag in the ocean implicit friction 354 rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1) 355 zflagi = 0._wp 356 ELSE 357 zflagi = 1._wp 358 ENDIF 352 359 ! 353 360 DO_2D( 0, 0, 0, 0 ) -
NEMO/trunk/src/ICE/icevar.F90
r13295 r13472 51 51 !! ice_var_sshdyn : compute equivalent ssh in lead 52 52 !! ice_var_itd : convert N-cat to M-cat 53 !! ice_var_snwfra : fraction of ice covered by snow 54 !! ice_var_snwblow : distribute snow fall between ice and ocean 53 55 !!---------------------------------------------------------------------- 54 56 USE dom_oce ! ocean space and time domain … … 77 79 PUBLIC ice_var_sshdyn 78 80 PUBLIC ice_var_itd 81 PUBLIC ice_var_snwfra 82 PUBLIC ice_var_snwblow 79 83 80 84 INTERFACE ice_var_itd … … 84 88 !! * Substitutions 85 89 # include "do_loop_substitute.h90" 90 91 INTERFACE ice_var_snwfra 92 MODULE PROCEDURE ice_var_snwfra_1d, ice_var_snwfra_2d, ice_var_snwfra_3d 93 END INTERFACE 94 95 INTERFACE ice_var_snwblow 96 MODULE PROCEDURE ice_var_snwblow_1d, ice_var_snwblow_2d 97 END INTERFACE 98 86 99 !!---------------------------------------------------------------------- 87 100 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 115 128 at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 116 129 vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) 130 vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 117 131 ! 118 132 ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction … … 166 180 ! 167 181 ! ! mean melt pond depth 168 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 169 ELSEWHERE ; hm_ip(:,:) = 0._wp 182 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) ; hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 183 ELSEWHERE ; hm_ip(:,:) = 0._wp ; hm_il(:,:) = 0._wp 170 184 END WHERE 171 185 ! … … 191 205 REAL(wp) :: zhmax, z1_zhmax ! - - 192 206 REAL(wp) :: zlay_i, zlay_s ! - - 193 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i 207 REAL(wp), PARAMETER :: zhl_max = 0.015_wp ! pond lid thickness above which the ponds disappear from the albedo calculation 208 REAL(wp), PARAMETER :: zhl_min = 0.005_wp ! pond lid thickness below which the full pond area is used in the albedo calculation 209 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i, z1_a_ip, za_s_fra 194 210 !!------------------------------------------------------------------- 195 211 … … 210 226 ELSEWHERE ; z1_v_i(:,:,:) = 0._wp 211 227 END WHERE 228 ! 229 WHERE( a_ip(:,:,:) > epsi20 ) ; z1_a_ip(:,:,:) = 1._wp / a_ip(:,:,:) 230 ELSEWHERE ; z1_a_ip(:,:,:) = 0._wp 231 END WHERE 212 232 ! !--- ice thickness 213 233 h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:) … … 224 244 ! !--- ice age 225 245 o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:) 226 ! !--- pond fraction and thickness 246 ! !--- pond and lid thickness 247 h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) 248 h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) 249 ! !--- melt pond effective area (used for albedo) 227 250 a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:) 228 WHERE( a_ip_frac(:,:,:) > epsi20 ) ; h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 229 ELSEWHERE ; h_ip(:,:,:) = 0._wp 230 END WHERE 251 WHERE ( h_il(:,:,:) <= zhl_min ) ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) ! lid is very thin. Expose all the pond 252 ELSEWHERE( h_il(:,:,:) >= zhl_max ) ; a_ip_eff(:,:,:) = 0._wp ! lid is very thick. Cover all the pond up with ice and snow 253 ELSEWHERE ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * & ! lid is in between. Expose part of the pond 254 & ( h_il(:,:,:) - zhl_min ) / ( zhl_max - zhl_min ) 255 END WHERE 256 ! 257 CALL ice_var_snwfra( h_s, za_s_fra ) ! calculate ice fraction covered by snow 258 a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra ) ! make sure (a_ip_eff + a_s_fra) <= 1 231 259 ! 232 260 ! !--- salinity (with a minimum value imposed everywhere) … … 292 320 sv_i(:,:,:) = s_i (:,:,:) * v_i (:,:,:) 293 321 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 322 v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 294 323 ! 295 324 END SUBROUTINE ice_var_eqv2glo … … 521 550 a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 522 551 v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 552 v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 523 553 ! 524 554 END_2D … … 542 572 543 573 544 SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, p e_s, pe_i )574 SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 545 575 !!------------------------------------------------------------------- 546 576 !! *** ROUTINE ice_var_zapneg *** … … 557 587 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 558 588 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 589 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_il ! melt pond lid volume 559 590 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content 560 591 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content … … 613 644 WHERE( pa_ip (:,:,:) < 0._wp ) pa_ip (:,:,:) = 0._wp 614 645 WHERE( pv_ip (:,:,:) < 0._wp ) pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 615 !but it does not change conservation, so keep it this way is ok646 WHERE( pv_il (:,:,:) < 0._wp ) pv_il (:,:,:) = 0._wp ! but it does not change conservation, so keep it this way is ok 616 647 ! 617 648 END SUBROUTINE ice_var_zapneg 618 649 619 650 620 SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, p e_s, pe_i )651 SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 621 652 !!------------------------------------------------------------------- 622 653 !! *** ROUTINE ice_var_roundoff *** … … 631 662 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 632 663 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_ip ! melt pond volume 664 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pv_il ! melt pond lid volume 633 665 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_s ! snw heat content 634 666 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe_i ! ice heat content … … 643 675 WHERE( pe_i (1:npti,:,:) < 0._wp ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 644 676 WHERE( pe_s (1:npti,:,:) < 0._wp ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 645 IF( ln_pnd_ H12) THEN677 IF( ln_pnd_LEV ) THEN 646 678 WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 647 679 WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 680 IF( ln_pnd_lids ) THEN 681 WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:) = 0._wp ! v_il must be >= 0 682 ENDIF 648 683 ENDIF 649 684 ! … … 764 799 !! ** Purpose : converting N-cat ice to jpl ice categories 765 800 !!------------------------------------------------------------------- 766 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, &767 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip)801 SUBROUTINE ice_var_itd_1c1c( phti, phts, pati , ph_i, ph_s, pa_i, & 802 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 768 803 !!------------------------------------------------------------------- 769 804 !! ** Purpose : converting 1-cat ice to 1 ice category … … 771 806 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 772 807 REAL(wp), DIMENSION(:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 773 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds774 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds808 REAL(wp), DIMENSION(:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 809 REAL(wp), DIMENSION(:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 775 810 !!------------------------------------------------------------------- 776 811 ! == thickness and concentration == ! … … 786 821 pa_ip(:) = patip(:) 787 822 ph_ip(:) = phtip(:) 823 ph_il(:) = phtil(:) 788 824 789 825 END SUBROUTINE ice_var_itd_1c1c 790 826 791 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, &792 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip)827 SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati , ph_i, ph_s, pa_i, & 828 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 793 829 !!------------------------------------------------------------------- 794 830 !! ** Purpose : converting N-cat ice to 1 ice category … … 796 832 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 797 833 REAL(wp), DIMENSION(:) , INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 798 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds799 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds834 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 835 REAL(wp), DIMENSION(:) , INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 800 836 ! 801 837 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs … … 832 868 ! == ponds == ! 833 869 pa_ip(:) = SUM( patip(:,:), dim=2 ) 834 WHERE( pa_ip(:) /= 0._wp ) ; ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 835 ELSEWHERE ; ph_ip(:) = 0._wp 870 WHERE( pa_ip(:) /= 0._wp ) 871 ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 872 ph_il(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 873 ELSEWHERE 874 ph_ip(:) = 0._wp 875 ph_il(:) = 0._wp 836 876 END WHERE 837 877 ! … … 840 880 END SUBROUTINE ice_var_itd_Nc1c 841 881 842 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, &843 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip)882 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, & 883 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 844 884 !!------------------------------------------------------------------- 845 885 !! … … 863 903 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 864 904 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 865 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds866 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds905 REAL(wp), DIMENSION(:) , INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 906 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 867 907 ! 868 908 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zfra, z1_hti … … 954 994 pt_su(:,jl) = ptmsu(:) 955 995 ps_i (:,jl) = psmi (:) 956 ps_i (:,jl) = psmi (:)957 996 END DO 958 997 ! … … 975 1014 END WHERE 976 1015 END DO 1016 ! keep the same v_il/v_i ratio for each category 1017 WHERE( ( phti(:) * pati(:) ) /= 0._wp ) ; zfra(:) = ( phtil(:) * patip(:) ) / ( phti(:) * pati(:) ) 1018 ELSEWHERE ; zfra(:) = 0._wp 1019 END WHERE 1020 DO jl = 1, jpl 1021 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1022 ELSEWHERE ; ph_il(:,jl) = 0._wp 1023 END WHERE 1024 END DO 977 1025 DEALLOCATE( zfra ) 978 1026 ! 979 1027 END SUBROUTINE ice_var_itd_1cMc 980 1028 981 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, &982 & ptmi, ptms, ptmsu, psmi, patip, phtip, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip)1029 SUBROUTINE ice_var_itd_NcMc( phti, phts, pati , ph_i, ph_s, pa_i, & 1030 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 983 1031 !!------------------------------------------------------------------- 984 1032 !! … … 995 1043 !! 996 1044 !! 2) Expand the filling to the cat jlmin-1 and jlmax+1 997 1045 !! by removing 25% ice area from jlmin and jlmax (resp.) 998 1046 !! 999 1047 !! 3) Expand the filling to the empty cat between jlmin and jlmax … … 1011 1059 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables 1012 1060 REAL(wp), DIMENSION(:,:), INTENT(inout) :: ph_i, ph_s, pa_i ! output ice/snow variables 1013 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip ! input ice/snow temp & sal & ponds1014 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ! output ice/snow temp & sal & ponds1061 REAL(wp), DIMENSION(:,:), INTENT(in) :: ptmi, ptms, ptmsu, psmi, patip, phtip, phtil ! input ice/snow temp & sal & ponds 1062 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ! output ice/snow temp & sal & ponds 1015 1063 ! 1016 1064 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: jlfil, jlfil2 … … 1041 1089 pa_ip(:,:) = patip(:,:) 1042 1090 ph_ip(:,:) = phtip(:,:) 1091 ph_il(:,:) = phtil(:,:) 1043 1092 ! ! ---------------------- ! 1044 1093 ELSEIF( icat == 1 ) THEN ! input cat = 1 ! … … 1046 1095 CALL ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 1047 1096 & ph_i(:,:), ph_s(:,:), pa_i (:,:), & 1048 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), &1049 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:) )1097 & ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), phtil(:,1), & 1098 & pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:), ph_il(:,:) ) 1050 1099 ! ! ---------------------- ! 1051 1100 ELSEIF( jpl == 1 ) THEN ! output cat = 1 ! … … 1053 1102 CALL ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 1054 1103 & ph_i(:,1), ph_s(:,1), pa_i (:,1), & 1055 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), &1056 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1) )1104 & ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), phtil(:,:), & 1105 & pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1), ph_il(:,1) ) 1057 1106 ! ! ----------------------- ! 1058 1107 ELSE ! input cat /= output cat ! … … 1196 1245 END WHERE 1197 1246 END DO 1247 ! keep the same v_il/v_i ratio for each category 1248 WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 1249 zfra(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 1250 ELSEWHERE 1251 zfra(:) = 0._wp 1252 END WHERE 1253 DO jl = 1, jpl 1254 WHERE( pa_ip(:,jl) /= 0._wp ) ; ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 1255 ELSEWHERE ; ph_il(:,jl) = 0._wp 1256 END WHERE 1257 END DO 1198 1258 DEALLOCATE( zfra ) 1199 1259 ! … … 1201 1261 ! 1202 1262 END SUBROUTINE ice_var_itd_NcMc 1263 1264 !!------------------------------------------------------------------- 1265 !! INTERFACE ice_var_snwfra 1266 !! 1267 !! ** Purpose : fraction of ice covered by snow 1268 !! 1269 !! ** Method : In absence of proper snow model on top of sea ice, 1270 !! we argue that snow does not cover the whole ice because 1271 !! of wind blowing... 1272 !! 1273 !! ** Arguments : ph_s: snow thickness 1274 !! 1275 !! ** Output : pa_s_fra: fraction of ice covered by snow 1276 !! 1277 !!------------------------------------------------------------------- 1278 SUBROUTINE ice_var_snwfra_3d( ph_s, pa_s_fra ) 1279 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ph_s ! snow thickness 1280 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow 1281 IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover 1282 WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 1283 ELSEWHERE ; pa_s_fra = 0._wp 1284 END WHERE 1285 ELSEIF( nn_snwfra == 1 ) THEN ! snow cover depends on hsnow (met-office style) 1286 pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 1287 ELSEIF( nn_snwfra == 2 ) THEN ! snow cover depends on hsnow (cice style) 1288 pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 1289 ENDIF 1290 END SUBROUTINE ice_var_snwfra_3d 1291 1292 SUBROUTINE ice_var_snwfra_2d( ph_s, pa_s_fra ) 1293 REAL(wp), DIMENSION(:,:), INTENT(in ) :: ph_s ! snow thickness 1294 REAL(wp), DIMENSION(:,:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow 1295 IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover 1296 WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 1297 ELSEWHERE ; pa_s_fra = 0._wp 1298 END WHERE 1299 ELSEIF( nn_snwfra == 1 ) THEN ! snow cover depends on hsnow (met-office style) 1300 pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 1301 ELSEIF( nn_snwfra == 2 ) THEN ! snow cover depends on hsnow (cice style) 1302 pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 1303 ENDIF 1304 END SUBROUTINE ice_var_snwfra_2d 1305 1306 SUBROUTINE ice_var_snwfra_1d( ph_s, pa_s_fra ) 1307 REAL(wp), DIMENSION(:), INTENT(in ) :: ph_s ! snow thickness 1308 REAL(wp), DIMENSION(:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow 1309 IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover 1310 WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 1311 ELSEWHERE ; pa_s_fra = 0._wp 1312 END WHERE 1313 ELSEIF( nn_snwfra == 1 ) THEN ! snow cover depends on hsnow (met-office style) 1314 pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 1315 ELSEIF( nn_snwfra == 2 ) THEN ! snow cover depends on hsnow (cice style) 1316 pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 1317 ENDIF 1318 END SUBROUTINE ice_var_snwfra_1d 1319 1320 !!-------------------------------------------------------------------------- 1321 !! INTERFACE ice_var_snwblow 1322 !! 1323 !! ** Purpose : Compute distribution of precip over the ice 1324 !! 1325 !! Snow accumulation in one thermodynamic time step 1326 !! snowfall is partitionned between leads and ice. 1327 !! If snow fall was uniform, a fraction (1-at_i) would fall into leads 1328 !! but because of the winds, more snow falls on leads than on sea ice 1329 !! and a greater fraction (1-at_i)^beta of the total mass of snow 1330 !! (beta < 1) falls in leads. 1331 !! In reality, beta depends on wind speed, 1332 !! and should decrease with increasing wind speed but here, it is 1333 !! considered as a constant. an average value is 0.66 1334 !!-------------------------------------------------------------------------- 1335 !!gm I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE.... 1336 SUBROUTINE ice_var_snwblow_2d( pin, pout ) 1337 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pin ! previous fraction lead ( 1. - a_i_b ) 1338 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 1339 pout = ( 1._wp - ( pin )**rn_snwblow ) 1340 END SUBROUTINE ice_var_snwblow_2d 1341 1342 SUBROUTINE ice_var_snwblow_1d( pin, pout ) 1343 REAL(wp), DIMENSION(:), INTENT(in ) :: pin 1344 REAL(wp), DIMENSION(:), INTENT(inout) :: pout 1345 pout = ( 1._wp - ( pin )**rn_snwblow ) 1346 END SUBROUTINE ice_var_snwblow_1d 1203 1347 1204 1348 #else -
NEMO/trunk/src/ICE/icewri.F90
r13295 r13472 114 114 IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip * zmsk00 ) ! melt pond depth 115 115 IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip * zmsk00 ) ! melt pond total volume per unit area 116 IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il * zmsk00 ) ! melt pond lid depth 117 IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il * zmsk00 ) ! melt pond lid total volume per unit area 116 118 ! salt 117 119 IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity … … 158 160 IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i * 100. * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 159 161 IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip * zmsk00l ) ! melt pond frac for categories 160 IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories 162 IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories 163 IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 161 164 IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac * zmsk00l ) ! melt pond frac for categories 165 IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff * zmsk00l ) ! melt pond effective frac for categories 162 166 IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 163 167 … … 173 177 IF( iom_use('dmisum') ) CALL iom_put( 'dmisum', - wfx_sum ) ! Sea-ice mass change through surface melting 174 178 IF( iom_use('dmibom') ) CALL iom_put( 'dmibom', - wfx_bom ) ! Sea-ice mass change through bottom melting 179 IF( iom_use('dmilam') ) CALL iom_put( 'dmilam', - wfx_lam ) ! Sea-ice mass change through lateral melting 175 180 IF( iom_use('dmtsub') ) CALL iom_put( 'dmtsub', - wfx_sub ) ! Sea-ice mass change through evaporation and sublimation 176 181 IF( iom_use('dmssub') ) CALL iom_put( 'dmssub', - wfx_snw_sub ) ! Snow mass change through sublimation -
NEMO/trunk/src/NST/agrif_ice_interp.F90
r13286 r13472 176 176 ptab(i1:i2,j1:j2,jm+5) = a_ip(i1:i2,j1:j2,jl) 177 177 ptab(i1:i2,j1:j2,jm+6) = v_ip(i1:i2,j1:j2,jl) 178 ptab(i1:i2,j1:j2,jm+7) = t_su(i1:i2,j1:j2,jl) 179 jm = jm + 8 178 ptab(i1:i2,j1:j2,jm+7) = v_il(i1:i2,j1:j2,jl) 179 ptab(i1:i2,j1:j2,jm+8) = t_su(i1:i2,j1:j2,jl) 180 jm = jm + 9 180 181 DO jk = 1, nlay_s 181 182 ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 … … 206 207 a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1) 207 208 v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1) 208 t_su(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1) 209 v_il(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1) 210 t_su(ji,jj,jl) = ptab(ji,jj,jm+8) * tmask(ji,jj,1) 209 211 END DO 210 212 END DO 211 jm = jm + 8213 jm = jm + 9 212 214 ! 213 215 DO jk = 1, nlay_s … … 239 241 ! ztab(:,:,jm+5) = a_ip(:,:,jl) 240 242 ! ztab(:,:,jm+6) = v_ip(:,:,jl) 241 ! ztab(:,:,jm+7) = t_su(:,:,jl) 242 ! jm = jm + 8 243 ! ztab(:,:,jm+7) = v_il(:,:,jl) 244 ! ztab(:,:,jm+8) = t_su(:,:,jl) 245 ! jm = jm + 9 243 246 ! DO jk = 1, nlay_s 244 247 ! ztab(:,:,jm) = e_s(:,:,jk,jl) … … 345 348 ! a_ip(ji,jj,jl) = ztab(ji,jj,jm+5) * tmask(ji,jj,1) 346 349 ! v_ip(ji,jj,jl) = ztab(ji,jj,jm+6) * tmask(ji,jj,1) 347 ! t_su(ji,jj,jl) = ztab(ji,jj,jm+7) * tmask(ji,jj,1) 350 ! v_il(ji,jj,jl) = ztab(ji,jj,jm+7) * tmask(ji,jj,1) 351 ! t_su(ji,jj,jl) = ztab(ji,jj,jm+8) * tmask(ji,jj,1) 348 352 ! END DO 349 353 ! END DO 350 ! jm = jm + 8354 ! jm = jm + 9 351 355 ! ! 352 356 ! DO jk = 1, nlay_s -
NEMO/trunk/src/NST/agrif_ice_update.F90
r13216 r13472 109 109 ptab(i1:i2,j1:j2,jm+5) = a_ip(i1:i2,j1:j2,jl) 110 110 ptab(i1:i2,j1:j2,jm+6) = v_ip(i1:i2,j1:j2,jl) 111 ptab(i1:i2,j1:j2,jm+7) = t_su(i1:i2,j1:j2,jl) 112 jm = jm + 8 111 ptab(i1:i2,j1:j2,jm+7) = v_il(i1:i2,j1:j2,jl) 112 ptab(i1:i2,j1:j2,jm+8) = t_su(i1:i2,j1:j2,jl) 113 jm = jm + 9 113 114 DO jk = 1, nlay_s 114 115 ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 … … 138 139 a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1) 139 140 v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1) 140 t_su(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1) 141 v_il(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1) 142 t_su(ji,jj,jl) = ptab(ji,jj,jm+8) * tmask(ji,jj,1) 141 143 ENDIF 142 144 END DO 143 145 END DO 144 jm = jm + 8146 jm = jm + 9 145 147 ! 146 148 DO jk = 1, nlay_s -
NEMO/trunk/src/NST/agrif_user.F90
r13295 r13472 663 663 ind2 = nn_hls + 2 + nbghostcells_x 664 664 ind3 = nn_hls + 2 + nbghostcells_y_s 665 ipl = jpl*( 8+nlay_s+nlay_i)665 ipl = jpl*(9+nlay_s+nlay_i) 666 666 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 667 667 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id) -
NEMO/trunk/src/OCE/BDY/bdy_oce.F90
r12377 r13472 63 63 REAL(wp), POINTER, DIMENSION(:,:) :: aip !: now ice pond concentration 64 64 REAL(wp), POINTER, DIMENSION(:,:) :: hip !: now ice pond depth 65 REAL(wp), POINTER, DIMENSION(:,:) :: hil !: now ice pond lid depth 65 66 #if defined key_top 66 67 CHARACTER(LEN=20) :: cn_obc !: type of boundary condition to apply … … 115 116 REAL(wp), DIMENSION(jp_bdy) :: rice_apnd !: pond conc. of incoming sea ice 116 117 REAL(wp), DIMENSION(jp_bdy) :: rice_hpnd !: pond thick. of incoming sea ice 118 REAL(wp), DIMENSION(jp_bdy) :: rice_hlid !: pond lid thick. of incoming sea ice 117 119 ! 118 120 !!---------------------------------------------------------------------- -
NEMO/trunk/src/OCE/BDY/bdydta.F90
r13237 r13472 43 43 PUBLIC bdy_dta_init ! routine called by nemogcm.F90 44 44 45 INTEGER , PARAMETER :: jpbdyfld = 1 6! maximum number of files to read45 INTEGER , PARAMETER :: jpbdyfld = 17 ! maximum number of files to read 46 46 INTEGER , PARAMETER :: jp_bdyssh = 1 ! 47 47 INTEGER , PARAMETER :: jp_bdyu2d = 2 ! … … 60 60 INTEGER , PARAMETER :: jp_bdyaip = 15 ! 61 61 INTEGER , PARAMETER :: jp_bdyhip = 16 ! 62 INTEGER , PARAMETER :: jp_bdyhil = 17 ! 62 63 #if ! defined key_si3 63 64 INTEGER , PARAMETER :: jpl = 1 … … 187 188 dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1) 188 189 dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1) 190 dta_bdy(jbdy)%hil(ib,jl) = h_il(ii,ij,jl) * tmask(ii,ij,1) 189 191 END DO 190 192 END DO … … 289 291 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) bf_alias(jp_bdytsu)%fnow(:,1,:) = rice_tem (jbdy) 290 292 IF( TRIM(bf_alias(jp_bdys_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdys_i)%fnow(:,1,:) = rice_sal (jbdy) 291 IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * &! rice_apnd is the pond fraction292 & bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd *a_i )293 IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' ) & ! rice_apnd is the pond fraction 294 & bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd*a_i ) 293 295 IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 294 296 IF( TRIM(bf_alias(jp_bdyhil)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhil)%fnow(:,1,:) = rice_hlid(jbdy) 297 295 298 ! if T_i is read and not T_su, set T_su = T_i 296 299 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) & … … 316 319 bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 317 320 bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 321 bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 322 ENDIF 323 IF ( .NOT.ln_pnd_lids ) THEN 324 bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 318 325 ENDIF 319 326 … … 321 328 ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3) 322 329 IF( ipl /= jpl ) THEN ! ice: convert N-cat fields (input) into jpl-cat (output) 323 CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & 324 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & 325 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 326 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 327 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), &328 & dta_alias%t_i , dta_alias%t_s , & 329 & dta_alias%tsu , dta_alias%s_i , & 330 & dta_alias%aip , dta_alias%hip )330 CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & ! in 331 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & ! out 332 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & ! in (optional) 333 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & ! in - 334 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), bf_alias(jp_bdyhil)%fnow(:,1,:), & ! in - 335 & dta_alias%t_i , dta_alias%t_s , & ! out - 336 & dta_alias%tsu , dta_alias%s_i , & ! out - 337 & dta_alias%aip , dta_alias%hip , dta_alias%hil ) ! out - 331 338 ENDIF 332 339 ENDIF … … 374 381 ! ! =F => baroclinic velocities in 3D boundary data 375 382 LOGICAL :: ln_zinterp ! =T => requires a vertical interpolation of the bdydta 376 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 383 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 377 384 INTEGER :: ipk,ipl ! 378 385 INTEGER :: idvar ! variable ID … … 387 394 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 388 395 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 389 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip 396 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil 390 397 TYPE(FLD_N), DIMENSION(:), POINTER :: bn_alias ! must be an array to be used with fld_fill 391 398 TYPE(FLD ), DIMENSION(:), POINTER :: bf_alias 392 399 ! 393 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 394 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip395 NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd396 NAMELIST/nambdy_dta/ln_full_vel, ln_zinterp400 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d, & 401 & bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil, & 402 & rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid, & 403 & ln_full_vel, ln_zinterp 397 404 !!--------------------------------------------------------------------------- 398 405 ! … … 464 471 #if defined key_si3 465 472 IF( .NOT.ln_pnd ) THEN 466 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 467 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 473 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. ; rn_ice_hlid = 0. 474 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 & rn_ice_hlid = 0 when no ponds' ) 475 ENDIF 476 IF( .NOT.ln_pnd_lids ) THEN 477 rn_ice_hlid = 0. 468 478 ENDIF 469 479 #endif … … 475 485 rice_apnd(jbdy) = rn_ice_apnd 476 486 rice_hpnd(jbdy) = rn_ice_hpnd 477 487 rice_hlid(jbdy) = rn_ice_hlid 488 478 489 479 490 DO jfld = 1, jpbdyfld … … 576 587 IF( jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 577 588 & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 578 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip 589 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip .OR. jfld == jp_bdyhil ) THEN 579 590 igrd = 1 ! T point 580 591 ipk = ipl ! jpl-cat data … … 627 638 bf_alias => bf(jp_bdyhip,jbdy:jbdy) ! alias for hip structure of bdy number jbdy 628 639 bn_alias => bn_hip ! alias for hip structure of nambdy_dta 640 ENDIF 641 IF( jfld == jp_bdyhil ) THEN 642 cl3 = 'hil' 643 bf_alias => bf(jp_bdyhil,jbdy:jbdy) ! alias for hil structure of bdy number jbdy 644 bn_alias => bn_hil ! alias for hil structure of nambdy_dta 629 645 ENDIF 630 646 … … 696 712 ENDIF 697 713 ENDIF 714 IF( jfld == jp_bdyhil ) THEN 715 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%hil => bf_alias(1)%fnow(:,1,:) 716 ELSE ; ALLOCATE( dta_bdy(jbdy)%hil(iszdim,jpl) ) 717 ENDIF 718 ENDIF 698 719 ENDIF 699 720 -
NEMO/trunk/src/OCE/BDY/bdyice.F90
r13226 r13472 94 94 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 95 95 ! exchange 3d arrays 96 CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1.0_wp, h_i , 'T', 1.0_wp, h_s , 'T', 1.0_wp, oa_i, 'T', 1.0_wp&97 & , a_ip, 'T', 1.0_wp, v_ip, 'T', 1.0_wp, s_i , 'T', 1.0_wp, t_su, 'T', 1.0_wp &98 & , v_i , 'T', 1.0_wp, v_s , 'T', 1.0_wp, sv_i, 'T', 1.0_wp&99 & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1)96 CALL lbc_lnk_multi('bdyice', a_i , 'T', 1._wp, h_i , 'T', 1._wp, h_s , 'T', 1._wp, oa_i, 'T', 1._wp & 97 & , s_i , 'T', 1._wp, t_su, 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp & 98 & , a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp & 99 & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 100 100 ! exchange 4d arrays : third dimension = 1 and then third dimension = jpk 101 CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1.0_wp, e_s , 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )102 CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1.0_wp, e_i , 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )101 CALL lbc_lnk_multi('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 102 CALL lbc_lnk_multi('bdyice', t_i , 'T', 1._wp, e_i , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 103 103 END IF 104 104 END DO ! ir … … 163 163 a_ip(ji,jj, jl) = ( a_ip(ji,jj, jl) * zwgt1 + dta%aip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond concentration 164 164 h_ip(ji,jj, jl) = ( h_ip(ji,jj, jl) * zwgt1 + dta%hip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond depth 165 h_il(ji,jj, jl) = ( h_il(ji,jj, jl) * zwgt1 + dta%hil(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond lid depth 165 166 ! 166 167 sz_i(ji,jj,:,jl) = s_i(ji,jj,jl) … … 170 171 a_ip(ji,jj,jl) = 0._wp 171 172 h_ip(ji,jj,jl) = 0._wp 173 h_il(ji,jj,jl) = 0._wp 174 ENDIF 175 176 IF( .NOT.ln_pnd_lids ) THEN 177 h_il(ji,jj,jl) = 0._wp 172 178 ENDIF 173 179 ! … … 231 237 a_ip(ji,jj, jl) = a_ip(ib,jb, jl) 232 238 h_ip(ji,jj, jl) = h_ip(ib,jb, jl) 239 h_il(ji,jj, jl) = h_il(ib,jb, jl) 233 240 ! 234 241 sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) … … 265 272 ! 266 273 ! melt ponds 267 IF( a_i(ji,jj,jl) > epsi10 ) THEN268 a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i (ji,jj,jl)269 ELSE270 a_ip_frac(ji,jj,jl) = 0._wp271 ENDIF272 274 v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) 275 v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) 273 276 ! 274 277 ELSE ! no ice at the boundary … … 278 281 h_s (ji,jj, jl) = 0._wp 279 282 oa_i(ji,jj, jl) = 0._wp 280 a_ip(ji,jj, jl) = 0._wp281 v_ip(ji,jj, jl) = 0._wp282 283 t_su(ji,jj, jl) = rt0 283 284 t_s (ji,jj,:,jl) = rt0 284 285 t_i (ji,jj,:,jl) = rt0 285 286 286 a_ip_frac(ji,jj,jl) = 0._wp 287 h_ip (ji,jj,jl) = 0._wp 288 a_ip (ji,jj,jl) = 0._wp 289 v_ip (ji,jj,jl) = 0._wp 287 a_ip(ji,jj,jl) = 0._wp 288 h_ip(ji,jj,jl) = 0._wp 289 h_il(ji,jj,jl) = 0._wp 290 290 291 291 IF( nn_icesal == 1 ) THEN ! if constant salinity … … 303 303 e_s (ji,jj,:,jl) = 0._wp 304 304 e_i (ji,jj,:,jl) = 0._wp 305 v_ip(ji,jj, jl) = 0._wp 306 v_il(ji,jj, jl) = 0._wp 305 307 306 308 ENDIF -
NEMO/trunk/src/OCE/CRS/crsfld.F90
r13295 r13472 146 146 CALL iom_put( "voces" , zs_crs ) ! vS 147 147 148 IF( iom_use( " eken") ) THEN ! kinetic energy148 IF( iom_use( "ke") ) THEN ! kinetic energy 149 149 z3d(:,:,jk) = 0._wp 150 150 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) … … 159 159 ! 160 160 CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 161 CALL iom_put( " eken", zt_crs )161 CALL iom_put( "ke", zt_crs ) 162 162 ENDIF 163 163 ! Horizontal divergence ( following OCE/DYN/divhor.F90 ) -
NEMO/trunk/src/OCE/DIA/diawri.F90
r13295 r13472 118 118 INTEGER :: ji, jj, jk ! dummy loop indices 119 119 INTEGER :: ikbot ! local integer 120 REAL(wp):: ze3 120 121 REAL(wp):: zztmp , zztmpx ! local scalar 121 122 REAL(wp):: zztmp2, zztmpy ! - - … … 175 176 CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature 176 177 IF ( iom_use("sbt") ) THEN 177 DO_2D( 1, 1, 1, 1)178 DO_2D( 0, 0, 0, 0 ) 178 179 ikbot = mbkt(ji,jj) 179 180 z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) … … 185 186 CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity 186 187 IF ( iom_use("sbs") ) THEN 187 DO_2D( 1, 1, 1, 1)188 DO_2D( 0, 0, 0, 0 ) 188 189 ikbot = mbkt(ji,jj) 189 190 z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) … … 207 208 ! 208 209 END_2D 209 CALL lbc_lnk( 'diawri', z2d, 'T', 1.0_wp )210 210 CALL iom_put( "taubot", z2d ) 211 211 ENDIF … … 214 214 CALL iom_put( "ssu", uu(:,:,1,Kmm) ) ! surface i-current 215 215 IF ( iom_use("sbu") ) THEN 216 DO_2D( 1, 1, 1, 1)216 DO_2D( 0, 0, 0, 0 ) 217 217 ikbot = mbku(ji,jj) 218 218 z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) … … 224 224 CALL iom_put( "ssv", vv(:,:,1,Kmm) ) ! surface j-current 225 225 IF ( iom_use("sbv") ) THEN 226 DO_2D( 1, 1, 1, 1)226 DO_2D( 0, 0, 0, 0 ) 227 227 ikbot = mbkv(ji,jj) 228 228 z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) … … 253 253 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 254 254 255 IF ( iom_use("socegrad") .OR. iom_use("socegrad2") ) THEN 256 z3d(:,:,jpk) = 0. 257 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 258 zztmp = ts(ji,jj,jk,jp_sal,Kmm) 259 zztmpx = (ts(ji+1,jj,jk,jp_sal,Kmm) - zztmp) * r1_e1u(ji,jj) + (zztmp - ts(ji-1,jj ,jk,jp_sal,Kmm)) * r1_e1u(ji-1,jj) 260 zztmpy = (ts(ji,jj+1,jk,jp_sal,Kmm) - zztmp) * r1_e2v(ji,jj) + (zztmp - ts(ji ,jj-1,jk,jp_sal,Kmm)) * r1_e2v(ji,jj-1) 261 z3d(ji,jj,jk) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 262 & * umask(ji,jj,jk) * umask(ji-1,jj,jk) * vmask(ji,jj,jk) * umask(ji,jj-1,jk) 263 END_3D 264 CALL iom_put( "socegrad2", z3d ) ! square of module of sal gradient 265 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 266 z3d(ji,jj,jk) = SQRT( z3d(ji,jj,jk) ) 267 END_3D 268 CALL iom_put( "socegrad" , z3d ) ! module of sal gradient 269 ENDIF 270 255 271 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 256 272 DO_2D( 0, 0, 0, 0 ) … … 261 277 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 262 278 END_2D 263 CALL lbc_lnk( 'diawri', z2d, 'T', 1.0_wp )264 279 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 265 z2d(:,:) = SQRT( z2d(:,:) ) 280 DO_2D( 0, 0, 0, 0 ) 281 z2d(ji,jj) = SQRT( z2d(ji,jj) ) 282 END_2D 266 283 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 267 284 ENDIF … … 270 287 IF( iom_use("heatc") ) THEN 271 288 z2d(:,:) = 0._wp 272 DO_3D( 1, 1, 1, 1, 1, jpkm1 )289 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 273 290 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 274 291 END_3D … … 278 295 IF( iom_use("saltc") ) THEN 279 296 z2d(:,:) = 0._wp 280 DO_3D( 1, 1, 1, 1, 1, jpkm1 )297 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 281 298 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 282 299 END_3D … … 284 301 ENDIF 285 302 ! 286 IF ( iom_use("eken") ) THEN 303 IF( iom_use("salt2c") ) THEN 304 z2d(:,:) = 0._wp 305 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 306 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 307 END_3D 308 CALL iom_put( "salt2c", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 309 ENDIF 310 ! 311 IF ( iom_use("ke") .OR. iom_use("ke_int") ) THEN 287 312 z3d(:,:,jpk) = 0._wp 288 313 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 289 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 290 z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 291 & + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 292 & + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 293 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 294 END_3D 295 CALL lbc_lnk( 'diawri', z3d, 'T', 1.0_wp ) 296 CALL iom_put( "eken", z3d ) ! kinetic energy 314 zztmpx = 0.5 * ( uu(ji-1,jj ,jk,Kmm) + uu(ji,jj,jk,Kmm) ) 315 zztmpy = 0.5 * ( vv(ji ,jj-1,jk,Kmm) + vv(ji,jj,jk,Kmm) ) 316 z3d(ji,jj,jk) = 0.5 * ( zztmpx*zztmpx + zztmpy*zztmpy ) 317 END_3D 318 CALL iom_put( "ke", z3d ) ! kinetic energy 319 320 z2d(:,:) = 0._wp 321 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 322 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk) 323 END_3D 324 CALL iom_put( "ke_int", z2d ) ! vertically integrated kinetic energy 297 325 ENDIF 298 326 ! 299 327 CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence 328 329 IF ( iom_use("relvor") .OR. iom_use("absvor") .OR. iom_use("potvor") ) THEN 330 331 z3d(:,:,jpk) = 0._wp 332 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 333 z3d(ji,jj,jk) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm) & 334 & - e1u(ji ,jj+1) * uu(ji ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm) ) * r1_e1e2f(ji,jj) 335 END_3D 336 CALL iom_put( "relvor", z3d ) ! relative vorticity 337 338 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 339 z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 340 END_3D 341 CALL iom_put( "absvor", z3d ) ! absolute vorticity 342 343 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 344 ze3 = ( e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 345 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 346 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 347 ELSE ; ze3 = 0._wp 348 ENDIF 349 z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 350 END_3D 351 CALL iom_put( "potvor", z3d ) ! potential vorticity 352 353 ENDIF 300 354 ! 301 355 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN … … 315 369 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 316 370 END_3D 317 CALL lbc_lnk( 'diawri', z2d, 'U', -1.0_wp )318 371 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 319 372 ENDIF … … 324 377 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 325 378 END_3D 326 CALL lbc_lnk( 'diawri', z2d, 'U', -1.0_wp )327 379 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 328 380 ENDIF … … 342 394 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 343 395 END_3D 344 CALL lbc_lnk( 'diawri', z2d, 'V', -1.0_wp )345 396 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 346 397 ENDIF … … 351 402 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 352 403 END_3D 353 CALL lbc_lnk( 'diawri', z2d, 'V', -1.0_wp )354 404 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 355 405 ENDIF … … 360 410 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 361 411 END_3D 362 CALL lbc_lnk( 'diawri', z2d, 'T', -1.0_wp )363 412 CALL iom_put( "tosmint", rho0 * z2d ) ! Vertical integral of temperature 364 413 ENDIF … … 368 417 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 369 418 END_3D 370 CALL lbc_lnk( 'diawri', z2d, 'T', -1.0_wp )371 419 CALL iom_put( "somint", rho0 * z2d ) ! Vertical integral of salinity 372 420 ENDIF -
NEMO/trunk/src/OCE/DOM/domain.F90
r13458 r13472 120 120 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 121 121 ENDIF 122 lwxios = .FALSE.122 nn_wxios = 0 123 123 ln_xios_read = .FALSE. 124 124 ! -
NEMO/trunk/src/OCE/DYN/dynatf.F90
r13295 r13472 34 34 USE dynspg_ts ! surface pressure gradient: split-explicit scheme 35 35 USE domvvl ! variable volume 36 USE bdy_oce , ONLY: ln_bdy36 USE bdy_oce , ONLY : ln_bdy 37 37 USE bdydta ! ocean open boundary conditions 38 38 USE bdydyn ! ocean open boundary conditions … … 50 50 USE prtctl ! Print control 51 51 USE timing ! Timing 52 USE zdfdrg , ONLY : ln_drgice_imp, rCdU_top 52 53 #if defined key_agrif 53 54 USE agrif_oce_interp … … 120 121 REAL(wp) :: zve3a, zve3n, zve3b, z1_2dt ! - - 121 122 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve, zwfld 123 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zutau, zvtau 122 124 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3t_f, ze3u_f, ze3v_f, zua, zva 123 125 !!---------------------------------------------------------------------- … … 321 323 ENDIF 322 324 ! 325 IF ( iom_use("utau") ) THEN 326 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 327 ALLOCATE(zutau(jpi,jpj)) 328 DO_2D( 0, 0, 0, 0 ) 329 jk = miku(ji,jj) 330 zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa) 331 END_2D 332 CALL iom_put( "utau", zutau(:,:) ) 333 DEALLOCATE(zutau) 334 ELSE 335 CALL iom_put( "utau", utau(:,:) ) 336 ENDIF 337 ENDIF 338 ! 339 IF ( iom_use("vtau") ) THEN 340 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 341 ALLOCATE(zvtau(jpi,jpj)) 342 DO_2D( 0, 0, 0, 0 ) 343 jk = mikv(ji,jj) 344 zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * pvv(ji,jj,jk,Kaa) 345 END_2D 346 CALL iom_put( "vtau", zvtau(:,:) ) 347 DEALLOCATE(zvtau) 348 ELSE 349 CALL iom_put( "vtau", vtau(:,:) ) 350 ENDIF 351 ENDIF 352 ! 323 353 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt - puu(:,:,:,Kaa): ', mask1=umask, & 324 354 & tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): ' , mask2=vmask ) -
NEMO/trunk/src/OCE/DYN/dynspg_ts.F90
r13295 r13472 264 264 IF( ln_wd_il ) THEN ! W/D : limiter applied to spgspg 265 265 CALL wad_spg( pssh(:,:,Kmm), zcpx, zcpy ) ! Calculating W/D gravity filters, zcpx and zcpy 266 DO_2D( 0, 0, 0, 0 ) 266 DO_2D( 0, 0, 0, 0 ) ! SPG with the application of W/D gravity filters 267 267 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj ,Kmm) - pssh(ji ,jj ,Kmm) ) & 268 268 & * r1_e1u(ji,jj) * zcpx(ji,jj) * wdrampu(ji,jj) !jth … … 1405 1405 ! !== Set the barotropic drag coef. ==! 1406 1406 ! 1407 IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities)1407 IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! top+bottom friction (ocean cavities) 1408 1408 1409 1409 DO_2D( 0, 0, 0, 0 ) … … 1456 1456 ! !== TOP stress contribution from baroclinic velocities ==! (no W/D case) 1457 1457 ! 1458 IF( ln_isfcav ) THEN1458 IF( ln_isfcav.OR.ln_drgice_imp ) THEN 1459 1459 ! 1460 1460 IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW top baroclinic velocity -
NEMO/trunk/src/OCE/DYN/dynzdf.F90
r13295 r13472 141 141 pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va 142 142 END_2D 143 IF( ln_isfcav ) THEN ! Ocean cavities (ISF)143 IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! Ocean cavities (ISF) 144 144 DO_2D( 0, 0, 0, 0 ) 145 145 iku = miku(ji,jj) ! top ocean level at u- and v-points … … 247 247 zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 248 248 END_2D 249 IF ( ln_isfcav ) THEN ! top friction (always implicit)249 IF ( ln_isfcav.OR.ln_drgice_imp ) THEN ! top friction (always implicit) 250 250 DO_2D( 0, 0, 0, 0 ) 251 251 !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed … … 273 273 !----------------------------------------------------------------------- 274 274 ! 275 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 275 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 276 276 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 277 277 END_3D 278 278 ! 279 DO_2D( 0, 0, 0, 0 ) 279 DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 280 280 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 281 281 & + r_vvl * e3u(ji,jj,1,Kaa) … … 287 287 END_3D 288 288 ! 289 DO_2D( 0, 0, 0, 0 ) 289 DO_2D( 0, 0, 0, 0 ) !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==! 290 290 puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 291 291 END_2D … … 329 329 END_3D 330 330 END SELECT 331 DO_2D( 0, 0, 0, 0 ) 331 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 332 332 zwi(ji,jj,1) = 0._wp 333 333 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & … … 385 385 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va 386 386 END_2D 387 IF ( ln_isfcav ) THEN387 IF ( ln_isfcav.OR.ln_drgice_imp ) THEN 388 388 DO_2D( 0, 0, 0, 0 ) 389 389 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) … … 410 410 !----------------------------------------------------------------------- 411 411 ! 412 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 412 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 413 413 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 414 414 END_3D 415 415 ! 416 DO_2D( 0, 0, 0, 0 ) 416 DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 417 417 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 418 418 & + r_vvl * e3v(ji,jj,1,Kaa) … … 424 424 END_3D 425 425 ! 426 DO_2D( 0, 0, 0, 0 ) 426 DO_2D( 0, 0, 0, 0 ) !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==! 427 427 pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 428 428 END_2D -
NEMO/trunk/src/OCE/IOM/iom.F90
r13295 r13472 350 350 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 351 351 ELSE 352 rst_file = TRIM(clpath)// '1_'//TRIM(cn_ocerst_in)352 rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 353 353 ENDIF 354 354 !set name of the restart file and enable available fields -
NEMO/trunk/src/OCE/ISF/isfcavmlt.F90
r13295 r13472 136 136 !! ** Method : The ice shelf melt latent heat is defined as being equal to the ocean/ice heat flux. 137 137 !! From this we can derived the fwf, ocean/ice heat flux and the heat content flux as being : 138 !! qfwf = Gammat * Rau0 * Cp * ( Tw - Tfrz ) / Lf138 !! qfwf = Gammat * rho0 * Cp * ( Tw - Tfrz ) / Lf 139 139 !! qhoce = qlat 140 140 !! qhc = qfwf * Cp * Tfrz -
NEMO/trunk/src/OCE/LBC/lbc_lnk_multi_generic.h90
r13286 r13472 35 35 #endif 36 36 37 SUBROUTINE ROUTINE_MULTI( cdname & 38 & , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4 & 39 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 40 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 37 SUBROUTINE ROUTINE_MULTI( cdname & 38 & , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4 & 39 & , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8 & 40 & , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12 & 41 & , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16 & 41 42 & , kfillmode, pfillval, lsend, lrecv ) 42 43 !!--------------------------------------------------------------------- 43 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 44 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied 45 ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9 , pt10 , pt11 46 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 47 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 48 REAL(wp) , INTENT(in ) :: psgn1 ! sign used across the north fold 49 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 50 INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 51 REAL(wp) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 52 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 44 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 45 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied 46 ARRAY_TYPE(:,:,:,:) , OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9 , & 47 & pt10 , pt11 , pt12 , pt13 , pt14 , pt15 , pt16 48 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 49 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & 50 & cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16 51 REAL(wp) , INTENT(in ) :: psgn1 ! sign used across the north fold 52 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, & 53 & psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16 54 INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 55 REAL(wp) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 56 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 53 57 !! 54 58 INTEGER :: kfld ! number of elements that will be attributed 55 PTR_TYPE , DIMENSION(1 1) :: ptab_ptr ! pointer array56 CHARACTER(len=1) , DIMENSION(1 1) :: cdna_ptr ! nature of ptab_ptr grid-points57 REAL(wp) , DIMENSION(1 1) :: psgn_ptr ! sign used across the north fold boundary59 PTR_TYPE , DIMENSION(16) :: ptab_ptr ! pointer array 60 CHARACTER(len=1) , DIMENSION(16) :: cdna_ptr ! nature of ptab_ptr grid-points 61 REAL(wp) , DIMENSION(16) :: psgn_ptr ! sign used across the north fold boundary 58 62 !!--------------------------------------------------------------------- 59 63 ! … … 74 78 IF( PRESENT(psgn10) ) CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 75 79 IF( PRESENT(psgn11) ) CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 80 IF( PRESENT(psgn12) ) CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 81 IF( PRESENT(psgn13) ) CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 82 IF( PRESENT(psgn14) ) CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 83 IF( PRESENT(psgn15) ) CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 84 IF( PRESENT(psgn16) ) CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 76 85 ! 77 CALL lbc_lnk_ptr ( cdname,ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv )86 CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 78 87 ! 79 88 END SUBROUTINE ROUTINE_MULTI -
NEMO/trunk/src/OCE/SBC/sbc_ice.F90
r12396 r13472 69 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s] 70 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_ice !: wind speed module at T-point [m/s] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sstfrz !: wind speed module at T-point [m/s] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sstfrz !: sea surface freezing temperature [degC] 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rCdU_ice !: ice-ocean drag at T-point (<0) [m/s] 72 73 #endif 73 74 … … 89 90 ! variables used in the coupled interface 90 91 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice 92 93 93 94 ! already defined in ice.F90 for SI3 … … 98 99 #endif 99 100 100 REAL(wp), PUBLIC, SAVE :: cldf_ice= 0.81 !: cloud fraction over sea ice, summer CLIO value [-]101 REAL(wp), PUBLIC, SAVE :: pp_cldf = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 101 102 102 103 !! arrays relating to embedding ice in the ocean … … 131 132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 132 133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 133 & emp_ice (jpi,jpj) , sstfrz (jpi,jpj) , STAT= ierr(2) )134 & emp_ice (jpi,jpj) , sstfrz (jpi,jpj) , rCdU_ice (jpi,jpj) , STAT= ierr(2) ) 134 135 #endif 135 136 … … 167 168 LOGICAL , PUBLIC, PARAMETER :: lk_si3 = .FALSE. !: no SI3 ice model 168 169 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE ice model 169 REAL(wp) , PUBLIC, PARAMETER :: cldf_ice = 0.81!: cloud fraction over sea ice, summer CLIO value [-]170 REAL(wp) , PUBLIC, PARAMETER :: pp_cldf = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 170 171 INTEGER , PUBLIC, PARAMETER :: jpl = 1 171 172 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj -
NEMO/trunk/src/OCE/SBC/sbc_oce.F90
r13295 r13472 136 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] 137 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-] 138 139 139 140 !!--------------------------------------------------------------------- … … 188 189 ! 189 190 ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , & 190 & atm_co2(jpi,jpj) , tsk_m(jpi,jpj) , 191 & atm_co2(jpi,jpj) , tsk_m(jpi,jpj) , cloud_fra(jpi,jpj), & 191 192 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 192 193 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) -
NEMO/trunk/src/OCE/SBC/sbcblk.F90
r13305 r13472 44 44 USE lib_fortran ! to use key_nosignedzero 45 45 #if defined key_si3 46 USE ice , ONLY : jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif47 USE ice thd_dh ! for CALL ice_thd_snwblow46 USE ice , ONLY : u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif, nn_qtrice 47 USE icevar ! for CALL ice_var_snwblow 48 48 #endif 49 49 USE sbcblk_algo_ncar ! => turb_ncar : NCAR - CORE (Large & Yeager, 2009) … … 87 87 INTEGER , PUBLIC, PARAMETER :: jp_voatm = 11 ! index of surface current (j-component) 88 88 ! ! seen by the atmospheric forcing (m/s) at T-point 89 INTEGER , PUBLIC, PARAMETER :: jp_hpgi = 12 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 90 INTEGER , PUBLIC, PARAMETER :: jp_hpgj = 13 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 91 INTEGER , PUBLIC, PARAMETER :: jpfld = 13 ! maximum number of files to read 89 INTEGER , PUBLIC, PARAMETER :: jp_cc = 12 ! index of cloud cover (-) range:0-1 90 INTEGER , PUBLIC, PARAMETER :: jp_hpgi = 13 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 91 INTEGER , PUBLIC, PARAMETER :: jp_hpgj = 14 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 92 INTEGER , PUBLIC, PARAMETER :: jpfld = 14 ! maximum number of files to read 92 93 93 94 ! Warning: keep this structure allocatable for Agrif... … … 175 176 TYPE(FLD_N) :: sn_qlw , sn_tair , sn_prec, sn_snow ! " " 176 177 TYPE(FLD_N) :: sn_slp , sn_uoatm, sn_voatm ! " " 177 TYPE(FLD_N) :: sn_ hpgi, sn_hpgj! " "178 TYPE(FLD_N) :: sn_cc, sn_hpgi, sn_hpgj ! " " 178 179 INTEGER :: ipka ! number of levels in the atmospheric variable 179 180 NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw , & ! input fields 180 181 & sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm, & 181 & sn_ hpgi, sn_hpgj,&182 & sn_cc, sn_hpgi, sn_hpgj, & 182 183 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF, & ! bulk algorithm 183 184 & cn_dir , rn_zqt, rn_zu, & … … 260 261 slf_i(jp_tair ) = sn_tair ; slf_i(jp_humi ) = sn_humi 261 262 slf_i(jp_prec ) = sn_prec ; slf_i(jp_snow ) = sn_snow 262 slf_i(jp_slp ) = sn_slp 263 slf_i(jp_slp ) = sn_slp ; slf_i(jp_cc ) = sn_cc 263 264 slf_i(jp_uoatm) = sn_uoatm ; slf_i(jp_voatm) = sn_voatm 264 265 slf_i(jp_hpgi ) = sn_hpgi ; slf_i(jp_hpgj ) = sn_hpgj … … 289 290 ! 290 291 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to default) 291 IF( jfpr == jp_slp 292 IF( jfpr == jp_slp ) THEN 292 293 sf(jfpr)%fnow(:,:,1:ipka) = 101325._wp ! use standard pressure in Pa 293 294 ELSEIF( jfpr == jp_prec .OR. jfpr == jp_snow .OR. jfpr == jp_uoatm .OR. jfpr == jp_voatm ) THEN … … 295 296 ELSEIF( ( jfpr == jp_hpgi .OR. jfpr == jp_hpgj ) .AND. .NOT. ln_abl ) THEN 296 297 DEALLOCATE( sf(jfpr)%fnow ) ! deallocate as not used in this case 298 ELSEIF( jfpr == jp_cc ) THEN 299 sf(jp_cc)%fnow(:,:,1:ipka) = pp_cldf 297 300 ELSE 298 301 WRITE(ctmp1,*) 'sbc_blk_init: no default value defined for field number', jfpr … … 303 306 ! 304 307 IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) & 305 306 308 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 309 & ' This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 307 310 ENDIF 308 311 END DO … … 559 562 ptsk(:,:) = pst(:,:) + rt0 ! by default: skin temperature = "bulk SST" (will remain this way if NCAR algorithm used!) 560 563 564 ! --- cloud cover --- ! 565 cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 566 561 567 ! ----------------------------------------------------------------------------- ! 562 568 ! 0 Wind components and module at T-point relative to the moving ocean ! … … 1019 1025 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 1020 1026 REAL(wp) :: zztmp, zztmp2, z1_rLsub ! - - 1021 REAL(wp) :: zfr1, zfr2 ! local variables1022 1027 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature 1023 1028 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice … … 1028 1033 REAL(wp), DIMENSION(jpi,jpj) :: zqair ! specific humidity of air at z=rn_zqt [kg/kg] !LB 1029 1034 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 1035 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1030 1036 !!--------------------------------------------------------------------- 1031 1037 ! … … 1112 1118 ! --- evaporation minus precipitation --- ! 1113 1119 zsnw(:,:) = 0._wp 1114 CALL ice_ thd_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing1120 CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing 1115 1121 emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 1116 1122 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw … … 1139 1145 END DO 1140 1146 1141 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 1142 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm 1143 zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1 1144 ! 1145 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 1146 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 1147 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 1148 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 1149 ELSEWHERE ! zero when hs>0 1150 qtr_ice_top(:,:,:) = 0._wp 1151 END WHERE 1152 ! 1153 1147 ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 1148 IF( nn_qtrice == 0 ) THEN 1149 ! formulation derived from Grenfell and Maykut (1977), where transmission rate 1150 ! 1) depends on cloudiness 1151 ! 2) is 0 when there is any snow 1152 ! 3) tends to 1 for thin ice 1153 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 1154 DO jl = 1, jpl 1155 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 1156 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 1157 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 1158 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 1159 ELSEWHERE ! zero when hs>0 1160 qtr_ice_top(:,:,jl) = 0._wp 1161 END WHERE 1162 ENDDO 1163 ELSEIF( nn_qtrice == 1 ) THEN 1164 ! formulation is derived from the thesis of M. Lebrun (2019). 1165 ! It represents the best fit using several sets of observations 1166 ! It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 1167 qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:) 1168 ENDIF 1169 ! 1154 1170 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN 1155 1171 ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) -
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r13461 r13472 41 41 #endif 42 42 #if defined key_si3 43 USE ice thd_dh ! for CALL ice_thd_snwblow43 USE icevar ! for CALL ice_var_snwblow 44 44 #endif 45 45 ! … … 48 48 USE lib_mpp ! distribued memory computing library 49 49 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 50 51 #if defined key_oasis3 52 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 53 #endif 50 54 51 55 IMPLICIT NONE … … 152 156 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 153 157 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 154 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area 158 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area fraction 155 159 INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness 156 160 INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity … … 159 163 160 164 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 165 166 #if ! defined key_oasis3 167 ! Dummy variables to enable compilation when oasis3 is not being used 168 INTEGER :: OASIS_Sent = -1 169 INTEGER :: OASIS_SentOut = -1 170 INTEGER :: OASIS_ToRest = -1 171 INTEGER :: OASIS_ToRestOut = -1 172 #endif 161 173 162 174 ! !!** namelist namsbc_cpl ** … … 184 196 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 185 197 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 198 LOGICAL :: ln_scale_ice_flux ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 199 186 200 TYPE :: DYNARR 187 201 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 191 205 192 206 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 207 #if defined key_si3 || defined key_cice 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time 209 #endif 193 210 194 211 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 211 228 !! *** FUNCTION sbc_cpl_alloc *** 212 229 !!---------------------------------------------------------------------- 213 INTEGER :: ierr( 4)230 INTEGER :: ierr(5) 214 231 !!---------------------------------------------------------------------- 215 232 ierr(:) = 0 … … 221 238 #endif 222 239 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 223 ! 224 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 240 #if defined key_si3 || defined key_cice 241 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 242 #endif 243 ! 244 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 225 245 226 246 sbc_cpl_alloc = MAXVAL( ierr ) … … 249 269 REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos 250 270 !! 251 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 271 NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, & 272 & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 252 273 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 253 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc ,&254 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr ,&274 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 275 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 255 276 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_tauwoc, & 256 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal ,&257 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,&258 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl ,&277 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 278 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 279 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 259 280 & sn_rcv_ts_ice 260 261 281 !!--------------------------------------------------------------------- 262 282 ! … … 278 298 ENDIF 279 299 IF( lwp .AND. ln_cpl ) THEN ! control print 300 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 301 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 302 WRITE(numout,*)' ln_scale_ice_flux = ', ln_scale_ice_flux 303 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 280 304 WRITE(numout,*)' received fields (mutiple ice categogies)' 281 305 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 326 350 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 327 351 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 328 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel329 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask330 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl331 352 ENDIF 332 353 … … 367 388 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & 368 389 .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 369 390 ! 370 391 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 371 392 … … 822 843 END SELECT 823 844 845 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 846 #if defined key_si3 || defined key_cice 847 a_i_last_couple(:,:,:) = 0._wp 848 #endif 824 849 ! ! ------------------------- ! 825 850 ! ! Ice Meltponds ! … … 1110 1135 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1111 1136 REAL(wp) :: zzx, zzy ! temporary variables 1112 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1137 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1113 1138 !!---------------------------------------------------------------------- 1114 1139 ! … … 1224 1249 ENDIF 1225 1250 ENDIF 1226 1251 !!$ ! ! ========================= ! 1252 !!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction ! 1253 !!$ ! ! ========================= ! 1254 !!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 1255 !!$ END SELECT 1256 !!$ 1257 zcloud_fra(:,:) = pp_cldf ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 1258 IF( ln_mixcpl ) THEN 1259 cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 1260 ELSE 1261 cloud_fra(:,:) = zcloud_fra(:,:) 1262 ENDIF 1263 ! ! ========================= ! 1227 1264 ! u(v)tau and taum will be modified by ice model 1228 1265 ! -> need to be reset before each call of the ice/fsbc … … 1623 1660 ! 1624 1661 INTEGER :: ji, jj, jl ! dummy loop index 1625 REAL(wp) :: ztri ! local scalar1626 1662 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1627 1663 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1628 1664 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1665 REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total 1629 1666 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 1667 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1630 1668 !!---------------------------------------------------------------------- 1631 1669 ! … … 1647 1685 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1648 1686 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1649 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)1650 1687 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1651 1688 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1659 1696 1660 1697 #if defined key_si3 1698 1699 ! --- evaporation over ice (kg/m2/s) --- ! 1700 IF (ln_scale_ice_flux) THEN ! typically met-office requirements 1701 IF (sn_rcv_emp%clcat == 'yes') THEN 1702 WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1703 ELSEWHERE ; zevap_ice(:,:,:) = 0._wp 1704 END WHERE 1705 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1706 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1707 END WHERE 1708 ELSE 1709 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 1710 ELSEWHERE ; zevap_ice(:,:,1) = 0._wp 1711 END WHERE 1712 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1713 DO jl = 2, jpl 1714 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1715 ENDDO 1716 ENDIF 1717 ELSE 1718 IF (sn_rcv_emp%clcat == 'yes') THEN 1719 zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 1720 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1721 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1722 END WHERE 1723 ELSE 1724 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 1725 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1726 DO jl = 2, jpl 1727 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1728 ENDDO 1729 ENDIF 1730 ENDIF 1731 1732 IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 1733 ! For conservative case zemp_ice has not been defined yet. Do it now. 1734 zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 1735 ENDIF 1736 1661 1737 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1662 zsnw(:,:) = 0._wp ; CALL ice_ thd_snwblow( ziceld, zsnw )1738 zsnw(:,:) = 0._wp ; CALL ice_var_snwblow( ziceld, zsnw ) 1663 1739 1664 1740 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! … … 1667 1743 1668 1744 ! --- evaporation over ocean (used later for qemp) --- ! 1669 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1670 1671 ! --- evaporation over ice (kg/m2/s) --- ! 1672 DO jl=1,jpl 1673 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1674 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1675 ENDDO 1745 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 1676 1746 1677 1747 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1751 1821 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1752 1822 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1753 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving1754 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs1755 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow1756 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation1757 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation1758 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)1759 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)1760 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average)1761 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )! Sublimation over sea-ice (cell average)1762 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &1763 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )! ice-free oce evap (cell average)1823 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1824 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs 1825 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1826 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation 1827 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1828 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1829 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1830 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1831 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1832 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1833 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1764 1834 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1765 1835 ! … … 1769 1839 CASE( 'oce only' ) ! the required field is directly provided 1770 1840 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1841 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1842 ! here so the only flux is the ocean only one. 1843 zqns_ice(:,:,:) = 0._wp 1771 1844 CASE( 'conservative' ) ! the required fields are directly provided 1772 1845 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1798 1871 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1799 1872 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1800 & 1873 & + pist(:,:,jl) * picefr(:,:) ) ) 1801 1874 END DO 1802 1875 ELSE … … 1804 1877 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1805 1878 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1806 & 1879 & + pist(:,:,jl) * picefr(:,:) ) ) 1807 1880 END DO 1808 1881 ENDIF … … 1910 1983 CASE( 'oce only' ) 1911 1984 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1985 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 1986 ! here so the only flux is the ocean only one. 1987 zqsr_ice(:,:,:) = 0._wp 1912 1988 CASE( 'conservative' ) 1913 1989 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1995 2071 ENDDO 1996 2072 ENDIF 2073 CASE( 'none' ) 2074 zdqns_ice(:,:,:) = 0._wp 1997 2075 END SELECT 1998 2076 … … 2010 2088 ! ! ========================= ! 2011 2089 CASE ('coupled') 2012 IF( ln_mixcpl ) THEN 2013 DO jl=1,jpl 2014 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2015 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2016 ENDDO 2090 IF (ln_scale_ice_flux) THEN 2091 WHERE( a_i(:,:,:) > 1.e-10_wp ) 2092 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2093 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2094 ELSEWHERE 2095 qml_ice(:,:,:) = 0.0_wp 2096 qcn_ice(:,:,:) = 0.0_wp 2097 END WHERE 2017 2098 ELSE 2018 2099 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) … … 2025 2106 IF( .NOT.ln_cndflx ) THEN !== No conduction flux as surface forcing ==! 2026 2107 ! 2027 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2028 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm (Grenfell Maykut 77) 2029 ! 2030 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2031 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2032 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2033 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2034 ELSEWHERE ! zero when hs>0 2035 zqtr_ice_top(:,:,:) = 0._wp 2036 END WHERE 2108 IF( nn_qtrice == 0 ) THEN 2109 ! formulation derived from Grenfell and Maykut (1977), where transmission rate 2110 ! 1) depends on cloudiness 2111 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2112 ! ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 2113 ! 2) is 0 when there is any snow 2114 ! 3) tends to 1 for thin ice 2115 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 2116 DO jl = 1, jpl 2117 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2118 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 2119 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2120 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 2121 ELSEWHERE ! zero when hs>0 2122 zqtr_ice_top(:,:,jl) = 0._wp 2123 END WHERE 2124 ENDDO 2125 ELSEIF( nn_qtrice == 1 ) THEN 2126 ! formulation is derived from the thesis of M. Lebrun (2019). 2127 ! It represents the best fit using several sets of observations 2128 ! It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 2129 zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 2130 ENDIF 2037 2131 ! 2038 2132 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2039 2133 ! 2040 ! 2041 ! 2134 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2135 ! for now just assume zero (fully opaque ice) 2042 2136 zqtr_ice_top(:,:,:) = 0._wp 2043 2137 ! … … 2096 2190 ! 2097 2191 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 2192 info = OASIS_idle 2098 2193 2099 2194 zfr_l(:,:) = 1.- fr_i(:,:) … … 2234 2329 ENDIF 2235 2330 2331 #if defined key_si3 || defined key_cice 2332 ! If this coupling was successful then save ice fraction for use between coupling points. 2333 ! This is needed for some calculations where the ice fraction at the last coupling point 2334 ! is needed. 2335 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2336 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2337 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2338 a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 2339 ENDIF 2340 ENDIF 2341 #endif 2342 2236 2343 IF( ssnd(jps_fice1)%laction ) THEN 2237 2344 SELECT CASE( sn_snd_thick1%clcat ) … … 2297 2404 SELECT CASE( sn_snd_mpnd%clcat ) 2298 2405 CASE( 'yes' ) 2299 ztmp3(:,:,1:jpl) = a_ip_ frac(:,:,1:jpl)2406 ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl) 2300 2407 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2301 2408 CASE( 'no' ) … … 2303 2410 ztmp4(:,:,:) = 0.0 2304 2411 DO jl=1,jpl 2305 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2306 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2412 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2413 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2307 2414 ENDDO 2308 2415 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) -
NEMO/trunk/src/OCE/SBC/sbcmod.F90
r13286 r13472 563 563 ENDIF 564 564 ! 565 CALL iom_put( "utau", utau ) ! i-wind stress (stress can be updated at each time step in sea-ice)566 CALL iom_put( "vtau", vtau ) ! j-wind stress567 !568 565 IF(sn_cfctl%l_prtctl) THEN ! print mean trends (used for debugging) 569 566 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask ) -
NEMO/trunk/src/OCE/ZDF/zdfdrg.F90
r13461 r13472 32 32 USE lib_mpp ! distributed memory computing 33 33 USE prtctl ! Print control 34 USE sbc_oce , ONLY : nn_ice 34 35 35 36 IMPLICIT NONE … … 46 47 LOGICAL :: ln_loglayer ! logarithmic drag: Cd = vkarmn/log(z/z0) 47 48 LOGICAL , PUBLIC :: ln_drgimp ! implicit top/bottom friction flag 48 49 LOGICAL , PUBLIC :: ln_drgice_imp ! implicit ice-ocean drag 49 50 ! !!* Namelist namdrg_top & _bot: TOP or BOTTOM coefficient namelist * 50 51 REAL(wp) :: rn_Cd0 !: drag coefficient [ - ] … … 226 227 INTEGER :: ios, ioptio ! local integers 227 228 !! 228 NAMELIST/namdrg/ ln_drg_OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp 229 NAMELIST/namdrg/ ln_drg_OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp, ln_drgice_imp 229 230 !!---------------------------------------------------------------------- 230 231 ! … … 247 248 WRITE(numout,*) ' logarithmic drag: Cd = vkarmn/log(z/z0) ln_loglayer = ', ln_loglayer 248 249 WRITE(numout,*) ' implicit friction ln_drgimp = ', ln_drgimp 250 WRITE(numout,*) ' implicit ice-ocean drag ln_drgice_imp =', ln_drgice_imp 249 251 ENDIF 250 252 ! … … 257 259 IF( ioptio /= 1 ) CALL ctl_stop( 'zdf_drg_init: Choose ONE type of drag coef in namdrg' ) 258 260 ! 261 IF ( ln_drgice_imp.AND.(.NOT.ln_drgimp) ) & 262 & CALL ctl_stop( 'zdf_drg_init: ln_drgice_imp=T requires ln_drgimp=T' ) 263 ! 264 IF ( ln_drgice_imp.AND.( nn_ice /=2 ) ) & 265 & CALL ctl_stop( 'zdf_drg_init: ln_drgice_imp=T requires si3' ) 259 266 ! 260 267 ! !== BOTTOM drag setting ==! (applied at seafloor) … … 267 274 ! !== TOP drag setting ==! (applied at the top of ocean cavities) 268 275 ! 269 IF( ln_isfcav ) THEN ! Ocean cavities: top friction setting 270 ALLOCATE( rCd0_top(jpi,jpj), rCdU_top(jpi,jpj) ) 276 IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! Ocean cavities: top friction setting 277 ALLOCATE( rCdU_top(jpi,jpj) ) 278 ENDIF 279 ! 280 IF( ln_isfcav ) THEN 281 ALLOCATE( rCd0_top(jpi,jpj)) 271 282 CALL drg_init( 'TOP ' , mikt , & ! <== in 272 283 & r_Cdmin_top, r_Cdmax_top, r_z0_top, r_ke0_top, rCd0_top, rCdU_top ) ! ==> out -
NEMO/trunk/src/OCE/ZDF/zdfgls.F90
r13461 r13472 54 54 INTEGER :: nn_bc_bot ! bottom boundary condition (=0/1) 55 55 INTEGER :: nn_z0_met ! Method for surface roughness computation 56 INTEGER :: nn_z0_ice ! Roughness accounting for sea ice 56 57 INTEGER :: nn_stab_func ! stability functions G88, KC or Canuto (=0/1/2) 57 58 INTEGER :: nn_clos ! closure 0/1/2/3 MY82/k-eps/k-w/gen … … 62 63 REAL(wp) :: rn_crban ! Craig and Banner constant for surface breaking waves mixing 63 64 REAL(wp) :: rn_hsro ! Minimum surface roughness 65 REAL(wp) :: rn_hsri ! Ice ocean roughness 64 66 REAL(wp) :: rn_frac_hs ! Fraction of wave height as surface roughness (if nn_z0_met > 1) 65 67 … … 153 155 REAL(wp), DIMENSION(jpi,jpj) :: zflxs ! Turbulence fluxed induced by internal waves 154 156 REAL(wp), DIMENSION(jpi,jpj) :: zhsro ! Surface roughness (surface waves) 157 REAL(wp), DIMENSION(jpi,jpj) :: zice_fra ! Tapering of wave breaking under sea ice 155 158 REAL(wp), DIMENSION(jpi,jpj,jpk) :: eb ! tke at time before 156 159 REAL(wp), DIMENSION(jpi,jpj,jpk) :: hmxl_b ! mixing length at time before … … 168 171 ustar2_bot (:,:) = 0._wp 169 172 173 SELECT CASE ( nn_z0_ice ) 174 CASE( 0 ) ; zice_fra(:,:) = 0._wp 175 CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(:,:) * 10._wp ) 176 CASE( 2 ) ; zice_fra(:,:) = fr_i(:,:) 177 CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 178 END SELECT 179 170 180 ! Compute surface, top and bottom friction at T-points 171 181 DO_2D( 0, 0, 0, 0 ) … … 207 217 END SELECT 208 218 ! 219 ! adapt roughness where there is sea ice 220 zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1) + (1._wp - tmask(:,:,1))*rn_hsro 221 ! 209 222 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 210 223 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) … … 291 304 CASE ( 0 ) ! Dirichlet boundary condition (set e at k=1 & 2) 292 305 ! First level 293 en (:,:,1) = MAX( rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 )306 en (:,:,1) = MAX( rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 ) 294 307 zd_lw(:,:,1) = en(:,:,1) 295 308 zd_up(:,:,1) = 0._wp … … 297 310 ! 298 311 ! One level below 299 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm))&300 & / zhsro(:,:) )**(1.5_wp*ra_sf) )**(2._wp/3._wp) 312 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm)) & 313 & / zhsro(:,:) )**(1.5_wp*ra_sf) )**(2._wp/3._wp) , rn_emin ) 301 314 zd_lw(:,:,2) = 0._wp 302 315 zd_up(:,:,2) = 0._wp … … 307 320 ! 308 321 ! Dirichlet conditions at k=1 309 en (:,:,1) = MAX( rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 , rn_emin )322 en (:,:,1) = MAX( rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 , rn_emin ) 310 323 zd_lw(:,:,1) = en(:,:,1) 311 324 zd_up(:,:,1) = 0._wp … … 317 330 zd_lw(:,:,2) = 0._wp 318 331 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) )) 319 zflxs(:,:) = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) &332 zflxs(:,:) = rsbc_tke2 * (1._wp-zice_fra(:,:)) * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 320 333 & * ( ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:) )**(1.5_wp*ra_sf) 321 334 !!gm why not : * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf) … … 530 543 zkar (:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope 531 544 zdep (:,:) = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf) 532 zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 545 zflxs(:,:) = (rnn + (1._wp-zice_fra(:,:))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:)) & 546 & *(1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 533 547 zdep (:,:) = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 534 548 & ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.) … … 753 767 REAL(wp):: zcr ! local scalar 754 768 !! 755 NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &756 & rn_clim_galp, ln_sigpsi, rn_hsro, 757 & rn_crban, rn_charn, rn_frac_hs, &758 & nn_bc_surf, nn_bc_bot, nn_z0_met, 769 NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, & 770 & rn_clim_galp, ln_sigpsi, rn_hsro, rn_hsri, & 771 & rn_crban, rn_charn, rn_frac_hs, & 772 & nn_bc_surf, nn_bc_bot, nn_z0_met, nn_z0_ice, & 759 773 & nn_stab_func, nn_clos 760 774 !!---------------------------------------------------------- … … 782 796 WRITE(numout,*) ' Charnock coefficient rn_charn = ', rn_charn 783 797 WRITE(numout,*) ' Surface roughness formula nn_z0_met = ', nn_z0_met 798 WRITE(numout,*) ' surface wave breaking under ice nn_z0_ice = ', nn_z0_ice 799 SELECT CASE( nn_z0_ice ) 800 CASE( 0 ) ; WRITE(numout,*) ' ==>>> no impact of ice cover on surface wave breaking' 801 CASE( 1 ) ; WRITE(numout,*) ' ==>>> roughness uses rn_hsri and is weigthed by 1-TANH( fr_i(:,:) * 10 )' 802 CASE( 2 ) ; WRITE(numout,*) ' ==>>> roughness uses rn_hsri and is weighted by 1-fr_i(:,:)' 803 CASE( 3 ) ; WRITE(numout,*) ' ==>>> roughness uses rn_hsri and is weighted by 1-MIN( 1, 4 * fr_i(:,:) )' 804 CASE DEFAULT 805 CALL ctl_stop( 'zdf_gls_init: wrong value for nn_z0_ice, should be 0,1,2, or 3') 806 END SELECT 784 807 WRITE(numout,*) ' Wave height frac. (used if nn_z0_met=2) rn_frac_hs = ', rn_frac_hs 785 808 WRITE(numout,*) ' Stability functions nn_stab_func = ', nn_stab_func 786 809 WRITE(numout,*) ' Type of closure nn_clos = ', nn_clos 787 810 WRITE(numout,*) ' Surface roughness (m) rn_hsro = ', rn_hsro 811 WRITE(numout,*) ' Ice-ocean roughness (used if nn_z0_ice/=0) rn_hsri = ', rn_hsri 788 812 WRITE(numout,*) 789 813 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:' -
NEMO/trunk/src/OCE/ZDF/zdfphy.F90
r13226 r13472 28 28 USE sbc_oce ! surface module (only for nn_isf in the option compatibility test) 29 29 USE sbcrnf ! surface boundary condition: runoff variables 30 USE sbc_ice ! sea ice drag 30 31 #if defined key_agrif 31 32 USE agrif_oce_interp ! interpavm … … 253 254 ENDIF 254 255 ! 256 #if defined key_si3 257 IF ( ln_drgice_imp) THEN 258 IF ( ln_isfcav ) THEN 259 rCdU_top(:,:) = rCdU_top(:,:) + ssmask(:,:) * tmask(:,:,1) * rCdU_ice(:,:) 260 ELSE 261 rCdU_top(:,:) = rCdU_ice(:,:) 262 ENDIF 263 ENDIF 264 #endif 265 ! 255 266 ! !== Kz from chosen turbulent closure ==! (avm_k, avt_k) 256 267 ! -
NEMO/trunk/src/OCE/ZDF/zdftke.F90
r13461 r13472 52 52 #endif 53 53 ! 54 #if defined key_si3 55 USE ice, ONLY: hm_i, h_i 56 #endif 57 #if defined key_cice 58 USE sbc_ice, ONLY: h_i 59 #endif 54 60 USE in_out_manager ! I/O manager 55 61 USE iom ! I/O manager library … … 68 74 ! !!** Namelist namzdf_tke ** 69 75 LOGICAL :: ln_mxl0 ! mixing length scale surface value as function of wind stress or not 76 INTEGER :: nn_mxlice ! type of scaling under sea-ice (=0/1/2/3) 77 REAL(wp) :: rn_mxlice ! ice thickness value when scaling under sea-ice 70 78 INTEGER :: nn_mxl ! type of mixing length (=0/1/2/3) 71 79 REAL(wp) :: rn_mxl0 ! surface min value of mixing length (kappa*z_o=0.4*0.1 m) [m] 72 INTEGER :: nn_mxlice ! type of scaling under sea-ice73 REAL(wp) :: rn_mxlice ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1)74 80 INTEGER :: nn_pdl ! Prandtl number or not (ratio avt/avm) (=0/1) 75 81 REAL(wp) :: rn_ediff ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) … … 82 88 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1) 83 89 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean 84 REAL(wp) :: rn_eice ! =0 ON below sea-ice, =4 OFF when ice fraction > 1/485 90 LOGICAL :: ln_lc ! Langmuir cells (LC) as a source term of TKE or not 86 91 REAL(wp) :: rn_lc ! coef to compute vertical velocity of Langmuir cells 92 INTEGER :: nn_eice ! attenutaion of langmuir & surface wave breaking under ice (=0/1/2/3) 87 93 88 94 REAL(wp) :: ri_cri ! critic Richardson number (deduced from rn_ediff and rn_ediss values) … … 199 205 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points) 200 206 ! 201 INTEGER :: ji, jj, jk ! dummy loop arguments207 INTEGER :: ji, jj, jk ! dummy loop arguments 202 208 REAL(wp) :: zetop, zebot, zmsku, zmskv ! local scalars 203 209 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 204 210 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 205 REAL(wp) :: zbbrau, z ri! local scalars206 REAL(wp) :: zfact1, zfact2, zfact3 ! - 207 REAL(wp) :: ztx2 , zty2 , zcof ! - 208 REAL(wp) :: ztau , zdif ! - 209 REAL(wp) :: zus , zwlc , zind ! - 210 REAL(wp) :: zzd_up, zzd_lw ! - 211 REAL(wp) :: zbbrau, zbbirau, zri ! local scalars 212 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 213 REAL(wp) :: ztx2 , zty2 , zcof ! - - 214 REAL(wp) :: ztau , zdif ! - - 215 REAL(wp) :: zus , zwlc , zind ! - - 216 REAL(wp) :: zzd_up, zzd_lw ! - - 211 217 INTEGER , DIMENSION(jpi,jpj) :: imlc 212 REAL(wp), DIMENSION(jpi,jpj) :: z hlc, zfr_i218 REAL(wp), DIMENSION(jpi,jpj) :: zice_fra, zhlc, zus3 213 219 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpelc, zdiag, zd_up, zd_lw 214 220 !!-------------------------------------------------------------------- 215 221 ! 216 zbbrau = rn_ebb / rho0 ! Local constant initialisation 217 zfact1 = -.5_wp * rn_Dt 218 zfact2 = 1.5_wp * rn_Dt * rn_ediss 219 zfact3 = 0.5_wp * rn_ediss 222 zbbrau = rn_ebb / rho0 ! Local constant initialisation 223 zbbirau = 3.75_wp / rho0 224 zfact1 = -.5_wp * rn_Dt 225 zfact2 = 1.5_wp * rn_Dt * rn_ediss 226 zfact3 = 0.5_wp * rn_ediss 227 ! 228 ! ice fraction considered for attenuation of langmuir & wave breaking 229 SELECT CASE ( nn_eice ) 230 CASE( 0 ) ; zice_fra(:,:) = 0._wp 231 CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(:,:) * 10._wp ) 232 CASE( 2 ) ; zice_fra(:,:) = fr_i(:,:) 233 CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 234 END SELECT 220 235 ! 221 236 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 222 237 ! ! Surface/top/bottom boundary condition on tke 223 238 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 224 ! 239 ! 225 240 DO_2D( 0, 0, 0, 0 ) 241 !! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly 242 !! one way around would be to increase zbbirau 243 !! en(ji,jj,1) = MAX( rn_emin0, ( ( 1._wp - fr_i(ji,jj) ) * zbbrau + & 244 !! & fr_i(ji,jj) * zbbirau ) * taum(ji,jj) ) * tmask(ji,jj,1) 226 245 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 227 246 END_2D … … 273 292 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 274 293 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 275 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 276 zus = zcof * taum(ji,jj)294 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! Last w-level at which zpelc>=0.5*us*us 295 zus = zcof * taum(ji,jj) ! with us=0.016*wind(starting from jpk-1) 277 296 IF( zpelc(ji,jj,jk) > zus ) imlc(ji,jj) = jk 278 297 END_3D … … 284 303 DO_2D( 0, 0, 0, 0 ) 285 304 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 286 zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 287 IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 305 zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 288 306 END_2D 289 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 290 IF ( zfr_i(ji,jj) /= 0. ) THEN 291 ! vertical velocity due to LC 307 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en 308 IF ( zus3(ji,jj) /= 0._wp ) THEN 292 309 IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 293 310 ! ! vertical velocity due to LC 294 zwlc = rn_lc * SIN( rpi * gdepw(ji,jj,jk,Kmm) / zhlc(ji,jj) ) ! warning: optimization: zus^3 is in zfr_i311 zwlc = rn_lc * SIN( rpi * gdepw(ji,jj,jk,Kmm) / zhlc(ji,jj) ) 295 312 ! ! TKE Langmuir circulation source term 296 en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * z fr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)313 en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zus3(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 297 314 ENDIF 298 315 ENDIF … … 326 343 ! ! eddy coefficient (ensure numerical stability) 327 344 zzd_up = zcof * MAX( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) , 2.e-5_wp ) & ! upper diagonal 328 & / ( e3t(ji,jj,jk ,Kmm) & 329 & * e3w(ji,jj,jk ,Kmm) ) 345 & / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk ,Kmm) ) 330 346 zzd_lw = zcof * MAX( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) , 2.e-5_wp ) & ! lower diagonal 331 & / ( e3t(ji,jj,jk-1,Kmm) & 332 & * e3w(ji,jj,jk ,Kmm) ) 347 & / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk ,Kmm) ) 333 348 ! 334 349 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) … … 370 385 371 386 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 372 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 387 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! nn_eice=0 : ON below sea-ice ; nn_eice>0 : partly OFF 373 388 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 374 & * MAX( 0.,1._wp - rn_eice *fr_i(ji,jj) )* wmask(ji,jj,jk) * tmask(ji,jj,1)389 & * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 375 390 END_3D 376 391 ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction) … … 378 393 jk = nmln(ji,jj) 379 394 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 380 & * MAX( 0.,1._wp - rn_eice *fr_i(ji,jj) )* wmask(ji,jj,jk) * tmask(ji,jj,1)395 & * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 381 396 END_2D 382 397 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) … … 388 403 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 389 404 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 390 & * MAX( 0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)405 & * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 391 406 END_3D 392 407 ENDIF … … 450 465 zmxlm(:,:,:) = rmxl_min 451 466 zmxld(:,:,:) = rmxl_min 452 ! 467 ! 453 468 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 454 469 ! … … 468 483 CASE( 1 ) ! scaling with constant sea-ice thickness 469 484 DO_2D( 0, 0, 0, 0 ) 470 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 485 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 486 & fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 471 487 END_2D 472 488 ! … … 474 490 DO_2D( 0, 0, 0, 0 ) 475 491 #if defined key_si3 476 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 492 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 493 & fr_i(ji,jj) * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 477 494 #elif defined key_cice 478 495 zmaxice = MAXVAL( h_i(ji,jj,:) ) 479 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 496 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 497 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 480 498 #endif 481 499 END_2D … … 484 502 DO_2D( 0, 0, 0, 0 ) 485 503 zmaxice = MAXVAL( h_i(ji,jj,:) ) 486 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 504 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 505 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 487 506 END_2D 488 507 ! … … 610 629 & rn_mxl0 , nn_mxlice, rn_mxlice, & 611 630 & nn_pdl , ln_lc , rn_lc , & 612 & nn_etau , nn_htau , rn_efr , rn_eice631 & nn_etau , nn_htau , rn_efr , nn_eice 613 632 !!---------------------------------------------------------------------- 614 633 ! … … 642 661 ENDIF 643 662 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0 663 IF( ln_mxl0 ) THEN 664 WRITE(numout,*) ' type of scaling under sea-ice nn_mxlice = ', nn_mxlice 665 IF( nn_mxlice == 1 ) & 666 WRITE(numout,*) ' ice thickness when scaling under sea-ice rn_mxlice = ', rn_mxlice 667 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 668 CASE( 0 ) ; WRITE(numout,*) ' ==>>> No scaling under sea-ice' 669 CASE( 1 ) ; WRITE(numout,*) ' ==>>> scaling with constant sea-ice thickness' 670 CASE( 2 ) ; WRITE(numout,*) ' ==>>> scaling with mean sea-ice thickness' 671 CASE( 3 ) ; WRITE(numout,*) ' ==>>> scaling with max sea-ice thickness' 672 CASE DEFAULT 673 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_mxlice, should be 0,1,2,3 or 4') 674 END SELECT 675 ENDIF 644 676 WRITE(numout,*) ' Langmuir cells parametrization ln_lc = ', ln_lc 645 677 WRITE(numout,*) ' coef to compute vertical velocity of LC rn_lc = ', rn_lc … … 647 679 WRITE(numout,*) ' type of tke penetration profile nn_htau = ', nn_htau 648 680 WRITE(numout,*) ' fraction of TKE that penetrates rn_efr = ', rn_efr 649 WRITE(numout,*) ' below sea-ice: =0 ON rn_eice = ', rn_eice 650 WRITE(numout,*) ' =4 OFF when ice fraction > 1/4 ' 681 WRITE(numout,*) ' langmuir & surface wave breaking under ice nn_eice = ', nn_eice 682 SELECT CASE( nn_eice ) 683 CASE( 0 ) ; WRITE(numout,*) ' ==>>> no impact of ice cover on langmuir & surface wave breaking' 684 CASE( 1 ) ; WRITE(numout,*) ' ==>>> weigthed by 1-TANH( fr_i(:,:) * 10 )' 685 CASE( 2 ) ; WRITE(numout,*) ' ==>>> weighted by 1-fr_i(:,:)' 686 CASE( 3 ) ; WRITE(numout,*) ' ==>>> weighted by 1-MIN( 1, 4 * fr_i(:,:) )' 687 CASE DEFAULT 688 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_eice, should be 0,1,2, or 3') 689 END SELECT 651 690 IF( .NOT.ln_drg_OFF ) THEN 652 691 WRITE(numout,*) -
NEMO/trunk/src/OCE/module_example
r11536 r13472 93 93 INTEGER :: ji, jj, jk ! dummy loop arguments (DOCTOR : start with j, but not jp) 94 94 INTEGER :: itoto, itata ! temporary integers (DOCTOR : start with i 95 REAL(wp) :: zmlmin, zbbr au! temporary scalars (DOCTOR : start with z)95 REAL(wp) :: zmlmin, zbbrho ! temporary scalars (DOCTOR : start with z) 96 96 REAL(wp) :: zfact1, zfact2 ! do not use continuation lines in declaration 97 97 REAL(wp), DIMENSION(jpi,jpj) :: zwrk_2d ! 2D workspace … … 101 101 102 102 zmlmin = 1.e-8 ! Local constant initialization 103 zbbr au = .5 * ebb / rau0103 zbbrho = .5 * ebb / rho0 104 104 zfact1 = -.5 * rdt * efave 105 105 zfact2 = 1.5 * rdt * ediss -
NEMO/trunk/src/SAS/nemogcm.F90
r13286 r13472 480 480 ierr = dia_wri_alloc() 481 481 ierr = ierr + dom_oce_alloc() ! ocean domain 482 ierr = ierr + oce_alloc () ! (ts n...) needed for agrif and/or SI3 and bdy482 ierr = ierr + oce_alloc () ! (ts...) needed for agrif and/or SI3 and bdy 483 483 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 484 484 ! -
NEMO/trunk/src/SWE/asminc.F90
r13295 r13472 362 362 363 363 IF ( ln_trainc ) THEN 364 CALL iom_get( inum, jpdom_auto glo, 'bckint', t_bkginc, 1 )365 CALL iom_get( inum, jpdom_auto glo, 'bckins', s_bkginc, 1 )364 CALL iom_get( inum, jpdom_auto, 'bckint', t_bkginc, 1 ) 365 CALL iom_get( inum, jpdom_auto, 'bckins', s_bkginc, 1 ) 366 366 ! Apply the masks 367 367 t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:) … … 374 374 375 375 IF ( ln_dyninc ) THEN 376 CALL iom_get( inum, jpdom_auto glo, 'bckinu', u_bkginc, 1 )377 CALL iom_get( inum, jpdom_auto glo, 'bckinv', v_bkginc, 1 )376 CALL iom_get( inum, jpdom_auto, 'bckinu', u_bkginc, 1 ) 377 CALL iom_get( inum, jpdom_auto, 'bckinv', v_bkginc, 1 ) 378 378 ! Apply the masks 379 379 u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:) … … 386 386 387 387 IF ( ln_sshinc ) THEN 388 CALL iom_get( inum, jpdom_auto glo, 'bckineta', ssh_bkginc, 1 )388 CALL iom_get( inum, jpdom_auto, 'bckineta', ssh_bkginc, 1 ) 389 389 ! Apply the masks 390 390 ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask(:,:,1) … … 395 395 396 396 IF ( ln_seaiceinc ) THEN 397 CALL iom_get( inum, jpdom_auto glo, 'bckinseaice', seaice_bkginc, 1 )397 CALL iom_get( inum, jpdom_auto, 'bckinseaice', seaice_bkginc, 1 ) 398 398 ! Apply the masks 399 399 seaice_bkginc(:,:) = seaice_bkginc(:,:) * tmask(:,:,1) … … 469 469 ! 470 470 IF ( ln_trainc ) THEN 471 CALL iom_get( inum, jpdom_auto glo, 'tn', t_bkg )472 CALL iom_get( inum, jpdom_auto glo, 'sn', s_bkg )471 CALL iom_get( inum, jpdom_auto, 'tn', t_bkg ) 472 CALL iom_get( inum, jpdom_auto, 'sn', s_bkg ) 473 473 t_bkg(:,:,:) = t_bkg(:,:,:) * tmask(:,:,:) 474 474 s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:) … … 476 476 ! 477 477 IF ( ln_dyninc ) THEN 478 CALL iom_get( inum, jpdom_auto glo, 'un', u_bkg )479 CALL iom_get( inum, jpdom_auto glo, 'vn', v_bkg )478 CALL iom_get( inum, jpdom_auto, 'un', u_bkg ) 479 CALL iom_get( inum, jpdom_auto, 'vn', v_bkg ) 480 480 u_bkg(:,:,:) = u_bkg(:,:,:) * umask(:,:,:) 481 481 v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:) … … 483 483 ! 484 484 IF ( ln_sshinc ) THEN 485 CALL iom_get( inum, jpdom_auto glo, 'sshn', ssh_bkg )485 CALL iom_get( inum, jpdom_auto, 'sshn', ssh_bkg ) 486 486 ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1) 487 487 ENDIF -
NEMO/trunk/src/SWE/domvvl.F90
r13458 r13472 1105 1105 IF( ln_rstart ) THEN !* Read the restart file 1106 1106 CALL rst_read_open ! open the restart file if necessary 1107 CALL iom_get( numror, jpdom_auto glo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )1107 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 1108 1108 ! 1109 1109 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 1118 1118 ! 1119 1119 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 1120 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )1121 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )1120 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 1121 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 1122 1122 ! needed to restart if land processor not computed 1123 1123 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 1133 1133 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 1134 1134 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 1135 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )1135 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 1136 1136 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 1137 1137 l_1st_euler = .true. … … 1140 1140 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 1141 1141 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 1142 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )1142 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 1143 1143 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 1144 1144 l_1st_euler = .true. … … 1165 1165 ! ! ----------------------- ! 1166 1166 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 1167 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios )1168 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios )1167 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 1168 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 1169 1169 ELSE ! one at least array is missing 1170 1170 tilde_e3t_b(:,:,:) = 0.0_wp … … 1175 1175 ! ! ------------ ! 1176 1176 IF( id5 > 0 ) THEN ! required array exists 1177 CALL iom_get( numror, jpdom_auto glo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios )1177 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 1178 1178 ELSE ! array is missing 1179 1179 hdiv_lf(:,:,:) = 0.0_wp -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zfechem.F90
r13295 r13472 118 118 ! 119 119 zfeequi = zFe3(ji,jj,jk) * 1E-9 120 zhplus = max( rtrn, hi(ji,jj,jk) )121 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 &122 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) &123 & + fesol(ji,jj,jk,5) / zhplus )124 120 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 125 121 ! precipitation of Fe3+, creation of nanoparticles -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsms.F90
r13295 r13472 69 69 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d 70 70 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: zw3d 71 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace71 REAL(wp), DIMENSION(jpi,jpj,jpk,jp_pisces) :: ztrbbio 72 72 73 73 !!--------------------------------------------------------------------- … … 93 93 rfact = rDt_trc 94 94 ! 95 ! trends computation initialisation96 IF( l_trdtrc ) THEN97 ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) ) !* store now fields before applying the Asselin filter98 ztrdt(:,:,:,:) = tr(:,:,:,:,Kmm)99 ENDIF100 !101 102 95 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 103 96 rfactr = 1. / rfact … … 117 110 END DO 118 111 ENDIF 112 113 DO jn = jp_pcs0, jp_pcs1 ! Store the tracer concentrations before entering PISCES 114 ztrbbio(:,:,:,jn) = tr(:,:,:,jn,Kbb) 115 END DO 116 119 117 ! 120 118 IF( ll_bc ) CALL p4z_bc( kt, Kbb, Kmm, Krhs ) ! external sources of nutrients … … 198 196 END DO 199 197 ! 200 IF( ln_top_euler ) THEN 201 DO jn = jp_pcs0, jp_pcs1 202 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 203 END DO 204 ENDIF 198 END DO 199 ! 200 #endif 201 ! 202 IF( ln_sediment ) THEN 203 ! 204 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 205 ! 206 ENDIF 207 ! 208 DO jn = jp_pcs0, jp_pcs1 209 tr(:,:,:,jn,Krhs) = ( tr(:,:,:,jn,Kbb) - ztrbbio(:,:,:,jn) ) * rfactr 210 tr(:,:,:,jn,Kbb ) = ztrbbio(:,:,:,jn) 211 ztrbbio(:,:,:,jn) = 0._wp 205 212 END DO 206 213 ! 207 214 IF( l_trdtrc ) THEN 208 215 DO jn = jp_pcs0, jp_pcs1 209 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr210 216 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 211 217 END DO 212 DEALLOCATE( ztrdt )213 218 END IF 214 #endif 215 ! 216 IF( ln_sediment ) THEN 217 ! 218 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 219 ! 220 IF( ln_top_euler ) THEN 221 DO jn = jp_pcs0, jp_pcs1 222 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 223 END DO 224 ENDIF 225 ! 226 ENDIF 227 ! 219 ! 228 220 IF( lrst_trc ) CALL p4z_rst( kt, Kbb, Kmm, 'WRITE' ) !* Write PISCES informations in restart file 229 221 ! -
NEMO/trunk/tests/BENCH/MY_SRC/usrdef_sbc.F90
r13295 r13472 137 137 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 138 138 !! 139 REAL(wp) :: zfr1, zfr2 ! local variables140 139 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 141 140 !!--------------------------------------------------------------------- … … 172 171 qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 173 172 174 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 175 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm 176 zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1 177 ! 178 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 179 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 180 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 181 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 182 ELSEWHERE ! zero when hs>0 183 qtr_ice_top(:,:,:) = 0._wp 184 END WHERE 173 ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 174 qtr_ice_top(:,:,:) = 0._wp 175 185 176 #endif 186 177 -
NEMO/trunk/tests/CANAL/EXPREF/file_def_nemo-oce.xml
r9572 r13472 15 15 <field field_ref="soce" /> 16 16 <field field_ref="ssh" /> 17 <field field_ref="s algrad" />18 <field field_ref=" ke_zint" />17 <field field_ref="socegrad" /> 18 <field field_ref="eken_int" /> 19 19 <field field_ref="relvor" /> 20 20 <field field_ref="potvor" /> -
NEMO/trunk/tests/CANAL/EXPREF/namelist_cfg
r13461 r13472 20 20 &namusr_def ! User defined : CANAL configuration: Flat bottom, beta-plane 21 21 !----------------------------------------------------------------------- 22 rn_domszx = 3600. ! x horizontal size [km]23 rn_domszy = 1 800. ! y horizontal size [km]24 rn_domszz = 5000. ! z vertical size [m]25 rn_dx = 30. ! x horizontal resolution [km]26 rn_dy = 30. ! y horizontal resolution [km]27 rn_dz = 500. ! z vertical resolution [m]22 rn_domszx = 2000. ! x horizontal size [km] 23 rn_domszy = 1000. ! y horizontal size [km] 24 rn_domszz = 1000. ! z vertical size [m] 25 rn_dx = 10. ! x horizontal resolution [km] 26 rn_dy = 10. ! y horizontal resolution [km] 27 rn_dz = 1000. ! z vertical resolution [m] 28 28 rn_0xratio = 0.5 ! x-domain ratio of the 0 29 29 rn_0yratio = 0.5 ! y-domain ratio of the 0 … … 31 31 rn_ppgphi0 = 38.5 ! Reference latitude [degrees] 32 32 rn_u10 = 0. ! 10m wind speed [m/s] 33 rn_windszx = 4000.! longitudinal wind extension [km]34 rn_windszy = 4000.! latitudinal wind extension [km]35 rn_uofac = 0.! Uoce multiplicative factor (0.:absolute or 1.:relative winds)33 rn_windszx = 90. ! longitudinal wind extension [km] 34 rn_windszy = 90. ! latitudinal wind extension [km] 35 !!clem rn_uofac = 0. ! Uoce multiplicative factor (0.:absolute or 1.:relative winds) 36 36 rn_vtxmax = 1. ! initial vortex max current [m/s] 37 37 rn_uzonal = 1. ! initial zonal current [m/s] 38 rn_ujetszx = 4000. 39 rn_ujetszy = 400 0. ! latitudinal jet extension [km]38 rn_ujetszx = 4000. ! longitudinal jet extension [km] 39 rn_ujetszy = 400. ! latitudinal jet extension [km] 40 40 nn_botcase = 0 ! bottom definition (0:flat, 1:bump) 41 nn_initcase = 1 ! initial condition case (0:rest, 1:zonal current, 2:current shear, 3: gaussian zonal current, 42 ! ! 4: geostrophic zonal pulse, 5: vortex) 43 ln_sshnoise = .false. ! add random noise on initial ssh 44 rn_lambda = 50. ! gaussian lambda 41 nn_initcase = 1 ! initial condition case 42 ! ! -1 : stratif at rest 43 ! ! 0 : rest 44 ! ! 1 : zonal current 45 ! ! 2 : current shear 46 ! ! 3 : gaussian zonal current 47 ! ! 4 : geostrophic zonal pulse 48 ! ! 5 : baroclinic vortex 49 ln_sshnoise = .FALSE. ! add random noise on initial ssh 50 rn_lambda = 50. ! gaussian lambda 51 nn_perio = 1 45 52 / 46 53 !----------------------------------------------------------------------- … … 59 66 !----------------------------------------------------------------------- 60 67 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 61 rn_Dt = 1440. ! time step for the dynamics (and tracer if nn_acc=0) 62 rn_atfp = 0.05 ! asselin time filter parameter 68 rn_Dt = 1200. ! time step for the dynamics (and tracer if nn_acc=0) 69 rn_atfp = 0.0 ! asselin time filter parameter 70 / 71 !----------------------------------------------------------------------- 72 &namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg) 73 !----------------------------------------------------------------------- 74 ln_write_cfg = .false. ! (=T) create the domain configuration file 75 cn_domcfg_out = "domain_cfg" ! newly created domain configuration filename 63 76 / 64 77 !!====================================================================== … … 148 161 ln_traadv_OFF = .false. ! No tracer advection 149 162 ln_traadv_cen = .false. ! 2nd order centered scheme 150 nn_cen_h = 4! =2/4, horizontal 2nd order CEN / 4th order CEN151 nn_cen_v = 4! =2/4, vertical 2nd order CEN / 4th order COMPACT163 nn_cen_h = 2 ! =2/4, horizontal 2nd order CEN / 4th order CEN 164 nn_cen_v = 2 ! =2/4, vertical 2nd order CEN / 4th order COMPACT 152 165 ln_traadv_fct = .false. ! FCT scheme 153 nn_fct_h = 2! =2/4, horizontal 2nd / 4th order166 nn_fct_h = 4 ! =2/4, horizontal 2nd / 4th order 154 167 nn_fct_v = 2 ! =2/4, vertical 2nd / COMPACT 4th order 155 168 ln_traadv_mus = .false. ! MUSCL scheme … … 162 175 &namtra_ldf ! lateral diffusion scheme for tracers (default: NO selection) 163 176 !----------------------------------------------------------------------- 164 ln_traldf_OFF = .true. ! No explicit diffusion 177 ! ! Operator type: 178 ln_traldf_OFF = .true. ! No explicit diffusion 179 ln_traldf_lap = .false. ! laplacian operator 180 ln_traldf_blp = .false. ! bilaplacian operator 181 ! 182 ! ! Direction of action: 183 ln_traldf_lev = .false. ! iso-level 184 ln_traldf_hor = .true. ! horizontal (geopotential) 185 ln_traldf_iso = .false. ! iso-neutral (standard operator) 186 ln_traldf_triad = .false. ! iso-neutral (triad operator) 187 ! 188 ! ! iso-neutral options: 189 ln_traldf_msc = .false. ! Method of Stabilizing Correction (both operators) 190 rn_slpmax = 0.01 ! slope limit (both operators) 191 ln_triad_iso = .false. ! pure horizontal mixing in ML (triad only) 192 rn_sw_triad = 1 ! =1 switching triad ; =0 all 4 triads used (triad only) 193 ln_botmix_triad = .false. ! lateral mixing on bottom (triad only) 194 ! 195 ! ! Coefficients: 196 nn_aht_ijk_t = 31 ! space/time variation of eddy coefficient: 197 ! ! =-20 (=-30) read in eddy_diffusivity_2D.nc (..._3D.nc) file 198 ! ! = 0 constant 199 ! ! = 10 F(k) =ldf_c1d 200 ! ! = 20 F(i,j) =ldf_c2d 201 ! ! = 21 F(i,j,t) =Treguier et al. JPO 1997 formulation 202 ! ! = 30 F(i,j,k) =ldf_c2d * ldf_c1d 203 ! ! = 31 F(i,j,k,t)=F(local velocity and grid-spacing) 204 ! ! time invariant coefficients: aht0 = 1/2 Ud*Ld (lap case) 205 ! ! or = 1/12 Ud*Ld^3 (blp case) 206 rn_Ud = 0.01 ! lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30) 207 rn_Ld = 200.e+3 ! lateral diffusive length [m] (nn_aht_ijk_t= 0, 10) 165 208 / 166 209 !!====================================================================== … … 183 226 nn_dynkeg = 0 ! scheme for grad(KE): =0 C2 ; =1 Hollingsworth correction 184 227 ln_dynadv_cen2 = .false. ! flux form - 2nd order centered scheme 185 ln_dynadv_ubs = .true. ! flux form - 3rd order UBS scheme228 ln_dynadv_ubs = .true. ! flux form - 3rd order UBS scheme 186 229 / 187 230 !----------------------------------------------------------------------- 188 231 &namdyn_vor ! Vorticity / Coriolis scheme (default: NO selection) 189 232 !----------------------------------------------------------------------- 190 ln_dynvor_ene = . true. ! energy conserving scheme191 ln_dynvor_ens = .false. ! enstrophy conserving scheme192 ln_dynvor_mix = .false. ! mixed scheme233 ln_dynvor_ene = .false. ! energy conserving scheme 234 ln_dynvor_ens = .false. ! enstrophy conserving scheme 235 ln_dynvor_mix = .false. ! mixed scheme 193 236 ln_dynvor_een = .false. ! energy & enstrophy scheme 237 ln_dynvor_enT = .false. ! energy conserving scheme (T-point) 238 ln_dynvor_eeT = .true. ! energy conserving scheme (een using e3t) 194 239 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 195 240 / … … 210 255 ! ! = 1 Boxcar over nn_e sub-steps 211 256 ! ! = 2 Boxcar over 2*nn_e " " 212 ln_bt_auto = . false. ! Number of sub-step defined from:257 ln_bt_auto = .true. ! Number of sub-step defined from: 213 258 nn_e = 24 ! =F : the number of sub-step in rn_Dt seconds 214 259 / … … 222 267 ! ! Direction of action : 223 268 ln_dynldf_lev = .false. ! iso-level 224 ln_dynldf_hor = . true. ! horizontal (geopotential)269 ln_dynldf_hor = .false. ! horizontal (geopotential) 225 270 ln_dynldf_iso = .false. ! iso-neutral 226 271 ! ! Coefficient 227 nn_ahm_ijk_t = 20! space/time variation of eddy coef272 nn_ahm_ijk_t = 31 ! space/time variation of eddy coef 228 273 ! ! =-30 read in eddy_viscosity_3D.nc file 229 274 ! ! =-20 read in eddy_viscosity_2D.nc file … … 275 320 !! namdiu Cool skin and warm layer models (default: OFF) 276 321 !! namdiu Cool skin and warm layer models (default: OFF) 322 <<<<<<< .working 277 323 !! namflo float parameters (default: OFF) 278 324 !! nam_diadct transports through some sections (default: OFF) 325 ||||||| .merge-left.r13465 326 !! namflo float parameters (default: OFF) 327 !! nam_diaharm Harmonic analysis of tidal constituents (default: OFF) 328 !! nam_diadct transports through some sections (default: OFF) 329 ======= 330 !! namflo float parameters ("key_float") 331 !! nam_diaharm Harmonic analysis of tidal constituents ("key_diaharm") 332 !! namdct transports through some sections ("key_diadct") 333 !! nam_diatmb Top Middle Bottom Output (default: OFF) 334 >>>>>>> .merge-right.r13470 279 335 !! nam_dia25h 25h Mean Output (default: OFF) 280 336 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") … … 285 341 !----------------------------------------------------------------------- 286 342 ln_glo_trd = .false. ! (T) global domain averaged diag for T, T^2, KE, and PE 287 ln_dyn_trd = .true. ! (T) 3D momentum trend output343 ln_dyn_trd = .true. ! (T) 3D momentum trend output 288 344 ln_dyn_mxl = .false. ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 289 345 ln_vor_trd = .false. ! (T) 2D barotropic vorticity trends (not coded yet) … … 312 368 &nammpp ! Massively Parallel Processing ("key_mpp_mpi") 313 369 !----------------------------------------------------------------------- 370 !! jpni = 8 ! jpni number of processors following i (set automatically if < 1) 371 !! jpnj = 1 ! jpnj number of processors following j (set automatically if < 1) 314 372 / 315 373 !----------------------------------------------------------------------- 316 374 &namctl ! Control prints (default: OFF) 317 375 !----------------------------------------------------------------------- 376 ln_timing = .true. ! timing by routine write out in timing.output file 377 !! ln_diacfl = .true. ! CFL diagnostics write out in cfl_diagnostics.ascii 318 378 / 319 379 !----------------------------------------------------------------------- -
NEMO/trunk/tests/CANAL/MY_SRC/usrdef_istate.F90
r13295 r13472 66 66 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 67 67 ! 68 IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom)69 68 zjetx = ABS(rn_ujetszx)/2. 70 69 zjety = ABS(rn_ujetszy)/2. 71 70 ! 71 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 72 ! 72 73 SELECT CASE(nn_initcase) 74 75 CASE(-1) ! stratif at rest 76 77 ! sea level: 78 pssh(:,:) = 0. 79 ! temperature: 80 pts(:,:,1,jp_tem) = 25. !!30._wp 81 pts(:,:,2:jpk,jp_tem) = 22. !!24._wp 82 ! salinity: 83 pts(:,:,:,jp_sal) = 35._wp 84 ! velocities: 85 pu(:,:,:) = 0. 86 pv(:,:,:) = 0. 87 73 88 CASE(0) ! rest 74 89 … … 98 113 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 99 114 WHERE( ABS(gphit) <= zjety ) 100 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:)* gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 )101 ELSEWHERE 102 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:)* SIGN(zjety, gphit(:,:)) * 1.e3 &115 pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 116 ELSEWHERE 117 pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 & 103 118 & + 0.5 * zbeta * zjety * zjety * 1.e6 ) 104 119 END WHERE … … 109 124 pts(:,:,jpk,jp_sal) = 0. 110 125 DO jk=1, jpkm1 111 pts(:,:,jk,jp_sal) = gphit(:,:) 126 WHERE( ABS(gphit) <= zjety ) 127 !!$ WHERE( ABS(gphit) <= zjety*0.5 .AND. ABS(glamt) <= zjety*0.5 ) ! for a square of salt 128 pts(:,:,jk,jp_sal) = 35. 129 ELSEWHERE 130 pts(:,:,jk,jp_sal) = 30. 131 END WHERE 112 132 END DO 113 133 ! velocities: … … 134 154 WHERE( ABS(gphit) <= zjety ) 135 155 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 136 & * ( ff_t(:,:)* gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 )156 & * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 137 157 ELSEWHERE 138 158 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 139 & * ( ff_t(:,:)* SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 )159 & * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 140 160 END WHERE 141 161 END SELECT … … 143 163 pts(:,:,:,jp_tem) = 10._wp 144 164 ! salinity: 145 pts(:,:,:,jp_sal) = 2.146 DO jk=1, jpkm1 147 WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 2. + SIGN(1.,gphiv(:,:))165 pts(:,:,:,jp_sal) = 30. 166 DO jk=1, jpkm1 167 WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 30. + SIGN(1.,gphiv(:,:)) 148 168 END DO 149 169 ! velocities: … … 176 196 ! salinity: 177 197 DO jk=1, jpkm1 178 pts(:,:,jk,jp_sal) = gphit(:,:)198 pts(:,:,jk,jp_sal) = pssh(:,:) 179 199 END DO 180 200 ! velocities: … … 210 230 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 211 231 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 212 zlambda = SQRT(2._wp)*rn_lambda ! Horizontal scale in meters232 zlambda = SQRT(2._wp)*rn_lambda*1.e3 ! Horizontal scale in meters 213 233 zn2 = 3.e-3**2 214 234 zH = 0.5_wp * 5000._wp … … 281 301 282 302 IF (ln_sshnoise) THEN 303 CALL RANDOM_SEED() 283 304 CALL RANDOM_NUMBER(zrandom) 284 305 pssh(:,:) = pssh(:,:) + ( 0.1 * zrandom(:,:) - 0.05 ) -
NEMO/trunk/tests/CANAL/MY_SRC/usrdef_nam.F90
r13286 r13472 50 50 LOGICAL , PUBLIC :: ln_sshnoise=.false. ! add random noise on initial ssh 51 51 REAL(wp), PUBLIC :: rn_lambda = 50. ! gaussian lambda 52 INTEGER , PUBLIC :: nn_perio = 0 ! periodicity of the channel (0=closed, 1=E-W) 52 53 53 54 !!---------------------------------------------------------------------- … … 79 80 !! 80 81 NAMELIST/namusr_def/ rn_domszx, rn_domszy, rn_domszz, rn_dx, rn_dy, rn_dz, rn_0xratio, rn_0yratio & 81 & , nn_fcase, rn_ppgphi0, rn_ vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy&82 & , rn_ u10, rn_windszx, rn_windszy, rn_uofac&83 & , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda 82 & , nn_fcase, rn_ppgphi0, rn_u10, rn_windszx, rn_windszy & !!, rn_uofac & 83 & , rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy & 84 & , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda, nn_perio 84 85 !!---------------------------------------------------------------------- 85 86 ! … … 148 149 WRITE(numout,*) ' add random noise on initial ssh ln_sshnoise= ', ln_sshnoise 149 150 WRITE(numout,*) ' Gaussian lambda parameter rn_lambda = ', rn_lambda 150 WRITE(numout,*) ' ' 151 WRITE(numout,*) ' Lateral boundary condition of the global domain' 152 WRITE(numout,*) ' EW_CANAL : closed basin jperio = ', kperio 151 WRITE(numout,*) ' Periodicity of the basin nn_perio = ', nn_perio 153 152 ENDIF 153 ! ! Set the lateral boundary condition of the global domain 154 kperio = nn_perio ! EW_CANAL configuration : closed basin 154 155 ! 155 156 END SUBROUTINE usr_def_nam -
NEMO/trunk/tests/CANAL/MY_SRC/usrdef_sbc.F90
r12740 r13472 17 17 USE sbc_oce ! Surface boundary condition: ocean fields 18 18 USE phycst ! physical constants 19 USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy 19 USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy, rn_windszx 20 20 ! 21 21 USE in_out_manager ! I/O manager … … 69 69 ! 70 70 utau(:,:) = 0._wp 71 IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN72 WHERE( ABS(gphit) <= rn_windszy/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u1073 ENDIF74 71 vtau(:,:) = 0._wp 75 72 taum(:,:) = 0._wp … … 81 78 qsr (:,:) = 0._wp 82 79 ! 80 ENDIF 81 82 IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 83 IF( nyear == 1 .AND. nmonth == 1 .AND. nday <= 10 ) THEN 84 WHERE( ABS(gphit) <= rn_windszy/2. .AND. ABS(glamt) <= rn_windszx/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 85 ELSE 86 utau(:,:) = 0. 87 ENDIF 83 88 ENDIF 84 89 -
NEMO/trunk/tests/CANAL/MY_SRC/usrdef_zgr.F90
r12740 r13472 197 197 zmaxlam = MAXVAL(glamt) 198 198 CALL mpp_max( 'usrdef_zgr', zmaxlam ) ! max over the global domain 199 zscl = rpi / zmaxlam200 z2d(:,:) = 0.5 * ( 1. - COS( glamt(:,:) * zscl ))201 z2d(:,:) = REAL(jpkm1 - NINT( 0. 75 * REAL(jpkm1,wp) * z2d(:,:) ), wp)199 zscl = 0.5 * rpi / zmaxlam 200 z2d(:,:) = COS( glamt(:,:) * zscl ) 201 z2d(:,:) = REAL(jpkm1 - NINT( 0.5 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 202 202 END SELECT 203 203 ! -
NEMO/trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg
r10535 r13472 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_60pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_120pts
r10431 r13472 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_120pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_240pts
r10431 r13472 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_240pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/trunk/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_60pts
r10431 r13472 88 88 !------------------------------------------------------------------------------ 89 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)90 nn_iceini_file = 1 ! netcdf file provided for initialization 91 91 92 92 sn_hti = 'initice_60pts' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/trunk/tests/ICE_ADV1D/MY_SRC/usrdef_sbc.F90
r12377 r13472 107 107 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 108 108 !! 109 INTEGER :: jl 109 110 REAL(wp) :: zfr1, zfr2 ! local variables 110 111 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 112 REAL(wp), DIMENSION(jpi,jpj) :: ztri 111 113 !!--------------------------------------------------------------------- 112 114 ! … … 141 143 142 144 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 143 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm144 z fr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1145 cloud_fra(:,:) = pp_cldf 146 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 145 147 ! 146 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 147 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 148 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 149 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 150 ELSEWHERE ! zero when hs>0 151 qtr_ice_top(:,:,:) = 0._wp 152 END WHERE 153 148 DO jl = 1, jpl 149 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 150 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 151 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 152 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 153 ELSEWHERE ! zero when hs>0 154 qtr_ice_top(:,:,jl) = 0._wp 155 END WHERE 156 ENDDO 157 158 154 159 END SUBROUTINE usrdef_sbc_ice_flx 155 160 -
NEMO/trunk/tests/ICE_ADV2D/EXPREF/namelist_ice_cfg
r10535 r13472 86 86 !------------------------------------------------------------------------------ 87 87 ln_iceini = .true. ! activate ice initialization (T) or not (F) 88 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)88 nn_iceini_file = 1 ! netcdf file provided for initialization 89 89 90 90 sn_hti = 'initice' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/trunk/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90
r12377 r13472 107 107 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 108 108 !! 109 INTEGER :: jl 109 110 REAL(wp) :: zfr1, zfr2 ! local variables 110 111 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 112 REAL(wp), DIMENSION(jpi,jpj) :: ztri 111 113 !!--------------------------------------------------------------------- 112 114 ! … … 141 143 142 144 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 143 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm144 z fr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1145 cloud_fra(:,:) = pp_cldf 146 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 145 147 ! 146 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 147 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 148 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 149 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 150 ELSEWHERE ! zero when hs>0 151 qtr_ice_top(:,:,:) = 0._wp 152 END WHERE 153 148 DO jl = 1, jpl 149 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 150 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 151 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 152 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 153 ELSEWHERE ! zero when hs>0 154 qtr_ice_top(:,:,jl) = 0._wp 155 END WHERE 156 ENDDO 157 158 154 159 END SUBROUTINE usrdef_sbc_ice_flx 155 160 -
NEMO/trunk/tests/ICE_AGRIF/EXPREF/namelist_ice_cfg
r10535 r13472 86 86 !------------------------------------------------------------------------------ 87 87 ln_iceini = .true. ! activate ice initialization (T) or not (F) 88 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F)88 nn_iceini_file = 1 ! netcdf file provided for initialization 89 89 90 90 sn_hti = 'initice' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' -
NEMO/trunk/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90
r12377 r13472 107 107 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 108 108 !! 109 INTEGER :: jl 109 110 REAL(wp) :: zfr1, zfr2 ! local variables 110 111 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 112 REAL(wp), DIMENSION(jpi,jpj) :: ztri 111 113 !!--------------------------------------------------------------------- 112 114 ! … … 141 143 142 144 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 143 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm144 z fr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1145 cloud_fra(:,:) = pp_cldf 146 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 145 147 ! 146 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 147 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 148 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 149 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 150 ELSEWHERE ! zero when hs>0 151 qtr_ice_top(:,:,:) = 0._wp 152 END WHERE 148 DO jl = 1, jpl 149 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 150 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 151 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 152 qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 153 ELSEWHERE ! zero when hs>0 154 qtr_ice_top(:,:,jl) = 0._wp 155 END WHERE 156 ENDDO 153 157 154 158 END SUBROUTINE usrdef_sbc_ice_flx
Note: See TracChangeset
for help on using the changeset viewer.