SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
average_diag.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 average_diag(K2M, OT2MMW, OSURF_BUDGET, OSURF_BUDGETC, OCOEF, &
7  osurf_vars, pfrac_tile, &
8  prn_tile, ph_tile, ple_tile, plei_tile , &
9  pgflux_tile, pri_tile, pcd_tile, pch_tile, &
10  pce_tile, pt2m_tile, pts_tile, pq2m_tile, &
11  phu2m_tile, pzon10m_tile, pmer10m_tile, &
12  pqs_tile, pz0_tile, pz0h_tile, &
13  pswd_tile, pswu_tile, pswbd_tile, pswbu_tile, &
14  plwd_tile, plwu_tile, pfmu_tile, pfmv_tile, &
15  prnc_tile, phc_tile, plec_tile, pgfluxc_tile, &
16  pswdc_tile, pswuc_tile, plwdc_tile, plwuc_tile, &
17  pfmuc_tile, pfmvc_tile, pt2m_min_tile, &
18  pt2m_max_tile, pleic_tile, &
19  prn, ph, ple, plei, pgflux, pri, pcd, pch, pce, &
20  pt2m, pts, pq2m, phu2m, pzon10m, pmer10m, &
21  pqs, pz0, pz0h, puref, pzref, &
22  pswd, pswu, pswbd, pswbu,plwd, plwu, pfmu, pfmv, &
23  prnc, phc, plec, pgfluxc, pswdc, pswuc, plwdc, &
24  plwuc, pfmuc, pfmvc, pt2m_min, pt2m_max, pleic, &
25  phu2m_min_tile, phu2m_max_tile, phu2m_min, &
26  phu2m_max, pwind10m_tile, pwind10m_max_tile, &
27  pwind10m, pwind10m_max, &
28  pevap_tile, pevapc_tile, pevap, pevapc, &
29  psubl_tile, psublc_tile, psubl, psublc )
30 ! ######################################################################
31 !
32 !
33 !!**** *AVERAGE_DIAG*
34 !!
35 !! PURPOSE
36 !! -------
37 ! Average the fluxes from the land and water surfaces depending on the
38 ! fraction of each surface cover type in the mesh area.
39 !
40 !!** METHOD
41 !! ------
42 !
43 !! EXTERNAL
44 !! --------
45 !!
46 !! IMPLICIT ARGUMENTS
47 !! ------------------
48 !!
49 !!
50 !! REFERENCE
51 !! ---------
52 !!
53 !! AUTHOR
54 !! ------
55 !! V. Masson * Meteo-France-
56 !!
57 !! MODIFICATIONS
58 !! -------------
59 !! Original 06/2003
60 !! Modified 08/2009 (B. Decharme) : new diag
61 ! 02/2010 - S. Riette - Security for wind average in case of XUNDEF values
62 ! B. decharme 04/2013 : Add EVAP and SUBL diag
63 !-------------------------------------------------------------------------------
64 !
65 !* 0. DECLARATIONS
66 ! ------------
67 !
68 USE yomhook ,ONLY : lhook, dr_hook
69 USE parkind1 ,ONLY : jprb
70 !
71 IMPLICIT NONE
72 !
73 !* 0.1 declarations of arguments
74 !
75 INTEGER, INTENT(IN) :: k2m ! Flag for 2m and 10m diagnostics
76 LOGICAL, INTENT(IN) :: ot2mmw ! Flag to perform modified weighting of 2m temperature
77 LOGICAL, INTENT(IN) :: osurf_budget ! Flag for surface energy budget
78 LOGICAL, INTENT(IN) :: osurf_budgetc! Flag for surface cumulated energy budget
79 LOGICAL, INTENT(IN) :: ocoef ! Flag for transfer coefficients
80 LOGICAL, INTENT(IN) :: osurf_vars
81 REAL, DIMENSION(:,:), INTENT(IN) :: pfrac_tile ! Fraction in a mesh-area of
82 ! ! a given surface
83 !* fields for each tile
84 REAL, DIMENSION(:,:), INTENT(IN) :: prn_tile ! Net radiation (W/m2)
85 REAL, DIMENSION(:,:), INTENT(IN) :: ph_tile ! Sensible heat flux (W/m2)
86 REAL, DIMENSION(:,:), INTENT(IN) :: ple_tile ! Total latent heat flux (W/m2)
87 REAL, DIMENSION(:,:), INTENT(IN) :: plei_tile ! Sublimation latent heat flux (W/m2)
88 REAL, DIMENSION(:,:), INTENT(IN) :: pgflux_tile ! Storage flux (W/m2)
89 REAL, DIMENSION(:,:), INTENT(IN) :: pevap_tile ! Total evapotranspiration (kg/m2/s)
90 REAL, DIMENSION(:,:), INTENT(IN) :: psubl_tile ! Sublimation (kg/m2/s)
91 REAL, DIMENSION(:,:), INTENT(IN) :: pri_tile ! Richardson number (-)
92 REAL, DIMENSION(:,:), INTENT(IN) :: pcd_tile ! drag coefficient for wind (W/s2)
93 REAL, DIMENSION(:,:), INTENT(IN) :: pch_tile ! drag coefficient for heat (W/s)
94 REAL, DIMENSION(:,:), INTENT(IN) :: pce_tile ! drag coefficient for evaporation (W/s/K)
95 REAL, DIMENSION(:,:), INTENT(IN) :: pt2m_tile ! temperature at 2m (K)
96 REAL, DIMENSION(:,:), INTENT(IN) :: pts_tile ! surface temperature (K)
97 REAL, DIMENSION(:,:), INTENT(IN) :: pt2m_min_tile ! minimum temperature at 2m (K)
98 REAL, DIMENSION(:,:), INTENT(IN) :: pt2m_max_tile ! maximum temperature at 2m (K)
99 REAL, DIMENSION(:,:), INTENT(IN) :: pq2m_tile ! humidity at 2m (kg/kg)
100 REAL, DIMENSION(:,:), INTENT(IN) :: phu2m_tile ! relative humidity at 2m (-)
101 REAL, DIMENSION(:,:), INTENT(IN) :: phu2m_max_tile! maximum relative humidity at 2m (-)
102 REAL, DIMENSION(:,:), INTENT(IN) :: phu2m_min_tile! minimum relative humidity at 2m (-)
103 REAL, DIMENSION(:,:), INTENT(IN) :: pzon10m_tile ! zonal wind at 10m (m/s)
104 REAL, DIMENSION(:,:), INTENT(IN) :: pmer10m_tile ! meridian wind at 10m(m/s)
105 REAL, DIMENSION(:,:), INTENT(IN) :: pwind10m_tile ! wind at 10m (m/s)
106 REAL, DIMENSION(:,:), INTENT(IN) :: pwind10m_max_tile ! maximum wind at 10m(m/s)
107 REAL, DIMENSION(:,:), INTENT(IN) :: pqs_tile
108 REAL, DIMENSION(:,:), INTENT(IN) :: pz0_tile ! roughness lenght for momentum (m)
109 REAL, DIMENSION(:,:), INTENT(IN) :: pz0h_tile ! roughness lenght for heat (m)
110 REAL, DIMENSION(:,:), INTENT(IN) :: pswd_tile ! short wave incoming radiation (W/m2)
111 REAL, DIMENSION(:,:), INTENT(IN) :: pswu_tile ! short wave outgoing radiation (W/m2)
112 REAL, DIMENSION(:,:,:), INTENT(IN) :: pswbd_tile ! short wave incoming radiation for each spectral band (W/m2)
113 REAL, DIMENSION(:,:,:), INTENT(IN) :: pswbu_tile ! short wave outgoing radiation for each spectral band (W/m2)
114 REAL, DIMENSION(:,:), INTENT(IN) :: plwd_tile ! long wave incoming radiation (W/m2)
115 REAL, DIMENSION(:,:), INTENT(IN) :: plwu_tile ! long wave outgoing radiation (W/m2)
116 REAL, DIMENSION(:,:), INTENT(IN) :: pfmu_tile ! zonal friction
117 REAL, DIMENSION(:,:), INTENT(IN) :: pfmv_tile ! meridian friction
118 REAL, DIMENSION(:,:), INTENT(IN) :: prnc_tile ! Net radiation (J/m2)
119 REAL, DIMENSION(:,:), INTENT(IN) :: phc_tile ! Sensible heat flux (J/m2)
120 REAL, DIMENSION(:,:), INTENT(IN) :: plec_tile ! Total latent heat flux (J/m2)
121 REAL, DIMENSION(:,:), INTENT(IN) :: pleic_tile ! Sublimation latent heat flux (J/m2)
122 REAL, DIMENSION(:,:), INTENT(IN) :: pgfluxc_tile ! Storage flux (J/m2)
123 REAL, DIMENSION(:,:), INTENT(IN) :: pevapc_tile ! Total evapotranspiration (kg/m2)
124 REAL, DIMENSION(:,:), INTENT(IN) :: psublc_tile ! Sublimation (kg/m2)
125 REAL, DIMENSION(:,:), INTENT(IN) :: pswdc_tile ! short wave incoming radiation (J/m2)
126 REAL, DIMENSION(:,:), INTENT(IN) :: pswuc_tile ! short wave outgoing radiation (J/m2)
127 REAL, DIMENSION(:,:), INTENT(IN) :: plwdc_tile ! long wave incoming radiation (J/m2)
128 REAL, DIMENSION(:,:), INTENT(IN) :: plwuc_tile ! long wave outgoing radiation (J/m2)
129 REAL, DIMENSION(:,:), INTENT(IN) :: pfmuc_tile ! zonal friction
130 REAL, DIMENSION(:,:), INTENT(IN) :: pfmvc_tile ! meridian friction
131 !
132 REAL, DIMENSION(:), INTENT(IN) :: puref ! reference height for wind (m)
133 REAL, DIMENSION(:), INTENT(IN) :: pzref ! reference height for T,q (m)
134 !
135 !* aggregated fields
136 REAL, DIMENSION(:), INTENT(OUT) :: prn ! Net radiation (W/m2)
137 REAL, DIMENSION(:), INTENT(OUT) :: ph ! Sensible heat flux (W/m2)
138 REAL, DIMENSION(:), INTENT(OUT) :: ple ! Total latent heat flux (W/m2)
139 REAL, DIMENSION(:), INTENT(OUT) :: plei ! Sublimation latent heat flux (W/m2)
140 REAL, DIMENSION(:), INTENT(OUT) :: pgflux ! Storage flux (W/m2)
141 REAL, DIMENSION(:), INTENT(OUT) :: pevap ! Total evapotranspiration (kg/m2/s)
142 REAL, DIMENSION(:), INTENT(OUT) :: psubl ! Sublimation (kg/m2/s)
143 REAL, DIMENSION(:), INTENT(OUT) :: pri ! Richardson number (-)
144 REAL, DIMENSION(:), INTENT(OUT) :: pcd ! drag coefficient for wind (W/s2)
145 REAL, DIMENSION(:), INTENT(OUT) :: pch ! drag coefficient for heat (W/s)
146 REAL, DIMENSION(:), INTENT(OUT) :: pce ! drag coefficient for evaporation (W/s/K)
147 REAL, DIMENSION(:), INTENT(OUT) :: pt2m ! temperature at 2m (K)
148 REAL, DIMENSION(:), INTENT(OUT) :: pts ! surface temperature (K)
149 REAL, DIMENSION(:), INTENT(OUT) :: pq2m ! humidity at 2m (kg/kg)
150 REAL, DIMENSION(:), INTENT(OUT) :: phu2m ! relative humidity at 2m (-)
151 REAL, DIMENSION(:), INTENT(OUT) :: pzon10m ! zonal wind at 10m (m/s)
152 REAL, DIMENSION(:), INTENT(OUT) :: pmer10m ! meridian wind at 10m(m/s)
153 REAL, DIMENSION(:), INTENT(OUT) :: pqs
154 REAL, DIMENSION(:), INTENT(OUT) :: pz0 ! roughness lenght for momentum (m)
155 REAL, DIMENSION(:), INTENT(OUT) :: pz0h ! roughness lenght for heat (m)
156 REAL, DIMENSION(:), INTENT(OUT) :: pswd ! short wave incoming radiation (W/m2)
157 REAL, DIMENSION(:), INTENT(OUT) :: pswu ! short wave outgoing radiation (W/m2)
158 REAL, DIMENSION(:,:), INTENT(OUT) :: pswbd ! short wave incoming radiation for each spectral band (W/m2)
159 REAL, DIMENSION(:,:), INTENT(OUT) :: pswbu ! short wave outgoing radiation for each spectral band (W/m2)
160 REAL, DIMENSION(:), INTENT(OUT) :: plwd ! long wave incoming radiation (W/m2)
161 REAL, DIMENSION(:), INTENT(OUT) :: plwu ! long wave outgoing radiation (W/m2)
162 REAL, DIMENSION(:), INTENT(OUT) :: pfmu ! zonal friction
163 REAL, DIMENSION(:), INTENT(OUT) :: pfmv ! meridian friction
164 REAL, DIMENSION(:), INTENT(OUT) :: prnc ! Net radiation (J/m2)
165 REAL, DIMENSION(:), INTENT(OUT) :: phc ! Sensible heat flux (J/m2)
166 REAL, DIMENSION(:), INTENT(OUT) :: plec ! Total latent heat flux (J/m2)
167 REAL, DIMENSION(:), INTENT(OUT) :: pleic ! Sublimation latent heat flux (J/m2)
168 REAL, DIMENSION(:), INTENT(OUT) :: pgfluxc ! Storage flux (J/m2)
169 REAL, DIMENSION(:), INTENT(OUT) :: pevapc ! Total evapotranspiration (kg/m2/s)
170 REAL, DIMENSION(:), INTENT(OUT) :: psublc ! Sublimation (kg/m2/s)
171 REAL, DIMENSION(:), INTENT(OUT) :: pswdc ! incoming short wave radiation (J/m2)
172 REAL, DIMENSION(:), INTENT(OUT) :: pswuc ! outgoing short wave radiation (J/m2)
173 REAL, DIMENSION(:), INTENT(OUT) :: plwdc ! incoming long wave radiation (J/m2)
174 REAL, DIMENSION(:), INTENT(OUT) :: plwuc ! outgoing long wave radiation (J/m2)
175 REAL, DIMENSION(:), INTENT(OUT) :: pfmuc ! zonal friction
176 REAL, DIMENSION(:), INTENT(OUT) :: pfmvc ! meridian friction
177 !
178 REAL, DIMENSION(:), INTENT(OUT) :: phu2m_min! Minimum relative humidity at 2m (-)
179 REAL, DIMENSION(:), INTENT(OUT) :: phu2m_max! Maximum relative humidity at 2m (-)
180 REAL, DIMENSION(:), INTENT(OUT) :: pt2m_min ! Minimum temperature at 2m (K)
181 REAL, DIMENSION(:), INTENT(OUT) :: pt2m_max ! Maximum temperature at 2m (K)
182 REAL, DIMENSION(:), INTENT(OUT) :: pwind10m ! wind at 10m(m/s)
183 REAL, DIMENSION(:), INTENT(OUT) :: pwind10m_max ! Maximum wind at 10m(m/s)
184 !
185 !* 0.2 declarations of local variables
186 !
187 REAL(KIND=JPRB) :: zhook_handle
188 !-------------------------------------------------------------------------------
189 !
190 ! 1. Grid-Box average fluxes
191 ! -----------------------
192 !
193 IF (lhook) CALL dr_hook('AVERAGE_DIAG',0,zhook_handle)
194 !
195 IF (osurf_budget) THEN
196 !
197 ! Net radiation
198 !
199  CALL make_average(pfrac_tile,prn_tile,prn)
200 !
201 ! Sensible heat flux
202 !
203  CALL make_average(pfrac_tile,ph_tile,ph)
204 !
205 ! Total latent heat flux
206 !
207  CALL make_average(pfrac_tile,ple_tile,ple)
208 !
209 ! Sublimation latent heat flux
210 !
211  CALL make_average(pfrac_tile,plei_tile,plei)
212 !
213 ! Total evapotranspiration
214 !
215  CALL make_average(pfrac_tile,pevap_tile,pevap)
216 !
217 ! Sublimation
218 !
219  CALL make_average(pfrac_tile,psubl_tile,psubl)
220 !
221 ! Storage flux
222 !
223  CALL make_average(pfrac_tile,pgflux_tile,pgflux)
224 !
225 ! Downwards short wave radiation
226 !
227  CALL make_average(pfrac_tile,pswd_tile,pswd)
228 !
229 ! Upwards short wave radiation
230 !
231  CALL make_average(pfrac_tile,pswu_tile,pswu)
232 !
233 ! Downwards long wave radiation
234 !
235  CALL make_average(pfrac_tile,plwd_tile,plwd)
236 !
237 ! Upwards long wave radiation
238 !
239  CALL make_average(pfrac_tile,plwu_tile,plwu)
240 !
241 ! Zonal wind stress
242 !
243  CALL make_average(pfrac_tile,pfmu_tile,pfmu)
244 !
245 ! Meridian wind stress
246 !
247  CALL make_average(pfrac_tile,pfmv_tile,pfmv)
248 !
249 ! Downwards short wave radiation for each spectral band
250 !
251  CALL make_average_2d(pfrac_tile,pswbd_tile,pswbd)
252 !
253 ! Upwards short wave radiation for each spectral band
254 !
255  CALL make_average_2d(pfrac_tile,pswbu_tile,pswbu)
256 !
257 END IF
258 !
259 IF (osurf_budgetc) THEN
260 !
261 ! Net radiation
262 !
263  CALL make_average(pfrac_tile,prnc_tile,prnc)
264 !
265 ! Sensible heat flux
266 !
267  CALL make_average(pfrac_tile,phc_tile,phc)
268 !
269 ! Total latent heat flux
270 !
271  CALL make_average(pfrac_tile,plec_tile,plec)
272 !
273 ! Sublimation latent heat flux
274 !
275  CALL make_average(pfrac_tile,pleic_tile,pleic)
276 !
277 ! Storage flux
278 !
279  CALL make_average(pfrac_tile,pgfluxc_tile,pgfluxc)
280 !
281 ! Total evapotranspiration
282 !
283  CALL make_average(pfrac_tile,pevapc_tile,pevapc)
284 !
285 ! Sublimation
286 !
287  CALL make_average(pfrac_tile,psublc_tile,psublc)
288 !
289 ! Downwards short wave radiation
290 !
291  CALL make_average(pfrac_tile,pswdc_tile,pswdc)
292 !
293 ! Upwards short wave radiation
294 !
295  CALL make_average(pfrac_tile,pswuc_tile,pswuc)
296 !
297 ! Downwards long wave radiation
298 !
299  CALL make_average(pfrac_tile,plwdc_tile,plwdc)
300 !
301 ! Upwards long wave radiation
302 !
303  CALL make_average(pfrac_tile,plwuc_tile,plwuc)
304 !
305 ! Zonal wind stress
306 !
307  CALL make_average(pfrac_tile,pfmuc_tile,pfmuc)
308 !
309 ! Meridian wind stress
310 !
311  CALL make_average(pfrac_tile,pfmvc_tile,pfmvc)
312 !
313 END IF
314 !
315 !-------------------------------------------------------------------------------
316 !
317 ! 2. Richardson number
318 ! -----------------
319 !
320 IF (k2m>=1) THEN
321 !
322  CALL make_average(pfrac_tile,pri_tile,pri)
323 !
324 ENDIF
325 !
326 !-------------------------------------------------------------------------------
327 !
328 ! 3. Operational parameters at surface, 2 and 10 meters
329 ! --------------------------------------------------
330 !
331 !
332 IF (k2m>=1.OR.osurf_budget.OR.osurf_budgetc) THEN
333 !
334 ! Surface temperature
335 !
336  CALL make_average(pfrac_tile,pts_tile,pts)
337 !
338 ENDIF
339 !
340 IF (k2m>=1) THEN
341 !
342 ! Temperature at 2 meters
343 !
344  IF (ot2mmw) THEN
345 ! Modified weighting giving increased weight to LAND temperature
346  CALL make_average_mw(pfrac_tile,pt2m_tile,pt2m)
347  CALL make_average_mw(pfrac_tile,pt2m_min_tile,pt2m_min)
348  CALL make_average_mw(pfrac_tile,pt2m_max_tile,pt2m_max)
349  ELSE
350  CALL make_average(pfrac_tile,pt2m_tile,pt2m)
351  CALL make_average(pfrac_tile,pt2m_min_tile,pt2m_min)
352  CALL make_average(pfrac_tile,pt2m_max_tile,pt2m_max)
353  ENDIF
354 !
355 ! Relative humidity at 2 meters
356 !
357  CALL make_average(pfrac_tile,phu2m_tile,phu2m)
358  CALL make_average(pfrac_tile,phu2m_min_tile,phu2m_min)
359  CALL make_average(pfrac_tile,phu2m_max_tile,phu2m_max)
360 !
361 ! Specific humidity at 2 meters
362 !
363  CALL make_average(pfrac_tile,pq2m_tile,pq2m)
364 !
365 ! Wind at 10 meters
366 !
367  CALL make_average(pfrac_tile,pzon10m_tile,pzon10m)
368 !
369  CALL make_average(pfrac_tile,pmer10m_tile,pmer10m)
370 !
371  CALL make_average(pfrac_tile,pwind10m_tile,pwind10m)
372  CALL make_average(pfrac_tile,pwind10m_max_tile,pwind10m_max)
373 !
374 END IF
375 !-------------------------------------------------------------------------------
376 !
377 ! 4. Transfer coeffients and roughness lengths
378 ! -----------------------------------------
379 !
380 IF (ocoef) THEN
381 !
382  CALL make_average(pfrac_tile,pcd_tile,pcd)
383 !
384  CALL make_average(pfrac_tile,pch_tile,pch)
385 !
386  CALL make_average(pfrac_tile,pce_tile,pce)
387 !
388  CALL make_average_z0(pfrac_tile,puref,pz0_tile,pz0)
389 !
390  CALL make_average_z0(pfrac_tile,pzref,pz0h_tile,pz0h)
391 !
392 ENDIF
393 !
394 IF (osurf_vars) THEN
395 !
396  CALL make_average(pfrac_tile,pqs_tile,pqs)
397 !
398 ENDIF
399 !
400 IF (lhook) CALL dr_hook('AVERAGE_DIAG',1,zhook_handle)
401 !
402  CONTAINS
403 !
404 SUBROUTINE make_average(PFRAC,PFIELD_IN,PFIELD_OUT)
405 !
406 USE modd_surf_par, ONLY : xundef
407 !
408 IMPLICIT NONE
409 !
410 REAL, DIMENSION(:,:),INTENT(IN) :: pfrac
411 REAL, DIMENSION(:,:),INTENT(IN) :: pfield_in
412 REAL, DIMENSION(:), INTENT(OUT) :: pfield_out
413 LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: gmask
414 REAL(KIND=JPRB) :: zhook_handle
415 INTEGER :: jt
416 !
417 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE',0,zhook_handle)
418 !
419 gmask(:) = .true.
420 DO jt=1,SIZE(pfield_in,2)
421  WHERE (pfield_in(:,jt)==xundef .AND. pfrac(:,jt)/=0.) gmask(:) = .false.
422 END DO
423 !
424 pfield_out(:) = 0.
425 DO jt=1,SIZE(pfield_in,2)
426  pfield_out(:) = pfield_out(:) + pfrac(:,jt) * pfield_in(:,jt)
427 END DO
428 WHERE(.NOT. gmask(:)) pfield_out(:) = xundef
429 !
430 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE',1,zhook_handle)
431 !
432 END SUBROUTINE make_average
433 !
434 SUBROUTINE make_average_2d(PFRAC,PFIELD_IN,PFIELD_OUT)
435 !
436 USE modd_surf_par, ONLY : xundef
437 !
438 IMPLICIT NONE
439 !
440 REAL, DIMENSION(:,:),INTENT(IN) :: pfrac
441 REAL, DIMENSION(:,:,:),INTENT(IN) :: pfield_in
442 REAL, DIMENSION(:,:), INTENT(OUT) :: pfield_out
443 LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: gmask
444 REAL(KIND=JPRB) :: zhook_handle
445 INTEGER :: jt, jl
446 !
447 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE_2D',0,zhook_handle)
448 !
449 DO jl=1,SIZE(pfield_in,3)
450  pfield_out(:,jl) = 0.
451  gmask(:) = .true.
452  DO jt=1,SIZE(pfield_in,2)
453  WHERE (pfield_in(:,jt,jl)==xundef .AND. pfrac(:,jt)/=0.) gmask(:) = .false.
454  pfield_out(:,jl) = pfield_out(:,jl) + pfrac(:,jt) * pfield_in(:,jt,jl)
455  END DO
456  WHERE(.NOT. gmask(:)) pfield_out(:,jl) = xundef
457 END DO
458 !
459 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE_2D',1,zhook_handle)
460 !
461 END SUBROUTINE make_average_2d
462 !
463 SUBROUTINE make_average_z0(PFRAC,PREF,PFIELD_IN,PFIELD_OUT)
464 !
465 USE modd_surf_par, ONLY : xundef
466 !
467 IMPLICIT NONE
468 !
469 REAL, DIMENSION(:,:),INTENT(IN) :: pfrac
470 REAL, DIMENSION(:,:),INTENT(IN) :: pfield_in
471 REAL, DIMENSION(:),INTENT(IN) :: pref
472 REAL, DIMENSION(:), INTENT(OUT) :: pfield_out
473 LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: gmask
474 REAL(KIND=JPRB) :: zhook_handle
475 INTEGER :: jt, jl
476 !
477 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE_Z0',0,zhook_handle)
478 !
479 gmask(:) = .true.
480 DO jt=1,SIZE(pfield_in,2)
481  WHERE (pfield_in(:,jt)==xundef .AND. pfrac(:,jt)/=0.) gmask(:) = .false.
482 END DO
483 !
484 pfield_out(:) = 0.
485 DO jt=1,SIZE(pfield_in,2)
486  pfield_out(:) = pfield_out(:) + pfrac(:,jt) * 1./(log(pref(:)/pfield_in(:,jt)))**2
487 END DO
488 WHERE (pfield_out(:) == 0.)
489  pfield_out(:) = xundef
490 ELSEWHERE
491  pfield_out(:) = pref(:) * exp( - sqrt(1./pfield_out(:)) )
492 ENDWHERE
493 WHERE(.NOT. gmask(:)) pfield_out(:) = xundef
494 !
495 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE_Z0',1,zhook_handle)
496 !
497 END SUBROUTINE make_average_z0
498 !
499 SUBROUTINE make_average_mw(PFRAC,PFIELD_IN,PFIELD_OUT)
500 !
501 USE modd_surf_par, ONLY : xundef
502 !
503 IMPLICIT NONE
504 !
505 REAL, DIMENSION(:,:),INTENT(IN) :: pfrac
506 REAL, DIMENSION(:,:),INTENT(IN) :: pfield_in
507 REAL, DIMENSION(:), INTENT(OUT) :: pfield_out
508 LOGICAL, DIMENSION(SIZE(PFIELD_IN,1)) :: gmask
509 REAL(KIND=JPRB) :: zhook_handle
510 INTEGER :: jt
511 REAL, DIMENSION(SIZE(PFIELD_IN,1)) :: zt2m_land, zt2m_sea, zfrl, zalfa
512 !
513 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE_MW',0,zhook_handle)
514 !
515 gmask(:) = .true.
516 DO jt=1,SIZE(pfield_in,2)
517  WHERE (pfield_in(:,jt)==xundef .AND. pfrac(:,jt)/=0.) gmask(:) = .false.
518 END DO
519 !
520 zt2m_sea(:)= 0.
521 zt2m_land(:)= 0.
522 zfrl(:)= 0.
523 DO jt=1,2
524  zt2m_sea(:) = zt2m_sea(:) + pfrac(:,jt) * pfield_in(:,jt)
525 END DO
526 !
527 DO jt=3,4
528  zt2m_land(:) = zt2m_land(:) + pfrac(:,jt) * pfield_in(:,jt)
529  zfrl(:) = zfrl(:) + pfrac(:,jt)
530 END DO
531 !
532 WHERE(zfrl(:)>0.)
533  zt2m_land(:) = zt2m_land(:)/zfrl(:)
534 ENDWHERE
535 WHERE(zfrl(:)<1.)
536  zt2m_sea(:) = zt2m_sea(:)/(1.-zfrl(:))
537 ENDWHERE
538 !
539 zalfa(:) = 1. - exp(-10.*zfrl(:))
540 pfield_out(:) = zalfa(:) * zt2m_land(:) + (1. - zalfa(:)) * zt2m_sea(:)
541 
542 WHERE(.NOT. gmask(:)) pfield_out(:) = xundef
543 !
544 IF (lhook) CALL dr_hook('AVERAGE_DIAG:MAKE_AVERAGE_MW',1,zhook_handle)
545 !
546 END SUBROUTINE make_average_mw
547 !
548 !-------------------------------------------------------------------------------
549 !
550 END SUBROUTINE average_diag
make_average_z0
subroutine make_average_z0(PFRAC, PREF, PFIELD_IN, PFIELD_OUT)
Definition: average_diag.F90:463
make_average_2d
subroutine make_average_2d(PFRAC, PFIELD_IN, PFIELD_OUT)
Definition: average_diag.F90:434
average_diag
subroutine average_diag(K2M, OT2MMW, OSURF_BUDGET, OSURF_BUDGETC, OCOEF, OSURF_VARS, PFRAC_TILE, PRN_TILE, PH_TILE, PLE_TILE, PLEI_TILE, PGFLUX_TILE, PRI_TILE, PCD_TILE, PCH_TILE, PCE_TILE, PT2M_TILE, PTS_TILE, PQ2M_TILE, PHU2M_TILE, PZON10M_TILE, PMER10M_TILE, PQS_TILE, PZ0_TILE, PZ0H_TILE, PSWD_TILE, PSWU_TILE, PSWBD_TILE, PSWBU_TILE, PLWD_TILE, PLWU_TILE, PFMU_TILE, PFMV_TILE, PRNC_TILE, PHC_TILE, PLEC_TILE, PGFLUXC_TILE, PSWDC_TILE, PSWUC_TILE, PLWDC_TILE, PLWUC_TILE, PFMUC_TILE, PFMVC_TILE, PT2M_MIN_TILE, PT2M_MAX_TILE, PLEIC_TILE, PRN, PH, PLE, PLEI, PGFLUX, PRI, PCD, PCH, PCE, PT2M, PTS, PQ2M, PHU2M, PZON10M, PMER10M, PQS, PZ0, PZ0H, PUREF, PZREF, PSWD, PSWU, PSWBD, PSWBU, PLWD, PLWU, PFMU, PFMV, PRNC, PHC, PLEC, PGFLUXC, PSWDC, PSWUC, PLWDC, PLWUC, PFMUC, PFMVC, PT2M_MIN, PT2M_MAX, PLEIC, PHU2M_MIN_TILE, PHU2M_MAX_TILE, PHU2M_MIN, PHU2M_MAX, PWIND10M_TILE, PWIND10M_MAX_TILE, PWIND10M, PWIND10M_MAX, PEVAP_TILE, PEVAPC_TILE, PEVAP, PEVAPC, PSUBL_TILE, PSUBLC_TILE, PSUBL, PSUBLC)
Definition: average_diag.F90:6
make_average_mw
subroutine make_average_mw(PFRAC, PFIELD_IN, PFIELD_OUT)
Definition: average_diag.F90:499
modd_surf_par
Definition: modd_surf_par.F90:6
make_average
subroutine make_average(PFRAC, PFIELD_IN, PFIELD_OUT)
Definition: average_diag.F90:404
Generated on Fri May 13 2016 09:31:00 for SURFEX by   doxygen 1.8.5