SURFEX v8.1
General documentation of Surfex
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 (DM, NDM, IO, NP, NPE)
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 !
54 !
55 USE modd_surf_par, ONLY : xundef, nundef
56 !
57 USE modd_csts, ONLY : xrholw
58 !
59 USE modi_comput_cold_layers_thick
60 !
61 USE yomhook ,ONLY : lhook, dr_hook
62 USE parkind1 ,ONLY : jprb
63 !
64 IMPLICIT NONE
65 !
66 !
67 TYPE(diag_misc_isba_t), INTENT(INOUT) :: DM
68 TYPE(diag_misc_isba_np_t), INTENT(INOUT) :: NDM
69 TYPE(isba_options_t), INTENT(INOUT) :: IO
70 TYPE(isba_np_t), INTENT(INOUT) :: NP
71 TYPE(isba_npe_t), INTENT(INOUT) :: NPE
72 !
73 TYPE(diag_misc_isba_t), POINTER :: DMK
74 TYPE(isba_p_t), POINTER :: PK
75 TYPE(isba_pe_t), POINTER :: PEK
76 INTEGER :: JI ! grid-cell loop counter
77 INTEGER :: JP ! tile loop counter
78 INTEGER :: JL ! layer loop counter
79 REAL, DIMENSION(SIZE(DM%XHV)) :: ZSUMDG, ZSNOW, ZSUMFRD2, ZSUMFRD3
80 REAL :: ZWORK
81 INTEGER :: INI,IDEPTH,IWORK,IMASK
82 !
83 REAL, DIMENSION(SIZE(DM%XHV),IO%NGROUND_LAYER) :: ZPOND, ZTG, ZDG
84 !
85 REAL(KIND=JPRB) :: ZHOOK_HANDLE
86 !
87 !-------------------------------------------------------------------------------
88 !
89 ! 0. Initialization
90 ! --------------
91 !
92 IF (lhook) CALL dr_hook('AVERAGE_DIAG_MISC_ISBA_N',0,zhook_handle)
93 !
94 IF (.NOT.dm%LSURF_MISC_BUDGET) THEN
95  IF (lhook) CALL dr_hook('AVERAGE_DIAG_MISC_ISBA_N',1,zhook_handle)
96  RETURN
97 ENDIF
98 !
99 ini=SIZE(dm%XHV)
100 !
101 !-------------------------------------------------------------------------------
102 !
103 ! 1. Surface Miscellaneous terms
104 ! ---------------------------
105 !
106 dm%XHV (:) = 0.
107 dm%XPSNG(:) = 0.
108 dm%XPSNV(:) = 0.
109 dm%XPSN (:) = 0.
110 dm%XFSAT(:) = 0.
111 dm%XFFG (:) = 0.
112 dm%XFFV (:) = 0.
113 dm%XFF (:) = 0.
114 dm%XLAI (:) = 0.
115 dm%XTWSNOW(:) = 0.
116 dm%XTDSNOW(:) = 0.
117 dm%XTTSNOW(:) = 0.
118 IF (dm%LPROSNOW .AND. npe%AL(1)%TSNOW%SCHEME=="CRO") THEN
119  dm%XSNDPT_1DY(:) = 0.
120  dm%XSNDPT_3DY(:) = 0.
121  dm%XSNDPT_5DY(:) = 0.
122  dm%XSNDPT_7DY(:) = 0.
123  dm%XSNSWE_1DY(:) = 0.
124  dm%XSNSWE_3DY(:) = 0.
125  dm%XSNSWE_5DY(:) = 0.
126  dm%XSNSWE_7DY(:) = 0.
127  dm%XSNRAM_SONDE(:) = 0.
128  dm%XSN_WETTHCKN(:) = 0.
129  dm%XSN_REFRZNTHCKN(:) = 0.
130 ENDIF
131 !
132 zsnow(:)=0.0
133 !
134 DO jp=1,io%NPATCH
135  pk => np%AL(jp)
136  dmk => ndm%AL(jp)
137  pek => npe%AL(jp)
138 
139  DO ji=1,pk%NSIZE_P
140  imask = pk%NR_P(ji)
141 
142  ! Halstead coefficient
143  dm%XHV (imask) = dm%XHV (imask) + pk%XPATCH(ji) * dmk%XHV(ji)
144  !
145  ! Snow fractions
146  dm%XPSNG(imask) = dm%XPSNG (imask) + pk%XPATCH(ji) * dmk%XPSNG(ji)
147  dm%XPSNV(imask) = dm%XPSNV (imask) + pk%XPATCH(ji) * dmk%XPSNV(ji)
148  dm%XPSN (imask) = dm%XPSN (imask) + pk%XPATCH(ji) * dmk%XPSN (ji)
149  !
150  ! Saturated fraction
151  dm%XFSAT (imask) = dm%XFSAT(imask) + pk%XPATCH(ji) * dmk%XFSAT(ji)
152  !
153  ! Flood fractions
154  dm%XFFG (imask) = dm%XFFG (imask) + pk%XPATCH(ji) * dmk%XFFG(ji)
155  dm%XFFV (imask) = dm%XFFV (imask) + pk%XPATCH(ji) * dmk%XFFV(ji)
156  dm%XFF (imask) = dm%XFF (imask) + pk%XPATCH(ji) * dmk%XFF (ji)
157  !
158  ! Total LAI
159  IF (pek%XLAI(ji)/=xundef) dm%XLAI(imask) = dm%XLAI(imask) + pk%XPATCH(ji) * pek%XLAI(ji)
160  !
161  ! Snow total outputs
162  dm%XTWSNOW(imask) = dm%XTWSNOW(imask) + pk%XPATCH(ji) * dmk%XTWSNOW(ji)
163  dm%XTDSNOW(imask) = dm%XTDSNOW(imask) + pk%XPATCH(ji) * dmk%XTDSNOW(ji)
164  !
165  IF (dmk%XTWSNOW(ji)>0.0) THEN
166  !
167  dm%XTTSNOW(imask) = dm%XTTSNOW(imask) + pk%XPATCH(ji) * dmk%XTTSNOW(ji)
168  zsnow(imask) = zsnow(imask) + pk%XPATCH(ji)
169  !
170  IF (dm%LPROSNOW .AND. npe%AL(1)%TSNOW%SCHEME=="CRO") THEN
171  !
172  dm%XSNDPT_1DY(imask) = dm%XSNDPT_1DY(imask) + pk%XPATCH(ji) * dmk%XSNDPT_1DY(ji)
173  dm%XSNDPT_3DY(imask) = dm%XSNDPT_3DY(imask) + pk%XPATCH(ji) * dmk%XSNDPT_3DY(ji)
174  dm%XSNDPT_5DY(imask) = dm%XSNDPT_5DY(imask) + pk%XPATCH(ji) * dmk%XSNDPT_5DY(ji)
175  dm%XSNDPT_7DY(imask) = dm%XSNDPT_7DY(imask) + pk%XPATCH(ji) * dmk%XSNDPT_7DY(ji)
176  dm%XSNSWE_1DY(imask) = dm%XSNSWE_1DY(imask) + pk%XPATCH(ji) * dmk%XSNSWE_1DY(ji)
177  dm%XSNSWE_3DY(imask) = dm%XSNSWE_3DY(imask) + pk%XPATCH(ji) * dmk%XSNSWE_3DY(ji)
178  dm%XSNSWE_5DY(imask) = dm%XSNSWE_5DY(imask) + pk%XPATCH(ji) * dmk%XSNSWE_5DY(ji)
179  dm%XSNSWE_7DY(imask) = dm%XSNSWE_7DY(imask) + pk%XPATCH(ji) * dmk%XSNSWE_7DY(ji)
180  dm%XSNRAM_SONDE(imask) = dm%XSNRAM_SONDE(imask) + pk%XPATCH(ji) * dmk%XSNRAM_SONDE(ji)
181  dm%XSN_WETTHCKN(imask) = dm%XSN_WETTHCKN(imask) + pk%XPATCH(ji) * dmk%XSN_WETTHCKN(ji)
182  dm%XSN_REFRZNTHCKN(imask) = dm%XSN_REFRZNTHCKN(imask) + pk%XPATCH(ji) * dmk%XSN_REFRZNTHCKN(ji)
183  !
184  ENDIF
185  !
186  ENDIF
187  !
188  ENDDO
189  !
190 ENDDO
191 !
192 !-------------------------------------------------------------------------------
193 !
194 ! 2. Specific treatement following CISBA option
195 ! ------------------------------------------
196 !
197 ! Soil Wetness Index profile, Total Soil Wetness Index and
198 ! Total Soil Water Content (Liquid+Solid) and Total Frozen Content
199 !
200 dm%XSWI (:,:) = 0.
201 dm%XTSWI(:,:) = 0.
202 !
203 dm%XSOIL_SWI (:) = 0.
204 dm%XSOIL_TSWI (:) = 0.
205 dm%XSOIL_TWG (:) = 0.
206 dm%XSOIL_TWGI (:) = 0.
207 dm%XSOIL_WG (:) = 0.
208 dm%XSOIL_WGI (:) = 0.
209 !
210 zsumdg(:)=0.0
211 !
212 !---------------------------------------------
213 IF(io%CISBA=='DIF')THEN ! DIF case
214 !---------------------------------------------
215 !
216  dm%XALT (:) = 0.
217  dm%XFLT (:) = 0.
218 
219 ! Active and Frozen layers thickness
220  ztg(:,:)=0.0
221  zdg(:,:)=0.0
222  DO jp=1,io%NPATCH
223  pk => np%AL(jp)
224  pek => npe%AL(jp)
225 
226  DO jl=1,io%NGROUND_LAYER
227  DO ji=1,pk%NSIZE_P
228  imask = pk%NR_P(ji)
229  ztg(imask,jl) = ztg(imask,jl) + pk%XPATCH(ji) * pek%XTG(ji,jl)
230  zdg(imask,jl) = zdg(imask,jl) + pk%XPATCH(ji) * pk%XDG (ji,jl)
231  ENDDO
232  ENDDO
233 
234  ENDDO
235  CALL comput_cold_layers_thick(zdg,ztg,dm%XALT,dm%XFLT)
236 !
237  zpond(:,:)=0.0
238  DO jp=1,io%NPATCH
239  dmk => ndm%AL(jp)
240  pk => np%AL(jp)
241  pek => npe%AL(jp)
242 
243  DO jl = 1,io%NGROUND_LAYER
244 
245  DO ji=1,pk%NSIZE_P
246  idepth = pk%NWG_LAYER(ji)
247  IF(jl<=idepth.AND.idepth/=nundef)THEN
248 
249  imask = pk%NR_P(ji)
250 
251  zwork = pk%XDZG(ji,jl)
252  !Soil Wetness Index profile
253  dm%XSWI (imask,jl) = dm%XSWI (imask,jl) + zwork*pk%XPATCH(ji) * dmk%XSWI (ji,jl)
254  dm%XTSWI(imask,jl) = dm%XTSWI(imask,jl) + zwork*pk%XPATCH(ji) * dmk%XTSWI(ji,jl)
255  zpond(imask,jl) = zpond(imask,jl) + zwork*pk%XPATCH(ji)
256  !Total soil wetness index, total water and ice contents
257  dm%XSOIL_SWI (imask) = dm%XSOIL_SWI (imask) + zwork * pk%XPATCH(ji) * dmk%XSWI (ji,jl)
258  dm%XSOIL_TSWI(imask) = dm%XSOIL_TSWI(imask) + zwork * pk%XPATCH(ji) * dmk%XTSWI(ji,jl)
259  zsumdg(imask) = zsumdg(imask) + zwork * pk%XPATCH(ji)
260  dm%XSOIL_TWG (imask) = dm%XSOIL_TWG (imask) + zwork * pk%XPATCH(ji) * (pek%XWG(ji,jl) + pek%XWGI(ji,jl))
261  dm%XSOIL_TWGI(imask) = dm%XSOIL_TWGI(imask) + zwork * pk%XPATCH(ji) * pek%XWGI(ji,jl)
262 
263  ENDIF
264 
265  ENDDO
266 
267  ENDDO
268  !
269  ENDDO
270  !
271  WHERE(zpond(:,:)> 0.)
272  dm%XSWI (:,:) = dm%XSWI (:,:) / zpond(:,:)
273  dm%XTSWI(:,:) = dm%XTSWI(:,:) / zpond(:,:)
274  ELSEWHERE
275  dm%XSWI (:,:) = xundef
276  dm%XTSWI(:,:) = xundef
277  ENDWHERE
278 !
279 ! ---------------------------------------------
280  IF(dm%LSURF_MISC_DIF)THEN ! LSURF_MISC_DIF case
281 ! ---------------------------------------------
282 !
283  zsumfrd2(:)=0.0
284  zsumfrd3(:)=0.0
285 !
286  dm%XFRD2_TSWI (:) = 0.
287  dm%XFRD2_TWG (:) = 0.
288  dm%XFRD2_TWGI (:) = 0.
289 !
290  dm%XFRD3_TSWI (:) = 0.
291  dm%XFRD3_TWG (:) = 0.
292  dm%XFRD3_TWGI (:) = 0.
293 
294  DO jp=1,io%NPATCH
295  pk => np%AL(jp)
296  pek => npe%AL(jp)
297  dmk => ndm%AL(jp)
298 
299  DO ji=1,pk%NSIZE_P
300  imask = pk%NR_P(ji)
301 
302  DO jl = 1,io%NGROUND_LAYER
303  idepth= pk%NWG_LAYER(ji)
304 
305  IF(jl<=idepth.AND.idepth/=nundef)THEN
306  !
307  ! ISBA-FR-DG2 comparable soil wetness index, liquid water and ice contents
308  zwork = min(pk%XDZG(ji,jl),max(0.0,pk%XDG2(ji)-pk%XDG(ji,jl)+pk%XDZG(ji,jl)))
309  dm%XFRD2_TSWI (imask) = dm%XFRD2_TSWI (imask) + zwork * pk%XPATCH(ji) * dmk%XTSWI(ji,jl)
310  dm%XFRD2_TWG (imask) = dm%XFRD2_TWG (imask) + zwork * pk%XPATCH(ji) * pek%XWG (ji,jl)
311  dm%XFRD2_TWGI (imask) = dm%XFRD2_TWGI (imask) + zwork * pk%XPATCH(ji) * pek%XWGI (ji,jl)
312  zsumfrd2(imask) = zsumfrd2(imask) + zwork * pk%XPATCH(ji)
313  !
314  ! ISBA-FR-DG3 comparable soil wetness index, liquid water and ice contents
315  zwork =min(pk%XDZG(ji,jl),max(0.0,pk%XDG(ji,jl)-pk%XDG2(ji)))
316  dm%XFRD3_TSWI (imask) = dm%XFRD3_TSWI (imask) + zwork * pk%XPATCH(ji) * dmk%XTSWI(ji,jl)
317  dm%XFRD3_TWG (imask) = dm%XFRD3_TWG (imask) + zwork * pk%XPATCH(ji) * pek%XWG (ji,jl)
318  dm%XFRD3_TWGI (imask) = dm%XFRD3_TWGI (imask) + zwork * pk%XPATCH(ji) * pek%XWGI (ji,jl)
319  zsumfrd3(imask) = zsumfrd3(imask) + zwork * pk%XPATCH(ji)
320  !
321  ENDIF
322  ENDDO
323  ENDDO
324 !
325  ENDDO
326 !
327  WHERE(zsumfrd2(:)>0.0)
328  dm%XFRD2_TSWI (:) = dm%XFRD2_TSWI (:) / zsumfrd2(:)
329  dm%XFRD2_TWG (:) = dm%XFRD2_TWG (:) / zsumfrd2(:)
330  dm%XFRD2_TWGI (:) = dm%XFRD2_TWGI (:) / zsumfrd2(:)
331  ELSEWHERE
332  dm%XFRD2_TSWI (:) = xundef
333  ENDWHERE
334 !
335  WHERE(zsumfrd3(:)>0.0)
336  dm%XFRD3_TSWI (:) = dm%XFRD3_TSWI (:) / zsumfrd3(:)
337  dm%XFRD3_TWG (:) = dm%XFRD3_TWG (:) / zsumfrd3(:)
338  dm%XFRD3_TWGI (:) = dm%XFRD3_TWGI (:) / zsumfrd3(:)
339  ELSEWHERE
340  dm%XFRD3_TSWI (:) = xundef
341  ENDWHERE
342 !
343 ! ---------------------------------------------
344  ENDIF ! End LSURF_MISC_DIF case
345 ! ---------------------------------------------
346 !
347 !---------------------------------------------
348 ELSE ! force-restore case
349 !---------------------------------------------
350 !
351  DO jp=1,io%NPATCH
352  pk => np%AL(jp)
353  pek => npe%AL(jp)
354  dmk => ndm%AL(jp)
355 
356  DO ji=1,pk%NSIZE_P
357  imask = pk%NR_P(ji)
358 !
359  dm%XSWI (imask,1) = dm%XSWI (imask,1) + pk%XPATCH(ji) * dmk%XSWI (ji,1)
360  dm%XSWI (imask,2) = dm%XSWI (imask,2) + pk%XPATCH(ji) * dmk%XSWI (ji,2)
361  dm%XTSWI(imask,1) = dm%XTSWI(imask,1) + pk%XPATCH(ji) * dmk%XTSWI(ji,1)
362  dm%XTSWI(imask,2) = dm%XTSWI(imask,2) + pk%XPATCH(ji) * dmk%XTSWI(ji,2)
363 !
364  dm%XSOIL_SWI (imask) = dm%XSOIL_SWI (imask) + pk%XPATCH(ji) * pk%XDG (ji,2) * dmk%XSWI (ji,2)
365  dm%XSOIL_TSWI(imask) = dm%XSOIL_TSWI(imask) + pk%XPATCH(ji) * pk%XDG (ji,2) * dmk%XTSWI(ji,2)
366  dm%XSOIL_TWG (imask) = dm%XSOIL_TWG (imask) + pk%XPATCH(ji) * pk%XDG (ji,2) * (pek%XWG(ji,2) + pek%XWGI(ji,2))
367  dm%XSOIL_TWGI(imask) = dm%XSOIL_TWGI(imask) + pk%XPATCH(ji) * pk%XDG (ji,2) * pek%XWGI(ji,2)
368 !
369  zsumdg(imask) = zsumdg(imask) + pk%XPATCH(ji) * pk%XDG(ji,io%NGROUND_LAYER)
370 !
371  ENDDO
372  ENDDO
373 !
374  IF(io%CISBA=='3-L')THEN
375 !
376  zpond(:,:)=0.0
377  DO jp=1,io%NPATCH
378  dmk => ndm%AL(jp)
379  pk => np%AL(jp)
380  pek => npe%AL(jp)
381 
382  DO ji=1,pk%NSIZE_P
383  imask = pk%NR_P(ji)
384 !
385  zwork=max(0.0,pk%XDG(ji,3)-pk%XDG(ji,2))
386 !
387 ! Remenber: no ice in the third layer of 3-L
388  zpond(imask,3) = zpond(imask,3) + pk%XPATCH(ji) * zwork
389  dm%XSWI (imask,3) = dm%XSWI (imask,3) + pk%XPATCH(ji) * zwork * dmk%XSWI (ji,3)
390  dm%XSOIL_SWI (imask ) = dm%XSOIL_SWI (imask ) + pk%XPATCH(ji) * zwork * dmk%XSWI (ji,3)
391  dm%XTSWI (imask,3) = dm%XTSWI (imask,3) + pk%XPATCH(ji) * zwork * dmk%XTSWI(ji,3)
392  dm%XSOIL_TSWI (imask ) = dm%XSOIL_TSWI(imask ) + pk%XPATCH(ji) * zwork * dmk%XTSWI(ji,3)
393  dm%XSOIL_TWG (imask ) = dm%XSOIL_TWG (imask ) + pk%XPATCH(ji) * zwork * pek%XWG (ji,3)
394 !
395  ENDDO
396  ENDDO
397 !
398  WHERE(zpond(:,3)>0.0)
399  dm%XSWI (:,3) = dm%XSWI (:,3) / zpond(:,3)
400  dm%XTSWI(:,3) = dm%XTSWI(:,3) / zpond(:,3)
401  ELSEWHERE
402  dm%XSWI (:,3) = xundef
403  dm%XTSWI(:,3) = xundef
404  ENDWHERE
405 !
406  ENDIF
407 
408 !
409 !---------------------------------------------
410 ENDIF ! End ISBA soil scheme case !
411 !
412 !---------------------------------------------
413 !
414 ! 3. Final computation for grid-cell diag
415 ! ------------------------------------
416 !
417 !Total Soil Wetness Index and Soil Water Content (m3.m-3)
418 WHERE(zsumdg(:)>0.0)
419  dm%XSOIL_SWI (:) = dm%XSOIL_SWI (:)/zsumdg(:)
420  dm%XSOIL_TSWI(:) = dm%XSOIL_TSWI(:)/zsumdg(:)
421  dm%XSOIL_WG (:) = dm%XSOIL_TWG (:)/zsumdg(:)
422  dm%XSOIL_WGI (:) = dm%XSOIL_TWGI(:)/zsumdg(:)
423 ENDWHERE
424 !
425 !Total Soil Water Content (Liquid+Solid) and Total Frozen Content (kg/m2)
426 dm%XSOIL_TWG (:)= dm%XSOIL_TWG (:) * xrholw
427 dm%XSOIL_TWGI(:)= dm%XSOIL_TWGI(:) * xrholw
428 !
429 ! Snow temperature
430 WHERE(zsnow(:)>0.0)
431  dm%XTTSNOW(:) = dm%XTTSNOW(:)/zsnow(:)
432 ELSEWHERE
433  dm%XTTSNOW(:) = xundef
434 ENDWHERE
435 !
436 !-------------------------------------------------------------------------------
437 !
438 IF (lhook) CALL dr_hook('AVERAGE_DIAG_MISC_ISBA_N',1,zhook_handle)
439 !-------------------------------------------------------------------------------
440 !
441 END SUBROUTINE average_diag_misc_isba_n
real, parameter xundef
integer, parameter jprb
Definition: parkind1.F90:32
integer, parameter nundef
logical lhook
Definition: yomhook.F90:15
real, save xrholw
Definition: modd_csts.F90:64
subroutine average_diag_misc_isba_n(DM, NDM, IO, NP, NPE)
subroutine comput_cold_layers_thick(PDG, PTG, PALT, PFLT)