SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
coupling_flaken.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! ###############################################################################
6 SUBROUTINE coupling_flake_n (FM, DST, SLT, &
7  hprogram, hcoupling, &
8  ptstep, kyear, kmonth, kday, ptime, ki, ksv, ksw, ptsun, pzenith, &
9  pzenith2, pazim, pzref, puref, pu, pv, pqa, pta, prhoa, psv, pco2, &
10  hsv, prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
11  psftq, psfth, psfts, psfco2, psfu, psfv, &
12  ptsrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
13  ppew_a_coef, ppew_b_coef, &
14  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
15  htest )
16 ! ###############################################################################
17 
18 !
19 !!**** *COUPLING_FLAKE_n * - Driver for FLAKE scheme for lakes
20 !!
21 !! PURPOSE
22 !! -------
23 !
24 !!** METHOD
25 !! ------
26 !!
27 !! REFERENCE
28 !! ---------
29 !!
30 !!
31 !! AUTHOR
32 !! ------
33 !! V. Masson
34 !!
35 !! MODIFICATIONS
36 !! -------------
37 !! Original 01/2004
38 !! V. Masson 05/2009 Implicitation of momentum fluxes
39 !! B. Decharme 01/2010 Add XTT in water_flux
40 !! V. Masson 11/2011 Ch limited to 1.E-7 in all cases and Cd coming from
41 !! Flake_interface routine if computed by flake
42 !! B. Decharme 09/2012 New wind implicitation
43 !! P. Le Moigne 10/2012 ECUME option for FLake. Remove wind threshold
44 !! P. Le Moigne 04/2013 Remove ECUME option for FLake
45 !! P. Le Moigne 04/2013 Chemistry, UPDATE_RAD_FLAKE
46 !! B. Decharme 04/2013 New diag, new coupling variables
47 !! P. Le Moigne 10/2014 Threshold on Cd when fluxes computed by FLake
48 !!------------------------------------------------------------------------------
49 !
50 !
51 !
52 USE modd_surfex_n, ONLY : flake_model_t
53 !
54 USE modd_dst_n, ONLY : dst_t
55 USE modd_slt_n, ONLY : slt_t
56 !
57 USE modd_reprod_oper, ONLY : cimplicit_wind
58 !
59 USE modd_csts, ONLY : xrd, xcpd, xp00, xlvtt, xlstt, xkarman, xtt
60 USE modd_surf_par, ONLY : xundef
61 !
62 !
63 !
64 USE modd_slt_surf
65 USE modd_dst_surf
66 !
67 USE mode_dslt_surf
68 USE mode_thermos
69 !
70 USE modi_water_flux
71 USE modi_add_forecast_to_date_surf
72 USE modi_diag_inline_flake_n
73 USE modi_diag_misc_flake_n
74 USE modi_ch_aer_dep
75 USE modi_ch_dep_water
76 USE modi_dslt_dep
77 USE modi_flake_albedo
78 USE modi_update_rad_flake
79 USE modi_abor1_sfx
80 USE modi_flake_interface
81 !
82 USE yomhook ,ONLY : lhook, dr_hook
83 USE parkind1 ,ONLY : jprb
84 !
85 !
86 IMPLICIT NONE
87 !
88 !* 0.1 declarations of arguments
89 !
90 !
91 TYPE(flake_model_t), INTENT(INOUT) :: fm
92 TYPE(dst_t), INTENT(INOUT) :: dst
93 TYPE(slt_t), INTENT(INOUT) :: slt
94 !
95  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling surf. schemes
96  CHARACTER(LEN=1), INTENT(IN) :: hcoupling ! type of coupling
97  ! 'E' : explicit
98  ! 'I' : implicit
99 INTEGER, INTENT(IN) :: kyear ! current year (UTC)
100 INTEGER, INTENT(IN) :: kmonth ! current month (UTC)
101 INTEGER, INTENT(IN) :: kday ! current day (UTC)
102 REAL, INTENT(IN) :: ptime ! current time since midnight (UTC, s)
103 INTEGER, INTENT(IN) :: ki ! number of points
104 INTEGER, INTENT(IN) :: ksv ! number of scalars
105 INTEGER, INTENT(IN) :: ksw ! number of short-wave spectral bands
106 REAL, DIMENSION(KI), INTENT(IN) :: ptsun ! solar time (s from midnight)
107 REAL, INTENT(IN) :: ptstep ! atmospheric time-step (s)
108 REAL, DIMENSION(KI), INTENT(IN) :: pzref ! height of T,q forcing (m)
109 REAL, DIMENSION(KI), INTENT(IN) :: puref ! height of wind forcing (m)
110 !
111 REAL, DIMENSION(KI), INTENT(IN) :: pta ! air temperature forcing (K)
112 REAL, DIMENSION(KI), INTENT(IN) :: pqa ! air humidity forcing (kg/m3)
113 REAL, DIMENSION(KI), INTENT(IN) :: prhoa ! air density (kg/m3)
114 REAL, DIMENSION(KI,KSV),INTENT(IN) :: psv ! scalar variables
115 ! ! chemistry: first char. in HSV: '#' (molecule/m3)
116 ! !
117  CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: hsv ! name of all scalar variables
118 REAL, DIMENSION(KI), INTENT(IN) :: pu ! zonal wind (m/s)
119 REAL, DIMENSION(KI), INTENT(IN) :: pv ! meridian wind (m/s)
120 REAL, DIMENSION(KI,KSW),INTENT(IN) :: pdir_sw ! direct solar radiation (on horizontal surf.)
121 ! ! (W/m2)
122 REAL, DIMENSION(KI,KSW),INTENT(IN) :: psca_sw ! diffuse solar radiation (on horizontal surf.)
123 ! ! (W/m2)
124 REAL, DIMENSION(KSW),INTENT(IN) :: psw_bands ! mean wavelength of each shortwave band (m)
125 REAL, DIMENSION(KI), INTENT(IN) :: pzenith ! zenithal angle at t (radian from the vertical)
126 REAL, DIMENSION(KI), INTENT(IN) :: pzenith2 ! zenithal angle at t+1 (radian from the vertical)
127 REAL, DIMENSION(KI), INTENT(IN) :: pazim ! azimuthal angle (radian from North, clockwise)
128 REAL, DIMENSION(KI), INTENT(IN) :: plw ! longwave radiation (on horizontal surf.)
129 ! ! (W/m2)
130 REAL, DIMENSION(KI), INTENT(IN) :: pps ! pressure at atmospheric model surface (Pa)
131 REAL, DIMENSION(KI), INTENT(IN) :: ppa ! pressure at forcing level (Pa)
132 REAL, DIMENSION(KI), INTENT(IN) :: pco2 ! CO2 concentration in the air (kg/m3)
133 REAL, DIMENSION(KI), INTENT(IN) :: psnow ! snow precipitation (kg/m2/s)
134 REAL, DIMENSION(KI), INTENT(IN) :: prain ! liquid precipitation (kg/m2/s)
135 !
136 !
137 REAL, DIMENSION(KI), INTENT(OUT) :: psfth ! flux of heat (W/m2)
138 REAL, DIMENSION(KI), INTENT(OUT) :: psftq ! flux of water vapor (kg/m2/s)
139 REAL, DIMENSION(KI), INTENT(OUT) :: psfu ! zonal momentum flux (Pa)
140 REAL, DIMENSION(KI), INTENT(OUT) :: psfv ! meridian momentum flux (Pa)
141 REAL, DIMENSION(KI), INTENT(OUT) :: psfco2 ! flux of CO2 (m/s*kg_CO2/kg_air)
142 REAL, DIMENSION(KI,KSV),INTENT(OUT):: psfts ! flux of scalar var. (kg/m2/s)
143 !
144 REAL, DIMENSION(KI), INTENT(OUT) :: ptsrad ! radiative temperature (K)
145 REAL, DIMENSION(KI,KSW),INTENT(OUT):: pdir_alb! direct albedo for each spectral band (-)
146 REAL, DIMENSION(KI,KSW),INTENT(OUT):: psca_alb! diffuse albedo for each spectral band (-)
147 REAL, DIMENSION(KI), INTENT(OUT) :: pemis ! emissivity (-)
148 !
149 REAL, DIMENSION(KI), INTENT(OUT) :: ptsurf ! surface effective temperature (K)
150 REAL, DIMENSION(KI), INTENT(OUT) :: pz0 ! roughness length for momentum (m)
151 REAL, DIMENSION(KI), INTENT(OUT) :: pz0h ! roughness length for heat (m)
152 REAL, DIMENSION(KI), INTENT(OUT) :: pqsurf ! specific humidity at surface (kg/kg)
153 !
154 REAL, DIMENSION(KI), INTENT(IN) :: ppew_a_coef! implicit coefficients (m2s/kg)
155 REAL, DIMENSION(KI), INTENT(IN) :: ppew_b_coef! needed if HCOUPLING='I' (m/s)
156 REAL, DIMENSION(KI), INTENT(IN) :: ppet_a_coef
157 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_a_coef
158 REAL, DIMENSION(KI), INTENT(IN) :: ppet_b_coef
159 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_b_coef
160  CHARACTER(LEN=2), INTENT(IN) :: htest ! must be equal to 'OK'
161 !
162 !* 0.2 declarations of local variables
163 !
164 REAL, DIMENSION(KI,KSW) :: zdir_alb ! Direct albedo at time t ,
165 REAL, DIMENSION(KI,KSW) :: zsca_alb ! Diffuse albedo at time t
166 !
167 REAL, DIMENSION(KI) :: zalb ! surface albedo
168 REAL, DIMENSION(KI) :: zswe ! snow water equivalent (kg.m-2)
169 !
170 REAL, DIMENSION(KI) :: zexna ! Exner function at forcing level
171 REAL, DIMENSION(KI) :: zexns ! Exner function at surface level
172 !
173 REAL, DIMENSION(KI) :: zwind ! Wind
174 REAL, DIMENSION(KI) :: zglobal_sw ! Solar radiation flux at the surface (W/m2)
175 REAL, DIMENSION(KI) :: zqa ! Air specific humidity (kg/kg)
176 !
177 REAL, DIMENSION(KI) :: zustar ! friction velocity (m/s)
178 REAL, DIMENSION(KI) :: zustar2! square of friction velocity (m2/s2)
179 REAL, DIMENSION(KI) :: zsfm ! flux of momentum (Pa)
180 !
181 REAL, DIMENSION(KI) :: zresa_water ! aerodynamical resistance
182 !
183 !salgado only for inline diagnostics - not used for the moment
184 ! flake don't have it
185 REAL, DIMENSION(KI) :: zcd ! Drag coefficient
186 REAL, DIMENSION(KI) :: zcdn ! Neutral Drag coefficient
187 REAL, DIMENSION(KI) :: zch ! Heat transfer coefficient
188 REAL, DIMENSION(KI) :: zce ! Heat transfer coefficient
189 REAL, DIMENSION(KI) :: zri ! Richardson number
190 REAL, DIMENSION(KI) :: zhu ! Near surface relative humidity
191 REAL, DIMENSION(KI) :: zz0h ! heat roughness length
192 REAL, DIMENSION(KI) :: zqsat ! humidity at saturation
193 REAL, DIMENSION(KI) :: ztstep ! time-step
194 REAL, DIMENSION(KI) :: zle ! total latent heat flux (W/m2)
195 REAL, DIMENSION(KI) :: zlei ! sublimation heat flux (W/m2)
196 REAL, DIMENSION(KI) :: zsubl ! sublimation (kg/m2/s)
197 REAL, DIMENSION(KI) :: zlwup ! upward longwave flux at t
198 REAL, DIMENSION(KI) :: ztrad ! Radiative temperature at time t
199 REAL, DIMENSION(KI) :: zwork ! Work array
200 !
201 REAL :: zconvertfacm0_slt, zconvertfacm0_dst
202 REAL :: zconvertfacm3_slt, zconvertfacm3_dst
203 REAL :: zconvertfacm6_slt, zconvertfacm6_dst
204 !
205 INTEGER :: iswb ! number of shortwave spectral bands
206 INTEGER :: jswb ! loop counter on shortwave spectral bands
207 !
208 INTEGER :: iluout ! output logical unit
209 !
210 LOGICAL :: gpwg = .false.
211 LOGICAL :: ghandle_sic = .false. ! no sea-ice model
212 !
213 REAL :: zeps = 1.e-7
214 !
215 REAL(KIND=JPRB) :: zhook_handle
216 !-------------------------------------------------------------------------------------
217 ! Preliminaries:
218 !-------------------------------------------------------------------------------------
219 IF (lhook) CALL dr_hook('COUPLING_FLAKE_N',0,zhook_handle)
220 IF (htest/='OK') THEN
221  CALL abor1_sfx('COUPLING_FLAKEN: FATAL ERROR DURING ARGUMENT TRANSFER')
222 END IF
223 !-------------------------------------------------------------------------------------
224 ! Variables needed by flake:
225 !-------------------------------------------------------------------------------------
226 !
227 zcd(:) = xundef
228 zcdn(:) = xundef
229 zch(:) = xundef
230 zri(:) = xundef
231 zresa_water(:) = xundef
232 zz0h(:) = xundef
233 zqsat(:) = xundef
234 zwork(:) = xundef
235 zalb(:) = xundef
236 zglobal_sw(:) = xundef
237 zswe(:) = xundef
238 !
239 zdir_alb(:,:) = xundef
240 zsca_alb(:,:) = xundef
241 zle(:) = xundef
242 zlei(:) = xundef
243 zsubl(:) = xundef
244 zlwup(:) = xundef
245 ztrad(:) = xundef
246 !
247 ztstep(:) = ptstep
248 !
249 zexns(:) = (pps(:)/xp00)**(xrd/xcpd)
250 zexna(:) = (ppa(:)/xp00)**(xrd/xcpd)
251 !
252 !
253 zwind(:) = sqrt(pu(:)**2+pv(:)**2)
254 !
255 zqa(:) = pqa(:)/prhoa(:)
256 !
257 psfts(:,:) = 0.
258 !
259 zhu(:) = 1.
260 !
261 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
262 ! Time evolution
263 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
264 !
265 fm%F%TTIME%TIME = fm%F%TTIME%TIME + ptstep
266  CALL add_forecast_to_date_surf(fm%F%TTIME%TDATE%YEAR,fm%F%TTIME%TDATE%MONTH,fm%F%TTIME%TDATE%DAY,fm%F%TTIME%TIME)
267 !
268 !----------------------------------------
269 !
270 psfu(:) = 0.
271 psfv(:) = 0.
272 zsfm(:) = 0.
273 !
274 IF (fm%F%CFLK_FLUX=='DEF ') THEN
275 !
276  CALL water_flux(fm%F%XZ0, &
277  pta, zexna, prhoa, fm%F%XTS, zexns, pqa,prain, psnow, &
278  xtt, zwind, pzref, puref, &
279  pps, ghandle_sic, zqsat, &
280  psfth, psftq, zustar, &
281  zcd, zcdn, zch, zri, zresa_water, zz0h )
282 !
283  WHERE (fm%F%XTS(:)<xtt)
284  zle(:) = psftq(:) * xlstt
285  zlei(:) = psftq(:) * xlstt
286  zsubl(:) = psftq(:)
287  ELSEWHERE
288  zle(:) = psftq(:) * xlvtt
289  zlei(:) = 0.0
290  zsubl(:) = 0.0
291  END WHERE
292 !
293  IF(cimplicit_wind=='OLD')THEN
294 ! old implicitation (m2/s2)
295  zustar2(:) = (zcd(:)*zwind(:)*ppew_b_coef(:))/ &
296  (1.0-prhoa(:)*zcd(:)*zwind(:)*ppew_a_coef(:))
297  ELSE
298 ! new implicitation (m2/s2)
299  zustar2(:) = (zcd(:)*zwind(:)*(2.*ppew_b_coef(:)-zwind(:))) /&
300  (1.0-2.0*prhoa(:)*zcd(:)*zwind(:)*ppew_a_coef(:))
301 !
302  zwork(:) = prhoa(:)*ppew_a_coef(:)*zustar2(:) + ppew_b_coef(:)
303  zwork(:) = max(zwork(:),0.)
304 !
305  WHERE(ppew_a_coef(:)/= 0.)
306  zustar2(:) = max( ( zwork(:) - ppew_b_coef(:) ) / (prhoa(:)*ppew_a_coef(:)), 0.)
307  ENDWHERE
308 !
309  ENDIF
310 !
311  WHERE (zwind(:)>0.)
312  zsfm(:) = - prhoa(:) * zustar2(:)
313  psfu(:) = zsfm(:) * pu(:) / zwind(:)
314  psfv(:) = zsfm(:) * pv(:) / zwind(:)
315  END WHERE
316 !
317 ELSE
318  zustar(:) = fm%F%XUSTAR(:)
319  zz0h(:) = fm%F%XZ0 (:)
320 ENDIF
321 !
322 !----------------------------------------
323 !radiative properties at t
324 !----------------------------------------
325 !
326 iswb = SIZE(psw_bands)
327 !
328 DO jswb=1,iswb
329  zdir_alb(:,jswb) = fm%F%XDIR_ALB(:)
330  zsca_alb(:,jswb) = fm%F%XSCA_ALB(:)
331 END DO
332 !
333 ztrad = fm%F%XTS
334 !
335  CALL flake_albedo(pdir_sw,psca_sw,ksw,zdir_alb,zsca_alb,zglobal_sw,zalb)
336 !
337  CALL flake_interface( ki, &
338 ! Atmospheric forcing:
339  psnow, zglobal_sw, plw, puref, pzref, zwind, pta, zqa, pps, &
340 ! Constant parameters
341  fm%F%XWATER_DEPTH, fm%F%XWATER_FETCH, fm%F%XDEPTH_BS, fm%F%XT_BS, fm%F%XCORIO,&
342  ztstep, &
343 ! surface albedo
344  fm%F%XEMIS, zalb, &
345 ! Parameters that may change (constants for the moment)
346  fm%F%XEXTCOEF_WATER, fm%F%XEXTCOEF_ICE, fm%F%XEXTCOEF_SNOW, &
347 ! Flake variables
348  fm%F%XT_SNOW, fm%F%XT_ICE, fm%F%XT_MNW, fm%F%XT_WML, fm%F%XT_BOT, fm%F%XT_B1, fm%F%XCT, &
349  fm%F%XH_SNOW, fm%F%XH_ICE, fm%F%XH_ML, fm%F%XH_B1, fm%F%XTS, &
350 ! Surface heat, momentum fluxes, and other diags
351  psfth, zle, zsfm, fm%F%XZ0, zz0h, zqsat, zri, zustar, &
352  zcd, psftq, zlei, zsubl, zlwup, zswe, &
353 ! Flags
354  fm%F%LSEDIMENTS, fm%F%LSKINTEMP, fm%F%CFLK_FLUX, ppew_a_coef, &
355  ppew_b_coef, prhoa, cimplicit_wind )
356 !
357 !-------------------------------------------------------------------------------------
358 !
359 ! Momentum fluxes
360 !
361 IF (fm%F%CFLK_FLUX=='FLAKE') THEN
362  psfu = 0.
363  psfv = 0.
364  WHERE (zwind(:)>0.)
365  psfu(:) = zsfm(:) * pu(:) / zwind(:)
366  psfv(:) = zsfm(:) * pv(:) / zwind(:)
367  END WHERE
368  !
369  ! ZUSTAR and ZRESA_WATER are not in Flake but are needed to the ch_* routines
370  !
371  zustar(:) = sqrt(abs(zsfm(:))/prhoa(:))
372  zexns(:) = (pps(:)/xp00)**(xrd/xcpd)
373  zexna(:) = (ppa(:)/xp00)**(xrd/xcpd)
374  zresa_water=2.e4
375  WHERE (psfth/=0.)
376  zresa_water(:) = xcpd * prhoa(:) * (fm%F%XTS(:) - pta(:) * zexns(:)/zexna(:)) &
377  / (psfth(:) * zexns(:))
378  END WHERE
379 !
380 ENDIF
381 !
382 fm%F%XUSTAR(:) = zustar(:)
383 !
384 ! CO2 flux
385 !
386 psfco2(:) = 0.0 ! Assumes no CO2 emission over water bodies
387 !
388 !-------------------------------------------------------------------------------------
389 ! Scalar fluxes:
390 !-------------------------------------------------------------------------------------
391 !
392 !
393 !salgado The scalar fluxes are computed as in watflux
394 IF (fm%CHF%SVF%NBEQ>0) THEN
395  IF (fm%CHF%CCH_DRY_DEP == "WES89") THEN
396  CALL ch_dep_water(zresa_water, zustar, pta, ztrad, &
397  psv(:,fm%CHF%SVF%NSV_CHSBEG:fm%CHF%SVF%NSV_CHSEND), &
398  fm%CHF%SVF%CSV(fm%CHF%SVF%NSV_CHSBEG:fm%CHF%SVF%NSV_CHSEND), &
399  fm%CHF%XDEP(:,1:fm%CHF%SVF%NBEQ) )
400 
401  psfts(:,fm%CHF%SVF%NSV_CHSBEG:fm%CHF%SVF%NSV_CHSEND) = - psv(:,fm%CHF%SVF%NSV_CHSBEG:fm%CHF%SVF%NSV_CHSEND) &
402  * fm%CHF%XDEP(:,1:fm%CHF%SVF%NBEQ)
403  IF (fm%CHF%SVF%NAEREQ > 0 ) THEN
404  CALL ch_aer_dep(psv(:,fm%CHF%SVF%NSV_AERBEG:fm%CHF%SVF%NSV_AEREND),&
405  psfts(:,fm%CHF%SVF%NSV_AERBEG:fm%CHF%SVF%NSV_AEREND),&
406  zustar,zresa_water,pta,prhoa)
407  END IF
408 
409  ELSE
410  psfts(:,fm%CHF%SVF%NSV_CHSBEG:fm%CHF%SVF%NSV_CHSEND) =0.
411  IF(fm%CHF%SVF%NSV_AERBEG.LT.fm%CHF%SVF%NSV_AEREND) psfts(:,fm%CHF%SVF%NSV_AERBEG:fm%CHF%SVF%NSV_AEREND) =0.
412  ENDIF
413 ENDIF
414 
415 IF (fm%CHF%SVF%NDSTEQ>0) THEN
416  CALL dslt_dep(psv(:,fm%CHF%SVF%NSV_DSTBEG:fm%CHF%SVF%NSV_DSTEND), psfts(:,fm%CHF%SVF%NSV_DSTBEG:fm%CHF%SVF%NSV_DSTEND), &
417  zustar, zresa_water, pta, prhoa, dst%XEMISSIG_DST, dst%XEMISRADIUS_DST, &
418  jpmode_dst, xdensity_dst, xmolarweight_dst, zconvertfacm0_dst, &
419  zconvertfacm6_dst, zconvertfacm3_dst, lvarsig_dst, lrgfix_dst, &
420  cvermod )
421 
422  CALL massflux2momentflux( &
423  psfts(:,fm%CHF%SVF%NSV_DSTBEG:fm%CHF%SVF%NSV_DSTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
424  prhoa, & !I [kg/m3] air density
425  dst%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3)
426  dst%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3)
427  ndstmde, &
428  zconvertfacm0_dst, &
429  zconvertfacm6_dst, &
430  zconvertfacm3_dst, &
431  lvarsig_dst, lrgfix_dst )
432 ENDIF
433 
434 
435 IF (fm%CHF%SVF%NSLTEQ>0) THEN
436  CALL dslt_dep(psv(:,fm%CHF%SVF%NSV_SLTBEG:fm%CHF%SVF%NSV_SLTEND), psfts(:,fm%CHF%SVF%NSV_SLTBEG:fm%CHF%SVF%NSV_SLTEND), &
437  zustar, zresa_water, pta, prhoa, slt%XEMISSIG_SLT, slt%XEMISRADIUS_SLT, &
438  jpmode_slt, xdensity_slt, xmolarweight_slt, zconvertfacm0_slt, &
439  zconvertfacm6_slt, zconvertfacm3_slt, lvarsig_slt, lrgfix_slt, &
440  cvermod )
441 
442  CALL massflux2momentflux( &
443  psfts(:,fm%CHF%SVF%NSV_SLTBEG:fm%CHF%SVF%NSV_SLTEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
444  prhoa, & !I [kg/m3] air density
445  slt%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
446  slt%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
447  nsltmde, &
448  zconvertfacm0_slt, &
449  zconvertfacm6_slt, &
450  zconvertfacm3_slt, &
451  lvarsig_slt, lrgfix_slt )
452 ENDIF
453 
454 !
455 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
456 ! Inline diagnostics
457 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
458 !
459 IF (fm%F%CFLK_FLUX=='FLAKE') THEN !compute some variables not present in FLake code
460 !
461  zch = zeps
462 !
463  WHERE (abs((fm%F%XTS(:) - pta(:) * zexns(:)/zexna(:))) > 1.e-2 .AND. zwind(:)/=0.)
464  zch = max(zeps,psfth / (xcpd * prhoa(:) * zwind(:) * (fm%F%XTS(:) - pta(:) * zexns(:)/zexna(:))) * zexns(:))
465  END WHERE
466 !
467  zcdn(:) = (xkarman/log(puref(:)/fm%F%XZ0(:)))**2
468  zcd(:) = max(zeps,zcd(:))
469 !
470 ENDIF
471 !
472  CALL diag_inline_flake_n(fm%DGF, fm%F, &
473  ptstep, pta, zqa, ppa, pps, prhoa, pu, &
474  pv, pzref, puref, prain, psnow, &
475  zcd, zcdn, zch, zri, zhu, &
476  zz0h, zqsat, psfth, psftq, psfu, psfv, &
477  pdir_sw, psca_sw, plw, zdir_alb, zsca_alb, &
478  zle, zlei, zsubl, zlwup, zalb, zswe )
479 !
480 !-------------------------------------------------------------------------------------
481 !
482  CALL diag_misc_flake_n(fm%DGMF, &
483  fm%F%XT_WML,fm%F%XT_BOT,fm%F%XH_ML,fm%F%XCT,fm%F%XWATER_DEPTH)
484 !
485 !-------------------------------------------------------------------------------
486 !Physical properties see by the atmosphere in order to close the energy budget
487 !between surfex and the atmosphere. All variables should be at t+1 but very
488 !difficult to do. Maybe it will be done later. However, Ts can be at time t+1
489 !-------------------------------------------------------------------------------
490 !
491 ptsurf(:) = fm%F%XTS (:)
492 pz0(:) = fm%F%XZ0 (:)
493 pz0h(:) = zz0h(:)
494 pqsurf(:) = zqsat(:)
495 !
496 !-------------------------------------------------------------------------------------
497 !Radiative properties at time t+1 (see by the atmosphere) in order to close
498 !the energy budget between surfex and the atmosphere
499 !-------------------------------------------------------------------------------------
500 !
501  CALL update_rad_flake(fm%F%CFLK_ALB,fm%F%XTS,pzenith2,fm%F%XH_ICE,fm%F%XH_SNOW,fm%F%XICE_ALB,fm%F%XSNOW_ALB, &
502  fm%F%XDIR_ALB,fm%F%XSCA_ALB,fm%F%XEMIS,pdir_alb,psca_alb,pemis,ptsrad )
503 !
504 IF (lhook) CALL dr_hook('COUPLING_FLAKE_N',1,zhook_handle)
505 !
506 !-------------------------------------------------------------------------------------
507 !
508 END SUBROUTINE coupling_flake_n
modd_slt_n
Definition: modd_sltn.F90:5
diag_inline_flake_n
subroutine diag_inline_flake_n(DGF, F, PTSTEP, PTA, PQA, PPA, PPS, PRHOA, PZONA, PMERA, PHT, PHW, PRAIN, PSNOW, PCD, PCDN, PCH, PRI, PHU, PZ0H, PQSAT, PSFTH, PSFTQ, PSFZON, PSFMER, PDIR_SW, PSCA_SW, PLW, PDIR_ALB, PSCA_ALB, PLE, PLEI, PSUBL, PLWUP, PALB, PSWE)
Definition: diag_inline_flaken.F90:6
modd_slt_n::slt_t
Definition: modd_sltn.F90:18
diag_misc_flake_n
subroutine diag_misc_flake_n(DGMF, PT_WML, PT_BOT, PH_ML, PCT, PWATER_DEPTH)
Definition: diag_misc_flaken.F90:6
modd_surfex_n
Definition: modd_surfexn.F90:5
mode_dslt_surf
Definition: mode_dslt_surf.F90:6
ch_aer_dep
subroutine ch_aer_dep(PSVT, PFSVT, PUSTAR, PRESA, PTA, PRHODREF)
Definition: ch_aer_dep.F90:6
mode_thermos
Definition: mode_thermos.F90:6
flake_interface
subroutine flake_interface(KI,
Definition: flake_interface.F90:6
modd_surfex_n::flake_model_t
Definition: modd_surfexn.F90:95
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
modd_dst_n::dst_t
Definition: modd_dstn.F90:19
flake_albedo
subroutine flake_albedo(PDIR_SW, PSCA_SW, KSW, PDIR_ALB, PSCA_ALB, PGLOBAL_SW, PALB)
Definition: flake_albedo.F90:6
mode_dslt_surf::massflux2momentflux
subroutine massflux2momentflux(PFLUX, PRHODREF, PEMISRADIUS, PEMISSIG, KMDE, PCONVERTFACM0, PCONVERTFACM6, PCONVERTFACM3, OVARSIG, ORGFIX)
Definition: mode_dslt_surf.F90:18
coupling_flake_n
subroutine coupling_flake_n(FM, DST, SLT, HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_flaken.F90:6
dslt_dep
subroutine dslt_dep(PSVT, PFSVT, PUSTAR, PRESA, PTA, PRHODREF, PEMISSIG, PEMISRADIUS, KPMODE, PDENSITY, PMOLARWEIGHT, PCONVERTFACM0, PCONVERTFACM6, PCONVERTFACM3, OVARSIG, ORGFIX, HVERMOD)
Definition: dslt_dep.F90:6
add_forecast_to_date_surf
subroutine add_forecast_to_date_surf(KYEAR, KMONTH, KDAY, PSEC)
Definition: add_forecast_to_date_surf.F90:6
modd_surf_par
Definition: modd_surf_par.F90:6
ch_dep_water
subroutine ch_dep_water(PRESA, PUSTAR, PTA, PTRAD, PSV, HSV, PDEP)
Definition: ch_dep_water.F90:6
water_flux
subroutine water_flux(PZ0SEA, PTA, PEXNA, PRHOA, PSST, PEXNS, PQA, PRR, PRS, PTT, PVMOD, PZREF, PUREF, PPS, OHANDLE_SIC, PQSAT, PSFTH, PSFTQ, PUSTAR, PCD, PCDN, PCH, PRI, PRESA, PZ0HSEA)
Definition: water_flux.F90:6
modd_dst_surf
Definition: modd_dst_surf.F90:5
modd_reprod_oper
Definition: modd_reprod_oper.F90:6
modd_dst_n
Definition: modd_dstn.F90:5
modd_csts
Definition: modd_csts.F90:6
update_rad_flake
subroutine update_rad_flake(HALB, PTS, PZENITH, PH_ICE, PH_SNOW, PICE_ALB, PSNOW_ALB, PDIR_ALB, PSCA_ALB, PEMIS, PDIR_ALB_ATMOS, PSCA_ALB_ATMOS, PEMIS_ATMOS, PTRAD)
Definition: update_rad_flake.F90:6
modd_slt_surf
Definition: modd_slt_surf.F90:5
Generated on Fri May 13 2016 09:31:01 for SURFEX by   doxygen 1.8.5