8 dmsnowdt_in, i_atm_in, q_atm_lw_in, height_u_in, height_tq_in, &
9 u_a_in, t_a_in, q_a_in, p_a_in, &
11 depth_w, fetch, depth_bs, t_bs, par_coriolis, del_time, &
14 extincoef_water, extincoef_ice, extincoef_snow, &
16 t_snow, t_ice, t_mnw, t_wml, t_bot, t_b1, c_t, h_snow, h_ice, &
19 q_sensible, q_latent ,q_momentum, z0, z0t, qsat, ri, ustar, cd_a, &
20 q_watvap, q_latenti, q_sublim, q_atm_lw_up, pswe, &
22 lflk_botsed, lflk_skintemp, hflk_flux, ppew_a_coef, ppew_b_coef, &
23 rho_a, himplicit_wind )
100 t_snow_p_flk, t_snow_n_flk , &
101 t_ice_p_flk, t_ice_n_flk , &
102 t_mnw_p_flk, t_mnw_n_flk , &
103 t_wml_p_flk, t_wml_n_flk , &
104 t_bot_p_flk, t_bot_n_flk , &
105 t_b1_p_flk, t_b1_n_flk , &
106 c_t_p_flk, c_t_n_flk , &
107 h_snow_p_flk, h_snow_n_flk , &
108 h_ice_p_flk, h_ice_n_flk , &
109 h_ml_p_flk, h_ml_n_flk , &
110 h_b1_p_flk, h_b1_n_flk , &
141 USE modi_wind_threshold
143 USE yomhook
,ONLY : lhook, dr_hook
144 USE parkind1
,ONLY : jprb
158 INTEGER,
INTENT(IN) :: ki
162 REAL,
DIMENSION(KI),
INTENT(IN) :: &
173 REAL,
DIMENSION(KI),
INTENT(IN) :: &
186 CHARACTER(LEN=*),
INTENT(IN) :: himplicit_wind
190 LOGICAL,
INTENT(IN) :: lflk_botsed
191 LOGICAL,
INTENT(IN) :: lflk_skintemp
192 CHARACTER(LEN=5),
INTENT(IN) :: hflk_flux
197 REAL,
DIMENSION(KI),
INTENT(IN) :: albedo
200 REAL,
DIMENSION(KI),
INTENT(INOUT) :: &
205 REAL,
DIMENSION(KI),
INTENT(INOUT) :: &
221 REAL,
DIMENSION(KI),
INTENT(INOUT) :: &
234 REAL,
DIMENSION(KI),
INTENT(OUT) :: &
246 REAL,
DIMENSION(KI) :: &
253 REAL(KIND=JPRB) :: zhook_handle
255 REAL,
PARAMETER :: ztimemax = 300.
258 REAL :: zaux, zcond, zloc, ztstep
263 IF (lhook) CALL dr_hook(
'FLAKE_INTERFACE',0,zhook_handle)
272 opticpar_ice = opticpar_ice_opaque
273 opticpar_snow = opticpar_snow_opaque
275 lflk_botsed_use = lflk_botsed
279 h_point_loop:
DO jl = 1,ki
285 (/1., (0.,i=2,nband_optic_max)/), &
286 (/extincoef_water(jl), (1.e+10,i=2,nband_optic_max)/))
287 t_snow_p_flk = t_snow(jl)
288 t_ice_p_flk = t_ice(jl)
289 t_mnw_p_flk = t_mnw(jl)
290 t_wml_p_flk = t_wml(jl)
291 t_bot_p_flk = t_bot(jl)
292 t_b1_p_flk = t_b1(jl)
294 h_snow_p_flk = h_snow(jl)
295 h_ice_p_flk = h_ice(jl)
296 h_ml_p_flk = h_ml(jl)
297 h_b1_p_flk = h_b1(jl)
303 dmsnowdt_flk = dmsnowdt_in(jl)
309 i_atm_flk = i_atm_in(jl)
310 CALL
flake_radflux( depth_w(jl), albedo(jl), opticpar_water(jl), &
311 opticpar_ice(jl), opticpar_snow(jl) )
318 q_w_flk = emis_water(jl)*q_atm_lw_in(jl) -
sfcflx_lwradwsfc(emis_water(jl),t_sfc(jl))
320 q_atm_lw_up(jl) = q_atm_lw_in(jl) - q_w_flk
326 IF (hflk_flux==
'FLAKE')
THEN
328 q_momentum(jl) = - rho_a(jl) * ustar(jl)**2
331 u_a_in(jl), t_a_in(jl), q_a_in(jl), t_sfc(jl), &
332 p_a_in(jl), h_ice_p_flk, q_momentum(jl), &
333 q_sensible(jl), q_latent(jl), q_watvap(jl), &
334 ri(jl), z0(jl), z0t(jl), qsat(jl), &
335 q_latenti(jl), q_sublim(jl) )
344 cd_a(jl) = - q_momentum(jl) / rho_a(jl) / zwind(jl)**2
349 IF(himplicit_wind==
'OLD')
THEN
351 ustar2 = (cd_a(jl)*u_a_in(jl)*ppew_b_coef(jl))/ &
352 (1.0-rho_a(jl)*cd_a(jl)*u_a_in(jl)*ppew_a_coef(jl))
355 ustar2 = (cd_a(jl)*u_a_in(jl)*(2.*ppew_b_coef(jl)-u_a_in(jl)))/ &
356 (1.0-2.0*rho_a(jl)*cd_a(jl)*u_a_in(jl)*ppew_a_coef(jl))
357 zvmod = rho_a(jl)*ppew_a_coef(jl)*ustar2 + ppew_b_coef(jl)
358 zvmod = max(0.0,zvmod)
359 IF(ppew_a_coef(jl)/= 0.)
THEN
360 ustar2 = max((zvmod-ppew_b_coef(jl))/(rho_a(jl)*ppew_a_coef(jl)),0.0)
363 ustar(jl) =sqrt(ustar2)
365 q_momentum(jl) = - rho_a(jl) * ustar2
368 u_star_w_flk = sqrt(-q_momentum(jl)/tpl_rho_w_r)
374 q_w_flk = q_w_flk - q_sensible(jl) - q_latent(jl)
376 IF(h_ice_p_flk.GE.h_ice_min_flk)
THEN
377 IF(h_snow_p_flk.GE.h_snow_min_flk)
THEN
396 indt = max(1,nint(del_time(jl)/ztimemax))
397 ztstep = del_time(jl)/
REAL(indt)
401 t_snow_p_flk = t_snow(jl)
402 t_ice_p_flk = t_ice(jl)
403 t_mnw_p_flk = t_mnw(jl)
404 t_wml_p_flk = t_wml(jl)
405 t_bot_p_flk = t_bot(jl)
406 t_b1_p_flk = t_b1(jl)
408 h_snow_p_flk = h_snow(jl)
409 h_ice_p_flk = h_ice(jl)
410 h_ml_p_flk = h_ml(jl)
411 h_b1_p_flk = h_b1(jl)
413 CALL
flake_driver( depth_w(jl), depth_bs(jl), t_bs(jl), par_coriolis(jl), &
414 opticpar_water(jl)%extincoef_optic(1), &
415 ztstep, t_sfc(jl), t_sfc_n )
421 t_snow(jl) = t_snow_n_flk
422 t_ice(jl) = t_ice_n_flk
423 t_mnw(jl) = t_mnw_n_flk
424 t_wml(jl) = t_wml_n_flk
425 t_bot(jl) = t_bot_n_flk
426 t_b1(jl) = t_b1_n_flk
428 h_snow(jl) = h_snow_n_flk
429 h_ice(jl) = h_ice_n_flk
430 h_ml(jl) = h_ml_n_flk
431 h_b1(jl) = h_b1_n_flk
445 IF (lflk_skintemp.AND.(h_ice(jl)<h_ice_min_flk).AND.(hflk_flux==
'FLAKE'))
THEN
447 zaux = (1.0-exp(-opticpar_water(jl)%extincoef_optic(1) * h_skinlayer_flk)) &
448 / opticpar_water(jl)%extincoef_optic(1)
452 zloc = ((1.0-albedo(jl))*i_atm_flk+q_w_flk)*h_skinlayer_flk-(1.0-albedo(jl))*i_atm_flk*zaux
454 t_sfc(jl) = t_sfc_n + zloc / zcond
460 IF (lhook) CALL dr_hook(
'FLAKE_INTERFACE',1,zhook_handle)
real function sfcflx_lwradwsfc(emis, pts)
subroutine sfcflx_momsenlat(height_u, height_tq, fetch, U_a, T_a, q_a, T_s, P_a, h_ice, Q_momentum, Q_sensible, Q_latent, Q_watvap, Ri, z0u_ini, z0t_ini, Qsat_out, Q_latenti, Q_sublim)
real function, dimension(size(pwind)) wind_threshold(PWIND, PUREF)
subroutine flake_radflux(depth_w, albedo, opticpar_water, opticpar_ice, opticpar_snow)
subroutine flake_interface(KI,
real function flake_snowdensity(h_snow)
subroutine flake_driver(depth_w, depth_bs, T_bs, par_Coriolis, extincoef_water_typ, del_time, T_sfc_p, T_sfc_n)