source: branches/publications/ORCHIDEE-Clateral/src_stomate/stomate_soilcarbon.f90 @ 7346

Last change on this file since 7346 was 7191, checked in by haicheng.zhang, 3 years ago

Implementing latral transfers of sediment and POC from land to ocean through river in ORCHILEAK

  • Property svn:keywords set to HeadURL Date Author Revision
File size: 92.1 KB
Line 
1
2! MODULE       : stomate_soilcarbon
3!
4! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
5!
6! LICENCE      : IPSL (2006)
7! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF       Calculate soil dynamics largely following the Century model
10!
11!!     
12!!\n DESCRIPTION: 11 layers discretization: Layers 1-11 are soil layers
13!!
14!! RECENT CHANGE(S): None
15!!
16!! SVN          :
17!! $HeadURL$
18!! $Date$
19!! $Revision$
20!! \n
21!_ ================================================================================================================================
22
23MODULE stomate_soilcarbon
24
25  ! modules used:
26  USE xios_orchidee
27  USE ioipsl_para
28  USE stomate_data
29  USE constantes
30  USE constantes_soil
31  USE pft_parameters
32  USE pft_parameters_var
33  USE vertical_soil
34  IMPLICIT NONE
35
36  ! private & public routines
37
38  PRIVATE
39  PUBLIC soilcarbon,soilcarbon_clear
40
41  ! Variables shared by all subroutines in this module
42 
43  LOGICAL, SAVE    :: firstcall = .TRUE.   !! Is this the first call? (true/false)
44!$OMP THREADPRIVATE(firstcall)
45
46CONTAINS
47
48
49!! ================================================================================================================================
50!!  SUBROUTINE   : soilcarbon_clear
51!!
52!>\BRIEF        Set the flag ::firstcall to .TRUE. and as such activate sections 1.1.2 and 1.2 of the subroutine soilcarbon
53!! (see below).
54!!
55!_ ================================================================================================================================
56 
57  SUBROUTINE soilcarbon_clear
58    firstcall=.TRUE.
59  ENDSUBROUTINE soilcarbon_clear
60
61
62!! ================================================================================================================================
63!!  SUBROUTINE   : soilcarbon
64!!
65!>\BRIEF        Computes the soil respiration and carbon stocks, essentially
66!! following Parton et al. (1987).
67!!
68!! DESCRIPTION  : The soil is divided into 3 carbon pools, with different
69!! characteristic turnover times : active (1-5 years), slow (20-40 years)
70!! and passive (200-1500 years).\n
71!! There are three types of carbon transferred in the soil:\n
72!! - carbon input in active and slow pools from litter decomposition,\n
73!! - carbon fluxes between the three pools,\n
74!! - carbon losses from the pools to the atmosphere, i.e., soil respiration.\n
75!!
76!! The subroutine performs the following tasks:\n
77!!
78!! Section 1.\n
79!! The flux fractions (f) between carbon pools are defined based on Parton et
80!! al. (1987). The fractions are constants, except for the flux fraction from
81!! the active pool to the slow pool, which depends on the clay content,\n
82!! \latexonly
83!! \input{soilcarbon_eq1.tex}
84!! \endlatexonly\n
85!! In addition, to each pool is assigned a constant turnover time.\n
86!!
87!! Section 2.\n
88!! The carbon input, calculated in the stomate_litter module, is added to the
89!! carbon stock of the different pools.\n
90!!
91!! Section 3.\n
92!! First, the outgoing carbon flux of each pool is calculated. It is
93!! proportional to the product of the carbon stock and the ratio between the
94!! iteration time step and the residence time:\n
95!! \latexonly
96!! \input{soilcarbon_eq2.tex}
97!! \endlatexonly
98!! ,\n
99!! Note that in the case of crops, the additional multiplicative factor
100!! integrates the faster decomposition due to tillage (following Gervois et
101!! al. (2008)).
102!! In addition, the flux from the active pool depends on the clay content:\n
103!! \latexonly
104!! \input{soilcarbon_eq3.tex}
105!! \endlatexonly
106!! ,\n
107!! Each pool is then cut from the carbon amount corresponding to each outgoing
108!! flux:\n
109!! \latexonly
110!! \input{soilcarbon_eq4.tex}
111!! \endlatexonly\n
112!! Second, the flux fractions lost to the atmosphere is calculated in each pool
113!! by subtracting from 1 the pool-to-pool flux fractions. The soil respiration
114!! is then the summed contribution of all the pools,\n
115!! \latexonly
116!! \input{soilcarbon_eq5.tex}
117!! \endlatexonly\n
118!! Finally, each carbon pool accumulates the contribution of the other pools:
119!! \latexonly
120!! \input{soilcarbon_eq6.tex}
121!! \endlatexonly
122!!
123!! RECENT CHANGE(S): None
124!!
125!! MAIN OUTPUTS VARIABLE(S): carbon, resp_hetero_soil
126!!
127!! REFERENCE(S)   :
128!! - Parton, W.J., D.S. Schimel, C.V. Cole, and D.S. Ojima. 1987. Analysis of
129!! factors controlling soil organic matter levels in Great Plains grasslands.
130!! Soil Sci. Soc. Am. J., 51, 1173-1179.
131!! - Gervois, S., P. Ciais, N. de Noblet-Ducoudre, N. Brisson, N. Vuichard,
132!! and N. Viovy (2008), Carbon and water balance of European croplands
133!! throughout the 20th century, Global Biogeochem. Cycles, 22, GB2022,
134!! doi:10.1029/2007GB003018.
135!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
136!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
137!!
138!! FLOWCHART    :
139!! \latexonly
140!! \includegraphics[scale=0.5]{soilcarbon_flowchart.jpg}
141!! \endlatexonly
142!! \n
143!_ ================================================================================================================================
144
145  SUBROUTINE soilcarbon (npts, dt, clay, &
146       soilcarbon_input, floodcarbon_input, control_temp_soil, control_moist_soil, &
147       carbon, &
148       resp_hetero_soil, resp_flood_soil, &
149       litter_above,litter_below,&
150       soilhum, DOC, moist_soil, DOC_EXP, &
151       lignin_struc_above, lignin_struc_below, &
152       floodout, runoff_per_soil, drainage_per_soil, wat_flux0, wat_flux,&
153       bulk_dens, soil_ph, poor_soils, veget_max, soil_mc, soiltile, &
154       Cinp_manure_liquid,DOC_to_topsoil, DOC_to_subsoil, flood_frac, &
155       precip2ground, precip2canopy, canopy2ground, &
156       dry_dep_canopy, DOC_precip2ground, DOC_precip2canopy, DOC_canopy2ground, &
157       DOC_infil, DOC_noinfil, interception_storage, biomass, fastr)
158
159!! 0. Variable and parameter declaration
160
161    !! 0.1 Input variables
162   
163    INTEGER(i_std), INTENT(in)                                        :: npts                  !! Domain size (unitless)
164    REAL(r_std), INTENT(in)                                           :: dt                    !! Time step \f$(dtradia one_day^{-1})$\f
165    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: clay                  !! Clay fraction (unitless, 0-1)
166    REAL(r_std), DIMENSION(npts), INTENT(inout)                       :: bulk_dens             !! Variable local of bulk density for the moment must change in the futur (kg m-3)
167
168    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: soil_ph               !! soil pH (pH unit, 0-14)
169    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: poor_soils            !! Fraction of poor soils (0-1)
170    REAL(r_std), DIMENSION(npts,nslmd,npool*2), INTENT(in)            :: control_temp_soil     !! Temperature control of heterotrophic respiration (unitless: 0->1)
171    REAL(r_std), DIMENSION(npts,nslmd,nvm), INTENT(in)                :: control_moist_soil    !! Moisture control of heterotrophic respiration (unitless: 0.25->1)
172
173    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(in)      :: litter_above          !! Metabolic and structural litter,above ground
174                                                                                               !! The unit is given by m^2 of ground
175                                                                                               !! @tex $(gC m^{-2})$ @endtex
176    REAL(r_std), DIMENSION(npts,nlitt,nvm,nslmd,nelements), INTENT(in)::litter_below           !! Metabolic and structural litter, below ground
177                                                                                               !! The unit is given by m^2 of
178                                                                                               !! ground @tex $(gC m^{-2}) $ @endtex
179    REAL(r_std), DIMENSION(npts,nslm), INTENT(in)                     :: soilhum               !! Daily soil humidity of each soil layer
180                                                                                               !! (unitless)
181    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                      :: lignin_struc_above    !! Ratio Lignin content in structural litter,
182                                                                                               !! above ground, (0-1, unitless)
183    REAL(r_std), DIMENSION(npts,nvm,nslmd), INTENT(in)                :: lignin_struc_below    !! Ratio Lignin content in structural litter,
184                                                                                               !! below ground, (0-1, unitless)
185    REAL(r_std),DIMENSION (npts), INTENT (in)                         :: floodout              !! flux out of floodplains
186    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: runoff_per_soil       !! Runoff per soil type [mm]
187    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: drainage_per_soil     !! Drainage per soil type [mm]
188    REAL(r_std),DIMENSION (npts,nstm), INTENT(in)                     :: wat_flux0             !! Water flux in the first soil layers exported for soil C calculations(mm)
189    REAL(r_std),DIMENSION (npts,nslm,nstm), INTENT(in)                :: wat_flux              !! Water flux in the soil layers exported for soil C calculations(mm)
190    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                        :: veget_max             !! PFT "Maximal" coverage fraction of a PFT
191                                                                                               !! defined in the input vegetation map
192                                                                                               !! @tex $(m^2 m^{-2})$ @endtex
193                                                                                               !! The unit is given by m^2 of
194                                                                                               !! water @tex $(gC m{-2} of water)$ @endtex
195    REAL(r_std),DIMENSION (npts,nslm,nstm), INTENT(in)                :: soil_mc               !! soil moisture content \f($m^3 \times m^3$)\f
196    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: soiltile              !! Fraction of each soil tile (0-1, unitless)
197
198    REAL(r_std),DIMENSION (npts,nflow), INTENT(in)                    :: DOC_to_topsoil        !! DOC inputs to top of the soil column, from reinfiltration on
199                                                                                               !! floodplains and from irrigation
200                                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
201    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                      :: precip2ground         !! Precipitation not intercepted by vegetation
202                                                                                               !! @tex $(mm.dt^{-1})$ @endtex
203    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                      :: precip2canopy         !! Precipitation intercepted by vegetation
204                                                                                               !! @tex $(mm.dt^{-1})$ @endtex
205    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                      :: canopy2ground         !! Water flux from canopy to ground
206                                                                                               !! @tex $(mm.dt^{-1})$ @endtex
207    REAL(r_std),DIMENSION (npts,nflow), INTENT(in)                    :: DOC_to_subsoil        !! DOC inputs to bottom of the soil column, from returnflow
208                                                                                               !! in swamps and lakes
209                                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
210    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: flood_frac            !! Flooded fraction of grid box
211                                                                                               !! @tex $(-)$ @endtex
212    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: fastr                 !! Fast reservoir (mm)
213        REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                        :: Cinp_manure_liquid    !! Liquid manure-C input (DOC, gC.m^{-2} dt{-1})
214                                                                                                                                                                                           !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex
215
216    !! 0.2 Output variables
217   
218    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                     :: resp_hetero_soil      !! Soil heterotrophic respiration \f$(gC m^{-2} (dtradia one_day^{-1})^{-1})$\f
219    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                     :: resp_flood_soil       !! Soil heterotrophic respiration when flooded
220                                                                                               !! \f$(gC m^{-2} (dtradia one_\day^{-1})^{-1})$\f
221    REAL(r_std), DIMENSION(npts,nvm,nexp,npool,nelements), INTENT(out):: DOC_EXP               !! Exported DOC through runoff, drainage, flood,
222                                                                                               !! The unit is given by m^2 of
223                                                                                               !! ground \f$(gC m^{-2} day^{-1})$\f
224    REAL(r_std), DIMENSION(npts,nslm), INTENT(out)                    :: moist_soil            !! moisture in soil for one pixel (m3/m3)
225    !! TF-DOC, maybe put all togetehr into one matrix, note that all Throughfall related fluxes are expressed relative to the total area of the pixel
226    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out):: dry_dep_canopy        !! Increase in canopy storage of soluble OC & DOC
227                                                                                    !! @tex $(gC.m^{-2})$ @endtex
228    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out):: DOC_precip2canopy     !! Wet deposition of DOC onto canopy
229                                                                                    !! @tex $(gC.m^{-2})$ @endtex
230    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out):: DOC_precip2ground     !! Wet deposition of DOC not intecepted by canopy
231                                                                                    !! @tex $(gC.m^{-2})$ @endtex
232    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out):: DOC_canopy2ground     !! Wet deposition of DOC not intecepted by canopy
233                                                                                    !! @tex $(gC.m^{-2})$ @endtex
234    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out):: DOC_infil             !! Wet deposition of DOC infiltrating into the ground
235                                                                                    !! @tex $(gC.m^{-2})$ @endtex
236    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out):: DOC_noinfil           !! Wet deposition of DOC going into surface runoff
237                                                                                    !! @tex $(gC.m^{-2})$ @endtex 
238    !! 0.3 Modified variables
239
240    REAL(r_std), DIMENSION(npts,nvm,nslmd,npool,nelements), INTENT(inout) :: soilcarbon_input   !! Amount of carbon going into the carbon pools
241                                                                                               !! from litter decomposition \f$(gC m^{-2} day^{-1})$\f
242    REAL(r_std), DIMENSION(npts,nvm,npool,nelements), INTENT(inout)    :: floodcarbon_input    !! Amount of carbon going directly into the water column
243                                                                                          !! from litter decomposition \f$(gC m^{-2} day^{-1})$\f   
244    REAL(r_std), DIMENSION(npts,ncarb,nvm,nslmd), INTENT(inout)                :: carbon   !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
245    REAL(r_std), DIMENSION(npts,nvm,nslmd,ndoc,npool,nelements), INTENT(inout) :: DOC      !! Dissolved Organic Carbon in soil
246                                                                                          !! The unit is given by m^2 of
247                                                                                          !! ground @tex $(gC m{-2} of ground)$ @endtex
248    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass           !! Biomass @tex $(gC m^{-2})$ @endtex
249    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(inout):: interception_storage      !! Storage of DOC and solube OC in canopy
250                                                                                          !! @tex $(gC.m^{-2})$ @endtex 
251    !! 0.4 Local variables
252    REAL(r_std), SAVE, DIMENSION(ncarb)                           :: carbon_tau       !! Residence time in carbon pools (years)
253!$OMP THREADPRIVATE(carbon_tau)
254    REAL(r_std), DIMENSION(npts,ncarb,ncarb)                      :: frac_carb        !! Flux fractions between carbon pools
255                                                                                      !! (second index=origin, third index=destination)
256                                                                                      !! (unitless, 0-1)
257    REAL(r_std), DIMENSION(npts,ncarb,nelements,nslmd)           :: fluxtot          !! Total flux out of carbon pools \f$(gC m^{2})$\f
258    REAL(r_std), DIMENSION(npts,nvm,nslmd,npool)                 :: fluxtot_DOC      !! Total flux out of dissolved organic carbon pools \f$(gC m^{2}ground)$\f
259    REAL(r_std), DIMENSION(npts,ncarb,nelements,nslmd)           :: fluxtot_flood    !! Total flux out of carbon pools \f$(gC m^{2})$\f
260    REAL(r_std), DIMENSION(npts,nvm,nslmd,npool)                 :: fluxtot_DOC_flood!! Total flux out of dissolved organic carbon pools \f$(gC m^{2}ground\)$\f
261    REAL(r_std), DIMENSION(npts,ncarb,nelements,nslmd)           :: flux2DOC         !! flux SOC to DOC
262    REAL(r_std), DIMENSION(npts,ncarb,nelements,nslmd)           :: flux2DOC_flood   !! flux SOC to DOC
263!! Add things for extrapolating passive SOC
264    REAL(r_std), DIMENSION(npts,nvm,nslmd)                       :: pass_out         !! Total flux out of passive carbon pools \f$(gC m^{2})$\f
265    REAL(r_std), DIMENSION(npts,nvm,nslmd)                       :: pass_in          !! Total flux into passive carbon pools \f$(gC m^{2}ground)$\f
266    CHARACTER(LEN=30)                                             :: var_name         !! To store variables with xios
267    CHARACTER(LEN=2)                                              :: part_str         !! To store variables with xios
268!!!!
269    REAL(r_std), DIMENSION(npts,npool,ncarb,nelements,nslmd)     :: flux             !! Fluxes between carbon pools \f$(gC m^{2})$\f
270    CHARACTER(LEN=7), DIMENSION(ncarb)                            :: carbon_str       !! Name of the carbon pools for informative outputs (unitless)
271    REAL(r_std), SAVE, DIMENSION(ncarb)                           :: priming_param    !! parmater controlling the sensitvity of priming effect on  each pools to the amount of LOM
272!$OMP THREADPRIVATE(priming_param)
273    REAL(r_std), SAVE, DIMENSION(npool)                           :: DOC_tau          !! Residence time of DOC (days)
274!$OMP THREADPRIVATE(DOC_tau)
275    REAL(r_std), DIMENSION(npts,nvm,nslmd)                       :: litter_tot       !! total litter (gC/m**2 of ground)
276    REAL(r_std), DIMENSION(npts,nvm,nslmd)                       :: LOM              !! total labile organic matter that could induce the decompostion rate
277                                                                                      !! (gC/m**2 of ground)
278    INTEGER(i_std)                                                :: k,kk,m,j,l,i,ig,kkk !! Indices (unitless)
279    REAL(r_std),DIMENSION(0:nslm)                                 :: z_soil           !! Soil levels (m)
280    REAL(r_std), DIMENSION(npts,nvm, nslmd,npool,nelements)      :: DOC_RE           !! Adsoprtion Desorption flux of DOC (mmol C/kg)
281    REAL(r_std), DIMENSION(npts,nvm, nslm,npool,nelements)        :: DOC_FLUX         !! DOC flux between layers in f$(gC m^{-2} day^{-1})$\f
282    REAL(r_std), DIMENSION(npts,nvm, nslm,npool,nelements)        :: DOC_FLUX_DIFF    !! DOC flux by diffusion between layers in f$(gC m^{-2} day^{-1})$\f
283    REAL(r_std), DIMENSION(npts,nvm, nslm,npool,nelements)        :: DOC_FLUX_DIFF_old !! DOC flux by diffusion between layers in f$(gC m^{-2} day^{-1})$\f for storage
284    REAL(r_std), DIMENSION(npts,nvm,npool,nelements)              :: DOC_RUN          !! DOC lost with runoff in f$(gC m^{-2} day^{-1})$\f
285    REAL(r_std), DIMENSION(npts,nvm,npool,nelements)              :: DOC_FLOOD        !! DOC lost with flooding in f$(gC m^{-2} day^{-1})$\f
286    REAL(r_std), DIMENSION(npts,nvm,npool,nelements)              :: DOC_DRAIN        !! DOC lost with drainage in f$(gC m^{-2} day^{-1})$\f
287    REAL(r_std), DIMENSION(npts,nvm,nslmd,ndoc,npool,nelements)    :: DOC_old          !! Dissolved Organic Carbon in soil
288                                                                                      !! The unit is given by m^2 of
289                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
290    REAL(r_std), DIMENSION(npts,nvm,nslmd,ndoc,npool,nelements)    :: DOC_old2         !! Dissolved Organic Carbon in soil
291                                                                                      !! The unit is given by m^2 of
292                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
293    REAL(r_std), DIMENSION(npts,nvm,nslmd,ndoc,npool,nelements)    :: DOC_old_buffer   !! Dissolved Organic Carbon in soil
294                                                                                      !! The unit is given by m^2 of
295                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
296
297    REAL(r_std), DIMENSION(npts,ncarb,nvm,nslmd)                   :: carbon_old       !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f used for storage
298    REAL(r_std), DIMENSION(npts,ncarb,nvm,nslmd)                   :: carbon_old_buffer!! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f used for storage
299    REAL(r_std), DIMENSION(npts)                                  :: Qmax             !! Maximum adsorption capacity for DOC in the Langmuir equation (mg kg¿1)
300    REAL(r_std), DIMENSION(npts,nslm)                             :: Kd               !! distribution coefficient between DOC adsorbed and DOC free (unitless [0-1])
301    REAL(r_std), DIMENSION(npts,nslm)                             :: b                !! desorption term of the Initial Mass (IM) isotherm (mmol C/kg)
302    REAL(r_std), DIMENSION(npts,nslm)                             :: IM               !! sorption affinity of the Initial Mass (IM) isotherm (unitless)
303
304    REAL(r_std), DIMENSION(npts)                                  :: Dif_coef         !! Diffusion coeficient used for bioturbation (m2 dt-1)
305
306    REAL(r_std), DIMENSION(npts)                                  :: Dif_DOC          !! Diffusion coeficient used for DOC diffusion (m2 dt-1)
307
308    REAL(r_std), DIMENSION(npts)                                  :: CUE_coef         !! Partition coefficient for DOC decomposed between CO2 and POC (unitless, 0-1)
309                                                                                   
310    REAL(r_std), DIMENSION(npts,ncarb,nvm,nslm)                   :: carbon_flux      !! Soil carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
311    REAL(r_std), DIMENSION(npts,ncarb,nvm,nslm)                   :: carbon_flux_old  !! Soil carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
312                                                                                      !! used for storage
313    REAL(r_std), DIMENSION(npts,nstm)                             :: soilwater_31mm   !! Soil water content of the first x layers (m)
314    REAL(r_std), DIMENSION(npts)                                  :: soilDOC_31mm     !! Soil DOC content of the first x layers (m)
315    REAL(r_std), DIMENSION(npts)                                  :: soilDOC_corr     !! Soil DOC content of the first x layers (m)
316    REAL(r_std), DIMENSION(npts)                                  :: flux_red         !! Flux reduction in upper meter of the soil
317    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)            :: check_intern     !! Contains the components of the internal
318                                                                                      !! mass balance chech for this routine
319                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
320    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: closure_intern   !! Check closure of internal mass balance
321
322    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_start       !! Start and end pool of this routine
323                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
324    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_end         !! Start and end pool of this routine
325                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
326    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_end_after   !! Start and end pool of this routine after mass balance correction
327                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
328    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: wet_dep_ground    !! total wet deposition of DOC onto the ground
329    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: wet_dep_flood     !! total wet deposition of DOC onto the flooded
330    REAL(r_std), DIMENSION(npts)                                  :: bio_frac          !! total wet deposition of DOC onto the flooded
331    REAL(r_std), DIMENSION(npts)                                  :: fastr_corr        !! correction factor based on fast reservoir
332    REAL(r_std)                                                   :: lat_exp           !! factor used to disable soil-water export of DOC
333!_ ================================================================================================================================
334
335    !! bavard is the level of diagnostic information, 0 (none) to 4 (full)
336    IF (printlev>=3) WRITE(numout,*) 'Entering soilcarbon' 
337
338!! 1. Initializations
339!    clay(:) = 1.E-06
340    !! 1.0 Calculation of soil moisture
341    IF (lat_exp_doc) THEN
342       lat_exp = un
343    ELSE
344       lat_exp = zero
345    ENDIF
346
347    moist_soil(:,:) = zero
348      DO l = 1,nslm
349          DO i = 1, nstm
350             moist_soil(:,l)= moist_soil(:,l) + soil_mc(:,l,i)*soiltile(:,i)
351          ENDDO
352      ENDDO
353      !! 1.1 soil levels
354       z_soil(0) = zero
355       z_soil(1:nslm) = zlt(1:nslm)
356   !    WRITE(numout,*) "ACHTUNG! zsoil(0,11):", z_soil
357       !! DOC flux reduction factor, effects of poor soils
358       flux_red(:) = flux_red_sro * (un - poor_soils(:)) + poor_soils(:)
359
360       !! 1.2 TF-DOC: Initialize wet and dry deposition of DOC
361       DOC_precip2canopy(:,:,icarbon) = zero
362       DOC_precip2ground(:,:,icarbon) = zero
363       dry_dep_canopy(:,:,icarbon) = zero
364       bio_frac(:)=SUM(veget_max(:,2:13),DIM=2)
365
366       IF (ok_TF_DOC) THEN   
367          !! Calculate the DOC depoited onto the ground
368          !! TF Calculate thoughfall DOC
369
370          !! TF.1 Flux of DOC with precipitation onto the ground and onto the canopy (interception storage)
371          DOC_precip2canopy(:,2:13,icarbon) = precip2canopy(:,2:13) * conc_DOC_rain * 1e-3
372          DOC_precip2ground(:,2:13,icarbon) = precip2ground(:,2:13) * conc_DOC_rain * 1e-3
373          !! TF.2 Daily contirubitoon of dry deposition and exsuadtes and feces
374
375          DO j = 2,9! Loop over PFTs composed of trees
376             DO i = 1, npts! Loop over # of pixels
377                IF (veget_max(i,j) .GT. 0) THEN
378                   dry_dep_canopy(i,j,icarbon) = DOC_incr_per_LEAF_M2 * dt * biomass(i,j,ileaf,icarbon) * veget_max(i,j)
379                   !! So far, this is only the parametrisation for PFT=2
380                   !! sa the rate is per day, we have to multiply by dt
381                ELSE
382                   dry_dep_canopy(i,j,icarbon) = zero
383                ENDIF
384             ENDDO ! Loop over # of pixels
385          ENDDO ! # End Loop over # of PFTs
386       ENDIF !(ok_TF_DOC)
387
388    !! 1.4 Initialize check for mass balance closure
389    !  The mass balance is calculated at the end of this routine
390    !  in section 14. Initial biomass and harvest pool and all other
391    !  relevant pools were set to zero before calling this routine.
392    pool_start(:,:,:) = zero
393    IF (ld_doc) THEN
394       !Starting carbon pool
395       DO m = 1, nvm
396          DO i = 1,ncarb
397             DO l = 1, nslmd
398                pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
399                     ( carbon(:,i,m,l) ) * veget_max(:,m)
400             ENDDO
401          ENDDO
402          pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + interception_storage(:,m,icarbon)
403       ENDDO
404
405       !Starting DOC pool
406       DO m = 1, nvm
407          DO i = 1,npool
408             DO l = 1, nslmd
409                DO j = 1, ndoc
410                   pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
411                        ( DOC(:,m,l,j,i,icarbon)) * veget_max(:,m)
412                ENDDO
413             ENDDO
414          ENDDO
415       ENDDO
416
417
418       !Starting litter below pool
419       DO m = 1,nvm
420          DO l = 1, nslmd
421             pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
422                  (soilcarbon_input(:,m,l,imetbel,icarbon)+soilcarbon_input(:,m,l,istrbel,icarbon)+ &
423                  soilcarbon_input(:,m,l,imetabo,icarbon)+soilcarbon_input(:,m,l,istrabo,icarbon)) * &
424                  veget_max(:,m) * dt
425          ENDDO
426       ENDDO
427
428       !Starting litter above pool
429       DO m = 1,nvm
430          WHERE (veget_max(:,m) .GT. zero)
431             pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
432                  (DOC_to_topsoil(:,idocl) + DOC_to_subsoil(:,idocl) + DOC_to_topsoil(:,idocr) + DOC_to_subsoil(:,idocr) + &
433                  floodcarbon_input(:,m,iact,icarbon) + floodcarbon_input(:,m,islo,icarbon))*dt*veget_max(:,m) + &
434                  DOC_precip2canopy(:,m,icarbon) + DOC_precip2ground(:,m,icarbon) + dry_dep_canopy(:,m,icarbon)
435          ELSEWHERE
436             pool_start(:,m,icarbon) = pool_start(:,m,icarbon) 
437          ENDWHERE
438       ENDDO
439    ENDIF
440
441    !! 1.2 Get soil "constants"
442    !! 1.2.1 Flux fractions between carbon pools: depend on clay content, recalculated each time
443    ! From active pool: depends on clay content
444    frac_carb(:,iactive,iactive) = zero
445    frac_carb(:,iactive,ipassive) = frac_carb_ap /(un - metabolic_ref_frac + active_to_pass_clay_frac*clay(:))
446    frac_carb(:,iactive,islow) = un - frac_carb(:,iactive,ipassive) 
447    ! 1.2.1.2 from slow pool
448    frac_carb(:,islow,islow) = zero
449    frac_carb(:,islow,iactive) = frac_carb_sa
450    frac_carb(:,islow,ipassive) = un - frac_carb(:,islow,iactive) 
451    ! From passive pool
452    frac_carb(:,ipassive,ipassive) = zero
453    frac_carb(:,ipassive,iactive) = frac_carb_pa
454    frac_carb(:,ipassive,islow) = un - frac_carb(:,ipassive,iactive)
455
456    ! 1.2.1.3 Initialization
457    carbon_flux(:,:,:,:) =  zero
458    carbon_flux_old(:,:,:,:) =  zero
459    IF ( firstcall ) THEN
460
461        !! 1.2.2 Residence times in carbon pools (in year converted in days)
462        carbon_tau(iactive) = carbon_tau_iactive * one_year      !residence times when SOM decomposition is function of litter coming from from optimization with the theoretical model SOM-FOM-DEP
463        carbon_tau(islow) = carbon_tau_islow * one_year          ! See Guenet et al., (In prep)
464        carbon_tau(ipassive) = carbon_tau_ipassive * one_year   
465
466        priming_param(iactive)=priming_param_iactive  !Priming parameter for mineralization obtained from optimization of SOM-FOM-DEP see Guenet et al., (In prep)
467        priming_param(islow)=priming_param_islow
468        priming_param(ipassive)=priming_param_ipassive
469
470        ! The values of DOC_tau are coming from Kalbitz et al 2003 Geoderma
471        ! (already in days)
472        DOC_tau(imetabo) = DOC_tau_labile
473        DOC_tau(istrabo) = DOC_tau_labile 
474        DOC_tau(imetbel) = DOC_tau_labile 
475        DOC_tau(istrbel) = DOC_tau_labile 
476        DOC_tau(iact) = DOC_tau_labile 
477        DOC_tau(islo) = DOC_tau_stable 
478        DOC_tau(ipas) = DOC_tau_stable 
479
480       !! 1.3 soil levels
481        !! 1.4 Messages : display the residence times 
482        carbon_str(iactive) = 'active'
483        carbon_str(islow) = 'slow'
484        carbon_str(ipassive) = 'passive'
485       
486        WRITE(numout,*) 'soilcarbon:'
487       
488        WRITE(numout,*) '   > minimal carbon residence time in carbon pools (d):'
489        DO k = 1, ncarb ! Loop over carbon pools
490          WRITE(numout,*) '(1, ::carbon_str(k)):',carbon_str(k),' : (1, ::carbon_tau(k)):',carbon_tau(k)
491        ENDDO
492       
493        WRITE(numout,*) '   > flux fractions between carbon pools: depend on clay content'
494        firstcall = .FALSE.
495       
496    ENDIF
497
498    !! 1.5 Initialization
499    !! 1.5.1 Initialization of parameters
500        Dif_coef(:) = (Dif/one_year)*dt
501        Dif_DOC(:)=D_DOC*dt        !We divided by one_year 
502                                   !because the unit of the Dif
503                                   !parameter is m2 yr-1 and the time stept of the model
504                                   !is dt (1/48, by default, i.e. the fraction
505                                   !of 30 min expressed in days)
506        CUE_coef(:)=CUE
507
508    !! 1.5.2 Set soil respiration and DOC fluxes to zero
509    resp_hetero_soil(:,:) = zero
510    resp_flood_soil(:,:) = zero
511    DOC_EXP(:,:,:,:,:) = zero
512    DOC_RE(:,:,:,:,:) = zero
513    DOC_FLUX(:,:,:,:,:) = zero
514    DOC_FLUX_DIFF(:,:,:,:,:) = zero
515    DOC_FLUX_DIFF_old(:,:,:,:,:) = zero
516    DOC_RUN(:,:,:,:)= zero
517    DOC_FLOOD(:,:,:,:)= zero
518    DOC_DRAIN(:,:,:,:)= zero
519    fluxtot(:,:,:,:)= zero
520    flux2DOC(:,:,:,:)= zero
521    fluxtot_DOC(:,:,:,:) = zero
522    fluxtot_flood(:,:,:,:) = zero
523    flux2DOC_flood(:,:,:,:) = zero
524    fluxtot_DOC_flood(:,:,:,:) = zero
525    litter_tot(:,:,:) = zero
526    DOC_canopy2ground(:,:,:) = zero
527    wet_dep_flood(:,:,:) = zero
528    wet_dep_ground(:,:,:) = zero
529    LOM(:,:,:)= zero
530
531    pass_in(:,:,:) = zero
532    pass_out(:,:,:) = zero
533
534    ! bulk_density must be in kg m-3 and is generally given in g cm-3
535    WHERE (bulk_dens(:) .LT. 500)
536    bulk_dens(:) = bulk_dens(:)*1e3
537    ENDWHERE
538 
539    !!1.6 Calculating water content of the first 5 layers
540    soilwater_31mm(:,:)= zero
541    soilwater_31mm(:,:)= soilwater_31mm(:,:) + (z_soil(1) * soil_mc(:,1,:))   
542     IF (sro_bottom .GT. 1) THEN
543      DO l=2, sro_bottom
544         soilwater_31mm(:,:)= soilwater_31mm(:,:) + ((z_soil(l)-z_soil(l-1)) * soil_mc(:,l,:))
545      ENDDO
546    ENDIF
547
548    !! 2. Fluxes between carbon reservoirs, and to the atmosphere (respiration) \n
549    !! 2.1 calculation of TF fluxes
550    !! Calculation of TF-Fluxes
551
552       !! TF.3 Calculate the flow to the ground
553
554       !! Calculate max possible DOC flux, assuming a maximum concentration
555       DO j = 2,nvm! Loop over # of PFTs
556          DO i = 1, npts! Loop over # of pixels
557             IF (veget_max(i,j) > zero) THEN
558                DOC_canopy2ground(i,j,icarbon) = min(canopy2ground(i,j)*conc_DOC_max * 1e-3, &
559                     &                                              interception_storage(i,j,icarbon))
560             ELSE
561                DOC_canopy2ground(i,j,icarbon) = zero
562             ENDIF
563          ENDDO ! Loop over # of pixels
564       ENDDO ! # End Loop over # of PFTs
565
566       DO j = 1,nvm! Loop over # of PFTs
567          wet_dep_flood(:,j,icarbon)  = (DOC_precip2ground(:,j,icarbon) + DOC_canopy2ground(:,j,icarbon)) * flood_frac(:)
568          wet_dep_ground(:,j,icarbon) = (DOC_precip2ground(:,j,icarbon) + DOC_canopy2ground(:,j,icarbon)) * (un-flood_frac(:))
569       ENDDO
570
571       IF (.NOT. lat_exp_doc) THEN
572          wet_dep_ground = wet_dep_ground + wet_dep_flood
573          wet_dep_flood = zero
574       ELSE
575          !Do nothing
576       ENDIF
577
578       !! TF.4 Update the canopy storage of soluble OC and DOC
579
580       DO j = 2,nvm! Loop over # of PFTs
581          DO i = 1, npts! Loop over # of pixels
582             IF (veget_max(i,j) > zero) THEN
583                interception_storage(i,j,icarbon) = interception_storage(i,j,icarbon) + dry_dep_canopy(i,j,icarbon) + &
584                     &                          DOC_precip2canopy(i,j,icarbon) - DOC_canopy2ground(i,j,icarbon)
585             ELSE
586                interception_storage(i,j,icarbon) = zero
587             ENDIF
588          ENDDO ! Loop over # of pixels
589       ENDDO ! # End Loop over # of PFTs
590
591       !! TF.5 Calculate the fraction that is infiltrating into the soil
592       DOC_infil = zero
593       DOC_noinfil = zero
594
595    !! 2.2 Input from litter to DOC and from reinflitration in floodplains
596    !! For the variables DOC_to_topsoil and DOC_to_subsoil we multiplied by
597    !veget_max because it is not defined per PFT and therefore we redistribute
598    !it following veget_max. Moreover we assume the all the DOC coming from
599    !floodplains reinfiltration is going to DOC coming from the active pool.
600        !WRITE(numout,*) 'STOMATECarb_ZHC1'
601        !WRITE(numout,*) 'C',MAXVAL(DOC),MAXVAL(carbon),MAXVAL(soilcarbon_input)
602        !WRITE(numout,*) 'RH',MAXVAL(resp_hetero_soil),MAXVAL(resp_flood_soil)
603        !WRITE(numout,*) 'f_temswc',MAXVAL(control_moist_soil),MAXVAL(control_temp_soil)
604        !WRITE(numout,*) 'lignin', MAXVAL(lignin_struc_above),MAXVAL(lignin_struc_below)
605       
606    DO m = 2, nvm
607       DO l = 1,nslmd
608
609          DOC(:,m,l,ifree,imetabo,icarbon) = DOC(:,m,l,ifree,imetabo,icarbon) + soilcarbon_input(:,m,l,imetabo,icarbon)*dt*f_litDOC/CUE 
610          DOC(:,m,l,ifree,istrabo,icarbon) = DOC(:,m,l,ifree,istrabo,icarbon) + soilcarbon_input(:,m,l,istrabo,icarbon)*dt*f_litDOC/CUE
611          DOC(:,m,l,ifree,imetbel,icarbon) = DOC(:,m,l,ifree,imetbel,icarbon) + soilcarbon_input(:,m,l,imetbel,icarbon)*dt*f_litDOC/CUE
612          DOC(:,m,l,ifree,istrbel,icarbon) = DOC(:,m,l,ifree,istrbel,icarbon) + soilcarbon_input(:,m,l,istrbel,icarbon)*dt*f_litDOC/CUE
613          carbon(:,iactive,m,l) = carbon(:,iactive,m,l) + &
614               & (soilcarbon_input(:,m,l,imetabo,icarbon) + &
615               &  soilcarbon_input(:,m,l,imetbel,icarbon) + &
616               &  soilcarbon_input(:,m,l,istrabo,icarbon) * (un - lignin_struc_above(:,m)) +  &
617               &  soilcarbon_input(:,m,l,istrbel,icarbon) * (un - lignin_struc_below(:,m,l)))*dt*(un-f_litDOC/CUE)
618          carbon(:,islow,m,l) = carbon(:,islow,m,l) + &
619               &  (soilcarbon_input(:,m,l,istrabo,icarbon) * lignin_struc_above(:,m) +   &
620               &  soilcarbon_input(:,m,l,istrbel,icarbon) * lignin_struc_below(:,m,l))*dt*(un-f_litDOC/CUE)
621
622       ENDDO
623           
624       WHERE (veget_max(:,m) .GT. zero)
625         DOC(:,m,1,ifree,iact,icarbon) = DOC(:,m,1,ifree,iact,icarbon) + DOC_to_topsoil(:,idocl)*dt/bio_frac(:) &
626               + wet_dep_ground(:,m,icarbon) * undemi/veget_max(:,m) + Cinp_manure_liquid(:,m)*f_lab_liqmanure
627         DOC(:,m,nslm,ifree,iact,icarbon) = DOC(:,m,nslm,ifree,iact,icarbon) + DOC_to_subsoil(:,idocl)*dt/bio_frac(:)
628         DOC(:,m,1,ifree,islo,icarbon) = DOC(:,m,1,ifree,islo,icarbon) + DOC_to_topsoil(:,idocr)*dt/bio_frac(:) &
629               + wet_dep_ground(:,m,icarbon) * undemi/veget_max(:,m)+ Cinp_manure_liquid(:,m)*(un-f_lab_liqmanure)
630         DOC(:,m,nslm,ifree,islo,icarbon) = DOC(:,m,nslm,ifree,islo,icarbon) + DOC_to_subsoil(:,idocr)*dt/bio_frac(:)
631       ELSEWHERE
632         DOC(:,m,1,ifree,iact,icarbon) = DOC(:,m,1,ifree,iact,icarbon) 
633         DOC(:,m,nslm,ifree,iact,icarbon) = DOC(:,m,nslm,ifree,iact,icarbon)
634       ENDWHERE
635           
636    ENDDO
637       
638        !WRITE(numout,*) 'STOMATECarb_ZHC2'
639        !WRITE(numout,*) 'C',MAXVAL(DOC),MAXVAL(carbon),MAXVAL(soilcarbon_input)
640        !WRITE(numout,*) 'RH',MAXVAL(resp_hetero_soil),MAXVAL(resp_flood_soil)
641        !WRITE(numout,*) 'f_temswc',MAXVAL(control_moist_soil),MAXVAL(control_temp_soil)
642
643    !! 2.3. Calculate fluxes
644    DO m = 2,nvm
645      !calculate total litter available
646      litter_tot(:,m,1)=litter_above(:,imetabolic,m,icarbon)+litter_above(:,istructural,m,icarbon)
647   
648      DO l = 1, nslmd
649         litter_tot(:,m,l)=litter_tot(:,m,l) + litter_below(:,imetabolic,m,l,icarbon)+litter_below(:,istructural,m,l,icarbon)
650      ENDDO 
651   ENDDO
652   
653        !WRITE(numout,*) 'STOMATECarb_ZHC3'
654        !WRITE(numout,*) 'LOM', SUM(LOM),SUM(litter_tot)
655    !WRITE(numout,*) 'Decomp', SUM(carbon),SUM(flood_frac),SUM(control_temp_soil),SUM(control_moist_soil)
656       
657    DO m = 1,nvm ! Loop over # PFTs
658      !! 2.3.1. Flux out of pools
659
660      DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
661
662        DO l = 1, nslmd !Loop over soil layers
663
664         ! Determine total flux out of pool
665         ! S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
666         ! Not crop
667         
668
669          IF (k == iactive) THEN
670             LOM(:,m,l) = litter_tot(:,m,l) + DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
671          ELSEIF (k == islow) THEN
672             LOM(:,m,l) = litter_tot(:,m,l) + carbon(:,iactive,m,l) + DOC(:,m,l,ifree,iact,icarbon) + &
673                          DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
674          ELSEIF (k == ipassive) THEN
675             LOM(:,m,l) = litter_tot(:,m,l) + carbon(:,iactive,m,l) + carbon(:,islow,m,l) + DOC(:,m,l,ifree,iact,icarbon) + DOC(:,m,l,ifree,islo,icarbon) + &
676                          DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
677          ELSE
678             WRITE(numout,*) "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
679             WRITE(numout,*) "BE CAREFUL SOMETHING STRANGE HAPPENS"
680             WRITE(numout,*) "IN STOMATE_SOILCARBON FOR LOM CALCULATION"
681             WRITE(numout,*) "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
682
683          ENDIF
684                 
685                  WHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND. (natural(m)))
686            fluxtot(:,k,icarbon,l) =(dt/(carbon_tau(k)*(un+poor_soils(:))))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
687                 control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * (un-flood_frac(:))
688            fluxtot_flood(:,k,icarbon,l) =(dt/(carbon_tau(k)*(un+poor_soils(:))))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
689                 control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flood_frac(:) * un/trois
690            ! C3 crop
691          ELSEWHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND.( (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) ))
692            fluxtot(:,k,icarbon,l) =(dt/(carbon_tau(k)*(un+poor_soils(:))))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
693                 control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(1) * (un-flood_frac(:))
694            fluxtot_flood(:,k,icarbon,l) =(dt/(carbon_tau(k)*(un+poor_soils(:))))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
695                 control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(1) * flood_frac(:) * un/trois
696            ! C4 crop
697          ELSEWHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND.( (.NOT. natural(m)) .AND. (is_c4(m)) )) 
698            fluxtot(:,k,icarbon,l) =(dt/(carbon_tau(k)*(un+poor_soils(:))))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
699                control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(2) * (un-flood_frac(:))
700            fluxtot_flood(:,k,icarbon,l) =(dt/(carbon_tau(k)*(un+poor_soils(:))))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
701                control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(2) * flood_frac(:) * un/trois
702          ELSEWHERE
703            fluxtot(:,k,icarbon,l) = zero
704            fluxtot_flood(:,k,icarbon,l) = zero
705          ENDWHERE
706         
707                !  DO ig = 1,npts
708                !     IF (fluxtot(ig,k,icarbon,l).GT.1.0E+50 .OR.fluxtot(ig,k,icarbon,l).LT.0.0 .OR. ISNAN(fluxtot(ig,k,icarbon,l))) THEN
709                !        WRITE(numout,*) 'fluxtot1', ig,k,l,fluxtot(ig,k,icarbon,l),fluxtot_flood(ig,k,icarbon,l)
710                !                WRITE(numout,*) 'LOM1', carbon(ig,k,m,l),LOM(ig,m,l),litter_tot(ig,m,l),DOC(ig,m,l,ifree,imetabo,icarbon)
711                !        WRITE(numout,*) 'Decomp1', flood_frac(ig),control_temp_soil(ig,l,k+4),control_moist_soil(ig,l,m)
712                !     ENDIF
713                !  ENDDO
714          ! END - S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
715
716          ! Carbon flux from active pools depends on clay content
717          IF ( k .EQ. iactive ) THEN
718              fluxtot(:,k,icarbon,l) = fluxtot(:,k,icarbon,l) * ( un - flux_tot_coeff(3) * clay(:) )
719              fluxtot_flood(:,k,icarbon,l) = fluxtot_flood(:,k,icarbon,l) * ( un - flux_tot_coeff(3) * clay(:) )
720          ENDIF
721        ENDDO ! End of loop over soil layers
722
723      ENDDO ! End of loop over carbon pools
724
725      IF (.NOT. lat_exp_doc) THEN
726         fluxtot = fluxtot + fluxtot_flood
727         fluxtot_flood = zero
728      ELSE
729         !do nothing
730      ENDIF
731
732      flux2DOC(:,:,:,:) = fluxtot(:,:,:,:) * f_SOCDOC
733      flux2DOC_flood(:,:,:,:) = fluxtot_flood(:,:,:,:) * f_SOCDOC
734      fluxtot(:,:,:,:) = fluxtot(:,:,:,:) - flux2DOC(:,:,:,:)
735      fluxtot_flood(:,:,:,:) = fluxtot_flood(:,:,:,:) - flux2DOC_flood(:,:,:,:)
736
737      !! 2.3.2 respiration
738      !BE CAREFUL: Here resp_hetero_soil is divided by dt to have a value which corresponds to
739      ! the sechiba time step but then in stomate.f90 resp_hetero_soil is multiplied by dt.
740      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
741      ! time step and avoid some constructions that could create bug during future developments.
742      !
743      DO l = 1,nslmd !Loop over soil layers
744         resp_hetero_soil(:,m) = resp_hetero_soil(:,m)+&
745            ( (un-CUE_coef(:)) * fluxtot(:,iactive,icarbon,l) + &
746            (un-CUE_coef(:)) * fluxtot(:,islow,icarbon,l) + &
747            (un-CUE_coef(:))* fluxtot(:,ipassive,icarbon,l)  ) / dt
748         resp_flood_soil(:,m) = resp_flood_soil(:,m)+&
749            ( (un-CUE_coef(:)) * fluxtot_flood(:,iactive,icarbon,l) + &
750            (un-CUE_coef(:)) * fluxtot_flood(:,islow,icarbon,l) + &
751            (un-CUE_coef(:))* fluxtot_flood(:,ipassive,icarbon,l)  ) / dt
752      ENDDO !End loop over soil layers
753
754      !! 2.3.3 DOC calculation
755      !! 2.3.3.1 DOC decomposition
756      ! In the Kalbitz et al., 2003 Geoderma as well
757      ! as in Qualls and Haines 1992 SSAJ
758      ! the equation are defined with exponential but for the time
759      ! step we used we can approximate the values with 1st order kinetics.
760
761     DO j = 1,npool  !Loop over pools
762       DO l = 1,nslmd !Loop over soil layers
763             !WRITE(numout,*) 'LOM', SUM(LOM(:,m,l)),SUM(litter_tot(:,m,l)),SUM(DOC(:,m,l,ifree,imetabo,icarbon))
764                 !WRITE(numout,*) 'Decomp', SUM(carbon(:,k,m,l)),SUM(flood_frac(:)),SUM(control_temp_soil(:,l,k+4)),SUM(control_moist_soil(:,l,m))
765             IF (l.EQ.nslmd) THEN
766            WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero) 
767                 fluxtot_DOC(:,m,l,j) = (dt/(DOC_tau(j)*(un+poor_soils(:))))* (un - flood_frac(:)) * &
768                                         DOC(:,m,l,ifree,j,icarbon)*control_temp_soil(:,nslmd,npool+j) 
769                 fluxtot_DOC_flood(:,m,l,j) = (dt/(DOC_tau(j)*(un+poor_soils(:))))* flood_frac(:) * un/trois * &
770                                         DOC(:,m,l,ifree,j,icarbon)*control_temp_soil(:,nslmd,npool+j)
771            ELSEWHERE
772                 fluxtot_DOC(:,m,l,j) = zero
773                 fluxtot_DOC_flood(:,m,l,j) = zero
774            ENDWHERE
775                 ELSE
776                    WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero) 
777                 fluxtot_DOC(:,m,l,j) = (dt/(DOC_tau(j)*(un+poor_soils(:))))* (un - flood_frac(:)) * &
778                                         DOC(:,m,l,ifree,j,icarbon)*control_temp_soil(:,l,npool+j) 
779                 fluxtot_DOC_flood(:,m,l,j) = (dt/(DOC_tau(j)*(un+poor_soils(:))))* flood_frac(:) * un/trois * &
780                                         DOC(:,m,l,ifree,j,icarbon)*control_temp_soil(:,l,npool+j)
781            ELSEWHERE
782                 fluxtot_DOC(:,m,l,j) = zero
783                 fluxtot_DOC_flood(:,m,l,j) = zero
784            ENDWHERE
785               
786                 ENDIF !IF (l.EQ.nslm+1) THEN
787               
788        ! DO ig = 1,npts
789                !    IF (fluxtot(ig,k,icarbon,l).GT.1.0E+50 .OR.fluxtot(ig,k,icarbon,l).LT.0.0 .OR. ISNAN(fluxtot(ig,k,icarbon,l))) THEN
790                !       WRITE(numout,*) 'fluxtot2',ig,k,l,fluxtot(ig,k,icarbon,l),fluxtot_flood(ig,k,icarbon,l)
791                !          WRITE(numout,*) 'LOM2', carbon(ig,k,m,l),LOM(ig,m,l),litter_tot(ig,m,l),DOC(ig,m,l,ifree,imetabo,icarbon)
792                !       WRITE(numout,*) 'Decomp2', flood_frac(ig),control_temp_soil(ig,l,k+4),control_moist_soil(ig,l,m)
793                !    ENDIF
794                ! ENDDO
795               
796          resp_hetero_soil(:,m) = resp_hetero_soil(:,m)+&
797             (un-CUE_coef(:))*fluxtot_DOC(:,m,l,j)/dt
798
799          resp_flood_soil(:,m) = resp_flood_soil(:,m)+&
800             (un-CUE_coef(:))*fluxtot_DOC_flood(:,m,l,j)/dt
801
802      ENDDO !End loop over soil layers!
803     ENDDO !End loop over soil pool!
804
805      !! 2.3.4 Pools update
806      !! 2.3.4.1 For POC
807      DO l= 1, nslmd ! Loop over soil layers
808
809        carbon(:,iactive,m,l) = carbon(:,iactive,m,l)+ &
810                               frac_carb(:,ipassive,iactive)*(CUE_coef(:))*(fluxtot_DOC(:,m,l,ipas) + &
811                               fluxtot(:,ipassive,icarbon,l)) + &
812                               frac_carb(:,islow,iactive)*(CUE_coef(:))*(fluxtot_DOC(:,m,l,islo) + &
813                               fluxtot(:,islow,icarbon,l)) + &
814                               (CUE_coef(:))*fluxtot_DOC(:,m,l,imetbel) + &
815                               (CUE_coef(:))*fluxtot_DOC(:,m,l,istrbel) * (un - lignin_struc_below(:,m,l)) + &
816                               (CUE_coef(:))*fluxtot_DOC(:,m,l,imetabo) + &
817                               (CUE_coef(:))*fluxtot_DOC(:,m,l,istrabo) * (un - lignin_struc_above(:,m)) + &
818                               frac_carb(:,ipassive,iactive)*(CUE_coef(:))*(fluxtot_DOC_flood(:,m,l,ipas) + &
819                               fluxtot_flood(:,ipassive,icarbon,l)) + &
820                               frac_carb(:,islow,iactive)*(CUE_coef(:))*(fluxtot_DOC_flood(:,m,l,islo) + &
821                               fluxtot_flood(:,islow,icarbon,l)) + &
822                               (CUE_coef(:))*fluxtot_DOC_flood(:,m,l,imetbel) + &
823                               (CUE_coef(:))*fluxtot_DOC_flood(:,m,l,istrbel) * (un - lignin_struc_below(:,m,l)) + &
824                               (CUE_coef(:))*fluxtot_DOC_flood(:,m,l,imetabo) + &
825                               (CUE_coef(:))*fluxtot_DOC_flood(:,m,l,istrabo) * (un - lignin_struc_above(:,m))
826
827        carbon(:,islow,m,l) = carbon(:,islow,m,l)+ &
828                               frac_carb(:,ipassive,islow)*(CUE_coef(:))*(fluxtot_DOC(:,m,l,ipas) + &
829                               fluxtot(:,ipassive,icarbon,l)) + &
830                               frac_carb(:,iactive,islow)*(CUE_coef(:))*(fluxtot_DOC(:,m,l,iact) + &
831                               fluxtot(:,iactive,icarbon,l)) + &
832                               (CUE_coef(:))*fluxtot_DOC(:,m,l,istrbel) *lignin_struc_below(:,m,l) + &
833                               (CUE_coef(:))*fluxtot_DOC(:,m,l,istrabo) *lignin_struc_above(:,m) + &
834                               frac_carb(:,ipassive,islow)*(CUE_coef(:))*(fluxtot_DOC_flood(:,m,l,ipas) + &
835                               fluxtot_flood(:,ipassive,icarbon,l)) + &
836                               frac_carb(:,iactive,islow)*(CUE_coef(:))*(fluxtot_DOC_flood(:,m,l,iact) + &
837                               fluxtot_flood(:,iactive,icarbon,l)) + &
838                               (CUE_coef(:))*fluxtot_DOC_flood(:,m,l,istrbel) *lignin_struc_below(:,m,l) + &
839                               (CUE_coef(:))*fluxtot_DOC_flood(:,m,l,istrabo) *lignin_struc_above(:,m)
840
841        carbon(:,ipassive,m,l) = carbon(:,ipassive,m,l)+CUE_coef(:) * &
842                               (frac_carb(:,iactive,ipassive)*(fluxtot_DOC(:,m,l,iact)+fluxtot(:,iactive,icarbon,l)) + &
843                               frac_carb(:,islow,ipassive)*(fluxtot_DOC(:,m,l,islo)+fluxtot(:,islow,icarbon,l)) + &
844                               frac_carb(:,iactive,ipassive)*(fluxtot_DOC_flood(:,m,l,iact)+fluxtot_flood(:,iactive,icarbon,l)) + &
845                               frac_carb(:,islow,ipassive)*(fluxtot_DOC_flood(:,m,l,islo)+fluxtot_flood(:,islow,icarbon,l)))
846
847      ENDDO ! End loop over soil layers
848 
849      DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
850        DO l = 1, nslmd !Loop over soil layers
851
852           carbon(:,k,m,l) = carbon(:,k,m,l) - fluxtot(:,k,icarbon,l) - fluxtot_flood(:,k,icarbon,l) &
853              &                            - flux2DOC(:,k,icarbon,l) - flux2DOC_flood(:,k,icarbon,l)
854
855        ENDDO ! End of loop over soil layers
856      ENDDO ! End of loop over carbon pools
857
858      !! 2.3.4.2 For DOC
859      DO l = 1,nslmd !Loop over soil layers
860         DO kk = 1,nelements !Loop over elements
861           IF (l .GT. sro_bottom) THEN
862              !For Active pool
863              DOC(:,m,l,ifree,iact,kk) = DOC(:,m,l,ifree,iact,kk) + flux2DOC(:,iactive,kk,l) + &
864                   flux2DOC_flood(:,iactive,kk,l)
865             
866              !For Slow pool   
867              DOC(:,m,l,ifree,islo,kk) = DOC(:,m,l,ifree,islo,kk) + flux2DOC(:,islow,kk,l) + &
868                   flux2DOC_flood(:,islow,kk,l)
869
870              !For Passive pool
871              DOC(:,m,l,ifree,ipas,kk) = DOC(:,m,l,ifree,ipas,kk) + flux2DOC(:,ipassive,kk,l) + &
872                   flux2DOC_flood(:,ipassive,kk,l)
873           ELSE
874              !For Active pool
875              DOC(:,m,l,ifree,iact,kk) = DOC(:,m,l,ifree,iact,kk) + flux2DOC(:,iactive,kk,l)
876              !For Slow pool
877              DOC(:,m,l,ifree,islo,kk) = DOC(:,m,l,ifree,islo,kk) + flux2DOC(:,islow,kk,l) 
878              !For Passive pool
879              DOC(:,m,l,ifree,ipas,kk) = DOC(:,m,l,ifree,ipas,kk) + flux2DOC(:,ipassive,kk,l)
880           ENDIF
881        ENDDO !End loop over elements
882     ENDDO !End loop over soil layers
883
884     DO j = 1,npool  !Loop over pools
885       DO l = 1,nslmd !Loop over soil layers
886
887          DOC(:,m,l,ifree,j,icarbon) = DOC(:,m,l,ifree,j,icarbon) - fluxtot_DOC(:,m,l,j) - fluxtot_DOC_flood(:,m,l,j)
888
889       ENDDO !End loop over soil layers!
890     ENDDO !End loop over soil pool!
891
892      !! 2.3.5 Adsorption/resorption of DOC using linear Mass isotherm assuming
893      !that DOC from native soil is zero (b parameters in Nodvin et al., 1986,
894      !Soil Science)
895      !For the moment, fixed parameters taken from Kaiser and others,1996, b in mg/g soil
896     Kd(:,:)=kd_ads
897     Kd(:,1) = dix**(-3.1+0.2*log10(clay(:)*cent)+log10(z_soil(1)*cent/deux))
898     DO l = 2,nslm
899        ! IM, b or Kd calculating following the statistical model obtained in
900        ! Camino Serrano et al. in prep
901        Kd(:,l) = dix**(-3.1+0.2*log10(clay(:)*cent)+log10((z_soil(l)+z_soil(l-1))/deux))
902        ! Kd(:,l) = 0.001225841-0.000212346*soil_ph(:)+0.003739918*clay(:)
903     ENDDO
904     Kd(:,:)=MAX(Kd(:,:),dix**(-3.2))
905     Kd(:,:)=MIN(Kd(:,:),dix**(-1.5))
906
907     ! Calculation of amount adsorbed/desorbed based on
908     ! Ota et al., 2013 JGR
909     DO l = 1,nslmd !Loop over soil layers
910        DO kk = 1,nelements !Loop over elements
911           DO kkk = 1,npool !Loop over soil and litter pool
912                      IF (l.EQ.nslmd) THEN
913                 DOC_RE(:,m,l,kkk,kk) = (Kd(:,nslm)*bulk_dens(:))/(Kd(:,nslm)*bulk_dens(:)+un)* &
914                     (DOC(:,m,l,ifree,kkk,kk)+DOC(:,m,l,iadsorbed,kkk,kk)) 
915                          ELSE
916                             DOC_RE(:,m,l,kkk,kk) = (Kd(:,l)*bulk_dens(:))/(Kd(:,l)*bulk_dens(:)+un)* &
917                     (DOC(:,m,l,ifree,kkk,kk)+DOC(:,m,l,iadsorbed,kkk,kk)) 
918                          ENDIF
919           ENDDO !End loop over soil and litter pool
920        ENDDO !End loop over elements
921     ENDDO !End loop over soil layers
922
923     DOC_old(:,m,:,:,:,:)= zero
924     DOC_old(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
925     DO l = 1,nslmd !Loop over soil layers
926        DO kk = 1,nelements !Loop over elements
927           DO kkk = 1,npool !Loop over soil and litter pool
928              WHERE (((DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) .GT. zero) .AND. (abs(DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) .GT. DOC_old(:,m,l,ifree,kkk,kk)))
929                 !To avoid adsorbing more DOC than existing (when there is not enough free carbon)
930                 DOC(:,m,l,iadsorbed,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)+ DOC_old(:,m,l,ifree,kkk,kk)
931                 DOC(:,m,l,ifree,kkk,kk)= zero           
932              ELSEWHERE (((DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) .LT. zero) .AND. (abs(DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) .GT. DOC_old(:,m,l,iadsorbed,kkk,kk)))
933               !To avoid desorbing more DOC than existing (when there is not enough adsorbed carbon)
934                 DOC(:,m,l,iadsorbed,kkk,kk)= zero 
935                 DOC(:,m,l,ifree,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)+ DOC_old(:,m,l,ifree,kkk,kk)       
936              ELSEWHERE ((DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) .NE. zero) 
937                !The normal functioning of the distribution coefficient to reach equilibrium between DOC adsorbed and DOC free   
938                 DOC(:,m,l,ifree,kkk,kk)=DOC_old(:,m,l,ifree,kkk,kk)-(DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) 
939                 DOC(:,m,l,iadsorbed,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)+(DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk))
940              ELSEWHERE
941                 DOC(:,m,l,ifree,kkk,kk)=DOC_old(:,m,l,ifree,kkk,kk)
942                 DOC(:,m,l,iadsorbed,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)
943              ENDWHERE
944           ENDDO !End loop over soil and litter pool
945        ENDDO !End loop over elements
946     ENDDO !End loop over soil layers
947
948
949
950     !! 2.3.6 Transport of DOC with the water fluxes following Futter et al.,
951     ! (2007) Water ressources research.
952     
953     !! 2.3.6.1 Change DOC free from gC m-2 of soil to g C m^-3 of water 
954     DO kk = 1, nelements !Loop over elements
955       
956        DO k = 1, npool ! Loop over soil and litter pools
957           
958           WHERE( soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
959
960              DOC(:,m,1,ifree,k,kk) = DOC(:,m,1,ifree,k,kk) / (z_soil(1)*soil_mc(:,1,pref_soil_veg(m)))
961
962           ELSEWHERE
963              DOC(:,m,1,ifree,k,kk) = DOC(:,m,1,ifree,k,kk)
964           ENDWHERE
965
966        ENDDO ! End loop over soil and litter pools
967
968     ENDDO !End loop over elements
969
970     DO l = 2,nslm !Loop over soil layers
971
972        DO kk = 1, nelements !Loop over elements
973
974           DO k = 1, npool ! Loop over soil and litter pools
975
976              WHERE( soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
977                 DOC(:,m,l,ifree,k,kk) = DOC(:,m,l,ifree,k,kk) / ((z_soil(l)-z_soil(l-1))*soil_mc(:,l,pref_soil_veg(m)))
978              ELSEWHERE
979                 DOC(:,m,l,ifree,k,kk) = DOC(:,m,l,ifree,k,kk)
980              ENDWHERE
981
982           ENDDO ! End loop over soil and litter pools
983
984        ENDDO !End loop over elements
985
986     ENDDO !End loop over soil layers
987     ! DOC fluxes between layers calculated (we multiplied by
988     ! 1E-3 to convert from kg/m2 to m3/m2)
989     DO l = 1,nslm-1 !Loop over soil layers
990        DO kk = 1,nelements !Loop over elements
991           DO kkk = 1,npool !Loop over soil and litter pool
992              WHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (soil_mc(:,l,pref_soil_veg(m)) .GT. zero))
993                 DOC_FLUX(:,m,l,kkk,kk) = DOC(:,m,l,ifree,kkk,kk)*wat_flux(:,l,pref_soil_veg(m))*1E-3*flux_red(:)
994              ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (soil_mc(:,l,pref_soil_veg(m)) .GT. zero))
995                 DOC_FLUX(:,m,l,kkk,kk) = DOC(:,m,l+1,ifree,kkk,kk)*abs(wat_flux(:,l,pref_soil_veg(m)))*1E-3*flux_red(:)
996              ELSEWHERE 
997                 DOC_FLUX(:,m,l,kkk,kk) = zero
998              ENDWHERE
999           ENDDO !End loop over soil and litter pool
1000        ENDDO !End loop over elements
1001     ENDDO !End loop over soil layers
1002
1003     !For the last layer
1004     DO kk = 1,nelements !Loop over elements
1005        DO kkk = 1,npool !Loop over soil and litter pool
1006           WHERE ((wat_flux(:,nslm,pref_soil_veg(m)) .GT. 0.) .AND. (soil_mc(:,nslm,pref_soil_veg(m)) .GT. zero))
1007              DOC_FLUX(:,m,nslm,kkk,kk) = DOC(:,m,nslm,ifree,kkk,kk)*wat_flux(:,nslm,pref_soil_veg(m))*1E-3*flux_red(:)
1008           ELSEWHERE 
1009              DOC_FLUX(:,m,nslm,kkk,kk) = zero
1010           ENDWHERE
1011        ENDDO !End loop over soil and litter pool
1012     ENDDO !End loop over elements
1013
1014     !! 2.3.7 DOC is reconverted from gC m^⁻3 of water in gC m^-2 of ground to exchange it with the other carbon pools
1015     !For the first layer
1016
1017     DO k = 1, npool ! Loop over soil and litter pools
1018        DO kk = 1,nelements !Loop over elements
1019           WHERE(soil_mc(:,1,pref_soil_veg(m)) .GT. zero)             
1020              DOC(:,m,1,ifree,k,kk)=DOC(:,m,1,ifree,k,kk) * soil_mc(:,1,pref_soil_veg(m)) * z_soil(1)
1021           ELSEWHERE
1022              DOC(:,m,1,ifree,k,kk)=DOC(:,m,1,ifree,k,kk) 
1023           ENDWHERE
1024        ENDDO !End loop over elements
1025     ENDDO ! End loop over soil and litter pools
1026
1027
1028     !For the other layers
1029
1030     DO l= 2, nslm ! Loop over soil layers
1031        DO k = 1, npool ! Loop over soil and litter pools
1032           DO kk = 1,nelements !Loop over elements
1033              WHERE(soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
1034                 DOC(:,m,l,ifree,k,kk)=DOC(:,m,l,ifree,k,kk) * soil_mc(:,l,pref_soil_veg(m)) * (z_soil(l)-z_soil(l-1))
1035              ELSEWHERE
1036                 DOC(:,m,l,ifree,k,kk)=DOC(:,m,l,ifree,k,kk) 
1037              ENDWHERE
1038           ENDDO !End loop over elements
1039        ENDDO ! End loop over soil and litter pools
1040     ENDDO ! End loop over soil layers
1041
1042     ! DOC update
1043     !For the first layer
1044     DOC_old(:,m,:,:,:,:)= zero
1045     DOC_old(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
1046
1047
1048     DO kk = 1,nelements !Loop over elements
1049        DO kkk = 1,npool !Loop over soil and litter pool
1050             
1051           WHERE (wat_flux(:,1,pref_soil_veg(m)) .GT. 0.) 
1052              DOC(:,m,1,ifree,kkk,kk) = DOC_old(:,m,1,ifree,kkk,kk) - MIN(DOC_old(:,m,1,ifree,kkk,kk),DOC_FLUX(:,m,1,kkk,kk)) 
1053           ELSEWHERE (wat_flux(:,1,pref_soil_veg(m)) .LT. 0.) 
1054              DOC(:,m,1,ifree,kkk,kk) = DOC_old(:,m,1,ifree,kkk,kk) + MIN(DOC_old(:,m,2,ifree,kkk,kk),DOC_FLUX(:,m,1,kkk,kk))
1055           ELSEWHERE
1056              DOC(:,m,1,ifree,kkk,kk) = DOC_old(:,m,1,ifree,kkk,kk)
1057           ENDWHERE
1058        ENDDO !End loop over soil and litter pool
1059     ENDDO !End loop over elements
1060
1061     ! For the other layers
1062     DO l = 2,nslm-1 !Loop over soil layers
1063        DO kk = 1,nelements !Loop over elements
1064           DO kkk = 1,npool !Loop over soil and litter pool
1065              WHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .GT. 0.))
1066                 DOC(:,m,l,ifree,kkk,kk) = DOC_old(:,m,l,ifree,kkk,kk) - MIN(DOC_FLUX(:,m,l,kkk,kk),DOC_old(:,m,l,ifree,kkk,kk)) + MIN(DOC_FLUX(:,m,l-1,kkk,kk),DOC_old(:,m,l-1,ifree,kkk,kk))
1067              ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .LT. 0.))
1068                 DOC(:,m,l,ifree,kkk,kk) = DOC_old(:,m,l,ifree,kkk,kk) + MIN(DOC_FLUX(:,m,l,kkk,kk),DOC_old(:,m,l+1,ifree,kkk,kk)) - MIN(DOC_FLUX(:,m,l-1,kkk,kk),DOC_old(:,m,l,ifree,kkk,kk))
1069              ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .LT. 0.))
1070                 DOC(:,m,l,ifree,kkk,kk) = DOC_old(:,m,l,ifree,kkk,kk) - MIN(DOC_FLUX(:,m,l,kkk,kk),DOC_old(:,m,l,ifree,kkk,kk)) - MIN(DOC_FLUX(:,m,l-1,kkk,kk),DOC_old(:,m,l,ifree,kkk,kk))
1071              ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .GT. 0.))
1072                 DOC(:,m,l,ifree,kkk,kk) = DOC_old(:,m,l,ifree,kkk,kk) + MIN(DOC_FLUX(:,m,l,kkk,kk),DOC_old(:,m,l+1,ifree,kkk,kk)) + MIN(DOC_FLUX(:,m,l-1,kkk,kk),DOC_old(:,m,l-1,ifree,kkk,kk))
1073              ELSEWHERE 
1074                 DOC(:,m,l,ifree,kkk,kk) = DOC_old(:,m,l,ifree,kkk,kk)
1075              ENDWHERE
1076           ENDDO !End loop over soil and litter pool
1077        ENDDO !End loop over elements
1078     ENDDO !End loop over soil layers
1079
1080     !For the last layer
1081     DO kk = 1,nelements !Loop over elements
1082        DO kkk = 1,npool !Loop over soil and litter pool
1083           WHERE (wat_flux(:,nslm-1,pref_soil_veg(m)) .GT. 0.)
1084              DOC(:,m,nslm,ifree,kkk,kk) = DOC_old(:,m,nslm,ifree,kkk,kk) + MIN(DOC_FLUX(:,m,nslm-1,kkk,kk),DOC_old(:,m,nslm-1,ifree,kkk,kk))
1085           ELSEWHERE (wat_flux(:,nslm-1,pref_soil_veg(m)) .LT. 0.)
1086              DOC(:,m,nslm,ifree,kkk,kk) = DOC_old(:,m,nslm,ifree,kkk,kk) - MIN(DOC_FLUX(:,m,nslm-1,kkk,kk),DOC_old(:,m,nslm,ifree,kkk,kk))
1087           ELSEWHERE
1088              DOC(:,m,nslm,ifree,kkk,kk) = DOC_old(:,m,nslm,ifree,kkk,kk)
1089           ENDWHERE
1090        ENDDO !End loop over soil and litter pool
1091     ENDDO !End loop over elements
1092
1093     !! 2.3.8 DOC transport by diffusion
1094     !! 2.3.8.1 Calculation of the DOC fluxes by diffusion
1095     ! Here we use the DOC concentration in the soil and not in water to
1096     ! stabilize the calcul of
1097     ! water distribution is continuous in the soil column (no dry places)
1098
1099
1100     DOC_old2(:,m,:,:,:,:)=zero
1101     DOC_old_buffer(:,m,:,:,:,:)=zero
1102     DOC_old2(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
1103
1104     DO kkk = 1, npool ! Loop over soil and litter pools
1105        DO kk = 1, nelements ! Loop over elements
1106               
1107           DOC_FLUX_DIFF(:,m,1,kkk,kk) = Dif_DOC(:)*ABS(DOC_old2(:,m,1,ifree,kkk,kk)/(z_soil(1))-DOC_old2(:,m,2,ifree,kkk,kk)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
1108
1109           DO l= 2, nslm-1 ! Loop over soil layers
1110              DOC_FLUX_DIFF(:,m,l,kkk,kk) = Dif_DOC(:)*ABS(DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1))-DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))
1111           ENDDO
1112
1113       !Below we checked if in case that, in a given layer, you have diffusion
1114       !in the above and below litters, both fluxes are not higher than the
1115       !stocks of the given layer.
1116           DO l =1, nslm-2
1117              WHERE (DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1)) .LT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l)) .AND. &
1118                   DOC_old2(:,m,l+2,ifree,kkk,kk)/(z_soil(l+2)-z_soil(l+1)) .LT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l)) .AND. &
1119                   DOC_FLUX_DIFF(:,m,l,kkk,kk) + DOC_FLUX_DIFF(:,m,l+1,kkk,kk) .GT. DOC_old2(:,m,l+1,ifree,kkk,kk))
1120                 DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk)*(DOC_FLUX_DIFF(:,m,l,kkk,kk)/(DOC_FLUX_DIFF(:,m,l,kkk,kk)+DOC_FLUX_DIFF(:,m,l+1,kkk,kk)))
1121                 DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk)*(DOC_FLUX_DIFF(:,m,l+1,kkk,kk)/(DOC_FLUX_DIFF(:,m,l,kkk,kk)+DOC_FLUX_DIFF(:,m,l+1,kkk,kk)))
1122              ELSEWHERE (DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1)) .GE. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l)) .AND. &
1123                   DOC_old2(:,m,l+2,ifree,kkk,kk)/(z_soil(l+2)-z_soil(l+1)) .LT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l)) .AND. &
1124                   DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk) - DOC_FLUX_DIFF(:,m,l+1,kkk,kk) .LE. min_stomate)
1125                 DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
1126                 DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk)
1127              ELSEWHERE (DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1)) .LT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l)) .AND. &
1128                   DOC_old2(:,m,l+2,ifree,kkk,kk)/(z_soil(l+2)-z_soil(l+1)) .GE. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l)) .AND. &
1129                   DOC_old2(:,m,l+1,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk) + DOC_FLUX_DIFF(:,m,l+1,kkk,kk) .LE. min_stomate)
1130                 DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
1131                 DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
1132              ELSEWHERE
1133                 DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
1134                 DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
1135              ENDWHERE
1136           ENDDO
1137
1138           DO l= 1, nslm-1 ! Loop over soil layers
1139              WHERE ((DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1)) .LT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l))) .AND. &
1140                   ((DOC_FLUX_DIFF(:,m,l,kkk,kk) - DOC_old2(:,m,l+1,ifree,kkk,kk)) .GE. min_stomate))
1141                 DOC(:,m,l,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk) + DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_old_buffer(:,m,l,ifree,kkk,kk)
1142                 DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = - DOC_old2(:,m,l+1,ifree,kkk,kk) 
1143                 DOC(:,m,l+1,ifree,kkk,kk) = zero
1144              ELSEWHERE ((DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1)) .LT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l))) .AND. &
1145                   ((DOC_old2(:,m,l+1,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)) .GT. min_stomate))
1146                 DOC(:,m,l,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk) + DOC_old_buffer(:,m,l,ifree,kkk,kk)
1147                 DOC_old_buffer(:,m,l+1,ifree,kkk,kk) =  - DOC_FLUX_DIFF(:,m,l,kkk,kk)
1148                 DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)
1149              ELSEWHERE ((DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1)) .GT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l))) .AND. &
1150                   ((DOC_FLUX_DIFF(:,m,l,kkk,kk) - DOC_old2(:,m,l,ifree,kkk,kk)) .GE. min_stomate))
1151                 DOC(:,m,l,ifree,kkk,kk) = zero + DOC_old_buffer(:,m,l,ifree,kkk,kk)
1152                 DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk)
1153                 DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_old2(:,m,l,ifree,kkk,kk)
1154              ELSEWHERE ((DOC_old2(:,m,l,ifree,kkk,kk)/(z_soil(l)-z_soil(l-1)) .GT. DOC_old2(:,m,l+1,ifree,kkk,kk)/(z_soil(l+1)-z_soil(l))) .AND. &
1155                   ((DOC_old2(:,m,l,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)) .GT. min_stomate))
1156                 DOC(:,m,l,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk) + DOC_old_buffer(:,m,l,ifree,kkk,kk)
1157                 DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
1158                 DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk)
1159              ELSEWHERE
1160                 DOC(:,m,l,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk)
1161                 DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk)
1162              ENDWHERE
1163           ENDDO ! End loop over soil layers
1164        ENDDO ! End loop over elements
1165     ENDDO ! End loop over DOC pools
1166
1167        !! 2.3.9 DOC export
1168        !! Calculate total DOC going out of the system (the factor 1E-3 is
1169        !! applied to convert runoff, floodout, drainage from kg/m2 to m3/m2)
1170        !! We assume that runoff and floodout affects the first layer of soil
1171        !! and drainage only the last layer.
1172        !! Drainage and runoff are given by soil type by hydrol.f90 but not floodout (it is a weighed mean) explaining why
1173        !! the calculation is a bit different between DOC_RUN and DOC_FLOOD. Moreover, floodout is computed as evaporation-precipitation,
1174        !! so it represent an export to the rivers only if floodout is negative explaing why we have to multiply by -un.
1175        !! Be careful we do not * by dt because it is already done in hydrol.f90
1176
1177        !! based on fast reservoir, we calculate a reduction factor. The calculation is based on the assumption that there
1178        !! head waters that is the main source of DOC to inland waters, while areas more remote from the head waters have a neglibile
1179        !! effect on the DOC in streams. We assume that the export from soils to head waters is proportional to the
1180        !! square root of the fast reservoir storage. This is consitnet with empirical finding relating stream width to discharge. As we
1181        !! do not directly consider a stream surface area, we simply assign a reference fast reservoir for which we assume that
1182        !! all top soils export DOC into the head waters (which can include streamlets). Note that very high runoff appears where swamps
1183        !! are pesent.
1184
1185
1186        fastr_corr(:) = (fastr(:)**undemi)/(fastr_ref**undemi)
1187        WHERE (fastr_corr(:) .LT. zero)
1188           fastr_corr(:) = zero
1189        ELSEWHERE
1190           fastr_corr(:) = fastr_corr(:)
1191        ENDWHERE
1192
1193        !! Based on maximum export concentration, we calculate a correction factor
1194         soilDOC_corr(:) = zero
1195         soilDOC_31mm(:) = zero
1196         DO kk = 1,nelements !Loop over elements
1197            DO kkk = 1,npool !Loop over soil and litter pool
1198               soilDOC_31mm(:) = soilDOC_31mm + DOC(:,m,1,ifree,kkk,kk)
1199               IF (sro_bottom .GT. 1) THEN
1200                  DO l=2,sro_bottom
1201                     soilDOC_31mm(:) = soilDOC_31mm(:) + DOC(:,m,l,ifree,kkk,kk)
1202                  ENDDO !l=2,sro_bottom
1203               ENDIF !(sro_bottom .GT. 1)
1204            ENDDO !kkk = 1,npool
1205         ENDDO !kk = 1,nelements
1206         !
1207         WHERE (soilDOC_31mm(:)*mod_red_sro*flux_red(:)*fastr_corr(:)/soilwater_31mm(:,pref_soil_veg(m)) .GT. DOCexp_max)
1208            soilDOC_corr(:) = DOCexp_max/(soilDOC_31mm(:)*(mod_red_sro*flux_red(:))*fastr_corr(:)/soilwater_31mm(:,pref_soil_veg(m)))
1209         ELSEWHERE
1210            soilDOC_corr(:) = un
1211         ENDWHERE
1212         soilDOC_corr(:) = soilDOC_corr(:) * (mod_red_sro*flux_red(:)) * fastr_corr(:)
1213         !
1214         DO kk = 1,nelements !Loop over elements
1215            DO kkk = 1,npool !Loop over soil and litter pool
1216               !DOC lost through runoff for the first layer
1217               WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
1218                  DOC_RUN(:,m,kkk,kk) = DOC_RUN(:,m,kkk,kk) + MIN(DOC(:,m,1,ifree,kkk,kk),lat_exp*soilDOC_corr(:) &
1219                       &              * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
1220                       &              * DOC(:,m,1,ifree,kkk,kk))
1221               ELSEWHERE
1222                  DOC_RUN(:,m,kkk,kk) = DOC_RUN(:,m,kkk,kk)
1223               ENDWHERE
1224               !
1225               IF (kkk .EQ. imetabo) THEN
1226                  DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,imetabo,kk) 
1227                  DOC_RUN(:,m,imetabo,kk) = zero
1228               ELSEIF (kkk .EQ. istrabo) THEN                 
1229                  DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,istrabo,kk) * (un - lignin_struc_above(:,m))       
1230                  DOC_RUN(:,m,islo,kk) = DOC_RUN(:,m,islo,kk) + DOC_RUN(:,m,istrabo,kk) * lignin_struc_above(:,m) 
1231                  DOC_RUN(:,m,istrabo,kk) = zero
1232               ELSEIF (kkk .EQ. istrbel) THEN
1233                  DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,istrbel,kk) * (un - lignin_struc_below(:,m,1))       
1234                  DOC_RUN(:,m,islo,kk) = DOC_RUN(:,m,islo,kk) + DOC_RUN(:,m,istrbel,kk) * lignin_struc_below(:,m,1) 
1235                  DOC_RUN(:,m,istrbel,kk) = zero 
1236               ELSEIF (kkk .EQ. imetbel) THEN             
1237                  DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,imetbel,kk) 
1238                  DOC_RUN(:,m,imetbel,kk) = zero
1239               ELSE
1240                  DOC_RUN(:,m,kkk,kk) = DOC_RUN(:,m,kkk,kk)
1241               ENDIF
1242               !
1243               !And for the layers 2-? layers
1244               IF (sro_bottom .GT. 1) THEN
1245                  DO l=2,sro_bottom
1246                     WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
1247                        DOC_RUN(:,m,kkk,kk) = DOC_RUN(:,m,kkk,kk) + MIN(DOC(:,m,l,ifree,kkk,kk), &
1248                             &      lat_exp * soilDOC_corr(:) * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
1249                             &    * DOC(:,m,l,ifree,kkk,kk))
1250                     ELSEWHERE
1251                        DOC_RUN(:,m,kkk,kk) = DOC_RUN(:,m,kkk,kk)
1252                     ENDWHERE
1253                     !
1254                     IF (kkk .EQ. imetabo) THEN
1255                        DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,imetabo,kk) 
1256                        DOC_RUN(:,m,imetabo,kk) = zero
1257                     ELSEIF (kkk .EQ. istrabo) THEN                 
1258                        DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,istrabo,kk) * (un - lignin_struc_above(:,m))       
1259                        DOC_RUN(:,m,islo,kk) = DOC_RUN(:,m,islo,kk) + DOC_RUN(:,m,istrabo,kk) * lignin_struc_above(:,m) 
1260                        DOC_RUN(:,m,istrabo,kk) = zero
1261                     ELSEIF (kkk .EQ. istrbel) THEN
1262                        DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,istrbel,kk) * (un - lignin_struc_below(:,m,l))       
1263                        DOC_RUN(:,m,islo,kk) = DOC_RUN(:,m,islo,kk) + DOC_RUN(:,m,istrbel,kk) * lignin_struc_below(:,m,l) 
1264                        DOC_RUN(:,m,istrbel,kk) = zero 
1265                     ELSEIF (kkk .EQ. imetbel) THEN             
1266                        DOC_RUN(:,m,iact,kk) = DOC_RUN(:,m,iact,kk) + DOC_RUN(:,m,imetbel,kk) 
1267                        DOC_RUN(:,m,imetbel,kk) = zero
1268                     ELSE
1269                        DOC_RUN(:,m,kkk,kk) = DOC_RUN(:,m,kkk,kk)
1270                     ENDIF
1271                  ENDDO
1272               ENDIF !sro_bottom .GT. 1
1273                     !
1274               WHERE (soil_mc(:,nslm,pref_soil_veg(m)) .GT. zero)
1275                  DOC_DRAIN(:,m,kkk,kk) = DOC_DRAIN(:,m,kkk,kk) + MIN(DOC(:,m,nslm,ifree,kkk,kk),&
1276                       &                                         lat_exp*DOC(:,m,nslm,ifree,kkk,kk)*drainage_per_soil(:,pref_soil_veg(m))*1E-3 &
1277                       &                                         /((z_soil(nslm)-z_soil(nslm-1)) * soil_mc(:,nslm,pref_soil_veg(m))))
1278               ELSEWHERE
1279                  DOC_DRAIN(:,m,kkk,kk) = DOC_DRAIN(:,m,kkk,kk)
1280               ENDWHERE
1281               !
1282               IF (kkk .EQ. imetabo) THEN
1283                  DOC_DRAIN(:,m,iact,kk) = DOC_DRAIN(:,m,iact,kk) + DOC_DRAIN(:,m,imetabo,kk) 
1284                  DOC_DRAIN(:,m,imetabo,kk) = zero
1285               ELSEIF (kkk .EQ. istrabo) THEN                 
1286                  DOC_DRAIN(:,m,iact,kk) = DOC_DRAIN(:,m,iact,kk) + DOC_DRAIN(:,m,istrabo,kk) * (un - lignin_struc_above(:,m))       
1287                  DOC_DRAIN(:,m,islo,kk) = DOC_DRAIN(:,m,islo,kk) + DOC_DRAIN(:,m,istrabo,kk) * lignin_struc_above(:,m) 
1288                  DOC_DRAIN(:,m,istrabo,kk) = zero
1289               ELSEIF (kkk .EQ. istrbel) THEN
1290                  DOC_DRAIN(:,m,iact,kk) = DOC_DRAIN(:,m,iact,kk) + DOC_DRAIN(:,m,istrbel,kk) * (un - lignin_struc_below(:,m,nslm))       
1291                  DOC_DRAIN(:,m,islo,kk) = DOC_DRAIN(:,m,islo,kk) + DOC_DRAIN(:,m,istrbel,kk) * lignin_struc_below(:,m,nslm) 
1292                  DOC_DRAIN(:,m,istrbel,kk) = zero 
1293               ELSEIF (kkk .EQ. imetbel) THEN             
1294                  DOC_DRAIN(:,m,iact,kk) = DOC_DRAIN(:,m,iact,kk) + DOC_DRAIN(:,m,imetbel,kk) 
1295                  DOC_DRAIN(:,m,imetbel,kk) = zero
1296               ELSE
1297                  DOC_DRAIN(:,m,kkk,kk) = DOC_DRAIN(:,m,kkk,kk)
1298               ENDIF
1299               !
1300            ENDDO !End loop over soil and litter pool         
1301            !! TF-DOC
1302            WHERE (veget_max(:,m) .GT. zero)
1303               DOC_FLOOD(:,m,iact,kk) = DOC_FLOOD(:,m,iact,kk) + wet_dep_flood(:,m,kk)*undemi/veget_max(:,m)
1304               DOC_FLOOD(:,m,islo,kk) = DOC_FLOOD(:,m,islo,kk) + wet_dep_flood(:,m,kk)*undemi/veget_max(:,m)
1305               DOC_FLOOD(:,m,iact,kk) = DOC_FLOOD(:,m,iact,kk) + floodcarbon_input(:,m,iact,kk)*dt
1306               DOC_FLOOD(:,m,islo,kk) = DOC_FLOOD(:,m,islo,kk) + floodcarbon_input(:,m,islo,kk)*dt
1307            ELSEWHERE
1308               DOC_FLOOD(:,m,iact,kk) = DOC_FLOOD(:,m,iact,kk)
1309            ENDWHERE
1310            !
1311            DO l=1,sro_bottom
1312               WHERE (veget_max(:,m) .GT. zero)
1313                  DOC_FLOOD(:,m,islo,kk) = DOC_FLOOD(:,m,islo,kk) + CUE_coef(:) * fluxtot_flood(:,islow,kk,l)
1314                  DOC_FLOOD(:,m,ipas,kk) = DOC_FLOOD(:,m,ipas,kk) + CUE_coef(:) * fluxtot_flood(:,ipassive,kk,l)
1315                  DOC_FLOOD(:,m,iact,kk) = DOC_FLOOD(:,m,iact,kk) + CUE_coef(:) * fluxtot_flood(:,iactive,kk,l)
1316               ELSEWHERE
1317                  DOC_FLOOD(:,m,iact,kk) = DOC_FLOOD(:,m,iact,kk)
1318               ENDWHERE
1319            ENDDO !l=1,sro_bottom
1320            !
1321         ENDDO !End loop over elements
1322
1323
1324         DO kk = 1,nelements !Loop over elements
1325            DOC_EXP(:,m,irunoff,:,kk) = DOC_RUN(:,m,:,kk)/dt
1326            DOC_EXP(:,m,iflooded,:,kk) = DOC_FLOOD(:,m,:,kk)/dt
1327            DOC_EXP(:,m,idrainage,:,kk) = DOC_DRAIN(:,m,:,kk)/dt
1328         ENDDO !End loop over elements
1329         ! We substract runoff, floodout and drainage from DOC pools
1330         DO kkk = 1,npool !Loop over soil and litter pool
1331            DO kk = 1, nelements
1332               
1333               !For the first layer
1334               WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
1335                  DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk) - MIN(DOC(:,m,1,ifree,kkk,kk), &
1336                       &                    lat_exp * soilDOC_corr(:) * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
1337                       &                  * DOC(:,m,1,ifree,kkk,kk))
1338               ELSEWHERE
1339                  DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk)
1340               ENDWHERE
1341               !And for the layers 2-5
1342               IF (sro_bottom .GT. 1) THEN
1343                  DO l=2,sro_bottom
1344                     WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
1345                        DOC(:,m,l,ifree,kkk,kk) = DOC(:,m,l,ifree,kkk,kk) - MIN(DOC(:,m,l,ifree,kkk,kk), &
1346                             &                    lat_exp * soilDOC_corr(:) * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
1347                             &                  * DOC(:,m,l,ifree,kkk,kk))
1348                     ELSEWHERE
1349                        DOC(:,m,l,ifree,kkk,kk) = DOC(:,m,l,ifree,kkk,kk)
1350                     ENDWHERE
1351                  ENDDO
1352               ENDIF !sro_bottom .GT. 1
1353               !For the last layer
1354               WHERE (soil_mc(:,nslm,pref_soil_veg(m)) .GT. zero)
1355                  DOC(:,m,nslm,ifree,kkk,kk) = DOC(:,m,nslm,ifree,kkk,kk) - &
1356                       &                       MIN(DOC(:,m,nslm,ifree,kkk,kk),&
1357                       &                       lat_exp * DOC(:,m,nslm,ifree,kkk,kk)*drainage_per_soil(:,pref_soil_veg(m))*1E-3 &
1358                       &                       /((z_soil(nslm)-z_soil(nslm-1)) * soil_mc(:,nslm,pref_soil_veg(m))))
1359               ELSEWHERE
1360                  DOC(:,m,nslm,ifree,kkk,kk) = DOC(:,m,nslm,ifree,kkk,kk)
1361               ENDWHERE
1362            ENDDO ! End loop over elements
1363         ENDDO !End loop over soil and litter pool
1364
1365      !! 2.3.10 Transport of particulate organic C (i.e. active, slow and passive
1366      !! pools) following the second Fick's Law (O¿Brien and Stout, 1978; Wynn
1367      !! et al., 2005). Represent the bioturbation and is generally associated
1368      !! with transport  plant debris (Elzein and Balesdent, 1995; Bruun et al.,
1369      !! 2007; Braakhekke et al., 2011, Guenet et al., 2013)
1370
1371      ! Definition of the diffusion rate from Guenet et al., (2013) BG for the
1372      ! moment but must depends on clay, ph organic C, or whatever...
1373     
1374
1375carbon_old(:,:,m,:)=zero
1376carbon_old_buffer(:,:,m,:)=zero
1377carbon_old(:,:,m,:)=carbon(:,:,m,:)
1378
1379     DO kk = 1, ncarb ! Loop over soil and litter pools
1380
1381        carbon_flux(:,kk,m,1) = Dif_coef(:)*ABS(carbon_old(:,kk,m,1)/(z_soil(1))-carbon_old(:,kk,m,2)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
1382
1383      DO l= 2, nslm-1 ! Loop over soil layers
1384        carbon_flux(:,kk,m,l) = Dif_coef(:)*ABS(carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1))-carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))
1385      ENDDO
1386        carbon_flux_old(:,kk,m,:) = carbon_flux(:,kk,m,:)
1387
1388       !Below we checked if in case that, in a given layer, you have diffusion
1389       !in the above and below litters, both fluxes are not higher than the
1390       !stocks of the given layer.
1391
1392      DO l =1, nslm-2
1393           WHERE (carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l)) .AND. &
1394                  carbon_old(:,kk,m,l+2)/(z_soil(l+2)-z_soil(l+1)) .LT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l)) .AND. &
1395                  carbon_flux(:,kk,m,l)+carbon_flux(:,kk,m,l+1) .GT. carbon_old(:,kk,m,l+1))
1396            carbon_flux(:,kk,m,l) = carbon_old(:,kk,m,l+1)*(carbon_flux(:,kk,m,l)/(carbon_flux(:,kk,m,l)+carbon_flux(:,kk,m,l+1)))
1397            carbon_flux(:,kk,m,l+1) = carbon_old(:,kk,m,l+1)*(carbon_flux(:,kk,m,l+1)/(carbon_flux(:,kk,m,l)+carbon_flux(:,kk,m,l+1)))
1398           ELSEWHERE (carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1)) .GE. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l)) .AND. &
1399                      carbon_old(:,kk,m,l+2)/(z_soil(l+2)-z_soil(l+1)) .LT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l)) .AND. &
1400                      carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l) - carbon_flux(:,kk,m,l+1) .LE. min_stomate)
1401            carbon_flux(:,kk,m,l) = carbon_flux(:,kk,m,l)
1402            carbon_flux(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l)
1403           ELSEWHERE (carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l)) .AND. &
1404                      carbon_old(:,kk,m,l+2)/(z_soil(l+2)-z_soil(l+1)) .GE. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l)) .AND. &
1405                      carbon_old(:,kk,m,l+1) - carbon_flux(:,kk,m,l) + carbon_flux(:,kk,m,l+1) .LE. min_stomate)
1406            carbon_flux(:,kk,m,l) = carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l+1)
1407            carbon_flux(:,kk,m,l+1) = carbon_flux(:,kk,m,l+1)
1408           ELSEWHERE
1409            carbon_flux(:,kk,m,l) = carbon_flux(:,kk,m,l)
1410            carbon_flux(:,kk,m,l+1) = carbon_flux(:,kk,m,l+1)
1411           ENDWHERE
1412      ENDDO
1413
1414      DO l= 1, nslm-1 ! Loop over soil layers
1415           WHERE ((carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l))) .AND. &
1416                 ((carbon_flux(:,kk,m,l) - carbon_old(:,kk,m,l+1)) .GE. min_stomate))
1417            carbon(:,kk,m,l) = carbon_old(:,kk,m,l) + carbon_old(:,kk,m,l+1) + carbon_old_buffer(:,kk,m,l)
1418            carbon_old_buffer(:,kk,m,l+1) = -carbon_old(:,kk,m,l+1) 
1419            carbon(:,kk,m,l+1) = zero
1420           ELSEWHERE ((carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l))) .AND. &
1421                  ((carbon_old(:,kk,m,l+1) - carbon_flux(:,kk,m,l)) .GT. min_stomate))
1422            carbon(:,kk,m,l) = carbon_old(:,kk,m,l) + carbon_flux(:,kk,m,l) + carbon_old_buffer(:,kk,m,l)
1423            carbon_old_buffer(:,kk,m,l+1) =  - carbon_flux(:,kk,m,l)
1424            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) - carbon_flux(:,kk,m,l)
1425           ELSEWHERE ((carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1)) .GT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l))) .AND. &
1426                  ((carbon_flux(:,kk,m,l) - carbon_old(:,kk,m,l)) .GE. min_stomate))
1427            carbon(:,kk,m,l) =zero + carbon_old_buffer(:,kk,m,l)
1428            carbon_old_buffer(:,kk,m,l+1) = carbon_old(:,kk,m,l)
1429            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) + carbon_old(:,kk,m,l)
1430           ELSEWHERE ((carbon_old(:,kk,m,l)/(z_soil(l)-z_soil(l-1)) .GT. carbon_old(:,kk,m,l+1)/(z_soil(l+1)-z_soil(l))) .AND. &
1431                  ((carbon_old(:,kk,m,l) - carbon_flux(:,kk,m,l)) .GT. min_stomate))
1432            carbon(:,kk,m,l) = carbon_old(:,kk,m,l) - carbon_flux(:,kk,m,l) + carbon_old_buffer(:,kk,m,l)
1433            carbon_old_buffer(:,kk,m,l+1) = carbon_flux(:,kk,m,l)
1434            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l)
1435           ELSEWHERE
1436            carbon(:,kk,m,l) = carbon_old(:,kk,m,l)
1437            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1)
1438           ENDWHERE
1439        ENDDO ! End loop over soil layers
1440
1441      ENDDO ! End loop over carbon pools
1442  ENDDO ! End loop over PFTs
1443 
1444!WRITE(numout,*) 'LOM', SUM(LOM),SUM(litter_tot)
1445!WRITE(numout,*) 'Decomp', SUM(carbon),SUM(flood_frac),SUM(control_temp_soil),SUM(control_moist_soil)
1446!! 3. Check mass balance closure
1447IF (ld_doc) THEN   
1448    !! 3.1 Calculate components of the mass balance
1449    pool_end(:,:,:) = zero 
1450
1451!Ending carbon pool
1452    DO m = 1, nvm
1453       DO i = 1,ncarb
1454          DO l = 1, nslmd
1455                 pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
1456                           ( carbon(:,i,m,l)* veget_max(:,m) ) 
1457          ENDDO
1458       ENDDO
1459    ENDDO
1460
1461!Ending DOC pool
1462    DO m = 1, nvm
1463       DO i = 1,npool
1464          DO l = 1, nslmd
1465             DO j = 1, ndoc
1466                    pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
1467                              ( DOC(:,m,l,j,i,icarbon) * veget_max(:,m)) 
1468             ENDDO
1469          ENDDO
1470       ENDDO
1471       pool_end(:,m,icarbon) = pool_end(:,m,icarbon) +  interception_storage(:,m,icarbon)
1472    ENDDO
1473
1474!WRITE(numout,*) " pool_start(:,m,icarbon) soil=",  pool_start(:,4,icarbon)
1475!WRITE(numout,*) " pool_end(:,m,icarbon) soil=",  pool_end(:,4,icarbon)
1476
1477 !! 3.2 Calculate mass balance
1478    !  Note that soilcarbon is transfered to other pools but that the pool
1479    !  was not updated. We should not account for it in ::pool_end
1480    check_intern(:,:,:,:) = zero
1481    check_intern(:,:,iatm2land,icarbon) = zero
1482
1483   
1484    check_intern(:,:,iland2atm,icarbon) = -un * (resp_hetero_soil(:,:)+resp_flood_soil(:,:)) * &
1485         veget_max(:,:) * dt 
1486    DO i=1,npool
1487       check_intern(:,:,ilat2out,icarbon) = check_intern(:,:,ilat2out,icarbon) - un * (DOC_EXP(:,:,irunoff,i,icarbon)+ &
1488            &         DOC_EXP(:,:,iflooded,i,icarbon)+ DOC_EXP(:,:,idrainage,i,icarbon)) * veget_max(:,:) * dt
1489    ENDDO !i=1,npool
1490    check_intern(:,:,ilat2in,icarbon) = un * zero
1491    check_intern(:,:,ipoolchange,icarbon) = -un * (pool_end(:,:,icarbon) - &
1492         pool_start(:,:,icarbon))
1493   
1494
1495    closure_intern = zero
1496
1497    DO i = 1,nmbcomp
1498       closure_intern(:,:,icarbon) = closure_intern(:,:,icarbon) + &
1499           check_intern(:,:,i,icarbon)
1500    ENDDO
1501
1502!! 3.3 Write verdict
1503    DO i = 1,npts
1504       IF (SUM(closure_intern(i,:,icarbon)) .GT. min_stomate .OR. &
1505            SUM(closure_intern(i,:,icarbon)) .LT. -min_stomate) THEN
1506          WRITE(numout,*) 'Error: mass balance is not closed in stomate_soilcarbon.f90 at pixel ', i
1507          WRITE(numout,*) '   Difference is, ', SUM(closure_intern(i,:,icarbon))
1508          WRITE(numout,*) '   Vegetation is, ', veget_max(i,:)
1509
1510          WRITE(numout,*) '   deposition, ', SUM(wet_dep_ground(i,:,icarbon))
1511          WRITE(numout,*) '   deposition flood, ', SUM(wet_dep_flood(i,:,icarbon))
1512
1513          WRITE(numout,*) '   soilcarbon_input, ', SUM(SUM(soilcarbon_input(i,:,:,:,icarbon),DIM=2),DIM=2)
1514
1515          WRITE(numout,*) '   DOC_EXP, ',  SUM(SUM(DOC_EXP(i,:,:,:,icarbon),DIM=2),DIM=2)
1516          WRITE(numout,*) '   FLOOD_carbon_input, ', SUM(floodcarbon_input(i,:,:,icarbon),DIM=2)
1517
1518          WRITE(numout,*) '   resp_hetero_soil(:,:), ', SUM(resp_hetero_soil(i,:))
1519          WRITE(numout,*) '   resp_flood_soil(:,:), ', SUM(resp_flood_soil(i,:))
1520       ENDIF
1521    ENDDO !i = 1,npts
1522ENDIF
1523
1524!! 4 Writing history files
1525
1526    CALL xios_orchidee_send_field("dry_dep_canopy",dry_dep_canopy(:,:,icarbon)/dt)
1527    CALL xios_orchidee_send_field("DOC_precip2canopy",DOC_precip2canopy(:,:,icarbon)/dt)
1528    CALL xios_orchidee_send_field("DOC_precip2ground",DOC_precip2ground(:,:,icarbon)/dt)
1529    CALL xios_orchidee_send_field("DOC_canopy2ground",DOC_canopy2ground(:,:,icarbon)/dt)
1530!    CALL xios_orchidee_send_field("EXP_DOC_RUNOFF_ref",DOC_EXP(:,:,irunoff,islo,kk)+DOC_EXP(:,:,irunoff,ipas,kk))
1531!    CALL xios_orchidee_send_field("EXP_DOC_RUNOFF_lab",DOC_EXP(:,:,irunoff,iact,kk))
1532!    CALL xios_orchidee_send_field("EXP_DOC_DRAIN_ref",DOC_EXP(:,:,idrainage,islo,kk)+DOC_EXP(:,:,idrainage,ipas,kk))
1533!    CALL xios_orchidee_send_field("EXP_DOC_DRAIN_lab",DOC_EXP(:,:,idrainage,iact,kk))
1534!    CALL xios_orchidee_send_field("EXP_DOC_FLOOD_ref",DOC_EXP(:,:,iflooded,islo,kk)+DOC_EXP(:,:,iflooded,ipas,kk))
1535!    CALL xios_orchidee_send_field("EXP_DOC_FLOOD_lab",DOC_EXP(:,:,iflooded,iact,kk))
1536    CALL xios_orchidee_send_field("interception_storage",interception_storage(:,:,icarbon))
1537    CALL xios_orchidee_send_field("precip2canopy",precip2canopy(:,:)/dt)
1538    CALL xios_orchidee_send_field("precip2ground",precip2ground(:,:)/dt)
1539    CALL xios_orchidee_send_field("canopy2ground",canopy2ground(:,:)/dt)
1540    CALL xios_orchidee_send_field("runoff_forest",runoff_per_soil(:,2)/dt)
1541    CALL xios_orchidee_send_field("CLAY",clay(:))
1542    CALL xios_orchidee_send_field("SOIL_pH",soil_pH(:))
1543    CALL xios_orchidee_send_field("KD",Kd(:,:))
1544    CALL xios_orchidee_send_field("POOR_SOILS",poor_soils(:))
1545!    DO m=1,13
1546!       WRITE (part_str, '(I1)') m
1547!       var_name = "pass_out_"//part_str(1:LEN_TRIM(part_str))
1548!       CALL xios_orchidee_send_field(var_name,pass_out(:,m,:)/dt*one_year)
1549!       var_name = "pass_in_"//part_str(1:LEN_TRIM(part_str))
1550!       CALL xios_orchidee_send_field(var_name,pass_in(:,m,:)/dt*one_year)
1551!    ENDDO
1552    IF (printlev>=4) WRITE(numout,*) 'Leaving soilcarbon'
1553   
1554  END SUBROUTINE soilcarbon
1555
1556END MODULE stomate_soilcarbon
Note: See TracBrowser for help on using the repository browser.