SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
average_diag_misc_isban.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_misc_isba_n (DGMI, I)
7 ! #############################
8 !
9 !
10 !!**** *AVERAGE_DIAG_MISC_ISBA_n*
11 !!
12 !! PURPOSE
13 !! -------
14 ! Average the cumulated diagnostics from all ISBA tiles
15 !
16 !!** METHOD
17 !! ------
18 !
19 !! EXTERNAL
20 !! --------
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !!
26 !! REFERENCE
27 !! ---------
28 !!
29 !! AUTHOR
30 !! ------
31 !! P. Le Moigne * Meteo-France *
32 !!
33 !! MODIFICATIONS
34 !! -------------
35 !! Original 10/2004
36 !! B. Decharme 2008 New diag Total albedo, Total SWI, & Flood
37 !! B. Decharme 09/2009 New diag Total soil SWI
38 !! B. Decharme 2012 Averaged LAI
39 !! B. Decharme 2012 New diag for DIF:
40 !! F2 stress
41 !! Root zone swi, wg and wgi
42 !! swi, wg and wgi comparable to ISBA-FR-DG2 and DG3 layers
43 !! active layer thickness over permafrost
44 !! frozen layer thickness over non-permafrost
45 !-------------------------------------------------------------------------------
46 !
47 !* 0. DECLARATIONS
48 ! ------------
49 !
50 !
51 USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
52 USE modd_isba_n, ONLY : isba_t
53 !
54 USE modd_surf_par, ONLY : xundef, nundef
55 !
56 USE modd_csts, ONLY : xrholw
57 !
58 !
59 !
60 USE modi_comput_cold_layers_thick
61 !
62 USE yomhook ,ONLY : lhook, dr_hook
63 USE parkind1 ,ONLY : jprb
64 !
65 IMPLICIT NONE
66 !
67 !
68 TYPE(diag_misc_isba_t), INTENT(INOUT) :: dgmi
69 TYPE(isba_t), INTENT(INOUT) :: i
70 !
71 INTEGER :: jj ! grid-cell loop counter
72 INTEGER :: jpatch ! tile loop counter
73 INTEGER :: jlayer ! layer loop counter
74 REAL, DIMENSION(SIZE(I%XPATCH,1)) :: zsumpatch
75 REAL, DIMENSION(SIZE(I%XPATCH,1)) :: zsumdg, zsnow, zsumfrd2, zsumfrd3, zpondf2
76 REAL, DIMENSION(SIZE(I%XPATCH,1),SIZE(I%XPATCH,2)) :: zlai
77 REAL :: zwork
78 INTEGER :: ini,inp,idepth,iwork
79 !
80 REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2)) :: zpond, ztg, zdg
81 !
82 REAL(KIND=JPRB) :: zhook_handle
83 !
84 !-------------------------------------------------------------------------------
85 !
86 ! 0. Initialization
87 ! --------------
88 !
89 IF (lhook) CALL dr_hook('AVERAGE_DIAG_MISC_ISBA_N',0,zhook_handle)
90 !
91 IF (.NOT.dgmi%LSURF_MISC_BUDGET) THEN
92  IF (lhook) CALL dr_hook('AVERAGE_DIAG_MISC_ISBA_N',1,zhook_handle)
93  RETURN
94 ENDIF
95 !
96 ini=SIZE(i%XPATCH,1)
97 inp=SIZE(i%XPATCH,2)
98 !
99 zsumpatch(:) = 0.0
100 DO jpatch=1,inp
101  DO jj=1,ini
102  zsumpatch(jj) = zsumpatch(jj) + i%XPATCH(jj,jpatch)
103  END DO
104 END DO
105 !
106 zsumfrd2(:)=0.0
107 zsumfrd3(:)=0.0
108 zsumdg(:)=0.0
109 zsnow(:)=0.0
110 zpondf2(:)=0.0
111 !
112 WHERE(i%XLAI(:,:)/=xundef)
113  zlai(:,:)=i%XLAI(:,:)
114 ELSEWHERE
115  zlai(:,:)=0.0
116 ENDWHERE
117 !
118 !-------------------------------------------------------------------------------
119 !
120 ! 1. Surface Miscellaneous terms
121 ! ---------------------------
122 !
123 dgmi%XAVG_HV (:) = 0.
124 dgmi%XAVG_PSNG(:) = 0.
125 dgmi%XAVG_PSNV(:) = 0.
126 dgmi%XAVG_PSN (:) = 0.
127 dgmi%XAVG_ALBT(:) = 0.
128 dgmi%XAVG_SWI (:,:) = 0.
129 dgmi%XAVG_TSWI(:,:) = 0.
130 dgmi%XAVG_FSAT(:) = 0.
131 dgmi%XAVG_FFG (:) = 0.
132 dgmi%XAVG_FFV (:) = 0.
133 dgmi%XAVG_FF (:) = 0.
134 dgmi%XAVG_TWSNOW(:) = 0.
135 dgmi%XAVG_TDSNOW(:) = 0.
136 dgmi%XAVG_TTSNOW(:) = 0.
137 dgmi%XAVG_LAI (:) = 0.
138 !
139 dgmi%XSOIL_SWI (:) = 0.
140 dgmi%XSOIL_TSWI (:) = 0.
141 dgmi%XSOIL_TWG (:) = 0.
142 dgmi%XSOIL_TWGI (:) = 0.
143 dgmi%XSOIL_WG (:) = 0.
144 dgmi%XSOIL_WGI (:) = 0.
145 !
146 IF(i%CISBA=='DIF')THEN
147 !
148  dgmi%XAVG_ALT (:) = 0.
149  dgmi%XAVG_FLT (:) = 0.
150 !
151 ENDIF
152 
153 IF(i%CISBA=='DIF'.AND.dgmi%LSURF_MISC_DIF)THEN
154 !
155  dgmi%XFRD2_TSWI (:) = 0.
156  dgmi%XFRD2_TWG (:) = 0.
157  dgmi%XFRD2_TWGI (:) = 0.
158 !
159  dgmi%XFRD3_TSWI (:) = 0.
160  dgmi%XFRD3_TWG (:) = 0.
161  dgmi%XFRD3_TWGI (:) = 0.
162 !
163 ENDIF
164 !
165 DO jpatch=1,inp
166 !
167 !cdir nodep
168  DO jj=1,ini
169 !
170  IF (zsumpatch(jj) > 0.) THEN
171 !
172 ! Halstead coefficient
173  dgmi%XAVG_HV(jj) = dgmi%XAVG_HV(jj) + i%XPATCH(jj,jpatch) * dgmi%XHV(jj,jpatch)
174 !
175 ! Snow fractions
176  dgmi%XAVG_PSNG(jj) = dgmi%XAVG_PSNG(jj) + i%XPATCH(jj,jpatch) * dgmi%XDPSNG(jj,jpatch)
177  dgmi%XAVG_PSNV(jj) = dgmi%XAVG_PSNV(jj) + i%XPATCH(jj,jpatch) * dgmi%XDPSNV(jj,jpatch)
178  dgmi%XAVG_PSN (jj) = dgmi%XAVG_PSN (jj) + i%XPATCH(jj,jpatch) * dgmi%XDPSN (jj,jpatch)
179 !
180 ! Saturated fraction
181  dgmi%XAVG_FSAT (jj) = dgmi%XAVG_FSAT (jj) + i%XPATCH(jj,jpatch) * dgmi%XDFSAT (jj,jpatch)
182 !
183 ! Flood fractions
184  dgmi%XAVG_FFG(jj) = dgmi%XAVG_FFG(jj) + i%XPATCH(jj,jpatch) * dgmi%XDFFG(jj,jpatch)
185  dgmi%XAVG_FFV(jj) = dgmi%XAVG_FFV(jj) + i%XPATCH(jj,jpatch) * dgmi%XDFFV(jj,jpatch)
186  dgmi%XAVG_FF (jj) = dgmi%XAVG_FF (jj) + i%XPATCH(jj,jpatch) * dgmi%XDFF (jj,jpatch)
187 !
188 ! Total albedo
189  dgmi%XAVG_ALBT(jj) = dgmi%XAVG_ALBT(jj) + i%XPATCH(jj,jpatch) * dgmi%XALBT (jj,jpatch)
190 !
191 ! Total LAI
192  dgmi%XAVG_LAI (jj) = dgmi%XAVG_LAI(jj) + i%XPATCH(jj,jpatch) * zlai(jj,jpatch)
193 !
194 ! Snow total outputs
195  dgmi%XAVG_TWSNOW(jj) = dgmi%XAVG_TWSNOW(jj) + i%XPATCH(jj,jpatch) * dgmi%XTWSNOW(jj,jpatch)
196  dgmi%XAVG_TDSNOW(jj) = dgmi%XAVG_TDSNOW(jj) + i%XPATCH(jj,jpatch) * dgmi%XTDSNOW(jj,jpatch)
197 !
198  IF (dgmi%XTWSNOW(jj,jpatch)>0.0) THEN
199  dgmi%XAVG_TTSNOW(jj) = dgmi%XAVG_TTSNOW(jj) + i%XPATCH(jj,jpatch) * dgmi%XTTSNOW(jj,jpatch)
200  zsnow(jj) = zsnow(jj) + i%XPATCH(jj,jpatch)
201  ENDIF
202 !
203  ENDIF
204 !
205  ENDDO
206 !
207 ENDDO
208 !
209 !-------------------------------------------------------------------------------
210 !
211 ! 2. Specific treatement following CISBA option
212 ! ------------------------------------------
213 !
214 ! Soil Wetness Index profile, Total Soil Wetness Index and
215 ! Total Soil Water Content (Liquid+Solid) and Total Frozen Content
216 !
217 !---------------------------------------------
218 IF(i%CISBA=='DIF')THEN ! DIF case
219 !---------------------------------------------
220 !
221 ! Active and Frozen layers thickness
222  ztg(:,:)=0.0
223  zdg(:,:)=0.0
224  DO jpatch=1,inp
225  DO jlayer=1,i%NGROUND_LAYER
226  DO jj=1,ini
227  ztg(jj,jlayer) = ztg(jj,jlayer) + i%XPATCH(jj,jpatch) * i%XTG(jj,jlayer,jpatch)
228  zdg(jj,jlayer) = zdg(jj,jlayer) + i%XPATCH(jj,jpatch) * i%XDG(jj,jlayer,jpatch)
229  ENDDO
230  ENDDO
231  ENDDO
232  CALL comput_cold_layers_thick(zdg,ztg,dgmi%XAVG_ALT,dgmi%XAVG_FLT)
233 !
234  zpond(:,:)=0.0
235  DO jpatch=1,inp
236  IF(i%NSIZE_NATURE_P(jpatch) > 0 )THEN
237  DO jlayer = 1,i%NGROUND_LAYER
238 ! cdir nodep
239  DO jj=1,ini
240  idepth=i%NWG_LAYER(jj,jpatch)
241  IF(jlayer<=idepth.AND.idepth/=nundef)THEN
242  zwork=i%XDZG(jj,jlayer,jpatch)
243  !Soil Wetness Index profile
244  dgmi%XAVG_SWI (jj,jlayer) = dgmi%XAVG_SWI (jj,jlayer)+zwork*i%XPATCH(jj,jpatch)*dgmi%XSWI (jj,jlayer,jpatch)
245  dgmi%XAVG_TSWI(jj,jlayer) = dgmi%XAVG_TSWI(jj,jlayer)+zwork*i%XPATCH(jj,jpatch)*dgmi%XTSWI(jj,jlayer,jpatch)
246  zpond(jj,jlayer) = zpond(jj,jlayer)+zwork*i%XPATCH(jj,jpatch)
247  !Total soil wetness index, total water and ice contents
248  dgmi%XSOIL_SWI (jj) = dgmi%XSOIL_SWI (jj) + zwork * i%XPATCH(jj,jpatch) * dgmi%XSWI (jj,jlayer,jpatch)
249  dgmi%XSOIL_TSWI(jj) = dgmi%XSOIL_TSWI(jj) + zwork * i%XPATCH(jj,jpatch) * dgmi%XTSWI(jj,jlayer,jpatch)
250  zsumdg(jj) = zsumdg(jj) + zwork * i%XPATCH(jj,jpatch)
251  dgmi%XSOIL_TWG (jj) = dgmi%XSOIL_TWG (jj) + zwork * i%XPATCH(jj,jpatch) * (i%XWG(jj,jlayer,jpatch) &
252  + i%XWGI(jj,jlayer,jpatch))
253  dgmi%XSOIL_TWGI(jj) = dgmi%XSOIL_TWGI(jj) + zwork * i%XPATCH(jj,jpatch) * i%XWGI(jj,jlayer,jpatch)
254  ENDIF
255  ENDDO
256  ENDDO
257  ENDIF
258  ENDDO
259 !
260  WHERE(zpond(:,:)> 0.)
261  dgmi%XAVG_SWI (:,:) = dgmi%XAVG_SWI (:,:) / zpond(:,:)
262  dgmi%XAVG_TSWI(:,:) = dgmi%XAVG_TSWI(:,:) / zpond(:,:)
263  ELSEWHERE
264  dgmi%XAVG_SWI (:,:) = xundef
265  dgmi%XAVG_TSWI(:,:) = xundef
266  ENDWHERE
267 !
268 ! ---------------------------------------------
269  IF(dgmi%LSURF_MISC_DIF)THEN ! LSURF_MISC_DIF case
270 ! ---------------------------------------------
271 !
272  DO jpatch=1,inp
273 !
274  IF (i%NSIZE_NATURE_P(jpatch) == 0 ) cycle
275 !
276  DO jlayer = 1,i%NGROUND_LAYER
277 ! cdir nodep
278  DO jj=1,ini
279  idepth=i%NWG_LAYER(jj,jpatch)
280  IF(jlayer<=idepth.AND.idepth/=nundef)THEN
281  !
282  ! ISBA-FR-DG2 comparable soil wetness index, liquid water and ice contents
283  zwork=min(i%XDZG(jj,jlayer,jpatch),max(0.0,i%XDG2(jj,jpatch)-i%XDG(jj,jlayer,jpatch)+i%XDZG(jj,jlayer,jpatch)))
284  dgmi%XFRD2_TSWI (jj) = dgmi%XFRD2_TSWI (jj) + zwork * i%XPATCH(jj,jpatch) * dgmi%XTSWI(jj,jlayer,jpatch)
285  dgmi%XFRD2_TWG (jj) = dgmi%XFRD2_TWG (jj) + zwork * i%XPATCH(jj,jpatch) * i%XWG (jj,jlayer,jpatch)
286  dgmi%XFRD2_TWGI (jj) = dgmi%XFRD2_TWGI (jj) + zwork * i%XPATCH(jj,jpatch) * i%XWGI (jj,jlayer,jpatch)
287  zsumfrd2(jj) = zsumfrd2(jj) + zwork * i%XPATCH(jj,jpatch)
288  !
289  ! ISBA-FR-DG3 comparable soil wetness index, liquid water and ice contents
290  zwork=min(i%XDZG(jj,jlayer,jpatch),max(0.0,i%XDG(jj,jlayer,jpatch)-i%XDG2(jj,jpatch)))
291  dgmi%XFRD3_TSWI (jj) = dgmi%XFRD3_TSWI (jj) + zwork * i%XPATCH(jj,jpatch) * dgmi%XTSWI(jj,jlayer,jpatch)
292  dgmi%XFRD3_TWG (jj) = dgmi%XFRD3_TWG (jj) + zwork * i%XPATCH(jj,jpatch) * i%XWG (jj,jlayer,jpatch)
293  dgmi%XFRD3_TWGI (jj) = dgmi%XFRD3_TWGI (jj) + zwork * i%XPATCH(jj,jpatch) * i%XWGI (jj,jlayer,jpatch)
294  zsumfrd3(jj) = zsumfrd3(jj) + zwork * i%XPATCH(jj,jpatch)
295  !
296  ENDIF
297  ENDDO
298  ENDDO
299 !
300  ENDDO
301 !
302  WHERE(zsumfrd2(:)>0.0)
303  dgmi%XFRD2_TSWI (:) = dgmi%XFRD2_TSWI (:) / zsumfrd2(:)
304  dgmi%XFRD2_TWG (:) = dgmi%XFRD2_TWG (:) / zsumfrd2(:)
305  dgmi%XFRD2_TWGI (:) = dgmi%XFRD2_TWGI (:) / zsumfrd2(:)
306  ELSEWHERE
307  dgmi%XFRD2_TSWI (:) = xundef
308  ENDWHERE
309 !
310  WHERE(zsumfrd3(:)>0.0)
311  dgmi%XFRD3_TSWI (:) = dgmi%XFRD3_TSWI (:) / zsumfrd3(:)
312  dgmi%XFRD3_TWG (:) = dgmi%XFRD3_TWG (:) / zsumfrd3(:)
313  dgmi%XFRD3_TWGI (:) = dgmi%XFRD3_TWGI (:) / zsumfrd3(:)
314  ELSEWHERE
315  dgmi%XFRD3_TSWI (:) = xundef
316  ENDWHERE
317 !
318 ! ---------------------------------------------
319  ENDIF ! End LSURF_MISC_DIF case
320 ! ---------------------------------------------
321 !
322 !---------------------------------------------
323 ELSE ! force-restore case
324 !---------------------------------------------
325 !
326  DO jpatch=1,inp
327  DO jj=1,ini
328  IF(zsumpatch(jj) > 0.)THEN
329 !
330  dgmi%XAVG_SWI (jj,1) = dgmi%XAVG_SWI (jj,1) + i%XPATCH(jj,jpatch) * dgmi%XSWI (jj,1,jpatch)
331  dgmi%XAVG_SWI (jj,2) = dgmi%XAVG_SWI (jj,2) + i%XPATCH(jj,jpatch) * dgmi%XSWI (jj,2,jpatch)
332  dgmi%XAVG_TSWI(jj,1) = dgmi%XAVG_TSWI(jj,1) + i%XPATCH(jj,jpatch) * dgmi%XTSWI(jj,1,jpatch)
333  dgmi%XAVG_TSWI(jj,2) = dgmi%XAVG_TSWI(jj,2) + i%XPATCH(jj,jpatch) * dgmi%XTSWI(jj,2,jpatch)
334 !
335  dgmi%XSOIL_SWI (jj) = dgmi%XSOIL_SWI (jj) + i%XPATCH(jj,jpatch) * i%XDG (jj,2,jpatch) * dgmi%XSWI (jj,2,jpatch)
336  dgmi%XSOIL_TSWI(jj) = dgmi%XSOIL_TSWI(jj) + i%XPATCH(jj,jpatch) * i%XDG (jj,2,jpatch) * dgmi%XTSWI(jj,2,jpatch)
337  dgmi%XSOIL_TWG (jj) = dgmi%XSOIL_TWG (jj) + i%XPATCH(jj,jpatch) * i%XDG (jj,2,jpatch) * (i%XWG(jj,2,jpatch) &
338  + i%XWGI(jj,2,jpatch))
339  dgmi%XSOIL_TWGI(jj) = dgmi%XSOIL_TWGI(jj) + i%XPATCH(jj,jpatch) * i%XDG (jj,2,jpatch) * i%XWGI(jj,2,jpatch)
340 !
341  zsumdg(jj) = zsumdg(jj) + i%XPATCH(jj,jpatch) * i%XDG(jj,i%NGROUND_LAYER,jpatch)
342 !
343  ENDIF
344  ENDDO
345  ENDDO
346 !
347  IF(i%CISBA=='3-L')THEN
348 !
349  zpond(:,:)=0.0
350  DO jpatch=1,inp
351  DO jj=1,SIZE(i%XPATCH,1)
352  IF(zsumpatch(jj) > 0.)THEN
353 !
354  zwork=max(0.0,i%XDG(jj,3,jpatch)-i%XDG(jj,2,jpatch))
355 !
356 ! Remenber: no ice in the third layer of 3-L
357  zpond(jj,3) = zpond(jj,3) + i%XPATCH(jj,jpatch) * zwork
358  dgmi%XAVG_SWI (jj,3) = dgmi%XAVG_SWI (jj,3) + i%XPATCH(jj,jpatch) * zwork * dgmi%XSWI (jj,3,jpatch)
359  dgmi%XSOIL_SWI (jj ) = dgmi%XSOIL_SWI (jj ) + i%XPATCH(jj,jpatch) * zwork * dgmi%XSWI (jj,3,jpatch)
360  dgmi%XAVG_TSWI (jj,3) = dgmi%XAVG_TSWI (jj,3) + i%XPATCH(jj,jpatch) * zwork * dgmi%XTSWI(jj,3,jpatch)
361  dgmi%XSOIL_TSWI(jj ) = dgmi%XSOIL_TSWI(jj ) + i%XPATCH(jj,jpatch) * zwork * dgmi%XTSWI(jj,3,jpatch)
362  dgmi%XSOIL_TWG (jj ) = dgmi%XSOIL_TWG (jj ) + i%XPATCH(jj,jpatch) * zwork * i%XWG (jj,3,jpatch)
363 !
364  ENDIF
365  ENDDO
366  ENDDO
367 !
368  WHERE(zpond(:,3)>0.0)
369  dgmi%XAVG_SWI (:,3) = dgmi%XAVG_SWI (:,3) / zpond(:,3)
370  dgmi%XAVG_TSWI(:,3) = dgmi%XAVG_TSWI(:,3) / zpond(:,3)
371  ELSEWHERE
372  dgmi%XAVG_SWI (:,3) = xundef
373  dgmi%XAVG_TSWI(:,3) = xundef
374  ENDWHERE
375 !
376  ENDIF
377 
378 !
379 !---------------------------------------------
380 ENDIF ! End ISBA soil scheme case
381 !---------------------------------------------
382 !
383 ! 3. Final computation for grid-cell diag
384 ! ------------------------------------
385 !
386 !Total Soil Wetness Index and Soil Water Content (m3.m-3)
387 WHERE(zsumdg(:)>0.0)
388  dgmi%XSOIL_SWI (:) = dgmi%XSOIL_SWI (:)/zsumdg(:)
389  dgmi%XSOIL_TSWI(:) = dgmi%XSOIL_TSWI(:)/zsumdg(:)
390  dgmi%XSOIL_WG (:) = dgmi%XSOIL_TWG (:)/zsumdg(:)
391  dgmi%XSOIL_WGI (:) = dgmi%XSOIL_TWGI(:)/zsumdg(:)
392 ENDWHERE
393 !
394 !Total Soil Water Content (Liquid+Solid) and Total Frozen Content (kg/m2)
395 dgmi%XSOIL_TWG (:)= dgmi%XSOIL_TWG (:) * xrholw
396 dgmi%XSOIL_TWGI(:)= dgmi%XSOIL_TWGI(:) * xrholw
397 !
398 ! Snow temperature
399 WHERE(zsnow(:)>0.0)
400  dgmi%XAVG_TTSNOW(:) = dgmi%XAVG_TTSNOW(:)/zsnow(:)
401 ELSEWHERE
402  dgmi%XAVG_TTSNOW(:) = xundef
403 ENDWHERE
404 !
405 !-------------------------------------------------------------------------------
406 !
407 IF (lhook) CALL dr_hook('AVERAGE_DIAG_MISC_ISBA_N',1,zhook_handle)
408 !-------------------------------------------------------------------------------
409 !
410 END SUBROUTINE average_diag_misc_isba_n
average_diag_misc_isba_n
subroutine average_diag_misc_isba_n(DGMI, I)
Definition: average_diag_misc_isban.F90:6
modd_isba_n
Definition: modd_isban.F90:6
modd_diag_misc_isba_n
Definition: modd_diag_misc_isban.F90:6
modd_diag_misc_isba_n::diag_misc_isba_t
Definition: modd_diag_misc_isban.F90:53
modd_surf_par
Definition: modd_surf_par.F90:6
modd_csts
Definition: modd_csts.F90:6
comput_cold_layers_thick
subroutine comput_cold_layers_thick(PDG, PTG, PALT, PFLT)
Definition: comput_cold_layers_thick.F90:5
Generated on Fri May 13 2016 09:31:00 for SURFEX by   doxygen 1.8.5