SURFEX v8.1
General documentation of Surfex
diag_evap_cumul_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_cumul_isba_n (OSURF_BUDGETC, DE, DECK, DCK, DEK, DK, PEK, &
7  IO, PTSTEP, 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 !
41 USE modd_diag_n, ONLY : diag_t
42 USE modd_isba_n, ONLY : isba_pe_t
44 !
45 USE yomhook ,ONLY : lhook, dr_hook
46 USE parkind1 ,ONLY : jprb
47 !
48 IMPLICIT NONE
49 !
50 !* 0.1 declarations of arguments
51 !
52 !
53 LOGICAL, INTENT(IN) :: OSURF_BUDGETC
54 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DE
55 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DECK
56 TYPE(diag_t), INTENT(INOUT) :: DCK
57 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEK
58 TYPE(diag_t), INTENT(INOUT) :: DK
59 TYPE(isba_pe_t), INTENT(INOUT) :: PEK
60 TYPE(isba_options_t), INTENT(INOUT) :: IO
61 !
62 REAL, INTENT(IN) :: PTSTEP ! time step
63 INTEGER, INTENT(IN) :: KSIZE
64 INTEGER, INTENT(IN) :: KPATCH
65 !
66 REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density for unit change
67 !
68 INTEGER :: JJ
69 REAL(KIND=JPRB) :: ZHOOK_HANDLE
70 !
71 !* 0.2 declarations of local variables
72 !
73 !-------------------------------------------------------------------------------------
74 !
75 IF (lhook) CALL dr_hook('DIAG_EVAP_CUMUL_ISBA_N',0,zhook_handle)
76 !
77 IF (osurf_budgetc) THEN
78 !cdir nodep
79  DO jj=1,ksize
80  !
81  dck%XRN (jj) = dck%XRN (jj) + dk%XRN (jj) * ptstep
82  dck%XH (jj) = dck%XH (jj) + dk%XH (jj) * ptstep
83  dck%XLE (jj) = dck%XLE (jj) + pek%XLE (jj) * ptstep
84  dck%XLEI (jj) = dck%XLEI (jj) + dk%XLEI (jj) * ptstep
85  dck%XGFLUX(jj) = dck%XGFLUX(jj) + dk%XGFLUX (jj) * ptstep
86  !
87  deck%XLEG (jj) = deck%XLEG (jj) + dek%XLEG (jj) * ptstep
88  deck%XLEGI (jj) = deck%XLEGI (jj) + dek%XLEGI (jj) * ptstep
89  deck%XLEV (jj) = deck%XLEV (jj) + dek%XLEV (jj) * ptstep
90  deck%XLES (jj) = deck%XLES (jj) + dek%XLES (jj) * ptstep
91  deck%XLER (jj) = deck%XLER (jj) + dek%XLER (jj) * ptstep
92  deck%XLETR (jj) = deck%XLETR (jj) + dek%XLETR (jj) * ptstep
93  dck%XEVAP (jj) = dck%XEVAP (jj) + dk%XEVAP (jj) * ptstep
94  dck%XSUBL (jj) = dck%XSUBL (jj) + dk%XSUBL (jj) * ptstep
95  deck%XDRAIN (jj) = deck%XDRAIN (jj) + dek%XDRAIN (jj) * ptstep
96  deck%XQSB (jj) = deck%XQSB (jj) + dek%XQSB (jj) * ptstep
97  deck%XRUNOFF (jj) = deck%XRUNOFF (jj) + dek%XRUNOFF (jj) * ptstep
98  deck%XHORT (jj) = deck%XHORT (jj) + dek%XHORT (jj) * ptstep
99  deck%XDRIP (jj) = deck%XDRIP (jj) + dek%XDRIP (jj) * ptstep
100  deck%XRRVEG (jj) = deck%XRRVEG (jj) + dek%XRRVEG (jj) * ptstep
101  deck%XMELT (jj) = deck%XMELT (jj) + dek%XMELT (jj) * ptstep
102  deck%XIFLOOD (jj) = deck%XIFLOOD (jj) + dek%XIFLOOD (jj) * ptstep
103  deck%XPFLOOD (jj) = deck%XPFLOOD (jj) + dek%XPFLOOD (jj) * ptstep
104  deck%XLE_FLOOD(jj) = deck%XLE_FLOOD(jj) + dek%XLE_FLOOD (jj) * ptstep
105  deck%XLEI_FLOOD (jj) = deck%XLEI_FLOOD (jj) + dek%XLEI_FLOOD (jj) * ptstep
106  deck%XIRRIG_FLUX(jj) = deck%XIRRIG_FLUX(jj) + dek%XIRRIG_FLUX(jj) * ptstep
107  !
108  IF (io%LMEB_PATCH(kpatch)) THEN
109  deck%XLEV_CV (jj) = deck%XLEV_CV (jj) + dek%XLEV_CV (jj) * ptstep
110  deck%XLES_CV (jj) = deck%XLES_CV (jj) + dek%XLES_CV (jj) * ptstep
111  deck%XLETR_CV(jj) = deck%XLETR_CV (jj) + dek%XLETR_CV(jj) * ptstep
112  deck%XLER_CV (jj) = deck%XLER_CV (jj) + dek%XLER_CV (jj) * ptstep
113  deck%XLE_CV (jj) = deck%XLE_CV (jj) + dek%XLE_CV (jj) * ptstep
114  deck%XH_CV (jj) = deck%XH_CV (jj) + dek%XH_CV (jj) * ptstep
115  deck%XMELT_CV(jj) = deck%XMELT_CV(jj) + dek%XMELT_CV(jj) * ptstep
116  deck%XFRZ_CV (jj) = deck%XFRZ_CV (jj) + dek%XFRZ_CV (jj) * ptstep
117 
118  deck%XLE_GV (jj) = deck%XLE_GV (jj) + dek%XLE_GV (jj) * ptstep
119  deck%XH_GV (jj) = deck%XH_GV (jj) + dek%XH_GV (jj) * ptstep
120 
121  deck%XLE_GN (jj) = deck%XLE_GN (jj) + dek%XLE_GN (jj) * ptstep
122  deck%XH_GN (jj) = deck%XH_GN (jj) + dek%XH_GN (jj) * ptstep
123  deck%XSR_GN (jj) = deck%XSR_GN (jj) + dek%XSR_GN (jj) * ptstep
124  deck%XSWDOWN_GN(jj) = deck%XSWDOWN_GN(jj) + dek%XSWDOWN_GN(jj) * ptstep
125  deck%XLWDOWN_GN(jj) = deck%XLWDOWN_GN(jj) + dek%XLWDOWN_GN(jj) * ptstep
126 
127  deck%XLE_CA (jj) = deck%XLE_CA (jj) + dek%XLE_CA (jj) * ptstep
128  deck%XH_CA (jj) = deck%XH_CA (jj) + dek%XH_CA (jj) * ptstep
129  !
130  deck%XSWNET_V (jj) = deck%XSWNET_V (jj) + dek%XSWNET_V (jj) * ptstep
131  deck%XSWNET_G (jj) = deck%XSWNET_G (jj) + dek%XSWNET_G (jj) * ptstep
132  deck%XSWNET_N (jj) = deck%XSWNET_N (jj) + dek%XSWNET_N (jj) * ptstep
133  deck%XSWNET_NS (jj) = deck%XSWNET_NS (jj) + dek%XSWNET_NS (jj) * ptstep
134  deck%XLWNET_V (jj) = deck%XLWNET_V (jj) + dek%XLWNET_V (jj) * ptstep
135  deck%XLWNET_G (jj) = deck%XLWNET_G (jj) + dek%XLWNET_G (jj) * ptstep
136  deck%XLWNET_N (jj) = deck%XLWNET_N (jj) + dek%XLWNET_N (jj) * ptstep
137  ENDIF
138  !
139  dck%XSWD(jj) = dck%XSWD(jj) + dk%XSWD(jj) * ptstep
140  dck%XSWU(jj) = dck%XSWU(jj) + dk%XSWU(jj) * ptstep
141  dck%XLWD(jj) = dck%XLWD(jj) + dk%XLWD(jj) * ptstep
142  dck%XLWU(jj) = dck%XLWU(jj) + dk%XLWU(jj) * ptstep
143  dck%XFMU(jj) = dck%XFMU(jj) + dk%XFMU(jj) * ptstep
144  dck%XFMV(jj) = dck%XFMV(jj) + dk%XFMV(jj) * ptstep
145  !
146  END DO
147  !
148  IF (pek%TSNOW%SCHEME=='3-L' .OR. pek%TSNOW%SCHEME=='CRO') THEN
149 !cdir nodep
150  DO jj=1,ksize
151  deck%XLESL (jj) = deck%XLESL (jj) + dek%XLESL (jj) * ptstep
152  deck%XSNDRIFT (jj) = deck%XSNDRIFT (jj) + dek%XSNDRIFT (jj) * ptstep
153  END DO
154  END IF
155  !
156  IF(io%CPHOTO/='NON')THEN
157 !cdir nodep
158  DO jj=1,ksize
159  !Transform units from kgCO2/kgair m/s to kgCO2/m2
160  deck%XGPP (jj) = deck%XGPP(jj) + dek%XGPP(jj) * ptstep
161  deck%XRESP_AUTO(jj) = deck%XRESP_AUTO(jj) + dek%XRESP_AUTO(jj) * ptstep
162  deck%XRESP_ECO (jj) = deck%XRESP_ECO (jj) + dek%XRESP_ECO(jj) * ptstep
163  END DO
164  ELSE
165  deck%XGPP (:)=0.0
166  deck%XRESP_AUTO(:)=0.0
167  deck%XRESP_ECO (:)=0.0
168  ENDIF
169  !
170  IF(io%LGLACIER)THEN
171 !cdir nodep
172  DO jj=1,ksize
173  deck%XICEFLUX(jj) = deck%XICEFLUX(jj) + dek%XICEFLUX(jj) * ptstep
174  END DO
175  END IF
176  !
177  IF(de%LWATER_BUDGET)THEN
178 !cdir nodep
179  DO jj=1,ksize
180  deck%XDWG (jj) = deck%XDWG (jj) + dek%XDWG (jj) * ptstep
181  deck%XDWGI (jj) = deck%XDWGI (jj) + dek%XDWGI (jj) * ptstep
182  deck%XDWR (jj) = deck%XDWR (jj) + dek%XDWR (jj) * ptstep
183  deck%XDSWE (jj) = deck%XDSWE (jj) + dek%XDSWE (jj) * ptstep
184  deck%XWATBUD(jj) = deck%XWATBUD(jj) + dek%XWATBUD(jj) * ptstep
185  END DO
186  ENDIF
187  !
188 END IF
189 IF (lhook) CALL dr_hook('DIAG_EVAP_CUMUL_ISBA_N',1,zhook_handle)
190 !
191 !-------------------------------------------------------------------------------------
192 !
193 END SUBROUTINE diag_evap_cumul_isba_n
integer, parameter jprb
Definition: parkind1.F90:32
logical lhook
Definition: yomhook.F90:15
subroutine diag_evap_cumul_isba_n(OSURF_BUDGETC, DE, DECK, DCK, DEK, DK, PEK, IO, PTSTEP, KSIZE, KPATCH, PRHOA)