SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
diag_evap_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 diag_evap_isba_n (DGEI, DGI, I, PKDI, PKI, &
7  hphoto,ptstep,kmask,ksize,kpatch,prhoa)
8 ! ###############################################################################
9 !
10 !!**** *DIAG_EVAP-ISBA_n * - additional diagnostics for ISBA
11 !!
12 !! PURPOSE
13 !! -------
14 !
15 !!** METHOD
16 !! ------
17 !!
18 !! REFERENCE
19 !! ---------
20 !!
21 !!
22 !! AUTHOR
23 !! ------
24 !! P. LeMoigne
25 !!
26 !! MODIFICATIONS
27 !! -------------
28 !! Original 01/2004
29 !! 2008 New diag
30 !! B. Decharme 2012 New snow diag LESL
31 !! Add carbon fluxes diag
32 !! Add isba water budget diag
33 !! B. Decharme 04/2013 add Subsurface runoff if SGH (DIF option only)
34 !! add sublimation
35 !! P Samuelsson 04/2012 MEB
36 !!------------------------------------------------------------------
37 !
38 !
39 
40 !
41 !
42 !
43 !
45 USE modd_diag_isba_n, ONLY : diag_isba_t
46 USE modd_isba_n, ONLY : isba_t
48 USE modd_pack_isba, ONLY : pack_isba_t
49 !
50 USE yomhook ,ONLY : lhook, dr_hook
51 USE parkind1 ,ONLY : jprb
52 !
53 IMPLICIT NONE
54 !
55 !* 0.1 declarations of arguments
56 !
57 !
58 TYPE(diag_evap_isba_t), INTENT(INOUT) :: dgei
59 TYPE(diag_isba_t), INTENT(INOUT) :: dgi
60 TYPE(isba_t), INTENT(INOUT) :: i
61 TYPE(pack_diag_isba_t), INTENT(INOUT) :: pkdi
62 TYPE(pack_isba_t), INTENT(INOUT) :: pki
63 !
64  CHARACTER(LEN=*), INTENT(IN) :: hphoto ! type of photosynthesis
65 REAL, INTENT(IN) :: ptstep ! time step
66 INTEGER, INTENT(IN) :: ksize, kpatch
67 !
68 INTEGER, DIMENSION(:), INTENT(IN) :: kmask
69 REAL, DIMENSION(:), INTENT(IN) :: prhoa ! air density for unit change
70 !
71 INTEGER :: jj
72 REAL(KIND=JPRB) :: zhook_handle
73 !
74 !* 0.2 declarations of local variables
75 !
76 !-------------------------------------------------------------------------------------
77 !
78 IF (lhook) CALL dr_hook('DIAG_EVAP_ISBA_N',0,zhook_handle)
79 !
80 IF (dgei%LSURF_EVAP_BUDGET) THEN
81 !cdir nodep
82  DO jj=1,ksize
83  !
84  dgei%XLEG (kmask(jj), kpatch) = pkdi%XP_LEG (jj)
85  dgei%XLEGI (kmask(jj), kpatch) = pkdi%XP_LEGI (jj)
86  dgei%XLEV (kmask(jj), kpatch) = pkdi%XP_LEV (jj)
87  dgei%XLES (kmask(jj), kpatch) = pkdi%XP_LES (jj)
88  dgei%XLER (kmask(jj), kpatch) = pkdi%XP_LER (jj)
89  dgei%XLETR (kmask(jj), kpatch) = pkdi%XP_LETR (jj)
90  dgei%XEVAP (kmask(jj), kpatch) = pkdi%XP_EVAP (jj)
91  dgei%XSUBL (kmask(jj), kpatch) = pkdi%XP_SUBL (jj)
92  dgei%XDRAIN (kmask(jj), kpatch) = pkdi%XP_DRAIN (jj)
93  dgei%XQSB (kmask(jj), kpatch) = pkdi%XP_QSB (jj)
94  dgei%XRUNOFF (kmask(jj), kpatch) = pkdi%XP_RUNOFF (jj)
95  dgei%XHORT (kmask(jj), kpatch) = pkdi%XP_HORT (jj)
96  dgei%XDRIP (kmask(jj), kpatch) = pkdi%XP_DRIP (jj)
97  dgei%XRRVEG (kmask(jj), kpatch) = pkdi%XP_RRVEG (jj)
98  dgei%XMELT (kmask(jj), kpatch) = pkdi%XP_MELT (jj)
99  dgei%XIFLOOD (kmask(jj), kpatch) = pkdi%XP_IFLOOD (jj)
100  dgei%XPFLOOD (kmask(jj), kpatch) = pkdi%XP_PFLOOD (jj)
101  dgei%XLE_FLOOD (kmask(jj), kpatch) = pkdi%XP_LE_FLOOD (jj)
102  dgei%XLEI_FLOOD (kmask(jj), kpatch) = pkdi%XP_LEI_FLOOD (jj)
103  dgei%XIRRIG_FLUX(kmask(jj), kpatch) = pkdi%XP_IRRIG_FLUX (jj)
104  !
105  IF (i%LMEB_PATCH(kpatch)) THEN
106  dgei%XLEVCV (kmask(jj), kpatch) = pkdi%XP_LEVCV (jj)
107  dgei%XLESC (kmask(jj), kpatch) = pkdi%XP_LESC (jj)
108  dgei%XLETRCV (kmask(jj), kpatch) = pkdi%XP_LETRCV (jj)
109  dgei%XLELITTER (kmask(jj), kpatch) = pkdi%XP_LELITTER (jj)
110  dgei%XLELITTERI(kmask(jj), kpatch) = pkdi%XP_LELITTERI(jj)
111  dgei%XDRIPLIT (kmask(jj), kpatch) = pkdi%XP_DRIPLIT (jj)
112  dgei%XRRLIT (kmask(jj), kpatch) = pkdi%XP_RRLIT (jj)
113  dgei%XLERCV (kmask(jj), kpatch) = pkdi%XP_LERCV (jj)
114  dgei%XLE_C_A (kmask(jj), kpatch) = pkdi%XP_LE_C_A (jj)
115  dgei%XLE_V_C (kmask(jj), kpatch) = pkdi%XP_LE_V_C (jj)
116  dgei%XLE_G_C (kmask(jj), kpatch) = pkdi%XP_LE_G_C (jj)
117  dgei%XLE_N_C (kmask(jj), kpatch) = pkdi%XP_LE_N_C (jj)
118  !
119  dgei%XSWNET_V (kmask(jj), kpatch) = pkdi%XP_SWNET_V (jj)
120  dgei%XSWNET_G (kmask(jj), kpatch) = pkdi%XP_SWNET_G (jj)
121  dgei%XSWNET_N (kmask(jj), kpatch) = pkdi%XP_SWNET_N (jj)
122  dgei%XSWNET_NS (kmask(jj), kpatch) = pkdi%XP_SWNET_NS (jj)
123  dgei%XLWNET_V (kmask(jj), kpatch) = pkdi%XP_LWNET_V (jj)
124  dgei%XLWNET_G (kmask(jj), kpatch) = pkdi%XP_LWNET_G (jj)
125  dgei%XLWNET_N (kmask(jj), kpatch) = pkdi%XP_LWNET_N (jj)
126  dgei%XSWDOWN_GN (kmask(jj), kpatch) = pkdi%XP_SWDOWN_GN (jj)
127  dgei%XLWDOWN_GN (kmask(jj), kpatch) = pkdi%XP_LWDOWN_GN (jj)
128  dgei%XH_V_C (kmask(jj), kpatch) = pkdi%XP_H_V_C (jj)
129  dgei%XH_G_C (kmask(jj), kpatch) = pkdi%XP_H_G_C (jj)
130  dgei%XH_C_A (kmask(jj), kpatch) = pkdi%XP_H_C_A (jj)
131  dgei%XH_N_C (kmask(jj), kpatch) = pkdi%XP_H_N_C (jj)
132  dgei%XSR_GN (kmask(jj), kpatch) = pkdi%XP_SR_GN (jj)
133  dgei%XMELTCV (kmask(jj), kpatch) = pkdi%XP_MELTCV (jj)
134  dgei%XFRZCV (kmask(jj), kpatch) = pkdi%XP_FRZCV (jj)
135  ENDIF
136  !
137  END DO
138  !
139  IF (i%TSNOW%SCHEME=='3-L' .OR. i%TSNOW%SCHEME=='CRO') THEN
140 !cdir nodep
141  DO jj=1,ksize
142  dgei%XLESL (kmask(jj), kpatch) = pkdi%XP_LESL (jj)
143  dgei%XSNDRIFT (kmask(jj), kpatch) = pkdi%XP_SNDRIFT (jj)
144  END DO
145  END IF
146  !
147  IF(hphoto/='NON')THEN
148 !cdir nodep
149  DO jj=1,ksize
150  ! Transform units from kgCO2/kgair m/s to kgCO2/m2/s
151  dgei%XGPP (kmask(jj), kpatch) = pkdi%XP_GPP (jj) * prhoa(jj)
152  dgei%XRESP_AUTO (kmask(jj), kpatch) = pkdi%XP_RESP_AUTO (jj) * prhoa(jj)
153  dgei%XRESP_ECO (kmask(jj), kpatch) = pkdi%XP_RESP_ECO (jj) * prhoa(jj)
154  !
155  END DO
156  ELSE
157  dgei%XGPP (:,:)=0.0
158  dgei%XRESP_AUTO(:,:)=0.0
159  dgei%XRESP_ECO (:,:)=0.0
160  ENDIF
161  !
162  IF(dgei%LWATER_BUDGET)THEN
163 !cdir nodep
164  DO jj=1,ksize
165  dgei%XDWG (kmask(jj), kpatch) = pkdi%XP_DWG (jj)
166  dgei%XDWGI (kmask(jj), kpatch) = pkdi%XP_DWGI (jj)
167  dgei%XDWR (kmask(jj), kpatch) = pkdi%XP_DWR (jj)
168  dgei%XDSWE (kmask(jj), kpatch) = pkdi%XP_DSWE (jj)
169  dgei%XWATBUD(kmask(jj), kpatch) = pkdi%XP_WATBUD(jj)
170  END DO
171  ENDIF
172  !
173 END IF
174 !
175 IF (dgei%LSURF_BUDGETC) THEN
176 !cdir nodep
177  DO jj=1,ksize
178  !
179  dgei%XRNC (kmask(jj), kpatch) = dgei%XRNC (kmask(jj), kpatch) + pkdi%XP_RN (jj) * ptstep
180  dgei%XHC (kmask(jj), kpatch) = dgei%XHC (kmask(jj), kpatch) + pkdi%XP_H (jj) * ptstep
181  dgei%XLEC (kmask(jj), kpatch) = dgei%XLEC (kmask(jj), kpatch) + pki%XP_LE (jj) * ptstep
182  dgei%XLEIC (kmask(jj), kpatch) = dgei%XLEIC (kmask(jj), kpatch) + pkdi%XP_LEI (jj) * ptstep
183  dgei%XGFLUXC (kmask(jj), kpatch) = dgei%XGFLUXC (kmask(jj), kpatch) + pkdi%XP_GFLUX (jj) * ptstep
184  dgei%XLEGC (kmask(jj), kpatch) = dgei%XLEGC (kmask(jj), kpatch) + pkdi%XP_LEG (jj) * ptstep
185  dgei%XLEGIC (kmask(jj), kpatch) = dgei%XLEGIC (kmask(jj), kpatch) + pkdi%XP_LEGI (jj) * ptstep
186  dgei%XLEVC (kmask(jj), kpatch) = dgei%XLEVC (kmask(jj), kpatch) + pkdi%XP_LEV (jj) * ptstep
187  dgei%XLESAC (kmask(jj), kpatch) = dgei%XLESAC (kmask(jj), kpatch) + pkdi%XP_LES (jj) * ptstep
188  dgei%XLERC (kmask(jj), kpatch) = dgei%XLERC (kmask(jj), kpatch) + pkdi%XP_LER (jj) * ptstep
189  dgei%XLETRC (kmask(jj), kpatch) = dgei%XLETRC (kmask(jj), kpatch) + pkdi%XP_LETR (jj) * ptstep
190  dgei%XEVAPC (kmask(jj), kpatch) = dgei%XEVAPC (kmask(jj), kpatch) + pkdi%XP_EVAP (jj) * ptstep
191  dgei%XSUBLC (kmask(jj), kpatch) = dgei%XSUBLC (kmask(jj), kpatch) + pkdi%XP_SUBL (jj) * ptstep
192  dgei%XDRAINC (kmask(jj), kpatch) = dgei%XDRAINC (kmask(jj), kpatch) + pkdi%XP_DRAIN (jj) * ptstep
193  dgei%XQSBC (kmask(jj), kpatch) = dgei%XQSBC (kmask(jj), kpatch) + pkdi%XP_QSB (jj) * ptstep
194  dgei%XRUNOFFC (kmask(jj), kpatch) = dgei%XRUNOFFC (kmask(jj), kpatch) + pkdi%XP_RUNOFF (jj) * ptstep
195  dgei%XHORTC (kmask(jj), kpatch) = dgei%XHORTC (kmask(jj), kpatch) + pkdi%XP_HORT (jj) * ptstep
196  dgei%XDRIPC (kmask(jj), kpatch) = dgei%XDRIPC (kmask(jj), kpatch) + pkdi%XP_DRIP (jj) * ptstep
197  dgei%XRRVEGC (kmask(jj), kpatch) = dgei%XRRVEGC (kmask(jj), kpatch) + pkdi%XP_RRVEG (jj) * ptstep
198  dgei%XMELTC (kmask(jj), kpatch) = dgei%XMELTC (kmask(jj), kpatch) + pkdi%XP_MELT (jj) * ptstep
199  dgei%XIFLOODC (kmask(jj), kpatch) = dgei%XIFLOODC (kmask(jj), kpatch) + pkdi%XP_IFLOOD (jj) * ptstep
200  dgei%XPFLOODC (kmask(jj), kpatch) = dgei%XPFLOODC (kmask(jj), kpatch) + pkdi%XP_PFLOOD (jj) * ptstep
201  dgei%XLE_FLOODC (kmask(jj), kpatch) = dgei%XLE_FLOODC (kmask(jj), kpatch) + pkdi%XP_LE_FLOOD (jj) * ptstep
202  dgei%XLEI_FLOODC (kmask(jj), kpatch) = dgei%XLEI_FLOODC (kmask(jj), kpatch) + pkdi%XP_LEI_FLOOD (jj) * ptstep
203  dgei%XIRRIG_FLUXC(kmask(jj), kpatch) = dgei%XIRRIG_FLUXC(kmask(jj), kpatch) + pkdi%XP_IRRIG_FLUX(jj) * ptstep
204  !
205  IF (i%LMEB_PATCH(kpatch)) THEN
206  dgei%XLEVCVC (kmask(jj), kpatch) = dgei%XLEVCVC (kmask(jj), kpatch) + pkdi%XP_LEVCV (jj) * ptstep
207  dgei%XLESCC (kmask(jj), kpatch) = dgei%XLESCC (kmask(jj), kpatch) + pkdi%XP_LESC (jj) * ptstep
208 ! XLETRGVC (KMASK(JJ), KPATCH) = XLETRGVC (KMASK(JJ), KPATCH) + XP_LETRGV (JJ) * PTSTEP
209  dgei%XLETRCVC (kmask(jj), kpatch) = dgei%XLETRCVC (kmask(jj), kpatch) + pkdi%XP_LETRCV (jj) * ptstep
210 ! XLERGVC (KMASK(JJ), KPATCH) = XLERGVC (KMASK(JJ), KPATCH) + XP_LERGV (JJ) * PTSTEP
211  dgei%XLERCVC (kmask(jj), kpatch) = dgei%XLERCVC (kmask(jj), kpatch) + pkdi%XP_LERCV (jj) * ptstep
212  dgei%XLE_C_AC (kmask(jj), kpatch) = dgei%XLE_C_AC (kmask(jj), kpatch) + pkdi%XP_LE_C_A (jj) * ptstep
213  dgei%XLE_V_CC (kmask(jj), kpatch) = dgei%XLE_V_CC (kmask(jj), kpatch) + pkdi%XP_LE_V_C (jj) * ptstep
214  dgei%XLE_G_CC (kmask(jj), kpatch) = dgei%XLE_G_CC (kmask(jj), kpatch) + pkdi%XP_LE_G_C (jj) * ptstep
215  dgei%XLE_N_CC (kmask(jj), kpatch) = dgei%XLE_N_CC (kmask(jj), kpatch) + pkdi%XP_LE_N_C (jj) * ptstep
216  !
217  dgei%XSWNET_VC (kmask(jj), kpatch) = dgei%XSWNET_VC (kmask(jj), kpatch) + pkdi%XP_SWNET_V (jj) * ptstep
218  dgei%XSWNET_GC (kmask(jj), kpatch) = dgei%XSWNET_GC (kmask(jj), kpatch) + pkdi%XP_SWNET_G (jj) * ptstep
219  dgei%XSWNET_NC (kmask(jj), kpatch) = dgei%XSWNET_NC (kmask(jj), kpatch) + pkdi%XP_SWNET_N (jj) * ptstep
220  dgei%XSWNET_NSC (kmask(jj), kpatch) = dgei%XSWNET_NSC (kmask(jj), kpatch) + pkdi%XP_SWNET_NS (jj) * ptstep
221  dgei%XLWNET_VC (kmask(jj), kpatch) = dgei%XLWNET_VC (kmask(jj), kpatch) + pkdi%XP_LWNET_V (jj) * ptstep
222  dgei%XLWNET_GC (kmask(jj), kpatch) = dgei%XLWNET_GC (kmask(jj), kpatch) + pkdi%XP_LWNET_G (jj) * ptstep
223  dgei%XLWNET_NC (kmask(jj), kpatch) = dgei%XLWNET_NC (kmask(jj), kpatch) + pkdi%XP_LWNET_N (jj) * ptstep
224  dgei%XSWDOWN_GNC (kmask(jj), kpatch) = dgei%XSWDOWN_GNC (kmask(jj), kpatch) + pkdi%XP_SWDOWN_GN (jj) * ptstep
225  dgei%XLWDOWN_GNC (kmask(jj), kpatch) = dgei%XLWDOWN_GNC (kmask(jj), kpatch) + pkdi%XP_LWDOWN_GN (jj) * ptstep
226  dgei%XH_V_CC (kmask(jj), kpatch) = dgei%XH_V_CC (kmask(jj), kpatch) + pkdi%XP_H_V_C (jj) * ptstep
227  dgei%XH_G_CC (kmask(jj), kpatch) = dgei%XH_G_CC (kmask(jj), kpatch) + pkdi%XP_H_G_C (jj) * ptstep
228  dgei%XH_C_AC (kmask(jj), kpatch) = dgei%XH_C_AC (kmask(jj), kpatch) + pkdi%XP_H_C_A (jj) * ptstep
229  dgei%XH_N_CC (kmask(jj), kpatch) = dgei%XH_N_CC (kmask(jj), kpatch) + pkdi%XP_H_N_C (jj) * ptstep
230  dgei%XSR_GNC (kmask(jj), kpatch) = dgei%XSR_GNC (kmask(jj), kpatch) + pkdi%XP_SR_GN (jj) * ptstep
231  dgei%XMELTCVC (kmask(jj), kpatch) = dgei%XMELTCVC (kmask(jj), kpatch) + pkdi%XP_MELTCV (jj) * ptstep
232  dgei%XFRZCVC (kmask(jj), kpatch) = dgei%XFRZCVC (kmask(jj), kpatch) + pkdi%XP_FRZCV (jj) * ptstep
233  ENDIF
234  !
235  dgi%XSWDC(kmask(jj), kpatch) = dgi%XSWDC(kmask(jj), kpatch) + pkdi%XP_SWD(jj) * ptstep
236  dgi%XSWUC(kmask(jj), kpatch) = dgi%XSWUC(kmask(jj), kpatch) + pkdi%XP_SWU(jj) * ptstep
237  dgi%XLWDC(kmask(jj), kpatch) = dgi%XLWDC(kmask(jj), kpatch) + pkdi%XP_LWD(jj) * ptstep
238  dgi%XLWUC(kmask(jj), kpatch) = dgi%XLWUC(kmask(jj), kpatch) + pkdi%XP_LWU(jj) * ptstep
239  dgi%XFMUC(kmask(jj), kpatch) = dgi%XFMUC(kmask(jj), kpatch) + pkdi%XP_FMU(jj) * ptstep
240  dgi%XFMVC(kmask(jj), kpatch) = dgi%XFMVC(kmask(jj), kpatch) + pkdi%XP_FMV(jj) * ptstep
241  !
242  END DO
243  !
244  IF (i%TSNOW%SCHEME=='3-L' .OR. i%TSNOW%SCHEME=='CRO') THEN
245 !cdir nodep
246  DO jj=1,ksize
247  dgei%XLESLC (kmask(jj), kpatch) = dgei%XLESLC (kmask(jj), kpatch) + pkdi%XP_LESL (jj) * ptstep
248  dgei%XSNDRIFTC (kmask(jj), kpatch) = dgei%XSNDRIFTC (kmask(jj), kpatch) + pkdi%XP_SNDRIFT (jj) * ptstep
249  END DO
250  END IF
251  !
252  IF(hphoto/='NON')THEN
253 !cdir nodep
254  DO jj=1,ksize
255  !Transform units from kgCO2/kgair m/s to kgCO2/m2
256  dgei%XGPPC (kmask(jj), kpatch) = dgei%XGPPC (kmask(jj), kpatch)+ pkdi%XP_GPP (jj) * prhoa(jj) * ptstep
257  dgei%XRESPC_AUTO (kmask(jj), kpatch) = dgei%XRESPC_AUTO (kmask(jj), kpatch)+ pkdi%XP_RESP_AUTO (jj) * prhoa(jj) * ptstep
258  dgei%XRESPC_ECO (kmask(jj), kpatch) = dgei%XRESPC_ECO (kmask(jj), kpatch)+ pkdi%XP_RESP_ECO (jj) * prhoa(jj) * ptstep
259  END DO
260  ELSE
261  dgei%XGPPC (:,:)=0.0
262  dgei%XRESPC_AUTO(:,:)=0.0
263  dgei%XRESPC_ECO (:,:)=0.0
264  ENDIF
265  !
266  IF(i%LGLACIER)THEN
267 !cdir nodep
268  DO jj=1,ksize
269  dgei%XICEFLUXC(kmask(jj), kpatch) = dgei%XICEFLUXC(kmask(jj), kpatch) + pkdi%XP_ICEFLUX(jj) * ptstep
270  END DO
271  END IF
272  !
273  IF(dgei%LWATER_BUDGET)THEN
274 !cdir nodep
275  DO jj=1,ksize
276  dgei%XDWGC (kmask(jj), kpatch) = dgei%XDWGC (kmask(jj), kpatch) + pkdi%XP_DWG (jj) * ptstep
277  dgei%XDWGIC (kmask(jj), kpatch) = dgei%XDWGIC (kmask(jj), kpatch) + pkdi%XP_DWGI (jj) * ptstep
278  dgei%XDWRC (kmask(jj), kpatch) = dgei%XDWRC (kmask(jj), kpatch) + pkdi%XP_DWR (jj) * ptstep
279  dgei%XDSWEC (kmask(jj), kpatch) = dgei%XDSWEC (kmask(jj), kpatch) + pkdi%XP_DSWE (jj) * ptstep
280  dgei%XWATBUDC(kmask(jj), kpatch) = dgei%XWATBUDC(kmask(jj), kpatch) + pkdi%XP_WATBUD(jj) * ptstep
281  END DO
282  ENDIF
283  !
284 END IF
285 IF (lhook) CALL dr_hook('DIAG_EVAP_ISBA_N',1,zhook_handle)
286 !
287 !-------------------------------------------------------------------------------------
288 !
289 END SUBROUTINE diag_evap_isba_n
subroutine diag_evap_isba_n(DGEI, DGI, I, PKDI, PKI, HPHOTO, PTSTEP, KMASK, KSIZE, KPATCH, PRHOA)